~ubuntu-branches/ubuntu/utopic/agda-stdlib/utopic-proposed

« back to all changes in this revision

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

  • Committer: Package Import Robot
  • Author(s): Iain Lane
  • Date: 2014-08-05 09:46:46 UTC
  • mfrom: (1.1.6)
  • Revision ID: package-import@ubuntu.com-20140805094646-zqd0c4m8ndngqg6x
Tags: 0.8-1
* [4ca6fd0] Update debian/watch to fetch tarballs from github
* [84d4313] Imported Upstream version 0.8
* [7b08243] debian/control: Require agda 2.4.x per upstream
* [37e7e10] debian/control: Standards-Version → 3.9.5, no changes required.
* [9051b9d] Run upstream's "GenerateEverything" script

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
------------------------------------------------------------------------
2
2
-- The Agda standard library
3
3
--
 
4
-- Compatibility module. Pending for removal. Use
 
5
-- Data.Fin.Subset.Properties instead.
4
6
------------------------------------------------------------------------
5
7
 
6
8
module Data.Fin.Subset.Props where
7
9
 
8
 
open import Algebra
9
 
import Algebra.Props.BooleanAlgebra as BoolProp
10
 
open import Data.Empty using (⊥-elim)
11
 
open import Data.Fin using (Fin); open Data.Fin.Fin
12
 
open import Data.Fin.Subset
13
 
open import Data.Nat using (ℕ)
14
 
open import Data.Product
15
 
open import Data.Sum as Sum
16
 
open import Data.Vec hiding (_∈_)
17
 
open import Function
18
 
open import Function.Equality using (_⟨$⟩_)
19
 
open import Function.Equivalence
20
 
  using (_⇔_; equivalence; module Equivalence)
21
 
open import Relation.Binary
22
 
open import Relation.Binary.PropositionalEquality as P using (_≡_)
23
 
 
24
 
------------------------------------------------------------------------
25
 
 
26
 
drop-there : ∀ {s n x} {p : Subset n} → suc x ∈ s ∷ p → x ∈ p
27
 
drop-there (there x∈p) = x∈p
28
 
 
29
 
drop-∷-⊆ : ∀ {n s₁ s₂} {p₁ p₂ : Subset n} → s₁ ∷ p₁ ⊆ s₂ ∷ p₂ → p₁ ⊆ p₂
30
 
drop-∷-⊆ p₁s₁⊆p₂s₂ x∈p₁ = drop-there $ p₁s₁⊆p₂s₂ (there x∈p₁)
31
 
 
32
 
drop-∷-Empty : ∀ {n s} {p : Subset n} → Empty (s ∷ p) → Empty p
33
 
drop-∷-Empty ¬∃∈ (x , x∈p) = ¬∃∈ (suc x , there x∈p)
34
 
 
35
 
------------------------------------------------------------------------
36
 
 
37
 
∉⊥ : ∀ {n} {x : Fin n} → x ∉ ⊥
38
 
∉⊥ (there p) = ∉⊥ p
39
 
 
40
 
⊥⊆ : ∀ {n} {p : Subset n} → ⊥ ⊆ p
41
 
⊥⊆ x∈⊥ with ∉⊥ x∈⊥
42
 
... | ()
43
 
 
44
 
Empty-unique : ∀ {n} {p : Subset n} →
45
 
               Empty p → p ≡ ⊥
46
 
Empty-unique {p = []}           ¬∃∈ = P.refl
47
 
Empty-unique {p = s ∷ p}        ¬∃∈ with Empty-unique (drop-∷-Empty ¬∃∈)
48
 
Empty-unique {p = outside ∷ .⊥} ¬∃∈ | P.refl = P.refl
49
 
Empty-unique {p = inside  ∷ .⊥} ¬∃∈ | P.refl =
50
 
  ⊥-elim (¬∃∈ (zero , here))
51
 
 
52
 
------------------------------------------------------------------------
53
 
 
54
 
∈⊤ : ∀ {n} {x : Fin n} → x ∈ ⊤
55
 
∈⊤ {x = zero}  = here
56
 
∈⊤ {x = suc x} = there ∈⊤
57
 
 
58
 
⊆⊤ : ∀ {n} {p : Subset n} → p ⊆ ⊤
59
 
⊆⊤ = const ∈⊤
60
 
 
61
 
------------------------------------------------------------------------
62
 
 
63
 
x∈⁅y⁆⇔x≡y : ∀ {n} {x y : Fin n} → x ∈ ⁅ y ⁆ ⇔ x ≡ y
64
 
x∈⁅y⁆⇔x≡y {x = x} {y} =
65
 
  equivalence (to y) (λ x≡y → P.subst (λ y → x ∈ ⁅ y ⁆) x≡y (x∈⁅x⁆ x))
66
 
  where
67
 
 
68
 
  to : ∀ {n x} (y : Fin n) → x ∈ ⁅ y ⁆ → x ≡ y
69
 
  to (suc y) (there p) = P.cong suc (to y p)
70
 
  to zero    here      = P.refl
71
 
  to zero    (there p) with ∉⊥ p
72
 
  ... | ()
73
 
 
74
 
  x∈⁅x⁆ : ∀ {n} (x : Fin n) → x ∈ ⁅ x ⁆
75
 
  x∈⁅x⁆ zero    = here
76
 
  x∈⁅x⁆ (suc x) = there (x∈⁅x⁆ x)
77
 
 
78
 
------------------------------------------------------------------------
79
 
 
80
 
∪⇔⊎ : ∀ {n} {p₁ p₂ : Subset n} {x} → x ∈ p₁ ∪ p₂ ⇔ (x ∈ p₁ ⊎ x ∈ p₂)
81
 
∪⇔⊎ = equivalence (to _ _) from
82
 
  where
83
 
  to : ∀ {n} (p₁ p₂ : Subset n) {x} → x ∈ p₁ ∪ p₂ → x ∈ p₁ ⊎ x ∈ p₂
84
 
  to []             []             ()
85
 
  to (inside  ∷ p₁) (s₂      ∷ p₂) here            = inj₁ here
86
 
  to (outside ∷ p₁) (inside  ∷ p₂) here            = inj₂ here
87
 
  to (s₁      ∷ p₁) (s₂      ∷ p₂) (there x∈p₁∪p₂) =
88
 
    Sum.map there there (to p₁ p₂ x∈p₁∪p₂)
89
 
 
90
 
  ⊆∪ˡ : ∀ {n p₁} (p₂ : Subset n) → p₁ ⊆ p₁ ∪ p₂
91
 
  ⊆∪ˡ []       ()
92
 
  ⊆∪ˡ (s ∷ p₂) here         = here
93
 
  ⊆∪ˡ (s ∷ p₂) (there x∈p₁) = there (⊆∪ˡ p₂ x∈p₁)
94
 
 
95
 
  ⊆∪ʳ : ∀ {n} (p₁ p₂ : Subset n) → p₂ ⊆ p₁ ∪ p₂
96
 
  ⊆∪ʳ p₁ p₂ rewrite BooleanAlgebra.∨-comm (booleanAlgebra _) p₁ p₂
97
 
    = ⊆∪ˡ p₁
98
 
 
99
 
  from : ∀ {n} {p₁ p₂ : Subset n} {x} → x ∈ p₁ ⊎ x ∈ p₂ → x ∈ p₁ ∪ p₂
100
 
  from (inj₁ x∈p₁) = ⊆∪ˡ _   x∈p₁
101
 
  from (inj₂ x∈p₂) = ⊆∪ʳ _ _ x∈p₂
102
 
 
103
 
------------------------------------------------------------------------
104
 
 
105
 
 
106
 
module NaturalPoset where
107
 
  private
108
 
    open module BA {n} = BoolProp (booleanAlgebra n) public
109
 
      using (poset)
110
 
    open module Po {n} = Poset (poset {n = n}) public
111
 
 
112
 
  -- _⊆_ is equivalent to the natural lattice order.
113
 
 
114
 
  orders-equivalent : ∀ {n} {p₁ p₂ : Subset n} → p₁ ⊆ p₂ ⇔ p₁ ≤ p₂
115
 
  orders-equivalent = equivalence (to _ _) (from _ _)
116
 
    where
117
 
    to : ∀ {n} (p₁ p₂ : Subset n) → p₁ ⊆ p₂ → p₁ ≤ p₂
118
 
    to []             []             p₁⊆p₂ = P.refl
119
 
    to (inside  ∷ p₁) (_       ∷ p₂) p₁⊆p₂ with p₁⊆p₂ here
120
 
    to (inside  ∷ p₁) (.inside ∷ p₂) p₁⊆p₂ | here = P.cong (_∷_ inside)  (to p₁ p₂ (drop-∷-⊆ p₁⊆p₂))
121
 
    to (outside ∷ p₁) (_       ∷ p₂) p₁⊆p₂        = P.cong (_∷_ outside) (to p₁ p₂ (drop-∷-⊆ p₁⊆p₂))
122
 
 
123
 
    from : ∀ {n} (p₁ p₂ : Subset n) → p₁ ≤ p₂ → p₁ ⊆ p₂
124
 
    from []             []       p₁≤p₂ x               = x
125
 
    from (.inside ∷ _)  (_ ∷ _)  p₁≤p₂ here            rewrite P.cong head p₁≤p₂ = here
126
 
    from (_       ∷ p₁) (_ ∷ p₂) p₁≤p₂ (there xs[i]=x) =
127
 
      there (from p₁ p₂ (P.cong tail p₁≤p₂) xs[i]=x)
128
 
 
129
 
 
130
 
poset : ℕ → Poset _ _ _
131
 
poset n = record
132
 
  { Carrier        = Subset n
133
 
  ; _≈_            = _≡_
134
 
  ; _≤_            = _⊆_
135
 
  ; isPartialOrder = record
136
 
    { isPreorder = record
137
 
      { isEquivalence = P.isEquivalence
138
 
      ; reflexive     = λ i≡j → from ⟨$⟩ reflexive i≡j
139
 
      ; trans         = λ x⊆y y⊆z → from ⟨$⟩ trans (to ⟨$⟩ x⊆y) (to ⟨$⟩ y⊆z)
140
 
      }
141
 
    ; antisym = λ x⊆y y⊆x → antisym (to ⟨$⟩ x⊆y) (to ⟨$⟩ y⊆x)
142
 
    }
143
 
  }
144
 
  where
145
 
  open NaturalPoset
146
 
  open module E {p₁ p₂} =
147
 
    Equivalence (orders-equivalent {n = n} {p₁ = p₁} {p₂ = p₂})
 
10
open import Data.Fin.Subset.Properties public