~ubuntu-branches/ubuntu/raring/agda-stdlib/raring

« back to all changes in this revision

Viewing changes to src/Data/Fin/Props.agda

  • Committer: Package Import Robot
  • Author(s): Iain Lane
  • Date: 2013-04-10 10:30:20 UTC
  • mfrom: (2.1.7 experimental)
  • Revision ID: package-import@ubuntu.com-20130410103020-bcspfz3whyy5iafu
Tags: 0.7-1
* [6d52289] Imported Upstream version 0.7
* [54104d0] Update Depends and Build-Depends for this version, compatible
  with Agda 2.3.2
* [b3ddce4] No need for the .install file to be executable (thanks lintian)
* [a9a6cb7] Standards-Version → 3.9.4, no changes required

Show diffs side-by-side

added added

removed removed

Lines of Context:
7
7
 
8
8
module Data.Fin.Props where
9
9
 
 
10
open import Algebra
10
11
open import Data.Fin
11
12
open import Data.Nat as N
12
 
  using (ℕ; zero; suc; s≤s; z≤n)
 
13
  using (ℕ; zero; suc; s≤s; z≤n; _∸_)
13
14
  renaming (_≤_ to _ℕ≤_; _<_ to _ℕ<_; _+_ to _ℕ+_)
14
 
open N.≤-Reasoning
15
15
import Data.Nat.Properties as N
 
16
open import Data.Product
16
17
open import Function
17
18
open import Function.Equality as FunS using (_⟨$⟩_)
18
19
open import Function.Injection
19
20
  using (Injection; module Injection)
 
21
open import Algebra.FunctionProperties
20
22
open import Relation.Nullary
21
23
open import Relation.Binary
22
 
open import Relation.Binary.PropositionalEquality as PropEq
 
24
open import Relation.Binary.PropositionalEquality as P
23
25
  using (_≡_; refl; cong; subst)
24
26
open import Category.Functor
25
27
open import Category.Applicative
28
30
-- Properties
29
31
 
30
32
private
31
 
  drop-suc : ∀ {o} {m n : Fin o} →
32
 
             suc m ≡ (suc n ∶ Fin (suc o)) → m ≡ n
 
33
  drop-suc : ∀ {o} {m n : Fin o} → Fin.suc m ≡ suc n → m ≡ n
33
34
  drop-suc refl = refl
34
35
 
35
36
preorder : ℕ → Preorder _ _ _
36
 
preorder n = PropEq.preorder (Fin n)
 
37
preorder n = P.preorder (Fin n)
37
38
 
38
39
setoid : ℕ → Setoid _ _
39
 
setoid n = PropEq.setoid (Fin n)
 
40
setoid n = P.setoid (Fin n)
40
41
 
41
42
strictTotalOrder : ℕ → StrictTotalOrder _ _ _
42
43
strictTotalOrder n = record
44
45
  ; _≈_                = _≡_
45
46
  ; _<_                = _<_
46
47
  ; isStrictTotalOrder = record
47
 
    { isEquivalence = PropEq.isEquivalence
 
48
    { isEquivalence = P.isEquivalence
48
49
    ; trans         = N.<-trans
49
50
    ; compare       = cmp
50
 
    ; <-resp-≈      = PropEq.resp₂ _<_
 
51
    ; <-resp-≈      = P.resp₂ _<_
51
52
    }
52
53
  }
53
54
  where
72
73
to-from zero    = refl
73
74
to-from (suc n) = cong suc (to-from n)
74
75
 
 
76
toℕ-injective : ∀ {n} {i j : Fin n} → toℕ i ≡ toℕ j → i ≡ j
 
77
toℕ-injective {zero}  {}      {}      _
 
78
toℕ-injective {suc n} {zero}  {zero}  eq = refl
 
79
toℕ-injective {suc n} {zero}  {suc j} ()
 
80
toℕ-injective {suc n} {suc i} {zero}  ()
 
81
toℕ-injective {suc n} {suc i} {suc j} eq =
 
82
  cong suc (toℕ-injective (cong N.pred eq))
 
83
 
75
84
bounded : ∀ {n} (i : Fin n) → toℕ i ℕ< n
76
85
bounded zero    = s≤s z≤n
77
86
bounded (suc i) = s≤s (bounded i)
83
92
 
84
93
nℕ-ℕi≤n : ∀ n i → n ℕ-ℕ i ℕ≤ n
85
94
nℕ-ℕi≤n n       zero     = begin n ∎
 
95
  where open N.≤-Reasoning
86
96
nℕ-ℕi≤n zero    (suc ())
87
97
nℕ-ℕi≤n (suc n) (suc i)  = begin
88
98
  n ℕ-ℕ i ≤⟨ nℕ-ℕi≤n n i ⟩
89
99
  n       ≤⟨ N.n≤1+n n ⟩
90
100
  suc n   ∎
 
101
  where open N.≤-Reasoning
91
102
 
92
103
inject-lemma : ∀ {n} {i : Fin n} (j : Fin′ i) →
93
104
               toℕ (inject j) ≡ toℕ j
145
156
reverse {zero}  ()
146
157
reverse {suc n} i  = inject≤ (n ℕ- i) (N.n∸m≤n (toℕ i) (suc n))
147
158
 
 
159
reverse-prop : ∀ {n} → (i : Fin n) → toℕ (reverse i) ≡ n ∸ suc (toℕ i)
 
160
reverse-prop {zero} ()
 
161
reverse-prop {suc n} i = begin
 
162
  toℕ (inject≤ (n ℕ- i) _)  ≡⟨ inject≤-lemma _ _ ⟩
 
163
  toℕ (n ℕ- i)              ≡⟨ toℕ‿ℕ- n i ⟩
 
164
  n ∸ toℕ i                 ∎
 
165
  where
 
166
  open P.≡-Reasoning
 
167
 
 
168
  toℕ‿ℕ- : ∀ n i → toℕ (n ℕ- i) ≡ n ∸ toℕ i
 
169
  toℕ‿ℕ- n       zero     = to-from n
 
170
  toℕ‿ℕ- zero    (suc ())
 
171
  toℕ‿ℕ- (suc n) (suc i)  = toℕ‿ℕ- n i
 
172
 
 
173
reverse-involutive : ∀ {n} → Involutive _≡_ reverse
 
174
reverse-involutive {n} i = toℕ-injective (begin
 
175
  toℕ (reverse (reverse i))  ≡⟨ reverse-prop _ ⟩
 
176
  n ∸ suc (toℕ (reverse i))  ≡⟨ eq ⟩
 
177
  toℕ i                      ∎)
 
178
  where
 
179
  open P.≡-Reasoning
 
180
  open CommutativeSemiring N.commutativeSemiring using (+-comm)
 
181
 
 
182
  lem₁ : ∀ m n → (m ℕ+ n) ∸ (m ℕ+ n ∸ m) ≡ m
 
183
  lem₁ m n = begin
 
184
    m ℕ+ n ∸ (m ℕ+ n ∸ m) ≡⟨ cong (λ ξ → m ℕ+ n ∸ (ξ ∸ m)) (+-comm m n) ⟩
 
185
    m ℕ+ n ∸ (n ℕ+ m ∸ m) ≡⟨ cong (λ ξ → m ℕ+ n ∸ ξ) (N.m+n∸n≡m n m) ⟩
 
186
    m ℕ+ n ∸ n            ≡⟨ N.m+n∸n≡m m n ⟩
 
187
    m                     ∎
 
188
 
 
189
  lem₂ : ∀ n → (i : Fin n) → n ∸ suc (n ∸ suc (toℕ i)) ≡ toℕ i
 
190
  lem₂ zero    ()
 
191
  lem₂ (suc n) i  = begin
 
192
    n ∸ (n ∸ toℕ i)                     ≡⟨ cong (λ ξ → ξ ∸ (ξ ∸ toℕ i)) i+j≡k ⟩
 
193
    (toℕ i ℕ+ j) ∸ (toℕ i ℕ+ j ∸ toℕ i) ≡⟨ lem₁ (toℕ i) j ⟩
 
194
    toℕ i                               ∎
 
195
    where
 
196
    decompose-n : ∃ λ j → n ≡ toℕ i ℕ+ j
 
197
    decompose-n = n ∸ toℕ i , P.sym (N.m+n∸m≡n (prop-toℕ-≤ i))
 
198
 
 
199
    j     = proj₁ decompose-n
 
200
    i+j≡k = proj₂ decompose-n
 
201
 
 
202
  eq : n ∸ suc (toℕ (reverse i)) ≡ toℕ i
 
203
  eq = begin
 
204
    n ∸ suc (toℕ (reverse i)) ≡⟨ cong (λ ξ → n ∸ suc ξ) (reverse-prop i) ⟩
 
205
    n ∸ suc (n ∸ suc (toℕ i)) ≡⟨ lem₂ n i ⟩
 
206
    toℕ i                     ∎
 
207
 
148
208
-- If there is an injection from a set to a finite set, then equality
149
209
-- of the set can be decided.
150
210
 
151
211
eq? : ∀ {s₁ s₂ n} {S : Setoid s₁ s₂} →
152
 
      Injection S (PropEq.setoid (Fin n)) → Decidable (Setoid._≈_ S)
 
212
      Injection S (P.setoid (Fin n)) → Decidable (Setoid._≈_ S)
153
213
eq? inj x y with to ⟨$⟩ x ≟ to ⟨$⟩ y where open Injection inj
154
214
... | yes tox≡toy = yes (Injection.injective inj tox≡toy)
155
215
... | no  tox≢toy = no  (tox≢toy ∘ FunS.cong (Injection.to inj))