|
72
|
1 {-# OPTIONS --allow-unsolved-metas #-}
|
|
|
2
|
|
|
3 module fin where
|
|
|
4
|
|
83
|
5 open import Data.Fin hiding (_<_ ; _≤_ )
|
|
72
|
6 open import Data.Nat
|
|
|
7 open import logic
|
|
|
8 open import nat
|
|
|
9 open import Relation.Binary.PropositionalEquality
|
|
|
10
|
|
|
11
|
|
|
12 n≤n : (n : ℕ) → n Data.Nat.≤ n
|
|
|
13 n≤n zero = z≤n
|
|
|
14 n≤n (suc n) = s≤s (n≤n n)
|
|
|
15
|
|
|
16 <→m≤n : {m n : ℕ} → m < n → m Data.Nat.≤ n
|
|
|
17 <→m≤n {zero} lt = z≤n
|
|
|
18 <→m≤n {suc m} {zero} ()
|
|
|
19 <→m≤n {suc m} {suc n} (s≤s lt) = s≤s (<→m≤n lt)
|
|
|
20
|
|
91
|
21 -- toℕ<n
|
|
72
|
22 fin<n : {n : ℕ} {f : Fin n} → toℕ f < n
|
|
|
23 fin<n {_} {zero} = s≤s z≤n
|
|
|
24 fin<n {suc n} {suc f} = s≤s (fin<n {n} {f})
|
|
|
25
|
|
91
|
26 -- toℕ≤n
|
|
83
|
27 fin≤n : {n : ℕ} (f : Fin (suc n)) → toℕ f ≤ n
|
|
|
28 fin≤n {_} zero = z≤n
|
|
|
29 fin≤n {suc n} (suc f) = s≤s (fin≤n {n} f)
|
|
|
30
|
|
72
|
31 pred<n : {n : ℕ} {f : Fin (suc n)} → n > 0 → Data.Nat.pred (toℕ f) < n
|
|
|
32 pred<n {suc n} {zero} (s≤s z≤n) = s≤s z≤n
|
|
|
33 pred<n {suc n} {suc f} (s≤s z≤n) = fin<n
|
|
|
34
|
|
91
|
35 -- fromℕ<-toℕ
|
|
72
|
36 toℕ→from : {n : ℕ} {x : Fin (suc n)} → toℕ x ≡ n → fromℕ n ≡ x
|
|
|
37 toℕ→from {0} {zero} refl = refl
|
|
|
38 toℕ→from {suc n} {suc x} eq = cong (λ k → suc k ) ( toℕ→from {n} {x} (cong (λ k → Data.Nat.pred k ) eq ))
|
|
|
39
|
|
91
|
40 -- toℕ-injective
|
|
72
|
41 i=j : {n : ℕ} (i j : Fin n) → toℕ i ≡ toℕ j → i ≡ j
|
|
|
42 i=j {suc n} zero zero refl = refl
|
|
|
43 i=j {suc n} (suc i) (suc j) eq = cong ( λ k → suc k ) ( i=j i j (cong ( λ k → Data.Nat.pred k ) eq) )
|
|
|
44
|
|
91
|
45 -- raise 1
|
|
72
|
46 fin+1 : { n : ℕ } → Fin n → Fin (suc n)
|
|
|
47 fin+1 zero = zero
|
|
|
48 fin+1 (suc x) = suc (fin+1 x)
|
|
|
49
|
|
|
50 open import Data.Nat.Properties as NatP hiding ( _≟_ )
|
|
|
51
|
|
74
|
52 fin+1≤ : { i n : ℕ } → (a : i < n) → fin+1 (fromℕ< a) ≡ fromℕ< (<-trans a a<sa)
|
|
72
|
53 fin+1≤ {0} {suc i} (s≤s z≤n) = refl
|
|
|
54 fin+1≤ {suc n} {suc (suc i)} (s≤s (s≤s a)) = cong (λ k → suc k ) ( fin+1≤ {n} {suc i} (s≤s a) )
|
|
|
55
|
|
|
56 fin+1-toℕ : { n : ℕ } → { x : Fin n} → toℕ (fin+1 x) ≡ toℕ x
|
|
|
57 fin+1-toℕ {suc n} {zero} = refl
|
|
|
58 fin+1-toℕ {suc n} {suc x} = cong (λ k → suc k ) (fin+1-toℕ {n} {x})
|
|
|
59
|
|
|
60 open import Relation.Nullary
|
|
|
61 open import Data.Empty
|
|
|
62
|
|
|
63 fin-1 : { n : ℕ } → (x : Fin (suc n)) → ¬ (x ≡ zero ) → Fin n
|
|
|
64 fin-1 zero ne = ⊥-elim (ne refl )
|
|
|
65 fin-1 {n} (suc x) ne = x
|
|
|
66
|
|
|
67 fin-1-sx : { n : ℕ } → (x : Fin n) → fin-1 (suc x) (λ ()) ≡ x
|
|
|
68 fin-1-sx zero = refl
|
|
|
69 fin-1-sx (suc x) = refl
|
|
|
70
|
|
|
71 fin-1-xs : { n : ℕ } → (x : Fin (suc n)) → (ne : ¬ (x ≡ zero )) → suc (fin-1 x ne ) ≡ x
|
|
|
72 fin-1-xs zero ne = ⊥-elim ( ne refl )
|
|
|
73 fin-1-xs (suc x) ne = refl
|
|
|
74
|
|
91
|
75 -- suc-injective
|
|
72
|
76 -- suc-eq : {n : ℕ } {x y : Fin n} → Fin.suc x ≡ Fin.suc y → x ≡ y
|
|
|
77 -- suc-eq {n} {x} {y} eq = subst₂ (λ j k → j ≡ k ) {!!} {!!} (cong (λ k → Data.Fin.pred k ) eq )
|
|
|
78
|
|
91
|
79 -- this is refl
|
|
74
|
80 lemma3 : {a b : ℕ } → (lt : a < b ) → fromℕ< (s≤s lt) ≡ suc (fromℕ< lt)
|
|
72
|
81 lemma3 (s≤s lt) = refl
|
|
91
|
82
|
|
|
83 -- fromℕ<-toℕ
|
|
74
|
84 lemma12 : {n m : ℕ } → (n<m : n < m ) → (f : Fin m ) → toℕ f ≡ n → f ≡ fromℕ< n<m
|
|
72
|
85 lemma12 {zero} {suc m} (s≤s z≤n) zero refl = refl
|
|
91
|
86 lemma12 {suc n} {suc m} (s≤s n<m) (suc f) refl = cong suc ( lemma12 {n} {m} n<m f refl )
|
|
72
|
87
|
|
|
88 open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ )
|
|
|
89 open import Data.Fin.Properties
|
|
|
90
|
|
91
|
91 -- <-irrelevant
|
|
|
92 <-nat=irr : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n
|
|
|
93 <-nat=irr {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
|
|
|
94 <-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 )
|
|
|
95
|
|
72
|
96 lemma8 : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n
|
|
|
97 lemma8 {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
|
|
|
98 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 )
|
|
91
|
99
|
|
|
100 -- fromℕ<-irrelevant
|
|
74
|
101 lemma10 : {n i j : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → fromℕ< i<n ≡ fromℕ< j<n
|
|
|
102 lemma10 {n} refl = HE.≅-to-≡ (HE.cong (λ k → fromℕ< k ) (lemma8 refl ))
|
|
91
|
103
|
|
72
|
104 lemma31 : {a b c : ℕ } → { a<b : a < b } { b<c : b < c } { a<c : a < c } → NatP.<-trans a<b b<c ≡ a<c
|
|
|
105 lemma31 {a} {b} {c} {a<b} {b<c} {a<c} = HE.≅-to-≡ (lemma8 refl)
|
|
91
|
106
|
|
|
107 -- toℕ-fromℕ<
|
|
74
|
108 lemma11 : {n m : ℕ } {x : Fin n } → (n<m : n < m ) → toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) ≡ toℕ x
|
|
72
|
109 lemma11 {n} {m} {x} n<m = begin
|
|
74
|
110 toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m))
|
|
|
111 ≡⟨ toℕ-fromℕ< _ ⟩
|
|
72
|
112 toℕ x
|
|
|
113 ∎ where
|
|
|
114 open ≡-Reasoning
|
|
|
115
|
|
|
116
|
