annotate automaton-in-agda/src/nat.agda @ 285:6e85b8b0d8db

remove ls<n
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Tue, 28 Dec 2021 00:28:29 +0900
parents 8b437dd616dd
children 4a00e5f2b793
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 {-# OPTIONS --allow-unsolved-metas #-}
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
2 module nat where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4 open import Data.Nat
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 open import Data.Nat.Properties
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 open import Data.Empty
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 open import Relation.Nullary
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 open import Relation.Binary.PropositionalEquality
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 open import Relation.Binary.Core
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 open import Relation.Binary.Definitions
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 open import logic
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 open import Level hiding ( zero ; suc )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
13
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
14 nat-<> : { x y : ℕ } → x < y → y < x → ⊥
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 nat-<> (s≤s x<y) (s≤s y<x) = nat-<> x<y y<x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
16
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
17 nat-≤> : { x y : ℕ } → x ≤ y → y < x → ⊥
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
18 nat-≤> (s≤s x<y) (s≤s y<x) = nat-≤> x<y y<x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
19
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
20 nat-<≡ : { x : ℕ } → x < x → ⊥
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
21 nat-<≡ (s≤s lt) = nat-<≡ lt
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
22
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
23 nat-≡< : { x y : ℕ } → x ≡ y → x < y → ⊥
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
24 nat-≡< refl lt = nat-<≡ lt
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
25
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 ¬a≤a : {la : ℕ} → suc la ≤ la → ⊥
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
27 ¬a≤a (s≤s lt) = ¬a≤a lt
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
28
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 a<sa : {la : ℕ} → la < suc la
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 a<sa {zero} = s≤s z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
31 a<sa {suc la} = s≤s a<sa
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
32
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
33 =→¬< : {x : ℕ } → ¬ ( x < x )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
34 =→¬< {zero} ()
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
35 =→¬< {suc x} (s≤s lt) = =→¬< lt
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
36
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
37 >→¬< : {x y : ℕ } → (x < y ) → ¬ ( y < x )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
38 >→¬< (s≤s x<y) (s≤s y<x) = >→¬< x<y y<x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
39
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
40 <-∨ : { x y : ℕ } → x < suc y → ( (x ≡ y ) ∨ (x < y) )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
41 <-∨ {zero} {zero} (s≤s z≤n) = case1 refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
42 <-∨ {zero} {suc y} (s≤s lt) = case2 (s≤s z≤n)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
43 <-∨ {suc x} {zero} (s≤s ())
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
44 <-∨ {suc x} {suc y} (s≤s lt) with <-∨ {x} {y} lt
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
45 <-∨ {suc x} {suc y} (s≤s lt) | case1 eq = case1 (cong (λ k → suc k ) eq)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
46 <-∨ {suc x} {suc y} (s≤s lt) | case2 lt1 = case2 (s≤s lt1)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
47
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
48 max : (x y : ℕ) → ℕ
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
49 max zero zero = zero
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
50 max zero (suc x) = (suc x)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
51 max (suc x) zero = (suc x)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
52 max (suc x) (suc y) = suc ( max x y )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
53
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
54 -- _*_ : ℕ → ℕ → ℕ
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
55 -- _*_ zero _ = zero
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
56 -- _*_ (suc n) m = m + ( n * m )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
57
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
58 -- x ^ y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
59 exp : ℕ → ℕ → ℕ
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
60 exp _ zero = 1
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
61 exp n (suc m) = n * ( exp n m )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
62
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
63 div2 : ℕ → (ℕ ∧ Bool )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
64 div2 zero = ⟪ 0 , false ⟫
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
65 div2 (suc zero) = ⟪ 0 , true ⟫
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
66 div2 (suc (suc n)) = ⟪ suc (proj1 (div2 n)) , proj2 (div2 n) ⟫ where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
67 open _∧_
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
68
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
69 div2-rev : (ℕ ∧ Bool ) → ℕ
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
70 div2-rev ⟪ x , true ⟫ = suc (x + x)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
71 div2-rev ⟪ x , false ⟫ = x + x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
72
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
73 div2-eq : (x : ℕ ) → div2-rev ( div2 x ) ≡ x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
74 div2-eq zero = refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
75 div2-eq (suc zero) = refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
76 div2-eq (suc (suc x)) with div2 x | inspect div2 x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
77 ... | ⟪ x1 , true ⟫ | record { eq = eq1 } = begin -- eq1 : div2 x ≡ ⟪ x1 , true ⟫
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
78 div2-rev ⟪ suc x1 , true ⟫ ≡⟨⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
79 suc (suc (x1 + suc x1)) ≡⟨ cong (λ k → suc (suc k )) (+-comm x1 _ ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
80 suc (suc (suc (x1 + x1))) ≡⟨⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
81 suc (suc (div2-rev ⟪ x1 , true ⟫)) ≡⟨ cong (λ k → suc (suc (div2-rev k ))) (sym eq1) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
82 suc (suc (div2-rev (div2 x))) ≡⟨ cong (λ k → suc (suc k)) (div2-eq x) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
83 suc (suc x) ∎ where open ≡-Reasoning
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
84 ... | ⟪ x1 , false ⟫ | record { eq = eq1 } = begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
85 div2-rev ⟪ suc x1 , false ⟫ ≡⟨⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
86 suc (x1 + suc x1) ≡⟨ cong (λ k → (suc k )) (+-comm x1 _ ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
87 suc (suc (x1 + x1)) ≡⟨⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
88 suc (suc (div2-rev ⟪ x1 , false ⟫)) ≡⟨ cong (λ k → suc (suc (div2-rev k ))) (sym eq1) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
89 suc (suc (div2-rev (div2 x))) ≡⟨ cong (λ k → suc (suc k)) (div2-eq x) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
90 suc (suc x) ∎ where open ≡-Reasoning
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
91
260
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
92 sucprd : {i : ℕ } → 0 < i → suc (pred i) ≡ i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
93 sucprd {suc i} 0<i = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 249
diff changeset
94
261
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
95 0<s : {x : ℕ } → zero < suc x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
96 0<s {_} = s≤s z≤n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
97
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
98 px<py : {x y : ℕ } → pred x < pred y → x < y
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
99 px<py {zero} {suc y} lt = 0<s
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
100 px<py {suc zero} {suc (suc y)} (s≤s lt) = s≤s 0<s
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
101 px<py {suc (suc x)} {suc (suc y)} (s≤s lt) = s≤s (px<py {suc x} {suc y} lt)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
102
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
103 minus : (a b : ℕ ) → ℕ
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
104 minus a zero = a
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
105 minus zero (suc b) = zero
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
106 minus (suc a) (suc b) = minus a b
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
107
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
108 _-_ = minus
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
109
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
110 m+= : {i j m : ℕ } → m + i ≡ m + j → i ≡ j
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
111 m+= {i} {j} {zero} refl = refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
112 m+= {i} {j} {suc m} eq = m+= {i} {j} {m} ( cong (λ k → pred k ) eq )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
113
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
114 +m= : {i j m : ℕ } → i + m ≡ j + m → i ≡ j
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
115 +m= {i} {j} {m} eq = m+= ( subst₂ (λ j k → j ≡ k ) (+-comm i _ ) (+-comm j _ ) eq )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
116
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
117 less-1 : { n m : ℕ } → suc n < m → n < m
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
118 less-1 {zero} {suc (suc _)} (s≤s (s≤s z≤n)) = s≤s z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
119 less-1 {suc n} {suc m} (s≤s lt) = s≤s (less-1 {n} {m} lt)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
120
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
121 sa=b→a<b : { n m : ℕ } → suc n ≡ m → n < m
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
122 sa=b→a<b {0} {suc zero} refl = s≤s z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
123 sa=b→a<b {suc n} {suc (suc n)} refl = s≤s (sa=b→a<b refl)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
124
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
125 minus+n : {x y : ℕ } → suc x > y → minus x y + y ≡ x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
126 minus+n {x} {zero} _ = trans (sym (+-comm zero _ )) refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
127 minus+n {zero} {suc y} (s≤s ())
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
128 minus+n {suc x} {suc y} (s≤s lt) = begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
129 minus (suc x) (suc y) + suc y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
130 ≡⟨ +-comm _ (suc y) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
131 suc y + minus x y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
132 ≡⟨ cong ( λ k → suc k ) (
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
133 begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
134 y + minus x y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
135 ≡⟨ +-comm y _ ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
136 minus x y + y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
137 ≡⟨ minus+n {x} {y} lt ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
138 x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
139
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
140 ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
141 suc x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
142 ∎ where open ≡-Reasoning
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
143
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
144 <-minus-0 : {x y z : ℕ } → z + x < z + y → x < y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
145 <-minus-0 {x} {suc _} {zero} lt = lt
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
146 <-minus-0 {x} {y} {suc z} (s≤s lt) = <-minus-0 {x} {y} {z} lt
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
147
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
148 <-minus : {x y z : ℕ } → x + z < y + z → x < y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
149 <-minus {x} {y} {z} lt = <-minus-0 ( subst₂ ( λ j k → j < k ) (+-comm x _) (+-comm y _ ) lt )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
150
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
151 x≤x+y : {z y : ℕ } → z ≤ z + y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
152 x≤x+y {zero} {y} = z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
153 x≤x+y {suc z} {y} = s≤s (x≤x+y {z} {y})
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
154
198
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 197
diff changeset
155 x≤y+x : {z y : ℕ } → z ≤ y + z
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 197
diff changeset
156 x≤y+x {z} {y} = subst (λ k → z ≤ k ) (+-comm _ y ) x≤x+y
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 197
diff changeset
157
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
158 <-plus : {x y z : ℕ } → x < y → x + z < y + z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
159 <-plus {zero} {suc y} {z} (s≤s z≤n) = s≤s (subst (λ k → z ≤ k ) (+-comm z _ ) x≤x+y )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
160 <-plus {suc x} {suc y} {z} (s≤s lt) = s≤s (<-plus {x} {y} {z} lt)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
161
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
162 <-plus-0 : {x y z : ℕ } → x < y → z + x < z + y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
163 <-plus-0 {x} {y} {z} lt = subst₂ (λ j k → j < k ) (+-comm _ z) (+-comm _ z) ( <-plus {x} {y} {z} lt )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
164
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
165 ≤-plus : {x y z : ℕ } → x ≤ y → x + z ≤ y + z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
166 ≤-plus {0} {y} {zero} z≤n = z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
167 ≤-plus {0} {y} {suc z} z≤n = subst (λ k → z < k ) (+-comm _ y ) x≤x+y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
168 ≤-plus {suc x} {suc y} {z} (s≤s lt) = s≤s ( ≤-plus {x} {y} {z} lt )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
169
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
170 ≤-plus-0 : {x y z : ℕ } → x ≤ y → z + x ≤ z + y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
171 ≤-plus-0 {x} {y} {zero} lt = lt
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
172 ≤-plus-0 {x} {y} {suc z} lt = s≤s ( ≤-plus-0 {x} {y} {z} lt )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
173
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
174 x+y<z→x<z : {x y z : ℕ } → x + y < z → x < z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
175 x+y<z→x<z {zero} {y} {suc z} (s≤s lt1) = s≤s z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
176 x+y<z→x<z {suc x} {y} {suc z} (s≤s lt1) = s≤s ( x+y<z→x<z {x} {y} {z} lt1 )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
177
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
178 *≤ : {x y z : ℕ } → x ≤ y → x * z ≤ y * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
179 *≤ lt = *-mono-≤ lt ≤-refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
180
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
181 *< : {x y z : ℕ } → x < y → x * suc z < y * suc z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
182 *< {zero} {suc y} lt = s≤s z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
183 *< {suc x} {suc y} (s≤s lt) = <-plus-0 (*< lt)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
185 <to<s : {x y : ℕ } → x < y → x < suc y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
186 <to<s {zero} {suc y} (s≤s lt) = s≤s z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
187 <to<s {suc x} {suc y} (s≤s lt) = s≤s (<to<s {x} {y} lt)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
188
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
189 <tos<s : {x y : ℕ } → x < y → suc x < suc y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
190 <tos<s {zero} {suc y} (s≤s z≤n) = s≤s (s≤s z≤n)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
191 <tos<s {suc x} {suc y} (s≤s lt) = s≤s (<tos<s {x} {y} lt)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
192
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
193 <to≤ : {x y : ℕ } → x < y → x ≤ y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
194 <to≤ {zero} {suc y} (s≤s z≤n) = z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
195 <to≤ {suc x} {suc y} (s≤s lt) = s≤s (<to≤ {x} {y} lt)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
196
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
197 refl-≤s : {x : ℕ } → x ≤ suc x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
198 refl-≤s {zero} = z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
199 refl-≤s {suc x} = s≤s (refl-≤s {x})
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
200
192
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
201 refl-≤ : {x : ℕ } → x ≤ x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
202 refl-≤ {zero} = z≤n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
203 refl-≤ {suc x} = s≤s (refl-≤ {x})
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
204
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
205 x<y→≤ : {x y : ℕ } → x < y → x ≤ suc y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
206 x<y→≤ {zero} {.(suc _)} (s≤s z≤n) = z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
207 x<y→≤ {suc x} {suc y} (s≤s lt) = s≤s (x<y→≤ {x} {y} lt)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
208
261
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
209 ≤→= : {i j : ℕ} → i ≤ j → j ≤ i → i ≡ j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
210 ≤→= {0} {0} z≤n z≤n = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
211 ≤→= {suc i} {suc j} (s≤s i<j) (s≤s j<i) = cong suc ( ≤→= {i} {j} i<j j<i )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
212
262
cb13c38103b1 LBℕ : Bijection ℕ ( List Bool ) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
213 px≤x : {x : ℕ } → pred x ≤ x
cb13c38103b1 LBℕ : Bijection ℕ ( List Bool ) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
214 px≤x {zero} = refl-≤
cb13c38103b1 LBℕ : Bijection ℕ ( List Bool ) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
215 px≤x {suc x} = refl-≤s
cb13c38103b1 LBℕ : Bijection ℕ ( List Bool ) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
216
cb13c38103b1 LBℕ : Bijection ℕ ( List Bool ) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
217 px≤py : {x y : ℕ } → x ≤ y → pred x ≤ pred y
cb13c38103b1 LBℕ : Bijection ℕ ( List Bool ) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
218 px≤py {zero} {zero} lt = refl-≤
cb13c38103b1 LBℕ : Bijection ℕ ( List Bool ) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
219 px≤py {zero} {suc y} lt = z≤n
cb13c38103b1 LBℕ : Bijection ℕ ( List Bool ) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
220 px≤py {suc x} {suc y} (s≤s lt) = lt
261
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
221
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
222 open import Data.Product
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
223
206
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 202
diff changeset
224 i-j=0→i=j : {i j : ℕ } → j ≤ i → i - j ≡ 0 → i ≡ j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 202
diff changeset
225 i-j=0→i=j {zero} {zero} _ refl = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 202
diff changeset
226 i-j=0→i=j {zero} {suc j} () refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 202
diff changeset
227 i-j=0→i=j {suc i} {zero} z≤n ()
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 202
diff changeset
228 i-j=0→i=j {suc i} {suc j} (s≤s lt) eq = cong suc (i-j=0→i=j {i} {j} lt eq)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 202
diff changeset
229
261
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
230 m*n=0⇒m=0∨n=0 : {i j : ℕ} → i * j ≡ 0 → (i ≡ 0) ∨ ( j ≡ 0 )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
231 m*n=0⇒m=0∨n=0 {zero} {j} refl = case1 refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
232 m*n=0⇒m=0∨n=0 {suc i} {zero} eq = case2 refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
233
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 260
diff changeset
234
197
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
235 minus+1 : {x y : ℕ } → y ≤ x → suc (minus x y) ≡ minus (suc x) y
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
236 minus+1 {zero} {zero} y≤x = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
237 minus+1 {suc x} {zero} y≤x = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
238 minus+1 {suc x} {suc y} (s≤s y≤x) = minus+1 {x} {y} y≤x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
239
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
240 minus+yz : {x y z : ℕ } → z ≤ y → x + minus y z ≡ minus (x + y) z
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
241 minus+yz {zero} {y} {z} _ = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
242 minus+yz {suc x} {y} {z} z≤y = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
243 suc x + minus y z ≡⟨ cong suc ( minus+yz z≤y ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
244 suc (minus (x + y) z) ≡⟨ minus+1 {x + y} {z} (≤-trans z≤y (subst (λ g → y ≤ g) (+-comm y x) x≤x+y) ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
245 minus (suc x + y) z ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 192
diff changeset
246
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
247 minus<=0 : {x y : ℕ } → x ≤ y → minus x y ≡ 0
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
248 minus<=0 {0} {zero} z≤n = refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
249 minus<=0 {0} {suc y} z≤n = refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
250 minus<=0 {suc x} {suc y} (s≤s le) = minus<=0 {x} {y} le
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
251
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
252 minus>0 : {x y : ℕ } → x < y → 0 < minus y x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
253 minus>0 {zero} {suc _} (s≤s z≤n) = s≤s z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
254 minus>0 {suc x} {suc y} (s≤s lt) = minus>0 {x} {y} lt
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
255
235
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 217
diff changeset
256 minus>0→x<y : {x y : ℕ } → 0 < minus y x → x < y
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 217
diff changeset
257 minus>0→x<y {x} {y} lt with <-cmp x y
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 217
diff changeset
258 ... | tri< a ¬b ¬c = a
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 217
diff changeset
259 ... | tri≈ ¬a refl ¬c = ⊥-elim ( nat-≡< (sym (minus<=0 {x} ≤-refl)) lt )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 217
diff changeset
260 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym (minus<=0 {y} (≤-trans refl-≤s c ))) lt )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 217
diff changeset
261
198
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 197
diff changeset
262 minus+y-y : {x y : ℕ } → (x + y) - y ≡ x
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 197
diff changeset
263 minus+y-y {zero} {y} = minus<=0 {zero + y} {y} ≤-refl
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 197
diff changeset
264 minus+y-y {suc x} {y} = begin
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 197
diff changeset
265 (suc x + y) - y ≡⟨ sym (minus+1 {_} {y} x≤y+x) ⟩
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 197
diff changeset
266 suc ((x + y) - y) ≡⟨ cong suc (minus+y-y {x} {y}) ⟩
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 197
diff changeset
267 suc x ∎ where open ≡-Reasoning
4b452c9d7e7b gcd done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 197
diff changeset
268
236
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 235
diff changeset
269 minus+yx-yz : {x y z : ℕ } → (y + x) - (y + z) ≡ x - z
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 235
diff changeset
270 minus+yx-yz {x} {zero} {z} = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 235
diff changeset
271 minus+yx-yz {x} {suc y} {z} = minus+yx-yz {x} {y} {z}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 235
diff changeset
272
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 235
diff changeset
273 minus+xy-zy : {x y z : ℕ } → (x + y) - (z + y) ≡ x - z
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 235
diff changeset
274 minus+xy-zy {x} {y} {z} = subst₂ (λ j k → j - k ≡ x - z ) (+-comm y x) (+-comm y z) (minus+yx-yz {x} {y} {z})
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 235
diff changeset
275
209
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
276 y-x<y : {x y : ℕ } → 0 < x → 0 < y → y - x < y
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
277 y-x<y {x} {y} 0<x 0<y with <-cmp x (suc y)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
278 ... | tri< a ¬b ¬c = +-cancelʳ-< {x} (y - x) y ( begin
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
279 suc ((y - x) + x) ≡⟨ cong suc (minus+n {y} {x} a ) ⟩
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
280 suc y ≡⟨ +-comm 1 _ ⟩
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
281 y + suc 0 ≤⟨ +-mono-≤ ≤-refl 0<x ⟩
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
282 y + x ∎ ) where open ≤-Reasoning
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
283 ... | tri≈ ¬a refl ¬c = subst ( λ k → k < y ) (sym (minus<=0 {y} {x} refl-≤s )) 0<y
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
284 ... | tri> ¬a ¬b c = subst ( λ k → k < y ) (sym (minus<=0 {y} {x} (≤-trans (≤-trans refl-≤s refl-≤s) c))) 0<y -- suc (suc y) ≤ x → y ≤ x
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
285
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
286 open import Relation.Binary.Definitions
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
287
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
288 distr-minus-* : {x y z : ℕ } → (minus x y) * z ≡ minus (x * z) (y * z)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
289 distr-minus-* {x} {zero} {z} = refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
290 distr-minus-* {x} {suc y} {z} with <-cmp x y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
291 distr-minus-* {x} {suc y} {z} | tri< a ¬b ¬c = begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
292 minus x (suc y) * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
293 ≡⟨ cong (λ k → k * z ) (minus<=0 {x} {suc y} (x<y→≤ a)) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
294 0 * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
295 ≡⟨ sym (minus<=0 {x * z} {z + y * z} le ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
296 minus (x * z) (z + y * z)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
297 ∎ where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
298 open ≡-Reasoning
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
299 le : x * z ≤ z + y * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
300 le = ≤-trans lemma (subst (λ k → y * z ≤ k ) (+-comm _ z ) (x≤x+y {y * z} {z} ) ) where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
301 lemma : x * z ≤ y * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
302 lemma = *≤ {x} {y} {z} (<to≤ a)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
303 distr-minus-* {x} {suc y} {z} | tri≈ ¬a refl ¬c = begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
304 minus x (suc y) * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
305 ≡⟨ cong (λ k → k * z ) (minus<=0 {x} {suc y} refl-≤s ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
306 0 * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
307 ≡⟨ sym (minus<=0 {x * z} {z + y * z} (lt {x} {z} )) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
308 minus (x * z) (z + y * z)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
309 ∎ where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
310 open ≡-Reasoning
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
311 lt : {x z : ℕ } → x * z ≤ z + x * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
312 lt {zero} {zero} = z≤n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
313 lt {suc x} {zero} = lt {x} {zero}
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
314 lt {x} {suc z} = ≤-trans lemma refl-≤s where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
315 lemma : x * suc z ≤ z + x * suc z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
316 lemma = subst (λ k → x * suc z ≤ k ) (+-comm _ z) (x≤x+y {x * suc z} {z})
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
317 distr-minus-* {x} {suc y} {z} | tri> ¬a ¬b c = +m= {_} {_} {suc y * z} ( begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
318 minus x (suc y) * z + suc y * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
319 ≡⟨ sym (proj₂ *-distrib-+ z (minus x (suc y) ) _) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
320 ( minus x (suc y) + suc y ) * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
321 ≡⟨ cong (λ k → k * z) (minus+n {x} {suc y} (s≤s c)) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
322 x * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
323 ≡⟨ sym (minus+n {x * z} {suc y * z} (s≤s (lt c))) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
324 minus (x * z) (suc y * z) + suc y * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
325 ∎ ) where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
326 open ≡-Reasoning
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
327 lt : {x y z : ℕ } → suc y ≤ x → z + y * z ≤ x * z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
328 lt {x} {y} {z} le = *≤ le
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
329
249
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 236
diff changeset
330 distr-minus-*' : {z x y : ℕ } → z * (minus x y) ≡ minus (z * x) (z * y)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 236
diff changeset
331 distr-minus-*' {z} {x} {y} = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 236
diff changeset
332 z * (minus x y) ≡⟨ *-comm _ (x - y) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 236
diff changeset
333 (minus x y) * z ≡⟨ distr-minus-* {x} {y} {z} ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 236
diff changeset
334 minus (x * z) (y * z) ≡⟨ cong₂ (λ j k → j - k ) (*-comm x z ) (*-comm y z) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 236
diff changeset
335 minus (z * x) (z * y) ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 236
diff changeset
336
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
337 minus- : {x y z : ℕ } → suc x > z + y → minus (minus x y) z ≡ minus x (y + z)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
338 minus- {x} {y} {z} gt = +m= {_} {_} {z} ( begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
339 minus (minus x y) z + z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
340 ≡⟨ minus+n {_} {z} lemma ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
341 minus x y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
342 ≡⟨ +m= {_} {_} {y} ( begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
343 minus x y + y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
344 ≡⟨ minus+n {_} {y} lemma1 ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
345 x
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
346 ≡⟨ sym ( minus+n {_} {z + y} gt ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
347 minus x (z + y) + (z + y)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
348 ≡⟨ sym ( +-assoc (minus x (z + y)) _ _ ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
349 minus x (z + y) + z + y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
350 ∎ ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
351 minus x (z + y) + z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
352 ≡⟨ cong (λ k → minus x k + z ) (+-comm _ y ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
353 minus x (y + z) + z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
354 ∎ ) where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
355 open ≡-Reasoning
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
356 lemma1 : suc x > y
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
357 lemma1 = x+y<z→x<z (subst (λ k → k < suc x ) (+-comm z _ ) gt )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
358 lemma : suc (minus x y) > z
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
359 lemma = <-minus {_} {_} {y} ( subst ( λ x → z + y < suc x ) (sym (minus+n {x} {y} lemma1 )) gt )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
360
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
361 minus-* : {M k n : ℕ } → n < k → minus k (suc n) * M ≡ minus (minus k n * M ) M
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
362 minus-* {zero} {k} {n} lt = begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
363 minus k (suc n) * zero
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
364 ≡⟨ *-comm (minus k (suc n)) zero ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
365 zero * minus k (suc n)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
366 ≡⟨⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
367 0 * minus k n
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
368 ≡⟨ *-comm 0 (minus k n) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
369 minus (minus k n * 0 ) 0
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
370 ∎ where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
371 open ≡-Reasoning
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
372 minus-* {suc m} {k} {n} lt with <-cmp k 1
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
373 minus-* {suc m} {.0} {zero} lt | tri< (s≤s z≤n) ¬b ¬c = refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
374 minus-* {suc m} {.0} {suc n} lt | tri< (s≤s z≤n) ¬b ¬c = refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
375 minus-* {suc zero} {.1} {zero} lt | tri≈ ¬a refl ¬c = refl
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
376 minus-* {suc (suc m)} {.1} {zero} lt | tri≈ ¬a refl ¬c = minus-* {suc m} {1} {zero} lt
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
377 minus-* {suc m} {.1} {suc n} (s≤s ()) | tri≈ ¬a refl ¬c
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
378 minus-* {suc m} {k} {n} lt | tri> ¬a ¬b c = begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
379 minus k (suc n) * M
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
380 ≡⟨ distr-minus-* {k} {suc n} {M} ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
381 minus (k * M ) ((suc n) * M)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
382 ≡⟨⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
383 minus (k * M ) (M + n * M )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
384 ≡⟨ cong (λ x → minus (k * M) x) (+-comm M _ ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
385 minus (k * M ) ((n * M) + M )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
386 ≡⟨ sym ( minus- {k * M} {n * M} (lemma lt) ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
387 minus (minus (k * M ) (n * M)) M
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
388 ≡⟨ cong (λ x → minus x M ) ( sym ( distr-minus-* {k} {n} )) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
389 minus (minus k n * M ) M
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
390 ∎ where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
391 M = suc m
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
392 lemma : {n k m : ℕ } → n < k → suc (k * suc m) > suc m + n * suc m
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
393 lemma {zero} {suc k} {m} (s≤s lt) = s≤s (s≤s (subst (λ x → x ≤ m + k * suc m) (+-comm 0 _ ) x≤x+y ))
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
394 lemma {suc n} {suc k} {m} lt = begin
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
395 suc (suc m + suc n * suc m)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
396 ≡⟨⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
397 suc ( suc (suc n) * suc m)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
398 ≤⟨ ≤-plus-0 {_} {_} {1} (*≤ lt ) ⟩
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
399 suc (suc k * suc m)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
400 ∎ where open ≤-Reasoning
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
401 open ≡-Reasoning
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
402
192
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
403 x=y+z→x-z=y : {x y z : ℕ } → x ≡ y + z → x - z ≡ y
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
404 x=y+z→x-z=y {x} {zero} {.x} refl = minus<=0 {x} {x} refl-≤ -- x ≡ suc (y + z) → (x ≡ y + z → x - z ≡ y) → (x - z) ≡ suc y
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
405 x=y+z→x-z=y {suc x} {suc y} {zero} eq = begin -- suc x ≡ suc (y + zero) → (suc x - zero) ≡ suc y
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
406 suc x - zero ≡⟨ refl ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
407 suc x ≡⟨ eq ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
408 suc y + zero ≡⟨ +-comm _ zero ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
409 suc y ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
410 x=y+z→x-z=y {suc x} {suc y} {suc z} eq = x=y+z→x-z=y {x} {suc y} {z} ( begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
411 x ≡⟨ cong pred eq ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
412 pred (suc y + suc z) ≡⟨ +-comm _ (suc z) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
413 suc z + y ≡⟨ cong suc ( +-comm _ y ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
414 suc y + z ∎ ) where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 185
diff changeset
415
202
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 198
diff changeset
416 m*1=m : {m : ℕ } → m * 1 ≡ m
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 198
diff changeset
417 m*1=m {zero} = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 198
diff changeset
418 m*1=m {suc m} = cong suc m*1=m
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 198
diff changeset
419
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
420 record Finduction {n m : Level} (P : Set n ) (Q : P → Set m ) (f : P → ℕ) : Set (n Level.⊔ m) where
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
421 field
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
422 fzero : {p : P} → f p ≡ zero → Q p
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
423 pnext : (p : P ) → P
209
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
424 decline : {p : P} → 0 < f p → f (pnext p) < f p
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
425 ind : {p : P} → Q (pnext p) → Q p
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
426
185
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 184
diff changeset
427 y<sx→y≤x : {x y : ℕ} → y < suc x → y ≤ x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 184
diff changeset
428 y<sx→y≤x (s≤s lt) = lt
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 184
diff changeset
429
217
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
430 fi0 : (x : ℕ) → x ≤ zero → x ≡ zero
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
431 fi0 .0 z≤n = refl
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
432
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
433 f-induction : {n m : Level} {P : Set n } → {Q : P → Set m }
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
434 → (f : P → ℕ)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
435 → Finduction P Q f
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
436 → (p : P ) → Q p
209
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
437 f-induction {n} {m} {P} {Q} f I p with <-cmp 0 (f p)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
438 ... | tri> ¬a ¬b ()
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
439 ... | tri≈ ¬a b ¬c = Finduction.fzero I (sym b)
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
440 ... | tri< lt _ _ = f-induction0 p (f p) (<to≤ (Finduction.decline I lt)) where
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
441 f-induction0 : (p : P) → (x : ℕ) → (f (Finduction.pnext I p)) ≤ x → Q p
266
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 262
diff changeset
442 f-induction0 p zero le = Finduction.ind I (Finduction.fzero I (fi0 _ le))
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
443 f-induction0 p (suc x) le with <-cmp (f (Finduction.pnext I p)) (suc x)
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
444 ... | tri< (s≤s a) ¬b ¬c = f-induction0 p x a
185
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 184
diff changeset
445 ... | tri≈ ¬a b ¬c = Finduction.ind I (f-induction0 (Finduction.pnext I p) x (y<sx→y≤x f1)) where
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
446 f1 : f (Finduction.pnext I (Finduction.pnext I p)) < suc x
209
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
447 f1 = subst (λ k → f (Finduction.pnext I (Finduction.pnext I p)) < k ) b ( Finduction.decline I {Finduction.pnext I p}
1c537e2b8f69 ... f-induction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 206
diff changeset
448 (subst (λ k → 0 < k ) (sym b) (s≤s z≤n ) ))
184
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
449 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> le c )
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
450
a810ae49187c Finduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
451
216
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
452 record Ninduction {n m : Level} (P : Set n ) (Q : P → Set m ) (f : P → ℕ) : Set (n Level.⊔ m) where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
453 field
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
454 pnext : (p : P ) → P
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
455 fzero : {p : P} → f (pnext p) ≡ zero → Q p
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
456 decline : {p : P} → 0 < f p → f (pnext p) < f p
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
457 ind : {p : P} → Q (pnext p) → Q p
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
458
217
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
459 s≤s→≤ : { i j : ℕ} → suc i ≤ suc j → i ≤ j
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
460 s≤s→≤ (s≤s lt) = lt
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
461
216
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
462 n-induction : {n m : Level} {P : Set n } → {Q : P → Set m }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
463 → (f : P → ℕ)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
464 → Ninduction P Q f
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
465 → (p : P ) → Q p
217
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
466 n-induction {n} {m} {P} {Q} f I p = f-induction0 p (f (Ninduction.pnext I p)) ≤-refl where
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
467 f-induction0 : (p : P) → (x : ℕ) → (f (Ninduction.pnext I p)) ≤ x → Q p
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
468 f-induction0 p zero lt = Ninduction.fzero I {p} (fi0 _ lt)
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
469 f-induction0 p (suc x) le with <-cmp (f (Ninduction.pnext I p)) (suc x)
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
470 ... | tri< (s≤s a) ¬b ¬c = f-induction0 p x a
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
471 ... | tri≈ ¬a b ¬c = Ninduction.ind I (f-induction0 (Ninduction.pnext I p) x (s≤s→≤ nle) ) where
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
472 f>0 : 0 < f (Ninduction.pnext I p)
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
473 f>0 = subst (λ k → 0 < k ) (sym b) ( s≤s z≤n )
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
474 nle : suc (f (Ninduction.pnext I (Ninduction.pnext I p))) ≤ suc x
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
475 nle = subst (λ k → suc (f (Ninduction.pnext I (Ninduction.pnext I p))) ≤ k) b (Ninduction.decline I {Ninduction.pnext I p} f>0 )
119ab3f823f1 NInduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 216
diff changeset
476 ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> le c )
216
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
477
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 209
diff changeset
478
281
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
479 record Factor (n m : ℕ ) : Set where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
480 field
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
481 factor : ℕ
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
482 remain : ℕ
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
483 is-factor : factor * n + remain ≡ m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
484
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
485 record Dividable (n m : ℕ ) : Set where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
486 field
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
487 factor : ℕ
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
488 is-factor : factor * n + 0 ≡ m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
489
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
490 open Factor
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
491
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
492 DtoF : {n m : ℕ} → Dividable n m → Factor n m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
493 DtoF {n} {m} record { factor = f ; is-factor = fa } = record { factor = f ; remain = 0 ; is-factor = fa }
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
494
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
495 FtoD : {n m : ℕ} → (fc : Factor n m) → remain fc ≡ 0 → Dividable n m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
496 FtoD {n} {m} record { factor = f ; remain = r ; is-factor = fa } refl = record { factor = f ; is-factor = fa }
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
497
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
498 --divdable^2 : ( n k : ℕ ) → Dividable k ( n * n ) → Dividable k n
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
499 --divdable^2 n k dn2 = {!!}
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
500
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
501 decf : { n k : ℕ } → ( x : Factor k (suc n) ) → Factor k n
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
502 decf {n} {k} record { factor = f ; remain = r ; is-factor = fa } =
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
503 decf1 {n} {k} f r fa where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
504 decf1 : { n k : ℕ } → (f r : ℕ) → (f * k + r ≡ suc n) → Factor k n
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
505 decf1 {n} {k} f (suc r) fa = -- this case must be the first
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
506 record { factor = f ; remain = r ; is-factor = ( begin -- fa : f * k + suc r ≡ suc n
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
507 f * k + r ≡⟨ cong pred ( begin
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
508 suc ( f * k + r ) ≡⟨ +-comm _ r ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
509 r + suc (f * k) ≡⟨ sym (+-assoc r 1 _) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
510 (r + 1) + f * k ≡⟨ cong (λ t → t + f * k ) (+-comm r 1) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
511 (suc r ) + f * k ≡⟨ +-comm (suc r) _ ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
512 f * k + suc r ≡⟨ fa ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
513 suc n ∎ ) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
514 n ∎ ) } where open ≡-Reasoning
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
515 decf1 {n} {zero} (suc f) zero fa = ⊥-elim ( nat-≡< fa (
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
516 begin suc (suc f * zero + zero) ≡⟨ cong suc (+-comm _ zero) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
517 suc (f * 0) ≡⟨ cong suc (*-comm f zero) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
518 suc zero ≤⟨ s≤s z≤n ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
519 suc n ∎ )) where open ≤-Reasoning
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
520 decf1 {n} {suc k} (suc f) zero fa =
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
521 record { factor = f ; remain = k ; is-factor = ( begin -- fa : suc (k + f * suc k + zero) ≡ suc n
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
522 f * suc k + k ≡⟨ +-comm _ k ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
523 k + f * suc k ≡⟨ +-comm zero _ ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
524 (k + f * suc k) + zero ≡⟨ cong pred fa ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
525 n ∎ ) } where open ≡-Reasoning
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
526
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
527 div0 : {k : ℕ} → Dividable k 0
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
528 div0 {k} = record { factor = 0; is-factor = refl }
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
529
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
530 div= : {k : ℕ} → Dividable k k
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
531 div= {k} = record { factor = 1; is-factor = ( begin
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
532 k + 0 * k + 0 ≡⟨ trans ( +-comm _ 0) ( +-comm _ 0) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
533 k ∎ ) } where open ≡-Reasoning
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
534
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
535 div1 : { k : ℕ } → k > 1 → ¬ Dividable k 1
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
536 div1 {k} k>1 record { factor = (suc f) ; is-factor = fa } = ⊥-elim ( nat-≡< (sym fa) ( begin
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
537 2 ≤⟨ k>1 ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
538 k ≡⟨ +-comm 0 _ ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
539 k + 0 ≡⟨ refl ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
540 1 * k ≤⟨ *-mono-≤ {1} {suc f} (s≤s z≤n ) ≤-refl ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
541 suc f * k ≡⟨ +-comm 0 _ ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
542 suc f * k + 0 ∎ )) where open ≤-Reasoning
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
543
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
544 div+div : { i j k : ℕ } → Dividable k i → Dividable k j → Dividable k (i + j) ∧ Dividable k (j + i)
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
545 div+div {i} {j} {k} di dj = ⟪ div+div1 , subst (λ g → Dividable k g) (+-comm i j) div+div1 ⟫ where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
546 fki = Dividable.factor di
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
547 fkj = Dividable.factor dj
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
548 div+div1 : Dividable k (i + j)
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
549 div+div1 = record { factor = fki + fkj ; is-factor = ( begin
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
550 (fki + fkj) * k + 0 ≡⟨ +-comm _ 0 ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
551 (fki + fkj) * k ≡⟨ *-distribʳ-+ k fki _ ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
552 fki * k + fkj * k ≡⟨ cong₂ ( λ i j → i + j ) (+-comm 0 (fki * k)) (+-comm 0 (fkj * k)) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
553 (fki * k + 0) + (fkj * k + 0) ≡⟨ cong₂ ( λ i j → i + j ) (Dividable.is-factor di) (Dividable.is-factor dj) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
554 i + j ∎ ) } where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
555 open ≡-Reasoning
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
556
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
557 div-div : { i j k : ℕ } → k > 1 → Dividable k i → Dividable k j → Dividable k (i - j) ∧ Dividable k (j - i)
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
558 div-div {i} {j} {k} k>1 di dj = ⟪ div-div1 di dj , div-div1 dj di ⟫ where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
559 div-div1 : {i j : ℕ } → Dividable k i → Dividable k j → Dividable k (i - j)
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
560 div-div1 {i} {j} di dj = record { factor = fki - fkj ; is-factor = ( begin
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
561 (fki - fkj) * k + 0 ≡⟨ +-comm _ 0 ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
562 (fki - fkj) * k ≡⟨ distr-minus-* {fki} {fkj} ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
563 (fki * k) - (fkj * k) ≡⟨ cong₂ ( λ i j → i - j ) (+-comm 0 (fki * k)) (+-comm 0 (fkj * k)) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
564 (fki * k + 0) - (fkj * k + 0) ≡⟨ cong₂ ( λ i j → i - j ) (Dividable.is-factor di) (Dividable.is-factor dj) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
565 i - j ∎ ) } where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
566 open ≡-Reasoning
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
567 fki = Dividable.factor di
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
568 fkj = Dividable.factor dj
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
569
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
570 open _∧_
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
571
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
572 div+1 : { i k : ℕ } → k > 1 → Dividable k i → ¬ Dividable k (suc i)
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
573 div+1 {i} {k} k>1 d d1 = div1 k>1 div+11 where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
574 div+11 : Dividable k 1
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
575 div+11 = subst (λ g → Dividable k g) (minus+y-y {1} {i} ) ( proj2 (div-div k>1 d d1 ) )
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
576
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
577 div<k : { m k : ℕ } → k > 1 → m > 0 → m < k → ¬ Dividable k m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
578 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
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
579 div<k1 : (f : ℕ ) → f * k + 0 ≡ m → k ≤ m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
580 div<k1 zero eq = ⊥-elim (nat-≡< eq m>0 )
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
581 div<k1 (suc f) eq = begin
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
582 k ≤⟨ x≤x+y ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
583 k + (f * k + 0) ≡⟨ sym (+-assoc k _ _) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
584 k + f * k + 0 ≡⟨ eq ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
585 m ∎ where open ≤-Reasoning
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
586
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
587 div→k≤m : { m k : ℕ } → k > 1 → m > 0 → Dividable k m → m ≥ k
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
588 div→k≤m {m} {k} k>1 m>0 d with <-cmp m k
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
589 ... | tri< a ¬b ¬c = ⊥-elim ( div<k k>1 m>0 a d )
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
590 ... | tri≈ ¬a refl ¬c = ≤-refl
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
591 ... | tri> ¬a ¬b c = <to≤ c
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
592
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
593 div1*k+0=k : {k : ℕ } → 1 * k + 0 ≡ k
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
594 div1*k+0=k {k} = begin
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
595 1 * k + 0 ≡⟨ cong (λ g → g + 0) (+-comm _ 0) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
596 k + 0 ≡⟨ +-comm _ 0 ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
597 k ∎ where open ≡-Reasoning
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
598
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
599 decD : {k m : ℕ} → k > 1 → Dec (Dividable k m )
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
600 decD {k} {m} k>1 = n-induction {_} {_} {ℕ} {λ m → Dec (Dividable k m ) } F I m where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
601 F : ℕ → ℕ
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
602 F m = m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
603 F0 : ( m : ℕ ) → F (m - k) ≡ 0 → Dec (Dividable k m )
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
604 F0 0 eq = yes record { factor = 0 ; is-factor = refl }
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
605 F0 (suc m) eq with <-cmp k (suc m)
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
606 ... | tri< a ¬b ¬c = yes record { factor = 1 ; is-factor =
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
607 subst (λ g → 1 * k + 0 ≡ g ) (sym (i-j=0→i=j (<to≤ a) eq )) div1*k+0=k } -- (suc m - k) ≡ 0 → k ≡ suc m, k ≤ suc m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
608 ... | tri≈ ¬a refl ¬c = yes record { factor = 1 ; is-factor = div1*k+0=k }
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
609 ... | tri> ¬a ¬b c = no ( λ d → ⊥-elim (div<k k>1 (s≤s z≤n ) c d) )
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
610 decl : {m : ℕ } → 0 < m → m - k < m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
611 decl {m} 0<m = y-x<y (<-trans a<sa k>1 ) 0<m
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
612 ind : (p : ℕ ) → Dec (Dividable k (p - k) ) → Dec (Dividable k p )
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
613 ind p (yes y) with <-cmp p k
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
614 ... | tri≈ ¬a refl ¬c = yes (subst (λ g → Dividable k g) (minus+n ≤-refl ) (proj1 ( div+div y div= )))
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
615 ... | tri> ¬a ¬b k<p = yes (subst (λ g → Dividable k g) (minus+n (<-trans k<p a<sa)) (proj1 ( div+div y div= )))
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
616 ... | tri< a ¬b ¬c with <-cmp p 0
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
617 ... | tri≈ ¬a refl ¬c₁ = yes div0
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
618 ... | tri> ¬a ¬b₁ c = no (λ d → not-div p (Dividable.factor d) a c (Dividable.is-factor d) ) where
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
619 not-div : (p f : ℕ) → p < k → 0 < p → f * k + 0 ≡ p → ⊥
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
620 not-div (suc p) (suc f) p<k 0<p eq = nat-≡< (sym eq) ( begin -- ≤-trans p<k {!!}) -- suc p ≤ k
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
621 suc (suc p) ≤⟨ p<k ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
622 k ≤⟨ x≤x+y ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
623 k + (f * k + 0) ≡⟨ sym (+-assoc k _ _) ⟩
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
624 suc f * k + 0 ∎ ) where open ≤-Reasoning
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
625 ind p (no n) = no (λ d → n (proj1 (div-div k>1 d div=)) )
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
626 I : Ninduction ℕ _ F
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
627 I = record {
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
628 pnext = λ p → p - k
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
629 ; fzero = λ {m} eq → F0 m eq
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
630 ; decline = λ {m} lt → decl lt
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
631 ; ind = λ {p} prev → ind p prev
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
632 }
8b437dd616dd fix gcd and root
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 266
diff changeset
633