annotate automaton-in-agda/src/gcd.agda @ 289:c9802aa2a8c9

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Tue, 28 Dec 2021 15:25:22 +0900
parents 8b437dd616dd
children 4a00e5f2b793
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
148
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 147
diff changeset
1 {-# OPTIONS --allow-unsolved-metas #-}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 147
diff changeset
2 module gcd where
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
4 open import Data.Nat
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
5 open import Data.Nat.Properties
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 open import Data.Empty
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
7 open import Data.Unit using (⊤ ; tt)
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 open import Relation.Nullary
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 open import Relation.Binary.PropositionalEquality
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
10 open import Relation.Binary.Definitions
149
d3a8572ced9c non terminating GCD
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
11 open import nat
151
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 150
diff changeset
12 open import logic
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
13
164
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 162
diff changeset
14 open Factor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 162
diff changeset
15
165
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
16 gcd1 : ( i i0 j j0 : ℕ ) → ℕ
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
17 gcd1 zero i0 zero j0 with <-cmp i0 j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
18 ... | tri< a ¬b ¬c = i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
19 ... | tri≈ ¬a refl ¬c = i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
20 ... | tri> ¬a ¬b c = j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
21 gcd1 zero i0 (suc zero) j0 = 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
22 gcd1 zero zero (suc (suc j)) j0 = j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
23 gcd1 zero (suc i0) (suc (suc j)) j0 = gcd1 i0 (suc i0) (suc j) (suc (suc j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
24 gcd1 (suc zero) i0 zero j0 = 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
25 gcd1 (suc (suc i)) i0 zero zero = i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
26 gcd1 (suc (suc i)) i0 zero (suc j0) = gcd1 (suc i) (suc (suc i)) j0 (suc j0)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
27 gcd1 (suc i) i0 (suc j) j0 = gcd1 i i0 j j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
29 gcd : ( i j : ℕ ) → ℕ
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
30 gcd i j = gcd1 i i j j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
31
209
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
32 gcd20 : (i : ℕ) → gcd i 0 ≡ i
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
33 gcd20 zero = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
34 gcd20 (suc i) = gcd201 (suc i) where
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
35 gcd201 : (i : ℕ ) → gcd1 i i zero zero ≡ i
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
36 gcd201 zero = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
37 gcd201 (suc zero) = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
38 gcd201 (suc (suc i)) = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
39
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
40 gcd22 : ( i i0 o o0 : ℕ ) → gcd1 (suc i) i0 (suc o) o0 ≡ gcd1 i i0 o o0
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
41 gcd22 zero i0 zero o0 = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
42 gcd22 zero i0 (suc o) o0 = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
43 gcd22 (suc i) i0 zero o0 = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
44 gcd22 (suc i) i0 (suc o) o0 = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
45
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
46 gcdmm : (n m : ℕ) → gcd1 n m n m ≡ m
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
47 gcdmm zero m with <-cmp m m
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
48 ... | tri< a ¬b ¬c = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
49 ... | tri≈ ¬a refl ¬c = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
50 ... | tri> ¬a ¬b c = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
51 gcdmm (suc n) m = subst (λ k → k ≡ m) (sym (gcd22 n m n m )) (gcdmm n m )
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
52
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
53 gcdsym2 : (i j : ℕ) → gcd1 zero i zero j ≡ gcd1 zero j zero i
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
54 gcdsym2 i j with <-cmp i j | <-cmp j i
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
55 ... | tri< a ¬b ¬c | tri< a₁ ¬b₁ ¬c₁ = ⊥-elim (nat-<> a a₁)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
56 ... | tri< a ¬b ¬c | tri≈ ¬a b ¬c₁ = ⊥-elim (nat-≡< (sym b) a)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
57 ... | tri< a ¬b ¬c | tri> ¬a ¬b₁ c = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
58 ... | tri≈ ¬a b ¬c | tri< a ¬b ¬c₁ = ⊥-elim (nat-≡< (sym b) a)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
59 ... | tri≈ ¬a refl ¬c | tri≈ ¬a₁ refl ¬c₁ = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
60 ... | tri≈ ¬a b ¬c | tri> ¬a₁ ¬b c = ⊥-elim (nat-≡< b c)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
61 ... | tri> ¬a ¬b c | tri< a ¬b₁ ¬c = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
62 ... | tri> ¬a ¬b c | tri≈ ¬a₁ b ¬c = ⊥-elim (nat-≡< b c)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
63 ... | tri> ¬a ¬b c | tri> ¬a₁ ¬b₁ c₁ = ⊥-elim (nat-<> c c₁)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
64 gcdsym1 : ( i i0 j j0 : ℕ ) → gcd1 i i0 j j0 ≡ gcd1 j j0 i i0
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
65 gcdsym1 zero zero zero zero = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
66 gcdsym1 zero zero zero (suc j0) = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
67 gcdsym1 zero (suc i0) zero zero = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
68 gcdsym1 zero (suc i0) zero (suc j0) = gcdsym2 (suc i0) (suc j0)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
69 gcdsym1 zero zero (suc zero) j0 = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
70 gcdsym1 zero zero (suc (suc j)) j0 = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
71 gcdsym1 zero (suc i0) (suc zero) j0 = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
72 gcdsym1 zero (suc i0) (suc (suc j)) j0 = gcdsym1 i0 (suc i0) (suc j) (suc (suc j))
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
73 gcdsym1 (suc zero) i0 zero j0 = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
74 gcdsym1 (suc (suc i)) i0 zero zero = refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
75 gcdsym1 (suc (suc i)) i0 zero (suc j0) = gcdsym1 (suc i) (suc (suc i))j0 (suc j0)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
76 gcdsym1 (suc i) i0 (suc j) j0 = subst₂ (λ j k → j ≡ k ) (sym (gcd22 i _ _ _)) (sym (gcd22 j _ _ _)) (gcdsym1 i i0 j j0 )
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
77
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
78 gcdsym : { n m : ℕ} → gcd n m ≡ gcd m n
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
79 gcdsym {n} {m} = gcdsym1 n n m m
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
80
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
81 gcd11 : ( i : ℕ ) → gcd i i ≡ i
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
82 gcd11 i = gcdmm i i
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
83
212
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
84
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
85 gcd203 : (i : ℕ) → gcd1 (suc i) (suc i) i i ≡ 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
86 gcd203 zero = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
87 gcd203 (suc i) = gcd205 (suc i) where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
88 gcd205 : (j : ℕ) → gcd1 (suc j) (suc (suc i)) j (suc i) ≡ 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
89 gcd205 zero = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
90 gcd205 (suc j) = subst (λ k → k ≡ 1) (gcd22 (suc j) (suc (suc i)) j (suc i)) (gcd205 j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
91
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
92 gcd204 : (i : ℕ) → gcd1 1 1 i i ≡ 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
93 gcd204 zero = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
94 gcd204 (suc zero) = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
95 gcd204 (suc (suc zero)) = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
96 gcd204 (suc (suc (suc i))) = gcd204 (suc (suc i))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
97
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
98 gcd+j : ( i j : ℕ ) → gcd (i + j) j ≡ gcd i j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
99 gcd+j i j = gcd200 i i j j refl refl where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
100 gcd202 : (i j1 : ℕ) → (i + suc j1) ≡ suc (i + j1)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
101 gcd202 zero j1 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
102 gcd202 (suc i) j1 = cong suc (gcd202 i j1)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
103 gcd201 : (i i0 j j0 j1 : ℕ) → gcd1 (i + j1) (i0 + suc j) j1 j0 ≡ gcd1 i (i0 + suc j) zero j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
104 gcd201 i i0 j j0 zero = subst (λ k → gcd1 k (i0 + suc j) zero j0 ≡ gcd1 i (i0 + suc j) zero j0 ) (+-comm zero i) refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
105 gcd201 i i0 j j0 (suc j1) = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
106 gcd1 (i + suc j1) (i0 + suc j) (suc j1) j0 ≡⟨ cong (λ k → gcd1 k (i0 + suc j) (suc j1) j0 ) (gcd202 i j1) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
107 gcd1 (suc (i + j1)) (i0 + suc j) (suc j1) j0 ≡⟨ gcd22 (i + j1) (i0 + suc j) j1 j0 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
108 gcd1 (i + j1) (i0 + suc j) j1 j0 ≡⟨ gcd201 i i0 j j0 j1 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
109 gcd1 i (i0 + suc j) zero j0 ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
110 gcd200 : (i i0 j j0 : ℕ) → i ≡ i0 → j ≡ j0 → gcd1 (i + j) (i0 + j) j j0 ≡ gcd1 i i j0 j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
111 gcd200 i .i zero .0 refl refl = subst (λ k → gcd1 k k zero zero ≡ gcd1 i i zero zero ) (+-comm zero i) refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
112 gcd200 (suc (suc i)) i0 (suc j) (suc j0) i=i0 j=j0 = gcd201 (suc (suc i)) i0 j (suc j0) (suc j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
113 gcd200 zero zero (suc zero) .1 i=i0 refl = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
114 gcd200 zero zero (suc (suc j)) .(suc (suc j)) i=i0 refl = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
115 gcd1 (zero + suc (suc j)) (zero + suc (suc j)) (suc (suc j)) (suc (suc j)) ≡⟨ gcdmm (suc (suc j)) (suc (suc j)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
116 suc (suc j) ≡⟨ sym (gcd20 (suc (suc j))) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
117 gcd1 zero zero (suc (suc j)) (suc (suc j)) ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
118 gcd200 zero (suc i0) (suc j) .(suc j) () refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
119 gcd200 (suc zero) .1 (suc j) .(suc j) refl refl = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
120 gcd1 (1 + suc j) (1 + suc j) (suc j) (suc j) ≡⟨ gcd203 (suc j) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
121 1 ≡⟨ sym ( gcd204 (suc j)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
122 gcd1 1 1 (suc j) (suc j) ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
123 gcd200 (suc (suc i)) i0 (suc j) zero i=i0 ()
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
124
196
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
125 open _∧_
192
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 191
diff changeset
126
193
875eb1fa9694 dividable reorganzaiton
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
127 gcd-gt : ( i i0 j j0 k : ℕ ) → k > 1 → (if : Factor k i) (i0f : Dividable k i0 ) (jf : Factor k j ) (j0f : Dividable k j0)
196
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
128 → Dividable k (i - j) ∧ Dividable k (j - i)
165
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 164
diff changeset
129 → Dividable k ( gcd1 i i0 j j0 )
196
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
130 gcd-gt zero i0 zero j0 k k>1 if i0f jf j0f i-j with <-cmp i0 j0
194
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 193
diff changeset
131 ... | tri< a ¬b ¬c = i0f
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 193
diff changeset
132 ... | tri≈ ¬a refl ¬c = i0f
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 193
diff changeset
133 ... | tri> ¬a ¬b c = j0f
196
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
134 gcd-gt zero i0 (suc zero) j0 k k>1 if i0f jf j0f i-j = ⊥-elim (div1 k>1 (proj2 i-j)) -- can't happen
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
135 gcd-gt zero zero (suc (suc j)) j0 k k>1 if i0f jf j0f i-j = j0f
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
136 gcd-gt zero (suc i0) (suc (suc j)) j0 k k>1 if i0f jf j0f i-j =
197
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 196
diff changeset
137 gcd-gt i0 (suc i0) (suc j) (suc (suc j)) k k>1 (decf (DtoF i0f)) i0f (decf jf) (proj2 i-j) (div-div k>1 i0f (proj2 i-j))
196
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
138 gcd-gt (suc zero) i0 zero j0 k k>1 if i0f jf j0f i-j = ⊥-elim (div1 k>1 (proj1 i-j)) -- can't happen
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
139 gcd-gt (suc (suc i)) i0 zero zero k k>1 if i0f jf j0f i-j = i0f
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
140 gcd-gt (suc (suc i)) i0 zero (suc j0) k k>1 if i0f jf j0f i-j = --
197
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 196
diff changeset
141 gcd-gt (suc i) (suc (suc i)) j0 (suc j0) k k>1 (decf if) (proj1 i-j) (decf (DtoF j0f)) j0f (div-div k>1 (proj1 i-j) j0f )
196
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
142 gcd-gt (suc zero) i0 (suc j) j0 k k>1 if i0f jf j0f i-j =
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
143 gcd-gt zero i0 j j0 k k>1 (decf if) i0f (decf jf) j0f i-j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
144 gcd-gt (suc (suc i)) i0 (suc j) j0 k k>1 if i0f jf j0f i-j =
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 195
diff changeset
145 gcd-gt (suc i) i0 j j0 k k>1 (decf if) i0f (decf jf) j0f i-j
164
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 162
diff changeset
146
194
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 193
diff changeset
147 gcd-div : ( i j k : ℕ ) → k > 1 → (if : Dividable k i) (jf : Dividable k j )
186
08f4ec41ea93 even→gcd
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
148 → Dividable k ( gcd i j )
197
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 196
diff changeset
149 gcd-div i j k k>1 if jf = gcd-gt i i j j k k>1 (DtoF if) if (DtoF jf) jf (div-div k>1 if jf)
143
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 142
diff changeset
150
235
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
151 di-next : {i i0 j j0 : ℕ} → Dividable i0 ((j0 + suc i) - suc j ) ∧ Dividable j0 ((i0 + suc j) - suc i) →
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
152 Dividable i0 ((j0 + i) - j ) ∧ Dividable j0 ((i0 + j) - i)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
153 di-next {i} {i0} {j} {j0} x =
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
154 ⟪ ( subst (λ k → Dividable i0 (k - suc j)) ( begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
155 j0 + suc i ≡⟨ sym (+-assoc j0 1 i ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
156 (j0 + 1) + i ≡⟨ cong (λ k → k + i) (+-comm j0 _ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
157 suc (j0 + i) ∎ ) (proj1 x) ) ,
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
158 ( subst (λ k → Dividable j0 (k - suc i)) ( begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
159 i0 + suc j ≡⟨ sym (+-assoc i0 1 j ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
160 (i0 + 1) + j ≡⟨ cong (λ k → k + j) (+-comm i0 _ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
161 suc (i0 + j) ∎ ) (proj2 x) ) ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
162 where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
163
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
164 di-next1 : {i0 j j0 : ℕ} → Dividable (suc i0) ((j0 + 0) - (suc (suc j))) ∧ Dividable j0 (suc (i0 + suc (suc j)))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
165 → Dividable (suc i0) ((suc (suc j) + i0) - suc j) ∧ Dividable (suc (suc j)) ((suc i0 + suc j) - i0)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
166 di-next1 {i0} {j} {j0} x =
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
167 ⟪ record { factor = 1 ; is-factor = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
168 1 * suc i0 + 0 ≡⟨ cong suc ( trans (+-comm _ 0) (+-comm _ 0) ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
169 suc i0 ≡⟨ sym (minus+y-y {suc i0} {j}) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
170 (suc i0 + j) - j ≡⟨ cong (λ k → k - j ) (+-comm (suc i0) _ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
171 (suc j + suc i0 ) - suc j ≡⟨ cong (λ k → k - suc j) (sym (+-assoc (suc j) 1 i0 )) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
172 ((suc j + 1) + i0) - suc j ≡⟨ cong (λ k → (k + i0) - suc j) (+-comm _ 1) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
173 (suc (suc j) + i0) - suc j ∎ } ,
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
174 subst (λ k → Dividable (suc (suc j)) k) ( begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
175 suc (suc j) ≡⟨ sym ( minus+y-y {suc (suc j)}{i0} ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
176 (suc (suc j) + i0 ) - i0 ≡⟨ cong (λ k → (k + i0) - i0) (cong suc (+-comm 1 _ )) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
177 ((suc j + 1) + i0 ) - i0 ≡⟨ cong (λ k → k - i0) (+-assoc (suc j) 1 _ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
178 (suc j + suc i0 ) - i0 ≡⟨ cong (λ k → k - i0) (+-comm (suc j) _) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
179 ((suc i0 + suc j) - i0) ∎ ) div= ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
180 where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
181
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
182 gcd>0 : ( i j : ℕ ) → 0 < i → 0 < j → 0 < gcd i j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
183 gcd>0 i j 0<i 0<j = gcd>01 i i j j 0<i 0<j where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
184 gcd>01 : ( i i0 j j0 : ℕ ) → 0 < i0 → 0 < j0 → gcd1 i i0 j j0 > 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
185 gcd>01 zero i0 zero j0 0<i 0<j with <-cmp i0 j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
186 ... | tri< a ¬b ¬c = 0<i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
187 ... | tri≈ ¬a refl ¬c = 0<i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
188 ... | tri> ¬a ¬b c = 0<j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
189 gcd>01 zero i0 (suc zero) j0 0<i 0<j = s≤s z≤n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
190 gcd>01 zero zero (suc (suc j)) j0 0<i 0<j = 0<j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
191 gcd>01 zero (suc i0) (suc (suc j)) j0 0<i 0<j = gcd>01 i0 (suc i0) (suc j) (suc (suc j)) 0<i (s≤s z≤n) -- 0 < suc (suc j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
192 gcd>01 (suc zero) i0 zero j0 0<i 0<j = s≤s z≤n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
193 gcd>01 (suc (suc i)) i0 zero zero 0<i 0<j = 0<i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
194 gcd>01 (suc (suc i)) i0 zero (suc j0) 0<i 0<j = gcd>01 (suc i) (suc (suc i)) j0 (suc j0) (s≤s z≤n) 0<j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
195 gcd>01 (suc i) i0 (suc j) j0 0<i 0<j = subst (λ k → 0 < k ) (sym (gcd033 i i0 j j0 )) (gcd>01 i i0 j j0 0<i 0<j ) where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
196 gcd033 : (i i0 j j0 : ℕ) → gcd1 (suc i) i0 (suc j) j0 ≡ gcd1 i i0 j j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
197 gcd033 zero zero zero zero = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
198 gcd033 zero zero (suc j) zero = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
199 gcd033 (suc i) zero j zero = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
200 gcd033 zero zero zero (suc j0) = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
201 gcd033 (suc i) zero zero (suc j0) = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
202 gcd033 zero zero (suc j) (suc j0) = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
203 gcd033 (suc i) zero (suc j) (suc j0) = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
204 gcd033 zero (suc i0) j j0 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
205 gcd033 (suc i) (suc i0) j j0 = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
206
238
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
207 -- gcd loop invariant
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
208 --
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
209 record GCD ( i i0 j j0 : ℕ ) : Set where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
210 field
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
211 i<i0 : i ≤ i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
212 j<j0 : j ≤ j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
213 div-i : Dividable i0 ((j0 + i) - j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
214 div-j : Dividable j0 ((i0 + j) - i)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
215
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
216 div-11 : {i j : ℕ } → Dividable i ((j + i) - j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
217 div-11 {i} {j} = record { factor = 1 ; is-factor = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
218 1 * i + 0 ≡⟨ +-comm _ 0 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
219 i + 0 ≡⟨ +-comm _ 0 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
220 i ≡⟨ sym (minus+y-y {i} {j}) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
221 (i + j ) - j ≡⟨ cong (λ k → k - j ) (+-comm i j ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
222 (j + i) - j ∎ } where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
223
247
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
224 div→gcd : {n k : ℕ } → k > 1 → Dividable k n → gcd n k ≡ k
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
225 div→gcd {n} {k} k>1 = n-induction {_} {_} {ℕ} {λ m → Dividable k m → gcd m k ≡ k } (λ x → x) I n where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
226 decl : {m : ℕ } → 0 < m → m - k < m
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
227 decl {m} 0<m = y-x<y (<-trans a<sa k>1 ) 0<m
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
228 ind : (m : ℕ ) → (Dividable k (m - k) → gcd (m - k) k ≡ k) → Dividable k m → gcd m k ≡ k
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
229 ind m prev d with <-cmp (suc m) k
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
230 ... | tri≈ ¬a refl ¬c = ⊥-elim ( div+1 k>1 d div= )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
231 ... | tri> ¬a ¬b c = subst (λ g → g ≡ k) ind1 ( prev (proj2 (div-div k>1 div= d))) where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
232 ind1 : gcd (m - k) k ≡ gcd m k
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
233 ind1 = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
234 gcd (m - k) k ≡⟨ sym (gcd+j (m - k) _) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
235 gcd (m - k + k) k ≡⟨ cong (λ g → gcd g k) (minus+n {m} {k} c) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
236 gcd m k ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
237 ... | tri< a ¬b ¬c with <-cmp 0 m
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
238 ... | tri< a₁ ¬b₁ ¬c₁ = ⊥-elim ( div<k k>1 a₁ (<-trans a<sa a) d )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
239 ... | tri≈ ¬a refl ¬c₁ = subst (λ g → g ≡ k ) (gcdsym {k} {0} ) (gcd20 k)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
240 fzero : (m : ℕ) → (m - k) ≡ zero → Dividable k m → gcd m k ≡ k
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
241 fzero 0 eq d = trans (gcdsym {0} {k} ) (gcd20 k)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
242 fzero (suc m) eq d with <-cmp (suc m) k
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
243 ... | tri< a ¬b ¬c = ⊥-elim ( div<k k>1 (s≤s z≤n) a d )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
244 ... | tri≈ ¬a refl ¬c = gcdmm k k
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
245 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym eq) (minus>0 c) )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
246 I : Ninduction ℕ _ (λ x → x)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
247 I = record {
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
248 pnext = λ p → p - k
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
249 ; fzero = λ {m} eq → fzero m eq
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
250 ; decline = λ {m} lt → decl lt
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
251 ; ind = λ {p} prev → ind p prev
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
252 }
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
253
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
254 GCDi : {i j : ℕ } → GCD i i j j
247
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
255 GCDi {i} {j} = record { i<i0 = refl-≤ ; j<j0 = refl-≤ ; div-i = div-11 {i} {j} ; div-j = div-11 {j} {i} }
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
256
238
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
257 GCD-sym : {i i0 j j0 : ℕ} → GCD i i0 j j0 → GCD j j0 i i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
258 GCD-sym g = record { i<i0 = GCD.j<j0 g ; j<j0 = GCD.i<i0 g ; div-i = GCD.div-j g ; div-j = GCD.div-i g }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
259
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
260 pred-≤ : {i i0 : ℕ } → suc i ≤ suc i0 → i ≤ suc i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
261 pred-≤ {i} {i0} (s≤s lt) = ≤-trans lt refl-≤s
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
262
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
263 gcd-next : {i i0 j j0 : ℕ} → GCD (suc i) i0 (suc j) j0 → GCD i i0 j j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
264 gcd-next {i} {0} {j} {0} ()
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
265 gcd-next {i} {suc i0} {j} {suc j0} g = record { i<i0 = pred-≤ (GCD.i<i0 g) ; j<j0 = pred-≤ (GCD.j<j0 g)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
266 ; div-i = proj1 (di-next {i} {suc i0} {j} {suc j0} ⟪ GCD.div-i g , GCD.div-j g ⟫ )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
267 ; div-j = proj2 (di-next {i} {suc i0} {j} {suc j0} ⟪ GCD.div-i g , GCD.div-j g ⟫ ) }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
268
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
269 gcd-next1 : {i0 j j0 : ℕ} → GCD 0 (suc i0) (suc (suc j)) j0 → GCD i0 (suc i0) (suc j) (suc (suc j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
270 gcd-next1 {i0} {j} {j0} g = record { i<i0 = refl-≤s ; j<j0 = refl-≤s
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
271 ; div-i = proj1 (di-next1 ⟪ GCD.div-i g , GCD.div-j g ⟫ ) ; div-j = proj2 (di-next1 ⟪ GCD.div-i g , GCD.div-j g ⟫ ) }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
272
243
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 242
diff changeset
273
231
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 230
diff changeset
274 -- gcd-dividable1 : ( i i0 j j0 : ℕ )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 230
diff changeset
275 -- → Dividable i0 (j0 + i - j ) ∨ Dividable j0 (i0 + j - i)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 230
diff changeset
276 -- → Dividable ( gcd1 i i0 j j0 ) i0 ∧ Dividable ( gcd1 i i0 j j0 ) j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 230
diff changeset
277 -- gcd-dividable1 zero i0 zero j0 with <-cmp i0 j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 230
diff changeset
278 -- ... | tri< a ¬b ¬c = ⟪ div= , {!!} ⟫ -- Dividable i0 (j0 + i - j ) ∧ Dividable j0 (i0 + j - i)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 230
diff changeset
279 -- ... | tri≈ ¬a refl ¬c = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 230
diff changeset
280 -- ... | tri> ¬a ¬b c = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 230
diff changeset
281 -- gcd-dividable1 zero i0 (suc zero) j0 = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 230
diff changeset
282 -- gcd-dividable1 i i0 j j0 = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 230
diff changeset
283
227
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 224
diff changeset
284 gcd-dividable : ( i j : ℕ )
212
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
285 → Dividable ( gcd i j ) i ∧ Dividable ( gcd i j ) j
227
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 224
diff changeset
286 gcd-dividable i j = f-induction {_} {_} {ℕ ∧ ℕ}
209
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
287 {λ p → Dividable ( gcd (proj1 p) (proj2 p) ) (proj1 p) ∧ Dividable ( gcd (proj1 p) (proj2 p) ) (proj2 p)} F I ⟪ i , j ⟫ where
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
288 F : ℕ ∧ ℕ → ℕ
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
289 F ⟪ 0 , 0 ⟫ = 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
290 F ⟪ 0 , suc j ⟫ = 0
222
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 221
diff changeset
291 F ⟪ suc i , 0 ⟫ = 0
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
292 F ⟪ suc i , suc j ⟫ with <-cmp i j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
293 ... | tri< a ¬b ¬c = suc j
209
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
294 ... | tri≈ ¬a b ¬c = 0
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
295 ... | tri> ¬a ¬b c = suc i
209
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
296 F0 : { i j : ℕ } → F ⟪ i , j ⟫ ≡ 0 → (i ≡ j) ∨ (i ≡ 0 ) ∨ (j ≡ 0)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
297 F0 {zero} {zero} p = case1 refl
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
298 F0 {zero} {suc j} p = case2 (case1 refl)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
299 F0 {suc i} {zero} p = case2 (case2 refl)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
300 F0 {suc i} {suc j} p with <-cmp i j
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
301 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≡< (sym p) (s≤s z≤n ))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
302 ... | tri≈ ¬a refl ¬c = case1 refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
303 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym p) (s≤s z≤n ))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
304 F00 : {p : ℕ ∧ ℕ} → F p ≡ zero → Dividable (gcd (proj1 p) (proj2 p)) (proj1 p) ∧ Dividable (gcd (proj1 p) (proj2 p)) (proj2 p)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
305 F00 {⟪ i , j ⟫} eq with F0 {i} {j} eq
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
306 ... | case1 refl = ⟪ subst (λ k → Dividable k i) (sym (gcdmm i i)) div= , subst (λ k → Dividable k i) (sym (gcdmm i i)) div= ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
307 ... | case2 (case1 refl) = ⟪ subst (λ k → Dividable k i) (sym (trans (gcdsym {0} {j} ) (gcd20 j)))div0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
308 , subst (λ k → Dividable k j) (sym (trans (gcdsym {0} {j}) (gcd20 j))) div= ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
309 ... | case2 (case2 refl) = ⟪ subst (λ k → Dividable k i) (sym (gcd20 i)) div=
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
310 , subst (λ k → Dividable k j) (sym (gcd20 i)) div0 ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
311 Fsym : {i j : ℕ } → F ⟪ i , j ⟫ ≡ F ⟪ j , i ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
312 Fsym {0} {0} = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
313 Fsym {0} {suc j} = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
314 Fsym {suc i} {0} = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
315 Fsym {suc i} {suc j} with <-cmp i j | <-cmp j i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
316 ... | tri< a ¬b ¬c | tri< a₁ ¬b₁ ¬c₁ = ⊥-elim (nat-<> a a₁)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
317 ... | tri< a ¬b ¬c | tri≈ ¬a b ¬c₁ = ⊥-elim (¬b (sym b))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
318 ... | tri< a ¬b ¬c | tri> ¬a ¬b₁ c = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
319 ... | tri≈ ¬a refl ¬c | tri< a ¬b ¬c₁ = ⊥-elim (¬b refl)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
320 ... | tri≈ ¬a refl ¬c | tri≈ ¬a₁ refl ¬c₁ = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
321 ... | tri≈ ¬a refl ¬c | tri> ¬a₁ ¬b c = ⊥-elim (¬b refl)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
322 ... | tri> ¬a ¬b c | tri< a ¬b₁ ¬c = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
323 ... | tri> ¬a ¬b c | tri≈ ¬a₁ b ¬c = ⊥-elim (¬b (sym b))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
324 ... | tri> ¬a ¬b c | tri> ¬a₁ ¬b₁ c₁ = ⊥-elim (nat-<> c c₁)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
325
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
326 record Fdec ( i j : ℕ ) : Set where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
327 field
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
328 ni : ℕ
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
329 nj : ℕ
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
330 fdec : 0 < F ⟪ i , j ⟫ → F ⟪ ni , nj ⟫ < F ⟪ i , j ⟫
214
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
331
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
332 fd1 : ( i j k : ℕ ) → i < j → k ≡ j - i → F ⟪ suc i , k ⟫ < F ⟪ suc i , suc j ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
333 fd1 i j 0 i<j eq = ⊥-elim ( nat-≡< eq (minus>0 {i} {j} i<j ))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
334 fd1 i j (suc k) i<j eq = fd2 i j k i<j eq where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
335 fd2 : ( i j k : ℕ ) → i < j → suc k ≡ j - i → F ⟪ suc i , suc k ⟫ < F ⟪ suc i , suc j ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
336 fd2 i j k i<j eq with <-cmp i k | <-cmp i j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
337 ... | tri< a ¬b ¬c | tri< a₁ ¬b₁ ¬c₁ = fd3 where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
338 fd3 : suc k < suc j -- suc j - suc i < suc j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
339 fd3 = subst (λ g → g < suc j) (sym eq) (y-x<y {suc i} {suc j} (s≤s z≤n) (s≤s z≤n))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
340 ... | tri< a ¬b ¬c | tri≈ ¬a b ¬c₁ = ⊥-elim (⊥-elim (¬a i<j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
341 ... | tri< a ¬b ¬c | tri> ¬a ¬b₁ c = ⊥-elim (⊥-elim (¬a i<j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
342 ... | tri≈ ¬a b ¬c | tri< a ¬b ¬c₁ = s≤s z≤n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
343 ... | tri≈ ¬a b ¬c | tri≈ ¬a₁ b₁ ¬c₁ = ⊥-elim (¬a₁ i<j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
344 ... | tri≈ ¬a b ¬c | tri> ¬a₁ ¬b c = s≤s z≤n -- i > j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
345 ... | tri> ¬a ¬b c | tri< a ¬b₁ ¬c = fd4 where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
346 fd4 : suc i < suc j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
347 fd4 = s≤s a
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
348 ... | tri> ¬a ¬b c | tri≈ ¬a₁ b ¬c = ⊥-elim (¬a₁ i<j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
349 ... | tri> ¬a ¬b c | tri> ¬a₁ ¬b₁ c₁ = ⊥-elim (¬a₁ i<j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
350
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
351 fedc0 : (i j : ℕ ) → Fdec i j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
352 fedc0 0 0 = record { ni = 0 ; nj = 0 ; fdec = λ () }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
353 fedc0 (suc i) 0 = record { ni = suc i ; nj = 0 ; fdec = λ () }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
354 fedc0 0 (suc j) = record { ni = 0 ; nj = suc j ; fdec = λ () }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
355 fedc0 (suc i) (suc j) with <-cmp i j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
356 ... | tri< i<j ¬b ¬c = record { ni = suc i ; nj = j - i ; fdec = λ lt → fd1 i j (j - i) i<j refl }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
357 ... | tri≈ ¬a refl ¬c = record { ni = suc i ; nj = suc j ; fdec = λ lt → ⊥-elim (nat-≡< fd0 lt) } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
358 fd0 : {i : ℕ } → 0 ≡ F ⟪ suc i , suc i ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
359 fd0 {i} with <-cmp i i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
360 ... | tri< a ¬b ¬c = ⊥-elim ( ¬b refl )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
361 ... | tri≈ ¬a b ¬c = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
362 ... | tri> ¬a ¬b c = ⊥-elim ( ¬b refl )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
363 ... | tri> ¬a ¬b c = record { ni = i - j ; nj = suc j ; fdec = λ lt →
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
364 subst₂ (λ s t → s < t) (Fsym {suc j} {i - j}) (Fsym {suc j} {suc i}) (fd1 j i (i - j) c refl ) }
214
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
365
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
366 ind3 : {i j : ℕ } → i < j
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
367 → Dividable (gcd (suc i) (j - i)) (suc i)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
368 → Dividable (gcd (suc i) (suc j)) (suc i)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
369 ind3 {i} {j} a prev =
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
370 subst (λ k → Dividable k (suc i)) ( begin
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
371 gcd (suc i) (j - i) ≡⟨ gcdsym {suc i} {j - i} ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
372 gcd (j - i ) (suc i) ≡⟨ sym (gcd+j (j - i) (suc i)) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
373 gcd ((j - i) + suc i) (suc i) ≡⟨ cong (λ k → gcd k (suc i)) ( begin
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
374 (suc j - suc i) + suc i ≡⟨ minus+n {suc j} {suc i} (<-trans ( s≤s a) a<sa ) ⟩ -- i ≤ n → suc (suc i) ≤ suc (suc (suc n))
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
375 suc j ∎ ) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
376 gcd (suc j) (suc i) ≡⟨ gcdsym {suc j} {suc i} ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
377 gcd (suc i) (suc j) ∎ ) prev where open ≡-Reasoning
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
378 ind7 : {i j : ℕ } → (i < j ) → (j - i) + suc i ≡ suc j
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
379 ind7 {i} {j} a = begin (suc j - suc i) + suc i ≡⟨ minus+n {suc j} {suc i} (<-trans (s≤s a) a<sa) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
380 suc j ∎ where open ≡-Reasoning
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
381 ind6 : {i j k : ℕ } → i < j
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
382 → Dividable k (j - i)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
383 → Dividable k (suc i)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
384 → Dividable k (suc j)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
385 ind6 {i} {j} {k} i<j dj di = subst (λ g → Dividable k g ) (ind7 i<j) (proj1 (div+div dj di))
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
386 ind4 : {i j : ℕ } → i < j
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
387 → Dividable (gcd (suc i) (j - i)) (j - i)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
388 → Dividable (gcd (suc i) (suc j)) (j - i)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
389 ind4 {i} {j} i<j prev = subst (λ k → k) ( begin
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
390 Dividable (gcd (suc i) (j - i)) (j - i) ≡⟨ cong (λ k → Dividable k (j - i)) (gcdsym {suc i} ) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
391 Dividable (gcd (j - i ) (suc i) ) (j - i) ≡⟨ cong (λ k → Dividable k (j - i)) ( sym (gcd+j (j - i) (suc i))) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
392 Dividable (gcd ((j - i) + suc i) (suc i)) (j - i) ≡⟨ cong (λ k → Dividable (gcd k (suc i)) (j - i)) (ind7 i<j ) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
393 Dividable (gcd (suc j) (suc i)) (j - i) ≡⟨ cong (λ k → Dividable k (j - i)) (gcdsym {suc j} ) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
394 Dividable (gcd (suc i) (suc j)) (j - i) ∎ ) prev where open ≡-Reasoning
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
395
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
396 ind : ( i j : ℕ ) →
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
397 Dividable (gcd (Fdec.ni (fedc0 i j)) (Fdec.nj (fedc0 i j))) (Fdec.ni (fedc0 i j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
398 ∧ Dividable (gcd (Fdec.ni (fedc0 i j)) (Fdec.nj (fedc0 i j))) (Fdec.nj (fedc0 i j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
399 → Dividable (gcd i j) i ∧ Dividable (gcd i j) j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
400 ind zero zero prev = ind0 where
210
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
401 ind0 : Dividable (gcd zero zero) zero ∧ Dividable (gcd zero zero) zero
212
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
402 ind0 = ⟪ div0 , div0 ⟫
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
403 ind zero (suc j) prev = ind1 where
210
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
404 ind1 : Dividable (gcd zero (suc j)) zero ∧ Dividable (gcd zero (suc j)) (suc j)
212
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
405 ind1 = ⟪ div0 , subst (λ k → Dividable k (suc j)) (sym (trans (gcdsym {zero} {suc j}) (gcd20 (suc j)))) div= ⟫
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
406 ind (suc i) zero prev = ind2 where
210
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
407 ind2 : Dividable (gcd (suc i) zero) (suc i) ∧ Dividable (gcd (suc i) zero) zero
212
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
408 ind2 = ⟪ subst (λ k → Dividable k (suc i)) (sym (trans refl (gcd20 (suc i)))) div= , div0 ⟫
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
409 ind (suc i) (suc j) prev with <-cmp i j
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
410 ... | tri< a ¬b ¬c = ⟪ ind3 a (proj1 prev) , ind6 a (ind4 a (proj2 prev)) (ind3 a (proj1 prev) ) ⟫
213
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 212
diff changeset
411 ... | tri≈ ¬a refl ¬c = ⟪ ind5 , ind5 ⟫ where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 212
diff changeset
412 ind5 : Dividable (gcd (suc i) (suc i)) (suc i)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 212
diff changeset
413 ind5 = subst (λ k → Dividable k (suc j)) (sym (gcdmm (suc i) (suc i))) div=
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
414 ... | tri> ¬a ¬b c = ⟪ ind8 c (proj1 prev) (proj2 prev) , ind10 c (proj2 prev) ⟫ where
214
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
415 ind9 : {i j : ℕ} → i < j → gcd (j - i) (suc i) ≡ gcd (suc j) (suc i)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
416 ind9 {i} {j} i<j = begin
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
417 gcd (j - i ) (suc i) ≡⟨ sym (gcd+j (j - i ) (suc i) ) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
418 gcd (j - i + suc i) (suc i) ≡⟨ cong (λ k → gcd k (suc i)) (ind7 i<j ) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
419 gcd (suc j) (suc i) ∎ where open ≡-Reasoning
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
420 ind8 : { i j : ℕ } → i < j
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
421 → Dividable (gcd (j - i) (suc i)) (j - i)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
422 → Dividable (gcd (j - i) (suc i)) (suc i)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
423 → Dividable (gcd (suc j) (suc i)) (suc j)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
424 ind8 {i} {j} i<j dji di = ind6 i<j (subst (λ k → Dividable k (j - i)) (ind9 i<j) dji) (subst (λ k → Dividable k (suc i)) (ind9 i<j) di)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
425 ind10 : { i j : ℕ } → j < i
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
426 → Dividable (gcd (i - j) (suc j)) (suc j)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
427 → Dividable (gcd (suc i) (suc j)) (suc j)
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
428 ind10 {i} {j} j<i dji = subst (λ g → Dividable g (suc j) ) (begin
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
429 gcd (i - j) (suc j) ≡⟨ sym (gcd+j (i - j) (suc j)) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
430 gcd (i - j + suc j) (suc j) ≡⟨ cong (λ k → gcd k (suc j)) (ind7 j<i ) ⟩
906b43b94228 gcd-dividable done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 213
diff changeset
431 gcd (suc i) (suc j) ∎ ) dji where open ≡-Reasoning
210
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
432
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
433 I : Finduction (ℕ ∧ ℕ) _ F
209
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
434 I = record {
224
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
435 fzero = F00
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
436 ; pnext = λ p → ⟪ Fdec.ni (fedc0 (proj1 p) (proj2 p)) , Fdec.nj (fedc0 (proj1 p) (proj2 p)) ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
437 ; decline = λ {p} lt → Fdec.fdec (fedc0 (proj1 p) (proj2 p)) lt
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 223
diff changeset
438 ; ind = λ {p} prev → ind (proj1 p ) ( proj2 p ) prev
209
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
439 }
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 208
diff changeset
440
247
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
441 f-div>0 : { k i : ℕ } → (d : Dividable k i ) → 0 < i → 0 < Dividable.factor d
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
442 f-div>0 {k} {i} d 0<i with <-cmp 0 (Dividable.factor d)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
443 ... | tri< a ¬b ¬c = a
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
444 ... | tri≈ ¬a b ¬c = ⊥-elim ( nat-≡< (begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
445 0 * k + 0 ≡⟨ cong (λ g → g * k + 0) b ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
446 Dividable.factor d * k + 0 ≡⟨ Dividable.is-factor d ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
447 i ∎ ) 0<i ) where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
448
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
449 gcd-≤i : ( i j : ℕ ) → 0 < i → i ≤ j → gcd i j ≤ i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
450 gcd-≤i zero _ () z≤n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
451 gcd-≤i (suc i) (suc j) _ (s≤s i<j) = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
452 gcd (suc i) (suc j) ≡⟨ sym m*1=m ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
453 gcd (suc i) (suc j) * 1 ≤⟨ *-monoʳ-≤ (gcd (suc i) (suc j)) (f-div>0 d (s≤s z≤n)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
454 gcd (suc i) (suc j) * f ≡⟨ +-comm 0 _ ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
455 gcd (suc i) (suc j) * f + 0 ≡⟨ cong (λ k → k + 0) (*-comm (gcd (suc i) (suc j)) _ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
456 Dividable.factor (proj1 (gcd-dividable (suc i) (suc j))) * gcd (suc i) (suc j) + 0 ≡⟨ Dividable.is-factor (proj1 (gcd-dividable (suc i) (suc j))) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
457 suc i ∎ where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
458 d = proj1 (gcd-dividable (suc i) (suc j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
459 f = Dividable.factor (proj1 (gcd-dividable (suc i) (suc j)))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
460 open ≤-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
461
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
462 gcd-≤ : { i j : ℕ } → 0 < i → 0 < j → gcd i j ≤ i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
463 gcd-≤ {i} {j} 0<i 0<j with <-cmp i j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
464 ... | tri< a ¬b ¬c = gcd-≤i i j 0<i (<to≤ a)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
465 ... | tri≈ ¬a refl ¬c = gcd-≤i i j 0<i refl-≤
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
466 ... | tri> ¬a ¬b c = ≤-trans (subst (λ k → k ≤ j) (gcdsym {j} {i}) (gcd-≤i j i 0<j (<to≤ c))) (<to≤ c)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
467
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
468 record Euclid (i j gcd : ℕ ) : Set where
233
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 232
diff changeset
469 field
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 232
diff changeset
470 eqa : ℕ
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 232
diff changeset
471 eqb : ℕ
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
472 is-equ< : eqa * i > eqb * j → (eqa * i) - (eqb * j) ≡ gcd
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
473 is-equ> : eqb * j > eqa * i → (eqb * j) - (eqa * i) ≡ gcd
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
474 is-equ= : eqa * i ≡ eqb * j → 0 ≡ gcd
234
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 233
diff changeset
475
235
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
476 ge3 : {a b c d : ℕ } → b > a → b - a ≡ d - c → d > c
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 234
diff changeset
477 ge3 {a} {b} {c} {d} b>a eq = minus>0→x<y (subst (λ k → 0 < k ) eq (minus>0 b>a))
234
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 233
diff changeset
478
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
479 ge01 : ( i0 j j0 ea eb : ℕ )
239
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 238
diff changeset
480 → ( di : GCD 0 (suc i0) (suc (suc j)) j0 )
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
481 → (((ea + eb * (Dividable.factor (GCD.div-i di))) * suc i0) ≡ (ea * suc i0) + (eb * (Dividable.factor (GCD.div-i di)) ) * suc i0 )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
482 ∧ ( (eb * j0) ≡ (eb * suc (suc j) + (eb * (Dividable.factor (GCD.div-i di)) ) * suc i0) )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
483 ge01 i0 j j0 ea eb di = ⟪ ge011 , ge012 ⟫ where
239
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 238
diff changeset
484 f = Dividable.factor (GCD.div-i di)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 238
diff changeset
485 ge4 : suc (j0 + 0) > suc (suc j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 238
diff changeset
486 ge4 = subst (λ k → k > suc (suc j)) (+-comm 0 _ ) ( s≤s (GCD.j<j0 di ))
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
487 ge011 : (ea + eb * f) * suc i0 ≡ ea * suc i0 + eb * f * suc i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
488 ge011 = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
489 (ea + eb * f) * suc i0 ≡⟨ *-distribʳ-+ (suc i0) ea _ ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
490 ea * suc i0 + eb * f * suc i0 ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
491 ge012 : eb * j0 ≡ eb * suc (suc j) + eb * f * suc i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
492 ge012 = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
493 eb * j0 ≡⟨ cong (λ k → eb * k) ( begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
494 j0 ≡⟨ +-comm 0 _ ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
495 j0 + 0 ≡⟨ sym (minus+n {j0 + 0} {suc (suc j)} ge4) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
496 ((j0 + 0) - (suc (suc j))) + suc (suc j) ≡⟨ +-comm _ (suc (suc j)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
497 suc (suc j) + ((j0 + 0) - suc (suc j)) ≡⟨ cong (λ k → suc (suc j) + k ) (sym (Dividable.is-factor (GCD.div-i di))) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
498 suc (suc j) + (f * suc i0 + 0) ≡⟨ cong (λ k → suc (suc j) + k ) ( +-comm _ 0 ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
499 suc (suc j) + (f * suc i0 ) ∎ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
500 eb * (suc (suc j) + (f * suc i0 ) ) ≡⟨ *-distribˡ-+ eb (suc (suc j)) (f * suc i0) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
501 eb * suc (suc j) + eb * (f * suc i0) ≡⟨ cong (λ k → eb * suc (suc j) + k ) ((sym (*-assoc eb _ _ )) ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
502 eb * suc (suc j) + eb * f * suc i0 ∎ where open ≡-Reasoning
239
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 238
diff changeset
503
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
504 ge20 : {i0 j0 : ℕ } → i0 ≡ 0 → 0 ≡ gcd1 zero i0 zero j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
505 ge20 {i0} {zero} refl = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
506 ge20 {i0} {suc j0} refl = refl
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
507
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
508 gcd-euclid1 : ( i i0 j j0 : ℕ ) → GCD i i0 j j0 → Euclid i0 j0 (gcd1 i i0 j j0)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
509 gcd-euclid1 zero i0 zero j0 di with <-cmp i0 j0
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
510 ... | tri< a' ¬b ¬c = record { eqa = 1 ; eqb = 0 ; is-equ< = λ _ → +-comm _ 0 ; is-equ> = λ () ; is-equ= = ge21 } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
511 ge21 : 1 * i0 ≡ 0 * j0 → 0 ≡ i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
512 ge21 eq = trans (sym eq) (+-comm i0 0)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
513 ... | tri≈ ¬a refl ¬c = record { eqa = 1 ; eqb = 0 ; is-equ< = λ _ → +-comm _ 0 ; is-equ> = λ () ; is-equ= = λ eq → trans (sym eq) (+-comm i0 0) }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
514 ... | tri> ¬a ¬b c = record { eqa = 0 ; eqb = 1 ; is-equ< = λ () ; is-equ> = λ _ → +-comm _ 0 ; is-equ= = ge22 } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
515 ge22 : 0 * i0 ≡ 1 * j0 → 0 ≡ j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
516 ge22 eq = trans eq (+-comm j0 0)
243
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 242
diff changeset
517 -- i<i0 : zero ≤ i0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 242
diff changeset
518 -- j<j0 : 1 ≤ j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 242
diff changeset
519 -- div-i : Dividable i0 ((j0 + zero) - 1) -- fi * i0 ≡ (j0 + zero) - 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 242
diff changeset
520 -- div-j : Dividable j0 ((i0 + 1) - zero) -- fj * j0 ≡ (i0 + 1) - zero
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
521 gcd-euclid1 zero i0 (suc zero) j0 di = record { eqa = 1 ; eqb = Dividable.factor (GCD.div-j di) ; is-equ< = λ lt → ⊥-elim ( ge7 lt) ; is-equ> = λ _ → ge6
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
522 ; is-equ= = λ eq → ⊥-elim (nat-≡< (sym (minus<=0 (subst (λ k → k ≤ 1 * i0) eq refl-≤ ))) (subst (λ k → 0 < k) (sym ge6) a<sa )) } where
244
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
523 ge6 : (Dividable.factor (GCD.div-j di) * j0) - (1 * i0) ≡ gcd1 zero i0 1 j0
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
524 ge6 = begin
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
525 (Dividable.factor (GCD.div-j di) * j0) - (1 * i0) ≡⟨ cong (λ k → k - (1 * i0)) (+-comm 0 _) ⟩
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
526 (Dividable.factor (GCD.div-j di) * j0 + 0) - (1 * i0) ≡⟨ cong (λ k → k - (1 * i0)) (Dividable.is-factor (GCD.div-j di) ) ⟩
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
527 ((i0 + 1) - zero) - (1 * i0) ≡⟨ refl ⟩
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
528 (i0 + 1) - (i0 + 0) ≡⟨ minus+yx-yz {_} {i0} {0} ⟩
243
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 242
diff changeset
529 1 ∎ where open ≡-Reasoning
244
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
530 ge7 : ¬ ( 1 * i0 > Dividable.factor (GCD.div-j di) * j0 )
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
531 ge7 lt = ⊥-elim ( nat-≡< (sym ( minus<=0 (<to≤ lt))) (subst (λ k → 0 < k) (sym ge6) (s≤s z≤n)))
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
532 gcd-euclid1 zero zero (suc (suc j)) j0 di = record { eqa = 0 ; eqb = 1 ; is-equ< = λ () ; is-equ> = λ _ → +-comm _ 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
533 ; is-equ= = λ eq → subst (λ k → 0 ≡ k) (+-comm _ 0) eq }
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
534 gcd-euclid1 zero (suc i0) (suc (suc j)) j0 di with gcd-euclid1 i0 (suc i0) (suc j) (suc (suc j)) ( gcd-next1 di )
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
535 ... | e = record { eqa = ea + eb * f ; eqb = eb
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
536 ; is-equ= = λ eq → Euclid.is-equ= e (ge23 eq)
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
537 ; is-equ< = λ lt → subst (λ k → ((ea + eb * f) * suc i0) - (eb * j0) ≡ k ) (Euclid.is-equ< e (ge3 lt (ge1 ))) (ge1 )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
538 ; is-equ> = λ lt → subst (λ k → (eb * j0) - ((ea + eb * f) * suc i0) ≡ k ) (Euclid.is-equ> e (ge3 lt (ge2 ))) (ge2 ) } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
539 ea = Euclid.eqa e
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
540 eb = Euclid.eqb e
238
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 237
diff changeset
541 f = Dividable.factor (GCD.div-i di)
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
542 ge1 : ((ea + eb * f) * suc i0) - (eb * j0) ≡ (ea * suc i0) - (eb * suc (suc j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
543 ge1 = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
544 ((ea + eb * f) * suc i0) - (eb * j0) ≡⟨ cong₂ (λ j k → j - k ) (proj1 (ge01 i0 j j0 ea eb di)) (proj2 (ge01 i0 j j0 ea eb di)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
545 (ea * suc i0 + (eb * f ) * suc i0 ) - ( eb * suc (suc j) + ((eb * f) * (suc i0)) ) ≡⟨ minus+xy-zy {ea * suc i0} {(eb * f ) * suc i0} {eb * suc (suc j)} ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
546 (ea * suc i0) - (eb * suc (suc j)) ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
547 ge2 : (eb * j0) - ((ea + eb * f) * suc i0) ≡ (eb * suc (suc j)) - (ea * suc i0)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
548 ge2 = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
549 (eb * j0) - ((ea + eb * f) * suc i0) ≡⟨ cong₂ (λ j k → j - k ) (proj2 (ge01 i0 j j0 ea eb di)) (proj1 (ge01 i0 j j0 ea eb di)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
550 ( eb * suc (suc j) + ((eb * f) * (suc i0)) ) - (ea * suc i0 + (eb * f ) * suc i0 ) ≡⟨ minus+xy-zy {eb * suc (suc j)}{(eb * f ) * suc i0} {ea * suc i0} ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
551 (eb * suc (suc j)) - (ea * suc i0) ∎ where open ≡-Reasoning
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
552 ge23 : (ea + eb * f) * suc i0 ≡ eb * j0 → ea * suc i0 ≡ eb * suc (suc j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
553 ge23 eq = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
554 ea * suc i0 ≡⟨ sym (minus+y-y {_} {(eb * f ) * suc i0} ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
555 (ea * suc i0 + ((eb * f ) * suc i0 )) - ((eb * f ) * suc i0 ) ≡⟨ cong (λ k → k - ((eb * f ) * suc i0 )) (sym ( proj1 (ge01 i0 j j0 ea eb di))) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
556 ((ea + eb * f) * suc i0) - ((eb * f ) * suc i0 ) ≡⟨ cong (λ k → k - ((eb * f ) * suc i0 )) eq ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
557 (eb * j0) - ((eb * f ) * suc i0 ) ≡⟨ cong (λ k → k - ((eb * f ) * suc i0 )) ( proj2 (ge01 i0 j j0 ea eb di)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
558 (eb * suc (suc j) + ((eb * f ) * suc i0 )) - ((eb * f ) * suc i0 ) ≡⟨ minus+y-y {_} {(eb * f ) * suc i0 } ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
559 eb * suc (suc j) ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
560 gcd-euclid1 (suc zero) i0 zero j0 di = record { eqb = 1 ; eqa = Dividable.factor (GCD.div-i di) ; is-equ> = λ lt → ⊥-elim ( ge7' lt) ; is-equ< = λ _ → ge6'
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
561 ; is-equ= = λ eq → ⊥-elim (nat-≡< (sym (minus<=0 (subst (λ k → k ≤ 1 * j0) (sym eq) refl-≤ ))) (subst (λ k → 0 < k) (sym ge6') a<sa )) } where
244
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
562 ge6' : (Dividable.factor (GCD.div-i di) * i0) - (1 * j0) ≡ gcd1 (suc zero) i0 zero j0
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
563 ge6' = begin
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
564 (Dividable.factor (GCD.div-i di) * i0) - (1 * j0) ≡⟨ cong (λ k → k - (1 * j0)) (+-comm 0 _) ⟩
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
565 (Dividable.factor (GCD.div-i di) * i0 + 0) - (1 * j0) ≡⟨ cong (λ k → k - (1 * j0)) (Dividable.is-factor (GCD.div-i di) ) ⟩
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
566 ((j0 + 1) - zero) - (1 * j0) ≡⟨ refl ⟩
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
567 (j0 + 1) - (j0 + 0) ≡⟨ minus+yx-yz {_} {j0} {0} ⟩
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
568 1 ∎ where open ≡-Reasoning
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
569 ge7' : ¬ ( 1 * j0 > Dividable.factor (GCD.div-i di) * i0 )
08994de7c82f gcd-euclid1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 243
diff changeset
570 ge7' lt = ⊥-elim ( nat-≡< (sym ( minus<=0 (<to≤ lt))) (subst (λ k → 0 < k) (sym ge6') (s≤s z≤n)))
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
571 gcd-euclid1 (suc (suc i)) i0 zero zero di = record { eqb = 0 ; eqa = 1 ; is-equ> = λ () ; is-equ< = λ _ → +-comm _ 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
572 ; is-equ= = λ eq → subst (λ k → 0 ≡ k) (+-comm _ 0) (sym eq) }
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
573 gcd-euclid1 (suc (suc i)) i0 zero (suc j0) di with gcd-euclid1 (suc i) (suc (suc i)) j0 (suc j0) (GCD-sym (gcd-next1 (GCD-sym di)))
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
574 ... | e = record { eqa = ea ; eqb = eb + ea * f
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
575 ; is-equ= = λ eq → Euclid.is-equ= e (ge24 eq)
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
576 ; is-equ< = λ lt → subst (λ k → ((ea * i0) - ((eb + ea * f) * suc j0)) ≡ k ) (Euclid.is-equ< e (ge3 lt ge4)) ge4
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
577 ; is-equ> = λ lt → subst (λ k → (((eb + ea * f) * suc j0) - (ea * i0)) ≡ k ) (Euclid.is-equ> e (ge3 lt ge5)) ge5 } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
578 ea = Euclid.eqa e
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
579 eb = Euclid.eqb e
242
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 241
diff changeset
580 f = Dividable.factor (GCD.div-j di)
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
581 ge5 : (((eb + ea * f) * suc j0) - (ea * i0)) ≡ ((eb * suc j0) - (ea * suc (suc i)))
242
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 241
diff changeset
582 ge5 = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 241
diff changeset
583 ((eb + ea * f) * suc j0) - (ea * i0) ≡⟨ cong₂ (λ j k → j - k ) (proj1 (ge01 j0 i i0 eb ea (GCD-sym di) )) (proj2 (ge01 j0 i i0 eb ea (GCD-sym di) )) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 241
diff changeset
584 ( eb * suc j0 + (ea * f )* suc j0) - (ea * suc (suc i) + (ea * f )* suc j0) ≡⟨ minus+xy-zy {_} {(ea * f )* suc j0} {ea * suc (suc i)} ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 241
diff changeset
585 (eb * suc j0) - (ea * suc (suc i)) ∎ where open ≡-Reasoning
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
586 ge4 : ((ea * i0) - ((eb + ea * f) * suc j0)) ≡ ((ea * suc (suc i)) - (eb * suc j0))
242
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 241
diff changeset
587 ge4 = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 241
diff changeset
588 (ea * i0) - ((eb + ea * f) * suc j0) ≡⟨ cong₂ (λ j k → j - k ) (proj2 (ge01 j0 i i0 eb ea (GCD-sym di) )) (proj1 (ge01 j0 i i0 eb ea (GCD-sym di) )) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 241
diff changeset
589 (ea * suc (suc i) + (ea * f )* suc j0) - ( eb * suc j0 + (ea * f )* suc j0) ≡⟨ minus+xy-zy {ea * suc (suc i)} {(ea * f )* suc j0} { eb * suc j0} ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 241
diff changeset
590 (ea * suc (suc i)) - (eb * suc j0) ∎ where open ≡-Reasoning
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
591 ge24 : ea * i0 ≡ (eb + ea * f) * suc j0 → ea * suc (suc i) ≡ eb * suc j0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
592 ge24 eq = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
593 ea * suc (suc i) ≡⟨ sym ( minus+y-y {_} {(ea * f ) * suc j0 }) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
594 (ea * suc (suc i) + (ea * f ) * suc j0 ) - ((ea * f ) * suc j0) ≡⟨ cong (λ k → k - ((ea * f ) * suc j0 )) (sym (proj2 (ge01 j0 i i0 eb ea (GCD-sym di) ))) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
595 (ea * i0) - ((ea * f ) * suc j0) ≡⟨ cong (λ k → k - ((ea * f ) * suc j0 )) eq ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
596 ((eb + ea * f) * suc j0) - ((ea * f ) * suc j0) ≡⟨ cong (λ k → k - ((ea * f ) * suc j0 )) ((proj1 (ge01 j0 i i0 eb ea (GCD-sym di)))) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
597 ( eb * suc j0 + (ea * f ) * suc j0 ) - ((ea * f ) * suc j0) ≡⟨ minus+y-y {_} {(ea * f ) * suc j0 } ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
598 eb * suc j0 ∎ where open ≡-Reasoning
241
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
599 gcd-euclid1 (suc zero) i0 (suc j) j0 di =
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
600 gcd-euclid1 zero i0 j j0 (gcd-next di)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
601 gcd-euclid1 (suc (suc i)) i0 (suc j) j0 di =
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 240
diff changeset
602 gcd-euclid1 (suc i) i0 j j0 (gcd-next di)
233
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 232
diff changeset
603
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
604 ge12 : (p x : ℕ) → 0 < x → 1 < p → ((i : ℕ ) → i < p → 0 < i → gcd p i ≡ 1) → ( gcd p x ≡ 1 ) ∨ ( Dividable p x )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
605 ge12 p x 0<x 1<p prime with decD {p} {x} 1<p
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
606 ... | yes y = case2 y
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
607 ... | no nx with <-cmp (gcd p x ) 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
608 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (s≤s (gcd>0 p x (<-trans a<sa 1<p) 0<x) ) )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
609 ... | tri≈ ¬a b ¬c = case1 b
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
610 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym (prime (gcd p x) ge13 (<to≤ c) )) ge18 ) where
247
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
611 -- 1 < gcd p x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
612 ge13 : gcd p x < p -- gcd p x ≡ p → ¬ nx
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
613 ge13 with <-cmp (gcd p x ) p
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
614 ... | tri< a ¬b ¬c = a
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
615 ... | tri≈ ¬a b ¬c = ⊥-elim ( nx (subst (λ k → Dividable k x) b (proj2 (gcd-dividable p x ))))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
616 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> (gcd-≤ (<-trans a<sa 1<p) 0<x) c )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
617 ge19 : Dividable (gcd p x) p
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
618 ge19 = proj1 (gcd-dividable p x )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
619 ge18 : 1 < gcd p (gcd p x) -- Dividable p (gcd p x) → gcd p (gcd p x) ≡ (gcd p x) > 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
620 ge18 = subst (λ k → 1 < k ) (sym (div→gcd {p} {gcd p x} c ge19 )) c
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
621
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
622 gcd-euclid : ( p a b : ℕ ) → 1 < p → 0 < a → 0 < b → ((i : ℕ ) → i < p → 0 < i → gcd p i ≡ 1) → Dividable p (a * b) → Dividable p a ∨ Dividable p b
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
623 gcd-euclid p a b 1<p 0<a 0<b prime div-ab with decD {p} {a} 1<p
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
624 ... | yes y = case1 y
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
625 ... | no np = case2 ge16 where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
626 f = Dividable.factor div-ab
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
627 ge10 : gcd p a ≡ 1
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
628 ge10 with ge12 p a 0<a 1<p prime
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
629 ... | case1 x = x
246
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 245
diff changeset
630 ... | case2 x = ⊥-elim ( np x )
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
631 ge11 : Euclid p a (gcd p a)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
632 ge11 = gcd-euclid1 p p a a GCDi
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
633 ea = Euclid.eqa ge11
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
634 eb = Euclid.eqb ge11
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
635 ge18 : (f * eb) * p ≡ b * (a * eb )
247
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
636 ge18 = begin
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
637 (f * eb) * p ≡⟨ *-assoc (f) (eb) p ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
638 f * (eb * p) ≡⟨ cong (λ k → f * k) (*-comm _ p) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
639 f * (p * eb ) ≡⟨ sym (*-assoc (f) p (eb) ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
640 (f * p ) * eb ≡⟨ cong (λ k → k * eb ) (+-comm 0 (f * p )) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
641 (f * p + 0) * eb ≡⟨ cong (λ k → k * eb) (((Dividable.is-factor div-ab))) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
642 (a * b) * eb ≡⟨ cong (λ k → k * eb) (*-comm a b) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
643 (b * a) * eb ≡⟨ *-assoc b a (eb ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
644 b * (a * eb ) ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
645 ge19 : ( ea * p ) ≡ ( eb * a ) → ((b * ea) - (f * eb)) * p + 0 ≡ b
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
646 ge19 eq = ⊥-elim ( nat-≡< (Euclid.is-equ= ge11 eq) (subst (λ k → 0 < k ) (sym ge10) a<sa ) )
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
647 ge14 : ( ea * p ) > ( eb * a ) → ((b * ea) - (f * eb)) * p + 0 ≡ b
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
648 ge14 lt = begin
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
649 (((b * ea) - (f * eb)) * p) + 0 ≡⟨ +-comm _ 0 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
650 ((b * ea) - ((f * eb)) * p) ≡⟨ distr-minus-* {_} {f * eb} {p} ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
651 ((b * ea) * p) - (((f * eb) * p)) ≡⟨ cong (λ k → ((b * ea) * p) - k ) ge18 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
652 ((b * ea) * p) - (b * (a * eb )) ≡⟨ cong (λ k → k - (b * (a * eb)) ) (*-assoc b _ p) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
653 (b * (ea * p)) - (b * (a * eb )) ≡⟨ sym ( distr-minus-*' {b} {ea * p} {a * eb} ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
654 b * (( ea * p) - (a * eb) ) ≡⟨ cong (λ k → b * ( ( ea * p) - k)) (*-comm a (eb)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
655 (b * ( (ea * p)) - (eb * a) ) ≡⟨ cong (b *_) (Euclid.is-equ< ge11 lt )⟩
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
656 b * gcd p a ≡⟨ cong (b *_) ge10 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
657 b * 1 ≡⟨ m*1=m ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
658 b ∎ where open ≡-Reasoning
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
659 ge15 : ( ea * p ) < ( eb * a ) → ((f * eb) - (b * ea ) ) * p + 0 ≡ b
247
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
660 ge15 lt = begin
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
661 ((f * eb) - (b * ea) ) * p + 0 ≡⟨ +-comm _ 0 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
662 ((f * eb) - (b * ea) ) * p ≡⟨ distr-minus-* {_} {b * ea} {p} ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
663 ((f * eb) * p) - ((b * ea) * p) ≡⟨ cong (λ k → k - ((b * ea) * p) ) ge18 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
664 (b * (a * eb )) - ((b * ea) * p ) ≡⟨ cong (λ k → (b * (a * eb)) - k ) (*-assoc b _ p) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
665 (b * (a * eb )) - (b * (ea * p) ) ≡⟨ sym ( distr-minus-*' {b} {a * eb} {ea * p} ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
666 b * ( (a * eb) - (ea * p) ) ≡⟨ cong (λ k → b * ( k - ( ea * p) )) (*-comm a (eb)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
667 b * ( (eb * a) - (ea * p) ) ≡⟨ cong (b *_) (Euclid.is-equ> ge11 lt) ⟩
247
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
668 b * gcd p a ≡⟨ cong (b *_) ge10 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
669 b * 1 ≡⟨ m*1=m ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 246
diff changeset
670 b ∎ where open ≡-Reasoning
246
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 245
diff changeset
671 ge17 : (x y : ℕ ) → x ≡ y → x ≤ y
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 245
diff changeset
672 ge17 x x refl = refl-≤
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
673 ge16 : Dividable p b
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
674 ge16 with <-cmp ( ea * p ) ( eb * a )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
675 ... | tri< a ¬b ¬c = record { factor = (f * eb) - (b * ea) ; is-factor = ge15 a }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
676 ... | tri≈ ¬a eq ¬c = record { factor = (b * ea) - ( f * eb) ; is-factor = ge19 eq }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
677 ... | tri> ¬a ¬b c = record { factor = (b * ea) - (f * eb) ; is-factor = ge14 c }
245
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
678
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 244
diff changeset
679
206
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 205
diff changeset
680
167
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
681 gcdmul+1 : ( m n : ℕ ) → gcd (m * n + 1) n ≡ 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
682 gcdmul+1 zero n = gcd204 n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
683 gcdmul+1 (suc m) n = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
684 gcd (suc m * n + 1) n ≡⟨⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
685 gcd (n + m * n + 1) n ≡⟨ cong (λ k → gcd k n ) (begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
686 n + m * n + 1 ≡⟨ cong (λ k → k + 1) (+-comm n _) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
687 m * n + n + 1 ≡⟨ +-assoc (m * n) _ _ ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
688 m * n + (n + 1) ≡⟨ cong (λ k → m * n + k) (+-comm n _) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
689 m * n + (1 + n) ≡⟨ sym ( +-assoc (m * n) _ _ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
690 m * n + 1 + n ∎
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
691 ) ⟩
212
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 211
diff changeset
692 gcd (m * n + 1 + n) n ≡⟨ gcd+j (m * n + 1) n ⟩
167
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
693 gcd (m * n + 1) n ≡⟨ gcdmul+1 m n ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
694 1 ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 166
diff changeset
695
230
a72bcc6eadad prime done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 227
diff changeset
696 m*n=m→n : {m n : ℕ } → 0 < m → m * n ≡ m * 1 → n ≡ 1
a72bcc6eadad prime done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 227
diff changeset
697 m*n=m→n {suc m} {n} (s≤s lt) eq = *-cancelˡ-≡ m eq
a72bcc6eadad prime done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 227
diff changeset
698