annotate agda/root2.agda @ 146:6663205ed308

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Wed, 30 Dec 2020 12:07:07 +0900
parents cdfdc8bfb3db
children 0d8a834c9c50
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
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 even : (n : ℕ ) → Set
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
12 even zero = ⊤
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
13 even (suc zero) = ⊥
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
14 even (suc (suc n)) = even n
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
15
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
16 even? : (n : ℕ ) → Dec ( even n )
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
17 even? zero = yes tt
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
18 even? (suc zero) = no (λ ())
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
19 even? (suc (suc n)) = even? n
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
20
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
21 n+even : {n m : ℕ } → even n → even m → even ( n + m )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
22 n+even {zero} {zero} tt tt = tt
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
23 n+even {zero} {suc m} tt em = em
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
24 n+even {suc (suc n)} {m} en em = n+even {n} {m} en em
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
25
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
26 n*even : {m n : ℕ } → even n → even ( m * n )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
27 n*even {zero} {n} en = tt
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
28 n*even {suc m} {n} en = n+even {n} {m * n} en (n*even {m} {n} en)
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
29
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
30 even*n : {n m : ℕ } → even n → even ( n * m )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
31 even*n {n} {m} en = subst even (*-comm m n) (n*even {m} {n} en)
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
32
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
33 gcd1 : ( i i0 j j0 : ℕ ) → ℕ
146
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
34 gcd1 zero i0 zero j0 with <-cmp i0 j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
35 ... | tri< a ¬b ¬c = j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
36 ... | tri≈ ¬a refl ¬c = i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
37 ... | tri> ¬a ¬b c = i0
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
38 gcd1 zero i0 (suc zero) j0 = 1
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
39 gcd1 zero zero (suc (suc j)) j0 = j0
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
40 gcd1 zero (suc i0) (suc (suc j)) j0 = gcd1 i0 (suc i0) (suc j) (suc (suc j))
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
41 gcd1 (suc zero) i0 zero j0 = 1
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
42 gcd1 (suc (suc i)) i0 zero zero = i0
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
43 gcd1 (suc (suc i)) i0 zero (suc j0) = gcd1 (suc i) (suc (suc i)) j0 (suc j0)
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
44 gcd1 (suc i) i0 (suc j) j0 = gcd1 i i0 j j0
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
45
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
46 gcd : ( i j : ℕ ) → ℕ
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
47 gcd i j = gcd1 i i j j
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
48
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
49 even→gcd=2 : {n : ℕ} → even n → n > 0 → gcd n 2 ≡ 2
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
50 even→gcd=2 {suc (suc zero)} en (s≤s z≤n) = refl
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
51 even→gcd=2 {suc (suc (suc (suc n)))} en (s≤s z≤n) = begin
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
52 gcd (suc (suc (suc (suc n)))) 2
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
53 ≡⟨⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
54 gcd (suc (suc n)) 2
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
55 ≡⟨ even→gcd=2 {suc (suc n)} en (s≤s z≤n) ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
56 2
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
57 ∎ where open ≡-Reasoning
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
58
142
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
59 open import nat
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
60
145
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
61 -- gcd26 : { n m : ℕ} → n > 1 → m > 1 → n - m > 0 → gcd n m ≡ gcd (n - m) m
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
62 -- gcd25 : { n m : ℕ} → n > 1 → m > 1 → n - m > 0 → gcd n m ≡ gcd m n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
63 -- gcd27 : { n m : ℕ} → n > 1 → m > 1 → n - m > 0 → gcd n k ≡ k → k ≤ n
143
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 142
diff changeset
64
146
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
65 gcd22 : ( i i0 o o0 : ℕ ) → gcd1 (suc i) i0 (suc o) o0 ≡ gcd1 i i0 o o0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
66 gcd22 zero i0 zero o0 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
67 gcd22 zero i0 (suc o) o0 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
68 gcd22 (suc i) i0 zero o0 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
69 gcd22 (suc i) i0 (suc o) o0 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
70
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
71 gcdsym : { n m : ℕ} → gcd n m ≡ gcd m n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
72 gcdsym {n} {m} = gcdsym1 n n m m where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
73 gcdsym0 : (i : ℕ) → gcd1 zero i zero i ≡ gcd1 zero i zero i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
74 gcdsym0 i = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
75 gcdsym2 : (i j : ℕ) → gcd1 zero i zero j ≡ gcd1 zero j zero i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
76 gcdsym2 i j with <-cmp i j | <-cmp j i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
77 ... | tri< a ¬b ¬c | tri< a₁ ¬b₁ ¬c₁ = ⊥-elim (nat-<> a a₁)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
78 ... | tri< a ¬b ¬c | tri≈ ¬a b ¬c₁ = ⊥-elim (nat-≡< (sym b) a)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
79 ... | tri< a ¬b ¬c | tri> ¬a ¬b₁ c = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
80 ... | tri≈ ¬a b ¬c | tri< a ¬b ¬c₁ = ⊥-elim (nat-≡< (sym b) a)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
81 ... | tri≈ ¬a refl ¬c | tri≈ ¬a₁ refl ¬c₁ = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
82 ... | tri≈ ¬a b ¬c | tri> ¬a₁ ¬b c = ⊥-elim (nat-≡< b c)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
83 ... | tri> ¬a ¬b c | tri< a ¬b₁ ¬c = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
84 ... | tri> ¬a ¬b c | tri≈ ¬a₁ b ¬c = ⊥-elim (nat-≡< b c)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
85 ... | tri> ¬a ¬b c | tri> ¬a₁ ¬b₁ c₁ = ⊥-elim (nat-<> c c₁)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
86 gcdsym1 : ( i i0 j j0 : ℕ ) → gcd1 i i0 j j0 ≡ gcd1 j j0 i i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
87 gcdsym1 zero zero zero zero = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
88 gcdsym1 zero zero zero (suc j0) = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
89 gcdsym1 zero (suc i0) zero zero = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
90 gcdsym1 zero (suc i0) zero (suc j0) = gcdsym2 (suc i0) (suc j0)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
91 gcdsym1 zero zero (suc zero) j0 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
92 gcdsym1 zero zero (suc (suc j)) j0 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
93 gcdsym1 zero (suc i0) (suc zero) j0 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
94 gcdsym1 zero (suc i0) (suc (suc j)) j0 = gcdsym1 i0 (suc i0) (suc j) (suc (suc j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
95 gcdsym1 (suc zero) i0 zero j0 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
96 gcdsym1 (suc (suc i)) i0 zero zero = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
97 gcdsym1 (suc (suc i)) i0 zero (suc j0) = gcdsym1 (suc i) (suc (suc i))j0 (suc j0)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
98 gcdsym1 (suc i) i0 (suc j) j0 = subst₂ (λ j k → j ≡ k ) (sym (gcd22 i _ _ _)) (sym (gcd22 j _ _ _)) (gcdsym1 i i0 j j0 )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
99
142
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
100 gcd24 : { n m k : ℕ} → n > 1 → m > 1 → k > 1 → gcd n k ≡ k → gcd m k ≡ k → ¬ ( gcd n m ≡ 1 )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
101 gcd24 {n} {m} {k} 1<n 1<m 1<k gn gm gnm = gcd21 n n m m k k 1<n 1<m 1<k gn gm gnm where
145
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
102 gcd23 : { j j0 : ℕ } → 1 < j → 1 < j0 → ¬ (gcd1 zero zero j j0 ≡ 1)
146
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
103 gcd23 {zero} {suc j0} 1<j 1<j0 _ = {!!}
145
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
104 gcd23 {suc zero} {suc j0} 1<j 1<j0 gn = nat-<≡ 1<j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
105 gcd23 {suc (suc j)} {suc .0} 1<j 1<j0 refl = nat-<≡ 1<j0
143
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 142
diff changeset
106 1<ss : {j : ℕ} → 1 < suc (suc j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 142
diff changeset
107 1<ss = s≤s (s≤s z≤n)
142
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
108 gcd21 : ( i i0 j j0 o o0 : ℕ ) → 1 < i0 → 1 < j0 → 1 < o0 → gcd1 i i0 o o0 ≡ k → gcd1 j j0 o o0 ≡ k → gcd1 i i0 j j0 ≡ 1 → ⊥
146
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
109 gcd21 zero i0 zero j0 o o0 1<i 1<j 1<o refl gm gnm = nat-≡< (sym gnm) {!!}
145
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
110 --- gcd1 zero i0 o o0 ≡ k o = suc zero → k ≡ 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
111 --- i0 = zero , o = suc (suc o) → o0 = k -> gcd1 zero zero (suc j) j0 ≡ 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
112 -- i0 = suc i0, o = suc (suc o) → gn = gcd1 i0 (suc i0) (suc o) (suc (suc o))
146
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
113 gcd21 zero i0 (suc j) j0 zero o0 1<i 1<j 1<o refl gm gnm = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
114 gcd21 zero i0 (suc j) j0 (suc zero) o0 1<i 1<j 1<o refl gm gnm = nat-<≡ 1<k
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
115 gcd21 zero (suc i0) (suc j) j0 (suc (suc o)) o0 1<i 1<j 1<o gn gm gnm =
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 145
diff changeset
116 gcd21 i0 {!!} (suc j) j0 (suc o) (suc (suc o)) 1<i 1<j {!!} gn {!!} {!!}
145
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
117 gcd21 (suc i) i0 zero j0 o o0 1<i 1<j 1<o gn gm gnm = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 144
diff changeset
118 -- ?
142
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
119 gcd21 (suc i) i0 (suc j) j0 zero o0 1<i 1<j 1<o gn gm gnm = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
120 gcd21 (suc i) i0 (suc j) j0 (suc o) o0 1<i 1<j 1<o gn gm gnm =
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
121 gcd21 i i0 j j0 o o0 1<i 1<j 1<o (subst (λ m → m ≡ k) (gcd22 i i0 _ _ ) gn)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
122 (subst (λ m → m ≡ k) (gcd22 j j0 _ _ ) gm) (subst (λ k → k ≡ 1) (gcd22 i i0 _ _ ) gnm)
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
123
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
124 record Even (i : ℕ) : Set where
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
125 field
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
126 j : ℕ
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
127 is-twice : i ≡ 2 * j
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
128
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
129 e2 : (i : ℕ) → even i → Even i
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
130 e2 zero en = record { j = 0 ; is-twice = refl }
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
131 e2 (suc (suc i)) en = record { j = suc (Even.j (e2 i en )) ; is-twice = e21 } where
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
132 e21 : suc (suc i) ≡ 2 * suc (Even.j (e2 i en))
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
133 e21 = begin
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
134 suc (suc i) ≡⟨ cong (λ k → suc (suc k)) (Even.is-twice (e2 i en)) ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
135 suc (suc (2 * Even.j (e2 i en))) ≡⟨ sym (*-distribˡ-+ 2 1 _) ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
136 2 * suc (Even.j (e2 i en)) ∎ where open ≡-Reasoning
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
137
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
138 record Odd (i : ℕ) : Set where
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
139 field
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
140 j : ℕ
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
141 is-twice : i ≡ suc (2 * j )
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
142
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
143 odd2 : (i : ℕ) → ¬ even i → even (suc i)
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
144 odd2 zero ne = ⊥-elim ( ne tt )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
145 odd2 (suc zero) ne = tt
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
146 odd2 (suc (suc i)) ne = odd2 i ne
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
147
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
148 odd3 : (i : ℕ) → ¬ even i → Odd i
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
149 odd3 zero ne = ⊥-elim ( ne tt )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
150 odd3 (suc zero) ne = record { j = 0 ; is-twice = refl }
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
151 odd3 (suc (suc i)) ne = record { j = Even.j (e2 (suc i) (odd2 i ne)) ; is-twice = odd31 } where
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
152 odd31 : suc (suc i) ≡ suc (2 * Even.j (e2 (suc i) (odd2 i ne)))
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
153 odd31 = begin
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
154 suc (suc i) ≡⟨ cong suc (Even.is-twice (e2 (suc i) (odd2 i ne))) ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
155 suc (2 * (Even.j (e2 (suc i) (odd2 i ne)))) ∎ where open ≡-Reasoning
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
156
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
157 odd4 : (i : ℕ) → even i → ¬ even ( suc i )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
158 odd4 (suc (suc i)) en en1 = odd4 i en en1
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
159
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
160 even^2 : {n : ℕ} → even ( n * n ) → even n
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
161 even^2 {n} en with even? n
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
162 ... | yes y = y
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
163 ... | 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
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
164 m : ℕ
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
165 m = Odd.j ( odd3 n ne )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
166 ee3 : even (2 * m)
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
167 ee3 = subst (λ k → even k ) (*-comm m 2) (n*even {m} {2} tt )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
168 ee4 : even ((2 * m) * suc (2 * m))
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
169 ee4 = even*n {(2 * m)} {suc (2 * m)} (even*n {2} {m} tt )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
170 ee2 : n * n ≡ suc (2 * m) + ((2 * m) * (suc (2 * m) ))
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
171 ee2 = begin n * n ≡⟨ cong ( λ k → k * k) (Odd.is-twice (odd3 n ne)) ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
172 suc (2 * m) * suc (2 * m) ≡⟨ *-distribʳ-+ (suc (2 * m)) 1 ((2 * m) ) ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
173 (1 * suc (2 * m)) + 2 * m * suc (2 * m) ≡⟨ cong (λ k → k + 2 * m * suc (2 * m)) (begin
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
174 suc m + 1 * m + 0 * (suc m + 1 * m ) ≡⟨ +-comm (suc m + 1 * m) 0 ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
175 suc m + 1 * m ≡⟨⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
176 suc (2 * m)
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
177 ∎) ⟩ suc (2 * m) + 2 * m * suc (2 * m) ∎ where open ≡-Reasoning
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
178
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
179 open import nat
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
180
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
181 e3 : {i j : ℕ } → 2 * i ≡ 2 * j → i ≡ j
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
182 e3 {zero} {zero} refl = refl
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
183 e3 {suc x} {suc y} eq with <-cmp x y
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
184 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≡< eq (s≤s (<-trans (<-plus a) (<-plus-0 (s≤s (<-plus a ))))))
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
185 ... | tri≈ ¬a b ¬c = cong suc b
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
186 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym eq) (s≤s (<-trans (<-plus c) (<-plus-0 (s≤s (<-plus c ))))))
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
187
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
188 record Rational : Set where
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
189 field
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
190 i j : ℕ
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
191 coprime : gcd i j ≡ 1
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
192
142
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
193 root2-irrational : ( n m : ℕ ) → n > 1 → m > 1 → 2 * n * n ≡ m * m → ¬ (gcd n m ≡ 1)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
194 root2-irrational n m n>1 m>1 2nm = gcd24 {n} {m} n>1 m>1 (s≤s (s≤s z≤n)) (even→gcd=2 rot7 (rot5 n>1)) (even→gcd=2 ( even^2 {m} ( rot1)) (rot5 m>1))where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
195 rot5 : {n : ℕ} → n > 1 → n > 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
196 rot5 {n} lt = <-trans a<sa lt
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
197 rot1 : even ( m * m )
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
198 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
199 rot4 : (n * n) * 2 ≡ m * m
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
200 rot4 = begin
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
201 (n * n) * 2 ≡⟨ *-comm (n * n) 2 ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
202 2 * ( n * n ) ≡⟨ sym (*-assoc 2 n n) ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
203 2 * n * n ≡⟨ 2nm ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
204 m * m ∎ where open ≡-Reasoning
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
205 E : Even m
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
206 E = e2 m ( even^2 {m} ( rot1 ))
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
207 rot2 : 2 * n * n ≡ 2 * Even.j E * m
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
208 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
209 rot3 : n * n ≡ Even.j E * m
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
210 rot3 = e3 ( begin
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
211 2 * (n * n) ≡⟨ sym (*-assoc 2 n _) ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
212 2 * n * n ≡⟨ rot2 ⟩
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
213 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
214 2 * (Even.j E * m) ∎ ) where open ≡-Reasoning
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
215 rot7 : even n
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
216 rot7 = even^2 {n} (subst (λ k → even k) (sym rot3) ((n*even {Even.j E} {m} ( even^2 {m} ( rot1 )))))
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
217