Mercurial > hg > Members > kono > Proof > automaton
changeset 233:327094b57ee2
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Fri, 25 Jun 2021 20:16:53 +0900 |
parents | 9011d76a67fb |
children | 65dea8980aee |
files | automaton-in-agda/src/gcd.agda automaton-in-agda/src/root2.agda |
diffstat | 2 files changed, 89 insertions(+), 138 deletions(-) [+] |
line wrap: on
line diff
--- a/automaton-in-agda/src/gcd.agda Fri Jun 25 09:20:32 2021 +0900 +++ b/automaton-in-agda/src/gcd.agda Fri Jun 25 20:16:53 2021 +0900 @@ -466,30 +466,89 @@ ; ind = λ {p} prev → ind (proj1 p ) ( proj2 p ) prev } --- record Equlid (i j gcd : ℕ ) : Set where --- field --- eqa : ℕ --- eqb : ℕ --- gcd-equ : ((eqa * i) - (eqb * j) ≡ gcd ) ∨ ((eqb * j) - (eqa * i) ≡ gcd ) --- --- gcd-equlid1 : ( i i0 j j0 : ℕ ) → Equlid i0 j0 (gcd1 i i0 j j0) --- gcd-equlid1 zero i0 zero j0 with <-cmp i0 j0 +record Equlid (i j gcd : ℕ ) : Set where + field + eqa : ℕ + eqb : ℕ + gcd-equ : ((eqa * i) - (eqb * j) ≡ gcd ) ∨ ((eqb * j) - (eqa * i) ≡ gcd ) + +di-next : {i i0 j j0 : ℕ} → Dividable i0 ((j0 + suc i) - suc j ) ∧ Dividable j0 ((i0 + suc j) - suc i) → + Dividable i0 ((j0 + i) - j ) ∧ Dividable j0 ((i0 + j) - i) +di-next {i} {i0} {j} {j0} x = + ⟪ ( subst (λ k → Dividable i0 (k - suc j)) ( begin + j0 + suc i ≡⟨ sym (+-assoc j0 1 i ) ⟩ + (j0 + 1) + i ≡⟨ cong (λ k → k + i) (+-comm j0 _ ) ⟩ + suc (j0 + i) ∎ ) (proj1 x) ) , + ( subst (λ k → Dividable j0 (k - suc i)) ( begin + i0 + suc j ≡⟨ sym (+-assoc i0 1 j ) ⟩ + (i0 + 1) + j ≡⟨ cong (λ k → k + j) (+-comm i0 _ ) ⟩ + suc (i0 + j) ∎ ) (proj2 x) ) ⟫ + where open ≡-Reasoning + +postulate + gcd-equlid : ( p q r : ℕ ) → 1 < p → ((i : ℕ ) → i < p → 0 < i → gcd p i ≡ 1) → Dividable p (q * r) → Dividable p q ∨ Dividable p r + gcd-equlid1 : ( i i0 j j0 : ℕ ) → Dividable i0 ((j0 + i) - j ) ∧ Dividable j0 ((i0 + j) - i) → Equlid i0 j0 (gcd1 i i0 j j0) +-- gcd-equlid1 zero i0 zero j0 di with <-cmp i0 j0 -- ... | tri< a' ¬b ¬c = record { eqa = 1 ; eqb = 0 ; gcd-equ = case1 {!!} } -- ... | tri≈ ¬a refl ¬c = record { eqa = 1 ; eqb = 0 ; gcd-equ = case1 {!!} } -- ... | tri> ¬a ¬b c = record { eqa = 0 ; eqb = 1 ; gcd-equ = case2 {!!} } --- gcd-equlid1 zero i0 (suc zero) j0 = record { eqa = 1 ; eqb = 1 ; gcd-equ = case1 {!!} } --- gcd-equlid1 zero zero (suc (suc j)) j0 = record { eqa = 0 ; eqb = 1 ; gcd-equ = case2 {!!} } --- gcd-equlid1 zero (suc i0) (suc (suc j)) j0 with gcd-equlid1 i0 (suc i0) (suc j) (suc (suc j)) --- ... | e = record { eqa = Equlid.eqb e ; eqb = Equlid.eqa e ; gcd-equ = {!!} } --- gcd-equlid1 (suc zero) i0 zero j0 = {!!} --- gcd-equlid1 (suc (suc i)) i0 zero zero = {!!} --- gcd-equlid1 (suc (suc i)) i0 zero (suc j0) with gcd-equlid1 (suc i) (suc (suc i)) j0 (suc j0) +-- gcd-equlid1 zero i0 (suc zero) j0 di = record { eqa = 1 ; eqb = 1 ; gcd-equ = case1 {!!} } +-- gcd-equlid1 zero zero (suc (suc j)) j0 di = record { eqa = 0 ; eqb = 1 ; gcd-equ = case2 {!!} } +-- gcd-equlid1 zero (suc i0) (suc (suc j)) j0 di with gcd-equlid1 i0 (suc i0) (suc j) (suc (suc j)) {!!} +-- ... | e with Equlid.gcd-equ e +-- ... | case1 x = record { eqa = ea + eb * f ; eqb = eb ; gcd-equ = case1 (trans ge1 x ) } where +-- -- Dividable (suc i0) ((j0 + 0) - (suc (suc j))) ∨ Dividable j0 (suc (i0 + suc (suc j))) +-- -- (j0 + 0) - (suc (suc j)) ≡ f * (suc i0) +-- ea = Equlid.eqa e +-- eb = Equlid.eqb e +-- f = Dividable.factor (proj1 di) +-- ge1 : ((ea + eb * f) * suc i0) - (eb * j0) ≡ (ea * suc i0) - (eb * suc (suc j)) +-- ge1 = begin +-- ((ea + eb * f ) * suc i0) - (eb * j0) ≡⟨ {!!} ⟩ +-- ((ea + eb * f ) * suc i0) - eb * (f * (suc i0) + suc (suc j) ) ≡⟨ {!!} ⟩ +-- ((ea + eb * f ) * suc i0 - (eb * f) * (suc i0)) + eb * suc (suc j) ≡⟨ {!!} ⟩ +-- ((ea * suc i0 + (eb * f ) * suc i0 ) - (eb * f) * (suc i0)) + eb * suc (suc j) ≡⟨ {!!} ⟩ +-- (ea * suc i0) - (eb * suc (suc j)) ∎ where open ≡-Reasoning +-- ... | case2 x = {!!} +-- gcd-equlid1 (suc zero) i0 zero j0 di = {!!} +-- gcd-equlid1 (suc (suc i)) i0 zero zero di = {!!} +-- gcd-equlid1 (suc (suc i)) i0 zero (suc j0) di with gcd-equlid1 (suc i) (suc (suc i)) j0 (suc j0) {!!} -- ... | e = {!!} --- gcd-equlid1 (suc zero) i0 (suc j) j0 = --- gcd-equlid1 zero i0 j j0 --- gcd-equlid1 (suc (suc i)) i0 (suc j) j0 = --- gcd-equlid1 (suc i) i0 j j0 +-- gcd-equlid1 (suc zero) i0 (suc j) j0 di = +-- gcd-equlid1 zero i0 j j0 (di-next di) +-- gcd-equlid1 (suc (suc i)) i0 (suc j) j0 di = +-- gcd-equlid1 (suc i) i0 j j0 (di-next di) + +div→gcd : {n k : ℕ } → k > 1 → Dividable k n → gcd n k ≡ k +div→gcd {n} {k} k>1 = n-induction {_} {_} {ℕ} {λ m → Dividable k m → gcd m k ≡ k } (λ x → x) I n where + decl : {m : ℕ } → 0 < m → m - k < m + decl {m} 0<m = y-x<y (<-trans a<sa k>1 ) 0<m + ind : (m : ℕ ) → (Dividable k (m - k) → gcd (m - k) k ≡ k) → Dividable k m → gcd m k ≡ k + ind m prev d with <-cmp (suc m) k + ... | tri≈ ¬a refl ¬c = ⊥-elim ( div+1 k>1 d div= ) + ... | tri> ¬a ¬b c = subst (λ g → g ≡ k) ind1 ( prev (proj2 (div-div k>1 div= d))) where + ind1 : gcd (m - k) k ≡ gcd m k + ind1 = begin + gcd (m - k) k ≡⟨ sym (gcd+j (m - k) _) ⟩ + gcd (m - k + k) k ≡⟨ cong (λ g → gcd g k) (minus+n {m} {k} c) ⟩ + gcd m k ∎ where open ≡-Reasoning + ... | tri< a ¬b ¬c with <-cmp 0 m + ... | tri< a₁ ¬b₁ ¬c₁ = ⊥-elim ( div<k k>1 a₁ (<-trans a<sa a) d ) + ... | tri≈ ¬a refl ¬c₁ = subst (λ g → g ≡ k ) (gcdsym {k} {0} ) (gcd20 k) + fzero : (m : ℕ) → (m - k) ≡ zero → Dividable k m → gcd m k ≡ k + fzero 0 eq d = trans (gcdsym {0} {k} ) (gcd20 k) + fzero (suc m) eq d with <-cmp (suc m) k + ... | tri< a ¬b ¬c = ⊥-elim ( div<k k>1 (s≤s z≤n) a d ) + ... | tri≈ ¬a refl ¬c = gcdmm k k + ... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym eq) (minus>0 c) ) + I : Ninduction ℕ _ (λ x → x) + I = record { + pnext = λ p → p - k + ; fzero = λ {m} eq → fzero m eq + ; decline = λ {m} lt → decl lt + ; ind = λ {p} prev → ind p prev + } gcdmul+1 : ( m n : ℕ ) → gcd (m * n + 1) n ≡ 1 gcdmul+1 zero n = gcd204 n
--- a/automaton-in-agda/src/root2.agda Fri Jun 25 09:20:32 2021 +0900 +++ b/automaton-in-agda/src/root2.agda Fri Jun 25 20:16:53 2021 +0900 @@ -20,80 +20,21 @@ open _∧_ -div→gcd : {n k : ℕ } → k > 1 → Dividable k n → gcd n k ≡ k -div→gcd {n} {k} k>1 = n-induction {_} {_} {ℕ} {λ m → Dividable k m → gcd m k ≡ k } (λ x → x) I n where - decl : {m : ℕ } → 0 < m → m - k < m - decl {m} 0<m = y-x<y (<-trans a<sa k>1 ) 0<m - ind : (m : ℕ ) → (Dividable k (m - k) → gcd (m - k) k ≡ k) → Dividable k m → gcd m k ≡ k - ind m prev d with <-cmp (suc m) k - ... | tri≈ ¬a refl ¬c = ⊥-elim ( div+1 k>1 d div= ) - ... | tri> ¬a ¬b c = subst (λ g → g ≡ k) ind1 ( prev (proj2 (div-div k>1 div= d))) where - ind1 : gcd (m - k) k ≡ gcd m k - ind1 = begin - gcd (m - k) k ≡⟨ sym (gcd+j (m - k) _) ⟩ - gcd (m - k + k) k ≡⟨ cong (λ g → gcd g k) (minus+n {m} {k} c) ⟩ - gcd m k ∎ where open ≡-Reasoning - ... | tri< a ¬b ¬c with <-cmp 0 m - ... | tri< a₁ ¬b₁ ¬c₁ = ⊥-elim ( div<k k>1 a₁ (<-trans a<sa a) d ) - ... | tri≈ ¬a refl ¬c₁ = subst (λ g → g ≡ k ) (gcdsym {k} {0} ) (gcd20 k) - fzero : (m : ℕ) → (m - k) ≡ zero → Dividable k m → gcd m k ≡ k - fzero 0 eq d = trans (gcdsym {0} {k} ) (gcd20 k) - fzero (suc m) eq d with <-cmp (suc m) k - ... | tri< a ¬b ¬c = ⊥-elim ( div<k k>1 (s≤s z≤n) a d ) - ... | tri≈ ¬a refl ¬c = gcdmm k k - ... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym eq) (minus>0 c) ) - I : Ninduction ℕ _ (λ x → x) - I = record { - pnext = λ p → p - k - ; fzero = λ {m} eq → fzero m eq - ; decline = λ {m} lt → decl lt - ; ind = λ {p} prev → ind p prev - } - --- n ≡ i * k + r --- n^2 = (i * k)^2 + i * r * k + r^2 --- r^2 | k yes → jj - open import prime -- equlid : ( n m k : ℕ ) → 1 < k → 1 < n → Prime k → Dividable k ( n * m ) → Dividable k n ∨ Dividable k m -- equlid = {!!} --- divdable^2 : ( n k : ℕ ) → 1 < k → 1 < n → Prime k → Dividable k ( n * n ) → Dividable k n --- divdable^2 zero zero 1<k 1<n pk dn2 = {!!} --- divdable^2 (suc n) (suc k) 1<k 1<n pk dn2 with decD {suc k} {suc n} 1<k --- ... | yes y = y --- ... | no non with equlid (suc n) (suc n) (suc k) 1<k {!!} pk dn2 --- ... | case1 dn = dn --- ... | case2 dm = dm - -even^2 : {n : ℕ} → even ( n * n ) → even n -even^2 {n} en with even? n +divdable^2 : ( n k : ℕ ) → 1 < k → 1 < n → Prime k → Dividable k ( n * n ) → Dividable k n +divdable^2 zero zero () 1<n pk dn2 +divdable^2 (suc n) (suc k) 1<k 1<n pk dn2 with decD {suc k} {suc n} 1<k ... | yes y = y -... | no ne = ⊥-elim ( odd4 ((2 * m) + 2 * m * suc (2 * m)) (n+even {2 * m} {2 * m * suc (2 * m)} ee3 ee4) (subst (λ k → even k) ee2 en )) where - m : ℕ - m = Odd.j ( odd3 n ne ) - ee3 : even (2 * m) - ee3 = subst (λ k → even k ) (*-comm m 2) (n*even {m} {2} tt ) - ee4 : even ((2 * m) * suc (2 * m)) - ee4 = even*n {(2 * m)} {suc (2 * m)} (even*n {2} {m} tt ) - ee2 : n * n ≡ suc (2 * m) + ((2 * m) * (suc (2 * m) )) - ee2 = begin n * n ≡⟨ cong ( λ k → k * k) (Odd.is-twice (odd3 n ne)) ⟩ - suc (2 * m) * suc (2 * m) ≡⟨ *-distribʳ-+ (suc (2 * m)) 1 ((2 * m) ) ⟩ - (1 * suc (2 * m)) + 2 * m * suc (2 * m) ≡⟨ cong (λ k → k + 2 * m * suc (2 * m)) (begin - suc m + 1 * m + 0 * (suc m + 1 * m ) ≡⟨ +-comm (suc m + 1 * m) 0 ⟩ - suc m + 1 * m ≡⟨⟩ - suc (2 * m) - ∎) ⟩ suc (2 * m) + 2 * m * suc (2 * m) ∎ where open ≡-Reasoning +... | no non with gcd-equlid (suc k) (suc n) (suc n) 1<k (Prime.isPrime pk) dn2 +... | case1 dn = dn +... | case2 dm = dm -e3 : {i j : ℕ } → 2 * i ≡ 2 * j → i ≡ j -e3 {zero} {zero} refl = refl -e3 {suc x} {suc y} eq with <-cmp x y -... | tri< a ¬b ¬c = ⊥-elim ( nat-≡< eq (s≤s (<-trans (<-plus a) (<-plus-0 (s≤s (<-plus a )))))) -... | tri≈ ¬a b ¬c = cong suc b -... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym eq) (s≤s (<-trans (<-plus c) (<-plus-0 (s≤s (<-plus c )))))) - -open Factor +p2 : Prime 2 + p2 = record { p>1 = a<sa ; isPrime = {!!} } -- gcd-div : ( i j k : ℕ ) → (if : Dividable k i) (jf : Dividable k j ) -- → Dividable k ( gcd i j ) @@ -104,58 +45,9 @@ rot13 d refl with Dividable.factor d | Dividable.is-factor d ... | zero | () ... | suc n | () - rot11 : {m : ℕ } → even m → Factor 2 m - rot11 {zero} em = record { factor = 0 ; remain = 0 ; is-factor = refl } - rot11 {suc zero} () - rot11 {suc (suc m) } em = record { factor = suc (factor fc ) ; remain = remain fc ; is-factor = isfc } where - fc : Factor 2 m - fc = rot11 {m} em - isfc : suc (factor fc) * 2 + remain fc ≡ suc (suc m) - isfc = begin - suc (factor fc) * 2 + remain fc ≡⟨ cong (λ k → k + remain fc) (*-distribʳ-+ 2 1 (factor fc)) ⟩ - ((1 * 2) + (factor fc)* 2 ) + remain fc ≡⟨⟩ - ((1 + 1) + (factor fc)* 2 ) + remain fc ≡⟨ cong (λ k → k + remain fc) (+-assoc 1 1 _ ) ⟩ - (1 + (1 + (factor fc)* 2 )) + remain fc ≡⟨⟩ - suc (suc ((factor fc * 2) + remain fc )) ≡⟨ cong (λ x → suc (suc x)) (is-factor fc) ⟩ - suc (suc m) ∎ where open ≡-Reasoning - rot5 : {n : ℕ} → n > 1 → n > 0 - rot5 {n} lt = <-trans a<sa lt - rot1 : even ( m * m ) - rot1 = subst (λ k → even k ) rot4 (n*even {n * n} {2} tt ) where - rot4 : (n * n) * 2 ≡ m * m - rot4 = begin - (n * n) * 2 ≡⟨ *-comm (n * n) 2 ⟩ - 2 * ( n * n ) ≡⟨ sym (*-assoc 2 n n) ⟩ - 2 * n * n ≡⟨ 2nm ⟩ - m * m ∎ where open ≡-Reasoning - E : Even m - E = e2 m ( even^2 {m} ( rot1 )) - rot2 : 2 * n * n ≡ 2 * Even.j E * m - rot2 = subst (λ k → 2 * n * n ≡ k * m ) (Even.is-twice E) 2nm - rot3 : n * n ≡ Even.j E * m - rot3 = e3 ( begin - 2 * (n * n) ≡⟨ sym (*-assoc 2 n _) ⟩ - 2 * n * n ≡⟨ rot2 ⟩ - 2 * Even.j E * m ≡⟨ *-assoc 2 (Even.j E) m ⟩ - 2 * (Even.j E * m) ∎ ) where open ≡-Reasoning - rot7 : even n - rot7 = even^2 {n} (subst (λ k → even k) (sym rot3) ((n*even {Even.j E} {m} ( even^2 {m} ( rot1 ))))) - f2 : Factor 2 n - f2 = rot11 rot7 - f3 : ( n : ℕ) → (e : even n ) → remain (rot11 {n} e) ≡ 0 - f3 zero e = refl - f3 (suc (suc n)) e = f3 n e - fm : Factor 2 m - fm = record { factor = Even.j E ; remain = 0 ; is-factor = fm1 } where - fm1 : Even.j E * 2 + 0 ≡ m - fm1 = begin - Even.j E * 2 + 0 ≡⟨ +-comm _ 0 ⟩ - Even.j E * 2 ≡⟨ *-comm (Even.j E) 2 ⟩ - 2 * Even.j E ≡⟨ sym ( Even.is-twice E ) ⟩ - m ∎ where open ≡-Reasoning + dm : Dividable 2 m + dm = divdable^2 m 2 a<sa m>1 p2 record { factor = n * n ; is-factor = {!!} } dn : Dividable 2 n - dn = record { factor = factor f2 ; is-factor = subst (λ k → factor f2 * 2 + k ≡ n ) (f3 n rot7) (is-factor f2) } - dm : Dividable 2 m - dm = record { factor = factor fm ; is-factor = is-factor fm } + dn = divdable^2 n 2 a<sa n>1 p2 record { factor = Dividable.factor dm * m ; is-factor = {!!} }