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

« back to all changes in this revision

Viewing changes to src/Algebra/Props/Lattice.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
-- Algebra.Properties.Lattice instead.
4
6
------------------------------------------------------------------------
5
7
 
6
8
open import Algebra
7
9
 
8
10
module Algebra.Props.Lattice {l₁ l₂} (L : Lattice l₁ l₂) where
9
11
 
10
 
open Lattice L
11
 
open import Algebra.Structures
12
 
import Algebra.FunctionProperties as P; open P _≈_
13
 
open import Relation.Binary
14
 
import Relation.Binary.EqReasoning as EqR; open EqR setoid
15
 
open import Function
16
 
open import Function.Equality using (_⟨$⟩_)
17
 
open import Function.Equivalence using (_⇔_; module Equivalence)
18
 
open import Data.Product
19
 
 
20
 
∧-idempotent : Idempotent _∧_
21
 
∧-idempotent x = begin
22
 
  x ∧ x            ≈⟨ refl ⟨ ∧-cong ⟩ sym (proj₁ absorptive _ _) ⟩
23
 
  x ∧ (x ∨ x ∧ x)  ≈⟨ proj₂ absorptive _ _ ⟩
24
 
  x                ∎
25
 
 
26
 
∨-idempotent : Idempotent _∨_
27
 
∨-idempotent x = begin
28
 
  x ∨ x      ≈⟨ refl ⟨ ∨-cong ⟩ sym (∧-idempotent _) ⟩
29
 
  x ∨ x ∧ x  ≈⟨ proj₁ absorptive _ _ ⟩
30
 
  x          ∎
31
 
 
32
 
 
33
 
∧-∨-isLattice : IsLattice _≈_ _∧_ _∨_
34
 
∧-∨-isLattice = record
35
 
  { isEquivalence = isEquivalence
36
 
  ; ∨-comm        = ∧-comm
37
 
  ; ∨-assoc       = ∧-assoc
38
 
  ; ∨-cong        = ∧-cong
39
 
  ; ∧-comm        = ∨-comm
40
 
  ; ∧-assoc       = ∨-assoc
41
 
  ; ∧-cong        = ∨-cong
42
 
  ; absorptive    = swap absorptive
43
 
  }
44
 
 
45
 
∧-∨-lattice : Lattice _ _
46
 
∧-∨-lattice = record
47
 
  { _∧_       = _∨_
48
 
  ; _∨_       = _∧_
49
 
  ; isLattice = ∧-∨-isLattice
50
 
  }
51
 
 
52
 
 
53
 
poset : Poset _ _ _
54
 
poset = record
55
 
  { Carrier        = Carrier
56
 
  ; _≈_            = _≈_
57
 
  ; _≤_            = λ x y → x ≈ x ∧ y
58
 
  ; isPartialOrder = record
59
 
    { isPreorder = record
60
 
      { isEquivalence = isEquivalence
61
 
      ; reflexive     = λ {i} {j} i≈j → begin
62
 
                          i      ≈⟨ sym $ ∧-idempotent _ ⟩
63
 
                          i ∧ i  ≈⟨ ∧-cong refl i≈j ⟩
64
 
                          i ∧ j  ∎
65
 
      ; trans         = λ {i} {j} {k} i≈i∧j j≈j∧k → begin
66
 
                          i            ≈⟨ i≈i∧j ⟩
67
 
                          i ∧ j        ≈⟨ ∧-cong refl j≈j∧k ⟩
68
 
                          i ∧ (j ∧ k)  ≈⟨ sym (∧-assoc _ _ _) ⟩
69
 
                          (i ∧ j) ∧ k  ≈⟨ ∧-cong (sym i≈i∧j) refl ⟩
70
 
                          i ∧ k        ∎
71
 
      }
72
 
    ; antisym = λ {x} {y} x≈x∧y y≈y∧x → begin
73
 
                  x      ≈⟨ x≈x∧y ⟩
74
 
                  x ∧ y  ≈⟨ ∧-comm _ _ ⟩
75
 
                  y ∧ x  ≈⟨ sym y≈y∧x ⟩
76
 
                  y      ∎
77
 
    }
78
 
  }
79
 
 
80
 
 
81
 
replace-equality : {_≈′_ : Rel Carrier l₂} →
82
 
                   (∀ {x y} → x ≈ y ⇔ x ≈′ y) → Lattice _ _
83
 
replace-equality {_≈′_} ≈⇔≈′ = record
84
 
  { _≈_       = _≈′_
85
 
  ; _∧_       = _∧_
86
 
  ; _∨_       = _∨_
87
 
  ; isLattice = record
88
 
    { isEquivalence = record
89
 
      { refl  = to ⟨$⟩ refl
90
 
      ; sym   = λ x≈y → to ⟨$⟩ sym (from ⟨$⟩ x≈y)
91
 
      ; trans = λ x≈y y≈z → to ⟨$⟩ trans (from ⟨$⟩ x≈y) (from ⟨$⟩ y≈z)
92
 
      }
93
 
    ; ∨-comm     = λ x y → to ⟨$⟩ ∨-comm x y
94
 
    ; ∨-assoc    = λ x y z → to ⟨$⟩ ∨-assoc x y z
95
 
    ; ∨-cong     = λ x≈y u≈v → to ⟨$⟩ ∨-cong (from ⟨$⟩ x≈y) (from ⟨$⟩ u≈v)
96
 
    ; ∧-comm     = λ x y → to ⟨$⟩ ∧-comm x y
97
 
    ; ∧-assoc    = λ x y z → to ⟨$⟩ ∧-assoc x y z
98
 
    ; ∧-cong     = λ x≈y u≈v → to ⟨$⟩ ∧-cong (from ⟨$⟩ x≈y) (from ⟨$⟩ u≈v)
99
 
    ; absorptive = (λ x y → to ⟨$⟩ proj₁ absorptive x y)
100
 
                 , (λ x y → to ⟨$⟩ proj₂ absorptive x y)
101
 
    }
102
 
  } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y})
 
12
open import Algebra.Properties.Lattice L public