comparison nat.agda @ 72:09fa2ab75703

add utilties
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 24 Aug 2020 23:06:10 +0900
parents
children 69ed81f8e212
comparison
equal deleted inserted replaced
71:da1677fae9ac 72:09fa2ab75703
1 {-# OPTIONS --allow-unsolved-metas #-}
2 module nat where
3
4 open import Data.Nat
5 open import Data.Nat.Properties
6 open import Data.Empty
7 open import Relation.Nullary
8 open import Relation.Binary.PropositionalEquality
9 open import Relation.Binary.Core
10 open import logic
11
12
13 nat-<> : { x y : ℕ } → x < y → y < x → ⊥
14 nat-<> (s≤s x<y) (s≤s y<x) = nat-<> x<y y<x
15
16 nat-≤> : { x y : ℕ } → x ≤ y → y < x → ⊥
17 nat-≤> (s≤s x<y) (s≤s y<x) = nat-≤> x<y y<x
18
19 nat-<≡ : { x : ℕ } → x < x → ⊥
20 nat-<≡ (s≤s lt) = nat-<≡ lt
21
22 nat-≡< : { x y : ℕ } → x ≡ y → x < y → ⊥
23 nat-≡< refl lt = nat-<≡ lt
24
25 ¬a≤a : {la : ℕ} → suc la ≤ la → ⊥
26 ¬a≤a (s≤s lt) = ¬a≤a lt
27
28 a<sa : {la : ℕ} → la < suc la
29 a<sa {zero} = s≤s z≤n
30 a<sa {suc la} = s≤s a<sa
31
32 refl-≤s : {x : ℕ } → x ≤ suc x
33 refl-≤s {zero} = z≤n
34 refl-≤s {suc x} = s≤s (refl-≤s {x})
35
36 =→¬< : {x : ℕ } → ¬ ( x < x )
37 =→¬< {zero} ()
38 =→¬< {suc x} (s≤s lt) = =→¬< lt
39
40 >→¬< : {x y : ℕ } → (x < y ) → ¬ ( y < x )
41 >→¬< (s≤s x<y) (s≤s y<x) = >→¬< x<y y<x
42
43 <-∨ : { x y : ℕ } → x < suc y → ( (x ≡ y ) ∨ (x < y) )
44 <-∨ {zero} {zero} (s≤s z≤n) = case1 refl
45 <-∨ {zero} {suc y} (s≤s lt) = case2 (s≤s z≤n)
46 <-∨ {suc x} {zero} (s≤s ())
47 <-∨ {suc x} {suc y} (s≤s lt) with <-∨ {x} {y} lt
48 <-∨ {suc x} {suc y} (s≤s lt) | case1 eq = case1 (cong (λ k → suc k ) eq)
49 <-∨ {suc x} {suc y} (s≤s lt) | case2 lt1 = case2 (s≤s lt1)
50
51 max : (x y : ℕ) → ℕ
52 max zero zero = zero
53 max zero (suc x) = (suc x)
54 max (suc x) zero = (suc x)
55 max (suc x) (suc y) = suc ( max x y )
56
57 -- _*_ : ℕ → ℕ → ℕ
58 -- _*_ zero _ = zero
59 -- _*_ (suc n) m = m + ( n * m )
60
61 exp : ℕ → ℕ → ℕ
62 exp _ zero = 1
63 exp n (suc m) = n * ( exp n m )
64
65 minus : (a b : ℕ ) → ℕ
66 minus a zero = a
67 minus zero (suc b) = zero
68 minus (suc a) (suc b) = minus a b
69
70 _-_ = minus
71
72 m+= : {i j m : ℕ } → m + i ≡ m + j → i ≡ j
73 m+= {i} {j} {zero} refl = refl
74 m+= {i} {j} {suc m} eq = m+= {i} {j} {m} ( cong (λ k → pred k ) eq )
75
76 +m= : {i j m : ℕ } → i + m ≡ j + m → i ≡ j
77 +m= {i} {j} {m} eq = m+= ( subst₂ (λ j k → j ≡ k ) (+-comm i _ ) (+-comm j _ ) eq )
78
79 less-1 : { n m : ℕ } → suc n < m → n < m
80 less-1 {zero} {suc (suc _)} (s≤s (s≤s z≤n)) = s≤s z≤n
81 less-1 {suc n} {suc m} (s≤s lt) = s≤s (less-1 {n} {m} lt)
82
83 sa=b→a<b : { n m : ℕ } → suc n ≡ m → n < m
84 sa=b→a<b {0} {suc zero} refl = s≤s z≤n
85 sa=b→a<b {suc n} {suc (suc n)} refl = s≤s (sa=b→a<b refl)
86
87 minus+n : {x y : ℕ } → suc x > y → minus x y + y ≡ x
88 minus+n {x} {zero} _ = trans (sym (+-comm zero _ )) refl
89 minus+n {zero} {suc y} (s≤s ())
90 minus+n {suc x} {suc y} (s≤s lt) = begin
91 minus (suc x) (suc y) + suc y
92 ≡⟨ +-comm _ (suc y) ⟩
93 suc y + minus x y
94 ≡⟨ cong ( λ k → suc k ) (
95 begin
96 y + minus x y
97 ≡⟨ +-comm y _ ⟩
98 minus x y + y
99 ≡⟨ minus+n {x} {y} lt ⟩
100 x
101
102 ) ⟩
103 suc x
104 ∎ where open ≡-Reasoning
105
106 sn-m=sn-m : {m n : ℕ } → m ≤ n → suc n - m ≡ suc ( n - m )
107 sn-m=sn-m {0} {n} z≤n = refl
108 sn-m=sn-m {suc m} {suc n} (s≤s m<n) = sn-m=sn-m m<n
109
110 si-sn=i-n : {i n : ℕ } → n < i → suc (i - suc n) ≡ (i - n)
111 si-sn=i-n {i} {n} n<i = begin
112 suc (i - suc n) ≡⟨ sym (sn-m=sn-m n<i ) ⟩
113 suc i - suc n ≡⟨⟩
114 i - n
115 ∎ where
116 open ≡-Reasoning
117
118 n-m<n : (n m : ℕ ) → n - m ≤ n
119 n-m<n zero zero = z≤n
120 n-m<n (suc n) zero = s≤s (n-m<n n zero)
121 n-m<n zero (suc m) = z≤n
122 n-m<n (suc n) (suc m) = ≤-trans (n-m<n n m ) refl-≤s
123
124 n-n-m=m : {m n : ℕ } → m ≤ n → m ≡ (n - (n - m))
125 n-n-m=m {0} {zero} z≤n = refl
126 n-n-m=m {0} {suc n} z≤n = n-n-m=m {0} {n} z≤n
127 n-n-m=m {suc m} {suc n} (s≤s m≤n) = sym ( begin
128 suc n - ( n - m ) ≡⟨ sn-m=sn-m (n-m<n n m) ⟩
129 suc (n - ( n - m )) ≡⟨ cong (λ k → suc k ) (sym (n-n-m=m m≤n)) ⟩
130 suc m
131 ∎ ) where
132 open ≡-Reasoning
133
134 0<s : {x : ℕ } → zero < suc x
135 0<s {_} = s≤s z≤n
136
137 <-minus-0 : {x y z : ℕ } → z + x < z + y → x < y
138 <-minus-0 {x} {suc _} {zero} lt = lt
139 <-minus-0 {x} {y} {suc z} (s≤s lt) = <-minus-0 {x} {y} {z} lt
140
141 <-minus : {x y z : ℕ } → x + z < y + z → x < y
142 <-minus {x} {y} {z} lt = <-minus-0 ( subst₂ ( λ j k → j < k ) (+-comm x _) (+-comm y _ ) lt )
143
144 x≤x+y : {z y : ℕ } → z ≤ z + y
145 x≤x+y {zero} {y} = z≤n
146 x≤x+y {suc z} {y} = s≤s (x≤x+y {z} {y})
147
148 <-plus : {x y z : ℕ } → x < y → x + z < y + z
149 <-plus {zero} {suc y} {z} (s≤s z≤n) = s≤s (subst (λ k → z ≤ k ) (+-comm z _ ) x≤x+y )
150 <-plus {suc x} {suc y} {z} (s≤s lt) = s≤s (<-plus {x} {y} {z} lt)
151
152 <-plus-0 : {x y z : ℕ } → x < y → z + x < z + y
153 <-plus-0 {x} {y} {z} lt = subst₂ (λ j k → j < k ) (+-comm _ z) (+-comm _ z) ( <-plus {x} {y} {z} lt )
154
155 ≤-plus : {x y z : ℕ } → x ≤ y → x + z ≤ y + z
156 ≤-plus {0} {y} {zero} z≤n = z≤n
157 ≤-plus {0} {y} {suc z} z≤n = subst (λ k → z < k ) (+-comm _ y ) x≤x+y
158 ≤-plus {suc x} {suc y} {z} (s≤s lt) = s≤s ( ≤-plus {x} {y} {z} lt )
159
160 ≤-plus-0 : {x y z : ℕ } → x ≤ y → z + x ≤ z + y
161 ≤-plus-0 {x} {y} {zero} lt = lt
162 ≤-plus-0 {x} {y} {suc z} lt = s≤s ( ≤-plus-0 {x} {y} {z} lt )
163
164 x+y<z→x<z : {x y z : ℕ } → x + y < z → x < z
165 x+y<z→x<z {zero} {y} {suc z} (s≤s lt1) = s≤s z≤n
166 x+y<z→x<z {suc x} {y} {suc z} (s≤s lt1) = s≤s ( x+y<z→x<z {x} {y} {z} lt1 )
167
168 *≤ : {x y z : ℕ } → x ≤ y → x * z ≤ y * z
169 *≤ lt = *-mono-≤ lt ≤-refl
170
171 *< : {x y z : ℕ } → x < y → x * suc z < y * suc z
172 *< {zero} {suc y} lt = s≤s z≤n
173 *< {suc x} {suc y} (s≤s lt) = <-plus-0 (*< lt)
174
175 <to<s : {x y : ℕ } → x < y → x < suc y
176 <to<s {zero} {suc y} (s≤s lt) = s≤s z≤n
177 <to<s {suc x} {suc y} (s≤s lt) = s≤s (<to<s {x} {y} lt)
178
179 <tos<s : {x y : ℕ } → x < y → suc x < suc y
180 <tos<s {zero} {suc y} (s≤s z≤n) = s≤s (s≤s z≤n)
181 <tos<s {suc x} {suc y} (s≤s lt) = s≤s (<tos<s {x} {y} lt)
182
183 ≤to< : {x y : ℕ } → x < y → x ≤ y
184 ≤to< {zero} {suc y} (s≤s z≤n) = z≤n
185 ≤to< {suc x} {suc y} (s≤s lt) = s≤s (≤to< {x} {y} lt)
186
187 x<y→≤ : {x y : ℕ } → x < y → x ≤ suc y
188 x<y→≤ {zero} {.(suc _)} (s≤s z≤n) = z≤n
189 x<y→≤ {suc x} {suc y} (s≤s lt) = s≤s (x<y→≤ {x} {y} lt)
190
191 open import Data.Product
192
193 minus<=0 : {x y : ℕ } → x ≤ y → minus x y ≡ 0
194 minus<=0 {0} {zero} z≤n = refl
195 minus<=0 {0} {suc y} z≤n = refl
196 minus<=0 {suc x} {suc y} (s≤s le) = minus<=0 {x} {y} le
197
198 minus>0 : {x y : ℕ } → x < y → 0 < minus y x
199 minus>0 {zero} {suc _} (s≤s z≤n) = s≤s z≤n
200 minus>0 {suc x} {suc y} (s≤s lt) = minus>0 {x} {y} lt
201
202 distr-minus-* : {x y z : ℕ } → (minus x y) * z ≡ minus (x * z) (y * z)
203 distr-minus-* {x} {zero} {z} = refl
204 distr-minus-* {x} {suc y} {z} with <-cmp x y
205 distr-minus-* {x} {suc y} {z} | tri< a ¬b ¬c = begin
206 minus x (suc y) * z
207 ≡⟨ cong (λ k → k * z ) (minus<=0 {x} {suc y} (x<y→≤ a)) ⟩
208 0 * z
209 ≡⟨ sym (minus<=0 {x * z} {z + y * z} le ) ⟩
210 minus (x * z) (z + y * z)
211 ∎ where
212 open ≡-Reasoning
213 le : x * z ≤ z + y * z
214 le = ≤-trans lemma (subst (λ k → y * z ≤ k ) (+-comm _ z ) (x≤x+y {y * z} {z} ) ) where
215 lemma : x * z ≤ y * z
216 lemma = *≤ {x} {y} {z} (≤to< a)
217 distr-minus-* {x} {suc y} {z} | tri≈ ¬a refl ¬c = begin
218 minus x (suc y) * z
219 ≡⟨ cong (λ k → k * z ) (minus<=0 {x} {suc y} refl-≤s ) ⟩
220 0 * z
221 ≡⟨ sym (minus<=0 {x * z} {z + y * z} (lt {x} {z} )) ⟩
222 minus (x * z) (z + y * z)
223 ∎ where
224 open ≡-Reasoning
225 lt : {x z : ℕ } → x * z ≤ z + x * z
226 lt {zero} {zero} = z≤n
227 lt {suc x} {zero} = lt {x} {zero}
228 lt {x} {suc z} = ≤-trans lemma refl-≤s where
229 lemma : x * suc z ≤ z + x * suc z
230 lemma = subst (λ k → x * suc z ≤ k ) (+-comm _ z) (x≤x+y {x * suc z} {z})
231 distr-minus-* {x} {suc y} {z} | tri> ¬a ¬b c = +m= {_} {_} {suc y * z} ( begin
232 minus x (suc y) * z + suc y * z
233 ≡⟨ sym (proj₂ *-distrib-+ z (minus x (suc y) ) _) ⟩
234 ( minus x (suc y) + suc y ) * z
235 ≡⟨ cong (λ k → k * z) (minus+n {x} {suc y} (s≤s c)) ⟩
236 x * z
237 ≡⟨ sym (minus+n {x * z} {suc y * z} (s≤s (lt c))) ⟩
238 minus (x * z) (suc y * z) + suc y * z
239 ∎ ) where
240 open ≡-Reasoning
241 lt : {x y z : ℕ } → suc y ≤ x → z + y * z ≤ x * z
242 lt {x} {y} {z} le = *≤ le
243
244 minus- : {x y z : ℕ } → suc x > z + y → minus (minus x y) z ≡ minus x (y + z)
245 minus- {x} {y} {z} gt = +m= {_} {_} {z} ( begin
246 minus (minus x y) z + z
247 ≡⟨ minus+n {_} {z} lemma ⟩
248 minus x y
249 ≡⟨ +m= {_} {_} {y} ( begin
250 minus x y + y
251 ≡⟨ minus+n {_} {y} lemma1 ⟩
252 x
253 ≡⟨ sym ( minus+n {_} {z + y} gt ) ⟩
254 minus x (z + y) + (z + y)
255 ≡⟨ sym ( +-assoc (minus x (z + y)) _ _ ) ⟩
256 minus x (z + y) + z + y
257 ∎ ) ⟩
258 minus x (z + y) + z
259 ≡⟨ cong (λ k → minus x k + z ) (+-comm _ y ) ⟩
260 minus x (y + z) + z
261 ∎ ) where
262 open ≡-Reasoning
263 lemma1 : suc x > y
264 lemma1 = x+y<z→x<z (subst (λ k → k < suc x ) (+-comm z _ ) gt )
265 lemma : suc (minus x y) > z
266 lemma = <-minus {_} {_} {y} ( subst ( λ x → z + y < suc x ) (sym (minus+n {x} {y} lemma1 )) gt )
267
268 minus-* : {M k n : ℕ } → n < k → minus k (suc n) * M ≡ minus (minus k n * M ) M
269 minus-* {zero} {k} {n} lt = begin
270 minus k (suc n) * zero
271 ≡⟨ *-comm (minus k (suc n)) zero ⟩
272 zero * minus k (suc n)
273 ≡⟨⟩
274 0 * minus k n
275 ≡⟨ *-comm 0 (minus k n) ⟩
276 minus (minus k n * 0 ) 0
277 ∎ where
278 open ≡-Reasoning
279 minus-* {suc m} {k} {n} lt with <-cmp k 1
280 minus-* {suc m} {.0} {zero} lt | tri< (s≤s z≤n) ¬b ¬c = refl
281 minus-* {suc m} {.0} {suc n} lt | tri< (s≤s z≤n) ¬b ¬c = refl
282 minus-* {suc zero} {.1} {zero} lt | tri≈ ¬a refl ¬c = refl
283 minus-* {suc (suc m)} {.1} {zero} lt | tri≈ ¬a refl ¬c = minus-* {suc m} {1} {zero} lt
284 minus-* {suc m} {.1} {suc n} (s≤s ()) | tri≈ ¬a refl ¬c
285 minus-* {suc m} {k} {n} lt | tri> ¬a ¬b c = begin
286 minus k (suc n) * M
287 ≡⟨ distr-minus-* {k} {suc n} {M} ⟩
288 minus (k * M ) ((suc n) * M)
289 ≡⟨⟩
290 minus (k * M ) (M + n * M )
291 ≡⟨ cong (λ x → minus (k * M) x) (+-comm M _ ) ⟩
292 minus (k * M ) ((n * M) + M )
293 ≡⟨ sym ( minus- {k * M} {n * M} (lemma lt) ) ⟩
294 minus (minus (k * M ) (n * M)) M
295 ≡⟨ cong (λ x → minus x M ) ( sym ( distr-minus-* {k} {n} )) ⟩
296 minus (minus k n * M ) M
297 ∎ where
298 M = suc m
299 lemma : {n k m : ℕ } → n < k → suc (k * suc m) > suc m + n * suc m
300 lemma {zero} {suc k} {m} (s≤s lt) = s≤s (s≤s (subst (λ x → x ≤ m + k * suc m) (+-comm 0 _ ) x≤x+y ))
301 lemma {suc n} {suc k} {m} lt = begin
302 suc (suc m + suc n * suc m)
303 ≡⟨⟩
304 suc ( suc (suc n) * suc m)
305 ≤⟨ ≤-plus-0 {_} {_} {1} (*≤ lt ) ⟩
306 suc (suc k * suc m)
307 ∎ where open ≤-Reasoning
308 open ≡-Reasoning