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