changeset 202:008309a9da91

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Fri, 18 Jun 2021 17:55:41 +0900
parents db05b4df5b67
children f1ee71c7c93a
files automaton-in-agda/src/nat.agda automaton-in-agda/src/prime.agda
diffstat 2 files changed, 19 insertions(+), 7 deletions(-) [+]
line wrap: on
line diff
--- a/automaton-in-agda/src/nat.agda	Fri Jun 18 10:04:11 2021 +0900
+++ b/automaton-in-agda/src/nat.agda	Fri Jun 18 17:55:41 2021 +0900
@@ -351,6 +351,10 @@
        suc z + y ≡⟨ cong suc ( +-comm _ y ) ⟩
        suc y + z ∎  ) where open ≡-Reasoning
 
+m*1=m : {m : ℕ } → m * 1 ≡ m
+m*1=m {zero} = refl
+m*1=m {suc m} = cong suc m*1=m
+
 record Finduction {n m : Level} (P : Set n ) (Q : P → Set m ) (f : P → ℕ) : Set  (n Level.⊔ m) where
   field
     fzero   : {p : P} → f p ≡ zero → Q p
--- a/automaton-in-agda/src/prime.agda	Fri Jun 18 10:04:11 2021 +0900
+++ b/automaton-in-agda/src/prime.agda	Fri Jun 18 17:55:41 2021 +0900
@@ -99,15 +99,23 @@
      fact1 zero = init
      fact1 (suc m) = record { f1 = fact2 ; is-f1 = fact3 }  where
         fact2 : (n : ℕ ) →  0 < n →  n < suc (suc (suc m )) → ℕ
-        fact2 (suc j)  with <-cmp n j
-        ... | tri< a ¬b ¬c = {!!}
-        ... | tri≈ ¬a refl ¬c = {!!}
-        ... | tri> ¬a ¬b c = {!!}
+        fact2 (suc zero) 0<n n<m = factorial (suc (suc m))
+        fact2 (suc (suc n)) (s≤s 0<n) n<m  with <-cmp (suc n) (suc m)
+        ... | tri< a ¬b ¬c = F.f1 (fact1 m) (suc n) (s≤s z≤n) (≤-trans a refl-≤s) -- suc (suc n) ≤ suc m → suc n < suc (suc m)
+        ... | tri≈ ¬a refl ¬c = F.f1 (fact1 m) (suc m) (s≤s z≤n) a<sa * suc m
+        ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> (s≤s c) n<m ) -- suc (suc m) ≤ suc n
         fact3 : (n : ℕ ) (0<n : 0 < n) (n<m : n < suc (suc (suc m))) → fact2 n 0<n n<m * n ≡ factorial (suc (suc m))
-        fact3 n 0<n n<m  with <-cmp n {!!}
+        fact3 n 0<n n<m with  fact2 n 0<n n<m | inspect (fact2 n 0<n ) n<m  
+        fact3 (suc zero) 0<n n<m     | t | record { eq = refl } = m*1=m
+        fact3 (suc (suc n))  0<n n<m | t | record { eq = eq1 }  with <-cmp (suc n) (suc m)
         ... | tri< a ¬b ¬c = {!!}
-        ... | tri≈ ¬a b ¬c = {!!}
-        ... | tri> ¬a ¬b c = {!!}
+        ... | tri≈ ¬a refl ¬c = begin
+            t * suc (suc m) ≡⟨ cong ( λ k → k * suc (suc m)) (sym eq1) ⟩
+            fact2 (suc (suc n)) 0<n n<m * suc (suc n) ≡⟨ {!!} ⟩
+            suc (suc m) * (F.f1 (fact1 m) (suc m) (s≤s z≤n) a<sa * suc m) ≡⟨ cong ( λ k → suc (suc m) * k ) (F.is-f1 (fact1 m) (suc n) (s≤s z≤n) a<sa) ⟩
+            suc (suc m) * factorial (suc m) ≡⟨ refl ⟩
+            factorial (suc (suc m)) ∎  where open ≡-Reasoning
+        ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> (s≤s c) n<m ) -- suc (suc m) ≤ suc n
      last :  F.f1 (fact1 m) n 0<n n<m * n + 0 ≡ factorial (suc m)
      last = begin
          F.f1 (fact1 m ) n 0<n n<m * n + 0 ≡⟨ +-comm _ 0 ⟩