annotate prob1.agda @ 27:73511e7ddf5c

u2 done
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 30 Mar 2020 14:28:14 +0900
parents fd8633b6d551
children 8ef3eecd159f
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 module prob1 where
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
2
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 open import Relation.Binary.PropositionalEquality
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4 open import Relation.Binary.Core
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 open import Data.Nat
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 open import Data.Nat.Properties
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 open import logic
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 open import nat
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 open import Data.Empty
14
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
10 open import Data.Product
0
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 open import Relation.Nullary
20
9cd63570c1ba add Uunique case
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 19
diff changeset
12 -- open import Relation.Binary.Definitions
19
9f5bf86fe6dd fix uniquness
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 18
diff changeset
13
0
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
14 -- All variables are positive integer
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 -- A = -M*n + i +k*M - M
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
16 -- where n is in range (0,…,k-1) and i is in range(0,…,M-1)
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
17 -- Goal: Prove that A can take all values of (0,…,k*M-1)
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
18 -- A1 = -M*n1 + i1 +k*M M, A2 = -M*n2 + i2 +k*M - M
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
19 -- (1) If n1!=n2 or i1!=i2 then A1!=A2
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
20 -- Or its contraposition: (2) if A1=A2 then n1=n2 and i1=i2
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
21 -- Proof by contradiction: Suppose A1=A2 and (n1!=n2 or i1!=i2) becomes
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
22 -- contradiction
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
23 -- Induction on n and i
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
24
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
25 record Cond1 (A M k : ℕ ) : Set where
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 field
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
27 n : ℕ
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
28 i : ℕ
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 range-n : n < k
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 range-i : i < M
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
31 rule1 : i + k * M ≡ M * (suc n) + A -- A ≡ (i + k * M ) - (M * (suc n))
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
32
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
33 -- k = 1 → n = 0 → ∀ M → A = i
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
34 -- k = 2 → n = 1 →
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
35 -- i + 2 * M = M * (suc n) + A i = suc n → A = 0
06002e20ce5c incudtion selection on diophantos equation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
36
26
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
37 record UCond1 (A M k : ℕ ) : Set where
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
38 field
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
39 c1 : Cond1 A M k
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
40 u1 : {j m : ℕ} → j < Cond1.i c1 → m < k → ¬ ( j + k * M ≡ M * (suc m) + A )
27
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
41 u2 : {j m : ℕ} → Cond1.i c1 < j → j < M → m < k → ¬ ( j + k * M ≡ M * (suc m) + A )
26
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
42 -- u3 : {j m : ℕ} → j < M → m < Cond1.n c1 → ¬ ( j + k * M ≡ M * (suc m) + A )
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
43 -- u4 : {j m : ℕ} → j < M → Cond1.n c1 < m → m < k → ¬ ( j + k * M ≡ M * (suc m) + A )
18
kono
parents: 17
diff changeset
44
26
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
45 problem1-0 : (k A M : ℕ ) → (A<kM : suc A < k * M )
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
46 → UCond1 A M k
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
47 problem1-0 zero A M ()
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
48 problem1-0 (suc k) A zero A<kM = ⊥-elim ( nat-<> A<kM (subst (λ x → x < suc A) (*-comm _ k ) 0<s ))
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
49 problem1-0 (suc k) A (suc m) A<kM = cc k a<sa (start-range k) where
13
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 12
diff changeset
50 M = suc m
14
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
51 cck : ( n : ℕ ) → n < suc k → (suc A > ((k - n) ) * M ) → A - ((k - n) * M) < M → Cond1 A M (suc k)
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
52 cck n n<k gt lt = record { n = n ; i = A - (((k - n)) * M ) ; range-n = n<k ; range-i = lt ; rule1 = lemma2 } where
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
53 lemma2 : A - ((k - n) * M) + suc k * M ≡ M * suc n + A
5
310a70c03166 cck done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 4
diff changeset
54 lemma2 = begin
14
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
55 A - ((k - n) * M) + suc k * M ≡⟨ cong ( λ x → A - ((k - n) * M) + suc x * M ) (sym (minus+n {k} {n} n<k )) ⟩
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
56 A - ((k - n) * M) + (suc (((k - n) ) + n )) * M ≡⟨ cong ( λ x → A - ((k - n) * M) + suc x * M ) (+-comm _ n) ⟩
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
57 A - ((k - n) * M) + (suc (n + ((k - n) ) )) * M ≡⟨⟩
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
58 A - ((k - n) * M) + (suc n + ((k - n) ) ) * M ≡⟨ cong ( λ x → A - ((k - n) * M) + x * M ) (+-comm (suc n) _) ⟩
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
59 A - ((k - n) * M) + (((k - n) ) + suc n ) * M ≡⟨ cong ( λ x → A - ((k - n) * M) + x ) (((proj₂ *-distrib-+)) M ((k - n)) _ ) ⟩
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
60 A - ((k - n) * M) + (((k - n) * M) + (suc n) * M) ≡⟨ sym (+-assoc (A - ((k - n) * M)) _ ((suc n) * M)) ⟩
8415d3f77fe0 minus clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
61 A - ((k - n) * M) + ((k - n) * M) + (suc n) * M ≡⟨ cong ( λ x → x + (suc n) * M ) ( minus+n {A} {(k - n) * M} gt ) ⟩
5
310a70c03166 cck done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 4
diff changeset
62 A + (suc n) * M ≡⟨ cong ( λ k → A + k ) (*-comm (suc n) _ ) ⟩
310a70c03166 cck done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 4
diff changeset
63 A + M * (suc n) ≡⟨ +-comm A _ ⟩
310a70c03166 cck done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 4
diff changeset
64 M * (suc n) + A
310a70c03166 cck done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 4
diff changeset
65 ∎ where open ≡-Reasoning
26
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
66 cck-u : ( n : ℕ ) → n < suc k → (suc A > ((k - n) ) * M ) → A - ((k - n) * M) < M → UCond1 A M (suc k)
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
67 cck-u n n<k k<A i<M = c0 where
21
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 20
diff changeset
68 c1 : Cond1 A M (suc k)
26
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
69 c1 = cck n n<k k<A i<M
24
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
70 lemma4 : {i j x y z : ℕ} → j + x ≡ y → i + x ≡ z → j < i → y < z
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
71 lemma4 {i} {j} {x} refl refl (s≤s z≤n) = s≤s (subst (λ k → x ≤ k ) (+-comm x _) x≤x+y)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
72 lemma4 refl refl (s≤s (s≤s lt)) = s≤s (lemma4 refl refl (s≤s lt) )
27
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
73 lemma5 : {m1 n : ℕ} → M * suc m1 + A < M * suc n + A
24
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
74 → M + (M * suc m1 + A) ≤ M * suc n + A
27
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
75 lemma5 {m1} {n} lt with <-cmp m1 n
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
76 lemma5 {m1} {n} lt | tri< a ¬b ¬c = begin
25
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
77 M + (M * suc m1 + A)
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
78 ≡⟨ sym (+-assoc M _ _ ) ⟩
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
79 (M + M * suc m1) + A
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
80 ≡⟨ sym ( cong (λ k → (k + M * suc m1) + A) ((proj₂ *-identity) M )) ⟩
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
81 (M * suc zero + M * suc m1) + A
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
82 ≡⟨ sym ( cong (λ k → k + A) (( proj₁ *-distrib-+ ) M (suc zero) _ )) ⟩
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
83 M * suc (suc m1) + A
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
84 ≤⟨ ≤-plus {_} {_} {A} (subst₂ (λ x y → x ≤ y ) (*-comm _ M ) (*-comm _ M ) (*≤ (s≤s a))) ⟩
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
85 M * suc n + A
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
86 ∎ where open ≤-Reasoning
27
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
87 lemma5 {m1} {n} lt | tri≈ ¬a refl ¬c = ⊥-elim ( nat-<≡ lt )
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
88 lemma5 {m1} {n} lt | tri> ¬a ¬b c = ⊥-elim ( nat-<> lt (<-plus {_} {_} {A} (<≤+ (s≤s c)
25
805986409de4 u1 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
89 (subst₂ (λ x y → x ≤ y ) (*-comm _ m ) (*-comm _ m ) (*≤ (s≤s (≤to< c)))))))
24
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
90 lemma6 : {i j x : ℕ} → M + (j + x ) ≤ i + x → M ≤ i
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
91 lemma6 {i} {j} {x} lt = ≤-minus {M} {i} {x} (x+y≤z→x≤z ( begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
92 M + x + j
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
93 ≡⟨ +-assoc M _ _ ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
94 M + (x + j )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
95 ≡⟨ cong (λ k → M + k ) (+-comm x _ ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
96 M + (j + x)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
97 ≤⟨ lt ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
98 i + x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
99 ∎ )) where open ≤-Reasoning
27
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
100 i : ℕ
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
101 i = A - ((k - n) * M)
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
102 lemma-u1 : {j : ℕ} {m1 : ℕ} → j < i → m1 < suc k → ¬ j + suc k * M ≡ M * suc m1 + A
23
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 22
diff changeset
103 lemma-u1 {j} {m1} j<akM m1<k eq with <-cmp j M
24
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
104 lemma-u1 {j} {m1} j<akM m1<k eq | tri< a ¬b ¬c =
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
105 ⊥-elim (nat-≤> (lemma6 (subst₂ (λ x y → M + x ≤ y) (sym eq) (sym (Cond1.rule1 c1 )) (lemma5 (lemma4 eq (Cond1.rule1 c1) j<akM ))) ) i<M ) where
27
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
106 lemma3 : M + (M * suc m1 + A) ≤ M * suc n + A -- M + j ≤ i
24
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
107 lemma3 = lemma5 (lemma4 eq (Cond1.rule1 c1) j<akM)
23
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 22
diff changeset
108 lemma-u1 {j} {m1} j<akM m1<k eq | tri≈ ¬a b ¬c = ⊥-elim (nat-≡< b ( (≤-trans j<akM (≤-trans refl-≤s i<M ))))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 22
diff changeset
109 lemma-u1 {j} {m1} j<akM m1<k eq | tri> ¬a ¬b c = ⊥-elim (nat-<> (≤-trans i<M (less-1 c)) j<akM )
27
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
110 lemma-u2 : {j : ℕ} {m1 : ℕ} → (A - ((k - n) * M)) < j →
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
111 j < M → m1 < suc k → ¬ j + suc k * M ≡ M * suc m1 + A
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
112 lemma-u2 {j} {m1} i<j j<M m1<k eq = ⊥-elim ( nat-≤> (lemma6 (subst₂ (λ x y → M + x ≤ y) (sym (Cond1.rule1 c1)) (sym eq) lemma3-2)) j<M ) where
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
113 lemma3-2 : M + (M * suc n + A) ≤ M * suc m1 + A -- M + i ≤ j
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
114 lemma3-2 = lemma5 (lemma4 (Cond1.rule1 c1) eq i<j)
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
115 c0 = record { c1 = record { n = n ; i = A - (((k - n)) * M ) ; range-n = n<k ; range-i = i<M; rule1 = Cond1.rule1 c1 }
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
116 ; u1 = lemma-u1
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
117 ; u2 = lemma-u2
73511e7ddf5c u2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
118 }
26
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
119 -- loop on range of A : ((k - n) ) * M ≤ A < ((k - n) ) * M + M
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
120 nextc : (n : ℕ ) → (suc n < suc k) → M < suc ((k - n) * M)
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
121 nextc n n<k with k - n | inspect (_-_ k) n
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
122 nextc n n<k | 0 | record { eq = e } = ⊥-elim ( nat-≡< (sym e) (minus>0 n<k) )
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
123 nextc n n<k | suc n0 | _ = s≤s (s≤s lemma) where
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
124 lemma : m ≤ m + n0 * suc m
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
125 lemma = x≤x+y
20
9cd63570c1ba add Uunique case
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 19
diff changeset
126 cc : (n : ℕ) → n < suc k → suc A > (k - n) * M → UCond1 A M (suc k)
26
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
127 cc zero n<k k<A = cck-u 0 n<k k<A lemma where
21
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 20
diff changeset
128 a<m : suc A < M + k * M
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 20
diff changeset
129 a<m = A<kM
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 20
diff changeset
130 lemma : A - ((k - 0) * M) < M
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 20
diff changeset
131 lemma = <-minus {_} {_} {k * M} (subst (λ x → x < M + k * M) (sym (minus+n {A} {k * M} k<A )) (less-1 a<m) )
17
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 15
diff changeset
132 cc (suc n) n<k k<A with <-cmp (A - ((k - (suc n)) * M)) M
26
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
133 cc (suc n) n<k k<A | tri< a ¬b ¬c = cck-u (suc n) n<k k<A a
20
9cd63570c1ba add Uunique case
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 19
diff changeset
134 cc (suc n) n<k k<A | tri≈ ¬a b ¬c =
22
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
135 cc n (less-1 n<k) (lemma1 b) where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
136 a=mk0 : (A - ((k - (suc n)) * M)) ≡ M → A ≡ (k - n) * M
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
137 a=mk0 a=mk = sym ( begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
138 (k - n) * M
26
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
139 ≡⟨ sym ( minus+n {(k - n) * M} {M} (nextc n n<k )) ⟩
22
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
140 ((k - n) * M ) - M + M
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
141 ≡⟨ +-comm _ M ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
142 M + (((k - n) * M ) - M)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
143 ≡⟨ cong (λ x → M + x ) (sym (minus-* {M} {k} (<-minus-0 n<k ))) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
144 M + (k - (suc n) * M)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
145 ≡⟨ cong (λ x → x + (k - (suc n)) * M) (sym a=mk) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
146 A - ((k - (suc n)) * M) + ((k - (suc n)) * M)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
147 ≡⟨ minus+n {A} {(k - (suc n)) * M} k<A ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
148 A
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
149 ∎ ) where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
150 lemma1 : (A - ((k - (suc n)) * M)) ≡ M → suc A > (k - n) * M
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
151 lemma1 a=mk = subst (λ x → (k - n) * M < suc x ) (sym (a=mk0 a=mk )) a<sa
20
9cd63570c1ba add Uunique case
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 19
diff changeset
152 cc (suc n) n<k k<A | tri> ¬a ¬b c =
22
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
153 cc n (less-1 n<k) (lemma3 c) where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
154 lemma3 : (A - ((k - (suc n)) * M)) > M → suc A > (k - n) * M
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
155 lemma3 mk<a = <-trans lemma5 a<sa where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
156 lemma6 : M + (k - (suc n)) * M ≡ (k - n) * M
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
157 lemma6 = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
158 M + (k - (suc n)) * M
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
159 ≡⟨ cong (λ x → M + x) (minus-* {M} {k} (<-minus-0 n<k)) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
160 M + (((k - n) * M ) - M )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
161 ≡⟨ +-comm M _ ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
162 ((k - n) * M ) - M + M
26
fd8633b6d551 clean up
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 25
diff changeset
163 ≡⟨ minus+n {_} {M} (nextc n n<k ) ⟩
22
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
164 (k - n) * M
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
165 ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
166 lemma4 : (M + (k - (suc n)) * M) < A
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
167 lemma4 = subst (λ x → (M + (k - (suc n)) * M) < x ) (minus+n {A}{(k - (suc n)) * M} k<A ) ( <-plus mk<a )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
168 lemma5 : (k - n) * M < A
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
169 lemma5 = subst (λ x → x < A ) lemma6 lemma4
17
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 15
diff changeset
170 start-range : (k : ℕ ) → suc A > (k - k) * M
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 15
diff changeset
171 start-range zero = s≤s z≤n
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 15
diff changeset
172 start-range (suc k) = start-range k
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 15
diff changeset
173