annotate automaton-in-agda/src/root2.agda @ 198:4b452c9d7e7b

gcd done
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 17 Jun 2021 17:16:36 +0900
parents 8007206a5a19
children 4a83abf7b822
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 module root2 where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
2
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
3 open import Data.Nat
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
4 open import Data.Nat.Properties
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 open import Data.Empty
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
6 open import Data.Unit using (⊤ ; tt)
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 open import Relation.Nullary
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 open import Relation.Binary.PropositionalEquality
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
9 open import Relation.Binary.Definitions
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
10
148
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 147
diff changeset
11 open import gcd
159
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
12 open import even
142
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
13 open import nat
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
14
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
15 record Rational : Set where
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
16 field
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
17 i j : ℕ
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
18 coprime : gcd i j ≡ 1
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
19
187
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 186
diff changeset
20 even→gcd=2 : {n : ℕ} → even n → gcd n 2 ≡ 2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 186
diff changeset
21 even→gcd=2 {zero} en = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 186
diff changeset
22 even→gcd=2 {suc (suc zero)} en = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 186
diff changeset
23 even→gcd=2 {suc (suc (suc (suc n)))} en = begin
159
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
24 gcd (suc (suc (suc (suc n)))) 2 ≡⟨⟩
187
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 186
diff changeset
25 gcd (suc (suc n)) 2 ≡⟨ even→gcd=2 {suc (suc n)} en ⟩
159
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
26 2 ∎ where open ≡-Reasoning
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
27
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
28 even^2 : {n : ℕ} → even ( n * n ) → even n
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
29 even^2 {n} en with even? n
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
30 ... | yes y = y
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
31 ... | 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
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
32 m : ℕ
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
33 m = Odd.j ( odd3 n ne )
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
34 ee3 : even (2 * m)
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
35 ee3 = subst (λ k → even k ) (*-comm m 2) (n*even {m} {2} tt )
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
36 ee4 : even ((2 * m) * suc (2 * m))
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
37 ee4 = even*n {(2 * m)} {suc (2 * m)} (even*n {2} {m} tt )
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
38 ee2 : n * n ≡ suc (2 * m) + ((2 * m) * (suc (2 * m) ))
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
39 ee2 = begin n * n ≡⟨ cong ( λ k → k * k) (Odd.is-twice (odd3 n ne)) ⟩
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
40 suc (2 * m) * suc (2 * m) ≡⟨ *-distribʳ-+ (suc (2 * m)) 1 ((2 * m) ) ⟩
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
41 (1 * suc (2 * m)) + 2 * m * suc (2 * m) ≡⟨ cong (λ k → k + 2 * m * suc (2 * m)) (begin
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
42 suc m + 1 * m + 0 * (suc m + 1 * m ) ≡⟨ +-comm (suc m + 1 * m) 0 ⟩
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
43 suc m + 1 * m ≡⟨⟩
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
44 suc (2 * m)
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
45 ∎) ⟩ suc (2 * m) + 2 * m * suc (2 * m) ∎ where open ≡-Reasoning
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
46
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
47 e3 : {i j : ℕ } → 2 * i ≡ 2 * j → i ≡ j
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
48 e3 {zero} {zero} refl = refl
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
49 e3 {suc x} {suc y} eq with <-cmp x y
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
50 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≡< eq (s≤s (<-trans (<-plus a) (<-plus-0 (s≤s (<-plus a ))))))
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
51 ... | tri≈ ¬a b ¬c = cong suc b
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
52 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym eq) (s≤s (<-trans (<-plus c) (<-plus-0 (s≤s (<-plus c ))))))
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
53
165
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
54 open Factor
164
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 159
diff changeset
55
186
08f4ec41ea93 even→gcd
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
56 -- gcd-div : ( i j k : ℕ ) → (if : Factor k i) (jf : Factor k j )
08f4ec41ea93 even→gcd
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
57 -- → remain if ≡ 0 → remain jf ≡ 0
08f4ec41ea93 even→gcd
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
58 -- → Dividable k ( gcd i j )
08f4ec41ea93 even→gcd
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
59
142
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
60 root2-irrational : ( n m : ℕ ) → n > 1 → m > 1 → 2 * n * n ≡ m * m → ¬ (gcd n m ≡ 1)
198
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
61 root2-irrational n m n>1 m>1 2nm = rot13 ( gcd-div n m 2 (s≤s (s≤s z≤n)) {!!} {!!} ) where
165
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
62 rot13 : {m : ℕ } → Dividable 2 m → m ≡ 1 → ⊥
185
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
63 rot13 d refl with Dividable.factor d | Dividable.is-factor d
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
64 ... | zero | ()
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
65 ... | suc n | ()
165
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
66 rot11 : {m : ℕ } → even m → Factor 2 m
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
67 rot11 {zero} em = record { factor = 0 ; remain = 0 ; is-factor = refl }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
68 rot11 {suc zero} ()
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
69 rot11 {suc (suc m) } em = record { factor = suc (factor fc ) ; remain = remain fc ; is-factor = isfc } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
70 fc : Factor 2 m
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
71 fc = rot11 {m} em
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
72 isfc : suc (factor fc) * 2 + remain fc ≡ suc (suc m)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
73 isfc = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
74 suc (factor fc) * 2 + remain fc ≡⟨ cong (λ k → k + remain fc) (*-distribʳ-+ 2 1 (factor fc)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
75 ((1 * 2) + (factor fc)* 2 ) + remain fc ≡⟨⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
76 ((1 + 1) + (factor fc)* 2 ) + remain fc ≡⟨ cong (λ k → k + remain fc) (+-assoc 1 1 _ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
77 (1 + (1 + (factor fc)* 2 )) + remain fc ≡⟨⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
78 suc (suc ((factor fc * 2) + remain fc )) ≡⟨ cong (λ x → suc (suc x)) (is-factor fc) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
79 suc (suc m) ∎ where open ≡-Reasoning
142
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
80 rot5 : {n : ℕ} → n > 1 → n > 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
81 rot5 {n} lt = <-trans a<sa lt
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
82 rot1 : even ( m * m )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
83 rot1 = subst (λ k → even k ) rot4 (n*even {n * n} {2} tt ) where
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
84 rot4 : (n * n) * 2 ≡ m * m
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
85 rot4 = begin
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
86 (n * n) * 2 ≡⟨ *-comm (n * n) 2 ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
87 2 * ( n * n ) ≡⟨ sym (*-assoc 2 n n) ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
88 2 * n * n ≡⟨ 2nm ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
89 m * m ∎ where open ≡-Reasoning
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
90 E : Even m
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
91 E = e2 m ( even^2 {m} ( rot1 ))
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
92 rot2 : 2 * n * n ≡ 2 * Even.j E * m
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
93 rot2 = subst (λ k → 2 * n * n ≡ k * m ) (Even.is-twice E) 2nm
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
94 rot3 : n * n ≡ Even.j E * m
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
95 rot3 = e3 ( begin
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
96 2 * (n * n) ≡⟨ sym (*-assoc 2 n _) ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
97 2 * n * n ≡⟨ rot2 ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
98 2 * Even.j E * m ≡⟨ *-assoc 2 (Even.j E) m ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
99 2 * (Even.j E * m) ∎ ) where open ≡-Reasoning
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
100 rot7 : even n
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
101 rot7 = even^2 {n} (subst (λ k → even k) (sym rot3) ((n*even {Even.j E} {m} ( even^2 {m} ( rot1 )))))
165
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
102 f2 : Factor 2 n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
103 f2 = rot11 rot7
185
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
104 f3 : ( n : ℕ) → (e : even n ) → remain (rot11 {n} e) ≡ 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
105 f3 zero e = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
106 f3 (suc (suc n)) e = f3 n e
165
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
107 fm : Factor 2 m
185
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
108 fm = record { factor = Even.j E ; remain = 0 ; is-factor = fm1 } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
109 fm1 : Even.j E * 2 + 0 ≡ m
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
110 fm1 = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
111 Even.j E * 2 + 0 ≡⟨ +-comm _ 0 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
112 Even.j E * 2 ≡⟨ *-comm (Even.j E) 2 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
113 2 * Even.j E ≡⟨ sym ( Even.is-twice E ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
114 m ∎ where open ≡-Reasoning
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
115
185
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
116