~ubuntu-branches/ubuntu/quantal/agda-stdlib/quantal

« back to all changes in this revision

Viewing changes to src/Relation/Binary.agda

  • Committer: Bazaar Package Importer
  • Author(s): Iain Lane
  • Date: 2010-01-08 23:35:09 UTC
  • Revision ID: james.westby@ubuntu.com-20100108233509-l6ejt9xji64xysfb
Import upstream version 0.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
------------------------------------------------------------------------
 
2
-- Properties of homogeneous binary relations
 
3
------------------------------------------------------------------------
 
4
 
 
5
{-# OPTIONS --universe-polymorphism #-}
 
6
 
 
7
module Relation.Binary where
 
8
 
 
9
open import Data.Product
 
10
open import Data.Sum
 
11
open import Data.Function
 
12
open import Level
 
13
import Relation.Binary.PropositionalEquality.Core as PropEq
 
14
open import Relation.Binary.Consequences
 
15
open import Relation.Binary.Core as Core using (_≡_)
 
16
 
 
17
------------------------------------------------------------------------
 
18
-- Simple properties and equivalence relations
 
19
 
 
20
open Core public hiding (_≡_; refl; _≢_)
 
21
 
 
22
------------------------------------------------------------------------
 
23
-- Preorders
 
24
 
 
25
record IsPreorder {a ℓ₁ ℓ₂} {A : Set a}
 
26
                  (_≈_ : Rel A ℓ₁) -- The underlying equality.
 
27
                  (_∼_ : Rel A ℓ₂) -- The relation.
 
28
                  : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where
 
29
  field
 
30
    isEquivalence : IsEquivalence _≈_
 
31
    -- Reflexivity is expressed in terms of an underlying equality:
 
32
    reflexive     : _≈_ ⇒ _∼_
 
33
    trans         : Transitive _∼_
 
34
    ∼-resp-≈      : _∼_ Respects₂ _≈_
 
35
 
 
36
  module Eq = IsEquivalence isEquivalence
 
37
 
 
38
  refl : Reflexive _∼_
 
39
  refl = reflexive Eq.refl
 
40
 
 
41
record Preorder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where
 
42
  infix 4 _≈_ _∼_
 
43
  field
 
44
    Carrier    : Set c
 
45
    _≈_        : Rel Carrier ℓ₁  -- The underlying equality.
 
46
    _∼_        : Rel Carrier ℓ₂  -- The relation.
 
47
    isPreorder : IsPreorder _≈_ _∼_
 
48
 
 
49
  open IsPreorder isPreorder public
 
50
 
 
51
------------------------------------------------------------------------
 
52
-- Setoids
 
53
 
 
54
-- Equivalence relations are defined in Relation.Binary.Core.
 
55
 
 
56
record Setoid c ℓ : Set (suc (c ⊔ ℓ)) where
 
57
  infix 4 _≈_
 
58
  field
 
59
    Carrier       : Set c
 
60
    _≈_           : Rel Carrier ℓ
 
61
    isEquivalence : IsEquivalence _≈_
 
62
 
 
63
  open IsEquivalence isEquivalence public
 
64
 
 
65
  isPreorder : IsPreorder _≡_ _≈_
 
66
  isPreorder = record
 
67
    { isEquivalence = PropEq.isEquivalence
 
68
    ; reflexive     = reflexive
 
69
    ; trans         = trans
 
70
    ; ∼-resp-≈      = PropEq.resp₂ _≈_
 
71
    }
 
72
 
 
73
  preorder : Preorder c zero ℓ
 
74
  preorder = record { isPreorder = isPreorder }
 
75
 
 
76
------------------------------------------------------------------------
 
77
-- Decidable equivalence relations
 
78
 
 
79
record IsDecEquivalence {a ℓ} {A : Set a}
 
80
                        (_≈_ : Rel A ℓ) : Set (a ⊔ ℓ) where
 
81
  infix 4 _≟_
 
82
  field
 
83
    isEquivalence : IsEquivalence _≈_
 
84
    _≟_           : Decidable _≈_
 
85
 
 
86
  open IsEquivalence isEquivalence public
 
87
 
 
88
record DecSetoid c ℓ : Set (suc (c ⊔ ℓ)) where
 
89
  infix 4 _≈_
 
90
  field
 
91
    Carrier          : Set c
 
92
    _≈_              : Rel Carrier ℓ
 
93
    isDecEquivalence : IsDecEquivalence _≈_
 
94
 
 
95
  open IsDecEquivalence isDecEquivalence public
 
96
 
 
97
  setoid : Setoid c ℓ
 
98
  setoid = record { isEquivalence = isEquivalence }
 
99
 
 
100
  open Setoid setoid public using (preorder)
 
101
 
 
102
------------------------------------------------------------------------
 
103
-- Partial orders
 
104
 
 
105
record IsPartialOrder {a ℓ₁ ℓ₂} {A : Set a}
 
106
                      (_≈_ : Rel A ℓ₁) (_≤_ : Rel A ℓ₂) :
 
107
                      Set (a ⊔ ℓ₁ ⊔ ℓ₂) where
 
108
  field
 
109
    isPreorder : IsPreorder _≈_ _≤_
 
110
    antisym    : Antisymmetric _≈_ _≤_
 
111
 
 
112
  open IsPreorder isPreorder public
 
113
         renaming (∼-resp-≈ to ≤-resp-≈)
 
114
 
 
115
record Poset c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where
 
116
  infix 4 _≈_ _≤_
 
117
  field
 
118
    Carrier        : Set c
 
119
    _≈_            : Rel Carrier ℓ₁
 
120
    _≤_            : Rel Carrier ℓ₂
 
121
    isPartialOrder : IsPartialOrder _≈_ _≤_
 
122
 
 
123
  open IsPartialOrder isPartialOrder public
 
124
 
 
125
  preorder : Preorder c ℓ₁ ℓ₂
 
126
  preorder = record { isPreorder = isPreorder }
 
127
 
 
128
------------------------------------------------------------------------
 
129
-- Strict partial orders
 
130
 
 
131
record IsStrictPartialOrder {a ℓ₁ ℓ₂} {A : Set a}
 
132
                            (_≈_ : Rel A ℓ₁) (_<_ : Rel A ℓ₂) :
 
133
                            Set (a ⊔ ℓ₁ ⊔ ℓ₂) where
 
134
  field
 
135
    isEquivalence : IsEquivalence _≈_
 
136
    irrefl        : Irreflexive _≈_ _<_
 
137
    trans         : Transitive _<_
 
138
    <-resp-≈      : _<_ Respects₂ _≈_
 
139
 
 
140
  module Eq = IsEquivalence isEquivalence
 
141
 
 
142
record StrictPartialOrder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where
 
143
  infix 4 _≈_ _<_
 
144
  field
 
145
    Carrier              : Set c
 
146
    _≈_                  : Rel Carrier ℓ₁
 
147
    _<_                  : Rel Carrier ℓ₂
 
148
    isStrictPartialOrder : IsStrictPartialOrder _≈_ _<_
 
149
 
 
150
  open IsStrictPartialOrder isStrictPartialOrder public
 
151
 
 
152
------------------------------------------------------------------------
 
153
-- Total orders
 
154
 
 
155
record IsTotalOrder {a ℓ₁ ℓ₂} {A : Set a}
 
156
                    (_≈_ : Rel A ℓ₁) (_≤_ : Rel A ℓ₂) :
 
157
                    Set (a ⊔ ℓ₁ ⊔ ℓ₂) where
 
158
  field
 
159
    isPartialOrder : IsPartialOrder _≈_ _≤_
 
160
    total          : Total _≤_
 
161
 
 
162
  open IsPartialOrder isPartialOrder public
 
163
 
 
164
record TotalOrder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where
 
165
  infix 4 _≈_ _≤_
 
166
  field
 
167
    Carrier      : Set c
 
168
    _≈_          : Rel Carrier ℓ₁
 
169
    _≤_          : Rel Carrier ℓ₂
 
170
    isTotalOrder : IsTotalOrder _≈_ _≤_
 
171
 
 
172
  open IsTotalOrder isTotalOrder public
 
173
 
 
174
  poset : Poset c ℓ₁ ℓ₂
 
175
  poset = record { isPartialOrder = isPartialOrder }
 
176
 
 
177
  open Poset poset public using (preorder)
 
178
 
 
179
------------------------------------------------------------------------
 
180
-- Decidable total orders
 
181
 
 
182
record IsDecTotalOrder {a ℓ₁ ℓ₂} {A : Set a}
 
183
                       (_≈_ : Rel A ℓ₁) (_≤_ : Rel A ℓ₂) :
 
184
                       Set (a ⊔ ℓ₁ ⊔ ℓ₂) where
 
185
  infix 4 _≟_ _≤?_
 
186
  field
 
187
    isTotalOrder : IsTotalOrder _≈_ _≤_
 
188
    _≟_          : Decidable _≈_
 
189
    _≤?_         : Decidable _≤_
 
190
 
 
191
  private
 
192
    module TO = IsTotalOrder isTotalOrder
 
193
  open TO public hiding (module Eq)
 
194
 
 
195
  module Eq where
 
196
 
 
197
    isDecEquivalence : IsDecEquivalence _≈_
 
198
    isDecEquivalence = record
 
199
      { isEquivalence = TO.isEquivalence
 
200
      ; _≟_           = _≟_
 
201
      }
 
202
 
 
203
    open IsDecEquivalence isDecEquivalence public
 
204
 
 
205
record DecTotalOrder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where
 
206
  infix 4 _≈_ _≤_
 
207
  field
 
208
    Carrier         : Set c
 
209
    _≈_             : Rel Carrier ℓ₁
 
210
    _≤_             : Rel Carrier ℓ₂
 
211
    isDecTotalOrder : IsDecTotalOrder _≈_ _≤_
 
212
 
 
213
  private
 
214
    module DTO = IsDecTotalOrder isDecTotalOrder
 
215
  open DTO public hiding (module Eq)
 
216
 
 
217
  totalOrder : TotalOrder c ℓ₁ ℓ₂
 
218
  totalOrder = record { isTotalOrder = isTotalOrder }
 
219
 
 
220
  open TotalOrder totalOrder public using (poset; preorder)
 
221
 
 
222
  module Eq where
 
223
 
 
224
    decSetoid : DecSetoid c ℓ₁
 
225
    decSetoid = record { isDecEquivalence = DTO.Eq.isDecEquivalence }
 
226
 
 
227
    open DecSetoid decSetoid public
 
228
 
 
229
------------------------------------------------------------------------
 
230
-- Strict total orders
 
231
 
 
232
-- Note that these orders are decidable (see compare).
 
233
 
 
234
record IsStrictTotalOrder {a ℓ₁ ℓ₂} {A : Set a}
 
235
                          (_≈_ : Rel A ℓ₁) (_<_ : Rel A ℓ₂) :
 
236
                          Set (a ⊔ ℓ₁ ⊔ ℓ₂) where
 
237
  field
 
238
    isEquivalence : IsEquivalence _≈_
 
239
    trans         : Transitive _<_
 
240
    compare       : Trichotomous _≈_ _<_
 
241
    <-resp-≈      : _<_ Respects₂ _≈_
 
242
 
 
243
  infix 4 _≟_ _<?_
 
244
 
 
245
  _≟_ : Decidable _≈_
 
246
  _≟_ = tri⟶dec≈ compare
 
247
 
 
248
  _<?_ : Decidable _<_
 
249
  _<?_ = tri⟶dec< compare
 
250
 
 
251
  isDecEquivalence : IsDecEquivalence _≈_
 
252
  isDecEquivalence = record
 
253
    { isEquivalence = isEquivalence
 
254
    ; _≟_           = _≟_
 
255
    }
 
256
 
 
257
  module Eq = IsDecEquivalence isDecEquivalence
 
258
 
 
259
  isStrictPartialOrder : IsStrictPartialOrder _≈_ _<_
 
260
  isStrictPartialOrder = record
 
261
    { isEquivalence = isEquivalence
 
262
    ; irrefl        = tri⟶irr <-resp-≈ Eq.sym compare
 
263
    ; trans         = trans
 
264
    ; <-resp-≈      = <-resp-≈
 
265
    }
 
266
 
 
267
  open IsStrictPartialOrder isStrictPartialOrder public using (irrefl)
 
268
 
 
269
record StrictTotalOrder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where
 
270
  infix 4 _≈_ _<_
 
271
  field
 
272
    Carrier            : Set c
 
273
    _≈_                : Rel Carrier ℓ₁
 
274
    _<_                : Rel Carrier ℓ₂
 
275
    isStrictTotalOrder : IsStrictTotalOrder _≈_ _<_
 
276
 
 
277
  open IsStrictTotalOrder isStrictTotalOrder public
 
278
    hiding (module Eq)
 
279
 
 
280
  strictPartialOrder : StrictPartialOrder c ℓ₁ ℓ₂
 
281
  strictPartialOrder =
 
282
    record { isStrictPartialOrder = isStrictPartialOrder }
 
283
 
 
284
  decSetoid : DecSetoid c ℓ₁
 
285
  decSetoid = record { isDecEquivalence = isDecEquivalence }
 
286
 
 
287
  module Eq = DecSetoid decSetoid