|
163
|
1 {-# OPTIONS --allow-unsolved-metas #-}
|
|
|
2
|
|
|
3 module fin where
|
|
|
4
|
|
283
|
5 open import Data.Fin hiding (_<_ ; _≤_ ; _>_ ; _+_ )
|
|
284
|
6 open import Data.Fin.Properties hiding (≤-trans ; <-trans ; ≤-refl ) renaming ( <-cmp to <-fcmp )
|
|
163
|
7 open import Data.Nat
|
|
284
|
8 open import Data.Nat.Properties
|
|
163
|
9 open import logic
|
|
|
10 open import nat
|
|
|
11 open import Relation.Binary.PropositionalEquality
|
|
|
12
|
|
|
13
|
|
|
14 -- toℕ<n
|
|
|
15 fin<n : {n : ℕ} {f : Fin n} → toℕ f < n
|
|
|
16 fin<n {_} {zero} = s≤s z≤n
|
|
|
17 fin<n {suc n} {suc f} = s≤s (fin<n {n} {f})
|
|
|
18
|
|
|
19 -- toℕ≤n
|
|
|
20 fin≤n : {n : ℕ} (f : Fin (suc n)) → toℕ f ≤ n
|
|
|
21 fin≤n {_} zero = z≤n
|
|
|
22 fin≤n {suc n} (suc f) = s≤s (fin≤n {n} f)
|
|
|
23
|
|
|
24 pred<n : {n : ℕ} {f : Fin (suc n)} → n > 0 → Data.Nat.pred (toℕ f) < n
|
|
|
25 pred<n {suc n} {zero} (s≤s z≤n) = s≤s z≤n
|
|
|
26 pred<n {suc n} {suc f} (s≤s z≤n) = fin<n
|
|
|
27
|
|
|
28 fin<asa : {n : ℕ} → toℕ (fromℕ< {n} a<sa) ≡ n
|
|
|
29 fin<asa = toℕ-fromℕ< nat.a<sa
|
|
|
30
|
|
|
31 -- fromℕ<-toℕ
|
|
|
32 toℕ→from : {n : ℕ} {x : Fin (suc n)} → toℕ x ≡ n → fromℕ n ≡ x
|
|
|
33 toℕ→from {0} {zero} refl = refl
|
|
|
34 toℕ→from {suc n} {suc x} eq = cong (λ k → suc k ) ( toℕ→from {n} {x} (cong (λ k → Data.Nat.pred k ) eq ))
|
|
|
35
|
|
|
36 0≤fmax : {n : ℕ } → (# 0) Data.Fin.≤ fromℕ< {n} a<sa
|
|
|
37 0≤fmax = subst (λ k → 0 ≤ k ) (sym (toℕ-fromℕ< a<sa)) z≤n
|
|
|
38
|
|
|
39 0<fmax : {n : ℕ } → (# 0) Data.Fin.< fromℕ< {suc n} a<sa
|
|
|
40 0<fmax = subst (λ k → 0 < k ) (sym (toℕ-fromℕ< a<sa)) (s≤s z≤n)
|
|
|
41
|
|
|
42 -- toℕ-injective
|
|
|
43 i=j : {n : ℕ} (i j : Fin n) → toℕ i ≡ toℕ j → i ≡ j
|
|
|
44 i=j {suc n} zero zero refl = refl
|
|
|
45 i=j {suc n} (suc i) (suc j) eq = cong ( λ k → suc k ) ( i=j i j (cong ( λ k → Data.Nat.pred k ) eq) )
|
|
|
46
|
|
|
47 -- raise 1
|
|
|
48 fin+1 : { n : ℕ } → Fin n → Fin (suc n)
|
|
|
49 fin+1 zero = zero
|
|
|
50 fin+1 (suc x) = suc (fin+1 x)
|
|
|
51
|
|
|
52 open import Data.Nat.Properties as NatP hiding ( _≟_ )
|
|
|
53
|
|
|
54 fin+1≤ : { i n : ℕ } → (a : i < n) → fin+1 (fromℕ< a) ≡ fromℕ< (<-trans a a<sa)
|
|
|
55 fin+1≤ {0} {suc i} (s≤s z≤n) = refl
|
|
|
56 fin+1≤ {suc n} {suc (suc i)} (s≤s (s≤s a)) = cong (λ k → suc k ) ( fin+1≤ {n} {suc i} (s≤s a) )
|
|
|
57
|
|
|
58 fin+1-toℕ : { n : ℕ } → { x : Fin n} → toℕ (fin+1 x) ≡ toℕ x
|
|
|
59 fin+1-toℕ {suc n} {zero} = refl
|
|
|
60 fin+1-toℕ {suc n} {suc x} = cong (λ k → suc k ) (fin+1-toℕ {n} {x})
|
|
|
61
|
|
|
62 open import Relation.Nullary
|
|
|
63 open import Data.Empty
|
|
|
64
|
|
|
65 fin-1 : { n : ℕ } → (x : Fin (suc n)) → ¬ (x ≡ zero ) → Fin n
|
|
|
66 fin-1 zero ne = ⊥-elim (ne refl )
|
|
|
67 fin-1 {n} (suc x) ne = x
|
|
|
68
|
|
|
69 fin-1-sx : { n : ℕ } → (x : Fin n) → fin-1 (suc x) (λ ()) ≡ x
|
|
|
70 fin-1-sx zero = refl
|
|
|
71 fin-1-sx (suc x) = refl
|
|
|
72
|
|
|
73 fin-1-xs : { n : ℕ } → (x : Fin (suc n)) → (ne : ¬ (x ≡ zero )) → suc (fin-1 x ne ) ≡ x
|
|
|
74 fin-1-xs zero ne = ⊥-elim ( ne refl )
|
|
|
75 fin-1-xs (suc x) ne = refl
|
|
|
76
|
|
|
77 -- suc-injective
|
|
|
78 -- suc-eq : {n : ℕ } {x y : Fin n} → Fin.suc x ≡ Fin.suc y → x ≡ y
|
|
|
79 -- suc-eq {n} {x} {y} eq = subst₂ (λ j k → j ≡ k ) {!!} {!!} (cong (λ k → Data.Fin.pred k ) eq )
|
|
|
80
|
|
|
81 -- this is refl
|
|
|
82 lemma3 : {a b : ℕ } → (lt : a < b ) → fromℕ< (s≤s lt) ≡ suc (fromℕ< lt)
|
|
|
83 lemma3 (s≤s lt) = refl
|
|
|
84
|
|
|
85 -- fromℕ<-toℕ
|
|
|
86 lemma12 : {n m : ℕ } → (n<m : n < m ) → (f : Fin m ) → toℕ f ≡ n → f ≡ fromℕ< n<m
|
|
|
87 lemma12 {zero} {suc m} (s≤s z≤n) zero refl = refl
|
|
|
88 lemma12 {suc n} {suc m} (s≤s n<m) (suc f) refl = cong suc ( lemma12 {n} {m} n<m f refl )
|
|
|
89
|
|
|
90 open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ )
|
|
|
91
|
|
|
92 -- <-irrelevant
|
|
|
93 <-nat=irr : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n
|
|
|
94 <-nat=irr {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
|
|
|
95 <-nat=irr {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( <-nat=irr {i} {i} {n} refl )
|
|
|
96
|
|
|
97 lemma8 : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n
|
|
|
98 lemma8 {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
|
|
|
99 lemma8 {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( lemma8 {i} {i} {n} refl )
|
|
|
100
|
|
|
101 -- fromℕ<-irrelevant
|
|
|
102 lemma10 : {n i j : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → fromℕ< i<n ≡ fromℕ< j<n
|
|
|
103 lemma10 {n} refl = HE.≅-to-≡ (HE.cong (λ k → fromℕ< k ) (lemma8 refl ))
|
|
|
104
|
|
|
105 lemma31 : {a b c : ℕ } → { a<b : a < b } { b<c : b < c } { a<c : a < c } → NatP.<-trans a<b b<c ≡ a<c
|
|
|
106 lemma31 {a} {b} {c} {a<b} {b<c} {a<c} = HE.≅-to-≡ (lemma8 refl)
|
|
|
107
|
|
|
108 -- toℕ-fromℕ<
|
|
|
109 lemma11 : {n m : ℕ } {x : Fin n } → (n<m : n < m ) → toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) ≡ toℕ x
|
|
|
110 lemma11 {n} {m} {x} n<m = begin
|
|
|
111 toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m))
|
|
|
112 ≡⟨ toℕ-fromℕ< _ ⟩
|
|
|
113 toℕ x
|
|
|
114 ∎ where
|
|
|
115 open ≡-Reasoning
|
|
|
116
|
|
284
|
117 x<y→fin-1 : {n : ℕ } → { x y : Fin (suc n)} → toℕ x < toℕ y → Fin n
|
|
|
118 x<y→fin-1 {n} {x} {y} lt = fromℕ< (≤-trans lt (fin≤n _ ))
|
|
|
119
|
|
|
120 x<y→fin-1-eq : {n : ℕ } → { x y : Fin (suc n)} → (lt : toℕ x < toℕ y ) → toℕ x ≡ toℕ (x<y→fin-1 lt )
|
|
|
121 x<y→fin-1-eq {n} {x} {y} lt = sym ( begin
|
|
|
122 toℕ (fromℕ< (≤-trans lt (fin≤n y)) ) ≡⟨ toℕ-fromℕ< _ ⟩
|
|
|
123 toℕ x ∎ ) where open ≡-Reasoning
|
|
|
124
|
|
289
|
125 f<→< : {n : ℕ } → { x y : Fin n} → x Data.Fin.< y → toℕ x < toℕ y
|
|
|
126 f<→< {_} {zero} {suc y} (s≤s lt) = s≤s z≤n
|
|
|
127 f<→< {_} {suc x} {suc y} (s≤s lt) = s≤s (f<→< {_} {x} {y} lt)
|
|
|
128
|
|
|
129 f≡→≡ : {n : ℕ } → { x y : Fin n} → x ≡ y → toℕ x ≡ toℕ y
|
|
|
130 f≡→≡ refl = refl
|
|
|
131
|
|
283
|
132 open import Data.List
|
|
|
133 open import Relation.Binary.Definitions
|
|
|
134
|
|
317
|
135 -- fin-count : { n : ℕ } (q : Fin n) (qs : List (Fin n) ) → ℕ
|
|
|
136 -- fin-count q p[ = 0
|
|
|
137 -- fin-count q (q0 ∷ qs ) with <-fcmp q q0
|
|
|
138 -- ... | tri-e = suc (fin-count q qs)
|
|
|
139 -- ... | false = fin-count q qs
|
|
|
140
|
|
|
141 -- fin-not-dup-in-list : { n : ℕ} (qs : List (Fin n) ) → Set
|
|
|
142 -- fin-not-dup-in-list {n} qs = (q : Fin n) → fin-count q ≤ 1
|
|
|
143
|
|
|
144 -- this is far easier
|
|
|
145 -- fin-not-dup-in-list→len<n : { n : ℕ} (qs : List (Fin n) ) → ( (q : Fin n) → fin-not-dup-in-list qs q) → length qs ≤ n
|
|
|
146 -- fin-not-dup-in-list→len<n = ?
|
|
|
147
|
|
283
|
148 fin-phase2 : { n : ℕ } (q : Fin n) (qs : List (Fin n) ) → Bool
|
|
|
149 fin-phase2 q [] = false
|
|
|
150 fin-phase2 q (x ∷ qs) with <-fcmp q x
|
|
|
151 ... | tri< a ¬b ¬c = fin-phase2 q qs
|
|
|
152 ... | tri≈ ¬a b ¬c = true
|
|
|
153 ... | tri> ¬a ¬b c = fin-phase2 q qs
|
|
|
154 fin-phase1 : { n : ℕ } (q : Fin n) (qs : List (Fin n) ) → Bool
|
|
|
155 fin-phase1 q [] = false
|
|
|
156 fin-phase1 q (x ∷ qs) with <-fcmp q x
|
|
|
157 ... | tri< a ¬b ¬c = fin-phase1 q qs
|
|
|
158 ... | tri≈ ¬a b ¬c = fin-phase2 q qs
|
|
|
159 ... | tri> ¬a ¬b c = fin-phase1 q qs
|
|
|
160
|
|
|
161 fin-dup-in-list : { n : ℕ} (q : Fin n) (qs : List (Fin n) ) → Bool
|
|
|
162 fin-dup-in-list {n} q qs = fin-phase1 q qs
|
|
|
163
|
|
|
164 record FDup-in-list (n : ℕ ) (qs : List (Fin n)) : Set where
|
|
|
165 field
|
|
|
166 dup : Fin n
|
|
|
167 is-dup : fin-dup-in-list dup qs ≡ true
|
|
|
168
|
|
|
169 list-less : {n : ℕ } → List (Fin (suc n)) → List (Fin n)
|
|
|
170 list-less [] = []
|
|
288
|
171 list-less {n} (i ∷ ls) with <-fcmp (fromℕ< a<sa) i
|
|
|
172 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ i < suc k ) (sym fin<asa) (fin≤n _ )))
|
|
283
|
173 ... | tri≈ ¬a b ¬c = list-less ls
|
|
288
|
174 ... | tri> ¬a ¬b c = x<y→fin-1 c ∷ list-less ls
|
|
283
|
175
|
|
289
|
176 fin010 : {n m : ℕ } {x : Fin n} (c : suc (toℕ x) ≤ toℕ (fromℕ< {m} a<sa) ) → toℕ (fromℕ< (≤-trans c (fin≤n (fromℕ< a<sa)))) ≡ toℕ x
|
|
|
177 fin010 {_} {_} {x} c = begin
|
|
|
178 toℕ (fromℕ< (≤-trans c (fin≤n (fromℕ< a<sa)))) ≡⟨ toℕ-fromℕ< _ ⟩
|
|
|
179 toℕ x ∎ where open ≡-Reasoning
|
|
|
180
|
|
291
|
181 ---
|
|
|
182 --- if List (Fin n) is longer than n, there is at most one duplication
|
|
|
183 ---
|
|
283
|
184 fin-dup-in-list>n : {n : ℕ } → (qs : List (Fin n)) → (len> : length qs > n ) → FDup-in-list n qs
|
|
|
185 fin-dup-in-list>n {zero} [] ()
|
|
|
186 fin-dup-in-list>n {zero} (() ∷ qs) lt
|
|
|
187 fin-dup-in-list>n {suc n} qs lt = fdup-phase0 where
|
|
284
|
188 open import Level using ( Level )
|
|
294
|
189 -- make a dup from one level below
|
|
292
|
190 fdup+1 : (qs : List (Fin (suc n))) (i : Fin n) → fin-dup-in-list (fromℕ< a<sa ) qs ≡ false
|
|
|
191 → fin-dup-in-list i (list-less qs) ≡ true → FDup-in-list (suc n) qs
|
|
|
192 fdup+1 qs i ne p = record { dup = fin+1 i ; is-dup = f1-phase1 qs p (case1 ne) } where
|
|
294
|
193 -- we have two loops on the max element and the current level. The disjuction means the phases may differ.
|
|
288
|
194 f1-phase2 : (qs : List (Fin (suc n)) ) → fin-phase2 i (list-less qs) ≡ true
|
|
|
195 → (fin-phase1 (fromℕ< a<sa) qs ≡ false ) ∨ (fin-phase2 (fromℕ< a<sa) qs ≡ false)
|
|
|
196 → fin-phase2 (fin+1 i) qs ≡ true
|
|
|
197 f1-phase2 (x ∷ qs) p (case1 q1) with <-fcmp (fromℕ< a<sa) x
|
|
|
198 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ x < suc k ) (sym fin<asa) (fin≤n _ )))
|
|
289
|
199 f1-phase2 (x ∷ qs) p (case1 q1) | tri≈ ¬a b ¬c with <-fcmp (fin+1 i) x
|
|
|
200 ... | tri< a ¬b ¬c₁ = f1-phase2 qs p (case2 q1)
|
|
|
201 ... | tri≈ ¬a₁ b₁ ¬c₁ = refl
|
|
|
202 ... | tri> ¬a₁ ¬b c = f1-phase2 qs p (case2 q1)
|
|
294
|
203 -- two fcmp is only different in the size of Fin, but to develop both f1-phase and list-less both fcmps are required
|
|
288
|
204 f1-phase2 (x ∷ qs) p (case1 q1) | tri> ¬a ¬b c with <-fcmp i (fromℕ< (≤-trans c (fin≤n (fromℕ< a<sa)))) | <-fcmp (fin+1 i) x
|
|
|
205 ... | tri< a ¬b₁ ¬c | tri< a₁ ¬b₂ ¬c₁ = f1-phase2 qs p (case1 q1)
|
|
289
|
206 ... | tri< a ¬b₁ ¬c | tri≈ ¬a₁ b ¬c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) (sym fin+1-toℕ) (toℕ-fromℕ< _) a ))
|
|
|
207 ... | tri< a ¬b₁ ¬c | tri> ¬a₁ ¬b₂ c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) (sym fin+1-toℕ) (toℕ-fromℕ< _) a ))
|
|
|
208 ... | tri≈ ¬a₁ b ¬c | tri< a ¬b₁ ¬c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) fin+1-toℕ (sym (toℕ-fromℕ< _)) a ))
|
|
288
|
209 ... | tri≈ ¬a₁ b ¬c | tri≈ ¬a₂ b₁ ¬c₁ = refl
|
|
289
|
210 ... | tri≈ ¬a₁ b ¬c | tri> ¬a₂ ¬b₁ c₁ = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) fin+1-toℕ (sym (toℕ-fromℕ< _)) c₁ ))
|
|
|
211 ... | tri> ¬a₁ ¬b₁ c₁ | tri< a ¬b₂ ¬c = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) (sym fin+1-toℕ) (toℕ-fromℕ< _) c₁ ))
|
|
|
212 ... | tri> ¬a₁ ¬b₁ c₁ | tri≈ ¬a₂ b ¬c = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) (sym fin+1-toℕ) (toℕ-fromℕ< _) c₁ ))
|
|
288
|
213 ... | tri> ¬a₁ ¬b₁ c₁ | tri> ¬a₂ ¬b₂ c₂ = f1-phase2 qs p (case1 q1)
|
|
289
|
214 f1-phase2 (x ∷ qs) p (case2 q1) with <-fcmp (fromℕ< a<sa) x
|
|
|
215 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ x < suc k ) (sym fin<asa) (fin≤n _ )))
|
|
|
216 f1-phase2 (x ∷ qs) p (case2 q1) | tri≈ ¬a b ¬c with <-fcmp (fin+1 i) x
|
|
|
217 ... | tri< a ¬b ¬c₁ = ⊥-elim ( ¬-bool q1 refl )
|
|
|
218 ... | tri≈ ¬a₁ b₁ ¬c₁ = refl
|
|
|
219 ... | tri> ¬a₁ ¬b c = ⊥-elim ( ¬-bool q1 refl )
|
|
|
220 f1-phase2 (x ∷ qs) p (case2 q1) | tri> ¬a ¬b c with <-fcmp i (fromℕ< (≤-trans c (fin≤n (fromℕ< a<sa)))) | <-fcmp (fin+1 i) x
|
|
|
221 ... | tri< a ¬b₁ ¬c | tri< a₁ ¬b₂ ¬c₁ = f1-phase2 qs p (case2 q1)
|
|
|
222 ... | tri< a ¬b₁ ¬c | tri≈ ¬a₁ b ¬c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) (sym fin+1-toℕ) (toℕ-fromℕ< _) a ))
|
|
|
223 ... | tri< a ¬b₁ ¬c | tri> ¬a₁ ¬b₂ c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) (sym fin+1-toℕ) (toℕ-fromℕ< _) a ))
|
|
|
224 ... | tri≈ ¬a₁ b ¬c | tri< a ¬b₁ ¬c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) fin+1-toℕ (sym (toℕ-fromℕ< _)) a ))
|
|
|
225 ... | tri≈ ¬a₁ b ¬c | tri≈ ¬a₂ b₁ ¬c₁ = refl
|
|
|
226 ... | tri≈ ¬a₁ b ¬c | tri> ¬a₂ ¬b₁ c₁ = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) fin+1-toℕ (sym (toℕ-fromℕ< _)) c₁ ))
|
|
|
227 ... | tri> ¬a₁ ¬b₁ c₁ | tri< a ¬b₂ ¬c = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) (sym fin+1-toℕ) (toℕ-fromℕ< _) c₁ ))
|
|
|
228 ... | tri> ¬a₁ ¬b₁ c₁ | tri≈ ¬a₂ b ¬c = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) (sym fin+1-toℕ) (toℕ-fromℕ< _) c₁ ))
|
|
|
229 ... | tri> ¬a₁ ¬b₁ c₁ | tri> ¬a₂ ¬b₂ c₂ = f1-phase2 qs p (case2 q1 )
|
|
288
|
230 f1-phase1 : (qs : List (Fin (suc n)) ) → fin-phase1 i (list-less qs) ≡ true
|
|
|
231 → (fin-phase1 (fromℕ< a<sa) qs ≡ false ) ∨ (fin-phase2 (fromℕ< a<sa) qs ≡ false)
|
|
|
232 → fin-phase1 (fin+1 i) qs ≡ true
|
|
290
|
233 f1-phase1 (x ∷ qs) p (case1 q1) with <-fcmp (fromℕ< a<sa) x
|
|
|
234 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ x < suc k ) (sym fin<asa) (fin≤n _ )))
|
|
|
235 f1-phase1 (x ∷ qs) p (case1 q1) | tri≈ ¬a b ¬c with <-fcmp (fin+1 i) x
|
|
|
236 ... | tri< a ¬b ¬c₁ = f1-phase1 qs p (case2 q1)
|
|
291
|
237 ... | tri≈ ¬a₁ b₁ ¬c₁ = ⊥-elim (fdup-10 b b₁) where
|
|
|
238 fdup-10 : fromℕ< a<sa ≡ x → fin+1 i ≡ x → ⊥
|
|
|
239 fdup-10 eq eq1 = nat-≡< (cong toℕ (trans eq1 (sym eq))) (subst₂ (λ j k → j < k ) (sym fin+1-toℕ) (sym fin<asa) fin<n )
|
|
290
|
240 ... | tri> ¬a₁ ¬b c = f1-phase1 qs p (case2 q1)
|
|
|
241 f1-phase1 (x ∷ qs) p (case1 q1) | tri> ¬a ¬b c with <-fcmp i (fromℕ< (≤-trans c (fin≤n (fromℕ< a<sa)))) | <-fcmp (fin+1 i) x
|
|
|
242 ... | tri< a ¬b₁ ¬c | tri< a₁ ¬b₂ ¬c₁ = f1-phase1 qs p (case1 q1)
|
|
|
243 ... | tri< a ¬b₁ ¬c | tri≈ ¬a₁ b ¬c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) (sym fin+1-toℕ) (toℕ-fromℕ< _) a ))
|
|
|
244 ... | tri< a ¬b₁ ¬c | tri> ¬a₁ ¬b₂ c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) (sym fin+1-toℕ) (toℕ-fromℕ< _) a ))
|
|
|
245 ... | tri≈ ¬a₁ b ¬c | tri< a ¬b₁ ¬c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) fin+1-toℕ (sym (toℕ-fromℕ< _)) a ))
|
|
|
246 ... | tri≈ ¬a₁ b ¬c | tri≈ ¬a₂ b₁ ¬c₁ = f1-phase2 qs p (case1 q1)
|
|
|
247 ... | tri≈ ¬a₁ b ¬c | tri> ¬a₂ ¬b₁ c₁ = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) fin+1-toℕ (sym (toℕ-fromℕ< _)) c₁ ))
|
|
|
248 ... | tri> ¬a₁ ¬b₁ c₁ | tri< a ¬b₂ ¬c = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) (sym fin+1-toℕ) (toℕ-fromℕ< _) c₁ ))
|
|
|
249 ... | tri> ¬a₁ ¬b₁ c₁ | tri≈ ¬a₂ b ¬c = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) (sym fin+1-toℕ) (toℕ-fromℕ< _) c₁ ))
|
|
|
250 ... | tri> ¬a₁ ¬b₁ c₁ | tri> ¬a₂ ¬b₂ c₂ = f1-phase1 qs p (case1 q1)
|
|
|
251 f1-phase1 (x ∷ qs) p (case2 q1) with <-fcmp (fromℕ< a<sa) x
|
|
|
252 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ x < suc k ) (sym fin<asa) (fin≤n _ )))
|
|
|
253 f1-phase1 (x ∷ qs) p (case2 q1) | tri≈ ¬a b ¬c = ⊥-elim ( ¬-bool q1 refl )
|
|
|
254 f1-phase1 (x ∷ qs) p (case2 q1) | tri> ¬a ¬b c with <-fcmp i (fromℕ< (≤-trans c (fin≤n (fromℕ< a<sa)))) | <-fcmp (fin+1 i) x
|
|
|
255 ... | tri< a ¬b₁ ¬c | tri< a₁ ¬b₂ ¬c₁ = f1-phase1 qs p (case2 q1)
|
|
|
256 ... | tri< a ¬b₁ ¬c | tri≈ ¬a₁ b ¬c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) (sym fin+1-toℕ) (toℕ-fromℕ< _) a ))
|
|
|
257 ... | tri< a ¬b₁ ¬c | tri> ¬a₁ ¬b₂ c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) (sym fin+1-toℕ) (toℕ-fromℕ< _) a ))
|
|
|
258 ... | tri≈ ¬a₁ b ¬c | tri< a ¬b₁ ¬c₁ = ⊥-elim ( ¬a₁ (subst₂ (λ j k → j < k) fin+1-toℕ (sym (toℕ-fromℕ< _)) a ))
|
|
|
259 ... | tri≈ ¬a₁ b ¬c | tri≈ ¬a₂ b₁ ¬c₁ = f1-phase2 qs p (case2 q1)
|
|
|
260 ... | tri≈ ¬a₁ b ¬c | tri> ¬a₂ ¬b₁ c₁ = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) fin+1-toℕ (sym (toℕ-fromℕ< _)) c₁ ))
|
|
|
261 ... | tri> ¬a₁ ¬b₁ c₁ | tri< a ¬b₂ ¬c = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) (sym fin+1-toℕ) (toℕ-fromℕ< _) c₁ ))
|
|
|
262 ... | tri> ¬a₁ ¬b₁ c₁ | tri≈ ¬a₂ b ¬c = ⊥-elim ( ¬c (subst₂ (λ j k → j > k) (sym fin+1-toℕ) (toℕ-fromℕ< _) c₁ ))
|
|
|
263 ... | tri> ¬a₁ ¬b₁ c₁ | tri> ¬a₂ ¬b₂ c₂ = f1-phase1 qs p (case2 q1)
|
|
283
|
264 fdup-phase0 : FDup-in-list (suc n) qs
|
|
292
|
265 fdup-phase0 with fin-dup-in-list (fromℕ< a<sa) qs | inspect (fin-dup-in-list (fromℕ< a<sa)) qs
|
|
|
266 ... | true | record { eq = eq } = record { dup = fromℕ< a<sa ; is-dup = eq }
|
|
|
267 ... | false | record { eq = ne } = fdup+1 qs (FDup-in-list.dup fdup) ne (FDup-in-list.is-dup fdup) where
|
|
294
|
268 -- if no dup in the max element, the list without the element is only one length shorter
|
|
292
|
269 fless : (qs : List (Fin (suc n))) → length qs > suc n → fin-dup-in-list (fromℕ< a<sa) qs ≡ false → n < length (list-less qs)
|
|
|
270 fless qs lt p = fl-phase1 n qs lt p where
|
|
293
|
271 fl-phase2 : (n1 : ℕ) (qs : List (Fin (suc n))) → length qs > n1 → fin-phase2 (fromℕ< a<sa) qs ≡ false → n1 < length (list-less qs)
|
|
292
|
272 fl-phase2 zero (x ∷ qs) (s≤s lt) p with <-fcmp (fromℕ< a<sa) x
|
|
293
|
273 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ x < suc k ) (sym fin<asa) (fin≤n _ )))
|
|
|
274 ... | tri> ¬a ¬b c = s≤s z≤n
|
|
292
|
275 fl-phase2 (suc n1) (x ∷ qs) (s≤s lt) p with <-fcmp (fromℕ< a<sa) x
|
|
293
|
276 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ x < suc k ) (sym fin<asa) (fin≤n _ )))
|
|
|
277 ... | tri> ¬a ¬b c = s≤s ( fl-phase2 n1 qs lt p )
|
|
292
|
278 fl-phase1 : (n1 : ℕ) (qs : List (Fin (suc n))) → length qs > suc n1 → fin-phase1 (fromℕ< a<sa) qs ≡ false → n1 < length (list-less qs)
|
|
|
279 fl-phase1 zero (x ∷ qs) (s≤s lt) p with <-fcmp (fromℕ< a<sa) x
|
|
|
280 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ x < suc k ) (sym fin<asa) (fin≤n _ )))
|
|
293
|
281 ... | tri≈ ¬a b ¬c = fl-phase2 0 qs lt p
|
|
292
|
282 ... | tri> ¬a ¬b c = s≤s z≤n
|
|
|
283 fl-phase1 (suc n1) (x ∷ qs) (s≤s lt) p with <-fcmp (fromℕ< a<sa) x
|
|
|
284 ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ x < suc k ) (sym fin<asa) (fin≤n _ )))
|
|
293
|
285 ... | tri≈ ¬a b ¬c = fl-phase2 (suc n1) qs lt p
|
|
292
|
286 ... | tri> ¬a ¬b c = s≤s ( fl-phase1 n1 qs lt p )
|
|
294
|
287 -- if the list without the max element is only one length shorter, we can recurse
|
|
283
|
288 fdup : FDup-in-list n (list-less qs)
|
|
292
|
289 fdup = fin-dup-in-list>n (list-less qs) (fless qs lt ne)
|
