annotate automaton-in-agda/src/root2.agda @ 405:af8f630b7e60

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 24 Sep 2023 18:02:04 +0900
parents 407684f806e4
children a60132983557
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 330
diff changeset
1 {-# OPTIONS --cubical-compatible --safe #-}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 330
diff changeset
2
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 module root2 where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
5 open import Data.Nat
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
6 open import Data.Nat.Properties
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 open import Data.Empty
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
8 open import Data.Unit using (⊤ ; tt)
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 open import Relation.Nullary
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 open import Relation.Binary.PropositionalEquality
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
11 open import Relation.Binary.Definitions
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
12
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
13 import gcd as GCD
159
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
14 open import even
142
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 141
diff changeset
15 open import nat
231
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 199
diff changeset
16 open import logic
141
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
17
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
18 record Rational : Set where
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
19 field
b3f05cd08d24 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 57
diff changeset
20 i j : ℕ
320
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
21 0<j : j > 0
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
22 coprime : GCD.gcd i j ≡ 1
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
23
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
24 -- record Dividable (n m : ℕ ) : Set where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
25 -- field
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
26 -- factor : ℕ
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
27 -- is-factor : factor * n + 0 ≡ m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
28
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
29 gcd : (i j : ℕ) → ℕ
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
30 gcd = GCD.gcd
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
31
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
32 gcd-euclid : ( p a b : ℕ ) → 1 < p → 0 < a → 0 < b → ((i : ℕ ) → i < p → 0 < i → gcd p i ≡ 1)
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
33 → Dividable p (a * b) → Dividable p a ∨ Dividable p b
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
34 gcd-euclid = GCD.gcd-euclid
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
35
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
36 gcd-div1 : ( i j k : ℕ ) → k > 1 → (if : Dividable k i) (jf : Dividable k j )
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
37 → Dividable k ( gcd i j )
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
38 gcd-div1 = GCD.gcd-div
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
39
231
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 199
diff changeset
40 open _∧_
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 199
diff changeset
41
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 199
diff changeset
42 open import prime
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 199
diff changeset
43
233
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 231
diff changeset
44 divdable^2 : ( n k : ℕ ) → 1 < k → 1 < n → Prime k → Dividable k ( n * n ) → Dividable k n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 231
diff changeset
45 divdable^2 zero zero () 1<n pk dn2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 231
diff changeset
46 divdable^2 (suc n) (suc k) 1<k 1<n pk dn2 with decD {suc k} {suc n} 1<k
159
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
47 ... | yes y = y
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 233
diff changeset
48 ... | no non with gcd-euclid (suc k) (suc n) (suc n) 1<k (<-trans a<sa 1<n) (<-trans a<sa 1<n) (Prime.isPrime pk) dn2
233
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 231
diff changeset
49 ... | case1 dn = dn
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 231
diff changeset
50 ... | case2 dm = dm
159
5530b3789e0c add even
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 148
diff changeset
51
330
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 325
diff changeset
52 -- divdable-n*m : { n m k : ℕ } → 1 < k → 1 < n → Prime k → Dividable k ( n * m ) → Dividable k n ∨ Dividable k n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 325
diff changeset
53 -- divdable-n*m = ?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 325
diff changeset
54
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 325
diff changeset
55 -- 2^2 : { n k : ℕ } → 1 < n → Dividable 2 ( n * n ) → Dividable 2 n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 325
diff changeset
56 -- 2^2 = ?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 325
diff changeset
57
255
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 254
diff changeset
58 -- p * n * n ≡ m * m means (m/n)^2 = p
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 254
diff changeset
59 -- rational m/n requires m and n is comprime each other which contradicts the condition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 254
diff changeset
60
254
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
61 root-prime-irrational : ( n m p : ℕ ) → n > 1 → Prime p → m > 1 → p * n * n ≡ m * m → ¬ (gcd n m ≡ 1)
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
62 root-prime-irrational n m 0 n>1 pn m>1 pnm = ⊥-elim ( nat-≡< refl (<-trans a<sa (Prime.p>1 pn)))
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
63 root-prime-irrational n m (suc p0) n>1 pn m>1 pnm = rot13 ( gcd-div1 n m (suc p0) 1<sp dn dm ) where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
64 p = suc p0
254
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
65 1<sp : 1 < p
253
012f79b51dba ... prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 251
diff changeset
66 1<sp = Prime.p>1 pn
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
67 rot13 : {m : ℕ } → Dividable (suc p0) m → m ≡ 1 → ⊥
185
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
68 rot13 d refl with Dividable.factor d | Dividable.is-factor d
253
012f79b51dba ... prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 251
diff changeset
69 ... | zero | () -- gcd 0 m ≡ 1
254
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
70 ... | suc n | x = ⊥-elim ( nat-≡< (sym x) rot17 ) where -- x : (suc n * p + 0) ≡ 1
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
71 rot17 : suc n * (suc p0) + 0 > 1
253
012f79b51dba ... prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 251
diff changeset
72 rot17 = begin
012f79b51dba ... prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 251
diff changeset
73 2 ≡⟨ refl ⟩
254
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
74 suc (1 * 1 ) ≤⟨ 1<sp ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
75 suc p0 ≡⟨ cong suc (+-comm 0 _) ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
76 suc (p0 + 0) ≤⟨ s≤s (+-monoʳ-≤ p0 z≤n) ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
77 suc (p0 + n * p ) ≡⟨ +-comm 0 _ ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
78 suc n * p + 0 ∎ where open ≤-Reasoning
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
79 dm : Dividable p m
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
80 dm = divdable^2 m p 1<sp m>1 pn record { factor = n * n ; is-factor = begin
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
81 (n * n) * p + 0 ≡⟨ +-comm _ 0 ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
82 (n * n) * p ≡⟨ *-comm (n * n) p ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
83 p * (n * n) ≡⟨ sym (*-assoc p n n) ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
84 (p * n) * n ≡⟨ pnm ⟩
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 233
diff changeset
85 m * m ∎ } where open ≡-Reasoning
254
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
86 -- p * n * n = 2m' 2m'
251
9d2cba39b33c root2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 250
diff changeset
87 -- n * n = m' 2m'
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 233
diff changeset
88 df = Dividable.factor dm
254
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
89 dn : Dividable p n
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
90 dn = divdable^2 n p 1<sp n>1 pn record { factor = df * df ; is-factor = begin
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 330
diff changeset
91 df * df * p + 0 ≡⟨ *-cancelʳ-≡ _ _ (suc p0) ( begin
254
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
92 (df * df * p + 0) * p ≡⟨ cong (λ k → k * p) (+-comm (df * df * p) 0) ⟩
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
93 ((df * df) * p ) * p ≡⟨ cong (λ k → k * p) (*-assoc df df p ) ⟩
254
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
94 (df * (df * p)) * p ≡⟨ cong (λ k → (df * k ) * p) (*-comm df p) ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
95 (df * (p * df)) * p ≡⟨ sym ( cong (λ k → k * p) (*-assoc df p df ) ) ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
96 ((df * p) * df) * p ≡⟨ *-assoc (df * p) df p ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
97 (df * p) * (df * p) ≡⟨ cong₂ (λ j k → j * k ) (+-comm 0 (df * p)) (+-comm 0 _) ⟩
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
98 (df * p + 0) * (df * p + 0) ≡⟨ cong₂ (λ j k → j * k) (Dividable.is-factor dm ) (Dividable.is-factor dm )⟩
253
012f79b51dba ... prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 251
diff changeset
99 m * m ≡⟨ sym pnm ⟩
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
100 p * n * n ≡⟨ cong (λ k → k * n) (*-comm p n) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
101 n * p * n ≡⟨ *-assoc n p n ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
102 n * (p * n) ≡⟨ cong (λ k → n * k) (*-comm p n) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
103 n * (n * p) ≡⟨ sym (*-assoc n n p) ⟩
254
24c721da4f27 prime version
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
104 n * n * p ∎ ) ⟩
250
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 233
diff changeset
105 n * n ∎ } where open ≡-Reasoning
57
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
106
320
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
107 mkRational : ( i j : ℕ ) → 0 < j → Rational
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
108 mkRational zero j 0<j = record { i = 0 ; j = 1 ; coprime = refl ; 0<j = s≤s z≤n }
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
109 mkRational (suc i) (suc j) (s≤s 0<j) = record { i = Dividable.factor id ; j = Dividable.factor jd ; coprime = cop ; 0<j = 0<fj } where
320
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
110 d : ℕ
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
111 d = gcd (suc i) (suc j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
112 d>0 : gcd (suc i) (suc j) > 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
113 d>0 = GCD.gcd>0 (suc i) (suc j) (s≤s z≤n) (s≤s z≤n )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
114 id : Dividable d (suc i)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
115 id = proj1 (GCD.gcd-dividable (suc i) (suc j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
116 jd : Dividable d (suc j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
117 jd = proj2 (GCD.gcd-dividable (suc i) (suc j))
320
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
118 0<fj : Dividable.factor jd > 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
119 0<fj = 0<factor d>0 (s≤s z≤n ) jd
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
120 cop : gcd (Dividable.factor id) (Dividable.factor jd) ≡ 1
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
121 cop = GCD.gcd-div-1 {suc i} {suc j} (s≤s z≤n) (s≤s z≤n )
320
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
122
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
123 r1 : {x y : ℕ} → x > 0 → y > 0 → x * y > 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
124 r1 {x} {y} x>0 y>0 = begin
320
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
125 1 * 1 ≤⟨ *≤ {1} {x} {1} x>0 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
126 x * 1 ≡⟨ *-comm x 1 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
127 1 * x ≤⟨ *≤ {1} {y} {x} y>0 ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
128 y * x ≡⟨ *-comm y x ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
129 x * y ∎ where open ≤-Reasoning
185
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
130
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
131 Rational* : (r s : Rational) → Rational
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
132 Rational* r s = mkRational (Rational.i r * Rational.i s) (Rational.j r * Rational.j s) (r1 (Rational.0<j r) (Rational.0<j s) )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
133
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
134 _r=_ : Rational → ℕ → Set
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
135 r r= p = p * Rational.j r ≡ Rational.i r
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
136
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
137 r3 : ( p : ℕ ) → p > 0 → ( r : Rational ) → Rational* r r r= p → p * Rational.j r * Rational.j r ≡ Rational.i r * Rational.i r
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
138 r3 p p>0 r rr = r4 where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
139 i : ℕ
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
140 i = Rational.i r * Rational.i r
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
141 j : ℕ
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
142 j = Rational.j r * Rational.j r
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
143 0<j : 0 < j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
144 0<j = r1 (Rational.0<j r) (Rational.0<j r)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
145 d1 = Dividable.factor (proj1 (GCD.gcd-dividable i j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
146 d2 = Dividable.factor (proj2 (GCD.gcd-dividable i j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
147 ri=id : ( i j : ℕ) → (0<i : 0 < i ) → (0<j : 0 < j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
148 → Rational.i (mkRational i j 0<j) ≡ Dividable.factor (proj1 (GCD.gcd-dividable i j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
149 ri=id (suc i₁) (suc j₁) 0<i (s≤s 0<j₁) = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
150 ri=jd : ( i j : ℕ) → (0<i : 0 < i ) → (0<j : 0 < j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
151 → Rational.j (mkRational i j 0<j) ≡ Dividable.factor (proj2 (GCD.gcd-dividable i j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
152 ri=jd (suc i₁) (suc j₁) 0<i (s≤s 0<j₁) = refl
322
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
153 r0=id : ( i j : ℕ) → (0=i : 0 ≡ i ) → (0<j : 0 < j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
154 → Rational.i (mkRational i j 0<j) ≡ 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
155 r0=id 0 j refl 0<j = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
156 r0=jd : ( i j : ℕ) → (0=i : 0 ≡ i ) → (0<j : 0 < j)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
157 → Rational.j (mkRational i j 0<j) ≡ 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
158 r0=jd 0 j refl 0<j = refl
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
159 d : ℕ
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
160 d = gcd i j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
161 r7 : i > 0 → d > 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
162 r7 0<i = GCD.gcd>0 _ _ 0<i 0<j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
163 r6 : i > 0 → d2 > 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
164 r6 0<i = 0<factor (r7 0<i ) 0<j (proj2 (GCD.gcd-dividable i j))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
165 r8 : 0 < i → d2 * p ≡ d1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
166 r8 0<i = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
167 d2 * p ≡⟨ *-comm d2 p ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
168 p * d2 ≡⟨ cong (λ k → p * k ) (sym (ri=jd i j 0<i 0<j )) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
169 p * Rational.j (mkRational i j _ ) ≡⟨ rr ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
170 Rational.i (Rational* r r) ≡⟨ ri=id i j 0<i 0<j ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
171 d1 ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
172 r4 : p * Rational.j r * Rational.j r ≡ Rational.i r * Rational.i r
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
173 r4 with <-cmp (Rational.i r * Rational.i r) 0
322
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
174 ... | tri≈ ¬a b ¬c = ⊥-elim (nat-≡< (begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
175 0 ≡⟨ sym (r0=id i j (sym b) 0<j ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
176 Rational.i (mkRational (Rational.i r * Rational.i r) (Rational.j r * Rational.j r) _ ) ≡⟨ sym rr ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
177 p * Rational.j (mkRational (Rational.i r * Rational.i r) (Rational.j r * Rational.j r) _ ) ≡⟨ cong (λ k → p * k ) (r0=jd i j (sym b) 0<j ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
178 p * 1 ≡⟨ m*1=m ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
179 p ∎ ) p>0 ) where open ≡-Reasoning
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
180 ... | tri> ¬a ¬b c = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
181 p * Rational.j r * Rational.j r ≡⟨ *-cancel-left (r6 c) ( begin
322
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
182 d2 * ((p * Rational.j r) * Rational.j r) ≡⟨ sym (*-assoc d2 _ _) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
183 (d2 * ( p * Rational.j r )) * Rational.j r ≡⟨ cong (λ k → k * Rational.j r) (sym (*-assoc d2 _ _ )) ⟩
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
184 (d2 * p) * Rational.j r * Rational.j r ≡⟨ cong (λ k → k * Rational.j r * Rational.j r) (r8 c) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
185 d1 * Rational.j r * Rational.j r ≡⟨ *-cancel-left (r7 c) ( begin
322
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
186 d * ((d1 * Rational.j r) * Rational.j r) ≡⟨ cong (λ k → d * k ) (*-assoc d1 _ _ )⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
187 d * (d1 * (Rational.j r * Rational.j r)) ≡⟨ sym (*-assoc d _ _) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
188 (d * d1) * (Rational.j r * Rational.j r) ≡⟨ cong (λ k → k * j) (*-comm d _ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
189 (d1 * d) * j ≡⟨ cong (λ k → k * j) (+-comm 0 (d1 * d) ) ⟩
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
190 (d1 * d + 0) * j ≡⟨ cong (λ k → k * j ) (Dividable.is-factor (proj1 (GCD.gcd-dividable i j)) ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
191 i * j ≡⟨ *-comm i j ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
192 j * i ≡⟨ cong (λ k → k * i ) (sym (Dividable.is-factor (proj2 (GCD.gcd-dividable i j))) ) ⟩
322
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
193 (d2 * GCD.gcd i j + 0) * i ≡⟨ cong (λ k → k * i ) (+-comm (d2 * d ) 0) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
194 (d2 * d) * i ≡⟨ cong (λ k → k * i ) (*-comm d2 _ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
195 (d * d2) * i ≡⟨ *-assoc d _ _ ⟩
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
196 d * (d2 * (Rational.i r * Rational.i r)) ∎ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
197 d2 * (Rational.i r * Rational.i r) ∎ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
198 Rational.i r * Rational.i r ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
199
325
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
200 *<-2 : {x y z : ℕ} → z > 0 → x < y → z * x < z * y
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 330
diff changeset
201 *<-2 {x} {y} {suc z} (s≤s z>0) x<y = ? -- *-monoʳ-< z x<y
325
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
202
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
203 r15 : {p : ℕ} → p > 1 → p < p * p
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
204 r15 {p} p>1 = subst (λ k → k < p * p ) m*1=m (*<-2 (<-trans a<sa p>1) p>1 )
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
205
320
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 281
diff changeset
206 root-prime-irrational1 : ( p : ℕ ) → Prime p → ( r : Rational ) → ¬ ( Rational* r r r= p )
321
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
207 root-prime-irrational1 p pr r div with <-cmp (Rational.j r) 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 320
diff changeset
208 ... | tri> ¬a ¬b c with <-cmp (Rational.i r) 1
325
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
209 ... | tri> ¬a₁ ¬b₁ c₁ = root-prime-irrational (Rational.j r) (Rational.i r) p c pr c₁ (r3 p (<-trans a<sa (Prime.p>1 pr ) ) r div)
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
210 (trans (GCD.gcdsym {Rational.j r} {_} ) (Rational.coprime r) )
324
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 323
diff changeset
211 ... | tri< a ¬b₁ ¬c = ⊥-elim ( nat-≡< (sym r05) r08) where
322
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
212 i = Rational.i r
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
213 j = Rational.j r
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
214 r00 : p * j * j ≡ i * i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
215 r00 = r3 p (<-trans a<sa (Prime.p>1 pr )) r div
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
216 r06 : i ≡ 0
324
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 323
diff changeset
217 r06 with <-cmp i 0
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 323
diff changeset
218 ... | tri≈ ¬a b ¬c = b
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 323
diff changeset
219 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> c a )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 323
diff changeset
220 r05 : p * j * j ≡ 0
325
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
221 r05 with r06
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
222 ... | refl = r00
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
223 r09 : p * j > 0
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
224 r09 = begin
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
225 suc zero ≤⟨ <-trans a<sa (Prime.p>1 pr) ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
226 p ≡⟨ sym m*1=m ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
227 p * 1 <⟨ *<-2 (<-trans a<sa (Prime.p>1 pr)) c ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
228 p * j ∎ where open ≤-Reasoning
324
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 323
diff changeset
229 r08 : p * j * j > 0
325
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
230 r08 = begin
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
231 suc zero ≤⟨ r09 ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
232 p * j ≡⟨ sym m*1=m ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
233 (p * j) * 1 <⟨ *<-2 r09 c ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
234 (p * j) * j ∎ where open ≤-Reasoning
324
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 323
diff changeset
235 ... | tri≈ ¬a₁ b ¬c = ⊥-elim ( nat-≡< (sym r07) r09) where
322
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
236 i = Rational.i r
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
237 j = Rational.j r
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
238 r00 : p * j * j ≡ i * i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 321
diff changeset
239 r00 = r3 p (<-trans a<sa (Prime.p>1 pr )) r div
324
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 323
diff changeset
240 r07 : p * j * j ≡ 1
325
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
241 r07 = begin
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
242 p * j * j ≡⟨ r00 ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
243 i * i ≡⟨ cong (λ k → k * k) b ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
244 1 * 1 ≡⟨⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
245 1 ∎ where open ≡-Reasoning
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
246 r19 : 1 < p * j
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
247 r19 = begin
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
248 suc 1 ≤⟨ Prime.p>1 pr ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
249 p ≡⟨ sym m*1=m ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
250 p * 1 <⟨ *<-2 (<-trans a<sa (Prime.p>1 pr)) c ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
251 p * j ∎ where open ≤-Reasoning
324
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 323
diff changeset
252 r09 : 1 < p * j * j
325
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
253 r09 = begin
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
254 suc 1 ≤⟨ r19 ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
255 p * j ≡⟨ sym m*1=m ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
256 p * j * 1 <⟨ *<-2 (<-trans a<sa r19 ) c ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
257 (p * j) * j ∎ where open ≤-Reasoning
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
258 root-prime-irrational1 p pr r div | tri< a ¬b ¬c = ⊥-elim (nat-≤> (Rational.0<j r) a )
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
259 root-prime-irrational1 p pr r div | tri≈ ¬a b ¬c = ⊥-elim (nat-≡< r04 (r03 r01)) where
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
260 i = Rational.i r
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
261 j = Rational.j r
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
262 p>0 : p > 0
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
263 p>0 = <-trans a<sa (Prime.p>1 pr)
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
264 r00 : p * j * j ≡ i * i
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
265 r00 = r3 p p>0 r div
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
266 r01 : p ≡ i * i
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
267 r01 = begin
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
268 p ≡⟨ sym m*1=m ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
269 p * 1 ≡⟨ sym m*1=m ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
270 p * 1 * 1 ≡⟨ cong (λ k → p * k * k ) (sym b) ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
271 p * j * j ≡⟨ r00 ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
272 i * i ∎ where open ≡-Reasoning
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
273 r03 : p ≡ i * i → i > 1
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
274 r03 eq with <-cmp i 1
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
275 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≡< (sym r11) p>0 ) where
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
276 r10 : i ≡ 0
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
277 r10 with <-cmp i 0
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
278 ... | tri≈ ¬a b ¬c = b
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
279 ... | tri> ¬a ¬b c = ⊥-elim (nat-≤> c a )
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
280 r11 : p ≡ 0
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
281 r11 = begin
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
282 p ≡⟨ r01 ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
283 i * i ≡⟨ cong (λ k → k * k ) r10 ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
284 0 * 0 ≡⟨⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
285 0 ∎ where open ≡-Reasoning
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
286 ... | tri≈ ¬a refl ¬c = ⊥-elim ( nat-≡< (sym r01 ) (Prime.p>1 pr))
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
287 ... | tri> ¬a ¬b c = c
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
288 r02 : p ≡ i * i → gcd p i ≡ i
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
289 r02 eq = GCD.div→gcd (r03 r01) record { factor = i ; is-factor = trans (+-comm _ 0 ) (sym r01) }
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
290 r14 : i < p
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
291 r14 with <-cmp i p
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
292 ... | tri< a ¬b ¬c = a
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
293 ... | tri≈ ¬a b ¬c = ⊥-elim ( nat-≡< r01 (begin
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
294 suc p ≤⟨ r15 (Prime.p>1 pr) ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
295 p * p ≡⟨ cong (λ k → k * k ) (sym b) ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
296 i * i ∎ )) where open ≤-Reasoning
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
297 ... | tri> ¬a ¬b c = ⊥-elim (nat-≡< r01 (<-trans c (r15 (r03 r01 ))))
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
298 r04 : 1 ≡ i
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
299 r04 = begin
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
300 1 ≡⟨ sym (Prime.isPrime pr _ r14 (<-trans a<sa (r03 r01 ))) ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
301 gcd p i ≡⟨ r02 r01 ⟩
39f0e1d7a7e5 root2 fulcomp
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 324
diff changeset
302 i ∎ where open ≡-Reasoning