Page not found :(
-The requested page could not be found.
-{-# OPTIONS --cubical-compatible --safe --no-universe-polymorphism + --no-sized-types --no-guardedness #-} + +module Agda.Builtin.Bool where + +data Bool : Set where + false true : Bool + +{-# BUILTIN BOOL Bool #-} +{-# BUILTIN FALSE false #-} +{-# BUILTIN TRUE true #-} + +{-# COMPILE JS Bool = function (x,v) { return ((x)? v["true"]() : v["false"]()); } #-} +{-# COMPILE JS false = false #-} +{-# COMPILE JS true = true #-} +\ No newline at end of file diff --git a/docs/Agda.Builtin.Equality.html b/docs/Agda.Builtin.Equality.html new file mode 100644 index 0000000..35891ff --- /dev/null +++ b/docs/Agda.Builtin.Equality.html @@ -0,0 +1,11 @@ + +
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness #-} + +module Agda.Builtin.Equality where + +infix 4 _≡_ +data _≡_ {a} {A : Set a} (x : A) : A → Set a where + instance refl : x ≡ x + +{-# BUILTIN EQUALITY _≡_ #-} +\ No newline at end of file diff --git a/docs/Agda.Builtin.List.html b/docs/Agda.Builtin.List.html new file mode 100644 index 0000000..adfe8d3 --- /dev/null +++ b/docs/Agda.Builtin.List.html @@ -0,0 +1,18 @@ + +
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness #-} + +module Agda.Builtin.List where + +infixr 5 _∷_ +data List {a} (A : Set a) : Set a where + [] : List A + _∷_ : (x : A) (xs : List A) → List A + +{-# BUILTIN LIST List #-} + +{-# COMPILE JS List = function(x,v) { + if (x.length < 1) { return v["[]"](); } else { return v["_∷_"](x[0], x.slice(1)); } +} #-} +{-# COMPILE JS [] = Array() #-} +{-# COMPILE JS _∷_ = function (x) { return function(y) { return Array(x).concat(y); }; } #-} +\ No newline at end of file diff --git a/docs/Agda.Builtin.Maybe.html b/docs/Agda.Builtin.Maybe.html new file mode 100644 index 0000000..8333b01 --- /dev/null +++ b/docs/Agda.Builtin.Maybe.html @@ -0,0 +1,11 @@ + +
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness #-} + +module Agda.Builtin.Maybe where + +data Maybe {a} (A : Set a) : Set a where + just : A → Maybe A + nothing : Maybe A + +{-# BUILTIN MAYBE Maybe #-} +\ No newline at end of file diff --git a/docs/Agda.Builtin.Nat.html b/docs/Agda.Builtin.Nat.html new file mode 100644 index 0000000..c4f6a72 --- /dev/null +++ b/docs/Agda.Builtin.Nat.html @@ -0,0 +1,136 @@ + +
{-# OPTIONS --cubical-compatible --safe --no-universe-polymorphism + --no-sized-types --no-guardedness #-} + +module Agda.Builtin.Nat where + +open import Agda.Builtin.Bool + +data Nat : Set where + zero : Nat + suc : (n : Nat) → Nat + +{-# BUILTIN NATURAL Nat #-} + +infix 4 _==_ _<_ +infixl 6 _+_ _-_ +infixl 7 _*_ + +_+_ : Nat → Nat → Nat +zero + m = m +suc n + m = suc (n + m) + +{-# BUILTIN NATPLUS _+_ #-} + +_-_ : Nat → Nat → Nat +n - zero = n +zero - suc m = zero +suc n - suc m = n - m + +{-# BUILTIN NATMINUS _-_ #-} + +_*_ : Nat → Nat → Nat +zero * m = zero +suc n * m = m + n * m + +{-# BUILTIN NATTIMES _*_ #-} + +_==_ : Nat → Nat → Bool +zero == zero = true +suc n == suc m = n == m +_ == _ = false + +{-# BUILTIN NATEQUALS _==_ #-} + +_<_ : Nat → Nat → Bool +_ < zero = false +zero < suc _ = true +suc n < suc m = n < m + +{-# BUILTIN NATLESS _<_ #-} + +-- Helper function div-helper for Euclidean division. +--------------------------------------------------------------------------- +-- +-- div-helper computes n / 1+m via iteration on n. +-- +-- n div (suc m) = div-helper 0 m n m +-- +-- The state of the iterator has two accumulator variables: +-- +-- k: The quotient, returned once n=0. Initialized to 0. +-- +-- j: A counter, initialized to the divisor m, decreased on each iteration step. +-- Once it reaches 0, the quotient k is increased and j reset to m, +-- starting the next countdown. +-- +-- Under the precondition j ≤ m, the invariant is +-- +-- div-helper k m n j = k + (n + m - j) div (1 + m) + +div-helper : (k m n j : Nat) → Nat +div-helper k m zero j = k +div-helper k m (suc n) zero = div-helper (suc k) m n m +div-helper k m (suc n) (suc j) = div-helper k m n j + +{-# BUILTIN NATDIVSUCAUX div-helper #-} + +-- Proof of the invariant by induction on n. +-- +-- clause 1: div-helper k m 0 j +-- = k by definition +-- = k + (0 + m - j) div (1 + m) since m - j < 1 + m +-- +-- clause 2: div-helper k m (1 + n) 0 +-- = div-helper (1 + k) m n m by definition +-- = 1 + k + (n + m - m) div (1 + m) by induction hypothesis +-- = 1 + k + n div (1 + m) by simplification +-- = k + (n + (1 + m)) div (1 + m) by expansion +-- = k + (1 + n + m - 0) div (1 + m) by expansion +-- +-- clause 3: div-helper k m (1 + n) (1 + j) +-- = div-helper k m n j by definition +-- = k + (n + m - j) div (1 + m) by induction hypothesis +-- = k + ((1 + n) + m - (1 + j)) div (1 + m) by expansion +-- +-- Q.e.d. + +-- Helper function mod-helper for the remainder computation. +--------------------------------------------------------------------------- +-- +-- (Analogous to div-helper.) +-- +-- mod-helper computes n % 1+m via iteration on n. +-- +-- n mod (suc m) = mod-helper 0 m n m +-- +-- The invariant is: +-- +-- m = k + j ==> mod-helper k m n j = (n + k) mod (1 + m). + +mod-helper : (k m n j : Nat) → Nat +mod-helper k m zero j = k +mod-helper k m (suc n) zero = mod-helper 0 m n m +mod-helper k m (suc n) (suc j) = mod-helper (suc k) m n j + +{-# BUILTIN NATMODSUCAUX mod-helper #-} + +-- Proof of the invariant by induction on n. +-- +-- clause 1: mod-helper k m 0 j +-- = k by definition +-- = (0 + k) mod (1 + m) since m = k + j, thus k < m +-- +-- clause 2: mod-helper k m (1 + n) 0 +-- = mod-helper 0 m n m by definition +-- = (n + 0) mod (1 + m) by induction hypothesis +-- = (n + (1 + m)) mod (1 + m) by expansion +-- = (1 + n) + k) mod (1 + m) since k = m (as l = 0) +-- +-- clause 3: mod-helper k m (1 + n) (1 + j) +-- = mod-helper (1 + k) m n j by definition +-- = (n + (1 + k)) mod (1 + m) by induction hypothesis +-- = ((1 + n) + k) mod (1 + m) by commutativity +-- +-- Q.e.d. +\ No newline at end of file diff --git a/docs/Agda.Builtin.Sigma.html b/docs/Agda.Builtin.Sigma.html new file mode 100644 index 0000000..645c090 --- /dev/null +++ b/docs/Agda.Builtin.Sigma.html @@ -0,0 +1,19 @@ + +
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness #-} + +module Agda.Builtin.Sigma where + +open import Agda.Primitive + +record Σ {a b} (A : Set a) (B : A → Set b) : Set (a ⊔ b) where + constructor _,_ + field + fst : A + snd : B fst + +open Σ public + +infixr 4 _,_ + +{-# BUILTIN SIGMA Σ #-} +\ No newline at end of file diff --git a/docs/Agda.Builtin.Strict.html b/docs/Agda.Builtin.Strict.html new file mode 100644 index 0000000..8989eab --- /dev/null +++ b/docs/Agda.Builtin.Strict.html @@ -0,0 +1,11 @@ + +
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness #-} + +module Agda.Builtin.Strict where + +open import Agda.Builtin.Equality + +primitive + primForce : ∀ {a b} {A : Set a} {B : A → Set b} (x : A) → (∀ x → B x) → B x + primForceLemma : ∀ {a b} {A : Set a} {B : A → Set b} (x : A) (f : ∀ x → B x) → primForce x f ≡ f x +\ No newline at end of file diff --git a/docs/Agda.Builtin.Unit.html b/docs/Agda.Builtin.Unit.html new file mode 100644 index 0000000..c3de243 --- /dev/null +++ b/docs/Agda.Builtin.Unit.html @@ -0,0 +1,12 @@ + +
{-# OPTIONS --cubical-compatible --safe --no-universe-polymorphism + --no-sized-types --no-guardedness #-} + +module Agda.Builtin.Unit where + +record ⊤ : Set where + instance constructor tt + +{-# BUILTIN UNIT ⊤ #-} +{-# COMPILE GHC ⊤ = data () (()) #-} +\ No newline at end of file diff --git a/docs/Agda.Primitive.html b/docs/Agda.Primitive.html new file mode 100644 index 0000000..a34ffc0 --- /dev/null +++ b/docs/Agda.Primitive.html @@ -0,0 +1,39 @@ + +
-- The Agda primitives (preloaded). + +{-# OPTIONS --cubical-compatible --no-import-sorts #-} + +module Agda.Primitive where + +------------------------------------------------------------------------ +-- Universe levels +------------------------------------------------------------------------ + +infixl 6 _⊔_ + +{-# BUILTIN TYPE Set #-} +{-# BUILTIN PROP Prop #-} +{-# BUILTIN SETOMEGA Setω #-} +{-# BUILTIN STRICTSET SSet #-} +{-# BUILTIN STRICTSETOMEGA SSetω #-} + +-- Level is the first thing we need to define. +-- The other postulates can only be checked if built-in Level is known. + +postulate + Level : Set + +-- MAlonzo compiles Level to (). This should be safe, because it is +-- not possible to pattern match on levels. + +{-# BUILTIN LEVEL Level #-} + +postulate + lzero : Level + lsuc : (ℓ : Level) → Level + _⊔_ : (ℓ₁ ℓ₂ : Level) → Level + +{-# BUILTIN LEVELZERO lzero #-} +{-# BUILTIN LEVELSUC lsuc #-} +{-# BUILTIN LEVELMAX _⊔_ #-} +\ No newline at end of file diff --git a/docs/Agda.css b/docs/Agda.css new file mode 100644 index 0000000..86813a5 --- /dev/null +++ b/docs/Agda.css @@ -0,0 +1,41 @@ +/* Aspects. */ +.Agda .Comment { color: #B22222 } +.Agda .Background {} +.Agda .Markup { color: #000000 } +.Agda .Keyword { color: #CD6600 } +.Agda .String { color: #B22222 } +.Agda .Number { color: #A020F0 } +.Agda .Symbol { color: #404040 } +.Agda .PrimitiveType { color: #0000CD } +.Agda .Pragma { color: black } +.Agda .Operator {} +.Agda .Hole { background: #B4EEB4 } + +/* NameKinds. */ +.Agda .Bound { color: black } +.Agda .Generalizable { color: black } +.Agda .InductiveConstructor { color: #008B00 } +.Agda .CoinductiveConstructor { color: #8B7500 } +.Agda .Datatype { color: #0000CD } +.Agda .Field { color: #EE1289 } +.Agda .Function { color: #0000CD } +.Agda .Module { color: #A020F0 } +.Agda .Postulate { color: #0000CD } +.Agda .Primitive { color: #0000CD } +.Agda .Record { color: #0000CD } + +/* OtherAspects. */ +.Agda .DottedPattern {} +.Agda .UnsolvedMeta { color: black; background: yellow } +.Agda .UnsolvedConstraint { color: black; background: yellow } +.Agda .TerminationProblem { color: black; background: #FFA07A } +.Agda .IncompletePattern { color: black; background: #F5DEB3 } +.Agda .Error { color: red; text-decoration: underline } +.Agda .TypeChecks { color: black; background: #ADD8E6 } +.Agda .Deadcode { color: black; background: #808080 } +.Agda .ShadowingInTelescope { color: black; background: #808080 } + +/* Standard attributes. */ +.Agda a { text-decoration: none } +.Agda a[href]:hover { background-color: #B4EEB4 } +.Agda [href].hover-highlight { background-color: #B4EEB4; } diff --git a/docs/Algebra.Bundles.html b/docs/Algebra.Bundles.html new file mode 100644 index 0000000..532382b --- /dev/null +++ b/docs/Algebra.Bundles.html @@ -0,0 +1,934 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Definitions of algebraic structures like monoids and rings +-- (packed in records together with sets, operations, etc.) +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via `Algebra`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Algebra.Bundles where + +open import Algebra.Core +open import Algebra.Structures +open import Relation.Binary +open import Function.Base +import Relation.Nullary as N +open import Level + +------------------------------------------------------------------------ +-- Bundles with 1 binary operation +------------------------------------------------------------------------ + +record RawMagma c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + + infix 4 _≉_ + _≉_ : Rel Carrier _ + x ≉ y = N.¬ (x ≈ y) + + +record Magma c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + isMagma : IsMagma _≈_ _∙_ + + open IsMagma isMagma public + + rawMagma : RawMagma _ _ + rawMagma = record { _≈_ = _≈_; _∙_ = _∙_ } + + open RawMagma rawMagma public + using (_≉_) + + +record SelectiveMagma c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + isSelectiveMagma : IsSelectiveMagma _≈_ _∙_ + + open IsSelectiveMagma isSelectiveMagma public + + magma : Magma c ℓ + magma = record { isMagma = isMagma } + + open Magma magma public using (rawMagma) + + +record CommutativeMagma c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + isCommutativeMagma : IsCommutativeMagma _≈_ _∙_ + + open IsCommutativeMagma isCommutativeMagma public + + magma : Magma c ℓ + magma = record { isMagma = isMagma } + + open Magma magma public using (rawMagma) + + +record Semigroup c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + isSemigroup : IsSemigroup _≈_ _∙_ + + open IsSemigroup isSemigroup public + + magma : Magma c ℓ + magma = record { isMagma = isMagma } + + open Magma magma public + using (_≉_; rawMagma) + + +record Band c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + isBand : IsBand _≈_ _∙_ + + open IsBand isBand public + + semigroup : Semigroup c ℓ + semigroup = record { isSemigroup = isSemigroup } + + open Semigroup semigroup public + using (_≉_; magma; rawMagma) + + +record CommutativeSemigroup c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _∙_ + + open IsCommutativeSemigroup isCommutativeSemigroup public + + semigroup : Semigroup c ℓ + semigroup = record { isSemigroup = isSemigroup } + + open Semigroup semigroup public + using (_≉_; magma; rawMagma) + + commutativeMagma : CommutativeMagma c ℓ + commutativeMagma = record { isCommutativeMagma = isCommutativeMagma } + + +record Semilattice c ℓ : Set (suc (c ⊔ ℓ)) where + infixr 7 _∧_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∧_ : Op₂ Carrier + isSemilattice : IsSemilattice _≈_ _∧_ + + open IsSemilattice isSemilattice public + + band : Band c ℓ + band = record { isBand = isBand } + + open Band band public + using (_≉_; rawMagma; magma; semigroup) + + +------------------------------------------------------------------------ +-- Bundles with 1 binary operation & 1 element +------------------------------------------------------------------------ + +-- A raw monoid is a monoid without any laws. + +record RawMonoid c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + ε : Carrier + + rawMagma : RawMagma c ℓ + rawMagma = record + { _≈_ = _≈_ + ; _∙_ = _∙_ + } + + open RawMagma rawMagma public + using (_≉_) + + +record Monoid c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + ε : Carrier + isMonoid : IsMonoid _≈_ _∙_ ε + + open IsMonoid isMonoid public + + semigroup : Semigroup _ _ + semigroup = record { isSemigroup = isSemigroup } + + open Semigroup semigroup public + using (_≉_; rawMagma; magma) + + rawMonoid : RawMonoid _ _ + rawMonoid = record { _≈_ = _≈_; _∙_ = _∙_; ε = ε} + + +record CommutativeMonoid c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + ε : Carrier + isCommutativeMonoid : IsCommutativeMonoid _≈_ _∙_ ε + + open IsCommutativeMonoid isCommutativeMonoid public + + monoid : Monoid _ _ + monoid = record { isMonoid = isMonoid } + + open Monoid monoid public + using (_≉_; rawMagma; magma; semigroup; rawMonoid) + + commutativeSemigroup : CommutativeSemigroup _ _ + commutativeSemigroup = record { isCommutativeSemigroup = isCommutativeSemigroup } + + open CommutativeSemigroup commutativeSemigroup public + using (commutativeMagma) + + +record IdempotentCommutativeMonoid c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + ε : Carrier + isIdempotentCommutativeMonoid : IsIdempotentCommutativeMonoid _≈_ _∙_ ε + + open IsIdempotentCommutativeMonoid isIdempotentCommutativeMonoid public + + commutativeMonoid : CommutativeMonoid _ _ + commutativeMonoid = record { isCommutativeMonoid = isCommutativeMonoid } + + open CommutativeMonoid commutativeMonoid public + using + ( _≉_; rawMagma; magma; commutativeMagma; semigroup; commutativeSemigroup + ; rawMonoid; monoid + ) + + +-- Idempotent commutative monoids are also known as bounded lattices. +-- Note that the BoundedLattice necessarily uses the notation inherited +-- from monoids rather than lattices. + +BoundedLattice = IdempotentCommutativeMonoid + +module BoundedLattice {c ℓ} (idemCommMonoid : IdempotentCommutativeMonoid c ℓ) = + IdempotentCommutativeMonoid idemCommMonoid + + +------------------------------------------------------------------------ +-- Bundles with 1 binary operation, 1 unary operation & 1 element +------------------------------------------------------------------------ + +record RawGroup c ℓ : Set (suc (c ⊔ ℓ)) where + infix 8 _⁻¹ + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + ε : Carrier + _⁻¹ : Op₁ Carrier + + rawMonoid : RawMonoid c ℓ + rawMonoid = record + { _≈_ = _≈_ + ; _∙_ = _∙_ + ; ε = ε + } + + open RawMonoid rawMonoid public + using (_≉_; rawMagma) + + +record Group c ℓ : Set (suc (c ⊔ ℓ)) where + infix 8 _⁻¹ + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + ε : Carrier + _⁻¹ : Op₁ Carrier + isGroup : IsGroup _≈_ _∙_ ε _⁻¹ + + open IsGroup isGroup public + + rawGroup : RawGroup _ _ + rawGroup = record { _≈_ = _≈_; _∙_ = _∙_; ε = ε; _⁻¹ = _⁻¹} + + monoid : Monoid _ _ + monoid = record { isMonoid = isMonoid } + + open Monoid monoid public + using (_≉_; rawMagma; magma; semigroup; rawMonoid) + +record AbelianGroup c ℓ : Set (suc (c ⊔ ℓ)) where + infix 8 _⁻¹ + infixl 7 _∙_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∙_ : Op₂ Carrier + ε : Carrier + _⁻¹ : Op₁ Carrier + isAbelianGroup : IsAbelianGroup _≈_ _∙_ ε _⁻¹ + + open IsAbelianGroup isAbelianGroup public + + group : Group _ _ + group = record { isGroup = isGroup } + + open Group group public + using (_≉_; rawMagma; magma; semigroup; monoid; rawMonoid; rawGroup) + + commutativeMonoid : CommutativeMonoid _ _ + commutativeMonoid = record { isCommutativeMonoid = isCommutativeMonoid } + + open CommutativeMonoid commutativeMonoid public + using (commutativeMagma; commutativeSemigroup) + + +------------------------------------------------------------------------ +-- Bundles with 2 binary operations +------------------------------------------------------------------------ + +record RawLattice c ℓ : Set (suc (c ⊔ ℓ)) where + infixr 7 _∧_ + infixr 6 _∨_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∧_ : Op₂ Carrier + _∨_ : Op₂ Carrier + + ∨-rawMagma : RawMagma c ℓ + ∨-rawMagma = record { _≈_ = _≈_; _∙_ = _∨_ } + + ∧-rawMagma : RawMagma c ℓ + ∧-rawMagma = record { _≈_ = _≈_; _∙_ = _∧_ } + + open RawMagma ∨-rawMagma public + using (_≉_) + + +record Lattice c ℓ : Set (suc (c ⊔ ℓ)) where + infixr 7 _∧_ + infixr 6 _∨_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∨_ : Op₂ Carrier + _∧_ : Op₂ Carrier + isLattice : IsLattice _≈_ _∨_ _∧_ + + open IsLattice isLattice public + + rawLattice : RawLattice c ℓ + rawLattice = record + { _≈_ = _≈_ + ; _∧_ = _∧_ + ; _∨_ = _∨_ + } + + open RawLattice rawLattice + using (∨-rawMagma; ∧-rawMagma) + + setoid : Setoid _ _ + setoid = record { isEquivalence = isEquivalence } + + open Setoid setoid public + using (_≉_) + + +record DistributiveLattice c ℓ : Set (suc (c ⊔ ℓ)) where + infixr 7 _∧_ + infixr 6 _∨_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∨_ : Op₂ Carrier + _∧_ : Op₂ Carrier + isDistributiveLattice : IsDistributiveLattice _≈_ _∨_ _∧_ + + open IsDistributiveLattice isDistributiveLattice public + + lattice : Lattice _ _ + lattice = record { isLattice = isLattice } + + open Lattice lattice public + using (_≉_; rawLattice; setoid) + + +------------------------------------------------------------------------ +-- Bundles with 2 binary operations & 1 element +------------------------------------------------------------------------ + +record RawNearSemiring c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + 0# : Carrier + + +-rawMonoid : RawMonoid c ℓ + +-rawMonoid = record + { _≈_ = _≈_ + ; _∙_ = _+_ + ; ε = 0# + } + + open RawMonoid +-rawMonoid public + using (_≉_) renaming (rawMagma to +-rawMagma) + + *-rawMagma : RawMagma c ℓ + *-rawMagma = record + { _≈_ = _≈_ + ; _∙_ = _*_ + } + + +record NearSemiring c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + 0# : Carrier + isNearSemiring : IsNearSemiring _≈_ _+_ _*_ 0# + + open IsNearSemiring isNearSemiring public + + rawNearSemiring : RawNearSemiring _ _ + rawNearSemiring = record + { _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; 0# = 0# + } + + +-monoid : Monoid _ _ + +-monoid = record { isMonoid = +-isMonoid } + + open Monoid +-monoid public + using (_≉_) renaming + ( rawMagma to +-rawMagma + ; magma to +-magma + ; semigroup to +-semigroup + ; rawMonoid to +-rawMonoid + ) + + *-semigroup : Semigroup _ _ + *-semigroup = record { isSemigroup = *-isSemigroup } + + open Semigroup *-semigroup public + using () renaming + ( rawMagma to *-rawMagma + ; magma to *-magma + ) + + +record SemiringWithoutOne c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + 0# : Carrier + isSemiringWithoutOne : IsSemiringWithoutOne _≈_ _+_ _*_ 0# + + open IsSemiringWithoutOne isSemiringWithoutOne public + + nearSemiring : NearSemiring _ _ + nearSemiring = record { isNearSemiring = isNearSemiring } + + open NearSemiring nearSemiring public + using + ( _≉_; +-rawMagma; +-magma; +-semigroup + ; +-rawMonoid; +-monoid + ; *-rawMagma; *-magma; *-semigroup + ; rawNearSemiring + ) + + +-commutativeMonoid : CommutativeMonoid _ _ + +-commutativeMonoid = record { isCommutativeMonoid = +-isCommutativeMonoid } + + open CommutativeMonoid +-commutativeMonoid public + using () renaming + ( commutativeMagma to +-commutativeMagma + ; commutativeSemigroup to +-commutativeSemigroup + ) + + +record CommutativeSemiringWithoutOne c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + 0# : Carrier + isCommutativeSemiringWithoutOne : + IsCommutativeSemiringWithoutOne _≈_ _+_ _*_ 0# + + open IsCommutativeSemiringWithoutOne + isCommutativeSemiringWithoutOne public + + semiringWithoutOne : SemiringWithoutOne _ _ + semiringWithoutOne = + record { isSemiringWithoutOne = isSemiringWithoutOne } + + open SemiringWithoutOne semiringWithoutOne public + using + ( _≉_; +-rawMagma; +-magma; +-semigroup; +-commutativeSemigroup + ; *-rawMagma; *-magma; *-semigroup + ; +-rawMonoid; +-monoid; +-commutativeMonoid + ; nearSemiring; rawNearSemiring + ) + +------------------------------------------------------------------------ +-- Bundles with 2 binary operations & 2 elements +------------------------------------------------------------------------ + +record RawSemiring c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + 0# : Carrier + 1# : Carrier + + rawNearSemiring : RawNearSemiring c ℓ + rawNearSemiring = record + { _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; 0# = 0# + } + + open RawNearSemiring rawNearSemiring public + using (_≉_; +-rawMonoid; +-rawMagma; *-rawMagma) + + *-rawMonoid : RawMonoid c ℓ + *-rawMonoid = record + { _≈_ = _≈_ + ; _∙_ = _*_ + ; ε = 1# + } + + +record SemiringWithoutAnnihilatingZero c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + 0# : Carrier + 1# : Carrier + isSemiringWithoutAnnihilatingZero : + IsSemiringWithoutAnnihilatingZero _≈_ _+_ _*_ 0# 1# + + open IsSemiringWithoutAnnihilatingZero + isSemiringWithoutAnnihilatingZero public + + rawSemiring : RawSemiring c ℓ + rawSemiring = record + { _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; 0# = 0# + ; 1# = 1# + } + + open RawSemiring rawSemiring public + using (rawNearSemiring) + + +-commutativeMonoid : CommutativeMonoid _ _ + +-commutativeMonoid = + record { isCommutativeMonoid = +-isCommutativeMonoid } + + open CommutativeMonoid +-commutativeMonoid public + using (_≉_) renaming + ( rawMagma to +-rawMagma + ; magma to +-magma + ; commutativeMagma to +-commutativeMagma + ; semigroup to +-semigroup + ; commutativeSemigroup to +-commutativeSemigroup + ; rawMonoid to +-rawMonoid + ; monoid to +-monoid + ) + + *-monoid : Monoid _ _ + *-monoid = record { isMonoid = *-isMonoid } + + open Monoid *-monoid public + using () renaming + ( rawMagma to *-rawMagma + ; magma to *-magma + ; semigroup to *-semigroup + ; rawMonoid to *-rawMonoid + ) + + +record Semiring c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + 0# : Carrier + 1# : Carrier + isSemiring : IsSemiring _≈_ _+_ _*_ 0# 1# + + open IsSemiring isSemiring public + + semiringWithoutAnnihilatingZero : SemiringWithoutAnnihilatingZero _ _ + semiringWithoutAnnihilatingZero = record + { isSemiringWithoutAnnihilatingZero = + isSemiringWithoutAnnihilatingZero + } + + open SemiringWithoutAnnihilatingZero + semiringWithoutAnnihilatingZero public + using + ( _≉_; +-rawMagma; +-magma; +-commutativeMagma; +-semigroup; +-commutativeSemigroup + ; *-rawMagma; *-magma; *-semigroup + ; +-rawMonoid; +-monoid; +-commutativeMonoid + ; *-rawMonoid; *-monoid + ; rawNearSemiring ; rawSemiring + ) + + semiringWithoutOne : SemiringWithoutOne _ _ + semiringWithoutOne = + record { isSemiringWithoutOne = isSemiringWithoutOne } + + open SemiringWithoutOne semiringWithoutOne public + using (nearSemiring) + + +record CommutativeSemiring c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + 0# : Carrier + 1# : Carrier + isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ 0# 1# + + open IsCommutativeSemiring isCommutativeSemiring public + + semiring : Semiring _ _ + semiring = record { isSemiring = isSemiring } + + open Semiring semiring public + using + ( _≉_; +-rawMagma; +-magma; +-commutativeMagma; +-semigroup; +-commutativeSemigroup + ; *-rawMagma; *-magma; *-semigroup + ; +-rawMonoid; +-monoid; +-commutativeMonoid + ; *-rawMonoid; *-monoid + ; nearSemiring; semiringWithoutOne + ; semiringWithoutAnnihilatingZero + ; rawSemiring + ) + + *-commutativeMonoid : CommutativeMonoid _ _ + *-commutativeMonoid = record + { isCommutativeMonoid = *-isCommutativeMonoid + } + + open CommutativeMonoid *-commutativeMonoid public + using () renaming + ( commutativeMagma to *-commutativeMagma + ; commutativeSemigroup to *-commutativeSemigroup + ) + + commutativeSemiringWithoutOne : CommutativeSemiringWithoutOne _ _ + commutativeSemiringWithoutOne = record + { isCommutativeSemiringWithoutOne = isCommutativeSemiringWithoutOne + } + + +record CancellativeCommutativeSemiring c ℓ : Set (suc (c ⊔ ℓ)) where + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + 0# : Carrier + 1# : Carrier + isCancellativeCommutativeSemiring : IsCancellativeCommutativeSemiring _≈_ _+_ _*_ 0# 1# + + open IsCancellativeCommutativeSemiring isCancellativeCommutativeSemiring public + + commutativeSemiring : CommutativeSemiring c ℓ + commutativeSemiring = record + { isCommutativeSemiring = isCommutativeSemiring + } + + open CommutativeSemiring commutativeSemiring public + using + ( +-rawMagma; +-magma; +-commutativeMagma; +-semigroup; +-commutativeSemigroup + ; *-rawMagma; *-magma; *-commutativeMagma; *-semigroup; *-commutativeSemigroup + ; +-rawMonoid; +-monoid; +-commutativeMonoid + ; *-rawMonoid; *-monoid; *-commutativeMonoid + ; nearSemiring; semiringWithoutOne + ; semiringWithoutAnnihilatingZero + ; rawSemiring + ; semiring + ; _≉_ + ) + + +------------------------------------------------------------------------ +-- Bundles with 2 binary operations, 1 unary operation & 2 elements +------------------------------------------------------------------------ + +-- A raw ring is a ring without any laws. + +record RawRing c ℓ : Set (suc (c ⊔ ℓ)) where + infix 8 -_ + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + -_ : Op₁ Carrier + 0# : Carrier + 1# : Carrier + + rawSemiring : RawSemiring c ℓ + rawSemiring = record + { _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; 0# = 0# + ; 1# = 1# + } + + open RawSemiring rawSemiring public + using + ( _≉_ + ; +-rawMagma; +-rawMonoid + ; *-rawMagma; *-rawMonoid + ) + + +-rawGroup : RawGroup c ℓ + +-rawGroup = record + { _≈_ = _≈_ + ; _∙_ = _+_ + ; ε = 0# + ; _⁻¹ = -_ + } + +record Ring c ℓ : Set (suc (c ⊔ ℓ)) where + infix 8 -_ + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + -_ : Op₁ Carrier + 0# : Carrier + 1# : Carrier + isRing : IsRing _≈_ _+_ _*_ -_ 0# 1# + + open IsRing isRing public + + +-abelianGroup : AbelianGroup _ _ + +-abelianGroup = record { isAbelianGroup = +-isAbelianGroup } + + semiring : Semiring _ _ + semiring = record { isSemiring = isSemiring } + + open Semiring semiring public + using + ( _≉_; +-rawMagma; +-magma; +-commutativeMagma; +-semigroup; +-commutativeSemigroup + ; *-rawMagma; *-magma; *-semigroup + ; +-rawMonoid; +-monoid ; +-commutativeMonoid + ; *-rawMonoid; *-monoid + ; nearSemiring; semiringWithoutOne + ; semiringWithoutAnnihilatingZero + ) + + open AbelianGroup +-abelianGroup public + using () renaming (group to +-group) + + rawRing : RawRing _ _ + rawRing = record + { _≈_ = _≈_ + ; _+_ = _+_ + ; _*_ = _*_ + ; -_ = -_ + ; 0# = 0# + ; 1# = 1# + } + + +record CommutativeRing c ℓ : Set (suc (c ⊔ ℓ)) where + infix 8 -_ + infixl 7 _*_ + infixl 6 _+_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _+_ : Op₂ Carrier + _*_ : Op₂ Carrier + -_ : Op₁ Carrier + 0# : Carrier + 1# : Carrier + isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ 0# 1# + + open IsCommutativeRing isCommutativeRing public + + ring : Ring _ _ + ring = record { isRing = isRing } + + open Ring ring public using (_≉_; rawRing; +-group; +-abelianGroup) + + commutativeSemiring : CommutativeSemiring _ _ + commutativeSemiring = + record { isCommutativeSemiring = isCommutativeSemiring } + + open CommutativeSemiring commutativeSemiring public + using + ( +-rawMagma; +-magma; +-commutativeMagma; +-semigroup; +-commutativeSemigroup + ; *-rawMagma; *-magma; *-commutativeMagma; *-semigroup; *-commutativeSemigroup + ; +-rawMonoid; +-monoid; +-commutativeMonoid + ; *-rawMonoid; *-monoid; *-commutativeMonoid + ; nearSemiring; semiringWithoutOne + ; semiringWithoutAnnihilatingZero; semiring + ; commutativeSemiringWithoutOne + ) + + +record BooleanAlgebra c ℓ : Set (suc (c ⊔ ℓ)) where + infix 8 ¬_ + infixr 7 _∧_ + infixr 6 _∨_ + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + _∨_ : Op₂ Carrier + _∧_ : Op₂ Carrier + ¬_ : Op₁ Carrier + ⊤ : Carrier + ⊥ : Carrier + isBooleanAlgebra : IsBooleanAlgebra _≈_ _∨_ _∧_ ¬_ ⊤ ⊥ + + open IsBooleanAlgebra isBooleanAlgebra public + + distributiveLattice : DistributiveLattice _ _ + distributiveLattice = record { isDistributiveLattice = isDistributiveLattice } + + open DistributiveLattice distributiveLattice public + using (_≉_; setoid; lattice) + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.0 + +RawSemigroup = RawMagma +{-# WARNING_ON_USAGE RawSemigroup +"Warning: RawSemigroup was deprecated in v1.0. +Please use RawMagma instead." +#-} +\ No newline at end of file diff --git a/docs/Algebra.Consequences.Base.html b/docs/Algebra.Consequences.Base.html new file mode 100644 index 0000000..5aab33e --- /dev/null +++ b/docs/Algebra.Consequences.Base.html @@ -0,0 +1,24 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Lemmas relating algebraic definitions (such as associativity and +-- commutativity) that don't the equality relation to be a setoid. +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Algebra.Consequences.Base + {a} {A : Set a} where + +open import Algebra.Core +open import Algebra.Definitions +open import Data.Sum.Base +open import Relation.Binary.Core + +sel⇒idem : ∀ {ℓ} {_•_ : Op₂ A} (_≈_ : Rel A ℓ) → + Selective _≈_ _•_ → Idempotent _≈_ _•_ +sel⇒idem _ sel x with sel x x +... | inj₁ x•x≈x = x•x≈x +... | inj₂ x•x≈x = x•x≈x +\ No newline at end of file diff --git a/docs/Algebra.Consequences.Propositional.html b/docs/Algebra.Consequences.Propositional.html new file mode 100644 index 0000000..b24a626 --- /dev/null +++ b/docs/Algebra.Consequences.Propositional.html @@ -0,0 +1,108 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Relations between properties of functions, such as associativity and +-- commutativity (specialised to propositional equality) +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Algebra.Consequences.Propositional + {a} {A : Set a} where + +open import Data.Sum.Base using (inj₁; inj₂) +open import Relation.Binary using (Rel; Setoid; Symmetric; Total) +open import Relation.Binary.PropositionalEquality +open import Relation.Unary using (Pred) + +open import Algebra.Core +open import Algebra.Definitions {A = A} _≡_ +import Algebra.Consequences.Setoid (setoid A) as Base + +------------------------------------------------------------------------ +-- Re-export all proofs that don't require congruence or substitutivity + +open Base public + hiding + ( assoc+distribʳ+idʳ+invʳ⇒zeˡ + ; assoc+distribˡ+idʳ+invʳ⇒zeʳ + ; assoc+id+invʳ⇒invˡ-unique + ; assoc+id+invˡ⇒invʳ-unique + ; comm+distrˡ⇒distrʳ + ; comm+distrʳ⇒distrˡ + ; comm⇒sym[distribˡ] + ; subst+comm⇒sym + ; wlog + ; sel⇒idem + ) + +------------------------------------------------------------------------ +-- Group-like structures + +module _ {_•_ _⁻¹ ε} where + + assoc+id+invʳ⇒invˡ-unique : Associative _•_ → Identity ε _•_ → + RightInverse ε _⁻¹ _•_ → + ∀ x y → (x • y) ≡ ε → x ≡ (y ⁻¹) + assoc+id+invʳ⇒invˡ-unique = Base.assoc+id+invʳ⇒invˡ-unique (cong₂ _) + + assoc+id+invˡ⇒invʳ-unique : Associative _•_ → Identity ε _•_ → + LeftInverse ε _⁻¹ _•_ → + ∀ x y → (x • y) ≡ ε → y ≡ (x ⁻¹) + assoc+id+invˡ⇒invʳ-unique = Base.assoc+id+invˡ⇒invʳ-unique (cong₂ _) + +------------------------------------------------------------------------ +-- Ring-like structures + +module _ {_+_ _*_ -_ 0#} where + + assoc+distribʳ+idʳ+invʳ⇒zeˡ : Associative _+_ → _*_ DistributesOverʳ _+_ → + RightIdentity 0# _+_ → RightInverse 0# -_ _+_ → + LeftZero 0# _*_ + assoc+distribʳ+idʳ+invʳ⇒zeˡ = + Base.assoc+distribʳ+idʳ+invʳ⇒zeˡ (cong₂ _+_) (cong₂ _*_) + + assoc+distribˡ+idʳ+invʳ⇒zeʳ : Associative _+_ → _*_ DistributesOverˡ _+_ → + RightIdentity 0# _+_ → RightInverse 0# -_ _+_ → + RightZero 0# _*_ + assoc+distribˡ+idʳ+invʳ⇒zeʳ = + Base.assoc+distribˡ+idʳ+invʳ⇒zeʳ (cong₂ _+_) (cong₂ _*_) + +------------------------------------------------------------------------ +-- Bisemigroup-like structures + +module _ {_•_ _◦_ : Op₂ A} (•-comm : Commutative _•_) where + + comm+distrˡ⇒distrʳ : _•_ DistributesOverˡ _◦_ → _•_ DistributesOverʳ _◦_ + comm+distrˡ⇒distrʳ = Base.comm+distrˡ⇒distrʳ (cong₂ _) •-comm + + comm+distrʳ⇒distrˡ : _•_ DistributesOverʳ _◦_ → _•_ DistributesOverˡ _◦_ + comm+distrʳ⇒distrˡ = Base.comm+distrʳ⇒distrˡ (cong₂ _) •-comm + + comm⇒sym[distribˡ] : ∀ x → Symmetric (λ y z → (x ◦ (y • z)) ≡ ((x ◦ y) • (x ◦ z))) + comm⇒sym[distribˡ] = Base.comm⇒sym[distribˡ] (cong₂ _◦_) •-comm + +------------------------------------------------------------------------ +-- Selectivity + +module _ {_•_ : Op₂ A} where + + sel⇒idem : Selective _•_ → Idempotent _•_ + sel⇒idem = Base.sel⇒idem _≡_ + +------------------------------------------------------------------------ +-- Without Loss of Generality + +module _ {p} {P : Pred A p} where + + subst+comm⇒sym : ∀ {f} (f-comm : Commutative f) → + Symmetric (λ a b → P (f a b)) + subst+comm⇒sym = Base.subst+comm⇒sym {P = P} subst + + wlog : ∀ {f} (f-comm : Commutative f) → + ∀ {r} {_R_ : Rel _ r} → Total _R_ → + (∀ a b → a R b → P (f a b)) → + ∀ a b → P (f a b) + wlog = Base.wlog {P = P} subst +\ No newline at end of file diff --git a/docs/Algebra.Consequences.Setoid.html b/docs/Algebra.Consequences.Setoid.html new file mode 100644 index 0000000..536e579 --- /dev/null +++ b/docs/Algebra.Consequences.Setoid.html @@ -0,0 +1,216 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Relations between properties of functions, such as associativity and +-- commutativity, when the underlying relation is a setoid +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary using (Rel; Setoid; Substitutive; Symmetric; Total) + +module Algebra.Consequences.Setoid {a ℓ} (S : Setoid a ℓ) where + +open Setoid S renaming (Carrier to A) +open import Algebra.Core +open import Algebra.Definitions _≈_ +open import Data.Sum.Base using (inj₁; inj₂) +open import Data.Product using (_,_) +open import Function.Base using (_$_) +import Relation.Binary.Consequences as Bin +open import Relation.Binary.Reasoning.Setoid S +open import Relation.Unary using (Pred) + +------------------------------------------------------------------------ +-- Re-exports + +-- Export base lemmas that don't require the setoid + +open import Algebra.Consequences.Base public + +------------------------------------------------------------------------ +-- Magma-like structures + +module _ {_•_ : Op₂ A} (comm : Commutative _•_) where + + comm+cancelˡ⇒cancelʳ : LeftCancellative _•_ → RightCancellative _•_ + comm+cancelˡ⇒cancelʳ cancelˡ {x} y z eq = cancelˡ x $ begin + x • y ≈⟨ comm x y ⟩ + y • x ≈⟨ eq ⟩ + z • x ≈⟨ comm z x ⟩ + x • z ∎ + + comm+cancelʳ⇒cancelˡ : RightCancellative _•_ → LeftCancellative _•_ + comm+cancelʳ⇒cancelˡ cancelʳ x {y} {z} eq = cancelʳ y z $ begin + y • x ≈⟨ comm y x ⟩ + x • y ≈⟨ eq ⟩ + x • z ≈⟨ comm x z ⟩ + z • x ∎ + +------------------------------------------------------------------------ +-- Monoid-like structures + +module _ {_•_ : Op₂ A} (comm : Commutative _•_) {e : A} where + + comm+idˡ⇒idʳ : LeftIdentity e _•_ → RightIdentity e _•_ + comm+idˡ⇒idʳ idˡ x = begin + x • e ≈⟨ comm x e ⟩ + e • x ≈⟨ idˡ x ⟩ + x ∎ + + comm+idʳ⇒idˡ : RightIdentity e _•_ → LeftIdentity e _•_ + comm+idʳ⇒idˡ idʳ x = begin + e • x ≈⟨ comm e x ⟩ + x • e ≈⟨ idʳ x ⟩ + x ∎ + + comm+zeˡ⇒zeʳ : LeftZero e _•_ → RightZero e _•_ + comm+zeˡ⇒zeʳ zeˡ x = begin + x • e ≈⟨ comm x e ⟩ + e • x ≈⟨ zeˡ x ⟩ + e ∎ + + comm+zeʳ⇒zeˡ : RightZero e _•_ → LeftZero e _•_ + comm+zeʳ⇒zeˡ zeʳ x = begin + e • x ≈⟨ comm e x ⟩ + x • e ≈⟨ zeʳ x ⟩ + e ∎ + + comm+almostCancelˡ⇒almostCancelʳ : AlmostLeftCancellative e _•_ → + AlmostRightCancellative e _•_ + comm+almostCancelˡ⇒almostCancelʳ cancelˡ-nonZero {x} y z x≉e yx≈zx = + cancelˡ-nonZero y z x≉e $ begin + x • y ≈⟨ comm x y ⟩ + y • x ≈⟨ yx≈zx ⟩ + z • x ≈⟨ comm z x ⟩ + x • z ∎ + + comm+almostCancelʳ⇒almostCancelˡ : AlmostRightCancellative e _•_ → + AlmostLeftCancellative e _•_ + comm+almostCancelʳ⇒almostCancelˡ cancelʳ-nonZero {x} y z x≉e xy≈xz = + cancelʳ-nonZero y z x≉e $ begin + y • x ≈⟨ comm y x ⟩ + x • y ≈⟨ xy≈xz ⟩ + x • z ≈⟨ comm x z ⟩ + z • x ∎ + +------------------------------------------------------------------------ +-- Group-like structures + +module _ {_•_ : Op₂ A} {_⁻¹ : Op₁ A} {e} (comm : Commutative _•_) where + + comm+invˡ⇒invʳ : LeftInverse e _⁻¹ _•_ → RightInverse e _⁻¹ _•_ + comm+invˡ⇒invʳ invˡ x = begin + x • (x ⁻¹) ≈⟨ comm x (x ⁻¹) ⟩ + (x ⁻¹) • x ≈⟨ invˡ x ⟩ + e ∎ + + comm+invʳ⇒invˡ : RightInverse e _⁻¹ _•_ → LeftInverse e _⁻¹ _•_ + comm+invʳ⇒invˡ invʳ x = begin + (x ⁻¹) • x ≈⟨ comm (x ⁻¹) x ⟩ + x • (x ⁻¹) ≈⟨ invʳ x ⟩ + e ∎ + +module _ {_•_ : Op₂ A} {_⁻¹ : Op₁ A} {e} (cong : Congruent₂ _•_) where + + assoc+id+invʳ⇒invˡ-unique : Associative _•_ → + Identity e _•_ → RightInverse e _⁻¹ _•_ → + ∀ x y → (x • y) ≈ e → x ≈ (y ⁻¹) + assoc+id+invʳ⇒invˡ-unique assoc (idˡ , idʳ) invʳ x y eq = begin + x ≈⟨ sym (idʳ x) ⟩ + x • e ≈⟨ cong refl (sym (invʳ y)) ⟩ + x • (y • (y ⁻¹)) ≈⟨ sym (assoc x y (y ⁻¹)) ⟩ + (x • y) • (y ⁻¹) ≈⟨ cong eq refl ⟩ + e • (y ⁻¹) ≈⟨ idˡ (y ⁻¹) ⟩ + y ⁻¹ ∎ + + assoc+id+invˡ⇒invʳ-unique : Associative _•_ → + Identity e _•_ → LeftInverse e _⁻¹ _•_ → + ∀ x y → (x • y) ≈ e → y ≈ (x ⁻¹) + assoc+id+invˡ⇒invʳ-unique assoc (idˡ , idʳ) invˡ x y eq = begin + y ≈⟨ sym (idˡ y) ⟩ + e • y ≈⟨ cong (sym (invˡ x)) refl ⟩ + ((x ⁻¹) • x) • y ≈⟨ assoc (x ⁻¹) x y ⟩ + (x ⁻¹) • (x • y) ≈⟨ cong refl eq ⟩ + (x ⁻¹) • e ≈⟨ idʳ (x ⁻¹) ⟩ + x ⁻¹ ∎ + +---------------------------------------------------------------------- +-- Bisemigroup-like structures + +module _ {_•_ _◦_ : Op₂ A} + (◦-cong : Congruent₂ _◦_) + (•-comm : Commutative _•_) + where + + comm+distrˡ⇒distrʳ : _•_ DistributesOverˡ _◦_ → _•_ DistributesOverʳ _◦_ + comm+distrˡ⇒distrʳ distrˡ x y z = begin + (y ◦ z) • x ≈⟨ •-comm (y ◦ z) x ⟩ + x • (y ◦ z) ≈⟨ distrˡ x y z ⟩ + (x • y) ◦ (x • z) ≈⟨ ◦-cong (•-comm x y) (•-comm x z) ⟩ + (y • x) ◦ (z • x) ∎ + + comm+distrʳ⇒distrˡ : _•_ DistributesOverʳ _◦_ → _•_ DistributesOverˡ _◦_ + comm+distrʳ⇒distrˡ distrˡ x y z = begin + x • (y ◦ z) ≈⟨ •-comm x (y ◦ z) ⟩ + (y ◦ z) • x ≈⟨ distrˡ x y z ⟩ + (y • x) ◦ (z • x) ≈⟨ ◦-cong (•-comm y x) (•-comm z x) ⟩ + (x • y) ◦ (x • z) ∎ + + comm⇒sym[distribˡ] : ∀ x → Symmetric (λ y z → (x ◦ (y • z)) ≈ ((x ◦ y) • (x ◦ z))) + comm⇒sym[distribˡ] x {y} {z} prf = begin + x ◦ (z • y) ≈⟨ ◦-cong refl (•-comm z y) ⟩ + x ◦ (y • z) ≈⟨ prf ⟩ + (x ◦ y) • (x ◦ z) ≈⟨ •-comm (x ◦ y) (x ◦ z) ⟩ + (x ◦ z) • (x ◦ y) ∎ + +---------------------------------------------------------------------- +-- Ring-like structures + +module _ {_+_ _*_ : Op₂ A} + {_⁻¹ : Op₁ A} {0# : A} + (+-cong : Congruent₂ _+_) + (*-cong : Congruent₂ _*_) + where + + assoc+distribʳ+idʳ+invʳ⇒zeˡ : Associative _+_ → _*_ DistributesOverʳ _+_ → + RightIdentity 0# _+_ → RightInverse 0# _⁻¹ _+_ → + LeftZero 0# _*_ + assoc+distribʳ+idʳ+invʳ⇒zeˡ +-assoc distribʳ idʳ invʳ x = begin + 0# * x ≈⟨ sym (idʳ _) ⟩ + (0# * x) + 0# ≈⟨ +-cong refl (sym (invʳ _)) ⟩ + (0# * x) + ((0# * x) + ((0# * x)⁻¹)) ≈⟨ sym (+-assoc _ _ _) ⟩ + ((0# * x) + (0# * x)) + ((0# * x)⁻¹) ≈⟨ +-cong (sym (distribʳ _ _ _)) refl ⟩ + ((0# + 0#) * x) + ((0# * x)⁻¹) ≈⟨ +-cong (*-cong (idʳ _) refl) refl ⟩ + (0# * x) + ((0# * x)⁻¹) ≈⟨ invʳ _ ⟩ + 0# ∎ + + assoc+distribˡ+idʳ+invʳ⇒zeʳ : Associative _+_ → _*_ DistributesOverˡ _+_ → + RightIdentity 0# _+_ → RightInverse 0# _⁻¹ _+_ → + RightZero 0# _*_ + assoc+distribˡ+idʳ+invʳ⇒zeʳ +-assoc distribˡ idʳ invʳ x = begin + x * 0# ≈⟨ sym (idʳ _) ⟩ + (x * 0#) + 0# ≈⟨ +-cong refl (sym (invʳ _)) ⟩ + (x * 0#) + ((x * 0#) + ((x * 0#)⁻¹)) ≈⟨ sym (+-assoc _ _ _) ⟩ + ((x * 0#) + (x * 0#)) + ((x * 0#)⁻¹) ≈⟨ +-cong (sym (distribˡ _ _ _)) refl ⟩ + (x * (0# + 0#)) + ((x * 0#)⁻¹) ≈⟨ +-cong (*-cong refl (idʳ _)) refl ⟩ + ((x * 0#) + ((x * 0#)⁻¹)) ≈⟨ invʳ _ ⟩ + 0# ∎ + +------------------------------------------------------------------------ +-- Without Loss of Generality + +module _ {p} {f : Op₂ A} {P : Pred A p} + (≈-subst : Substitutive _≈_ p) + (comm : Commutative f) + where + + subst+comm⇒sym : Symmetric (λ a b → P (f a b)) + subst+comm⇒sym = ≈-subst P (comm _ _) + + wlog : ∀ {r} {_R_ : Rel _ r} → Total _R_ → + (∀ a b → a R b → P (f a b)) → + ∀ a b → P (f a b) + wlog r-total = Bin.wlog r-total subst+comm⇒sym +\ No newline at end of file diff --git a/docs/Algebra.Construct.NaturalChoice.Base.html b/docs/Algebra.Construct.NaturalChoice.Base.html new file mode 100644 index 0000000..1eae070 --- /dev/null +++ b/docs/Algebra.Construct.NaturalChoice.Base.html @@ -0,0 +1,63 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Basic definition of an operator that computes the min/max value +-- with respect to a total ordering. +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Algebra.Core +open import Level as L hiding (_⊔_) +open import Function.Base using (flip) +open import Relation.Binary +open import Relation.Binary.Construct.Converse using () + renaming (totalPreorder to flipOrder) +import Relation.Binary.Properties.TotalOrder as TotalOrderProperties + +module Algebra.Construct.NaturalChoice.Base where + +private + variable + a ℓ₁ ℓ₂ : Level + O : TotalPreorder a ℓ₁ ℓ₂ + +------------------------------------------------------------------------ +-- Definition + +module _ (O : TotalPreorder a ℓ₁ ℓ₂) where + open TotalPreorder O renaming (_≲_ to _≤_) + private _≥_ = flip _≤_ + + record MinOperator : Set (a L.⊔ ℓ₁ L.⊔ ℓ₂) where + infixl 7 _⊓_ + field + _⊓_ : Op₂ Carrier + x≤y⇒x⊓y≈x : ∀ {x y} → x ≤ y → x ⊓ y ≈ x + x≥y⇒x⊓y≈y : ∀ {x y} → x ≥ y → x ⊓ y ≈ y + + record MaxOperator : Set (a L.⊔ ℓ₁ L.⊔ ℓ₂) where + infixl 6 _⊔_ + field + _⊔_ : Op₂ Carrier + x≤y⇒x⊔y≈y : ∀ {x y} → x ≤ y → x ⊔ y ≈ y + x≥y⇒x⊔y≈x : ∀ {x y} → x ≥ y → x ⊔ y ≈ x + +------------------------------------------------------------------------ +-- Properties + +MinOp⇒MaxOp : MinOperator O → MaxOperator (flipOrder O) +MinOp⇒MaxOp minOp = record + { _⊔_ = _⊓_ + ; x≤y⇒x⊔y≈y = x≥y⇒x⊓y≈y + ; x≥y⇒x⊔y≈x = x≤y⇒x⊓y≈x + } where open MinOperator minOp + +MaxOp⇒MinOp : MaxOperator O → MinOperator (flipOrder O) +MaxOp⇒MinOp maxOp = record + { _⊓_ = _⊔_ + ; x≤y⇒x⊓y≈x = x≥y⇒x⊔y≈x + ; x≥y⇒x⊓y≈y = x≤y⇒x⊔y≈y + } where open MaxOperator maxOp +\ No newline at end of file diff --git a/docs/Algebra.Construct.NaturalChoice.MaxOp.html b/docs/Algebra.Construct.NaturalChoice.MaxOp.html new file mode 100644 index 0000000..21cb94e --- /dev/null +++ b/docs/Algebra.Construct.NaturalChoice.MaxOp.html @@ -0,0 +1,83 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of a max operator derived from a spec over a total order. +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Algebra.Core +open import Algebra.Construct.NaturalChoice.Base +import Algebra.Construct.NaturalChoice.MinOp as MinOp +open import Function.Base using (flip) +open import Relation.Binary +open import Relation.Binary.Construct.Converse using () + renaming (totalPreorder to flipOrder) + +module Algebra.Construct.NaturalChoice.MaxOp + {a ℓ₁ ℓ₂} {O : TotalPreorder a ℓ₁ ℓ₂} (maxOp : MaxOperator O) + where + +open TotalPreorder O renaming (Carrier to A; _≲_ to _≤_) +open MaxOperator maxOp + +-- Max is just min with a flipped order + +private + module Min = MinOp (MaxOp⇒MinOp maxOp) + +open Min public + using () + renaming + ( ⊓-cong to ⊔-cong + ; ⊓-congʳ to ⊔-congʳ + ; ⊓-congˡ to ⊔-congˡ + ; ⊓-idem to ⊔-idem + ; ⊓-sel to ⊔-sel + ; ⊓-assoc to ⊔-assoc + ; ⊓-comm to ⊔-comm + + ; ⊓-identityˡ to ⊔-identityˡ + ; ⊓-identityʳ to ⊔-identityʳ + ; ⊓-identity to ⊔-identity + ; ⊓-zeroˡ to ⊔-zeroˡ + ; ⊓-zeroʳ to ⊔-zeroʳ + ; ⊓-zero to ⊔-zero + + ; ⊓-isMagma to ⊔-isMagma + ; ⊓-isSemigroup to ⊔-isSemigroup + ; ⊓-isCommutativeSemigroup to ⊔-isCommutativeSemigroup + ; ⊓-isBand to ⊔-isBand + ; ⊓-isSemilattice to ⊔-isSemilattice + ; ⊓-isMonoid to ⊔-isMonoid + ; ⊓-isSelectiveMagma to ⊔-isSelectiveMagma + + ; ⊓-magma to ⊔-magma + ; ⊓-semigroup to ⊔-semigroup + ; ⊓-commutativeSemigroup to ⊔-commutativeSemigroup + ; ⊓-band to ⊔-band + ; ⊓-semilattice to ⊔-semilattice + ; ⊓-monoid to ⊔-monoid + ; ⊓-selectiveMagma to ⊔-selectiveMagma + + ; x⊓y≈y⇒y≤x to x⊔y≈y⇒x≤y + ; x⊓y≈x⇒x≤y to x⊔y≈x⇒y≤x + ; x⊓y≤x to x≤x⊔y + ; x⊓y≤y to x≤y⊔x + ; x≤y⇒x⊓z≤y to x≤y⇒x≤y⊔z + ; x≤y⇒z⊓x≤y to x≤y⇒x≤z⊔y + ; x≤y⊓z⇒x≤y to x⊔y≤z⇒x≤z + ; x≤y⊓z⇒x≤z to x⊔y≤z⇒y≤z + + ; ⊓-glb to ⊔-lub + ; ⊓-triangulate to ⊔-triangulate + ; ⊓-mono-≤ to ⊔-mono-≤ + ; ⊓-monoˡ-≤ to ⊔-monoˡ-≤ + ; ⊓-monoʳ-≤ to ⊔-monoʳ-≤ + ) + +mono-≤-distrib-⊔ : ∀ {f} → f Preserves _≈_ ⟶ _≈_ → f Preserves _≤_ ⟶ _≤_ → + ∀ x y → f (x ⊔ y) ≈ f x ⊔ f y +mono-≤-distrib-⊔ cong pres = Min.mono-≤-distrib-⊓ cong pres +\ No newline at end of file diff --git a/docs/Algebra.Construct.NaturalChoice.MinMaxOp.html b/docs/Algebra.Construct.NaturalChoice.MinMaxOp.html new file mode 100644 index 0000000..ba3d1f5 --- /dev/null +++ b/docs/Algebra.Construct.NaturalChoice.MinMaxOp.html @@ -0,0 +1,201 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of min and max operators specified over a total order +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Algebra.Core +open import Algebra.Bundles +open import Algebra.Construct.NaturalChoice.Base +open import Data.Sum.Base as Sum using (inj₁; inj₂; [_,_]) +open import Data.Product using (_,_) +open import Function.Base using (id; _∘_; flip) +open import Relation.Binary +open import Relation.Binary.Consequences + +module Algebra.Construct.NaturalChoice.MinMaxOp + {a ℓ₁ ℓ₂} {O : TotalPreorder a ℓ₁ ℓ₂} + (minOp : MinOperator O) + (maxOp : MaxOperator O) + where + +open TotalPreorder O renaming + ( Carrier to A + ; _≲_ to _≤_ + ; ≲-resp-≈ to ≤-resp-≈ + ; ≲-respʳ-≈ to ≤-respʳ-≈ + ; ≲-respˡ-≈ to ≤-respˡ-≈ + ) +open MinOperator minOp +open MaxOperator maxOp + +open import Algebra.Definitions _≈_ +open import Algebra.Structures _≈_ +open import Algebra.Consequences.Setoid Eq.setoid +open import Relation.Binary.Reasoning.Preorder preorder + +------------------------------------------------------------------------ +-- Re-export properties of individual operators + +open import Algebra.Construct.NaturalChoice.MinOp minOp public +open import Algebra.Construct.NaturalChoice.MaxOp maxOp public + +------------------------------------------------------------------------ +-- Joint algebraic structures + +⊓-distribˡ-⊔ : _⊓_ DistributesOverˡ _⊔_ +⊓-distribˡ-⊔ x y z with total y z +... | inj₁ y≤z = begin-equality + x ⊓ (y ⊔ z) ≈⟨ ⊓-congˡ x (x≤y⇒x⊔y≈y y≤z) ⟩ + x ⊓ z ≈˘⟨ x≤y⇒x⊔y≈y (⊓-monoʳ-≤ x y≤z) ⟩ + (x ⊓ y) ⊔ (x ⊓ z) ∎ +... | inj₂ y≥z = begin-equality + x ⊓ (y ⊔ z) ≈⟨ ⊓-congˡ x (x≥y⇒x⊔y≈x y≥z) ⟩ + x ⊓ y ≈˘⟨ x≥y⇒x⊔y≈x (⊓-monoʳ-≤ x y≥z) ⟩ + (x ⊓ y) ⊔ (x ⊓ z) ∎ + +⊓-distribʳ-⊔ : _⊓_ DistributesOverʳ _⊔_ +⊓-distribʳ-⊔ = comm+distrˡ⇒distrʳ ⊔-cong ⊓-comm ⊓-distribˡ-⊔ + +⊓-distrib-⊔ : _⊓_ DistributesOver _⊔_ +⊓-distrib-⊔ = ⊓-distribˡ-⊔ , ⊓-distribʳ-⊔ + +⊔-distribˡ-⊓ : _⊔_ DistributesOverˡ _⊓_ +⊔-distribˡ-⊓ x y z with total y z +... | inj₁ y≤z = begin-equality + x ⊔ (y ⊓ z) ≈⟨ ⊔-congˡ x (x≤y⇒x⊓y≈x y≤z) ⟩ + x ⊔ y ≈˘⟨ x≤y⇒x⊓y≈x (⊔-monoʳ-≤ x y≤z) ⟩ + (x ⊔ y) ⊓ (x ⊔ z) ∎ +... | inj₂ y≥z = begin-equality + x ⊔ (y ⊓ z) ≈⟨ ⊔-congˡ x (x≥y⇒x⊓y≈y y≥z) ⟩ + x ⊔ z ≈˘⟨ x≥y⇒x⊓y≈y (⊔-monoʳ-≤ x y≥z) ⟩ + (x ⊔ y) ⊓ (x ⊔ z) ∎ + +⊔-distribʳ-⊓ : _⊔_ DistributesOverʳ _⊓_ +⊔-distribʳ-⊓ = comm+distrˡ⇒distrʳ ⊓-cong ⊔-comm ⊔-distribˡ-⊓ + +⊔-distrib-⊓ : _⊔_ DistributesOver _⊓_ +⊔-distrib-⊓ = ⊔-distribˡ-⊓ , ⊔-distribʳ-⊓ + +⊓-absorbs-⊔ : _⊓_ Absorbs _⊔_ +⊓-absorbs-⊔ x y with total x y +... | inj₁ x≤y = begin-equality + x ⊓ (x ⊔ y) ≈⟨ ⊓-congˡ x (x≤y⇒x⊔y≈y x≤y) ⟩ + x ⊓ y ≈⟨ x≤y⇒x⊓y≈x x≤y ⟩ + x ∎ +... | inj₂ y≤x = begin-equality + x ⊓ (x ⊔ y) ≈⟨ ⊓-congˡ x (x≥y⇒x⊔y≈x y≤x) ⟩ + x ⊓ x ≈⟨ ⊓-idem x ⟩ + x ∎ + +⊔-absorbs-⊓ : _⊔_ Absorbs _⊓_ +⊔-absorbs-⊓ x y with total x y +... | inj₁ x≤y = begin-equality + x ⊔ (x ⊓ y) ≈⟨ ⊔-congˡ x (x≤y⇒x⊓y≈x x≤y) ⟩ + x ⊔ x ≈⟨ ⊔-idem x ⟩ + x ∎ +... | inj₂ y≤x = begin-equality + x ⊔ (x ⊓ y) ≈⟨ ⊔-congˡ x (x≥y⇒x⊓y≈y y≤x) ⟩ + x ⊔ y ≈⟨ x≥y⇒x⊔y≈x y≤x ⟩ + x ∎ + +⊔-⊓-absorptive : Absorptive _⊔_ _⊓_ +⊔-⊓-absorptive = ⊔-absorbs-⊓ , ⊓-absorbs-⊔ + +⊓-⊔-absorptive : Absorptive _⊓_ _⊔_ +⊓-⊔-absorptive = ⊓-absorbs-⊔ , ⊔-absorbs-⊓ + +⊔-⊓-isLattice : IsLattice _⊔_ _⊓_ +⊔-⊓-isLattice = record + { isEquivalence = isEquivalence + ; ∨-comm = ⊔-comm + ; ∨-assoc = ⊔-assoc + ; ∨-cong = ⊔-cong + ; ∧-comm = ⊓-comm + ; ∧-assoc = ⊓-assoc + ; ∧-cong = ⊓-cong + ; absorptive = ⊔-⊓-absorptive + } + +⊓-⊔-isLattice : IsLattice _⊓_ _⊔_ +⊓-⊔-isLattice = record + { isEquivalence = isEquivalence + ; ∨-comm = ⊓-comm + ; ∨-assoc = ⊓-assoc + ; ∨-cong = ⊓-cong + ; ∧-comm = ⊔-comm + ; ∧-assoc = ⊔-assoc + ; ∧-cong = ⊔-cong + ; absorptive = ⊓-⊔-absorptive + } + +⊓-⊔-isDistributiveLattice : IsDistributiveLattice _⊓_ _⊔_ +⊓-⊔-isDistributiveLattice = record + { isLattice = ⊓-⊔-isLattice + ; ∨-distribʳ-∧ = ⊓-distribʳ-⊔ + } + +⊔-⊓-isDistributiveLattice : IsDistributiveLattice _⊔_ _⊓_ +⊔-⊓-isDistributiveLattice = record + { isLattice = ⊔-⊓-isLattice + ; ∨-distribʳ-∧ = ⊔-distribʳ-⊓ + } + +⊔-⊓-lattice : Lattice _ _ +⊔-⊓-lattice = record + { isLattice = ⊔-⊓-isLattice + } + +⊓-⊔-lattice : Lattice _ _ +⊓-⊔-lattice = record + { isLattice = ⊓-⊔-isLattice + } + +⊔-⊓-distributiveLattice : DistributiveLattice _ _ +⊔-⊓-distributiveLattice = record + { isDistributiveLattice = ⊔-⊓-isDistributiveLattice + } + +⊓-⊔-distributiveLattice : DistributiveLattice _ _ +⊓-⊔-distributiveLattice = record + { isDistributiveLattice = ⊓-⊔-isDistributiveLattice + } + +------------------------------------------------------------------------ +-- Other joint properties + +private _≥_ = flip _≤_ + +antimono-≤-distrib-⊓ : ∀ {f} → f Preserves _≈_ ⟶ _≈_ → f Preserves _≤_ ⟶ _≥_ → + ∀ x y → f (x ⊓ y) ≈ f x ⊔ f y +antimono-≤-distrib-⊓ {f} cong antimono x y with total x y +... | inj₁ x≤y = begin-equality + f (x ⊓ y) ≈⟨ cong (x≤y⇒x⊓y≈x x≤y) ⟩ + f x ≈˘⟨ x≥y⇒x⊔y≈x (antimono x≤y) ⟩ + f x ⊔ f y ∎ +... | inj₂ y≤x = begin-equality + f (x ⊓ y) ≈⟨ cong (x≥y⇒x⊓y≈y y≤x) ⟩ + f y ≈˘⟨ x≤y⇒x⊔y≈y (antimono y≤x) ⟩ + f x ⊔ f y ∎ + +antimono-≤-distrib-⊔ : ∀ {f} → f Preserves _≈_ ⟶ _≈_ → f Preserves _≤_ ⟶ _≥_ → + ∀ x y → f (x ⊔ y) ≈ f x ⊓ f y +antimono-≤-distrib-⊔ {f} cong antimono x y with total x y +... | inj₁ x≤y = begin-equality + f (x ⊔ y) ≈⟨ cong (x≤y⇒x⊔y≈y x≤y) ⟩ + f y ≈˘⟨ x≥y⇒x⊓y≈y (antimono x≤y) ⟩ + f x ⊓ f y ∎ +... | inj₂ y≤x = begin-equality + f (x ⊔ y) ≈⟨ cong (x≥y⇒x⊔y≈x y≤x) ⟩ + f x ≈˘⟨ x≤y⇒x⊓y≈x (antimono y≤x) ⟩ + f x ⊓ f y ∎ + +x⊓y≤x⊔y : ∀ x y → x ⊓ y ≤ x ⊔ y +x⊓y≤x⊔y x y = begin + x ⊓ y ∼⟨ x⊓y≤x x y ⟩ + x ∼⟨ x≤x⊔y x y ⟩ + x ⊔ y ∎ +\ No newline at end of file diff --git a/docs/Algebra.Construct.NaturalChoice.MinOp.html b/docs/Algebra.Construct.NaturalChoice.MinOp.html new file mode 100644 index 0000000..4ee3ffb --- /dev/null +++ b/docs/Algebra.Construct.NaturalChoice.MinOp.html @@ -0,0 +1,267 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of a min operator derived from a spec over a total order. +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Algebra.Core +open import Algebra.Bundles +open import Algebra.Construct.NaturalChoice.Base +open import Data.Sum.Base as Sum using (inj₁; inj₂; [_,_]) +open import Data.Product using (_,_) +open import Function.Base using (id; _∘_) +open import Relation.Binary +open import Relation.Binary.Consequences + +module Algebra.Construct.NaturalChoice.MinOp + {a ℓ₁ ℓ₂} {O : TotalPreorder a ℓ₁ ℓ₂} (minOp : MinOperator O) where + +open TotalPreorder O renaming + ( Carrier to A + ; _≲_ to _≤_ + ; ≲-resp-≈ to ≤-resp-≈ + ; ≲-respʳ-≈ to ≤-respʳ-≈ + ; ≲-respˡ-≈ to ≤-respˡ-≈ + ) +open MinOperator minOp + +open import Algebra.Definitions _≈_ +open import Algebra.Structures _≈_ +open import Relation.Binary.Reasoning.Preorder preorder + +------------------------------------------------------------------------ +-- Helpful properties + +x⊓y≤x : ∀ x y → x ⊓ y ≤ x +x⊓y≤x x y with total x y +... | inj₁ x≤y = ≤-respˡ-≈ (Eq.sym (x≤y⇒x⊓y≈x x≤y)) refl +... | inj₂ y≤x = ≤-respˡ-≈ (Eq.sym (x≥y⇒x⊓y≈y y≤x)) y≤x + +x⊓y≤y : ∀ x y → x ⊓ y ≤ y +x⊓y≤y x y with total x y +... | inj₁ x≤y = ≤-respˡ-≈ (Eq.sym (x≤y⇒x⊓y≈x x≤y)) x≤y +... | inj₂ y≤x = ≤-respˡ-≈ (Eq.sym (x≥y⇒x⊓y≈y y≤x)) refl + +------------------------------------------------------------------------ +-- Algebraic properties + +⊓-comm : Commutative _⊓_ +⊓-comm x y with total x y +... | inj₁ x≤y = Eq.trans (x≤y⇒x⊓y≈x x≤y) (Eq.sym (x≥y⇒x⊓y≈y x≤y)) +... | inj₂ y≤x = Eq.trans (x≥y⇒x⊓y≈y y≤x) (Eq.sym (x≤y⇒x⊓y≈x y≤x)) + +⊓-congˡ : ∀ x → Congruent₁ (x ⊓_) +⊓-congˡ x {y} {r} y≈r with total x y +... | inj₁ x≤y = begin-equality + x ⊓ y ≈⟨ x≤y⇒x⊓y≈x x≤y ⟩ + x ≈˘⟨ x≤y⇒x⊓y≈x (≤-respʳ-≈ y≈r x≤y) ⟩ + x ⊓ r ∎ +... | inj₂ y≤x = begin-equality + x ⊓ y ≈⟨ x≥y⇒x⊓y≈y y≤x ⟩ + y ≈⟨ y≈r ⟩ + r ≈˘⟨ x≥y⇒x⊓y≈y (≤-respˡ-≈ y≈r y≤x) ⟩ + x ⊓ r ∎ + +⊓-congʳ : ∀ x → Congruent₁ (_⊓ x) +⊓-congʳ x {y₁} {y₂} y₁≈y₂ = begin-equality + y₁ ⊓ x ≈˘⟨ ⊓-comm x y₁ ⟩ + x ⊓ y₁ ≈⟨ ⊓-congˡ x y₁≈y₂ ⟩ + x ⊓ y₂ ≈⟨ ⊓-comm x y₂ ⟩ + y₂ ⊓ x ∎ + +⊓-cong : Congruent₂ _⊓_ +⊓-cong {x₁} {x₂} {y₁} {y₂} x₁≈x₂ y₁≈y₂ = Eq.trans (⊓-congˡ x₁ y₁≈y₂) (⊓-congʳ y₂ x₁≈x₂) + +⊓-assoc : Associative _⊓_ +⊓-assoc x y r with total x y | total y r +⊓-assoc x y r | inj₁ x≤y | inj₁ y≤r = begin-equality + (x ⊓ y) ⊓ r ≈⟨ ⊓-congʳ r (x≤y⇒x⊓y≈x x≤y) ⟩ + x ⊓ r ≈⟨ x≤y⇒x⊓y≈x (trans x≤y y≤r) ⟩ + x ≈˘⟨ x≤y⇒x⊓y≈x x≤y ⟩ + x ⊓ y ≈˘⟨ ⊓-congˡ x (x≤y⇒x⊓y≈x y≤r) ⟩ + x ⊓ (y ⊓ r) ∎ +⊓-assoc x y r | inj₁ x≤y | inj₂ r≤y = begin-equality + (x ⊓ y) ⊓ r ≈⟨ ⊓-congʳ r (x≤y⇒x⊓y≈x x≤y) ⟩ + x ⊓ r ≈˘⟨ ⊓-congˡ x (x≥y⇒x⊓y≈y r≤y) ⟩ + x ⊓ (y ⊓ r) ∎ +⊓-assoc x y r | inj₂ y≤x | _ = begin-equality + (x ⊓ y) ⊓ r ≈⟨ ⊓-congʳ r (x≥y⇒x⊓y≈y y≤x) ⟩ + y ⊓ r ≈˘⟨ x≥y⇒x⊓y≈y (trans (x⊓y≤x y r) y≤x) ⟩ + x ⊓ (y ⊓ r) ∎ + +⊓-idem : Idempotent _⊓_ +⊓-idem x = x≤y⇒x⊓y≈x (refl {x}) + +⊓-sel : Selective _⊓_ +⊓-sel x y = Sum.map x≤y⇒x⊓y≈x x≥y⇒x⊓y≈y (total x y) + +⊓-identityˡ : ∀ {⊤} → Maximum _≤_ ⊤ → LeftIdentity ⊤ _⊓_ +⊓-identityˡ max = x≥y⇒x⊓y≈y ∘ max + +⊓-identityʳ : ∀ {⊤} → Maximum _≤_ ⊤ → RightIdentity ⊤ _⊓_ +⊓-identityʳ max = x≤y⇒x⊓y≈x ∘ max + +⊓-identity : ∀ {⊤} → Maximum _≤_ ⊤ → Identity ⊤ _⊓_ +⊓-identity max = ⊓-identityˡ max , ⊓-identityʳ max + +⊓-zeroˡ : ∀ {⊥} → Minimum _≤_ ⊥ → LeftZero ⊥ _⊓_ +⊓-zeroˡ min = x≤y⇒x⊓y≈x ∘ min + +⊓-zeroʳ : ∀ {⊥} → Minimum _≤_ ⊥ → RightZero ⊥ _⊓_ +⊓-zeroʳ min = x≥y⇒x⊓y≈y ∘ min + +⊓-zero : ∀ {⊥} → Minimum _≤_ ⊥ → Zero ⊥ _⊓_ +⊓-zero min = ⊓-zeroˡ min , ⊓-zeroʳ min + +------------------------------------------------------------------------ +-- Structures + +⊓-isMagma : IsMagma _⊓_ +⊓-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = ⊓-cong + } + +⊓-isSemigroup : IsSemigroup _⊓_ +⊓-isSemigroup = record + { isMagma = ⊓-isMagma + ; assoc = ⊓-assoc + } + +⊓-isBand : IsBand _⊓_ +⊓-isBand = record + { isSemigroup = ⊓-isSemigroup + ; idem = ⊓-idem + } + +⊓-isCommutativeSemigroup : IsCommutativeSemigroup _⊓_ +⊓-isCommutativeSemigroup = record + { isSemigroup = ⊓-isSemigroup + ; comm = ⊓-comm + } + +⊓-isSemilattice : IsSemilattice _⊓_ +⊓-isSemilattice = record + { isBand = ⊓-isBand + ; comm = ⊓-comm + } + +⊓-isSelectiveMagma : IsSelectiveMagma _⊓_ +⊓-isSelectiveMagma = record + { isMagma = ⊓-isMagma + ; sel = ⊓-sel + } + +⊓-isMonoid : ∀ {⊤} → Maximum _≤_ ⊤ → IsMonoid _⊓_ ⊤ +⊓-isMonoid max = record + { isSemigroup = ⊓-isSemigroup + ; identity = ⊓-identity max + } + +------------------------------------------------------------------------ +-- Raw bandles + +⊓-rawMagma : RawMagma _ _ +⊓-rawMagma = record { _≈_ = _≈_ ; _∙_ = _⊓_ } + +------------------------------------------------------------------------ +-- Bundles + +⊓-magma : Magma _ _ +⊓-magma = record + { isMagma = ⊓-isMagma + } + +⊓-semigroup : Semigroup _ _ +⊓-semigroup = record + { isSemigroup = ⊓-isSemigroup + } + +⊓-band : Band _ _ +⊓-band = record + { isBand = ⊓-isBand + } + +⊓-commutativeSemigroup : CommutativeSemigroup _ _ +⊓-commutativeSemigroup = record + { isCommutativeSemigroup = ⊓-isCommutativeSemigroup + } + +⊓-semilattice : Semilattice _ _ +⊓-semilattice = record + { isSemilattice = ⊓-isSemilattice + } + +⊓-selectiveMagma : SelectiveMagma _ _ +⊓-selectiveMagma = record + { isSelectiveMagma = ⊓-isSelectiveMagma + } + +⊓-monoid : ∀ {⊤} → Maximum _≤_ ⊤ → Monoid a ℓ₁ +⊓-monoid max = record + { isMonoid = ⊓-isMonoid max + } + +------------------------------------------------------------------------ +-- Other properties + +x⊓y≈x⇒x≤y : ∀ {x y} → x ⊓ y ≈ x → x ≤ y +x⊓y≈x⇒x≤y {x} {y} x⊓y≈x with total x y +... | inj₁ x≤y = x≤y +... | inj₂ y≤x = reflexive (Eq.trans (Eq.sym x⊓y≈x) (x≥y⇒x⊓y≈y y≤x)) + +x⊓y≈y⇒y≤x : ∀ {x y} → x ⊓ y ≈ y → y ≤ x +x⊓y≈y⇒y≤x {x} {y} x⊓y≈y = x⊓y≈x⇒x≤y (begin-equality + y ⊓ x ≈⟨ ⊓-comm y x ⟩ + x ⊓ y ≈⟨ x⊓y≈y ⟩ + y ∎) + +mono-≤-distrib-⊓ : ∀ {f} → f Preserves _≈_ ⟶ _≈_ → f Preserves _≤_ ⟶ _≤_ → + ∀ x y → f (x ⊓ y) ≈ f x ⊓ f y +mono-≤-distrib-⊓ {f} cong mono x y with total x y +... | inj₁ x≤y = begin-equality + f (x ⊓ y) ≈⟨ cong (x≤y⇒x⊓y≈x x≤y) ⟩ + f x ≈˘⟨ x≤y⇒x⊓y≈x (mono x≤y) ⟩ + f x ⊓ f y ∎ +... | inj₂ y≤x = begin-equality + f (x ⊓ y) ≈⟨ cong (x≥y⇒x⊓y≈y y≤x) ⟩ + f y ≈˘⟨ x≥y⇒x⊓y≈y (mono y≤x) ⟩ + f x ⊓ f y ∎ + +x≤y⇒x⊓z≤y : ∀ {x y} z → x ≤ y → x ⊓ z ≤ y +x≤y⇒x⊓z≤y z x≤y = trans (x⊓y≤x _ z) x≤y + +x≤y⇒z⊓x≤y : ∀ {x y} z → x ≤ y → z ⊓ x ≤ y +x≤y⇒z⊓x≤y y x≤y = trans (x⊓y≤y y _) x≤y + +x≤y⊓z⇒x≤y : ∀ {x} y z → x ≤ y ⊓ z → x ≤ y +x≤y⊓z⇒x≤y y z x≤y⊓z = trans x≤y⊓z (x⊓y≤x y z) + +x≤y⊓z⇒x≤z : ∀ {x} y z → x ≤ y ⊓ z → x ≤ z +x≤y⊓z⇒x≤z y z x≤y⊓z = trans x≤y⊓z (x⊓y≤y y z) + +⊓-mono-≤ : _⊓_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ +⊓-mono-≤ {x} {y} {u} {v} x≤y u≤v with ⊓-sel y v +... | inj₁ y⊓v≈y = ≤-respʳ-≈ (Eq.sym y⊓v≈y) (trans (x⊓y≤x x u) x≤y) +... | inj₂ y⊓v≈v = ≤-respʳ-≈ (Eq.sym y⊓v≈v) (trans (x⊓y≤y x u) u≤v) + +⊓-monoˡ-≤ : ∀ x → (_⊓ x) Preserves _≤_ ⟶ _≤_ +⊓-monoˡ-≤ x y≤z = ⊓-mono-≤ y≤z (refl {x}) + +⊓-monoʳ-≤ : ∀ x → (x ⊓_) Preserves _≤_ ⟶ _≤_ +⊓-monoʳ-≤ x y≤z = ⊓-mono-≤ (refl {x}) y≤z + +⊓-glb : ∀ {x y z} → x ≤ y → x ≤ z → x ≤ y ⊓ z +⊓-glb {x} x≤y x≤z = ≤-respˡ-≈ (⊓-idem x) (⊓-mono-≤ x≤y x≤z) + +⊓-triangulate : ∀ x y z → x ⊓ y ⊓ z ≈ (x ⊓ y) ⊓ (y ⊓ z) +⊓-triangulate x y z = begin-equality + x ⊓ y ⊓ z ≈˘⟨ ⊓-congʳ z (⊓-congˡ x (⊓-idem y)) ⟩ + x ⊓ (y ⊓ y) ⊓ z ≈⟨ ⊓-assoc x _ _ ⟩ + x ⊓ ((y ⊓ y) ⊓ z) ≈⟨ ⊓-congˡ x (⊓-assoc y y z) ⟩ + x ⊓ (y ⊓ (y ⊓ z)) ≈˘⟨ ⊓-assoc x y (y ⊓ z) ⟩ + (x ⊓ y) ⊓ (y ⊓ z) ∎ +\ No newline at end of file diff --git a/docs/Algebra.Core.html b/docs/Algebra.Core.html new file mode 100644 index 0000000..7c2dbbd --- /dev/null +++ b/docs/Algebra.Core.html @@ -0,0 +1,33 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Core algebraic definitions +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via `Algebra`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Algebra.Core where + +open import Level using (_⊔_) + +------------------------------------------------------------------------ +-- Unary and binary operations + +Op₁ : ∀ {ℓ} → Set ℓ → Set ℓ +Op₁ A = A → A + +Op₂ : ∀ {ℓ} → Set ℓ → Set ℓ +Op₂ A = A → A → A + +------------------------------------------------------------------------ +-- Left and right actions + +Opₗ : ∀ {a b} → Set a → Set b → Set (a ⊔ b) +Opₗ A B = A → B → B + +Opᵣ : ∀ {a b} → Set a → Set b → Set (a ⊔ b) +Opᵣ A B = B → A → B +\ No newline at end of file diff --git a/docs/Algebra.Definitions.html b/docs/Algebra.Definitions.html new file mode 100644 index 0000000..ebd97a1 --- /dev/null +++ b/docs/Algebra.Definitions.html @@ -0,0 +1,134 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of functions, such as associativity and commutativity +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via `Algebra`, unless +-- you want to parameterise it via the equality relation. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary.Core +open import Relation.Nullary using (¬_) + +module Algebra.Definitions + {a ℓ} {A : Set a} -- The underlying set + (_≈_ : Rel A ℓ) -- The underlying equality + where + +open import Algebra.Core +open import Data.Product +open import Data.Sum.Base + +------------------------------------------------------------------------ +-- Properties of operations + +Congruent₁ : Op₁ A → Set _ +Congruent₁ f = f Preserves _≈_ ⟶ _≈_ + +Congruent₂ : Op₂ A → Set _ +Congruent₂ ∙ = ∙ Preserves₂ _≈_ ⟶ _≈_ ⟶ _≈_ + +LeftCongruent : Op₂ A → Set _ +LeftCongruent _∙_ = ∀ {x} → (x ∙_) Preserves _≈_ ⟶ _≈_ + +RightCongruent : Op₂ A → Set _ +RightCongruent _∙_ = ∀ {x} → (_∙ x) Preserves _≈_ ⟶ _≈_ + +Associative : Op₂ A → Set _ +Associative _∙_ = ∀ x y z → ((x ∙ y) ∙ z) ≈ (x ∙ (y ∙ z)) + +Commutative : Op₂ A → Set _ +Commutative _∙_ = ∀ x y → (x ∙ y) ≈ (y ∙ x) + +LeftIdentity : A → Op₂ A → Set _ +LeftIdentity e _∙_ = ∀ x → (e ∙ x) ≈ x + +RightIdentity : A → Op₂ A → Set _ +RightIdentity e _∙_ = ∀ x → (x ∙ e) ≈ x + +Identity : A → Op₂ A → Set _ +Identity e ∙ = (LeftIdentity e ∙) × (RightIdentity e ∙) + +LeftZero : A → Op₂ A → Set _ +LeftZero z _∙_ = ∀ x → (z ∙ x) ≈ z + +RightZero : A → Op₂ A → Set _ +RightZero z _∙_ = ∀ x → (x ∙ z) ≈ z + +Zero : A → Op₂ A → Set _ +Zero z ∙ = (LeftZero z ∙) × (RightZero z ∙) + +LeftInverse : A → Op₁ A → Op₂ A → Set _ +LeftInverse e _⁻¹ _∙_ = ∀ x → ((x ⁻¹) ∙ x) ≈ e + +RightInverse : A → Op₁ A → Op₂ A → Set _ +RightInverse e _⁻¹ _∙_ = ∀ x → (x ∙ (x ⁻¹)) ≈ e + +Inverse : A → Op₁ A → Op₂ A → Set _ +Inverse e ⁻¹ ∙ = (LeftInverse e ⁻¹) ∙ × (RightInverse e ⁻¹ ∙) + +LeftConical : A → Op₂ A → Set _ +LeftConical e _∙_ = ∀ x y → (x ∙ y) ≈ e → x ≈ e + +RightConical : A → Op₂ A → Set _ +RightConical e _∙_ = ∀ x y → (x ∙ y) ≈ e → y ≈ e + +Conical : A → Op₂ A → Set _ +Conical e ∙ = (LeftConical e ∙) × (RightConical e ∙) + +_DistributesOverˡ_ : Op₂ A → Op₂ A → Set _ +_*_ DistributesOverˡ _+_ = + ∀ x y z → (x * (y + z)) ≈ ((x * y) + (x * z)) + +_DistributesOverʳ_ : Op₂ A → Op₂ A → Set _ +_*_ DistributesOverʳ _+_ = + ∀ x y z → ((y + z) * x) ≈ ((y * x) + (z * x)) + +_DistributesOver_ : Op₂ A → Op₂ A → Set _ +* DistributesOver + = (* DistributesOverˡ +) × (* DistributesOverʳ +) + +_IdempotentOn_ : Op₂ A → A → Set _ +_∙_ IdempotentOn x = (x ∙ x) ≈ x + +Idempotent : Op₂ A → Set _ +Idempotent ∙ = ∀ x → ∙ IdempotentOn x + +IdempotentFun : Op₁ A → Set _ +IdempotentFun f = ∀ x → f (f x) ≈ f x + +Selective : Op₂ A → Set _ +Selective _∙_ = ∀ x y → (x ∙ y) ≈ x ⊎ (x ∙ y) ≈ y + +_Absorbs_ : Op₂ A → Op₂ A → Set _ +_∙_ Absorbs _∘_ = ∀ x y → (x ∙ (x ∘ y)) ≈ x + +Absorptive : Op₂ A → Op₂ A → Set _ +Absorptive ∙ ∘ = (∙ Absorbs ∘) × (∘ Absorbs ∙) + +Involutive : Op₁ A → Set _ +Involutive f = ∀ x → f (f x) ≈ x + +LeftCancellative : Op₂ A → Set _ +LeftCancellative _•_ = ∀ x {y z} → (x • y) ≈ (x • z) → y ≈ z + +RightCancellative : Op₂ A → Set _ +RightCancellative _•_ = ∀ {x} y z → (y • x) ≈ (z • x) → y ≈ z + +Cancellative : Op₂ A → Set _ +Cancellative _•_ = (LeftCancellative _•_) × (RightCancellative _•_) + +AlmostLeftCancellative : A → Op₂ A → Set _ +AlmostLeftCancellative e _•_ = ∀ {x} y z → ¬ x ≈ e → (x • y) ≈ (x • z) → y ≈ z + +AlmostRightCancellative : A → Op₂ A → Set _ +AlmostRightCancellative e _•_ = ∀ {x} y z → ¬ x ≈ e → (y • x) ≈ (z • x) → y ≈ z + +AlmostCancellative : A → Op₂ A → Set _ +AlmostCancellative e _•_ = AlmostLeftCancellative e _•_ × AlmostRightCancellative e _•_ + +Interchangable : Op₂ A → Op₂ A → Set _ +Interchangable _∘_ _∙_ = ∀ w x y z → ((w ∙ x) ∘ (y ∙ z)) ≈ ((w ∘ y) ∙ (x ∘ z)) +\ No newline at end of file diff --git a/docs/Algebra.Morphism.Definitions.html b/docs/Algebra.Morphism.Definitions.html new file mode 100644 index 0000000..4be376c --- /dev/null +++ b/docs/Algebra.Morphism.Definitions.html @@ -0,0 +1,48 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Basic definitions for morphisms between algebraic structures +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary.Core + +module Algebra.Morphism.Definitions + {a} (A : Set a) -- The domain of the morphism + {b} (B : Set b) -- The codomain of the morphism + {ℓ} (_≈_ : Rel B ℓ) -- The equality relation over the codomain + where + +open import Algebra.Core + using (Op₁; Op₂) + +------------------------------------------------------------------------ +-- Basic definitions + +Homomorphic₀ : (A → B) → A → B → Set _ +Homomorphic₀ ⟦_⟧ ∙ ∘ = ⟦ ∙ ⟧ ≈ ∘ + +Homomorphic₁ : (A → B) → Op₁ A → Op₁ B → Set _ +Homomorphic₁ ⟦_⟧ ∙_ ∘_ = ∀ x → ⟦ ∙ x ⟧ ≈ (∘ ⟦ x ⟧) + +Homomorphic₂ : (A → B) → Op₂ A → Op₂ B → Set _ +Homomorphic₂ ⟦_⟧ _∙_ _∘_ = ∀ x y → ⟦ x ∙ y ⟧ ≈ (⟦ x ⟧ ∘ ⟦ y ⟧) + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.3 + +Morphism : Set _ +Morphism = A → B + +{-# WARNING_ON_USAGE Morphism +"Warning: Morphism was deprecated in v1.3. +Please use the standard function notation (e.g. A → B) instead." +#-} +\ No newline at end of file diff --git a/docs/Algebra.Morphism.Structures.html b/docs/Algebra.Morphism.Structures.html new file mode 100644 index 0000000..5ed8e02 --- /dev/null +++ b/docs/Algebra.Morphism.Structures.html @@ -0,0 +1,506 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Morphisms between algebraic structures +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary.Core + +module Algebra.Morphism.Structures where + +open import Algebra.Core +open import Algebra.Bundles +import Algebra.Morphism.Definitions as MorphismDefinitions +open import Level using (Level; _⊔_) +import Function.Definitions as FunctionDefinitions +open import Relation.Binary.Morphism.Structures + +private + variable + a b ℓ₁ ℓ₂ : Level + +------------------------------------------------------------------------ +-- Morphisms over magma-like structures +------------------------------------------------------------------------ + +module MagmaMorphisms (M₁ : RawMagma a ℓ₁) (M₂ : RawMagma b ℓ₂) where + + open RawMagma M₁ renaming (Carrier to A; _≈_ to _≈₁_; _∙_ to _∙_) + open RawMagma M₂ renaming (Carrier to B; _≈_ to _≈₂_; _∙_ to _◦_) + open MorphismDefinitions A B _≈₂_ + open FunctionDefinitions _≈₁_ _≈₂_ + + + record IsMagmaHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isRelHomomorphism : IsRelHomomorphism _≈₁_ _≈₂_ ⟦_⟧ + homo : Homomorphic₂ ⟦_⟧ _∙_ _◦_ + + open IsRelHomomorphism isRelHomomorphism public + renaming (cong to ⟦⟧-cong) + + + record IsMagmaMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isMagmaHomomorphism : IsMagmaHomomorphism ⟦_⟧ + injective : Injective ⟦_⟧ + + open IsMagmaHomomorphism isMagmaHomomorphism public + + isRelMonomorphism : IsRelMonomorphism _≈₁_ _≈₂_ ⟦_⟧ + isRelMonomorphism = record + { isHomomorphism = isRelHomomorphism + ; injective = injective + } + + + record IsMagmaIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isMagmaMonomorphism : IsMagmaMonomorphism ⟦_⟧ + surjective : Surjective ⟦_⟧ + + open IsMagmaMonomorphism isMagmaMonomorphism public + + isRelIsomorphism : IsRelIsomorphism _≈₁_ _≈₂_ ⟦_⟧ + isRelIsomorphism = record + { isMonomorphism = isRelMonomorphism + ; surjective = surjective + } + + +------------------------------------------------------------------------ +-- Morphisms over monoid-like structures +------------------------------------------------------------------------ + +module MonoidMorphisms (M₁ : RawMonoid a ℓ₁) (M₂ : RawMonoid b ℓ₂) where + + open RawMonoid M₁ renaming (Carrier to A; _≈_ to _≈₁_; _∙_ to _∙_; ε to ε₁) + open RawMonoid M₂ renaming (Carrier to B; _≈_ to _≈₂_; _∙_ to _◦_; ε to ε₂) + open MorphismDefinitions A B _≈₂_ + open FunctionDefinitions _≈₁_ _≈₂_ + open MagmaMorphisms (RawMonoid.rawMagma M₁) (RawMonoid.rawMagma M₂) + + record IsMonoidHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isMagmaHomomorphism : IsMagmaHomomorphism ⟦_⟧ + ε-homo : Homomorphic₀ ⟦_⟧ ε₁ ε₂ + + open IsMagmaHomomorphism isMagmaHomomorphism public + + record IsMonoidMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isMonoidHomomorphism : IsMonoidHomomorphism ⟦_⟧ + injective : Injective ⟦_⟧ + + open IsMonoidHomomorphism isMonoidHomomorphism public + + isMagmaMonomorphism : IsMagmaMonomorphism ⟦_⟧ + isMagmaMonomorphism = record + { isMagmaHomomorphism = isMagmaHomomorphism + ; injective = injective + } + + open IsMagmaMonomorphism isMagmaMonomorphism public + using (isRelMonomorphism) + + + record IsMonoidIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isMonoidMonomorphism : IsMonoidMonomorphism ⟦_⟧ + surjective : Surjective ⟦_⟧ + + open IsMonoidMonomorphism isMonoidMonomorphism public + + isMagmaIsomorphism : IsMagmaIsomorphism ⟦_⟧ + isMagmaIsomorphism = record + { isMagmaMonomorphism = isMagmaMonomorphism + ; surjective = surjective + } + + open IsMagmaIsomorphism isMagmaIsomorphism public + using (isRelIsomorphism) + + +------------------------------------------------------------------------ +-- Morphisms over group-like structures +------------------------------------------------------------------------ + +module GroupMorphisms (G₁ : RawGroup a ℓ₁) (G₂ : RawGroup b ℓ₂) where + + open RawGroup G₁ renaming + (Carrier to A; _≈_ to _≈₁_; _∙_ to _∙_; _⁻¹ to _⁻¹₁; ε to ε₁) + open RawGroup G₂ renaming + (Carrier to B; _≈_ to _≈₂_; _∙_ to _◦_; _⁻¹ to _⁻¹₂; ε to ε₂) + open MorphismDefinitions A B _≈₂_ + open FunctionDefinitions _≈₁_ _≈₂_ + open MagmaMorphisms (RawGroup.rawMagma G₁) (RawGroup.rawMagma G₂) + open MonoidMorphisms (RawGroup.rawMonoid G₁) (RawGroup.rawMonoid G₂) + + record IsGroupHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isMonoidHomomorphism : IsMonoidHomomorphism ⟦_⟧ + ⁻¹-homo : Homomorphic₁ ⟦_⟧ _⁻¹₁ _⁻¹₂ + + open IsMonoidHomomorphism isMonoidHomomorphism public + + record IsGroupMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isGroupHomomorphism : IsGroupHomomorphism ⟦_⟧ + injective : Injective ⟦_⟧ + + open IsGroupHomomorphism isGroupHomomorphism + renaming (homo to ∙-homo) public + + isMonoidMonomorphism : IsMonoidMonomorphism ⟦_⟧ + isMonoidMonomorphism = record + { isMonoidHomomorphism = isMonoidHomomorphism + ; injective = injective + } + + open IsMonoidMonomorphism isMonoidMonomorphism public + using (isRelMonomorphism) + + record IsGroupIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isGroupMonomorphism : IsGroupMonomorphism ⟦_⟧ + surjective : Surjective ⟦_⟧ + + open IsGroupMonomorphism isGroupMonomorphism public + + isMonoidIsomorphism : IsMonoidIsomorphism ⟦_⟧ + isMonoidIsomorphism = record + { isMonoidMonomorphism = isMonoidMonomorphism + ; surjective = surjective + } + + open IsMonoidIsomorphism isMonoidIsomorphism public + using (isRelIsomorphism) + + +------------------------------------------------------------------------ +-- Morphisms over near-semiring-like structures +------------------------------------------------------------------------ + +module NearSemiringMorphisms (R₁ : RawNearSemiring a ℓ₁) (R₂ : RawNearSemiring b ℓ₂) where + + open RawNearSemiring R₁ renaming + ( Carrier to A; _≈_ to _≈₁_ + ; +-rawMonoid to +-rawMonoid₁ + ; *-rawMagma to *-rawMagma₁) + + open RawNearSemiring R₂ renaming + ( Carrier to B; _≈_ to _≈₂_ + ; +-rawMonoid to +-rawMonoid₂ + ; *-rawMagma to *-rawMagma₂) + + private + module + = MonoidMorphisms +-rawMonoid₁ +-rawMonoid₂ + module * = MagmaMorphisms *-rawMagma₁ *-rawMagma₂ + + open MorphismDefinitions A B _≈₂_ + open FunctionDefinitions _≈₁_ _≈₂_ + + record IsNearSemiringHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + +-isMonoidHomomorphism : +.IsMonoidHomomorphism ⟦_⟧ + *-isMagmaHomomorphism : *.IsMagmaHomomorphism ⟦_⟧ + + open +.IsMonoidHomomorphism +-isMonoidHomomorphism renaming + (homo to +-homo; ε-homo to 0#-homo) public + + open *.IsMagmaHomomorphism *-isMagmaHomomorphism renaming + (homo to *-homo) public + + record IsNearSemiringMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isNearSemiringHomomorphism : IsNearSemiringHomomorphism ⟦_⟧ + injective : Injective ⟦_⟧ + + open IsNearSemiringHomomorphism isNearSemiringHomomorphism public + + +-isMonoidMonomorphism : +.IsMonoidMonomorphism ⟦_⟧ + +-isMonoidMonomorphism = record + { isMonoidHomomorphism = +-isMonoidHomomorphism + ; injective = injective + } + + *-isMagmaMonomorphism : *.IsMagmaMonomorphism ⟦_⟧ + *-isMagmaMonomorphism = record + { isMagmaHomomorphism = *-isMagmaHomomorphism + ; injective = injective + } + + open *.IsMagmaMonomorphism *-isMagmaMonomorphism public + using (isRelMonomorphism) + + record IsNearSemiringIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isNearSemiringMonomorphism : IsNearSemiringMonomorphism ⟦_⟧ + surjective : Surjective ⟦_⟧ + + open IsNearSemiringMonomorphism isNearSemiringMonomorphism public + + +-isMonoidIsomorphism : +.IsMonoidIsomorphism ⟦_⟧ + +-isMonoidIsomorphism = record + { isMonoidMonomorphism = +-isMonoidMonomorphism + ; surjective = surjective + } + + *-isMagmaIsomorphism : *.IsMagmaIsomorphism ⟦_⟧ + *-isMagmaIsomorphism = record + { isMagmaMonomorphism = *-isMagmaMonomorphism + ; surjective = surjective + } + + open *.IsMagmaIsomorphism *-isMagmaIsomorphism public + using (isRelIsomorphism) + + +------------------------------------------------------------------------ +-- Morphisms over semiring-like structures +------------------------------------------------------------------------ + +module SemiringMorphisms (R₁ : RawSemiring a ℓ₁) (R₂ : RawSemiring b ℓ₂) where + + open RawSemiring R₁ renaming + ( Carrier to A; _≈_ to _≈₁_ + ; +-rawMonoid to +-rawMonoid₁ + ; *-rawMonoid to *-rawMonoid₁) + + open RawSemiring R₂ renaming + ( Carrier to B; _≈_ to _≈₂_ + ; +-rawMonoid to +-rawMonoid₂ + ; *-rawMonoid to *-rawMonoid₂) + + private + module + = MonoidMorphisms +-rawMonoid₁ +-rawMonoid₂ + module * = MonoidMorphisms *-rawMonoid₁ *-rawMonoid₂ + + open MorphismDefinitions A B _≈₂_ + open FunctionDefinitions _≈₁_ _≈₂_ + + record IsSemiringHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + +-isMonoidHomomorphism : +.IsMonoidHomomorphism ⟦_⟧ + *-isMonoidHomomorphism : *.IsMonoidHomomorphism ⟦_⟧ + + open +.IsMonoidHomomorphism +-isMonoidHomomorphism renaming + (homo to +-homo; ε-homo to 0#-homo) public + + open *.IsMonoidHomomorphism *-isMonoidHomomorphism renaming + (homo to *-homo; ε-homo to 1#-homo) public + + record IsSemiringMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isSemiringHomomorphism : IsSemiringHomomorphism ⟦_⟧ + injective : Injective ⟦_⟧ + + open IsSemiringHomomorphism isSemiringHomomorphism public + + +-isMonoidMonomorphism : +.IsMonoidMonomorphism ⟦_⟧ + +-isMonoidMonomorphism = record + { isMonoidHomomorphism = +-isMonoidHomomorphism + ; injective = injective + } + + *-isMonoidMonomorphism : *.IsMonoidMonomorphism ⟦_⟧ + *-isMonoidMonomorphism = record + { isMonoidHomomorphism = *-isMonoidHomomorphism + ; injective = injective + } + + open *.IsMonoidMonomorphism *-isMonoidMonomorphism public + using (isRelMonomorphism) + + record IsSemiringIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isSemiringMonomorphism : IsSemiringMonomorphism ⟦_⟧ + surjective : Surjective ⟦_⟧ + + open IsSemiringMonomorphism isSemiringMonomorphism public + + +-isMonoidIsomorphism : +.IsMonoidIsomorphism ⟦_⟧ + +-isMonoidIsomorphism = record + { isMonoidMonomorphism = +-isMonoidMonomorphism + ; surjective = surjective + } + + *-isMonoidIsomorphism : *.IsMonoidIsomorphism ⟦_⟧ + *-isMonoidIsomorphism = record + { isMonoidMonomorphism = *-isMonoidMonomorphism + ; surjective = surjective + } + + open *.IsMonoidIsomorphism *-isMonoidIsomorphism public + using (isRelIsomorphism) + + +------------------------------------------------------------------------ +-- Morphisms over ring-like structures +------------------------------------------------------------------------ + +module RingMorphisms (R₁ : RawRing a ℓ₁) (R₂ : RawRing b ℓ₂) where + + open RawRing R₁ renaming + ( Carrier to A; _≈_ to _≈₁_ + ; *-rawMonoid to *-rawMonoid₁ + ; +-rawGroup to +-rawGroup₁) + + open RawRing R₂ renaming + ( Carrier to B; _≈_ to _≈₂_ + ; *-rawMonoid to *-rawMonoid₂ + ; +-rawGroup to +-rawGroup₂) + + module + = GroupMorphisms +-rawGroup₁ +-rawGroup₂ + module * = MonoidMorphisms *-rawMonoid₁ *-rawMonoid₂ + + open MorphismDefinitions A B _≈₂_ + open FunctionDefinitions _≈₁_ _≈₂_ + + record IsRingHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + +-isGroupHomomorphism : +.IsGroupHomomorphism ⟦_⟧ + *-isMonoidHomomorphism : *.IsMonoidHomomorphism ⟦_⟧ + + open +.IsGroupHomomorphism +-isGroupHomomorphism renaming + (homo to +-homo; ε-homo to 0#-homo) public + + open *.IsMonoidHomomorphism *-isMonoidHomomorphism renaming + (homo to *-homo; ε-homo to 1#-homo) public + + record IsRingMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isRingHomomorphism : IsRingHomomorphism ⟦_⟧ + injective : Injective ⟦_⟧ + + open IsRingHomomorphism isRingHomomorphism public + + +-isGroupMonomorphism : +.IsGroupMonomorphism ⟦_⟧ + +-isGroupMonomorphism = record + { isGroupHomomorphism = +-isGroupHomomorphism + ; injective = injective + } + + *-isMonoidMonomorphism : *.IsMonoidMonomorphism ⟦_⟧ + *-isMonoidMonomorphism = record + { isMonoidHomomorphism = *-isMonoidHomomorphism + ; injective = injective + } + + open *.IsMonoidMonomorphism *-isMonoidMonomorphism public + using (isRelMonomorphism) + + record IsRingIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isRingMonomorphism : IsRingMonomorphism ⟦_⟧ + surjective : Surjective ⟦_⟧ + + open IsRingMonomorphism isRingMonomorphism public + + +-isGroupIsomorphism : +.IsGroupIsomorphism ⟦_⟧ + +-isGroupIsomorphism = record + { isGroupMonomorphism = +-isGroupMonomorphism + ; surjective = surjective + } + + *-isMonoidIsomorphism : *.IsMonoidIsomorphism ⟦_⟧ + *-isMonoidIsomorphism = record + { isMonoidMonomorphism = *-isMonoidMonomorphism + ; surjective = surjective + } + + open *.IsMonoidIsomorphism *-isMonoidIsomorphism public + using (isRelIsomorphism) + + +------------------------------------------------------------------------ +-- Morphisms over lattice-like structures +------------------------------------------------------------------------ + +module LatticeMorphisms (L₁ : RawLattice a ℓ₁) (L₂ : RawLattice b ℓ₂) where + + open RawLattice L₁ renaming + ( Carrier to A; _≈_ to _≈₁_ + ; ∧-rawMagma to ∧-rawMagma₁ + ; ∨-rawMagma to ∨-rawMagma₁) + + open RawLattice L₂ renaming + ( Carrier to B; _≈_ to _≈₂_ + ; ∧-rawMagma to ∧-rawMagma₂ + ; ∨-rawMagma to ∨-rawMagma₂) + + module ∨ = MagmaMorphisms ∨-rawMagma₁ ∨-rawMagma₂ + module ∧ = MagmaMorphisms ∧-rawMagma₁ ∧-rawMagma₂ + + open MorphismDefinitions A B _≈₂_ + open FunctionDefinitions _≈₁_ _≈₂_ + + record IsLatticeHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + ∨-isMagmaHomomorphism : ∨.IsMagmaHomomorphism ⟦_⟧ + ∧-isMagmaHomomorphism : ∧.IsMagmaHomomorphism ⟦_⟧ + + open ∨.IsMagmaHomomorphism ∨-isMagmaHomomorphism renaming + (homo to ∨-homo) public + + open ∧.IsMagmaHomomorphism ∧-isMagmaHomomorphism renaming + (homo to ∧-homo) public + + record IsLatticeMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isLatticeHomomorphism : IsLatticeHomomorphism ⟦_⟧ + injective : Injective ⟦_⟧ + + open IsLatticeHomomorphism isLatticeHomomorphism public + + ∨-isMagmaMonomorphism : ∨.IsMagmaMonomorphism ⟦_⟧ + ∨-isMagmaMonomorphism = record + { isMagmaHomomorphism = ∨-isMagmaHomomorphism + ; injective = injective + } + + ∧-isMagmaMonomorphism : ∧.IsMagmaMonomorphism ⟦_⟧ + ∧-isMagmaMonomorphism = record + { isMagmaHomomorphism = ∧-isMagmaHomomorphism + ; injective = injective + } + + open ∧.IsMagmaMonomorphism ∧-isMagmaMonomorphism public + using (isRelMonomorphism) + + record IsLatticeIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isLatticeMonomorphism : IsLatticeMonomorphism ⟦_⟧ + surjective : Surjective ⟦_⟧ + + open IsLatticeMonomorphism isLatticeMonomorphism public + + ∨-isMagmaIsomorphism : ∨.IsMagmaIsomorphism ⟦_⟧ + ∨-isMagmaIsomorphism = record + { isMagmaMonomorphism = ∨-isMagmaMonomorphism + ; surjective = surjective + } + + ∧-isMagmaIsomorphism : ∧.IsMagmaIsomorphism ⟦_⟧ + ∧-isMagmaIsomorphism = record + { isMagmaMonomorphism = ∧-isMagmaMonomorphism + ; surjective = surjective + } + + open ∧.IsMagmaIsomorphism ∧-isMagmaIsomorphism public + using (isRelIsomorphism) + +------------------------------------------------------------------------ +-- Re-export contents of modules publicly + +open MagmaMorphisms public +open MonoidMorphisms public +open GroupMorphisms public +open NearSemiringMorphisms public +open SemiringMorphisms public +open RingMorphisms public +open LatticeMorphisms public +\ No newline at end of file diff --git a/docs/Algebra.Morphism.html b/docs/Algebra.Morphism.html new file mode 100644 index 0000000..aeb8d60 --- /dev/null +++ b/docs/Algebra.Morphism.html @@ -0,0 +1,211 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Morphisms between algebraic structures +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Algebra.Morphism where + +import Algebra.Morphism.Definitions as MorphismDefinitions +open import Algebra +import Algebra.Properties.Group as GroupP +open import Function hiding (Morphism) +open import Level +open import Relation.Binary +import Relation.Binary.Reasoning.Setoid as EqR + +private + variable + a b ℓ₁ ℓ₂ : Level + A : Set a + B : Set b + +------------------------------------------------------------------------ +-- Re-export + +module Definitions {a b ℓ₁} (A : Set a) (B : Set b) (_≈_ : Rel B ℓ₁) where + open MorphismDefinitions A B _≈_ public + +open import Algebra.Morphism.Structures public + + +------------------------------------------------------------------------ +-- DEPRECATED +------------------------------------------------------------------------ +-- Please use the new definitions re-exported from +-- `Algebra.Morphism.Structures` as continuing support for the below is +-- no guaranteed. + +-- Version 1.5 + +module _ {c₁ ℓ₁ c₂ ℓ₂} + (From : Semigroup c₁ ℓ₁) + (To : Semigroup c₂ ℓ₂) where + + private + module F = Semigroup From + module T = Semigroup To + open Definitions F.Carrier T.Carrier T._≈_ + + record IsSemigroupMorphism (⟦_⟧ : Morphism) : + Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where + field + ⟦⟧-cong : ⟦_⟧ Preserves F._≈_ ⟶ T._≈_ + ∙-homo : Homomorphic₂ ⟦_⟧ F._∙_ T._∙_ + + IsSemigroupMorphism-syntax = IsSemigroupMorphism + syntax IsSemigroupMorphism-syntax From To F = F Is From -Semigroup⟶ To + +module _ {c₁ ℓ₁ c₂ ℓ₂} + (From : Monoid c₁ ℓ₁) + (To : Monoid c₂ ℓ₂) where + + private + module F = Monoid From + module T = Monoid To + open Definitions F.Carrier T.Carrier T._≈_ + + record IsMonoidMorphism (⟦_⟧ : Morphism) : + Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where + field + sm-homo : IsSemigroupMorphism F.semigroup T.semigroup ⟦_⟧ + ε-homo : Homomorphic₀ ⟦_⟧ F.ε T.ε + + open IsSemigroupMorphism sm-homo public + + IsMonoidMorphism-syntax = IsMonoidMorphism + syntax IsMonoidMorphism-syntax From To F = F Is From -Monoid⟶ To + +module _ {c₁ ℓ₁ c₂ ℓ₂} + (From : CommutativeMonoid c₁ ℓ₁) + (To : CommutativeMonoid c₂ ℓ₂) where + + private + module F = CommutativeMonoid From + module T = CommutativeMonoid To + open Definitions F.Carrier T.Carrier T._≈_ + + record IsCommutativeMonoidMorphism (⟦_⟧ : Morphism) : + Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where + field + mn-homo : IsMonoidMorphism F.monoid T.monoid ⟦_⟧ + + open IsMonoidMorphism mn-homo public + + IsCommutativeMonoidMorphism-syntax = IsCommutativeMonoidMorphism + syntax IsCommutativeMonoidMorphism-syntax From To F = F Is From -CommutativeMonoid⟶ To + +module _ {c₁ ℓ₁ c₂ ℓ₂} + (From : IdempotentCommutativeMonoid c₁ ℓ₁) + (To : IdempotentCommutativeMonoid c₂ ℓ₂) where + + private + module F = IdempotentCommutativeMonoid From + module T = IdempotentCommutativeMonoid To + open Definitions F.Carrier T.Carrier T._≈_ + + record IsIdempotentCommutativeMonoidMorphism (⟦_⟧ : Morphism) : + Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where + field + mn-homo : IsMonoidMorphism F.monoid T.monoid ⟦_⟧ + + open IsMonoidMorphism mn-homo public + + isCommutativeMonoidMorphism : + IsCommutativeMonoidMorphism F.commutativeMonoid T.commutativeMonoid ⟦_⟧ + isCommutativeMonoidMorphism = record { mn-homo = mn-homo } + + IsIdempotentCommutativeMonoidMorphism-syntax = IsIdempotentCommutativeMonoidMorphism + syntax IsIdempotentCommutativeMonoidMorphism-syntax From To F = F Is From -IdempotentCommutativeMonoid⟶ To + +module _ {c₁ ℓ₁ c₂ ℓ₂} + (From : Group c₁ ℓ₁) + (To : Group c₂ ℓ₂) where + + private + module F = Group From + module T = Group To + open Definitions F.Carrier T.Carrier T._≈_ + + record IsGroupMorphism (⟦_⟧ : Morphism) : + Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where + field + mn-homo : IsMonoidMorphism F.monoid T.monoid ⟦_⟧ + + open IsMonoidMorphism mn-homo public + + ⁻¹-homo : Homomorphic₁ ⟦_⟧ F._⁻¹ T._⁻¹ + ⁻¹-homo x = let open EqR T.setoid in T.uniqueˡ-⁻¹ ⟦ x F.⁻¹ ⟧ ⟦ x ⟧ $ begin + ⟦ x F.⁻¹ ⟧ T.∙ ⟦ x ⟧ ≈⟨ T.sym (∙-homo (x F.⁻¹) x) ⟩ + ⟦ x F.⁻¹ F.∙ x ⟧ ≈⟨ ⟦⟧-cong (F.inverseˡ x) ⟩ + ⟦ F.ε ⟧ ≈⟨ ε-homo ⟩ + T.ε ∎ + + IsGroupMorphism-syntax = IsGroupMorphism + syntax IsGroupMorphism-syntax From To F = F Is From -Group⟶ To + +module _ {c₁ ℓ₁ c₂ ℓ₂} + (From : AbelianGroup c₁ ℓ₁) + (To : AbelianGroup c₂ ℓ₂) where + + private + module F = AbelianGroup From + module T = AbelianGroup To + open Definitions F.Carrier T.Carrier T._≈_ + + record IsAbelianGroupMorphism (⟦_⟧ : Morphism) : + Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where + field + gp-homo : IsGroupMorphism F.group T.group ⟦_⟧ + + open IsGroupMorphism gp-homo public + + IsAbelianGroupMorphism-syntax = IsAbelianGroupMorphism + syntax IsAbelianGroupMorphism-syntax From To F = F Is From -AbelianGroup⟶ To + +module _ {c₁ ℓ₁ c₂ ℓ₂} + (From : Ring c₁ ℓ₁) + (To : Ring c₂ ℓ₂) where + + private + module F = Ring From + module T = Ring To + open Definitions F.Carrier T.Carrier T._≈_ + + record IsRingMorphism (⟦_⟧ : Morphism) : + Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where + field + +-abgp-homo : ⟦_⟧ Is F.+-abelianGroup -AbelianGroup⟶ T.+-abelianGroup + *-mn-homo : ⟦_⟧ Is F.*-monoid -Monoid⟶ T.*-monoid + + IsRingMorphism-syntax = IsRingMorphism + syntax IsRingMorphism-syntax From To F = F Is From -Ring⟶ To + +{-# WARNING_ON_USAGE IsSemigroupMorphism +"Warning: IsSemigroupMorphism was deprecated in v1.5. +Please use IsSemigroupHomomorphism instead." +#-} +{-# WARNING_ON_USAGE IsMonoidMorphism +"Warning: IsMonoidMorphism was deprecated in v1.5. +Please use IsMonoidHomomorphism instead." +#-} +{-# WARNING_ON_USAGE IsCommutativeMonoidMorphism +"Warning: IsCommutativeMonoidMorphism was deprecated in v1.5. +Please use IsMonoidHomomorphism instead." +#-} +{-# WARNING_ON_USAGE IsIdempotentCommutativeMonoidMorphism +"Warning: IsIdempotentCommutativeMonoidMorphism was deprecated in v1.5. +Please use IsMonoidHomomorphism instead." +#-} +{-# WARNING_ON_USAGE IsGroupMorphism +"Warning: IsGroupMorphism was deprecated in v1.5. +Please use IsGroupHomomorphism instead." +#-} +{-# WARNING_ON_USAGE IsAbelianGroupMorphism +"Warning: IsAbelianGroupMorphism was deprecated in v1.5. +Please use IsGroupHomomorphism instead." +#-} +\ No newline at end of file diff --git a/docs/Algebra.Properties.BooleanAlgebra.html b/docs/Algebra.Properties.BooleanAlgebra.html new file mode 100644 index 0000000..82cda84 --- /dev/null +++ b/docs/Algebra.Properties.BooleanAlgebra.html @@ -0,0 +1,614 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Some derivable properties +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +-- Disabled to prevent warnings from deprecated names +{-# OPTIONS --warn=noUserWarning #-} + +open import Algebra.Bundles + +module Algebra.Properties.BooleanAlgebra + {b₁ b₂} (B : BooleanAlgebra b₁ b₂) + where + +open BooleanAlgebra B + +import Algebra.Properties.DistributiveLattice as DistribLatticeProperties +open import Algebra.Core +open import Algebra.Structures _≈_ +open import Algebra.Definitions _≈_ +open import Algebra.Consequences.Setoid setoid +open import Relation.Binary.Reasoning.Setoid setoid +open import Relation.Binary +open import Function.Base +open import Function.Equality using (_⟨$⟩_) +open import Function.Equivalence using (_⇔_; module Equivalence) +open import Data.Product using (_,_) + +------------------------------------------------------------------------ +-- Export properties from distributive lattices + +open DistribLatticeProperties distributiveLattice public + hiding (replace-equality) + +------------------------------------------------------------------------ +-- Some simple consequences + +∨-complementˡ : LeftInverse ⊤ ¬_ _∨_ +∨-complementˡ = comm+invʳ⇒invˡ ∨-comm ∨-complementʳ + +∨-complement : Inverse ⊤ ¬_ _∨_ +∨-complement = ∨-complementˡ , ∨-complementʳ + +∧-complementˡ : LeftInverse ⊥ ¬_ _∧_ +∧-complementˡ = comm+invʳ⇒invˡ ∧-comm ∧-complementʳ + +∧-complement : Inverse ⊥ ¬_ _∧_ +∧-complement = ∧-complementˡ , ∧-complementʳ + +------------------------------------------------------------------------ +-- The dual construction is also a boolean algebra + +∧-∨-isBooleanAlgebra : IsBooleanAlgebra _∧_ _∨_ ¬_ ⊥ ⊤ +∧-∨-isBooleanAlgebra = record + { isDistributiveLattice = ∧-∨-isDistributiveLattice + ; ∨-complementʳ = ∧-complementʳ + ; ∧-complementʳ = ∨-complementʳ + ; ¬-cong = ¬-cong + } + +∧-∨-booleanAlgebra : BooleanAlgebra _ _ +∧-∨-booleanAlgebra = record + { isBooleanAlgebra = ∧-∨-isBooleanAlgebra + } + +------------------------------------------------------------------------ +-- (∨, ∧, ⊥, ⊤) and (∧, ∨, ⊤, ⊥) are commutative semirings + +∧-identityʳ : RightIdentity ⊤ _∧_ +∧-identityʳ x = begin + x ∧ ⊤ ≈⟨ ∧-congˡ (sym (∨-complementʳ _)) ⟩ + x ∧ (x ∨ ¬ x) ≈⟨ ∧-absorbs-∨ _ _ ⟩ + x ∎ + +∧-identityˡ : LeftIdentity ⊤ _∧_ +∧-identityˡ = comm+idʳ⇒idˡ ∧-comm ∧-identityʳ + +∧-identity : Identity ⊤ _∧_ +∧-identity = ∧-identityˡ , ∧-identityʳ + +∨-identityʳ : RightIdentity ⊥ _∨_ +∨-identityʳ x = begin + x ∨ ⊥ ≈⟨ ∨-congˡ $ sym (∧-complementʳ _) ⟩ + x ∨ x ∧ ¬ x ≈⟨ ∨-absorbs-∧ _ _ ⟩ + x ∎ + +∨-identityˡ : LeftIdentity ⊥ _∨_ +∨-identityˡ = comm+idʳ⇒idˡ ∨-comm ∨-identityʳ + +∨-identity : Identity ⊥ _∨_ +∨-identity = ∨-identityˡ , ∨-identityʳ + +∧-zeroʳ : RightZero ⊥ _∧_ +∧-zeroʳ x = begin + x ∧ ⊥ ≈˘⟨ ∧-congˡ (∧-complementʳ x) ⟩ + x ∧ x ∧ ¬ x ≈˘⟨ ∧-assoc x x (¬ x) ⟩ + (x ∧ x) ∧ ¬ x ≈⟨ ∧-congʳ (∧-idempotent x) ⟩ + x ∧ ¬ x ≈⟨ ∧-complementʳ x ⟩ + ⊥ ∎ + +∧-zeroˡ : LeftZero ⊥ _∧_ +∧-zeroˡ = comm+zeʳ⇒zeˡ ∧-comm ∧-zeroʳ + +∧-zero : Zero ⊥ _∧_ +∧-zero = ∧-zeroˡ , ∧-zeroʳ + +∨-zeroʳ : ∀ x → x ∨ ⊤ ≈ ⊤ +∨-zeroʳ x = begin + x ∨ ⊤ ≈˘⟨ ∨-congˡ (∨-complementʳ x) ⟩ + x ∨ x ∨ ¬ x ≈˘⟨ ∨-assoc x x (¬ x) ⟩ + (x ∨ x) ∨ ¬ x ≈⟨ ∨-congʳ (∨-idempotent x) ⟩ + x ∨ ¬ x ≈⟨ ∨-complementʳ x ⟩ + ⊤ ∎ + +∨-zeroˡ : LeftZero ⊤ _∨_ +∨-zeroˡ = comm+zeʳ⇒zeˡ ∨-comm ∨-zeroʳ + +∨-zero : Zero ⊤ _∨_ +∨-zero = ∨-zeroˡ , ∨-zeroʳ + +∨-⊥-isMonoid : IsMonoid _∨_ ⊥ +∨-⊥-isMonoid = record + { isSemigroup = ∨-isSemigroup + ; identity = ∨-identity + } + +∧-⊤-isMonoid : IsMonoid _∧_ ⊤ +∧-⊤-isMonoid = record + { isSemigroup = ∧-isSemigroup + ; identity = ∧-identity + } + +∨-⊥-isCommutativeMonoid : IsCommutativeMonoid _∨_ ⊥ +∨-⊥-isCommutativeMonoid = record + { isMonoid = ∨-⊥-isMonoid + ; comm = ∨-comm + } + +∧-⊤-isCommutativeMonoid : IsCommutativeMonoid _∧_ ⊤ +∧-⊤-isCommutativeMonoid = record + { isMonoid = ∧-⊤-isMonoid + ; comm = ∧-comm + } + +∨-∧-isSemiring : IsSemiring _∨_ _∧_ ⊥ ⊤ +∨-∧-isSemiring = record + { isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = ∨-⊥-isCommutativeMonoid + ; *-isMonoid = ∧-⊤-isMonoid + ; distrib = ∧-∨-distrib + } + ; zero = ∧-zero + } + +∧-∨-isSemiring : IsSemiring _∧_ _∨_ ⊤ ⊥ +∧-∨-isSemiring = record + { isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = ∧-⊤-isCommutativeMonoid + ; *-isMonoid = ∨-⊥-isMonoid + ; distrib = ∨-∧-distrib + } + ; zero = ∨-zero + } + +∨-∧-isCommutativeSemiring : IsCommutativeSemiring _∨_ _∧_ ⊥ ⊤ +∨-∧-isCommutativeSemiring = record + { isSemiring = ∨-∧-isSemiring + ; *-comm = ∧-comm + } + +∧-∨-isCommutativeSemiring : IsCommutativeSemiring _∧_ _∨_ ⊤ ⊥ +∧-∨-isCommutativeSemiring = record + { isSemiring = ∧-∨-isSemiring + ; *-comm = ∨-comm + } + +∨-∧-commutativeSemiring : CommutativeSemiring _ _ +∨-∧-commutativeSemiring = record + { isCommutativeSemiring = ∨-∧-isCommutativeSemiring + } + +∧-∨-commutativeSemiring : CommutativeSemiring _ _ +∧-∨-commutativeSemiring = record + { isCommutativeSemiring = ∧-∨-isCommutativeSemiring + } + +------------------------------------------------------------------------ +-- Some other properties + +-- I took the statement of this lemma (called Uniqueness of +-- Complements) from some course notes, "Boolean Algebra", written +-- by Gert Smolka. + +private + lemma : ∀ x y → x ∧ y ≈ ⊥ → x ∨ y ≈ ⊤ → ¬ x ≈ y + lemma x y x∧y=⊥ x∨y=⊤ = begin + ¬ x ≈˘⟨ ∧-identityʳ _ ⟩ + ¬ x ∧ ⊤ ≈˘⟨ ∧-congˡ x∨y=⊤ ⟩ + ¬ x ∧ (x ∨ y) ≈⟨ ∧-∨-distribˡ _ _ _ ⟩ + ¬ x ∧ x ∨ ¬ x ∧ y ≈⟨ ∨-congʳ $ ∧-complementˡ _ ⟩ + ⊥ ∨ ¬ x ∧ y ≈˘⟨ ∨-congʳ x∧y=⊥ ⟩ + x ∧ y ∨ ¬ x ∧ y ≈˘⟨ ∧-∨-distribʳ _ _ _ ⟩ + (x ∨ ¬ x) ∧ y ≈⟨ ∧-congʳ $ ∨-complementʳ _ ⟩ + ⊤ ∧ y ≈⟨ ∧-identityˡ _ ⟩ + y ∎ + +⊥≉⊤ : ¬ ⊥ ≈ ⊤ +⊥≉⊤ = lemma ⊥ ⊤ (∧-identityʳ _) (∨-zeroʳ _) + +⊤≉⊥ : ¬ ⊤ ≈ ⊥ +⊤≉⊥ = lemma ⊤ ⊥ (∧-zeroʳ _) (∨-identityʳ _) + +¬-involutive : Involutive ¬_ +¬-involutive x = lemma (¬ x) x (∧-complementˡ _) (∨-complementˡ _) + +deMorgan₁ : ∀ x y → ¬ (x ∧ y) ≈ ¬ x ∨ ¬ y +deMorgan₁ x y = lemma (x ∧ y) (¬ x ∨ ¬ y) lem₁ lem₂ + where + lem₁ = begin + (x ∧ y) ∧ (¬ x ∨ ¬ y) ≈⟨ ∧-∨-distribˡ _ _ _ ⟩ + (x ∧ y) ∧ ¬ x ∨ (x ∧ y) ∧ ¬ y ≈⟨ ∨-congʳ $ ∧-congʳ $ ∧-comm _ _ ⟩ + (y ∧ x) ∧ ¬ x ∨ (x ∧ y) ∧ ¬ y ≈⟨ ∧-assoc _ _ _ ⟨ ∨-cong ⟩ ∧-assoc _ _ _ ⟩ + y ∧ (x ∧ ¬ x) ∨ x ∧ (y ∧ ¬ y) ≈⟨ (∧-congˡ $ ∧-complementʳ _) ⟨ ∨-cong ⟩ + (∧-congˡ $ ∧-complementʳ _) ⟩ + (y ∧ ⊥) ∨ (x ∧ ⊥) ≈⟨ ∧-zeroʳ _ ⟨ ∨-cong ⟩ ∧-zeroʳ _ ⟩ + ⊥ ∨ ⊥ ≈⟨ ∨-identityʳ _ ⟩ + ⊥ ∎ + + lem₃ = begin + (x ∧ y) ∨ ¬ x ≈⟨ ∨-∧-distribʳ _ _ _ ⟩ + (x ∨ ¬ x) ∧ (y ∨ ¬ x) ≈⟨ ∧-congʳ $ ∨-complementʳ _ ⟩ + ⊤ ∧ (y ∨ ¬ x) ≈⟨ ∧-identityˡ _ ⟩ + y ∨ ¬ x ≈⟨ ∨-comm _ _ ⟩ + ¬ x ∨ y ∎ + + lem₂ = begin + (x ∧ y) ∨ (¬ x ∨ ¬ y) ≈˘⟨ ∨-assoc _ _ _ ⟩ + ((x ∧ y) ∨ ¬ x) ∨ ¬ y ≈⟨ ∨-congʳ lem₃ ⟩ + (¬ x ∨ y) ∨ ¬ y ≈⟨ ∨-assoc _ _ _ ⟩ + ¬ x ∨ (y ∨ ¬ y) ≈⟨ ∨-congˡ $ ∨-complementʳ _ ⟩ + ¬ x ∨ ⊤ ≈⟨ ∨-zeroʳ _ ⟩ + ⊤ ∎ + +deMorgan₂ : ∀ x y → ¬ (x ∨ y) ≈ ¬ x ∧ ¬ y +deMorgan₂ x y = begin + ¬ (x ∨ y) ≈˘⟨ ¬-cong $ ((¬-involutive _) ⟨ ∨-cong ⟩ (¬-involutive _)) ⟩ + ¬ (¬ ¬ x ∨ ¬ ¬ y) ≈˘⟨ ¬-cong $ deMorgan₁ _ _ ⟩ + ¬ ¬ (¬ x ∧ ¬ y) ≈⟨ ¬-involutive _ ⟩ + ¬ x ∧ ¬ y ∎ + +------------------------------------------------------------------------ +-- (⊕, ∧, id, ⊥, ⊤) is a commutative ring + +-- This construction is parameterised over the definition of xor. + +module XorRing + (xor : Op₂ Carrier) + (⊕-def : ∀ x y → xor x y ≈ (x ∨ y) ∧ ¬ (x ∧ y)) + where + + private + infixl 6 _⊕_ + + _⊕_ : Op₂ Carrier + _⊕_ = xor + + helper : ∀ {x y u v} → x ≈ y → u ≈ v → x ∧ ¬ u ≈ y ∧ ¬ v + helper x≈y u≈v = x≈y ⟨ ∧-cong ⟩ ¬-cong u≈v + + ⊕-cong : Congruent₂ _⊕_ + ⊕-cong {x} {y} {u} {v} x≈y u≈v = begin + x ⊕ u ≈⟨ ⊕-def _ _ ⟩ + (x ∨ u) ∧ ¬ (x ∧ u) ≈⟨ helper (x≈y ⟨ ∨-cong ⟩ u≈v) + (x≈y ⟨ ∧-cong ⟩ u≈v) ⟩ + (y ∨ v) ∧ ¬ (y ∧ v) ≈˘⟨ ⊕-def _ _ ⟩ + y ⊕ v ∎ + + ⊕-comm : Commutative _⊕_ + ⊕-comm x y = begin + x ⊕ y ≈⟨ ⊕-def _ _ ⟩ + (x ∨ y) ∧ ¬ (x ∧ y) ≈⟨ helper (∨-comm _ _) (∧-comm _ _) ⟩ + (y ∨ x) ∧ ¬ (y ∧ x) ≈˘⟨ ⊕-def _ _ ⟩ + y ⊕ x ∎ + + ¬-distribˡ-⊕ : ∀ x y → ¬ (x ⊕ y) ≈ ¬ x ⊕ y + ¬-distribˡ-⊕ x y = begin + ¬ (x ⊕ y) ≈⟨ ¬-cong $ ⊕-def _ _ ⟩ + ¬ ((x ∨ y) ∧ (¬ (x ∧ y))) ≈⟨ ¬-cong (∧-∨-distribʳ _ _ _) ⟩ + ¬ ((x ∧ ¬ (x ∧ y)) ∨ (y ∧ ¬ (x ∧ y))) ≈⟨ ¬-cong $ ∨-congˡ $ ∧-congˡ $ ¬-cong (∧-comm _ _) ⟩ + ¬ ((x ∧ ¬ (x ∧ y)) ∨ (y ∧ ¬ (y ∧ x))) ≈⟨ ¬-cong $ lem _ _ ⟨ ∨-cong ⟩ lem _ _ ⟩ + ¬ ((x ∧ ¬ y) ∨ (y ∧ ¬ x)) ≈⟨ deMorgan₂ _ _ ⟩ + ¬ (x ∧ ¬ y) ∧ ¬ (y ∧ ¬ x) ≈⟨ ∧-congʳ $ deMorgan₁ _ _ ⟩ + (¬ x ∨ (¬ ¬ y)) ∧ ¬ (y ∧ ¬ x) ≈⟨ helper (∨-congˡ $ ¬-involutive _) (∧-comm _ _) ⟩ + (¬ x ∨ y) ∧ ¬ (¬ x ∧ y) ≈˘⟨ ⊕-def _ _ ⟩ + ¬ x ⊕ y ∎ + where + lem : ∀ x y → x ∧ ¬ (x ∧ y) ≈ x ∧ ¬ y + lem x y = begin + x ∧ ¬ (x ∧ y) ≈⟨ ∧-congˡ $ deMorgan₁ _ _ ⟩ + x ∧ (¬ x ∨ ¬ y) ≈⟨ ∧-∨-distribˡ _ _ _ ⟩ + (x ∧ ¬ x) ∨ (x ∧ ¬ y) ≈⟨ ∨-congʳ $ ∧-complementʳ _ ⟩ + ⊥ ∨ (x ∧ ¬ y) ≈⟨ ∨-identityˡ _ ⟩ + x ∧ ¬ y ∎ + + ¬-distribʳ-⊕ : ∀ x y → ¬ (x ⊕ y) ≈ x ⊕ ¬ y + ¬-distribʳ-⊕ x y = begin + ¬ (x ⊕ y) ≈⟨ ¬-cong $ ⊕-comm _ _ ⟩ + ¬ (y ⊕ x) ≈⟨ ¬-distribˡ-⊕ _ _ ⟩ + ¬ y ⊕ x ≈⟨ ⊕-comm _ _ ⟩ + x ⊕ ¬ y ∎ + + ⊕-annihilates-¬ : ∀ x y → x ⊕ y ≈ ¬ x ⊕ ¬ y + ⊕-annihilates-¬ x y = begin + x ⊕ y ≈˘⟨ ¬-involutive _ ⟩ + ¬ ¬ (x ⊕ y) ≈⟨ ¬-cong $ ¬-distribˡ-⊕ _ _ ⟩ + ¬ (¬ x ⊕ y) ≈⟨ ¬-distribʳ-⊕ _ _ ⟩ + ¬ x ⊕ ¬ y ∎ + + ⊕-identityˡ : LeftIdentity ⊥ _⊕_ + ⊕-identityˡ x = begin + ⊥ ⊕ x ≈⟨ ⊕-def _ _ ⟩ + (⊥ ∨ x) ∧ ¬ (⊥ ∧ x) ≈⟨ helper (∨-identityˡ _) (∧-zeroˡ _) ⟩ + x ∧ ¬ ⊥ ≈⟨ ∧-congˡ ⊥≉⊤ ⟩ + x ∧ ⊤ ≈⟨ ∧-identityʳ _ ⟩ + x ∎ + + ⊕-identityʳ : RightIdentity ⊥ _⊕_ + ⊕-identityʳ _ = ⊕-comm _ _ ⟨ trans ⟩ ⊕-identityˡ _ + + ⊕-identity : Identity ⊥ _⊕_ + ⊕-identity = ⊕-identityˡ , ⊕-identityʳ + + ⊕-inverseˡ : LeftInverse ⊥ id _⊕_ + ⊕-inverseˡ x = begin + x ⊕ x ≈⟨ ⊕-def _ _ ⟩ + (x ∨ x) ∧ ¬ (x ∧ x) ≈⟨ helper (∨-idempotent _) (∧-idempotent _) ⟩ + x ∧ ¬ x ≈⟨ ∧-complementʳ _ ⟩ + ⊥ ∎ + + ⊕-inverseʳ : RightInverse ⊥ id _⊕_ + ⊕-inverseʳ _ = ⊕-comm _ _ ⟨ trans ⟩ ⊕-inverseˡ _ + + ⊕-inverse : Inverse ⊥ id _⊕_ + ⊕-inverse = ⊕-inverseˡ , ⊕-inverseʳ + + ∧-distribˡ-⊕ : _∧_ DistributesOverˡ _⊕_ + ∧-distribˡ-⊕ x y z = begin + x ∧ (y ⊕ z) ≈⟨ ∧-congˡ $ ⊕-def _ _ ⟩ + x ∧ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈˘⟨ ∧-assoc _ _ _ ⟩ + (x ∧ (y ∨ z)) ∧ ¬ (y ∧ z) ≈⟨ ∧-congˡ $ deMorgan₁ _ _ ⟩ + (x ∧ (y ∨ z)) ∧ + (¬ y ∨ ¬ z) ≈˘⟨ ∨-identityˡ _ ⟩ + ⊥ ∨ + ((x ∧ (y ∨ z)) ∧ + (¬ y ∨ ¬ z)) ≈⟨ ∨-congʳ lem₃ ⟩ + ((x ∧ (y ∨ z)) ∧ ¬ x) ∨ + ((x ∧ (y ∨ z)) ∧ + (¬ y ∨ ¬ z)) ≈˘⟨ ∧-∨-distribˡ _ _ _ ⟩ + (x ∧ (y ∨ z)) ∧ + (¬ x ∨ (¬ y ∨ ¬ z)) ≈˘⟨ ∧-congˡ $ ∨-congˡ (deMorgan₁ _ _) ⟩ + (x ∧ (y ∨ z)) ∧ + (¬ x ∨ ¬ (y ∧ z)) ≈˘⟨ ∧-congˡ (deMorgan₁ _ _) ⟩ + (x ∧ (y ∨ z)) ∧ + ¬ (x ∧ (y ∧ z)) ≈⟨ helper refl lem₁ ⟩ + (x ∧ (y ∨ z)) ∧ + ¬ ((x ∧ y) ∧ (x ∧ z)) ≈⟨ ∧-congʳ $ ∧-∨-distribˡ _ _ _ ⟩ + ((x ∧ y) ∨ (x ∧ z)) ∧ + ¬ ((x ∧ y) ∧ (x ∧ z)) ≈˘⟨ ⊕-def _ _ ⟩ + (x ∧ y) ⊕ (x ∧ z) ∎ + where + lem₂ = begin + x ∧ (y ∧ z) ≈˘⟨ ∧-assoc _ _ _ ⟩ + (x ∧ y) ∧ z ≈⟨ ∧-congʳ $ ∧-comm _ _ ⟩ + (y ∧ x) ∧ z ≈⟨ ∧-assoc _ _ _ ⟩ + y ∧ (x ∧ z) ∎ + + lem₁ = begin + x ∧ (y ∧ z) ≈˘⟨ ∧-congʳ (∧-idempotent _) ⟩ + (x ∧ x) ∧ (y ∧ z) ≈⟨ ∧-assoc _ _ _ ⟩ + x ∧ (x ∧ (y ∧ z)) ≈⟨ ∧-congˡ lem₂ ⟩ + x ∧ (y ∧ (x ∧ z)) ≈˘⟨ ∧-assoc _ _ _ ⟩ + (x ∧ y) ∧ (x ∧ z) ∎ + + lem₃ = begin + ⊥ ≈˘⟨ ∧-zeroʳ _ ⟩ + (y ∨ z) ∧ ⊥ ≈˘⟨ ∧-congˡ (∧-complementʳ _) ⟩ + (y ∨ z) ∧ (x ∧ ¬ x) ≈˘⟨ ∧-assoc _ _ _ ⟩ + ((y ∨ z) ∧ x) ∧ ¬ x ≈⟨ ∧-comm _ _ ⟨ ∧-cong ⟩ refl ⟩ + (x ∧ (y ∨ z)) ∧ ¬ x ∎ + + ∧-distribʳ-⊕ : _∧_ DistributesOverʳ _⊕_ + ∧-distribʳ-⊕ = comm+distrˡ⇒distrʳ ⊕-cong ∧-comm ∧-distribˡ-⊕ + + ∧-distrib-⊕ : _∧_ DistributesOver _⊕_ + ∧-distrib-⊕ = ∧-distribˡ-⊕ , ∧-distribʳ-⊕ + + private + + lemma₂ : ∀ x y u v → + (x ∧ y) ∨ (u ∧ v) ≈ + ((x ∨ u) ∧ (y ∨ u)) ∧ + ((x ∨ v) ∧ (y ∨ v)) + lemma₂ x y u v = begin + (x ∧ y) ∨ (u ∧ v) ≈⟨ ∨-∧-distribˡ _ _ _ ⟩ + ((x ∧ y) ∨ u) ∧ ((x ∧ y) ∨ v) ≈⟨ ∨-∧-distribʳ _ _ _ + ⟨ ∧-cong ⟩ + ∨-∧-distribʳ _ _ _ ⟩ + ((x ∨ u) ∧ (y ∨ u)) ∧ + ((x ∨ v) ∧ (y ∨ v)) ∎ + + ⊕-assoc : Associative _⊕_ + ⊕-assoc x y z = sym $ begin + x ⊕ (y ⊕ z) ≈⟨ refl ⟨ ⊕-cong ⟩ ⊕-def _ _ ⟩ + x ⊕ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ ⊕-def _ _ ⟩ + (x ∨ ((y ∨ z) ∧ ¬ (y ∧ z))) ∧ + ¬ (x ∧ ((y ∨ z) ∧ ¬ (y ∧ z))) ≈⟨ lem₃ ⟨ ∧-cong ⟩ lem₄ ⟩ + (((x ∨ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z)) ∧ + (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈⟨ ∧-assoc _ _ _ ⟩ + ((x ∨ y) ∨ z) ∧ + (((x ∨ ¬ y) ∨ ¬ z) ∧ + (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z))) ≈⟨ ∧-congˡ lem₅ ⟩ + ((x ∨ y) ∨ z) ∧ + (((¬ x ∨ ¬ y) ∨ z) ∧ + (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z))) ≈˘⟨ ∧-assoc _ _ _ ⟩ + (((x ∨ y) ∨ z) ∧ ((¬ x ∨ ¬ y) ∨ z)) ∧ + (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈⟨ lem₁ ⟨ ∧-cong ⟩ lem₂ ⟩ + (((x ∨ y) ∧ ¬ (x ∧ y)) ∨ z) ∧ + ¬ (((x ∨ y) ∧ ¬ (x ∧ y)) ∧ z) ≈˘⟨ ⊕-def _ _ ⟩ + ((x ∨ y) ∧ ¬ (x ∧ y)) ⊕ z ≈˘⟨ ⊕-def _ _ ⟨ ⊕-cong ⟩ refl ⟩ + (x ⊕ y) ⊕ z ∎ + where + lem₁ = begin + ((x ∨ y) ∨ z) ∧ ((¬ x ∨ ¬ y) ∨ z) ≈˘⟨ ∨-∧-distribʳ _ _ _ ⟩ + ((x ∨ y) ∧ (¬ x ∨ ¬ y)) ∨ z ≈˘⟨ ∨-congʳ $ ∧-congˡ (deMorgan₁ _ _) ⟩ + ((x ∨ y) ∧ ¬ (x ∧ y)) ∨ z ∎ + + lem₂′ = begin + (x ∨ ¬ y) ∧ (¬ x ∨ y) ≈˘⟨ ∧-identityˡ _ ⟨ ∧-cong ⟩ ∧-identityʳ _ ⟩ + (⊤ ∧ (x ∨ ¬ y)) ∧ ((¬ x ∨ y) ∧ ⊤) ≈˘⟨ (∨-complementˡ _ ⟨ ∧-cong ⟩ ∨-comm _ _) + ⟨ ∧-cong ⟩ + (∧-congˡ $ ∨-complementˡ _) ⟩ + ((¬ x ∨ x) ∧ (¬ y ∨ x)) ∧ + ((¬ x ∨ y) ∧ (¬ y ∨ y)) ≈˘⟨ lemma₂ _ _ _ _ ⟩ + (¬ x ∧ ¬ y) ∨ (x ∧ y) ≈˘⟨ deMorgan₂ _ _ ⟨ ∨-cong ⟩ ¬-involutive _ ⟩ + ¬ (x ∨ y) ∨ ¬ ¬ (x ∧ y) ≈˘⟨ deMorgan₁ _ _ ⟩ + ¬ ((x ∨ y) ∧ ¬ (x ∧ y)) ∎ + + lem₂ = begin + ((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z) ≈˘⟨ ∨-∧-distribʳ _ _ _ ⟩ + ((x ∨ ¬ y) ∧ (¬ x ∨ y)) ∨ ¬ z ≈⟨ ∨-congʳ lem₂′ ⟩ + ¬ ((x ∨ y) ∧ ¬ (x ∧ y)) ∨ ¬ z ≈˘⟨ deMorgan₁ _ _ ⟩ + ¬ (((x ∨ y) ∧ ¬ (x ∧ y)) ∧ z) ∎ + + lem₃ = begin + x ∨ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ ∨-congˡ $ ∧-congˡ $ deMorgan₁ _ _ ⟩ + x ∨ ((y ∨ z) ∧ (¬ y ∨ ¬ z)) ≈⟨ ∨-∧-distribˡ _ _ _ ⟩ + (x ∨ (y ∨ z)) ∧ (x ∨ (¬ y ∨ ¬ z)) ≈˘⟨ ∨-assoc _ _ _ ⟨ ∧-cong ⟩ ∨-assoc _ _ _ ⟩ + ((x ∨ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z) ∎ + + lem₄′ = begin + ¬ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ deMorgan₁ _ _ ⟩ + ¬ (y ∨ z) ∨ ¬ ¬ (y ∧ z) ≈⟨ deMorgan₂ _ _ ⟨ ∨-cong ⟩ ¬-involutive _ ⟩ + (¬ y ∧ ¬ z) ∨ (y ∧ z) ≈⟨ lemma₂ _ _ _ _ ⟩ + ((¬ y ∨ y) ∧ (¬ z ∨ y)) ∧ + ((¬ y ∨ z) ∧ (¬ z ∨ z)) ≈⟨ (∨-complementˡ _ ⟨ ∧-cong ⟩ ∨-comm _ _) + ⟨ ∧-cong ⟩ + (∧-congˡ $ ∨-complementˡ _) ⟩ + (⊤ ∧ (y ∨ ¬ z)) ∧ + ((¬ y ∨ z) ∧ ⊤) ≈⟨ ∧-identityˡ _ ⟨ ∧-cong ⟩ ∧-identityʳ _ ⟩ + (y ∨ ¬ z) ∧ (¬ y ∨ z) ∎ + + lem₄ = begin + ¬ (x ∧ ((y ∨ z) ∧ ¬ (y ∧ z))) ≈⟨ deMorgan₁ _ _ ⟩ + ¬ x ∨ ¬ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ ∨-congˡ lem₄′ ⟩ + ¬ x ∨ ((y ∨ ¬ z) ∧ (¬ y ∨ z)) ≈⟨ ∨-∧-distribˡ _ _ _ ⟩ + (¬ x ∨ (y ∨ ¬ z)) ∧ + (¬ x ∨ (¬ y ∨ z)) ≈˘⟨ ∨-assoc _ _ _ ⟨ ∧-cong ⟩ ∨-assoc _ _ _ ⟩ + ((¬ x ∨ y) ∨ ¬ z) ∧ + ((¬ x ∨ ¬ y) ∨ z) ≈⟨ ∧-comm _ _ ⟩ + ((¬ x ∨ ¬ y) ∨ z) ∧ + ((¬ x ∨ y) ∨ ¬ z) ∎ + + lem₅ = begin + ((x ∨ ¬ y) ∨ ¬ z) ∧ + (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈˘⟨ ∧-assoc _ _ _ ⟩ + (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ ¬ y) ∨ z)) ∧ + ((¬ x ∨ y) ∨ ¬ z) ≈⟨ ∧-congʳ $ ∧-comm _ _ ⟩ + (((¬ x ∨ ¬ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z)) ∧ + ((¬ x ∨ y) ∨ ¬ z) ≈⟨ ∧-assoc _ _ _ ⟩ + ((¬ x ∨ ¬ y) ∨ z) ∧ + (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ∎ + + ⊕-isMagma : IsMagma _⊕_ + ⊕-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = ⊕-cong + } + + ⊕-isSemigroup : IsSemigroup _⊕_ + ⊕-isSemigroup = record + { isMagma = ⊕-isMagma + ; assoc = ⊕-assoc + } + + ⊕-⊥-isMonoid : IsMonoid _⊕_ ⊥ + ⊕-⊥-isMonoid = record + { isSemigroup = ⊕-isSemigroup + ; identity = ⊕-identity + } + + ⊕-⊥-isGroup : IsGroup _⊕_ ⊥ id + ⊕-⊥-isGroup = record + { isMonoid = ⊕-⊥-isMonoid + ; inverse = ⊕-inverse + ; ⁻¹-cong = id + } + + ⊕-⊥-isAbelianGroup : IsAbelianGroup _⊕_ ⊥ id + ⊕-⊥-isAbelianGroup = record + { isGroup = ⊕-⊥-isGroup + ; comm = ⊕-comm + } + + ⊕-∧-isRing : IsRing _⊕_ _∧_ id ⊥ ⊤ + ⊕-∧-isRing = record + { +-isAbelianGroup = ⊕-⊥-isAbelianGroup + ; *-isMonoid = ∧-⊤-isMonoid + ; distrib = ∧-distrib-⊕ + ; zero = ∧-zero + } + + ⊕-∧-isCommutativeRing : IsCommutativeRing _⊕_ _∧_ id ⊥ ⊤ + ⊕-∧-isCommutativeRing = record + { isRing = ⊕-∧-isRing + ; *-comm = ∧-comm + } + + ⊕-∧-commutativeRing : CommutativeRing _ _ + ⊕-∧-commutativeRing = record + { isCommutativeRing = ⊕-∧-isCommutativeRing + } + + ⊕-¬-distribˡ = ¬-distribˡ-⊕ + {-# WARNING_ON_USAGE ⊕-¬-distribˡ + "Warning: ⊕-¬-distribˡ was deprecated in v1.1. + Please use ¬-distribˡ-⊕ instead." + #-} + ⊕-¬-distribʳ = ¬-distribʳ-⊕ + {-# WARNING_ON_USAGE ⊕-¬-distribʳ + "Warning: ⊕-¬-distribʳ was deprecated in v1.1. + Please use ¬-distribʳ-⊕ instead." + #-} + isCommutativeRing = ⊕-∧-isCommutativeRing + {-# WARNING_ON_USAGE isCommutativeRing + "Warning: isCommutativeRing was deprecated in v1.1. + Please use ⊕-∧-isCommutativeRing instead." + #-} + commutativeRing = ⊕-∧-commutativeRing + {-# WARNING_ON_USAGE commutativeRing + "Warning: commutativeRing was deprecated in v1.1. + Please use ⊕-∧-commutativeRing instead." + #-} + + +infixl 6 _⊕_ + +_⊕_ : Op₂ Carrier +x ⊕ y = (x ∨ y) ∧ ¬ (x ∧ y) + +module DefaultXorRing = XorRing _⊕_ (λ _ _ → refl) + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.1 + +¬⊥=⊤ = ⊥≉⊤ +{-# WARNING_ON_USAGE ¬⊥=⊤ +"Warning: ¬⊥=⊤ was deprecated in v1.1. +Please use ⊥≉⊤ instead." +#-} +¬⊤=⊥ = ⊤≉⊥ +{-# WARNING_ON_USAGE ¬⊤=⊥ +"Warning: ¬⊤=⊥ was deprecated in v1.1. +Please use ⊤≉⊥ instead." +#-} + +-- Version 1.4 + +replace-equality : {_≈′_ : Rel Carrier b₂} → + (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → + BooleanAlgebra _ _ +replace-equality {_≈′_} ≈⇔≈′ = record + { isBooleanAlgebra = record + { isDistributiveLattice = DistributiveLattice.isDistributiveLattice + (DistribLatticeProperties.replace-equality distributiveLattice ≈⇔≈′) + ; ∨-complementʳ = λ x → to ⟨$⟩ ∨-complementʳ x + ; ∧-complementʳ = λ x → to ⟨$⟩ ∧-complementʳ x + ; ¬-cong = λ i≈j → to ⟨$⟩ ¬-cong (from ⟨$⟩ i≈j) + } + } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) +{-# WARNING_ON_USAGE replace-equality +"Warning: replace-equality was deprecated in v1.4. +Please use isBooleanAlgebra from `Algebra.Construct.Subst.Equality` instead." +#-} +\ No newline at end of file diff --git a/docs/Algebra.Properties.CommutativeSemigroup.html b/docs/Algebra.Properties.CommutativeSemigroup.html new file mode 100644 index 0000000..974559d --- /dev/null +++ b/docs/Algebra.Properties.CommutativeSemigroup.html @@ -0,0 +1,124 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Some theory for commutative semigroup +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Algebra using (CommutativeSemigroup) + +module Algebra.Properties.CommutativeSemigroup + {a ℓ} (CS : CommutativeSemigroup a ℓ) + where + +open CommutativeSemigroup CS + +open import Relation.Binary.Reasoning.Setoid setoid + +------------------------------------------------------------------------------ +-- Re-export the contents of semigroup + +open import Algebra.Properties.Semigroup semigroup public + +------------------------------------------------------------------------------ +-- Permutation laws for _∙_ for three factors. + +------------------------------------------------------------------------------ +-- Partitions (1,1). +-- There are five nontrivial permutations. +------------------------------------------------------------------------------ + +x∙yz≈y∙xz : ∀ x y z → x ∙ (y ∙ z) ≈ y ∙ (x ∙ z) +x∙yz≈y∙xz x y z = begin + x ∙ (y ∙ z) ≈⟨ sym (assoc x y z) ⟩ + (x ∙ y) ∙ z ≈⟨ ∙-congʳ (comm x y) ⟩ + (y ∙ x) ∙ z ≈⟨ assoc y x z ⟩ + y ∙ (x ∙ z) ∎ + +x∙yz≈z∙yx : ∀ x y z → x ∙ (y ∙ z) ≈ z ∙ (y ∙ x) +x∙yz≈z∙yx x y z = begin + x ∙ (y ∙ z) ≈⟨ ∙-congˡ (comm y z) ⟩ + x ∙ (z ∙ y) ≈⟨ x∙yz≈y∙xz x z y ⟩ + z ∙ (x ∙ y) ≈⟨ ∙-congˡ (comm x y) ⟩ + z ∙ (y ∙ x) ∎ + +x∙yz≈x∙zy : ∀ x y z → x ∙ (y ∙ z) ≈ x ∙ (z ∙ y) +x∙yz≈x∙zy _ y z = ∙-congˡ (comm y z) + +x∙yz≈y∙zx : ∀ x y z → x ∙ (y ∙ z) ≈ y ∙ (z ∙ x) +x∙yz≈y∙zx x y z = begin + x ∙ (y ∙ z) ≈⟨ comm x _ ⟩ + (y ∙ z) ∙ x ≈⟨ assoc y z x ⟩ + y ∙ (z ∙ x) ∎ + +x∙yz≈z∙xy : ∀ x y z → x ∙ (y ∙ z) ≈ z ∙ (x ∙ y) +x∙yz≈z∙xy x y z = begin + x ∙ (y ∙ z) ≈⟨ sym (assoc x y z) ⟩ + (x ∙ y) ∙ z ≈⟨ comm _ z ⟩ + z ∙ (x ∙ y) ∎ + +------------------------------------------------------------------------------ +-- Partitions (1,2). +-- These permutation laws are proved by composing the proofs for +-- partitions (1,1) with \p → trans p (sym (assoc _ _ _)). +------------------------------------------------------------------------------ + +x∙yz≈yx∙z : ∀ x y z → x ∙ (y ∙ z) ≈ (y ∙ x) ∙ z +x∙yz≈yx∙z x y z = trans (x∙yz≈y∙xz x y z) (sym (assoc y x z)) + +x∙yz≈zy∙x : ∀ x y z → x ∙ (y ∙ z) ≈ (z ∙ y) ∙ x +x∙yz≈zy∙x x y z = trans (x∙yz≈z∙yx x y z) (sym (assoc z y x)) + +x∙yz≈xz∙y : ∀ x y z → x ∙ (y ∙ z) ≈ (x ∙ z) ∙ y +x∙yz≈xz∙y x y z = trans (x∙yz≈x∙zy x y z) (sym (assoc x z y)) + +x∙yz≈yz∙x : ∀ x y z → x ∙ (y ∙ z) ≈ (y ∙ z) ∙ x +x∙yz≈yz∙x x y z = trans (x∙yz≈y∙zx _ _ _) (sym (assoc y z x)) + +x∙yz≈zx∙y : ∀ x y z → x ∙ (y ∙ z) ≈ (z ∙ x) ∙ y +x∙yz≈zx∙y x y z = trans (x∙yz≈z∙xy x y z) (sym (assoc z x y)) + + +------------------------------------------------------------------------------ +-- Partitions (2,1). +-- Their laws are proved by composing proofs for partitions (1,1) with +-- trans (assoc x y z). +------------------------------------------------------------------------------ + +xy∙z≈y∙xz : ∀ x y z → (x ∙ y) ∙ z ≈ y ∙ (x ∙ z) +xy∙z≈y∙xz x y z = trans (assoc x y z) (x∙yz≈y∙xz x y z) + +xy∙z≈z∙yx : ∀ x y z → (x ∙ y) ∙ z ≈ z ∙ (y ∙ x) +xy∙z≈z∙yx x y z = trans (assoc x y z) (x∙yz≈z∙yx x y z) + +xy∙z≈x∙zy : ∀ x y z → (x ∙ y) ∙ z ≈ x ∙ (z ∙ y) +xy∙z≈x∙zy x y z = trans (assoc x y z) (x∙yz≈x∙zy x y z) + +xy∙z≈y∙zx : ∀ x y z → (x ∙ y) ∙ z ≈ y ∙ (z ∙ x) +xy∙z≈y∙zx x y z = trans (assoc x y z) (x∙yz≈y∙zx x y z) + +xy∙z≈z∙xy : ∀ x y z → (x ∙ y) ∙ z ≈ z ∙ (x ∙ y) +xy∙z≈z∙xy x y z = trans (assoc x y z) (x∙yz≈z∙xy x y z) + +------------------------------------------------------------------------------ +-- Partitions (2,2). +-- These proofs are by composing with the proofs for (2,1). +------------------------------------------------------------------------------ + +xy∙z≈yx∙z : ∀ x y z → (x ∙ y) ∙ z ≈ (y ∙ x) ∙ z +xy∙z≈yx∙z x y z = trans (xy∙z≈y∙xz _ _ _) (sym (assoc y x z)) + +xy∙z≈zy∙x : ∀ x y z → (x ∙ y) ∙ z ≈ (z ∙ y) ∙ x +xy∙z≈zy∙x x y z = trans (xy∙z≈z∙yx x y z) (sym (assoc z y x)) + +xy∙z≈xz∙y : ∀ x y z → (x ∙ y) ∙ z ≈ (x ∙ z) ∙ y +xy∙z≈xz∙y x y z = trans (xy∙z≈x∙zy x y z) (sym (assoc x z y)) + +xy∙z≈yz∙x : ∀ x y z → (x ∙ y) ∙ z ≈ (y ∙ z) ∙ x +xy∙z≈yz∙x x y z = trans (xy∙z≈y∙zx x y z) (sym (assoc y z x)) + +xy∙z≈zx∙y : ∀ x y z → (x ∙ y) ∙ z ≈ (z ∙ x) ∙ y +xy∙z≈zx∙y x y z = trans (xy∙z≈z∙xy x y z) (sym (assoc z x y)) +\ No newline at end of file diff --git a/docs/Algebra.Properties.DistributiveLattice.html b/docs/Algebra.Properties.DistributiveLattice.html new file mode 100644 index 0000000..2e8f2c9 --- /dev/null +++ b/docs/Algebra.Properties.DistributiveLattice.html @@ -0,0 +1,132 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Some derivable properties +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +-- Disabled to prevent warnings from deprecated names +{-# OPTIONS --warn=noUserWarning #-} + +open import Algebra.Bundles + +module Algebra.Properties.DistributiveLattice + {dl₁ dl₂} (DL : DistributiveLattice dl₁ dl₂) + where + +open DistributiveLattice DL +import Algebra.Properties.Lattice as LatticeProperties +open import Algebra.Structures +open import Algebra.Definitions _≈_ +open import Relation.Binary +open import Relation.Binary.Reasoning.Setoid setoid +open import Function.Base +open import Function.Equality using (_⟨$⟩_) +open import Function.Equivalence using (_⇔_; module Equivalence) +open import Data.Product using (_,_) + +------------------------------------------------------------------------ +-- Export properties of lattices + +open LatticeProperties lattice public + hiding (replace-equality) + +------------------------------------------------------------------------ +-- Other properties + +∨-distribˡ-∧ : _∨_ DistributesOverˡ _∧_ +∨-distribˡ-∧ x y z = begin + x ∨ y ∧ z ≈⟨ ∨-comm _ _ ⟩ + y ∧ z ∨ x ≈⟨ ∨-distribʳ-∧ _ _ _ ⟩ + (y ∨ x) ∧ (z ∨ x) ≈⟨ ∨-comm _ _ ⟨ ∧-cong ⟩ ∨-comm _ _ ⟩ + (x ∨ y) ∧ (x ∨ z) ∎ + +∨-distrib-∧ : _∨_ DistributesOver _∧_ +∨-distrib-∧ = ∨-distribˡ-∧ , ∨-distribʳ-∧ + +∧-distribˡ-∨ : _∧_ DistributesOverˡ _∨_ +∧-distribˡ-∨ x y z = begin + x ∧ (y ∨ z) ≈⟨ ∧-congʳ $ sym (∧-absorbs-∨ _ _) ⟩ + (x ∧ (x ∨ y)) ∧ (y ∨ z) ≈⟨ ∧-congʳ $ ∧-congˡ $ ∨-comm _ _ ⟩ + (x ∧ (y ∨ x)) ∧ (y ∨ z) ≈⟨ ∧-assoc _ _ _ ⟩ + x ∧ ((y ∨ x) ∧ (y ∨ z)) ≈⟨ ∧-congˡ $ sym (∨-distribˡ-∧ _ _ _) ⟩ + x ∧ (y ∨ x ∧ z) ≈⟨ ∧-congʳ $ sym (∨-absorbs-∧ _ _) ⟩ + (x ∨ x ∧ z) ∧ (y ∨ x ∧ z) ≈⟨ sym $ ∨-distribʳ-∧ _ _ _ ⟩ + x ∧ y ∨ x ∧ z ∎ + +∧-distribʳ-∨ : _∧_ DistributesOverʳ _∨_ +∧-distribʳ-∨ x y z = begin + (y ∨ z) ∧ x ≈⟨ ∧-comm _ _ ⟩ + x ∧ (y ∨ z) ≈⟨ ∧-distribˡ-∨ _ _ _ ⟩ + x ∧ y ∨ x ∧ z ≈⟨ ∧-comm _ _ ⟨ ∨-cong ⟩ ∧-comm _ _ ⟩ + y ∧ x ∨ z ∧ x ∎ + +∧-distrib-∨ : _∧_ DistributesOver _∨_ +∧-distrib-∨ = ∧-distribˡ-∨ , ∧-distribʳ-∨ + +-- The dual construction is also a distributive lattice. + +∧-∨-isDistributiveLattice : IsDistributiveLattice _≈_ _∧_ _∨_ +∧-∨-isDistributiveLattice = record + { isLattice = ∧-∨-isLattice + ; ∨-distribʳ-∧ = ∧-distribʳ-∨ + } + +∧-∨-distributiveLattice : DistributiveLattice _ _ +∧-∨-distributiveLattice = record + { isDistributiveLattice = ∧-∨-isDistributiveLattice + } + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.1 + +∨-∧-distribˡ = ∨-distribˡ-∧ +{-# WARNING_ON_USAGE ∨-∧-distribˡ +"Warning: ∨-∧-distribˡ was deprecated in v1.1. +Please use ∨-distribˡ-∧ instead." +#-} +∨-∧-distrib = ∨-distrib-∧ +{-# WARNING_ON_USAGE ∨-∧-distrib +"Warning: ∨-∧-distrib was deprecated in v1.1. +Please use ∨-distrib-∧ instead." +#-} +∧-∨-distribˡ = ∧-distribˡ-∨ +{-# WARNING_ON_USAGE ∧-∨-distribˡ +"Warning: ∧-∨-distribˡ was deprecated in v1.1. +Please use ∧-distribˡ-∨ instead." +#-} +∧-∨-distribʳ = ∧-distribʳ-∨ +{-# WARNING_ON_USAGE ∧-∨-distribʳ +"Warning: ∧-∨-distribʳ was deprecated in v1.1. +Please use ∧-distribʳ-∨ instead." +#-} +∧-∨-distrib = ∧-distrib-∨ +{-# WARNING_ON_USAGE ∧-∨-distrib +"Warning: ∧-∨-distrib was deprecated in v1.1. +Please use ∧-distrib-∨ instead." +#-} + +-- Version 1.4 + +replace-equality : {_≈′_ : Rel Carrier dl₂} → + (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → + DistributiveLattice _ _ +replace-equality {_≈′_} ≈⇔≈′ = record + { isDistributiveLattice = record + { isLattice = Lattice.isLattice + (LatticeProperties.replace-equality lattice ≈⇔≈′) + ; ∨-distribʳ-∧ = λ x y z → to ⟨$⟩ ∨-distribʳ-∧ x y z + } + } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) +{-# WARNING_ON_USAGE replace-equality +"Warning: replace-equality was deprecated in v1.4. +Please use isDistributiveLattice from `Algebra.Construct.Subst.Equality` instead." +#-} +\ No newline at end of file diff --git a/docs/Algebra.Properties.Group.html b/docs/Algebra.Properties.Group.html new file mode 100644 index 0000000..e5e8eb2 --- /dev/null +++ b/docs/Algebra.Properties.Group.html @@ -0,0 +1,140 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Some derivable properties +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Algebra.Bundles + +module Algebra.Properties.Group {g₁ g₂} (G : Group g₁ g₂) where + +open Group G +open import Algebra.Definitions _≈_ +open import Relation.Binary.Reasoning.Setoid setoid +open import Function +open import Data.Product + +ε⁻¹≈ε : ε ⁻¹ ≈ ε +ε⁻¹≈ε = begin + ε ⁻¹ ≈⟨ sym $ identityʳ (ε ⁻¹) ⟩ + ε ⁻¹ ∙ ε ≈⟨ inverseˡ ε ⟩ + ε ∎ + +private + + left-helper : ∀ x y → x ≈ (x ∙ y) ∙ y ⁻¹ + left-helper x y = begin + x ≈⟨ sym (identityʳ x) ⟩ + x ∙ ε ≈⟨ ∙-congˡ $ sym (inverseʳ y) ⟩ + x ∙ (y ∙ y ⁻¹) ≈⟨ sym (assoc x y (y ⁻¹)) ⟩ + (x ∙ y) ∙ y ⁻¹ ∎ + + right-helper : ∀ x y → y ≈ x ⁻¹ ∙ (x ∙ y) + right-helper x y = begin + y ≈⟨ sym (identityˡ y) ⟩ + ε ∙ y ≈⟨ ∙-congʳ $ sym (inverseˡ x) ⟩ + (x ⁻¹ ∙ x) ∙ y ≈⟨ assoc (x ⁻¹) x y ⟩ + x ⁻¹ ∙ (x ∙ y) ∎ + +∙-cancelˡ : LeftCancellative _∙_ +∙-cancelˡ x {y} {z} eq = begin + y ≈⟨ right-helper x y ⟩ + x ⁻¹ ∙ (x ∙ y) ≈⟨ ∙-congˡ eq ⟩ + x ⁻¹ ∙ (x ∙ z) ≈˘⟨ right-helper x z ⟩ + z ∎ + +∙-cancelʳ : RightCancellative _∙_ +∙-cancelʳ {x} y z eq = begin + y ≈⟨ left-helper y x ⟩ + y ∙ x ∙ x ⁻¹ ≈⟨ ∙-congʳ eq ⟩ + z ∙ x ∙ x ⁻¹ ≈˘⟨ left-helper z x ⟩ + z ∎ + +∙-cancel : Cancellative _∙_ +∙-cancel = ∙-cancelˡ , ∙-cancelʳ + +⁻¹-involutive : ∀ x → x ⁻¹ ⁻¹ ≈ x +⁻¹-involutive x = begin + x ⁻¹ ⁻¹ ≈˘⟨ identityʳ _ ⟩ + x ⁻¹ ⁻¹ ∙ ε ≈˘⟨ ∙-congˡ $ inverseˡ _ ⟩ + x ⁻¹ ⁻¹ ∙ (x ⁻¹ ∙ x) ≈˘⟨ right-helper (x ⁻¹) x ⟩ + x ∎ + +⁻¹-injective : ∀ {x y} → x ⁻¹ ≈ y ⁻¹ → x ≈ y +⁻¹-injective {x} {y} eq = ∙-cancelʳ x y ( begin + x ∙ x ⁻¹ ≈⟨ inverseʳ x ⟩ + ε ≈˘⟨ inverseʳ y ⟩ + y ∙ y ⁻¹ ≈˘⟨ ∙-congˡ eq ⟩ + y ∙ x ⁻¹ ∎ ) + +⁻¹-anti-homo-∙ : ∀ x y → (x ∙ y) ⁻¹ ≈ y ⁻¹ ∙ x ⁻¹ +⁻¹-anti-homo-∙ x y = ∙-cancelˡ _ ( begin + x ∙ y ∙ (x ∙ y) ⁻¹ ≈⟨ inverseʳ _ ⟩ + ε ≈˘⟨ inverseʳ _ ⟩ + x ∙ x ⁻¹ ≈⟨ ∙-congʳ (left-helper x y) ⟩ + (x ∙ y) ∙ y ⁻¹ ∙ x ⁻¹ ≈⟨ assoc (x ∙ y) (y ⁻¹) (x ⁻¹) ⟩ + x ∙ y ∙ (y ⁻¹ ∙ x ⁻¹) ∎ ) + +identityˡ-unique : ∀ x y → x ∙ y ≈ y → x ≈ ε +identityˡ-unique x y eq = begin + x ≈⟨ left-helper x y ⟩ + (x ∙ y) ∙ y ⁻¹ ≈⟨ ∙-congʳ eq ⟩ + y ∙ y ⁻¹ ≈⟨ inverseʳ y ⟩ + ε ∎ + +identityʳ-unique : ∀ x y → x ∙ y ≈ x → y ≈ ε +identityʳ-unique x y eq = begin + y ≈⟨ right-helper x y ⟩ + x ⁻¹ ∙ (x ∙ y) ≈⟨ refl ⟨ ∙-cong ⟩ eq ⟩ + x ⁻¹ ∙ x ≈⟨ inverseˡ x ⟩ + ε ∎ + +identity-unique : ∀ {x} → Identity x _∙_ → x ≈ ε +identity-unique {x} id = identityˡ-unique x x (proj₂ id x) + +inverseˡ-unique : ∀ x y → x ∙ y ≈ ε → x ≈ y ⁻¹ +inverseˡ-unique x y eq = begin + x ≈⟨ left-helper x y ⟩ + (x ∙ y) ∙ y ⁻¹ ≈⟨ ∙-congʳ eq ⟩ + ε ∙ y ⁻¹ ≈⟨ identityˡ (y ⁻¹) ⟩ + y ⁻¹ ∎ + +inverseʳ-unique : ∀ x y → x ∙ y ≈ ε → y ≈ x ⁻¹ +inverseʳ-unique x y eq = begin + y ≈⟨ sym (⁻¹-involutive y) ⟩ + y ⁻¹ ⁻¹ ≈⟨ ⁻¹-cong (sym (inverseˡ-unique x y eq)) ⟩ + x ⁻¹ ∎ + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.1 + +left-identity-unique = identityˡ-unique +{-# WARNING_ON_USAGE left-identity-unique +"Warning: left-identity-unique was deprecated in v1.1. +Please use identityˡ-unique instead." +#-} +right-identity-unique = identityʳ-unique +{-# WARNING_ON_USAGE right-identity-unique +"Warning: right-identity-unique was deprecated in v1.1. +Please use identityʳ-unique instead." +#-} +left-inverse-unique = inverseˡ-unique +{-# WARNING_ON_USAGE left-inverse-unique +"Warning: left-inverse-unique was deprecated in v1.1. +Please use inverseˡ-unique instead." +#-} +right-inverse-unique = inverseʳ-unique +{-# WARNING_ON_USAGE right-inverse-unique +"Warning: right-inverse-unique was deprecated in v1.1. +Please use inverseʳ-unique instead." +#-} +\ No newline at end of file diff --git a/docs/Algebra.Properties.Lattice.html b/docs/Algebra.Properties.Lattice.html new file mode 100644 index 0000000..db15468 --- /dev/null +++ b/docs/Algebra.Properties.Lattice.html @@ -0,0 +1,237 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Some derivable properties +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Algebra.Bundles + +module Algebra.Properties.Lattice {l₁ l₂} (L : Lattice l₁ l₂) where + +open Lattice L +open import Algebra.Structures _≈_ +open import Algebra.Definitions _≈_ +import Algebra.Properties.Semilattice as SemilatticeProperties +open import Relation.Binary +import Relation.Binary.Lattice as R +open import Relation.Binary.Reasoning.Setoid setoid +open import Function.Base +open import Function.Equality using (_⟨$⟩_) +open import Function.Equivalence using (_⇔_; module Equivalence) +open import Data.Product using (_,_; swap) + +------------------------------------------------------------------------ +-- _∧_ is a semilattice + +∧-idem : Idempotent _∧_ +∧-idem x = begin + x ∧ x ≈⟨ ∧-congˡ (sym (∨-absorbs-∧ _ _)) ⟩ + x ∧ (x ∨ x ∧ x) ≈⟨ ∧-absorbs-∨ _ _ ⟩ + x ∎ + +∧-isMagma : IsMagma _∧_ +∧-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = ∧-cong + } + +∧-isSemigroup : IsSemigroup _∧_ +∧-isSemigroup = record + { isMagma = ∧-isMagma + ; assoc = ∧-assoc + } + +∧-isBand : IsBand _∧_ +∧-isBand = record + { isSemigroup = ∧-isSemigroup + ; idem = ∧-idem + } + +∧-isSemilattice : IsSemilattice _∧_ +∧-isSemilattice = record + { isBand = ∧-isBand + ; comm = ∧-comm + } + +∧-semilattice : Semilattice l₁ l₂ +∧-semilattice = record + { isSemilattice = ∧-isSemilattice + } + +open SemilatticeProperties ∧-semilattice public + using + ( ∧-isOrderTheoreticMeetSemilattice + ; ∧-isOrderTheoreticJoinSemilattice + ; ∧-orderTheoreticMeetSemilattice + ; ∧-orderTheoreticJoinSemilattice + ) + +------------------------------------------------------------------------ +-- _∨_ is a semilattice + +∨-idem : Idempotent _∨_ +∨-idem x = begin + x ∨ x ≈⟨ ∨-congˡ (sym (∧-idem _)) ⟩ + x ∨ x ∧ x ≈⟨ ∨-absorbs-∧ _ _ ⟩ + x ∎ + +∨-isMagma : IsMagma _∨_ +∨-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = ∨-cong + } + +∨-isSemigroup : IsSemigroup _∨_ +∨-isSemigroup = record + { isMagma = ∨-isMagma + ; assoc = ∨-assoc + } + +∨-isBand : IsBand _∨_ +∨-isBand = record + { isSemigroup = ∨-isSemigroup + ; idem = ∨-idem + } + +∨-isSemilattice : IsSemilattice _∨_ +∨-isSemilattice = record + { isBand = ∨-isBand + ; comm = ∨-comm + } + +∨-semilattice : Semilattice l₁ l₂ +∨-semilattice = record + { isSemilattice = ∨-isSemilattice + } + +open SemilatticeProperties ∨-semilattice public + using () + renaming + ( ∧-isOrderTheoreticMeetSemilattice to ∨-isOrderTheoreticMeetSemilattice + ; ∧-isOrderTheoreticJoinSemilattice to ∨-isOrderTheoreticJoinSemilattice + ; ∧-orderTheoreticMeetSemilattice to ∨-orderTheoreticMeetSemilattice + ; ∧-orderTheoreticJoinSemilattice to ∨-orderTheoreticJoinSemilattice + ) + +------------------------------------------------------------------------ +-- The dual construction is also a lattice. + +∧-∨-isLattice : IsLattice _∧_ _∨_ +∧-∨-isLattice = record + { isEquivalence = isEquivalence + ; ∨-comm = ∧-comm + ; ∨-assoc = ∧-assoc + ; ∨-cong = ∧-cong + ; ∧-comm = ∨-comm + ; ∧-assoc = ∨-assoc + ; ∧-cong = ∨-cong + ; absorptive = swap absorptive + } + +∧-∨-lattice : Lattice _ _ +∧-∨-lattice = record + { isLattice = ∧-∨-isLattice + } + +------------------------------------------------------------------------ +-- Every algebraic lattice can be turned into an order-theoretic one. + +open SemilatticeProperties ∧-semilattice public using (poset) +open Poset poset using (_≤_; isPartialOrder) + +∨-∧-isOrderTheoreticLattice : R.IsLattice _≈_ _≤_ _∨_ _∧_ +∨-∧-isOrderTheoreticLattice = record + { isPartialOrder = isPartialOrder + ; supremum = supremum + ; infimum = infimum + } + where + open R.MeetSemilattice ∧-orderTheoreticMeetSemilattice using (infimum) + open R.JoinSemilattice ∨-orderTheoreticJoinSemilattice using (x≤x∨y; y≤x∨y; ∨-least) + renaming (_≤_ to _≤′_) + + -- An alternative but equivalent interpretation of the order _≤_. + + sound : ∀ {x y} → x ≤′ y → x ≤ y + sound {x} {y} y≈y∨x = sym $ begin + x ∧ y ≈⟨ ∧-congˡ y≈y∨x ⟩ + x ∧ (y ∨ x) ≈⟨ ∧-congˡ (∨-comm y x) ⟩ + x ∧ (x ∨ y) ≈⟨ ∧-absorbs-∨ x y ⟩ + x ∎ + + complete : ∀ {x y} → x ≤ y → x ≤′ y + complete {x} {y} x≈x∧y = sym $ begin + y ∨ x ≈⟨ ∨-congˡ x≈x∧y ⟩ + y ∨ (x ∧ y) ≈⟨ ∨-congˡ (∧-comm x y) ⟩ + y ∨ (y ∧ x) ≈⟨ ∨-absorbs-∧ y x ⟩ + y ∎ + + supremum : R.Supremum _≤_ _∨_ + supremum x y = + sound (x≤x∨y x y) , + sound (y≤x∨y x y) , + λ z x≤z y≤z → sound (∨-least (complete x≤z) (complete y≤z)) + +∨-∧-orderTheoreticLattice : R.Lattice _ _ _ +∨-∧-orderTheoreticLattice = record + { isLattice = ∨-∧-isOrderTheoreticLattice + } + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.1 + +∧-idempotent = ∧-idem +{-# WARNING_ON_USAGE ∧-idempotent +"Warning: ∧-idempotent was deprecated in v1.1. +Please use ∧-idem instead." +#-} +∨-idempotent = ∨-idem +{-# WARNING_ON_USAGE ∨-idempotent +"Warning: ∨-idempotent was deprecated in v1.1. +Please use ∨-idem instead." +#-} +isOrderTheoreticLattice = ∨-∧-isOrderTheoreticLattice +{-# WARNING_ON_USAGE isOrderTheoreticLattice +"Warning: isOrderTheoreticLattice was deprecated in v1.1. +Please use ∨-∧-isOrderTheoreticLattice instead." +#-} +orderTheoreticLattice = ∨-∧-orderTheoreticLattice +{-# WARNING_ON_USAGE orderTheoreticLattice +"Warning: orderTheoreticLattice was deprecated in v1.1. +Please use ∨-∧-orderTheoreticLattice instead." +#-} + +-- Version 1.4 + +replace-equality : {_≈′_ : Rel Carrier l₂} → + (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → Lattice _ _ +replace-equality {_≈′_} ≈⇔≈′ = record + { isLattice = record + { isEquivalence = record + { refl = to ⟨$⟩ refl + ; sym = λ x≈y → to ⟨$⟩ sym (from ⟨$⟩ x≈y) + ; trans = λ x≈y y≈z → to ⟨$⟩ trans (from ⟨$⟩ x≈y) (from ⟨$⟩ y≈z) + } + ; ∨-comm = λ x y → to ⟨$⟩ ∨-comm x y + ; ∨-assoc = λ x y z → to ⟨$⟩ ∨-assoc x y z + ; ∨-cong = λ x≈y u≈v → to ⟨$⟩ ∨-cong (from ⟨$⟩ x≈y) (from ⟨$⟩ u≈v) + ; ∧-comm = λ x y → to ⟨$⟩ ∧-comm x y + ; ∧-assoc = λ x y z → to ⟨$⟩ ∧-assoc x y z + ; ∧-cong = λ x≈y u≈v → to ⟨$⟩ ∧-cong (from ⟨$⟩ x≈y) (from ⟨$⟩ u≈v) + ; absorptive = (λ x y → to ⟨$⟩ ∨-absorbs-∧ x y) + , (λ x y → to ⟨$⟩ ∧-absorbs-∨ x y) + } + } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) +{-# WARNING_ON_USAGE replace-equality +"Warning: replace-equality was deprecated in v1.4. +Please use isLattice from `Algebra.Construct.Subst.Equality` instead." +#-} +\ No newline at end of file diff --git a/docs/Algebra.Properties.Semigroup.html b/docs/Algebra.Properties.Semigroup.html new file mode 100644 index 0000000..1d182e5 --- /dev/null +++ b/docs/Algebra.Properties.Semigroup.html @@ -0,0 +1,18 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Some theory for Semigroup +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Algebra using (Semigroup) + +module Algebra.Properties.Semigroup {a ℓ} (S : Semigroup a ℓ) where + +open Semigroup S + +x∙yz≈xy∙z : ∀ x y z → x ∙ (y ∙ z) ≈ (x ∙ y) ∙ z +x∙yz≈xy∙z x y z = sym (assoc x y z) +\ No newline at end of file diff --git a/docs/Algebra.Properties.Semilattice.html b/docs/Algebra.Properties.Semilattice.html new file mode 100644 index 0000000..b87dde1 --- /dev/null +++ b/docs/Algebra.Properties.Semilattice.html @@ -0,0 +1,91 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Some derivable properties +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Algebra + +module Algebra.Properties.Semilattice {c ℓ} (L : Semilattice c ℓ) where + +open Semilattice L + +open import Algebra.Structures +open import Function +open import Data.Product +open import Relation.Binary +open import Relation.Binary.Reasoning.Setoid setoid +import Relation.Binary.Construct.NaturalOrder.Left _≈_ _∧_ as LeftNaturalOrder +open import Relation.Binary.Lattice +import Relation.Binary.Properties.Poset as PosetProperties +open import Relation.Binary.Reasoning.Setoid setoid + +------------------------------------------------------------------------ +-- Every semilattice can be turned into a poset via the left natural +-- order. + +poset : Poset c ℓ ℓ +poset = LeftNaturalOrder.poset isSemilattice + +open Poset poset using (_≤_; isPartialOrder) +open PosetProperties poset using (_≥_; ≥-isPartialOrder) + +------------------------------------------------------------------------ +-- Every algebraic semilattice can be turned into an order-theoretic one. + +∧-isOrderTheoreticMeetSemilattice : IsMeetSemilattice _≈_ _≤_ _∧_ +∧-isOrderTheoreticMeetSemilattice = record + { isPartialOrder = isPartialOrder + ; infimum = LeftNaturalOrder.infimum isSemilattice + } + +∧-isOrderTheoreticJoinSemilattice : IsJoinSemilattice _≈_ _≥_ _∧_ +∧-isOrderTheoreticJoinSemilattice = record + { isPartialOrder = ≥-isPartialOrder + ; supremum = IsMeetSemilattice.infimum + ∧-isOrderTheoreticMeetSemilattice + } + +∧-orderTheoreticMeetSemilattice : MeetSemilattice c ℓ ℓ +∧-orderTheoreticMeetSemilattice = record + { isMeetSemilattice = ∧-isOrderTheoreticMeetSemilattice + } + +∧-orderTheoreticJoinSemilattice : JoinSemilattice c ℓ ℓ +∧-orderTheoreticJoinSemilattice = record + { isJoinSemilattice = ∧-isOrderTheoreticJoinSemilattice + } + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.1 + +isOrderTheoreticMeetSemilattice = ∧-isOrderTheoreticMeetSemilattice +{-# WARNING_ON_USAGE isOrderTheoreticMeetSemilattice +"Warning: isOrderTheoreticMeetSemilattice was deprecated in v1.1. +Please use ∧-isOrderTheoreticMeetSemilattice instead." +#-} +isOrderTheoreticJoinSemilattice = ∧-isOrderTheoreticJoinSemilattice +{-# WARNING_ON_USAGE isOrderTheoreticJoinSemilattice +"Warning: isOrderTheoreticJoinSemilattice was deprecated in v1.1. +Please use ∧-isOrderTheoreticJoinSemilattice instead." +#-} +orderTheoreticMeetSemilattice = ∧-orderTheoreticMeetSemilattice +{-# WARNING_ON_USAGE orderTheoreticMeetSemilattice +"Warning: orderTheoreticMeetSemilattice was deprecated in v1.1. +Please use ∧-orderTheoreticMeetSemilattice instead." +#-} +orderTheoreticJoinSemilattice = ∧-orderTheoreticJoinSemilattice +{-# WARNING_ON_USAGE orderTheoreticJoinSemilattice +"Warning: orderTheoreticJoinSemilattice was deprecated in v1.1. +Please use ∧-orderTheoreticJoinSemilattice instead." +#-} +\ No newline at end of file diff --git a/docs/Algebra.Structures.html b/docs/Algebra.Structures.html new file mode 100644 index 0000000..786b45f --- /dev/null +++ b/docs/Algebra.Structures.html @@ -0,0 +1,571 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Some algebraic structures (not packed up with sets, operations, +-- etc.) +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via `Algebra`, unless +-- you want to parameterise it via the equality relation. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary using (Rel; Setoid; IsEquivalence) + +module Algebra.Structures + {a ℓ} {A : Set a} -- The underlying set + (_≈_ : Rel A ℓ) -- The underlying equality relation + where + +-- The file is divided into sections depending on the arities of the +-- components of the algebraic structure. + +open import Algebra.Core +open import Algebra.Definitions _≈_ +import Algebra.Consequences.Setoid as Consequences +open import Data.Product using (_,_; proj₁; proj₂) +open import Level using (_⊔_) + +------------------------------------------------------------------------ +-- Structures with 1 binary operation +------------------------------------------------------------------------ + +record IsMagma (∙ : Op₂ A) : Set (a ⊔ ℓ) where + field + isEquivalence : IsEquivalence _≈_ + ∙-cong : Congruent₂ ∙ + + open IsEquivalence isEquivalence public + + setoid : Setoid a ℓ + setoid = record { isEquivalence = isEquivalence } + + ∙-congˡ : LeftCongruent ∙ + ∙-congˡ y≈z = ∙-cong refl y≈z + + ∙-congʳ : RightCongruent ∙ + ∙-congʳ y≈z = ∙-cong y≈z refl + + +record IsCommutativeMagma (∙ : Op₂ A) : Set (a ⊔ ℓ) where + field + isMagma : IsMagma ∙ + comm : Commutative ∙ + + open IsMagma isMagma public + + +record IsSelectiveMagma (∙ : Op₂ A) : Set (a ⊔ ℓ) where + field + isMagma : IsMagma ∙ + sel : Selective ∙ + + open IsMagma isMagma public + + +record IsSemigroup (∙ : Op₂ A) : Set (a ⊔ ℓ) where + field + isMagma : IsMagma ∙ + assoc : Associative ∙ + + open IsMagma isMagma public + + +record IsBand (∙ : Op₂ A) : Set (a ⊔ ℓ) where + field + isSemigroup : IsSemigroup ∙ + idem : Idempotent ∙ + + open IsSemigroup isSemigroup public + + +record IsCommutativeSemigroup (∙ : Op₂ A) : Set (a ⊔ ℓ) where + field + isSemigroup : IsSemigroup ∙ + comm : Commutative ∙ + + open IsSemigroup isSemigroup public + + isCommutativeMagma : IsCommutativeMagma ∙ + isCommutativeMagma = record + { isMagma = isMagma + ; comm = comm + } + + +record IsSemilattice (∧ : Op₂ A) : Set (a ⊔ ℓ) where + field + isBand : IsBand ∧ + comm : Commutative ∧ + + open IsBand isBand public + renaming (∙-cong to ∧-cong; ∙-congˡ to ∧-congˡ; ∙-congʳ to ∧-congʳ) + + + +------------------------------------------------------------------------ +-- Structures with 1 binary operation & 1 element +------------------------------------------------------------------------ + +record IsMonoid (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where + field + isSemigroup : IsSemigroup ∙ + identity : Identity ε ∙ + + open IsSemigroup isSemigroup public + + identityˡ : LeftIdentity ε ∙ + identityˡ = proj₁ identity + + identityʳ : RightIdentity ε ∙ + identityʳ = proj₂ identity + + +record IsCommutativeMonoid (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where + field + isMonoid : IsMonoid ∙ ε + comm : Commutative ∙ + + open IsMonoid isMonoid public + + isCommutativeSemigroup : IsCommutativeSemigroup ∙ + isCommutativeSemigroup = record + { isSemigroup = isSemigroup + ; comm = comm + } + + open IsCommutativeSemigroup isCommutativeSemigroup public + using (isCommutativeMagma) + + +record IsIdempotentCommutativeMonoid (∙ : Op₂ A) + (ε : A) : Set (a ⊔ ℓ) where + field + isCommutativeMonoid : IsCommutativeMonoid ∙ ε + idem : Idempotent ∙ + + open IsCommutativeMonoid isCommutativeMonoid public + + +-- Idempotent commutative monoids are also known as bounded lattices. +-- Note that the BoundedLattice necessarily uses the notation inherited +-- from monoids rather than lattices. + +IsBoundedLattice = IsIdempotentCommutativeMonoid + +module IsBoundedLattice {∙ : Op₂ A} + {ε : A} + (isIdemCommMonoid : IsIdempotentCommutativeMonoid ∙ ε) = + IsIdempotentCommutativeMonoid isIdemCommMonoid + + +------------------------------------------------------------------------ +-- Structures with 1 binary operation, 1 unary operation & 1 element +------------------------------------------------------------------------ + +record IsGroup (_∙_ : Op₂ A) (ε : A) (_⁻¹ : Op₁ A) : Set (a ⊔ ℓ) where + field + isMonoid : IsMonoid _∙_ ε + inverse : Inverse ε _⁻¹ _∙_ + ⁻¹-cong : Congruent₁ _⁻¹ + + open IsMonoid isMonoid public + + infixl 6 _-_ + _-_ : Op₂ A + x - y = x ∙ (y ⁻¹) + + inverseˡ : LeftInverse ε _⁻¹ _∙_ + inverseˡ = proj₁ inverse + + inverseʳ : RightInverse ε _⁻¹ _∙_ + inverseʳ = proj₂ inverse + + uniqueˡ-⁻¹ : ∀ x y → (x ∙ y) ≈ ε → x ≈ (y ⁻¹) + uniqueˡ-⁻¹ = Consequences.assoc+id+invʳ⇒invˡ-unique + setoid ∙-cong assoc identity inverseʳ + + uniqueʳ-⁻¹ : ∀ x y → (x ∙ y) ≈ ε → y ≈ (x ⁻¹) + uniqueʳ-⁻¹ = Consequences.assoc+id+invˡ⇒invʳ-unique + setoid ∙-cong assoc identity inverseˡ + + +record IsAbelianGroup (∙ : Op₂ A) + (ε : A) (⁻¹ : Op₁ A) : Set (a ⊔ ℓ) where + field + isGroup : IsGroup ∙ ε ⁻¹ + comm : Commutative ∙ + + open IsGroup isGroup public + + isCommutativeMonoid : IsCommutativeMonoid ∙ ε + isCommutativeMonoid = record + { isMonoid = isMonoid + ; comm = comm + } + + open IsCommutativeMonoid isCommutativeMonoid public + using (isCommutativeMagma; isCommutativeSemigroup) + + +------------------------------------------------------------------------ +-- Structures with 2 binary operations +------------------------------------------------------------------------ + +-- Note that `IsLattice` is not defined in terms of `IsSemilattice` +-- because the idempotence laws of ∨ and ∧ can be derived from the +-- absorption laws, which makes the corresponding "idem" fields +-- redundant. The derived idempotence laws are stated and proved in +-- `Algebra.Properties.Lattice` along with the fact that every lattice +-- consists of two semilattices. + +record IsLattice (∨ ∧ : Op₂ A) : Set (a ⊔ ℓ) where + field + isEquivalence : IsEquivalence _≈_ + ∨-comm : Commutative ∨ + ∨-assoc : Associative ∨ + ∨-cong : Congruent₂ ∨ + ∧-comm : Commutative ∧ + ∧-assoc : Associative ∧ + ∧-cong : Congruent₂ ∧ + absorptive : Absorptive ∨ ∧ + + open IsEquivalence isEquivalence public + + ∨-absorbs-∧ : ∨ Absorbs ∧ + ∨-absorbs-∧ = proj₁ absorptive + + ∧-absorbs-∨ : ∧ Absorbs ∨ + ∧-absorbs-∨ = proj₂ absorptive + + ∧-congˡ : LeftCongruent ∧ + ∧-congˡ y≈z = ∧-cong refl y≈z + + ∧-congʳ : RightCongruent ∧ + ∧-congʳ y≈z = ∧-cong y≈z refl + + ∨-congˡ : LeftCongruent ∨ + ∨-congˡ y≈z = ∨-cong refl y≈z + + ∨-congʳ : RightCongruent ∨ + ∨-congʳ y≈z = ∨-cong y≈z refl + + +record IsDistributiveLattice (∨ ∧ : Op₂ A) : Set (a ⊔ ℓ) where + field + isLattice : IsLattice ∨ ∧ + ∨-distribʳ-∧ : ∨ DistributesOverʳ ∧ + + open IsLattice isLattice public + + ∨-∧-distribʳ = ∨-distribʳ-∧ + {-# WARNING_ON_USAGE ∨-∧-distribʳ + "Warning: ∨-∧-distribʳ was deprecated in v1.1. + Please use ∨-distribʳ-∧ instead." + #-} + +------------------------------------------------------------------------ +-- Structures with 2 binary operations & 1 element +------------------------------------------------------------------------ + +record IsNearSemiring (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where + field + +-isMonoid : IsMonoid + 0# + *-isSemigroup : IsSemigroup * + distribʳ : * DistributesOverʳ + + zeroˡ : LeftZero 0# * + + open IsMonoid +-isMonoid public + renaming + ( assoc to +-assoc + ; ∙-cong to +-cong + ; ∙-congˡ to +-congˡ + ; ∙-congʳ to +-congʳ + ; identity to +-identity + ; identityˡ to +-identityˡ + ; identityʳ to +-identityʳ + ; isMagma to +-isMagma + ; isSemigroup to +-isSemigroup + ) + + open IsSemigroup *-isSemigroup public + using () + renaming + ( assoc to *-assoc + ; ∙-cong to *-cong + ; ∙-congˡ to *-congˡ + ; ∙-congʳ to *-congʳ + ; isMagma to *-isMagma + ) + + +record IsSemiringWithoutOne (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where + field + +-isCommutativeMonoid : IsCommutativeMonoid + 0# + *-isSemigroup : IsSemigroup * + distrib : * DistributesOver + + zero : Zero 0# * + + open IsCommutativeMonoid +-isCommutativeMonoid public + using () + renaming + ( comm to +-comm + ; isMonoid to +-isMonoid + ; isCommutativeMagma to +-isCommutativeMagma + ; isCommutativeSemigroup to +-isCommutativeSemigroup + ) + + zeroˡ : LeftZero 0# * + zeroˡ = proj₁ zero + + zeroʳ : RightZero 0# * + zeroʳ = proj₂ zero + + isNearSemiring : IsNearSemiring + * 0# + isNearSemiring = record + { +-isMonoid = +-isMonoid + ; *-isSemigroup = *-isSemigroup + ; distribʳ = proj₂ distrib + ; zeroˡ = zeroˡ + } + + open IsNearSemiring isNearSemiring public + hiding (+-isMonoid; zeroˡ; *-isSemigroup) + + +record IsCommutativeSemiringWithoutOne + (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where + field + isSemiringWithoutOne : IsSemiringWithoutOne + * 0# + *-comm : Commutative * + + open IsSemiringWithoutOne isSemiringWithoutOne public + + *-isCommutativeSemigroup : IsCommutativeSemigroup * + *-isCommutativeSemigroup = record + { isSemigroup = *-isSemigroup + ; comm = *-comm + } + + open IsCommutativeSemigroup *-isCommutativeSemigroup public + using () renaming (isCommutativeMagma to *-isCommutativeMagma) + +------------------------------------------------------------------------ +-- Structures with 2 binary operations & 2 elements +------------------------------------------------------------------------ + +record IsSemiringWithoutAnnihilatingZero (+ * : Op₂ A) + (0# 1# : A) : Set (a ⊔ ℓ) where + field + -- Note that these structures do have an additive unit, but this + -- unit does not necessarily annihilate multiplication. + +-isCommutativeMonoid : IsCommutativeMonoid + 0# + *-isMonoid : IsMonoid * 1# + distrib : * DistributesOver + + + distribˡ : * DistributesOverˡ + + distribˡ = proj₁ distrib + + distribʳ : * DistributesOverʳ + + distribʳ = proj₂ distrib + + open IsCommutativeMonoid +-isCommutativeMonoid public + renaming + ( assoc to +-assoc + ; ∙-cong to +-cong + ; ∙-congˡ to +-congˡ + ; ∙-congʳ to +-congʳ + ; identity to +-identity + ; identityˡ to +-identityˡ + ; identityʳ to +-identityʳ + ; comm to +-comm + ; isMagma to +-isMagma + ; isSemigroup to +-isSemigroup + ; isMonoid to +-isMonoid + ; isCommutativeMagma to +-isCommutativeMagma + ; isCommutativeSemigroup to +-isCommutativeSemigroup + ) + + open IsMonoid *-isMonoid public + using () + renaming + ( assoc to *-assoc + ; ∙-cong to *-cong + ; ∙-congˡ to *-congˡ + ; ∙-congʳ to *-congʳ + ; identity to *-identity + ; identityˡ to *-identityˡ + ; identityʳ to *-identityʳ + ; isMagma to *-isMagma + ; isSemigroup to *-isSemigroup + ) + + +record IsSemiring (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where + field + isSemiringWithoutAnnihilatingZero : + IsSemiringWithoutAnnihilatingZero + * 0# 1# + zero : Zero 0# * + + open IsSemiringWithoutAnnihilatingZero + isSemiringWithoutAnnihilatingZero public + + isSemiringWithoutOne : IsSemiringWithoutOne + * 0# + isSemiringWithoutOne = record + { +-isCommutativeMonoid = +-isCommutativeMonoid + ; *-isSemigroup = *-isSemigroup + ; distrib = distrib + ; zero = zero + } + + open IsSemiringWithoutOne isSemiringWithoutOne public + using + ( isNearSemiring + ; zeroˡ + ; zeroʳ + ) + + +record IsCommutativeSemiring (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where + field + isSemiring : IsSemiring + * 0# 1# + *-comm : Commutative * + + open IsSemiring isSemiring public + + isCommutativeSemiringWithoutOne : + IsCommutativeSemiringWithoutOne + * 0# + isCommutativeSemiringWithoutOne = record + { isSemiringWithoutOne = isSemiringWithoutOne + ; *-comm = *-comm + } + + open IsCommutativeSemiringWithoutOne isCommutativeSemiringWithoutOne public + using + ( *-isCommutativeMagma + ; *-isCommutativeSemigroup + ) + + *-isCommutativeMonoid : IsCommutativeMonoid * 1# + *-isCommutativeMonoid = record + { isMonoid = *-isMonoid + ; comm = *-comm + } + + +record IsCancellativeCommutativeSemiring (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where + field + isCommutativeSemiring : IsCommutativeSemiring + * 0# 1# + *-cancelˡ-nonZero : AlmostLeftCancellative 0# * + + open IsCommutativeSemiring isCommutativeSemiring public + + + +------------------------------------------------------------------------ +-- Structures with 2 binary operations, 1 unary operation & 2 elements +------------------------------------------------------------------------ + +record IsRing (+ * : Op₂ A) (-_ : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where + field + +-isAbelianGroup : IsAbelianGroup + 0# -_ + *-isMonoid : IsMonoid * 1# + distrib : * DistributesOver + + zero : Zero 0# * + + open IsAbelianGroup +-isAbelianGroup public + renaming + ( assoc to +-assoc + ; ∙-cong to +-cong + ; ∙-congˡ to +-congˡ + ; ∙-congʳ to +-congʳ + ; identity to +-identity + ; identityˡ to +-identityˡ + ; identityʳ to +-identityʳ + ; inverse to -‿inverse + ; inverseˡ to -‿inverseˡ + ; inverseʳ to -‿inverseʳ + ; ⁻¹-cong to -‿cong + ; comm to +-comm + ; isMagma to +-isMagma + ; isSemigroup to +-isSemigroup + ; isMonoid to +-isMonoid + ; isCommutativeMagma to +-isCommutativeMagma + ; isCommutativeMonoid to +-isCommutativeMonoid + ; isCommutativeSemigroup to +-isCommutativeSemigroup + ; isGroup to +-isGroup + ) + + open IsMonoid *-isMonoid public + using () + renaming + ( assoc to *-assoc + ; ∙-cong to *-cong + ; ∙-congˡ to *-congˡ + ; ∙-congʳ to *-congʳ + ; identity to *-identity + ; identityˡ to *-identityˡ + ; identityʳ to *-identityʳ + ; isMagma to *-isMagma + ; isSemigroup to *-isSemigroup + ) + + zeroˡ : LeftZero 0# * + zeroˡ = proj₁ zero + + zeroʳ : RightZero 0# * + zeroʳ = proj₂ zero + + isSemiringWithoutAnnihilatingZero + : IsSemiringWithoutAnnihilatingZero + * 0# 1# + isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = +-isCommutativeMonoid + ; *-isMonoid = *-isMonoid + ; distrib = distrib + } + + isSemiring : IsSemiring + * 0# 1# + isSemiring = record + { isSemiringWithoutAnnihilatingZero = + isSemiringWithoutAnnihilatingZero + ; zero = zero + } + + open IsSemiring isSemiring public + using (distribˡ; distribʳ; isNearSemiring; isSemiringWithoutOne) + + +record IsCommutativeRing + (+ * : Op₂ A) (- : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where + field + isRing : IsRing + * - 0# 1# + *-comm : Commutative * + + open IsRing isRing public + + isCommutativeSemiring : IsCommutativeSemiring + * 0# 1# + isCommutativeSemiring = record + { isSemiring = isSemiring + ; *-comm = *-comm + } + + open IsCommutativeSemiring isCommutativeSemiring public + using + ( isCommutativeSemiringWithoutOne + ; *-isCommutativeMagma + ; *-isCommutativeSemigroup + ; *-isCommutativeMonoid + ) + + +record IsBooleanAlgebra + (∨ ∧ : Op₂ A) (¬ : Op₁ A) (⊤ ⊥ : A) : Set (a ⊔ ℓ) where + field + isDistributiveLattice : IsDistributiveLattice ∨ ∧ + ∨-complementʳ : RightInverse ⊤ ¬ ∨ + ∧-complementʳ : RightInverse ⊥ ¬ ∧ + ¬-cong : Congruent₁ ¬ + + open IsDistributiveLattice isDistributiveLattice public +\ No newline at end of file diff --git a/docs/Algebra.html b/docs/Algebra.html new file mode 100644 index 0000000..a73ef87 --- /dev/null +++ b/docs/Algebra.html @@ -0,0 +1,17 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Definitions of algebraic structures like monoids and rings +-- (packed in records together with sets, operations, etc.) +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Algebra where + +open import Algebra.Core public +open import Algebra.Definitions public +open import Algebra.Structures public +open import Algebra.Bundles public +\ No newline at end of file diff --git a/docs/Axiom.Extensionality.Propositional.html b/docs/Axiom.Extensionality.Propositional.html new file mode 100644 index 0000000..1079f07 --- /dev/null +++ b/docs/Axiom.Extensionality.Propositional.html @@ -0,0 +1,64 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Results concerning function extensionality for propositional equality +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Axiom.Extensionality.Propositional where + +open import Function.Base +open import Level using (Level; _⊔_; suc; lift) +open import Relation.Binary.Core +open import Relation.Binary.PropositionalEquality.Core + +------------------------------------------------------------------------ +-- Function extensionality states that if two functions are +-- propositionally equal for every input, then the functions themselves +-- must be propositionally equal. + +Extensionality : (a b : Level) → Set _ +Extensionality a b = + {A : Set a} {B : A → Set b} {f g : (x : A) → B x} → + (∀ x → f x ≡ g x) → f ≡ g + +-- A variant for implicit function spaces. + +ExtensionalityImplicit : (a b : Level) → Set _ +ExtensionalityImplicit a b = + {A : Set a} {B : A → Set b} {f g : {x : A} → B x} → + (∀ {x} → f {x} ≡ g {x}) → (λ {x} → f {x}) ≡ (λ {x} → g {x}) + + +------------------------------------------------------------------------ +-- Properties + +-- If extensionality holds for a given universe level, then it also +-- holds for lower ones. + +lower-extensionality : ∀ {a₁ b₁} a₂ b₂ → + Extensionality (a₁ ⊔ a₂) (b₁ ⊔ b₂) → + Extensionality a₁ b₁ +lower-extensionality a₂ b₂ ext f≡g = cong (λ h → Level.lower ∘ h ∘ lift) $ + ext (cong (lift {ℓ = b₂}) ∘ f≡g ∘ Level.lower {ℓ = a₂}) + +-- Functional extensionality implies a form of extensionality for +-- Π-types. + +∀-extensionality : ∀ {a b} → Extensionality a (suc b) → + {A : Set a} (B₁ B₂ : A → Set b) → + (∀ x → B₁ x ≡ B₂ x) → + (∀ x → B₁ x) ≡ (∀ x → B₂ x) +∀-extensionality ext B₁ B₂ B₁≡B₂ with ext B₁≡B₂ +... | refl = refl + +-- Extensionality for explicit function spaces implies extensionality +-- for implicit function spaces. + +implicit-extensionality : ∀ {a b} → + Extensionality a b → + ExtensionalityImplicit a b +implicit-extensionality ext f≡g = cong _$- (ext (λ x → f≡g)) +\ No newline at end of file diff --git a/docs/Axiom.UniquenessOfIdentityProofs.html b/docs/Axiom.UniquenessOfIdentityProofs.html new file mode 100644 index 0000000..5bb7fab --- /dev/null +++ b/docs/Axiom.UniquenessOfIdentityProofs.html @@ -0,0 +1,79 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Results concerning uniqueness of identity proofs +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Axiom.UniquenessOfIdentityProofs where + +open import Data.Bool.Base using (true; false) +open import Data.Empty +open import Relation.Nullary.Reflects using (invert) +open import Relation.Nullary hiding (Irrelevant) +open import Relation.Binary.Core +open import Relation.Binary.Definitions +open import Relation.Binary.PropositionalEquality.Core +open import Relation.Binary.PropositionalEquality.Properties + +------------------------------------------------------------------------ +-- Definition +-- +-- Uniqueness of Identity Proofs (UIP) states that all proofs of +-- equality are themselves equal. In other words, the equality relation +-- is irrelevant. Here we define UIP relative to a given type. + +UIP : ∀ {a} (A : Set a) → Set a +UIP A = Irrelevant {A = A} _≡_ + +------------------------------------------------------------------------ +-- Properties + +-- UIP always holds when using axiom K +-- (see `Axiom.UniquenessOfIdentityProofs.WithK`). + +-- The existence of a constant function over proofs of equality for +-- elements in A is enough to prove UIP for A. Indeed, we can relate any +-- proof to its image via this function which we then know is equal to +-- the image of any other proof. + +module Constant⇒UIP + {a} {A : Set a} (f : _≡_ {A = A} ⇒ _≡_) + (f-constant : ∀ {a b} (p q : a ≡ b) → f p ≡ f q) + where + + ≡-canonical : ∀ {a b} (p : a ≡ b) → trans (sym (f refl)) (f p) ≡ p + ≡-canonical refl = trans-symˡ (f refl) + + ≡-irrelevant : UIP A + ≡-irrelevant p q = begin + p ≡⟨ sym (≡-canonical p) ⟩ + trans (sym (f refl)) (f p) ≡⟨ cong (trans _) (f-constant p q) ⟩ + trans (sym (f refl)) (f q) ≡⟨ ≡-canonical q ⟩ + q ∎ + where open ≡-Reasoning + +-- If equality is decidable for a given type, then we can prove UIP for +-- that type. Indeed, the decision procedure allows us to define a +-- function over proofs of equality which is constant: it returns the +-- proof produced by the decision procedure. + +module Decidable⇒UIP + {a} {A : Set a} (_≟_ : Decidable {A = A} _≡_) + where + + ≡-normalise : _≡_ {A = A} ⇒ _≡_ + ≡-normalise {a} {b} a≡b with a ≟ b + ... | true because [p] = invert [p] + ... | false because [¬p] = ⊥-elim (invert [¬p] a≡b) + + ≡-normalise-constant : ∀ {a b} (p q : a ≡ b) → ≡-normalise p ≡ ≡-normalise q + ≡-normalise-constant {a} {b} p q with a ≟ b + ... | true because _ = refl + ... | false because [¬p] = ⊥-elim (invert [¬p] p) + + ≡-irrelevant : UIP A + ≡-irrelevant = Constant⇒UIP.≡-irrelevant ≡-normalise ≡-normalise-constant +\ No newline at end of file diff --git a/docs/Base.Algebras.Basic.html b/docs/Base.Algebras.Basic.html new file mode 100644 index 0000000..79efb50 --- /dev/null +++ b/docs/Base.Algebras.Basic.html @@ -0,0 +1,255 @@ + +
--- +layout: default +title : "Base.Algebras.Basic module (Agda Universal Algebra Library)" +date : "2021-04-23" +author: "agda-algebras development team" +--- + +### <a id="basic-definitions">Basic definitions</a> + +This is the [Base.Algebras.Basic][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( 𝓞 ; 𝓥 ; Signature ) + +module Base.Algebras.Basic {𝑆 : Signature 𝓞 𝓥 } where + +-- Imports from the Agda (Builtin) and the Agda Standard Library -------------- +open import Agda.Primitive using () renaming ( Set to Type ; lzero to ℓ₀ ) +open import Data.Product using ( _,_ ; _×_ ; Σ-syntax ) +open import Level using ( Level ; _⊔_ ; suc ) +open import Relation.Binary using ( IsEquivalence ) renaming ( Rel to BinRel ) +open import Relation.Unary using ( _∈_ ; Pred ) + + +-- Imports from the Agda Universal Algebra Library ---------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ; Op ) +open import Base.Relations using ( _|:_ ; _|:pred_ ; Rel ; compatible-Rel ) + using ( REL ; compatible-REL ) + +private variable α β ρ : Level + +\end{code} + + +#### <a id="algebras">Algebras</a> + +Our first goal is to develop a working vocabulary and formal library for classical +(single-sorted, set-based) universal algebra. In this section we define the main +objects of study. An *algebraic structure* (or *algebra*) in the signature +`𝑆 = (𝐹, ρ)` is denoted by `𝑨 = (A, Fᴬ)` and consists of + +* `A` := a *nonempty* set (or type), called the *domain* (or *carrier* or + *universe*) of the algebra; +* `Fᴬ := { fᴬ ∣ f ∈ F, : (ρf → A) → A }`, a collection of *operations* on `𝑨`; +* a (potentially empty) collection of *identities* satisfied by elements and + *operations of `𝑨`. + +Note that to each operation symbol `f ∈ 𝐹` corresponds an operation +`fᴬ` on `𝑨` of arity `ρf`; we call such `fᴬ` the *interpretation* of the symbol +`f` in the algebra `𝑨`. We call an algebra in the signature `𝑆` an `𝑆`-*algebra*. +An algebra is called *finite* if it has a finite domain, and is called *trivial* +if its universe is a singleton. Given two algebras `𝑨` and `𝑩`, we say that `𝑩` +is a *reduct* of `𝑨` if both algebras have the same domain and `𝑩` can be obtained +from `𝑨` by simply removing some of the operations. + +Recall, we defined the type `Signature 𝓞 𝓥` above as the dependent pair type +`Σ F ꞉ Type 𝓞 , (F → Type 𝓥)`, and the type `Op` of operation symbols is the +function type `Op I A = (I → A) → A` (see [Base.Relations.Discrete][]). + +For a fixed signature `𝑆 : Signature 𝓞 𝓥` and universe level `α`, we define the +*type of algebras in the signature* `𝑆` (or *type of* `𝑆`-*algebras*) *with domain +type* `Type α` as follows. + +\begin{code} + +Algebra : (α : Level) → Type (𝓞 ⊔ 𝓥 ⊔ suc α) +Algebra α = Σ[ A ∈ Type α ] -- the domain + ∀ (f : ∣ 𝑆 ∣) → Op A (∥ 𝑆 ∥ f) -- the basic operations + +\end{code} + +It would be more precise to refer to inhabitants of this type as ∞-*algebras* +because their domains can be of arbitrary type and need not be truncated at some +level and, in particular, need to be a set. (See [Base.Equality.Truncation][].) + +We might take this opportunity to define the type of 0-*algebras*, that is, +algebras whose domains are sets, which is probably closer to what most of us think +of when doing informal universal algebra. However, in the +[agda-algebras](https://github.com/ualib/agda-algebras) library we will only need +to know that the domains of certain algebras are sets in a few places, so it seems +preferable to work with general (∞-)algebras throughout and then explicitly +postulate additional axioms (e.g., [uniquness of identity +proofs](https://ualib.github.io/agda-algebras/Equality.Truncation.html#uniqueness-of-identity-proofs) +if and only if necessary. + + +#### <a id="algebras-as-record-types">Algebras as record types</a> + +A popular way to represent algebraic structures in type theory is with record +types. The Sigma type defined above provides an equivalent alternative that we +happen to prefer and we use it throughout the library, both for consistency and +because of its direct connection to the existential quantifier of logic. Recall +that the type `Σ x ꞉ X , P x` represents the proposition, "there exists `x` in `X` +such that `P x` holds;" in symbols, `∃ x ∈ X , P x`. Indeed, an inhabitant of `Σ +x ꞉ X , P x` is a pair `(x , p)` such that `x` inhabits `X` and `p` is a proof of +`P x`. In other terms, the pair `(x , p)` is a witness and proof of the +proposition `∃ x ∈ X , P x`. + +Nonetheless, for those who prefer to represent algebraic structures in type theory +using records, we offer the following definition (which is equivalent to the Sigma +type formulation). + +\begin{code} + +record algebra (α : Level) : Type(suc(𝓞 ⊔ 𝓥 ⊔ α)) where + constructor mkalg + field + carrier : Type α + opsymbol : (f : ∣ 𝑆 ∣) → ((∥ 𝑆 ∥ f) → carrier) → carrier + +\end{code} + +This representation of algebras as inhabitants of a record type is equivalent to +the representation using Sigma types in the sense that a bi-implication between +the two representations is obvious. + +\begin{code} + +open algebra + +algebra→Algebra : algebra α → Algebra α +algebra→Algebra 𝑨 = (carrier 𝑨 , opsymbol 𝑨) + +Algebra→algebra : Algebra α → algebra α +Algebra→algebra 𝑨 = mkalg ∣ 𝑨 ∣ ∥ 𝑨 ∥ +\end{code} + + +#### <a id="operation-interpretation-syntax">Operation interpretation syntax</a> + +We now define a convenient shorthand for the interpretation of an operation symbol. +This looks more similar to the standard notation one finds in the literature as +compared to the double bar notation we started with, so we will use this new notation +almost exclusively in the remaining modules of the [agda-algebras][] library. + +\begin{code} + +_̂_ : (𝑓 : ∣ 𝑆 ∣)(𝑨 : Algebra α) → (∥ 𝑆 ∥ 𝑓 → ∣ 𝑨 ∣) → ∣ 𝑨 ∣ +𝑓 ̂ 𝑨 = λ 𝑎 → (∥ 𝑨 ∥ 𝑓) 𝑎 + +\end{code} + +So, if `𝑓 : ∣ 𝑆 ∣` is an operation symbol in the signature `𝑆`, and if +`𝑎 : ∥ 𝑆 ∥ 𝑓 → ∣ 𝑨 ∣` is a tuple of the appropriate arity, then `(𝑓 ̂ 𝑨) 𝑎` +denotes the operation `𝑓` interpreted in `𝑨` and evaluated at `𝑎`. + +#### <a id="the-universe-level-of-an-algebra">The universe level of an algebra</a> + +Occasionally we will be given an algebra and we just need to know the universe +level of its domain. The following utility function provides this. + +\begin{code} + +Level-of-Alg : {α : Level} → Algebra α → Level +Level-of-Alg {α = α} _ = 𝓞 ⊔ 𝓥 ⊔ suc α + +Level-of-Carrier : {α : Level} → Algebra α → Level +Level-of-Carrier {α = α} _ = α +\end{code} + + +#### <a id="lifts-of-algebras">Level lifting algebra types</a> + +Recall, in the [section on level lifting and +lowering](Functions.Lifts.html#level-lifting-and-lowering), we described the +difficulties one may encounter when working with a noncumulative universe +hierarchy. We made a promise to provide some domain-specific level lifting and +level lowering methods. Here we fulfill this promise by supplying a couple of +bespoke tools designed specifically for our operation and algebra types. + +\begin{code} + +open Level + +Lift-alg-op : {I : Type 𝓥} {A : Type α} → Op A I → (β : Level) → Op (Lift β A) I +Lift-alg-op f β = λ x → lift (f (λ i → lower (x i))) + +Lift-Alg : Algebra α → (β : Level) → Algebra (α ⊔ β) +Lift-Alg 𝑨 β = Lift β ∣ 𝑨 ∣ , (λ (𝑓 : ∣ 𝑆 ∣) → Lift-alg-op (𝑓 ̂ 𝑨) β) + +open algebra + +Lift-algebra : algebra α → (β : Level) → algebra (α ⊔ β) +Lift-algebra 𝑨 β = mkalg (Lift β (carrier 𝑨)) (λ (f : ∣ 𝑆 ∣) + → Lift-alg-op ((opsymbol 𝑨) f) β) + +\end{code} + +What makes the `Lift-Alg` type so useful for resolving type level errors involving +algebras is the nice properties it possesses. Indeed, the [agda-algebras][] +library contains formal proofs of the following facts. + ++ [`Lift-Alg` is a homomorphism](Base.Homomorphisms.Basic.html#exmples-of-homomorphisms) + (see [Base.Homomorphisms.Basic][]) ++ [`Lift-Alg` is an algebraic invariant](Base.Homomorphisms.Isomorphisms.html#lift-is-an-algebraic-invariant") + (see [Base.Homomorphisms.Isomorphisms][]) ++ [`Lift-Alg` of a subalgebra is a subalgebra](Base.Subalgebras.Subalgebras.html#lifts-of-subalgebras) + (see [Base.Subalgebras.Subalgebras][]) ++ [`Lift-Alg` preserves identities](Base.Varieties.EquationalLogic.html#lift-invariance)) + (see [Base.Varieties.EquationalLogic][]) + + +#### <a id="compatibility-of-binary-relations">Compatibility of binary relations</a> + +We now define the function `compatible` so that, if `𝑨` denotes an algebra and `R` +a binary relation, then `compatible 𝑨 R` will represent the assertion that `R` is +*compatible* with all basic operations of `𝑨`. The formal definition is immediate +since all the work is done by the relation `|:`, which we defined above (see +[Base.Relations.Discrete][]). + +\begin{code} + +compatible : (𝑨 : Algebra α) → BinRel ∣ 𝑨 ∣ ρ → Type (𝓞 ⊔ 𝓥 ⊔ α ⊔ ρ) +compatible 𝑨 R = ∀ 𝑓 → (𝑓 ̂ 𝑨) |: R + +compatible-pred : (𝑨 : Algebra α) → Pred (∣ 𝑨 ∣ × ∣ 𝑨 ∣)ρ → Type (𝓞 ⊔ 𝓥 ⊔ α ⊔ ρ) +compatible-pred 𝑨 P = ∀ 𝑓 → (𝑓 ̂ 𝑨) |:pred P + +\end{code} + +Recall, the `|:` type was defined in [Base.Relations.Discrete][] module. + + +#### <a id="compatibility-of-continuous-relations">Compatibility of continuous relations</a> + +In the [Base.Relations.Continuous][] module, we defined a function called +`compatible-Rel` to represent the assertion that a given continuous relation is +compatible with a given operation. With that, it is easy to define a function, +which we call `compatible-Rel-alg`, representing compatibility of a continuous +relation with all operations of an algebra. Similarly, we define the analogous +`compatible-REL-alg` function for the (even more general) type of *dependent +relations*. + +\begin{code} + +module _ {I : Type 𝓥} where + + compatible-Rel-alg : (𝑨 : Algebra α) → Rel ∣ 𝑨 ∣ I{ρ} → Type(𝓞 ⊔ α ⊔ 𝓥 ⊔ ρ) + compatible-Rel-alg 𝑨 R = ∀ (𝑓 : ∣ 𝑆 ∣ ) → compatible-Rel (𝑓 ̂ 𝑨) R + + compatible-REL-alg : (𝒜 : I → Algebra α) → REL I (λ i → ∣ 𝒜 i ∣) {ρ} → Type _ + compatible-REL-alg 𝒜 R = ∀ ( 𝑓 : ∣ 𝑆 ∣ ) → compatible-REL (λ i → 𝑓 ̂ (𝒜 i)) R +\end{code} + +------------------------------------- + +<span style="float:left;">[↑ Base.Algebras](Base.Algebras.html)</span> +<span style="float:right;">[Base.Algebras.Products →](Base.Algebras.Products.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Algebras.Congruences.html b/docs/Base.Algebras.Congruences.html new file mode 100644 index 0000000..8074de8 --- /dev/null +++ b/docs/Base.Algebras.Congruences.html @@ -0,0 +1,159 @@ + +
--- +layout: default +title : "Base.Algebras.Congruences module (The Agda Universal Algebra Library)" +date : "2021-07-03" +author: "agda-algebras development team" +--- + +### <a id="congruence-relations">Congruence Relations</a> + +This is the [Base.Algebras.Congruences][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( 𝓞 ; 𝓥 ; Signature ) + +module Base.Algebras.Congruences {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library ------------------------------ +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( Σ-syntax ; _,_ ) +open import Function.Base using ( _∘_ ) +open import Level using ( Level ; _⊔_ ; suc ) +open import Relation.Binary using ( IsEquivalence ) renaming ( Rel to BinRel ) +open import Relation.Binary.PropositionalEquality using ( _≡_ ; refl ) + +-- Imports from agda-algebras --------------------------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ) +open import Base.Relations using ( _|:_ ; 0[_] ; 0[_]Equivalence ; _/_ ; ⟪_⟫ ; IsBlock ) +open import Base.Equality using ( swelldef ) + +open import Base.Algebras.Basic {𝑆 = 𝑆} using ( Algebra ; compatible ; _̂_ ) +open import Base.Algebras.Products {𝑆 = 𝑆} using ( ov ) + +private variable α β ρ : Level + +\end{code} + +A *congruence relation* of an algebra `𝑨` is defined to be an equivalence relation +that is compatible with the basic operations of `𝑨`. This concept can be +represented in a number of alternative but equivalent ways. +Formally, we define a record type (`IsCongruence`) to represent the property of +being a congruence, and we define a Sigma type (`Con`) to represent the type of +congruences of a given algebra. + +\begin{code} + +record IsCongruence (𝑨 : Algebra α)(θ : BinRel ∣ 𝑨 ∣ ρ) : Type(ov ρ ⊔ α) where + constructor mkcon + field + is-equivalence : IsEquivalence θ + is-compatible : compatible 𝑨 θ + +Con : (𝑨 : Algebra α) → Type(α ⊔ ov ρ) +Con {α}{ρ}𝑨 = Σ[ θ ∈ ( BinRel ∣ 𝑨 ∣ ρ ) ] IsCongruence 𝑨 θ + +\end{code} + +Each of these types captures what it means to be a congruence and they are +equivalent in the sense that each implies the other. One implication is the +"uncurry" operation and the other is the second projection. + +\begin{code} + +IsCongruence→Con : {𝑨 : Algebra α}(θ : BinRel ∣ 𝑨 ∣ ρ) → IsCongruence 𝑨 θ → Con 𝑨 +IsCongruence→Con θ p = θ , p + +Con→IsCongruence : {𝑨 : Algebra α} → ((θ , _) : Con{α}{ρ} 𝑨) → IsCongruence 𝑨 θ +Con→IsCongruence θ = ∥ θ ∥ +\end{code} + + +#### <a id="example">Example</a> + +We now defined the *zero relation* `0[_]` and build the *trivial congruence*, +which has `0[_]` as its underlying relation. Observe that `0[_]` is equivalent to +the identity relation `≡` and is obviously an equivalence relation. + +\begin{code} + +open Level + +-- Example. The zero congruence of a structure. +0[_]Compatible : {α : Level}(𝑨 : Algebra α){ρ : Level} → swelldef 𝓥 α → (𝑓 : ∣ 𝑆 ∣) → (𝑓 ̂ 𝑨) |: (0[ ∣ 𝑨 ∣ ]{ρ}) +0[ 𝑨 ]Compatible wd 𝑓 {i}{j} ptws0 = lift γ + where + γ : (𝑓 ̂ 𝑨) i ≡ (𝑓 ̂ 𝑨) j + γ = wd (𝑓 ̂ 𝑨) i j (lower ∘ ptws0) + +open IsCongruence +0Con[_] : {α : Level}(𝑨 : Algebra α){ρ : Level} → swelldef 𝓥 α → Con{α}{α ⊔ ρ} 𝑨 +0Con[ 𝑨 ]{ρ} wd = let 0eq = 0[ ∣ 𝑨 ∣ ]Equivalence{ρ} in + ∣ 0eq ∣ , mkcon ∥ 0eq ∥ (0[ 𝑨 ]Compatible wd) +\end{code} + +A concrete example is `⟪𝟎⟫[ 𝑨 ╱ θ ]`, presented in the next subsection. + + +#### <a id="quotient-algebras">Quotient algebras</a> + +In many areas of abstract mathematics the *quotient* of an algebra `𝑨` with +respect to a congruence relation `θ` of `𝑨` plays an important role. This quotient +is typically denoted by `𝑨 / θ` and Agda allows us to define and express quotients +using this standard notation. + +\begin{code} + +_╱_ : (𝑨 : Algebra α) → Con{α}{ρ} 𝑨 → Algebra (α ⊔ suc ρ) +𝑨 ╱ θ = (∣ 𝑨 ∣ / ∣ θ ∣) , -- domain of quotient algebra + λ 𝑓 𝑎 → ⟪ (𝑓 ̂ 𝑨)(λ i → IsBlock.blk ∥ 𝑎 i ∥) ⟫ -- ops of quotient algebra + +\end{code} + +**Example**. If we adopt the notation `𝟎[ 𝑨 ╱ θ ]` for the zero (or identity) + relation on the quotient algebra `𝑨 ╱ θ`, then we define the zero relation as + follows. + +\begin{code} + +𝟘[_╱_] : (𝑨 : Algebra α)(θ : Con{α}{ρ} 𝑨) → BinRel (∣ 𝑨 ∣ / ∣ θ ∣)(α ⊔ suc ρ) +𝟘[ 𝑨 ╱ θ ] = λ u v → u ≡ v + +\end{code} + +From this we easily obtain the zero congruence of `𝑨 ╱ θ` by applying the `Δ` +function defined above. + +\begin{code} + +𝟎[_╱_] : {α : Level}(𝑨 : Algebra α){ρ : Level}(θ : Con {α}{ρ}𝑨) + → swelldef 𝓥 (α ⊔ suc ρ) → Con (𝑨 ╱ θ) + +𝟎[_╱_] {α} 𝑨 {ρ} θ wd = let 0eq = 0[ ∣ 𝑨 ╱ θ ∣ ]Equivalence in + ∣ 0eq ∣ , mkcon ∥ 0eq ∥ (0[ 𝑨 ╱ θ ]Compatible {ρ} wd) + +\end{code} + +Finally, the following elimination rule is sometimes useful (but it 'cheats' a lot +by baking in a large amount of extensionality that is miraculously true). + +\begin{code} + +open IsCongruence + +/-≡ : {𝑨 : Algebra α}(θ : Con{α}{ρ} 𝑨){u v : ∣ 𝑨 ∣} + → ⟪ u ⟫ {∣ θ ∣} ≡ ⟪ v ⟫ → ∣ θ ∣ u v + +/-≡ θ refl = IsEquivalence.refl (is-equivalence ∥ θ ∥) +\end{code} + +------------------------------------------------- + +<span style="float:left;">[← Base.Algebras.Products](Base.Algebras.Products.html)</span> +<span style="float:right;">[Base.Homomorphisms →](Base.Homomorphisms.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Algebras.Products.html b/docs/Base.Algebras.Products.html new file mode 100644 index 0000000..5f70a33 --- /dev/null +++ b/docs/Base.Algebras.Products.html @@ -0,0 +1,157 @@ + +
--- +layout: default +title : "Base.Algebras.Products module (Agda Universal Algebra Library)" +date : "2021-01-12" +author: "agda-algebras development team" +--- + +### <a id="products-of-algebras-and-product-algebras">Products of Algebras and Product Algebras</a> + +This is the [Base.Algebras.Products][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( 𝓞 ; 𝓥 ; Signature ) + +module Base.Algebras.Products {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library ------------------------------ +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; Σ ; Σ-syntax ) +open import Level using ( Level ; _⊔_ ; suc ) +open import Relation.Unary using ( Pred ; _⊆_ ; _∈_ ) + +-- Imports from agda-algebras --------------------------------------------------- +open import Overture using (_⁻¹; 𝑖𝑑; ∣_∣; ∥_∥) +open import Base.Algebras.Basic {𝑆 = 𝑆} using ( Algebra ; _̂_ ; algebra ) + +private variable α β ρ 𝓘 : Level + +\end{code} + +From now on, the modules of the +[agda-algebras](https://github.com/ualib/agda-algebras) library will assume a +fixed signature `𝑆 : Signature 𝓞 𝓥`. + +Recall the informal definition of a *product* of `𝑆`-algebras. Given a type `I : +Type 𝓘` and a family `𝒜 : I → Algebra α`, the *product* `⨅ 𝒜` is the algebra +whose domain is the Cartesian product `Π 𝑖 ꞉ I , ∣ 𝒜 𝑖 ∣` of the domains of the +algebras in `𝒜`, and whose operations are defined as follows: if `𝑓` is a `J`-ary +operation symbol and if `𝑎 : Π 𝑖 ꞉ I , J → 𝒜 𝑖` is an `I`-tuple of `J`-tuples such +that `𝑎 𝑖` is a `J`-tuple of elements of `𝒜 𝑖` (for each `𝑖`), then `(𝑓 ̂ ⨅ 𝒜) 𝑎 := +(i : I) → (𝑓 ̂ 𝒜 i)(𝑎 i)`. + +In the [agda-algebras](https://github.com/ualib/agda-algebras) library a *product +of* `𝑆`-*algebras* is represented by the following type. + +\begin{code} + +⨅ : {I : Type 𝓘 }(𝒜 : I → Algebra α ) → Algebra (𝓘 ⊔ α) + +⨅ {I = I} 𝒜 = ( ∀ (i : I) → ∣ 𝒜 i ∣ ) , -- domain of the product algebra + λ 𝑓 𝑎 i → (𝑓 ̂ 𝒜 i) λ x → 𝑎 x i -- basic operations of the product algebra + +\end{code} + +The type just defined is the one that will be used throughout the +[agda-algebras](https://github.com/ualib/agda-algebras) library whenever the +product of an indexed collection of algebras (of type `Algebra`) is required. +However, for the sake of completeness, here is how one could define a type +representing the product of algebras inhabiting the record type `algebra`. + +\begin{code} + +open algebra + +⨅' : {I : Type 𝓘 }(𝒜 : I → algebra α) → algebra (𝓘 ⊔ α) +⨅' {I} 𝒜 = record { carrier = ∀ i → carrier (𝒜 i) -- domain + ; opsymbol = λ 𝑓 𝑎 i → (opsymbol (𝒜 i)) 𝑓 λ x → 𝑎 x i } -- basic operations +\end{code} + +**Notation**. Given a signature `𝑆 : Signature 𝓞 𝓥`, the type `Algebra α` has +type `Type(𝓞 ⊔ 𝓥 ⊔ lsuc α)`. Such types occur so often in the +[agda-algebras](https://github.com/ualib/agda-algebras) library that we define +the following shorthand for their universes. + +\begin{code} + +ov : Level → Level +ov α = 𝓞 ⊔ 𝓥 ⊔ suc α +\end{code} + + +### <a id="products-of-classes-of-algebras">Products of classes of algebras</a> + +An arbitrary class `𝒦` of algebras is represented as a predicate over the type +`Algebra α`, for some universe level `α` and signature `𝑆`. That is, `𝒦 : Pred +(Algebra α) β`, for some type `β`. Later we will formally state and prove that +the product of all subalgebras of algebras in `𝒦` belongs to the class `SP(𝒦)` of +subalgebras of products of algebras in `𝒦`. That is, `⨅ S(𝒦) ∈ SP(𝒦 )`. This turns +out to be a nontrivial exercise. + +To begin, we need to define types that represent products over arbitrary +(nonindexed) families such as `𝒦` or `S(𝒦)`. Observe that `Π 𝒦` is certainly not +what we want. For recall that `Pred (Algebra α) β` is just an alias for the +function type `Algebra α → Type β`, and the semantics of the latter takes `𝒦 𝑨` +(and `𝑨 ∈ 𝒦`) to mean that `𝑨` belongs to the class `𝒦`. Thus, by definition, + +```agda + Π 𝒦 := Π 𝑨 ꞉ (Algebra α) , 𝒦 𝑨 := ∀ (𝑨 : Algebra α) → 𝑨 ∈ 𝒦, +``` + +which asserts that every inhabitant of the type `Algebra α` belongs to `𝒦`. +Evidently this is not the product algebra that we seek. + +What we need is a type that serves to index the class `𝒦`, and a function `𝔄` that +maps an index to the inhabitant of `𝒦` at that index. But `𝒦` is a predicate (of +type `(Algebra α) → Type β`) and the type `Algebra α` seems rather nebulous in +that there is no natural indexing class with which to "enumerate" all inhabitants +of `Algebra α` belonging to `𝒦`. + +The solution is to essentially take `𝒦` itself to be the indexing type, at least +heuristically that is how one can view the type `ℑ` that we now define. + +\begin{code} + +module _ {𝒦 : Pred (Algebra α)(ov α)} where + ℑ : Type (ov α) + ℑ = Σ[ 𝑨 ∈ Algebra α ] 𝑨 ∈ 𝒦 + +\end{code} + +Taking the product over the index type `ℑ` requires a function that maps an index +`i : ℑ` to the corresponding algebra. Each `i : ℑ` is a pair, `(𝑨 , p)`, where +`𝑨` is an algebra and `p` is a proof that `𝑨` belongs to `𝒦`, so the function +mapping an index to the corresponding algebra is simply the first projection. + +\begin{code} + + 𝔄 : ℑ → Algebra α + 𝔄 i = ∣ i ∣ + +\end{code} + +Finally, we define `class-product` which represents the product of all members of +𝒦. + +\begin{code} + + class-product : Algebra (ov α) + class-product = ⨅ 𝔄 + +\end{code} + +If `p : 𝑨 ∈ 𝒦`, we view the pair `(𝑨 , p) ∈ ℑ` as an *index* over the class, so we +can think of `𝔄 (𝑨 , p)` (which is simply `𝑨`) as the projection of the product `⨅ +𝔄` onto the `(𝑨 , p)`-th component. + +----------------------- + +<span style="float:left;">[← Base.Algebras.Basic](Base.Algebras.Basic.html)</span> +<span style="float:right;">[Base.Algebras.Congruences →](Base.Algebras.Congruences.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Algebras.html b/docs/Base.Algebras.html new file mode 100644 index 0000000..5e5978d --- /dev/null +++ b/docs/Base.Algebras.html @@ -0,0 +1,36 @@ + +
--- +layout: default +title : "Base.Algebras module (Agda Universal Algebra Library)" +date : "2021-01-12" +author: "agda-algebras development team" +--- + +## <a id="algebra-types">Algebra Types</a> + +This is the [Base.Algebras][] module of the [Agda Universal Algebra Library][] +in which we use type theory and [Agda][] to codify the most basic objects of +universal algebra, such as *signatures*, *algebras*, *product algebras*, +*congruence relations*, and *quotient algebras*. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( 𝓞 ; 𝓥 ; Signature ) + +module Base.Algebras {𝑆 : Signature 𝓞 𝓥 } where + +open import Base.Algebras.Basic {𝑆 = 𝑆} public +open import Base.Algebras.Products {𝑆 = 𝑆} public +open import Base.Algebras.Congruences {𝑆 = 𝑆} public + +\end{code} + +------------------------------------- + +<span style="float:left;">[← Base.Adjunction.Residuation](Base.Adjunction.Residuation.html)</span> +<span style="float:right;">[Base.Algebras.Basic →](Base.Algebras.Basic.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Equality.Extensionality.html b/docs/Base.Equality.Extensionality.html new file mode 100644 index 0000000..7f5698b --- /dev/null +++ b/docs/Base.Equality.Extensionality.html @@ -0,0 +1,106 @@ + +
--- +layout: default +title : "Base.Equality.Extensionality module (The Agda Universal Algebra Library)" +date : "2021-02-23" +author: "agda-algebras development team" +--- + +### <a id="extensionality">Extensionality</a> + +This is the [Base.Equality.Extensionality][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Equality.Extensionality where + +-- imports from Agda and the Agda Standard Library ------------------------------------ +open import Agda.Primitive using () renaming ( Set to Type ; Setω to Typeω ) +open import Data.Product using ( _,_ ) renaming ( _×_ to _∧_ ) +open import Level using ( _⊔_ ; Level ) +open import Relation.Binary using ( IsEquivalence ) renaming ( Rel to BinRel ) +open import Relation.Unary using ( Pred ; _⊆_ ) + +open import Axiom.Extensionality.Propositional using () renaming ( Extensionality to funext ) +open import Relation.Binary.PropositionalEquality using ( _≡_ ; refl ) + +-- imports from agda-algebras -------------------------------------------------------------- +open import Overture using ( transport ) +open import Base.Relations using ( [_] ; []-⊆ ; []-⊇ ; IsBlock ; ⟪_⟫ ) +open import Base.Equality.Truncation using ( blk-uip ; to-Σ-≡ ) + +private variable α β γ ρ 𝓥 : Level +\end{code} + +#### <a id="function-extensionality">Function Extensionality</a> + + +Previous versions of the [agda-algebras][] library made heavy use of a *global function extensionality +principle* asserting that function extensionality holds at all universe levels. +However, we have removed all instances of global function extensionality from the current version of the library and we now limit ourselves to local applications of the principle. This has the advantage of making transparent precisely how and where the library depends on function extensionality. Eventually we hope to be able to remove these postulates altogether in favor of an alternative approach to extensionality (e.g., by working with setoids or by reimplementing the entire library in Cubical Agda). + +The following definition is useful for postulating function extensionality when and where needed. + +\begin{code} + +DFunExt : Typeω +DFunExt = (𝓤 𝓥 : Level) → funext 𝓤 𝓥 +\end{code} + + +#### <a id="an-alternative-way-to-express-function-extensionality">An alternative way to express function extensionality</a> + +A useful alternative for expressing dependent function extensionality, which is essentially equivalent to `dfunext`, is to assert that the `happly` function is actually an *equivalence*. + +The principle of *proposition extensionality* asserts that logically equivalent propositions are equivalent. That is, if `P` and `Q` are propositions and if `P ⊆ Q` and `Q ⊆ P`, then `P ≡ Q`. For our purposes, it will suffice to formalize this notion for general predicates, rather than for propositions (i.e., truncated predicates). + +\begin{code} + +_≐_ : {α β : Level}{A : Type α}(P Q : Pred A β ) → Type _ +P ≐ Q = (P ⊆ Q) ∧ (Q ⊆ P) + +pred-ext : (α β : Level) → Type _ +pred-ext α β = ∀ {A : Type α}{P Q : Pred A β } → P ⊆ Q → Q ⊆ P → P ≡ Q + +\end{code} + +Note that `pred-ext` merely defines an extensionality principle. It does not postulate that the principle holds. If we wish to postulate `pred-ext`, then we do so by assuming that type is inhabited (see `block-ext` below, for example). + + +#### Quotient extensionality + +We need an identity type for congruence classes (blocks) over sets so that two different presentations of the same block (e.g., using different representatives) may be identified. This requires two postulates: (1) *predicate extensionality*, manifested by the `pred-ext` type; (2) *equivalence class truncation* or "uniqueness of block identity proofs", manifested by the `blk-uip` type defined in the [Base.Relations.Truncation][] module. We now use `pred-ext` and `blk-uip` to define a type called `block-ext|uip` which we require for the proof of the First Homomorphism Theorem presented in [Base.Homomorphisms.Noether][]. + +\begin{code} + +module _ {A : Type α}{R : BinRel A ρ} where + + block-ext : pred-ext α ρ → IsEquivalence{a = α}{ℓ = ρ} R + → {u v : A} → R u v → [ u ] R ≡ [ v ] R + + block-ext pe Req {u}{v} Ruv = pe ([]-⊆ {R = (R , Req)} u v Ruv) + ([]-⊇ {R = (R , Req)} u v Ruv) + + private + to-subtype|uip : blk-uip A R + → {C D : Pred A ρ}{c : IsBlock C {R}}{d : IsBlock D {R}} + → C ≡ D → (C , c) ≡ (D , d) + + to-subtype|uip buip {C}{D}{c}{d} CD = + to-Σ-≡ (CD , buip D (transport (λ B → IsBlock B) CD c) d) + + block-ext|uip : pred-ext α ρ → blk-uip A R + → IsEquivalence R → ∀{u}{v} → R u v → ⟪ u ⟫ ≡ ⟪ v ⟫ + + block-ext|uip pe buip Req Ruv = to-subtype|uip buip (block-ext pe Req Ruv) +\end{code} + +--------------------------------------- + +<span style="float:left;">[← Base.Equality.Truncation](Base.Equality.Truncation.html)</span> +<span style="float:right;">[Adjunction →](Adjunction.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Equality.Truncation.html b/docs/Base.Equality.Truncation.html new file mode 100644 index 0000000..b612105 --- /dev/null +++ b/docs/Base.Equality.Truncation.html @@ -0,0 +1,243 @@ + +
--- +layout: default +title : "Base.Equality.Truncation module (The Agda Universal Algebra Library)" +date : "2021-02-23" +author: "agda-algebras development team" +--- + +### <a id="truncation">Truncation</a> + +This is the [Base.Equality.Truncation][] module of the [Agda Universal Algebra Library][]. + +We start with a brief discussion of standard notions of *truncation*, *h-sets* (which we just call *sets*), and the *uniqueness of identity types* principle. +We then prove that a monic function into a *set* is an embedding. The section concludes with a *uniqueness of identity proofs* principle for blocks of equivalence relations. + +Readers who want to learn more about "proof-relevant mathematics" and other concepts mentioned in this module may wish to consult other sources, such as [Section 34](https://www.cs.bham.ac.uk/~mhe/HoTT-UF-in-Agda-Lecture-Notes/HoTT-UF-Agda.html#truncation) and [35](https://www.cs.bham.ac.uk/~mhe/HoTT-UF-in-Agda-Lecture-Notes/HoTT-UF-Agda.html#resizing) of [Martín Escardó's notes][], or [Guillaume Brunerie, Truncations and truncated higher inductive types](https://homotopytypetheory.org/2012/09/16/truncations-and-truncated-higher-inductive-types/), or Section 7.1 of the [HoTT book][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Equality.Truncation where + +-- Imports from Agda and the Agda Standard Library ------------------------------------- +open import Agda.Primitive renaming ( Set to Type ) using () +open import Data.Product renaming ( proj₁ to fst ; proj₂ to snd ) using ( _,_ ; Σ ; Σ-syntax ; _×_ ) +open import Function using ( _∘_ ; id ) +open import Level using ( _⊔_ ; suc ; Level ) +open import Relation.Binary renaming ( Rel to BinRel ) using ( IsEquivalence ) +open import Relation.Binary.PropositionalEquality as ≡ using ( _≡_ ; module ≡-Reasoning ) +open import Relation.Unary using ( Pred ; _⊆_ ) + +-- Imports from the Agda Universal Algebra Library -------------------------------------- +open import Overture using ( _⁻¹ ; transport ; ∥_∥ ; _≈_ ; ∣_∣ ) +open import Base.Functions using ( IsInjective ) +open import Base.Relations using ( IsBlock ; Rel ; REL ) + +private variable α β ρ 𝓥 : Level + +\end{code} + +The MGS-Quotient module of the [Type Topology][] library defines a *uniqueness-of-proofs* principle for binary relations. We borrow this and related definitions from [Type Topology][]. + +First, a type is a *singleton* if it has exactly one inhabitant and a *subsingleton* if it has *at most* one inhabitant. Representing these concepts are the following types (whose original definitions we import from the `MGS-Basic-UF` module of [Type Topology][]). + +\begin{code} + +is-center : (A : Type α ) → A → Type α +is-center A c = (x : A) → c ≡ x + +is-singleton : Type α → Type α +is-singleton A = Σ A (is-center A) + +is-prop : Type α → Type α +is-prop A = (x y : A) → x ≡ y + +is-prop-valued : {A : Type α} → BinRel A ρ → Type(α ⊔ ρ) +is-prop-valued _≈_ = ∀ x y → is-prop (x ≈ y) + +open ≡-Reasoning +singleton-is-prop : {α : Level}(X : Type α) → is-singleton X → is-prop X +singleton-is-prop X (c , φ) x y = x ≡⟨ (φ x)⁻¹ ⟩ c ≡⟨ φ y ⟩ y ∎ + +\end{code} + +The concept of a [fiber](https://ncatlab.org/nlab/show/fiber) of a function is, in the [Type Topology][] library, defined as a Sigma type whose inhabitants represent inverse images of points in the codomain of the given function. + +\begin{code} + +fiber : {A : Type α } {B : Type β } (f : A → B) → B → Type (α ⊔ β) +fiber {α}{β}{A} f y = Σ[ x ∈ A ] f x ≡ y + +-- A function is called an *equivalence* if all of its fibers are singletons. +is-equiv : {A : Type α } {B : Type β } → (A → B) → Type (α ⊔ β) +is-equiv f = ∀ y → is-singleton (fiber f y) + +-- An alternative means of postulating function extensionality. +hfunext : ∀ α β → Type (suc (α ⊔ β)) +hfunext α β = {A : Type α}{B : A → Type β} (f g : (x : A) → B x) → is-equiv (≡.cong-app{f = f}{g}) + +\end{code} + +Thus, if `R : Rel A β`, then `is-subsingleton-valued R` is the assertion that for each pair `x y : A` there can be at most one proof that `R x y` holds. + + + +#### <a id="uniqueness-of-identity-proofs">Uniqueness of identity proofs</a> + +This brief introduction is intended for novices; those already familiar with the concept of *truncation* and *uniqueness of identity proofs* may want to skip to the next subsection. + +In general, we may have many inhabitants of a given type, hence (via Curry-Howard) many proofs of a given proposition. For instance, suppose we have a type `A` and an identity relation `_≡₀_` on `A` so that, given two inhabitants of `A`, say, `a b : A`, we can form the type `a ≡₀ b`. Suppose `p` and `q` inhabit the type `a ≡₀ b`; that is, `p` and `q` are proofs of `a ≡₀ b`, in which case we write `p q : a ≡₀ b`. We might then wonder whether and in what sense are the two proofs `p` and `q` the equivalent. + +We are asking about an identity type on the identity type `≡₀`, and whether there is some inhabitant, say, `r` of this type; i.e., whether there is a proof `r : p ≡ₓ₁ q` that the proofs of `a ≡₀ b` are the same. If such a proof exists for all `p q : a ≡₀ b`, then the proof of `a ≡₀ b` is unique; as a property of the types `A` and `≡₀`, this is sometimes called <a id="uniqueness-of-identity-proofs">*uniqueness of identity proofs*</a> (uip). + +Now, perhaps we have two proofs, say, `r s : p ≡₁ q` that the proofs `p` and `q` are equivalent. Then of course we wonder whether `r ≡₂ s` has a proof! But at some level we may decide that the potential to distinguish two proofs of an identity in a meaningful way (so-called *proof-relevance*) is not useful or desirable. At that point, say, at level `k`, we would be naturally inclined to assume that there is at most one proof of any identity of the form `p ≡ₖ q`. This is called [truncation](https://www.cs.bham.ac.uk/~mhe/HoTT-UF-in-Agda-Lecture-Notes/HoTT-UF-Agda.html#truncation) (at level `k`). + + +#### Sets + +In [homotopy type theory](https://homotopytypetheory.org), a type `A` with an identity relation `≡₀` is called a *set* (or *0-groupoid*) if for every pair `x y : A` there is at most one proof of `x ≡₀ y`. In other words, the type `A`, along with it's equality type `≡₀`, form a *set* if for all `x y : A` there is at most one proof of `x ≡₀ y`. + +This notion is formalized in the [Type Topology][] library, using the `is-subsingleton` type that we saw earlier ([Base.Functions.Inverses][]), as follows. + +\begin{code} + +is-set : Type α → Type α +is-set A = is-prop-valued{A = A} _≡_ + +\end{code} + +Thus, the pair `(A , ≡₀)` forms a set if and only if it satisfies `∀ x y : A → is-subsingleton (x ≡₀ y)`. + +We will also need the function [to-Σ-≡](https://www.cs.bham.ac.uk/~mhe/HoTT-UF-in-Agda-Lecture-Notes/HoTT-UF-Agda.html#sigmaequality), which is part of Escardó's characterization of *equality in Sigma types*. + +\begin{code} + +module _ {A : Type α}{B : A → Type β} where + + to-Σ-≡ : {σ τ : Σ[ x ∈ A ] B x} → (Σ[ p ∈ (fst σ ≡ fst τ) ] (transport B p ∥ σ ∥) ≡ ∥ τ ∥) → σ ≡ τ + to-Σ-≡ (≡.refl , ≡.refl) = ≡.refl +\end{code} + + +#### <a id="embeddings">Embeddings</a> + +The `is-embedding` type is defined in the `MGS-Embeddings` module of the [Type Topology][] library in the following way. + +\begin{code} + +is-embedding : {A : Type α}{B : Type β} → (A → B) → Type (α ⊔ β) +is-embedding f = ∀ b → is-prop (fiber f b) + +singleton-type : {A : Type α} → A → Type α +singleton-type {α}{A} x = Σ[ y ∈ A ] y ≡ x + +\end{code} + +Thus, `is-embedding f` asserts that `f` is a function all of whose fibers are subsingletons. Observe that an embedding is not simply an injective map. However, if we assume that the codomain `B` has *unique identity proofs* (UIP), then we can prove that a monic function into `B` is an embedding. We will do exactly that in the [Base.Relations.Truncation][] module when we take up the topic of *sets* and the UIP. + +Finding a proof that a function is an embedding isn't always easy, but one approach that is often fairly straightforward is to first prove that the function is invertible and then invoke the `invertible-is-embedding` theorem from the [Type Topology][] library. + +\begin{code} + +module _ {A : Type α}{B : Type β} where + + invertible : (A → B) → Type (α ⊔ β) + invertible f = Σ[ g ∈ (B → A) ] ((g ∘ f ≈ id) × (f ∘ g ≈ id)) + + equiv-is-embedding : (f : A → B) → is-equiv f → is-embedding f + equiv-is-embedding f i y = singleton-is-prop (fiber f y) (i y) + +\end{code} + +We will use `is-embedding`, `is-set`, and `to-Σ-≡` in the next subsection to prove that a monic function into a set is an embedding. + + +#### Injective functions are set embeddings + +Before moving on to define [propositions](#general-propositions), we discharge an obligation we mentioned but left unfulfilled in the [embeddings](Base.Functions.Inverses.html#embeddings) section of the [Base.Functions.Inverses][] module. Recall, we described and imported the `is-embedding` type, and we remarked that an embedding is not simply a monic function. However, if we assume that the codomain is truncated so as to have unique identity proofs (i.e., is a set), then we can prove that any monic function into that codomain will be an embedding. On the other hand, embeddings are always monic, so we will end up with an equivalence. + +\begin{code} + +private variable + A : Type α + B : Type β + +monic-is-embedding|Set : (f : A → B) → is-set B → IsInjective f → is-embedding f +monic-is-embedding|Set f Bset fmon b (u , fu≡b) (v , fv≡b) = γ + where + fuv : f u ≡ f v + fuv = ≡.trans fu≡b (fv≡b ⁻¹) + + uv : u ≡ v + uv = fmon fuv + + arg1 : Σ[ p ∈ u ≡ v ] transport (λ a → f a ≡ b) p fu≡b ≡ fv≡b + arg1 = uv , Bset (f v) b (transport (λ a → f a ≡ b) uv fu≡b) fv≡b + + γ : (u , fu≡b) ≡ (v , fv≡b) + γ = to-Σ-≡ arg1 + +\end{code} + +In stating the previous result, we introduce a new convention to which we will try to adhere. If the antecedent of a theorem includes the assumption that one of the types involved is a *set* (in the sense defined above), then we add to the name of the theorem the suffix `|Set`, which calls to mind the standard mathematical notation for the restriction of a function. + + +#### <a id="equivalence-class-truncation">Equivalence class truncation</a> + +Recall, `IsBlock` was defined in the [Base.Relations.Quotients][] module as follows: + +``` + IsBlock : {A : Type α}(C : Pred A β){R : Rel A β} → Type(α ⊔ lsuc β) + IsBlock {A} C {R} = Σ u ꞉ A , C ≡ [ u ] {R} +``` + +In the next module we will define a *quotient extensionality* principle that will require a form of unique identity proofs---specifically, we will assume that for each predicate `C : Pred A β` there is at most one proof of `IsBlock C`. We call this proof-irrelevance principle "uniqueness of block identity proofs", and define it as follows. + +\begin{code} + +blk-uip : (A : Type α)(R : BinRel A ρ ) → Type(α ⊔ suc ρ) +blk-uip A R = ∀ (C : Pred A _) → is-prop (IsBlock C {R}) + +\end{code} + +It might seem unreasonable to postulate that there is at most one inhabitant of `IsBlock C`, since equivalence classes typically have multiple members, any one of which could serve as a class representative. However, postulating `blk-uip A R` is tantamount to collapsing each `R`-block to a single point, and this is indeed the correct semantic interpretation of the elements of the quotient `A / R`. + + +#### <a id="general-propositions">General propositions</a> + +This section defines more general truncated predicates which we call *continuous propositions* and *dependent propositions*. Recall, above (in the [Base.Relations.Continuous][] module) we defined types called `Rel` and `REL` to represent relations of arbitrary arity over arbitrary collections of sorts. + +Naturally, we define the corresponding *truncated continuous relation type* and *truncated dependent relation type*, the inhabitants of which we will call *continuous propositions* and *dependent propositions*, respectively. + +\begin{code} + +module _ {I : Type 𝓥} where + + IsRelProp : {ρ : Level}(A : Type α) → Rel A I{ρ} → Type (𝓥 ⊔ α ⊔ ρ) + IsRelProp B P = ∀ (b : (I → B)) → is-prop (P b) + + RelProp : Type α → (ρ : Level) → Type (𝓥 ⊔ α ⊔ suc ρ) + RelProp A ρ = Σ[ P ∈ Rel A I{ρ} ] IsRelProp A P + + RelPropExt : Type α → (ρ : Level) → Type (𝓥 ⊔ α ⊔ suc ρ) + RelPropExt A ρ = {P Q : RelProp A ρ } → ∣ P ∣ ⊆ ∣ Q ∣ → ∣ Q ∣ ⊆ ∣ P ∣ → P ≡ Q + + IsRELProp : {ρ : Level} (𝒜 : I → Type α) → REL I 𝒜 {ρ} → Type (𝓥 ⊔ α ⊔ ρ) + IsRELProp 𝒜 P = ∀ (a : ((i : I) → 𝒜 i)) → is-prop (P a) + + RELProp : (I → Type α) → (ρ : Level) → Type (𝓥 ⊔ α ⊔ suc ρ) + RELProp 𝒜 ρ = Σ[ P ∈ REL I 𝒜 {ρ} ] IsRELProp 𝒜 P + + RELPropExt : (I → Type α) → (ρ : Level) → Type (𝓥 ⊔ α ⊔ suc ρ) + RELPropExt 𝒜 ρ = {P Q : RELProp 𝒜 ρ} → ∣ P ∣ ⊆ ∣ Q ∣ → ∣ Q ∣ ⊆ ∣ P ∣ → P ≡ Q +\end{code} + +---------------------------- + +<span style="float:left;">[← Base.Equality.Welldefined](Base.Equality.Welldefined.html)</span> +<span style="float:right;">[Base.Equality.Extensionality →](Base.Equality.Extensionality.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Equality.Welldefined.html b/docs/Base.Equality.Welldefined.html new file mode 100644 index 0000000..e972ae5 --- /dev/null +++ b/docs/Base.Equality.Welldefined.html @@ -0,0 +1,266 @@ + +
--- +layout: default +title : "Base.Equality.Welldefined module (The Agda Universal Algebra Library)" +date : "2021-07-25" +author: "agda-algebras development team" +--- + +### <a id="notions-of-well-definedness">Notions of well-definedness</a> + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Equality.Welldefined where + +-- Imports from Agda and the Agda Standard Library ------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ; Setω to Typeω ) +open import Data.Fin using ( Fin ; toℕ ) +open import Data.Product using ( _,_ ; _×_ ) +open import Data.List using ( List ; [] ; [_] ; _∷_ ; _++_ ) +open import Function using ( _$_ ; _∘_ ; id ) +open import Level using ( _⊔_ ; suc ; Level ) + +open import Axiom.Extensionality.Propositional using () renaming ( Extensionality to funext ) +open import Relation.Binary.PropositionalEquality using ( _≡_ ; refl ; module ≡-Reasoning ; cong ) + +-- Imports from agda-algebras ----------------------------------------------------------- +open import Overture using ( _≈_ ; _⁻¹ ; Op ) +open import Base.Functions using ( A×A→B-to-Fin2A→B ; UncurryFin2 ; UncurryFin3 ) + +private variable ι α β 𝓥 ρ : Level + +\end{code} + +#### <a id="strongly-well-defined-operations">Strongly well-defined operations</a> + +We now describe an extensionality principle that seems weaker than function +extensionality, but still (probably) not provable in [MLTT][]. (We address this +and other questions below.) We call this the principle *strong well-definedness +of operations*. We will encounter situations in which this weaker extensionality +principle suffices as a substitute for function extensionality. + +Suppose we have a function whose domain is a function type, say, `I → A`. For +example, inhabitants of the type `Op` defined above are such functions. (Recall, +the domain of inhabitants of type `Op I A := (I → A) → A` is `I → A`.) + +Of course, operations of type `Op I A` are well-defined in the sense that equal +inputs result in equal outputs. + +\begin{code} + +welldef : {A : Type α}{I : Type 𝓥}(f : Op A I) → ∀ u v → u ≡ v → f u ≡ f v +welldef f u v = cong f + +\end{code} + +A stronger form of well-definedness of operations is to suppose that point-wise +equal inputs lead to the same output. In other terms, we could suppose that for +all `f : Op I A`, we have `f u ≡ f v` whenever `∀ i → u i ≡ v i` holds. We call +this formalize this notation in the following type. + +\begin{code} + +swelldef : ∀ ι α → Type (suc (α ⊔ ι)) +swelldef ι α = ∀ {I : Type ι}{A : Type α}(f : Op A I)(u v : I → A) + → u ≈ v → f u ≡ f v + +funext→swelldef : {α 𝓥 : Level} → funext 𝓥 α → swelldef 𝓥 α +funext→swelldef fe f u v ptweq = welldef f u v (fe ptweq) + +-- level-polymorphic version +SwellDef : Typeω +SwellDef = (α β : Level) → swelldef α β + +\end{code} + +There are certain situations in which a (seemingly) weaker principle than function +extensionality suffices. + +Here are the more general versions of the foregoing that are not restricted to +(I-ary) *operations* on A (of type (I → A) → A), but handle also (I-ary) +*functions* from A^I to B (of type (I → A) → B). + +\begin{code} + +swelldef' : ∀ ι α β → Type (suc (ι ⊔ α ⊔ β)) +swelldef' ι α β = ∀ {I : Type ι} {A : Type α} {B : Type β} + → (f : (I → A) → B) {u v : I → A} → u ≈ v → f u ≡ f v + +funext' : ∀ α β → Type (suc (α ⊔ β)) +funext' α β = ∀ {A : Type α } {B : Type β } {f g : A → B} → f ≈ g → f ≡ g + +-- `funext ι α` implies `swelldef ι α β` (Note the universe levels!) +funext'→swelldef' : funext' ι α → swelldef' ι α β +funext'→swelldef' fe f ptweq = cong f (fe ptweq) + + -- `swelldef ι α (ι ⊔ α)` implies `funext ι α` (Note the universe levels!) +swelldef'→funext' : swelldef' ι α (ι ⊔ α) → funext' ι α +swelldef'→funext' wd ptweq = wd _$_ ptweq +\end{code} + +#### <a id="questions">Questions</a> + +1. Does the converse `swelldef→funext` hold or is `swelldef` is strictly weaker + than `funext`? +2. If `swelldef` is strictly weaker than `funext`, then can we prove it in MLTT? +3. If the answer to 2 is no in general, then for what types `I` can we prove + `swelldef 𝓥 _ {I}`? + +Notice that the implication swelldef → funext holds *if* we restrict the universe +level β to be `ι ⊔ α`. This is because to go from swelldef to funext, we must +apply the swelldef premise to the special case in which `f` is the identify +function on `I → A`, which of course has type `(I → A) → (I → A)`. + +This is possible if we take `swelldef ι α (ι ⊔ α)` as the premise (so that we can +assume `B` is `I → A`). + +It is NOT possible if we merely assume `swelldef ι α β` for *some* β (not +necessarily `ι ⊔ α`) and for some B (not necessarily `I → A`). + +In the agda-algebras library, swelldef is used exclusively on operation type, so +that B ≡ A. I believe there is no way to prove that `swelldef ι α α` implies funext ι α. + + +#### <a id="some-new-ideas">Some new ideas</a> + +It seems unlikely that we could prove swelldef in MLTT because, on the face of it, +to prove f u ≡ f v, we need u ≡ v, but we only have ∀ i → u i ≡ v i. + +```agda +swelldef-proof : ∀ {I : Type ι}{A : Type α}{B : Type β} + → (f : (I → A) → B){u v : I → A} + → (∀ i → u i ≡ v i) → f u ≡ f v +swelldef-proof {I = I}{A}{B} f {u}{v} x = {!!} -- <== we are stuck +``` + +However, we *can* prove swelldef in MLTT for certain types at least, using a +zipper argument. + +This certainly works in the special case of *finitary* functions, say, +`f : (Fin n → A) → B` for some `n`. + +I expect this proof will generalize to countable arities, but I have yet to +formally prove it. + +If `f` is finitary, then we can Curry and work instead with the function + +``` +(Curry f) : A → A → A → ... → A → B +``` + +(for some appropriate number of arrow; i.e., number of arguments). + +The idea is to partially apply f, and inductively build up a proof of f u ≡ f v, like so. + +1. `f (u 0) ≡ f (v 0)` (by `u 0 ≡ v 0`), +2. `f (u 0)(u 1) ≡ f (v 0)(v 1)` (by 1. and u 1 ≡ v 1), +⋮ +n. `f (u 0) … (u(n-1)) ≡ f (v 0) … (v(n-1))` (by n-1 and `u(n-1) ≡ v(n-1)`). +⋮ + +Actually, the proof should probably go in the other direction, + +⋮ +n. `f (u 0) … (u(n-2))(u(n-1)) ≡ f (u 0) … (u(n-2))(v(n-1))` +n-1. `f (u 0) (u(n-2))(u(n-1)) ≡ f (v 0) … (v(n-2))(v(n-1))` +⋮ +2. `f (u 0)(u 1) ≡ f (v 0)(v 1)` +1. `f (u 0) ≡ f (v 0)` + + +To formalize this, let's begin with the simplest case, that is, when `f : A → A +→ B`, so `f` is essentially of type `(Fin 2 → A) → B`. + +However, we still need to establish a one-to-one correspondence between the types +`(Fin 2 → A) → B` and `A → A → B`, (and `A × A → B`), which turns out to be nontrivial. + +\begin{code} + +module _ {A : Type α}{B : Type β} where + open Fin renaming ( zero to z ; suc to s ) + open ≡-Reasoning + + A×A-wd : (f : A × A → B)(u v : Fin 2 → A) + → u ≈ v → (A×A→B-to-Fin2A→B f) u ≡ (A×A→B-to-Fin2A→B f) v + + A×A-wd f u v u≈v = Goal + where + zip1 : ∀ {a x y} → x ≡ y → f (a , x) ≡ f (a , y) + zip1 refl = refl + + zip2 : ∀ {x y b} → x ≡ y → f (x , b) ≡ f (y , b) + zip2 refl = refl + + Goal : (A×A→B-to-Fin2A→B f) u ≡ (A×A→B-to-Fin2A→B f) v + Goal = (A×A→B-to-Fin2A→B f) u ≡⟨ refl ⟩ + f (u z , u (s z)) ≡⟨ zip1 (u≈v (s z)) ⟩ + f (u z , v (s z)) ≡⟨ zip2 (u≈v z) ⟩ + f (v z , v (s z)) ≡⟨ refl ⟩ + (A×A→B-to-Fin2A→B f) v ∎ + + Fin2-wd : (f : A → A → B)(u v : Fin 2 → A) + → u ≈ v → (UncurryFin2 f) u ≡ (UncurryFin2 f) v + + Fin2-wd f u v u≈v = Goal + where + zip1 : ∀ {a x y} → x ≡ y → f a x ≡ f a y + zip1 refl = refl + + zip2 : ∀ {x y b} → x ≡ y → f x b ≡ f y b + zip2 refl = refl + + Goal : (UncurryFin2 f) u ≡ (UncurryFin2 f) v + Goal = (UncurryFin2 f) u ≡⟨ refl ⟩ + f (u z) (u (s z)) ≡⟨ zip1 (u≈v (s z)) ⟩ + f (u z) (v (s z)) ≡⟨ zip2 (u≈v z) ⟩ + f (v z) (v (s z)) ≡⟨ refl ⟩ + (UncurryFin2 f) v ∎ + + + Fin3-wd : (f : A → A → A → B)(u v : Fin 3 → A) + → u ≈ v → (UncurryFin3 f) u ≡ (UncurryFin3 f) v + + Fin3-wd f u v u≈v = Goal + where + zip1 : ∀ {a b x y} → x ≡ y → f a b x ≡ f a b y + zip1 refl = refl + + zip2 : ∀ {a b x y} → x ≡ y → f a x b ≡ f a y b + zip2 refl = refl + + zip3 : ∀ {a b x y} → x ≡ y → f x a b ≡ f y a b + zip3 refl = refl + + Goal : (UncurryFin3 f) u ≡ (UncurryFin3 f) v + Goal = (UncurryFin3 f) u ≡⟨ refl ⟩ + f (u z) (u (s z)) (u (s (s z))) ≡⟨ zip1 (u≈v (s (s z))) ⟩ + f (u z) (u (s z)) (v (s (s z))) ≡⟨ zip2 (u≈v (s z)) ⟩ + f (u z) (v (s z)) (v (s (s z))) ≡⟨ zip3 (u≈v z) ⟩ + f (v z) (v (s z)) (v (s (s z))) ≡⟨ refl ⟩ + (UncurryFin3 f) v ∎ + + -- NEXT: try to prove (f : (Fin 2 → A) → B)(u v : Fin 2 → A) → u ≈ v → f u ≡ f v + +module _ {A : Type α}{B : Type β} where + + ListA→B : (f : List A → B)(u v : List A) → u ≡ v → f u ≡ f v + ListA→B f u .u refl = refl + + CurryListA : (List A → B) → (List A → A → B) + CurryListA f [] a = f [ a ] + CurryListA f (x ∷ l) a = f ((x ∷ l) ++ [ a ]) + + CurryListA' : (List A → B) → (A → List A → B) + CurryListA' f a [] = f [ a ] + CurryListA' f a (x ∷ l) = f ([ a ] ++ (x ∷ l)) +\end{code} + +------------------------------------- + +<span style="float:left;">[↑ Equality](Base.Equality.html)</span> +<span style="float:right;">[Base.Equality.Truncation →](Base.Equality.Truncation.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Equality.html b/docs/Base.Equality.html new file mode 100644 index 0000000..2bd9ef2 --- /dev/null +++ b/docs/Base.Equality.html @@ -0,0 +1,30 @@ + +
--- +layout: default +title : "Base.Equality module (The Agda Universal Algebra Library)" +date : "2021-07-26" +author: "agda-algebras development team" +--- + +## <a id="equality">Equality</a> + +This is the [Base.Equality][] module of the [Agda Universal Algebra Library][]. + + +\begin{code} +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Equality where + +open import Base.Equality.Welldefined public +open import Base.Equality.Truncation public +open import Base.Equality.Extensionality public +\end{code} + +------------------------------------- + +<span style="float:left;">[← Base.Relations.Quotients](Base.Relations.Quotients.html)</span> +<span style="float:right;">[Base.Equality.Welldefined →](Base.Equality.Welldefined.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Functions.Injective.html b/docs/Base.Functions.Injective.html new file mode 100644 index 0000000..03fdcc6 --- /dev/null +++ b/docs/Base.Functions.Injective.html @@ -0,0 +1,61 @@ + +
--- +layout: default +title : "Base.Functions.Injective module" +date : "2021-09-10" +author: "the agda-algebras development team" +--- + +### <a id="injective-functions">Injective functions</a> + +This is the [Base.Functions.Injective][] module of the [agda-algebras][] library. + +We say that a function `f : A → B` is *injective* (or *monic*) if it +does not map two distinct elements of the domain to the same point in +the codomain. The following type manifests this property. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Functions.Injective where + +-- Imports from Agda and the Agda Standard Library ------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Function using ( _↣_ ; _∘_ ; Injective ) +open import Function.Construct.Identity using ( id-↣ ) +open import Level using ( _⊔_ ; Level ) +open import Relation.Binary using ( Rel ) +open import Relation.Binary.PropositionalEquality using ( _≡_ ; refl ) + +private variable α β γ ℓ₁ ℓ₂ ℓ₃ : Level + +id-is-injective : {A : Type α} → A ↣ A +id-is-injective {A = A} = id-↣ A + +module _ {A : Type α}{B : Type β} where + + IsInjective : (A → B) → Type (α ⊔ β) + IsInjective f = Injective _≡_ _≡_ f + +\end{code} + +The composition of injective functions is injective. + +\begin{code} + +∘-injective : {A : Type α}{B : Type β}{C : Type γ}{f : A → B}{g : B → C} + → IsInjective f → IsInjective g → IsInjective (g ∘ f) + +∘-injective fi gi = λ x → fi (gi x) +\end{code} + +-------------------------------------- + +<span style="float:left;">[← Base.Functions.FuncInverses](Base.Functions.FuncInverses.html)</span> +<span style="float:right;">[Base.Functions.Surjective →](Base.Functions.Surjective.html)</span> + +{% include UALib.Links.md %} + + +\ No newline at end of file diff --git a/docs/Base.Functions.Inverses.html b/docs/Base.Functions.Inverses.html new file mode 100644 index 0000000..468ca65 --- /dev/null +++ b/docs/Base.Functions.Inverses.html @@ -0,0 +1,117 @@ + +
--- +layout: default +title : "Base.Functions.Inverses module" +date : "2021-01-12" +author: "the agda-algebras development team" +--- + +### <a id="inverses">Inverses</a> + +This is the [Base.Functions.Inverses][] module of the [agda-algebras][] library. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} +module Base.Functions.Inverses where + +-- Imports from Agda and the Agda Standard Library --------------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; Σ-syntax ) +open import Level using ( Level ; _⊔_ ) +open import Relation.Binary.PropositionalEquality + using ( _≡_ ; sym ; refl ) +open import Relation.Unary using ( Pred ; _∈_ ) + +-- Imports from agda-algebras ---------------------------------------------------------------- +open import Overture.Basic using ( ∃-syntax ; ∣_∣ ) + +private variable α β : Level + +\end{code} + +We begin by defining an data type that represents the semantic concept of *inverse +image* of a function. + +\begin{code} + +module _ {A : Type α }{B : Type β } where + + data Image_∋_ (f : A → B) : B → Type (α ⊔ β) where + eq : {b : B} → (a : A) → b ≡ f a → Image f ∋ b + + open Image_∋_ + + Range : (A → B) → Pred B (α ⊔ β) + Range f b = ∃[ a ∈ A ] (f a) ≡ b + + range : (A → B) → Type (α ⊔ β) + range f = Σ[ b ∈ B ] ∃[ a ∈ A ](f a) ≡ b + + Image⊆Range : (f : A → B) → ∀ b → Image f ∋ b → b ∈ Range f + Image⊆Range f b (eq a x) = a , (sym x) + + Range⊆Image : (f : A → B) → ∀ b → b ∈ Range f → Image f ∋ b + Range⊆Image f b (a , x) = eq a (sym x) + + Imagef∋f : {f : A → B}{a : A} → Image f ∋ (f a) + Imagef∋f = eq _ refl + + f∈range : {f : A → B}(a : A) → range f + f∈range {f} a = (f a) , (a , refl) + +\end{code} + +An inhabitant of `Image f ∋ b` is a dependent pair `(a , p)`, where `a : A` and +`p : b ≡ f a` is a proof that `f` maps `a` to `b`. Since the proof that `b` belongs +to the image of `f` is always accompanied by a witness `a : A`, we can actually +*compute* a (pseudo)inverse of `f`. For convenience, we define this inverse +function, which we call `Inv`, and which takes an arbitrary `b : B` and a +(*witness*, *proof*)-pair, `(a , p) : Image f ∋ b`, and returns the witness `a`. + +\begin{code} + + Inv : (f : A → B){b : B} → Image f ∋ b → A + Inv f (eq a _) = a + + + [_]⁻¹ : (f : A → B) → range f → A + [ f ]⁻¹ (_ , (a , _)) = a + +\end{code} + +We can prove that `Inv f` is the (range-restricted) *right-inverse* of `f`, as +follows. + +\begin{code} + + InvIsInverseʳ : {f : A → B}{b : B}(q : Image f ∋ b) → f(Inv f q) ≡ b + InvIsInverseʳ (eq _ p) = sym p + + ⁻¹IsInverseʳ : {f : A → B}{bap : range f} → f ([ f ]⁻¹ bap) ≡ ∣ bap ∣ + ⁻¹IsInverseʳ {bap = (_ , (_ , p))} = p + +\end{code} + +Of course, the "range-restricted" qualifier is needed because `Inf f` is not defined outside the range of `f`. + +In a certain sense, `Inv f` is also a (range-restricted) *left-inverse*. + +\begin{code} + + InvIsInverseˡ : ∀ {f a} → Inv f {b = f a} Imagef∋f ≡ a + InvIsInverseˡ = refl + + ⁻¹IsInverseˡ : ∀ {f a} → [ f ]⁻¹ (f∈range a) ≡ a + ⁻¹IsInverseˡ = refl +\end{code} + +-------------------------------------- + +<span style="float:left;">[← Base.Functions.Preliminaries](Base.Functions.Preliminaries.html)</span> +<span style="float:right;">[Base.Functions.Injective →](Base.Functions.Injective.html)</span> + +{% include UALib.Links.md %} + + +\ No newline at end of file diff --git a/docs/Base.Functions.Surjective.html b/docs/Base.Functions.Surjective.html new file mode 100644 index 0000000..f97981b --- /dev/null +++ b/docs/Base.Functions.Surjective.html @@ -0,0 +1,168 @@ + +
--- +layout: default +title : "Base.Functions.Surjective module" +date : "2021-01-12" +author: "the agda-algebras development team" +--- + +### <a id="surjective-functions">Surjective functions</a> + +This is the [Base.Functions.Surjective][] module of the [agda-algebras][] library. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} +module Base.Functions.Surjective where + +-- Imports from Agda and the Agda Standard Library -------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Empty using (⊥-elim) +open import Function using ( Surjective ; _∘_ ) +open import Level using ( _⊔_ ; Level ) +open import Relation.Binary using ( Decidable ) +open import Relation.Nullary using ( Dec ; yes ; no ) +open import Data.Product using ( _,_ ; Σ ; Σ-syntax ) + renaming ( proj₁ to fst ; proj₂ to snd ) +open import Axiom.UniquenessOfIdentityProofs + using ( module Decidable⇒UIP ) +open import Relation.Binary.PropositionalEquality + using ( _≡_ ; sym ; cong-app ; cong ; refl ) + +-- Imports from agda-algebras ----------------------------------------------------- +open import Overture.Basic using ( _≈_ ; _∙_ ; transport ) +open import Base.Functions.Inverses using ( Image_∋_ ; eq ; Inv ; InvIsInverseʳ ) + +private variable α β γ c ι : Level +\end{code} + +A *surjective function* from `A` to `B` is a function `f : A → B` such that for +all `b : B` there exists `a : A` such that `f a ≡ b`. In other words, the range +and codomain of `f` agree. The following types manifest this notion. + +\begin{code} + +module _ {A : Type α}{B : Type β} where + + IsSurjective : (A → B) → Type (α ⊔ β) + IsSurjective f = ∀ y → Image f ∋ y + + onto : Type (α ⊔ β) + onto = Σ (A → B) IsSurjective + + IsSurjective→Surjective : (f : A → B) → IsSurjective f + → Surjective{A = A} _≡_ _≡_ f + + IsSurjective→Surjective f fE y = imgfy→A (fE y) + where + imgfy→A : Image f ∋ y → Σ[ a ∈ A ] f a ≡ y + imgfy→A (eq a p) = a , sym p + + Surjective→IsSurjective : (f : A → B) → Surjective{A = A} _≡_ _≡_ f + → IsSurjective f + + Surjective→IsSurjective f fE y = eq (fst (fE y)) (sym (snd(fE y))) + +\end{code} + +With the next definition, we can represent a *right-inverse* of a surjective +function. + +\begin{code} + + SurjInv : (f : A → B) → IsSurjective f → B → A + SurjInv f fE b = Inv f (fE b) + +\end{code} +Thus, a right-inverse of `f` is obtained by applying `SurjInv` to `f` and a proof +of `IsSurjective f`. Next we prove that this does indeed give the right-inverse. + +\begin{code} + +module _ {A : Type α}{B : Type β} where + + SurjInvIsInverseʳ : (f : A → B)(fE : IsSurjective f) + → ∀ b → f ((SurjInv f fE) b) ≡ b + + SurjInvIsInverseʳ f fE b = InvIsInverseʳ (fE b) + + -- composition law for epics + epic-factor : {C : Type γ}(f : A → B)(g : A → C)(h : C → B) + → f ≈ h ∘ g → IsSurjective f → IsSurjective h + + epic-factor f g h compId fe y = Goal + where + finv : B → A + finv = SurjInv f fe + + ζ : y ≡ f (finv y) + ζ = sym (SurjInvIsInverseʳ f fe y) + + η : y ≡ (h ∘ g) (finv y) + η = ζ ∙ compId (finv y) + + Goal : Image h ∋ y + Goal = eq (g (finv y)) η + + epic-factor-intensional : {C : Type γ}(f : A → B)(g : A → C)(h : C → B) + → f ≡ h ∘ g → IsSurjective f → IsSurjective h + + epic-factor-intensional f g h compId fe y = Goal + where + finv : B → A + finv = SurjInv f fe + + ζ : f (finv y) ≡ y + ζ = SurjInvIsInverseʳ f fe y + + η : (h ∘ g) (finv y) ≡ y + η = (cong-app (sym compId)(finv y)) ∙ ζ + + Goal : Image h ∋ y + Goal = eq (g (finv y)) (sym η) + +\end{code} + +Later we will need the fact that the projection of an arbitrary product onto one (or any number) of its factors is surjective. + +\begin{code} + +module _ {I : Set ι}(_≟_ : Decidable{A = I} _≡_) + {B : I → Set β} + (bs₀ : ∀ i → (B i)) + where + open Decidable⇒UIP _≟_ using ( ≡-irrelevant ) + + proj : (j : I) → (∀ i → (B i)) → (B j) + proj j xs = xs j + + update : (∀ i → B i) → ((j , _) : Σ I B) → (∀ i → Dec (i ≡ j) → B i) + update _ (_ , b) i (yes x) = transport B (sym x) b + update bs _ i (no _) = bs i + + update-id : ∀{j b} → (c : Dec (j ≡ j)) → update bs₀ (j , b) j c ≡ b + update-id {j}{b} (yes p) = cong (λ x → transport B x b)(≡-irrelevant (sym p) refl) + update-id (no ¬p) = ⊥-elim (¬p refl) + + proj-is-onto : ∀{j} → Surjective{A = ∀ i → (B i)} _≡_ _≡_ (proj j) + proj-is-onto {j} b = bs , pf + where + bs : (i : I) → B i + bs i = update bs₀ (j , b) i (i ≟ j) + + pf : proj j bs ≡ b + pf = update-id (j ≟ j) + + projIsOnto : ∀{j} → IsSurjective (proj j) + projIsOnto {j} = Surjective→IsSurjective (proj j) proj-is-onto +\end{code} + +-------------------------------------- + +<span style="float:left;">[← Base.Functions.Injective](Base.Functions.Injective.html)</span> +<span style="float:right;">[Base.Functions.Transformers →](Base.Functions.Transformers.html)</span> + +{% include UALib.Links.md %} + + +\ No newline at end of file diff --git a/docs/Base.Functions.Transformers.html b/docs/Base.Functions.Transformers.html new file mode 100644 index 0000000..98dad58 --- /dev/null +++ b/docs/Base.Functions.Transformers.html @@ -0,0 +1,181 @@ + +
--- +layout: default +title : "Base.Functions.Transformers module" +date : "2021-07-26" +author: "the agda-algebras development team" +--- + +### <a id="type-transformers">Type Transformers</a> + +This is the [Base.Functions.Transformers][] module of the [agda-algebras][] +library. Here we define functions for translating from one type to another. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Functions.Transformers where + +-- Imports from Agda and the Agda Standard Library ------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; _×_ ) +open import Data.Fin.Base using ( Fin ) +open import Function.Base using ( _∘_ ; id ) +open import Level using ( _⊔_ ; Level ) + +open import Relation.Binary.PropositionalEquality + using ( _≡_ ; refl ; module ≡-Reasoning ) + +-- Imports from agda-algebras ---------------------------------------------------- +open import Overture using ( _≈_ ) + +private variable α β : Level +\end{code} + + +#### <a id="bijections-of-nondependent-function-types">Bijections of nondependent function types</a> + +In set theory, these would simply be bijections between sets, or "set isomorphisms." +\begin{code} + +record Bijection (A : Type α)(B : Type β) : Type (α ⊔ β) where + field + to : A → B + from : B → A + to-from : to ∘ from ≡ id + from-to : from ∘ to ≡ id + +∣_∣=∣_∣ : (A : Type α)(B : Type β) → Type (α ⊔ β) +∣ A ∣=∣ B ∣ = Bijection A B + +record PointwiseBijection (A : Type α)(B : Type β) : Type (α ⊔ β) where + field + to : A → B + from : B → A + to-from : to ∘ from ≈ id + from-to : from ∘ to ≈ id + +∣_∣≈∣_∣ : (A : Type α)(B : Type β) → Type (α ⊔ β) +∣ A ∣≈∣ B ∣ = PointwiseBijection A B + +uncurry₀ : {A : Type α} → A → A → (A × A) +uncurry₀ x y = x , y + +module _ {A : Type α} {B : Type β} where + + Curry : ((A × A) → B) → A → A → B + Curry f x y = f (uncurry₀ x y) + + Uncurry : (A → A → B) → A × A → B + Uncurry f (x , y) = f x y + + A×A→B≅A→A→B : ∣ (A × A → B) ∣=∣ (A → A → B) ∣ + A×A→B≅A→A→B = record { to = Curry ; from = Uncurry + ; to-from = refl ; from-to = refl } +\end{code} + +#### <a id="non-bijective-transformations">Non-bijective transformations</a> + +\begin{code} + +module _ {A : Type α} where + open Fin renaming (zero to z ; suc to s) + + A×A→Fin2A : A × A → Fin 2 → A + A×A→Fin2A (x , y) z = x + A×A→Fin2A (x , y) (s z) = y + + Fin2A→A×A : (Fin 2 → A) → A × A + Fin2A→A×A u = u z , u (s z) + + Fin2A~A×A : {A : Type α} → Fin2A→A×A ∘ A×A→Fin2A ≡ id + Fin2A~A×A = refl + + A×A~Fin2A-ptws : ∀ u → (A×A→Fin2A (Fin2A→A×A u)) ≈ u + A×A~Fin2A-ptws u z = refl + A×A~Fin2A-ptws u (s z) = refl + + A→A→Fin2A : A → A → Fin 2 → A + A→A→Fin2A x y z = x + A→A→Fin2A x y (s _) = y + + A→A→Fin2A' : A → A → Fin 2 → A + A→A→Fin2A' x y = u + where + u : Fin 2 → A + u z = x + u (s z) = y + + A→A→Fin2A-ptws-agree : (x y : A) → ∀ i → (A→A→Fin2A x y) i ≡ (A→A→Fin2A' x y) i + A→A→Fin2A-ptws-agree x y z = refl + A→A→Fin2A-ptws-agree x y (s z) = refl + + A→A~Fin2A-ptws : (v : Fin 2 → A) → ∀ i → A→A→Fin2A (v z) (v (s z)) i ≡ v i + A→A~Fin2A-ptws v z = refl + A→A~Fin2A-ptws v (s z) = refl + + Fin2A : (Fin 2 → A) → Fin 2 → A + Fin2A u z = u z + Fin2A u (s z) = u (s z) + Fin2A u (s (s ())) + + Fin2A≡ : (u : Fin 2 → A) → ∀ i → (Fin2A u) i ≡ u i + Fin2A≡ u z = refl + Fin2A≡ u (s z) = refl + +\end{code} + +Somehow we cannot establish a bijection between the two seemingly isomorphic +function types, `(Fin 2 → A) → B` and `A × A → B`, nor between the types +`(Fin 2 → A) → B` and `A → A → B`. + +\begin{code} + +module _ {A : Type α} {B : Type β} where + open Fin renaming (zero to z ; suc to s) + + lemma : (u : Fin 2 → A) → u ≈ (λ {z → u z ; (s z) → u (s z)}) + lemma u z = refl + lemma u (s z) = refl + + CurryFin2 : ((Fin 2 → A) → B) → A → A → B + CurryFin2 f x y = f (A→A→Fin2A x y) + + UncurryFin2 : (A → A → B) → ((Fin 2 → A) → B) + UncurryFin2 f u = f (u z) (u (s z)) + + CurryFin2~UncurryFin2 : CurryFin2 ∘ UncurryFin2 ≡ id + CurryFin2~UncurryFin2 = refl + + open ≡-Reasoning + + CurryFin3 : {A : Type α} → ((Fin 3 → A) → B) → A → A → A → B + CurryFin3 {A = A} f x₁ x₂ x₃ = f u + where + u : Fin 3 → A + u z = x₁ + u (s z) = x₂ + u (s (s z)) = x₃ + + UncurryFin3 : (A → A → A → B) → ((Fin 3 → A) → B) + UncurryFin3 f u = f (u z) (u (s z)) (u (s (s z))) + + Fin2A→B-to-A×A→B : ((Fin 2 → A) → B) → A × A → B + Fin2A→B-to-A×A→B f = f ∘ A×A→Fin2A + + A×A→B-to-Fin2A→B : (A × A → B) → ((Fin 2 → A) → B) + A×A→B-to-Fin2A→B f = f ∘ Fin2A→A×A + + Fin2A→B~A×A→B : Fin2A→B-to-A×A→B ∘ A×A→B-to-Fin2A→B ≡ id + Fin2A→B~A×A→B = refl +\end{code} + +-------------------------------------- + +<span style="float:left;">[← Base.Functions.Inverses](Base.Functions.Inverses.html)</span> +<span style="float:right;">[Base.Relations →](Base.Relations.html)</span> + +{% include UALib.Links.md %} + +\ No newline at end of file diff --git a/docs/Base.Functions.html b/docs/Base.Functions.html new file mode 100644 index 0000000..48487fc --- /dev/null +++ b/docs/Base.Functions.html @@ -0,0 +1,37 @@ + +
--- +layout: default +title : "Base.Functions module (Agda Universal Algebra Library)" +date : "2021-01-12" +author: "the agda-algebras development team" +--- + +## <a id="functions">Functions</a> + +This is the [Base.Functions][] module of the [Agda Universal Algebra Library][]. + +The source code for this module comprises the (literate) [Agda][] program that was +used to generate the html page displaying the sentence you are now reading. This +source code inhabits the file [Base/Functions.lagda][], which resides in the +[git repository of the agda-algebras library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Functions where + +open import Base.Functions.Inverses public +open import Base.Functions.Injective public +open import Base.Functions.Surjective public +open import Base.Functions.Transformers public + +\end{code} + +-------------------------------------- + +<span style="float:left;">[↑ Base](Base.html)</span> +<span style="float:right;">[Base.Functions.Inverses →](Base.Functions.Inverses.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Homomorphisms.Basic.html b/docs/Base.Homomorphisms.Basic.html new file mode 100644 index 0000000..2960319 --- /dev/null +++ b/docs/Base.Homomorphisms.Basic.html @@ -0,0 +1,155 @@ + +
--- +layout: default +title : "Base.Homomorphisms.Basic module (The Agda Universal Algebra Library)" +date : "2021-01-13" +author: "agda-algebras development team" +--- + +### <a id="basic-definitions">Basic Definitions</a> + +This is the [Base.Homomorphisms.Basic] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( Signature; 𝓞 ; 𝓥 ) + +module Base.Homomorphisms.Basic {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library -------------------------------- +open import Agda.Primitive renaming ( Set to Type ) using () +open import Data.Product renaming ( proj₁ to fst ) + using ( _,_ ; Σ ; _×_ ; Σ-syntax) +open import Function using ( _∘_ ; id ) +open import Level using ( Level ; _⊔_ ) + +open import Relation.Binary.PropositionalEquality using ( _≡_ ; refl ) + +-- Imports from the Agda Universal Algebras Library -------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ) +open import Base.Functions using ( IsInjective ; IsSurjective ) +open import Base.Algebras {𝑆 = 𝑆} using ( Algebra ; _̂_ ; Lift-Alg ) + +private variable α β : Level +\end{code} + +#### <a id="homomorphisms">Homomorphisms</a> + +If `𝑨` and `𝑩` are `𝑆`-algebras, then a *homomorphism* from `𝑨` to `𝑩` is a +function `h : ∣ 𝑨 ∣ → ∣ 𝑩 ∣` from the domain of `𝑨` to the domain of `𝑩` that is +*compatible* (or *commutes*) with all of the basic operations of the signature; +that is, for all operation symbols `𝑓 : ∣ 𝑆 ∣` and tuples `a : ∥ 𝑆 ∥ 𝑓 → ∣ 𝑨 ∣` of +`𝑨`, the following holds: + +`h ((𝑓 ̂ 𝑨) a) ≡ (𝑓 ̂ 𝑩) (h ∘ a)`. + +**Remarks**. Recall, `h ∘ 𝒂` is the tuple whose i-th component is `h (𝒂 i)`. +Instead of "homomorphism," we sometimes use the nickname "hom" to refer to such +a map. + +To formalize this concept, we first define a type representing the assertion that +a function `h : ∣ 𝑨 ∣ → ∣ 𝑩 ∣` commutes with a single basic operation `𝑓`. With +Agda's extremely flexible syntax the defining equation above can be expressed +unadulterated. + +\begin{code} + +module _ (𝑨 : Algebra α)(𝑩 : Algebra β) where + + compatible-op-map : ∣ 𝑆 ∣ → (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type(α ⊔ 𝓥 ⊔ β) + compatible-op-map 𝑓 h = ∀ 𝑎 → h ((𝑓 ̂ 𝑨) 𝑎) ≡ (𝑓 ̂ 𝑩) (h ∘ 𝑎) + +\end{code} + +Agda infers from the shorthand `∀ 𝑎` that `𝑎` has type `∥ 𝑆 ∥ 𝑓 → ∣ 𝑨 ∣` since it +must be a tuple on `∣ 𝑨 ∣` of "length" `∥ 𝑆 ∥ 𝑓` (the arity of `𝑓`). + +We now define the type `hom 𝑨 𝑩` of homomorphisms from `𝑨` to `𝑩` by first +defining the type `is-homomorphism` which represents the property of being a +homomorphism. + +\begin{code} + + is-homomorphism : (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type(𝓞 ⊔ 𝓥 ⊔ α ⊔ β) + is-homomorphism g = ∀ 𝑓 → compatible-op-map 𝑓 g + + hom : Type(𝓞 ⊔ 𝓥 ⊔ α ⊔ β) + hom = Σ (∣ 𝑨 ∣ → ∣ 𝑩 ∣) is-homomorphism +\end{code} + + +#### <a id="important-exmples-of-homomorphisms">Important examples of homomorphisms</a> + +Let's look at a few important examples of homomorphisms. These examples are +actually quite special in that every algebra has such a homomorphism. + +We begin with the identity map, which is proved to be (the underlying map of) a +homomorphism as follows. + +\begin{code} + +𝒾𝒹 : (𝑨 : Algebra α) → hom 𝑨 𝑨 +𝒾𝒹 _ = id , λ 𝑓 𝑎 → refl + +\end{code} + +Next, the lifting of an algebra to a higher universe level is, in fact, a +homomorphism. Dually, the lowering of a lifted algebra to its original universe +level is a homomorphism. + +\begin{code} + +open Level + +𝓁𝒾𝒻𝓉 : {β : Level}(𝑨 : Algebra α) → hom 𝑨 (Lift-Alg 𝑨 β) +𝓁𝒾𝒻𝓉 _ = lift , λ 𝑓 𝑎 → refl + +𝓁ℴ𝓌ℯ𝓇 : {β : Level}(𝑨 : Algebra α) → hom (Lift-Alg 𝑨 β) 𝑨 +𝓁ℴ𝓌ℯ𝓇 _ = lower , λ 𝑓 𝑎 → refl +\end{code} + + +#### <a id="monomorphisms-and-epimorphisms">Monomorphisms and epimorphisms</a> + +A *monomorphism* is an injective homomorphism and an *epimorphism* is a surjective +homomorphism. These are represented in the [agda-algebras][] library by the following +types. + +\begin{code} + +is-monomorphism : (𝑨 : Algebra α)(𝑩 : Algebra β) → (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type _ +is-monomorphism 𝑨 𝑩 g = is-homomorphism 𝑨 𝑩 g × IsInjective g + +mon : Algebra α → Algebra β → Type(𝓞 ⊔ 𝓥 ⊔ α ⊔ β) +mon 𝑨 𝑩 = Σ[ g ∈ (∣ 𝑨 ∣ → ∣ 𝑩 ∣) ] is-monomorphism 𝑨 𝑩 g + +is-epimorphism : (𝑨 : Algebra α)(𝑩 : Algebra β) → (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type _ +is-epimorphism 𝑨 𝑩 g = is-homomorphism 𝑨 𝑩 g × IsSurjective g + +epi : Algebra α → Algebra β → Type(𝓞 ⊔ 𝓥 ⊔ α ⊔ β) +epi 𝑨 𝑩 = Σ[ g ∈ (∣ 𝑨 ∣ → ∣ 𝑩 ∣) ] is-epimorphism 𝑨 𝑩 g + +\end{code} + +It will be convenient to have a function that takes an inhabitant of `mon` (or +`epi`) and extracts the homomorphism part, or *hom reduct* (that is, the pair +consisting of the map and a proof that the map is a homomorphism). + +\begin{code} + +mon→hom : (𝑨 : Algebra α){𝑩 : Algebra β} → mon 𝑨 𝑩 → hom 𝑨 𝑩 +mon→hom 𝑨 ϕ = ∣ ϕ ∣ , fst ∥ ϕ ∥ + +epi→hom : {𝑨 : Algebra α}(𝑩 : Algebra β) → epi 𝑨 𝑩 → hom 𝑨 𝑩 +epi→hom _ ϕ = ∣ ϕ ∣ , fst ∥ ϕ ∥ +\end{code} + +--------------------------------- + +<span style="float:left;">[↑ Base.Homomorphisms](Base.Homomorphisms.html)</span> +<span style="float:right;">[Base.Homomorphisms.Properties →](Base.Homomorphisms.Properties.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Homomorphisms.Factor.html b/docs/Base.Homomorphisms.Factor.html new file mode 100644 index 0000000..c1d4b02 --- /dev/null +++ b/docs/Base.Homomorphisms.Factor.html @@ -0,0 +1,125 @@ + +
--- +layout: default +title : "Base.Homomorphisms.Factor module (The Agda Universal Algebra Library)" +date : "2021-09-20" +author: "agda-algebras development team" +--- + +### <a id="homomorphism-decomposition">Homomorphism decomposition</a> + +This is the [Base.Homomorphisms.Factor][] module of the [Agda Universal Algebra Library][] in which we prove the following theorem: + +If `τ : hom 𝑨 𝑩`, `ν : hom 𝑨 𝑪`, `ν` is surjective, and `ker ν ⊆ ker τ`, then there exists `φ : hom 𝑪 𝑩` such that `τ = φ ∘ ν` so the following diagram commutes: + +``` +𝑨 --- ν ->> 𝑪 + \ . + \ . + τ φ + \ . + \ . + V + 𝑩 +``` + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( 𝓞 ; 𝓥 ; Signature ) + +module Base.Homomorphisms.Factor {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library --------------------------------------- +open import Data.Product using ( Σ-syntax ; _,_ ) + renaming ( proj₁ to fst ; proj₂ to snd ) +open import Function using ( _∘_ ) +open import Level using ( Level ) +open import Relation.Unary using ( _⊆_ ) + +open import Relation.Binary.PropositionalEquality as ≡ + using ( module ≡-Reasoning ; _≡_ ) + +-- Imports from agda-algebras -------------------------------------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ; _⁻¹ ) +open import Base.Equality using ( swelldef ) +open import Base.Relations using ( kernel ) +open import Base.Functions using ( IsSurjective ; SurjInv ) + using ( SurjInvIsInverseʳ ; epic-factor ) + +open import Base.Algebras {𝑆 = 𝑆} using ( Algebra ; _̂_) +open import Base.Homomorphisms.Basic {𝑆 = 𝑆} using ( hom ; epi ) + +private variable α β γ : Level + +module _ {𝑨 : Algebra α}{𝑪 : Algebra γ} where + + open ≡-Reasoning + + HomFactor : swelldef 𝓥 γ + → (𝑩 : Algebra β)(τ : hom 𝑨 𝑩)(ν : hom 𝑨 𝑪) + → kernel ∣ ν ∣ ⊆ kernel ∣ τ ∣ → IsSurjective ∣ ν ∣ + ----------------------------------------------------- + → Σ[ φ ∈ (hom 𝑪 𝑩)] ∀ x → ∣ τ ∣ x ≡ ∣ φ ∣ (∣ ν ∣ x) + + HomFactor wd 𝑩 τ ν Kντ νE = (φ , φIsHomCB) , τφν + where + νInv : ∣ 𝑪 ∣ → ∣ 𝑨 ∣ + νInv = SurjInv ∣ ν ∣ νE + + η : ∀ c → ∣ ν ∣ (νInv c) ≡ c + η c = SurjInvIsInverseʳ ∣ ν ∣ νE c + + φ : ∣ 𝑪 ∣ → ∣ 𝑩 ∣ + φ = ∣ τ ∣ ∘ νInv + + ξ : ∀ a → kernel ∣ ν ∣ (a , νInv (∣ ν ∣ a)) + ξ a = (η (∣ ν ∣ a))⁻¹ + + τφν : ∀ x → ∣ τ ∣ x ≡ φ (∣ ν ∣ x) + τφν = λ x → Kντ (ξ x) + + φIsHomCB : ∀ 𝑓 c → φ ((𝑓 ̂ 𝑪) c) ≡ ((𝑓 ̂ 𝑩)(φ ∘ c)) + φIsHomCB 𝑓 c = + φ ((𝑓 ̂ 𝑪) c) ≡⟨ goal ⟩ + φ ((𝑓 ̂ 𝑪)(∣ ν ∣ ∘(νInv ∘ c))) ≡⟨ ≡.cong φ (∥ ν ∥ 𝑓 (νInv ∘ c))⁻¹ ⟩ + φ (∣ ν ∣((𝑓 ̂ 𝑨)(νInv ∘ c))) ≡⟨ (τφν ((𝑓 ̂ 𝑨)(νInv ∘ c)))⁻¹ ⟩ + ∣ τ ∣((𝑓 ̂ 𝑨)(νInv ∘ c)) ≡⟨ ∥ τ ∥ 𝑓 (νInv ∘ c) ⟩ + (𝑓 ̂ 𝑩)(λ x → ∣ τ ∣(νInv (c x))) ∎ + where + goal : φ ((𝑓 ̂ 𝑪) c) ≡ φ ((𝑓 ̂ 𝑪) (∣ ν ∣ ∘(νInv ∘ c))) + goal = ≡.cong φ (wd (𝑓 ̂ 𝑪) c (∣ ν ∣ ∘ (νInv ∘ c)) λ i → (η (c i))⁻¹) + +\end{code} + +If, in addition to the hypotheses of the last theorem, we assume `τ` is epic, then so is `φ`. + +\begin{code} + + HomFactorEpi : swelldef 𝓥 γ + → (𝑩 : Algebra β)(τ : hom 𝑨 𝑩)(ν : hom 𝑨 𝑪) + → kernel ∣ ν ∣ ⊆ kernel ∣ τ ∣ + → IsSurjective ∣ ν ∣ → IsSurjective ∣ τ ∣ + --------------------------------------------- + → Σ[ φ ∈ epi 𝑪 𝑩 ] ∀ x → ∣ τ ∣ x ≡ ∣ φ ∣ (∣ ν ∣ x) + + HomFactorEpi wd 𝑩 τ ν kerincl νe τe = (fst ∣ φF ∣ ,(snd ∣ φF ∣ , φE)), ∥ φF ∥ + where + φF : Σ[ φ ∈ hom 𝑪 𝑩 ] ∀ x → ∣ τ ∣ x ≡ ∣ φ ∣ (∣ ν ∣ x) + φF = HomFactor wd 𝑩 τ ν kerincl νe + + φ : ∣ 𝑪 ∣ → ∣ 𝑩 ∣ + φ = ∣ τ ∣ ∘ (SurjInv ∣ ν ∣ νe) + + φE : IsSurjective φ + φE = epic-factor ∣ τ ∣ ∣ ν ∣ φ ∥ φF ∥ τe +\end{code} + +-------------------------------------- + +<span style="float:left;">[← Base.Homomorphisms.Noether](Base.Homomorphisms.Noether.html)</span> +<span style="float:right;">[Base.Homomorphisms.Isomorphisms →](Base.Homomorphisms.Isomorphisms.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Homomorphisms.HomomorphicImages.html b/docs/Base.Homomorphisms.HomomorphicImages.html new file mode 100644 index 0000000..9a41eba --- /dev/null +++ b/docs/Base.Homomorphisms.HomomorphicImages.html @@ -0,0 +1,131 @@ + +
--- +layout: default +title : "Base.Homomorphisms.HomomorphicImages module (The Agda Universal Algebra Library)" +date : "2021-01-14" +author: "agda-algebras development team" +--- + +### <a id="homomorphic-images">Homomorphic Images</a> + +This is the [Base.Homomorphisms.HomomorphicImages][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( Signature ; 𝓞 ; 𝓥 ) + +module Base.Homomorphisms.HomomorphicImages {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library ------------------------------------------ +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; Σ-syntax ; Σ ; _×_ ) +open import Level using ( Level ; _⊔_ ; suc ) +open import Relation.Unary using ( Pred ; _∈_ ) +open import Relation.Binary.PropositionalEquality as ≡ + using ( _≡_ ; module ≡-Reasoning ) + +-- Imports from the Agda Universal Algebra Library ------------------------------------------ +open import Overture using ( 𝑖𝑑 ; ∣_∣ ; ∥_∥ ; lower∼lift ; lift∼lower ) +open import Base.Functions + using ( Image_∋_ ; Inv ; InvIsInverseʳ ; eq ; IsSurjective ) +open import Base.Algebras {𝑆 = 𝑆} + using ( Algebra ; Level-of-Carrier ; Lift-Alg ; ov ) + +open import Base.Homomorphisms.Basic {𝑆 = 𝑆} using ( hom ; 𝓁𝒾𝒻𝓉 ; 𝓁ℴ𝓌ℯ𝓇 ) +open import Base.Homomorphisms.Properties {𝑆 = 𝑆} using ( Lift-hom ) +\end{code} + + +#### <a id="images-of-a-single-algebra">Images of a single algebra</a> + +We begin with what seems, for our purposes, the most useful way to represent the class of *homomorphic images* of an algebra in dependent type theory. + +\begin{code} + +module _ {α β : Level } where + + _IsHomImageOf_ : (𝑩 : Algebra β)(𝑨 : Algebra α) → Type _ + 𝑩 IsHomImageOf 𝑨 = Σ[ φ ∈ hom 𝑨 𝑩 ] IsSurjective ∣ φ ∣ + + HomImages : Algebra α → Type(𝓞 ⊔ 𝓥 ⊔ α ⊔ suc β) + HomImages 𝑨 = Σ[ 𝑩 ∈ Algebra β ] 𝑩 IsHomImageOf 𝑨 + +\end{code} + +These types should be self-explanatory, but just to be sure, let's describe the Sigma type appearing in the second definition. Given an `𝑆`-algebra `𝑨 : Algebra α`, the type `HomImages 𝑨` denotes the class of algebras `𝑩 : Algebra β` with a map `φ : ∣ 𝑨 ∣ → ∣ 𝑩 ∣` such that `φ` is a surjective homomorphism. + + +#### <a id="images-of-a-class-of-algebras">Images of a class of algebras</a> + +Given a class `𝒦` of `𝑆`-algebras, we need a type that expresses the assertion that a given algebra is a homomorphic image of some algebra in the class, as well as a type that represents all such homomorphic images. + +\begin{code} + +module _ {α : Level} where + + IsHomImageOfClass : {𝒦 : Pred (Algebra α)(suc α)} → Algebra α → Type(ov α) + IsHomImageOfClass {𝒦 = 𝒦} 𝑩 = Σ[ 𝑨 ∈ Algebra α ] ((𝑨 ∈ 𝒦) × (𝑩 IsHomImageOf 𝑨)) + + HomImageOfClass : Pred (Algebra α) (suc α) → Type(ov α) + HomImageOfClass 𝒦 = Σ[ 𝑩 ∈ Algebra α ] IsHomImageOfClass{𝒦} 𝑩 +\end{code} + + +#### <a id="lifting-tools">Lifting tools</a> + +Here are some tools that have been useful (e.g., in the road to the proof of Birkhoff's HSP theorem). The first states and proves the simple fact that the lift of an epimorphism is an epimorphism. + +\begin{code} + +module _ {α β : Level} where + + open Level + open ≡-Reasoning + + Lift-epi-is-epi : {𝑨 : Algebra α}(ℓᵃ : Level){𝑩 : Algebra β}(ℓᵇ : Level)(h : hom 𝑨 𝑩) + → IsSurjective ∣ h ∣ → IsSurjective ∣ Lift-hom ℓᵃ {𝑩} ℓᵇ h ∣ + + Lift-epi-is-epi {𝑨 = 𝑨} ℓᵃ {𝑩} ℓᵇ h hepi y = eq (lift a) η + where + lh : hom (Lift-Alg 𝑨 ℓᵃ) (Lift-Alg 𝑩 ℓᵇ) + lh = Lift-hom ℓᵃ {𝑩} ℓᵇ h + + ζ : Image ∣ h ∣ ∋ (lower y) + ζ = hepi (lower y) + + a : ∣ 𝑨 ∣ + a = Inv ∣ h ∣ ζ + + ν : lift (∣ h ∣ a) ≡ ∣ Lift-hom ℓᵃ {𝑩} ℓᵇ h ∣ (Level.lift a) + ν = ≡.cong (λ - → lift (∣ h ∣ (- a))) (lower∼lift {Level-of-Carrier 𝑨}{β}) + + η : y ≡ ∣ lh ∣ (lift a) + η = y ≡⟨ (≡.cong-app lift∼lower) y ⟩ + lift (lower y) ≡⟨ ≡.cong lift (≡.sym (InvIsInverseʳ ζ)) ⟩ + lift (∣ h ∣ a) ≡⟨ ν ⟩ + ∣ lh ∣ (lift a) ∎ + + Lift-Alg-hom-image : {𝑨 : Algebra α}(ℓᵃ : Level){𝑩 : Algebra β}(ℓᵇ : Level) + → 𝑩 IsHomImageOf 𝑨 + → (Lift-Alg 𝑩 ℓᵇ) IsHomImageOf (Lift-Alg 𝑨 ℓᵃ) + + Lift-Alg-hom-image {𝑨 = 𝑨} ℓᵃ {𝑩} ℓᵇ ((φ , φhom) , φepic) = Goal + where + lφ : hom (Lift-Alg 𝑨 ℓᵃ) (Lift-Alg 𝑩 ℓᵇ) + lφ = Lift-hom ℓᵃ {𝑩} ℓᵇ (φ , φhom) + + lφepic : IsSurjective ∣ lφ ∣ + lφepic = Lift-epi-is-epi ℓᵃ {𝑩} ℓᵇ (φ , φhom) φepic + Goal : (Lift-Alg 𝑩 ℓᵇ) IsHomImageOf _ + Goal = lφ , lφepic +\end{code} + +-------------------------------------- + +<span style="float:left;">[← Base.Homomorphisms.Isomorphisms](Base.Homomorphisms.Isomorphisms.html)</span> +<span style="float:right;">[Base.Terms →](Base.Terms.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Homomorphisms.Isomorphisms.html b/docs/Base.Homomorphisms.Isomorphisms.html new file mode 100644 index 0000000..b5ff055 --- /dev/null +++ b/docs/Base.Homomorphisms.Isomorphisms.html @@ -0,0 +1,242 @@ + +
--- +layout: default +title : "Base.Homomorphisms.Isomoprhisms module (The Agda Universal Algebra Library)" +date : "2021-07-11" +author: "agda-algebras development team" +--- + +### <a id="isomorphisms">Isomorphisms</a> + +This is the [Base.Homomorphisms.Isomorphisms][] module of the [Agda Universal Algebra Library][]. +Here we formalize the informal notion of isomorphism between algebraic structures. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( Signature ; 𝓞 ; 𝓥 ) + +module Base.Homomorphisms.Isomorphisms {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library ----------------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; Σ-syntax ; _×_ ) +open import Function using ( _∘_ ) +open import Level using ( Level ; _⊔_ ) +open import Relation.Binary using ( Reflexive ; Sym ; Symmetric; Trans; Transitive ) + +open import Relation.Binary.PropositionalEquality as ≡ + using ( _≡_ ; module ≡-Reasoning ) + +open import Axiom.Extensionality.Propositional + using () renaming (Extensionality to funext ) + +-- Imports from the Agda Universal Algebra Library ----------------------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ; _≈_ ; _∙_ ; lower∼lift ; lift∼lower ) +open import Base.Functions using ( IsInjective ) + +open import Base.Algebras {𝑆 = 𝑆} using ( Algebra ; Lift-Alg ; ⨅ ) + +open import Base.Homomorphisms.Basic {𝑆 = 𝑆} + using ( hom ; 𝒾𝒹 ; 𝓁𝒾𝒻𝓉 ; 𝓁ℴ𝓌ℯ𝓇 ; is-homomorphism ) + +open import Base.Homomorphisms.Properties {𝑆 = 𝑆} using ( ∘-hom ) + +\end{code} + +#### <a id="definition-of-isomorphism">Definition of isomorphism</a> + +Recall, we use ``f ≈ g`` to denote the assertion that ``f`` and ``g`` are +*extensionally* (or point-wise) equal; i.e., ``∀ x, f x ≡ g x``. This notion +of equality of functions is used in the following definition of *isomorphism* +between two algebras, say, `𝑨` and `𝑩`. + +\begin{code} + +record _≅_ {α β : Level}(𝑨 : Algebra α)(𝑩 : Algebra β) : Type (𝓞 ⊔ 𝓥 ⊔ α ⊔ β) where + constructor mkiso + field + to : hom 𝑨 𝑩 + from : hom 𝑩 𝑨 + to∼from : ∣ to ∣ ∘ ∣ from ∣ ≈ ∣ 𝒾𝒹 𝑩 ∣ + from∼to : ∣ from ∣ ∘ ∣ to ∣ ≈ ∣ 𝒾𝒹 𝑨 ∣ + +open _≅_ public + +\end{code} + +That is, two structures are *isomorphic* provided there are homomorphisms going back and forth between them which compose to the identity map. + +We could define this using Sigma types, like this. + +```agda +_≅_ : {α β : Level}(𝑨 : Algebra α)(𝑩 : Algebra β) → Type(𝓞 ⊔ 𝓥 ⊔ α ⊔ β) +𝑨 ≅ 𝑩 = Σ[ f ∈ (hom 𝑨 𝑩)] Σ[ g ∈ hom 𝑩 𝑨 ] ((∣ f ∣ ∘ ∣ g ∣ ≈ ∣ 𝒾𝒹 𝑩 ∣) × (∣ g ∣ ∘ ∣ f ∣ ≈ ∣ 𝒾𝒹 𝑨 ∣)) +``` + +However, with four components, an equivalent record type is easier to work with. + +#### <a id="isomorphism-is-an-equivalence-relation">Isomorphism is an equivalence relation</a> + +\begin{code} + +private variable α β γ ι : Level + +≅-refl : Reflexive (_≅_ {α}) +≅-refl {α}{𝑨} = mkiso (𝒾𝒹 𝑨) (𝒾𝒹 𝑨) (λ _ → ≡.refl) λ _ → ≡.refl + +≅-sym : Sym (_≅_ {α}) (_≅_ {β}) +≅-sym φ = mkiso (from φ) (to φ) (from∼to φ) (to∼from φ) + +≅-trans : Trans (_≅_ {α})(_≅_ {β})(_≅_ {α}{γ}) +≅-trans {γ = γ}{𝑨}{𝑩}{𝑪} ab bc = mkiso f g τ ν + where + f : hom 𝑨 𝑪 + f = ∘-hom 𝑨 𝑪 (to ab) (to bc) + g : hom 𝑪 𝑨 + g = ∘-hom 𝑪 𝑨 (from bc) (from ab) + + τ : ∣ f ∣ ∘ ∣ g ∣ ≈ ∣ 𝒾𝒹 𝑪 ∣ + τ x = (≡.cong ∣ to bc ∣(to∼from ab (∣ from bc ∣ x)))∙(to∼from bc) x + + ν : ∣ g ∣ ∘ ∣ f ∣ ≈ ∣ 𝒾𝒹 𝑨 ∣ + ν x = (≡.cong ∣ from ab ∣(from∼to bc (∣ to ab ∣ x)))∙(from∼to ab) x + + +-- The "to" map of an isomorphism is injective. +≅toInjective : {α β : Level}{𝑨 : Algebra α}{𝑩 : Algebra β} + (φ : 𝑨 ≅ 𝑩) → IsInjective ∣ to φ ∣ + +≅toInjective (mkiso (f , _) (g , _) _ g∼f){a}{b} fafb = + a ≡⟨ ≡.sym (g∼f a) ⟩ + g (f a) ≡⟨ ≡.cong g fafb ⟩ + g (f b) ≡⟨ g∼f b ⟩ + b ∎ where open ≡-Reasoning + + +-- The "from" map of an isomorphism is injective. +≅fromInjective : {α β : Level}{𝑨 : Algebra α}{𝑩 : Algebra β} + (φ : 𝑨 ≅ 𝑩) → IsInjective ∣ from φ ∣ + +≅fromInjective φ = ≅toInjective (≅-sym φ) +\end{code} + + +#### <a id="lift-is-an-algebraic-invariant">Lift is an algebraic invariant</a> + +Fortunately, the lift operation preserves isomorphism (i.e., it's an *algebraic invariant*). As our focus is universal algebra, this is important and is what makes the lift operation a workable solution to the technical problems that arise from the noncumulativity of Agda's universe hierarchy. + +\begin{code} + +open Level + +Lift-≅ : {α β : Level}{𝑨 : Algebra α} → 𝑨 ≅ (Lift-Alg 𝑨 β) +Lift-≅{β = β}{𝑨 = 𝑨} = record { to = 𝓁𝒾𝒻𝓉 𝑨 + ; from = 𝓁ℴ𝓌ℯ𝓇 𝑨 + ; to∼from = ≡.cong-app lift∼lower + ; from∼to = ≡.cong-app (lower∼lift {β = β}) + } + +Lift-Alg-iso : {α β : Level}{𝑨 : Algebra α}{𝓧 : Level} + {𝑩 : Algebra β}{𝓨 : Level} + → 𝑨 ≅ 𝑩 → (Lift-Alg 𝑨 𝓧) ≅ (Lift-Alg 𝑩 𝓨) + +Lift-Alg-iso A≅B = ≅-trans (≅-trans (≅-sym Lift-≅) A≅B) Lift-≅ +\end{code} + + +#### <a id="lift-associativity">Lift associativity</a> + +The lift is also associative, up to isomorphism at least. + +\begin{code} + +Lift-Alg-assoc : (ℓ₁ ℓ₂ : Level) {𝑨 : Algebra α} + → Lift-Alg 𝑨 (ℓ₁ ⊔ ℓ₂) ≅ (Lift-Alg (Lift-Alg 𝑨 ℓ₁) ℓ₂) + +Lift-Alg-assoc ℓ₁ ℓ₂ {𝑨} = ≅-trans (≅-trans Goal Lift-≅) Lift-≅ + where + Goal : Lift-Alg 𝑨 (ℓ₁ ⊔ ℓ₂) ≅ 𝑨 + Goal = ≅-sym Lift-≅ +\end{code} + + +#### <a id="products-preserve-isomorphisms">Products preserve isomorphisms</a> + +Products of isomorphic families of algebras are themselves isomorphic. The proof looks a bit technical, but it is as straightforward as it ought to be. + +\begin{code} + +module _ {α β ι : Level}{I : Type ι}{fiu : funext ι α}{fiw : funext ι β} where + + ⨅≅ : {𝒜 : I → Algebra α}{ℬ : I → Algebra β} + → (∀ (i : I) → 𝒜 i ≅ ℬ i) → ⨅ 𝒜 ≅ ⨅ ℬ + + ⨅≅ {𝒜}{ℬ} AB = record { to = ϕ , ϕhom ; from = ψ , ψhom + ; to∼from = ϕ∼ψ ; from∼to = ψ∼ϕ + } + where + ϕ : ∣ ⨅ 𝒜 ∣ → ∣ ⨅ ℬ ∣ + ϕ a i = ∣ to (AB i) ∣ (a i) + + ϕhom : is-homomorphism (⨅ 𝒜) (⨅ ℬ) ϕ + ϕhom 𝑓 a = fiw (λ i → ∥ to (AB i) ∥ 𝑓 (λ x → a x i)) + + ψ : ∣ ⨅ ℬ ∣ → ∣ ⨅ 𝒜 ∣ + ψ b i = ∣ from (AB i) ∣ (b i) + + ψhom : is-homomorphism (⨅ ℬ) (⨅ 𝒜) ψ + ψhom 𝑓 𝒃 = fiu (λ i → ∥ from (AB i) ∥ 𝑓 (λ x → 𝒃 x i)) + + ϕ∼ψ : ϕ ∘ ψ ≈ ∣ 𝒾𝒹 (⨅ ℬ) ∣ + ϕ∼ψ 𝒃 = fiw λ i → to∼from (AB i) (𝒃 i) + + ψ∼ϕ : ψ ∘ ϕ ≈ ∣ 𝒾𝒹 (⨅ 𝒜) ∣ + ψ∼ϕ a = fiu λ i → from∼to (AB i)(a i) + +\end{code} + +A nearly identical proof goes through for isomorphisms of lifted products (though, just for fun, we use the universal quantifier syntax here to express the dependent function type in the statement of the lemma, instead of the Pi notation we used in the statement of the previous lemma; that is, `∀ i → 𝒜 i ≅ ℬ (lift i)` instead of `Π i ꞉ I , 𝒜 i ≅ ℬ (lift i)`.) + +\begin{code} + +module _ {α β γ ι : Level}{I : Type ι}{fizw : funext (ι ⊔ γ) β}{fiu : funext ι α} where + + Lift-Alg-⨅≅ : {𝒜 : I → Algebra α}{ℬ : (Lift γ I) → Algebra β} + → (∀ i → 𝒜 i ≅ ℬ (lift i)) → Lift-Alg (⨅ 𝒜) γ ≅ ⨅ ℬ + + Lift-Alg-⨅≅ {𝒜}{ℬ} AB = Goal + where + ϕ : ∣ ⨅ 𝒜 ∣ → ∣ ⨅ ℬ ∣ + ϕ a i = ∣ to (AB (lower i)) ∣ (a (lower i)) + + ϕhom : is-homomorphism (⨅ 𝒜) (⨅ ℬ) ϕ + ϕhom 𝑓 a = fizw (λ i → (∥ to (AB (lower i)) ∥) 𝑓 (λ x → a x (lower i))) + + ψ : ∣ ⨅ ℬ ∣ → ∣ ⨅ 𝒜 ∣ + ψ b i = ∣ from (AB i) ∣ (b (lift i)) + + ψhom : is-homomorphism (⨅ ℬ) (⨅ 𝒜) ψ + ψhom 𝑓 𝒃 = fiu (λ i → ∥ from (AB i) ∥ 𝑓 (λ x → 𝒃 x (lift i))) + + ϕ∼ψ : ϕ ∘ ψ ≈ ∣ 𝒾𝒹 (⨅ ℬ) ∣ + ϕ∼ψ 𝒃 = fizw λ i → to∼from (AB (lower i)) (𝒃 i) + + ψ∼ϕ : ψ ∘ ϕ ≈ ∣ 𝒾𝒹 (⨅ 𝒜) ∣ + ψ∼ϕ a = fiu λ i → from∼to (AB i) (a i) + + A≅B : ⨅ 𝒜 ≅ ⨅ ℬ + A≅B = record { to = ϕ , ϕhom ; from = ψ , ψhom ; to∼from = ϕ∼ψ ; from∼to = ψ∼ϕ } + + Goal : Lift-Alg (⨅ 𝒜) γ ≅ ⨅ ℬ + Goal = ≅-trans (≅-sym Lift-≅) A≅B +\end{code} + +-------------------------------------- + +<span style="float:left;">[← Base.Homomorphisms.Factor](Base.Homomorphisms.Factor.html)</span> +<span style="float:right;">[Base.Homomorphisms.HomomorphicImages →](Base.Homomorphisms.HomomorphicImages.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Homomorphisms.Kernels.html b/docs/Base.Homomorphisms.Kernels.html new file mode 100644 index 0000000..5d399a6 --- /dev/null +++ b/docs/Base.Homomorphisms.Kernels.html @@ -0,0 +1,161 @@ + +
--- +layout: default +title : "Base.Homomorphisms.Kernels module (The Agda Universal Algebra Library)" +date : "2021-09-08" +author: "agda-algebras development team" +--- + +### <a id="kernels-of-homomorphisms">Kernels of Homomorphisms</a> + +This is the [Base.Homomorphisms.Kernels] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( Signature; 𝓞 ; 𝓥 ) + +module Base.Homomorphisms.Kernels {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library -------------------------------- +open import Data.Product using ( _,_ ) +open import Function.Base using ( _∘_ ) +open import Level using ( Level ; _⊔_ ; suc ) + +open import Relation.Binary.PropositionalEquality + using ( _≡_ ; module ≡-Reasoning ; refl ) + +-- Imports from the Agda Universal Algebras Library -------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ; _⁻¹ ) +open import Base.Functions using ( Image_∋_ ; IsSurjective ) +open import Base.Equality using ( swelldef ) +open import Base.Relations using ( ker ; ker-IsEquivalence ; ⟪_⟫ ; mkblk ) + +open import Base.Algebras {𝑆 = 𝑆} + using ( Algebra ; compatible ; _̂_ ; Con ; mkcon ; _╱_ ; IsCongruence ; /-≡ ) + +open import Base.Homomorphisms.Basic {𝑆 = 𝑆} using ( hom ; epi ; epi→hom ) + +private variable α β : Level +\end{code} + + +#### <a id="definition">Definition</a> + +The kernel of a homomorphism is a congruence relation and conversely for every +congruence relation θ, there exists a homomorphism with kernel θ (namely, that +canonical projection onto the quotient modulo θ). + +\begin{code} + +module _ {𝑨 : Algebra α} where + open ≡-Reasoning + homker-comp : swelldef 𝓥 β → {𝑩 : Algebra β}(h : hom 𝑨 𝑩) + → compatible 𝑨 (ker ∣ h ∣) + + homker-comp wd {𝑩} h f {u}{v} kuv = + ∣ h ∣((f ̂ 𝑨) u) ≡⟨ ∥ h ∥ f u ⟩ + (f ̂ 𝑩)(∣ h ∣ ∘ u) ≡⟨ wd(f ̂ 𝑩)(∣ h ∣ ∘ u)(∣ h ∣ ∘ v)kuv ⟩ + (f ̂ 𝑩)(∣ h ∣ ∘ v) ≡⟨ (∥ h ∥ f v)⁻¹ ⟩ + ∣ h ∣((f ̂ 𝑨) v) ∎ + +\end{code} + +(Notice, it is here that the `swelldef` postulate comes into play, and because it +is needed to prove `homker-comp`, it is postulated by all the lemmas below that +depend upon `homker-comp`.) + +It is convenient to define a function that takes a homomorphism and constructs a +congruence from its kernel. We call this function `kercon`. + +\begin{code} + + kercon : swelldef 𝓥 β → {𝑩 : Algebra β} → hom 𝑨 𝑩 → Con{α}{β} 𝑨 + kercon wd {𝑩} h = ker ∣ h ∣ , mkcon (ker-IsEquivalence ∣ h ∣)(homker-comp wd {𝑩} h) + +\end{code} + +With this congruence we construct the corresponding quotient, along with some +syntactic sugar to denote it. + +\begin{code} + + kerquo : swelldef 𝓥 β → {𝑩 : Algebra β} → hom 𝑨 𝑩 → Algebra (α ⊔ suc β) + kerquo wd {𝑩} h = 𝑨 ╱ (kercon wd {𝑩} h) + +ker[_⇒_]_↾_ : (𝑨 : Algebra α)(𝑩 : Algebra β) → hom 𝑨 𝑩 → swelldef 𝓥 β + → Algebra (α ⊔ suc β) + +ker[ 𝑨 ⇒ 𝑩 ] h ↾ wd = kerquo wd {𝑩} h + +\end{code} + +Thus, given `h : hom 𝑨 𝑩`, we can construct the quotient of `𝑨` modulo the kernel +of `h`, and the syntax for this quotient in the +[agda-algebras](https://github.com/ualib/agda-algebras) library is +`𝑨 [ 𝑩 ]/ker h ↾ fe`. + +#### <a id="the-canonical-projection">The canonical projection</a> + +Given an algebra `𝑨` and a congruence `θ`, the *canonical projection* is a map +from `𝑨` onto `𝑨 ╱ θ` that is constructed, and proved epimorphic, as follows. + +\begin{code} + +module _ {α β : Level}{𝑨 : Algebra α} where + πepi : (θ : Con{α}{β} 𝑨) → epi 𝑨 (𝑨 ╱ θ) + πepi θ = (λ a → ⟪ a ⟫) , (λ _ _ → refl) , cπ-is-epic where + cπ-is-epic : IsSurjective (λ a → ⟪ a ⟫) + cπ-is-epic (C , mkblk a refl ) = Image_∋_.eq a refl + +\end{code} + +In may happen that we don't care about the surjectivity of `πepi`, in which case +would might prefer to work with the *homomorphic reduct* of `πepi`. This is +obtained by applying `epi-to-hom`, like so. + +\begin{code} + + πhom : (θ : Con{α}{β} 𝑨) → hom 𝑨 (𝑨 ╱ θ) + πhom θ = epi→hom (𝑨 ╱ θ) (πepi θ) + +\end{code} + +We combine the foregoing to define a function that takes 𝑆-algebras `𝑨` and `𝑩`, +and a homomorphism `h : hom 𝑨 𝑩` and returns the canonical epimorphism from `𝑨` +onto `𝑨 [ 𝑩 ]/ker h`. (Recall, the latter is the special notation we defined above +for the quotient of `𝑨` modulo the kernel of `h`.) + +\begin{code} + + πker : (wd : swelldef 𝓥 β){𝑩 : Algebra β}(h : hom 𝑨 𝑩) + → epi 𝑨 (ker[ 𝑨 ⇒ 𝑩 ] h ↾ wd) + + πker wd {𝑩} h = πepi (kercon wd {𝑩} h) + +\end{code} + +The kernel of the canonical projection of `𝑨` onto `𝑨 / θ` is equal to `θ`, but +since equality of inhabitants of certain types (like `Congruence` or `Rel`) can be +a tricky business, we settle for proving the containment `𝑨 / θ ⊆ θ`. Of the two +containments, this is the easier one to prove; luckily it is also the one we need +later. + +\begin{code} + + open IsCongruence + + ker-in-con : {wd : swelldef 𝓥 (α ⊔ suc β)}(θ : Con 𝑨) + → ∀ {x}{y} → ∣ kercon wd {𝑨 ╱ θ} (πhom θ) ∣ x y → ∣ θ ∣ x y + + ker-in-con θ hyp = /-≡ θ hyp +\end{code} + +--------------------------------- + +<span style="float:left;">[← Base.Homomorphisms.Properties](Base.Homomorphisms.Properties.html)</span> +<span style="float:right;">[Base.Homomorphisms.Products →](Base.Homomorphisms.Products.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Homomorphisms.Noether.html b/docs/Base.Homomorphisms.Noether.html new file mode 100644 index 0000000..5914860 --- /dev/null +++ b/docs/Base.Homomorphisms.Noether.html @@ -0,0 +1,213 @@ + +
--- +layout: default +title : "Base.Homomorphisms.Noether module (The Agda Universal Algebra Library)" +date : "2021-01-13" +author: "agda-algebras development team" +--- + +### <a id="homomorphism-theorems">Homomorphism Theorems</a> + +This is the [Base.Homomorphisms.Noether][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( 𝓞 ; 𝓥 ; Signature ) + +module Base.Homomorphisms.Noether {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library --------------------------------------- +open import Data.Product using ( Σ-syntax ; _,_ ; _×_ ) + renaming ( proj₁ to fst ; proj₂ to snd ) +open import Function using ( _∘_ ; id ) +open import Level using (Level ) +open import Relation.Binary using ( IsEquivalence ) + +open import Relation.Binary.PropositionalEquality as ≡ + using ( module ≡-Reasoning ; _≡_ ) + +-- Imports from agda-algebras -------------------------------------------------------------- +open import Base.Relations using ( ⌞_⌟ ; mkblk ; ⟪_⟫ ) +open import Overture using ( ∣_∣ ; ∥_∥ ; _⁻¹ ) +open import Base.Functions using ( Image_∋_ ; IsInjective ; SurjInv ) + using ( IsSurjective ; SurjInvIsInverseʳ ) + +open import Base.Algebras {𝑆 = 𝑆} using ( Algebra ; _̂_ ; Con ; IsCongruence ) + +open import Base.Homomorphisms.Kernels {𝑆 = 𝑆} + using ( kercon ; ker[_⇒_]_↾_ ; πker ) + +open import Base.Equality + using ( swelldef ; is-set ; blk-uip ; is-embedding ; monic-is-embedding|Set ) + using ( pred-ext ; block-ext|uip ) + +open import Base.Homomorphisms.Basic {𝑆 = 𝑆} + using ( hom ; is-homomorphism ; epi ; epi→hom ) + +private variable α β γ : Level +\end{code} + + +#### <a id="the-first-homomorphism-theorem">The First Homomorphism Theorem</a> + +Here we formalize a version of the *first homomorphism theorem*, sometimes called +*Noether's first homomorphism theorem*, after Emmy Noether who was among the first +proponents of the abstract approach to the subject that we now call "modern algebra"). + +Informally, the theorem states that every homomorphism from `𝑨` to `𝑩` (`𝑆`-algebras) +factors through the quotient algebra `𝑨 ╱ ker h` (`𝑨` modulo the kernel of the given +homomorphism). In other terms, given `h : hom 𝑨 𝑩` there exists `φ : hom (𝑨 ╱ ker h) 𝑩` +which, when composed with the canonical projection `πker : 𝑨 ↠ 𝑨 ╱ ker h`, is equal to +`h`; that is, `h = φ ∘ πker`. Moreover, `φ` is a *monomorphism* (injective homomorphism) +and is unique. + +Our formal proof of this theorem will require function extensionality, proposition +extensionality, and a couple of truncation assumptions. The extensionality +assumptions are postulated using `swelldef` and `pred-ext` which were defined +in [Base.Equality.Welldefined][] and [Base.Equality.Extensionality][]. As for +truncation, to prove that `φ` is injective we require + ++ `buip`: *uniqueness of (block) identity proofs*; given two blocks of the kernel + there is at most one proof that the blocks are equal; + +To prove that `φ` is an embedding we require + ++ `Bset`: *uniqueness of identity proofs* in the codomain; that is, the codomain + `∣ 𝑩 ∣` is assumed to be a *set*. + +Note that the classical, informal statement of the first homomorphism theorem does not +demand that `φ` be an embedding (in our sense of having subsingleton fibers), and if +we left this out of the consequent of our formal theorem statement, then we could omit +from the antecedent the assumption that `∣ 𝑩 ∣` is a set. + +Without further ado, we present our formalization of the first homomorphism theorem. + +\begin{code} + +open ≡-Reasoning + +FirstHomTheorem|Set : (𝑨 : Algebra α)(𝑩 : Algebra β)(h : hom 𝑨 𝑩) + {- extensionality assumptions -} (pe : pred-ext α β)(fe : swelldef 𝓥 β) + {- truncation assumptions -} (Bset : is-set ∣ 𝑩 ∣) + (buip : blk-uip ∣ 𝑨 ∣ ∣ kercon fe {𝑩} h ∣) + ------------------------------------------------------------------------- + → Σ[ φ ∈ hom (ker[ 𝑨 ⇒ 𝑩 ] h ↾ fe) 𝑩 ] + ( ∣ h ∣ ≡ ∣ φ ∣ ∘ ∣ πker fe{𝑩}h ∣ × IsInjective ∣ φ ∣ × is-embedding ∣ φ ∣ ) + +FirstHomTheorem|Set 𝑨 𝑩 h pe fe Bset buip = (φ , φhom) , ≡.refl , φmon , φemb + where + θ : Con 𝑨 + θ = kercon fe{𝑩} h + ξ : IsEquivalence ∣ θ ∣ + ξ = IsCongruence.is-equivalence ∥ θ ∥ + + φ : ∣ (ker[ 𝑨 ⇒ 𝑩 ] h ↾ fe) ∣ → ∣ 𝑩 ∣ + φ a = ∣ h ∣ ⌞ a ⌟ + + φhom : is-homomorphism (ker[ 𝑨 ⇒ 𝑩 ] h ↾ fe) 𝑩 φ + φhom 𝑓 a = ∣ h ∣ ( (𝑓 ̂ 𝑨) (λ x → ⌞ a x ⌟) ) ≡⟨ ∥ h ∥ 𝑓 (λ x → ⌞ a x ⌟) ⟩ + (𝑓 ̂ 𝑩) (∣ h ∣ ∘ (λ x → ⌞ a x ⌟)) ≡⟨ ≡.cong (𝑓 ̂ 𝑩) ≡.refl ⟩ + (𝑓 ̂ 𝑩) (λ x → φ (a x)) ∎ + + φmon : IsInjective φ + φmon {_ , mkblk u ≡.refl} {_ , mkblk v ≡.refl} φuv = block-ext|uip pe buip ξ φuv + + φemb : is-embedding φ + φemb = monic-is-embedding|Set φ Bset φmon + +\end{code} + +Below we will prove that the homomorphism `φ`, whose existence we just proved, is +unique (see `NoetherHomUnique`), but first we show that if we add to the hypotheses +of the first homomorphism theorem the assumption that `h` is surjective, then we +obtain the so-called *first isomorphism theorem*. Naturally, we let +`FirstHomTheorem|Set` do most of the work. + +\begin{code} + +FirstIsoTheorem|Set : (𝑨 : Algebra α) (𝑩 : Algebra β) (h : hom 𝑨 𝑩) + {- extensionality assumptions -} (pe : pred-ext α β) (fe : swelldef 𝓥 β) + {- truncation assumptions -} (Bset : is-set ∣ 𝑩 ∣) + (buip : blk-uip ∣ 𝑨 ∣ ∣ kercon fe{𝑩}h ∣) + → IsSurjective ∣ h ∣ + → Σ[ f ∈ (epi (ker[ 𝑨 ⇒ 𝑩 ] h ↾ fe) 𝑩)] + ( ∣ h ∣ ≡ ∣ f ∣ ∘ ∣ πker fe{𝑩}h ∣ + × IsInjective ∣ f ∣ × is-embedding ∣ f ∣ ) + +FirstIsoTheorem|Set 𝑨 𝑩 h pe fe Bset buip hE = + (fmap , fhom , fepic) , ≡.refl , (snd ∥ FHT ∥) + where + FHT = FirstHomTheorem|Set 𝑨 𝑩 h pe fe Bset buip + + fmap : ∣ ker[ 𝑨 ⇒ 𝑩 ] h ↾ fe ∣ → ∣ 𝑩 ∣ + fmap = fst ∣ FHT ∣ + + fhom : is-homomorphism (ker[ 𝑨 ⇒ 𝑩 ] h ↾ fe) 𝑩 fmap + fhom = snd ∣ FHT ∣ + + fepic : IsSurjective fmap + fepic b = Goal where + a : ∣ 𝑨 ∣ + a = SurjInv ∣ h ∣ hE b + + bfa : b ≡ fmap ⟪ a ⟫ + bfa = ((SurjInvIsInverseʳ ∣ h ∣ hE) b)⁻¹ + + Goal : Image fmap ∋ b + Goal = Image_∋_.eq ⟪ a ⟫ bfa + +\end{code} + +Now we prove that the homomorphism `φ`, whose existence is guaranteed by `FirstHomTheorem|Set`, is unique. + +\begin{code} + +module _ {fe : swelldef 𝓥 β}(𝑨 : Algebra α)(𝑩 : Algebra β)(h : hom 𝑨 𝑩) where + + FirstHomUnique : (f g : hom (ker[ 𝑨 ⇒ 𝑩 ] h ↾ fe) 𝑩) + → ∣ h ∣ ≡ ∣ f ∣ ∘ ∣ πker fe{𝑩}h ∣ + → ∣ h ∣ ≡ ∣ g ∣ ∘ ∣ πker fe{𝑩}h ∣ + → ∀ a → ∣ f ∣ a ≡ ∣ g ∣ a + + FirstHomUnique f g hfk hgk (_ , mkblk a ≡.refl) = + ∣ f ∣ (_ , mkblk a ≡.refl) ≡⟨ ≡.cong-app(hfk ⁻¹)a ⟩ + ∣ h ∣ a ≡⟨ ≡.cong-app(hgk)a ⟩ + ∣ g ∣ (_ , mkblk a ≡.refl) ∎ + +\end{code} + +If, in addition, we postulate extensionality of functions defined on the domain +`ker[ 𝑨 ⇒ 𝑩 ] h`, then we obtain the following variation of the last result. +(See [Base.Equality.Truncation][] for a discussion of *truncation*, *sets*, +and *uniqueness of identity proofs*.) + +``` +fe-FirstHomUnique : {fuww : funext (α ⊔ lsuc β) β}(f g : hom (ker[ 𝑨 ⇒ 𝑩 ] h ↾ fe) 𝑩) + → ∣ h ∣ ≡ ∣ f ∣ ∘ ∣ πker fe{𝑩}h ∣ + → ∣ h ∣ ≡ ∣ g ∣ ∘ ∣ πker fe{𝑩}h ∣ + → ∣ f ∣ ≡ ∣ g ∣ + + fe-FirstHomUnique {fuww} f g hfk hgk = fuww (NoetherHomUnique f g hfk hgk) +``` + +The proof of `NoetherHomUnique` goes through for the special case of epimorphisms, as we now verify. + +\begin{code} + + FirstIsoUnique : (f g : epi (ker[ 𝑨 ⇒ 𝑩 ] h ↾ fe) 𝑩) + → ∣ h ∣ ≡ ∣ f ∣ ∘ ∣ πker fe{𝑩}h ∣ + → ∣ h ∣ ≡ ∣ g ∣ ∘ ∣ πker fe{𝑩}h ∣ + → ∀ a → ∣ f ∣ a ≡ ∣ g ∣ a + + FirstIsoUnique f g hfk hgk = FirstHomUnique (epi→hom 𝑩 f) (epi→hom 𝑩 g) hfk hgk +\end{code} + +-------------------------------------- + +<span style="float:left;">[← Base.Homomorphisms.Products](Base.Homomorphisms.Products.html)</span> +<span style="float:right;">[Base.Homomorphisms.Factor →](Base.Homomorphisms.Factor.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Homomorphisms.Products.html b/docs/Base.Homomorphisms.Products.html new file mode 100644 index 0000000..aa85de7 --- /dev/null +++ b/docs/Base.Homomorphisms.Products.html @@ -0,0 +1,92 @@ + +
--- +layout: default +title : "Base.Homomorphisms.Products module (The Agda Universal Algebra Library)" +date : "2021-09-08" +author: "agda-algebras development team" +--- + +### <a id="products-of-homomorphisms">Products of Homomorphisms</a> + +This is the [Base.Homomorphisms.Products] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using (Signature ; 𝓞 ; 𝓥 ) + +module Base.Homomorphisms.Products {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library ----------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ) +open import Level using ( Level ; _⊔_ ; suc ) + +open import Relation.Binary.PropositionalEquality using ( refl ) + +open import Axiom.Extensionality.Propositional renaming (Extensionality to funext) + using () + +-- Imports from the Agda Universal Algebras Library ---------------------- +open import Overture using ( ∣_∣ ; ∥_∥) + +open import Base.Algebras {𝑆 = 𝑆} using ( Algebra ; ⨅ ) +open import Base.Homomorphisms.Basic {𝑆 = 𝑆} using ( hom ; epi ) + +private variable 𝓘 β : Level + +\end{code} + +Suppose we have an algebra `𝑨`, a type `I : Type 𝓘`, and a family `ℬ : I → Algebra β` of algebras. We sometimes refer to the inhabitants of `I` as *indices*, and call `ℬ` an *indexed family of algebras*. + +If in addition we have a family `𝒽 : (i : I) → hom 𝑨 (ℬ i)` of homomorphisms, then we can construct a homomorphism from `𝑨` to the product `⨅ ℬ` in the natural way. + +\begin{code} + +module _ {I : Type 𝓘}(ℬ : I → Algebra β) where + + ⨅-hom-co : funext 𝓘 β → {α : Level}(𝑨 : Algebra α) + → (∀(i : I) → hom 𝑨 (ℬ i)) → hom 𝑨 (⨅ ℬ) + + ⨅-hom-co fe 𝑨 𝒽 = (λ a i → ∣ 𝒽 i ∣ a) , λ 𝑓 𝒶 → fe λ i → ∥ 𝒽 i ∥ 𝑓 𝒶 + +\end{code} + +The foregoing generalizes easily to the case in which the domain is also a product +of a family of algebras. That is, if we are given `𝒜 : I → Algebra α` and +`ℬ : I → Algebra β` (two families of `𝑆`-algebras), and +`𝒽 : Π i ꞉ I , hom (𝒜 i)(ℬ i)` (a family of homomorphisms), then we can +construct a homomorphism from `⨅ 𝒜` to `⨅ ℬ` in the following natural way. + +\begin{code} + + ⨅-hom : funext 𝓘 β → {α : Level}(𝒜 : I → Algebra α) + → (∀(i : I) → hom (𝒜 i) (ℬ i)) → hom (⨅ 𝒜)(⨅ ℬ) + + ⨅-hom fe 𝒜 𝒽 = (λ x i → ∣ 𝒽 i ∣ (x i)) , λ 𝑓 𝒶 → fe λ i → ∥ 𝒽 i ∥ 𝑓 λ x → 𝒶 x i +\end{code} + + +#### <a id="projections-out-of-products">Projection out of products</a> + +Later we will need a proof of the fact that projecting out of a product algebra +onto one of its factors is a homomorphism. + +\begin{code} + + ⨅-projection-hom : (i : I) → hom (⨅ ℬ) (ℬ i) + ⨅-projection-hom = λ x → (λ z → z x) , λ _ _ → refl + +\end{code} + +We could prove a more general result involving projections onto multiple factors, +but so far the single-factor result has sufficed. + +--------------------------------- + +<span style="float:left;">[← Base.Homomorphisms.Kernels](Base.Homomorphisms.Kernels.html)</span> +<span style="float:right;">[Base.Homomorphisms.Noether →](Base.Homomorphisms.Noether.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Homomorphisms.Properties.html b/docs/Base.Homomorphisms.Properties.html new file mode 100644 index 0000000..50a8042 --- /dev/null +++ b/docs/Base.Homomorphisms.Properties.html @@ -0,0 +1,97 @@ + +
--- +layout: default +title : "Base.Homomorphisms.Properties module (The Agda Universal Algebra Library)" +date : "2021-09-08" +author: "agda-algebras development team" +--- + +### <a id="properties-of-homomorphisms">Properties of Homomorphisms</a> + +This is the [Base.Homomorphisms.Properties][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using (Signature ; 𝓞 ; 𝓥 ) + +module Base.Homomorphisms.Properties {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library -------------------------------- +open import Data.Product using ( _,_ ) +open import Function using ( _∘_ ) +open import Level using ( Level ) + +open import Relation.Binary.PropositionalEquality as ≡ + using ( _≡_ ; module ≡-Reasoning ) + +-- Imports from the Agda Universal Algebras Library -------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ) +open import Base.Algebras {𝑆 = 𝑆} using ( Algebra ; _̂_ ; Lift-Alg ) +open import Base.Homomorphisms.Basic {𝑆 = 𝑆} using ( hom ; is-homomorphism ) + +private variable α β γ ρ : Level +\end{code} + + +#### <a id="homomorphism-composition">Homomorphism composition</a> + +The composition of homomorphisms is again a homomorphism. We formalize this in a +number of alternative ways. + +\begin{code} + +open ≡-Reasoning + +module _ (𝑨 : Algebra α){𝑩 : Algebra β}(𝑪 : Algebra γ) where + + ∘-hom : hom 𝑨 𝑩 → hom 𝑩 𝑪 → hom 𝑨 𝑪 + ∘-hom (g , ghom) (h , hhom) = h ∘ g , Goal where + + Goal : ∀ 𝑓 a → (h ∘ g)((𝑓 ̂ 𝑨) a) ≡ (𝑓 ̂ 𝑪)(h ∘ g ∘ a) + Goal 𝑓 a = (h ∘ g)((𝑓 ̂ 𝑨) a) ≡⟨ ≡.cong h ( ghom 𝑓 a ) ⟩ + h ((𝑓 ̂ 𝑩)(g ∘ a)) ≡⟨ hhom 𝑓 ( g ∘ a ) ⟩ + (𝑓 ̂ 𝑪)(h ∘ g ∘ a) ∎ + + ∘-is-hom : {f : ∣ 𝑨 ∣ → ∣ 𝑩 ∣}{g : ∣ 𝑩 ∣ → ∣ 𝑪 ∣} + → is-homomorphism 𝑨 𝑩 f → is-homomorphism 𝑩 𝑪 g + → is-homomorphism 𝑨 𝑪 (g ∘ f) + + ∘-is-hom {f} {g} fhom ghom = ∥ ∘-hom (f , fhom) (g , ghom) ∥ + +\end{code} + +A homomorphism from `𝑨` to `𝑩` can be lifted to a homomorphism from +`Lift-Alg 𝑨 ℓᵃ` to `Lift-Alg 𝑩 ℓᵇ`. + +\begin{code} + +open Level + +Lift-hom : {𝑨 : Algebra α}(ℓᵃ : Level){𝑩 : Algebra β} (ℓᵇ : Level) + → hom 𝑨 𝑩 → hom (Lift-Alg 𝑨 ℓᵃ) (Lift-Alg 𝑩 ℓᵇ) + +Lift-hom {𝑨 = 𝑨} ℓᵃ {𝑩} ℓᵇ (f , fhom) = lift ∘ f ∘ lower , Goal + where + lABh : is-homomorphism (Lift-Alg 𝑨 ℓᵃ) 𝑩 (f ∘ lower) + lABh = ∘-is-hom (Lift-Alg 𝑨 ℓᵃ) 𝑩 {lower}{f} (λ _ _ → ≡.refl) fhom + + Goal : is-homomorphism(Lift-Alg 𝑨 ℓᵃ)(Lift-Alg 𝑩 ℓᵇ) (lift ∘ (f ∘ lower)) + Goal = ∘-is-hom (Lift-Alg 𝑨 ℓᵃ) (Lift-Alg 𝑩 ℓᵇ) + {f ∘ lower}{lift} lABh λ _ _ → ≡.refl + +\end{code} + +We should probably point out that while the lifting and lowering homomorphisms +are important for our formal treatment of algebras in type theory, they never +arise---in fact, they are not even definable---in classical universal algebra +based on set theory. + +--------------------------------- + +<span style="float:left;">[← Base.Homomorphisms.Basic](Base.Homomorphisms.Basic.html)</span> +<span style="float:right;">[Base.Homomorphisms.Kernels →](Base.Homomorphisms.Kernels.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Homomorphisms.html b/docs/Base.Homomorphisms.html new file mode 100644 index 0000000..9d536d3 --- /dev/null +++ b/docs/Base.Homomorphisms.html @@ -0,0 +1,37 @@ + +
--- +layout: default +title : "Base.Homomorphisms module (The Agda Universal Algebra Library)" +date : "2021-01-12" +author: "agda-algebras development team" +--- + +## <a id="homomorphism-types">Homomorphism Types</a> + +This chapter presents the [Base.Homomorphisms][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using (Signature ; 𝓞 ; 𝓥 ) + +module Base.Homomorphisms {𝑆 : Signature 𝓞 𝓥} where + +open import Base.Homomorphisms.Basic {𝑆 = 𝑆} public +open import Base.Homomorphisms.Properties {𝑆 = 𝑆} public +open import Base.Homomorphisms.Kernels {𝑆 = 𝑆} public +open import Base.Homomorphisms.Products {𝑆 = 𝑆} public +open import Base.Homomorphisms.Noether {𝑆 = 𝑆} public +open import Base.Homomorphisms.Factor {𝑆 = 𝑆} public +open import Base.Homomorphisms.Isomorphisms {𝑆 = 𝑆} public +open import Base.Homomorphisms.HomomorphicImages {𝑆 = 𝑆} public +\end{code} + +-------------------------------------- + +<span style="float:left;">[← Base.Algebras.Congruences](Base.Algebras.Congruences.html)</span> +<span style="float:right;">[Base.Homomorphisms.Basic →](Base.Homomorphisms.Basic.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Relations.Continuous.html b/docs/Base.Relations.Continuous.html new file mode 100644 index 0000000..5b47f87 --- /dev/null +++ b/docs/Base.Relations.Continuous.html @@ -0,0 +1,189 @@ + +
--- +layout: default +title : "Base.Relations.Continuous module (The Agda Universal Algebra Library)" +date : "2021-02-28" +author: "[agda-algebras development team][]" +--- + +### <a id="continuous-relations">Continuous Relations</a> + +This is the [Base.Relations.Continuous][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Relations.Continuous where + +-- Imports from Agda and the Agda Standard Library ------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Level using ( _⊔_ ; suc ; Level ) + +-- Imports from agda-algebras ---------------------------------------------------- +open import Overture using ( Π ; Π-syntax ; Op ; arity[_] ) + +private variable α ρ : Level + +\end{code} + +#### <a id="motivation">Motivation</a> + +In set theory, an n-ary relation on a set `A` is simply a subset of the n-fold product `A × A × ⋯ × A`. As such, we could model these as predicates over the type `A × A × ⋯ × A`, or as relations of type `A → A → ⋯ → A → Type β` (for some universe β). + +To implement such a relation in type theory, we would need to know the arity in advance, and then somehow form an n-fold arrow →. + +It's easier and more general to instead define an arity type `I : Type 𝓥`, and define the type representing `I`-ary relations on `A` as the function type `(I → A) → Type β`. + +Then, if we are specifically interested in an n-ary relation for some natural number `n`, we could take `I` to be a finite set (e.g., of type `Fin n`). + +Below we define `Rel` to be the type `(I → A) → Type β` and we call this the type of *continuous relations*. This generalizes "discrete" relations (i.e., relations of finite arity---unary, binary, etc), defined in the standard library since inhabitants of the continuous relation type can have arbitrary arity. + +The relations of type `Rel` not completely general, however, since they are defined over a single type. Said another way, they are *single-sorted* relations. We will remove this limitation when we define the type of *dependent continuous relations* later in the module. + +Just as `Rel A β` is the single-sorted special case of the multisorted `REL A B β` in the standard library, so too is our continuous version, `Rel I A β`, the single-sorted special case of a completely general type of relations. + +The latter represents relations that not only have arbitrary arities, but also are defined over arbitrary families of types. + +Concretely, given an arbitrary family `A : I → Type α` of types, we may have a relation from `A i` to `A j` to `A k` to …, where the collection represented by the "indexing" type `I` might not even be enumerable. + +We refer to such relations as *dependent continuous relations* (or *dependent relations* for short) because the definition of a type that represents them requires depedent types. + +The `REL` type that we define [below](Base.Relations.Continuous.html#dependent-relations) manifests this completely general notion of relation. + +**Warning**! The type of binary relations in the standard library's `Relation.Binary` module is also called `Rel`. Therefore, to use both the discrete binary relation from the standard library, and our continuous relation type, we recommend renaming the former when importing with a line like this + +`open import Relation.Binary renaming ( REL to BinREL ; Rel to BinRel )` + + +#### <a id="continuous-and-dependent-relations">Continuous and dependent relations</a> + +Here we define the types `Rel` and `REL`. The first of these represents predicates of arbitrary arity over a single type `A`. As noted above, we call these *continuous relations*. + +The definition of `REL` goes even further and exploits the full power of dependent types resulting in a completely general relation type, which we call the type of *dependent relations*. + +Here, the tuples of a relation of type `REL I 𝒜 β` inhabit the dependent function type `𝒜 : I → Type α` (where the codomain may depend on the input coordinate `i : I` of the domain). + +Heuristically, we can think of an inhabitant of type `REL I 𝒜 β` as a relation from `𝒜 i` to `𝒜 j` to `𝒜 k` to …. + +(This is only a rough heuristic since `I` could denote an uncountable collection.) See the discussion below for a more detailed explanation. + +\begin{code} + +module _ {𝓥 : Level} where + ar : Type (suc 𝓥) + ar = Type 𝓥 + +-- Relations of arbitrary arity over a single sort. + Rel : Type α → ar → {ρ : Level} → Type (α ⊔ 𝓥 ⊔ suc ρ) + Rel A I {ρ} = (I → A) → Type ρ + + Rel-syntax : Type α → ar → (ρ : Level) → Type (𝓥 ⊔ α ⊔ suc ρ) + Rel-syntax A I ρ = Rel A I {ρ} + + syntax Rel-syntax A I ρ = Rel[ A ^ I ] ρ + infix 6 Rel-syntax + + -- The type of arbitrarily multisorted relations of arbitrary arity + REL : (I : ar) → (I → Type α) → {ρ : Level} → Type (𝓥 ⊔ α ⊔ suc ρ) + REL I 𝒜 {ρ} = ((i : I) → 𝒜 i) → Type ρ + + REL-syntax : (I : ar) → (I → Type α) → {ρ : Level} → Type (𝓥 ⊔ α ⊔ suc ρ) + REL-syntax I 𝒜 {ρ} = REL I 𝒜 {ρ} + + syntax REL-syntax I (λ i → 𝒜) = REL[ i ∈ I ] 𝒜 + infix 6 REL-syntax + +\end{code} + +#### <a id="compatibility-with-general-relations">Compatibility with general relations</a> + +\begin{code} + + -- Lift a relation of tuples up to a relation on tuples of tuples. + eval-Rel : {I : ar}{A : Type α} → Rel A I{ρ} → (J : ar) → (I → J → A) → Type (𝓥 ⊔ ρ) + eval-Rel R J t = ∀ (j : J) → R λ i → t i j + +\end{code} + +A relation `R` is compatible with an operation `f` if for every tuple `t` of tuples +belonging to `R`, the tuple whose elements are the result of applying `f` to +sections of `t` also belongs to `R`. + +\begin{code} + + compatible-Rel : {I J : ar}{A : Type α} → Op(A) J → Rel A I{ρ} → Type (𝓥 ⊔ α ⊔ ρ) + compatible-Rel f R = ∀ t → eval-Rel R arity[ f ] t → R λ i → f (t i) + -- (inferred type of t is I → J → A) + +\end{code} + + +#### <a id="compatibility-of-operations-with-dependent-relations">Compatibility of operations with dependent relations</a> + +\begin{code} + + eval-REL : {I J : ar}{𝒜 : I → Type α} + → REL I 𝒜 {ρ} -- the relation type: subsets of Π[ i ∈ I ] 𝒜 i + -- (where Π[ i ∈ I ] 𝒜 i is a type of dependent functions or "tuples") + → ((i : I) → J → 𝒜 i) -- an I-tuple of (𝒥 i)-tuples + → Type (𝓥 ⊔ ρ) + + eval-REL{I = I}{J}{𝒜} R t = ∀ j → R λ i → (t i) j + + compatible-REL : {I J : ar}{𝒜 : I → Type α} + → (∀ i → Op (𝒜 i) J) -- for each i : I, an operation of type Op(𝒜 i){J} = (J → 𝒜 i) → 𝒜 i + → REL I 𝒜 {ρ} -- a subset of Π[ i ∈ I ] 𝒜 i + -- (where Π[ i ∈ I ] 𝒜 i is a type of dependent functions or "tuples") + → Type (𝓥 ⊔ α ⊔ ρ) + compatible-REL {I = I}{J}{𝒜} 𝑓 R = Π[ t ∈ ((i : I) → J → 𝒜 i) ] eval-REL R t + +\end{code} + +The definition `eval-REL` denotes an *evaluation* function which lifts an `I`-ary relation to an `(I → J)`-ary relation. + +The lifted relation will relate an `I`-tuple of `J`-tuples when the `I`-slices (or rows) of the `J`-tuples belong +to the original relation. + +The second definition, compatible-REL, denotes compatibility of an operation with a continuous relation. + + +#### <a id="detailed-explanation-of-the-dependent-relation-type">Detailed explanation of the dependent relation type</a> + +The last two definitions above may be hard to comprehend at first, so perhaps a more detailed explanation of the semantics of these deifnitions would help. + +First, one should internalize the fact that `𝒶 : I → J → A` denotes an `I`-tuple of `J`-tuples of inhabitants of `A`. + +Next, recall that a continuous relation `R` denotes a certain collection of `I`-tuples (if `x : I → A`, then `R x` asserts that `x` belongs to `R`). + +For such `R`, the type `eval-REL R` represents a certain collection of `I`-tuples of `J`-tuples, namely, the tuples `𝒶 : I → J → A` for which `eval-REL R 𝒶` holds. + +For simplicity, pretend for a moment that `J` is a finite set, say, `{1, 2, ..., J}`, so that we can write down a couple of the `J`-tuples as columns. + +For example, here are the i-th and k-th columns (for some `i k : I`). + +``` +𝒶 i 1 𝒶 k 1 +𝒶 i 2 𝒶 k 2 <-- (a row of I such columns forms an I-tuple) + ⋮ ⋮ +𝒶 i J 𝒶 k J +``` + +Now `eval-REL R 𝒶` is defined by `∀ j → R (λ i → 𝒶 i j)` which asserts that each row of the `I` columns shown above belongs to the original relation `R`. + +Finally, `compatible-REL` takes + +* an `I`-tuple (`λ i → (𝑓 i)`) of `J`-ary operations, where for each i the type of `𝑓 i` is `(J → 𝒜 i) → 𝒜 i`, and +* an `I`-tuple (`𝒶 : I → J → A`) of `J`-tuples + +and determines whether the `I`-tuple `λ i → (𝑓 i) (𝑎 i)` belongs to `R`. + +-------------------------------------- + +<span style="float:left;">[← Base.Relations.Discrete](Base.Relations.Discrete.html)</span> +<span style="float:right;">[Base.Relations.Properties →](Base.Relations.Properties.html)</span> + +{% include UALib.Links.md %} + +[agda-algebras development team]: https://github.com/ualib/agda-algebras#the-agda-algebras-development-team +\ No newline at end of file diff --git a/docs/Base.Relations.Discrete.html b/docs/Base.Relations.Discrete.html new file mode 100644 index 0000000..99fde02 --- /dev/null +++ b/docs/Base.Relations.Discrete.html @@ -0,0 +1,232 @@ + +
--- +layout: default +title : "Base.Relations.Discrete module (The Agda Universal Algebra Library)" +date : "2021-02-28" +author: "the agda-algebras development team" +--- + +### <a id="discrete-relations">Discrete Relations</a> + +This is the [Base.Relations.Discrete][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Relations.Discrete where + +-- Imports from Agda and the Agda Standard Library ---------------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; _×_ ) +open import Function.Base using ( _∘_ ) +open import Level using ( _⊔_ ; Level ; Lift ) +open import Relation.Binary using ( IsEquivalence ; _⇒_ ; _=[_]⇒_ ) + renaming ( REL to BinREL ; Rel to BinRel ) +open import Relation.Binary.Definitions using ( Reflexive ; Transitive ) +open import Relation.Unary using ( _∈_; Pred ) +open import Relation.Binary.PropositionalEquality using ( _≡_ ) + +-- Imports from agda-algebras ------------------------------------------------------------------- +open import Overture using (_≈_ ; Π-syntax ; Op) + +private variable α β ρ 𝓥 : Level +\end{code} + +We begin with a definition that is useful for defining poitwise "equality" of functions +with respect to a given "equality" relation (see also the definition of `_≈̇_` in the [Base.Adjunction.Residuation][] module). + +\begin{code} + +module _ {A : Type α} where + + PointWise : {B : Type β } (_≋_ : BinRel B ρ) → BinRel (A → B) _ + PointWise {B = B} _≋_ = λ (f g : A → B) → ∀ x → f x ≋ g x + +\end{code} + +Thus, given a binary relation `≋` on ‵B`, and a pair of functions `f, g : A → B`, +we have `f (Pointwise _≋_) g` provided `∀ x → f x ≋ g x`. + +Here is the analogous definition for dependent functions. + +\begin{code} + + depPointWise : {B : A → Type β } + (_≋_ : {γ : Level}{C : Type γ} → BinRel C ρ) + → BinRel ((a : A) → B a) _ + depPointWise {B = B} _≋_ = λ (f g : (a : A) → B a) → ∀ x → f x ≋ g x + +\end{code} + +Next we define a type that is useful for asserting that the image of a function +is contained in a particular "subset" (predicate) of the codomain. + +\begin{code} + + Im_⊆_ : {B : Type β} → (A → B) → Pred B ρ → Type (α ⊔ ρ) + Im f ⊆ S = ∀ x → f x ∈ S + +\end{code} + + +#### <a id="operation-symbols-unary-relations-binary-relations">Operation symbols, unary relations, binary relations</a> + +The unary relation (or "predicate") type is imported from Relation.Unary of the [Agda Standard Library][]. + +```agda +Pred : ∀ {a} → Type a → (ℓ : Level) → Type (a ⊔ suc ℓ) +Pred A ℓ = A → Type ℓ +``` +We represent "sets" as inhabitants of such predicate types. + +(In the definition of `Pred` above, we replaced `Set` with `Type` for consistency with our notation.) + +Sometimes it is useful to obtain the underlying type (`A`) over which the predicates in `Pred A ℓ` (the "subsets" of `A`) are defined. + +\begin{code} + + PredType : Pred A ρ → Type α + PredType _ = A + +\end{code} + +The binary relation types are called `Rel` and `REL` in the standard library, but we +will call them `BinRel` and `BinREL` and reserve the names `Rel` and `REL` for the relation +types we define below and in the [Base.Relations.Continuous][] module. + +We import the "heterogeneous" binary relation type from the standard library and renamed `BinREL`. + +```agda +BinREL : ∀ {ℓ} (A B : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ')) +BinREL A B ℓ' = A → B → Type ℓ' +``` + +A special case, the homogeneous binary relation type is also imported and renamed `BinRel`. + +```agda +BinRel : ∀{ℓ} → Type ℓ → (ℓ' : Level) → Type (ℓ ⊔ lsuc ℓ') +BinRel A ℓ' = REL A A ℓ' +``` + +Occasionally it is useful to extract the universe level over which a binary relation is defined. + +\begin{code} + + Level-of-Rel : {ℓ : Level} → BinRel A ℓ → Level + Level-of-Rel {ℓ} _ = ℓ +\end{code} + + +#### <a id="kernels">Kernels</a> + +The *kernel* of `f : A → B` is defined informally by `{(x , y) ∈ A × A : f x = f y}`. +This can be represented in type theory and Agda in a number of ways, each of which +may be useful in a particular context. For example, we could define the kernel +to be an inhabitant of a (binary) relation type, or a (unary) predicate type. + +\begin{code} + +module _ {A : Type α}{B : Type β} where + + ker : (A → B) → BinRel A β + ker g x y = g x ≡ g y + + kerRel : {ρ : Level} → BinRel B ρ → (A → B) → BinRel A ρ + kerRel _≈_ g x y = g x ≈ g y + + kernelRel : {ρ : Level} → BinRel B ρ → (A → B) → Pred (A × A) ρ + kernelRel _≈_ g (x , y) = g x ≈ g y + + open IsEquivalence + + kerRelOfEquiv : {ρ : Level}{R : BinRel B ρ} + → IsEquivalence R → (h : A → B) → IsEquivalence (kerRel R h) + + kerRelOfEquiv eqR h = record { refl = refl eqR + ; sym = sym eqR + ; trans = trans eqR + } + + kerlift : (A → B) → (ρ : Level) → BinRel A (β ⊔ ρ) + kerlift g ρ x y = Lift ρ (g x ≡ g y) + + ker' : (A → B) → (I : Type 𝓥) → BinRel (I → A) (β ⊔ 𝓥) + ker' g I x y = g ∘ x ≡ g ∘ y + + kernel : (A → B) → Pred (A × A) β + kernel g (x , y) = g x ≡ g y + +-- The *identity relation* (equivalently, the kernel of a 1-to-1 function) +0[_] : (A : Type α) → {ρ : Level} → BinRel A (α ⊔ ρ) +0[ A ] {ρ} = λ x y → Lift ρ (x ≡ y) + +module _ {A : Type (α ⊔ ρ)} where + + -- Subset containment relation for binary realtions + _⊑_ : BinRel A ρ → BinRel A ρ → Type (α ⊔ ρ) + P ⊑ Q = ∀ x y → P x y → Q x y + + ⊑-refl : Reflexive _⊑_ + ⊑-refl = λ _ _ z → z + + ⊑-trans : Transitive _⊑_ + ⊑-trans P⊑Q Q⊑R x y Pxy = Q⊑R x y (P⊑Q x y Pxy) +\end{code} + + +### <a id="compatibility-of-operations-and-relations">Compatibility of operations and relations</a> + +Recall, from the [Overture.Signatures][] and [Overture.Operations][] modules which established +our convention of reserving the sybmols `𝓞` and `𝓥` for types that +represent operation symbols and arities, respectively. + +In the present subsection, we define types that are useful for asserting and proving +facts about *compatibility* of operations and relations + +\begin{code} + +-- lift a binary relation to the corresponding `I`-ary relation. + +eval-rel : {A : Type α}{I : Type 𝓥} → BinRel A ρ → BinRel (I → A) (𝓥 ⊔ ρ) +eval-rel R u v = ∀ i → R (u i) (v i) + +eval-pred : {A : Type α}{I : Type 𝓥} → Pred (A × A) ρ → BinRel (I → A) (𝓥 ⊔ ρ) +eval-pred P u v = ∀ i → (u i , v i) ∈ P + +\end{code} + +If `f : Op I` and `R : Rel A β`, then we say `f` and `R` are *compatible* just in case `∀ u v : I → A`, `Π i ꞉ I , R (u i) (v i) → R (f u) (f v)`. + +\begin{code} + +_preserves_ : {A : Type α}{I : Type 𝓥} → Op A I → BinRel A ρ → Type (α ⊔ 𝓥 ⊔ ρ) +f preserves R = ∀ u v → (eval-rel R) u v → R (f u) (f v) + +--shorthand notation for preserves +_|:_ : {A : Type α}{I : Type 𝓥} → Op A I → BinRel A ρ → Type (α ⊔ 𝓥 ⊔ ρ) +f |: R = (eval-rel R) =[ f ]⇒ R + +-- predicate version of the compatibility relation +_preserves-pred_ : {A : Type α}{I : Type 𝓥} → Op A I → Pred ( A × A ) ρ → Type (α ⊔ 𝓥 ⊔ ρ) +f preserves-pred P = ∀ u v → (eval-pred P) u v → (f u , f v) ∈ P + +_|:pred_ : {A : Type α}{I : Type 𝓥} → Op A I → Pred (A × A) ρ → Type (α ⊔ 𝓥 ⊔ ρ) +f |:pred P = (eval-pred P) =[ f ]⇒ λ x y → (x , y) ∈ P + + +-- The two types just defined are logically equivalent. +module _ {A : Type α}{I : Type 𝓥}{f : Op A I}{R : BinRel A ρ} where + compatibility-agreement : f preserves R → f |: R + compatibility-agreement c {x}{y} Rxy = c x y Rxy + compatibility-agreement' : f |: R → f preserves R + compatibility-agreement' c = λ u v x → c x +\end{code} + +-------------------------------------- + +<span style="float:left;">[↑ Base.Relations](Base.Relations.html)</span> +<span style="float:right;">[Base.Relations.Continuous →](Base.Relations.Continuous.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Relations.Properties.html b/docs/Base.Relations.Properties.html new file mode 100644 index 0000000..fa0b72f --- /dev/null +++ b/docs/Base.Relations.Properties.html @@ -0,0 +1,99 @@ + +
--- +layout: default +title : "Base.Relations.Properties module (The Agda Universal Algebra Library)" +date : "2021-06-26" +author: "the agda-algebras development team" +--- + +### <a id="properties-of-binary-predicates">Properties of binary predicates</a> + +This is the [Base.Relations.Properties][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Relations.Properties where + +-- imports from Agda and the Agda Standard Library --------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; _×_ ) +open import Data.Sum.Base using ( _⊎_ ) +open import Level using ( Level ) +open import Relation.Binary.Core using ( ) renaming ( REL to BinREL ; Rel to BinRel ) +open import Relation.Unary using ( Pred ; _∈_ ; _∉_ ) +open import Relation.Binary.PropositionalEquality + using ( _≡_ ) + +private variable + α β γ ℓ ℓ₁ ℓ₂ ℓ₃ : Level + A : Set α + B : Set β + C : Set γ + +curry : Pred(A × B) ℓ → BinREL A B ℓ +curry P x y = (x , y) ∈ P + +uncurry : BinREL A B ℓ → Pred(A × B) ℓ +uncurry _≈_ (a , b) = a ≈ b + +Reflexive : Pred (A × A) ℓ → Type _ +Reflexive P = ∀ {x} → (x , x) ∈ P + +-- Generalised symmetry +Sym : Pred (A × B) ℓ₁ → Pred (B × A) ℓ₂ → Type _ +Sym P Q = ∀ {x y} → (x , y) ∈ P → (y , x) ∈ Q + +-- Symmetry +Symmetric : Pred (A × A) ℓ → Type _ +Symmetric P = Sym P P + +-- Generalised transitivity. +Trans : Pred (A × B) ℓ₁ → Pred (B × C) ℓ₂ → Pred (A × C) ℓ₃ → Type _ +Trans P Q R = ∀ {i j k} → P (i , j) → Q (j , k) → R (i , k) + +-- A flipped variant of generalised transitivity. +TransFlip : Pred (A × B) ℓ₁ → Pred (B × C) ℓ₂ → Pred(A × C) ℓ₃ → Type _ +TransFlip P Q R = ∀ {i j k} → Q (j , k) → P (i , j) → R (i , k) + +-- Transitivity. +Transitive : Pred (A × A) ℓ → Type _ +Transitive P = Trans P P P + +-- Generalised antisymmetry +Antisym : Pred (A × B) ℓ₁ → Pred (B × A) ℓ₂ → Pred (A × B) ℓ₃ → Type _ +Antisym R S E = ∀ {i j} → R (i , j) → S (j , i) → E (i , j) + +-- Antisymmetry (defined terms of a given equality _≈_). +Antisymmetric : BinRel A ℓ₁ → Pred (A × A) ℓ₂ → Type _ +Antisymmetric _≈_ P = Antisym P P (uncurry _≈_) + +-- Irreflexivity (defined terms of a given equality _≈_). + +Irreflexive : BinREL A B ℓ₁ → Pred (A × B) ℓ₂ → Type _ +Irreflexive _≈_ P = ∀ {x y} → x ≈ y → (x , y) ∉ P + +-- Asymmetry. + +Asymmetric : Pred (A × A) ℓ → Type _ +Asymmetric P = ∀ {x y} → (x , y) ∈ P → (y , x) ∉ P + +-- Generalised connex - exactly one of the two relations holds. + +Connex : Pred (A × B) ℓ₁ → Pred (B × A) ℓ₂ → Type _ +Connex P Q = ∀ x y → (x , y) ∈ P ⊎ (y , x) ∈ Q + +-- Totality. + +Total : Pred (A × A) ℓ → Type _ +Total P = Connex P P +\end{code} + +----------------------------------------------- + +<span style="float:left;">[← Base.Relations.Continuous](Base.Relations.Continuous.html)</span> +<span style="float:right;">[Base.Relations.Quotients →](Base.Relations.Quotients.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Relations.Quotients.html b/docs/Base.Relations.Quotients.html new file mode 100644 index 0000000..ffc0bb0 --- /dev/null +++ b/docs/Base.Relations.Quotients.html @@ -0,0 +1,244 @@ + +
--- +layout: default +title : "Base.Relations.Quotients module (The Agda Universal Algebra Library)" +date : "2021-01-13" +author: "the agda-algebras development team" +--- + +### <a id="quotients">Quotients</a> + +This is the [Base.Relations.Quotients][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Relations.Quotients where + +-- Imports from Agda and the Agda Standard Library ---------------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; _×_ ; Σ-syntax ) renaming ( proj₁ to fst ; proj₂ to snd ) +open import Level using ( Level ; _⊔_ ; suc ) +open import Relation.Binary using ( IsEquivalence ; IsPartialEquivalence) renaming ( Rel to BinRel ) +open import Relation.Unary using ( Pred ; _⊆_ ) +open import Relation.Binary.PropositionalEquality as PE + using ( _≡_ ) + +-- Imports from agda-algebras --------------------------------------------------------------------- +open import Overture using ( ∣_∣ ) +open import Base.Relations.Discrete using ( ker ; 0[_] ; kerlift ) +open import Base.Relations.Properties using ( Reflexive ; Symmetric ; Transitive ) + +private variable α β χ : Level +\end{code} + +#### <a id="equivalence-relations">Equivalence relations</a> + +A binary relation is called a *preorder* if it is reflexive and transitive. +An *equivalence relation* is a symmetric preorder. The property of being +an equivalence relation is represented in the [Agda Standard Library][] by +a record type called `IsEquivalence`. Here we define the `Equivalence` type +which is inhabited by pairs `(r , p)` where `r` is a binary relation and `p` +is a proof that `r` satisfies `IsEquivalence`. + +\begin{code} + +Equivalence : Type α → {ρ : Level} → Type (α ⊔ suc ρ) +Equivalence A {ρ} = Σ[ r ∈ BinRel A ρ ] IsEquivalence r + +\end{code} + +Another way to represent binary relations is as the inhabitants of the +type `Pred(X × X) _`, and we here define the `IsPartialEquivPred` +and `IsEquivPred` types corresponding to such a representation. + +\begin{code} + +module _ {X : Type χ}{ρ : Level} where + + record IsPartialEquivPred (R : Pred (X × X) ρ) : Type (χ ⊔ ρ) where + field + sym : Symmetric R + trans : Transitive R + + record IsEquivPred (R : Pred (X × X) ρ) : Type (χ ⊔ ρ) where + field + refl : Reflexive R + sym : Symmetric R + trans : Transitive R + + reflexive : ∀ x y → x ≡ y → R (x , y) + reflexive x .x PE.refl = refl + +\end{code} + +Thus, if we have `(R , p) : Equivalence A`, then `R` denotes a binary +relation over `A` and `p` is of record type `IsEquivalence R` with fields +containing the three proofs showing that `R` is an equivalence relation. + +#### <a id="kernels">Kernels</a> + +A prominent example of an equivalence relation is the kernel of any function. + +\begin{code} + +open Level +ker-IsEquivalence : {A : Type α}{B : Type β}(f : A → B) → IsEquivalence (ker f) +ker-IsEquivalence f = record { refl = PE.refl + ; sym = λ x → PE.sym x + ; trans = λ x y → PE.trans x y + } + +kerlift-IsEquivalence : {A : Type α}{B : Type β}(f : A → B){ρ : Level} + → IsEquivalence (kerlift f ρ) + +kerlift-IsEquivalence f = record { refl = lift PE.refl + ; sym = λ x → lift (PE.sym (lower x)) + ; trans = λ x y → lift (PE.trans (lower x) (lower y)) + } +\end{code} + + +#### <a id="equivalence-classes"> Equivalence classes (blocks) </a> + + +If `R` is an equivalence relation on `A`, then for each `u : A` there is +an *equivalence class* (or *equivalence block*, or `R`-*block*) containing `u`, +which we denote and define by `[ u ] := {v : A | R u v}`. + +Before defining the quotient type, we define a type representing inhabitants of quotients; +i.e., blocks of a partition (recall partitions correspond to equivalence relations) -} + +\begin{code} + +[_] : {A : Type α} → A → {ρ : Level} → BinRel A ρ → Pred A ρ +[ u ]{ρ} R = R u -- (the R-block containing u : A) + +-- Alternative notation +[_/_] : {A : Type α} → A → {ρ : Level} → Equivalence A {ρ} → Pred A ρ +[ u / R ] = ∣ R ∣ u + +-- Alternative notation +Block : {A : Type α} → A → {ρ : Level} → Equivalence A{ρ} → Pred A ρ +Block u {ρ} R = ∣ R ∣ u + +infix 60 [_] + +\end{code} + +Thus, `v ∈ [ u ]` if and only if `R u v`, as desired. We often refer to `[ u ]` +as the `R`-*block containing* `u`. + +A predicate `C` over `A` is an `R`-block if and only if `C ≡ [ u ]` for some `u : A`. +We represent this characterization of an `R`-block as follows. + +\begin{code} + +record IsBlock {A : Type α}{ρ : Level} + (P : Pred A ρ){R : BinRel A ρ} : Type(α ⊔ suc ρ) where + constructor mkblk + field + blk : A + P≡[blk] : P ≡ [ blk ]{ρ} R + +\end{code} + +If `R` is an equivalence relation on `A`, then the *quotient* of `A` modulo `R` is +denoted by `A / R` and is defined to be the collection `{[ u ] ∣ y : A}` of all +`R`-blocks. + +\begin{code} + +Quotient : (A : Type α){ρ : Level} → Equivalence A{ρ} → Type(α ⊔ suc ρ) +Quotient A R = Σ[ P ∈ Pred A _ ] IsBlock P {∣ R ∣} + +_/_ : (A : Type α){ρ : Level} → BinRel A ρ → Type(α ⊔ suc ρ) +A / R = Σ[ P ∈ Pred A _ ] IsBlock P {R} + +infix -1 _/_ + +\end{code} + +We use the following type to represent an R-block with a designated representative. + +\begin{code} + +⟪_⟫ : {α : Level}{A : Type α}{ρ : Level} → A → {R : BinRel A ρ} → A / R +⟪ a ⟫{R} = [ a ] R , mkblk a PE.refl + +\end{code} + +Dually, the next type provides an *elimination rule*. + +\begin{code} + +⌞_⌟ : {α : Level}{A : Type α}{ρ : Level}{R : BinRel A ρ} → A / R → A +⌞ _ , mkblk a _ ⌟ = a + +\end{code} + +Here `C` is a predicate and `p` is a proof of `C ≡ [ a ] R`. + +\begin{code} + +module _ {A : Type α} + {ρ : Level} -- note: ρ is an implicit parameter + {R : Equivalence A {ρ}} where + + open IsEquivalence + []-⊆ : (x y : A) → ∣ R ∣ x y → [ x ]{ρ} ∣ R ∣ ⊆ [ y ] ∣ R ∣ + []-⊆ x y Rxy {z} Rxz = IsEquivalence.trans (snd R) (IsEquivalence.sym (snd R) Rxy) Rxz + + []-⊇ : (x y : A) → ∣ R ∣ x y → [ y ] ∣ R ∣ ⊆ [ x ] ∣ R ∣ + []-⊇ x y Rxy {z} Ryz = IsEquivalence.trans (snd R) Rxy Ryz + + ⊆-[] : (x y : A) → [ x ] ∣ R ∣ ⊆ [ y ] ∣ R ∣ → ∣ R ∣ x y + ⊆-[] x y xy = IsEquivalence.sym (snd R) (xy (IsEquivalence.refl (snd R))) + + ⊇-[] : (x y : A) → [ y ] ∣ R ∣ ⊆ [ x ] ∣ R ∣ → ∣ R ∣ x y + ⊇-[] x y yx = yx (IsEquivalence.refl (snd R)) + +\end{code} + +An example application of these is the `block-ext` type in the [Base.Relations.Extensionality] module. + +Recall, from Base.Relations.Discrete, the zero (or "identity") relation is + +```agda +0[_] : (A : Type α) → {ρ : Level} → BinRel A (α ⊔ ρ) +0[ A ] {ρ} = λ x y → Lift ρ (x ≡ y) +``` + +This is obviously an equivalence relation, as we now confirm. + +\begin{code} + +0[_]IsEquivalence : (A : Type α){ρ : Level} → IsEquivalence (0[ A ] {ρ}) +0[ A ]IsEquivalence {ρ} = record { refl = lift PE.refl + ; sym = λ p → lift (PE.sym (lower p)) + ; trans = λ p q → lift (PE.trans (lower p) (lower q)) + } + +0[_]Equivalence : (A : Type α) {ρ : Level} → Equivalence A {α ⊔ ρ} +0[ A ]Equivalence {ρ} = 0[ A ] {ρ} , 0[ A ]IsEquivalence + + +⟪_∼_⟫-elim : {A : Type α} → (u v : A) → {ρ : Level}{R : Equivalence A{ρ} } + → ⟪ u ⟫{∣ R ∣} ≡ ⟪ v ⟫ → ∣ R ∣ u v + +⟪ u ∼ .u ⟫-elim {ρ} {R} PE.refl = IsEquivalence.refl (snd R) + +≡→⊆ : {A : Type α}{ρ : Level}(Q R : Pred A ρ) → Q ≡ R → Q ⊆ R +≡→⊆ Q .Q PE.refl {x} Qx = Qx +\end{code} + + +------------------------------------- + +<span style="float:left;">[← Base.Relations.Properties](Base.Relations.Properties.html)</span> +<span style="float:right;">[Base.Equality →](Base.Equality.html)</span> + +{% include UALib.Links.md %} + +\ No newline at end of file diff --git a/docs/Base.Relations.html b/docs/Base.Relations.html new file mode 100644 index 0000000..e0142c0 --- /dev/null +++ b/docs/Base.Relations.html @@ -0,0 +1,40 @@ + +
--- +layout: default +title : "Relations module (The Agda Universal Algebra Library)" +date : "2021-01-12" +author: "the agda-algebras development team" +--- + +## <a id="relations">Relations</a> + +This is the [Base.Relations][] module of the [Agda Universal Algebra Library][]. + +In the [Base.Relations.Discrete][] submodule we define types that represent *unary* and *binary relations*. + +We refer to these as "discrete relations" to contrast them with the "continuous," *general* and *dependent relations* that we introduce in [Base.Relations.Continuous][]. + +We call the latter "continuous relations" because they can have arbitrary arity and they can be defined over arbitrary families of types. + +Finally, in [Base.Relations.Quotients][] we define quotient types. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Relations where + +open import Base.Relations.Discrete public +open import Base.Relations.Continuous public +open import Base.Relations.Properties public +open import Base.Relations.Quotients public + +\end{code} + +------------------------------------- + +<span style="float:left;">[↑ Base](Base.html)</span> +<span style="float:right;">[Base.Relations.Discrete →](Base.Relations.Discrete.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Basic.html b/docs/Base.Structures.Basic.html new file mode 100644 index 0000000..1e374c7 --- /dev/null +++ b/docs/Base.Structures.Basic.html @@ -0,0 +1,123 @@ + +
--- +layout: default +title : "Base.Structures.Basic module (Agda Universal Algebra Library)" +date : "2021-05-20" +author: "agda-algebras development team" +--- + +### <a id="basic-definitions">Basic Definitions</a> + +This is the [Base.Structures.Basic][] module of the [Agda Universal Algebra Library][]. It is a submodule of the Structures module which presents general (relational-algebraic) structures as inhabitants of record types. For a similar development using Sigma types see the Base.Structures.Sigma.Basic module. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Basic where + +-- Imports from Agda and the Agda Standard Library ----------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Function.Base using ( flip ; _∘_ ) +open import Level using ( _⊔_ ; suc ; Level ) +open import Relation.Binary.Core using () renaming ( Rel to BinRel ) + +-- Imports from the Agda Universal Algebra Library ----------------------------- +open import Overture using ( Op ) +open import Base.Relations using ( _|:_ ; _preserves_ ; Rel ) + +private variable 𝓞₀ 𝓥₀ 𝓞₁ 𝓥₁ : Level + +-- Signature as a record type +record signature (𝓞 𝓥 : Level) : Type (suc (𝓞 ⊔ 𝓥)) where + field + symbol : Type 𝓞 + arity : symbol → Type 𝓥 + +siglˡ : {𝓞 𝓥 : Level} → signature 𝓞 𝓥 → Level +siglˡ {𝓞}{𝓥} _ = 𝓞 + +siglʳ : {𝓞 𝓥 : Level} → signature 𝓞 𝓥 → Level +siglʳ {𝓞}{𝓥} _ = 𝓥 + +sigl : {𝓞 𝓥 : Level} → signature 𝓞 𝓥 → Level +sigl {𝓞}{𝓥} _ = 𝓞 ⊔ 𝓥 + +open signature public + +record structure (𝐹 : signature 𝓞₀ 𝓥₀) + (𝑅 : signature 𝓞₁ 𝓥₁) + {α ρ : Level} : Type (𝓞₀ ⊔ 𝓥₀ ⊔ 𝓞₁ ⊔ 𝓥₁ ⊔ (suc (α ⊔ ρ))) + where + field + carrier : Type α + op : ∀(f : symbol 𝐹) → Op carrier (arity 𝐹 f) -- interpret. of operations + rel : ∀(r : symbol 𝑅) → Rel carrier (arity 𝑅 r) {ρ} -- interpret. of relations + + -- Forgetful Functor + 𝕌 : Type α + 𝕌 = carrier + +open structure public + +module _ {𝐹 : signature 𝓞₀ 𝓥₀}{𝑅 : signature 𝓞₁ 𝓥₁} where + -- Syntactic sugar for interpretation of operation + _ʳ_ : ∀{α ρ} → (r : symbol 𝑅)(𝒜 : structure 𝐹 𝑅 {α}{ρ}) + → Rel (carrier 𝒜) ((arity 𝑅) r) {ρ} + _ʳ_ = flip rel + + _ᵒ_ : ∀{α ρ} → (f : symbol 𝐹)(𝒜 : structure 𝐹 𝑅 {α}{ρ}) + → Op (carrier 𝒜)((arity 𝐹) f) + _ᵒ_ = flip op + + compatible : ∀{α ρ ℓ} → (𝑨 : structure 𝐹 𝑅 {α}{ρ}) + → BinRel (carrier 𝑨) ℓ → Type _ + compatible 𝑨 r = ∀ (f : symbol 𝐹) → (f ᵒ 𝑨) |: r + + open Level + + -- lift an operation to act on type of higher universe level + Lift-op : ∀{ι α} → {I : Type ι}{A : Type α} + → Op A I → {ℓ : Level} → Op (Lift ℓ A) I + + Lift-op f = λ z → lift (f (lower ∘ z)) + + -- lift a relation to a predicate on type of higher universe level + -- (note ρ doesn't change; see Lift-Structʳ for that) + Lift-rel : ∀{ι α ρ} → {I : Type ι}{A : Type α} + → Rel A I {ρ} → {ℓ : Level} → Rel (Lift ℓ A) I{ρ} + + Lift-rel r x = r (lower ∘ x) + + -- lift the domain of a structure to live in a type at a higher universe level + Lift-Strucˡ : ∀{α ρ} → (ℓ : Level) + → structure 𝐹 𝑅 {α}{ρ} → structure 𝐹 𝑅 {α ⊔ ℓ}{ρ} + + Lift-Strucˡ ℓ 𝑨 = record { carrier = Lift ℓ (carrier 𝑨) + ; op = λ f → Lift-op (f ᵒ 𝑨) + ; rel = λ R → Lift-rel (R ʳ 𝑨) + } + + -- lift the relations of a structure from level ρ to level ρ ⊔ ℓ + Lift-Strucʳ : ∀{α ρ} → (ℓ : Level) + → structure 𝐹 𝑅 {α}{ρ} → structure 𝐹 𝑅 {α}{ρ ⊔ ℓ} + + Lift-Strucʳ ℓ 𝑨 = record { carrier = carrier 𝑨 ; op = op 𝑨 ; rel = lrel } + where + lrel : (r : symbol 𝑅) → Rel (carrier 𝑨) ((arity 𝑅) r) + lrel r = Lift ℓ ∘ r ʳ 𝑨 + + -- lift both domain of structure and the level of its relations + Lift-Struc : ∀{α ρ} → (ℓˡ ℓʳ : Level) + → structure 𝐹 𝑅 {α}{ρ} → structure 𝐹 𝑅 {α ⊔ ℓˡ}{ρ ⊔ ℓʳ} + + Lift-Struc ℓˡ ℓʳ 𝑨 = Lift-Strucʳ ℓʳ (Lift-Strucˡ ℓˡ 𝑨) +\end{code} + +-------------------------------- + +<span style="float:left;">[↑ Base.Structures](Base.Structures.html)</span> +<span style="float:right;">[Base.Structures.Graphs →](Base.Structures.Graphs.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Congruences.html b/docs/Base.Structures.Congruences.html new file mode 100644 index 0000000..5b9a27b --- /dev/null +++ b/docs/Base.Structures.Congruences.html @@ -0,0 +1,101 @@ + +
--- +layout: default +title : "Base.Structures.Congruences.Records module" +date : "2021-05-28" +author: "agda-algebras development team" +--- + +### <a id="congruences-of-general-structures">Congruences of general structures</a> + +This is the [Base.Structures.Congruences][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Congruences where + +-- Imports from Agda and the Agda Standard Library -------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; _×_ ; Σ-syntax ) + renaming ( proj₁ to fst ) +open import Function.Base using ( _∘_ ) +open import Level using ( Level ; suc ; _⊔_ ; lower ; lift ) + +open import Relation.Binary.PropositionalEquality using ( _≡_ ) + +-- Imports from the Agda Universal Algebra Library -------------------------------------- +open import Overture using ( ∣_∣ ) +open import Base.Relations using ( _|:_ ; 0[_] ; Equivalence ; Quotient ; ⟪_⟫ ) + using ( 0[_]Equivalence ; ⌞_⌟ ; ⟪_∼_⟫-elim ; _/_ ) +open import Base.Equality using ( swelldef ) + +open import Base.Structures.Basic using ( signature ; structure ; sigl ) + using ( siglʳ ; compatible ) +private variable + 𝓞₀ 𝓥₀ 𝓞₁ 𝓥₁ : Level + 𝐹 : signature 𝓞₀ 𝓥₀ + 𝑅 : signature 𝓞₁ 𝓥₁ + α ρ : Level + +open signature ; open structure + +con : ∀ {α ρ} → structure 𝐹 𝑅 {α}{ρ} → Type (sigl 𝐹 ⊔ suc α ⊔ suc ρ) +con {α = α}{ρ} 𝑨 = Σ[ θ ∈ Equivalence (carrier 𝑨){α ⊔ ρ} ] (compatible 𝑨 ∣ θ ∣) +\end{code} + + +#### <a id="the-zero-congruence-of-a-structure">The zero congruence of a structure</a> + +\begin{code} + +0[_]compatible : (𝑨 : structure 𝐹 𝑅 {α} {ρ}) → swelldef (siglʳ 𝐹) α + → (𝑓 : symbol 𝐹) → (op 𝑨) 𝑓 |: (0[ carrier 𝑨 ] {ρ}) + +0[ 𝑨 ]compatible wd 𝑓 {i}{j} ptws0 = lift γ + where + γ : ((op 𝑨) 𝑓) i ≡ ((op 𝑨) 𝑓) j + γ = wd ((op 𝑨) 𝑓) i j (lower ∘ ptws0) + +0con[_] : (𝑨 : structure 𝐹 𝑅 {α} {ρ}) → swelldef (siglʳ 𝐹) α → con 𝑨 +0con[ 𝑨 ] wd = 0[ carrier 𝑨 ]Equivalence , 0[ 𝑨 ]compatible wd +\end{code} + +#### <a id="quotient-structures">Quotient structures</a> + +\begin{code} + +_╱_ -- alias (useful on when signature and universe parameters can be inferred) + quotient : (𝑨 : structure 𝐹 𝑅 {α}{ρ}) → con 𝑨 → structure 𝐹 𝑅 +quotient 𝑨 θ = + record { carrier = Quotient (carrier 𝑨) ∣ θ ∣ -- domain of quotient structure + ; op = λ f b → ⟪ ((op 𝑨) f) (λ i → ⌞ b i ⌟) ⟫ {fst ∣ θ ∣} -- interp of operations + ; rel = λ r x → ((rel 𝑨) r) (λ i → ⌞ x i ⌟) -- interpretation of relations + } + +_╱_ = quotient -- (alias) + +/≡-elim : {𝑨 : structure 𝐹 𝑅 {α}{ρ}} ((θ , _ ) : con 𝑨){u v : carrier 𝑨} + → ⟪ u ⟫ {∣ θ ∣} ≡ ⟪ v ⟫ {∣ θ ∣} → ∣ θ ∣ u v + +/≡-elim θ {u}{v} x = ⟪ u ∼ v ⟫-elim{R = ∣ θ ∣} x +\end{code} + +#### <a id="the-zero-congruence-of-a-quotient-structure">The zero congruence of a quotient structure</a> + +\begin{code} + +𝟎[_╱_] : (𝑨 : structure 𝐹 𝑅 {α}{ρ}) (θ : con 𝑨) + → swelldef (siglʳ 𝐹)(suc (α ⊔ ρ)) → con (𝑨 ╱ θ) + +𝟎[ 𝑨 ╱ θ ] wd = 0con[ 𝑨 ╱ θ ] wd +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Products](Base.Structures.Products.html)</span> +<span style="float:right;">[Base.Structures.Homs →](Base.Structures.Homs.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.EquationalLogic.html b/docs/Base.Structures.EquationalLogic.html new file mode 100644 index 0000000..ef4aadd --- /dev/null +++ b/docs/Base.Structures.EquationalLogic.html @@ -0,0 +1,66 @@ + +
--- +layout: default +title : "Base.Structures.EquationalLogic" +date : "2021-07-23" +author: "agda-algebras development team" +--- + +### <a id="equational-logic-for-general-structures">Equational Logic for General Structures</a> + +This is the [Base.Structures.EquationalLogic][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.EquationalLogic where + +-- Imports from Agda and the Agda Standard Library -------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Fin.Base using ( Fin ) +open import Data.Nat using ( ℕ ) +open import Data.Product using ( _×_ ; _,_ ) renaming ( proj₁ to fst ; proj₂ to snd ) +open import Level using ( Level ) +open import Relation.Unary using ( Pred ; _∈_ ) + +-- Imports from the Agda Universal Algebra Library -------------------------------------- +open import Overture using ( _≈_ ) +open import Base.Terms using ( Term ) +open import Base.Structures.Basic using ( signature ; structure ; _ᵒ_ ) +open import Base.Structures.Terms using ( _⟦_⟧ ) + +private variable + 𝓞₀ 𝓥₀ 𝓞₁ 𝓥₁ χ α ρ ℓ : Level + 𝐹 : signature 𝓞₀ 𝓥₀ + 𝑅 : signature 𝓞₁ 𝓥₁ + X : Type χ + +-- Entailment, equational theories, and models + +_⊧_≈_ : structure 𝐹 𝑅 {α}{ρ} → Term X → Term X → Type _ +𝑨 ⊧ p ≈ q = 𝑨 ⟦ p ⟧ ≈ 𝑨 ⟦ q ⟧ + +_⊧_≋_ : Pred(structure 𝐹 𝑅 {α}{ρ}) ℓ → Term X → Term X → Type _ +𝒦 ⊧ p ≋ q = ∀{𝑨 : structure _ _} → 𝒦 𝑨 → 𝑨 ⊧ p ≈ q + +-- Theories +Th : Pred (structure 𝐹 𝑅{α}{ρ}) ℓ → Pred(Term X × Term X) _ -- (ℓ₁ ⊔ χ) +Th 𝒦 = λ (p , q) → 𝒦 ⊧ p ≋ q + +-- Models +Mod : Pred(Term X × Term X) ℓ → Pred(structure 𝐹 𝑅 {α} {ρ}) _ -- (χ ⊔ ℓ₀) +Mod ℰ = λ 𝑨 → ∀ p q → (p , q) ∈ ℰ → 𝑨 ⊧ p ≈ q + +fMod : {n : ℕ} → (Fin n → (Term X × Term X)) → Pred(structure 𝐹 𝑅 {α} {ρ}) _ +fMod ℰ = λ 𝑨 → ∀ i → 𝑨 ⊧ fst (ℰ i) ≈ snd (ℰ i) + +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Substructures](Base.Structures.Substructures.html)</span> +<span style="float:right;">[Base.Structures.Sigma →](Base.Structures.Sigma.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Graphs.html b/docs/Base.Structures.Graphs.html new file mode 100644 index 0000000..bfdb1ab --- /dev/null +++ b/docs/Base.Structures.Graphs.html @@ -0,0 +1,108 @@ + +
--- +layout: default +title : "Base.Structures.Graphs module" +date : "2021-06-22" +author: "agda-algebras development team" +--- + +### <a id="graph-structures">Graph Structures</a> + +This is the [Base.Structures.Graphs][] module of the [Agda Universal Algebra Library][]. + +N.B. This module differs from 0Graphs.lagda in that this module is universe polymorphic; i.e., we do not restrict universe levels (to, e.g., `ℓ₀`). This complicates some things; e.g., we must use lift and lower in some places (cf. [Base/Structures/Graphs0.lagda][]). + +**Definition** (Graph of a structure). Let `𝑨` be an `(𝑅, 𝐹)`-structure (relations from `𝑅` and operations from `𝐹`). The *graph* of `𝑨` is the structure `Gr 𝑨` with the same domain as `𝑨` with relations from `𝑅` together with a (`k+1`)-ary relation symbol `G 𝑓` for each `𝑓 ∈ 𝐹` of arity `k`, which is interpreted in `Gr 𝑨` as all tuples `(t , y) ∈ Aᵏ⁺¹` such that `𝑓 t ≡ y`. (See also Definition 2 of https://arxiv.org/pdf/2010.04958v2.pdf) + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Graphs where + +-- imports from Agda and the Agda Standard Library ------------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ; lzero to ℓ₀ ) +open import Data.Product using ( _,_ ; Σ-syntax ; _×_ ) +open import Data.Sum.Base using ( _⊎_ ) renaming ( inj₁ to inl ; inj₂ to inr ) +open import Data.Unit.Base using ( ⊤ ; tt ) +open import Level using ( _⊔_ ; Level ; Lift ; lift ; lower ) +open import Function.Base using ( _∘_ ) +open import Relation.Binary.PropositionalEquality as ≡ + using ( _≡_ ; module ≡-Reasoning ) + +-- Imports from the Agda Universal Algebra Library --------------------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ) +open import Base.Relations using ( Rel ) +open import Base.Structures.Basic using ( signature ; structure ) +open import Base.Structures.Homs using ( hom ; ∘-hom ; is-hom-rel ; is-hom-op) +open import Examples.Structures.Signatures using ( S∅ ) + +open signature ; open structure ; open _⊎_ + +Gr-sig : signature ℓ₀ ℓ₀ → signature ℓ₀ ℓ₀ → signature ℓ₀ ℓ₀ + +Gr-sig 𝐹 𝑅 = record { symbol = symbol 𝑅 ⊎ symbol 𝐹 + ; arity = ar + } + where + ar : symbol 𝑅 ⊎ symbol 𝐹 → Type _ + ar (inl 𝑟) = (arity 𝑅) 𝑟 + ar (inr 𝑓) = (arity 𝐹) 𝑓 ⊎ ⊤ + +private variable + 𝐹 𝑅 : signature ℓ₀ ℓ₀ + α ρ : Level + +Gr : ∀{α ρ} → structure 𝐹 𝑅 {α} {ρ} → structure S∅ (Gr-sig 𝐹 𝑅) {α} {α ⊔ ρ} +Gr {𝐹}{𝑅}{α}{ρ} 𝑨 = record { carrier = carrier 𝑨 ; op = λ () ; rel = split } + where + split : (s : symbol 𝑅 ⊎ symbol 𝐹) → Rel (carrier 𝑨) (arity (Gr-sig 𝐹 𝑅) s) {α ⊔ ρ} + split (inl 𝑟) arg = Lift α (rel 𝑨 𝑟 arg) + split (inr 𝑓) args = Lift ρ (op 𝑨 𝑓 (args ∘ inl) ≡ args (inr tt)) + +open ≡-Reasoning + +private variable ρᵃ β ρᵇ : Level + +module _ {𝑨 : structure 𝐹 𝑅 {α} {ρᵃ}} {𝑩 : structure 𝐹 𝑅 {β} {ρᵇ}} where + + hom→Grhom : hom 𝑨 𝑩 → hom (Gr 𝑨) (Gr 𝑩) + hom→Grhom (h , hhom) = h , (i , ii) + where + i : is-hom-rel (Gr 𝑨) (Gr 𝑩) h + i (inl 𝑟) a x = lift (∣ hhom ∣ 𝑟 a (lower x)) + i (inr 𝑓) a x = lift goal + where + homop : h (op 𝑨 𝑓 (a ∘ inl)) ≡ op 𝑩 𝑓 (h ∘ (a ∘ inl)) + homop = ∥ hhom ∥ 𝑓 (a ∘ inl) + + goal : op 𝑩 𝑓 (h ∘ (a ∘ inl)) ≡ h (a (inr tt)) + goal = op 𝑩 𝑓 (h ∘ (a ∘ inl)) ≡⟨ ≡.sym homop ⟩ + h (op 𝑨 𝑓 (a ∘ inl)) ≡⟨ ≡.cong h (lower x) ⟩ + h (a (inr tt)) ∎ + + ii : is-hom-op (Gr 𝑨) (Gr 𝑩) h + ii = λ () + + Grhom→hom : hom (Gr 𝑨) (Gr 𝑩) → hom 𝑨 𝑩 + Grhom→hom (h , hhom) = h , (i , ii) + where + i : is-hom-rel 𝑨 𝑩 h + i R a x = lower (∣ hhom ∣ (inl R) a (lift x)) + ii : is-hom-op 𝑨 𝑩 h + ii f a = goal + where + split : arity 𝐹 f ⊎ ⊤ → carrier 𝑨 + split (inl x) = a x + split (inr y) = op 𝑨 f a + goal : h (op 𝑨 f a) ≡ op 𝑩 f (λ x → h (a x)) + goal = ≡.sym (lower (∣ hhom ∣ (inr f) split (lift ≡.refl))) +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Basic](Base.Structures.Basic.html)</span> +<span style="float:right;">[Base.Structures.Graphs0 →](Base.Structures.Graphs0.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Graphs0.html b/docs/Base.Structures.Graphs0.html new file mode 100644 index 0000000..2caf5d4 --- /dev/null +++ b/docs/Base.Structures.Graphs0.html @@ -0,0 +1,150 @@ + +
--- +layout: default +title : "Base.Structures.Graphs0" +date : "2021-06-22" +author: "agda-algebras development team" +--- + +### <a id="graph-structures-again">Graph Structures (again)</a> + +This is the [Base.Structures.Graphs0][] module of the [Agda Universal Algebra Library][]. + +N.B. This module differs from Graphs.lagda in that here we assume some universes are level zero (i.e., ℓ₀). This simplifies some things; e.g., we avoid having to use lift and lower (cf. [Base/Structures/Graphs.lagda][]) + +Definition [Graph of a structure]. Let `𝑨` be an `(𝑅,𝐹)`-structure (relations from `𝑅` and operations from `𝐹`). +The *graph* of `𝑨` is the structure `Gr 𝑨` with the same domain as `𝑨` with relations from `𝑅` and together with a `(k+1)`-ary relation symbol `G 𝑓` for each `𝑓 ∈ 𝐹` of arity `k`, which is interpreted in `Gr 𝑨` as all tuples `(t , y) ∈ Aᵏ⁺¹` such that `𝑓 t ≡ y`. (See also Definition 2 of https://arxiv.org/pdf/2010.04958v2.pdf) + + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Graphs0 where + +-- Imports from Agda and the Agda Standard Library ------------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ; lzero to ℓ₀ ) +open import Data.Product using ( _,_ ; _×_ ; Σ-syntax ) +open import Data.Sum.Base using ( _⊎_ ) renaming ( inj₁ to inl ; inj₂ to inr ) +open import Data.Fin.Base using ( Fin ) +open import Data.Nat using ( ℕ ) +open import Data.Unit.Base using ( ⊤ ; tt ) +open import Function.Base using ( _∘_ ) +open import Relation.Unary using ( Pred ; _∈_ ) +open import Relation.Binary.PropositionalEquality + using ( _≡_ ; module ≡-Reasoning ; cong ; sym ; refl ) + +-- Imports from the Agda Universal Algebra Library --------------------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ) +open import Base.Relations using ( Rel ) +open import Base.Structures.Basic using ( signature ; structure ) +open import Base.Structures.Homs using ( hom ; is-hom-rel ; is-hom-op ) +open import Examples.Structures.Signatures using ( S∅ ) + +open signature ; open structure ; open _⊎_ + +Gr-sig : signature ℓ₀ ℓ₀ → signature ℓ₀ ℓ₀ → signature ℓ₀ ℓ₀ + +Gr-sig 𝐹 𝑅 = record { symbol = symbol 𝑅 ⊎ symbol 𝐹 + ; arity = ar } + where + ar : symbol 𝑅 ⊎ symbol 𝐹 → Type ℓ₀ + ar (inl 𝑟) = (arity 𝑅) 𝑟 + ar (inr 𝑓) = (arity 𝐹) 𝑓 ⊎ ⊤ + +private variable 𝐹 𝑅 : signature ℓ₀ ℓ₀ + +Gr : structure 𝐹 𝑅 {ℓ₀} {ℓ₀} → structure S∅ (Gr-sig 𝐹 𝑅) {ℓ₀} {ℓ₀} +Gr {𝐹}{𝑅} 𝑨 = record { carrier = carrier 𝑨 ; op = λ () ; rel = split } + where + split : (s : symbol 𝑅 ⊎ symbol 𝐹) → Rel (carrier 𝑨) (arity (Gr-sig 𝐹 𝑅) s) {ℓ₀} + split (inl 𝑟) arg = rel 𝑨 𝑟 arg + split (inr 𝑓) args = op 𝑨 𝑓 (args ∘ inl) ≡ args (inr tt) + +open ≡-Reasoning + +module _ {𝑨 𝑩 : structure 𝐹 𝑅 {ℓ₀}{ℓ₀}} where + + hom→Grhom : hom 𝑨 𝑩 → hom (Gr 𝑨) (Gr 𝑩) + hom→Grhom (h , hhom) = h , (i , ii) + where + i : is-hom-rel (Gr 𝑨) (Gr 𝑩) h + i (inl 𝑟) a x = ∣ hhom ∣ 𝑟 a x + i (inr 𝑓) a x = goal + where + homop : h (op 𝑨 𝑓 (a ∘ inl)) ≡ op 𝑩 𝑓 (h ∘ (a ∘ inl)) + homop = ∥ hhom ∥ 𝑓 (a ∘ inl) + + goal : op 𝑩 𝑓 (h ∘ (a ∘ inl)) ≡ h (a (inr tt)) + goal = op 𝑩 𝑓 (h ∘ (a ∘ inl)) ≡⟨ sym homop ⟩ + h (op 𝑨 𝑓 (a ∘ inl)) ≡⟨ cong h x ⟩ + h (a (inr tt)) ∎ + + ii : is-hom-op (Gr 𝑨) (Gr 𝑩) h + ii = λ () + + Grhom→hom : hom (Gr 𝑨) (Gr 𝑩) → hom 𝑨 𝑩 + Grhom→hom (h , hhom) = h , (i , ii) + where + i : is-hom-rel 𝑨 𝑩 h + i R a x = ∣ hhom ∣ (inl R) a x + ii : is-hom-op 𝑨 𝑩 h + ii f a = goal + where + split : arity 𝐹 f ⊎ ⊤ → carrier 𝑨 + split (inl x) = a x + split (inr y) = op 𝑨 f a + goal : h (op 𝑨 f a) ≡ op 𝑩 f (λ x → h (a x)) + goal = sym (∣ hhom ∣ (inr f) split refl) + +\end{code} + +**Lemma III.1**. Let `𝑆` be a signature and `𝑨` be an `𝑆`-structure. +Let `ℰ` be a finite set of identities such that `𝑨 ⊧ ℰ`. For every +instance `𝑿` of CSP(`𝑨`), one can compute in polynomial time an +instance `𝒀` of CSP(`𝑨`) such that `𝒀 ⊧ ℰ` and `| hom 𝑿 𝑨 | = | hom 𝒀 𝑨 |`. + +**Proof**. `∀ s ≈ t` in `ℰ` and each tuple `b` such that `𝑩 ⟦ s ⟧ b ≢ 𝑩 ⟦ t ⟧ b`, one can compute +the congruence `θ = Cg (𝑩 ⟦ s ⟧ b , 𝑩 ⟦ t ⟧ b)` generated by `𝑩 ⟦ s ⟧ b` and `𝑩 ⟦ t ⟧ b`. +Let `𝑩₁ := 𝑩 / θ`, and note that `| 𝑩₁ | < | 𝑩 |`. + +We show there exists a bijection from `hom 𝑩 𝑨` to `hom 𝑩₁ 𝑨`. +Fix an `h : hom 𝑩 𝑨`. For all `s ≈ t` in `ℰ`, we have + +`h (𝑩 ⟦ s ⟧ b) = 𝑨 ⟦ s ⟧ (h b) = 𝑨 ⟦ t ⟧ (h b) = h (𝑩 ⟦ t ⟧ b)`. + +Therefore, `θ ⊆ ker h`, so `h` factors uniquely as `h = h' ∘ π : 𝑩 → (𝑩 / θ) → 𝑨`, +where `π` is the canonical projection onto `𝑩 / θ`. + +Thus the mapping `φ : hom 𝑩 𝑨 → hom 𝑩₁ 𝑨` that takes each `h` to `h'` such that `h = h' ∘ π` +is injective. It is also surjective since each `g' : 𝑩 / θ → 𝑨` is mapped back to +a `g : 𝑩 → 𝑨` such that `g = g' ∘ π`. Iterating over all identities in `ℰ`, possibly +several times, at the final step we obtain a structure `𝑩ₙ` that satisfies `ℰ` +and is such that `∣ hom 𝑩 𝑨 ∣ = ∣ hom 𝑩ₙ 𝑨 ∣`. Moreover, since the number of elements +in the intermediate structures decreases at each step, `| 𝑩ᵢ₊₁ | < | 𝑩ᵢ |`, the process +finishes in time that is bounded by a polynomial in the size of `𝑩`. + +\begin{code} + +record _⇛_⇚_ (𝑩 𝑨 𝑪 : structure 𝐹 𝑅) : Type ℓ₀ where + field + to : hom 𝑩 𝑨 → hom 𝑪 𝑨 + from : hom 𝑪 𝑨 → hom 𝑩 𝑨 + to∼from : ∀ h → (to ∘ from) h ≡ h + from∼to : ∀ h → (from ∘ to) h ≡ h + + -- TODO: formalize Lemma III.1 + -- module _ {χ : Level}{X : Type χ} + -- {𝑨 : structure 𝐹 𝑅 {ℓ₀} {ℓ₀}} where + -- LEMMAIII1 : {n : ℕ}(ℰ : Fin n → (Term X × Term X))(𝑨 ∈ fMod ℰ) + -- → ∀(𝑩 : structure 𝐹 𝑅) → Σ[ 𝑪 ∈ structure 𝐹 𝑅 ] (𝑪 ∈ fMod ℰ × (𝑩 ⇛ 𝑨 ⇚ 𝑪)) + -- LEMMAIII1 ℰ 𝑨⊧ℰ 𝑩 = {!!} , {!!} +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Graphs](Base.Structures.Graphs.html)</span> +<span style="float:right;">[Base.Structures.Products →](Base.Structures.Products.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Homs.html b/docs/Base.Structures.Homs.html new file mode 100644 index 0000000..9a369a0 --- /dev/null +++ b/docs/Base.Structures.Homs.html @@ -0,0 +1,270 @@ + +
--- +layout: default +title : "Base.Structures.Homs" +date : "2021-06-22" +author: "agda-algebras development team" +--- + +### <a id="homomorphisms-of-general-structures">Homomorphisms of General Structures</a> + +This is the [Base.Structures.Homs][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Homs where + +-- Imports from Agda and the Agda Standard Library ------------------------------------------- +open import Agda.Primitive using () renaming ( lzero to ℓ₀ ; Set to Type ) +open import Axiom.Extensionality.Propositional + using () renaming (Extensionality to funext) +open import Data.Product using ( _×_ ; Σ-syntax ; _,_ ) + renaming ( proj₁ to fst ; proj₂ to snd ) +open import Function.Base using ( _∘_ ; id ) +open import Level using ( _⊔_ ; suc ; Level ; Lift ; lift ) +open import Relation.Binary using ( IsEquivalence ) +open import Relation.Binary.PropositionalEquality + using ( _≡_ ; refl ; sym ; cong ; module ≡-Reasoning ; trans ) + +-- Imports from the Agda Universal Algebra Library --------------------------------------------- +open import Overture using ( _∙_ ; ∣_∣ ; ∥_∥ ; _⁻¹ ; Π-syntax ) +open import Base.Functions using ( Image_∋_ ; IsSurjective ; IsInjective ) +open import Base.Relations using ( ker ; kerlift ; ⟪_⟫ ; mkblk ) +open import Base.Equality using ( swelldef ) + +open import Examples.Structures.Signatures using ( S∅ ) + +open import Base.Structures.Basic using ( signature ; structure ; Lift-Struc ) + using ( Lift-Strucʳ ; Lift-Strucˡ ) + using ( compatible ; siglʳ ; sigl ) + +open import Base.Structures.Congruences using ( con ; _╱_) +open import Base.Structures.Products using ( ⨅ ) +open structure ; open signature + +private variable + 𝓞₀ 𝓥₀ 𝓞₁ 𝓥₁ : Level + 𝐹 : signature 𝓞₀ 𝓥₀ + 𝑅 : signature 𝓞₁ 𝓥₁ + α ρᵃ β ρᵇ γ ρᶜ ℓ : Level + +module _ (𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}) (𝑩 : structure 𝐹 𝑅 {β}{ρᵇ}) where + private + A = carrier 𝑨 + B = carrier 𝑩 + + preserves : (symbol 𝑅) → (A → B) → Type (siglʳ 𝑅 ⊔ α ⊔ ρᵃ ⊔ ρᵇ) + preserves 𝑟 h = ∀ a → ((rel 𝑨) 𝑟 a) → ((rel 𝑩) 𝑟) (h ∘ a) + + is-hom-rel : (A → B) → Type (sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ ρᵇ) + is-hom-rel h = ∀ (r : symbol 𝑅) → preserves r h + + comm-op : (A → B) → (symbol 𝐹) → Type (siglʳ 𝐹 ⊔ α ⊔ β) + comm-op h f = ∀ a → h (((op 𝑨) f) a) ≡ ((op 𝑩) f) (h ∘ a) + + is-hom-op : (A → B) → Type (sigl 𝐹 ⊔ α ⊔ β) + is-hom-op h = ∀ f → comm-op h f + + is-hom : (A → B) → Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + is-hom h = is-hom-rel h × is-hom-op h + + -- homomorphism + hom : Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + hom = Σ[ h ∈ (A → B) ] is-hom h + +-- endomorphism +end : structure 𝐹 𝑅 {α}{ρᵃ} → Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ) +end 𝑨 = hom 𝑨 𝑨 + +module _ {𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} + {𝑩 : structure 𝐹 𝑅 {β}{ρᵇ}} + {𝑪 : structure 𝐹 𝑅 {γ}{ρᶜ}} where + + private A = carrier 𝑨 ; B = carrier 𝑩 ; C = carrier 𝑪 + + ∘-is-hom-rel : (f : A → B)(g : B → C) + → is-hom-rel 𝑨 𝑩 f → is-hom-rel 𝑩 𝑪 g → is-hom-rel 𝑨 𝑪 (g ∘ f) + ∘-is-hom-rel f g fhr ghr R a = λ z → ghr R (λ z₁ → f (a z₁)) (fhr R a z) + + ∘-is-hom-op : (f : A → B)(g : B → C) + → is-hom-op 𝑨 𝑩 f → is-hom-op 𝑩 𝑪 g → is-hom-op 𝑨 𝑪 (g ∘ f) + ∘-is-hom-op f g fho gho 𝑓 a = cong g (fho 𝑓 a) ∙ gho 𝑓 (f ∘ a) + + ∘-is-hom : (f : A → B)(g : B → C) + → is-hom 𝑨 𝑩 f → is-hom 𝑩 𝑪 g → is-hom 𝑨 𝑪 (g ∘ f) + ∘-is-hom f g fhro ghro = ihr , iho + where + ihr : is-hom-rel 𝑨 𝑪 (g ∘ f) + ihr = ∘-is-hom-rel f g ∣ fhro ∣ ∣ ghro ∣ + + iho : is-hom-op 𝑨 𝑪 (g ∘ f) + iho = ∘-is-hom-op f g ∥ fhro ∥ ∥ ghro ∥ + + ∘-hom : hom 𝑨 𝑩 → hom 𝑩 𝑪 → hom 𝑨 𝑪 + ∘-hom (f , fh) (g , gh) = g ∘ f , ∘-is-hom f g fh gh + + +𝒾𝒹 : {𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} → end 𝑨 +𝒾𝒹 = id , (λ _ _ z → z) , (λ _ _ → refl) + + +module _ {𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} {𝑩 : structure 𝐹 𝑅 {β}{ρᵇ}} where + + private A = carrier 𝑨 ; B = carrier 𝑩 + + is-mon : (A → B) → Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + is-mon g = is-hom 𝑨 𝑩 g × IsInjective g + + mon : Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + mon = Σ[ g ∈ (A → B) ] is-mon g + + mon→hom : mon → hom 𝑨 𝑩 + mon→hom ϕ = ∣ ϕ ∣ , fst ∥ ϕ ∥ + + is-epi : (A → B) → Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + is-epi g = is-hom 𝑨 𝑩 g × IsSurjective g + + epi : Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + epi = Σ[ g ∈ (A → B) ] is-epi g + + epi→hom : epi → hom 𝑨 𝑩 + epi→hom ϕ = ∣ ϕ ∣ , fst ∥ ϕ ∥ + +open Lift + +𝓁𝒾𝒻𝓉ˡ : {ℓ : Level}{𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} → hom 𝑨 (Lift-Strucˡ ℓ 𝑨) +𝓁𝒾𝒻𝓉ˡ = lift , (λ _ _ x → x) , λ _ _ → refl + +𝓁𝒾𝒻𝓉ʳ : {ρ : Level}{𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} → hom 𝑨 (Lift-Strucʳ ρ 𝑨) +𝓁𝒾𝒻𝓉ʳ = id , (λ _ _ x → lift x) , λ _ _ → refl + +𝓁𝒾𝒻𝓉 : {ℓˡ ℓʳ : Level}{𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} → hom 𝑨 (Lift-Struc ℓˡ ℓʳ 𝑨) +𝓁𝒾𝒻𝓉 = lift , ((λ _ _ x → lift x) , λ _ _ → refl) + +𝓁ℴ𝓌ℯ𝓇ˡ : {ℓ : Level}{𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} → hom (Lift-Strucˡ ℓ 𝑨) 𝑨 +𝓁ℴ𝓌ℯ𝓇ˡ = lower , (λ _ _ x → x) , (λ _ _ → refl) + +𝓁ℴ𝓌ℯ𝓇ʳ : {ρ : Level}{𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} → hom (Lift-Strucʳ ρ 𝑨) 𝑨 +𝓁ℴ𝓌ℯ𝓇ʳ = id , ((λ _ _ x → lower x) , λ _ _ → refl) + +𝓁ℴ𝓌ℯ𝓇 : {ℓˡ ℓʳ : Level}{𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} → hom (Lift-Struc ℓˡ ℓʳ 𝑨) 𝑨 +𝓁ℴ𝓌ℯ𝓇 = lower , (λ _ _ x → lower x) , (λ _ _ → refl) +\end{code} + + +#### <a id="kernels-of-homomorphisms">Kernels of homomorphisms</a> + +\begin{code} + +open ≡-Reasoning +module _ {𝑨 : structure 𝐹 𝑅 {α}{β ⊔ ρᵃ}}{𝑩 : structure 𝐹 𝑅 {β} {ρᵇ}} where + + homker-comp : (h : hom 𝑨 𝑩){wd : swelldef (siglʳ 𝐹) β} + → compatible 𝑨 (ker ∣ h ∣) + + homker-comp (h , hhom) {wd} f {u}{v} kuv = + h (((op 𝑨)f) u) ≡⟨ ∥ hhom ∥ f u ⟩ + ((op 𝑩) f)(h ∘ u) ≡⟨ wd ((op 𝑩)f) (h ∘ u) (h ∘ v) kuv ⟩ + ((op 𝑩) f)(h ∘ v) ≡⟨ (∥ hhom ∥ f v)⁻¹ ⟩ + h (((op 𝑨)f) v) ∎ + + kerlift-comp : (h : hom 𝑨 𝑩){wd : swelldef (siglʳ 𝐹) β} + → compatible 𝑨 (kerlift ∣ h ∣ (α ⊔ ρᵃ) ) + + kerlift-comp (h , hhom) {wd} f {u}{v} kuv = lift goal + where + goal : h (op 𝑨 f u) ≡ h (op 𝑨 f v) + goal = h (op 𝑨 f u) ≡⟨ ∥ hhom ∥ f u ⟩ + (op 𝑩 f)(h ∘ u) ≡⟨ wd (op 𝑩 f)(h ∘ u)(h ∘ v)(lower ∘ kuv) ⟩ + (op 𝑩 f)(h ∘ v) ≡⟨ (∥ hhom ∥ f v ) ⁻¹ ⟩ + h (op 𝑨 f v) ∎ + + + kercon : hom 𝑨 𝑩 → {wd : swelldef (siglʳ 𝐹) β} → con 𝑨 + kercon (h , hhom) {wd} = ((λ x y → Lift (α ⊔ ρᵃ) (h x ≡ h y)) , goal) + , kerlift-comp (h , hhom) {wd} + where + goal : IsEquivalence (λ x y → Lift (α ⊔ ρᵃ) (h x ≡ h y)) + goal = record { refl = lift refl + ; sym = λ p → lift (sym (lower p)) + ; trans = λ p q → lift (trans (lower p)(lower q)) + } + + kerquo : hom 𝑨 𝑩 → {wd : swelldef (siglʳ 𝐹) β} + → structure 𝐹 𝑅 {suc (α ⊔ β ⊔ ρᵃ)} {β ⊔ ρᵃ} + + kerquo h {wd} = 𝑨 ╱ (kercon h {wd}) + +ker[_⇒_] : (𝑨 : structure 𝐹 𝑅 {α} {β ⊔ ρᵃ} )(𝑩 : structure 𝐹 𝑅 {β}{ρᵇ} ) + → hom 𝑨 𝑩 → {wd : swelldef (siglʳ 𝐹) β} → structure 𝐹 𝑅 + +ker[_⇒_] {ρᵃ = ρᵃ} 𝑨 𝑩 h {wd} = kerquo{ρᵃ = ρᵃ}{𝑨 = 𝑨}{𝑩} h {wd} +\end{code} + + +#### <a id="canonical-projections">Canonical projections</a> + +\begin{code} + +module _ {𝑨 : structure 𝐹 𝑅 {α}{ρᵃ} } where + + open Image_∋_ + + πepi : (θ : con 𝑨) → epi {𝑨 = 𝑨}{𝑩 = 𝑨 ╱ θ} + πepi θ = (λ a → ⟪ a ⟫ {fst ∣ θ ∣}) , (γrel , (λ _ _ → refl)) , cπ-is-epic + where + γrel : is-hom-rel 𝑨 (𝑨 ╱ θ) (λ a → ⟪ a ⟫ {fst ∣ θ ∣}) + γrel R a x = x + cπ-is-epic : IsSurjective (λ a → ⟪ a ⟫ {fst ∣ θ ∣}) + cπ-is-epic (C , mkblk a refl) = eq a refl + + πhom : (θ : con 𝑨) → hom 𝑨 (𝑨 ╱ θ) + πhom θ = epi→hom {𝑨 = 𝑨} {𝑩 = (𝑨 ╱ θ)} (πepi θ) + +module _ {𝑨 : structure 𝐹 𝑅 {α}{β ⊔ ρᵃ}}{𝑩 : structure 𝐹 𝑅 {β} {ρᵇ}} where + + πker : (h : hom 𝑨 𝑩){wd : swelldef (siglʳ 𝐹) β} + → epi {𝑨 = 𝑨} {𝑩 = (ker[_⇒_]{ρᵃ = ρᵃ} 𝑨 𝑩 h {wd})} + + πker h {wd} = πepi (kercon{ρᵃ = ρᵃ} {𝑨 = 𝑨}{𝑩 = 𝑩} h {wd}) + + +module _ {I : Type ℓ} where + + module _ {𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}}{ℬ : I → structure 𝐹 𝑅 {β}{ρᵇ}} where + + ⨅-hom-co : funext ℓ β → (∀(i : I) → hom 𝑨 (ℬ i)) → hom 𝑨 (⨅ ℬ) + ⨅-hom-co fe h = (λ a i → ∣ h i ∣ a) + , (λ R a x 𝔦 → fst ∥ h 𝔦 ∥ R a x) + , λ f a → fe (λ i → snd ∥ h i ∥ f a) + + module _ {𝒜 : I → structure 𝐹 𝑅 {α}{ρᵃ}} + {ℬ : I → structure 𝐹 𝑅 {β}{ρᵇ}} where + + ⨅-hom : funext ℓ β → Π[ i ∈ I ] hom (𝒜 i)(ℬ i) → hom (⨅ 𝒜)(⨅ ℬ) + ⨅-hom fe h = (λ a i → ∣ h i ∣ (a i)) + , (λ R a x 𝔦 → fst ∥ h 𝔦 ∥ R (λ z → a z 𝔦) (x 𝔦)) + , λ f a → fe (λ i → snd ∥ h i ∥ f λ z → a z i) + + -- Projection out of products + module _ {𝒜 : I → structure 𝐹 𝑅 {α}{ρᵃ}} where + ⨅-projection-hom : Π[ i ∈ I ] hom (⨅ 𝒜) (𝒜 i) + ⨅-projection-hom = λ x → (λ z → z x) , (λ R a z → z x) , λ f a → refl + +-- The special case when 𝑅 = ∅ (i.e., purely algebraic structures) +module _ {𝑨 : structure 𝐹 S∅ {α}{ℓ₀}} {𝑩 : structure 𝐹 S∅ {β}{ℓ₀}} where + + -- The type of homomorphisms from one algebraic structure to another. + hom-alg : Type (sigl 𝐹 ⊔ α ⊔ β) + hom-alg = Σ[ h ∈ ((carrier 𝑨) → (carrier 𝑩)) ] is-hom-op 𝑨 𝑩 h +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Congruences](Base.Structures.Congruences.html)</span> +<span style="float:right;">[Base.Structures.Isos →](Base.Structures.Isos.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Isos.html b/docs/Base.Structures.Isos.html new file mode 100644 index 0000000..8343c00 --- /dev/null +++ b/docs/Base.Structures.Isos.html @@ -0,0 +1,273 @@ + +
--- +layout: default +title : "Base.Structures.Isos module (The Agda Universal Algebra Library)" +date : "2021-07-23" +author: "agda-algebras development team" +--- + +### <a id="isomorphisms">Isomorphisms</a> + +This is the [Base.Structures.Isos][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Isos where + +-- Imports from Agda and the Agda Standard Library --------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Axiom.Extensionality.Propositional + using () renaming (Extensionality to funext) +open import Data.Product using ( _,_ ; Σ-syntax ; _×_ ) + renaming ( proj₁ to fst ; proj₂ to snd ) +open import Function using ( _∘_ ) +open import Level using ( _⊔_ ; Level ; Lift ) +open import Relation.Binary.PropositionalEquality as ≡ + using ( module ≡-Reasoning ; cong-app ) + +-- Imports from the Agda Universal Algebra Library --------------------------------------------- +open import Overture using ( ∣_∣ ; _≈_ ; ∥_∥ ; _∙_ ; lower∼lift ; lift∼lower ) + +open import Base.Structures.Basic using ( signature ; structure ; Lift-Strucˡ ) + using ( Lift-Strucʳ ; Lift-Struc ; sigl ) + using ( siglˡ ; siglʳ ) +open import Base.Structures.Homs using ( hom ; 𝒾𝒹 ; ∘-hom ; 𝓁𝒾𝒻𝓉 ; 𝓁ℴ𝓌ℯ𝓇 ; 𝓁𝒾𝒻𝓉ˡ ) + using ( 𝓁ℴ𝓌ℯ𝓇ˡ ; 𝓁𝒾𝒻𝓉ʳ ; 𝓁ℴ𝓌ℯ𝓇ʳ ; is-hom ) +open import Base.Structures.Products + using ( ⨅ ; ℓp ; ℑ ; class-product ) +private variable + 𝓞₀ 𝓥₀ 𝓞₁ 𝓥₁ α ρᵃ β ρᵇ γ ρᶜ ρ ℓ ι : Level + 𝐹 : signature 𝓞₀ 𝓥₀ + 𝑅 : signature 𝓞₁ 𝓥₁ +\end{code} + + +#### <a id="definition-of-isomorphism">Definition of Isomorphism</a> + +Recall, `f ≈ g` means f and g are *extensionally* (or pointwise) equal; i.e., `∀ x, f x ≡ g x`. +We use this notion of equality of functions in the following definition of *isomorphism*. + +\begin{code} + +record _≅_ (𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}) + (𝑩 : structure 𝐹 𝑅 {β}{ρᵇ}) : Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + where + + constructor mkiso + field + to : hom 𝑨 𝑩 + from : hom 𝑩 𝑨 + to∼from : ∣ to ∣ ∘ ∣ from ∣ ≈ ∣ 𝒾𝒹 {𝑨 = 𝑩} ∣ + from∼to : ∣ from ∣ ∘ ∣ to ∣ ≈ ∣ 𝒾𝒹 {𝑨 = 𝑨} ∣ + +open _≅_ public + +\end{code} + +That is, two structures are isomorphic provided there are homomorphisms going back and forth between them which compose to the identity map. + + +#### <a id="isomorphism-is-an-equivalence-relation">Isomorphism is an equivalence relation</a> + +\begin{code} + +module _ {𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} where + + ≅-refl : 𝑨 ≅ 𝑨 + ≅-refl = mkiso 𝒾𝒹 𝒾𝒹 (λ _ → ≡.refl) (λ _ → ≡.refl) + + module _ {𝑩 : structure 𝐹 𝑅 {β}{ρᵇ}} where + ≅-sym : 𝑨 ≅ 𝑩 → 𝑩 ≅ 𝑨 + ≅-sym φ = mkiso (from φ) (to φ) (from∼to φ) (to∼from φ) + + module _ {𝑪 : structure 𝐹 𝑅 {γ}{ρᶜ}} where + ≅-trans : 𝑨 ≅ 𝑩 → 𝑩 ≅ 𝑪 → 𝑨 ≅ 𝑪 + ≅-trans φab φbc = mkiso f g τ ν + where + f : hom 𝑨 𝑪 + f = ∘-hom {𝑨 = 𝑨}{𝑩}{𝑪} (to φab) (to φbc) + g : hom 𝑪 𝑨 + g = ∘-hom {𝑨 = 𝑪}{𝑩}{𝑨} (from φbc) (from φab) + + τ : ∣ f ∣ ∘ ∣ g ∣ ≈ ∣ 𝒾𝒹 {𝑨 = 𝑪} ∣ + τ x = ( ≡.cong ∣ to φbc ∣ (to∼from φab (∣ from φbc ∣ x)) ) ∙ (to∼from φbc) x + + ν : ∣ g ∣ ∘ ∣ f ∣ ≈ ∣ 𝒾𝒹 {𝑨 = 𝑨} ∣ + ν x = ( ≡.cong ∣ from φab ∣ (from∼to φbc (∣ to φab ∣ x)) ) ∙ (from∼to φab) x +\end{code} + + +#### <a id="lift-is-an-algebraic-invariant">Lift is an algebraic invariant</a> + +Fortunately, the lift operation preserves isomorphism (i.e., it's an *algebraic invariant*). As our focus is universal algebra, this is important and is what makes the lift operation a workable solution to the technical problems that arise from the noncumulativity of the universe hierarchy discussed in the [Base.Overture][] module. + +\begin{code} + +open Level + +module _ {𝑨 : structure 𝐹 𝑅{α}{ρᵃ}} where + + Lift-≅ˡ : 𝑨 ≅ (Lift-Strucˡ ℓ 𝑨) + Lift-≅ˡ = record { to = 𝓁𝒾𝒻𝓉ˡ + ; from = 𝓁ℴ𝓌ℯ𝓇ˡ {𝑨 = 𝑨} + ; to∼from = cong-app lift∼lower + ; from∼to = cong-app (lower∼lift{α}{ρᵃ}) + } + + Lift-≅ʳ : 𝑨 ≅ (Lift-Strucʳ ℓ 𝑨) + Lift-≅ʳ = record { to = 𝓁𝒾𝒻𝓉ʳ + ; from = 𝓁ℴ𝓌ℯ𝓇ʳ + ; to∼from = cong-app ≡.refl + ; from∼to = cong-app ≡.refl + } + + Lift-≅ : 𝑨 ≅ (Lift-Struc ℓ ρ 𝑨) + Lift-≅ = record { to = 𝓁𝒾𝒻𝓉 + ; from = 𝓁ℴ𝓌ℯ𝓇 {𝑨 = 𝑨} + ; to∼from = cong-app lift∼lower + ; from∼to = cong-app (lower∼lift{α}{ρᵃ}) + } + +module _ {𝑨 : structure 𝐹 𝑅{α}{ρᵃ}} {𝑩 : structure 𝐹 𝑅{β}{ρᵇ}} where + + Lift-Strucˡ-iso : (ℓ ℓ' : Level) → 𝑨 ≅ 𝑩 → Lift-Strucˡ ℓ 𝑨 ≅ Lift-Strucˡ ℓ' 𝑩 + Lift-Strucˡ-iso ℓ ℓ' A≅B = ≅-trans ( ≅-trans (≅-sym Lift-≅ˡ) A≅B ) Lift-≅ˡ + + + Lift-Struc-iso : (ℓ ρ ℓ' ρ' : Level) → 𝑨 ≅ 𝑩 + → Lift-Struc ℓ ρ 𝑨 ≅ Lift-Struc ℓ' ρ' 𝑩 + + Lift-Struc-iso ℓ ρ ℓ' ρ' A≅B = ≅-trans ( ≅-trans (≅-sym Lift-≅) A≅B ) Lift-≅ +\end{code} + + +#### <a id="lift-associativity">Lift associativity</a> + +The lift is also associative, up to isomorphism at least. + +\begin{code} + +module _ {𝑨 : structure 𝐹 𝑅 {α}{ρᵃ} } where + + Lift-Struc-assocˡ : {ℓ ℓ' : Level} + → Lift-Strucˡ (ℓ ⊔ ℓ') 𝑨 ≅ (Lift-Strucˡ ℓ (Lift-Strucˡ ℓ' 𝑨)) + + Lift-Struc-assocˡ {ℓ}{ℓ'} = ≅-trans (≅-trans Goal Lift-≅ˡ) Lift-≅ˡ + where + Goal : Lift-Strucˡ (ℓ ⊔ ℓ') 𝑨 ≅ 𝑨 + Goal = ≅-sym Lift-≅ˡ + + Lift-Struc-assocʳ : {ρ ρ' : Level} + → Lift-Strucʳ (ρ ⊔ ρ') 𝑨 ≅ (Lift-Strucʳ ρ (Lift-Strucʳ ρ' 𝑨)) + + Lift-Struc-assocʳ {ρ}{ρ'} = ≅-trans (≅-trans Goal Lift-≅ʳ) Lift-≅ʳ + where + Goal : Lift-Strucʳ (ρ ⊔ ρ') 𝑨 ≅ 𝑨 + Goal = ≅-sym Lift-≅ʳ + + Lift-Struc-assoc : {ℓ ℓ' ρ ρ' : Level} + → Lift-Struc (ℓ ⊔ ℓ') (ρ ⊔ ρ') 𝑨 ≅ (Lift-Struc ℓ ρ (Lift-Struc ℓ' ρ' 𝑨)) + Lift-Struc-assoc {ℓ}{ℓ'}{ρ}{ρ'} = ≅-trans (≅-trans Goal Lift-≅ ) Lift-≅ + where + Goal : Lift-Struc (ℓ ⊔ ℓ') (ρ ⊔ ρ') 𝑨 ≅ 𝑨 + Goal = ≅-sym Lift-≅ +\end{code} + + +#### <a id="products-preserve-isomorphisms">Products preserve isomorphisms</a> + +Products of isomorphic families of algebras are themselves isomorphic. +The proof looks a bit technical, but it is as straightforward as it ought to be. + +\begin{code} + +module _ {I : Type ι} + {𝒜 : I → structure 𝐹 𝑅{α}{ρᵃ}} + {ℬ : I → structure 𝐹 𝑅{β}{ρᵇ}} where + open structure + open ≡-Reasoning + + ⨅≅ : funext ι α → funext ι β → (∀ (i : I) → 𝒜 i ≅ ℬ i) → ⨅ 𝒜 ≅ ⨅ ℬ + + ⨅≅ fiu fiw AB = record { to = ϕ , ϕhom + ; from = ψ , ψhom + ; to∼from = ϕ~ψ + ; from∼to = ψ~ϕ + } + where + ϕ : carrier (⨅ 𝒜) → carrier (⨅ ℬ) + ϕ a i = ∣ to (AB i) ∣ (a i) + + ϕhom : is-hom (⨅ 𝒜) (⨅ ℬ) ϕ + ϕhom = ( λ r a x 𝔦 → fst ∥ to (AB 𝔦) ∥ r (λ z → a z 𝔦) (x 𝔦)) + , λ f a → fiw (λ i → snd ∥ to (AB i) ∥ f λ z → a z i) + ψ : carrier (⨅ ℬ) → carrier (⨅ 𝒜) + ψ b i = ∣ from (AB i) ∣ (b i) + + ψhom : is-hom (⨅ ℬ) (⨅ 𝒜) ψ + ψhom = ( λ r a x 𝔦 → fst ∥ from (AB 𝔦) ∥ r (λ z → a z 𝔦) (x 𝔦)) + , λ f a → fiu (λ i → snd ∥ from (AB i) ∥ f λ z → a z i) + + ϕ~ψ : ϕ ∘ ψ ≈ ∣ 𝒾𝒹 {𝑨 = ⨅ ℬ} ∣ + ϕ~ψ 𝒃 = fiw λ i → (to∼from (AB i)) (𝒃 i) + + ψ~ϕ : ψ ∘ ϕ ≈ ∣ 𝒾𝒹 {𝑨 = ⨅ 𝒜} ∣ + ψ~ϕ a = fiu λ i → (from∼to (AB i)) (a i) + +\end{code} + +A nearly identical proof goes through for isomorphisms of lifted products (though, +just for fun, we use the universal quantifier syntax here to express the dependent +function type in the statement of the lemma, instead of the Pi notation we used in +the statement of the previous lemma; that is, `∀ i → 𝒜 i ≅ ℬ (lift i)` instead of +`Π i ꞉ I , 𝒜 i ≅ ℬ (lift i)`.) + +\begin{code} + +module _ {I : Type ι} + {𝒜 : I → structure 𝐹 𝑅 {α}{ρᵃ}} + {ℬ : (Lift γ I) → structure 𝐹 𝑅 {β}{ρᵇ}} where + + open structure + + Lift-Struc-⨅≅ : funext (ι ⊔ γ) β → funext ι α + → (∀ i → 𝒜 i ≅ ℬ (lift i)) → Lift-Strucˡ γ (⨅ 𝒜) ≅ ⨅ ℬ + + Lift-Struc-⨅≅ fizw fiu AB = Goal + where + ϕ : carrier (⨅ 𝒜) → carrier (⨅ ℬ) + ϕ a i = ∣ to (AB (lower i)) ∣ (a (lower i)) + + ϕhom : is-hom (⨅ 𝒜) (⨅ ℬ) ϕ + ϕhom = ( λ r a x i → fst ∥ to (AB (lower i)) ∥ r (λ x₁ → a x₁ (lower i)) (x (lower i))) + , λ f a → fizw (λ i → snd ∥ to (AB (lower i)) ∥ f λ x → a x (lower i)) + + ψ : carrier (⨅ ℬ) → carrier (⨅ 𝒜) + ψ b i = ∣ from (AB i) ∣ (b (lift i)) + + ψhom : is-hom (⨅ ℬ) (⨅ 𝒜) ψ + ψhom = ( λ r a x i → fst ∥ from (AB i) ∥ r (λ x₁ → a x₁ (lift i)) (x (lift i))) + , λ f a → fiu (λ i → snd ∥ from (AB i) ∥ f λ x → a x (lift i)) + + ϕ~ψ : ϕ ∘ ψ ≈ ∣ 𝒾𝒹 {𝑨 = (⨅ ℬ)} ∣ + ϕ~ψ b = fizw λ i → to∼from (AB (lower i)) (b i) + + ψ~ϕ : ψ ∘ ϕ ≈ ∣ 𝒾𝒹 {𝑨 = (⨅ 𝒜)} ∣ + ψ~ϕ a = fiu λ i → from∼to (AB i) (a i) + + A≅B : ⨅ 𝒜 ≅ ⨅ ℬ + A≅B = mkiso (ϕ , ϕhom) (ψ , ψhom) ϕ~ψ ψ~ϕ + + Goal : Lift-Strucˡ γ (⨅ 𝒜) ≅ ⨅ ℬ + Goal = ≅-trans (≅-sym Lift-≅ˡ) A≅B +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Homs](Base.Structures.Homs.html)</span> +<span style="float:right;">[Base.Structures.Terms →](Base.Structures.Terms.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Products.html b/docs/Base.Structures.Products.html new file mode 100644 index 0000000..b496247 --- /dev/null +++ b/docs/Base.Structures.Products.html @@ -0,0 +1,66 @@ + +
--- +layout: default +title : "Sturctures.Products module" +date : "2021-05-11" +author: "agda-algebras development team" +--- + +### <a id="products-for-structures-as-records">Products for structures as records</a> + +This is the [Base.Structures.Products][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Products where + +-- Imports from the Agda Standard Library ---------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; Σ-syntax ) +open import Level using ( Level ; suc ; _⊔_ ) +open import Relation.Unary using ( _∈_ ; Pred ) + +-- Imports from the Agda Universal Algebra Library ------------------------- +open import Overture using ( ∣_∣ ; Π-syntax ) +open import Base.Structures.Basic using ( signature ; structure ) + + +private variable + 𝓞₀ 𝓥₀ 𝓞₁ 𝓥₁ : Level + 𝐹 : signature 𝓞₀ 𝓥₀ + 𝑅 : signature 𝓞₁ 𝓥₁ + α ρ ℓ : Level + +open structure + +⨅ : {ℑ : Type ℓ}(𝒜 : ℑ → structure 𝐹 𝑅 {α}{ρ} ) → structure 𝐹 𝑅 +⨅ {ℑ = ℑ} 𝒜 = + record { carrier = Π[ i ∈ ℑ ] carrier (𝒜 i) -- domain of the product structure + ; op = λ 𝑓 a i → (op (𝒜 i) 𝑓) λ x → a x i -- interpretation of operations + ; rel = λ r a → ∀ i → (rel (𝒜 i) r) λ x → a x i -- interpretation of relations + } + + +module _ {𝒦 : Pred (structure 𝐹 𝑅 {α}{ρ}) ℓ} where + ℓp : Level + ℓp = suc (α ⊔ ρ) ⊔ ℓ + + ℑ : Type _ + ℑ = Σ[ 𝑨 ∈ structure 𝐹 𝑅 {α}{ρ}] 𝑨 ∈ 𝒦 + + 𝔄 : ℑ → structure 𝐹 𝑅 {α}{ρ} + 𝔄 𝔦 = ∣ 𝔦 ∣ + + class-product : structure 𝐹 𝑅 + class-product = ⨅ 𝔄 +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Graphs0](Base.Structures.Graphs0.html)</span> +<span style="float:right;">[Base.Structures.Congruences →](Base.Structures.Congruences.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Sigma.Basic.html b/docs/Base.Structures.Sigma.Basic.html new file mode 100644 index 0000000..fe78ca9 --- /dev/null +++ b/docs/Base.Structures.Sigma.Basic.html @@ -0,0 +1,110 @@ + +
--- +layout: default +title : "Base.Structures.Sigma.Basic module" +date : "2021-05-20" +author: "agda-algebras development team" +--- + +#### <a id="basic-definitions">Basic Definitions</a> + +This is the [Base.Structures.Sigma.Basic][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Sigma.Basic where + +-- Imports from the Agda Standard Library ------------------------------------------------ +open import Agda.Primitive using () renaming ( Set to Type ; lzero to ℓ₀ ) +open import Data.Product using ( _,_ ; _×_ ; Σ-syntax ) + renaming ( proj₁ to fst ; proj₂ to snd ) +open import Level using ( _⊔_ ; suc ; Level ) +open import Relation.Binary.Core using ( _⇒_ ; _=[_]⇒_ ) + renaming ( REL to BinREL ; Rel to BinRel ) + +-- Imports from the Agda Universal Algebra Library --------------------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ; ℓ₁ ; Op ) +open import Base.Relations using ( _|:_ ; _preserves_ ; Rel ) + +-- Inhabitants of Signature type are pairs, (s , ar), where s is an operation symbol, +Signature : Type ℓ₁ -- OR a relation symbol (new!), +Signature = Σ[ F ∈ Type ℓ₀ ] (F → Type ℓ₀) -- and ar the arity of s. + +Structure : (𝑅 F : Signature){α ρ : Level} → Type (suc (α ⊔ ρ)) +Structure 𝑅 𝐹 {α}{ρ} = + Σ[ A ∈ Type α ] -- the domain of the structure is A + ( ((r : ∣ 𝑅 ∣) → Rel A (snd 𝑅 r){ρ}) -- the interpretations of the relation symbols + × ((f : ∣ 𝐹 ∣) → Op A (snd 𝐹 f)) ) -- the interpretations of the operation symbols + +RStructure : Signature → {α ρ : Level} → Type (suc (α ⊔ ρ)) +RStructure 𝑅 {α} {ρ} = Σ[ A ∈ Type α ] ∀(r : ∣ 𝑅 ∣) → Rel A (snd 𝑅 r) {ρ} + +AStructure : Signature → {α : Level} → Type (suc α) +AStructure 𝐹 {α} = Σ[ A ∈ Type α ] ∀ (f : ∣ 𝐹 ∣) → Op A (snd 𝐹 f) + +module _ {𝑅 𝐹 : Signature} {α ρ : Level} where + +-- Reducts + Structure→RStructure : Structure 𝑅 𝐹 {α}{ρ} → RStructure 𝑅 {α}{ρ} + Structure→RStructure (A , (ℛ , _)) = A , ℛ + + Structure→AStructure : Structure 𝑅 𝐹 {α}{ρ} → AStructure 𝐹 + Structure→AStructure (A , (_ , ℱ)) = A , ℱ + + -- Syntax for interpretation of relations and operations. + _⟦_⟧ᵣ : (𝒜 : Structure 𝑅 𝐹 {α}{ρ})(𝑟 : ∣ 𝑅 ∣) → Rel ∣ 𝒜 ∣ (∥ 𝑅 ∥ 𝑟) {ρ} + 𝒜 ⟦ 𝑟 ⟧ᵣ = λ a → (fst ∥ 𝒜 ∥ 𝑟) a + + _⟦_⟧ₒ : (𝒜 : Structure 𝑅 𝐹 {α}{ρ})(𝑓 : ∣ 𝐹 ∣) → Op ∣ 𝒜 ∣ (∥ 𝐹 ∥ 𝑓) + 𝒜 ⟦ 𝑓 ⟧ₒ = λ a → (snd ∥ 𝒜 ∥ 𝑓) a + + _ʳ_ : (𝑟 : ∣ 𝑅 ∣)(𝒜 : Structure 𝑅 𝐹 {α}) → Rel ∣ 𝒜 ∣ (∥ 𝑅 ∥ 𝑟){ρ} + 𝑟 ʳ 𝒜 = λ a → (𝒜 ⟦ 𝑟 ⟧ᵣ) a + + _ᵒ_ : (𝑓 : ∣ 𝐹 ∣)(𝒜 : Structure 𝑅 𝐹 {α}{ρ}) → Op ∣ 𝒜 ∣(∥ 𝐹 ∥ 𝑓) + 𝑓 ᵒ 𝒜 = λ a → (𝒜 ⟦ 𝑓 ⟧ₒ) a + + Compatible : {ρ' : Level}(𝑨 : Structure 𝑅 𝐹{α}{ρ}) → BinRel ∣ 𝑨 ∣ ρ' → Type (α ⊔ ρ') + Compatible 𝑨 r = ∀ 𝑓 → (𝑓 ᵒ 𝑨) |: r + + Compatible' : {ρ' : Level}(𝑨 : Structure 𝑅 𝐹 {α}{ρ}) → BinRel ∣ 𝑨 ∣ ρ' → Type (α ⊔ ρ') + Compatible' 𝑨 r = ∀ 𝑓 → (𝑓 ᵒ 𝑨) preserves r + + open Level + + Lift-op : {I : Type ℓ₀}{A : Type α} → Op A I → (ℓ : Level) → Op (Lift ℓ A) I + Lift-op f ℓ = λ x → lift (f (λ i → lower (x i))) + + Lift-rel : {I : Type ℓ₀}{A : Type α} → Rel A I {ρ} → (ℓ : Level) → Rel (Lift ℓ A) I{ρ} + Lift-rel r ℓ x = r (λ i → lower (x i)) + + Lift-Strucˡ : (ℓ : Level) → Structure 𝑅 𝐹 {α}{ρ} → Structure 𝑅 𝐹 {α = (α ⊔ ℓ)}{ρ} + Lift-Strucˡ ℓ 𝑨 = Lift ℓ ∣ 𝑨 ∣ , (lrel , lop ) + where + lrel : (r : ∣ 𝑅 ∣) → Rel (Lift ℓ ∣ 𝑨 ∣)(∥ 𝑅 ∥ r){ρ} + lrel r = λ x → ((r ʳ 𝑨) (λ i → lower (x i))) + lop : (f : ∣ 𝐹 ∣) → Op (Lift ℓ ∣ 𝑨 ∣) (∥ 𝐹 ∥ f) + lop f = λ x → lift ((f ᵒ 𝑨)( λ i → lower (x i))) + + Lift-Strucʳ : (ℓ : Level) → Structure 𝑅 𝐹 {α}{ρ} → Structure 𝑅 𝐹 {α}{ρ = (ρ ⊔ ℓ)} + Lift-Strucʳ ℓ 𝑨 = ∣ 𝑨 ∣ , lrel , snd ∥ 𝑨 ∥ + where + lrel : (r : ∣ 𝑅 ∣) → Rel (∣ 𝑨 ∣)(∥ 𝑅 ∥ r){ρ ⊔ ℓ} + lrel r = λ x → Lift ℓ ((r ʳ 𝑨) x) -- λ x → ((r ʳ 𝑨) (λ i → lower (x i))) + +module _ {𝑅 𝐹 : Signature} {α ρ : Level} where + + Lift-Struc : (ℓˡ ℓʳ : Level) → Structure 𝑅 𝐹 {α}{ρ} → Structure 𝑅 𝐹 {α ⊔ ℓˡ}{ρ ⊔ ℓʳ} + Lift-Struc ℓˡ ℓʳ 𝑨 = Lift-Strucʳ ℓʳ (Lift-Strucˡ ℓˡ 𝑨) + +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Sigma](Base.Structures.Sigma.html)</span> +<span style="float:right;">[Base.Structures.Sigma.Products →](Base.Structures.Sigma.Products.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Sigma.Congruences.html b/docs/Base.Structures.Sigma.Congruences.html new file mode 100644 index 0000000..fcd30c4 --- /dev/null +++ b/docs/Base.Structures.Sigma.Congruences.html @@ -0,0 +1,92 @@ + +
--- +layout: default +title : "Base.Structures.Sigma.Congruences module" +date : "2021-05-12" +author: "agda-algebras development team" +--- + +#### <a id="congruences-of-general-structures">Congruences of general structures</a> + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Sigma.Congruences where + +-- Imports from the Agda Standard Library ------------------------------------------------ +open import Agda.Primitive using () renaming ( Set to Type ; lzero to ℓ₀ ) +open import Data.Product using ( _,_ ; _×_ ; Σ-syntax ) renaming ( proj₁ to fst ) +open import Function using ( _∘_ ) +open import Level using ( _⊔_ ; suc ; Level ; Lift ; lift ; lower ) +open import Relation.Unary using ( Pred ; _∈_ ) +open import Relation.Binary using ( IsEquivalence ) renaming ( Rel to BinRel ) +open import Relation.Binary.PropositionalEquality using ( _≡_ ) + +-- Imports from the Agda Universal Algebra Library --------------------------------------- +open import Overture using ( ∣_∣ ) +open import Base.Equality using ( swelldef ) +open import Base.Relations using ( _|:_ ; 0[_] ; Equivalence ; ⟪_⟫ ; ⌞_⌟ ) + using ( 0[_]Equivalence ; _/_ ; ⟪_∼_⟫-elim ; Quotient ) +open import Base.Structures.Sigma.Basic + using ( Signature ; Structure ; _ᵒ_ ; Compatible ; _ʳ_ ) + +private variable 𝑅 𝐹 : Signature + +module _ {α ρ : Level} where + + Con : (𝑨 : Structure 𝑅 𝐹 {α}{ρ}) → Type (suc (α ⊔ ρ)) + Con 𝑨 = Σ[ θ ∈ Equivalence ∣ 𝑨 ∣{α ⊔ ρ} ] (Compatible 𝑨 ∣ θ ∣) + + -- The zero congruence of a structure. + 0[_]Compatible : (𝑨 : Structure 𝑅 𝐹 {α}{ρ}) → swelldef ℓ₀ α + → (𝑓 : ∣ 𝐹 ∣) → (𝑓 ᵒ 𝑨) |: (0[ ∣ 𝑨 ∣ ]{ρ}) + + 0[ 𝑨 ]Compatible wd 𝑓 {i}{j} ptws0 = lift γ + where + γ : (𝑓 ᵒ 𝑨) i ≡ (𝑓 ᵒ 𝑨) j + γ = wd (𝑓 ᵒ 𝑨) i j (lower ∘ ptws0) + + 0Con[_] : (𝑨 : Structure 𝑅 𝐹 {α}{ρ}) → swelldef ℓ₀ α → Con 𝑨 + 0Con[ 𝑨 ] wd = 0[ ∣ 𝑨 ∣ ]Equivalence , 0[ 𝑨 ]Compatible wd +\end{code} + + +#### <a id="quotient-structures">Quotients of structures of sigma type</a> + +\begin{code} + + _╱_ : (𝑨 : Structure 𝑅 𝐹 {α}{ρ}) → Con 𝑨 → Structure 𝑅 𝐹 {suc (α ⊔ ρ)}{ρ} + + 𝑨 ╱ θ = ( Quotient (∣ 𝑨 ∣) {α ⊔ ρ} ∣ θ ∣) -- domain of quotient structure + , (λ r x → (r ʳ 𝑨) λ i → ⌞ x i ⌟) -- interpretation of relations + , λ f b → ⟪ (f ᵒ 𝑨) (λ i → ⌞ b i ⌟) ⟫ -- interp of operations + + /≡-elim : {𝑨 : Structure 𝑅 𝐹 {α}{ρ}}( (θ , _ ) : Con 𝑨){u v : ∣ 𝑨 ∣} + → ⟪ u ⟫{∣ θ ∣} ≡ ⟪ v ⟫ → ∣ θ ∣ u v + + /≡-elim θ {u}{v} x = ⟪ u ∼ v ⟫-elim {R = ∣ θ ∣} x +\end{code} + +#### <a id="the-zero-congruence-of-an-arbitrary-structure">The zero congruence of an arbitrary structure</a> + +\begin{code} + + 𝟘[_╱_] : (𝑨 : Structure 𝑅 𝐹 {α}{ρ})(θ : Con 𝑨) + → BinRel (∣ 𝑨 ∣ / (fst ∣ θ ∣)) (suc (α ⊔ ρ)) + + 𝟘[ 𝑨 ╱ θ ] = λ u v → u ≡ v + +𝟎[_╱_] : {α ρ : Level}(𝑨 : Structure 𝑅 𝐹 {α}{ρ})(θ : Con 𝑨) + → swelldef ℓ₀ (suc (α ⊔ ρ)) → Con (𝑨 ╱ θ) + +𝟎[ 𝑨 ╱ θ ] wd = 0[ ∣ 𝑨 ╱ θ ∣ ]Equivalence , 0[ 𝑨 ╱ θ ]Compatible wd +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Sigma.Products](Base.Structures.Sigma.Products.html)</span> +<span style="float:right;">[Base.Structures.Sigma.Homs →](Base.Structures.Sigma.Homs.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Sigma.Homs.html b/docs/Base.Structures.Sigma.Homs.html new file mode 100644 index 0000000..751a35d --- /dev/null +++ b/docs/Base.Structures.Sigma.Homs.html @@ -0,0 +1,456 @@ + +
--- +layout: default +title : "Base.Structures.Sigma.Homs" +date : "2021-06-22" +author: "agda-algebras development team" +--- + +#### <a id="homomorphisms-of-general-structures">Homomorphisms of general structures</a> + + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Sigma.Homs where + +-- Imports from the Agda Standard Library ---------------------------------------------------------- +open import Agda.Primitive using ( _⊔_ ; lsuc ) renaming ( Set to Type ; lzero to ℓ₀ ) +open import Data.Product using ( _,_ ; _×_ ; Σ-syntax ) renaming ( proj₁ to fst ; proj₂ to snd ) +open import Level using ( Level ; Lift ; lift ; lower ) +open import Function.Base using ( _∘_ ; id ) +open import Relation.Binary.PropositionalEquality + using ( _≡_ ; cong ; refl ; module ≡-Reasoning ) + +-- Imports from the Agda Universal Algebra Library --------------------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ; _∙_ ; _⁻¹) +open import Base.Functions using ( IsInjective ; IsSurjective ) +open import Base.Relations using ( _|:_ ; 0[_] ; ker ; Equivalence ; Quotient ) + using ( 0[_]Equivalence ; ker-IsEquivalence ; ⟪_⟫ ) + using ( kerlift-IsEquivalence ; ⌞_⌟ ; ⟪_∼_⟫-elim ; _/_ ) +open import Base.Equality using ( swelldef ) +open import Base.Structures.Sigma.Basic + using ( Signature ; Structure ; Compatible ; _ʳ_ ; _ᵒ_ ) + using ( Lift-Strucʳ ; Lift-Strucˡ ; Lift-Struc ) + +private variable 𝑅 𝐹 : Signature + +-- Development for Structures (Sigma type representation) +module _ {α ρᵃ : Level} (𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ}) + {β ρᵇ : Level} (𝑩 : Structure 𝑅 𝐹 {β}{ρᵇ}) where + + preserves : ∣ 𝑅 ∣ → (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type (α ⊔ ρᵃ ⊔ ρᵇ) + preserves r h = ∀ a → ((r ʳ 𝑨) a) → ((r ʳ 𝑩) (h ∘ a)) + + is-hom-rel : (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type (α ⊔ ρᵃ ⊔ ρᵇ) + is-hom-rel h = ∀ r → preserves r h + + comp-op : ∣ 𝐹 ∣ → (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type (α ⊔ β) + comp-op f h = ∀ a → h ((f ᵒ 𝑨) a) ≡ (f ᵒ 𝑩) (h ∘ a) + + is-hom-op : (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type (α ⊔ β) + is-hom-op h = ∀ f → comp-op f h + + is-hom : (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type (α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + is-hom h = is-hom-rel h × is-hom-op h + + hom : Type (α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + hom = Σ[ h ∈ (∣ 𝑨 ∣ → ∣ 𝑩 ∣) ] is-hom h + +module _ {𝑅 𝐹 : Signature} + {α ρᵃ : Level}(𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ}) + {β ρᵇ : Level}{𝑩 : Structure 𝑅 𝐹 {β}{ρᵇ}} + {γ ρᶜ : Level}(𝑪 : Structure 𝑅 𝐹 {γ}{ρᶜ}) where + + ∘-is-hom-rel : {f : ∣ 𝑨 ∣ → ∣ 𝑩 ∣}{g : ∣ 𝑩 ∣ → ∣ 𝑪 ∣} + → is-hom-rel 𝑨 𝑩 f → is-hom-rel 𝑩 𝑪 g → is-hom-rel 𝑨 𝑪 (g ∘ f) + + ∘-is-hom-rel {f}{g} fhr ghr R a = λ z → ghr R (λ z₁ → f (a z₁)) (fhr R a z) + + + ∘-is-hom-op : {f : ∣ 𝑨 ∣ → ∣ 𝑩 ∣}{g : ∣ 𝑩 ∣ → ∣ 𝑪 ∣} + → is-hom-op 𝑨 𝑩 f → is-hom-op 𝑩 𝑪 g → is-hom-op 𝑨 𝑪 (g ∘ f) + + ∘-is-hom-op {f}{g} fho gho 𝑓 a = cong g (fho 𝑓 a) ∙ gho 𝑓 (f ∘ a) + + + ∘-is-hom : {f : ∣ 𝑨 ∣ → ∣ 𝑩 ∣}{g : ∣ 𝑩 ∣ → ∣ 𝑪 ∣} + → is-hom 𝑨 𝑩 f → is-hom 𝑩 𝑪 g → is-hom 𝑨 𝑪 (g ∘ f) + + ∘-is-hom {f} {g} fhro ghro = ihr , iho + where + ihr : is-hom-rel 𝑨 𝑪 (g ∘ f) + ihr = ∘-is-hom-rel {f}{g} (fst fhro) (fst ghro) + + iho : is-hom-op 𝑨 𝑪 (g ∘ f) + iho = ∘-is-hom-op {f}{g} (snd fhro) (snd ghro) + + ∘-hom : hom 𝑨 𝑩 → hom 𝑩 𝑪 → hom 𝑨 𝑪 + ∘-hom (f , fh) (g , gh) = g ∘ f , ∘-is-hom {f}{g} fh gh + + +module _ {α ρ : Level} where + + 𝒾𝒹 : (𝑨 : Structure 𝑅 𝐹 {α}{ρ}) → hom 𝑨 𝑨 + 𝒾𝒹 _ = id , (λ R a z → z) , (λ f a → refl) + +module _ {α ρᵃ : Level} (𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ}) + {β ρᵇ : Level} (𝑩 : Structure 𝑅 𝐹 {β}{ρᵇ}) where + + is-mon : (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type (α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + is-mon g = is-hom 𝑨 𝑩 g × IsInjective g + + mon : Type (α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + mon = Σ[ g ∈ (∣ 𝑨 ∣ → ∣ 𝑩 ∣) ] is-mon g + + is-epi : (∣ 𝑨 ∣ → ∣ 𝑩 ∣) → Type (α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + is-epi g = is-hom 𝑨 𝑩 g × IsSurjective g + + epi : Type (α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + epi = Σ[ g ∈ (∣ 𝑨 ∣ → ∣ 𝑩 ∣) ] is-epi g + + mon→hom : mon → hom 𝑨 𝑩 + mon→hom ϕ = (fst ϕ) , fst (snd ϕ ) + + epi→hom : epi → hom 𝑨 𝑩 + epi→hom ϕ = (fst ϕ) , fst (snd ϕ) + +\end{code} + +Next, `lift` and `lower` are (the maps of) homomorphisms. + +\begin{code} + +module _ {𝑅 𝐹 : Signature}{α ρᵃ : Level} where + open Lift + + 𝓁𝒾𝒻𝓉 : (ℓ ρ : Level)(𝑨 : Structure 𝑅 𝐹{α}{ρᵃ}) → hom 𝑨 (Lift-Struc ℓ ρ 𝑨) + 𝓁𝒾𝒻𝓉 = λ ℓ ρ 𝑨 → lift , ( (λ R a x → lift x) , λ f a → refl ) + + 𝓁ℴ𝓌ℯ𝓇 : (ℓ ρ : Level)(𝑨 : Structure 𝑅 𝐹{α}{ρᵃ}) → hom (Lift-Struc ℓ ρ 𝑨) 𝑨 + 𝓁ℴ𝓌ℯ𝓇 = λ ℓ ρ 𝑨 → lower , (λ R a x → lower x) , (λ f a → refl) + +module _ {𝑅 𝐹 : Signature}{α ρᵃ β ρᵇ : Level}{𝑅 𝐹 : Signature} + {𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ}}{𝑩 : Structure 𝑅 𝐹 {β}{ρᵇ}} where + + Lift-Hom : (ℓ ρ ℓ' ρ' : Level) → hom 𝑨 𝑩 → hom (Lift-Struc ℓ ρ 𝑨) (Lift-Struc ℓ' ρ' 𝑩) + Lift-Hom ℓ ρ ℓ' ρ' (h , hhom) = lift ∘ h ∘ lower , Goal + where + lABh : is-hom (Lift-Struc ℓ ρ 𝑨) 𝑩 (h ∘ lower) + lABh = ∘-is-hom{𝑅 = 𝑅}{𝐹} (Lift-Struc ℓ ρ 𝑨) 𝑩{lower}{h} ((λ R a x → lower x) , (λ f a → refl)) hhom + + Goal : is-hom (Lift-Struc ℓ ρ 𝑨) (Lift-Struc ℓ' ρ' 𝑩) (lift ∘ h ∘ lower) + Goal = ∘-is-hom {𝑅 = 𝑅}{𝐹} (Lift-Struc ℓ ρ 𝑨) (Lift-Struc ℓ' ρ' 𝑩) + {h ∘ lower}{lift} lABh ((λ R a x → lift x) , (λ f a → refl)) +\end{code} + + +#### <a id="kernels-of-homomorphisms-of-structures-of-sigma-type">Kernels of homomorphisms of structures of sigma type</a> + +The kernel of a homomorphism is a congruence relation and conversely for +every congruence relation `θ`, there exists a homomorphism with kernel `θ` +(namely, that canonical projection onto the quotient modulo `θ`). + +\begin{code} + +open ≡-Reasoning +module _ {𝑅 𝐹 : Signature} {α ρᵃ β ρᵇ : Level} + {𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ}}{𝑩 : Structure 𝑅 𝐹{β}{ρᵇ}} where + + Homker-comp : swelldef ℓ₀ β → (h : hom 𝑨 𝑩) → Compatible 𝑨 (ker ∣ h ∣) + Homker-comp wd h f {u}{v} kuv = (∣ h ∣ ((f ᵒ 𝑨) u)) ≡⟨(snd ∥ h ∥) f u ⟩ + ((f ᵒ 𝑩)(∣ h ∣ ∘ u)) ≡⟨ wd (f ᵒ 𝑩) (∣ h ∣ ∘ u) (∣ h ∣ ∘ v) kuv ⟩ + ((f ᵒ 𝑩)(∣ h ∣ ∘ v)) ≡⟨((snd ∥ h ∥) f v)⁻¹ ⟩ + (∣ h ∣((f ᵒ 𝑨) v)) ∎ +\end{code} + +-------------------------------- + +<br> + +[← Base.Structures.Sigma.Congruences](Base.Structures.Sigma.Congruences.html) +<span style="float:right;">[Base.Structures.Sigma.Isos →](Base.Structures.Sigma.Isos.html)</span> + +{% include UALib.Links.md %} + +[agda-algebras development team]: https://github.com/ualib/agda-algebras#the-agda-algebras-development-team + + + + + + +<!-- ------- The rest is not yet integrated ------------------------------------------------ + +module _ {𝑅 𝐹 : Signature} + {α ρᵃ β ρᵇ : Level} + {𝑨 : Structure {α}{ρᵃ} 𝑅 𝐹}{𝑩 : Structure {β}{ρᵇ} 𝑅 𝐹} where + + KerCon : swelldef {!!} {!!} → Hom 𝑨 𝑩 → Con{α = α}{ρ = (β ⊔ ρᵃ)} (Lift-Strucʳ β 𝑨) + KerCon wd h = θ , Cθ -- θ , Cθ + where + θ : Equivalence{α = α} ∣ 𝑨 ∣ {ρ = (α ⊔ β ⊔ ρᵃ)} + θ = (λ x y → Lift (α ⊔ ρᵃ) (ker ∣ h ∣ x y)) , kerlift-IsEquivalence ∣ h ∣ + + + Cθ : Compatible (Lift-Strucʳ β 𝑨) ∣ θ ∣ + Cθ = {!Homker-comp{𝑨 = (Lift-Strucʳ β 𝑨)} wd (Lift-Hom ℓ₀ β ℓ₀ ℓ₀ h) ?!} + +\end{code} + +With this congruence we construct the corresponding quotient, along with some syntactic sugar to denote it. + +begin{code} + +module _ {α ρᵃ β ρᵇ : Level}{𝑅 𝐹 : Signature} + {𝑨 : Structure {α}{ρᵃ} 𝑅 𝐹}{𝑩 : Structure {β}{ρᵇ} 𝑅 𝐹} where + KerQuo : Hom 𝑨 𝑩 → Structure 𝑅 𝐹 + KerQuo h = {!!} -- 𝑨 ╱ KerCon{𝑨 = 𝑨}{𝑩 = 𝑩}{wd = wd} h +module _ {𝑨 : Structure {α} {ℓ₀} 𝑅 𝐹} {wd : swelldef ℓ₀ ℓ₀ } where + KerQuo : {𝑩 : Structure {ℓ₀} {ℓ₀} 𝑅 𝐹} → Hom 𝑨 𝑩 → Structure {lsuc α} {ℓ₀} 𝑅 𝐹 -- lsuc ℓ₀ ⊔ α + KerQuo {𝑩 = 𝑩} h = {!!} -- 𝑨 ╱ KerCon{𝑨 = 𝑨}{𝑩 = 𝑩}{wd = wd} h + +module _ {α β ρ ρ : Level} {𝑨 : Structure {ρ} 𝑅 𝐹 {α}} where + + kerquo : {𝑩 : Structure {ρ} 𝑅 𝐹 {β}} → hom 𝑨 𝑩 → Structure {ρ} 𝑅 𝐹 {lsuc ρ ⊔ α} -- {𝓤 ⊔ lsuc 𝓦} + kerquo {𝑩 = 𝑩} h = 𝑨 ╱ {!kercon h!} -- (kercon {𝑩 = 𝑩} h) + + +ker[_⇒_]_ : (𝑨 : Structure{ρ} 𝑅 𝐹 {α})(𝑩 : Structure{ρ} 𝑅 𝐹 {β}) → hom 𝑨 𝑩 → Structure 𝑅 𝐹 +ker[ 𝑨 ⇒ 𝑩 ] h = kerquo {𝑩 = 𝑩} h + +\end{code} + +Thus, given `h : hom 𝑨 𝑩`, we can construct the quotient of `𝑨` modulo the kernel of `h`, and the syntax for this quotient in the [agda-algebras](https://github.com/ualib/agda-algebras) library is `𝑨 [ 𝑩 ]/ker h ↾ fe`. + + +#### <a id="the-canonical-projection">The canonical projection</a> + +Given an algebra `𝑨` and a congruence `θ`, the *canonical projection* is a map from `𝑨` onto `𝑨 ╱ θ` that is constructed, and proved epimorphic, as follows. + +begin{code} + +module _ {𝑩 : Structure 𝑅 𝐹 {β}} where + open Image_∋_ + πepi : (θ : Con{α} 𝑩) → epi 𝑩 (𝑩 ╱ θ) + πepi θ = (λ a → ⟪ a / ∣ θ ∣ ⟫) , (γrel , (λ _ _ → refl)) , cπ-is-epic where -- (λ _ _ → refl) + γrel : IsHom-rel 𝑩 (𝑩 ╱ θ) (λ a → ⟪ a / ∣ θ ∣ ⟫) + γrel R a x = {!!} + cπ-is-epic : IsSurjective (λ a → ⟪ a / ∣ θ ∣ ⟫) + cπ-is-epic (C , (a , Ca)) = eq (C , (a , Ca)) a λ i → {!!} , {!!} -- Image_∋_.im a + +\end{code} + +In may happen that we don't care about the surjectivity of `πepi`, in which case would might prefer to work with the *homomorphic reduct* of `πepi`. This is obtained by applying `epi-to-hom`, like so. + + + πhom : (θ : Con{𝓤}{𝓦} 𝑨) → hom 𝑨 (𝑨 ╱ θ) + πhom θ = epi-to-hom (𝑨 ╱ θ) (πepi θ) + +\end{code} + + +We combine the foregoing to define a function that takes 𝑆-algebras `𝑨` and `𝑩`, and a homomorphism `h : hom 𝑨 𝑩` and returns the canonical epimorphism from `𝑨` onto `𝑨 [ 𝑩 ]/ker h`. (Recall, the latter is the special notation we defined above for the quotient of `𝑨` modulo the kernel of `h`.) + +begin{code} + + πker : (wd : swelldef 𝓥 𝓦){𝑩 : Algebra 𝓦 𝑆}(h : hom 𝑨 𝑩) → epi 𝑨 (ker[ 𝑨 ⇒ 𝑩 ] h ↾ wd) + πker wd {𝑩} h = πepi (kercon wd {𝑩} h) + +\end{code} + +The kernel of the canonical projection of `𝑨` onto `𝑨 / θ` is equal to `θ`, but since equality of inhabitants of certain types (like `Congruence` or `Rel`) can be a tricky business, we settle for proving the containment `𝑨 / θ ⊆ θ`. Of the two containments, this is the easier one to prove; luckily it is also the one we need later. + + + open IsCongruence + + ker-in-con : {wd : swelldef 𝓥 (𝓤 ⊔ lsuc 𝓦)}(θ : Con 𝑨) + → ∀ {x}{y} → ∣ kercon wd {𝑨 ╱ θ} (πhom θ) ∣ x y → ∣ θ ∣ x y + + ker-in-con θ hyp = /-≡ θ hyp + +\end{code} + + +#### <a id="product-homomorphisms">Product homomorphisms</a> + +Suppose we have an algebra `𝑨`, a type `I : Type 𝓘`, and a family `ℬ : I → Algebra 𝓦 𝑆` of algebras. We sometimes refer to the inhabitants of `I` as *indices*, and call `ℬ` an *indexed family of algebras*. + +If in addition we have a family `𝒽 : (i : I) → hom 𝑨 (ℬ i)` of homomorphisms, then we can construct a homomorphism from `𝑨` to the product `⨅ ℬ` in the natural way. + +begin{code} + +module _ {𝓘 𝓦 : Level}{I : Type 𝓘}(ℬ : I → Algebra 𝓦 𝑆) where + + ⨅-hom-co : funext 𝓘 𝓦 → {𝓤 : Level}(𝑨 : Algebra 𝓤 𝑆) → (∀(i : I) → hom 𝑨 (ℬ i)) → hom 𝑨 (⨅ ℬ) + ⨅-hom-co fe 𝑨 𝒽 = ((λ a i → ∣ 𝒽 i ∣ a)) , (λ 𝑓 𝒶 → fe λ i → ∥ 𝒽 i ∥ 𝑓 𝒶) + +\end{code} + +The family `𝒽` of homomorphisms inhabits the dependent type `Π i ꞉ I , hom 𝑨 (ℬ i)`. The syntax we use to represent this type is available to us because of the way `-Π` is defined in the [Type Topology][] library. We like this syntax because it is very close to the notation one finds in the standard type theory literature. However, +we could equally well have used one of the following alternatives, which may be closer to "standard Agda" syntax: + +`Π λ i → hom 𝑨 (ℬ i)` or `(i : I) → hom 𝑨 (ℬ i)` or `∀ i → hom 𝑨 (ℬ i)`. + +The foregoing generalizes easily to the case in which the domain is also a product of a family of algebras. That is, if we are given `𝒜 : I → Algebra 𝓤 𝑆 and ℬ : I → Algebra 𝓦 𝑆` (two families of `𝑆`-algebras), and `𝒽 : Π i ꞉ I , hom (𝒜 i)(ℬ i)` (a family of homomorphisms), then we can construct a homomorphism from `⨅ 𝒜` to `⨅ ℬ` in the following natural way. + +begin{code} + + ⨅-hom : funext 𝓘 𝓦 → {𝓤 : Level}(𝒜 : I → Algebra 𝓤 𝑆) → Π[ i ꞉ I ] hom (𝒜 i)(ℬ i) → hom (⨅ 𝒜)(⨅ ℬ) + ⨅-hom fe 𝒜 𝒽 = (λ x i → ∣ 𝒽 i ∣ (x i)) , (λ 𝑓 𝒶 → fe λ i → ∥ 𝒽 i ∥ 𝑓 (λ x → 𝒶 x i)) + +\end{code} + + + +#### <a id="projections-out-of-products">Projection out of products</a> + +Later we will need a proof of the fact that projecting out of a product algebra onto one of its factors is a homomorphism. + +begin{code} + + ⨅-projection-hom : Π[ i ꞉ I ] hom (⨅ ℬ) (ℬ i) + ⨅-projection-hom = λ x → (λ z → z x) , λ _ _ → refl + +\end{code} + +We could prove a more general result involving projections onto multiple factors, but so far the single-factor result has sufficed. + +\end{code} + +--> + + + + + + + + + + + + + + + + +(Notice, it is here that the `swelldef` postulate comes into play, and because it is needed to prove `homker-comp`, it is postulated by all the lemmas below that depend upon `homker-comp`.) + +It is convenient to define a function that takes a homomorphism and constructs a congruence from its kernel. We call this function `kercon`. + + + kercon : swelldef 𝓥 𝓦 → {𝑩 : Algebra 𝓦 𝑆} → hom 𝑨 𝑩 → Con{𝓤}{𝓦} 𝑨 + kercon wd {𝑩} h = ker ∣ h ∣ , mkcon (ker-IsEquivalence ∣ h ∣)(homker-comp wd {𝑩} h) + +\end{code} + +With this congruence we construct the corresponding quotient, along with some syntactic sugar to denote it. + + + kerquo : swelldef 𝓥 𝓦 → {𝑩 : Algebra 𝓦 𝑆} → hom 𝑨 𝑩 → Algebra (𝓤 ⊔ lsuc 𝓦) 𝑆 + kerquo wd {𝑩} h = 𝑨 ╱ (kercon wd {𝑩} h) + + +ker[_⇒_]_↾_ : (𝑨 : Algebra 𝓤 𝑆)(𝑩 : Algebra 𝓦 𝑆) → hom 𝑨 𝑩 → swelldef 𝓥 𝓦 → Algebra (𝓤 ⊔ lsuc 𝓦) 𝑆 +ker[ 𝑨 ⇒ 𝑩 ] h ↾ wd = kerquo wd {𝑩} h + +\end{code} + +Thus, given `h : hom 𝑨 𝑩`, we can construct the quotient of `𝑨` modulo the kernel of `h`, and the syntax for this quotient in the [agda-algebras](https://github.com/ualib/agda-algebras) library is `𝑨 [ 𝑩 ]/ker h ↾ fe`. + + + +#### <a id="the-canonical-projection">The canonical projection</a> + +Given an algebra `𝑨` and a congruence `θ`, the *canonical projection* is a map from `𝑨` onto `𝑨 ╱ θ` that is constructed, and proved epimorphic, as follows. + + +module _ {𝓤 𝓦 : Level}{𝑨 : Algebra 𝓤 𝑆} where + πepi : (θ : Con{𝓤}{𝓦} 𝑨) → epi 𝑨 (𝑨 ╱ θ) + πepi θ = (λ a → ⟪ a ⟫) , (λ _ _ → refl) , cπ-is-epic where + cπ-is-epic : IsSurjective (λ a → ⟪ a ⟫) + cπ-is-epic (C , (a , refl)) = Image_∋_.im a + +\end{code} + +In may happen that we don't care about the surjectivity of `πepi`, in which case would might prefer to work with the *homomorphic reduct* of `πepi`. This is obtained by applying `epi-to-hom`, like so. + + + πhom : (θ : Con{𝓤}{𝓦} 𝑨) → hom 𝑨 (𝑨 ╱ θ) + πhom θ = epi-to-hom (𝑨 ╱ θ) (πepi θ) + +\end{code} + + +We combine the foregoing to define a function that takes 𝑆-algebras `𝑨` and `𝑩`, and a homomorphism `h : hom 𝑨 𝑩` and returns the canonical epimorphism from `𝑨` onto `𝑨 [ 𝑩 ]/ker h`. (Recall, the latter is the special notation we defined above for the quotient of `𝑨` modulo the kernel of `h`.) + + + πker : (wd : swelldef 𝓥 𝓦){𝑩 : Algebra 𝓦 𝑆}(h : hom 𝑨 𝑩) → epi 𝑨 (ker[ 𝑨 ⇒ 𝑩 ] h ↾ wd) + πker wd {𝑩} h = πepi (kercon wd {𝑩} h) + +\end{code} + +The kernel of the canonical projection of `𝑨` onto `𝑨 / θ` is equal to `θ`, but since equality of inhabitants of certain types (like `Congruence` or `Rel`) can be a tricky business, we settle for proving the containment `𝑨 / θ ⊆ θ`. Of the two containments, this is the easier one to prove; luckily it is also the one we need later. + + + open IsCongruence + + ker-in-con : {wd : swelldef 𝓥 (𝓤 ⊔ lsuc 𝓦)}(θ : Con 𝑨) + → ∀ {x}{y} → ∣ kercon wd {𝑨 ╱ θ} (πhom θ) ∣ x y → ∣ θ ∣ x y + + ker-in-con θ hyp = /-≡ θ hyp + +\end{code} + + + +#### <a id="product-homomorphisms">Product homomorphisms</a> + +Suppose we have an algebra `𝑨`, a type `I : Type 𝓘`, and a family `ℬ : I → Algebra 𝓦 𝑆` of algebras. We sometimes refer to the inhabitants of `I` as *indices*, and call `ℬ` an *indexed family of algebras*. + +If in addition we have a family `𝒽 : (i : I) → hom 𝑨 (ℬ i)` of homomorphisms, then we can construct a homomorphism from `𝑨` to the product `⨅ ℬ` in the natural way. + + +module _ {𝓘 𝓦 : Level}{I : Type 𝓘}(ℬ : I → Algebra 𝓦 𝑆) where + + ⨅-hom-co : funext 𝓘 𝓦 → {𝓤 : Level}(𝑨 : Algebra 𝓤 𝑆) → (∀(i : I) → hom 𝑨 (ℬ i)) → hom 𝑨 (⨅ ℬ) + ⨅-hom-co fe 𝑨 𝒽 = (λ a i → ∣ 𝒽 i ∣ a) , (λ 𝑓 𝒶 → fe λ i → ∥ 𝒽 i ∥ 𝑓 𝒶) + +\end{code} + +The family `𝒽` of homomorphisms inhabits the dependent type `Π i ꞉ I , hom 𝑨 (ℬ i)`. The syntax we use to represent this type is available to us because of the way `-Π` is defined in the [Type Topology][] library. We like this syntax because it is very close to the notation one finds in the standard type theory literature. However, +we could equally well have used one of the following alternatives, which may be closer to "standard Agda" syntax: + +`Π λ i → hom 𝑨 (ℬ i)` or `(i : I) → hom 𝑨 (ℬ i)` or `∀ i → hom 𝑨 (ℬ i)`. + +The foregoing generalizes easily to the case in which the domain is also a product of a family of algebras. That is, if we are given `𝒜 : I → Algebra 𝓤 𝑆 and ℬ : I → Algebra 𝓦 𝑆` (two families of `𝑆`-algebras), and `𝒽 : Π i ꞉ I , hom (𝒜 i)(ℬ i)` (a family of homomorphisms), then we can construct a homomorphism from `⨅ 𝒜` to `⨅ ℬ` in the following natural way. + + + ⨅-hom : funext 𝓘 𝓦 → {𝓤 : Level}(𝒜 : I → Algebra 𝓤 𝑆) → Π[ i ꞉ I ] hom (𝒜 i)(ℬ i) → hom (⨅ 𝒜)(⨅ ℬ) + ⨅-hom fe 𝒜 𝒽 = (λ x i → ∣ 𝒽 i ∣ (x i)) , (λ 𝑓 𝒶 → fe λ i → ∥ 𝒽 i ∥ 𝑓 (λ x → 𝒶 x i)) + +\end{code} + + + +#### <a id="projections-out-of-products">Projection out of products</a> + +Later we will need a proof of the fact that projecting out of a product algebra onto one of its factors is a homomorphism. + + + ⨅-projection-hom : Π[ i ꞉ I ] hom (⨅ ℬ) (ℬ i) + ⨅-projection-hom = λ x → (λ z → z x) , λ _ _ → refl + +\end{code} + +We could prove a more general result involving projections onto multiple factors, but so far the single-factor result has sufficed. + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Sigma.Congruences](Base.Structures.Sigma.Congruences.html)</span> +<span style="float:right;">[Base.Structures.Sigma.Isos →](Base.Structures.Sigma.Isos.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Sigma.Isos.html b/docs/Base.Structures.Sigma.Isos.html new file mode 100644 index 0000000..e4e80d3 --- /dev/null +++ b/docs/Base.Structures.Sigma.Isos.html @@ -0,0 +1,220 @@ + +
--- +layout: default +title : "Base.Structures.Sigma.Isos module (The Agda Universal Algebra Library)" +date : "2021-06-22" +author: "agda-algebras development team" +--- + +#### <a id="isomorphisms-of-general-structures">Isomorphisms of general structures</a> + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Sigma.Isos where + +-- Imports from the Agda Standard Library ------------------------------------------------------ +open import Axiom.Extensionality.Propositional + using () renaming (Extensionality to funext) +open import Agda.Primitive using ( _⊔_ ; lsuc ) renaming ( Set to Type ) +open import Data.Product using ( _,_ ; Σ-syntax ; _×_ ) renaming ( proj₁ to fst ; proj₂ to snd ) +open import Function.Base using ( _∘_ ) +open import Level using ( Level ; Lift ; lift ; lower ) +open import Relation.Binary.PropositionalEquality using ( _≡_ ; refl ; cong ; cong-app ) + +-- Imports from the Agda Universal Algebra Library --------------------------------------------- +open import Overture using ( ∣_∣ ; _≈_ ; ∥_∥ ; _∙_ ; lower∼lift ; lift∼lower ) +open import Base.Structures.Sigma.Basic using ( Signature ; Structure ; Lift-Struc ) +open import Base.Structures.Sigma.Homs using ( hom ; 𝒾𝒹 ; ∘-hom ; 𝓁𝒾𝒻𝓉 ; 𝓁ℴ𝓌ℯ𝓇 ; is-hom) +open import Base.Structures.Sigma.Products using ( ⨅ ; ℓp ; ℑ ; 𝔖 ; class-prod ) + +private variable 𝑅 𝐹 : Signature + +\end{code} + +Recall, `f ≈ g` means f and g are *extensionally* (or pointwise) equal; i.e., +`∀ x, f x ≡ g x`. We use this notion of equality of functions in the following +definition of **isomorphism**. + +\begin{code} + +module _ {α ρᵃ β ρᵇ : Level} where + + record _≅_ (𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ})(𝑩 : Structure 𝑅 𝐹 {β}{ρᵇ}) : Type (α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) where + field + to : hom 𝑨 𝑩 + from : hom 𝑩 𝑨 + to∼from : ∣ to ∣ ∘ ∣ from ∣ ≈ ∣ 𝒾𝒹 𝑩 ∣ + from∼to : ∣ from ∣ ∘ ∣ to ∣ ≈ ∣ 𝒾𝒹 𝑨 ∣ + + open _≅_ public + +\end{code} + +That is, two structures are **isomorphic** provided there are homomorphisms going +back and forth between them which compose to the identity map. + + +#### <a id="properties-of-isomorphism-of-structures-of-sigma-type">Properties of isomorphism of structures of sigma type</a> + +\begin{code} + +module _ {α ρᵃ : Level} where + + ≅-refl : {𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ}} → 𝑨 ≅ 𝑨 + ≅-refl {𝑨 = 𝑨} = + record { to = 𝒾𝒹 𝑨 ; from = 𝒾𝒹 𝑨 ; to∼from = λ _ → refl ; from∼to = λ _ → refl } + +module _ {α ρᵃ β ρᵇ : Level} where + + ≅-sym : {𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ}}{𝑩 : Structure 𝑅 𝐹 {β}{ρᵇ}} + → 𝑨 ≅ 𝑩 → 𝑩 ≅ 𝑨 + ≅-sym A≅B = record { to = from A≅B ; from = to A≅B ; to∼from = from∼to A≅B ; from∼to = to∼from A≅B } + +module _ {α ρᵃ β ρᵇ γ ρᶜ : Level} + (𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ}){𝑩 : Structure 𝑅 𝐹 {β}{ρᵇ}} + (𝑪 : Structure 𝑅 𝐹 {γ}{ρᶜ}) where + + ≅-trans : 𝑨 ≅ 𝑩 → 𝑩 ≅ 𝑪 → 𝑨 ≅ 𝑪 + + ≅-trans ab bc = record { to = f ; from = g ; to∼from = τ ; from∼to = ν } + where + f1 : hom 𝑨 𝑩 + f1 = to ab + f2 : hom 𝑩 𝑪 + f2 = to bc + f : hom 𝑨 𝑪 + f = ∘-hom 𝑨 𝑪 f1 f2 + + g1 : hom 𝑪 𝑩 + g1 = from bc + g2 : hom 𝑩 𝑨 + g2 = from ab + g : hom 𝑪 𝑨 + g = ∘-hom 𝑪 𝑨 g1 g2 + + τ : ∣ f ∣ ∘ ∣ g ∣ ≈ ∣ 𝒾𝒹 𝑪 ∣ + τ x = (cong ∣ f2 ∣(to∼from ab (∣ g1 ∣ x)))∙(to∼from bc) x + + ν : ∣ g ∣ ∘ ∣ f ∣ ≈ ∣ 𝒾𝒹 𝑨 ∣ + ν x = (cong ∣ g2 ∣(from∼to bc (∣ f1 ∣ x)))∙(from∼to ab) x + +\end{code} + +Fortunately, the lift operation preserves isomorphism (i.e., it's an *algebraic invariant*). As our focus is universal algebra, this is important and is what makes the lift operation a workable solution to the technical problems that arise from the noncumulativity of Agda's universe hierarchy. + +\begin{code} + +open Level + +module _ {α ρᵃ : Level} where + + Lift-≅ : (ℓ ρ : Level) → {𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ}} → 𝑨 ≅ (Lift-Struc ℓ ρ 𝑨) + Lift-≅ ℓ ρ {𝑨} = record { to = 𝓁𝒾𝒻𝓉 ℓ ρ 𝑨 + ; from = 𝓁ℴ𝓌ℯ𝓇 ℓ ρ 𝑨 + ; to∼from = cong-app lift∼lower + ; from∼to = cong-app (lower∼lift{α}{ρ}) } + +module _ {α ρᵃ β ρᵇ : Level} + {𝑨 : Structure 𝑅 𝐹 {α}{ρᵃ}}{𝑩 : Structure 𝑅 𝐹 {β}{ρᵇ}} where + + Lift-Struc-iso : (ℓ ρ ℓ' ρ' : Level) → 𝑨 ≅ 𝑩 → Lift-Struc ℓ ρ 𝑨 ≅ Lift-Struc ℓ' ρ' 𝑩 + + Lift-Struc-iso ℓ ρ ℓ' ρ' A≅B = ≅-trans (Lift-Struc ℓ ρ 𝑨) (Lift-Struc ℓ' ρ' 𝑩) + ( ≅-trans (Lift-Struc ℓ ρ 𝑨) 𝑩 (≅-sym (Lift-≅ ℓ ρ)) A≅B ) + (Lift-≅ ℓ' ρ') + +\end{code} + +Products of isomorphic families of algebras are themselves isomorphic. The proof looks a bit technical, but it is as straightforward as it ought to be. + +\begin{code} + +module _ {ι : Level}{I : Type ι} + {α ρᵃ β ρᵇ : Level} {fe : funext ρᵇ ρᵇ} + {fiu : funext ι α} {fiw : funext ι β} where + + ⨅≅ : {𝒜 : I → Structure 𝑅 𝐹 {α}{ρᵃ}}{ℬ : I → Structure 𝑅 𝐹 {β}{ρᵇ}} + → (∀ (i : I) → 𝒜 i ≅ ℬ i) → ⨅ 𝒜 ≅ ⨅ ℬ + + ⨅≅ {𝒜 = 𝒜}{ℬ} AB = record { to = ϕ , ϕhom + ; from = ψ , ψhom + ; to∼from = ϕ~ψ + ; from∼to = ψ~ϕ + } + where + ϕ : ∣ ⨅ 𝒜 ∣ → ∣ ⨅ ℬ ∣ + ϕ a i = ∣ to (AB i) ∣ (a i) + + ϕhom : is-hom (⨅ 𝒜) (⨅ ℬ) ϕ + ϕhom = ( λ r a x 𝔦 → fst ∥ to (AB 𝔦) ∥ r (λ z → a z 𝔦) (x 𝔦)) + , λ f a → fiw (λ i → snd ∥ to (AB i) ∥ f (λ z → a z i) ) + + ψ : ∣ ⨅ ℬ ∣ → ∣ ⨅ 𝒜 ∣ + ψ b i = ∣ from (AB i) ∣ (b i) + + ψhom : is-hom (⨅ ℬ) (⨅ 𝒜) ψ + ψhom = ( λ r a x 𝔦 → fst ∥ from (AB 𝔦) ∥ r (λ z → a z 𝔦) (x 𝔦)) + , λ f a → fiu (λ i → snd ∥ from (AB i) ∥ f (λ z → a z i) ) + + ϕ~ψ : ϕ ∘ ψ ≈ ∣ 𝒾𝒹 (⨅ ℬ) ∣ + ϕ~ψ 𝒃 = fiw λ i → (to∼from (AB i)) (𝒃 i) + + ψ~ϕ : ψ ∘ ϕ ≈ ∣ 𝒾𝒹 (⨅ 𝒜) ∣ + ψ~ϕ a = fiu λ i → (from∼to (AB i)) (a i) +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Sigma.Homs](Base.Structures.Sigma.Homs.html)</span> +<span style="float:right;">[Base.Categories →](Base.Categories.html)</span> + +{% include UALib.Links.md %} + + + + + + +<!-- the rest is not yet implemented + +A nearly identical proof goes through for isomorphisms of lifted products (though, just for fun, we use the universal quantifier syntax here to express the dependent function type in the statement of the lemma, instead of the Pi notation we used in the statement of the previous lemma; that is, `∀ i → 𝒜 i ≅ ℬ (lift i)` instead of `Π i ꞉ I , 𝒜 i ≅ ℬ (lift i)`.) + +begin{code} + +module _ {𝓘 : Level}{I : Type 𝓘}{fizw : funext (𝓘 ⊔ γ) β}{fiu : funext 𝓘 α} where + + Lift-Alg-⨅≅ : {𝒜 : I → Algebra α 𝑆}{ℬ : (Lift γ I) → Algebra β 𝑆} + → (∀ i → 𝒜 i ≅ ℬ (lift i)) → Lift-Alg (⨅ 𝒜) γ ≅ ⨅ ℬ + + Lift-Alg-⨅≅ {𝒜}{ℬ} AB = Goal + where + ϕ : ∣ ⨅ 𝒜 ∣ → ∣ ⨅ ℬ ∣ + ϕ a i = ∣ fst (AB (lower i)) ∣ (a (lower i)) + + ϕhom : is-homomorphism (⨅ 𝒜) (⨅ ℬ) ϕ + ϕhom 𝑓 a = fizw (λ i → (∥ fst (AB (lower i)) ∥) 𝑓 (λ x → a x (lower i))) + + ψ : ∣ ⨅ ℬ ∣ → ∣ ⨅ 𝒜 ∣ + ψ b i = ∣ fst ∥ AB i ∥ ∣ (b (lift i)) + + ψhom : is-homomorphism (⨅ ℬ) (⨅ 𝒜) ψ + ψhom 𝑓 𝒃 = fiu (λ i → (snd ∣ snd (AB i) ∣) 𝑓 (λ x → 𝒃 x (lift i))) + + ϕ~ψ : ϕ ∘ ψ ≈ ∣ 𝒾𝒹 (⨅ ℬ) ∣ + ϕ~ψ 𝒃 = fizw λ i → fst ∥ snd (AB (lower i)) ∥ (𝒃 i) + + ψ~ϕ : ψ ∘ ϕ ≈ ∣ 𝒾𝒹 (⨅ 𝒜) ∣ + ψ~ϕ a = fiu λ i → snd ∥ snd (AB i) ∥ (a i) + + A≅B : ⨅ 𝒜 ≅ ⨅ ℬ + A≅B = (ϕ , ϕhom) , ((ψ , ψhom) , ϕ~ψ , ψ~ϕ) + + Goal : Lift-Alg (⨅ 𝒜) γ ≅ ⨅ ℬ + Goal = ≅-trans (≅-sym Lift-≅) A≅B + +\end{code} + +--> +\ No newline at end of file diff --git a/docs/Base.Structures.Sigma.Products.html b/docs/Base.Structures.Sigma.Products.html new file mode 100644 index 0000000..8f44a57 --- /dev/null +++ b/docs/Base.Structures.Sigma.Products.html @@ -0,0 +1,60 @@ + +
--- +layout: default +title : "Base.Structures.Sigma.Products module" +date : "2021-05-11" +author: "agda-algebras development team" +--- + +#### <a id="product-structures">Product structures</a> + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Sigma.Products where + +-- Imports from the Agda Standard Library ------------------------------------ +open import Agda.Primitive using ( _⊔_ ; lsuc ) renaming ( Set to Type ) +open import Data.Product using ( _,_ ; _×_ ; Σ-syntax ) +open import Level using ( Level ; Lift ) +open import Relation.Unary using ( _∈_ ; Pred ) + +-- Imports from the Agda Universal Algebra Library --------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ; Π ; Π-syntax ) +open import Base.Structures.Sigma.Basic using ( Signature ; Structure ; _ʳ_ ; _ᵒ_ ) + +private variable + 𝑅 𝐹 : Signature + α ρ ι : Level + +⨅ : {ℑ : Type ι}(𝒜 : ℑ → Structure 𝑅 𝐹{α}{ρ}) → Structure 𝑅 𝐹 {α ⊔ ι} {ρ ⊔ ι} +⨅ {ℑ = ℑ} 𝒜 = Π[ 𝔦 ∈ ℑ ] ∣ 𝒜 𝔦 ∣ -- domain of the product structure + , ( λ r a → ∀ 𝔦 → (r ʳ 𝒜 𝔦) λ x → a x 𝔦 ) -- interpretations of relations + , ( λ 𝑓 a 𝔦 → (𝑓 ᵒ 𝒜 𝔦) λ x → a x 𝔦 ) -- interpretations of operations + +module _ {α ρ τ : Level}{𝒦 : Pred (Structure 𝑅 𝐹 {α}{ρ}) τ} where + + ℓp : Level + ℓp = lsuc (α ⊔ ρ) ⊔ τ + + ℑ : Type ℓp + ℑ = Σ[ 𝑨 ∈ Structure 𝑅 𝐹 ] (𝑨 ∈ 𝒦) + + 𝔖 : ℑ → Structure 𝑅 𝐹 -- (type \MfS to get 𝔖) + 𝔖 𝔦 = ∣ 𝔦 ∣ + + class-prod : Structure 𝑅 𝐹 + class-prod = ⨅ 𝔖 + +\end{code} + +If `p : 𝑨 ∈ 𝒦`, we view the pair `(𝑨 , p) ∈ ℑ` as an *index* over the class, so we can think of `𝔄 (𝑨 , p)` (which is simply `𝑨`) as the projection of the product `⨅ 𝔄` onto the `(𝑨 , p)`-th component. + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Sigma.Basic](Base.Structures.Sigma.Basic.html)</span> +<span style="float:right;">[Base.Structures.Sigma.Congruences →](Base.Structures.Sigma.Congruences.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Sigma.html b/docs/Base.Structures.Sigma.html new file mode 100644 index 0000000..e8092c1 --- /dev/null +++ b/docs/Base.Structures.Sigma.html @@ -0,0 +1,32 @@ + +
--- +layout: default +title : "Base.Structures.Sigma module (Agda Universal Algebra Library)" +date : "2021-07-26" +author: "agda-algebras development team" +--- + +### <a id="sigma-types-for-general-mathematical-structures">Sigma Types for General Mathematical Structures</a> + +This is the [Base.Structures.Sigma][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Sigma where + +open import Base.Structures.Sigma.Basic public +open import Base.Structures.Sigma.Products public +open import Base.Structures.Sigma.Congruences public +open import Base.Structures.Sigma.Homs public +open import Base.Structures.Sigma.Isos public +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.EquationalLogic](Base.Structures.EquationalLogic.html)</span> +<span style="float:right;">[Base.Structures.Sigma.Basic →](Base.Structures.Sigma.Basic.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Substructures.html b/docs/Base.Structures.Substructures.html new file mode 100644 index 0000000..2972f1e --- /dev/null +++ b/docs/Base.Structures.Substructures.html @@ -0,0 +1,306 @@ + +
--- +layout: default +title : "Base.Structures.Substructures module (Agda Universal Algebra Library)" +date : "2021-07-26" +author: "agda-algebras development team" +--- + +### <a id="types-for-substructures-of-general-mathematical-structures">Types for Substructures of General Structures</a> + +This is the [Base.Structures.Substructures][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Substructures where + +-- Imports from Agda and the Agda Standard Library ------------------------------------ +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; Σ-syntax ; _×_ ) renaming ( proj₂ to snd ) +open import Function using ( _∘_ ) +open import Level using ( _⊔_ ; suc ; Level ) +open import Relation.Binary using ( REL ) +open import Relation.Unary using ( Pred ; _∈_ ; _⊆_ ; ⋂ ) +open import Relation.Binary.PropositionalEquality + using ( _≡_ ; module ≡-Reasoning ) + +-- Imports from the Agda Universal Algebra Library ------------------------------------- +open import Overture using ( ∣_∣ ; ∥_∥ ; _⁻¹ ) +open import Base.Functions using ( IsInjective ) +open import Base.Relations using ( Im_⊆_ ; PredType ) +open import Base.Equality using ( swelldef ) +open import Base.Terms using ( Term ) -- ; _⟦_⟧ ) + +open import Base.Structures.Basic using ( signature ; structure ; _ᵒ_ ; sigl ) + using ( siglˡ ; siglʳ ) +open import Base.Structures.Homs using ( hom ) +open import Base.Structures.Terms using ( _⟦_⟧ ) + +open structure ; open signature + +private variable + 𝓞₀ 𝓥₀ 𝓞₁ 𝓥₁ ρ α ρᵃ β ρᵇ γ ρᶜ χ ι : Level + 𝐹 : signature 𝓞₀ 𝓥₀ + 𝑅 : signature 𝓞₁ 𝓥₁ + +module _ {𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} {X : Type χ} where + + Subuniverses : Pred (Pred (carrier 𝑨) ρ) (sigl 𝐹 ⊔ α ⊔ ρ) + Subuniverses B = ∀ f a → Im a ⊆ B → (f ᵒ 𝑨) a ∈ B + + -- Subuniverses as a record type + record Subuniverse : Type (sigl 𝐹 ⊔ α ⊔ suc ρ) where + constructor mksub + field + sset : Pred (carrier 𝑨) ρ + isSub : sset ∈ Subuniverses + + -- Subuniverse Generation + data Sg (G : Pred (carrier 𝑨) ρ) : Pred (carrier 𝑨) (sigl 𝐹 ⊔ α ⊔ ρ) where + var : ∀ {v} → v ∈ G → v ∈ Sg G + app : ∀ f a → Im a ⊆ Sg G → (f ᵒ 𝑨) a ∈ Sg G + +\end{code} + +(The inferred types in the `app` constructor are `f : ∣ 𝑆 ∣` and `a : ∥ 𝑆 ∥ 𝑓 → ∣ 𝑨 ∣`.) + +Given an arbitrary subset `X` of the domain `∣ 𝑨 ∣` of an `𝑆`-algebra `𝑨`, the type `Sg X` does indeed represent a subuniverse of `𝑨`. Proving this using the inductive type `Sg` is trivial, as we see here. + +\begin{code} + + sgIsSub : {G : Pred (carrier 𝑨) ρ} → Sg G ∈ Subuniverses + sgIsSub = app + +\end{code} + +Next we prove by structural induction that `Sg X` is the smallest subuniverse of `𝑨` containing `X`. + +\begin{code} + + sgIsSmallest : {G : Pred (carrier 𝑨) ρ}(B : Pred (carrier 𝑨) ρᵇ) + → B ∈ Subuniverses → G ⊆ B → Sg G ⊆ B + + sgIsSmallest _ _ G⊆B (var Gx) = G⊆B Gx + sgIsSmallest B B≤A G⊆B {.((f ᵒ 𝑨) a)} (app f a SgGa) = Goal + where + IH : Im a ⊆ B + IH i = sgIsSmallest B B≤A G⊆B (SgGa i) + + Goal : (f ᵒ 𝑨) a ∈ B + Goal = B≤A f a IH + +\end{code} + +When the element of `Sg G` is constructed as `app f a SgGa`, we may assume (the induction hypothesis) that the arguments in the tuple `a` belong to `B`. Then the result of applying `f` to `a` also belongs to `B` since `B` is a subuniverse. + +\begin{code} + + ⋂s : (I : Type ι){𝒜 : I → Pred (carrier 𝑨) ρ} + → (∀ i → 𝒜 i ∈ Subuniverses) → ⋂ I 𝒜 ∈ Subuniverses + + ⋂s I σ f a ν = λ i → σ i f a (λ x → ν x i) + +\end{code} + +In the proof above, we assume the following typing judgments: + +``` +ν : Im a ⊆ ⋂ I 𝒜 +a : arity 𝐹 f → carrier 𝑨 +f : symbol 𝐹 +σ : (i : I) → 𝒜 i ∈ Subuniverses +𝒜 : I → Pred (carrier 𝑨) ρ (not in scope) +``` +and we must prove `(f ᵒ 𝑨) a ∈ ⋂ I 𝒜`. Agda can fill in the proof term +`λ i → σ i f a (λ x → ν x i)` automatically using `C-c C-a`. + +\begin{code} + + open Term + -- subuniverses are closed under the action of term operations + sub-term-closed : (B : Pred (carrier 𝑨) ρ) → (B ∈ Subuniverses) + → (t : Term X)(b : X → (carrier 𝑨)) + → (Im b ⊆ B) → (𝑨 ⟦ t ⟧) b ∈ B + + sub-term-closed _ _ (ℊ x) b Bb = Bb x + + sub-term-closed B B≤A (node f t) b ν = + B≤A f (λ z → (𝑨 ⟦ t z ⟧) b) (λ x → sub-term-closed B B≤A (t x) b ν) + +\end{code} + +In the induction step of the foregoing proof, the typing judgments of the premise are the following: + +``` +ν : Im b ⊆ B +b : X → carrier 𝑨 +t : arity 𝐹 f → Term X +f : symbol 𝐹 +B≤A : B ∈ Subuniverses +B : Pred (carrier 𝑨) ρ +𝑨 : structure 𝐹 𝑅 +``` +and the given proof term establishes the goal `op 𝑨 f (λ i → (𝑨 ⟦ t i ⟧) b) ∈ B` + +Alternatively, we could express the preceeding fact using an inductive type representing images of terms. + +\begin{code} + + data TermImage (B : Pred (carrier 𝑨) ρ) : Pred (carrier 𝑨) (sigl 𝐹 ⊔ α ⊔ ρ) + where + var : ∀ {b : carrier 𝑨} → b ∈ B → b ∈ TermImage B + app : ∀ f ts → ((i : (arity 𝐹) f) → ts i ∈ TermImage B) → (f ᵒ 𝑨) ts ∈ TermImage B + + -- `TermImage B` is a subuniverse of 𝑨 that contains B. + TermImageIsSub : {B : Pred (carrier 𝑨) ρ} → TermImage B ∈ Subuniverses + TermImageIsSub = app + + B-onlyif-TermImageB : {B : Pred (carrier 𝑨) ρ} → B ⊆ TermImage B + B-onlyif-TermImageB Ba = var Ba + + -- Since `Sg B` is the smallest subuniverse containing B, we obtain the following inclusion. + SgB-onlyif-TermImageB : (B : Pred (carrier 𝑨) ρ) → Sg B ⊆ TermImage B + SgB-onlyif-TermImageB B = sgIsSmallest (TermImage B) + TermImageIsSub B-onlyif-TermImageB + + module _ {𝑩 : structure 𝐹 𝑅 {β}{ρᵇ}} where + private + A = carrier 𝑨 + B = carrier 𝑩 + + -- Homomorphisms are uniquely determined by their values on a generating set. + hom-unique : swelldef (siglʳ 𝐹) β → (G : Pred A ρ) (g h : hom 𝑨 𝑩) + → ((x : A) → (x ∈ G → ∣ g ∣ x ≡ ∣ h ∣ x)) + ------------------------------------------------- + → (a : A) → (a ∈ Sg G → ∣ g ∣ a ≡ ∣ h ∣ a) + + hom-unique _ G g h σ a (var Ga) = σ a Ga + hom-unique wd G g h σ .((f ᵒ 𝑨) a) (app f a SgGa) = Goal + where + IH : ∀ x → ∣ g ∣ (a x) ≡ ∣ h ∣ (a x) + IH x = hom-unique wd G g h σ (a x) (SgGa x) + open ≡-Reasoning + Goal : ∣ g ∣ ((f ᵒ 𝑨) a) ≡ ∣ h ∣ ((f ᵒ 𝑨) a) + Goal = ∣ g ∣ ((f ᵒ 𝑨) a) ≡⟨ snd ∥ g ∥ f a ⟩ + (f ᵒ 𝑩)(∣ g ∣ ∘ a ) ≡⟨ wd (f ᵒ 𝑩) (∣ g ∣ ∘ a) (∣ h ∣ ∘ a) IH ⟩ + (f ᵒ 𝑩)(∣ h ∣ ∘ a) ≡⟨ (snd ∥ h ∥ f a)⁻¹ ⟩ + ∣ h ∣ ((f ᵒ 𝑨) a ) ∎ + +\end{code} + +In the induction step, the following typing judgments are assumed: + +``` +SgGa : Im a ⊆ Sg G +a : arity 𝐹 f → carrier 𝑨 +f : symbol 𝐹 +σ : (x : A) → x ∈ G → ∣ g ∣ x ≡ ∣ h ∣ x +h : hom 𝑨 𝑩 +g : hom 𝑨 𝑩 +G : Pred A ρ +wd : swelldef (siglʳ 𝐹) β +𝑩 : structure 𝐹 𝑅 +``` + +and, under these assumptions, we proved `∣ g ∣ ((f ᵒ 𝑨) a) ≡ ∣ h ∣ ((f ᵒ 𝑨) a)`. + +#### <a id="substructures">Substructures</a> + + +\begin{code} + +_≥_ -- (alias for supstructure (aka parent structure; aka overstructure)) + _IsSupstructureOf_ : structure 𝐹 𝑅 {α}{ρᵃ} → structure 𝐹 𝑅 {β}{ρᵇ} + → Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) + +𝑨 IsSupstructureOf 𝑩 = Σ[ h ∈ hom 𝑩 𝑨 ] IsInjective ∣ h ∣ + + +_≤_ -- (alias for subalgebra relation)) + _IsSubstructureOf_ : structure 𝐹 𝑅 {α}{ρᵃ} → structure 𝐹 𝑅 {β}{ρᵇ} + → Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ β ⊔ ρᵇ ) + +𝑨 IsSubstructureOf 𝑩 = Σ[ h ∈ hom 𝑨 𝑩 ] IsInjective ∣ h ∣ + +-- Syntactic sugar for sup/sub-algebra relations. +𝑨 ≥ 𝑩 = 𝑨 IsSupstructureOf 𝑩 +𝑨 ≤ 𝑩 = 𝑨 IsSubstructureOf 𝑩 + + +record SubstructureOf : Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ suc (α ⊔ ρᵃ ⊔ β ⊔ ρᵇ)) where + field + struc : structure 𝐹 𝑅 {α}{ρᵃ} + substruc : structure 𝐹 𝑅 {β}{ρᵇ} + issubstruc : substruc ≤ struc + + + +module _ {𝐹 : signature 𝓞₀ 𝓥₀}{𝑅 : signature 𝓞₁ 𝓥₁} where + + Substructure : structure 𝐹 𝑅 {α}{ρᵃ} → {β ρᵇ : Level} + → Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ α ⊔ ρᵃ ⊔ suc (β ⊔ ρᵇ)) + + Substructure 𝑨 {β}{ρᵇ} = Σ[ 𝑩 ∈ (structure 𝐹 𝑅 {β}{ρᵇ}) ] 𝑩 ≤ 𝑨 + + {- For 𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}, inhabitant of `Substructure 𝑨` is + a pair `(𝑩 , p) : Substructure 𝑨` providing + + a structure, `𝑩 : structure 𝐹 𝑅 {β}{ρᵇ}`, and + + a proof, `p : 𝑩 ≤ 𝑨`, that 𝑩 is a substructure of 𝐴. -} + + + IsSubstructureREL : ∀ {α}{ρᵃ}{β}{ρᵇ} + → REL (structure 𝐹 𝑅 {α}{ρᵃ})(structure 𝐹 𝑅 {β}{ρᵇ}) ρ + → Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ suc (α ⊔ ρᵃ ⊔ β ⊔ ρᵇ)) + + IsSubstructureREL {α = α}{ρᵃ}{β}{ρᵇ} R = ∀ {𝑨 : structure 𝐹 𝑅 {α}{ρᵃ}} + {𝑩 : structure 𝐹 𝑅 {β}{ρᵇ}} → 𝑨 ≤ 𝑩 + +\end{code} + +From now on we will use `𝑩 ≤ 𝑨` to express the assertion that `𝑩` is a subalgebra of `𝑨`. + +#### Substructures of a class of algebras + +Suppose `𝒦 : Pred (Algebra α 𝑆) γ` denotes a class of `𝑆`-algebras and `𝑩 : structure 𝐹 𝑅 {β}{ρᵇ}` denotes an arbitrary `𝑆`-algebra. Then we might wish to consider the assertion that `𝑩` is a subalgebra of an algebra in the class `𝒦`. The next type we define allows us to express this assertion as `𝑩 IsSubstructureOfClass 𝒦`. + +\begin{code} + + _≤c_ -- (alias for substructure-of-class relation) + _IsSubstructureOfClass_ : structure 𝐹 𝑅 {β}{ρᵇ} → Pred (structure 𝐹 𝑅 {α}{ρᵃ}) ρ + → Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ suc (α ⊔ ρᵃ) ⊔ β ⊔ ρᵇ ⊔ ρ) + + 𝑩 IsSubstructureOfClass 𝒦 = Σ[ 𝑨 ∈ PredType 𝒦 ] ((𝑨 ∈ 𝒦) × (𝑩 ≤ 𝑨)) + + 𝑩 ≤c 𝒦 = 𝑩 IsSubstructureOfClass 𝒦 + + record SubstructureOfClass : Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ suc (α ⊔ ρ ⊔ β ⊔ ρᵇ ⊔ ρᵃ)) where + field + class : Pred (structure 𝐹 𝑅 {α}{ρᵃ}) ρ + substruc : structure 𝐹 𝑅 {β}{ρᵇ} + issubstrucofclass : substruc ≤c class + + + record SubstructureOfClass' : Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ suc (α ⊔ ρ ⊔ β ⊔ ρᵇ ⊔ ρᵃ)) where + field + class : Pred (structure 𝐹 𝑅 {α}{ρᵃ}) ρ + classalgebra : structure 𝐹 𝑅 {α}{ρᵃ} + isclassalgebra : classalgebra ∈ class + subalgebra : structure 𝐹 𝑅 {β}{ρᵇ} + issubalgebra : subalgebra ≤ classalgebra + + -- The collection of subalgebras of algebras in class 𝒦. + SubstructuresOfClass : Pred (structure 𝐹 𝑅 {α}{ρᵃ}) ρ → {β ρᵇ : Level} + → Type (sigl 𝐹 ⊔ sigl 𝑅 ⊔ suc (α ⊔ ρᵃ ⊔ β ⊔ ρᵇ) ⊔ ρ) + + SubstructuresOfClass 𝒦 {β}{ρᵇ} = Σ[ 𝑩 ∈ structure 𝐹 𝑅 {β}{ρᵇ} ] 𝑩 ≤c 𝒦 +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Terms](Base.Structures.Terms.html)</span> +<span style="float:right;">[Base.Structures.EquationalLogic →](Base.Structures.EquationalLogic.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.Terms.html b/docs/Base.Structures.Terms.html new file mode 100644 index 0000000..4ecb31f --- /dev/null +++ b/docs/Base.Structures.Terms.html @@ -0,0 +1,62 @@ + +
--- +layout: default +title : "Base.Structures.Terms (The Agda Universal Algebra Library)" +date : "2021-07-26" +author: "agda-algebras development team" +--- + +### <a id="interpretation-of-terms-in-general-structures">Interpretation of Terms in General Structures</a> + +This is the [Base.Structures.Terms][] module of the [Agda Universal Algebra Library][]. + +When we interpret a term in a structure we call the resulting +function a *term operation*. Given a term `p` and a structure `𝑨`, +we denote by `𝑨 ⟦ p ⟧` the *interpretation* of `p` in `𝑨`. +This is defined inductively as follows. + +1. If `p` is a variable symbol `x : X` and + if `a : X → ∣ 𝑨 ∣` is a tuple of elements of `∣ 𝑨 ∣`, then + define `𝑨 ⟦ p ⟧ a := a x`. + +2. If `p = f t`, where `f : ∣ 𝑆 ∣` is an operation symbol, + if `t : (arity 𝐹) f → 𝑻 X` is a tuple of terms, and + if `a : X → ∣ 𝑨 ∣` is a tuple from `𝑨`, then + define `𝑨 ⟦ p ⟧ a := (f ᵒ 𝑨) (λ i → 𝑨 ⟦ t i ⟧ a)`. + +Thus interpretation of a term is defined by structural induction. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures.Terms where + +-- Imports from Agda and the Agda Standard Library --------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Level using ( Level ) + +open import Base.Structures.Basic using ( signature ; structure ; _ᵒ_ ) +open import Base.Terms.Basic + +private variable + 𝓞₀ 𝓥₀ 𝓞₁ 𝓥₁ χ α ρ : Level + 𝐹 : signature 𝓞₀ 𝓥₀ + 𝑅 : signature 𝓞₁ 𝓥₁ + X : Type χ + +open signature +open structure + +_⟦_⟧ : (𝑨 : structure 𝐹 𝑅 {α} {ρ}) → Term X → (X → carrier 𝑨) → carrier 𝑨 +𝑨 ⟦ ℊ x ⟧ = λ a → a x +𝑨 ⟦ node f t ⟧ = λ a → (f ᵒ 𝑨) (λ i → (𝑨 ⟦ t i ⟧ ) a) +\end{code} + +-------------------------------- + +<span style="float:left;">[← Base.Structures.Isos](Base.Structures.Isos.html)</span> +<span style="float:right;">[Base.Structures.Substructures →](Base.Structures.Substructures.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Structures.html b/docs/Base.Structures.html new file mode 100644 index 0000000..cc78216 --- /dev/null +++ b/docs/Base.Structures.html @@ -0,0 +1,39 @@ + +
--- +layout: default +title : "Base.Structures module (Agda Universal Algebra Library)" +date : "2021-07-26" +author: "agda-algebras development team" +--- + +## <a id="types-for-general-mathematical-structures">Types for General Mathematical Structures</a> + +This is the [Base.Structures][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Base.Structures where + +open import Base.Structures.Basic public +open import Base.Structures.Products public +open import Base.Structures.Congruences public +open import Base.Structures.Homs public +open import Base.Structures.Graphs public +open import Base.Structures.Graphs0 +open import Base.Structures.Isos public +open import Base.Structures.Terms public +open import Base.Structures.Substructures public +open import Base.Structures.EquationalLogic public +open import Base.Structures.Sigma + +\end{code} + +-------------------------------- + +<span style="float:left;">[↑ Base](Base.html)</span> +<span style="float:right;">[Base.Structures.Basic →](Base.Structures.Basic.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Terms.Basic.html b/docs/Base.Terms.Basic.html new file mode 100644 index 0000000..05fd2c0 --- /dev/null +++ b/docs/Base.Terms.Basic.html @@ -0,0 +1,95 @@ + +
--- +layout: default +title : "Base.Terms.Basic module (The Agda Universal Algebra Library)" +date : "2021-01-14" +author: "the agda-algebras development team" +--- + +### <a id="basic-definitions">Basic Definitions</a> + +This is the [Base.Terms.Basic][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using (Signature ; 𝓞 ; 𝓥 ) + +module Base.Terms.Basic {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library ---------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ) +open import Level using ( Level ) + +-- Imports from the Agda Universal Algebra Library ---------------- +open import Overture using ( ∣_∣ ; ∥_∥ ) +open import Base.Algebras {𝑆 = 𝑆} using ( Algebra ; ov ) + +private variable χ : Level +\end{code} + +#### <a id="the-type-of-terms">The type of terms</a> + +Fix a signature `𝑆` and let `X` denote an arbitrary nonempty collection of variable +symbols. Assume the symbols in `X` are distinct from the operation symbols of `𝑆`, +that is `X ∩ ∣ 𝑆 ∣ = ∅`. + +By a *word* in the language of `𝑆`, we mean a nonempty, finite sequence of members +of `X ∪ ∣ 𝑆 ∣`. We denote the concatenation of such sequences by simple juxtaposition. + +Let `S₀` denote the set of nullary operation symbols of `𝑆`. We define by induction +on `n` the sets `𝑇ₙ` of *words* over `X ∪ ∣ 𝑆 ∣` as follows +(cf. [Bergman (2012)][] Def. 4.19): + +`𝑇₀ := X ∪ S₀` and `𝑇ₙ₊₁ := 𝑇ₙ ∪ 𝒯ₙ` + +where `𝒯ₙ` is the collection of all `f t` such that `f : ∣ 𝑆 ∣` and `t : ∥ 𝑆 ∥ f → 𝑇ₙ`. +(Recall, `∥ 𝑆 ∥ f` is the arity of the operation symbol `f`.) + +We define the collection of *terms* in the signature `𝑆` over `X` by `Term X := ⋃ₙ 𝑇ₙ`. +By an 𝑆-*term* we mean a term in the language of `𝑆`. + +The definition of `Term X` is recursive, indicating that an inductive type could be used +to represent the semantic notion of terms in type theory. Indeed, such a representation +is given by the following inductive type. + +\begin{code} + +data Term (X : Type χ ) : Type (ov χ) where + ℊ : X → Term X -- (ℊ for "generator") + node : (f : ∣ 𝑆 ∣)(t : ∥ 𝑆 ∥ f → Term X) → Term X + +open Term + +\end{code} + +This is a very basic inductive type that represents each term as a tree with an operation symbol at each `node` and a variable symbol at each leaf (`generator`). + +**Notation**. As usual, the type `X` represents an arbitrary collection of variable symbols. Recall, `ov χ` is our shorthand notation for the universe level `𝓞 ⊔ 𝓥 ⊔ suc χ`. + + +#### <a id="the-term-algebra">The term algebra</a> + +For a given signature `𝑆`, if the type `Term X` is nonempty (equivalently, if `X` or `∣ 𝑆 ∣` is nonempty), then we can define an algebraic structure, denoted by `𝑻 X` and called the *term algebra in the signature* `𝑆` *over* `X`. Terms are viewed as acting on other terms, so both the domain and basic operations of the algebra are the terms themselves. + + ++ For each operation symbol `f : ∣ 𝑆 ∣`, denote by `f ̂ (𝑻 X)` the operation on `Term X` that maps a tuple `t : ∥ 𝑆 ∥ f → ∣ 𝑻 X ∣` to the formal term `f t`. ++ Define `𝑻 X` to be the algebra with universe `∣ 𝑻 X ∣ := Term X` and operations `f ̂ (𝑻 X)`, one for each symbol `f` in `∣ 𝑆 ∣`. + +In [Agda][] the term algebra can be defined as simply as one could hope. + +\begin{code} + +𝑻 : (X : Type χ ) → Algebra (ov χ) +𝑻 X = Term X , node +\end{code} + +------------------------------ + +<span style="float:left;">[↑ Base.Terms](Base.Terms.html)</span> +<span style="float:right;">[Base.Terms.Properties →](Base.Terms.Properties.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Terms.Operations.html b/docs/Base.Terms.Operations.html new file mode 100644 index 0000000..e5af027 --- /dev/null +++ b/docs/Base.Terms.Operations.html @@ -0,0 +1,290 @@ + +
--- +layout: default +title : "Base.Terms.Operations module (The Agda Universal Algebra Library)" +date : "2021-01-14" +author: "agda-algebras development team" +--- + +### <a id="term-operations">Term Operations</a> + +This section presents the [Base.Terms.Operations][] module of the [Agda Universal Algebra Library][]. + +Here we define *term operations* which are simply terms interpreted in a +particular algebra, and we prove some compatibility properties of term operations. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( 𝓞 ; 𝓥 ; Signature ) + +module Base.Terms.Operations {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library --------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; Σ-syntax ; Σ ) +open import Function using ( _∘_ ) +open import Level using ( Level ; _⊔_ ) +open import Relation.Binary.PropositionalEquality as ≡ + using ( _≡_ ; module ≡-Reasoning ) +open import Axiom.Extensionality.Propositional + using () renaming (Extensionality to funext) + +-- Imports from Agda Universal Algebra Library ---------------------------------------------- +open import Overture using ( _∙_ ; _⁻¹ ; ∣_∣ ; ∥_∥ ; Π ; Π-syntax ; _≈_ ) +open import Base.Relations using ( _|:_ ) +open import Base.Equality using ( swelldef ) + +open import Base.Algebras {𝑆 = 𝑆} using ( Algebra ; _̂_ ; ov ; ⨅ ) + using ( IsCongruence ; Con ) +open import Base.Homomorphisms {𝑆 = 𝑆} using ( hom ) +open import Base.Terms.Basic {𝑆 = 𝑆} using ( Term ; 𝑻 ) +open import Base.Terms.Properties {𝑆 = 𝑆} using ( free-lift ) + +open Term +private variable α β γ ρ χ : Level + +\end{code} + +When we interpret a term in an algebra we call the resulting function a +*term operation*. Given a term `p` and an algebra `𝑨`, we denote by `𝑨 ⟦ p ⟧` +the *interpretation* of `p` in `𝑨`. This is defined inductively as follows. + +1. If `p` is a variable symbol `x : X` and if `a : X → ∣ 𝑨 ∣` is a tuple of + elements of `∣ 𝑨 ∣`, then `𝑨 ⟦ p ⟧ a := a x`. + +2. If `p = f t`, where `f : ∣ 𝑆 ∣` is an operation symbol, if `t : ∥ 𝑆 ∥ f → 𝑻 X` + is a tuple of terms, and if `a : X → ∣ 𝑨 ∣` is a tuple from `𝑨`, then we + define `𝑨 ⟦ p ⟧ a = 𝑨 ⟦ f t ⟧ a := (f ̂ 𝑨) (λ i → 𝑨 ⟦ t i ⟧ a)`. + +Thus the interpretation of a term is defined by induction on the structure of the +term, and the definition is formally implemented in the [agda-algebras][] +library as follows. + +\begin{code} + +_⟦_⟧ : (𝑨 : Algebra α){X : Type χ } → Term X → (X → ∣ 𝑨 ∣) → ∣ 𝑨 ∣ +𝑨 ⟦ ℊ x ⟧ = λ η → η x +𝑨 ⟦ node f t ⟧ = λ η → (f ̂ 𝑨) (λ i → (𝑨 ⟦ t i ⟧) η) + +\end{code} + +It turns out that the intepretation of a term is the same as the `free-lift` +(modulo argument order and assuming function extensionality). + +\begin{code} + +free-lift-interp : swelldef 𝓥 α → (𝑨 : Algebra α){X : Type χ } + (η : X → ∣ 𝑨 ∣)(p : Term X) → (𝑨 ⟦ p ⟧) η ≡ (free-lift 𝑨 η) p + +free-lift-interp _ 𝑨 η (ℊ x) = ≡.refl +free-lift-interp wd 𝑨 η (node f t) = + wd (f ̂ 𝑨) (λ z → (𝑨 ⟦ t z ⟧) η) + ((free-lift 𝑨 η) ∘ t)((free-lift-interp wd 𝑨 η) ∘ t) + +\end{code} + +If the algebra in question happens to be `𝑻 X`, then we expect that `∀ s` +we have `(𝑻 X)⟦ p ⟧ s ≡ p s`. But what is `(𝑻 X)⟦ p ⟧ s` exactly? By +definition, it depends on the form of `p` as follows: + +* if `p = ℊ x`, then `(𝑻 X)⟦ p ⟧ s := (𝑻 X)⟦ ℊ x ⟧ s ≡ s x` + +* if `p = node f t`, then + `(𝑻 X)⟦ p ⟧ s := (𝑻 X)⟦ node f t ⟧ s = (f ̂ 𝑻 X) λ i → (𝑻 X)⟦ t i ⟧ s` + +Now, assume `ϕ : hom 𝑻 𝑨`. Then by `comm-hom-term`, we have +`∣ ϕ ∣ (𝑻 X)⟦ p ⟧ s = 𝑨 ⟦ p ⟧ ∣ ϕ ∣ ∘ s`. + +* if `p = ℊ x` (and `t : X → ∣ 𝑻 X ∣`), then + + `∣ ϕ ∣ p ≡ ∣ ϕ ∣ (ℊ x) ≡ ∣ ϕ ∣ (λ t → h t) ≡ λ t → (∣ ϕ ∣ ∘ t) x` + +* if `p = node f t`, then + + `∣ ϕ ∣ p ≡ ∣ ϕ ∣ (𝑻 X)⟦ p ⟧ s = (𝑻 X)⟦ node f t ⟧ s = (f ̂ 𝑻 X) λ i → (𝑻 X)⟦ t i ⟧ s` + +We claim that for all `p : Term X` there exists `q : Term X` and `t : X → ∣ 𝑻 X ∣` +such that `p ≡ (𝑻 X)⟦ q ⟧ t`. We prove this fact as follows. + +\begin{code} + +term-interp : {X : Type χ} (f : ∣ 𝑆 ∣){s t : ∥ 𝑆 ∥ f → Term X} + → s ≡ t → node f s ≡ (f ̂ 𝑻 X) t + +term-interp f {s}{t} st = ≡.cong (node f) st + + +term-interp' : swelldef 𝓥 (ov χ) → {X : Type χ} (f : ∣ 𝑆 ∣){s t : ∥ 𝑆 ∥ f → Term X} + → (∀ i → s i ≡ t i) → node f s ≡ (f ̂ 𝑻 X) t + +term-interp' wd f {s}{t} st = wd (node f) s t st + + +term-gen : swelldef 𝓥 (ov χ) → {X : Type χ}(p : ∣ 𝑻 X ∣) + → Σ[ q ∈ ∣ 𝑻 X ∣ ] p ≡ (𝑻 X ⟦ q ⟧) ℊ + +term-gen _ (ℊ x) = (ℊ x) , ≡.refl +term-gen wd (node f t) = (node f (λ i → ∣ term-gen wd (t i) ∣)) , + term-interp' wd f λ i → ∥ term-gen wd (t i) ∥ + +term-gen-agreement : (wd : swelldef 𝓥 (ov χ)){X : Type χ}(p : ∣ 𝑻 X ∣) + → (𝑻 X ⟦ p ⟧) ℊ ≡ (𝑻 X ⟦ ∣ term-gen wd p ∣ ⟧) ℊ +term-gen-agreement _ (ℊ x) = ≡.refl +term-gen-agreement wd {X} (node f t) = wd ( f ̂ 𝑻 X) (λ x → (𝑻 X ⟦ t x ⟧) ℊ) + (λ x → (𝑻 X ⟦ ∣ term-gen wd (t x) ∣ ⟧) ℊ) + λ i → term-gen-agreement wd (t i) + +term-agreement : swelldef 𝓥 (ov χ) → {X : Type χ}(p : ∣ 𝑻 X ∣) → p ≡ (𝑻 X ⟦ p ⟧) ℊ +term-agreement wd {X} p = ∥ term-gen wd p ∥ ∙ (term-gen-agreement wd p)⁻¹ +\end{code} + + +#### <a id="interpretation-of-terms-in-product-algebras">Interpretation of terms in product algebras</a> + +\begin{code} + +module _ (wd : swelldef 𝓥 (β ⊔ α)){X : Type χ }{I : Type β} where + + interp-prod : (p : Term X)(𝒜 : I → Algebra α)(a : X → Π[ i ∈ I ] ∣ 𝒜 i ∣) + → (⨅ 𝒜 ⟦ p ⟧) a ≡ λ i → (𝒜 i ⟦ p ⟧)(λ x → (a x) i) + + interp-prod (ℊ _) 𝒜 a = ≡.refl + interp-prod (node f t) 𝒜 a = wd ((f ̂ ⨅ 𝒜)) u v IH + where + u : ∀ x → ∣ ⨅ 𝒜 ∣ + u = λ x → (⨅ 𝒜 ⟦ t x ⟧) a + v : ∀ x i → ∣ 𝒜 i ∣ + v = λ x i → (𝒜 i ⟦ t x ⟧)(λ j → a j i) + IH : ∀ i → u i ≡ v i + IH = λ x → interp-prod (t x) 𝒜 a + + interp-prod2 : funext (α ⊔ β ⊔ χ) (α ⊔ β) → (p : Term X)(𝒜 : I → Algebra α) + → ⨅ 𝒜 ⟦ p ⟧ ≡ (λ a i → (𝒜 i ⟦ p ⟧) λ x → a x i) + + interp-prod2 _ (ℊ x₁) 𝒜 = ≡.refl + interp-prod2 fe (node f t) 𝒜 = fe λ a → wd (f ̂ ⨅ 𝒜)(u a) (v a) (IH a) + where + u : ∀ a x → ∣ ⨅ 𝒜 ∣ + u a = λ x → (⨅ 𝒜 ⟦ t x ⟧) a + v : ∀ (a : X → ∣ ⨅ 𝒜 ∣) → ∀ x i → ∣ 𝒜 i ∣ + v a = λ x i → (𝒜 i ⟦ t x ⟧)(λ z → (a z) i) + IH : ∀ a x → (⨅ 𝒜 ⟦ t x ⟧) a ≡ λ i → (𝒜 i ⟦ t x ⟧)(λ z → (a z) i) + IH a = λ x → interp-prod (t x) 𝒜 a +\end{code} + + +#### <a id="compatibility-of-terms">Compatibility of terms</a> + +We now prove two important facts about term operations. The first of these, which +is used very often in the sequel, asserts that every term commutes with every +homomorphism. + +\begin{code} + +open ≡-Reasoning + +comm-hom-term : swelldef 𝓥 β → {𝑨 : Algebra α} (𝑩 : Algebra β) + (h : hom 𝑨 𝑩){X : Type χ}(t : Term X)(a : X → ∣ 𝑨 ∣) + ------------------------------------------------------ + → ∣ h ∣ ((𝑨 ⟦ t ⟧) a) ≡ (𝑩 ⟦ t ⟧) (∣ h ∣ ∘ a) + +comm-hom-term _ 𝑩 h (ℊ x) a = ≡.refl +comm-hom-term wd {𝑨} 𝑩 h (node f t) a = + ∣ h ∣((f ̂ 𝑨) λ i → (𝑨 ⟦ t i ⟧) a) ≡⟨ i ⟩ + (f ̂ 𝑩)(λ i → ∣ h ∣ ((𝑨 ⟦ t i ⟧) a)) ≡⟨ ii ⟩ + (f ̂ 𝑩)(λ r → (𝑩 ⟦ t r ⟧) (∣ h ∣ ∘ a)) ∎ + where i = ∥ h ∥ f λ r → (𝑨 ⟦ t r ⟧) a + ii = wd (f ̂ 𝑩) ( λ i₁ → ∣ h ∣ ((𝑨 ⟦ t i₁ ⟧) a) ) + ( λ r → (𝑩 ⟦ t r ⟧) (λ x → ∣ h ∣ (a x)) ) + λ j → comm-hom-term wd 𝑩 h (t j) a + +\end{code} + +To conclude this module, we prove that every term is compatible with every +congruence relation. That is, if `t : Term X` and `θ : Con 𝑨`, then +`a θ b → t(a) θ t(b)`. (Recall, the compatibility relation `|:` was defined in +[Relations.Discrete][].) + +\begin{code} + + +module _ {α β : Level}{X : Type α} where + + open IsCongruence + + _∣:_ : {𝑨 : Algebra α}(t : Term X)(θ : Con{α}{β} 𝑨) → (𝑨 ⟦ t ⟧) |: ∣ θ ∣ + ((ℊ x) ∣: θ) p = p x + ((node f t) ∣: θ) p = (is-compatible ∥ θ ∥) f λ x → ((t x) ∣: θ) p + +\end{code} + +**WARNING!** The compatibility relation for terms `∣:` is typed as \|:, whereas +the compatibility type for functions `|:` (defined in the +[Base.Relations.Discrete][] module) is typed as `|:`. + + + +#### <a id="substitution">Substitution</a> + +A substitution from `Y` to `X` is simply a function from `Y` to `X`, and the +application of a substitution is represented as follows. + +\begin{code} + +_[_] : {χ : Level}{X Y : Type χ} → Term Y → (Y → X) → Term X +(ℊ y) [ σ ] = ℊ (σ y) +(node f t) [ σ ] = node f λ i → t i [ σ ] + +\end{code} + +Alternatively, we may want a substitution that replaces each variable symbol in +`Y`, not with an element of `X`, but with a term from `Term X`. + +\begin{code} + +-- Substerm X Y, an inhabitant of which replaces each variable symbol in Y +-- with a term from Term X. +Substerm : (X Y : Type χ) → Type (ov χ) +Substerm X Y = (y : Y) → Term X + +-- Application of a Substerm. +_[_]t : {X Y : Type χ } → Term Y → Substerm X Y → Term X +(ℊ y) [ σ ]t = σ y +(node f t) [ σ ]t = node f (λ z → (t z) [ σ ]t ) + +\end{code} + +Next we prove the important Substitution Theorem which asserts that an identity `p +≈ q` holds in an algebra `𝑨` iff it holds in `𝑨` after applying any substitution. + +\begin{code} + +subst-lemma : swelldef 𝓥 α → {X Y : Type χ }(p : Term Y)(σ : Y → X) + (𝑨 : Algebra α)(η : X → ∣ 𝑨 ∣) + → (𝑨 ⟦ p [ σ ] ⟧) η ≡ (𝑨 ⟦ p ⟧) (η ∘ σ) + +subst-lemma _ (ℊ x) σ 𝑨 η = ≡.refl +subst-lemma wd (node f t) σ 𝑨 η = wd (f ̂ 𝑨) ( λ i → (𝑨 ⟦ (t i) [ σ ] ⟧) η ) + ( λ i → (𝑨 ⟦ t i ⟧) (η ∘ σ) ) + λ i → subst-lemma wd (t i) σ 𝑨 η + +subst-theorem : swelldef 𝓥 α → {X Y : Type χ } + (p q : Term Y)(σ : Y → X)(𝑨 : Algebra α) + → 𝑨 ⟦ p ⟧ ≈ 𝑨 ⟦ q ⟧ → 𝑨 ⟦ p [ σ ] ⟧ ≈ 𝑨 ⟦ q [ σ ] ⟧ + +subst-theorem wd p q σ 𝑨 Apq η = + (𝑨 ⟦ p [ σ ] ⟧) η ≡⟨ subst-lemma wd p σ 𝑨 η ⟩ + (𝑨 ⟦ p ⟧) (η ∘ σ) ≡⟨ Apq (η ∘ σ) ⟩ + (𝑨 ⟦ q ⟧) (η ∘ σ) ≡⟨ ≡.sym (subst-lemma wd q σ 𝑨 η) ⟩ + (𝑨 ⟦ q [ σ ] ⟧) η ∎ +\end{code} + +---------------------------------- + +<span style="float:left;">[← Base.Terms.Properties](Base.Terms.Properties.html)</span> +<span style="float:right;">[Base.Subalgebras →](Base.Subalgebras.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Terms.Properties.html b/docs/Base.Terms.Properties.html new file mode 100644 index 0000000..aefe058 --- /dev/null +++ b/docs/Base.Terms.Properties.html @@ -0,0 +1,136 @@ + +
--- +layout: default +title : "Base.Terms.Properties module (The Agda Universal Algebra Library)" +date : "2021-07-03" +author: "agda-algebras development team" +--- + +### <a id="properties-of-terms-and-the-term-algebra">Properties of Terms and the Term Algebra</a> + +This is the [Base.Terms.Properties][] module of the [Agda Universal Algebra Library][]. + + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using ( 𝓞 ; 𝓥 ; Signature ) + +module Base.Terms.Properties {𝑆 : Signature 𝓞 𝓥} where + +-- Imports from Agda and the Agda Standard Library -------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( _,_ ; Σ-syntax ) +open import Function using ( _∘_ ) +open import Data.Empty.Polymorphic using ( ⊥ ) +open import Level using ( Level ) +open import Relation.Binary using ( IsEquivalence ; Setoid ; Reflexive ) + using ( Symmetric ; Transitive ) +open import Relation.Binary.PropositionalEquality as ≡ + using ( _≡_ ; module ≡-Reasoning ) +open import Axiom.Extensionality.Propositional + using () renaming (Extensionality to funext) + + +-- Imports from the Agda Universal Algebra Library ---------------------------------------- +open import Overture using ( _⁻¹ ; 𝑖𝑑 ; ∣_∣ ; ∥_∥ ) +open import Base.Functions using ( Inv ; InvIsInverseʳ ; Image_∋_) + using ( eq ; IsSurjective ) +open import Base.Equality using ( swelldef ) + +open import Base.Algebras {𝑆 = 𝑆} using ( Algebra ; _̂_ ; ov ) +open import Base.Homomorphisms {𝑆 = 𝑆} using ( hom ) +open import Base.Terms.Basic {𝑆 = 𝑆} using ( Term ; 𝑻 ) + +open Term +private variable α β χ : Level +\end{code} + +#### <a id="the-universal-property">The universal property</a> + +The term algebra `𝑻 X` is *absolutely free* (or *universal*, or *initial*) for algebras in the signature `𝑆`. That is, for every 𝑆-algebra `𝑨`, the following hold. + +1. Every function from `𝑋` to `∣ 𝑨 ∣` lifts to a homomorphism from `𝑻 X` to `𝑨`. +2. The homomorphism that exists by item 1 is unique. + +We now prove this in [Agda][], starting with the fact that every map from `X` to `∣ 𝑨 ∣` lifts to a map from `∣ 𝑻 X ∣` to `∣ 𝑨 ∣` in a natural way, by induction on the structure of the given term. + +\begin{code} + +private variable X : Type χ + +free-lift : (𝑨 : Algebra α)(h : X → ∣ 𝑨 ∣) → ∣ 𝑻 X ∣ → ∣ 𝑨 ∣ +free-lift _ h (ℊ x) = h x +free-lift 𝑨 h (node f 𝑡) = (f ̂ 𝑨) (λ i → free-lift 𝑨 h (𝑡 i)) + +\end{code} + +Naturally, at the base step of the induction, when the term has the form `generator` +x, the free lift of `h` agrees with `h`. For the inductive step, when the +given term has the form `node f 𝑡`, the free lift is defined as +follows: Assuming (the induction hypothesis) that we know the image of each +subterm `𝑡 i` under the free lift of `h`, define the free lift at the +full term by applying `f ̂ 𝑨` to the images of the subterms. + +The free lift so defined is a homomorphism by construction. Indeed, here is the trivial proof. + +\begin{code} + +lift-hom : (𝑨 : Algebra α) → (X → ∣ 𝑨 ∣) → hom (𝑻 X) 𝑨 +lift-hom 𝑨 h = free-lift 𝑨 h , λ f a → ≡.cong (f ̂ 𝑨) ≡.refl + +\end{code} + +Finally, we prove that the homomorphism is unique. This requires `funext 𝓥 α` (i.e., *function extensionality* at universe levels `𝓥` and `α`) which we postulate by making it part of the premise in the following function type definition. + +\begin{code} + +open ≡-Reasoning + +free-unique : swelldef 𝓥 α → (𝑨 : Algebra α)(g h : hom (𝑻 X) 𝑨) + → (∀ x → ∣ g ∣ (ℊ x) ≡ ∣ h ∣ (ℊ x)) + → ∀(t : Term X) → ∣ g ∣ t ≡ ∣ h ∣ t + +free-unique _ _ _ _ p (ℊ x) = p x + +free-unique wd 𝑨 g h p (node 𝑓 𝑡) = + ∣ g ∣ (node 𝑓 𝑡) ≡⟨ ∥ g ∥ 𝑓 𝑡 ⟩ + (𝑓 ̂ 𝑨)(∣ g ∣ ∘ 𝑡) ≡⟨ Goal ⟩ + (𝑓 ̂ 𝑨)(∣ h ∣ ∘ 𝑡) ≡⟨ (∥ h ∥ 𝑓 𝑡)⁻¹ ⟩ + ∣ h ∣ (node 𝑓 𝑡) ∎ + where + Goal : (𝑓 ̂ 𝑨) (λ x → ∣ g ∣ (𝑡 x)) ≡ (𝑓 ̂ 𝑨) (λ x → ∣ h ∣ (𝑡 x)) + Goal = wd (𝑓 ̂ 𝑨)(∣ g ∣ ∘ 𝑡)(∣ h ∣ ∘ 𝑡)(λ i → free-unique wd 𝑨 g h p (𝑡 i)) + +\end{code} + +Let's account for what we have proved thus far about the term algebra. If we postulate a type `X : Type χ` (representing an arbitrary collection of variable symbols) such that for each `𝑆`-algebra `𝑨` there is a map from `X` to the domain of `𝑨`, then it follows that for every `𝑆`-algebra `𝑨` there is a homomorphism from `𝑻 X` to `∣ 𝑨 ∣` that "agrees with the original map on `X`," by which we mean that for all `x : X` the lift evaluated at `ℊ x` is equal to the original function evaluated at `x`. + +If we further assume that each of the mappings from `X` to `∣ 𝑨 ∣` is *surjective*, then the homomorphisms constructed with `free-lift` and `lift-hom` are *epimorphisms*, as we now prove. + +\begin{code} + +lift-of-epi-is-epi : (𝑨 : Algebra α){h₀ : X → ∣ 𝑨 ∣} + → IsSurjective h₀ → IsSurjective ∣ lift-hom 𝑨 h₀ ∣ + +lift-of-epi-is-epi 𝑨 {h₀} hE y = Goal + where + h₀⁻¹y = Inv h₀ (hE y) + + η : y ≡ ∣ lift-hom 𝑨 h₀ ∣ (ℊ h₀⁻¹y) + η = (InvIsInverseʳ (hE y))⁻¹ + + Goal : Image ∣ lift-hom 𝑨 h₀ ∣ ∋ y + Goal = eq (ℊ h₀⁻¹y) η +\end{code} + +The `lift-hom` and `lift-of-epi-is-epi` types will be called to action when such epimorphisms are needed later (e.g., in the [Base.Varieties][] module). + +------------------------------ + +<span style="float:left;">[← Base.Terms.Basic](Base.Terms.Basic.html)</span> +<span style="float:right;">[Base.Terms.Operations →](Base.Terms.Operations.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Base.Terms.html b/docs/Base.Terms.html new file mode 100644 index 0000000..9beabd7 --- /dev/null +++ b/docs/Base.Terms.html @@ -0,0 +1,33 @@ + +
--- +layout: default +title : "Base.Terms module (The Agda Universal Algebra Library)" +date : "2021-01-14" +author: "agda-algebras development team" +--- + +## <a id="types-for-terms">Types for Terms</a> + +This is the [Base.Terms][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +open import Overture using (Signature ; 𝓞 ; 𝓥 ) + +module Base.Terms {𝑆 : Signature 𝓞 𝓥} where + +open import Base.Terms.Basic {𝑆 = 𝑆} public +open import Base.Terms.Properties {𝑆 = 𝑆} public +open import Base.Terms.Operations {𝑆 = 𝑆} public + +\end{code} + +------------------------------------- + +<span style="float:left;">[← Base.Homomorphisms.HomomorphicImages](Base.Homomorphisms.HomomorphicImages.html)</span> +<span style="float:right;">[Base.Terms.Basic →](Base.Terms.Basic.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Category.Applicative.Indexed.html b/docs/Category.Applicative.Indexed.html new file mode 100644 index 0000000..4098977 --- /dev/null +++ b/docs/Category.Applicative.Indexed.html @@ -0,0 +1,116 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Indexed applicative functors +------------------------------------------------------------------------ + +-- Note that currently the applicative functor laws are not included +-- here. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Category.Applicative.Indexed where + +open import Category.Functor using (RawFunctor) +open import Data.Product using (_×_; _,_) +open import Function hiding (Morphism) +open import Level +open import Relation.Binary.PropositionalEquality as P using (_≡_) + +private + variable + a b c i f : Level + A : Set a + B : Set b + C : Set c + +IFun : Set i → (ℓ : Level) → Set (i ⊔ suc ℓ) +IFun I ℓ = I → I → Set ℓ → Set ℓ + +------------------------------------------------------------------------ +-- Type, and usual combinators + +record RawIApplicative {I : Set i} (F : IFun I f) : + Set (i ⊔ suc f) where + infixl 4 _⊛_ _<⊛_ _⊛>_ + infix 4 _⊗_ + + field + pure : ∀ {i} → A → F i i A + _⊛_ : ∀ {i j k} → F i j (A → B) → F j k A → F i k B + + rawFunctor : ∀ {i j} → RawFunctor (F i j) + rawFunctor = record + { _<$>_ = λ g x → pure g ⊛ x + } + + private + open module RF {i j : I} = + RawFunctor (rawFunctor {i = i} {j = j}) + public + + _<⊛_ : ∀ {i j k} → F i j A → F j k B → F i k A + x <⊛ y = const <$> x ⊛ y + + _⊛>_ : ∀ {i j k} → F i j A → F j k B → F i k B + x ⊛> y = constᵣ <$> x ⊛ y + + _⊗_ : ∀ {i j k} → F i j A → F j k B → F i k (A × B) + x ⊗ y = (_,_) <$> x ⊛ y + + zipWith : ∀ {i j k} → (A → B → C) → F i j A → F j k B → F i k C + zipWith f x y = f <$> x ⊛ y + + zip : ∀ {i j k} → F i j A → F j k B → F i k (A × B) + zip = zipWith _,_ + +------------------------------------------------------------------------ +-- Applicative with a zero + +record RawIApplicativeZero + {I : Set i} (F : IFun I f) : + Set (i ⊔ suc f) where + field + applicative : RawIApplicative F + ∅ : ∀ {i j} → F i j A + + open RawIApplicative applicative public + +------------------------------------------------------------------------ +-- Alternative functors: `F i j A` is a monoid + +record RawIAlternative + {I : Set i} (F : IFun I f) : + Set (i ⊔ suc f) where + infixr 3 _∣_ + field + applicativeZero : RawIApplicativeZero F + _∣_ : ∀ {i j} → F i j A → F i j A → F i j A + + open RawIApplicativeZero applicativeZero public + + +------------------------------------------------------------------------ +-- Applicative functor morphisms, specialised to propositional +-- equality. + +record Morphism {I : Set i} {F₁ F₂ : IFun I f} + (A₁ : RawIApplicative F₁) + (A₂ : RawIApplicative F₂) : Set (i ⊔ suc f) where + module A₁ = RawIApplicative A₁ + module A₂ = RawIApplicative A₂ + field + op : ∀ {i j} → F₁ i j A → F₂ i j A + op-pure : ∀ {i} (x : A) → op (A₁.pure {i = i} x) ≡ A₂.pure x + op-⊛ : ∀ {i j k} (f : F₁ i j (A → B)) (x : F₁ j k A) → + op (f A₁.⊛ x) ≡ (op f A₂.⊛ op x) + + op-<$> : ∀ {i j} (f : A → B) (x : F₁ i j A) → + op (f A₁.<$> x) ≡ (f A₂.<$> op x) + op-<$> f x = begin + op (A₁._⊛_ (A₁.pure f) x) ≡⟨ op-⊛ _ _ ⟩ + A₂._⊛_ (op (A₁.pure f)) (op x) ≡⟨ P.cong₂ A₂._⊛_ (op-pure _) P.refl ⟩ + A₂._⊛_ (A₂.pure f) (op x) ∎ + where open P.≡-Reasoning +\ No newline at end of file diff --git a/docs/Category.Applicative.html b/docs/Category.Applicative.html new file mode 100644 index 0000000..7d1f51c --- /dev/null +++ b/docs/Category.Applicative.html @@ -0,0 +1,43 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Applicative functors +------------------------------------------------------------------------ + +-- Note that currently the applicative functor laws are not included +-- here. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Category.Applicative where + +open import Level using (Level; suc; _⊔_) +open import Data.Unit +open import Category.Applicative.Indexed + +private + variable + f : Level + +RawApplicative : (Set f → Set f) → Set (suc f) +RawApplicative F = RawIApplicative {I = ⊤} λ _ _ → F + +module RawApplicative {F : Set f → Set f} + (app : RawApplicative F) where + open RawIApplicative app public + +RawApplicativeZero : (Set f → Set f) → Set (suc f) +RawApplicativeZero F = RawIApplicativeZero {I = ⊤} (λ _ _ → F) + +module RawApplicativeZero {F : Set f → Set f} + (app : RawApplicativeZero F) where + open RawIApplicativeZero app public + +RawAlternative : (Set f → Set f) → Set _ +RawAlternative F = RawIAlternative {I = ⊤} (λ _ _ → F) + +module RawAlternative {F : Set f → Set f} + (app : RawAlternative F) where + open RawIAlternative app public +\ No newline at end of file diff --git a/docs/Category.Functor.html b/docs/Category.Functor.html new file mode 100644 index 0000000..96b16ca --- /dev/null +++ b/docs/Category.Functor.html @@ -0,0 +1,48 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Functors +------------------------------------------------------------------------ + +-- Note that currently the functor laws are not included here. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Category.Functor where + +open import Function hiding (Morphism) +open import Level + +open import Relation.Binary.PropositionalEquality + +private + variable + ℓ ℓ′ ℓ″ : Level + A B X Y : Set ℓ + +record RawFunctor (F : Set ℓ → Set ℓ′) : Set (suc ℓ ⊔ ℓ′) where + infixl 4 _<$>_ _<$_ + infixl 1 _<&>_ + + field + _<$>_ : (A → B) → F A → F B + + _<$_ : A → F B → F A + x <$ y = const x <$> y + + _<&>_ : F A → (A → B) → F B + _<&>_ = flip _<$>_ + +-- A functor morphism from F₁ to F₂ is an operation op such that +-- op (F₁ f x) ≡ F₂ f (op x) + +record Morphism {F₁ : Set ℓ → Set ℓ′} {F₂ : Set ℓ → Set ℓ″} + (fun₁ : RawFunctor F₁) + (fun₂ : RawFunctor F₂) : Set (suc ℓ ⊔ ℓ′ ⊔ ℓ″) where + open RawFunctor + field + op : F₁ X → F₂ X + op-<$> : (f : X → Y) (x : F₁ X) → + op (fun₁ ._<$>_ f x) ≡ fun₂ ._<$>_ f (op x) +\ No newline at end of file diff --git a/docs/Category.Monad.Indexed.html b/docs/Category.Monad.Indexed.html new file mode 100644 index 0000000..2548b60 --- /dev/null +++ b/docs/Category.Monad.Indexed.html @@ -0,0 +1,81 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Indexed monads +------------------------------------------------------------------------ + +-- Note that currently the monad laws are not included here. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Category.Monad.Indexed where + +open import Category.Applicative.Indexed +open import Function +open import Level + +private + variable + a b c i f : Level + A : Set a + B : Set b + C : Set c + I : Set i + +record RawIMonad {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where + infixl 1 _>>=_ _>>_ _>=>_ + infixr 1 _=<<_ _<=<_ + + field + return : ∀ {i} → A → M i i A + _>>=_ : ∀ {i j k} → M i j A → (A → M j k B) → M i k B + + _>>_ : ∀ {i j k} → M i j A → M j k B → M i k B + m₁ >> m₂ = m₁ >>= λ _ → m₂ + + _=<<_ : ∀ {i j k} → (A → M j k B) → M i j A → M i k B + f =<< c = c >>= f + + _>=>_ : ∀ {i j k} → (A → M i j B) → (B → M j k C) → (A → M i k C) + f >=> g = _=<<_ g ∘ f + + _<=<_ : ∀ {i j k} → (B → M j k C) → (A → M i j B) → (A → M i k C) + g <=< f = f >=> g + + join : ∀ {i j k} → M i j (M j k A) → M i k A + join m = m >>= id + + rawIApplicative : RawIApplicative M + rawIApplicative = record + { pure = return + ; _⊛_ = λ f x → f >>= λ f′ → x >>= λ x′ → return (f′ x′) + } + + open RawIApplicative rawIApplicative public + +RawIMonadT : {I : Set i} (T : IFun I f → IFun I f) → Set (i ⊔ suc f) +RawIMonadT T = ∀ {M} → RawIMonad M → RawIMonad (T M) + +record RawIMonadZero {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where + field + monad : RawIMonad M + applicativeZero : RawIApplicativeZero M + + open RawIMonad monad public + open RawIApplicativeZero applicativeZero using (∅) public + +record RawIMonadPlus {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where + field + monad : RawIMonad M + alternative : RawIAlternative M + + open RawIMonad monad public + open RawIAlternative alternative using (∅; _∣_) public + + monadZero : RawIMonadZero M + monadZero = record + { monad = monad + ; applicativeZero = RawIAlternative.applicativeZero alternative + } +\ No newline at end of file diff --git a/docs/Category.Monad.html b/docs/Category.Monad.html new file mode 100644 index 0000000..74c959b --- /dev/null +++ b/docs/Category.Monad.html @@ -0,0 +1,43 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Monads +------------------------------------------------------------------------ + +-- Note that currently the monad laws are not included here. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Category.Monad where + +open import Function +open import Category.Monad.Indexed +open import Data.Unit +open import Level + +private + variable + f : Level + +RawMonad : (Set f → Set f) → Set _ +RawMonad M = RawIMonad {I = ⊤} (λ _ _ → M) + +RawMonadT : (T : (Set f → Set f) → (Set f → Set f)) → Set _ +RawMonadT T = RawIMonadT {I = ⊤} (λ M _ _ → T (M _ _)) + +RawMonadZero : (Set f → Set f) → Set _ +RawMonadZero M = RawIMonadZero {I = ⊤} (λ _ _ → M) + +RawMonadPlus : (Set f → Set f) → Set _ +RawMonadPlus M = RawIMonadPlus {I = ⊤} (λ _ _ → M) + +module RawMonad {M : Set f → Set f} (Mon : RawMonad M) where + open RawIMonad Mon public + +module RawMonadZero {M : Set f → Set f}(Mon : RawMonadZero M) where + open RawIMonadZero Mon public + +module RawMonadPlus {M : Set f → Set f} (Mon : RawMonadPlus M) where + open RawIMonadPlus Mon public +\ No newline at end of file diff --git a/docs/Clones.BakerPixley.html b/docs/Clones.BakerPixley.html new file mode 100644 index 0000000..686be17 --- /dev/null +++ b/docs/Clones.BakerPixley.html @@ -0,0 +1,20 @@ + +
--- +layout: default +title : "Clones.BakerPixlar module" +date : "2023-10-18" +author: "Gonzalo Zigarán" +--- + +# BakerPixlar + + +```agda + +open import Agda.Primitive using () renaming ( Set to Type ) +open import Level using ( _⊔_ ; Level ; suc ) + +module Clones.BakerPixley (α : Level) (A : Type α) where + +``` +\ No newline at end of file diff --git a/docs/Clones.Basic.html b/docs/Clones.Basic.html new file mode 100644 index 0000000..3574422 --- /dev/null +++ b/docs/Clones.Basic.html @@ -0,0 +1,109 @@ + +
--- +layout: default +title : "Clones.Basic module" +date : "2023-10-18" +author: "Gonzalo Zigarán" +--- + +# Clones: Basic definitions + + +```agda +module Clones.Basic where + +open import Agda.Primitive using () renaming ( Set to Type ) +open import Level using ( _⊔_ ; Level ; suc ) +open import Data.Nat using ( ℕ ) +open import Data.Fin using ( Fin ) +open import Data.Product using ( _×_ ; Σ-syntax ; _,_ ) +open import Relation.Unary using ( Pred ; _∈_ ) + +private variable α ρ : Level + +``` + +## Operaciones y Relaciones + +Para un conjunto $A$ y un $n ∈ ℕ$, definimos el conjunto de operaciones $n$-arias, y luego el conjunto de operaciones de aridad finita. + +```agda + +open import Overture using ( Op ) +-- Operaciones de aridad finita +FinOp : { n : ℕ } → Type α → Type α +FinOp { n = n } A = Op A (Fin n) + +FinOps : Type α → Type α +FinOps A = Σ[ n ∈ ℕ ] (FinOp {n = n} A) + +``` + +De la misma manera, el conjunto de relaciones con elementos de $A$ de aridad $n$, con $n ∈ ℕ$ fijo, y de relaciones de aridad finita + +```agda + +open import Base.Relations.Continuous using ( Rel ) +-- Relaciones de aridad finita +FinRel : { n : ℕ } → Type α → Type (suc α) +FinRel { n = n } A = Rel A (Fin n) + +FinRels : Type α → Type (suc α) +FinRels A = Σ[ n ∈ ℕ ] (FinRel {n = n} A) + +``` + +## Clones + +Difinimos a un clon de $A$ como un conjunto de operaciones en $A$ que cumple que: + +- Contiene todas las proyecciones. +- Es cerrado por composiciones. + +```agda +-- Funcion proyeccion, proyecta en la coordenada dada, infiere la aridad +π : {A : Type α} → { n : ℕ } → Fin n → FinOp A +π k = λ x → x k + +-- Definimos propiedades que tiene que cumplir un Clon +containsProjections : {A : Type α} → Pred (FinOps A) ρ → Type ρ +containsProjections F = ∀ (n : ℕ) → ∀ (k : Fin n) → F ( n , π {n = n} k ) + +containsCompositions : {A : Type α} → Pred (FinOps A) ρ → Type (α ⊔ ρ) +containsCompositions {A = A} F = (n m : ℕ)(f : FinOp {n = m} A )(gs : (Fin m → FinOp {n = n} A)) + → F ( m , f ) + → (∀ (i : Fin m) → F ( n , gs i )) + → F ( n , λ (xs : (Fin n → A)) → f (λ i → gs i xs) ) +-- Definimos Clon +isClon : {A : Type α} → Pred (FinOps A) ρ → Type (α ⊔ ρ) +isClon F = containsProjections F × containsCompositions F + +-- Clones : {A : Type α} → Pred (Pred (FinOps A) ρ) (α ⊔ ρ) +-- Clones = λ F → isClon F + +record Clon {A : Type α} : Type (α ⊔ suc ρ) where + constructor mkclon + field + F : Pred (FinOps A) ρ + FIsClon : isClon F + +``` + +### Clon generado + +A partir de un conjunto $F$ de operaciones en $A$ podemos hablar del clon generado por $F$ como el menor clon que contiene a $F$. Lo denotamos con [ $F$ ]. + +```agda + +-- clon generado +data [_] {A : Type α} (F : Pred (FinOps A) ρ) : Pred (FinOps A) (suc Level.zero ⊔ α ⊔ ρ) + where + ops : ∀ {f} → f ∈ F → f ∈ [ F ] + projections : containsProjections [ F ] + compositions : containsCompositions [ F ] + +GeneratedClonIsClon : {A : Type α} {F : Pred (FinOps A) ρ} → isClon {A = A} [ F ] +GeneratedClonIsClon = projections , compositions + +``` +\ No newline at end of file diff --git a/docs/Clones.GaloisConnection.html b/docs/Clones.GaloisConnection.html new file mode 100644 index 0000000..df04b14 --- /dev/null +++ b/docs/Clones.GaloisConnection.html @@ -0,0 +1,52 @@ + +
--- +layout: default +title : "Clones.GaloisConnection module" +date : "2023-10-18" +author: "Gonzalo Zigarán" +--- + +# Galois Connection + + +```agda + +module Clones.GaloisConnection where + +open import Agda.Primitive using () renaming ( Set to Type ) +open import Level using ( _⊔_ ; Level ; suc ) +open import Data.Nat using ( ℕ ) +open import Data.Product using ( proj₂) +open import Relation.Unary using ( Pred ; _∈_ ) + +import Relation.Binary.PropositionalEquality as Eq + +open import Overture using ( _≈_ ) + +private variable α ρ : Level + +``` + + +```agda + +open import Clones.Basic using ( FinOps ; FinRels ; FinOp ; FinRel ) +open import Clones.Preservation using ( _◃_ ) + +-- invariantes de un conjunto de operaciones F +invₙ : {A : Type α} {n : ℕ} → Pred (FinOps A) ρ → Pred (FinRel {n = n} A) (α ⊔ ρ) +invₙ F = λ r → ∀ f → f ∈ F → (proj₂ f) ◃ r + +inv : {A : Type α} → Pred (FinOps A) ρ → Pred (FinRels A) (α ⊔ ρ) +inv F = λ r → ∀ f → f ∈ F → (proj₂ f) ◃ (proj₂ r) + + +-- polimorfismos de un conjunto de relaciones R +polₙ : {A : Type α} {n : ℕ} → Pred (FinRels A) ρ → Pred (FinOp {n = n} A) (suc α ⊔ ρ) +polₙ R = λ f → ∀ r → r ∈ R → f ◃ (proj₂ r) + +pol : {A : Type α} → Pred (FinRels A) ρ → Pred (FinOps A) (suc α ⊔ ρ) +pol R = λ f → ∀ r → r ∈ R → (proj₂ f) ◃ (proj₂ r) + +``` +\ No newline at end of file diff --git a/docs/Clones.Interpolation.html b/docs/Clones.Interpolation.html new file mode 100644 index 0000000..5e5b3ca --- /dev/null +++ b/docs/Clones.Interpolation.html @@ -0,0 +1,20 @@ + +
--- +layout: default +title : "Clones.Interpolation module" +date : "2023-10-18" +author: "Gonzalo Zigarán" +--- + +# Interpolation + + +```agda + +open import Agda.Primitive using () renaming ( Set to Type ) +open import Level using ( _⊔_ ; Level ; suc ) + +module Clones.Interpolation (α : Level) (A : Type α) where + +``` +\ No newline at end of file diff --git a/docs/Clones.Preservation.html b/docs/Clones.Preservation.html new file mode 100644 index 0000000..c97d438 --- /dev/null +++ b/docs/Clones.Preservation.html @@ -0,0 +1,96 @@ + +
--- +layout: default +title : "Clones.Preservation module" +date : "2023-10-18" +author: "Gonzalo Zigarán" +--- + +# Preservation + + +```agda + +{-# OPTIONS --allow-unsolved-metas #-} + +module Clones.Preservation where + +open import Agda.Primitive using () renaming ( Set to Type ) +open import Level using ( Level ) +open import Data.Nat using ( ℕ ) +open import Data.Fin using ( Fin ) +open import Data.Product using ( _,_ ) + +import Relation.Binary.PropositionalEquality as Eq +open Eq using ( _≡_ ) + +private variable α ρ : Level +``` + +En esta sección vamos a empezar a ver la relación que hay entre el espacio de Operaciones y de Relaciones de un conjunto $A$ dado. Para eso, vamos a definir cuando una operación $f$ preserva una relación $r$ ( $f◃r$ ). +Concretamente, dada una operación $n$-aria $f$ y una relación $k$-aria $r$, decimos que $f$ preserva a $r$ si: + +$(a₁₁, a₁₂, ... , a₁ₖ), ... , (aₙ₁, aₙ₂, ... , aₙₖ) ∈ r$ + +implica que + +$(f(a₁₁, ..., aₙ₁), ..., f(a₁ₖ, ..., aₙₖ)) ∈ r$. + +```agda + +open import Clones.Basic using ( FinOp ; FinRel ) + +-- Se fija que k vectores de largo n, coordeanada a coordenada, pertenezcan a la relación de aridad k +evalFinRel : {A : Type α } → { k : ℕ } → FinRel { n = k} A → ( n : ℕ) → (Fin k → Fin n → A) → Type α +evalFinRel r n t = ∀ (j : Fin n) → r λ i → t i j + +-- f preserva la relacion r +_◃_ : {A : Type α} → { n k : ℕ } → FinOp {n = n} A → FinRel {n = k} A → Type α +_◃_ { n = n} f r = ∀ t → evalFinRel r n t → r (λ i → f (t i)) + +``` + +Definida esta noción, demostramos la conexión entre que $f◃r$, que $r$ sea un subuniverso del álgebra con la función $f$ y que $f$ sea un homomorfismo en el modelo que tiene la relación $r$. + +Primero vemos la equivalencia entre que $f◃r$ y que $r$ sea subuniverso de ⟨ $A$ , $f$ ⟩ ᵏ. + +```agda +open import Base.Structures.Substructures using ( Subuniverses ) +open import Base.Structures.Products using ( ⨅ ) +open import Clones.TermOps using ( ⟨_,_,_⟩ ; R∅ ; F∅ ) + +preserv-then-r-subuniv : {A : Type α} → ∀ {n k : ℕ} (f : FinOp {n = n} A ) (r : FinRel {n = k} A ) + → (f ◃ r) + --------- + → Subuniverses {𝑨 = ⨅ {ℑ = Fin k } (λ i → ⟨ A , (λ g → g ≡ ( n , f )) , R∅ ⟩)} {X = Type ρ} r +preserv-then-r-subuniv f r pfr = λ ( ( m , h ) , pmh≡nf ) a x → {!!} + +r-subuniv-then-preserv : {A : Type α} → ∀ {n k : ℕ} (f : FinOp {n = n} A ) (r : FinRel {n = k} A ) + → Subuniverses {𝑨 = ⨅ {ℑ = Fin k } (λ i → ⟨ A , (λ g → g ≡ ( n , f )) , R∅ ⟩)} {X = Type ρ} r + --------- + → (f ◃ r) +r-subuniv-then-preserv f r psubr = λ t → λ prtij → {!!} +-- r-subuniv-then-preserv f r psubr = λ t → λ prtij → {!!} + +``` + +A continuación demostramos la equivalencia entre $f◃r$ y que $f$ sea un homomorfismo de ⟨ $A$ , $r$ ⟩ ⁿ en ⟨ $A$ , $r$ ⟩ . + +```agda + +open import Base.Structures using ( is-hom-rel ) + +preserv-then-f-homo : {A : Type α} → ∀ {n k : ℕ} (f : FinOp {n = n} A ) (r : FinRel {n = k} A ) + → (f ◃ r) + ---------- + → is-hom-rel ( ⨅ {ℑ = Fin n } (λ i → ⟨ A , F∅ , (λ s → s ≡ ( k , r ) ) ⟩ )) ⟨ A , F∅ , (λ s → s ≡ ( k , r ) ) ⟩ f +preserv-then-f-homo f r pfr = λ ( ( m , s ) , ps ) → λ as → λ i → {!!} + +f-homo-then-preserv : {A : Type α} → ∀ {n k : ℕ} (f : FinOp {n = n} A ) (r : FinRel {n = k} A ) + → is-hom-rel ( ⨅ {ℑ = Fin n } (λ i → ⟨ A , F∅ , (λ s → s ≡ ( k , r ) ) ⟩ )) ⟨ A , F∅ , (λ s → s ≡ ( k , r ) ) ⟩ f + --------- + → (f ◃ r) +f-homo-then-preserv f r pfhomo = λ t → λ prtij → {!!} + +``` +\ No newline at end of file diff --git a/docs/Clones.TermOps.html b/docs/Clones.TermOps.html new file mode 100644 index 0000000..2ddc1a3 --- /dev/null +++ b/docs/Clones.TermOps.html @@ -0,0 +1,149 @@ + +
--- +layout: default +title : "Clones.TermOps module" +date : "2023-10-18" +author: "Gonzalo Zigarán" +--- + +# Term Operations + + +```agda + +{-# OPTIONS --allow-unsolved-metas #-} + +module Clones.TermOps where + +open import Agda.Primitive using () renaming ( Set to Type ) +open import Level using ( _⊔_ ; Level ; suc ) +open import Data.Fin using ( Fin ) +open import Data.Product using ( Σ-syntax ; proj₁ ; proj₂ ; _,_ ) +open import Relation.Unary using ( Pred ) + +import Relation.Binary.PropositionalEquality as Eq +open Eq using ( _≡_; refl; sym ) +open Eq.≡-Reasoning using ( _≡⟨⟩_ ; step-≡ ; _∎) + +open import Overture using ( _≈_ ) + +private variable α ρ β : Level + +``` + +Para un álgebra $𝑨$ dada, podemos hablar del Clon de $𝑨$ cómo todas las operaciones que se pueden generar a partir de componer las funciones del álgebra y las proyecciones. Este clon coincide con las *term-operations*, que son todas las operaciones definidas a partir de un término. + + +```agda + +-- term-operations +open import Clones.Basic using ( FinOps ; FinRels ) +open import Base.Structures.Basic using ( signature ; structure ) +open signature ; open structure +open import Base.Terms.Basic using ( Term ) +open import Base.Structures.Terms using ( _⟦_⟧ ) +variable + 𝓞₀ 𝓥₀ 𝓞₁ 𝓥₁ χ : Level + 𝐹 : signature 𝓞₀ 𝓥₀ + 𝑅 : signature 𝓞₁ 𝓥₁ + +TermOps : (𝑨 : structure 𝐹 𝑅 {α} {ρ}) → Pred (FinOps ( carrier 𝑨 )) _ +TermOps 𝑨 ( n , f ) = Σ[ t ∈ Term (Fin n) ] (∀ as → f as ≡ (𝑨 ⟦ t ⟧) as) + + +``` + +Lo primero a demostrar es que efectivamente el conjunto de *term-operations* de un álgebra es un Clon. Para ello vamos a utilizar una versión del lema de sustitución. + +```agda + +open import Base.Terms.Operations using ( _[_]t ; Substerm ) +open import Base.Equality using ( swelldef ) + +subst-lemma-t : { 𝐹 : signature 𝓞₀ 𝓥₀} → swelldef 𝓥₀ α → {I J : Type χ }(r : Term I)(s : Substerm J I ) + (𝑨 : structure 𝐹 𝑅 {α} {ρ})(as : J → carrier 𝑨) + ---------------------------------------------------- + → (𝑨 ⟦ r [ s ]t ⟧) as ≡ (𝑨 ⟦ r ⟧) (λ i → (𝑨 ⟦ s i ⟧) as) +subst-lemma-t _ (Term.ℊ x) s 𝑨 as = refl +subst-lemma-t wd (Term.node f t) s 𝑨 as = wd ((op 𝑨) f) ( λ j → (𝑨 ⟦ (t j) [ s ]t ⟧) as ) + ( λ j → (𝑨 ⟦ t j ⟧) (λ i → (𝑨 ⟦ s i ⟧) as) ) + λ j → subst-lemma-t wd (t j) s 𝑨 as + +open import Clones.Basic using ( isClon ) + +TermOpsIsClon : { 𝐹 : signature 𝓞₀ 𝓥₀} → (∀ ℓ ℓ' → swelldef ℓ ℓ' ) + → (𝑨 : structure 𝐹 𝑅 {α} {ρ}) + ------------------------------------ + → isClon {A = carrier 𝑨} (TermOps 𝑨) +TermOpsIsClon wd 𝑨 = ( (λ n → λ k → ( Term.ℊ k , λ as → refl )) , + λ n m → λ f → λ gs → λ tf → λ tgs → ( (proj₁ tf) [ (λ i → proj₁ (tgs i)) ]t , λ as → + f (λ i → gs i as) + ≡⟨ proj₂ tf (λ i → gs i as) ⟩ + (𝑨 ⟦ proj₁ tf ⟧) (λ i → gs i as) + ≡⟨ wd _ _ (𝑨 ⟦ proj₁ tf ⟧) (λ z → gs z as) (λ i → (𝑨 ⟦ proj₁ (tgs i)⟧) as) (λ i → proj₂ (tgs i ) as) ⟩ + (𝑨 ⟦ proj₁ tf ⟧) (λ i → (𝑨 ⟦ proj₁ (tgs i)⟧) as) + ≡⟨ sym (subst-lemma-t (wd _ _) (proj₁ tf) (λ i → proj₁ (tgs i)) 𝑨 as) ⟩ + (𝑨 ⟦ ( (proj₁ tf) [ (λ i → proj₁ (tgs i) ) ]t) ⟧ ) as + ∎ ) ) +``` + +En varias ocaciones, a partir de un conjunto de operaciones $F$ y uno de relaciones $R$, vamos a querer hablar de la estructura dada por el conjunto $A$ y con el lenguaje que tiene un símbolo para cada operación en $F$ y un símbolo de relación para cada relación en $R$, interpretados de la manera esperable. Denotaremos con ⟨ $A$, $F$, $R$ ⟩ a dicha estructura. + + +```agda + +-- a partir de un subconjunto, nos generamos una signatura con un símbolo para cada elemento +SubType : {U : Type β} → Pred U ρ → Type (β ⊔ ρ) +SubType {U = U} P = Σ[ a ∈ U ] (P a) + +-- signatura para un conjunto de operaciones +Ops-sig : {A : Type α} → Pred (FinOps A) ρ → signature (α ⊔ ρ) Level.zero +Ops-sig F = record {symbol = SubType F ; arity = λ f → Fin (proj₁ (proj₁ f))} + +-- signatura para un conjunto de relaciones +Rels-sig : {A : Type α} → Pred (FinRels A) ρ → signature (suc α ⊔ ρ) Level.zero +Rels-sig R = record {symbol = SubType R ; arity = λ r → Fin (proj₁ (proj₁ r))} + +-- estructura inducida por F y R +⟨_,_,_⟩ : (A : Type α) → (F : Pred (FinOps A) ρ) → (R : Pred (FinRels A) ρ) + ------------------------------------------------------------ + → structure (Ops-sig {A = A} F) (Rels-sig {A = A} R) {α} {α} +⟨ A , F , R ⟩ = record {carrier = A ; op = λ f → proj₂ (proj₁ f) ; rel = λ r → proj₂ (proj₁ r) } + +``` + +Si $F$∅ es el conjunto vacío de operaciones y $R$∅ el conjunto vacío de relaciones, entones ⟨ $A$, $F$∅, $R$ ⟩ es una estructura relacional y ⟨ $A$, $F$, $R$∅ ⟩ un álgebra. Y como tenemos un álgebra, podemos hablar del clon de las *term-operations*, denotado por Clo[ $A$ , $F$ ]. + +```agda + +data ⊥ { ρ : Level } : Type ρ where + +-- conjunto vacío de relaciones +R∅ : {A : Type α } → Pred (FinRels A) ρ +R∅ r = ⊥ + +-- conjunto vacío de relaciones +F∅ : {A : Type α } → Pred (FinOps A) ρ +F∅ f = ⊥ + +Clo[_,_] : (A : Type α) → (F : Pred (FinOps A) ρ) → Pred (FinOps A) (suc Level.zero ⊔ α ⊔ ρ) +Clo[ A , F ] = TermOps ⟨ A , F , R∅ {A = A} ⟩ + +``` + +El clon de las *term-operations* dado por Clo[ $A$ , $F$ ] coincide con el clon generado por $F$. + +```agda + +-- Lema: [F] = clon(A,F) +open import Clones.Basic using ( [_] ) + +-- TermOps 𝑨 ( n , f ) = Σ[ t ∈ Term (Fin n) ] (∀ as → f as ≡ (𝑨 ⟦ t ⟧) as) + +[F]≡Clo[A,F] : (A : Type α) (F : Pred (FinOps A) ρ) + ---------------------- + → Clo[ A , F ] ≈ [ F ] +[F]≡Clo[A,F] A F = λ ( n , f ) → {!!} + +``` +\ No newline at end of file diff --git a/docs/Clones.html b/docs/Clones.html new file mode 100644 index 0000000..d1466eb --- /dev/null +++ b/docs/Clones.html @@ -0,0 +1,25 @@ + +
--- +layout: default +title : "Clones module" +date : "2023-10-18" +author: "Gonzalo Zigarán" +--- + +# Clones + + +```agda + +module Clones where + +open import Clones.Basic public +open import Clones.TermOps public +open import Clones.Preservation public +open import Clones.GaloisConnection public +open import Clones.Interpolation public +open import Clones.BakerPixley public + + +``` +\ No newline at end of file diff --git a/docs/Data.Bool.Base.html b/docs/Data.Bool.Base.html new file mode 100644 index 0000000..5b39ba7 --- /dev/null +++ b/docs/Data.Bool.Base.html @@ -0,0 +1,75 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- The type for booleans and some operations +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Bool.Base where + +open import Data.Unit.Base using (⊤) +open import Data.Empty +open import Level using (Level) + +private + variable + a : Level + A : Set a + +------------------------------------------------------------------------ +-- The boolean type + +open import Agda.Builtin.Bool public + +------------------------------------------------------------------------ +-- Relations + +infix 4 _≤_ _<_ + +data _≤_ : Bool → Bool → Set where + f≤t : false ≤ true + b≤b : ∀ {b} → b ≤ b + +data _<_ : Bool → Bool → Set where + f<t : false < true + +------------------------------------------------------------------------ +-- Boolean operations + +infixr 6 _∧_ +infixr 5 _∨_ _xor_ + +not : Bool → Bool +not true = false +not false = true + +_∧_ : Bool → Bool → Bool +true ∧ b = b +false ∧ b = false + +_∨_ : Bool → Bool → Bool +true ∨ b = true +false ∨ b = b + +_xor_ : Bool → Bool → Bool +true xor b = not b +false xor b = b + +------------------------------------------------------------------------ +-- Other operations + +infix 0 if_then_else_ + +if_then_else_ : Bool → A → A → A +if true then t else f = t +if false then t else f = f + +-- A function mapping true to an inhabited type and false to an empty +-- type. + +T : Bool → Set +T true = ⊤ +T false = ⊥ +\ No newline at end of file diff --git a/docs/Data.Bool.Properties.html b/docs/Data.Bool.Properties.html new file mode 100644 index 0000000..a6ee136 --- /dev/null +++ b/docs/Data.Bool.Properties.html @@ -0,0 +1,798 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- A bunch of properties +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Bool.Properties where + +open import Algebra.Bundles +open import Data.Bool.Base +open import Data.Empty +open import Data.Product +open import Data.Sum.Base +open import Function.Base +open import Function.Equality using (_⟨$⟩_) +open import Function.Equivalence + using (_⇔_; equivalence; module Equivalence) +open import Level using (Level; 0ℓ) +open import Relation.Binary hiding (_⇔_) +open import Relation.Binary.PropositionalEquality hiding ([_]) +open import Relation.Nullary using (ofʸ; ofⁿ; does; proof; yes; no) +open import Relation.Nullary.Decidable using (True) +import Relation.Unary as U + +open import Algebra.Definitions {A = Bool} _≡_ +open import Algebra.Structures {A = Bool} _≡_ +open ≡-Reasoning + +private + variable + a b : Level + A : Set a + B : Set b + +------------------------------------------------------------------------ +-- Properties of _≡_ + +infix 4 _≟_ + +_≟_ : Decidable {A = Bool} _≡_ +true ≟ true = yes refl +false ≟ false = yes refl +true ≟ false = no λ() +false ≟ true = no λ() + +≡-setoid : Setoid 0ℓ 0ℓ +≡-setoid = setoid Bool + +≡-decSetoid : DecSetoid 0ℓ 0ℓ +≡-decSetoid = decSetoid _≟_ + +------------------------------------------------------------------------ +-- Properties of _≤_ + +-- Relational properties + +≤-reflexive : _≡_ ⇒ _≤_ +≤-reflexive refl = b≤b + +≤-refl : Reflexive _≤_ +≤-refl = ≤-reflexive refl + +≤-trans : Transitive _≤_ +≤-trans b≤b p = p +≤-trans f≤t b≤b = f≤t + +≤-antisym : Antisymmetric _≡_ _≤_ +≤-antisym b≤b _ = refl + +≤-minimum : Minimum _≤_ false +≤-minimum false = b≤b +≤-minimum true = f≤t + +≤-maximum : Maximum _≤_ true +≤-maximum false = f≤t +≤-maximum true = b≤b + +≤-total : Total _≤_ +≤-total false b = inj₁ (≤-minimum b) +≤-total true b = inj₂ (≤-maximum b) + +infix 4 _≤?_ + +_≤?_ : Decidable _≤_ +false ≤? b = yes (≤-minimum b) +true ≤? false = no λ () +true ≤? true = yes b≤b + +≤-irrelevant : Irrelevant _≤_ +≤-irrelevant {_} f≤t f≤t = refl +≤-irrelevant {false} b≤b b≤b = refl +≤-irrelevant {true} b≤b b≤b = refl + +-- Structures + +≤-isPreorder : IsPreorder _≡_ _≤_ +≤-isPreorder = record + { isEquivalence = isEquivalence + ; reflexive = ≤-reflexive + ; trans = ≤-trans + } + +≤-isPartialOrder : IsPartialOrder _≡_ _≤_ +≤-isPartialOrder = record + { isPreorder = ≤-isPreorder + ; antisym = ≤-antisym + } + +≤-isTotalOrder : IsTotalOrder _≡_ _≤_ +≤-isTotalOrder = record + { isPartialOrder = ≤-isPartialOrder + ; total = ≤-total + } + +≤-isDecTotalOrder : IsDecTotalOrder _≡_ _≤_ +≤-isDecTotalOrder = record + { isTotalOrder = ≤-isTotalOrder + ; _≟_ = _≟_ + ; _≤?_ = _≤?_ + } + +-- Bundles + +≤-poset : Poset 0ℓ 0ℓ 0ℓ +≤-poset = record + { isPartialOrder = ≤-isPartialOrder + } + +≤-preorder : Preorder 0ℓ 0ℓ 0ℓ +≤-preorder = record + { isPreorder = ≤-isPreorder + } + +≤-totalOrder : TotalOrder 0ℓ 0ℓ 0ℓ +≤-totalOrder = record + { isTotalOrder = ≤-isTotalOrder + } + +≤-decTotalOrder : DecTotalOrder 0ℓ 0ℓ 0ℓ +≤-decTotalOrder = record + { isDecTotalOrder = ≤-isDecTotalOrder + } + +------------------------------------------------------------------------ +-- Properties of _<_ + +-- Relational properties + +<-irrefl : Irreflexive _≡_ _<_ +<-irrefl refl () + +<-asym : Asymmetric _<_ +<-asym f<t () + +<-trans : Transitive _<_ +<-trans f<t () + +<-transʳ : Trans _≤_ _<_ _<_ +<-transʳ b≤b f<t = f<t + +<-transˡ : Trans _<_ _≤_ _<_ +<-transˡ f<t b≤b = f<t + +<-cmp : Trichotomous _≡_ _<_ +<-cmp false false = tri≈ (λ()) refl (λ()) +<-cmp false true = tri< f<t (λ()) (λ()) +<-cmp true false = tri> (λ()) (λ()) f<t +<-cmp true true = tri≈ (λ()) refl (λ()) + +infix 4 _<?_ + +_<?_ : Decidable _<_ +false <? false = no (λ()) +false <? true = yes f<t +true <? _ = no (λ()) + +<-resp₂-≡ : _<_ Respects₂ _≡_ +<-resp₂-≡ = subst (_ <_) , subst (_< _) + +<-irrelevant : Irrelevant _<_ +<-irrelevant f<t f<t = refl + +-- Structures + +<-isStrictPartialOrder : IsStrictPartialOrder _≡_ _<_ +<-isStrictPartialOrder = record + { isEquivalence = isEquivalence + ; irrefl = <-irrefl + ; trans = <-trans + ; <-resp-≈ = <-resp₂-≡ + } + +<-isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_ +<-isStrictTotalOrder = record + { isEquivalence = isEquivalence + ; trans = <-trans + ; compare = <-cmp + } + +-- Bundles + +<-strictPartialOrder : StrictPartialOrder 0ℓ 0ℓ 0ℓ +<-strictPartialOrder = record + { isStrictPartialOrder = <-isStrictPartialOrder + } + +<-strictTotalOrder : StrictTotalOrder 0ℓ 0ℓ 0ℓ +<-strictTotalOrder = record + { isStrictTotalOrder = <-isStrictTotalOrder + } + +------------------------------------------------------------------------ +-- Properties of _∨_ + +∨-assoc : Associative _∨_ +∨-assoc true y z = refl +∨-assoc false y z = refl + +∨-comm : Commutative _∨_ +∨-comm true true = refl +∨-comm true false = refl +∨-comm false true = refl +∨-comm false false = refl + +∨-identityˡ : LeftIdentity false _∨_ +∨-identityˡ _ = refl + +∨-identityʳ : RightIdentity false _∨_ +∨-identityʳ false = refl +∨-identityʳ true = refl + +∨-identity : Identity false _∨_ +∨-identity = ∨-identityˡ , ∨-identityʳ + +∨-zeroˡ : LeftZero true _∨_ +∨-zeroˡ _ = refl + +∨-zeroʳ : RightZero true _∨_ +∨-zeroʳ false = refl +∨-zeroʳ true = refl + +∨-zero : Zero true _∨_ +∨-zero = ∨-zeroˡ , ∨-zeroʳ + +∨-inverseˡ : LeftInverse true not _∨_ +∨-inverseˡ false = refl +∨-inverseˡ true = refl + +∨-inverseʳ : RightInverse true not _∨_ +∨-inverseʳ x = ∨-comm x (not x) ⟨ trans ⟩ ∨-inverseˡ x + +∨-inverse : Inverse true not _∨_ +∨-inverse = ∨-inverseˡ , ∨-inverseʳ + +∨-idem : Idempotent _∨_ +∨-idem false = refl +∨-idem true = refl + +∨-sel : Selective _∨_ +∨-sel false y = inj₂ refl +∨-sel true y = inj₁ refl + +∨-isMagma : IsMagma _∨_ +∨-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = cong₂ _∨_ + } + +∨-magma : Magma 0ℓ 0ℓ +∨-magma = record + { isMagma = ∨-isMagma + } + +∨-isSemigroup : IsSemigroup _∨_ +∨-isSemigroup = record + { isMagma = ∨-isMagma + ; assoc = ∨-assoc + } + +∨-semigroup : Semigroup 0ℓ 0ℓ +∨-semigroup = record + { isSemigroup = ∨-isSemigroup + } + +∨-isBand : IsBand _∨_ +∨-isBand = record + { isSemigroup = ∨-isSemigroup + ; idem = ∨-idem + } + +∨-band : Band 0ℓ 0ℓ +∨-band = record + { isBand = ∨-isBand + } + +∨-isSemilattice : IsSemilattice _∨_ +∨-isSemilattice = record + { isBand = ∨-isBand + ; comm = ∨-comm + } + +∨-semilattice : Semilattice 0ℓ 0ℓ +∨-semilattice = record + { isSemilattice = ∨-isSemilattice + } + +∨-isMonoid : IsMonoid _∨_ false +∨-isMonoid = record + { isSemigroup = ∨-isSemigroup + ; identity = ∨-identity + } + +∨-isCommutativeMonoid : IsCommutativeMonoid _∨_ false +∨-isCommutativeMonoid = record + { isMonoid = ∨-isMonoid + ; comm = ∨-comm + } + +∨-commutativeMonoid : CommutativeMonoid 0ℓ 0ℓ +∨-commutativeMonoid = record + { isCommutativeMonoid = ∨-isCommutativeMonoid + } + +∨-isIdempotentCommutativeMonoid : + IsIdempotentCommutativeMonoid _∨_ false +∨-isIdempotentCommutativeMonoid = record + { isCommutativeMonoid = ∨-isCommutativeMonoid + ; idem = ∨-idem + } + +∨-idempotentCommutativeMonoid : IdempotentCommutativeMonoid 0ℓ 0ℓ +∨-idempotentCommutativeMonoid = record + { isIdempotentCommutativeMonoid = ∨-isIdempotentCommutativeMonoid + } + +------------------------------------------------------------------------ +-- Properties of _∧_ + +∧-assoc : Associative _∧_ +∧-assoc true y z = refl +∧-assoc false y z = refl + +∧-comm : Commutative _∧_ +∧-comm true true = refl +∧-comm true false = refl +∧-comm false true = refl +∧-comm false false = refl + +∧-identityˡ : LeftIdentity true _∧_ +∧-identityˡ _ = refl + +∧-identityʳ : RightIdentity true _∧_ +∧-identityʳ false = refl +∧-identityʳ true = refl + +∧-identity : Identity true _∧_ +∧-identity = ∧-identityˡ , ∧-identityʳ + +∧-zeroˡ : LeftZero false _∧_ +∧-zeroˡ _ = refl + +∧-zeroʳ : RightZero false _∧_ +∧-zeroʳ false = refl +∧-zeroʳ true = refl + +∧-zero : Zero false _∧_ +∧-zero = ∧-zeroˡ , ∧-zeroʳ + +∧-inverseˡ : LeftInverse false not _∧_ +∧-inverseˡ false = refl +∧-inverseˡ true = refl + +∧-inverseʳ : RightInverse false not _∧_ +∧-inverseʳ x = ∧-comm x (not x) ⟨ trans ⟩ ∧-inverseˡ x + +∧-inverse : Inverse false not _∧_ +∧-inverse = ∧-inverseˡ , ∧-inverseʳ + +∧-idem : Idempotent _∧_ +∧-idem false = refl +∧-idem true = refl + +∧-sel : Selective _∧_ +∧-sel false y = inj₁ refl +∧-sel true y = inj₂ refl + +∧-distribˡ-∨ : _∧_ DistributesOverˡ _∨_ +∧-distribˡ-∨ true y z = refl +∧-distribˡ-∨ false y z = refl + +∧-distribʳ-∨ : _∧_ DistributesOverʳ _∨_ +∧-distribʳ-∨ x y z = begin + (y ∨ z) ∧ x ≡⟨ ∧-comm (y ∨ z) x ⟩ + x ∧ (y ∨ z) ≡⟨ ∧-distribˡ-∨ x y z ⟩ + x ∧ y ∨ x ∧ z ≡⟨ cong₂ _∨_ (∧-comm x y) (∧-comm x z) ⟩ + y ∧ x ∨ z ∧ x ∎ + +∧-distrib-∨ : _∧_ DistributesOver _∨_ +∧-distrib-∨ = ∧-distribˡ-∨ , ∧-distribʳ-∨ + +∨-distribˡ-∧ : _∨_ DistributesOverˡ _∧_ +∨-distribˡ-∧ true y z = refl +∨-distribˡ-∧ false y z = refl + +∨-distribʳ-∧ : _∨_ DistributesOverʳ _∧_ +∨-distribʳ-∧ x y z = begin + (y ∧ z) ∨ x ≡⟨ ∨-comm (y ∧ z) x ⟩ + x ∨ (y ∧ z) ≡⟨ ∨-distribˡ-∧ x y z ⟩ + (x ∨ y) ∧ (x ∨ z) ≡⟨ cong₂ _∧_ (∨-comm x y) (∨-comm x z) ⟩ + (y ∨ x) ∧ (z ∨ x) ∎ + +∨-distrib-∧ : _∨_ DistributesOver _∧_ +∨-distrib-∧ = ∨-distribˡ-∧ , ∨-distribʳ-∧ + +∧-abs-∨ : _∧_ Absorbs _∨_ +∧-abs-∨ true y = refl +∧-abs-∨ false y = refl + +∨-abs-∧ : _∨_ Absorbs _∧_ +∨-abs-∧ true y = refl +∨-abs-∧ false y = refl + +∨-∧-absorptive : Absorptive _∨_ _∧_ +∨-∧-absorptive = ∨-abs-∧ , ∧-abs-∨ + +∧-isMagma : IsMagma _∧_ +∧-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = cong₂ _∧_ + } + +∧-magma : Magma 0ℓ 0ℓ +∧-magma = record + { isMagma = ∧-isMagma + } + +∧-isSemigroup : IsSemigroup _∧_ +∧-isSemigroup = record + { isMagma = ∧-isMagma + ; assoc = ∧-assoc + } + +∧-semigroup : Semigroup 0ℓ 0ℓ +∧-semigroup = record + { isSemigroup = ∧-isSemigroup + } + +∧-isBand : IsBand _∧_ +∧-isBand = record + { isSemigroup = ∧-isSemigroup + ; idem = ∧-idem + } + +∧-band : Band 0ℓ 0ℓ +∧-band = record + { isBand = ∧-isBand + } + +∧-isSemilattice : IsSemilattice _∧_ +∧-isSemilattice = record + { isBand = ∧-isBand + ; comm = ∧-comm + } + +∧-semilattice : Semilattice 0ℓ 0ℓ +∧-semilattice = record + { isSemilattice = ∧-isSemilattice + } + +∧-isMonoid : IsMonoid _∧_ true +∧-isMonoid = record + { isSemigroup = ∧-isSemigroup + ; identity = ∧-identity + } + +∧-isCommutativeMonoid : IsCommutativeMonoid _∧_ true +∧-isCommutativeMonoid = record + { isMonoid = ∧-isMonoid + ; comm = ∧-comm + } + +∧-commutativeMonoid : CommutativeMonoid 0ℓ 0ℓ +∧-commutativeMonoid = record + { isCommutativeMonoid = ∧-isCommutativeMonoid + } + +∧-isIdempotentCommutativeMonoid : + IsIdempotentCommutativeMonoid _∧_ true +∧-isIdempotentCommutativeMonoid = record + { isCommutativeMonoid = ∧-isCommutativeMonoid + ; idem = ∧-idem + } + +∧-idempotentCommutativeMonoid : IdempotentCommutativeMonoid 0ℓ 0ℓ +∧-idempotentCommutativeMonoid = record + { isIdempotentCommutativeMonoid = ∧-isIdempotentCommutativeMonoid + } + +∨-∧-isSemiring : IsSemiring _∨_ _∧_ false true +∨-∧-isSemiring = record + { isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = ∨-isCommutativeMonoid + ; *-isMonoid = ∧-isMonoid + ; distrib = ∧-distrib-∨ + } + ; zero = ∧-zero + } + +∨-∧-isCommutativeSemiring + : IsCommutativeSemiring _∨_ _∧_ false true +∨-∧-isCommutativeSemiring = record + { isSemiring = ∨-∧-isSemiring + ; *-comm = ∧-comm + } + +∨-∧-commutativeSemiring : CommutativeSemiring 0ℓ 0ℓ +∨-∧-commutativeSemiring = record + { _+_ = _∨_ + ; _*_ = _∧_ + ; 0# = false + ; 1# = true + ; isCommutativeSemiring = ∨-∧-isCommutativeSemiring + } + +∧-∨-isSemiring : IsSemiring _∧_ _∨_ true false +∧-∨-isSemiring = record + { isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = ∧-isCommutativeMonoid + ; *-isMonoid = ∨-isMonoid + ; distrib = ∨-distrib-∧ + } + ; zero = ∨-zero + } + +∧-∨-isCommutativeSemiring + : IsCommutativeSemiring _∧_ _∨_ true false +∧-∨-isCommutativeSemiring = record + { isSemiring = ∧-∨-isSemiring + ; *-comm = ∨-comm + } + +∧-∨-commutativeSemiring : CommutativeSemiring 0ℓ 0ℓ +∧-∨-commutativeSemiring = record + { _+_ = _∧_ + ; _*_ = _∨_ + ; 0# = true + ; 1# = false + ; isCommutativeSemiring = ∧-∨-isCommutativeSemiring + } + +∨-∧-isLattice : IsLattice _∨_ _∧_ +∨-∧-isLattice = record + { isEquivalence = isEquivalence + ; ∨-comm = ∨-comm + ; ∨-assoc = ∨-assoc + ; ∨-cong = cong₂ _∨_ + ; ∧-comm = ∧-comm + ; ∧-assoc = ∧-assoc + ; ∧-cong = cong₂ _∧_ + ; absorptive = ∨-∧-absorptive + } + +∨-∧-lattice : Lattice 0ℓ 0ℓ +∨-∧-lattice = record + { isLattice = ∨-∧-isLattice + } + +∨-∧-isDistributiveLattice : IsDistributiveLattice _∨_ _∧_ +∨-∧-isDistributiveLattice = record + { isLattice = ∨-∧-isLattice + ; ∨-distribʳ-∧ = ∨-distribʳ-∧ + } + +∨-∧-distributiveLattice : DistributiveLattice 0ℓ 0ℓ +∨-∧-distributiveLattice = record + { isDistributiveLattice = ∨-∧-isDistributiveLattice + } + +∨-∧-isBooleanAlgebra : IsBooleanAlgebra _∨_ _∧_ not true false +∨-∧-isBooleanAlgebra = record + { isDistributiveLattice = ∨-∧-isDistributiveLattice + ; ∨-complementʳ = ∨-inverseʳ + ; ∧-complementʳ = ∧-inverseʳ + ; ¬-cong = cong not + } + +∨-∧-booleanAlgebra : BooleanAlgebra 0ℓ 0ℓ +∨-∧-booleanAlgebra = record + { isBooleanAlgebra = ∨-∧-isBooleanAlgebra + } + +------------------------------------------------------------------------ +-- Properties of _xor_ + +xor-is-ok : ∀ x y → x xor y ≡ (x ∨ y) ∧ not (x ∧ y) +xor-is-ok true y = refl +xor-is-ok false y = sym (∧-identityʳ _) + +xor-∧-commutativeRing : CommutativeRing 0ℓ 0ℓ +xor-∧-commutativeRing = commutativeRing + where + import Algebra.Properties.BooleanAlgebra as BA + open BA ∨-∧-booleanAlgebra + open XorRing _xor_ xor-is-ok + +------------------------------------------------------------------------ +-- Miscellaneous other properties + +not-involutive : Involutive not +not-involutive true = refl +not-involutive false = refl + +not-injective : ∀ {x y} → not x ≡ not y → x ≡ y +not-injective {false} {false} nx≢ny = refl +not-injective {true} {true} nx≢ny = refl + +not-¬ : ∀ {x y} → x ≡ y → x ≢ not y +not-¬ {true} refl () +not-¬ {false} refl () + +¬-not : ∀ {x y} → x ≢ y → x ≡ not y +¬-not {true} {true} x≢y = ⊥-elim (x≢y refl) +¬-not {true} {false} _ = refl +¬-not {false} {true} _ = refl +¬-not {false} {false} x≢y = ⊥-elim (x≢y refl) + +⇔→≡ : {x y z : Bool} → x ≡ z ⇔ y ≡ z → x ≡ y +⇔→≡ {true } {true } hyp = refl +⇔→≡ {true } {false} {true } hyp = sym (Equivalence.to hyp ⟨$⟩ refl) +⇔→≡ {true } {false} {false} hyp = Equivalence.from hyp ⟨$⟩ refl +⇔→≡ {false} {true } {true } hyp = Equivalence.from hyp ⟨$⟩ refl +⇔→≡ {false} {true } {false} hyp = sym (Equivalence.to hyp ⟨$⟩ refl) +⇔→≡ {false} {false} hyp = refl + +T-≡ : ∀ {x} → T x ⇔ x ≡ true +T-≡ {false} = equivalence (λ ()) (λ ()) +T-≡ {true} = equivalence (const refl) (const _) + +T-not-≡ : ∀ {x} → T (not x) ⇔ x ≡ false +T-not-≡ {false} = equivalence (const refl) (const _) +T-not-≡ {true} = equivalence (λ ()) (λ ()) + +T-∧ : ∀ {x y} → T (x ∧ y) ⇔ (T x × T y) +T-∧ {true} {true} = equivalence (const (_ , _)) (const _) +T-∧ {true} {false} = equivalence (λ ()) proj₂ +T-∧ {false} {_} = equivalence (λ ()) proj₁ + +T-∨ : ∀ {x y} → T (x ∨ y) ⇔ (T x ⊎ T y) +T-∨ {true} {_} = equivalence inj₁ (const _) +T-∨ {false} {true} = equivalence inj₂ (const _) +T-∨ {false} {false} = equivalence inj₁ [ id , id ] + +T-irrelevant : U.Irrelevant T +T-irrelevant {true} _ _ = refl + +T? : U.Decidable T +does (T? b) = b +proof (T? true ) = ofʸ _ +proof (T? false) = ofⁿ λ() + +T?-diag : ∀ b → T b → True (T? b) +T?-diag true _ = _ + +push-function-into-if : ∀ (f : A → B) x {y z} → + f (if x then y else z) ≡ (if x then f y else f z) +push-function-into-if _ true = refl +push-function-into-if _ false = refl + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 0.15 + +∧-∨-distˡ = ∧-distribˡ-∨ +{-# WARNING_ON_USAGE ∧-∨-distˡ +"Warning: ∧-∨-distˡ was deprecated in v0.15. +Please use ∧-distribˡ-∨ instead." +#-} +∧-∨-distʳ = ∧-distribʳ-∨ +{-# WARNING_ON_USAGE ∧-∨-distʳ +"Warning: ∧-∨-distʳ was deprecated in v0.15. +Please use ∧-distribʳ-∨ instead." +#-} +distrib-∧-∨ = ∧-distrib-∨ +{-# WARNING_ON_USAGE distrib-∧-∨ +"Warning: distrib-∧-∨ was deprecated in v0.15. +Please use ∧-distrib-∨ instead." +#-} +∨-∧-distˡ = ∨-distribˡ-∧ +{-# WARNING_ON_USAGE ∨-∧-distˡ +"Warning: ∨-∧-distˡ was deprecated in v0.15. +Please use ∨-distribˡ-∧ instead." +#-} +∨-∧-distʳ = ∨-distribʳ-∧ +{-# WARNING_ON_USAGE ∨-∧-distʳ +"Warning: ∨-∧-distʳ was deprecated in v0.15. +Please use ∨-distribʳ-∧ instead." +#-} +∨-∧-distrib = ∨-distrib-∧ +{-# WARNING_ON_USAGE ∨-∧-distrib +"Warning: ∨-∧-distrib was deprecated in v0.15. +Please use ∨-distrib-∧ instead." +#-} +∨-∧-abs = ∨-abs-∧ +{-# WARNING_ON_USAGE ∨-∧-abs +"Warning: ∨-∧-abs was deprecated in v0.15. +Please use ∨-abs-∧ instead." +#-} +∧-∨-abs = ∧-abs-∨ +{-# WARNING_ON_USAGE ∧-∨-abs +"Warning: ∧-∨-abs was deprecated in v0.15. +Please use ∧-abs-∨ instead." +#-} +not-∧-inverseˡ = ∧-inverseˡ +{-# WARNING_ON_USAGE not-∧-inverseˡ +"Warning: not-∧-inverseˡ was deprecated in v0.15. +Please use ∧-inverseˡ instead." +#-} +not-∧-inverseʳ = ∧-inverseʳ +{-# WARNING_ON_USAGE not-∧-inverseʳ +"Warning: not-∧-inverseʳ was deprecated in v0.15. +Please use ∧-inverseʳ instead." +#-} +not-∧-inverse = ∧-inverse +{-# WARNING_ON_USAGE not-∧-inverse +"Warning: not-∧-inverse was deprecated in v0.15. +Please use ∧-inverse instead." +#-} +not-∨-inverseˡ = ∨-inverseˡ +{-# WARNING_ON_USAGE not-∨-inverseˡ +"Warning: not-∨-inverseˡ was deprecated in v0.15. +Please use ∨-inverseˡ instead." +#-} +not-∨-inverseʳ = ∨-inverseʳ +{-# WARNING_ON_USAGE not-∨-inverseʳ +"Warning: not-∨-inverseʳ was deprecated in v0.15. +Please use ∨-inverseʳ instead." +#-} +not-∨-inverse = ∨-inverse +{-# WARNING_ON_USAGE not-∨-inverse +"Warning: not-∨-inverse was deprecated in v0.15. +Please use ∨-inverse instead." +#-} +isCommutativeSemiring-∨-∧ = ∨-∧-isCommutativeSemiring +{-# WARNING_ON_USAGE isCommutativeSemiring-∨-∧ +"Warning: isCommutativeSemiring-∨-∧ was deprecated in v0.15. +Please use ∨-∧-isCommutativeSemiring instead." +#-} +commutativeSemiring-∨-∧ = ∨-∧-commutativeSemiring +{-# WARNING_ON_USAGE commutativeSemiring-∨-∧ +"Warning: commutativeSemiring-∨-∧ was deprecated in v0.15. +Please use ∨-∧-commutativeSemiring instead." +#-} +isCommutativeSemiring-∧-∨ = ∧-∨-isCommutativeSemiring +{-# WARNING_ON_USAGE isCommutativeSemiring-∧-∨ +"Warning: isCommutativeSemiring-∧-∨ was deprecated in v0.15. +Please use ∧-∨-isCommutativeSemiring instead." +#-} +commutativeSemiring-∧-∨ = ∧-∨-commutativeSemiring +{-# WARNING_ON_USAGE commutativeSemiring-∧-∨ +"Warning: commutativeSemiring-∧-∨ was deprecated in v0.15. +Please use ∧-∨-commutativeSemiring instead." +#-} +isBooleanAlgebra = ∨-∧-isBooleanAlgebra +{-# WARNING_ON_USAGE isBooleanAlgebra +"Warning: isBooleanAlgebra was deprecated in v0.15. +Please use ∨-∧-isBooleanAlgebra instead." +#-} +booleanAlgebra = ∨-∧-booleanAlgebra +{-# WARNING_ON_USAGE booleanAlgebra +"Warning: booleanAlgebra was deprecated in v0.15. +Please use ∨-∧-booleanAlgebra instead." +#-} +commutativeRing-xor-∧ = xor-∧-commutativeRing +{-# WARNING_ON_USAGE commutativeRing-xor-∧ +"Warning: commutativeRing-xor-∧ was deprecated in v0.15. +Please use xor-∧-commutativeRing instead." +#-} +proof-irrelevance = T-irrelevant +{-# WARNING_ON_USAGE proof-irrelevance +"Warning: proof-irrelevance was deprecated in v0.15. +Please use T-irrelevant instead." +#-} + +-- Version 1.0 + +T-irrelevance = T-irrelevant +{-# WARNING_ON_USAGE T-irrelevance +"Warning: T-irrelevance was deprecated in v1.0. +Please use T-irrelevant instead." +#-} +\ No newline at end of file diff --git a/docs/Data.Empty.Irrelevant.html b/docs/Data.Empty.Irrelevant.html new file mode 100644 index 0000000..818ea0d --- /dev/null +++ b/docs/Data.Empty.Irrelevant.html @@ -0,0 +1,16 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- An irrelevant version of ⊥-elim +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Empty.Irrelevant where + +open import Data.Empty hiding (⊥-elim) + +⊥-elim : ∀ {w} {Whatever : Set w} → .⊥ → Whatever +⊥-elim () +\ No newline at end of file diff --git a/docs/Data.Empty.Polymorphic.html b/docs/Data.Empty.Polymorphic.html new file mode 100644 index 0000000..c571e8a --- /dev/null +++ b/docs/Data.Empty.Polymorphic.html @@ -0,0 +1,21 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Level polymorphic Empty type +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Empty.Polymorphic where + +import Data.Empty as Empty +open import Level + +⊥ : {ℓ : Level} → Set ℓ +⊥ {ℓ} = Lift ℓ Empty.⊥ + +-- make ⊥-elim dependent too, as it does seem useful +⊥-elim : ∀ {w ℓ} {Whatever : ⊥ {ℓ} → Set w} → (witness : ⊥ {ℓ}) → Whatever witness +⊥-elim () +\ No newline at end of file diff --git a/docs/Data.Empty.html b/docs/Data.Empty.html new file mode 100644 index 0000000..2760667 --- /dev/null +++ b/docs/Data.Empty.html @@ -0,0 +1,26 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Empty type +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Empty where + +------------------------------------------------------------------------ +-- Definition + +-- Note that by default the empty type is not universe polymorphic as it +-- often results in unsolved metas. See `Data.Empty.Polymorphic` for a +-- universe polymorphic variant. + +data ⊥ : Set where + +------------------------------------------------------------------------ +-- Functions + +⊥-elim : ∀ {w} {Whatever : Set w} → ⊥ → Whatever +⊥-elim () +\ No newline at end of file diff --git a/docs/Data.Fin.Base.html b/docs/Data.Fin.Base.html new file mode 100644 index 0000000..6eb3644 --- /dev/null +++ b/docs/Data.Fin.Base.html @@ -0,0 +1,310 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Finite sets +------------------------------------------------------------------------ + +-- Note that elements of Fin n can be seen as natural numbers in the +-- set {m | m < n}. The notation "m" in comments below refers to this +-- natural number view. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Fin.Base where + +open import Data.Empty using (⊥-elim) +open import Data.Nat.Base as ℕ using (ℕ; zero; suc; z≤n; s≤s) +open import Data.Nat.Properties.Core using (≤-pred) +open import Data.Product as Product using (_×_; _,_) +open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂; [_,_]′) +open import Function.Base using (id; _∘_; _on_) +open import Level using (0ℓ) +open import Relation.Nullary using (yes; no) +open import Relation.Nullary.Decidable.Core using (True; toWitness) +open import Relation.Binary.Core +open import Relation.Binary.PropositionalEquality.Core using (_≡_; _≢_; refl; cong) + +------------------------------------------------------------------------ +-- Types + +-- Fin n is a type with n elements. + +data Fin : ℕ → Set where + zero : {n : ℕ} → Fin (suc n) + suc : {n : ℕ} (i : Fin n) → Fin (suc n) + +-- A conversion: toℕ "i" = i. + +toℕ : ∀ {n} → Fin n → ℕ +toℕ zero = 0 +toℕ (suc i) = suc (toℕ i) + +-- A Fin-indexed variant of Fin. + +Fin′ : ∀ {n} → Fin n → Set +Fin′ i = Fin (toℕ i) + +------------------------------------------------------------------------ +-- A cast that actually computes on constructors (as opposed to subst) + +cast : ∀ {m n} → .(_ : m ≡ n) → Fin m → Fin n +cast {zero} {zero} eq k = k +cast {suc m} {suc n} eq zero = zero +cast {suc m} {suc n} eq (suc k) = suc (cast (cong ℕ.pred eq) k) + +------------------------------------------------------------------------ +-- Conversions + +-- toℕ is defined above. + +-- fromℕ n = "n". + +fromℕ : (n : ℕ) → Fin (suc n) +fromℕ zero = zero +fromℕ (suc n) = suc (fromℕ n) + +-- fromℕ< {m} _ = "m". + +fromℕ< : ∀ {m n} → m ℕ.< n → Fin n +fromℕ< {zero} {suc n} m≤n = zero +fromℕ< {suc m} {suc n} m≤n = suc (fromℕ< (≤-pred m≤n)) + +-- fromℕ<″ m _ = "m". + +fromℕ<″ : ∀ m {n} → m ℕ.<″ n → Fin n +fromℕ<″ zero (ℕ.less-than-or-equal refl) = zero +fromℕ<″ (suc m) (ℕ.less-than-or-equal refl) = + suc (fromℕ<″ m (ℕ.less-than-or-equal refl)) + +-- raise m "i" = "m + i". + +raise : ∀ {m} n → Fin m → Fin (n ℕ.+ m) +raise zero i = i +raise (suc n) i = suc (raise n i) + +-- reduce≥ "m + i" _ = "i". + +reduce≥ : ∀ {m n} (i : Fin (m ℕ.+ n)) (i≥m : toℕ i ℕ.≥ m) → Fin n +reduce≥ {zero} i i≥m = i +reduce≥ {suc m} (suc i) (s≤s i≥m) = reduce≥ i i≥m + +-- inject⋆ m "i" = "i". + +inject : ∀ {n} {i : Fin n} → Fin′ i → Fin n +inject {i = suc i} zero = zero +inject {i = suc i} (suc j) = suc (inject j) + +inject! : ∀ {n} {i : Fin (suc n)} → Fin′ i → Fin n +inject! {n = suc _} {i = suc _} zero = zero +inject! {n = suc _} {i = suc _} (suc j) = suc (inject! j) + +inject+ : ∀ {m} n → Fin m → Fin (m ℕ.+ n) +inject+ n zero = zero +inject+ n (suc i) = suc (inject+ n i) + +inject₁ : ∀ {m} → Fin m → Fin (suc m) +inject₁ zero = zero +inject₁ (suc i) = suc (inject₁ i) + +inject≤ : ∀ {m n} → Fin m → m ℕ.≤ n → Fin n +inject≤ {_} {suc n} zero le = zero +inject≤ {_} {suc n} (suc i) le = suc (inject≤ i (≤-pred le)) + +-- lower₁ "i" _ = "i". + +lower₁ : ∀ {n} → (i : Fin (suc n)) → (n ≢ toℕ i) → Fin n +lower₁ {zero} zero ne = ⊥-elim (ne refl) +lower₁ {suc n} zero _ = zero +lower₁ {suc n} (suc i) ne = suc (lower₁ i λ x → ne (cong suc x)) + +-- A strengthening injection into the minimal Fin fibre. +strengthen : ∀ {n} (i : Fin n) → Fin′ (suc i) +strengthen zero = zero +strengthen (suc i) = suc (strengthen i) + +-- splitAt m "i" = inj₁ "i" if i < m +-- inj₂ "i - m" if i ≥ m +-- This is dual to splitAt from Data.Vec. + +splitAt : ∀ m {n} → Fin (m ℕ.+ n) → Fin m ⊎ Fin n +splitAt zero i = inj₂ i +splitAt (suc m) zero = inj₁ zero +splitAt (suc m) (suc i) = Sum.map suc id (splitAt m i) + +-- inverse of above function +join : ∀ m n → Fin m ⊎ Fin n → Fin (m ℕ.+ n) +join m n = [ inject+ n , raise {n} m ]′ + +-- quotRem k "i" = "i % k" , "i / k" +-- This is dual to group from Data.Vec. + +quotRem : ∀ {n} k → Fin (n ℕ.* k) → Fin k × Fin n +quotRem {suc n} k i with splitAt k i +... | inj₁ j = j , zero +... | inj₂ j = Product.map₂ suc (quotRem {n} k j) + +-- a variant of quotRem the type of whose result matches the order of multiplication +remQuot : ∀ {n} k → Fin (n ℕ.* k) → Fin n × Fin k +remQuot k = Product.swap ∘ quotRem k + +-- inverse of remQuot +combine : ∀ {n k} → Fin n → Fin k → Fin (n ℕ.* k) +combine {suc n} {k} zero y = inject+ (n ℕ.* k) y +combine {suc n} {k} (suc x) y = raise k (combine x y) + +------------------------------------------------------------------------ +-- Operations + +-- Folds. + +fold : ∀ {t} (T : ℕ → Set t) {m} → + (∀ {n} → T n → T (suc n)) → + (∀ {n} → T (suc n)) → + Fin m → T m +fold T f x zero = x +fold T f x (suc i) = f (fold T f x i) + +fold′ : ∀ {n t} (T : Fin (suc n) → Set t) → + (∀ i → T (inject₁ i) → T (suc i)) → + T zero → + ∀ i → T i +fold′ T f x zero = x +fold′ {n = suc n} T f x (suc i) = + f i (fold′ (T ∘ inject₁) (f ∘ inject₁) x i) + +-- Lifts functions. + +lift : ∀ {m n} k → (Fin m → Fin n) → Fin (k ℕ.+ m) → Fin (k ℕ.+ n) +lift zero f i = f i +lift (suc k) f zero = zero +lift (suc k) f (suc i) = suc (lift k f i) + +-- "i" + "j" = "i + j". + +infixl 6 _+_ + +_+_ : ∀ {m n} (i : Fin m) (j : Fin n) → Fin (toℕ i ℕ.+ n) +zero + j = j +suc i + j = suc (i + j) + +-- "i" - "j" = "i ∸ j". + +infixl 6 _-_ + +_-_ : ∀ {m} (i : Fin m) (j : Fin′ (suc i)) → Fin (m ℕ.∸ toℕ j) +i - zero = i +suc i - suc j = i - j + +-- m ℕ- "i" = "m ∸ i". + +infixl 6 _ℕ-_ + +_ℕ-_ : (n : ℕ) (j : Fin (suc n)) → Fin (suc n ℕ.∸ toℕ j) +n ℕ- zero = fromℕ n +suc n ℕ- suc i = n ℕ- i + +-- m ℕ-ℕ "i" = m ∸ i. + +infixl 6 _ℕ-ℕ_ + +_ℕ-ℕ_ : (n : ℕ) → Fin (suc n) → ℕ +n ℕ-ℕ zero = n +suc n ℕ-ℕ suc i = n ℕ-ℕ i + +-- pred "i" = "pred i". + +pred : ∀ {n} → Fin n → Fin n +pred zero = zero +pred (suc i) = inject₁ i + +-- opposite "i" = "n - i" (i.e. the additive inverse). + +opposite : ∀ {n} → Fin n → Fin n +opposite {suc n} zero = fromℕ n +opposite {suc n} (suc i) = inject₁ (opposite i) + +-- The function f(i,j) = if j>i then j-1 else j +-- This is a variant of the thick function from Conor +-- McBride's "First-order unification by structural recursion". + +punchOut : ∀ {m} {i j : Fin (suc m)} → i ≢ j → Fin m +punchOut {_} {zero} {zero} i≢j = ⊥-elim (i≢j refl) +punchOut {_} {zero} {suc j} _ = j +punchOut {suc m} {suc i} {zero} _ = zero +punchOut {suc m} {suc i} {suc j} i≢j = suc (punchOut (i≢j ∘ cong suc)) + +-- The function f(i,j) = if j≥i then j+1 else j + +punchIn : ∀ {m} → Fin (suc m) → Fin m → Fin (suc m) +punchIn zero j = suc j +punchIn (suc i) zero = zero +punchIn (suc i) (suc j) = suc (punchIn i j) + +-- The function f(i,j) such that f(i,j) = if j≤i then j else j-1 + +pinch : ∀ {n} → Fin n → Fin (suc n) → Fin n +pinch {suc n} _ zero = zero +pinch {suc n} zero (suc j) = j +pinch {suc n} (suc i) (suc j) = suc (pinch i j) + +------------------------------------------------------------------------ +-- Order relations + +infix 4 _≤_ _≥_ _<_ _>_ + +_≤_ : ∀ {n} → Rel (Fin n) 0ℓ +_≤_ = ℕ._≤_ on toℕ + +_≥_ : ∀ {n} → Rel (Fin n) 0ℓ +_≥_ = ℕ._≥_ on toℕ + +_<_ : ∀ {n} → Rel (Fin n) 0ℓ +_<_ = ℕ._<_ on toℕ + +_>_ : ∀ {n} → Rel (Fin n) 0ℓ +_>_ = ℕ._>_ on toℕ + + +data _≺_ : ℕ → ℕ → Set where + _≻toℕ_ : ∀ n (i : Fin n) → toℕ i ≺ n + +------------------------------------------------------------------------ +-- An ordering view. + +data Ordering {n : ℕ} : Fin n → Fin n → Set where + less : ∀ greatest (least : Fin′ greatest) → + Ordering (inject least) greatest + equal : ∀ i → Ordering i i + greater : ∀ greatest (least : Fin′ greatest) → + Ordering greatest (inject least) + +compare : ∀ {n} (i j : Fin n) → Ordering i j +compare zero zero = equal zero +compare zero (suc j) = less (suc j) zero +compare (suc i) zero = greater (suc i) zero +compare (suc i) (suc j) with compare i j +... | less greatest least = less (suc greatest) (suc least) +... | greater greatest least = greater (suc greatest) (suc least) +... | equal i = equal (suc i) + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.2 + +fromℕ≤ = fromℕ< +{-# WARNING_ON_USAGE fromℕ≤ +"Warning: fromℕ≤ was deprecated in v1.2. +Please use fromℕ< instead." +#-} +fromℕ≤″ = fromℕ<″ +{-# WARNING_ON_USAGE fromℕ≤″ +"Warning: fromℕ≤″ was deprecated in v1.2. +Please use fromℕ<″ instead." +#-} +\ No newline at end of file diff --git a/docs/Data.Fin.Patterns.html b/docs/Data.Fin.Patterns.html new file mode 100644 index 0000000..083b089 --- /dev/null +++ b/docs/Data.Fin.Patterns.html @@ -0,0 +1,27 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Patterns for Fin +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Fin.Patterns where + +open import Data.Fin.Base + +------------------------------------------------------------------------ +-- Constants + +pattern 0F = zero +pattern 1F = suc 0F +pattern 2F = suc 1F +pattern 3F = suc 2F +pattern 4F = suc 3F +pattern 5F = suc 4F +pattern 6F = suc 5F +pattern 7F = suc 6F +pattern 8F = suc 7F +pattern 9F = suc 8F +\ No newline at end of file diff --git a/docs/Data.Fin.Properties.html b/docs/Data.Fin.Properties.html new file mode 100644 index 0000000..0688a80 --- /dev/null +++ b/docs/Data.Fin.Properties.html @@ -0,0 +1,964 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties related to Fin, and operations making use of these +-- properties (or other properties not available in Data.Fin) +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Fin.Properties where + +open import Category.Applicative using (RawApplicative) +open import Category.Functor using (RawFunctor) +open import Data.Bool.Base using (Bool; true; false; not; _∧_; _∨_) +open import Data.Empty using (⊥; ⊥-elim) +open import Data.Fin.Base +open import Data.Fin.Patterns +open import Data.Nat.Base as ℕ using (ℕ; zero; suc; s≤s; z≤n; _∸_) +import Data.Nat.Properties as ℕₚ +open import Data.Unit using (tt) +open import Data.Product using (Σ-syntax; ∃; ∃₂; ∄; _×_; _,_; map; proj₁; uncurry; <_,_>) +open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂; [_,_]; [_,_]′) +open import Data.Sum.Properties using ([,]-map-commute; [,]-∘-distr) +open import Function.Base using (_∘_; id; _$_) +open import Function.Bundles using (_↔_; mk↔′) +open import Function.Definitions.Core2 using (Surjective) +open import Function.Equivalence using (_⇔_; equivalence) +open import Function.Injection using (_↣_) +open import Relation.Binary as B hiding (Decidable; _⇔_) +open import Relation.Binary.PropositionalEquality as P + using (_≡_; _≢_; refl; sym; trans; cong; subst; module ≡-Reasoning) +open import Relation.Nullary.Decidable as Dec using (map′) +open import Relation.Nullary.Reflects +open import Relation.Nullary.Negation using (contradiction) +open import Relation.Nullary + using (Reflects; ofʸ; ofⁿ; Dec; _because_; does; proof; yes; no; ¬_) +open import Relation.Nullary.Product using (_×-dec_) +open import Relation.Nullary.Sum using (_⊎-dec_) +open import Relation.Unary as U + using (U; Pred; Decidable; _⊆_; Satisfiable; Universal) +open import Relation.Unary.Properties using (U?) + +------------------------------------------------------------------------ +-- Fin +------------------------------------------------------------------------ + +¬Fin0 : ¬ Fin 0 +¬Fin0 () + +------------------------------------------------------------------------ +-- Bundles + +Fin0↔⊥ : Fin 0 ↔ ⊥ +Fin0↔⊥ = mk↔′ ¬Fin0 (λ ()) (λ ()) (λ ()) + +------------------------------------------------------------------------ +-- Properties of _≡_ +------------------------------------------------------------------------ + +suc-injective : ∀ {o} {m n : Fin o} → Fin.suc m ≡ suc n → m ≡ n +suc-injective refl = refl + +infix 4 _≟_ + +_≟_ : ∀ {n} → B.Decidable {A = Fin n} _≡_ +zero ≟ zero = yes refl +zero ≟ suc y = no λ() +suc x ≟ zero = no λ() +suc x ≟ suc y = map′ (cong suc) suc-injective (x ≟ y) + +------------------------------------------------------------------------ +-- Structures + +≡-isDecEquivalence : ∀ {n} → IsDecEquivalence (_≡_ {A = Fin n}) +≡-isDecEquivalence = record + { isEquivalence = P.isEquivalence + ; _≟_ = _≟_ + } + +------------------------------------------------------------------------ +-- Bundles + +≡-preorder : ℕ → Preorder _ _ _ +≡-preorder n = P.preorder (Fin n) + +≡-setoid : ℕ → Setoid _ _ +≡-setoid n = P.setoid (Fin n) + +≡-decSetoid : ℕ → DecSetoid _ _ +≡-decSetoid n = record + { isDecEquivalence = ≡-isDecEquivalence {n} + } + +------------------------------------------------------------------------ +-- toℕ +------------------------------------------------------------------------ + +toℕ-injective : ∀ {n} {i j : Fin n} → toℕ i ≡ toℕ j → i ≡ j +toℕ-injective {zero} {} {} _ +toℕ-injective {suc n} {zero} {zero} eq = refl +toℕ-injective {suc n} {suc i} {suc j} eq = + cong suc (toℕ-injective (cong ℕ.pred eq)) + +toℕ-strengthen : ∀ {n} (i : Fin n) → toℕ (strengthen i) ≡ toℕ i +toℕ-strengthen zero = refl +toℕ-strengthen (suc i) = cong suc (toℕ-strengthen i) + +toℕ-raise : ∀ {m} n (i : Fin m) → toℕ (raise n i) ≡ n ℕ.+ toℕ i +toℕ-raise zero i = refl +toℕ-raise (suc n) i = cong suc (toℕ-raise n i) + +toℕ<n : ∀ {n} (i : Fin n) → toℕ i ℕ.< n +toℕ<n zero = s≤s z≤n +toℕ<n (suc i) = s≤s (toℕ<n i) + +toℕ≤n : ∀ {n} → (i : Fin n) → toℕ i ℕ.≤ n +toℕ≤n = ℕₚ.<⇒≤ ∘ toℕ<n + +toℕ≤pred[n] : ∀ {n} (i : Fin n) → toℕ i ℕ.≤ ℕ.pred n +toℕ≤pred[n] zero = z≤n +toℕ≤pred[n] (suc {n = suc n} i) = s≤s (toℕ≤pred[n] i) + +-- A simpler implementation of toℕ≤pred[n], +-- however, with a different reduction behavior. +-- If no one needs the reduction behavior of toℕ≤pred[n], +-- it can be removed in favor of toℕ≤pred[n]′. +toℕ≤pred[n]′ : ∀ {n} (i : Fin n) → toℕ i ℕ.≤ ℕ.pred n +toℕ≤pred[n]′ i = ℕₚ.<⇒≤pred (toℕ<n i) + +------------------------------------------------------------------------ +-- fromℕ +------------------------------------------------------------------------ + +toℕ-fromℕ : ∀ n → toℕ (fromℕ n) ≡ n +toℕ-fromℕ zero = refl +toℕ-fromℕ (suc n) = cong suc (toℕ-fromℕ n) + +fromℕ-toℕ : ∀ {n} (i : Fin n) → fromℕ (toℕ i) ≡ strengthen i +fromℕ-toℕ zero = refl +fromℕ-toℕ (suc i) = cong suc (fromℕ-toℕ i) + +≤fromℕ : ∀ {n} → (i : Fin (ℕ.suc n)) → i ≤ fromℕ n +≤fromℕ {n} i = subst (toℕ i ℕ.≤_) (sym (toℕ-fromℕ n)) (ℕₚ.≤-pred (toℕ<n i)) + +------------------------------------------------------------------------ +-- fromℕ< +------------------------------------------------------------------------ + +fromℕ<-toℕ : ∀ {m} (i : Fin m) (i<m : toℕ i ℕ.< m) → fromℕ< i<m ≡ i +fromℕ<-toℕ zero (s≤s z≤n) = refl +fromℕ<-toℕ (suc i) (s≤s (s≤s m≤n)) = cong suc (fromℕ<-toℕ i (s≤s m≤n)) + +toℕ-fromℕ< : ∀ {m n} (m<n : m ℕ.< n) → toℕ (fromℕ< m<n) ≡ m +toℕ-fromℕ< (s≤s z≤n) = refl +toℕ-fromℕ< (s≤s (s≤s m<n)) = cong suc (toℕ-fromℕ< (s≤s m<n)) + +-- fromℕ is a special case of fromℕ<. +fromℕ-def : ∀ n → fromℕ n ≡ fromℕ< ℕₚ.≤-refl +fromℕ-def zero = refl +fromℕ-def (suc n) = cong suc (fromℕ-def n) + +fromℕ<-cong : ∀ m n {o} → m ≡ n → + (m<o : m ℕ.< o) → + (n<o : n ℕ.< o) → + fromℕ< m<o ≡ fromℕ< n<o +fromℕ<-cong 0 0 r (s≤s z≤n) (s≤s z≤n) = refl +fromℕ<-cong (suc _) (suc _) r (s≤s (s≤s p)) (s≤s (s≤s q)) + = cong suc (fromℕ<-cong _ _ (ℕₚ.suc-injective r) (s≤s p) (s≤s q)) + +fromℕ<-injective : ∀ m n {o} → + (m<o : m ℕ.< o) → + (n<o : n ℕ.< o) → + fromℕ< m<o ≡ fromℕ< n<o → + m ≡ n +fromℕ<-injective 0 0 (s≤s z≤n) (s≤s z≤n) r = refl +fromℕ<-injective (suc _) (suc _) (s≤s (s≤s p)) (s≤s (s≤s q)) r + = cong suc (fromℕ<-injective _ _ (s≤s p) (s≤s q) (suc-injective r)) + +------------------------------------------------------------------------ +-- fromℕ<″ +------------------------------------------------------------------------ + +fromℕ<≡fromℕ<″ : ∀ {m n} (m<n : m ℕ.< n) (m<″n : m ℕ.<″ n) → + fromℕ< m<n ≡ fromℕ<″ m m<″n +fromℕ<≡fromℕ<″ (s≤s z≤n) (ℕ.less-than-or-equal refl) = refl +fromℕ<≡fromℕ<″ (s≤s (s≤s m<n)) (ℕ.less-than-or-equal refl) = + cong suc (fromℕ<≡fromℕ<″ (s≤s m<n) (ℕ.less-than-or-equal refl)) + +toℕ-fromℕ<″ : ∀ {m n} (m<n : m ℕ.<″ n) → toℕ (fromℕ<″ m m<n) ≡ m +toℕ-fromℕ<″ {m} {n} m<n = begin + toℕ (fromℕ<″ m m<n) ≡⟨ cong toℕ (sym (fromℕ<≡fromℕ<″ (ℕₚ.≤″⇒≤ m<n) m<n)) ⟩ + toℕ (fromℕ< _) ≡⟨ toℕ-fromℕ< (ℕₚ.≤″⇒≤ m<n) ⟩ + m ∎ + where open ≡-Reasoning + +------------------------------------------------------------------------ +-- cast +------------------------------------------------------------------------ + +toℕ-cast : ∀ {m n} .(eq : m ≡ n) (k : Fin m) → toℕ (cast eq k) ≡ toℕ k +toℕ-cast {n = suc n} eq zero = refl +toℕ-cast {n = suc n} eq (suc k) = cong suc (toℕ-cast (cong ℕ.pred eq) k) + +------------------------------------------------------------------------ +-- Properties of _≤_ +------------------------------------------------------------------------ +-- Relational properties + +≤-reflexive : ∀ {n} → _≡_ ⇒ (_≤_ {n}) +≤-reflexive refl = ℕₚ.≤-refl + +≤-refl : ∀ {n} → Reflexive (_≤_ {n}) +≤-refl = ≤-reflexive refl + +≤-trans : ∀ {n} → Transitive (_≤_ {n}) +≤-trans = ℕₚ.≤-trans + +≤-antisym : ∀ {n} → Antisymmetric _≡_ (_≤_ {n}) +≤-antisym x≤y y≤x = toℕ-injective (ℕₚ.≤-antisym x≤y y≤x) + +≤-total : ∀ {n} → Total (_≤_ {n}) +≤-total x y = ℕₚ.≤-total (toℕ x) (toℕ y) + +≤-irrelevant : ∀ {n} → Irrelevant (_≤_ {n}) +≤-irrelevant = ℕₚ.≤-irrelevant + +infix 4 _≤?_ _<?_ + +_≤?_ : ∀ {n} → B.Decidable (_≤_ {n}) +a ≤? b = toℕ a ℕₚ.≤? toℕ b + +_<?_ : ∀ {n} → B.Decidable (_<_ {n}) +m <? n = suc (toℕ m) ℕₚ.≤? toℕ n + +------------------------------------------------------------------------ +-- Structures + +≤-isPreorder : ∀ {n} → IsPreorder _≡_ (_≤_ {n}) +≤-isPreorder = record + { isEquivalence = P.isEquivalence + ; reflexive = ≤-reflexive + ; trans = ≤-trans + } + +≤-isPartialOrder : ∀ {n} → IsPartialOrder _≡_ (_≤_ {n}) +≤-isPartialOrder = record + { isPreorder = ≤-isPreorder + ; antisym = ≤-antisym + } + + +≤-isTotalOrder : ∀ {n} → IsTotalOrder _≡_ (_≤_ {n}) +≤-isTotalOrder = record + { isPartialOrder = ≤-isPartialOrder + ; total = ≤-total + } + +≤-isDecTotalOrder : ∀ {n} → IsDecTotalOrder _≡_ (_≤_ {n}) +≤-isDecTotalOrder = record + { isTotalOrder = ≤-isTotalOrder + ; _≟_ = _≟_ + ; _≤?_ = _≤?_ + } + +------------------------------------------------------------------------ +-- Bundles + +≤-preorder : ℕ → Preorder _ _ _ +≤-preorder n = record + { isPreorder = ≤-isPreorder {n} + } + +≤-poset : ℕ → Poset _ _ _ +≤-poset n = record + { isPartialOrder = ≤-isPartialOrder {n} + } + +≤-totalOrder : ℕ → TotalOrder _ _ _ +≤-totalOrder n = record + { isTotalOrder = ≤-isTotalOrder {n} + } + +≤-decTotalOrder : ℕ → DecTotalOrder _ _ _ +≤-decTotalOrder n = record + { isDecTotalOrder = ≤-isDecTotalOrder {n} + } + +------------------------------------------------------------------------ +-- Properties of _<_ +------------------------------------------------------------------------ +-- Relational properties + +<-irrefl : ∀ {n} → Irreflexive _≡_ (_<_ {n}) +<-irrefl refl = ℕₚ.<-irrefl refl + +<-asym : ∀ {n} → Asymmetric (_<_ {n}) +<-asym = ℕₚ.<-asym + +<-trans : ∀ {n} → Transitive (_<_ {n}) +<-trans = ℕₚ.<-trans + +<-cmp : ∀ {n} → Trichotomous _≡_ (_<_ {n}) +<-cmp zero zero = tri≈ (λ()) refl (λ()) +<-cmp zero (suc j) = tri< (s≤s z≤n) (λ()) (λ()) +<-cmp (suc i) zero = tri> (λ()) (λ()) (s≤s z≤n) +<-cmp (suc i) (suc j) with <-cmp i j +... | tri< i<j i≢j j≮i = tri< (s≤s i<j) (i≢j ∘ suc-injective) (j≮i ∘ ℕₚ.≤-pred) +... | tri> i≮j i≢j j<i = tri> (i≮j ∘ ℕₚ.≤-pred) (i≢j ∘ suc-injective) (s≤s j<i) +... | tri≈ i≮j i≡j j≮i = tri≈ (i≮j ∘ ℕₚ.≤-pred) (cong suc i≡j) (j≮i ∘ ℕₚ.≤-pred) + +<-respˡ-≡ : ∀ {n} → (_<_ {n}) Respectsˡ _≡_ +<-respˡ-≡ refl x≤y = x≤y + +<-respʳ-≡ : ∀ {n} → (_<_ {n}) Respectsʳ _≡_ +<-respʳ-≡ refl x≤y = x≤y + +<-resp₂-≡ : ∀ {n} → (_<_ {n}) Respects₂ _≡_ +<-resp₂-≡ = <-respʳ-≡ , <-respˡ-≡ + +<-irrelevant : ∀ {n} → Irrelevant (_<_ {n}) +<-irrelevant = ℕₚ.<-irrelevant + +------------------------------------------------------------------------ +-- Structures + +<-isStrictPartialOrder : ∀ {n} → IsStrictPartialOrder _≡_ (_<_ {n}) +<-isStrictPartialOrder = record + { isEquivalence = P.isEquivalence + ; irrefl = <-irrefl + ; trans = <-trans + ; <-resp-≈ = <-resp₂-≡ + } + +<-isStrictTotalOrder : ∀ {n} → IsStrictTotalOrder _≡_ (_<_ {n}) +<-isStrictTotalOrder = record + { isEquivalence = P.isEquivalence + ; trans = <-trans + ; compare = <-cmp + } + +------------------------------------------------------------------------ +-- Bundles + +<-strictPartialOrder : ℕ → StrictPartialOrder _ _ _ +<-strictPartialOrder n = record + { isStrictPartialOrder = <-isStrictPartialOrder {n} + } + +<-strictTotalOrder : ℕ → StrictTotalOrder _ _ _ +<-strictTotalOrder n = record + { isStrictTotalOrder = <-isStrictTotalOrder {n} + } + +------------------------------------------------------------------------ +-- Other properties + +<⇒≢ : ∀ {n} {i j : Fin n} → i < j → i ≢ j +<⇒≢ i<i refl = ℕₚ.n≮n _ i<i + +≤∧≢⇒< : ∀ {n} {i j : Fin n} → i ≤ j → i ≢ j → i < j +≤∧≢⇒< {i = zero} {zero} _ 0≢0 = contradiction refl 0≢0 +≤∧≢⇒< {i = zero} {suc j} _ _ = s≤s z≤n +≤∧≢⇒< {i = suc i} {suc j} (s≤s i≤j) 1+i≢1+j = + s≤s (≤∧≢⇒< i≤j (1+i≢1+j ∘ (cong suc))) + +------------------------------------------------------------------------ +-- inject +------------------------------------------------------------------------ + +toℕ-inject : ∀ {n} {i : Fin n} (j : Fin′ i) → + toℕ (inject j) ≡ toℕ j +toℕ-inject {i = suc i} zero = refl +toℕ-inject {i = suc i} (suc j) = cong suc (toℕ-inject j) + +------------------------------------------------------------------------ +-- inject+ +------------------------------------------------------------------------ + +toℕ-inject+ : ∀ {m} n (i : Fin m) → toℕ i ≡ toℕ (inject+ n i) +toℕ-inject+ n zero = refl +toℕ-inject+ n (suc i) = cong suc (toℕ-inject+ n i) + +------------------------------------------------------------------------ +-- inject₁ +------------------------------------------------------------------------ + +inject₁-injective : ∀ {n} {i j : Fin n} → inject₁ i ≡ inject₁ j → i ≡ j +inject₁-injective {i = zero} {zero} i≡j = refl +inject₁-injective {i = suc i} {suc j} i≡j = + cong suc (inject₁-injective (suc-injective i≡j)) + +toℕ-inject₁ : ∀ {n} (i : Fin n) → toℕ (inject₁ i) ≡ toℕ i +toℕ-inject₁ zero = refl +toℕ-inject₁ (suc i) = cong suc (toℕ-inject₁ i) + +toℕ-inject₁-≢ : ∀ {n}(i : Fin n) → n ≢ toℕ (inject₁ i) +toℕ-inject₁-≢ (suc i) = toℕ-inject₁-≢ i ∘ ℕₚ.suc-injective + +inject₁ℕ< : ∀ {n} → (i : Fin n) → toℕ (inject₁ i) ℕ.< n +inject₁ℕ< {n} i = subst (ℕ._< n) (sym (toℕ-inject₁ i)) (toℕ<n i) + +inject₁ℕ≤ : ∀ {n} → (i : Fin n) → toℕ (inject₁ i) ℕ.≤ n +inject₁ℕ≤ = ℕₚ.<⇒≤ ∘ inject₁ℕ< + +≤̄⇒inject₁< : ∀ {n} → {i j : Fin n} → j ≤ i → inject₁ j < suc i +≤̄⇒inject₁< {i = i} {j} p = subst (ℕ._< toℕ (suc i)) (sym (toℕ-inject₁ j)) (s≤s p) + +ℕ<⇒inject₁< : ∀ {n} → {i : Fin (ℕ.suc n)} → {j : Fin n} → + toℕ j ℕ.< toℕ i → inject₁ j < i +ℕ<⇒inject₁< {i = suc i} (s≤s p) = ≤̄⇒inject₁< p + +------------------------------------------------------------------------ +-- lower₁ +------------------------------------------------------------------------ + +toℕ-lower₁ : ∀ {m} x → (p : m ≢ toℕ x) → toℕ (lower₁ x p) ≡ toℕ x +toℕ-lower₁ {ℕ.zero} zero p = contradiction refl p +toℕ-lower₁ {ℕ.suc m} zero p = refl +toℕ-lower₁ {ℕ.suc m} (suc x) p = cong ℕ.suc (toℕ-lower₁ x (p ∘ cong ℕ.suc)) + +------------------------------------------------------------------------ +-- inject₁ and lower₁ + +inject₁-lower₁ : ∀ {n} (i : Fin (suc n)) (n≢i : n ≢ toℕ i) → + inject₁ (lower₁ i n≢i) ≡ i +inject₁-lower₁ {zero} zero 0≢0 = contradiction refl 0≢0 +inject₁-lower₁ {suc n} zero _ = refl +inject₁-lower₁ {suc n} (suc i) n+1≢i+1 = + cong suc (inject₁-lower₁ i (n+1≢i+1 ∘ cong suc)) + +lower₁-inject₁′ : ∀ {n} (i : Fin n) (n≢i : n ≢ toℕ (inject₁ i)) → + lower₁ (inject₁ i) n≢i ≡ i +lower₁-inject₁′ zero _ = refl +lower₁-inject₁′ (suc i) n+1≢i+1 = + cong suc (lower₁-inject₁′ i (n+1≢i+1 ∘ cong suc)) + +lower₁-inject₁ : ∀ {n} (i : Fin n) → + lower₁ (inject₁ i) (toℕ-inject₁-≢ i) ≡ i +lower₁-inject₁ i = lower₁-inject₁′ i (toℕ-inject₁-≢ i) + +lower₁-irrelevant : ∀ {n} (i : Fin (suc n)) n≢i₁ n≢i₂ → + lower₁ {n} i n≢i₁ ≡ lower₁ {n} i n≢i₂ +lower₁-irrelevant {zero} zero 0≢0 _ = contradiction refl 0≢0 +lower₁-irrelevant {suc n} zero _ _ = refl +lower₁-irrelevant {suc n} (suc i) _ _ = + cong suc (lower₁-irrelevant i _ _) + +inject₁≡⇒lower₁≡ : ∀ {n} → {i : Fin n} → + {j : Fin (ℕ.suc n)} → + (≢p : n ≢ (toℕ j)) → + inject₁ i ≡ j → + lower₁ j ≢p ≡ i +inject₁≡⇒lower₁≡ ≢p ≡p = inject₁-injective (trans (inject₁-lower₁ _ ≢p) (sym ≡p)) + +------------------------------------------------------------------------ +-- inject≤ +------------------------------------------------------------------------ + +toℕ-inject≤ : ∀ {m n} (i : Fin m) (le : m ℕ.≤ n) → + toℕ (inject≤ i le) ≡ toℕ i +toℕ-inject≤ {_} {suc n} zero _ = refl +toℕ-inject≤ {_} {suc n} (suc i) le = cong suc (toℕ-inject≤ i (ℕₚ.≤-pred le)) + +inject≤-refl : ∀ {n} (i : Fin n) (n≤n : n ℕ.≤ n) → inject≤ i n≤n ≡ i +inject≤-refl {suc n} zero _ = refl +inject≤-refl {suc n} (suc i) n≤n = cong suc (inject≤-refl i (ℕₚ.≤-pred n≤n)) + +inject≤-idempotent : ∀ {m n k} (i : Fin m) + (m≤n : m ℕ.≤ n) (n≤k : n ℕ.≤ k) (m≤k : m ℕ.≤ k) → + inject≤ (inject≤ i m≤n) n≤k ≡ inject≤ i m≤k +inject≤-idempotent {_} {suc n} {suc k} zero _ _ _ = refl +inject≤-idempotent {_} {suc n} {suc k} (suc i) m≤n n≤k _ = + cong suc (inject≤-idempotent i (ℕₚ.≤-pred m≤n) (ℕₚ.≤-pred n≤k) _) + +inject≤-injective : ∀ {n m} (n≤m n≤m′ : n ℕ.≤ m) x y → inject≤ x n≤m ≡ inject≤ y n≤m′ → x ≡ y +inject≤-injective (s≤s p) (s≤s q) zero zero eq = refl +inject≤-injective (s≤s p) (s≤s q) (suc x) (suc y) eq = + cong suc (inject≤-injective p q x y (suc-injective eq)) + +------------------------------------------------------------------------ +-- pred +------------------------------------------------------------------------ + +pred< : ∀ {n} → (i : Fin (ℕ.suc n)) → i ≢ zero → pred i < i +pred< zero p = contradiction refl p +pred< (suc i) p = ≤̄⇒inject₁< ℕₚ.≤-refl + +------------------------------------------------------------------------ +-- splitAt +------------------------------------------------------------------------ + +-- Fin (m + n) ↔ Fin m ⊎ Fin n + +splitAt-inject+ : ∀ m n i → splitAt m (inject+ n i) ≡ inj₁ i +splitAt-inject+ (suc m) n zero = refl +splitAt-inject+ (suc m) n (suc i) rewrite splitAt-inject+ m n i = refl + +splitAt-raise : ∀ m n i → splitAt m (raise {n} m i) ≡ inj₂ i +splitAt-raise zero n i = refl +splitAt-raise (suc m) n i rewrite splitAt-raise m n i = refl + +splitAt-join : ∀ m n i → splitAt m (join m n i) ≡ i +splitAt-join m n (inj₁ x) = splitAt-inject+ m n x +splitAt-join m n (inj₂ y) = splitAt-raise m n y + +join-splitAt : ∀ m n i → join m n (splitAt m i) ≡ i +join-splitAt zero n i = refl +join-splitAt (suc m) n zero = refl +join-splitAt (suc m) n (suc i) = begin + [ inject+ n , raise {n} (suc m) ]′ (splitAt (suc m) (suc i)) ≡⟨ [,]-map-commute (splitAt m i) ⟩ + [ suc ∘ (inject+ n) , suc ∘ (raise {n} m) ]′ (splitAt m i) ≡˘⟨ [,]-∘-distr suc (splitAt m i) ⟩ + suc ([ inject+ n , raise {n} m ]′ (splitAt m i)) ≡⟨ cong suc (join-splitAt m n i) ⟩ + suc i ∎ + where open ≡-Reasoning + +-- splitAt "m" "i" ≡ inj₁ "i" if i < m + +splitAt-< : ∀ m {n} i → (i<m : toℕ i ℕ.< m) → splitAt m {n} i ≡ inj₁ (fromℕ< i<m) +splitAt-< (suc m) zero _ = refl +splitAt-< (suc m) (suc i) (s≤s i<m) = cong (Sum.map suc id) (splitAt-< m i i<m) + +-- splitAt "m" "i" ≡ inj₂ "i - m" if i ≥ m + +splitAt-≥ : ∀ m {n} i → (i≥m : toℕ i ℕ.≥ m) → splitAt m {n} i ≡ inj₂ (reduce≥ i i≥m) +splitAt-≥ zero i _ = refl +splitAt-≥ (suc m) (suc i) (s≤s i≥m) = cong (Sum.map suc id) (splitAt-≥ m i i≥m) + +------------------------------------------------------------------------ +-- Bundles + ++↔⊎ : ∀ {m n} → Fin (m ℕ.+ n) ↔ (Fin m ⊎ Fin n) ++↔⊎ {m} {n} = mk↔′ (splitAt m {n}) (join m n) (splitAt-join m n) (join-splitAt m n) + +------------------------------------------------------------------------ +-- remQuot +------------------------------------------------------------------------ + +-- Fin (m * n) ↔ Fin m × Fin n + +remQuot-combine : ∀ {n k} (x : Fin n) y → remQuot k (combine x y) ≡ (x , y) +remQuot-combine {suc n} {k} 0F y rewrite splitAt-inject+ k (n ℕ.* k) y = refl +remQuot-combine {suc n} {k} (suc x) y rewrite splitAt-raise k (n ℕ.* k) (combine x y) = cong (Data.Product.map₁ suc) (remQuot-combine x y) + +combine-remQuot : ∀ {n} k (i : Fin (n ℕ.* k)) → uncurry combine (remQuot {n} k i) ≡ i +combine-remQuot {suc n} k i with splitAt k i | P.inspect (splitAt k) i +... | inj₁ j | P.[ eq ] = begin + join k (n ℕ.* k) (inj₁ j) ≡˘⟨ cong (join k (n ℕ.* k)) eq ⟩ + join k (n ℕ.* k) (splitAt k i) ≡⟨ join-splitAt k (n ℕ.* k) i ⟩ + i ∎ + where open ≡-Reasoning +... | inj₂ j | P.[ eq ] = begin + raise {n ℕ.* k} k (uncurry combine (remQuot {n} k j)) ≡⟨ cong (raise k) (combine-remQuot {n} k j) ⟩ + join k (n ℕ.* k) (inj₂ j) ≡˘⟨ cong (join k (n ℕ.* k)) eq ⟩ + join k (n ℕ.* k) (splitAt k i) ≡⟨ join-splitAt k (n ℕ.* k) i ⟩ + i ∎ + where open ≡-Reasoning + +------------------------------------------------------------------------ +-- Bundles +*↔× : ∀ {m n} → Fin (m ℕ.* n) ↔ (Fin m × Fin n) +*↔× {m} {n} = mk↔′ (remQuot {m} n) (uncurry combine) (uncurry remQuot-combine) (combine-remQuot {m} n) + +------------------------------------------------------------------------ +-- lift +------------------------------------------------------------------------ + +lift-injective : ∀ {m n} (f : Fin m → Fin n) → + (∀ {x y} → f x ≡ f y → x ≡ y) → + ∀ k {x y} → lift k f x ≡ lift k f y → x ≡ y +lift-injective f inj zero eq = inj eq +lift-injective f inj (suc k) {0F} {0F} eq = refl +lift-injective f inj (suc k) {suc i} {suc y} eq = cong suc (lift-injective f inj k (suc-injective eq)) + + +------------------------------------------------------------------------ +-- _≺_ +------------------------------------------------------------------------ + +≺⇒<′ : _≺_ ⇒ ℕ._<′_ +≺⇒<′ (n ≻toℕ i) = ℕₚ.≤⇒≤′ (toℕ<n i) + +<′⇒≺ : ℕ._<′_ ⇒ _≺_ +<′⇒≺ {n} ℕ.≤′-refl = subst (_≺ suc n) (toℕ-fromℕ n) + (suc n ≻toℕ fromℕ n) +<′⇒≺ (ℕ.≤′-step m≤′n) with <′⇒≺ m≤′n +... | n ≻toℕ i = subst (_≺ suc n) (toℕ-inject₁ i) (suc n ≻toℕ _) + +------------------------------------------------------------------------ +-- pred +------------------------------------------------------------------------ + +<⇒≤pred : ∀ {n} {i j : Fin n} → j < i → j ≤ pred i +<⇒≤pred {i = suc i} {zero} j<i = z≤n +<⇒≤pred {i = suc i} {suc j} (s≤s j<i) = + subst (_ ℕ.≤_) (sym (toℕ-inject₁ i)) j<i + +------------------------------------------------------------------------ +-- _ℕ-_ +------------------------------------------------------------------------ + +toℕ‿ℕ- : ∀ n i → toℕ (n ℕ- i) ≡ n ∸ toℕ i +toℕ‿ℕ- n zero = toℕ-fromℕ n +toℕ‿ℕ- (suc n) (suc i) = toℕ‿ℕ- n i + +------------------------------------------------------------------------ +-- _ℕ-ℕ_ +------------------------------------------------------------------------ + +nℕ-ℕi≤n : ∀ n i → n ℕ-ℕ i ℕ.≤ n +nℕ-ℕi≤n n zero = ℕₚ.≤-refl +nℕ-ℕi≤n (suc n) (suc i) = begin + n ℕ-ℕ i ≤⟨ nℕ-ℕi≤n n i ⟩ + n ≤⟨ ℕₚ.n≤1+n n ⟩ + suc n ∎ + where open ℕₚ.≤-Reasoning + +------------------------------------------------------------------------ +-- punchIn +------------------------------------------------------------------------ + +punchIn-injective : ∀ {m} i (j k : Fin m) → + punchIn i j ≡ punchIn i k → j ≡ k +punchIn-injective zero _ _ refl = refl +punchIn-injective (suc i) zero zero _ = refl +punchIn-injective (suc i) (suc j) (suc k) ↑j+1≡↑k+1 = + cong suc (punchIn-injective i j k (suc-injective ↑j+1≡↑k+1)) + +punchInᵢ≢i : ∀ {m} i (j : Fin m) → punchIn i j ≢ i +punchInᵢ≢i (suc i) (suc j) = punchInᵢ≢i i j ∘ suc-injective + +------------------------------------------------------------------------ +-- punchOut +------------------------------------------------------------------------ + +-- A version of 'cong' for 'punchOut' in which the inequality argument can be +-- changed out arbitrarily (reflecting the proof-irrelevance of that argument). + +punchOut-cong : ∀ {n} (i : Fin (suc n)) {j k} {i≢j : i ≢ j} {i≢k : i ≢ k} → j ≡ k → punchOut i≢j ≡ punchOut i≢k +punchOut-cong zero {zero} {i≢j = 0≢0} = contradiction refl 0≢0 +punchOut-cong zero {suc j} {zero} {i≢k = 0≢0} = contradiction refl 0≢0 +punchOut-cong zero {suc j} {suc k} = suc-injective +punchOut-cong {suc n} (suc i) {zero} {zero} _ = refl +punchOut-cong {suc n} (suc i) {suc j} {suc k} = cong suc ∘ punchOut-cong i ∘ suc-injective + +-- An alternative to 'punchOut-cong' in the which the new inequality argument is +-- specific. Useful for enabling the omission of that argument during equational +-- reasoning. + +punchOut-cong′ : ∀ {n} (i : Fin (suc n)) {j k} {p : i ≢ j} (q : j ≡ k) → punchOut p ≡ punchOut (p ∘ sym ∘ trans q ∘ sym) +punchOut-cong′ i q = punchOut-cong i q + +punchOut-injective : ∀ {m} {i j k : Fin (suc m)} + (i≢j : i ≢ j) (i≢k : i ≢ k) → + punchOut i≢j ≡ punchOut i≢k → j ≡ k +punchOut-injective {_} {zero} {zero} {_} 0≢0 _ _ = contradiction refl 0≢0 +punchOut-injective {_} {zero} {_} {zero} _ 0≢0 _ = contradiction refl 0≢0 +punchOut-injective {_} {zero} {suc j} {suc k} _ _ pⱼ≡pₖ = cong suc pⱼ≡pₖ +punchOut-injective {suc n} {suc i} {zero} {zero} _ _ _ = refl +punchOut-injective {suc n} {suc i} {suc j} {suc k} i≢j i≢k pⱼ≡pₖ = + cong suc (punchOut-injective (i≢j ∘ cong suc) (i≢k ∘ cong suc) (suc-injective pⱼ≡pₖ)) + +punchIn-punchOut : ∀ {m} {i j : Fin (suc m)} (i≢j : i ≢ j) → + punchIn i (punchOut i≢j) ≡ j +punchIn-punchOut {_} {zero} {zero} 0≢0 = contradiction refl 0≢0 +punchIn-punchOut {_} {zero} {suc j} _ = refl +punchIn-punchOut {suc m} {suc i} {zero} i≢j = refl +punchIn-punchOut {suc m} {suc i} {suc j} i≢j = + cong suc (punchIn-punchOut (i≢j ∘ cong suc)) + +punchOut-punchIn : ∀ {n} i {j : Fin n} → punchOut {i = i} {j = punchIn i j} (punchInᵢ≢i i j ∘ sym) ≡ j +punchOut-punchIn zero {j} = refl +punchOut-punchIn (suc i) {zero} = refl +punchOut-punchIn (suc i) {suc j} = cong suc (begin + punchOut (punchInᵢ≢i i j ∘ suc-injective ∘ sym ∘ cong suc) ≡⟨ punchOut-cong i refl ⟩ + punchOut (punchInᵢ≢i i j ∘ sym) ≡⟨ punchOut-punchIn i ⟩ + j ∎) + where open ≡-Reasoning + + +------------------------------------------------------------------------ +-- pinch +------------------------------------------------------------------------ + +pinch-surjective : ∀ {m} (i : Fin m) → Surjective _≡_ (pinch i) +pinch-surjective _ zero = zero , refl +pinch-surjective zero (suc j) = suc (suc j) , refl +pinch-surjective (suc i) (suc j) = map suc (cong suc) (pinch-surjective i j) + +pinch-mono-≤ : ∀ {m} (i : Fin m) → (pinch i) Preserves _≤_ ⟶ _≤_ +pinch-mono-≤ 0F {0F} {k} 0≤n = z≤n +pinch-mono-≤ 0F {suc j} {suc k} (s≤s j≤k) = j≤k +pinch-mono-≤ (suc i) {0F} {k} 0≤n = z≤n +pinch-mono-≤ (suc i) {suc j} {suc k} (s≤s j≤k) = s≤s (pinch-mono-≤ i j≤k) + +------------------------------------------------------------------------ +-- Quantification +------------------------------------------------------------------------ + +module _ {n p} {P : Pred (Fin (suc n)) p} where + + ∀-cons : P zero → Π[ P ∘ suc ] → Π[ P ] + ∀-cons z s zero = z + ∀-cons z s (suc i) = s i + + ∀-cons-⇔ : (P zero × Π[ P ∘ suc ]) ⇔ Π[ P ] + ∀-cons-⇔ = equivalence (uncurry ∀-cons) < _$ zero , _∘ suc > + + ∃-here : P zero → ∃⟨ P ⟩ + ∃-here = zero ,_ + + ∃-there : ∃⟨ P ∘ suc ⟩ → ∃⟨ P ⟩ + ∃-there = map suc id + + ∃-toSum : ∃⟨ P ⟩ → P zero ⊎ ∃⟨ P ∘ suc ⟩ + ∃-toSum ( zero , P₀ ) = inj₁ P₀ + ∃-toSum (suc f , P₁₊) = inj₂ (f , P₁₊) + + ⊎⇔∃ : (P zero ⊎ ∃⟨ P ∘ suc ⟩) ⇔ ∃⟨ P ⟩ + ⊎⇔∃ = equivalence [ ∃-here , ∃-there ] ∃-toSum + +decFinSubset : ∀ {n p q} {P : Pred (Fin n) p} {Q : Pred (Fin n) q} → + Decidable Q → (∀ {f} → Q f → Dec (P f)) → Dec (Q ⊆ P) +decFinSubset {zero} Q? P? = yes λ {} +decFinSubset {suc n} {P = P} {Q} Q? P? + with Q? zero | ∀-cons {P = λ x → Q x → P x} +... | false because [¬Q0] | cons = + map′ (λ f {x} → cons (⊥-elim ∘ invert [¬Q0]) (λ x → f {x}) x) + (λ f {x} → f {suc x}) + (decFinSubset (Q? ∘ suc) P?) +... | true because [Q0] | cons = + map′ (uncurry λ P0 rec {x} → cons (λ _ → P0) (λ x → rec {x}) x) + < _$ invert [Q0] , (λ f {x} → f {suc x}) > + (P? (invert [Q0]) ×-dec decFinSubset (Q? ∘ suc) P?) + +any? : ∀ {n p} {P : Fin n → Set p} → Decidable P → Dec (∃ P) +any? {zero} {P = _} P? = no λ { (() , _) } +any? {suc n} {P = P} P? = Dec.map ⊎⇔∃ (P? zero ⊎-dec any? (P? ∘ suc)) + +all? : ∀ {n p} {P : Pred (Fin n) p} → + Decidable P → Dec (∀ f → P f) +all? P? = map′ (λ ∀p f → ∀p tt) (λ ∀p {x} _ → ∀p x) + (decFinSubset U? (λ {f} _ → P? f)) + +private + -- A nice computational property of `all?`: + -- The boolean component of the result is exactly the + -- obvious fold of boolean tests (`foldr _∧_ true`). + note : ∀ {p} {P : Pred (Fin 3) p} (P? : Decidable P) → + ∃ λ z → does (all? P?) ≡ z + note P? = does (P? 0F) ∧ does (P? 1F) ∧ does (P? 2F) ∧ true + , refl + +-- If a decidable predicate P over a finite set is sometimes false, +-- then we can find the smallest value for which this is the case. + +¬∀⟶∃¬-smallest : ∀ n {p} (P : Pred (Fin n) p) → Decidable P → + ¬ (∀ i → P i) → ∃ λ i → ¬ P i × ((j : Fin′ i) → P (inject j)) +¬∀⟶∃¬-smallest zero P P? ¬∀P = contradiction (λ()) ¬∀P +¬∀⟶∃¬-smallest (suc n) P P? ¬∀P with P? zero +... | false because [¬P₀] = (zero , invert [¬P₀] , λ ()) +... | true because [P₀] = map suc (map id (∀-cons (invert [P₀]))) + (¬∀⟶∃¬-smallest n (P ∘ suc) (P? ∘ suc) (¬∀P ∘ (∀-cons (invert [P₀])))) + +-- When P is a decidable predicate over a finite set the following +-- lemma can be proved. + +¬∀⟶∃¬ : ∀ n {p} (P : Pred (Fin n) p) → Decidable P → + ¬ (∀ i → P i) → (∃ λ i → ¬ P i) +¬∀⟶∃¬ n P P? ¬P = map id proj₁ (¬∀⟶∃¬-smallest n P P? ¬P) + +-- The pigeonhole principle. + +pigeonhole : ∀ {m n} → m ℕ.< n → (f : Fin n → Fin m) → + ∃₂ λ i j → i ≢ j × f i ≡ f j +pigeonhole (s≤s z≤n) f = contradiction (f zero) λ() +pigeonhole (s≤s (s≤s m≤n)) f with any? (λ k → f zero ≟ f (suc k)) +... | yes (j , f₀≡fⱼ) = zero , suc j , (λ()) , f₀≡fⱼ +... | no f₀≢fₖ with pigeonhole (s≤s m≤n) (λ j → punchOut (f₀≢fₖ ∘ (j ,_ ))) +... | (i , j , i≢j , fᵢ≡fⱼ) = + suc i , suc j , i≢j ∘ suc-injective , + punchOut-injective (f₀≢fₖ ∘ (i ,_)) _ fᵢ≡fⱼ + +------------------------------------------------------------------------ +-- Categorical +------------------------------------------------------------------------ + +module _ {f} {F : Set f → Set f} (RA : RawApplicative F) where + + open RawApplicative RA + + sequence : ∀ {n} {P : Pred (Fin n) f} → + (∀ i → F (P i)) → F (∀ i → P i) + sequence {zero} ∀iPi = pure λ() + sequence {suc n} ∀iPi = ∀-cons <$> ∀iPi zero ⊛ sequence (∀iPi ∘ suc) + +module _ {f} {F : Set f → Set f} (RF : RawFunctor F) where + + open RawFunctor RF + + sequence⁻¹ : ∀ {A : Set f} {P : Pred A f} → + F (∀ i → P i) → (∀ i → F (P i)) + sequence⁻¹ F∀iPi i = (λ f → f i) <$> F∀iPi + +------------------------------------------------------------------------ +-- If there is an injection from a type to a finite set, then the type +-- has decidable equality. + +module _ {a} {A : Set a} where + + eq? : ∀ {n} → A ↣ Fin n → B.Decidable {A = A} _≡_ + eq? inj = Dec.via-injection inj _≟_ + + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 0.15 + +cmp = <-cmp +{-# WARNING_ON_USAGE cmp +"Warning: cmp was deprecated in v0.15. +Please use <-cmp instead." +#-} +strictTotalOrder = <-strictTotalOrder +{-# WARNING_ON_USAGE strictTotalOrder +"Warning: strictTotalOrder was deprecated in v0.15. +Please use <-strictTotalOrder instead." +#-} + +-- Version 0.16 + +to-from = toℕ-fromℕ +{-# WARNING_ON_USAGE to-from +"Warning: to-from was deprecated in v0.16. +Please use toℕ-fromℕ instead." +#-} +from-to = fromℕ-toℕ +{-# WARNING_ON_USAGE from-to +"Warning: from-to was deprecated in v0.16. +Please use fromℕ-toℕ instead." +#-} +bounded = toℕ<n +{-# WARNING_ON_USAGE bounded +"Warning: bounded was deprecated in v0.16. +Please use toℕ<n instead." +#-} +prop-toℕ-≤ = toℕ≤pred[n] +{-# WARNING_ON_USAGE prop-toℕ-≤ +"Warning: prop-toℕ-≤ was deprecated in v0.16. +Please use toℕ≤pred[n] instead." +#-} +prop-toℕ-≤′ = toℕ≤pred[n]′ +{-# WARNING_ON_USAGE prop-toℕ-≤′ +"Warning: prop-toℕ-≤′ was deprecated in v0.16. +Please use toℕ≤pred[n]′ instead." +#-} +inject-lemma = toℕ-inject +{-# WARNING_ON_USAGE inject-lemma +"Warning: inject-lemma was deprecated in v0.16. +Please use toℕ-inject instead." +#-} +inject+-lemma = toℕ-inject+ +{-# WARNING_ON_USAGE inject+-lemma +"Warning: inject+-lemma was deprecated in v0.16. +Please use toℕ-inject+ instead." +#-} +inject₁-lemma = toℕ-inject₁ +{-# WARNING_ON_USAGE inject₁-lemma +"Warning: inject₁-lemma was deprecated in v0.16. +Please use toℕ-inject₁ instead." +#-} +inject≤-lemma = toℕ-inject≤ +{-# WARNING_ON_USAGE inject≤-lemma +"Warning: inject≤-lemma was deprecated in v0.16. +Please use toℕ-inject≤ instead." +#-} + +-- Version 0.17 + +≤+≢⇒< = ≤∧≢⇒< +{-# WARNING_ON_USAGE ≤+≢⇒< +"Warning: ≤+≢⇒< was deprecated in v0.17. +Please use ≤∧≢⇒< instead." +#-} + +-- Version 1.0 + +≤-irrelevance = ≤-irrelevant +{-# WARNING_ON_USAGE ≤-irrelevance +"Warning: ≤-irrelevance was deprecated in v1.0. +Please use ≤-irrelevant instead." +#-} +<-irrelevance = <-irrelevant +{-# WARNING_ON_USAGE <-irrelevance +"Warning: <-irrelevance was deprecated in v1.0. +Please use <-irrelevant instead." +#-} + +-- Version 1.1 + +infixl 6 _+′_ +_+′_ : ∀ {m n} (i : Fin m) (j : Fin n) → Fin (ℕ.pred m ℕ.+ n) +i +′ j = inject≤ (i + j) (ℕₚ.+-monoˡ-≤ _ (toℕ≤pred[n] i)) +{-# WARNING_ON_USAGE _+′_ +"Warning: _+′_ was deprecated in v1.1. +Please use `raise` or `inject+` from `Data.Fin` instead." +#-} + +-- Version 1.2 + +fromℕ≤-toℕ = fromℕ<-toℕ +{-# WARNING_ON_USAGE fromℕ≤-toℕ +"Warning: fromℕ≤-toℕ was deprecated in v1.2. +Please use fromℕ<-toℕ instead." +#-} +toℕ-fromℕ≤ = toℕ-fromℕ< +{-# WARNING_ON_USAGE toℕ-fromℕ≤ +"Warning: toℕ-fromℕ≤ was deprecated in v1.2. +Please use toℕ-fromℕ< instead." +#-} +fromℕ≤≡fromℕ≤″ = fromℕ<≡fromℕ<″ +{-# WARNING_ON_USAGE fromℕ≤≡fromℕ≤″ +"Warning: fromℕ≤≡fromℕ≤″ was deprecated in v1.2. +Please use fromℕ<≡fromℕ<″ instead." +#-} +toℕ-fromℕ≤″ = toℕ-fromℕ<″ +{-# WARNING_ON_USAGE toℕ-fromℕ≤″ +"Warning: toℕ-fromℕ≤″ was deprecated in v1.2. +Please use toℕ-fromℕ<″ instead." +#-} +isDecEquivalence = ≡-isDecEquivalence +{-# WARNING_ON_USAGE isDecEquivalence +"Warning: isDecEquivalence was deprecated in v1.2. +Please use ≡-isDecEquivalence instead." +#-} +preorder = ≡-preorder +{-# WARNING_ON_USAGE preorder +"Warning: preorder was deprecated in v1.2. +Please use ≡-preorder instead." +#-} +setoid = ≡-setoid +{-# WARNING_ON_USAGE setoid +"Warning: setoid was deprecated in v1.2. +Please use ≡-setoid instead." +#-} +decSetoid = ≡-decSetoid +{-# WARNING_ON_USAGE decSetoid +"Warning: decSetoid was deprecated in v1.2. +Please use ≡-decSetoid instead." +#-} + +-- Version 1.5 + +inject+-raise-splitAt = join-splitAt +{-# WARNING_ON_USAGE inject+-raise-splitAt +"Warning: decSetoid was deprecated in v1.5. +Please use join-splitAt instead." +#-} +\ No newline at end of file diff --git a/docs/Data.Fin.html b/docs/Data.Fin.html new file mode 100644 index 0000000..35596bb --- /dev/null +++ b/docs/Data.Fin.html @@ -0,0 +1,33 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Finite sets +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Fin where + +open import Relation.Nullary.Decidable.Core +open import Data.Nat.Base using (suc) +import Data.Nat.Properties as ℕₚ + +------------------------------------------------------------------------ +-- Publicly re-export the contents of the base module + +open import Data.Fin.Base public + +------------------------------------------------------------------------ +-- Publicly re-export queries + +open import Data.Fin.Properties public + using (_≟_; _≤?_; _<?_) + +-- # m = "m". + +infix 10 #_ + +#_ : ∀ m {n} {m<n : True (suc m ℕₚ.≤? n)} → Fin n +#_ _ {m<n = m<n} = fromℕ< (toWitness m<n) +\ No newline at end of file diff --git a/docs/Data.List.Base.html b/docs/Data.List.Base.html new file mode 100644 index 0000000..4b5f137 --- /dev/null +++ b/docs/Data.List.Base.html @@ -0,0 +1,488 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Lists, basic types and operations +------------------------------------------------------------------------ + +-- See README.Data.List for examples of how to use and reason about +-- lists. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.List.Base where + +open import Data.Bool.Base as Bool + using (Bool; false; true; not; _∧_; _∨_; if_then_else_) +open import Data.Fin.Base using (Fin; zero; suc) +open import Data.Maybe.Base as Maybe using (Maybe; nothing; just; maybe′) +open import Data.Nat.Base as ℕ using (ℕ; zero; suc; _+_; _*_ ; _≤_ ; s≤s) +open import Data.Product as Prod using (_×_; _,_) +open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂) +open import Data.These.Base as These using (These; this; that; these) +open import Function.Base using (id; _∘_ ; _∘′_; const; flip) +open import Level using (Level) +open import Relation.Nullary using (does) +open import Relation.Nullary.Negation.Core using (¬?) +open import Relation.Unary using (Pred; Decidable) +open import Relation.Unary.Properties using (∁?) +open import Relation.Binary.Core using (Rel) +import Relation.Binary.Definitions as B + +private + variable + a b c p ℓ : Level + A : Set a + B : Set b + C : Set c + +------------------------------------------------------------------------ +-- Types + +open import Agda.Builtin.List public + using (List; []; _∷_) + +------------------------------------------------------------------------ +-- Operations for transforming lists + +map : (A → B) → List A → List B +map f [] = [] +map f (x ∷ xs) = f x ∷ map f xs + +mapMaybe : (A → Maybe B) → List A → List B +mapMaybe p [] = [] +mapMaybe p (x ∷ xs) with p x +... | just y = y ∷ mapMaybe p xs +... | nothing = mapMaybe p xs + +infixr 5 _++_ + +_++_ : List A → List A → List A +[] ++ ys = ys +(x ∷ xs) ++ ys = x ∷ (xs ++ ys) + +intersperse : A → List A → List A +intersperse x [] = [] +intersperse x (y ∷ []) = y ∷ [] +intersperse x (y ∷ ys) = y ∷ x ∷ intersperse x ys + +intercalate : List A → List (List A) → List A +intercalate xs [] = [] +intercalate xs (ys ∷ []) = ys +intercalate xs (ys ∷ yss) = ys ++ xs ++ intercalate xs yss + +cartesianProductWith : (A → B → C) → List A → List B → List C +cartesianProductWith f [] _ = [] +cartesianProductWith f (x ∷ xs) ys = map (f x) ys ++ cartesianProductWith f xs ys + +cartesianProduct : List A → List B → List (A × B) +cartesianProduct = cartesianProductWith _,_ + +------------------------------------------------------------------------ +-- Aligning and zipping + +alignWith : (These A B → C) → List A → List B → List C +alignWith f [] bs = map (f ∘′ that) bs +alignWith f as [] = map (f ∘′ this) as +alignWith f (a ∷ as) (b ∷ bs) = f (these a b) ∷ alignWith f as bs + +zipWith : (A → B → C) → List A → List B → List C +zipWith f (x ∷ xs) (y ∷ ys) = f x y ∷ zipWith f xs ys +zipWith f _ _ = [] + +unalignWith : (A → These B C) → List A → List B × List C +unalignWith f [] = [] , [] +unalignWith f (a ∷ as) with f a +... | this b = Prod.map₁ (b ∷_) (unalignWith f as) +... | that c = Prod.map₂ (c ∷_) (unalignWith f as) +... | these b c = Prod.map (b ∷_) (c ∷_) (unalignWith f as) + +unzipWith : (A → B × C) → List A → List B × List C +unzipWith f [] = [] , [] +unzipWith f (xy ∷ xys) = Prod.zip _∷_ _∷_ (f xy) (unzipWith f xys) + +partitionSumsWith : (A → B ⊎ C) → List A → List B × List C +partitionSumsWith f = unalignWith (These.fromSum ∘′ f) + +align : List A → List B → List (These A B) +align = alignWith id + +zip : List A → List B → List (A × B) +zip = zipWith (_,_) + +unalign : List (These A B) → List A × List B +unalign = unalignWith id + +unzip : List (A × B) → List A × List B +unzip = unzipWith id + +partitionSums : List (A ⊎ B) → List A × List B +partitionSums = partitionSumsWith id + +merge : {R : Rel A ℓ} → B.Decidable R → List A → List A → List A +merge R? [] ys = ys +merge R? xs [] = xs +merge R? (x ∷ xs) (y ∷ ys) = if does (R? x y) + then x ∷ merge R? xs (y ∷ ys) + else y ∷ merge R? (x ∷ xs) ys + +------------------------------------------------------------------------ +-- Operations for reducing lists + +foldr : (A → B → B) → B → List A → B +foldr c n [] = n +foldr c n (x ∷ xs) = c x (foldr c n xs) + +foldl : (A → B → A) → A → List B → A +foldl c n [] = n +foldl c n (x ∷ xs) = foldl c (c n x) xs + +concat : List (List A) → List A +concat = foldr _++_ [] + +concatMap : (A → List B) → List A → List B +concatMap f = concat ∘ map f + +null : List A → Bool +null [] = true +null (x ∷ xs) = false + +and : List Bool → Bool +and = foldr _∧_ true + +or : List Bool → Bool +or = foldr _∨_ false + +any : (A → Bool) → List A → Bool +any p = or ∘ map p + +all : (A → Bool) → List A → Bool +all p = and ∘ map p + +sum : List ℕ → ℕ +sum = foldr _+_ 0 + +product : List ℕ → ℕ +product = foldr _*_ 1 + +length : List A → ℕ +length = foldr (const suc) 0 + +------------------------------------------------------------------------ +-- Operations for constructing lists + +[_] : A → List A +[ x ] = x ∷ [] + +fromMaybe : Maybe A → List A +fromMaybe (just x) = [ x ] +fromMaybe nothing = [] + +replicate : ℕ → A → List A +replicate zero x = [] +replicate (suc n) x = x ∷ replicate n x + +inits : List A → List (List A) +inits [] = [] ∷ [] +inits (x ∷ xs) = [] ∷ map (x ∷_) (inits xs) + +tails : List A → List (List A) +tails [] = [] ∷ [] +tails (x ∷ xs) = (x ∷ xs) ∷ tails xs + +-- Scans + +scanr : (A → B → B) → B → List A → List B +scanr f e [] = e ∷ [] +scanr f e (x ∷ xs) with scanr f e xs +... | [] = [] -- dead branch +... | y ∷ ys = f x y ∷ y ∷ ys + +scanl : (A → B → A) → A → List B → List A +scanl f e [] = e ∷ [] +scanl f e (x ∷ xs) = e ∷ scanl f (f e x) xs + +-- Tabulation + +applyUpTo : (ℕ → A) → ℕ → List A +applyUpTo f zero = [] +applyUpTo f (suc n) = f zero ∷ applyUpTo (f ∘ suc) n + +applyDownFrom : (ℕ → A) → ℕ → List A +applyDownFrom f zero = [] +applyDownFrom f (suc n) = f n ∷ applyDownFrom f n + +tabulate : ∀ {n} (f : Fin n → A) → List A +tabulate {n = zero} f = [] +tabulate {n = suc n} f = f zero ∷ tabulate (f ∘ suc) + +lookup : ∀ (xs : List A) → Fin (length xs) → A +lookup (x ∷ xs) zero = x +lookup (x ∷ xs) (suc i) = lookup xs i + +-- Numerical + +upTo : ℕ → List ℕ +upTo = applyUpTo id + +downFrom : ℕ → List ℕ +downFrom = applyDownFrom id + +allFin : ∀ n → List (Fin n) +allFin n = tabulate id + +unfold : ∀ (P : ℕ → Set b) + (f : ∀ {n} → P (suc n) → Maybe (A × P n)) → + ∀ {n} → P n → List A +unfold P f {n = zero} s = [] +unfold P f {n = suc n} s with f s +... | nothing = [] +... | just (x , s′) = x ∷ unfold P f s′ + +------------------------------------------------------------------------ +-- Operations for deconstructing lists + +-- Note that although the following three combinators can be useful for +-- programming, when proving it is often a better idea to manually +-- destruct a list argument as each branch of the pattern-matching will +-- have a refined type. + +uncons : List A → Maybe (A × List A) +uncons [] = nothing +uncons (x ∷ xs) = just (x , xs) + +head : List A → Maybe A +head [] = nothing +head (x ∷ _) = just x + +tail : List A → Maybe (List A) +tail [] = nothing +tail (_ ∷ xs) = just xs + +last : List A → Maybe A +last [] = nothing +last (x ∷ []) = just x +last (_ ∷ xs) = last xs + +take : ℕ → List A → List A +take zero xs = [] +take (suc n) [] = [] +take (suc n) (x ∷ xs) = x ∷ take n xs + +drop : ℕ → List A → List A +drop zero xs = xs +drop (suc n) [] = [] +drop (suc n) (x ∷ xs) = drop n xs + +splitAt : ℕ → List A → (List A × List A) +splitAt zero xs = ([] , xs) +splitAt (suc n) [] = ([] , []) +splitAt (suc n) (x ∷ xs) with splitAt n xs +... | (ys , zs) = (x ∷ ys , zs) + +takeWhile : ∀ {P : Pred A p} → Decidable P → List A → List A +takeWhile P? [] = [] +takeWhile P? (x ∷ xs) with does (P? x) +... | true = x ∷ takeWhile P? xs +... | false = [] + +dropWhile : ∀ {P : Pred A p} → Decidable P → List A → List A +dropWhile P? [] = [] +dropWhile P? (x ∷ xs) with does (P? x) +... | true = dropWhile P? xs +... | false = x ∷ xs + +filter : ∀ {P : Pred A p} → Decidable P → List A → List A +filter P? [] = [] +filter P? (x ∷ xs) with does (P? x) +... | false = filter P? xs +... | true = x ∷ filter P? xs + +partition : ∀ {P : Pred A p} → Decidable P → List A → (List A × List A) +partition P? [] = ([] , []) +partition P? (x ∷ xs) with does (P? x) | partition P? xs +... | true | (ys , zs) = (x ∷ ys , zs) +... | false | (ys , zs) = (ys , x ∷ zs) + +span : ∀ {P : Pred A p} → Decidable P → List A → (List A × List A) +span P? [] = ([] , []) +span P? (x ∷ xs) with does (P? x) +... | true = Prod.map (x ∷_) id (span P? xs) +... | false = ([] , x ∷ xs) + +break : ∀ {P : Pred A p} → Decidable P → List A → (List A × List A) +break P? = span (∁? P?) + +derun : ∀ {R : Rel A p} → B.Decidable R → List A → List A +derun R? [] = [] +derun R? (x ∷ []) = x ∷ [] +derun R? (x ∷ y ∷ xs) with does (R? x y) | derun R? (y ∷ xs) +... | true | ys = ys +... | false | ys = x ∷ ys + +deduplicate : ∀ {R : Rel A p} → B.Decidable R → List A → List A +deduplicate R? [] = [] +deduplicate R? (x ∷ xs) = x ∷ filter (¬? ∘ R? x) (deduplicate R? xs) + +------------------------------------------------------------------------ +-- Actions on single elements + +infixl 5 _[_]%=_ _[_]∷=_ _─_ + +_[_]%=_ : (xs : List A) → Fin (length xs) → (A → A) → List A +(x ∷ xs) [ zero ]%= f = f x ∷ xs +(x ∷ xs) [ suc k ]%= f = x ∷ (xs [ k ]%= f) + +_[_]∷=_ : (xs : List A) → Fin (length xs) → A → List A +xs [ k ]∷= v = xs [ k ]%= const v + +_─_ : (xs : List A) → Fin (length xs) → List A +(x ∷ xs) ─ zero = xs +(x ∷ xs) ─ suc k = x ∷ (xs ─ k) + +------------------------------------------------------------------------ +-- Operations for reversing lists + +reverseAcc : List A → List A → List A +reverseAcc = foldl (flip _∷_) + +reverse : List A → List A +reverse = reverseAcc [] + +-- "Reverse append" xs ʳ++ ys = reverse xs ++ ys + +infixr 5 _ʳ++_ + +_ʳ++_ : List A → List A → List A +_ʳ++_ = flip reverseAcc + +-- Snoc: Cons, but from the right. + +infixl 6 _∷ʳ_ + +_∷ʳ_ : List A → A → List A +xs ∷ʳ x = xs ++ [ x ] + +-- Conditional versions of cons and snoc + +infixr 5 _?∷_ +_?∷_ : Maybe A → List A → List A +_?∷_ = maybe′ _∷_ id + +infixl 6 _∷ʳ?_ +_∷ʳ?_ : List A → Maybe A → List A +xs ∷ʳ? x = maybe′ (xs ∷ʳ_) xs x + + +-- Backwards initialisation + +infixl 5 _∷ʳ′_ + +data InitLast {A : Set a} : List A → Set a where + [] : InitLast [] + _∷ʳ′_ : (xs : List A) (x : A) → InitLast (xs ∷ʳ x) + +initLast : (xs : List A) → InitLast xs +initLast [] = [] +initLast (x ∷ xs) with initLast xs +... | [] = [] ∷ʳ′ x +... | ys ∷ʳ′ y = (x ∷ ys) ∷ʳ′ y + +-- uncons, but from the right +unsnoc : List A → Maybe (List A × A) +unsnoc as with initLast as +... | [] = nothing +... | xs ∷ʳ′ x = just (xs , x) + +------------------------------------------------------------------------ +-- Splitting a list + +-- The predicate `P` represents the notion of newline character for the type `A` +-- It is used to split the input list into a list of lines. Some lines may be +-- empty if the input contains at least two consecutive newline characters. + +linesBy : ∀ {P : Pred A p} → Decidable P → List A → List (List A) +linesBy {A = A} P? = go nothing where + + go : Maybe (List A) → List A → List (List A) + go acc [] = maybe′ ([_] ∘′ reverse) [] acc + go acc (c ∷ cs) with does (P? c) + ... | true = reverse (Maybe.fromMaybe [] acc) ∷ go nothing cs + ... | false = go (just (c ∷ Maybe.fromMaybe [] acc)) cs + +-- The predicate `P` represents the notion of space character for the type `A`. +-- It is used to split the input list into a list of words. All the words are +-- non empty and the output does not contain any space characters. + +wordsBy : ∀ {P : Pred A p} → Decidable P → List A → List (List A) +wordsBy {A = A} P? = go [] where + + cons : List A → List (List A) → List (List A) + cons [] ass = ass + cons as ass = reverse as ∷ ass + + go : List A → List A → List (List A) + go acc [] = cons acc [] + go acc (c ∷ cs) with does (P? c) + ... | true = cons acc (go [] cs) + ... | false = go (c ∷ acc) cs + +------------------------------------------------------------------------ +-- DEPRECATED +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. +-- +-- Note that the `boolX` functions are not given warnings as they are +-- used by other deprecated proofs throughout the library. + +-- Version 0.15 + +gfilter = mapMaybe +{-# WARNING_ON_USAGE gfilter +"Warning: gfilter was deprecated in v0.15. +Please use mapMaybe instead." +#-} + +boolFilter : (A → Bool) → List A → List A +boolFilter p = mapMaybe (λ x → if p x then just x else nothing) + +boolPartition : (A → Bool) → List A → (List A × List A) +boolPartition p [] = ([] , []) +boolPartition p (x ∷ xs) with p x | boolPartition p xs +... | true | (ys , zs) = (x ∷ ys , zs) +... | false | (ys , zs) = (ys , x ∷ zs) + +-- Version 0.16 + +boolTakeWhile : (A → Bool) → List A → List A +boolTakeWhile p [] = [] +boolTakeWhile p (x ∷ xs) with p x +... | true = x ∷ boolTakeWhile p xs +... | false = [] + +boolDropWhile : (A → Bool) → List A → List A +boolDropWhile p [] = [] +boolDropWhile p (x ∷ xs) with p x +... | true = boolDropWhile p xs +... | false = x ∷ xs + +boolSpan : (A → Bool) → List A → (List A × List A) +boolSpan p [] = ([] , []) +boolSpan p (x ∷ xs) with p x +... | true = Prod.map (x ∷_) id (boolSpan p xs) +... | false = ([] , x ∷ xs) + +boolBreak : (A → Bool) → List A → (List A × List A) +boolBreak p = boolSpan (not ∘ p) + +-- Version 1.4 + +infixl 5 _∷ʳ'_ +_∷ʳ'_ : (xs : List A) (x : A) → InitLast (xs ∷ʳ x) +_∷ʳ'_ = InitLast._∷ʳ′_ +{-# WARNING_ON_USAGE _∷ʳ'_ +"Warning: _∷ʳ'_ (ending in an apostrophe) was deprecated in v1.4. +Please use _∷ʳ′_ (ending in a prime) instead." +#-} +\ No newline at end of file diff --git a/docs/Data.List.html b/docs/Data.List.html new file mode 100644 index 0000000..93b52b3 --- /dev/null +++ b/docs/Data.List.html @@ -0,0 +1,19 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Lists +------------------------------------------------------------------------ + +-- See README.Data.List for examples of how to use and reason about +-- lists. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.List where + +------------------------------------------------------------------------ +-- Types and basic operations + +open import Data.List.Base public +\ No newline at end of file diff --git a/docs/Data.Maybe.Base.html b/docs/Data.Maybe.Base.html new file mode 100644 index 0000000..db1c1fe --- /dev/null +++ b/docs/Data.Maybe.Base.html @@ -0,0 +1,140 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- The Maybe type and some operations +------------------------------------------------------------------------ + +-- The definitions in this file are reexported by Data.Maybe. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Maybe.Base where + +open import Level +open import Data.Bool.Base using (Bool; true; false; not) +open import Data.Unit.Base using (⊤) +open import Data.These.Base using (These; this; that; these) +open import Data.Product as Prod using (_×_; _,_) +open import Function.Base +open import Relation.Nullary.Reflects +open import Relation.Nullary + +private + variable + a b c : Level + A : Set a + B : Set b + C : Set c + +------------------------------------------------------------------------ +-- Definition + +open import Agda.Builtin.Maybe public + using (Maybe; just; nothing) + +------------------------------------------------------------------------ +-- Some operations + +boolToMaybe : Bool → Maybe ⊤ +boolToMaybe true = just _ +boolToMaybe false = nothing + +is-just : Maybe A → Bool +is-just (just _) = true +is-just nothing = false + +is-nothing : Maybe A → Bool +is-nothing = not ∘ is-just + +decToMaybe : Dec A → Maybe A +decToMaybe ( true because [a]) = just (invert [a]) +decToMaybe (false because _ ) = nothing + +-- A dependent eliminator. + +maybe : ∀ {A : Set a} {B : Maybe A → Set b} → + ((x : A) → B (just x)) → B nothing → (x : Maybe A) → B x +maybe j n (just x) = j x +maybe j n nothing = n + +-- A non-dependent eliminator. + +maybe′ : (A → B) → B → Maybe A → B +maybe′ = maybe + +-- A defaulting mechanism + +fromMaybe : A → Maybe A → A +fromMaybe = maybe′ id + +-- A safe variant of "fromJust". If the value is nothing, then the +-- return type is the unit type. + +module _ {a} {A : Set a} where + + From-just : Maybe A → Set a + From-just (just _) = A + From-just nothing = Lift a ⊤ + + from-just : (x : Maybe A) → From-just x + from-just (just x) = x + from-just nothing = _ + +-- Functoriality: map + +map : (A → B) → Maybe A → Maybe B +map f = maybe (just ∘ f) nothing + +-- Applicative: ap + +ap : Maybe (A → B) → Maybe A → Maybe B +ap nothing = const nothing +ap (just f) = map f + +-- Monad: bind + +infixl 1 _>>=_ +_>>=_ : Maybe A → (A → Maybe B) → Maybe B +nothing >>= f = nothing +just a >>= f = f a + +-- Alternative: <∣> + +_<∣>_ : Maybe A → Maybe A → Maybe A +just x <∣> my = just x +nothing <∣> my = my + +-- Just when the boolean is true + +when : Bool → A → Maybe A +when b c = map (const c) (boolToMaybe b) + +------------------------------------------------------------------------ +-- Aligning and zipping + +alignWith : (These A B → C) → Maybe A → Maybe B → Maybe C +alignWith f (just a) (just b) = just (f (these a b)) +alignWith f (just a) nothing = just (f (this a)) +alignWith f nothing (just b) = just (f (that b)) +alignWith f nothing nothing = nothing + +zipWith : (A → B → C) → Maybe A → Maybe B → Maybe C +zipWith f (just a) (just b) = just (f a b) +zipWith _ _ _ = nothing + +align : Maybe A → Maybe B → Maybe (These A B) +align = alignWith id + +zip : Maybe A → Maybe B → Maybe (A × B) +zip = zipWith _,_ + +------------------------------------------------------------------------ +-- Injections. + +thisM : A → Maybe B → These A B +thisM a = maybe′ (these a) (this a) + +thatM : Maybe A → B → These A B +thatM = maybe′ these that +\ No newline at end of file diff --git a/docs/Data.Nat.Base.html b/docs/Data.Nat.Base.html new file mode 100644 index 0000000..5a198d6 --- /dev/null +++ b/docs/Data.Nat.Base.html @@ -0,0 +1,242 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Natural numbers, basic types and operations +------------------------------------------------------------------------ + +-- See README.Data.Nat for examples of how to use and reason about +-- naturals. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Nat.Base where + +open import Data.Bool.Base using (Bool; true; false) +open import Data.Empty using (⊥) +open import Data.Unit.Base using (⊤; tt) +open import Level using (0ℓ) +open import Relation.Binary.Core using (Rel) +open import Relation.Binary.PropositionalEquality.Core + using (_≡_; _≢_; refl) +open import Relation.Nullary using (¬_) +open import Relation.Nullary.Negation.Core using (contradiction) +open import Relation.Unary using (Pred) + +------------------------------------------------------------------------ +-- Types + +open import Agda.Builtin.Nat public + using (zero; suc) renaming (Nat to ℕ) + +------------------------------------------------------------------------ +-- Boolean equality relation + +open import Agda.Builtin.Nat public + using () renaming (_==_ to _≡ᵇ_) + +------------------------------------------------------------------------ +-- Boolean ordering relation + +open import Agda.Builtin.Nat public + using () renaming (_<_ to _<ᵇ_) + +infix 4 _≤ᵇ_ +_≤ᵇ_ : (m n : ℕ) → Bool +zero ≤ᵇ n = true +suc m ≤ᵇ n = m <ᵇ n + +------------------------------------------------------------------------ +-- Standard ordering relations + +infix 4 _≤_ _<_ _≥_ _>_ _≰_ _≮_ _≱_ _≯_ + +data _≤_ : Rel ℕ 0ℓ where + z≤n : ∀ {n} → zero ≤ n + s≤s : ∀ {m n} (m≤n : m ≤ n) → suc m ≤ suc n + +_<_ : Rel ℕ 0ℓ +m < n = suc m ≤ n + +_≥_ : Rel ℕ 0ℓ +m ≥ n = n ≤ m + +_>_ : Rel ℕ 0ℓ +m > n = n < m + +_≰_ : Rel ℕ 0ℓ +a ≰ b = ¬ a ≤ b + +_≮_ : Rel ℕ 0ℓ +a ≮ b = ¬ a < b + +_≱_ : Rel ℕ 0ℓ +a ≱ b = ¬ a ≥ b + +_≯_ : Rel ℕ 0ℓ +a ≯ b = ¬ a > b + +------------------------------------------------------------------------ +-- Simple predicates + +-- Defining `NonZero` in terms of `⊤` and `⊥` allows Agda to +-- automatically infer nonZero-ness for any natural of the form +-- `suc n`. Consequently in many circumstances this eliminates the need +-- to explicitly pass a proof when the NonZero argument is either an +-- implicit or an instance argument. +-- +-- It could alternatively be defined using a datatype with an instance +-- constructor but then it would not be inferrable when passed as an +-- implicit argument. +-- +-- See `Data.Nat.DivMod` for an example. + +NonZero : ℕ → Set +NonZero zero = ⊥ +NonZero (suc x) = ⊤ + +-- Constructors + +≢-nonZero : ∀ {n} → n ≢ 0 → NonZero n +≢-nonZero {zero} 0≢0 = 0≢0 refl +≢-nonZero {suc n} n≢0 = tt + +>-nonZero : ∀ {n} → n > 0 → NonZero n +>-nonZero (s≤s 0<n) = tt + +------------------------------------------------------------------------ +-- Arithmetic + +open import Agda.Builtin.Nat public + using (_+_; _*_) renaming (_-_ to _∸_) + +pred : ℕ → ℕ +pred n = n ∸ 1 + +infixl 7 _⊓_ +infixl 6 _+⋎_ _⊔_ + +-- Argument-swapping addition. Used by Data.Vec._⋎_. + +_+⋎_ : ℕ → ℕ → ℕ +zero +⋎ n = n +suc m +⋎ n = suc (n +⋎ m) + +-- Max. + +_⊔_ : ℕ → ℕ → ℕ +zero ⊔ n = n +suc m ⊔ zero = suc m +suc m ⊔ suc n = suc (m ⊔ n) + +-- Min. + +_⊓_ : ℕ → ℕ → ℕ +zero ⊓ n = zero +suc m ⊓ zero = zero +suc m ⊓ suc n = suc (m ⊓ n) + +-- Division by 2, rounded downwards. + +⌊_/2⌋ : ℕ → ℕ +⌊ 0 /2⌋ = 0 +⌊ 1 /2⌋ = 0 +⌊ suc (suc n) /2⌋ = suc ⌊ n /2⌋ + +-- Division by 2, rounded upwards. + +⌈_/2⌉ : ℕ → ℕ +⌈ n /2⌉ = ⌊ suc n /2⌋ + +-- Naïve exponentiation + +_^_ : ℕ → ℕ → ℕ +x ^ zero = 1 +x ^ suc n = x * x ^ n + +-- Distance + +∣_-_∣ : ℕ → ℕ → ℕ +∣ zero - y ∣ = y +∣ x - zero ∣ = x +∣ suc x - suc y ∣ = ∣ x - y ∣ + +------------------------------------------------------------------------ +-- Alternative definition of _≤_ + +-- The following definition of _≤_ is more suitable for well-founded +-- induction (see Data.Nat.Induction) + +infix 4 _≤′_ _<′_ _≥′_ _>′_ + +data _≤′_ (m : ℕ) : ℕ → Set where + ≤′-refl : m ≤′ m + ≤′-step : ∀ {n} (m≤′n : m ≤′ n) → m ≤′ suc n + +_<′_ : Rel ℕ 0ℓ +m <′ n = suc m ≤′ n + +_≥′_ : Rel ℕ 0ℓ +m ≥′ n = n ≤′ m + +_>′_ : Rel ℕ 0ℓ +m >′ n = n <′ m + +------------------------------------------------------------------------ +-- Another alternative definition of _≤_ + +record _≤″_ (m n : ℕ) : Set where + constructor less-than-or-equal + field + {k} : ℕ + proof : m + k ≡ n + +infix 4 _≤″_ _<″_ _≥″_ _>″_ + +_<″_ : Rel ℕ 0ℓ +m <″ n = suc m ≤″ n + +_≥″_ : Rel ℕ 0ℓ +m ≥″ n = n ≤″ m + +_>″_ : Rel ℕ 0ℓ +m >″ n = n <″ m + +------------------------------------------------------------------------ +-- Another alternative definition of _≤_ + +-- Useful for induction when you have an upper bound. + +data _≤‴_ : ℕ → ℕ → Set where + ≤‴-refl : ∀{m} → m ≤‴ m + ≤‴-step : ∀{m n} → suc m ≤‴ n → m ≤‴ n + +infix 4 _≤‴_ _<‴_ _≥‴_ _>‴_ + +_<‴_ : Rel ℕ 0ℓ +m <‴ n = suc m ≤‴ n + +_≥‴_ : Rel ℕ 0ℓ +m ≥‴ n = n ≤‴ m + +_>‴_ : Rel ℕ 0ℓ +m >‴ n = n <‴ m + +------------------------------------------------------------------------ +-- A comparison view. Taken from "View from the left" +-- (McBride/McKinna); details may differ. + +data Ordering : Rel ℕ 0ℓ where + less : ∀ m k → Ordering m (suc (m + k)) + equal : ∀ m → Ordering m m + greater : ∀ m k → Ordering (suc (m + k)) m + +compare : ∀ m n → Ordering m n +compare zero zero = equal zero +compare (suc m) zero = greater zero m +compare zero (suc n) = less zero n +compare (suc m) (suc n) with compare m n +... | less m k = less (suc m) k +... | equal m = equal (suc m) +... | greater n k = greater (suc n) k +\ No newline at end of file diff --git a/docs/Data.Nat.Properties.Core.html b/docs/Data.Nat.Properties.Core.html new file mode 100644 index 0000000..c3395de --- /dev/null +++ b/docs/Data.Nat.Properties.Core.html @@ -0,0 +1,20 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- ≤-pred definition so as to not cause dependency problems. +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Nat.Properties.Core where + +open import Data.Nat.Base + +------------------------------------------------------------------------ +-- Properties of _≤_ +------------------------------------------------------------------------ + +≤-pred : ∀ {m n} → suc m ≤ suc n → m ≤ n +≤-pred (s≤s m≤n) = m≤n +\ No newline at end of file diff --git a/docs/Data.Nat.Properties.html b/docs/Data.Nat.Properties.html new file mode 100644 index 0000000..d8a37af --- /dev/null +++ b/docs/Data.Nat.Properties.html @@ -0,0 +1,2397 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- A bunch of properties about natural number operations +------------------------------------------------------------------------ + +-- See README.Data.Nat for some examples showing how this module can be +-- used. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Nat.Properties where + +open import Axiom.UniquenessOfIdentityProofs +open import Algebra.Bundles +open import Algebra.Morphism +open import Algebra.Consequences.Propositional +open import Algebra.Construct.NaturalChoice.Base +import Algebra.Construct.NaturalChoice.MinMaxOp as MinMaxOp +import Algebra.Properties.CommutativeSemigroup as CommSemigroupProperties +open import Data.Bool.Base using (Bool; false; true; T) +open import Data.Bool.Properties using (T?) +open import Data.Empty using (⊥) +open import Data.Nat.Base +open import Data.Product using (_×_; _,_) +open import Data.Sum.Base as Sum +open import Data.Unit using (tt) +open import Function.Base +open import Function.Injection using (_↣_) +open import Function.Metric.Nat +open import Level using (0ℓ) +open import Relation.Binary +open import Relation.Binary.Consequences using (flip-Connex) +open import Relation.Binary.PropositionalEquality +open import Relation.Nullary hiding (Irrelevant) +open import Relation.Nullary.Decidable using (True; via-injection; map′) +open import Relation.Nullary.Negation using (contradiction) +open import Relation.Nullary.Reflects using (fromEquivalence) + +open import Algebra.Definitions {A = ℕ} _≡_ + hiding (LeftCancellative; RightCancellative; Cancellative) +open import Algebra.Definitions + using (LeftCancellative; RightCancellative; Cancellative) +open import Algebra.Structures {A = ℕ} _≡_ + +------------------------------------------------------------------------ +-- Properties of _≡_ +------------------------------------------------------------------------ + +suc-injective : ∀ {m n} → suc m ≡ suc n → m ≡ n +suc-injective refl = refl + +≡ᵇ⇒≡ : ∀ m n → T (m ≡ᵇ n) → m ≡ n +≡ᵇ⇒≡ zero zero _ = refl +≡ᵇ⇒≡ (suc m) (suc n) eq = cong suc (≡ᵇ⇒≡ m n eq) + +≡⇒≡ᵇ : ∀ m n → m ≡ n → T (m ≡ᵇ n) +≡⇒≡ᵇ zero zero eq = _ +≡⇒≡ᵇ (suc m) (suc n) eq = ≡⇒≡ᵇ m n (suc-injective eq) + +-- NB: we use the builtin function `_≡ᵇ_` here so that the function +-- quickly decides whether to return `yes` or `no`. It still takes +-- a linear amount of time to generate the proof if it is inspected. +-- We expect the main benefit to be visible in compiled code as the +-- backend erases proofs. + +infix 4 _≟_ +_≟_ : Decidable {A = ℕ} _≡_ +m ≟ n = map′ (≡ᵇ⇒≡ m n) (≡⇒≡ᵇ m n) (T? (m ≡ᵇ n)) + +≡-irrelevant : Irrelevant {A = ℕ} _≡_ +≡-irrelevant = Decidable⇒UIP.≡-irrelevant _≟_ + +≟-diag : ∀ {m n} (eq : m ≡ n) → (m ≟ n) ≡ yes eq +≟-diag = ≡-≟-identity _≟_ + +≡-isDecEquivalence : IsDecEquivalence (_≡_ {A = ℕ}) +≡-isDecEquivalence = record + { isEquivalence = isEquivalence + ; _≟_ = _≟_ + } + +≡-decSetoid : DecSetoid 0ℓ 0ℓ +≡-decSetoid = record + { Carrier = ℕ + ; _≈_ = _≡_ + ; isDecEquivalence = ≡-isDecEquivalence + } + +0≢1+n : ∀ {n} → 0 ≢ suc n +0≢1+n () + +1+n≢0 : ∀ {n} → suc n ≢ 0 +1+n≢0 () + +1+n≢n : ∀ {n} → suc n ≢ n +1+n≢n {suc n} = 1+n≢n ∘ suc-injective + +------------------------------------------------------------------------ +-- Properties of _<ᵇ_ +------------------------------------------------------------------------ + +<ᵇ⇒< : ∀ m n → T (m <ᵇ n) → m < n +<ᵇ⇒< zero (suc n) m<n = s≤s z≤n +<ᵇ⇒< (suc m) (suc n) m<n = s≤s (<ᵇ⇒< m n m<n) + +<⇒<ᵇ : ∀ {m n} → m < n → T (m <ᵇ n) +<⇒<ᵇ (s≤s z≤n) = tt +<⇒<ᵇ (s≤s (s≤s m<n)) = <⇒<ᵇ (s≤s m<n) + +<ᵇ-reflects-< : ∀ m n → Reflects (m < n) (m <ᵇ n) +<ᵇ-reflects-< m n = fromEquivalence (<ᵇ⇒< m n) <⇒<ᵇ + +------------------------------------------------------------------------ +-- Properties of _≤ᵇ_ +------------------------------------------------------------------------ + +≤ᵇ⇒≤ : ∀ m n → T (m ≤ᵇ n) → m ≤ n +≤ᵇ⇒≤ zero n m≤n = z≤n +≤ᵇ⇒≤ (suc m) n m≤n = <ᵇ⇒< m n m≤n + +≤⇒≤ᵇ : ∀ {m n} → m ≤ n → T (m ≤ᵇ n) +≤⇒≤ᵇ z≤n = tt +≤⇒≤ᵇ m≤n@(s≤s _) = <⇒<ᵇ m≤n + +≤ᵇ-reflects-≤ : ∀ m n → Reflects (m ≤ n) (m ≤ᵇ n) +≤ᵇ-reflects-≤ m n = fromEquivalence (≤ᵇ⇒≤ m n) ≤⇒≤ᵇ + +------------------------------------------------------------------------ +-- Properties of _≤_ +------------------------------------------------------------------------ + +open import Data.Nat.Properties.Core public + +------------------------------------------------------------------------ +-- Relational properties of _≤_ + +≤-reflexive : _≡_ ⇒ _≤_ +≤-reflexive {zero} refl = z≤n +≤-reflexive {suc m} refl = s≤s (≤-reflexive refl) + +≤-refl : Reflexive _≤_ +≤-refl = ≤-reflexive refl + +≤-antisym : Antisymmetric _≡_ _≤_ +≤-antisym z≤n z≤n = refl +≤-antisym (s≤s m≤n) (s≤s n≤m) = cong suc (≤-antisym m≤n n≤m) + +≤-trans : Transitive _≤_ +≤-trans z≤n _ = z≤n +≤-trans (s≤s m≤n) (s≤s n≤o) = s≤s (≤-trans m≤n n≤o) + +≤-total : Total _≤_ +≤-total zero _ = inj₁ z≤n +≤-total _ zero = inj₂ z≤n +≤-total (suc m) (suc n) with ≤-total m n +... | inj₁ m≤n = inj₁ (s≤s m≤n) +... | inj₂ n≤m = inj₂ (s≤s n≤m) + +≤-irrelevant : Irrelevant _≤_ +≤-irrelevant z≤n z≤n = refl +≤-irrelevant (s≤s m≤n₁) (s≤s m≤n₂) = cong s≤s (≤-irrelevant m≤n₁ m≤n₂) + +-- NB: we use the builtin function `_<ᵇ_` here so that the function +-- quickly decides whether to return `yes` or `no`. It still takes +-- a linear amount of time to generate the proof if it is inspected. +-- We expect the main benefit to be visible in compiled code as the +-- backend erases proofs. + +infix 4 _≤?_ _≥?_ + +_≤?_ : Decidable _≤_ +m ≤? n = map′ (≤ᵇ⇒≤ m n) ≤⇒≤ᵇ (T? (m ≤ᵇ n)) + +_≥?_ : Decidable _≥_ +_≥?_ = flip _≤?_ + +------------------------------------------------------------------------ +-- Structures + +≤-isPreorder : IsPreorder _≡_ _≤_ +≤-isPreorder = record + { isEquivalence = isEquivalence + ; reflexive = ≤-reflexive + ; trans = ≤-trans + } + +≤-isTotalPreorder : IsTotalPreorder _≡_ _≤_ +≤-isTotalPreorder = record + { isPreorder = ≤-isPreorder + ; total = ≤-total + } + +≤-isPartialOrder : IsPartialOrder _≡_ _≤_ +≤-isPartialOrder = record + { isPreorder = ≤-isPreorder + ; antisym = ≤-antisym + } + +≤-isTotalOrder : IsTotalOrder _≡_ _≤_ +≤-isTotalOrder = record + { isPartialOrder = ≤-isPartialOrder + ; total = ≤-total + } + +≤-isDecTotalOrder : IsDecTotalOrder _≡_ _≤_ +≤-isDecTotalOrder = record + { isTotalOrder = ≤-isTotalOrder + ; _≟_ = _≟_ + ; _≤?_ = _≤?_ + } + +------------------------------------------------------------------------ +-- Bundles + +≤-preorder : Preorder 0ℓ 0ℓ 0ℓ +≤-preorder = record + { isPreorder = ≤-isPreorder + } + +≤-totalPreorder : TotalPreorder 0ℓ 0ℓ 0ℓ +≤-totalPreorder = record + { isTotalPreorder = ≤-isTotalPreorder + } + +≤-poset : Poset 0ℓ 0ℓ 0ℓ +≤-poset = record + { isPartialOrder = ≤-isPartialOrder + } + +≤-totalOrder : TotalOrder 0ℓ 0ℓ 0ℓ +≤-totalOrder = record + { isTotalOrder = ≤-isTotalOrder + } + +≤-decTotalOrder : DecTotalOrder 0ℓ 0ℓ 0ℓ +≤-decTotalOrder = record + { isDecTotalOrder = ≤-isDecTotalOrder + } + +------------------------------------------------------------------------ +-- Other properties of _≤_ + +s≤s-injective : ∀ {m n} {p q : m ≤ n} → s≤s p ≡ s≤s q → p ≡ q +s≤s-injective refl = refl + +≤-step : ∀ {m n} → m ≤ n → m ≤ 1 + n +≤-step z≤n = z≤n +≤-step (s≤s m≤n) = s≤s (≤-step m≤n) + +n≤1+n : ∀ n → n ≤ 1 + n +n≤1+n _ = ≤-step ≤-refl + +1+n≰n : ∀ {n} → 1 + n ≰ n +1+n≰n (s≤s le) = 1+n≰n le + +n≤0⇒n≡0 : ∀ {n} → n ≤ 0 → n ≡ 0 +n≤0⇒n≡0 z≤n = refl + +------------------------------------------------------------------------ +-- Properties of _<_ +------------------------------------------------------------------------ + +-- Relationships between the various relations + +<⇒≤ : _<_ ⇒ _≤_ +<⇒≤ (s≤s m≤n) = ≤-trans m≤n (≤-step ≤-refl) + +<⇒≢ : _<_ ⇒ _≢_ +<⇒≢ m<n refl = 1+n≰n m<n + +>⇒≢ : _>_ ⇒ _≢_ +>⇒≢ = ≢-sym ∘ <⇒≢ + +≤⇒≯ : _≤_ ⇒ _≯_ +≤⇒≯ (s≤s m≤n) (s≤s n≤m) = ≤⇒≯ m≤n n≤m + +<⇒≱ : _<_ ⇒ _≱_ +<⇒≱ (s≤s m+1≤n) (s≤s n≤m) = <⇒≱ m+1≤n n≤m + +<⇒≯ : _<_ ⇒ _≯_ +<⇒≯ (s≤s m<n) (s≤s n<m) = <⇒≯ m<n n<m + +≰⇒≮ : _≰_ ⇒ _≮_ +≰⇒≮ m≰n 1+m≤n = m≰n (<⇒≤ 1+m≤n) + +≰⇒> : _≰_ ⇒ _>_ +≰⇒> {zero} z≰n = contradiction z≤n z≰n +≰⇒> {suc m} {zero} _ = s≤s z≤n +≰⇒> {suc m} {suc n} m≰n = s≤s (≰⇒> (m≰n ∘ s≤s)) + +≰⇒≥ : _≰_ ⇒ _≥_ +≰⇒≥ = <⇒≤ ∘ ≰⇒> + +≮⇒≥ : _≮_ ⇒ _≥_ +≮⇒≥ {_} {zero} _ = z≤n +≮⇒≥ {zero} {suc j} 1≮j+1 = contradiction (s≤s z≤n) 1≮j+1 +≮⇒≥ {suc i} {suc j} i+1≮j+1 = s≤s (≮⇒≥ (i+1≮j+1 ∘ s≤s)) + +≤∧≢⇒< : ∀ {m n} → m ≤ n → m ≢ n → m < n +≤∧≢⇒< {_} {zero} z≤n m≢n = contradiction refl m≢n +≤∧≢⇒< {_} {suc n} z≤n m≢n = s≤s z≤n +≤∧≢⇒< {_} {suc n} (s≤s m≤n) 1+m≢1+n = + s≤s (≤∧≢⇒< m≤n (1+m≢1+n ∘ cong suc)) + +≤∧≮⇒≡ : ∀ {m n} → m ≤ n → m ≮ n → m ≡ n +≤∧≮⇒≡ m≤n m≮n = ≤-antisym m≤n (≮⇒≥ m≮n) + +≤-<-connex : Connex _≤_ _<_ +≤-<-connex m n with m ≤? n +... | yes m≤n = inj₁ m≤n +... | no ¬m≤n = inj₂ (≰⇒> ¬m≤n) + +≥->-connex : Connex _≥_ _>_ +≥->-connex = flip ≤-<-connex + +<-≤-connex : Connex _<_ _≤_ +<-≤-connex = flip-Connex ≤-<-connex + +>-≥-connex : Connex _>_ _≥_ +>-≥-connex = flip-Connex ≥->-connex + +------------------------------------------------------------------------ +-- Relational properties of _<_ + +<-irrefl : Irreflexive _≡_ _<_ +<-irrefl refl (s≤s n<n) = <-irrefl refl n<n + +<-asym : Asymmetric _<_ +<-asym (s≤s n<m) (s≤s m<n) = <-asym n<m m<n + +<-trans : Transitive _<_ +<-trans (s≤s i≤j) (s≤s j<k) = s≤s (≤-trans i≤j (≤-trans (n≤1+n _) j<k)) + +<-transʳ : Trans _≤_ _<_ _<_ +<-transʳ m≤n (s≤s n≤o) = s≤s (≤-trans m≤n n≤o) + +<-transˡ : Trans _<_ _≤_ _<_ +<-transˡ (s≤s m≤n) (s≤s n≤o) = s≤s (≤-trans m≤n n≤o) + +-- NB: we use the builtin function `_<ᵇ_` here so that the function +-- quickly decides which constructor to return. It still takes a +-- linear amount of time to generate the proof if it is inspected. +-- We expect the main benefit to be visible in compiled code as the +-- backend erases proofs. + +<-cmp : Trichotomous _≡_ _<_ +<-cmp m n with m ≟ n | T? (m <ᵇ n) +... | yes m≡n | _ = tri≈ (<-irrefl m≡n) m≡n (<-irrefl (sym m≡n)) +... | no m≢n | yes m<n = tri< (<ᵇ⇒< m n m<n) m≢n (<⇒≯ (<ᵇ⇒< m n m<n)) +... | no m≢n | no m≮n = tri> (m≮n ∘ <⇒<ᵇ) m≢n (≤∧≢⇒< (≮⇒≥ (m≮n ∘ <⇒<ᵇ)) (m≢n ∘ sym)) + +infix 4 _<?_ _>?_ + +_<?_ : Decidable _<_ +m <? n = suc m ≤? n + +_>?_ : Decidable _>_ +_>?_ = flip _<?_ + +<-irrelevant : Irrelevant _<_ +<-irrelevant = ≤-irrelevant + +<-resp₂-≡ : _<_ Respects₂ _≡_ +<-resp₂-≡ = subst (_ <_) , subst (_< _) + +------------------------------------------------------------------------ +-- Bundles + +<-isStrictPartialOrder : IsStrictPartialOrder _≡_ _<_ +<-isStrictPartialOrder = record + { isEquivalence = isEquivalence + ; irrefl = <-irrefl + ; trans = <-trans + ; <-resp-≈ = <-resp₂-≡ + } + +<-isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_ +<-isStrictTotalOrder = record + { isEquivalence = isEquivalence + ; trans = <-trans + ; compare = <-cmp + } + +<-strictPartialOrder : StrictPartialOrder 0ℓ 0ℓ 0ℓ +<-strictPartialOrder = record + { isStrictPartialOrder = <-isStrictPartialOrder + } + +<-strictTotalOrder : StrictTotalOrder 0ℓ 0ℓ 0ℓ +<-strictTotalOrder = record + { isStrictTotalOrder = <-isStrictTotalOrder + } + +------------------------------------------------------------------------ +-- Other properties of _<_ + +n≮n : ∀ n → n ≮ n +n≮n n = <-irrefl (refl {x = n}) + +0<1+n : ∀ {n} → 0 < suc n +0<1+n = s≤s z≤n + +n<1+n : ∀ n → n < suc n +n<1+n n = ≤-refl + +n<1⇒n≡0 : ∀ {n} → n < 1 → n ≡ 0 +n<1⇒n≡0 (s≤s n≤0) = n≤0⇒n≡0 n≤0 + +n≢0⇒n>0 : ∀ {n} → n ≢ 0 → n > 0 +n≢0⇒n>0 {zero} 0≢0 = contradiction refl 0≢0 +n≢0⇒n>0 {suc n} _ = 0<1+n + +m<n⇒0<n : ∀ {m n} → m < n → 0 < n +m<n⇒0<n = ≤-trans 0<1+n + +m<n⇒n≢0 : ∀ {m n} → m < n → n ≢ 0 +m<n⇒n≢0 (s≤s m≤n) () + +m<n⇒m≤1+n : ∀ {m n} → m < n → m ≤ suc n +m<n⇒m≤1+n = ≤-step ∘ <⇒≤ + +∀[m≤n⇒m≢o]⇒n<o : ∀ n o → (∀ {m} → m ≤ n → m ≢ o) → n < o +∀[m≤n⇒m≢o]⇒n<o _ zero m≤n⇒n≢0 = contradiction refl (m≤n⇒n≢0 z≤n) +∀[m≤n⇒m≢o]⇒n<o zero (suc o) _ = 0<1+n +∀[m≤n⇒m≢o]⇒n<o (suc n) (suc o) m≤n⇒n≢o = s≤s (∀[m≤n⇒m≢o]⇒n<o n o rec) + where + rec : ∀ {m} → m ≤ n → m ≢ o + rec m≤n refl = m≤n⇒n≢o (s≤s m≤n) refl + +∀[m<n⇒m≢o]⇒n≤o : ∀ n o → (∀ {m} → m < n → m ≢ o) → n ≤ o +∀[m<n⇒m≢o]⇒n≤o zero n _ = z≤n +∀[m<n⇒m≢o]⇒n≤o (suc n) zero m<n⇒m≢0 = contradiction refl (m<n⇒m≢0 0<1+n) +∀[m<n⇒m≢o]⇒n≤o (suc n) (suc o) m<n⇒m≢o = s≤s (∀[m<n⇒m≢o]⇒n≤o n o rec) + where + rec : ∀ {m} → m < n → m ≢ o + rec x<m refl = m<n⇒m≢o (s≤s x<m) refl + +------------------------------------------------------------------------ +-- A module for reasoning about the _≤_ and _<_ relations +------------------------------------------------------------------------ + +module ≤-Reasoning where + open import Relation.Binary.Reasoning.Base.Triple + ≤-isPreorder + <-trans + (resp₂ _<_) + <⇒≤ + <-transˡ + <-transʳ + public + hiding (step-≈; step-≈˘) + +open ≤-Reasoning + +------------------------------------------------------------------------ +-- Properties of _+_ +------------------------------------------------------------------------ + ++-suc : ∀ m n → m + suc n ≡ suc (m + n) ++-suc zero n = refl ++-suc (suc m) n = cong suc (+-suc m n) + +------------------------------------------------------------------------ +-- Algebraic properties of _+_ + ++-assoc : Associative _+_ ++-assoc zero _ _ = refl ++-assoc (suc m) n o = cong suc (+-assoc m n o) + ++-identityˡ : LeftIdentity 0 _+_ ++-identityˡ _ = refl + ++-identityʳ : RightIdentity 0 _+_ ++-identityʳ zero = refl ++-identityʳ (suc n) = cong suc (+-identityʳ n) + ++-identity : Identity 0 _+_ ++-identity = +-identityˡ , +-identityʳ + ++-comm : Commutative _+_ ++-comm zero n = sym (+-identityʳ n) ++-comm (suc m) n = begin-equality + suc m + n ≡⟨⟩ + suc (m + n) ≡⟨ cong suc (+-comm m n) ⟩ + suc (n + m) ≡⟨ sym (+-suc n m) ⟩ + n + suc m ∎ + ++-cancelˡ-≡ : LeftCancellative _≡_ _+_ ++-cancelˡ-≡ zero eq = eq ++-cancelˡ-≡ (suc m) eq = +-cancelˡ-≡ m (cong pred eq) + ++-cancelʳ-≡ : RightCancellative _≡_ _+_ ++-cancelʳ-≡ = comm+cancelˡ⇒cancelʳ +-comm +-cancelˡ-≡ + ++-cancel-≡ : Cancellative _≡_ _+_ ++-cancel-≡ = +-cancelˡ-≡ , +-cancelʳ-≡ + +------------------------------------------------------------------------ +-- Structures + ++-isMagma : IsMagma _+_ ++-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = cong₂ _+_ + } + ++-isSemigroup : IsSemigroup _+_ ++-isSemigroup = record + { isMagma = +-isMagma + ; assoc = +-assoc + } + ++-isCommutativeSemigroup : IsCommutativeSemigroup _+_ ++-isCommutativeSemigroup = record + { isSemigroup = +-isSemigroup + ; comm = +-comm + } + ++-0-isMonoid : IsMonoid _+_ 0 ++-0-isMonoid = record + { isSemigroup = +-isSemigroup + ; identity = +-identity + } + ++-0-isCommutativeMonoid : IsCommutativeMonoid _+_ 0 ++-0-isCommutativeMonoid = record + { isMonoid = +-0-isMonoid + ; comm = +-comm + } + +------------------------------------------------------------------------ +-- Raw bundles + ++-rawMagma : RawMagma 0ℓ 0ℓ ++-rawMagma = record + { _≈_ = _≡_ + ; _∙_ = _+_ + } + ++-0-rawMonoid : RawMonoid 0ℓ 0ℓ ++-0-rawMonoid = record + { _≈_ = _≡_ + ; _∙_ = _+_ + ; ε = 0 + } + +------------------------------------------------------------------------ +-- Bundles + ++-magma : Magma 0ℓ 0ℓ ++-magma = record + { isMagma = +-isMagma + } + ++-semigroup : Semigroup 0ℓ 0ℓ ++-semigroup = record + { isSemigroup = +-isSemigroup + } + ++-commutativeSemigroup : CommutativeSemigroup 0ℓ 0ℓ ++-commutativeSemigroup = record + { isCommutativeSemigroup = +-isCommutativeSemigroup + } + ++-0-monoid : Monoid 0ℓ 0ℓ ++-0-monoid = record + { isMonoid = +-0-isMonoid + } + ++-0-commutativeMonoid : CommutativeMonoid 0ℓ 0ℓ ++-0-commutativeMonoid = record + { isCommutativeMonoid = +-0-isCommutativeMonoid + } + +∸-magma : Magma 0ℓ 0ℓ +∸-magma = magma _∸_ + + +------------------------------------------------------------------------ +-- Other properties of _+_ and _≡_ + +m≢1+m+n : ∀ m {n} → m ≢ suc (m + n) +m≢1+m+n (suc m) eq = m≢1+m+n m (cong pred eq) + +m≢1+n+m : ∀ m {n} → m ≢ suc (n + m) +m≢1+n+m m m≡1+n+m = m≢1+m+n m (trans m≡1+n+m (cong suc (+-comm _ m))) + +m+1+n≢m : ∀ m {n} → m + suc n ≢ m +m+1+n≢m (suc m) = (m+1+n≢m m) ∘ suc-injective + +m+1+n≢0 : ∀ m {n} → m + suc n ≢ 0 +m+1+n≢0 m {n} rewrite +-suc m n = λ() + +m+n≡0⇒m≡0 : ∀ m {n} → m + n ≡ 0 → m ≡ 0 +m+n≡0⇒m≡0 zero eq = refl + +m+n≡0⇒n≡0 : ∀ m {n} → m + n ≡ 0 → n ≡ 0 +m+n≡0⇒n≡0 m {n} m+n≡0 = m+n≡0⇒m≡0 n (trans (+-comm n m) (m+n≡0)) + +------------------------------------------------------------------------ +-- Properties of _+_ and _≤_/_<_ + ++-cancelˡ-≤ : LeftCancellative _≤_ _+_ ++-cancelˡ-≤ zero le = le ++-cancelˡ-≤ (suc m) (s≤s le) = +-cancelˡ-≤ m le + ++-cancelʳ-≤ : RightCancellative _≤_ _+_ ++-cancelʳ-≤ {m} n o le = + +-cancelˡ-≤ m (subst₂ _≤_ (+-comm n m) (+-comm o m) le) + ++-cancel-≤ : Cancellative _≤_ _+_ ++-cancel-≤ = +-cancelˡ-≤ , +-cancelʳ-≤ + ++-cancelˡ-< : LeftCancellative _<_ _+_ ++-cancelˡ-< m {n} {o} = +-cancelˡ-≤ m ∘ subst (_≤ m + o) (sym (+-suc m n)) + ++-cancelʳ-< : RightCancellative _<_ _+_ ++-cancelʳ-< n o n+m<o+m = +-cancelʳ-≤ (suc n) o n+m<o+m + ++-cancel-< : Cancellative _<_ _+_ ++-cancel-< = +-cancelˡ-< , +-cancelʳ-< + +≤-stepsˡ : ∀ {m n} o → m ≤ n → m ≤ o + n +≤-stepsˡ zero m≤n = m≤n +≤-stepsˡ (suc o) m≤n = ≤-step (≤-stepsˡ o m≤n) + +≤-stepsʳ : ∀ {m n} o → m ≤ n → m ≤ n + o +≤-stepsʳ {m} o m≤n = subst (m ≤_) (+-comm o _) (≤-stepsˡ o m≤n) + +m≤m+n : ∀ m n → m ≤ m + n +m≤m+n zero n = z≤n +m≤m+n (suc m) n = s≤s (m≤m+n m n) + +m≤n+m : ∀ m n → m ≤ n + m +m≤n+m m n = subst (m ≤_) (+-comm m n) (m≤m+n m n) + +m≤n⇒m<n∨m≡n : ∀ {m n} → m ≤ n → m < n ⊎ m ≡ n +m≤n⇒m<n∨m≡n {0} {0} _ = inj₂ refl +m≤n⇒m<n∨m≡n {0} {suc n} _ = inj₁ 0<1+n +m≤n⇒m<n∨m≡n {suc m} {suc n} (s≤s m≤n) with m≤n⇒m<n∨m≡n m≤n +... | inj₂ m≡n = inj₂ (cong suc m≡n) +... | inj₁ m<n = inj₁ (s≤s m<n) + +m+n≤o⇒m≤o : ∀ m {n o} → m + n ≤ o → m ≤ o +m+n≤o⇒m≤o zero m+n≤o = z≤n +m+n≤o⇒m≤o (suc m) (s≤s m+n≤o) = s≤s (m+n≤o⇒m≤o m m+n≤o) + +m+n≤o⇒n≤o : ∀ m {n o} → m + n ≤ o → n ≤ o +m+n≤o⇒n≤o zero n≤o = n≤o +m+n≤o⇒n≤o (suc m) m+n<o = m+n≤o⇒n≤o m (<⇒≤ m+n<o) + ++-mono-≤ : _+_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ++-mono-≤ {_} {m} z≤n o≤p = ≤-trans o≤p (m≤n+m _ m) ++-mono-≤ {_} {_} (s≤s m≤n) o≤p = s≤s (+-mono-≤ m≤n o≤p) + ++-monoˡ-≤ : ∀ n → (_+ n) Preserves _≤_ ⟶ _≤_ ++-monoˡ-≤ n m≤o = +-mono-≤ m≤o (≤-refl {n}) + ++-monoʳ-≤ : ∀ n → (n +_) Preserves _≤_ ⟶ _≤_ ++-monoʳ-≤ n m≤o = +-mono-≤ (≤-refl {n}) m≤o + ++-mono-<-≤ : _+_ Preserves₂ _<_ ⟶ _≤_ ⟶ _<_ ++-mono-<-≤ {_} {suc n} (s≤s z≤n) o≤p = s≤s (≤-stepsˡ n o≤p) ++-mono-<-≤ {_} {_} (s≤s (s≤s m<n)) o≤p = s≤s (+-mono-<-≤ (s≤s m<n) o≤p) + ++-mono-≤-< : _+_ Preserves₂ _≤_ ⟶ _<_ ⟶ _<_ ++-mono-≤-< {_} {n} z≤n o<p = ≤-trans o<p (m≤n+m _ n) ++-mono-≤-< {_} {_} (s≤s m≤n) o<p = s≤s (+-mono-≤-< m≤n o<p) + ++-mono-< : _+_ Preserves₂ _<_ ⟶ _<_ ⟶ _<_ ++-mono-< m≤n = +-mono-≤-< (<⇒≤ m≤n) + ++-monoˡ-< : ∀ n → (_+ n) Preserves _<_ ⟶ _<_ ++-monoˡ-< n = +-monoˡ-≤ n + ++-monoʳ-< : ∀ n → (n +_) Preserves _<_ ⟶ _<_ ++-monoʳ-< zero m≤o = m≤o ++-monoʳ-< (suc n) m≤o = s≤s (+-monoʳ-< n m≤o) + +m+1+n≰m : ∀ m {n} → m + suc n ≰ m +m+1+n≰m (suc m) le = m+1+n≰m m (≤-pred le) + +m<m+n : ∀ m {n} → n > 0 → m < m + n +m<m+n zero n>0 = n>0 +m<m+n (suc m) n>0 = s≤s (m<m+n m n>0) + +m<n+m : ∀ m {n} → n > 0 → m < n + m +m<n+m m {n} n>0 rewrite +-comm n m = m<m+n m n>0 + +m+n≮n : ∀ m n → m + n ≮ n +m+n≮n zero n = n≮n n +m+n≮n (suc m) (suc n) (s≤s m+n<n) = m+n≮n m (suc n) (≤-step m+n<n) + +m+n≮m : ∀ m n → m + n ≮ m +m+n≮m m n = subst (_≮ m) (+-comm n m) (m+n≮n n m) + +------------------------------------------------------------------------ +-- Properties of _*_ +------------------------------------------------------------------------ + +*-suc : ∀ m n → m * suc n ≡ m + m * n +*-suc zero n = refl +*-suc (suc m) n = begin-equality + suc m * suc n ≡⟨⟩ + suc n + m * suc n ≡⟨ cong (suc n +_) (*-suc m n) ⟩ + suc n + (m + m * n) ≡⟨⟩ + suc (n + (m + m * n)) ≡⟨ cong suc (sym (+-assoc n m (m * n))) ⟩ + suc (n + m + m * n) ≡⟨ cong (λ x → suc (x + m * n)) (+-comm n m) ⟩ + suc (m + n + m * n) ≡⟨ cong suc (+-assoc m n (m * n)) ⟩ + suc (m + (n + m * n)) ≡⟨⟩ + suc m + suc m * n ∎ + +------------------------------------------------------------------------ +-- Algebraic properties of _*_ + +*-identityˡ : LeftIdentity 1 _*_ +*-identityˡ n = +-identityʳ n + +*-identityʳ : RightIdentity 1 _*_ +*-identityʳ zero = refl +*-identityʳ (suc n) = cong suc (*-identityʳ n) + +*-identity : Identity 1 _*_ +*-identity = *-identityˡ , *-identityʳ + +*-zeroˡ : LeftZero 0 _*_ +*-zeroˡ _ = refl + +*-zeroʳ : RightZero 0 _*_ +*-zeroʳ zero = refl +*-zeroʳ (suc n) = *-zeroʳ n + +*-zero : Zero 0 _*_ +*-zero = *-zeroˡ , *-zeroʳ + +*-comm : Commutative _*_ +*-comm zero n = sym (*-zeroʳ n) +*-comm (suc m) n = begin-equality + suc m * n ≡⟨⟩ + n + m * n ≡⟨ cong (n +_) (*-comm m n) ⟩ + n + n * m ≡⟨ sym (*-suc n m) ⟩ + n * suc m ∎ + +*-distribʳ-+ : _*_ DistributesOverʳ _+_ +*-distribʳ-+ m zero o = refl +*-distribʳ-+ m (suc n) o = begin-equality + (suc n + o) * m ≡⟨⟩ + m + (n + o) * m ≡⟨ cong (m +_) (*-distribʳ-+ m n o) ⟩ + m + (n * m + o * m) ≡⟨ sym (+-assoc m (n * m) (o * m)) ⟩ + m + n * m + o * m ≡⟨⟩ + suc n * m + o * m ∎ + +*-distribˡ-+ : _*_ DistributesOverˡ _+_ +*-distribˡ-+ = comm+distrʳ⇒distrˡ *-comm *-distribʳ-+ + +*-distrib-+ : _*_ DistributesOver _+_ +*-distrib-+ = *-distribˡ-+ , *-distribʳ-+ + +*-assoc : Associative _*_ +*-assoc zero n o = refl +*-assoc (suc m) n o = begin-equality + (suc m * n) * o ≡⟨⟩ + (n + m * n) * o ≡⟨ *-distribʳ-+ o n (m * n) ⟩ + n * o + (m * n) * o ≡⟨ cong (n * o +_) (*-assoc m n o) ⟩ + n * o + m * (n * o) ≡⟨⟩ + suc m * (n * o) ∎ + +------------------------------------------------------------------------ +-- Structures + +*-isMagma : IsMagma _*_ +*-isMagma = record + { isEquivalence = isEquivalence + ; ∙-cong = cong₂ _*_ + } + +*-isSemigroup : IsSemigroup _*_ +*-isSemigroup = record + { isMagma = *-isMagma + ; assoc = *-assoc + } + +*-isCommutativeSemigroup : IsCommutativeSemigroup _*_ +*-isCommutativeSemigroup = record + { isSemigroup = *-isSemigroup + ; comm = *-comm + } + +*-1-isMonoid : IsMonoid _*_ 1 +*-1-isMonoid = record + { isSemigroup = *-isSemigroup + ; identity = *-identity + } + +*-1-isCommutativeMonoid : IsCommutativeMonoid _*_ 1 +*-1-isCommutativeMonoid = record + { isMonoid = *-1-isMonoid + ; comm = *-comm + } + ++-*-isSemiring : IsSemiring _+_ _*_ 0 1 ++-*-isSemiring = record + { isSemiringWithoutAnnihilatingZero = record + { +-isCommutativeMonoid = +-0-isCommutativeMonoid + ; *-isMonoid = *-1-isMonoid + ; distrib = *-distrib-+ + } + ; zero = *-zero + } + ++-*-isCommutativeSemiring : IsCommutativeSemiring _+_ _*_ 0 1 ++-*-isCommutativeSemiring = record + { isSemiring = +-*-isSemiring + ; *-comm = *-comm + } + +------------------------------------------------------------------------ +-- Bundles + +*-rawMagma : RawMagma 0ℓ 0ℓ +*-rawMagma = record + { _≈_ = _≡_ + ; _∙_ = _*_ + } + +*-1-rawMonoid : RawMonoid 0ℓ 0ℓ +*-1-rawMonoid = record + { _≈_ = _≡_ + ; _∙_ = _*_ + ; ε = 1 + } + +*-magma : Magma 0ℓ 0ℓ +*-magma = record + { isMagma = *-isMagma + } + +*-semigroup : Semigroup 0ℓ 0ℓ +*-semigroup = record + { isSemigroup = *-isSemigroup + } + +*-commutativeSemigroup : CommutativeSemigroup 0ℓ 0ℓ +*-commutativeSemigroup = record + { isCommutativeSemigroup = *-isCommutativeSemigroup + } + +*-1-monoid : Monoid 0ℓ 0ℓ +*-1-monoid = record + { isMonoid = *-1-isMonoid + } + +*-1-commutativeMonoid : CommutativeMonoid 0ℓ 0ℓ +*-1-commutativeMonoid = record + { isCommutativeMonoid = *-1-isCommutativeMonoid + } + ++-*-semiring : Semiring 0ℓ 0ℓ ++-*-semiring = record + { isSemiring = +-*-isSemiring + } + ++-*-commutativeSemiring : CommutativeSemiring 0ℓ 0ℓ ++-*-commutativeSemiring = record + { isCommutativeSemiring = +-*-isCommutativeSemiring + } + +------------------------------------------------------------------------ +-- Other properties of _*_ and _≡_ + +*-cancelʳ-≡ : ∀ m n {o} → m * suc o ≡ n * suc o → m ≡ n +*-cancelʳ-≡ zero zero eq = refl +*-cancelʳ-≡ (suc m) (suc n) {o} eq = + cong suc (*-cancelʳ-≡ m n (+-cancelˡ-≡ (suc o) eq)) + +*-cancelˡ-≡ : ∀ {m n} o → suc o * m ≡ suc o * n → m ≡ n +*-cancelˡ-≡ {m} {n} o eq = *-cancelʳ-≡ m n + (subst₂ _≡_ (*-comm (suc o) m) (*-comm (suc o) n) eq) + +m*n≡0⇒m≡0∨n≡0 : ∀ m {n} → m * n ≡ 0 → m ≡ 0 ⊎ n ≡ 0 +m*n≡0⇒m≡0∨n≡0 zero {n} eq = inj₁ refl +m*n≡0⇒m≡0∨n≡0 (suc m) {zero} eq = inj₂ refl + +m*n≡1⇒m≡1 : ∀ m n → m * n ≡ 1 → m ≡ 1 +m*n≡1⇒m≡1 (suc zero) n _ = refl +m*n≡1⇒m≡1 (suc (suc m)) (suc zero) () +m*n≡1⇒m≡1 (suc (suc m)) zero eq = + contradiction (trans (sym $ *-zeroʳ m) eq) λ() + +m*n≡1⇒n≡1 : ∀ m n → m * n ≡ 1 → n ≡ 1 +m*n≡1⇒n≡1 m n eq = m*n≡1⇒m≡1 n m (trans (*-comm n m) eq) + +[m*n]*[o*p]≡[m*o]*[n*p] : ∀ m n o p → (m * n) * (o * p) ≡ (m * o) * (n * p) +[m*n]*[o*p]≡[m*o]*[n*p] m n o p = begin-equality + (m * n) * (o * p) ≡⟨ *-assoc m n (o * p) ⟩ + m * (n * (o * p)) ≡⟨ cong (m *_) (x∙yz≈y∙xz n o p) ⟩ + m * (o * (n * p)) ≡˘⟨ *-assoc m o (n * p) ⟩ + (m * o) * (n * p) ∎ + where open CommSemigroupProperties *-commutativeSemigroup + +------------------------------------------------------------------------ +-- Other properties of _*_ and _≤_/_<_ + +*-cancelʳ-≤ : ∀ m n o → m * suc o ≤ n * suc o → m ≤ n +*-cancelʳ-≤ zero _ _ _ = z≤n +*-cancelʳ-≤ (suc m) (suc n) o le = + s≤s (*-cancelʳ-≤ m n o (+-cancelˡ-≤ (suc o) le)) + +*-cancelˡ-≤ : ∀ {m n} o → suc o * m ≤ suc o * n → m ≤ n +*-cancelˡ-≤ {m} {n} o rewrite *-comm (suc o) m | *-comm (suc o) n = *-cancelʳ-≤ m n o + +*-mono-≤ : _*_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ +*-mono-≤ z≤n _ = z≤n +*-mono-≤ (s≤s m≤n) u≤v = +-mono-≤ u≤v (*-mono-≤ m≤n u≤v) + +*-monoˡ-≤ : ∀ n → (_* n) Preserves _≤_ ⟶ _≤_ +*-monoˡ-≤ n m≤o = *-mono-≤ m≤o (≤-refl {n}) + +*-monoʳ-≤ : ∀ n → (n *_) Preserves _≤_ ⟶ _≤_ +*-monoʳ-≤ n m≤o = *-mono-≤ (≤-refl {n}) m≤o + +*-mono-< : _*_ Preserves₂ _<_ ⟶ _<_ ⟶ _<_ +*-mono-< (s≤s z≤n) (s≤s u≤v) = s≤s z≤n +*-mono-< (s≤s (s≤s m≤n)) (s≤s u≤v) = + +-mono-< (s≤s u≤v) (*-mono-< (s≤s m≤n) (s≤s u≤v)) + +*-monoˡ-< : ∀ n → (_* suc n) Preserves _<_ ⟶ _<_ +*-monoˡ-< n (s≤s z≤n) = s≤s z≤n +*-monoˡ-< n (s≤s (s≤s m≤o)) = + +-mono-≤-< (≤-refl {suc n}) (*-monoˡ-< n (s≤s m≤o)) + +*-monoʳ-< : ∀ n → (suc n *_) Preserves _<_ ⟶ _<_ +*-monoʳ-< zero (s≤s m≤o) = +-mono-≤ (s≤s m≤o) z≤n +*-monoʳ-< (suc n) (s≤s m≤o) = + +-mono-≤ (s≤s m≤o) (<⇒≤ (*-monoʳ-< n (s≤s m≤o))) + +m≤m*n : ∀ m {n} → 0 < n → m ≤ m * n +m≤m*n m {n} 0<n = begin + m ≡⟨ sym (*-identityʳ m) ⟩ + m * 1 ≤⟨ *-monoʳ-≤ m 0<n ⟩ + m * n ∎ + +m≤n*m : ∀ m {n} → 0 < n → m ≤ n * m +m≤n*m m {n} 0<n = begin + m ≤⟨ m≤m*n m 0<n ⟩ + m * n ≡⟨ *-comm m n ⟩ + n * m ∎ + +m<m*n : ∀ {m n} → 0 < m → 1 < n → m < m * n +m<m*n {m@(suc m-1)} {n@(suc (suc n-2))} (s≤s _) (s≤s (s≤s _)) = begin-strict + m <⟨ s≤s (s≤s (m≤n+m m-1 n-2)) ⟩ + n + m-1 ≤⟨ +-monoʳ-≤ n (m≤m*n m-1 0<1+n) ⟩ + n + m-1 * n ≡⟨⟩ + m * n ∎ + +*-cancelʳ-< : RightCancellative _<_ _*_ +*-cancelʳ-< {zero} zero (suc o) _ = 0<1+n +*-cancelʳ-< {suc m} zero (suc o) _ = 0<1+n +*-cancelʳ-< {m} (suc n) (suc o) nm<om = + s≤s (*-cancelʳ-< n o (+-cancelˡ-< m nm<om)) + +-- Redo in terms of `comm+cancelʳ⇒cancelˡ` when generalised +*-cancelˡ-< : LeftCancellative _<_ _*_ +*-cancelˡ-< x {y} {z} rewrite *-comm x y | *-comm x z = *-cancelʳ-< y z + +*-cancel-< : Cancellative _<_ _*_ +*-cancel-< = *-cancelˡ-< , *-cancelʳ-< + +------------------------------------------------------------------------ +-- Properties of _^_ +------------------------------------------------------------------------ + +^-identityʳ : RightIdentity 1 _^_ +^-identityʳ zero = refl +^-identityʳ (suc n) = cong suc (^-identityʳ n) + +^-zeroˡ : LeftZero 1 _^_ +^-zeroˡ zero = refl +^-zeroˡ (suc n) = begin-equality + 1 ^ suc n ≡⟨⟩ + 1 * (1 ^ n) ≡⟨ *-identityˡ (1 ^ n) ⟩ + 1 ^ n ≡⟨ ^-zeroˡ n ⟩ + 1 ∎ + +^-distribˡ-+-* : ∀ m n o → m ^ (n + o) ≡ m ^ n * m ^ o +^-distribˡ-+-* m zero o = sym (+-identityʳ (m ^ o)) +^-distribˡ-+-* m (suc n) o = begin-equality + m * (m ^ (n + o)) ≡⟨ cong (m *_) (^-distribˡ-+-* m n o) ⟩ + m * ((m ^ n) * (m ^ o)) ≡⟨ sym (*-assoc m _ _) ⟩ + (m * (m ^ n)) * (m ^ o) ∎ + +^-semigroup-morphism : ∀ {n} → (n ^_) Is +-semigroup -Semigroup⟶ *-semigroup +^-semigroup-morphism = record + { ⟦⟧-cong = cong (_ ^_) + ; ∙-homo = ^-distribˡ-+-* _ + } + +^-monoid-morphism : ∀ {n} → (n ^_) Is +-0-monoid -Monoid⟶ *-1-monoid +^-monoid-morphism = record + { sm-homo = ^-semigroup-morphism + ; ε-homo = refl + } + +^-*-assoc : ∀ m n o → (m ^ n) ^ o ≡ m ^ (n * o) +^-*-assoc m n zero = cong (m ^_) (sym $ *-zeroʳ n) +^-*-assoc m n (suc o) = begin-equality + (m ^ n) * ((m ^ n) ^ o) ≡⟨ cong ((m ^ n) *_) (^-*-assoc m n o) ⟩ + (m ^ n) * (m ^ (n * o)) ≡⟨ sym (^-distribˡ-+-* m n (n * o)) ⟩ + m ^ (n + n * o) ≡⟨ cong (m ^_) (sym (*-suc n o)) ⟩ + m ^ (n * (suc o)) ∎ + +m^n≡0⇒m≡0 : ∀ m n → m ^ n ≡ 0 → m ≡ 0 +m^n≡0⇒m≡0 m (suc n) eq = [ id , m^n≡0⇒m≡0 m n ]′ (m*n≡0⇒m≡0∨n≡0 m eq) + +m^n≡1⇒n≡0∨m≡1 : ∀ m n → m ^ n ≡ 1 → n ≡ 0 ⊎ m ≡ 1 +m^n≡1⇒n≡0∨m≡1 m zero _ = inj₁ refl +m^n≡1⇒n≡0∨m≡1 m (suc n) eq = inj₂ (m*n≡1⇒m≡1 m (m ^ n) eq) + +------------------------------------------------------------------------ +-- Properties of _⊓_ and _⊔_ +------------------------------------------------------------------------ +-- Basic specification in terms of _≤_ + +m≤n⇒m⊔n≡n : ∀ {m n} → m ≤ n → m ⊔ n ≡ n +m≤n⇒m⊔n≡n {zero} _ = refl +m≤n⇒m⊔n≡n {suc m} (s≤s m≤n) = cong suc (m≤n⇒m⊔n≡n m≤n) + +m≥n⇒m⊔n≡m : ∀ {m n} → m ≥ n → m ⊔ n ≡ m +m≥n⇒m⊔n≡m {zero} {zero} z≤n = refl +m≥n⇒m⊔n≡m {suc m} {zero} z≤n = refl +m≥n⇒m⊔n≡m {suc m} {suc n} (s≤s m≥n) = cong suc (m≥n⇒m⊔n≡m m≥n) + +m≤n⇒m⊓n≡m : ∀ {m n} → m ≤ n → m ⊓ n ≡ m +m≤n⇒m⊓n≡m {zero} z≤n = refl +m≤n⇒m⊓n≡m {suc m} (s≤s m≤n) = cong suc (m≤n⇒m⊓n≡m m≤n) + +m≥n⇒m⊓n≡n : ∀ {m n} → m ≥ n → m ⊓ n ≡ n +m≥n⇒m⊓n≡n {zero} {zero} z≤n = refl +m≥n⇒m⊓n≡n {suc m} {zero} z≤n = refl +m≥n⇒m⊓n≡n {suc m} {suc n} (s≤s m≤n) = cong suc (m≥n⇒m⊓n≡n m≤n) + +⊓-operator : MinOperator ≤-totalPreorder +⊓-operator = record + { x≤y⇒x⊓y≈x = m≤n⇒m⊓n≡m + ; x≥y⇒x⊓y≈y = m≥n⇒m⊓n≡n + } + +⊔-operator : MaxOperator ≤-totalPreorder +⊔-operator = record + { x≤y⇒x⊔y≈y = m≤n⇒m⊔n≡n + ; x≥y⇒x⊔y≈x = m≥n⇒m⊔n≡m + } + +------------------------------------------------------------------------ +-- Derived properties of _⊓_ and _⊔_ + +private + module ⊓-⊔-properties = MinMaxOp ⊓-operator ⊔-operator + +open ⊓-⊔-properties public + using + ( ⊓-idem -- : Idempotent _⊓_ + ; ⊓-sel -- : Selective _⊓_ + ; ⊓-assoc -- : Associative _⊓_ + ; ⊓-comm -- : Commutative _⊓_ + + ; ⊔-idem -- : Idempotent _⊔_ + ; ⊔-sel -- : Selective _⊔_ + ; ⊔-assoc -- : Associative _⊔_ + ; ⊔-comm -- : Commutative _⊔_ + + ; ⊓-distribˡ-⊔ -- : _⊓_ DistributesOverˡ _⊔_ + ; ⊓-distribʳ-⊔ -- : _⊓_ DistributesOverʳ _⊔_ + ; ⊓-distrib-⊔ -- : _⊓_ DistributesOver _⊔_ + ; ⊔-distribˡ-⊓ -- : _⊔_ DistributesOverˡ _⊓_ + ; ⊔-distribʳ-⊓ -- : _⊔_ DistributesOverʳ _⊓_ + ; ⊔-distrib-⊓ -- : _⊔_ DistributesOver _⊓_ + ; ⊓-absorbs-⊔ -- : _⊓_ Absorbs _⊔_ + ; ⊔-absorbs-⊓ -- : _⊔_ Absorbs _⊓_ + ; ⊔-⊓-absorptive -- : Absorptive _⊔_ _⊓_ + ; ⊓-⊔-absorptive -- : Absorptive _⊓_ _⊔_ + + ; ⊓-isMagma -- : IsMagma _⊓_ + ; ⊓-isSemigroup -- : IsSemigroup _⊓_ + ; ⊓-isCommutativeSemigroup -- : IsCommutativeSemigroup _⊓_ + ; ⊓-isBand -- : IsBand _⊓_ + ; ⊓-isSemilattice -- : IsSemilattice _⊓_ + ; ⊓-isSelectiveMagma -- : IsSelectiveMagma _⊓_ + + ; ⊔-isMagma -- : IsMagma _⊔_ + ; ⊔-isSemigroup -- : IsSemigroup _⊔_ + ; ⊔-isCommutativeSemigroup -- : IsCommutativeSemigroup _⊔_ + ; ⊔-isBand -- : IsBand _⊔_ + ; ⊔-isSemilattice -- : IsSemilattice _⊔_ + ; ⊔-isSelectiveMagma -- : IsSelectiveMagma _⊔_ + + ; ⊔-⊓-isLattice -- : IsLattice _⊔_ _⊓_ + ; ⊓-⊔-isLattice -- : IsLattice _⊓_ _⊔_ + ; ⊔-⊓-isDistributiveLattice -- : IsDistributiveLattice _⊔_ _⊓_ + ; ⊓-⊔-isDistributiveLattice -- : IsDistributiveLattice _⊓_ _⊔_ + + ; ⊓-magma -- : Magma _ _ + ; ⊓-semigroup -- : Semigroup _ _ + ; ⊓-band -- : Band _ _ + ; ⊓-commutativeSemigroup -- : CommutativeSemigroup _ _ + ; ⊓-semilattice -- : Semilattice _ _ + ; ⊓-selectiveMagma -- : SelectiveMagma _ _ + + ; ⊔-magma -- : Magma _ _ + ; ⊔-semigroup -- : Semigroup _ _ + ; ⊔-band -- : Band _ _ + ; ⊔-commutativeSemigroup -- : CommutativeSemigroup _ _ + ; ⊔-semilattice -- : Semilattice _ _ + ; ⊔-selectiveMagma -- : SelectiveMagma _ _ + + ; ⊔-⊓-lattice -- : Lattice _ _ + ; ⊓-⊔-lattice -- : Lattice _ _ + ; ⊔-⊓-distributiveLattice -- : DistributiveLattice _ _ + ; ⊓-⊔-distributiveLattice -- : DistributiveLattice _ _ + + ; ⊓-glb -- : ∀ {m n o} → m ≥ o → n ≥ o → m ⊓ n ≥ o + ; ⊓-triangulate -- : ∀ m n o → m ⊓ n ⊓ o ≡ (m ⊓ n) ⊓ (n ⊓ o) + ; ⊓-mono-≤ -- : _⊓_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ + ; ⊓-monoˡ-≤ -- : ∀ n → (_⊓ n) Preserves _≤_ ⟶ _≤_ + ; ⊓-monoʳ-≤ -- : ∀ n → (n ⊓_) Preserves _≤_ ⟶ _≤_ + + ; ⊔-lub -- : ∀ {m n o} → m ≤ o → n ≤ o → m ⊔ n ≤ o + ; ⊔-triangulate -- : ∀ m n o → m ⊔ n ⊔ o ≡ (m ⊔ n) ⊔ (n ⊔ o) + ; ⊔-mono-≤ -- : _⊔_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ + ; ⊔-monoˡ-≤ -- : ∀ n → (_⊔ n) Preserves _≤_ ⟶ _≤_ + ; ⊔-monoʳ-≤ -- : ∀ n → (n ⊔_) Preserves _≤_ ⟶ _≤_ + ) + renaming + ( x⊓y≈y⇒y≤x to m⊓n≡n⇒n≤m -- : ∀ {m n} → m ⊓ n ≡ n → n ≤ m + ; x⊓y≈x⇒x≤y to m⊓n≡m⇒m≤n -- : ∀ {m n} → m ⊓ n ≡ m → m ≤ n + ; x⊓y≤x to m⊓n≤m -- : ∀ m n → m ⊓ n ≤ m + ; x⊓y≤y to m⊓n≤n -- : ∀ m n → m ⊓ n ≤ n + ; x≤y⇒x⊓z≤y to m≤n⇒m⊓o≤n -- : ∀ {m n} o → m ≤ n → m ⊓ o ≤ n + ; x≤y⇒z⊓x≤y to m≤n⇒o⊓m≤n -- : ∀ {m n} o → m ≤ n → o ⊓ m ≤ n + ; x≤y⊓z⇒x≤y to m≤n⊓o⇒m≤n -- : ∀ {m} n o → m ≤ n ⊓ o → m ≤ n + ; x≤y⊓z⇒x≤z to m≤n⊓o⇒m≤o -- : ∀ {m} n o → m ≤ n ⊓ o → m ≤ o + + ; x⊔y≈y⇒x≤y to m⊔n≡n⇒m≤n -- : ∀ {m n} → m ⊔ n ≡ n → m ≤ n + ; x⊔y≈x⇒y≤x to m⊔n≡m⇒n≤m -- : ∀ {m n} → m ⊔ n ≡ m → n ≤ m + ; x≤x⊔y to m≤m⊔n -- : ∀ m n → m ≤ m ⊔ n + ; x≤y⊔x to m≤n⊔m -- : ∀ m n → m ≤ n ⊔ m + ; x≤y⇒x≤y⊔z to m≤n⇒m≤n⊔o -- : ∀ {m n} o → m ≤ n → m ≤ n ⊔ o + ; x≤y⇒x≤z⊔y to m≤n⇒m≤o⊔n -- : ∀ {m n} o → m ≤ n → m ≤ o ⊔ n + ; x⊔y≤z⇒x≤z to m⊔n≤o⇒m≤o -- : ∀ m n {o} → m ⊔ n ≤ o → m ≤ o + ; x⊔y≤z⇒y≤z to m⊔n≤o⇒n≤o -- : ∀ m n {o} → m ⊔ n ≤ o → n ≤ o + + ; x⊓y≤x⊔y to m⊓n≤m⊔n -- : ∀ m n → m ⊓ n ≤ m ⊔ n + ) + +------------------------------------------------------------------------ +-- Automatically derived properties of _⊓_ and _⊔_ + +⊔-identityˡ : LeftIdentity 0 _⊔_ +⊔-identityˡ _ = refl + +⊔-identityʳ : RightIdentity 0 _⊔_ +⊔-identityʳ zero = refl +⊔-identityʳ (suc n) = refl + +⊔-identity : Identity 0 _⊔_ +⊔-identity = ⊔-identityˡ , ⊔-identityʳ + +------------------------------------------------------------------------ +-- Structures + +⊔-0-isMonoid : IsMonoid _⊔_ 0 +⊔-0-isMonoid = record + { isSemigroup = ⊔-isSemigroup + ; identity = ⊔-identity + } + +⊔-0-isCommutativeMonoid : IsCommutativeMonoid _⊔_ 0 +⊔-0-isCommutativeMonoid = record + { isMonoid = ⊔-0-isMonoid + ; comm = ⊔-comm + } + +------------------------------------------------------------------------ +-- Bundles + +⊔-0-monoid : Monoid 0ℓ 0ℓ +⊔-0-monoid = record + { isMonoid = ⊔-0-isMonoid + } + +⊔-0-commutativeMonoid : CommutativeMonoid 0ℓ 0ℓ +⊔-0-commutativeMonoid = record + { isCommutativeMonoid = ⊔-0-isCommutativeMonoid + } + +------------------------------------------------------------------------ +-- Other properties of _⊔_ and _≤_/_<_ + +mono-≤-distrib-⊔ : ∀ {f} → f Preserves _≤_ ⟶ _≤_ → + ∀ m n → f (m ⊔ n) ≡ f m ⊔ f n +mono-≤-distrib-⊔ {f} = ⊓-⊔-properties.mono-≤-distrib-⊔ (cong f) + +mono-≤-distrib-⊓ : ∀ {f} → f Preserves _≤_ ⟶ _≤_ → + ∀ m n → f (m ⊓ n) ≡ f m ⊓ f n +mono-≤-distrib-⊓ {f} = ⊓-⊔-properties.mono-≤-distrib-⊓ (cong f) + +antimono-≤-distrib-⊓ : ∀ {f} → f Preserves _≤_ ⟶ _≥_ → + ∀ m n → f (m ⊓ n) ≡ f m ⊔ f n +antimono-≤-distrib-⊓ {f} = ⊓-⊔-properties.antimono-≤-distrib-⊓ (cong f) + +antimono-≤-distrib-⊔ : ∀ {f} → f Preserves _≤_ ⟶ _≥_ → + ∀ m n → f (m ⊔ n) ≡ f m ⊓ f n +antimono-≤-distrib-⊔ {f} = ⊓-⊔-properties.antimono-≤-distrib-⊔ (cong f) + +m<n⇒m<n⊔o : ∀ {m n} o → m < n → m < n ⊔ o +m<n⇒m<n⊔o = m≤n⇒m≤n⊔o + +m<n⇒m<o⊔n : ∀ {m n} o → m < n → m < o ⊔ n +m<n⇒m<o⊔n = m≤n⇒m≤o⊔n + +m⊔n<o⇒m<o : ∀ m n {o} → m ⊔ n < o → m < o +m⊔n<o⇒m<o m n m⊔n<o = <-transʳ (m≤m⊔n m n) m⊔n<o + +m⊔n<o⇒n<o : ∀ m n {o} → m ⊔ n < o → n < o +m⊔n<o⇒n<o m n m⊔n<o = <-transʳ (m≤n⊔m m n) m⊔n<o + +⊔-mono-< : _⊔_ Preserves₂ _<_ ⟶ _<_ ⟶ _<_ +⊔-mono-< = ⊔-mono-≤ + +⊔-pres-<m : ∀ {m n o} → n < m → o < m → n ⊔ o < m +⊔-pres-<m {m} n<m o<m = subst (_ <_) (⊔-idem m) (⊔-mono-< n<m o<m) + +------------------------------------------------------------------------ +-- Other properties of _⊔_ and _+_ + ++-distribˡ-⊔ : _+_ DistributesOverˡ _⊔_ ++-distribˡ-⊔ zero n o = refl ++-distribˡ-⊔ (suc m) n o = cong suc (+-distribˡ-⊔ m n o) + ++-distribʳ-⊔ : _+_ DistributesOverʳ _⊔_ ++-distribʳ-⊔ = comm+distrˡ⇒distrʳ +-comm +-distribˡ-⊔ + ++-distrib-⊔ : _+_ DistributesOver _⊔_ ++-distrib-⊔ = +-distribˡ-⊔ , +-distribʳ-⊔ + +m⊔n≤m+n : ∀ m n → m ⊔ n ≤ m + n +m⊔n≤m+n m n with ⊔-sel m n +... | inj₁ m⊔n≡m rewrite m⊔n≡m = m≤m+n m n +... | inj₂ m⊔n≡n rewrite m⊔n≡n = m≤n+m n m + +------------------------------------------------------------------------ +-- Other properties of _⊔_ and _*_ + +*-distribˡ-⊔ : _*_ DistributesOverˡ _⊔_ +*-distribˡ-⊔ m zero o = sym (cong (_⊔ m * o) (*-zeroʳ m)) +*-distribˡ-⊔ m (suc n) zero = begin-equality + m * (suc n ⊔ zero) ≡⟨⟩ + m * suc n ≡˘⟨ ⊔-identityʳ (m * suc n) ⟩ + m * suc n ⊔ zero ≡˘⟨ cong (m * suc n ⊔_) (*-zeroʳ m) ⟩ + m * suc n ⊔ m * zero ∎ +*-distribˡ-⊔ m (suc n) (suc o) = begin-equality + m * (suc n ⊔ suc o) ≡⟨⟩ + m * suc (n ⊔ o) ≡⟨ *-suc m (n ⊔ o) ⟩ + m + m * (n ⊔ o) ≡⟨ cong (m +_) (*-distribˡ-⊔ m n o) ⟩ + m + (m * n ⊔ m * o) ≡⟨ +-distribˡ-⊔ m (m * n) (m * o) ⟩ + (m + m * n) ⊔ (m + m * o) ≡˘⟨ cong₂ _⊔_ (*-suc m n) (*-suc m o) ⟩ + (m * suc n) ⊔ (m * suc o) ∎ + +*-distribʳ-⊔ : _*_ DistributesOverʳ _⊔_ +*-distribʳ-⊔ = comm+distrˡ⇒distrʳ *-comm *-distribˡ-⊔ + +*-distrib-⊔ : _*_ DistributesOver _⊔_ +*-distrib-⊔ = *-distribˡ-⊔ , *-distribʳ-⊔ + +------------------------------------------------------------------------ +-- Properties of _⊓_ +------------------------------------------------------------------------ + +------------------------------------------------------------------------ +-- Algebraic properties + +⊓-zeroˡ : LeftZero 0 _⊓_ +⊓-zeroˡ _ = refl + +⊓-zeroʳ : RightZero 0 _⊓_ +⊓-zeroʳ zero = refl +⊓-zeroʳ (suc n) = refl + +⊓-zero : Zero 0 _⊓_ +⊓-zero = ⊓-zeroˡ , ⊓-zeroʳ + +------------------------------------------------------------------------ +-- Structures + +⊔-⊓-isSemiringWithoutOne : IsSemiringWithoutOne _⊔_ _⊓_ 0 +⊔-⊓-isSemiringWithoutOne = record + { +-isCommutativeMonoid = ⊔-0-isCommutativeMonoid + ; *-isSemigroup = ⊓-isSemigroup + ; distrib = ⊓-distrib-⊔ + ; zero = ⊓-zero + } + +⊔-⊓-isCommutativeSemiringWithoutOne + : IsCommutativeSemiringWithoutOne _⊔_ _⊓_ 0 +⊔-⊓-isCommutativeSemiringWithoutOne = record + { isSemiringWithoutOne = ⊔-⊓-isSemiringWithoutOne + ; *-comm = ⊓-comm + } + +------------------------------------------------------------------------ +-- Bundles + +⊔-⊓-commutativeSemiringWithoutOne : CommutativeSemiringWithoutOne 0ℓ 0ℓ +⊔-⊓-commutativeSemiringWithoutOne = record + { isCommutativeSemiringWithoutOne = + ⊔-⊓-isCommutativeSemiringWithoutOne + } + +------------------------------------------------------------------------ +-- Other properties of _⊓_ and _≤_/_<_ + +m<n⇒m⊓o<n : ∀ {m n} o → m < n → m ⊓ o < n +m<n⇒m⊓o<n o m<n = <-transʳ (m⊓n≤m _ o) m<n + +m<n⇒o⊓m<n : ∀ {m n} o → m < n → o ⊓ m < n +m<n⇒o⊓m<n o m<n = <-transʳ (m⊓n≤n o _) m<n + +m<n⊓o⇒m<n : ∀ {m} n o → m < n ⊓ o → m < n +m<n⊓o⇒m<n = m≤n⊓o⇒m≤n + +m<n⊓o⇒m<o : ∀ {m} n o → m < n ⊓ o → m < o +m<n⊓o⇒m<o = m≤n⊓o⇒m≤o + +⊓-mono-< : _⊓_ Preserves₂ _<_ ⟶ _<_ ⟶ _<_ +⊓-mono-< = ⊓-mono-≤ + +⊓-pres-m< : ∀ {m n o} → m < n → m < o → m < n ⊓ o +⊓-pres-m< {m} m<n m<o = subst (_< _) (⊓-idem m) (⊓-mono-< m<n m<o) + +------------------------------------------------------------------------ +-- Other properties of _⊓_ and _+_ + ++-distribˡ-⊓ : _+_ DistributesOverˡ _⊓_ ++-distribˡ-⊓ zero n o = refl ++-distribˡ-⊓ (suc m) n o = cong suc (+-distribˡ-⊓ m n o) + ++-distribʳ-⊓ : _+_ DistributesOverʳ _⊓_ ++-distribʳ-⊓ = comm+distrˡ⇒distrʳ +-comm +-distribˡ-⊓ + ++-distrib-⊓ : _+_ DistributesOver _⊓_ ++-distrib-⊓ = +-distribˡ-⊓ , +-distribʳ-⊓ + +m⊓n≤m+n : ∀ m n → m ⊓ n ≤ m + n +m⊓n≤m+n m n with ⊓-sel m n +... | inj₁ m⊓n≡m rewrite m⊓n≡m = m≤m+n m n +... | inj₂ m⊓n≡n rewrite m⊓n≡n = m≤n+m n m + +------------------------------------------------------------------------ +-- Other properties of _⊓_ and _*_ + +*-distribˡ-⊓ : _*_ DistributesOverˡ _⊓_ +*-distribˡ-⊓ m 0 o = begin-equality + m * (0 ⊓ o) ≡⟨⟩ + m * 0 ≡⟨ *-zeroʳ m ⟩ + 0 ≡⟨⟩ + 0 ⊓ (m * o) ≡˘⟨ cong (_⊓ (m * o)) (*-zeroʳ m) ⟩ + (m * 0) ⊓ (m * o) ∎ +*-distribˡ-⊓ m (suc n) 0 = begin-equality + m * (suc n ⊓ 0) ≡⟨⟩ + m * 0 ≡⟨ *-zeroʳ m ⟩ + 0 ≡˘⟨ ⊓-zeroʳ (m * suc n) ⟩ + (m * suc n) ⊓ 0 ≡˘⟨ cong (m * suc n ⊓_) (*-zeroʳ m) ⟩ + (m * suc n) ⊓ (m * 0) ∎ +*-distribˡ-⊓ m (suc n) (suc o) = begin-equality + m * (suc n ⊓ suc o) ≡⟨⟩ + m * suc (n ⊓ o) ≡⟨ *-suc m (n ⊓ o) ⟩ + m + m * (n ⊓ o) ≡⟨ cong (m +_) (*-distribˡ-⊓ m n o) ⟩ + m + (m * n) ⊓ (m * o) ≡⟨ +-distribˡ-⊓ m (m * n) (m * o) ⟩ + (m + m * n) ⊓ (m + m * o) ≡˘⟨ cong₂ _⊓_ (*-suc m n) (*-suc m o) ⟩ + (m * suc n) ⊓ (m * suc o) ∎ + +*-distribʳ-⊓ : _*_ DistributesOverʳ _⊓_ +*-distribʳ-⊓ = comm+distrˡ⇒distrʳ *-comm *-distribˡ-⊓ + +*-distrib-⊓ : _*_ DistributesOver _⊓_ +*-distrib-⊓ = *-distribˡ-⊓ , *-distribʳ-⊓ + +------------------------------------------------------------------------ +-- Properties of _∸_ +------------------------------------------------------------------------ + +0∸n≡0 : LeftZero zero _∸_ +0∸n≡0 zero = refl +0∸n≡0 (suc _) = refl + +n∸n≡0 : ∀ n → n ∸ n ≡ 0 +n∸n≡0 zero = refl +n∸n≡0 (suc n) = n∸n≡0 n + +------------------------------------------------------------------------ +-- Properties of _∸_ and pred + +pred[m∸n]≡m∸[1+n] : ∀ m n → pred (m ∸ n) ≡ m ∸ suc n +pred[m∸n]≡m∸[1+n] zero zero = refl +pred[m∸n]≡m∸[1+n] (suc m) zero = refl +pred[m∸n]≡m∸[1+n] zero (suc n) = refl +pred[m∸n]≡m∸[1+n] (suc m) (suc n) = pred[m∸n]≡m∸[1+n] m n + +------------------------------------------------------------------------ +-- Properties of _∸_ and _≤_/_<_ + +m∸n≤m : ∀ m n → m ∸ n ≤ m +m∸n≤m n zero = ≤-refl +m∸n≤m zero (suc n) = ≤-refl +m∸n≤m (suc m) (suc n) = ≤-trans (m∸n≤m m n) (n≤1+n m) + +m≮m∸n : ∀ m n → m ≮ m ∸ n +m≮m∸n m zero = n≮n m +m≮m∸n (suc m) (suc n) = m≮m∸n m n ∘ ≤-trans (n≤1+n (suc m)) + +1+m≢m∸n : ∀ {m} n → suc m ≢ m ∸ n +1+m≢m∸n {m} n eq = m≮m∸n m n (≤-reflexive eq) + +∸-mono : _∸_ Preserves₂ _≤_ ⟶ _≥_ ⟶ _≤_ +∸-mono z≤n (s≤s n₁≥n₂) = z≤n +∸-mono (s≤s m₁≤m₂) (s≤s n₁≥n₂) = ∸-mono m₁≤m₂ n₁≥n₂ +∸-mono m₁≤m₂ (z≤n {n = n₁}) = ≤-trans (m∸n≤m _ n₁) m₁≤m₂ + +∸-monoˡ-≤ : ∀ {m n} o → m ≤ n → m ∸ o ≤ n ∸ o +∸-monoˡ-≤ o m≤n = ∸-mono {u = o} m≤n ≤-refl + +∸-monoʳ-≤ : ∀ {m n} o → m ≤ n → o ∸ m ≥ o ∸ n +∸-monoʳ-≤ _ m≤n = ∸-mono ≤-refl m≤n + +∸-monoʳ-< : ∀ {m n o} → o < n → n ≤ m → m ∸ n < m ∸ o +∸-monoʳ-< {n = suc n} {zero} (s≤s o<n) (s≤s n<m) = s≤s (m∸n≤m _ n) +∸-monoʳ-< {n = suc n} {suc o} (s≤s o<n) (s≤s n<m) = ∸-monoʳ-< o<n n<m + +∸-cancelʳ-≤ : ∀ {m n o} → m ≤ o → o ∸ n ≤ o ∸ m → m ≤ n +∸-cancelʳ-≤ {_} {_} z≤n _ = z≤n +∸-cancelʳ-≤ {suc m} {zero} (s≤s _) o<o∸m = contradiction o<o∸m (m≮m∸n _ m) +∸-cancelʳ-≤ {suc m} {suc n} (s≤s m≤o) o∸n<o∸m = s≤s (∸-cancelʳ-≤ m≤o o∸n<o∸m) + +∸-cancelʳ-< : ∀ {m n o} → o ∸ m < o ∸ n → n < m +∸-cancelʳ-< {zero} {n} {o} o<o∸n = contradiction o<o∸n (m≮m∸n o n) +∸-cancelʳ-< {suc m} {zero} {_} o∸n<o∸m = 0<1+n +∸-cancelʳ-< {suc m} {suc n} {suc o} o∸n<o∸m = s≤s (∸-cancelʳ-< o∸n<o∸m) + +∸-cancelˡ-≡ : ∀ {m n o} → n ≤ m → o ≤ m → m ∸ n ≡ m ∸ o → n ≡ o +∸-cancelˡ-≡ {_} z≤n z≤n _ = refl +∸-cancelˡ-≡ {o = suc o} z≤n (s≤s _) eq = contradiction eq (1+m≢m∸n o) +∸-cancelˡ-≡ {n = suc n} (s≤s _) z≤n eq = contradiction (sym eq) (1+m≢m∸n n) +∸-cancelˡ-≡ {_} (s≤s n≤m) (s≤s o≤m) eq = cong suc (∸-cancelˡ-≡ n≤m o≤m eq) + +∸-cancelʳ-≡ : ∀ {m n o} → o ≤ m → o ≤ n → m ∸ o ≡ n ∸ o → m ≡ n +∸-cancelʳ-≡ z≤n z≤n eq = eq +∸-cancelʳ-≡ (s≤s o≤m) (s≤s o≤n) eq = cong suc (∸-cancelʳ-≡ o≤m o≤n eq) + +m∸n≡0⇒m≤n : ∀ {m n} → m ∸ n ≡ 0 → m ≤ n +m∸n≡0⇒m≤n {zero} {_} _ = z≤n +m∸n≡0⇒m≤n {suc m} {suc n} eq = s≤s (m∸n≡0⇒m≤n eq) + +m≤n⇒m∸n≡0 : ∀ {m n} → m ≤ n → m ∸ n ≡ 0 +m≤n⇒m∸n≡0 {n = n} z≤n = 0∸n≡0 n +m≤n⇒m∸n≡0 {_} (s≤s m≤n) = m≤n⇒m∸n≡0 m≤n + +m<n⇒0<n∸m : ∀ {m n} → m < n → 0 < n ∸ m +m<n⇒0<n∸m {zero} {suc n} _ = 0<1+n +m<n⇒0<n∸m {suc m} {suc n} (s≤s m<n) = m<n⇒0<n∸m m<n + +m∸n≢0⇒n<m : ∀ {m n} → m ∸ n ≢ 0 → n < m +m∸n≢0⇒n<m {m} {n} m∸n≢0 with n <? m +... | yes n<m = n<m +... | no n≮m = contradiction (m≤n⇒m∸n≡0 (≮⇒≥ n≮m)) m∸n≢0 + +m>n⇒m∸n≢0 : ∀ {m n} → m > n → m ∸ n ≢ 0 +m>n⇒m∸n≢0 {n = suc n} (s≤s m>n) = m>n⇒m∸n≢0 m>n + +--------------------------------------------------------------- +-- Properties of _∸_ and _+_ + ++-∸-comm : ∀ {m} n {o} → o ≤ m → (m + n) ∸ o ≡ (m ∸ o) + n ++-∸-comm {zero} _ {zero} _ = refl ++-∸-comm {suc m} _ {zero} _ = refl ++-∸-comm {suc m} n {suc o} (s≤s o≤m) = +-∸-comm n o≤m + +∸-+-assoc : ∀ m n o → (m ∸ n) ∸ o ≡ m ∸ (n + o) +∸-+-assoc zero zero o = refl +∸-+-assoc zero (suc n) o = 0∸n≡0 o +∸-+-assoc (suc m) zero o = refl +∸-+-assoc (suc m) (suc n) o = ∸-+-assoc m n o + ++-∸-assoc : ∀ m {n o} → o ≤ n → (m + n) ∸ o ≡ m + (n ∸ o) ++-∸-assoc m (z≤n {n = n}) = begin-equality m + n ∎ ++-∸-assoc m (s≤s {m = o} {n = n} o≤n) = begin-equality + (m + suc n) ∸ suc o ≡⟨ cong (_∸ suc o) (+-suc m n) ⟩ + suc (m + n) ∸ suc o ≡⟨⟩ + (m + n) ∸ o ≡⟨ +-∸-assoc m o≤n ⟩ + m + (n ∸ o) ∎ + +m≤n+m∸n : ∀ m n → m ≤ n + (m ∸ n) +m≤n+m∸n zero n = z≤n +m≤n+m∸n (suc m) zero = ≤-refl +m≤n+m∸n (suc m) (suc n) = s≤s (m≤n+m∸n m n) + +m+n∸n≡m : ∀ m n → m + n ∸ n ≡ m +m+n∸n≡m m n = begin-equality + (m + n) ∸ n ≡⟨ +-∸-assoc m (≤-refl {x = n}) ⟩ + m + (n ∸ n) ≡⟨ cong (m +_) (n∸n≡0 n) ⟩ + m + 0 ≡⟨ +-identityʳ m ⟩ + m ∎ + +m+n∸m≡n : ∀ m n → m + n ∸ m ≡ n +m+n∸m≡n m n = trans (cong (_∸ m) (+-comm m n)) (m+n∸n≡m n m) + +m+[n∸m]≡n : ∀ {m n} → m ≤ n → m + (n ∸ m) ≡ n +m+[n∸m]≡n {m} {n} m≤n = begin-equality + m + (n ∸ m) ≡⟨ sym $ +-∸-assoc m m≤n ⟩ + (m + n) ∸ m ≡⟨ cong (_∸ m) (+-comm m n) ⟩ + (n + m) ∸ m ≡⟨ m+n∸n≡m n m ⟩ + n ∎ + +m∸n+n≡m : ∀ {m n} → n ≤ m → (m ∸ n) + n ≡ m +m∸n+n≡m {m} {n} n≤m = begin-equality + (m ∸ n) + n ≡⟨ sym (+-∸-comm n n≤m) ⟩ + (m + n) ∸ n ≡⟨ m+n∸n≡m m n ⟩ + m ∎ + +m∸[m∸n]≡n : ∀ {m n} → n ≤ m → m ∸ (m ∸ n) ≡ n +m∸[m∸n]≡n {m} {_} z≤n = n∸n≡0 m +m∸[m∸n]≡n {suc m} {suc n} (s≤s n≤m) = begin-equality + suc m ∸ (m ∸ n) ≡⟨ +-∸-assoc 1 (m∸n≤m m n) ⟩ + suc (m ∸ (m ∸ n)) ≡⟨ cong suc (m∸[m∸n]≡n n≤m) ⟩ + suc n ∎ + +[m+n]∸[m+o]≡n∸o : ∀ m n o → (m + n) ∸ (m + o) ≡ n ∸ o +[m+n]∸[m+o]≡n∸o zero n o = refl +[m+n]∸[m+o]≡n∸o (suc m) n o = [m+n]∸[m+o]≡n∸o m n o + +------------------------------------------------------------------------ +-- Properties of _∸_ and _*_ + +*-distribʳ-∸ : _*_ DistributesOverʳ _∸_ +*-distribʳ-∸ m zero zero = refl +*-distribʳ-∸ zero zero (suc o) = sym (0∸n≡0 (o * zero)) +*-distribʳ-∸ (suc m) zero (suc o) = refl +*-distribʳ-∸ m (suc n) zero = refl +*-distribʳ-∸ m (suc n) (suc o) = begin-equality + (n ∸ o) * m ≡⟨ *-distribʳ-∸ m n o ⟩ + n * m ∸ o * m ≡⟨ sym $ [m+n]∸[m+o]≡n∸o m _ _ ⟩ + m + n * m ∸ (m + o * m) ∎ + +*-distribˡ-∸ : _*_ DistributesOverˡ _∸_ +*-distribˡ-∸ = comm+distrʳ⇒distrˡ *-comm *-distribʳ-∸ + +*-distrib-∸ : _*_ DistributesOver _∸_ +*-distrib-∸ = *-distribˡ-∸ , *-distribʳ-∸ + +even≢odd : ∀ m n → 2 * m ≢ suc (2 * n) +even≢odd (suc m) zero eq = contradiction (suc-injective eq) (m+1+n≢0 m) +even≢odd (suc m) (suc n) eq = even≢odd m n (suc-injective (begin-equality + suc (2 * m) ≡⟨ sym (+-suc m _) ⟩ + m + suc (m + 0) ≡⟨ suc-injective eq ⟩ + suc n + suc (n + 0) ≡⟨ cong suc (+-suc n _) ⟩ + suc (suc (2 * n)) ∎)) + +------------------------------------------------------------------------ +-- Properties of _∸_ and _⊓_ and _⊔_ + +m⊓n+n∸m≡n : ∀ m n → (m ⊓ n) + (n ∸ m) ≡ n +m⊓n+n∸m≡n zero n = refl +m⊓n+n∸m≡n (suc m) zero = refl +m⊓n+n∸m≡n (suc m) (suc n) = cong suc $ m⊓n+n∸m≡n m n + +[m∸n]⊓[n∸m]≡0 : ∀ m n → (m ∸ n) ⊓ (n ∸ m) ≡ 0 +[m∸n]⊓[n∸m]≡0 zero zero = refl +[m∸n]⊓[n∸m]≡0 zero (suc n) = refl +[m∸n]⊓[n∸m]≡0 (suc m) zero = refl +[m∸n]⊓[n∸m]≡0 (suc m) (suc n) = [m∸n]⊓[n∸m]≡0 m n + +∸-distribˡ-⊓-⊔ : ∀ m n o → m ∸ (n ⊓ o) ≡ (m ∸ n) ⊔ (m ∸ o) +∸-distribˡ-⊓-⊔ m n o = antimono-≤-distrib-⊓ (∸-monoʳ-≤ m) n o + +∸-distribʳ-⊓ : _∸_ DistributesOverʳ _⊓_ +∸-distribʳ-⊓ m n o = mono-≤-distrib-⊓ (∸-monoˡ-≤ m) n o + +∸-distribˡ-⊔-⊓ : ∀ m n o → m ∸ (n ⊔ o) ≡ (m ∸ n) ⊓ (m ∸ o) +∸-distribˡ-⊔-⊓ m n o = antimono-≤-distrib-⊔ (∸-monoʳ-≤ m) n o + +∸-distribʳ-⊔ : _∸_ DistributesOverʳ _⊔_ +∸-distribʳ-⊔ m n o = mono-≤-distrib-⊔ (∸-monoˡ-≤ m) n o + +------------------------------------------------------------------------ +-- Properties of pred +------------------------------------------------------------------------ + +pred-mono : pred Preserves _≤_ ⟶ _≤_ +pred-mono m≤n = ∸-mono m≤n (≤-refl {1}) + +pred[n]≤n : ∀ {n} → pred n ≤ n +pred[n]≤n {zero} = z≤n +pred[n]≤n {suc n} = n≤1+n n + +≤pred⇒≤ : ∀ {m n} → m ≤ pred n → m ≤ n +≤pred⇒≤ {m} {zero} le = le +≤pred⇒≤ {m} {suc n} le = ≤-step le + +≤⇒pred≤ : ∀ {m n} → m ≤ n → pred m ≤ n +≤⇒pred≤ {zero} le = le +≤⇒pred≤ {suc m} le = ≤-trans (n≤1+n m) le + +<⇒≤pred : ∀ {m n} → m < n → m ≤ pred n +<⇒≤pred (s≤s le) = le + +suc[pred[n]]≡n : ∀ {n} → n ≢ 0 → suc (pred n) ≡ n +suc[pred[n]]≡n {zero} n≢0 = contradiction refl n≢0 +suc[pred[n]]≡n {suc n} n≢0 = refl + +------------------------------------------------------------------------ +-- Properties of ∣_-_∣ +------------------------------------------------------------------------ + +------------------------------------------------------------------------ +-- Basic + +m≡n⇒∣m-n∣≡0 : ∀ {m n} → m ≡ n → ∣ m - n ∣ ≡ 0 +m≡n⇒∣m-n∣≡0 {zero} refl = refl +m≡n⇒∣m-n∣≡0 {suc m} refl = m≡n⇒∣m-n∣≡0 {m} refl + +∣m-n∣≡0⇒m≡n : ∀ {m n} → ∣ m - n ∣ ≡ 0 → m ≡ n +∣m-n∣≡0⇒m≡n {zero} {zero} eq = refl +∣m-n∣≡0⇒m≡n {suc m} {suc n} eq = cong suc (∣m-n∣≡0⇒m≡n eq) + +m≤n⇒∣n-m∣≡n∸m : ∀ {m n} → m ≤ n → ∣ n - m ∣ ≡ n ∸ m +m≤n⇒∣n-m∣≡n∸m {_} {zero} z≤n = refl +m≤n⇒∣n-m∣≡n∸m {_} {suc m} z≤n = refl +m≤n⇒∣n-m∣≡n∸m {_} {_} (s≤s m≤n) = m≤n⇒∣n-m∣≡n∸m m≤n + +∣m-n∣≡m∸n⇒n≤m : ∀ {m n} → ∣ m - n ∣ ≡ m ∸ n → n ≤ m +∣m-n∣≡m∸n⇒n≤m {zero} {zero} eq = z≤n +∣m-n∣≡m∸n⇒n≤m {suc m} {zero} eq = z≤n +∣m-n∣≡m∸n⇒n≤m {suc m} {suc n} eq = s≤s (∣m-n∣≡m∸n⇒n≤m eq) + +∣n-n∣≡0 : ∀ n → ∣ n - n ∣ ≡ 0 +∣n-n∣≡0 n = m≡n⇒∣m-n∣≡0 {n} refl + +∣m-m+n∣≡n : ∀ m n → ∣ m - m + n ∣ ≡ n +∣m-m+n∣≡n zero n = refl +∣m-m+n∣≡n (suc m) n = ∣m-m+n∣≡n m n + +∣m+n-m+o∣≡∣n-o∣ : ∀ m n o → ∣ m + n - m + o ∣ ≡ ∣ n - o ∣ +∣m+n-m+o∣≡∣n-o∣ zero n o = refl +∣m+n-m+o∣≡∣n-o∣ (suc m) n o = ∣m+n-m+o∣≡∣n-o∣ m n o + +m∸n≤∣m-n∣ : ∀ m n → m ∸ n ≤ ∣ m - n ∣ +m∸n≤∣m-n∣ m n with ≤-total m n +... | inj₁ m≤n = subst (_≤ ∣ m - n ∣) (sym (m≤n⇒m∸n≡0 m≤n)) z≤n +... | inj₂ n≤m = subst (m ∸ n ≤_) (sym (m≤n⇒∣n-m∣≡n∸m n≤m)) ≤-refl + +∣m-n∣≤m⊔n : ∀ m n → ∣ m - n ∣ ≤ m ⊔ n +∣m-n∣≤m⊔n zero m = ≤-refl +∣m-n∣≤m⊔n (suc m) zero = ≤-refl +∣m-n∣≤m⊔n (suc m) (suc n) = ≤-step (∣m-n∣≤m⊔n m n) + +∣-∣-identityˡ : LeftIdentity 0 ∣_-_∣ +∣-∣-identityˡ x = refl + +∣-∣-identityʳ : RightIdentity 0 ∣_-_∣ +∣-∣-identityʳ zero = refl +∣-∣-identityʳ (suc x) = refl + +∣-∣-identity : Identity 0 ∣_-_∣ +∣-∣-identity = ∣-∣-identityˡ , ∣-∣-identityʳ + +∣-∣-comm : Commutative ∣_-_∣ +∣-∣-comm zero zero = refl +∣-∣-comm zero (suc n) = refl +∣-∣-comm (suc m) zero = refl +∣-∣-comm (suc m) (suc n) = ∣-∣-comm m n + +∣m-n∣≡[m∸n]∨[n∸m] : ∀ m n → (∣ m - n ∣ ≡ m ∸ n) ⊎ (∣ m - n ∣ ≡ n ∸ m) +∣m-n∣≡[m∸n]∨[n∸m] m n with ≤-total m n +... | inj₂ n≤m = inj₁ $ m≤n⇒∣n-m∣≡n∸m n≤m +... | inj₁ m≤n = inj₂ $ begin-equality + ∣ m - n ∣ ≡⟨ ∣-∣-comm m n ⟩ + ∣ n - m ∣ ≡⟨ m≤n⇒∣n-m∣≡n∸m m≤n ⟩ + n ∸ m ∎ + +private + + *-distribˡ-∣-∣-aux : ∀ a m n → m ≤ n → a * ∣ n - m ∣ ≡ ∣ a * n - a * m ∣ + *-distribˡ-∣-∣-aux a m n m≤n = begin-equality + a * ∣ n - m ∣ ≡⟨ cong (a *_) (m≤n⇒∣n-m∣≡n∸m m≤n) ⟩ + a * (n ∸ m) ≡⟨ *-distribˡ-∸ a n m ⟩ + a * n ∸ a * m ≡⟨ sym $′ m≤n⇒∣n-m∣≡n∸m (*-monoʳ-≤ a m≤n) ⟩ + ∣ a * n - a * m ∣ ∎ + +*-distribˡ-∣-∣ : _*_ DistributesOverˡ ∣_-_∣ +*-distribˡ-∣-∣ a m n with ≤-total m n +... | inj₂ n≤m = *-distribˡ-∣-∣-aux a n m n≤m +... | inj₁ m≤n = begin-equality + a * ∣ m - n ∣ ≡⟨ cong (a *_) (∣-∣-comm m n) ⟩ + a * ∣ n - m ∣ ≡⟨ *-distribˡ-∣-∣-aux a m n m≤n ⟩ + ∣ a * n - a * m ∣ ≡⟨ ∣-∣-comm (a * n) (a * m) ⟩ + ∣ a * m - a * n ∣ ∎ + +*-distribʳ-∣-∣ : _*_ DistributesOverʳ ∣_-_∣ +*-distribʳ-∣-∣ = comm+distrˡ⇒distrʳ *-comm *-distribˡ-∣-∣ + +*-distrib-∣-∣ : _*_ DistributesOver ∣_-_∣ +*-distrib-∣-∣ = *-distribˡ-∣-∣ , *-distribʳ-∣-∣ + +m≤n+∣n-m∣ : ∀ m n → m ≤ n + ∣ n - m ∣ +m≤n+∣n-m∣ zero n = z≤n +m≤n+∣n-m∣ (suc m) zero = ≤-refl +m≤n+∣n-m∣ (suc m) (suc n) = s≤s (m≤n+∣n-m∣ m n) + +m≤n+∣m-n∣ : ∀ m n → m ≤ n + ∣ m - n ∣ +m≤n+∣m-n∣ m n = subst (m ≤_) (cong (n +_) (∣-∣-comm n m)) (m≤n+∣n-m∣ m n) + +m≤∣m-n∣+n : ∀ m n → m ≤ ∣ m - n ∣ + n +m≤∣m-n∣+n m n = subst (m ≤_) (+-comm n _) (m≤n+∣m-n∣ m n) + +∣-∣-triangle : TriangleInequality ∣_-_∣ +∣-∣-triangle zero y z = m≤n+∣n-m∣ z y +∣-∣-triangle x zero z = begin + ∣ x - z ∣ ≤⟨ ∣m-n∣≤m⊔n x z ⟩ + x ⊔ z ≤⟨ m⊔n≤m+n x z ⟩ + x + z ≡⟨ cong₂ _+_ (sym (∣-∣-identityʳ x)) refl ⟩ + ∣ x - 0 ∣ + z ∎ + where open ≤-Reasoning +∣-∣-triangle x y zero = begin + ∣ x - 0 ∣ ≡⟨ ∣-∣-identityʳ x ⟩ + x ≤⟨ m≤∣m-n∣+n x y ⟩ + ∣ x - y ∣ + y ≡⟨ cong₂ _+_ refl (sym (∣-∣-identityʳ y)) ⟩ + ∣ x - y ∣ + ∣ y - 0 ∣ ∎ + where open ≤-Reasoning +∣-∣-triangle (suc x) (suc y) (suc z) = ∣-∣-triangle x y z + +------------------------------------------------------------------------ +-- Metric structures + +∣-∣-isProtoMetric : IsProtoMetric _≡_ ∣_-_∣ +∣-∣-isProtoMetric = record + { isPartialOrder = ≤-isPartialOrder + ; ≈-isEquivalence = isEquivalence + ; cong = cong₂ ∣_-_∣ + ; nonNegative = z≤n + } + +∣-∣-isPreMetric : IsPreMetric _≡_ ∣_-_∣ +∣-∣-isPreMetric = record + { isProtoMetric = ∣-∣-isProtoMetric + ; ≈⇒0 = m≡n⇒∣m-n∣≡0 + } + +∣-∣-isQuasiSemiMetric : IsQuasiSemiMetric _≡_ ∣_-_∣ +∣-∣-isQuasiSemiMetric = record + { isPreMetric = ∣-∣-isPreMetric + ; 0⇒≈ = ∣m-n∣≡0⇒m≡n + } + +∣-∣-isSemiMetric : IsSemiMetric _≡_ ∣_-_∣ +∣-∣-isSemiMetric = record + { isQuasiSemiMetric = ∣-∣-isQuasiSemiMetric + ; sym = ∣-∣-comm + } + +∣-∣-isMetric : IsMetric _≡_ ∣_-_∣ +∣-∣-isMetric = record + { isSemiMetric = ∣-∣-isSemiMetric + ; triangle = ∣-∣-triangle + } + +------------------------------------------------------------------------ +-- Metric bundles + +∣-∣-quasiSemiMetric : QuasiSemiMetric 0ℓ 0ℓ +∣-∣-quasiSemiMetric = record + { isQuasiSemiMetric = ∣-∣-isQuasiSemiMetric + } + +∣-∣-semiMetric : SemiMetric 0ℓ 0ℓ +∣-∣-semiMetric = record + { isSemiMetric = ∣-∣-isSemiMetric + } + +∣-∣-preMetric : PreMetric 0ℓ 0ℓ +∣-∣-preMetric = record + { isPreMetric = ∣-∣-isPreMetric + } + +∣-∣-metric : Metric 0ℓ 0ℓ +∣-∣-metric = record + { isMetric = ∣-∣-isMetric + } + +------------------------------------------------------------------------ +-- Properties of ⌊_/2⌋ and ⌈_/2⌉ +------------------------------------------------------------------------ + +⌊n/2⌋-mono : ⌊_/2⌋ Preserves _≤_ ⟶ _≤_ +⌊n/2⌋-mono z≤n = z≤n +⌊n/2⌋-mono (s≤s z≤n) = z≤n +⌊n/2⌋-mono (s≤s (s≤s m≤n)) = s≤s (⌊n/2⌋-mono m≤n) + +⌈n/2⌉-mono : ⌈_/2⌉ Preserves _≤_ ⟶ _≤_ +⌈n/2⌉-mono m≤n = ⌊n/2⌋-mono (s≤s m≤n) + +⌊n/2⌋≤⌈n/2⌉ : ∀ n → ⌊ n /2⌋ ≤ ⌈ n /2⌉ +⌊n/2⌋≤⌈n/2⌉ zero = z≤n +⌊n/2⌋≤⌈n/2⌉ (suc zero) = z≤n +⌊n/2⌋≤⌈n/2⌉ (suc (suc n)) = s≤s (⌊n/2⌋≤⌈n/2⌉ n) + +⌊n/2⌋+⌈n/2⌉≡n : ∀ n → ⌊ n /2⌋ + ⌈ n /2⌉ ≡ n +⌊n/2⌋+⌈n/2⌉≡n zero = refl +⌊n/2⌋+⌈n/2⌉≡n (suc n) = begin-equality + ⌊ suc n /2⌋ + suc ⌊ n /2⌋ ≡⟨ +-comm ⌊ suc n /2⌋ (suc ⌊ n /2⌋) ⟩ + suc ⌊ n /2⌋ + ⌊ suc n /2⌋ ≡⟨⟩ + suc (⌊ n /2⌋ + ⌊ suc n /2⌋) ≡⟨ cong suc (⌊n/2⌋+⌈n/2⌉≡n n) ⟩ + suc n ∎ + +⌊n/2⌋≤n : ∀ n → ⌊ n /2⌋ ≤ n +⌊n/2⌋≤n zero = z≤n +⌊n/2⌋≤n (suc zero) = z≤n +⌊n/2⌋≤n (suc (suc n)) = s≤s (≤-step (⌊n/2⌋≤n n)) + +⌊n/2⌋<n : ∀ n → ⌊ suc n /2⌋ < suc n +⌊n/2⌋<n zero = s≤s z≤n +⌊n/2⌋<n (suc n) = s≤s (s≤s (⌊n/2⌋≤n n)) + +⌈n/2⌉≤n : ∀ n → ⌈ n /2⌉ ≤ n +⌈n/2⌉≤n zero = z≤n +⌈n/2⌉≤n (suc n) = s≤s (⌊n/2⌋≤n n) + +⌈n/2⌉<n : ∀ n → ⌈ suc (suc n) /2⌉ < suc (suc n) +⌈n/2⌉<n n = s≤s (⌊n/2⌋<n n) + +------------------------------------------------------------------------ +-- Properties of _≤′_ and _<′_ +------------------------------------------------------------------------ + +≤′-trans : Transitive _≤′_ +≤′-trans m≤n ≤′-refl = m≤n +≤′-trans m≤n (≤′-step n≤o) = ≤′-step (≤′-trans m≤n n≤o) + +z≤′n : ∀ {n} → zero ≤′ n +z≤′n {zero} = ≤′-refl +z≤′n {suc n} = ≤′-step z≤′n + +s≤′s : ∀ {m n} → m ≤′ n → suc m ≤′ suc n +s≤′s ≤′-refl = ≤′-refl +s≤′s (≤′-step m≤′n) = ≤′-step (s≤′s m≤′n) + +≤′⇒≤ : _≤′_ ⇒ _≤_ +≤′⇒≤ ≤′-refl = ≤-refl +≤′⇒≤ (≤′-step m≤′n) = ≤-step (≤′⇒≤ m≤′n) + +≤⇒≤′ : _≤_ ⇒ _≤′_ +≤⇒≤′ z≤n = z≤′n +≤⇒≤′ (s≤s m≤n) = s≤′s (≤⇒≤′ m≤n) + +≤′-step-injective : ∀ {m n} {p q : m ≤′ n} → ≤′-step p ≡ ≤′-step q → p ≡ q +≤′-step-injective refl = refl + +infix 4 _≤′?_ _<′?_ _≥′?_ _>′?_ + +_≤′?_ : Decidable _≤′_ +m ≤′? n = map′ ≤⇒≤′ ≤′⇒≤ (m ≤? n) + +_<′?_ : Decidable _<′_ +m <′? n = suc m ≤′? n + +_≥′?_ : Decidable _≥′_ +_≥′?_ = flip _≤′?_ + +_>′?_ : Decidable _>′_ +_>′?_ = flip _<′?_ + +m≤′m+n : ∀ m n → m ≤′ m + n +m≤′m+n m n = ≤⇒≤′ (m≤m+n m n) + +n≤′m+n : ∀ m n → n ≤′ m + n +n≤′m+n zero n = ≤′-refl +n≤′m+n (suc m) n = ≤′-step (n≤′m+n m n) + +⌈n/2⌉≤′n : ∀ n → ⌈ n /2⌉ ≤′ n +⌈n/2⌉≤′n zero = ≤′-refl +⌈n/2⌉≤′n (suc zero) = ≤′-refl +⌈n/2⌉≤′n (suc (suc n)) = s≤′s (≤′-step (⌈n/2⌉≤′n n)) + +⌊n/2⌋≤′n : ∀ n → ⌊ n /2⌋ ≤′ n +⌊n/2⌋≤′n zero = ≤′-refl +⌊n/2⌋≤′n (suc n) = ≤′-step (⌈n/2⌉≤′n n) + +------------------------------------------------------------------------ +-- Properties of _≤″_ and _<″_ +------------------------------------------------------------------------ + +m<ᵇn⇒1+m+[n-1+m]≡n : ∀ m n → T (m <ᵇ n) → suc m + (n ∸ suc m) ≡ n +m<ᵇn⇒1+m+[n-1+m]≡n m n lt = m+[n∸m]≡n (<ᵇ⇒< m n lt) + +m<ᵇ1+m+n : ∀ m {n} → T (m <ᵇ suc (m + n)) +m<ᵇ1+m+n m = <⇒<ᵇ (m≤m+n (suc m) _) + +<ᵇ⇒<″ : ∀ {m n} → T (m <ᵇ n) → m <″ n +<ᵇ⇒<″ {m} {n} leq = less-than-or-equal (m+[n∸m]≡n (<ᵇ⇒< m n leq)) + +<″⇒<ᵇ : ∀ {m n} → m <″ n → T (m <ᵇ n) +<″⇒<ᵇ {m} (less-than-or-equal refl) = <⇒<ᵇ (m≤m+n (suc m) _) + +-- equivalence to _≤_ + +≤″⇒≤ : _≤″_ ⇒ _≤_ +≤″⇒≤ {zero} (less-than-or-equal refl) = z≤n +≤″⇒≤ {suc m} (less-than-or-equal refl) = + s≤s (≤″⇒≤ (less-than-or-equal refl)) + +≤⇒≤″ : _≤_ ⇒ _≤″_ +≤⇒≤″ = less-than-or-equal ∘ m+[n∸m]≡n + +-- NB: we use the builtin function `_<ᵇ_ : (m n : ℕ) → Bool` here so +-- that the function quickly decides whether to return `yes` or `no`. +-- It still takes a linear amount of time to generate the proof if it +-- is inspected. We expect the main benefit to be visible for compiled +-- code: the backend erases proofs. + +infix 4 _<″?_ _≤″?_ _≥″?_ _>″?_ + +_<″?_ : Decidable _<″_ +m <″? n = map′ <ᵇ⇒<″ <″⇒<ᵇ (T? (m <ᵇ n)) + +_≤″?_ : Decidable _≤″_ +zero ≤″? n = yes (less-than-or-equal refl) +suc m ≤″? n = m <″? n + +_≥″?_ : Decidable _≥″_ +_≥″?_ = flip _≤″?_ + +_>″?_ : Decidable _>″_ +_>″?_ = flip _<″?_ + +≤″-irrelevant : Irrelevant _≤″_ +≤″-irrelevant {m} (less-than-or-equal eq₁) + (less-than-or-equal eq₂) + with +-cancelˡ-≡ m (trans eq₁ (sym eq₂)) +... | refl = cong less-than-or-equal (≡-irrelevant eq₁ eq₂) + +<″-irrelevant : Irrelevant _<″_ +<″-irrelevant = ≤″-irrelevant + +>″-irrelevant : Irrelevant _>″_ +>″-irrelevant = ≤″-irrelevant + +≥″-irrelevant : Irrelevant _≥″_ +≥″-irrelevant = ≤″-irrelevant + +------------------------------------------------------------------------ +-- Properties of _≤‴_ +------------------------------------------------------------------------ + +≤‴⇒≤″ : ∀{m n} → m ≤‴ n → m ≤″ n +≤‴⇒≤″ {m = m} ≤‴-refl = less-than-or-equal {k = 0} (+-identityʳ m) +≤‴⇒≤″ {m = m} (≤‴-step x) = less-than-or-equal (trans (+-suc m _) (_≤″_.proof ind)) where + ind = ≤‴⇒≤″ x + +m≤‴m+k : ∀{m n k} → m + k ≡ n → m ≤‴ n +m≤‴m+k {m} {k = zero} refl = subst (λ z → m ≤‴ z) (sym (+-identityʳ m)) (≤‴-refl {m}) +m≤‴m+k {m} {k = suc k} proof + = ≤‴-step (m≤‴m+k {k = k} (trans (sym (+-suc m _)) proof)) + +≤″⇒≤‴ : ∀{m n} → m ≤″ n → m ≤‴ n +≤″⇒≤‴ (less-than-or-equal {k} proof) = m≤‴m+k proof + +0≤‴n : ∀{n} → 0 ≤‴ n +0≤‴n {n} = m≤‴m+k refl + +<ᵇ⇒<‴ : ∀ {m n} → T (m <ᵇ n) → m <‴ n +<ᵇ⇒<‴ {m} {n} leq = ≤″⇒≤‴ (<ᵇ⇒<″ leq) + +<‴⇒<ᵇ : ∀ {m n} → m <‴ n → T (m <ᵇ n) +<‴⇒<ᵇ leq = <″⇒<ᵇ (≤‴⇒≤″ leq) + +infix 4 _<‴?_ _≤‴?_ _≥‴?_ _>‴?_ + +_<‴?_ : Decidable _<‴_ +m <‴? n = map′ <ᵇ⇒<‴ <‴⇒<ᵇ (T? (m <ᵇ n)) + +_≤‴?_ : Decidable _≤‴_ +zero ≤‴? n = yes 0≤‴n +suc m ≤‴? n = m <‴? n + +_≥‴?_ : Decidable _≥‴_ +_≥‴?_ = flip _≤‴?_ + +_>‴?_ : Decidable _>‴_ +_>‴?_ = flip _<‴?_ + +≤⇒≤‴ : _≤_ ⇒ _≤‴_ +≤⇒≤‴ = ≤″⇒≤‴ ∘ ≤⇒≤″ + +≤‴⇒≤ : _≤‴_ ⇒ _≤_ +≤‴⇒≤ = ≤″⇒≤ ∘ ≤‴⇒≤″ + +------------------------------------------------------------------------ +-- Other properties +------------------------------------------------------------------------ + +-- If there is an injection from a type to ℕ, then the type has +-- decidable equality. + +eq? : ∀ {a} {A : Set a} → A ↣ ℕ → Decidable {A = A} _≡_ +eq? inj = via-injection inj _≟_ + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 0.14 + +_*-mono_ = *-mono-≤ +{-# WARNING_ON_USAGE _*-mono_ +"Warning: _*-mono_ was deprecated in v0.14. +Please use *-mono-≤ instead." +#-} +_+-mono_ = +-mono-≤ +{-# WARNING_ON_USAGE _+-mono_ +"Warning: _+-mono_ was deprecated in v0.14. +Please use +-mono-≤ instead." +#-} ++-right-identity = +-identityʳ +{-# WARNING_ON_USAGE +-right-identity +"Warning: +-right-identity was deprecated in v0.14. +Please use +-identityʳ instead." +#-} +*-right-zero = *-zeroʳ +{-# WARNING_ON_USAGE *-right-zero +"Warning: *-right-zero was deprecated in v0.14. +Please use *-zeroʳ instead." +#-} +distribʳ-*-+ = *-distribʳ-+ +{-# WARNING_ON_USAGE distribʳ-*-+ +"Warning: distribʳ-*-+ was deprecated in v0.14. +Please use *-distribʳ-+ instead." +#-} +*-distrib-∸ʳ = *-distribʳ-∸ +{-# WARNING_ON_USAGE *-distrib-∸ʳ +"Warning: *-distrib-∸ʳ was deprecated in v0.14. +Please use *-distribʳ-∸ instead." +#-} +cancel-+-left = +-cancelˡ-≡ +{-# WARNING_ON_USAGE cancel-+-left +"Warning: cancel-+-left was deprecated in v0.14. +Please use +-cancelˡ-≡ instead." +#-} +cancel-+-left-≤ = +-cancelˡ-≤ +{-# WARNING_ON_USAGE cancel-+-left-≤ +"Warning: cancel-+-left-≤ was deprecated in v0.14. +Please use +-cancelˡ-≤ instead." +#-} +cancel-*-right = *-cancelʳ-≡ +{-# WARNING_ON_USAGE cancel-*-right +"Warning: cancel-*-right was deprecated in v0.14. +Please use *-cancelʳ-≡ instead." +#-} +cancel-*-right-≤ = *-cancelʳ-≤ +{-# WARNING_ON_USAGE cancel-*-right-≤ +"Warning: cancel-*-right-≤ was deprecated in v0.14. +Please use *-cancelʳ-≤ instead." +#-} +strictTotalOrder = <-strictTotalOrder +{-# WARNING_ON_USAGE strictTotalOrder +"Warning: strictTotalOrder was deprecated in v0.14. +Please use <-strictTotalOrder instead." +#-} +isCommutativeSemiring = +-*-isCommutativeSemiring +{-# WARNING_ON_USAGE isCommutativeSemiring +"Warning: isCommutativeSemiring was deprecated in v0.14. +Please use *-+-isCommutativeSemiring instead." +#-} +commutativeSemiring = +-*-commutativeSemiring +{-# WARNING_ON_USAGE commutativeSemiring +"Warning: commutativeSemiring was deprecated in v0.14. +Please use *-+-commutativeSemiring instead." +#-} +isDistributiveLattice = ⊓-⊔-isDistributiveLattice +{-# WARNING_ON_USAGE isDistributiveLattice +"Warning: isDistributiveLattice was deprecated in v0.14. +Please use ⊓-⊔-isDistributiveLattice instead." +#-} +distributiveLattice = ⊓-⊔-distributiveLattice +{-# WARNING_ON_USAGE distributiveLattice +"Warning: distributiveLattice was deprecated in v0.14. +Please use ⊓-⊔-distributiveLattice instead." +#-} +⊔-⊓-0-isSemiringWithoutOne = ⊔-⊓-isSemiringWithoutOne +{-# WARNING_ON_USAGE ⊔-⊓-0-isSemiringWithoutOne +"Warning: ⊔-⊓-0-isSemiringWithoutOne was deprecated in v0.14. +Please use ⊔-⊓-isSemiringWithoutOne instead." +#-} +⊔-⊓-0-isCommutativeSemiringWithoutOne = ⊔-⊓-isCommutativeSemiringWithoutOne +{-# WARNING_ON_USAGE ⊔-⊓-0-isCommutativeSemiringWithoutOne +"Warning: ⊔-⊓-0-isCommutativeSemiringWithoutOne was deprecated in v0.14. +Please use ⊔-⊓-isCommutativeSemiringWithoutOne instead." +#-} +⊔-⊓-0-commutativeSemiringWithoutOne = ⊔-⊓-commutativeSemiringWithoutOne +{-# WARNING_ON_USAGE ⊔-⊓-0-commutativeSemiringWithoutOne +"Warning: ⊔-⊓-0-commutativeSemiringWithoutOne was deprecated in v0.14. +Please use ⊔-⊓-commutativeSemiringWithoutOne instead." +#-} + +-- Version 0.15 + +¬i+1+j≤i = m+1+n≰m +{-# WARNING_ON_USAGE ¬i+1+j≤i +"Warning: ¬i+1+j≤i was deprecated in v0.15. +Please use m+1+n≰m instead." +#-} +≤-steps = ≤-stepsˡ +{-# WARNING_ON_USAGE ≤-steps +"Warning: ≤-steps was deprecated in v0.15. +Please use ≤-stepsˡ instead." +#-} + +-- Version 0.17 + +i∸k∸j+j∸k≡i+j∸k : ∀ i j k → i ∸ (k ∸ j) + (j ∸ k) ≡ i + j ∸ k +i∸k∸j+j∸k≡i+j∸k zero j k = cong (_+ (j ∸ k)) (0∸n≡0 (k ∸ j)) +i∸k∸j+j∸k≡i+j∸k (suc i) j zero = cong (λ x → suc i ∸ x + j) (0∸n≡0 j) +i∸k∸j+j∸k≡i+j∸k (suc i) zero (suc k) = begin-equality + i ∸ k + 0 ≡⟨ +-identityʳ _ ⟩ + i ∸ k ≡⟨ cong (_∸ k) (sym (+-identityʳ _)) ⟩ + i + 0 ∸ k ∎ +i∸k∸j+j∸k≡i+j∸k (suc i) (suc j) (suc k) = begin-equality + suc i ∸ (k ∸ j) + (j ∸ k) ≡⟨ i∸k∸j+j∸k≡i+j∸k (suc i) j k ⟩ + suc i + j ∸ k ≡⟨ cong (_∸ k) (sym (+-suc i j)) ⟩ + i + suc j ∸ k ∎ +{-# WARNING_ON_USAGE i∸k∸j+j∸k≡i+j∸k +"Warning: i∸k∸j+j∸k≡i+j∸k was deprecated in v0.17." +#-} +im≡jm+n⇒[i∸j]m≡n : ∀ i j m n → i * m ≡ j * m + n → (i ∸ j) * m ≡ n +im≡jm+n⇒[i∸j]m≡n i j m n eq = begin-equality + (i ∸ j) * m ≡⟨ *-distribʳ-∸ m i j ⟩ + (i * m) ∸ (j * m) ≡⟨ cong (_∸ j * m) eq ⟩ + (j * m + n) ∸ (j * m) ≡⟨ cong (_∸ j * m) (+-comm (j * m) n) ⟩ + (n + j * m) ∸ (j * m) ≡⟨ m+n∸n≡m n (j * m) ⟩ + n ∎ +{-# WARNING_ON_USAGE im≡jm+n⇒[i∸j]m≡n +"Warning: im≡jm+n⇒[i∸j]m≡n was deprecated in v0.17." +#-} +≤+≢⇒< = ≤∧≢⇒< +{-# WARNING_ON_USAGE ≤+≢⇒< +"Warning: ≤+≢⇒< was deprecated in v0.17. +Please use ≤∧≢⇒< instead." +#-} + +-- Version 1.0 + +≤-irrelevance = ≤-irrelevant +{-# WARNING_ON_USAGE ≤-irrelevance +"Warning: ≤-irrelevance was deprecated in v1.0. +Please use ≤-irrelevant instead." +#-} +<-irrelevance = <-irrelevant +{-# WARNING_ON_USAGE <-irrelevance +"Warning: <-irrelevance was deprecated in v1.0. +Please use <-irrelevant instead." +#-} + +-- Version 1.1 + +i+1+j≢i = m+1+n≢m +{-# WARNING_ON_USAGE i+1+j≢i +"Warning: i+1+j≢i was deprecated in v1.1. +Please use m+1+n≢m instead." +#-} +i+j≡0⇒i≡0 = m+n≡0⇒m≡0 +{-# WARNING_ON_USAGE i+j≡0⇒i≡0 +"Warning: i+j≡0⇒i≡0 was deprecated in v1.1. +Please use m+n≡0⇒m≡0 instead." +#-} +i+j≡0⇒j≡0 = m+n≡0⇒n≡0 +{-# WARNING_ON_USAGE i+j≡0⇒j≡0 +"Warning: i+j≡0⇒j≡0 was deprecated in v1.1. +Please use m+n≡0⇒n≡0 instead." +#-} +i+1+j≰i = m+1+n≰m +{-# WARNING_ON_USAGE i+1+j≰i +"Warning: i+1+j≰i was deprecated in v1.1. +Please use m+1+n≰m instead." +#-} +i*j≡0⇒i≡0∨j≡0 = m*n≡0⇒m≡0∨n≡0 +{-# WARNING_ON_USAGE i*j≡0⇒i≡0∨j≡0 +"Warning: i*j≡0⇒i≡0∨j≡0 was deprecated in v1.1. +Please use m*n≡0⇒m≡0∨n≡0 instead." +#-} +i*j≡1⇒i≡1 = m*n≡1⇒m≡1 +{-# WARNING_ON_USAGE i*j≡1⇒i≡1 +"Warning: i*j≡1⇒i≡1 was deprecated in v1.1. +Please use m*n≡1⇒m≡1 instead." +#-} +i*j≡1⇒j≡1 = m*n≡1⇒n≡1 +{-# WARNING_ON_USAGE i*j≡1⇒j≡1 +"Warning: i*j≡1⇒j≡1 was deprecated in v1.1. +Please use m*n≡1⇒n≡1 instead." +#-} +i^j≡0⇒i≡0 = m^n≡0⇒m≡0 +{-# WARNING_ON_USAGE i^j≡0⇒i≡0 +"Warning: i^j≡0⇒i≡0 was deprecated in v1.1. +Please use m^n≡0⇒m≡0 instead." +#-} +i^j≡1⇒j≡0∨i≡1 = m^n≡1⇒n≡0∨m≡1 +{-# WARNING_ON_USAGE i^j≡1⇒j≡0∨i≡1 +"Warning: i^j≡1⇒j≡0∨i≡1 was deprecated in v1.1. +Please use m^n≡1⇒n≡0∨m≡1 instead." +#-} +[i+j]∸[i+k]≡j∸k = [m+n]∸[m+o]≡n∸o +{-# WARNING_ON_USAGE [i+j]∸[i+k]≡j∸k +"Warning: [i+j]∸[i+k]≡j∸k was deprecated in v1.1. +Please use [m+n]∸[m+o]≡n∸o instead." +#-} +m≢0⇒suc[pred[m]]≡m = suc[pred[n]]≡n +{-# WARNING_ON_USAGE m≢0⇒suc[pred[m]]≡m +"Warning: m≢0⇒suc[pred[m]]≡m was deprecated in v1.1. +Please use suc[pred[n]]≡n instead." +#-} +n≡m⇒∣n-m∣≡0 = m≡n⇒∣m-n∣≡0 +{-# WARNING_ON_USAGE n≡m⇒∣n-m∣≡0 +"Warning: n≡m⇒∣n-m∣≡0 was deprecated in v1.1. +Please use m≡n⇒∣m-n∣≡0 instead." +#-} +∣n-m∣≡0⇒n≡m = ∣m-n∣≡0⇒m≡n +{-# WARNING_ON_USAGE ∣n-m∣≡0⇒n≡m +"Warning: ∣n-m∣≡0⇒n≡m was deprecated in v1.1. +Please use ∣m-n∣≡0⇒m≡n instead." +#-} +∣n-m∣≡n∸m⇒m≤n = ∣m-n∣≡m∸n⇒n≤m +{-# WARNING_ON_USAGE ∣n-m∣≡n∸m⇒m≤n +"Warning: ∣n-m∣≡n∸m⇒m≤n was deprecated in v1.1. +Please use ∣m-n∣≡m∸n⇒n≤m instead." +#-} +∣n-n+m∣≡m = ∣m-m+n∣≡n +{-# WARNING_ON_USAGE ∣n-n+m∣≡m +"Warning: ∣n-n+m∣≡m was deprecated in v1.1. +Please use ∣m-m+n∣≡n instead." +#-} +∣n+m-n+o∣≡∣m-o| = ∣m+n-m+o∣≡∣n-o∣ +{-# WARNING_ON_USAGE ∣n+m-n+o∣≡∣m-o| +"Warning: ∣n+m-n+o∣≡∣m-o| was deprecated in v1.1. +Please use ∣m+n-m+o∣≡∣n-o∣ instead." +#-} +∣m+n-m+o∣≡∣n-o| = ∣m+n-m+o∣≡∣n-o∣ +{-# WARNING_ON_USAGE ∣m+n-m+o∣≡∣n-o| +"Warning: ∣m+n-m+o∣≡∣n-o| was deprecated in v1.6. +Please use ∣m+n-m+o∣≡∣n-o∣ instead. Note the final is a \\| rather than a |" +#-} +n∸m≤∣n-m∣ = m∸n≤∣m-n∣ +{-# WARNING_ON_USAGE n∸m≤∣n-m∣ +"Warning: n∸m≤∣n-m∣ was deprecated in v1.1. +Please use m∸n≤∣m-n∣ instead." +#-} +∣n-m∣≤n⊔m = ∣m-n∣≤m⊔n +{-# WARNING_ON_USAGE ∣n-m∣≤n⊔m +"Warning: ∣n-m∣≤n⊔m was deprecated in v1.1. +Please use ∣m-n∣≤m⊔n instead." +#-} +n≤m+n : ∀ m n → n ≤ m + n +n≤m+n m n = subst (n ≤_) (+-comm n m) (m≤m+n n m) +{-# WARNING_ON_USAGE n≤m+n +"Warning: n≤m+n was deprecated in v1.1. +Please use m≤n+m instead (note, you will need to switch the argument order)." +#-} +n≤m+n∸m : ∀ m n → n ≤ m + (n ∸ m) +n≤m+n∸m m zero = z≤n +n≤m+n∸m zero (suc n) = ≤-refl +n≤m+n∸m (suc m) (suc n) = s≤s (n≤m+n∸m m n) +{-# WARNING_ON_USAGE n≤m+n∸m +"Warning: n≤m+n∸m was deprecated in v1.1. +Please use m≤n+m∸n instead (note, you will need to switch the argument order)." +#-} +∣n-m∣≡[n∸m]∨[m∸n] : ∀ m n → (∣ n - m ∣ ≡ n ∸ m) ⊎ (∣ n - m ∣ ≡ m ∸ n) +∣n-m∣≡[n∸m]∨[m∸n] m n with ≤-total m n +... | inj₁ m≤n = inj₁ $ m≤n⇒∣n-m∣≡n∸m m≤n +... | inj₂ n≤m = inj₂ $ begin-equality + ∣ n - m ∣ ≡⟨ ∣-∣-comm n m ⟩ + ∣ m - n ∣ ≡⟨ m≤n⇒∣n-m∣≡n∸m n≤m ⟩ + m ∸ n ∎ +{-# WARNING_ON_USAGE ∣n-m∣≡[n∸m]∨[m∸n] +"Warning: ∣n-m∣≡[n∸m]∨[m∸n] was deprecated in v1.1. +Please use ∣m-n∣≡[m∸n]∨[n∸m] instead (note, you will need to switch the argument order)." +#-} + +-- Version 1.2 + ++-*-suc = *-suc +{-# WARNING_ON_USAGE +-*-suc +"Warning: +-*-suc was deprecated in v1.2. +Please use *-suc instead." +#-} + +n∸m≤n : ∀ m n → n ∸ m ≤ n +n∸m≤n m n = m∸n≤m n m +{-# WARNING_ON_USAGE n∸m≤n +"Warning: n∸m≤n was deprecated in v1.2. +Please use m∸n≤m instead (note, you will need to switch the argument order)." +#-} + +-- Version 1.3 + +∀[m≤n⇒m≢o]⇒o<n : ∀ n o → (∀ {m} → m ≤ n → m ≢ o) → n < o +∀[m≤n⇒m≢o]⇒o<n = ∀[m≤n⇒m≢o]⇒n<o +{-# WARNING_ON_USAGE ∀[m≤n⇒m≢o]⇒o<n +"Warning: ∀[m≤n⇒m≢o]⇒o<n was deprecated in v1.3. +Please use ∀[m≤n⇒m≢o]⇒n<o instead." +#-} +∀[m<n⇒m≢o]⇒o≤n : ∀ n o → (∀ {m} → m < n → m ≢ o) → n ≤ o +∀[m<n⇒m≢o]⇒o≤n = ∀[m<n⇒m≢o]⇒n≤o +{-# WARNING_ON_USAGE ∀[m<n⇒m≢o]⇒o≤n +"Warning: ∀[m<n⇒m≢o]⇒o≤n was deprecated in v1.3. +Please use ∀[m<n⇒m≢o]⇒n≤o instead." +#-} + +-- Version 1.4 + +*-+-isSemiring = +-*-isSemiring +{-# WARNING_ON_USAGE *-+-isSemiring +"Warning: *-+-isSemiring was deprecated in v1.4. +Please use +-*-isSemiring instead." +#-} +*-+-isCommutativeSemiring = +-*-isCommutativeSemiring +{-# WARNING_ON_USAGE *-+-isCommutativeSemiring +"Warning: *-+-isCommutativeSemiring was deprecated in v1.4. +Please use +-*-isCommutativeSemiring instead." +#-} +*-+-semiring = +-*-semiring +{-# WARNING_ON_USAGE *-+-semiring +"Warning: *-+-semiring was deprecated in v1.4. +Please use +-*-semiring instead." +#-} +*-+-commutativeSemiring = +-*-commutativeSemiring +{-# WARNING_ON_USAGE *-+-commutativeSemiring +"Warning: *-+-commutativeSemiring was deprecated in v1.4. +Please use +-*-commutativeSemiring instead." +#-} + +-- Version 1.6 + +m≤n⇒n⊔m≡n = m≥n⇒m⊔n≡m +{-# WARNING_ON_USAGE m≤n⇒n⊔m≡n +"Warning: m≤n⇒n⊔m≡n was deprecated in v1.6. Please use m≥n⇒m⊔n≡m instead." +#-} +m≤n⇒n⊓m≡m = m≥n⇒m⊓n≡n +{-# WARNING_ON_USAGE m≤n⇒n⊓m≡m +"Warning: m≤n⇒n⊓m≡m was deprecated in v1.6. Please use m≥n⇒m⊓n≡n instead." +#-} +n⊔m≡m⇒n≤m = m⊔n≡n⇒m≤n +{-# WARNING_ON_USAGE n⊔m≡m⇒n≤m +"Warning: n⊔m≡m⇒n≤m was deprecated in v1.6. Please use m⊔n≡n⇒m≤n instead." +#-} +n⊔m≡n⇒m≤n = m⊔n≡m⇒n≤m +{-# WARNING_ON_USAGE n⊔m≡n⇒m≤n +"Warning: n⊔m≡n⇒m≤n was deprecated in v1.6. Please use m⊔n≡m⇒n≤m instead." +#-} +n≤m⊔n = m≤n⊔m +{-# WARNING_ON_USAGE n≤m⊔n +"Warning: n≤m⊔n was deprecated in v1.6. Please use m≤n⊔m instead." +#-} +⊔-least = ⊔-lub +{-# WARNING_ON_USAGE ⊔-least +"Warning: ⊔-least was deprecated in v1.6. Please use ⊔-lub instead." +#-} +⊓-greatest = ⊓-glb +{-# WARNING_ON_USAGE ⊓-greatest +"Warning: ⊓-greatest was deprecated in v1.6. Please use ⊓-glb instead." +#-} +⊔-pres-≤m = ⊔-lub +{-# WARNING_ON_USAGE ⊔-pres-≤m +"Warning: ⊔-pres-≤m was deprecated in v1.6. Please use ⊔-lub instead." +#-} +⊓-pres-m≤ = ⊓-glb +{-# WARNING_ON_USAGE ⊓-pres-m≤ +"Warning: ⊓-pres-m≤ was deprecated in v1.6. Please use ⊓-glb instead." +#-} +⊔-abs-⊓ = ⊔-absorbs-⊓ +{-# WARNING_ON_USAGE ⊔-abs-⊓ +"Warning: ⊔-abs-⊓ was deprecated in v1.6. Please use ⊔-absorbs-⊓ instead." +#-} +⊓-abs-⊔ = ⊓-absorbs-⊔ +{-# WARNING_ON_USAGE ⊓-abs-⊔ +"Warning: ⊓-abs-⊔ was deprecated in v1.6. Please use ⊓-absorbs-⊔ instead." +#-} +\ No newline at end of file diff --git a/docs/Data.Nat.html b/docs/Data.Nat.html new file mode 100644 index 0000000..b5d7135 --- /dev/null +++ b/docs/Data.Nat.html @@ -0,0 +1,39 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Natural numbers +------------------------------------------------------------------------ + +-- See README.Data.Nat for examples of how to use and reason about +-- naturals. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Nat where + +------------------------------------------------------------------------ +-- Publicly re-export the contents of the base module + +open import Data.Nat.Base public + +------------------------------------------------------------------------ +-- Publicly re-export queries + +open import Data.Nat.Properties public + using + ( _≟_ + ; _≤?_ ; _≥?_ ; _<?_ ; _>?_ + ; _≤′?_; _≥′?_; _<′?_; _>′?_ + ; _≤″?_; _<″?_; _≥″?_; _>″?_ + ; _<‴?_; _≤‴?_; _≥‴?_; _>‴?_ + ) + +------------------------------------------------------------------------ +-- Deprecated + +-- Version 0.17 + +open import Data.Nat.Properties public + using (≤-pred) +\ No newline at end of file diff --git a/docs/Data.Product.html b/docs/Data.Product.html new file mode 100644 index 0000000..e293a0c --- /dev/null +++ b/docs/Data.Product.html @@ -0,0 +1,208 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Products +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Product where + +open import Function.Base +open import Level +open import Relation.Nullary +open import Agda.Builtin.Equality + +private + variable + a b c d e f ℓ p q r : Level + A : Set a + B : Set b + C : Set c + D : Set d + E : Set e + F : Set f + +------------------------------------------------------------------------ +-- Definition of dependent products + +open import Agda.Builtin.Sigma public + renaming (fst to proj₁; snd to proj₂) + hiding (module Σ) + +module Σ = Agda.Builtin.Sigma.Σ + renaming (fst to proj₁; snd to proj₂) + +-- The syntax declaration below is attached to Σ-syntax, to make it +-- easy to import Σ without the special syntax. + +infix 2 Σ-syntax + +Σ-syntax : (A : Set a) → (A → Set b) → Set (a ⊔ b) +Σ-syntax = Σ + +syntax Σ-syntax A (λ x → B) = Σ[ x ∈ A ] B + +------------------------------------------------------------------------ +-- Definition of non-dependent products + +infixr 4 _,′_ +infixr 2 _×_ + +_×_ : ∀ (A : Set a) (B : Set b) → Set (a ⊔ b) +A × B = Σ[ x ∈ A ] B + +_,′_ : A → B → A × B +_,′_ = _,_ + +------------------------------------------------------------------------ +-- Existential quantifiers + +∃ : ∀ {A : Set a} → (A → Set b) → Set (a ⊔ b) +∃ = Σ _ + +∄ : ∀ {A : Set a} → (A → Set b) → Set (a ⊔ b) +∄ P = ¬ ∃ P + +∃₂ : ∀ {A : Set a} {B : A → Set b} + (C : (x : A) → B x → Set c) → Set (a ⊔ b ⊔ c) +∃₂ C = ∃ λ a → ∃ λ b → C a b + +-- Unique existence (parametrised by an underlying equality). + +∃! : {A : Set a} → (A → A → Set ℓ) → (A → Set b) → Set (a ⊔ b ⊔ ℓ) +∃! _≈_ B = ∃ λ x → B x × (∀ {y} → B y → x ≈ y) + +-- Syntax + +infix 2 ∃-syntax + +∃-syntax : ∀ {A : Set a} → (A → Set b) → Set (a ⊔ b) +∃-syntax = ∃ + +syntax ∃-syntax (λ x → B) = ∃[ x ] B + +infix 2 ∄-syntax + +∄-syntax : ∀ {A : Set a} → (A → Set b) → Set (a ⊔ b) +∄-syntax = ∄ + +syntax ∄-syntax (λ x → B) = ∄[ x ] B + +------------------------------------------------------------------------ +-- Operations over dependent products + +infix 4 -,_ +infixr 2 _-×-_ _-,-_ +infixl 2 _<*>_ + +-- Sometimes the first component can be inferred. + +-,_ : ∀ {A : Set a} {B : A → Set b} {x} → B x → ∃ B +-, y = _ , y + +<_,_> : ∀ {A : Set a} {B : A → Set b} {C : ∀ {x} → B x → Set c} + (f : (x : A) → B x) → ((x : A) → C (f x)) → + ((x : A) → Σ (B x) C) +< f , g > x = (f x , g x) + +map : ∀ {P : A → Set p} {Q : B → Set q} → + (f : A → B) → (∀ {x} → P x → Q (f x)) → + Σ A P → Σ B Q +map f g (x , y) = (f x , g y) + +map₁ : (A → B) → A × C → B × C +map₁ f = map f id + +map₂ : ∀ {A : Set a} {B : A → Set b} {C : A → Set c} → + (∀ {x} → B x → C x) → Σ A B → Σ A C +map₂ f = map id f + +-- A version of map where the output can depend on the input +dmap : ∀ {B : A → Set b} {P : A → Set p} {Q : ∀ {a} → P a → B a → Set q} → + (f : (a : A) → B a) → (∀ {a} (b : P a) → Q b (f a)) → + ((a , b) : Σ A P) → Σ (B a) (Q b) +dmap f g (x , y) = f x , g y + +zip : ∀ {P : A → Set p} {Q : B → Set q} {R : C → Set r} → + (_∙_ : A → B → C) → + (∀ {x y} → P x → Q y → R (x ∙ y)) → + Σ A P → Σ B Q → Σ C R +zip _∙_ _∘_ (a , p) (b , q) = ((a ∙ b) , (p ∘ q)) + +curry : ∀ {A : Set a} {B : A → Set b} {C : Σ A B → Set c} → + ((p : Σ A B) → C p) → + ((x : A) → (y : B x) → C (x , y)) +curry f x y = f (x , y) + +uncurry : ∀ {A : Set a} {B : A → Set b} {C : Σ A B → Set c} → + ((x : A) → (y : B x) → C (x , y)) → + ((p : Σ A B) → C p) +uncurry f (x , y) = f x y + +-- Rewriting dependent products +assocʳ : {B : A → Set b} {C : (a : A) → B a → Set c} → + Σ (Σ A B) (uncurry C) → Σ A (λ a → Σ (B a) (C a)) +assocʳ ((a , b) , c) = (a , (b , c)) + +assocˡ : {B : A → Set b} {C : (a : A) → B a → Set c} → + Σ A (λ a → Σ (B a) (C a)) → Σ (Σ A B) (uncurry C) +assocˡ (a , (b , c)) = ((a , b) , c) + +-- Alternate form of associativity for dependent products +-- where the C parameter is uncurried. +assocʳ-curried : {B : A → Set b} {C : Σ A B → Set c} → + Σ (Σ A B) C → Σ A (λ a → Σ (B a) (curry C a)) +assocʳ-curried ((a , b) , c) = (a , (b , c)) + +assocˡ-curried : {B : A → Set b} {C : Σ A B → Set c} → + Σ A (λ a → Σ (B a) (curry C a)) → Σ (Σ A B) C +assocˡ-curried (a , (b , c)) = ((a , b) , c) + +------------------------------------------------------------------------ +-- Operations for non-dependent products + +-- Any of the above operations for dependent products will also work for +-- non-dependent products but sometimes Agda has difficulty inferring +-- the non-dependency. Primed (′ = \prime) versions of the operations +-- are therefore provided below that sometimes have better inference +-- properties. + +zip′ : (A → B → C) → (D → E → F) → A × D → B × E → C × F +zip′ f g = zip f g + +curry′ : (A × B → C) → (A → B → C) +curry′ = curry + +uncurry′ : (A → B → C) → (A × B → C) +uncurry′ = uncurry + +dmap′ : ∀ {x y} {X : A → Set x} {Y : B → Set y} → + ((a : A) → X a) → ((b : B) → Y b) → + ((a , b) : A × B) → X a × Y b +dmap′ f g = dmap f g + +_<*>_ : ∀ {x y} {X : A → Set x} {Y : B → Set y} → + ((a : A) → X a) × ((b : B) → Y b) → + ((a , b) : A × B) → X a × Y b +_<*>_ = uncurry dmap′ + +-- Operations that can only be defined for non-dependent products + +swap : A × B → B × A +swap (x , y) = (y , x) + +_-×-_ : (A → B → Set p) → (A → B → Set q) → (A → B → Set _) +f -×- g = f -⟪ _×_ ⟫- g + +_-,-_ : (A → B → C) → (A → B → D) → (A → B → C × D) +f -,- g = f -⟪ _,_ ⟫- g + +-- Rewriting non-dependent products +assocʳ′ : (A × B) × C → A × (B × C) +assocʳ′ ((a , b) , c) = (a , (b , c)) + +assocˡ′ : A × (B × C) → (A × B) × C +assocˡ′ (a , (b , c)) = ((a , b) , c) +\ No newline at end of file diff --git a/docs/Data.Sum.Base.html b/docs/Data.Sum.Base.html new file mode 100644 index 0000000..941e31d --- /dev/null +++ b/docs/Data.Sum.Base.html @@ -0,0 +1,88 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Sums (disjoint unions) +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Sum.Base where + +open import Data.Bool.Base using (true; false) +open import Function.Base using (_∘_; _∘′_; _-⟪_⟫-_ ; id) +open import Relation.Nullary.Reflects using (invert) +open import Relation.Nullary using (Dec; yes; no; _because_; ¬_) +open import Level using (Level; _⊔_) + +private + variable + a b c d : Level + A : Set a + B : Set b + C : Set c + D : Set d + +------------------------------------------------------------------------ +-- Definition + +infixr 1 _⊎_ + +data _⊎_ (A : Set a) (B : Set b) : Set (a ⊔ b) where + inj₁ : (x : A) → A ⊎ B + inj₂ : (y : B) → A ⊎ B + +------------------------------------------------------------------------ +-- Functions + +[_,_] : ∀ {C : A ⊎ B → Set c} → + ((x : A) → C (inj₁ x)) → ((x : B) → C (inj₂ x)) → + ((x : A ⊎ B) → C x) +[ f , g ] (inj₁ x) = f x +[ f , g ] (inj₂ y) = g y + +[_,_]′ : (A → C) → (B → C) → (A ⊎ B → C) +[_,_]′ = [_,_] + +fromInj₁ : (B → A) → A ⊎ B → A +fromInj₁ = [ id ,_]′ + +fromInj₂ : (A → B) → A ⊎ B → B +fromInj₂ = [_, id ]′ + +reduce : A ⊎ A → A +reduce = [ id , id ]′ + +swap : A ⊎ B → B ⊎ A +swap (inj₁ x) = inj₂ x +swap (inj₂ x) = inj₁ x + +map : (A → C) → (B → D) → (A ⊎ B → C ⊎ D) +map f g = [ inj₁ ∘ f , inj₂ ∘ g ]′ + +map₁ : (A → C) → (A ⊎ B → C ⊎ B) +map₁ f = map f id + +map₂ : (B → D) → (A ⊎ B → A ⊎ D) +map₂ = map id + +assocʳ : (A ⊎ B) ⊎ C → A ⊎ B ⊎ C +assocʳ = [ map₂ inj₁ , inj₂ ∘′ inj₂ ]′ + +assocˡ : A ⊎ B ⊎ C → (A ⊎ B) ⊎ C +assocˡ = [ inj₁ ∘′ inj₁ , map₁ inj₂ ]′ + +infixr 1 _-⊎-_ +_-⊎-_ : (A → B → Set c) → (A → B → Set d) → (A → B → Set (c ⊔ d)) +f -⊎- g = f -⟪ _⊎_ ⟫- g + +-- Conversion back and forth with Dec + +fromDec : Dec A → A ⊎ ¬ A +fromDec ( true because [p]) = inj₁ (invert [p]) +fromDec (false because [¬p]) = inj₂ (invert [¬p]) + +toDec : A ⊎ ¬ A → Dec A +toDec (inj₁ p) = yes p +toDec (inj₂ ¬p) = no ¬p +\ No newline at end of file diff --git a/docs/Data.Sum.Properties.html b/docs/Data.Sum.Properties.html new file mode 100644 index 0000000..695761c --- /dev/null +++ b/docs/Data.Sum.Properties.html @@ -0,0 +1,105 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of sums (disjoint unions) +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Sum.Properties where + +open import Level +open import Data.Sum.Base +open import Function +open import Relation.Binary using (Decidable) +open import Relation.Binary.PropositionalEquality +open import Relation.Nullary using (yes; no) +open import Relation.Nullary.Decidable using (map′) + +private + variable + a b c d e f : Level + A : Set a + B : Set b + C : Set c + D : Set d + E : Set e + F : Set f + +inj₁-injective : ∀ {x y} → (A ⊎ B ∋ inj₁ x) ≡ inj₁ y → x ≡ y +inj₁-injective refl = refl + +inj₂-injective : ∀ {x y} → (A ⊎ B ∋ inj₂ x) ≡ inj₂ y → x ≡ y +inj₂-injective refl = refl + +module _ (dec₁ : Decidable {A = A} {B = A} _≡_) + (dec₂ : Decidable {A = B} {B = B} _≡_) where + + ≡-dec : Decidable {A = A ⊎ B} _≡_ + ≡-dec (inj₁ x) (inj₁ y) = map′ (cong inj₁) inj₁-injective (dec₁ x y) + ≡-dec (inj₁ x) (inj₂ y) = no λ() + ≡-dec (inj₂ x) (inj₁ y) = no λ() + ≡-dec (inj₂ x) (inj₂ y) = map′ (cong inj₂) inj₂-injective (dec₂ x y) + +swap-involutive : swap {A = A} {B = B} ∘ swap ≗ id +swap-involutive = [ (λ _ → refl) , (λ _ → refl) ] + +map-id : map {A = A} {B = B} id id ≗ id +map-id (inj₁ _) = refl +map-id (inj₂ _) = refl + +[,]-∘-distr : (f : A → B) + {g : C → A} {h : D → A} → + f ∘ [ g , h ] ≗ [ f ∘ g , f ∘ h ] +[,]-∘-distr _ (inj₁ _) = refl +[,]-∘-distr _ (inj₂ _) = refl + +[,]-map-commute : {f : A → B} {g : C → D} + {f′ : B → E} {g′ : D → E} → + [ f′ , g′ ] ∘ map f g ≗ [ f′ ∘ f , g′ ∘ g ] +[,]-map-commute (inj₁ _) = refl +[,]-map-commute (inj₂ _) = refl + +map-commute : {f : A → B} {g : C → D} + {f′ : B → E} {g′ : D → F} → + map f′ g′ ∘ map f g ≗ map (f′ ∘ f) (g′ ∘ g) +map-commute (inj₁ _) = refl +map-commute (inj₂ _) = refl + +map₁₂-commute : {f : A → B} {g : C → D} → + map₁ f ∘ map₂ g ≗ map₂ g ∘ map₁ f +map₁₂-commute (inj₁ _) = refl +map₁₂-commute (inj₂ _) = refl + +[,]-cong : {f f′ : A → B} {g g′ : C → B} → + f ≗ f′ → g ≗ g′ → + [ f , g ] ≗ [ f′ , g′ ] +[,]-cong = [_,_] + +[-,]-cong : {f f′ : A → B} {g : C → B} → + f ≗ f′ → + [ f , g ] ≗ [ f′ , g ] +[-,]-cong = [_, (λ _ → refl) ] + +[,-]-cong : {f : A → B} {g g′ : C → B} → + g ≗ g′ → + [ f , g ] ≗ [ f , g′ ] +[,-]-cong = [ (λ _ → refl) ,_] + +map-cong : {f f′ : A → B} {g g′ : C → D} → + f ≗ f′ → g ≗ g′ → + map f g ≗ map f′ g′ +map-cong f≗f′ g≗g′ (inj₁ x) = cong inj₁ (f≗f′ x) +map-cong f≗f′ g≗g′ (inj₂ x) = cong inj₂ (g≗g′ x) + +map₁-cong : {f f′ : A → B} → + f ≗ f′ → + map₁ {B = C} f ≗ map₁ f′ +map₁-cong f≗f′ = [-,]-cong ((cong inj₁) ∘ f≗f′) + +map₂-cong : {g g′ : C → D} → + g ≗ g′ → + map₂ {A = A} g ≗ map₂ g′ +map₂-cong g≗g′ = [,-]-cong ((cong inj₂) ∘ g≗g′) +\ No newline at end of file diff --git a/docs/Data.These.Base.html b/docs/Data.These.Base.html new file mode 100644 index 0000000..a672f64 --- /dev/null +++ b/docs/Data.These.Base.html @@ -0,0 +1,82 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- An either-or-both data type, basic type and operations +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.These.Base where + +open import Level +open import Data.Sum.Base using (_⊎_; [_,_]′) +open import Function.Base + +private + variable + a b c d e f : Level + A : Set a + B : Set b + C : Set c + D : Set d + E : Set e + F : Set f + +data These {a b} (A : Set a) (B : Set b) : Set (a ⊔ b) where + this : A → These A B + that : B → These A B + these : A → B → These A B + +------------------------------------------------------------------------ +-- Operations + +-- injection + +fromSum : A ⊎ B → These A B +fromSum = [ this , that ]′ + +-- map + +map : (f : A → B) (g : C → D) → These A C → These B D +map f g (this a) = this (f a) +map f g (that b) = that (g b) +map f g (these a b) = these (f a) (g b) + +map₁ : (f : A → B) → These A C → These B C +map₁ f = map f id + +map₂ : (g : B → C) → These A B → These A C +map₂ = map id + +-- fold + +fold : (A → C) → (B → C) → (A → B → C) → These A B → C +fold l r lr (this a) = l a +fold l r lr (that b) = r b +fold l r lr (these a b) = lr a b + +foldWithDefaults : A → B → (A → B → C) → These A B → C +foldWithDefaults a b lr = fold (flip lr b) (lr a) lr + +-- swap + +swap : These A B → These B A +swap = fold that this (flip these) + +-- align + +alignWith : (These A C → E) → (These B D → F) → These A B → These C D → These E F +alignWith f g (this a) (this c) = this (f (these a c)) +alignWith f g (this a) (that d) = these (f (this a)) (g (that d)) +alignWith f g (this a) (these c d) = these (f (these a c)) (g (that d)) +alignWith f g (that b) (this c) = these (f (that c)) (g (this b)) +alignWith f g (that b) (that d) = that (g (these b d)) +alignWith f g (that b) (these c d) = these (f (that c)) (g (these b d)) +alignWith f g (these a b) (this c) = these (f (these a c)) (g (this b)) +alignWith f g (these a b) (that d) = these (f (this a)) (g (these b d)) +alignWith f g (these a b) (these c d) = these (f (these a c)) (g (these b d)) + +align : These A B → These C D → These (These A C) (These B D) +align = alignWith id id +\ No newline at end of file diff --git a/docs/Data.Unit.Base.html b/docs/Data.Unit.Base.html new file mode 100644 index 0000000..d03b0b5 --- /dev/null +++ b/docs/Data.Unit.Base.html @@ -0,0 +1,39 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- The unit type and the total relation on unit +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Agda.Builtin.Equality using (_≡_) + +module Data.Unit.Base where + +------------------------------------------------------------------------ +-- A unit type defined as a record type + +-- Note that by default the unit type is not universe polymorphic as it +-- often results in unsolved metas. See `Data.Unit.Polymorphic` for a +-- universe polymorphic variant. + +-- Note also that the name of this type is "\top", not T. + +open import Agda.Builtin.Unit public + using (⊤; tt) + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.2 + +record _≤_ (x y : ⊤) : Set where +{-# WARNING_ON_USAGE _≤_ +"Warning: _≤_ was deprecated in v1.2. +Please use _≡_ from Relation.Binary.PropositionalEquality instead." +#-} +\ No newline at end of file diff --git a/docs/Data.Unit.Properties.html b/docs/Data.Unit.Properties.html new file mode 100644 index 0000000..75a4c24 --- /dev/null +++ b/docs/Data.Unit.Properties.html @@ -0,0 +1,189 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of the unit type +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +-- Disabled to prevent warnings from deprecation warnings for _≤_ +{-# OPTIONS --warn=noUserWarning #-} + +module Data.Unit.Properties where + +open import Data.Sum.Base +open import Data.Unit.Base +open import Level using (0ℓ) +open import Relation.Nullary +open import Relation.Binary hiding (Irrelevant) +open import Relation.Binary.PropositionalEquality + +------------------------------------------------------------------------ +-- Irrelevancy + +⊤-irrelevant : Irrelevant ⊤ +⊤-irrelevant _ _ = refl + +------------------------------------------------------------------------ +-- Equality + +infix 4 _≟_ + +_≟_ : Decidable {A = ⊤} _≡_ +_ ≟ _ = yes refl + +≡-setoid : Setoid 0ℓ 0ℓ +≡-setoid = setoid ⊤ + +≡-decSetoid : DecSetoid 0ℓ 0ℓ +≡-decSetoid = decSetoid _≟_ + +------------------------------------------------------------------------ +-- Relational properties + +≡-total : Total {A = ⊤} _≡_ +≡-total _ _ = inj₁ refl + +≡-antisym : Antisymmetric {A = ⊤} _≡_ _≡_ +≡-antisym eq _ = eq + +------------------------------------------------------------------------ +-- Structures + +≡-isPreorder : IsPreorder {A = ⊤} _≡_ _≡_ +≡-isPreorder = record + { isEquivalence = isEquivalence + ; reflexive = λ x → x + ; trans = trans + } + +≡-isPartialOrder : IsPartialOrder _≡_ _≡_ +≡-isPartialOrder = record + { isPreorder = ≡-isPreorder + ; antisym = ≡-antisym + } + +≡-isTotalOrder : IsTotalOrder _≡_ _≡_ +≡-isTotalOrder = record + { isPartialOrder = ≡-isPartialOrder + ; total = ≡-total + } + +≡-isDecTotalOrder : IsDecTotalOrder _≡_ _≡_ +≡-isDecTotalOrder = record + { isTotalOrder = ≡-isTotalOrder + ; _≟_ = _≟_ + ; _≤?_ = _≟_ + } + +------------------------------------------------------------------------ +-- Bundles + +≡-poset : Poset 0ℓ 0ℓ 0ℓ +≡-poset = record + { isPartialOrder = ≡-isPartialOrder + } + +≡-decTotalOrder : DecTotalOrder 0ℓ 0ℓ 0ℓ +≡-decTotalOrder = record + { isDecTotalOrder = ≡-isDecTotalOrder + } + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.2 + +≤-reflexive : _≡_ ⇒ _≤_ +≤-reflexive _ = _ +{-# WARNING_ON_USAGE ≤-reflexive +"Warning: ≤-reflexive was deprecated in v1.2. +Please use id from Function instead." +#-} +≤-trans : Transitive _≤_ +≤-trans _ _ = _ +{-# WARNING_ON_USAGE ≤-trans +"Warning: ≤-trans was deprecated in v1.2. +Please use trans from Relation.Binary.PropositionalEquality instead." +#-} +≤-antisym : Antisymmetric _≡_ _≤_ +≤-antisym _ _ = refl +{-# WARNING_ON_USAGE ≤-antisym +"Warning: ≤-antisym was deprecated in v1.2. +Please use ≡-antisym instead." +#-} +≤-total : Total _≤_ +≤-total _ _ = inj₁ _ +{-# WARNING_ON_USAGE ≤-total +"Warning: ≤-total was deprecated in v1.2. +Please use ≡-total instead." +#-} +infix 4 _≤?_ +_≤?_ : Decidable _≤_ +_ ≤? _ = yes _ +{-# WARNING_ON_USAGE _≤?_ +"Warning: _≤?_ was deprecated in v1.2. +Please use _≟_ instead." +#-} +≤-isPreorder : IsPreorder _≡_ _≤_ +≤-isPreorder = record + { isEquivalence = isEquivalence + ; reflexive = ≤-reflexive + ; trans = ≤-trans + } +{-# WARNING_ON_USAGE ≤-isPreorder +"Warning: ≤-isPreorder was deprecated in v1.2. +Please use ≡-isPreorder instead." +#-} +≤-isPartialOrder : IsPartialOrder _≡_ _≤_ +≤-isPartialOrder = record + { isPreorder = ≤-isPreorder + ; antisym = ≤-antisym + } +{-# WARNING_ON_USAGE ≤-isPartialOrder +"Warning: ≤-isPartialOrder was deprecated in v1.2. +Please use ≡-isPartialOrder instead." +#-} +≤-isTotalOrder : IsTotalOrder _≡_ _≤_ +≤-isTotalOrder = record + { isPartialOrder = ≤-isPartialOrder + ; total = ≤-total + } +{-# WARNING_ON_USAGE ≤-isTotalOrder +"Warning: ≤-isTotalOrder was deprecated in v1.2. +Please use ≡-isTotalOrder instead." +#-} +≤-isDecTotalOrder : IsDecTotalOrder _≡_ _≤_ +≤-isDecTotalOrder = record + { isTotalOrder = ≤-isTotalOrder + ; _≟_ = _≟_ + ; _≤?_ = _≤?_ + } +{-# WARNING_ON_USAGE ≤-isDecTotalOrder +"Warning: ≤-isDecTotalOrder was deprecated in v1.2. +Please use ≡-isDecTotalOrder instead." +#-} + +-- Bundles + +≤-poset : Poset 0ℓ 0ℓ 0ℓ +≤-poset = record + { isPartialOrder = ≤-isPartialOrder + } +{-# WARNING_ON_USAGE ≤-poset +"Warning: ≤-poset was deprecated in v1.2. +Please use ≡-poset instead." +#-} +≤-decTotalOrder : DecTotalOrder 0ℓ 0ℓ 0ℓ +≤-decTotalOrder = record + { isDecTotalOrder = ≤-isDecTotalOrder + } +{-# WARNING_ON_USAGE ≤-decTotalOrder +"Warning: ≤-decTotalOrder was deprecated in v1.2. +Please use ≡-decTotalOrder instead." +#-} +\ No newline at end of file diff --git a/docs/Data.Unit.html b/docs/Data.Unit.html new file mode 100644 index 0000000..7a26978 --- /dev/null +++ b/docs/Data.Unit.html @@ -0,0 +1,63 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- The unit type +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Data.Unit where + +import Relation.Binary.PropositionalEquality as PropEq + +------------------------------------------------------------------------ +-- Re-export contents of base module + +open import Data.Unit.Base public + +------------------------------------------------------------------------ +-- Re-export query operations + +open import Data.Unit.Properties public + using (_≟_; _≤?_) + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.1 + +setoid = Data.Unit.Properties.≡-setoid +{-# WARNING_ON_USAGE setoid +"Warning: setoid was deprecated in v1.1. +Please use ≡-setoid from Data.Unit.Properties instead." +#-} +decSetoid = Data.Unit.Properties.≡-decSetoid +{-# WARNING_ON_USAGE decSetoid +"Warning: decSetoid was deprecated in v1.1. +Please use ≡-decSetoid from Data.Unit.Properties instead." +#-} +total = Data.Unit.Properties.≡-total +{-# WARNING_ON_USAGE total +"Warning: total was deprecated in v1.1. +Please use ≡-total from Data.Unit.Properties instead" +#-} +poset = Data.Unit.Properties.≡-poset +{-# WARNING_ON_USAGE poset +"Warning: poset was deprecated in v1.1. +Please use ≡-poset from Data.Unit.Properties instead." +#-} +decTotalOrder = Data.Unit.Properties.≡-decTotalOrder +{-# WARNING_ON_USAGE decTotalOrder +"Warning: decTotalOrder was deprecated in v1.1. +Please use ≡-decTotalOrder from Data.Unit.Properties instead." +#-} +preorder = PropEq.preorder ⊤ +{-# WARNING_ON_USAGE decTotalOrder +"Warning: preorder was deprecated in v1.1. +Please use ≡-preorder from Data.Unit.Properties instead." +#-} +\ No newline at end of file diff --git a/docs/Examples.Structures.Signatures.html b/docs/Examples.Structures.Signatures.html new file mode 100644 index 0000000..a9abf60 --- /dev/null +++ b/docs/Examples.Structures.Signatures.html @@ -0,0 +1,66 @@ + +
--- +layout: default +title : "Examples.Structures.Signatures module (Agda Universal Algebra Library)" +date : "2021-07-16" +author: "agda-algebras development team" +--- + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Examples.Structures.Signatures where + +open import Agda.Primitive using () renaming ( lzero to ℓ₀ ) +open import Data.Unit.Base using () renaming ( ⊤ to 𝟙 ; tt to 𝟎 ) +open import Data.Empty using () renaming ( ⊥ to 𝟘 ) +open import Overture using ( 𝟚 ; 𝟛 ) +open import Base.Structures.Basic using ( signature ; structure ) + +\end{code} + +#### <a id="examples-of-finite-signatures">Examples of finite signatures</a> + +\begin{code} + +-- The signature with... + +-- ... no symbols (e.g., sets) +S∅ : signature ℓ₀ ℓ₀ +S∅ = record { symbol = 𝟘 ; arity = λ () } + +-- ... one nullary symbol (e.g., pointed sets) +S1 : signature ℓ₀ ℓ₀ +S1 = record { symbol = 𝟙 ; arity = λ _ → 𝟘 } + +S01 : signature ℓ₀ ℓ₀ -- ...one unary +S01 = record { symbol = 𝟙 ; arity = λ _ → 𝟙 } + +-- ...one binary symbol (e.g., magmas, semigroups, semilattices) +S001 : signature ℓ₀ ℓ₀ +S001 = record { symbol = 𝟙 ; arity = λ _ → 𝟚 } + +-- ...one ternary symbol (e.g., boolean NAE-3-SAT relational structure) +S0001 : signature ℓ₀ ℓ₀ +S0001 = record { symbol = 𝟙 ; arity = λ _ → 𝟛 } + +-- ...0 nullary, 2 unary, and 1 binary +S021 : signature ℓ₀ ℓ₀ +S021 = record { symbol = 𝟛 ; arity = λ{ 𝟛.𝟎 → 𝟚 ; 𝟛.𝟏 → 𝟙 ; 𝟛.𝟐 → 𝟙 } } + +-- ...one nullary and one binary (e.g., monoids) +S101 : signature ℓ₀ ℓ₀ +S101 = record { symbol = 𝟚 ; arity = λ{ 𝟚.𝟎 → 𝟘 ; 𝟚.𝟏 → 𝟚 } } + +-- ...one nullary, one unary, and one binary (e.g., groups) +S111 : signature ℓ₀ ℓ₀ +S111 = record { symbol = 𝟛 ; arity = λ{ 𝟛.𝟎 → 𝟘 ; 𝟛.𝟏 → 𝟙 ; 𝟛.𝟐 → 𝟚 } } + +\end{code} + +-------------------------------- + +{% include UALib.Links.md %} + +\ No newline at end of file diff --git a/docs/Function.Base.html b/docs/Function.Base.html new file mode 100644 index 0000000..3934849 --- /dev/null +++ b/docs/Function.Base.html @@ -0,0 +1,259 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Simple combinators working solely on and with functions +------------------------------------------------------------------------ + +-- The contents of this file can be accessed from `Function`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Base where + +open import Level +open import Strict + +private + variable + a b c d e : Level + A : Set a + B : Set b + C : Set c + D : Set d + E : Set e + +------------------------------------------------------------------------ +-- Some simple functions + +id : A → A +id x = x + +const : A → B → A +const x = λ _ → x + +constᵣ : A → B → B +constᵣ _ = id + +------------------------------------------------------------------------ +-- Operations on dependent functions + +-- These are functions whose output has a type that depends on the +-- value of the input to the function. + +infixr 9 _∘_ _∘₂_ +infixl 8 _ˢ_ +infixl 0 _|>_ +infix 0 case_return_of_ +infixr -1 _$_ _$!_ + +-- Composition + +_∘_ : ∀ {A : Set a} {B : A → Set b} {C : {x : A} → B x → Set c} → + (∀ {x} (y : B x) → C y) → (g : (x : A) → B x) → + ((x : A) → C (g x)) +f ∘ g = λ x → f (g x) +{-# INLINE _∘_ #-} + +_∘₂_ : ∀ {A₁ : Set a} {A₂ : A₁ → Set d} + {B : (x : A₁) → A₂ x → Set b} + {C : {x : A₁} → {y : A₂ x} → B x y → Set c} → + ({x : A₁} → {y : A₂ x} → (z : B x y) → C z) → + (g : (x : A₁) → (y : A₂ x) → B x y) → + ((x : A₁) → (y : A₂ x) → C (g x y)) +f ∘₂ g = λ x y → f (g x y) + +-- Flipping order of arguments + +flip : ∀ {A : Set a} {B : Set b} {C : A → B → Set c} → + ((x : A) (y : B) → C x y) → ((y : B) (x : A) → C x y) +flip f = λ y x → f x y +{-# INLINE flip #-} + +-- Application - note that _$_ is right associative, as in Haskell. +-- If you want a left associative infix application operator, use +-- Category.Functor._<$>_ from Category.Monad.Identity.IdentityMonad. + +_$_ : ∀ {A : Set a} {B : A → Set b} → + ((x : A) → B x) → ((x : A) → B x) +f $ x = f x +{-# INLINE _$_ #-} + +-- Strict (call-by-value) application + +_$!_ : ∀ {A : Set a} {B : A → Set b} → + ((x : A) → B x) → ((x : A) → B x) +_$!_ = flip force + +-- Flipped application (aka pipe-forward) + +_|>_ : ∀ {A : Set a} {B : A → Set b} → + (a : A) → (∀ a → B a) → B a +_|>_ = flip _$_ +{-# INLINE _|>_ #-} + +-- The S combinator - written infix as in Conor McBride's paper +-- "Outrageous but Meaningful Coincidences: Dependent type-safe syntax +-- and evaluation". + +_ˢ_ : ∀ {A : Set a} {B : A → Set b} {C : (x : A) → B x → Set c} → + ((x : A) (y : B x) → C x y) → + (g : (x : A) → B x) → + ((x : A) → C x (g x)) +f ˢ g = λ x → f x (g x) +{-# INLINE _ˢ_ #-} + +-- Converting between implicit and explicit function spaces. + +_$- : ∀ {A : Set a} {B : A → Set b} → ((x : A) → B x) → ({x : A} → B x) +f $- = f _ +{-# INLINE _$- #-} + +λ- : ∀ {A : Set a} {B : A → Set b} → ({x : A} → B x) → ((x : A) → B x) +λ- f = λ x → f +{-# INLINE λ- #-} + +-- Case expressions (to be used with pattern-matching lambdas, see +-- README.Case). + +case_return_of_ : ∀ {A : Set a} (x : A) (B : A → Set b) → + ((x : A) → B x) → B x +case x return B of f = f x +{-# INLINE case_return_of_ #-} + +------------------------------------------------------------------------ +-- Non-dependent versions of dependent operations + +-- Any of the above operations for dependent functions will also work +-- for non-dependent functions but sometimes Agda has difficulty +-- inferring the non-dependency. Primed (′ = \prime) versions of the +-- operations are therefore provided below that sometimes have better +-- inference properties. + +infixr 9 _∘′_ _∘₂′_ +infixl 0 _|>′_ +infix 0 case_of_ +infixr -1 _$′_ _$!′_ + +-- Composition + +_∘′_ : (B → C) → (A → B) → (A → C) +f ∘′ g = _∘_ f g + +_∘₂′_ : (C → D) → (A → B → C) → (A → B → D) +f ∘₂′ g = _∘₂_ f g + +-- Application + +_$′_ : (A → B) → (A → B) +_$′_ = _$_ + +-- Strict (call-by-value) application + +_$!′_ : (A → B) → (A → B) +_$!′_ = _$!_ + +-- Flipped application (aka pipe-forward) + +_|>′_ : A → (A → B) → B +_|>′_ = _|>_ + +-- Case expressions (to be used with pattern-matching lambdas, see +-- README.Case). + +case_of_ : A → (A → B) → B +case x of f = case x return _ of f +{-# INLINE case_of_ #-} + +------------------------------------------------------------------------ +-- Operations that are only defined for non-dependent functions + +infixl 1 _⟨_⟩_ +infixl 0 _∋_ + +-- Binary application + +_⟨_⟩_ : A → (A → B → C) → B → C +x ⟨ f ⟩ y = f x y + +-- In Agda you cannot annotate every subexpression with a type +-- signature. This function can be used instead. + +_∋_ : (A : Set a) → A → A +A ∋ x = x + +-- Conversely it is sometimes useful to be able to extract the +-- type of a given expression. + +typeOf : {A : Set a} → A → Set a +typeOf {A = A} _ = A + +-- Construct an element of the given type by instance search. + +it : {A : Set a} → {{A}} → A +it {{x}} = x + +------------------------------------------------------------------------ +-- Composition of a binary function with other functions + +infixr 0 _-⟪_⟫-_ _-⟨_⟫-_ +infixl 0 _-⟪_⟩-_ +infixr 1 _-⟨_⟩-_ ∣_⟫-_ ∣_⟩-_ +infixl 1 _on_ _on₂_ _-⟪_∣ _-⟨_∣ + +-- Two binary functions + +_-⟪_⟫-_ : (A → B → C) → (C → D → E) → (A → B → D) → (A → B → E) +f -⟪ _*_ ⟫- g = λ x y → f x y * g x y + +-- A single binary function on the left + +_-⟪_∣ : (A → B → C) → (C → B → D) → (A → B → D) +f -⟪ _*_ ∣ = f -⟪ _*_ ⟫- constᵣ + +-- A single binary function on the right + +∣_⟫-_ : (A → C → D) → (A → B → C) → (A → B → D) +∣ _*_ ⟫- g = const -⟪ _*_ ⟫- g + +-- A single unary function on the left + +_-⟨_∣ : (A → C) → (C → B → D) → (A → B → D) +f -⟨ _*_ ∣ = f ∘₂ const -⟪ _*_ ∣ + +-- A single unary function on the right + +∣_⟩-_ : (A → C → D) → (B → C) → (A → B → D) +∣ _*_ ⟩- g = ∣ _*_ ⟫- g ∘₂ constᵣ + +-- A binary function and a unary function + +_-⟪_⟩-_ : (A → B → C) → (C → D → E) → (B → D) → (A → B → E) +f -⟪ _*_ ⟩- g = f -⟪ _*_ ⟫- ∣ constᵣ ⟩- g + +-- A unary function and a binary function + +_-⟨_⟫-_ : (A → C) → (C → D → E) → (A → B → D) → (A → B → E) +f -⟨ _*_ ⟫- g = f -⟨ const ∣ -⟪ _*_ ⟫- g + +-- Two unary functions + +_-⟨_⟩-_ : (A → C) → (C → D → E) → (B → D) → (A → B → E) +f -⟨ _*_ ⟩- g = f -⟨ const ∣ -⟪ _*_ ⟫- ∣ constᵣ ⟩- g + +-- A single binary function on both sides + +_on₂_ : (C → C → D) → (A → B → C) → (A → B → D) +_*_ on₂ f = f -⟪ _*_ ⟫- f + +-- A single unary function on both sides + +_on_ : (B → B → C) → (A → B) → (A → A → C) +_*_ on f = f -⟨ _*_ ⟩- f + +_-[_]-_ = _-⟪_⟫-_ +{-# WARNING_ON_USAGE _-[_]-_ +"Warning: Function._-[_]-_ was deprecated in v1.4. +Please use _-⟪_⟫-_ instead." +#-} +\ No newline at end of file diff --git a/docs/Function.Bundles.html b/docs/Function.Bundles.html new file mode 100644 index 0000000..f0c8a3e --- /dev/null +++ b/docs/Function.Bundles.html @@ -0,0 +1,424 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Bundles for types of functions +------------------------------------------------------------------------ + +-- The contents of this file should usually be accessed from `Function`. + +-- Note that these bundles differ from those found elsewhere in other +-- library hierarchies as they take Setoids as parameters. This is +-- because a function is of no use without knowing what its domain and +-- codomain is, as well which equalities are being considered over them. +-- One consequence of this is that they are not built from the +-- definitions found in `Function.Structures` as is usually the case in +-- other library hierarchies, as this would duplicate the equality +-- axioms. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Bundles where + +import Function.Definitions as FunctionDefinitions +import Function.Structures as FunctionStructures +open import Level using (Level; _⊔_; suc) +open import Data.Product using (_,_; proj₁; proj₂) +open import Relation.Binary hiding (_⇔_) +open import Relation.Binary.PropositionalEquality as ≡ + using (_≡_) +open Setoid using (isEquivalence) + +private + variable + a b ℓ₁ ℓ₂ : Level + +------------------------------------------------------------------------ +-- Setoid bundles +------------------------------------------------------------------------ + +module _ (From : Setoid a ℓ₁) (To : Setoid b ℓ₂) where + + open Setoid From using () renaming (Carrier to A; _≈_ to _≈₁_) + open Setoid To using () renaming (Carrier to B; _≈_ to _≈₂_) + open FunctionDefinitions _≈₁_ _≈₂_ + open FunctionStructures _≈₁_ _≈₂_ + +------------------------------------------------------------------------ +-- Bundles with one element + + -- Called `Func` rather than `Function` in order to avoid clashing + -- with the top-level module. + record Func : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f : A → B + cong : f Preserves _≈₁_ ⟶ _≈₂_ + + isCongruent : IsCongruent f + isCongruent = record + { cong = cong + ; isEquivalence₁ = isEquivalence From + ; isEquivalence₂ = isEquivalence To + } + + open IsCongruent isCongruent public + using (module Eq₁; module Eq₂) + + + record Injection : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f : A → B + cong : f Preserves _≈₁_ ⟶ _≈₂_ + injective : Injective f + + function : Func + function = record + { f = f + ; cong = cong + } + + open Func function public + hiding (f; cong) + + isInjection : IsInjection f + isInjection = record + { isCongruent = isCongruent + ; injective = injective + } + + + record Surjection : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f : A → B + cong : f Preserves _≈₁_ ⟶ _≈₂_ + surjective : Surjective f + + isCongruent : IsCongruent f + isCongruent = record + { cong = cong + ; isEquivalence₁ = isEquivalence From + ; isEquivalence₂ = isEquivalence To + } + + open IsCongruent isCongruent public using (module Eq₁; module Eq₂) + + isSurjection : IsSurjection f + isSurjection = record + { isCongruent = isCongruent + ; surjective = surjective + } + + + record Bijection : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f : A → B + cong : f Preserves _≈₁_ ⟶ _≈₂_ + bijective : Bijective f + + injective : Injective f + injective = proj₁ bijective + + surjective : Surjective f + surjective = proj₂ bijective + + injection : Injection + injection = record + { cong = cong + ; injective = injective + } + + surjection : Surjection + surjection = record + { cong = cong + ; surjective = surjective + } + + open Injection injection public using (isInjection) + open Surjection surjection public using (isSurjection) + + isBijection : IsBijection f + isBijection = record + { isInjection = isInjection + ; surjective = surjective + } + + open IsBijection isBijection public using (module Eq₁; module Eq₂) + + +------------------------------------------------------------------------ +-- Bundles with two elements + + record Equivalence : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f : A → B + g : B → A + cong₁ : f Preserves _≈₁_ ⟶ _≈₂_ + cong₂ : g Preserves _≈₂_ ⟶ _≈₁_ + + + record LeftInverse : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f : A → B + g : B → A + cong₁ : f Preserves _≈₁_ ⟶ _≈₂_ + cong₂ : g Preserves _≈₂_ ⟶ _≈₁_ + inverseˡ : Inverseˡ f g + + isCongruent : IsCongruent f + isCongruent = record + { cong = cong₁ + ; isEquivalence₁ = isEquivalence From + ; isEquivalence₂ = isEquivalence To + } + + open IsCongruent isCongruent public using (module Eq₁; module Eq₂) + + isLeftInverse : IsLeftInverse f g + isLeftInverse = record + { isCongruent = isCongruent + ; cong₂ = cong₂ + ; inverseˡ = inverseˡ + } + + equivalence : Equivalence + equivalence = record + { cong₁ = cong₁ + ; cong₂ = cong₂ + } + + + record RightInverse : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f : A → B + g : B → A + cong₁ : f Preserves _≈₁_ ⟶ _≈₂_ + cong₂ : g Preserves _≈₂_ ⟶ _≈₁_ + inverseʳ : Inverseʳ f g + + isCongruent : IsCongruent f + isCongruent = record + { cong = cong₁ + ; isEquivalence₁ = isEquivalence From + ; isEquivalence₂ = isEquivalence To + } + + isRightInverse : IsRightInverse f g + isRightInverse = record + { isCongruent = isCongruent + ; cong₂ = cong₂ + ; inverseʳ = inverseʳ + } + + equivalence : Equivalence + equivalence = record + { cong₁ = cong₁ + ; cong₂ = cong₂ + } + + + record Inverse : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f : A → B + f⁻¹ : B → A + cong₁ : f Preserves _≈₁_ ⟶ _≈₂_ + cong₂ : f⁻¹ Preserves _≈₂_ ⟶ _≈₁_ + inverse : Inverseᵇ f f⁻¹ + + inverseˡ : Inverseˡ f f⁻¹ + inverseˡ = proj₁ inverse + + inverseʳ : Inverseʳ f f⁻¹ + inverseʳ = proj₂ inverse + + leftInverse : LeftInverse + leftInverse = record + { cong₁ = cong₁ + ; cong₂ = cong₂ + ; inverseˡ = inverseˡ + } + + rightInverse : RightInverse + rightInverse = record + { cong₁ = cong₁ + ; cong₂ = cong₂ + ; inverseʳ = inverseʳ + } + + open LeftInverse leftInverse public using (isLeftInverse) + open RightInverse rightInverse public using (isRightInverse) + + isInverse : IsInverse f f⁻¹ + isInverse = record + { isLeftInverse = isLeftInverse + ; inverseʳ = inverseʳ + } + + open IsInverse isInverse public using (module Eq₁; module Eq₂) + + +------------------------------------------------------------------------ +-- Bundles with three elements + + record BiEquivalence : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f : A → B + g₁ : B → A + g₂ : B → A + cong₁ : f Preserves _≈₁_ ⟶ _≈₂_ + cong₂ : g₁ Preserves _≈₂_ ⟶ _≈₁_ + cong₃ : g₂ Preserves _≈₂_ ⟶ _≈₁_ + + + record BiInverse : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f : A → B + g₁ : B → A + g₂ : B → A + cong₁ : f Preserves _≈₁_ ⟶ _≈₂_ + cong₂ : g₁ Preserves _≈₂_ ⟶ _≈₁_ + cong₃ : g₂ Preserves _≈₂_ ⟶ _≈₁_ + inverseˡ : Inverseˡ f g₁ + inverseʳ : Inverseʳ f g₂ + + f-isCongruent : IsCongruent f + f-isCongruent = record + { cong = cong₁ + ; isEquivalence₁ = isEquivalence From + ; isEquivalence₂ = isEquivalence To + } + + isBiInverse : IsBiInverse f g₁ g₂ + isBiInverse = record + { f-isCongruent = f-isCongruent + ; cong₂ = cong₂ + ; inverseˡ = inverseˡ + ; cong₃ = cong₃ + ; inverseʳ = inverseʳ + } + + biEquivalence : BiEquivalence + biEquivalence = record + { cong₁ = cong₁ + ; cong₂ = cong₂ + ; cong₃ = cong₃ + } + + +------------------------------------------------------------------------ +-- Bundles specialised for propositional equality +------------------------------------------------------------------------ + +infix 3 _⟶_ _↣_ _↠_ _⤖_ _⇔_ _↩_ _↪_ _↩↪_ _↔_ +_⟶_ : Set a → Set b → Set _ +A ⟶ B = Func (≡.setoid A) (≡.setoid B) + +_↣_ : Set a → Set b → Set _ +A ↣ B = Injection (≡.setoid A) (≡.setoid B) + +_↠_ : Set a → Set b → Set _ +A ↠ B = Surjection (≡.setoid A) (≡.setoid B) + +_⤖_ : Set a → Set b → Set _ +A ⤖ B = Bijection (≡.setoid A) (≡.setoid B) + +_⇔_ : Set a → Set b → Set _ +A ⇔ B = Equivalence (≡.setoid A) (≡.setoid B) + +_↩_ : Set a → Set b → Set _ +A ↩ B = LeftInverse (≡.setoid A) (≡.setoid B) + +_↪_ : Set a → Set b → Set _ +A ↪ B = RightInverse (≡.setoid A) (≡.setoid B) + +_↩↪_ : Set a → Set b → Set _ +A ↩↪ B = BiInverse (≡.setoid A) (≡.setoid B) + +_↔_ : Set a → Set b → Set _ +A ↔ B = Inverse (≡.setoid A) (≡.setoid B) + +-- We now define some constructors for the above that +-- automatically provide the required congruency proofs. + +module _ {A : Set a} {B : Set b} where + + open FunctionDefinitions {A = A} {B} _≡_ _≡_ + + mk⟶ : (A → B) → A ⟶ B + mk⟶ f = record + { f = f + ; cong = ≡.cong f + } + + mk↣ : ∀ {f : A → B} → Injective f → A ↣ B + mk↣ {f} inj = record + { f = f + ; cong = ≡.cong f + ; injective = inj + } + + mk↠ : ∀ {f : A → B} → Surjective f → A ↠ B + mk↠ {f} surj = record + { f = f + ; cong = ≡.cong f + ; surjective = surj + } + + mk⤖ : ∀ {f : A → B} → Bijective f → A ⤖ B + mk⤖ {f} bij = record + { f = f + ; cong = ≡.cong f + ; bijective = bij + } + + mk⇔ : ∀ (f : A → B) (g : B → A) → A ⇔ B + mk⇔ f g = record + { f = f + ; g = g + ; cong₁ = ≡.cong f + ; cong₂ = ≡.cong g + } + + mk↩ : ∀ {f : A → B} {g : B → A} → Inverseˡ f g → A ↩ B + mk↩ {f} {g} invˡ = record + { f = f + ; g = g + ; cong₁ = ≡.cong f + ; cong₂ = ≡.cong g + ; inverseˡ = invˡ + } + + mk↪ : ∀ {f : A → B} {g : B → A} → Inverseʳ f g → A ↪ B + mk↪ {f} {g} invʳ = record + { f = f + ; g = g + ; cong₁ = ≡.cong f + ; cong₂ = ≡.cong g + ; inverseʳ = invʳ + } + + mk↩↪ : ∀ {f : A → B} {g₁ : B → A} {g₂ : B → A} → + Inverseˡ f g₁ → Inverseʳ f g₂ → A ↩↪ B + mk↩↪ {f} {g₁} {g₂} invˡ invʳ = record + { f = f + ; g₁ = g₁ + ; g₂ = g₂ + ; cong₁ = ≡.cong f + ; cong₂ = ≡.cong g₁ + ; cong₃ = ≡.cong g₂ + ; inverseˡ = invˡ + ; inverseʳ = invʳ + } + + mk↔ : ∀ {f : A → B} {f⁻¹ : B → A} → Inverseᵇ f f⁻¹ → A ↔ B + mk↔ {f} {f⁻¹} inv = record + { f = f + ; f⁻¹ = f⁻¹ + ; cong₁ = ≡.cong f + ; cong₂ = ≡.cong f⁻¹ + ; inverse = inv + } + + -- Sometimes the implicit arguments above cannot be inferred + mk↔′ : ∀ (f : A → B) (f⁻¹ : B → A) → Inverseˡ f f⁻¹ → Inverseʳ f f⁻¹ → A ↔ B + mk↔′ f f⁻¹ invˡ invʳ = mk↔ {f = f} {f⁻¹ = f⁻¹} (invˡ , invʳ) +\ No newline at end of file diff --git a/docs/Function.Construct.Identity.html b/docs/Function.Construct.Identity.html new file mode 100644 index 0000000..f519529 --- /dev/null +++ b/docs/Function.Construct.Identity.html @@ -0,0 +1,204 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- The identity function +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Construct.Identity where + +open import Data.Product using (_,_) +open import Function.Base using (id) +open import Function.Bundles +import Function.Definitions as Definitions +import Function.Structures as Structures +open import Level +open import Relation.Binary as B hiding (_⇔_; IsEquivalence) +open import Relation.Binary.PropositionalEquality using (_≡_; setoid) + +private + variable + a ℓ : Level + A : Set a + +------------------------------------------------------------------------ +-- Properties + +module _ (_≈_ : Rel A ℓ) where + + open Definitions _≈_ _≈_ + + congruent : Congruent id + congruent = id + + injective : Injective id + injective = id + + surjective : Reflexive _≈_ → Surjective id + surjective refl x = x , refl + + bijective : Reflexive _≈_ → Bijective id + bijective refl = injective , surjective refl + + inverseˡ : Reflexive _≈_ → Inverseˡ id id + inverseˡ refl x = refl + + inverseʳ : Reflexive _≈_ → Inverseʳ id id + inverseʳ refl x = refl + + inverseᵇ : Reflexive _≈_ → Inverseᵇ id id + inverseᵇ refl = inverseˡ refl , inverseʳ refl + +------------------------------------------------------------------------ +-- Structures + +module _ {_≈_ : Rel A ℓ} (isEq : B.IsEquivalence _≈_) where + + open Structures _≈_ _≈_ + open B.IsEquivalence isEq + + isCongruent : IsCongruent id + isCongruent = record + { cong = id + ; isEquivalence₁ = isEq + ; isEquivalence₂ = isEq + } + + isInjection : IsInjection id + isInjection = record + { isCongruent = isCongruent + ; injective = injective _≈_ + } + + isSurjection : IsSurjection id + isSurjection = record + { isCongruent = isCongruent + ; surjective = surjective _≈_ refl + } + + isBijection : IsBijection id + isBijection = record + { isInjection = isInjection + ; surjective = surjective _≈_ refl + } + + isLeftInverse : IsLeftInverse id id + isLeftInverse = record + { isCongruent = isCongruent + ; cong₂ = id + ; inverseˡ = inverseˡ _≈_ refl + } + + isRightInverse : IsRightInverse id id + isRightInverse = record + { isCongruent = isCongruent + ; cong₂ = id + ; inverseʳ = inverseʳ _≈_ refl + } + + isInverse : IsInverse id id + isInverse = record + { isLeftInverse = isLeftInverse + ; inverseʳ = inverseʳ _≈_ refl + } + +------------------------------------------------------------------------ +-- Setoid bundles + +module _ (S : Setoid a ℓ) where + + open Setoid S + + function : Func S S + function = record + { f = id + ; cong = id + } + + injection : Injection S S + injection = record + { f = id + ; cong = id + ; injective = injective _≈_ + } + + surjection : Surjection S S + surjection = record + { f = id + ; cong = id + ; surjective = surjective _≈_ refl + } + + bijection : Bijection S S + bijection = record + { f = id + ; cong = id + ; bijective = bijective _≈_ refl + } + + equivalence : Equivalence S S + equivalence = record + { f = id + ; g = id + ; cong₁ = id + ; cong₂ = id + } + + leftInverse : LeftInverse S S + leftInverse = record + { f = id + ; g = id + ; cong₁ = id + ; cong₂ = id + ; inverseˡ = inverseˡ _≈_ refl + } + + rightInverse : RightInverse S S + rightInverse = record + { f = id + ; g = id + ; cong₁ = id + ; cong₂ = id + ; inverseʳ = inverseʳ _≈_ refl + } + + inverse : Inverse S S + inverse = record + { f = id + ; f⁻¹ = id + ; cong₁ = id + ; cong₂ = id + ; inverse = inverseᵇ _≈_ refl + } + +------------------------------------------------------------------------ +-- Propositional bundles + +module _ (A : Set a) where + + id-⟶ : A ⟶ A + id-⟶ = function (setoid A) + + id-↣ : A ↣ A + id-↣ = injection (setoid A) + + id-↠ : A ↠ A + id-↠ = surjection (setoid A) + + id-⤖ : A ⤖ A + id-⤖ = bijection (setoid A) + + id-⇔ : A ⇔ A + id-⇔ = equivalence (setoid A) + + id-↩ : A ↩ A + id-↩ = leftInverse (setoid A) + + id-↪ : A ↪ A + id-↪ = rightInverse (setoid A) + + id-↔ : A ↔ A + id-↔ = inverse (setoid A) +\ No newline at end of file diff --git a/docs/Function.Core.html b/docs/Function.Core.html new file mode 100644 index 0000000..d36bc7e --- /dev/null +++ b/docs/Function.Core.html @@ -0,0 +1,30 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Core definitions for Functions +------------------------------------------------------------------------ + +-- The contents of this file should usually be accessed from `Function`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Core where + +open import Level using (_⊔_) + +------------------------------------------------------------------------ +-- Types + +Fun₁ : ∀ {a} → Set a → Set a +Fun₁ A = A → A + +Fun₂ : ∀ {a} → Set a → Set a +Fun₂ A = A → A → A + +------------------------------------------------------------------------ +-- Morphism + +Morphism : ∀ {a} → ∀ {b} → Set a → Set b → Set (a ⊔ b) +Morphism A B = A → B +\ No newline at end of file diff --git a/docs/Function.Definitions.Core1.html b/docs/Function.Definitions.Core1.html new file mode 100644 index 0000000..90405c2 --- /dev/null +++ b/docs/Function.Definitions.Core1.html @@ -0,0 +1,27 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Definitions for types of functions that only require an equality +-- relation over the domain. +------------------------------------------------------------------------ + +-- The contents of this file should usually be accessed from `Function`. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Function.Definitions.Core1 + {a ℓ₁} {A : Set a} (_≈₁_ : Rel A ℓ₁) + where + +open import Level using (_⊔_) + +------------------------------------------------------------------------ +-- Definitions + +-- (Note the name `RightInverse` is used for the bundle) +Inverseʳ : ∀ {b} {B : Set b} → (A → B) → (B → A) → Set (a ⊔ ℓ₁) +Inverseʳ f g = ∀ x → g (f x) ≈₁ x +\ No newline at end of file diff --git a/docs/Function.Definitions.Core2.html b/docs/Function.Definitions.Core2.html new file mode 100644 index 0000000..a1e7ace --- /dev/null +++ b/docs/Function.Definitions.Core2.html @@ -0,0 +1,31 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Definitions for types of functions that only require an equality +-- relation over the co-domain. +------------------------------------------------------------------------ + +-- The contents of this file should usually be accessed from `Function`. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Function.Definitions.Core2 + {b ℓ₂} {B : Set b} (_≈₂_ : Rel B ℓ₂) + where + +open import Data.Product using (∃) +open import Level using (Level; _⊔_) + +------------------------------------------------------------------------ +-- Definitions + +Surjective : ∀ {a} {A : Set a} → (A → B) → Set (a ⊔ b ⊔ ℓ₂) +Surjective f = ∀ y → ∃ λ x → f x ≈₂ y + +-- (Note the name `LeftInverse` is used for the bundle) +Inverseˡ : ∀ {a} {A : Set a} → (A → B) → (B → A) → Set (b ⊔ ℓ₂) +Inverseˡ f g = ∀ x → f (g x) ≈₂ x +\ No newline at end of file diff --git a/docs/Function.Definitions.html b/docs/Function.Definitions.html new file mode 100644 index 0000000..a7c2b83 --- /dev/null +++ b/docs/Function.Definitions.html @@ -0,0 +1,49 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Definitions for types of functions. +------------------------------------------------------------------------ + +-- The contents of this file should usually be accessed from `Function`. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Function.Definitions + {a b ℓ₁ ℓ₂} {A : Set a} {B : Set b} + (_≈₁_ : Rel A ℓ₁) -- Equality over the domain + (_≈₂_ : Rel B ℓ₂) -- Equality over the codomain + where + +open import Data.Product using (∃; _×_) +import Function.Definitions.Core1 as Core₁ +import Function.Definitions.Core2 as Core₂ +open import Function.Base +open import Level using (_⊔_) + +------------------------------------------------------------------------ +-- Definitions + +Congruent : (A → B) → Set (a ⊔ ℓ₁ ⊔ ℓ₂) +Congruent f = ∀ {x y} → x ≈₁ y → f x ≈₂ f y + +Injective : (A → B) → Set (a ⊔ ℓ₁ ⊔ ℓ₂) +Injective f = ∀ {x y} → f x ≈₂ f y → x ≈₁ y + +open Core₂ _≈₂_ public + using (Surjective) + +Bijective : (A → B) → Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) +Bijective f = Injective f × Surjective f + +open Core₂ _≈₂_ public + using (Inverseˡ) + +open Core₁ _≈₁_ public + using (Inverseʳ) + +Inverseᵇ : (A → B) → (B → A) → Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) +Inverseᵇ f g = Inverseˡ f g × Inverseʳ f g +\ No newline at end of file diff --git a/docs/Function.Equality.html b/docs/Function.Equality.html new file mode 100644 index 0000000..dfb9f0a --- /dev/null +++ b/docs/Function.Equality.html @@ -0,0 +1,126 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Function setoids and related constructions +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +-- Note: use of the standard function hierarchy is encouraged. The +-- module `Function` re-exports `Congruent`, `IsBijection` and +-- `Bijection`. The alternative definitions found in this file will +-- eventually be deprecated. + +module Function.Equality where + +import Function.Base as Fun +open import Level +open import Relation.Binary using (Setoid) +open import Relation.Binary.Indexed.Heterogeneous + using (IndexedSetoid; _=[_]⇒_) +import Relation.Binary.Indexed.Heterogeneous.Construct.Trivial + as Trivial + +------------------------------------------------------------------------ +-- Functions which preserve equality + +record Π {f₁ f₂ t₁ t₂} + (From : Setoid f₁ f₂) + (To : IndexedSetoid (Setoid.Carrier From) t₁ t₂) : + Set (f₁ ⊔ f₂ ⊔ t₁ ⊔ t₂) where + infixl 5 _⟨$⟩_ + field + _⟨$⟩_ : (x : Setoid.Carrier From) → IndexedSetoid.Carrier To x + cong : Setoid._≈_ From =[ _⟨$⟩_ ]⇒ IndexedSetoid._≈_ To + +open Π public + +infixr 0 _⟶_ + +_⟶_ : ∀ {f₁ f₂ t₁ t₂} → Setoid f₁ f₂ → Setoid t₁ t₂ → Set _ +From ⟶ To = Π From (Trivial.indexedSetoid To) + +------------------------------------------------------------------------ +-- Identity and composition. + +id : ∀ {a₁ a₂} {A : Setoid a₁ a₂} → A ⟶ A +id = record { _⟨$⟩_ = Fun.id; cong = Fun.id } + +infixr 9 _∘_ + +_∘_ : ∀ {a₁ a₂} {A : Setoid a₁ a₂} + {b₁ b₂} {B : Setoid b₁ b₂} + {c₁ c₂} {C : Setoid c₁ c₂} → + B ⟶ C → A ⟶ B → A ⟶ C +f ∘ g = record + { _⟨$⟩_ = Fun._∘_ (_⟨$⟩_ f) (_⟨$⟩_ g) + ; cong = Fun._∘_ (cong f) (cong g) + } + +-- Constant equality-preserving function. + +const : ∀ {a₁ a₂} {A : Setoid a₁ a₂} + {b₁ b₂} {B : Setoid b₁ b₂} → + Setoid.Carrier B → A ⟶ B +const {B = B} b = record + { _⟨$⟩_ = Fun.const b + ; cong = Fun.const (Setoid.refl B) + } + +------------------------------------------------------------------------ +-- Function setoids + +-- Dependent. + +setoid : ∀ {f₁ f₂ t₁ t₂} + (From : Setoid f₁ f₂) → + IndexedSetoid (Setoid.Carrier From) t₁ t₂ → + Setoid _ _ +setoid From To = record + { Carrier = Π From To + ; _≈_ = λ f g → ∀ {x y} → x ≈₁ y → f ⟨$⟩ x ≈₂ g ⟨$⟩ y + ; isEquivalence = record + { refl = λ {f} → cong f + ; sym = λ f∼g x∼y → To.sym (f∼g (From.sym x∼y)) + ; trans = λ f∼g g∼h x∼y → To.trans (f∼g From.refl) (g∼h x∼y) + } + } + where + open module From = Setoid From using () renaming (_≈_ to _≈₁_) + open module To = IndexedSetoid To using () renaming (_≈_ to _≈₂_) + +-- Non-dependent. + +infixr 0 _⇨_ + +_⇨_ : ∀ {f₁ f₂ t₁ t₂} → Setoid f₁ f₂ → Setoid t₁ t₂ → Setoid _ _ +From ⇨ To = setoid From (Trivial.indexedSetoid To) + +-- A variant of setoid which uses the propositional equality setoid +-- for the domain, and a more convenient definition of _≈_. + +≡-setoid : ∀ {f t₁ t₂} (From : Set f) → IndexedSetoid From t₁ t₂ → Setoid _ _ +≡-setoid From To = record + { Carrier = (x : From) → Carrier x + ; _≈_ = λ f g → ∀ x → f x ≈ g x + ; isEquivalence = record + { refl = λ {f} x → refl + ; sym = λ f∼g x → sym (f∼g x) + ; trans = λ f∼g g∼h x → trans (f∼g x) (g∼h x) + } + } where open IndexedSetoid To + +-- Parameter swapping function. + +flip : ∀ {a₁ a₂} {A : Setoid a₁ a₂} + {b₁ b₂} {B : Setoid b₁ b₂} + {c₁ c₂} {C : Setoid c₁ c₂} → + A ⟶ B ⇨ C → B ⟶ A ⇨ C +flip {B = B} f = record + { _⟨$⟩_ = λ b → record + { _⟨$⟩_ = λ a → f ⟨$⟩ a ⟨$⟩ b + ; cong = λ a₁≈a₂ → cong f a₁≈a₂ (Setoid.refl B) } + ; cong = λ b₁≈b₂ a₁≈a₂ → cong f a₁≈a₂ b₁≈b₂ + } +\ No newline at end of file diff --git a/docs/Function.Equivalence.html b/docs/Function.Equivalence.html new file mode 100644 index 0000000..c637000 --- /dev/null +++ b/docs/Function.Equivalence.html @@ -0,0 +1,130 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Equivalence (coinhabitance) +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Equivalence where + +-- Note: use of the standard function hierarchy is encouraged. The +-- module `Function` re-exports `Congruent` and `IsCongruent`. +-- The alternative definitions found in this file will eventually be +-- deprecated. + +open import Function.Base using (flip) +open import Function.Equality as F + using (_⟶_; _⟨$⟩_) renaming (_∘_ to _⟪∘⟫_) +open import Level +open import Relation.Binary hiding (_⇔_) +import Relation.Binary.PropositionalEquality as P + +------------------------------------------------------------------------ +-- Setoid equivalence + +record Equivalence {f₁ f₂ t₁ t₂} + (From : Setoid f₁ f₂) (To : Setoid t₁ t₂) : + Set (f₁ ⊔ f₂ ⊔ t₁ ⊔ t₂) where + field + to : From ⟶ To + from : To ⟶ From + +------------------------------------------------------------------------ +-- The set of all equivalences between two sets (i.e. equivalences +-- with propositional equality) + +infix 3 _⇔_ + +_⇔_ : ∀ {f t} → Set f → Set t → Set _ +From ⇔ To = Equivalence (P.setoid From) (P.setoid To) + +equivalence : ∀ {f t} {From : Set f} {To : Set t} → + (From → To) → (To → From) → From ⇔ To +equivalence to from = record + { to = P.→-to-⟶ to + ; from = P.→-to-⟶ from + } + +------------------------------------------------------------------------ +-- Equivalence is an equivalence relation + +-- Identity and composition (reflexivity and transitivity). + +id : ∀ {s₁ s₂} → Reflexive (Equivalence {s₁} {s₂}) +id {x = S} = record + { to = F.id + ; from = F.id + } + +infixr 9 _∘_ + +_∘_ : ∀ {f₁ f₂ m₁ m₂ t₁ t₂} → + TransFlip (Equivalence {f₁} {f₂} {m₁} {m₂}) + (Equivalence {m₁} {m₂} {t₁} {t₂}) + (Equivalence {f₁} {f₂} {t₁} {t₂}) +f ∘ g = record + { to = to f ⟪∘⟫ to g + ; from = from g ⟪∘⟫ from f + } where open Equivalence + +-- Symmetry. + +sym : ∀ {f₁ f₂ t₁ t₂} → + Sym (Equivalence {f₁} {f₂} {t₁} {t₂}) + (Equivalence {t₁} {t₂} {f₁} {f₂}) +sym eq = record + { from = to + ; to = from + } where open Equivalence eq + +-- For fixed universe levels we can construct setoids. + +setoid : (s₁ s₂ : Level) → Setoid (suc (s₁ ⊔ s₂)) (s₁ ⊔ s₂) +setoid s₁ s₂ = record + { Carrier = Setoid s₁ s₂ + ; _≈_ = Equivalence + ; isEquivalence = record + { refl = id + ; sym = sym + ; trans = flip _∘_ + } + } + +⇔-setoid : (ℓ : Level) → Setoid (suc ℓ) ℓ +⇔-setoid ℓ = record + { Carrier = Set ℓ + ; _≈_ = _⇔_ + ; isEquivalence = record + { refl = id + ; sym = sym + ; trans = flip _∘_ + } + } + +------------------------------------------------------------------------ +-- Transformations + +map : ∀ {f₁ f₂ t₁ t₂} {From : Setoid f₁ f₂} {To : Setoid t₁ t₂} + {f₁′ f₂′ t₁′ t₂′} + {From′ : Setoid f₁′ f₂′} {To′ : Setoid t₁′ t₂′} → + ((From ⟶ To) → (From′ ⟶ To′)) → + ((To ⟶ From) → (To′ ⟶ From′)) → + Equivalence From To → Equivalence From′ To′ +map t f eq = record { to = t to; from = f from } + where open Equivalence eq + +zip : ∀ {f₁₁ f₂₁ t₁₁ t₂₁} + {From₁ : Setoid f₁₁ f₂₁} {To₁ : Setoid t₁₁ t₂₁} + {f₁₂ f₂₂ t₁₂ t₂₂} + {From₂ : Setoid f₁₂ f₂₂} {To₂ : Setoid t₁₂ t₂₂} + {f₁ f₂ t₁ t₂} {From : Setoid f₁ f₂} {To : Setoid t₁ t₂} → + ((From₁ ⟶ To₁) → (From₂ ⟶ To₂) → (From ⟶ To)) → + ((To₁ ⟶ From₁) → (To₂ ⟶ From₂) → (To ⟶ From)) → + Equivalence From₁ To₁ → Equivalence From₂ To₂ → + Equivalence From To +zip t f eq₁ eq₂ = + record { to = t (to eq₁) (to eq₂); from = f (from eq₁) (from eq₂) } + where open Equivalence +\ No newline at end of file diff --git a/docs/Function.Injection.html b/docs/Function.Injection.html new file mode 100644 index 0000000..cfec473 --- /dev/null +++ b/docs/Function.Injection.html @@ -0,0 +1,80 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Injections +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +-- Note: use of the standard function hierarchy is encouraged. The +-- module `Function` re-exports `Injective`, `IsInjection` and +-- `Injection`. The alternative definitions found in this file will +-- eventually be deprecated. + +module Function.Injection where + +open import Function as Fun using () renaming (_∘_ to _⟨∘⟩_) +open import Level +open import Relation.Binary +open import Function.Equality as F + using (_⟶_; _⟨$⟩_ ; Π) renaming (_∘_ to _⟪∘⟫_) +open import Relation.Binary.PropositionalEquality as P using (_≡_) + +------------------------------------------------------------------------ +-- Injective functions + +Injective : ∀ {a₁ a₂ b₁ b₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} → + A ⟶ B → Set _ +Injective {A = A} {B} f = ∀ {x y} → f ⟨$⟩ x ≈₂ f ⟨$⟩ y → x ≈₁ y + where + open Setoid A renaming (_≈_ to _≈₁_) + open Setoid B renaming (_≈_ to _≈₂_) + +------------------------------------------------------------------------ +-- The set of all injections between two setoids + +record Injection {f₁ f₂ t₁ t₂} + (From : Setoid f₁ f₂) (To : Setoid t₁ t₂) : + Set (f₁ ⊔ f₂ ⊔ t₁ ⊔ t₂) where + field + to : From ⟶ To + injective : Injective to + + open Π to public + +------------------------------------------------------------------------ +-- The set of all injections from one set to another (i.e. injections +-- with propositional equality) + +infix 3 _↣_ + +_↣_ : ∀ {f t} → Set f → Set t → Set _ +From ↣ To = Injection (P.setoid From) (P.setoid To) + +injection : ∀ {f t} {From : Set f} {To : Set t} → (to : From → To) → + (∀ {x y} → to x ≡ to y → x ≡ y) → From ↣ To +injection to injective = record + { to = P.→-to-⟶ to + ; injective = injective + } + +------------------------------------------------------------------------ +-- Identity and composition. + +infixr 9 _∘_ + +id : ∀ {s₁ s₂} {S : Setoid s₁ s₂} → Injection S S +id = record + { to = F.id + ; injective = Fun.id + } + +_∘_ : ∀ {f₁ f₂ m₁ m₂ t₁ t₂} + {F : Setoid f₁ f₂} {M : Setoid m₁ m₂} {T : Setoid t₁ t₂} → + Injection M T → Injection F M → Injection F T +f ∘ g = record + { to = to f ⟪∘⟫ to g + ; injective = (λ {_} → injective g) ⟨∘⟩ injective f + } where open Injection +\ No newline at end of file diff --git a/docs/Function.Metric.Bundles.html b/docs/Function.Metric.Bundles.html new file mode 100644 index 0000000..b2fc420 --- /dev/null +++ b/docs/Function.Metric.Bundles.html @@ -0,0 +1,144 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Bundles for metrics +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via `Function.Metric`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Metric.Bundles where + +open import Algebra.Core using (Op₂) +open import Level using (Level; suc; _⊔_) +open import Relation.Binary.Core using (Rel) + +open import Function.Metric.Structures +open import Function.Metric.Core + +------------------------------------------------------------------------ +-- ProtoMetric + +record ProtoMetric (a i ℓ₁ ℓ₂ ℓ₃ : Level) + : Set (suc (a ⊔ i ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃)) where + field + Carrier : Set a + Image : Set i + _≈_ : Rel Carrier ℓ₁ + _≈ᵢ_ : Rel Image ℓ₂ + _≤_ : Rel Image ℓ₃ + 0# : Image + d : DistanceFunction Carrier Image + isProtoMetric : IsProtoMetric _≈_ _≈ᵢ_ _≤_ 0# d + + open IsProtoMetric isProtoMetric public + +------------------------------------------------------------------------ +-- PreMetric + +record PreMetric (a i ℓ₁ ℓ₂ ℓ₃ : Level) + : Set (suc (a ⊔ i ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃)) where + field + Carrier : Set a + Image : Set i + _≈_ : Rel Carrier ℓ₁ + _≈ᵢ_ : Rel Image ℓ₂ + _≤_ : Rel Image ℓ₃ + 0# : Image + d : DistanceFunction Carrier Image + isPreMetric : IsPreMetric _≈_ _≈ᵢ_ _≤_ 0# d + + open IsPreMetric isPreMetric public + + protoMetric : ProtoMetric a i ℓ₁ ℓ₂ ℓ₃ + protoMetric = record + { isProtoMetric = isProtoMetric + } + +------------------------------------------------------------------------ +-- QuasiSemiMetric + +record QuasiSemiMetric (a i ℓ₁ ℓ₂ ℓ₃ : Level) + : Set (suc (a ⊔ i ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃)) where + field + Carrier : Set a + Image : Set i + _≈_ : Rel Carrier ℓ₁ + _≈ᵢ_ : Rel Image ℓ₂ + _≤_ : Rel Image ℓ₃ + 0# : Image + d : DistanceFunction Carrier Image + isQuasiSemiMetric : IsQuasiSemiMetric _≈_ _≈ᵢ_ _≤_ 0# d + + open IsQuasiSemiMetric isQuasiSemiMetric public + + preMetric : PreMetric a i ℓ₁ ℓ₂ ℓ₃ + preMetric = record + { isPreMetric = isPreMetric + } + + open PreMetric preMetric public + using (protoMetric) + +------------------------------------------------------------------------ +-- SemiMetric + +record SemiMetric (a i ℓ₁ ℓ₂ ℓ₃ : Level) + : Set (suc (a ⊔ i ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃)) where + field + Carrier : Set a + Image : Set i + _≈_ : Rel Carrier ℓ₁ + _≈ᵢ_ : Rel Image ℓ₂ + _≤_ : Rel Image ℓ₃ + 0# : Image + d : DistanceFunction Carrier Image + isSemiMetric : IsSemiMetric _≈_ _≈ᵢ_ _≤_ 0# d + + open IsSemiMetric isSemiMetric public + + quasiSemiMetric : QuasiSemiMetric a i ℓ₁ ℓ₂ ℓ₃ + quasiSemiMetric = record + { isQuasiSemiMetric = isQuasiSemiMetric + } + + open QuasiSemiMetric quasiSemiMetric public + using (protoMetric; preMetric) + +------------------------------------------------------------------------ +-- GeneralMetric + +-- Note that this package is not necessarily a metric in the classical +-- sense as there is no way to ensure that the _∙_ operator really +-- represents addition. See `Function.Metric.Nat` and +-- `Function.Metric.Rational` for more specialised `Metric` and +-- `UltraMetric` packages. + +-- See the discussion accompanying the `IsGeneralMetric` structure for +-- more details. + +record GeneralMetric (a i ℓ₁ ℓ₂ ℓ₃ : Level) + : Set (suc (a ⊔ i ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃)) where + field + Carrier : Set a + Image : Set i + _≈_ : Rel Carrier ℓ₁ + _≈ᵢ_ : Rel Image ℓ₂ + _≤_ : Rel Image ℓ₃ + 0# : Image + _∙_ : Op₂ Image + d : DistanceFunction Carrier Image + isGeneralMetric : IsGeneralMetric _≈_ _≈ᵢ_ _≤_ 0# _∙_ d + + open IsGeneralMetric isGeneralMetric public + + semiMetric : SemiMetric a i ℓ₁ ℓ₂ ℓ₃ + semiMetric = record + { isSemiMetric = isSemiMetric + } + + open SemiMetric semiMetric public + using (protoMetric; preMetric; quasiSemiMetric) +\ No newline at end of file diff --git a/docs/Function.Metric.Core.html b/docs/Function.Metric.Core.html new file mode 100644 index 0000000..2f68377 --- /dev/null +++ b/docs/Function.Metric.Core.html @@ -0,0 +1,22 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Core metric definitions +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Metric.Core where + +open import Level using (Level) +private + variable + a i : Level + +------------------------------------------------------------------------ +-- Distance functions + +DistanceFunction : Set a → Set i → Set _ +DistanceFunction A I = A → A → I +\ No newline at end of file diff --git a/docs/Function.Metric.Definitions.html b/docs/Function.Metric.Definitions.html new file mode 100644 index 0000000..41700e2 --- /dev/null +++ b/docs/Function.Metric.Definitions.html @@ -0,0 +1,65 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Definitions of properties over distance functions +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via `Function.Metric`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Metric.Definitions where + +open import Algebra.Core using (Op₂) +open import Data.Product using (∃) +open import Function.Metric.Core using (DistanceFunction) +open import Level using (Level) +open import Relation.Binary.Core using (Rel; _Preserves₂_⟶_⟶_) +open import Relation.Nullary using (¬_) + +private + variable + a i ℓ ℓ₁ ℓ₂ : Level + A : Set a + I : Set i + +----------------------------------------------------------------------- +-- Properties + +Congruent : Rel A ℓ₁ → Rel I ℓ₂ → DistanceFunction A I → Set _ +Congruent _≈ₐ_ _≈ᵢ_ d = d Preserves₂ _≈ₐ_ ⟶ _≈ₐ_ ⟶ _≈ᵢ_ + +Indiscernable : Rel A ℓ₁ → Rel I ℓ₂ → DistanceFunction A I → I → Set _ +Indiscernable _≈ₐ_ _≈ᵢ_ d 0# = ∀ {x y} → d x y ≈ᵢ 0# → x ≈ₐ y + +Definite : Rel A ℓ₁ → Rel I ℓ₂ → DistanceFunction A I → I → Set _ +Definite _≈ₐ_ _≈ᵢ_ d 0# = ∀ {x y} → x ≈ₐ y → d x y ≈ᵢ 0# + +NonNegative : Rel I ℓ₂ → DistanceFunction A I → I → Set _ +NonNegative _≤_ d 0# = ∀ {x y} → 0# ≤ d x y + +Symmetric : Rel I ℓ → DistanceFunction A I → Set _ +Symmetric _≈_ d = ∀ x y → d x y ≈ d y x + +TriangleInequality : Rel I ℓ → Op₂ I → DistanceFunction A I → _ +TriangleInequality _≤_ _∙_ d = ∀ x y z → d x z ≤ (d x y ∙ d y z) + +Bounded : Rel I ℓ → DistanceFunction A I → Set _ +Bounded _≤_ d = ∃ λ n → ∀ x y → d x y ≤ n + +TranslationInvariant : Rel I ℓ₂ → Op₂ A → DistanceFunction A I → Set _ +TranslationInvariant _≈_ _∙_ d = ∀ {x y a} → d (x ∙ a) (y ∙ a) ≈ d x y + +Contracting : Rel I ℓ → (A → A) → DistanceFunction A I → Set _ +Contracting _≤_ f d = ∀ x y → d (f x) (f y) ≤ d x y + +ContractingOnOrbits : Rel I ℓ → (A → A) → DistanceFunction A I → Set _ +ContractingOnOrbits _≤_ f d = ∀ x → d (f x) (f (f x)) ≤ d x (f x) + +StrictlyContracting : Rel A ℓ₁ → Rel I ℓ₂ → (A → A) → DistanceFunction A I → Set _ +StrictlyContracting _≈_ _<_ f d = ∀ {x y} → ¬ (y ≈ x) → d (f x) (f y) < d x y + +StrictlyContractingOnOrbits : Rel A ℓ₁ → Rel I ℓ₂ → (A → A) → DistanceFunction A I → Set _ +StrictlyContractingOnOrbits _≈_ _<_ f d = ∀ {x} → ¬ (f x ≈ x) → d (f x) (f (f x)) < d x (f x) +\ No newline at end of file diff --git a/docs/Function.Metric.Nat.Bundles.html b/docs/Function.Metric.Nat.Bundles.html new file mode 100644 index 0000000..cf77cbe --- /dev/null +++ b/docs/Function.Metric.Nat.Bundles.html @@ -0,0 +1,136 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Bundles for metrics over ℕ +------------------------------------------------------------------------ + +-- Unfortunately, unlike definitions and structures, the bundles over +-- general metric spaces cannot be reused as it is impossible to +-- constrain the image set to ℕ. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Metric.Nat.Bundles where + +open import Data.Nat.Base hiding (suc; _⊔_) +open import Function using (const) +open import Level using (Level; suc; _⊔_) +open import Relation.Binary.Core +open import Relation.Binary.PropositionalEquality + using (_≡_; isEquivalence) + +open import Function.Metric.Nat.Core +open import Function.Metric.Nat.Structures +open import Function.Metric.Bundles as Base + using (GeneralMetric) + +------------------------------------------------------------------------ +-- Proto-metric + +record ProtoMetric a ℓ : Set (suc (a ⊔ ℓ)) where + field + Carrier : Set a + _≈_ : Rel Carrier ℓ + d : DistanceFunction Carrier + isProtoMetric : IsProtoMetric _≈_ d + + open IsProtoMetric isProtoMetric public + +------------------------------------------------------------------------ +-- PreMetric + +record PreMetric a ℓ : Set (suc (a ⊔ ℓ)) where + field + Carrier : Set a + _≈_ : Rel Carrier ℓ + d : DistanceFunction Carrier + isPreMetric : IsPreMetric _≈_ d + + open IsPreMetric isPreMetric public + + protoMetric : ProtoMetric a ℓ + protoMetric = record + { isProtoMetric = isProtoMetric + } + +------------------------------------------------------------------------ +-- QuasiSemiMetric + +record QuasiSemiMetric a ℓ : Set (suc (a ⊔ ℓ)) where + field + Carrier : Set a + _≈_ : Rel Carrier ℓ + d : DistanceFunction Carrier + isQuasiSemiMetric : IsQuasiSemiMetric _≈_ d + + open IsQuasiSemiMetric isQuasiSemiMetric public + + preMetric : PreMetric a ℓ + preMetric = record + { isPreMetric = isPreMetric + } + + open PreMetric preMetric public + using (protoMetric) + +------------------------------------------------------------------------ +-- SemiMetric + +record SemiMetric a ℓ : Set (suc (a ⊔ ℓ)) where + field + Carrier : Set a + _≈_ : Rel Carrier ℓ + d : DistanceFunction Carrier + isSemiMetric : IsSemiMetric _≈_ d + + open IsSemiMetric isSemiMetric public + + quasiSemiMetric : QuasiSemiMetric a ℓ + quasiSemiMetric = record + { isQuasiSemiMetric = isQuasiSemiMetric + } + + open QuasiSemiMetric quasiSemiMetric public + using (protoMetric; preMetric) + +------------------------------------------------------------------------ +-- Metrics + +record Metric a ℓ : Set (suc (a ⊔ ℓ)) where + field + Carrier : Set a + _≈_ : Rel Carrier ℓ + d : DistanceFunction Carrier + isMetric : IsMetric _≈_ d + + open IsMetric isMetric public + + semiMetric : SemiMetric a ℓ + semiMetric = record + { isSemiMetric = isSemiMetric + } + + open SemiMetric semiMetric public + using (protoMetric; preMetric; quasiSemiMetric) + +------------------------------------------------------------------------ +-- UltraMetrics + +record UltraMetric a ℓ : Set (suc (a ⊔ ℓ)) where + field + Carrier : Set a + _≈_ : Rel Carrier ℓ + d : DistanceFunction Carrier + isUltraMetric : IsUltraMetric _≈_ d + + open IsUltraMetric isUltraMetric public + + semiMetric : SemiMetric a ℓ + semiMetric = record + { isSemiMetric = isSemiMetric + } + + open SemiMetric semiMetric public + using (protoMetric; preMetric; quasiSemiMetric) +\ No newline at end of file diff --git a/docs/Function.Metric.Nat.Core.html b/docs/Function.Metric.Nat.Core.html new file mode 100644 index 0000000..287f868 --- /dev/null +++ b/docs/Function.Metric.Nat.Core.html @@ -0,0 +1,20 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Core definitions for metrics over ℕ +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Metric.Nat.Core where + +open import Data.Nat.Base using (ℕ) +import Function.Metric.Core as Base + +------------------------------------------------------------------------ +-- Definition + +DistanceFunction : ∀ {a} → Set a → Set a +DistanceFunction A = Base.DistanceFunction A ℕ +\ No newline at end of file diff --git a/docs/Function.Metric.Nat.Definitions.html b/docs/Function.Metric.Nat.Definitions.html new file mode 100644 index 0000000..8139c80 --- /dev/null +++ b/docs/Function.Metric.Nat.Definitions.html @@ -0,0 +1,70 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Core definitions for metrics over ℕ +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Metric.Nat.Definitions where + +open import Algebra.Core using (Op₂) +open import Data.Nat.Base +open import Level using (Level) +open import Relation.Binary.Core +open import Relation.Binary.PropositionalEquality.Core using (_≡_) + +open import Function.Metric.Nat.Core +import Function.Metric.Definitions as Base + +private + variable + a ℓ : Level + A : Set a + +------------------------------------------------------------------------ +-- Properties + +-- Basic + +Congruent : Rel A ℓ → DistanceFunction A → Set _ +Congruent _≈ₐ_ d = Base.Congruent _≈ₐ_ _≡_ d + +Indiscernable : Rel A ℓ → DistanceFunction A → Set _ +Indiscernable _≈ₐ_ d = Base.Indiscernable _≈ₐ_ _≡_ d 0 + +Definite : Rel A ℓ → DistanceFunction A → Set _ +Definite _≈ₐ_ d = Base.Definite _≈ₐ_ _≡_ d 0 + +Symmetric : DistanceFunction A → Set _ +Symmetric = Base.Symmetric _≡_ + +Bounded : DistanceFunction A → Set _ +Bounded = Base.Bounded _≤_ + +TranslationInvariant : Op₂ A → DistanceFunction A → Set _ +TranslationInvariant = Base.TranslationInvariant _≡_ + +-- Inequalities + +TriangleInequality : DistanceFunction A → Set _ +TriangleInequality = Base.TriangleInequality _≤_ _+_ + +MaxTriangleInequality : DistanceFunction A → Set _ +MaxTriangleInequality = Base.TriangleInequality _≤_ _⊔_ + +-- Contractions + +Contracting : (A → A) → DistanceFunction A → Set _ +Contracting = Base.Contracting _≤_ + +ContractingOnOrbits : (A → A) → DistanceFunction A → Set _ +ContractingOnOrbits = Base.ContractingOnOrbits _≤_ + +StrictlyContracting : Rel A ℓ → (A → A) → DistanceFunction A → Set _ +StrictlyContracting _≈_ = Base.StrictlyContracting _≈_ _<_ + +StrictlyContractingOnOrbits : Rel A ℓ → (A → A) → DistanceFunction A → Set _ +StrictlyContractingOnOrbits _≈_ = Base.StrictlyContractingOnOrbits _≈_ _<_ +\ No newline at end of file diff --git a/docs/Function.Metric.Nat.Structures.html b/docs/Function.Metric.Nat.Structures.html new file mode 100644 index 0000000..382a955 --- /dev/null +++ b/docs/Function.Metric.Nat.Structures.html @@ -0,0 +1,78 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Core definitions for metrics over ℕ +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Metric.Nat.Structures where + +open import Data.Nat.Base hiding (suc) +open import Function using (const) +open import Level using (Level; suc) +open import Relation.Binary hiding (Symmetric) +open import Relation.Binary.PropositionalEquality using (_≡_) + +open import Function.Metric.Nat.Core +open import Function.Metric.Nat.Definitions +import Function.Metric.Structures as Base + +private + variable + a ℓ : Level + A : Set a + +------------------------------------------------------------------------ +-- Proto-metrics + +IsProtoMetric : Rel A ℓ → DistanceFunction A → Set _ +IsProtoMetric _≈_ = Base.IsProtoMetric _≈_ _≡_ _≤_ 0 + +open Base using (module IsProtoMetric) public + +------------------------------------------------------------------------ +-- Pre-metrics + +IsPreMetric : Rel A ℓ → DistanceFunction A → Set _ +IsPreMetric _≈_ = Base.IsPreMetric _≈_ _≡_ _≤_ 0 + +open Base using (module IsPreMetric) public + +------------------------------------------------------------------------ +-- Quasi-semi-metrics + +IsQuasiSemiMetric : Rel A ℓ → DistanceFunction A → Set _ +IsQuasiSemiMetric _≈_ = Base.IsQuasiSemiMetric _≈_ _≡_ _≤_ 0 + +open Base using (module IsQuasiSemiMetric) public + +------------------------------------------------------------------------ +-- Semi-metrics + +IsSemiMetric : Rel A ℓ → DistanceFunction A → Set _ +IsSemiMetric _≈_ = Base.IsSemiMetric _≈_ _≡_ _≤_ 0 + +open Base using (module IsSemiMetric) public + +------------------------------------------------------------------------ +-- Metrics + +IsMetric : Rel A ℓ → DistanceFunction A → Set _ +IsMetric _≈_ = Base.IsGeneralMetric _≈_ _≡_ _≤_ 0 _+_ + +module IsMetric {_≈_ : Rel A ℓ} {d : DistanceFunction A} + (M : IsMetric _≈_ d) where + open Base.IsGeneralMetric M public + +------------------------------------------------------------------------ +-- Ultra-metrics + +IsUltraMetric : Rel A ℓ → DistanceFunction A → Set _ +IsUltraMetric _≈_ = Base.IsGeneralMetric _≈_ _≡_ _≤_ 0 _⊔_ + +module IsUltraMetric {_≈_ : Rel A ℓ} {d : DistanceFunction A} + (UM : IsUltraMetric _≈_ d) where + open Base.IsGeneralMetric UM public +\ No newline at end of file diff --git a/docs/Function.Metric.Nat.html b/docs/Function.Metric.Nat.html new file mode 100644 index 0000000..4707f54 --- /dev/null +++ b/docs/Function.Metric.Nat.html @@ -0,0 +1,16 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Metrics with ℕ as the codomain of the metric function +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function.Metric.Nat where + +open import Function.Metric.Nat.Core public +open import Function.Metric.Nat.Definitions public +open import Function.Metric.Nat.Structures public +open import Function.Metric.Nat.Bundles public +\ No newline at end of file diff --git a/docs/Function.Metric.Structures.html b/docs/Function.Metric.Structures.html new file mode 100644 index 0000000..4fac8bc --- /dev/null +++ b/docs/Function.Metric.Structures.html @@ -0,0 +1,98 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Some metric structures (not packed up with sets, operations, etc.) +------------------------------------------------------------------------ + +-- The contents of this module should usually be accessed via +-- `Function.Metric`. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary hiding (Symmetric) + +module Function.Metric.Structures + {a i ℓ₁ ℓ₂ ℓ₃} {A : Set a} {I : Set i} + (_≈ₐ_ : Rel A ℓ₁) (_≈ᵢ_ : Rel I ℓ₂) (_≤_ : Rel I ℓ₃) (0# : I) where + +open import Algebra.Core using (Op₂) +open import Function.Metric.Core +open import Function.Metric.Definitions +open import Level using (_⊔_) + +------------------------------------------------------------------------ +-- Proto-metrics + +-- We do not insist that the ordering relation is total as otherwise +-- we would exclude the real numbers. + +record IsProtoMetric (d : DistanceFunction A I) + : Set (a ⊔ i ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃) where + field + isPartialOrder : IsPartialOrder _≈ᵢ_ _≤_ + ≈-isEquivalence : IsEquivalence _≈ₐ_ + cong : Congruent _≈ₐ_ _≈ᵢ_ d + nonNegative : NonNegative _≤_ d 0# + + open IsPartialOrder isPartialOrder public + renaming (module Eq to EqI) + + module EqC = IsEquivalence ≈-isEquivalence + +------------------------------------------------------------------------ +-- Pre-metrics + +record IsPreMetric (d : DistanceFunction A I) + : Set (a ⊔ i ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃) where + field + isProtoMetric : IsProtoMetric d + ≈⇒0 : Definite _≈ₐ_ _≈ᵢ_ d 0# + + open IsProtoMetric isProtoMetric public + +------------------------------------------------------------------------ +-- Quasi-semi-metrics + +record IsQuasiSemiMetric (d : DistanceFunction A I) + : Set (a ⊔ i ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃) where + field + isPreMetric : IsPreMetric d + 0⇒≈ : Indiscernable _≈ₐ_ _≈ᵢ_ d 0# + + open IsPreMetric isPreMetric public + +------------------------------------------------------------------------ +-- Semi-metrics + +record IsSemiMetric (d : DistanceFunction A I) + : Set (a ⊔ i ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃) where + field + isQuasiSemiMetric : IsQuasiSemiMetric d + sym : Symmetric _≈ᵢ_ d + + open IsQuasiSemiMetric isQuasiSemiMetric public + +------------------------------------------------------------------------ +-- General metrics + +-- A general metric obeys a generalised form of the triangle inequality. +-- It can be specialised to a standard metric/ultrametric/inframetric +-- etc. by providing the correct operator. +-- +-- Furthermore we do not assume that _∙_ & 0# form a monoid as +-- associativity does not hold for p-relaxed metrics/p-inframetrics and +-- the identity laws do not hold for ultrametrics over negative +-- codomains. +-- +-- See "Properties of distance spaces with power triangle inequalities" +-- by Daniel J. Greenhoe, 2016 (arXiv) + +record IsGeneralMetric (_∙_ : Op₂ I) (d : DistanceFunction A I) + : Set (a ⊔ i ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃) where + field + isSemiMetric : IsSemiMetric d + triangle : TriangleInequality _≤_ _∙_ d + + open IsSemiMetric isSemiMetric public +\ No newline at end of file diff --git a/docs/Function.Structures.html b/docs/Function.Structures.html new file mode 100644 index 0000000..0358863 --- /dev/null +++ b/docs/Function.Structures.html @@ -0,0 +1,154 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Structures for types of functions +------------------------------------------------------------------------ + +-- The contents of this file should usually be accessed from `Function`. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Function.Structures {a b ℓ₁ ℓ₂} + {A : Set a} (_≈₁_ : Rel A ℓ₁) -- Equality over the domain + {B : Set b} (_≈₂_ : Rel B ℓ₂) -- Equality over the codomain + where + +open import Data.Product using (∃; _×_; _,_) +open import Function.Base +open import Function.Definitions +open import Level using (_⊔_) + +------------------------------------------------------------------------ +-- One element structures +------------------------------------------------------------------------ + +record IsCongruent (f : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + cong : Congruent _≈₁_ _≈₂_ f + isEquivalence₁ : IsEquivalence _≈₁_ + isEquivalence₂ : IsEquivalence _≈₂_ + + module Eq₁ where + + setoid : Setoid a ℓ₁ + setoid = record + { isEquivalence = isEquivalence₁ + } + + open Setoid setoid public + + module Eq₂ where + + setoid : Setoid b ℓ₂ + setoid = record + { isEquivalence = isEquivalence₂ + } + + open Setoid setoid public + + +record IsInjection (f : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isCongruent : IsCongruent f + injective : Injective _≈₁_ _≈₂_ f + + open IsCongruent isCongruent public + + +record IsSurjection (f : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isCongruent : IsCongruent f + surjective : Surjective _≈₁_ _≈₂_ f + + open IsCongruent isCongruent public + + +record IsBijection (f : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isInjection : IsInjection f + surjective : Surjective _≈₁_ _≈₂_ f + + open IsInjection isInjection public + + bijective : Bijective _≈₁_ _≈₂_ f + bijective = injective , surjective + + isSurjection : IsSurjection f + isSurjection = record + { isCongruent = isCongruent + ; surjective = surjective + } + + +------------------------------------------------------------------------ +-- Two element structures +------------------------------------------------------------------------ + +record IsLeftInverse (f : A → B) (g : B → A) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isCongruent : IsCongruent f + cong₂ : Congruent _≈₂_ _≈₁_ g + inverseˡ : Inverseˡ _≈₁_ _≈₂_ f g + + open IsCongruent isCongruent public + renaming (cong to cong₁) + + +record IsRightInverse (f : A → B) (g : B → A) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isCongruent : IsCongruent f + cong₂ : Congruent _≈₂_ _≈₁_ g + inverseʳ : Inverseʳ _≈₁_ _≈₂_ f g + + open IsCongruent isCongruent public + renaming (cong to cong₁) + + +record IsInverse (f : A → B) (g : B → A) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isLeftInverse : IsLeftInverse f g + inverseʳ : Inverseʳ _≈₁_ _≈₂_ f g + + open IsLeftInverse isLeftInverse public + + isRightInverse : IsRightInverse f g + isRightInverse = record + { isCongruent = isCongruent + ; cong₂ = cong₂ + ; inverseʳ = inverseʳ + } + + inverse : Inverseᵇ _≈₁_ _≈₂_ f g + inverse = inverseˡ , inverseʳ + + +------------------------------------------------------------------------ +-- Three element structures +------------------------------------------------------------------------ + +record IsBiEquivalence + (f : A → B) (g₁ : B → A) (g₂ : B → A) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f-isCongruent : IsCongruent f + cong₂ : Congruent _≈₂_ _≈₁_ g₁ + cong₃ : Congruent _≈₂_ _≈₁_ g₂ + + open IsCongruent f-isCongruent public + renaming (cong to cong₁) + + +record IsBiInverse + (f : A → B) (g₁ : B → A) (g₂ : B → A) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + f-isCongruent : IsCongruent f + cong₂ : Congruent _≈₂_ _≈₁_ g₁ + inverseˡ : Inverseˡ _≈₁_ _≈₂_ f g₁ + cong₃ : Congruent _≈₂_ _≈₁_ g₂ + inverseʳ : Inverseʳ _≈₁_ _≈₂_ f g₂ + + open IsCongruent f-isCongruent public + renaming (cong to cong₁) +\ No newline at end of file diff --git a/docs/Function.html b/docs/Function.html new file mode 100644 index 0000000..a70eb80 --- /dev/null +++ b/docs/Function.html @@ -0,0 +1,17 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Functions +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Function where + +open import Function.Core public +open import Function.Base public +open import Function.Definitions public +open import Function.Structures public +open import Function.Bundles public +\ No newline at end of file diff --git a/docs/Gemfile b/docs/Gemfile deleted file mode 100644 index f2915df..0000000 --- a/docs/Gemfile +++ /dev/null @@ -1,37 +0,0 @@ -source "https://rubygems.org" -# Hello! This is where you manage which Jekyll version is used to run. -# When you want to use a different version, change it below, save the -# file and run `bundle install`. Run Jekyll with `bundle exec`, like so: -# -# bundle exec jekyll serve -# -# This will help ensure the proper Jekyll version is running. -# Happy Jekylling! -# gem "jekyll", "~> 4.3.2" -# This is the default theme for new Jekyll sites. You may change this to anything you like. -gem "minima", "~> 2.5" -# If you want to use GitHub Pages, remove the "gem "jekyll"" above and -# uncomment the line below. To upgrade, run `bundle update github-pages`. -gem "github-pages", "~> 231", group: :jekyll_plugins -# If you have any plugins, put them here! -group :jekyll_plugins do - gem "jekyll-feed", "~> 0.12" -end - -group :jekyll_plugins do - gem "jekyll-agda" -end - -# Windows and JRuby does not include zoneinfo files, so bundle the tzinfo-data gem -# and associated library. -platforms :mingw, :x64_mingw, :mswin, :jruby do - gem "tzinfo", ">= 1", "< 3" - gem "tzinfo-data" -end - -# Performance-booster for watching directories on Windows -gem "wdm", "~> 0.1.1", :platforms => [:mingw, :x64_mingw, :mswin] - -# Lock `http_parser.rb` gem to `v0.6.x` on JRuby builds since newer versions of the gem -# do not have a Java counterpart. -gem "http_parser.rb", "~> 0.6.0", :platforms => [:jruby] diff --git a/docs/Gemfile.lock b/docs/Gemfile.lock deleted file mode 100644 index 735fe69..0000000 --- a/docs/Gemfile.lock +++ /dev/null @@ -1,279 +0,0 @@ -GEM - remote: https://rubygems.org/ - specs: - activesupport (7.1.3.2) - base64 - bigdecimal - concurrent-ruby (~> 1.0, >= 1.0.2) - connection_pool (>= 2.2.5) - drb - i18n (>= 1.6, < 2) - minitest (>= 5.1) - mutex_m - tzinfo (~> 2.0) - addressable (2.8.6) - public_suffix (>= 2.0.2, < 6.0) - base64 (0.2.0) - bigdecimal (3.1.7) - coffee-script (2.4.1) - coffee-script-source - execjs - coffee-script-source (1.12.2) - colorator (1.1.0) - commonmarker (0.23.10) - concurrent-ruby (1.2.3) - connection_pool (2.4.1) - dnsruby (1.72.0) - simpleidn (~> 0.2.1) - drb (2.2.1) - em-websocket (0.5.3) - eventmachine (>= 0.12.9) - http_parser.rb (~> 0) - ethon (0.16.0) - ffi (>= 1.15.0) - eventmachine (1.2.7) - execjs (2.9.1) - faraday (2.9.0) - faraday-net_http (>= 2.0, < 3.2) - faraday-net_http (3.1.0) - net-http - ffi (1.16.3) - forwardable-extended (2.6.0) - gemoji (4.1.0) - github-pages (231) - github-pages-health-check (= 1.18.2) - jekyll (= 3.9.5) - jekyll-avatar (= 0.8.0) - jekyll-coffeescript (= 1.2.2) - jekyll-commonmark-ghpages (= 0.4.0) - jekyll-default-layout (= 0.1.5) - jekyll-feed (= 0.17.0) - jekyll-gist (= 1.5.0) - jekyll-github-metadata (= 2.16.1) - jekyll-include-cache (= 0.2.1) - jekyll-mentions (= 1.6.0) - jekyll-optional-front-matter (= 0.3.2) - jekyll-paginate (= 1.1.0) - jekyll-readme-index (= 0.3.0) - jekyll-redirect-from (= 0.16.0) - jekyll-relative-links (= 0.6.1) - jekyll-remote-theme (= 0.4.3) - jekyll-sass-converter (= 1.5.2) - jekyll-seo-tag (= 2.8.0) - jekyll-sitemap (= 1.4.0) - jekyll-swiss (= 1.0.0) - jekyll-theme-architect (= 0.2.0) - jekyll-theme-cayman (= 0.2.0) - jekyll-theme-dinky (= 0.2.0) - jekyll-theme-hacker (= 0.2.0) - jekyll-theme-leap-day (= 0.2.0) - jekyll-theme-merlot (= 0.2.0) - jekyll-theme-midnight (= 0.2.0) - jekyll-theme-minimal (= 0.2.0) - jekyll-theme-modernist (= 0.2.0) - jekyll-theme-primer (= 0.6.0) - jekyll-theme-slate (= 0.2.0) - jekyll-theme-tactile (= 0.2.0) - jekyll-theme-time-machine (= 0.2.0) - jekyll-titles-from-headings (= 0.5.3) - jemoji (= 0.13.0) - kramdown (= 2.4.0) - kramdown-parser-gfm (= 1.1.0) - liquid (= 4.0.4) - mercenary (~> 0.3) - minima (= 2.5.1) - nokogiri (>= 1.13.6, < 2.0) - rouge (= 3.30.0) - terminal-table (~> 1.4) - github-pages-health-check (1.18.2) - addressable (~> 2.3) - dnsruby (~> 1.60) - octokit (>= 4, < 8) - public_suffix (>= 3.0, < 6.0) - typhoeus (~> 1.3) - html-pipeline (2.14.3) - activesupport (>= 2) - nokogiri (>= 1.4) - http_parser.rb (0.8.0) - i18n (1.14.4) - concurrent-ruby (~> 1.0) - jekyll (3.9.5) - addressable (~> 2.4) - colorator (~> 1.0) - em-websocket (~> 0.5) - i18n (>= 0.7, < 2) - jekyll-sass-converter (~> 1.0) - jekyll-watch (~> 2.0) - kramdown (>= 1.17, < 3) - liquid (~> 4.0) - mercenary (~> 0.3.3) - pathutil (~> 0.9) - rouge (>= 1.7, < 4) - safe_yaml (~> 1.0) - jekyll-agda (0.1.0) - jekyll (>= 3, < 5) - jekyll-avatar (0.8.0) - jekyll (>= 3.0, < 5.0) - jekyll-coffeescript (1.2.2) - coffee-script (~> 2.2) - coffee-script-source (~> 1.12) - jekyll-commonmark (1.4.0) - commonmarker (~> 0.22) - jekyll-commonmark-ghpages (0.4.0) - commonmarker (~> 0.23.7) - jekyll (~> 3.9.0) - jekyll-commonmark (~> 1.4.0) - rouge (>= 2.0, < 5.0) - jekyll-default-layout (0.1.5) - jekyll (>= 3.0, < 5.0) - jekyll-feed (0.17.0) - jekyll (>= 3.7, < 5.0) - jekyll-gist (1.5.0) - octokit (~> 4.2) - jekyll-github-metadata (2.16.1) - jekyll (>= 3.4, < 5.0) - octokit (>= 4, < 7, != 4.4.0) - jekyll-include-cache (0.2.1) - jekyll (>= 3.7, < 5.0) - jekyll-mentions (1.6.0) - html-pipeline (~> 2.3) - jekyll (>= 3.7, < 5.0) - jekyll-optional-front-matter (0.3.2) - jekyll (>= 3.0, < 5.0) - jekyll-paginate (1.1.0) - jekyll-readme-index (0.3.0) - jekyll (>= 3.0, < 5.0) - jekyll-redirect-from (0.16.0) - jekyll (>= 3.3, < 5.0) - jekyll-relative-links (0.6.1) - jekyll (>= 3.3, < 5.0) - jekyll-remote-theme (0.4.3) - addressable (~> 2.0) - jekyll (>= 3.5, < 5.0) - jekyll-sass-converter (>= 1.0, <= 3.0.0, != 2.0.0) - rubyzip (>= 1.3.0, < 3.0) - jekyll-sass-converter (1.5.2) - sass (~> 3.4) - jekyll-seo-tag (2.8.0) - jekyll (>= 3.8, < 5.0) - jekyll-sitemap (1.4.0) - jekyll (>= 3.7, < 5.0) - jekyll-swiss (1.0.0) - jekyll-theme-architect (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-cayman (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-dinky (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-hacker (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-leap-day (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-merlot (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-midnight (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-minimal (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-modernist (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-primer (0.6.0) - jekyll (> 3.5, < 5.0) - jekyll-github-metadata (~> 2.9) - jekyll-seo-tag (~> 2.0) - jekyll-theme-slate (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-tactile (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-theme-time-machine (0.2.0) - jekyll (> 3.5, < 5.0) - jekyll-seo-tag (~> 2.0) - jekyll-titles-from-headings (0.5.3) - jekyll (>= 3.3, < 5.0) - jekyll-watch (2.2.1) - listen (~> 3.0) - jemoji (0.13.0) - gemoji (>= 3, < 5) - html-pipeline (~> 2.2) - jekyll (>= 3.0, < 5.0) - kramdown (2.4.0) - rexml - kramdown-parser-gfm (1.1.0) - kramdown (~> 2.0) - liquid (4.0.4) - listen (3.9.0) - rb-fsevent (~> 0.10, >= 0.10.3) - rb-inotify (~> 0.9, >= 0.9.10) - mercenary (0.3.6) - minima (2.5.1) - jekyll (>= 3.5, < 5.0) - jekyll-feed (~> 0.9) - jekyll-seo-tag (~> 2.1) - minitest (5.22.3) - mutex_m (0.2.0) - net-http (0.4.1) - uri - nokogiri (1.16.3-x86_64-linux) - racc (~> 1.4) - octokit (4.25.1) - faraday (>= 1, < 3) - sawyer (~> 0.9) - pathutil (0.16.2) - forwardable-extended (~> 2.6) - public_suffix (5.0.5) - racc (1.7.3) - rb-fsevent (0.11.2) - rb-inotify (0.10.1) - ffi (~> 1.0) - rexml (3.2.6) - rouge (3.30.0) - rubyzip (2.3.2) - safe_yaml (1.0.5) - sass (3.7.4) - sass-listen (~> 4.0.0) - sass-listen (4.0.0) - rb-fsevent (~> 0.9, >= 0.9.4) - rb-inotify (~> 0.9, >= 0.9.7) - sawyer (0.9.2) - addressable (>= 2.3.5) - faraday (>= 0.17.3, < 3) - simpleidn (0.2.1) - unf (~> 0.1.4) - terminal-table (1.8.0) - unicode-display_width (~> 1.1, >= 1.1.1) - typhoeus (1.4.1) - ethon (>= 0.9.0) - tzinfo (2.0.6) - concurrent-ruby (~> 1.0) - unf (0.1.4) - unf_ext - unf_ext (0.0.9.1) - unicode-display_width (1.8.0) - uri (0.13.0) - -PLATFORMS - x86_64-linux - -DEPENDENCIES - github-pages (~> 231) - http_parser.rb (~> 0.6.0) - jekyll-agda - jekyll-feed (~> 0.12) - minima (~> 2.5) - tzinfo (>= 1, < 3) - tzinfo-data - wdm (~> 0.1.1) - -BUNDLED WITH - 2.3.5 diff --git a/docs/Level.html b/docs/Level.html new file mode 100644 index 0000000..81fae27 --- /dev/null +++ b/docs/Level.html @@ -0,0 +1,36 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Universe levels +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Level where + +-- Levels. + +open import Agda.Primitive as Prim public + using (Level; _⊔_; Setω) + renaming (lzero to zero; lsuc to suc) + +-- Lifting. + +record Lift {a} ℓ (A : Set a) : Set (a ⊔ ℓ) where + constructor lift + field lower : A + +open Lift public + +-- Synonyms + +0ℓ : Level +0ℓ = zero + +levelOfType : ∀ {a} → Set a → Level +levelOfType {a} _ = a + +levelOfTerm : ∀ {a} {A : Set a} → A → Level +levelOfTerm {a} _ = a +\ No newline at end of file diff --git a/docs/Overture.Basic.html b/docs/Overture.Basic.html new file mode 100644 index 0000000..516fe97 --- /dev/null +++ b/docs/Overture.Basic.html @@ -0,0 +1,296 @@ + +
--- +layout: default +title : "Overture.Basic module" +date : "2021-01-13" +author: "the agda-algebras development team" +--- + +### <a id="preliminaries">Preliminaries</a> + +This is the [Overture.Basic][] module of the [Agda Universal Algebra Library][]. + +#### <a id="logical-foundations">Logical foundations</a> + +(See also the Equality module of the [agda-algebras][] library.) + +An Agda program typically begins by setting some options and by importing types +from existing Agda libraries. Options are specified with the `OPTIONS` *pragma* +and control the way Agda behaves by, for example, specifying the logical axioms +and deduction rules we wish to assume when the program is type-checked to verify +its correctness. Every Agda program in [agda-algebras][] begins with the following line. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +\end{code} + +These options control certain foundational assumptions that Agda makes when +type-checking the program to verify its correctness. + +* `--without-K` disables + [Streicher's K axiom](https://ncatlab.org/nlab/show/axiom+K+%28type+theory%29); + see also the + [section on axiom K](https://agda.readthedocs.io/en/v2.6.1/language/without-k.html) + in the [Agda Language Reference Manual](https://agda.readthedocs.io/en/v2.6.1.3/language). + +* `--exact-split` makes Agda accept only those definitions that behave like so-called + *judgmental* equalities. [Martín Escardó](https://www.cs.bham.ac.uk/~mhe) explains + this by saying it "makes sure that pattern matching corresponds to Martin-Löf + eliminators;" see also the + [Pattern matching and equality section](https://agda.readthedocs.io/en/v2.6.1/tools/command-line-options.html#pattern-matching-and-equality) + of the [Agda Tools](https://agda.readthedocs.io/en/v2.6.1.3/tools/) documentation. + +* `safe` ensures that nothing is postulated outright---every non-MLTT axiom has to be + an explicit assumption (e.g., an argument to a function or module); see also + [this section](https://agda.readthedocs.io/en/v2.6.1/tools/command-line-options.html#cmdoption-safe) + of the [Agda Tools](https://agda.readthedocs.io/en/v2.6.1.3/tools/) documentation and the + [Safe Agda section](https://agda.readthedocs.io/en/v2.6.1/language/safe-agda.html#safe-agda) + of the [Agda Language Reference](https://agda.readthedocs.io/en/v2.6.1.3/language). + +Note that if we wish to type-check a file that imports another file that still +has some unmet proof obligations, we must replace the `--safe` flag with +`--allow-unsolved-metas`, but this is never done in (publicly released versions + of) the [agda-algebras][]. + + +#### <a id="agda-modules">Agda modules</a> + +The `OPTIONS` pragma is usually followed by the start of a module. For example, +the [Base.Functions.Basic][] module begins with the following line, and then a +list of imports of things used in the module. +\begin{code} + +module Overture.Basic where + +-- Imports from Agda and the Agda Standard Library ----------------------------------------------- +open import Agda.Primitive using () renaming ( Set to Type ; lzero to ℓ₀ ) +open import Data.Product using ( _,_ ; ∃ ; Σ-syntax ; _×_ ) + renaming ( proj₁ to fst ; proj₂ to snd ) +open import Function.Base using ( _∘_ ; id ) +open import Level using ( Level ; suc ; _⊔_ ; lift ; lower ; Lift ) +open import Relation.Binary using ( Decidable ) +open import Relation.Binary using ( IsEquivalence ; IsPartialOrder ) +open import Relation.Nullary using ( Dec ; yes ; no ; Irrelevant ) + +open import Relation.Binary.PropositionalEquality using ( _≡_ ; refl ; sym ; trans ) + +private variable α β : Level + +ℓ₁ : Level +ℓ₁ = suc ℓ₀ + +-- the two element type +data 𝟚 : Type ℓ₀ where 𝟎 : 𝟚 ; 𝟏 : 𝟚 + +-- the three element type +data 𝟛 : Type ℓ₀ where 𝟎 : 𝟛 ; 𝟏 : 𝟛 ; 𝟐 : 𝟛 +\end{code} + +#### <a id="projection-notation">Projection notation</a> + +The definition of `Σ` (and thus, of `×`) includes the fields `proj₁` and `proj₂` +representing the first and second projections out of the product. However, we +prefer the shorter names `fst` and `snd`. Sometimes we prefer to denote these +projections by `∣_∣` and `∥_∥`, respectively. We define these alternative +notations for projections out of pairs as follows. + +\begin{code} + +module _ {A : Type α }{B : A → Type β} where + + ∣_∣ : Σ[ x ∈ A ] B x → A + ∣_∣ = fst + + ∥_∥ : (z : Σ[ a ∈ A ] B a) → B ∣ z ∣ + ∥_∥ = snd + + infix 40 ∣_∣ + +\end{code} + +Here we put the definitions inside an *anonymous module*, which starts with the + `module` keyword followed by an underscore (instead of a module name). The +purpose is simply to move the postulated typing judgments---the "parameters" +of the module (e.g., `A : Type α`)---out of the way so they don't obfuscate +the definitions inside the module. + +Let's define some useful syntactic sugar that will make it easier to apply +symmetry and transitivity of `≡` in proofs. + +\begin{code} + +_⁻¹ : {A : Type α} {x y : A} → x ≡ y → y ≡ x +p ⁻¹ = sym p + +infix 40 _⁻¹ + +\end{code} + +If we have a proof `p : x ≡ y`, and we need a proof of `y ≡ x`, then instead of +`sym p` we can use the more intuitive `p ⁻¹`. Similarly, the following syntactic +sugar makes abundant appeals to transitivity easier to stomach. + +\begin{code} + +_∙_ : {A : Type α}{x y z : A} → x ≡ y → y ≡ z → x ≡ z +p ∙ q = trans p q + +𝑖𝑑 : (A : Type α ) → A → A +𝑖𝑑 A = λ x → x + +infixl 30 _∙_ +\end{code} + +#### <a id="sigma-types">Sigma types</a> + +\begin{code} + +infix 2 ∃-syntax + +∃-syntax : ∀ {A : Type α} → (A → Type β) → Set (α ⊔ β) +∃-syntax = ∃ + +syntax ∃-syntax (λ x → B) = ∃[ x ∈ A ] B +\end{code} + +#### <a id="pi-types">Pi types</a> + +The dependent function type is traditionally denoted with an uppercase pi symbol +and typically expressed as `Π(x : A) B x`, or something similar. In Agda syntax, +one writes `(x : A) → B x` for this dependent function type, but we can define +syntax that is closer to standard notation as follows. + +\begin{code} + +Π : {A : Type α } (B : A → Type β ) → Type (α ⊔ β) +Π {A = A} B = (x : A) → B x + +Π-syntax : (A : Type α)(B : A → Type β) → Type (α ⊔ β) +Π-syntax A B = Π B + +syntax Π-syntax A (λ x → B) = Π[ x ∈ A ] B +infix 6 Π-syntax + +\end{code} +In the modules that follow, we will see many examples of this syntax in action. + + +#### <a id="agdas-universe-hierarchy">Agda's universe hierarchy</a> + +The hierarchy of universes in Agda is structured as follows: +```agda + +Type α : Type (lsuc α) , Type (lsuc α) : Type (lsuc (lsuc α)) , etc. + +``` +and so on. This means that the universe `Type α` has type `Type(lsuc α)`, and +`Type(lsuc α)` has type `Type(lsuc (lsuc α))`, and so on. It is important to +note, however, this does *not* imply that `Type α : Type(lsuc(lsuc α))`. In other +words, Agda's universe hierarchy is *non-cumulative*. This makes it possible to +treat universe levels more precisely, which is nice. On the other hand, a +non-cumulative hierarchy can sometimes make for a non-fun proof assistant. +Specifically, in certain situations, the non-cumulativity makes it unduly +difficult to convince Agda that a program or proof is correct. + + +#### <a id="lifting-and-lowering">Lifting and lowering</a> + +Here we describe a general `Lift` type that help us overcome the technical issue +described in the previous subsection. In the [Lifts of algebras +section](Base.Algebras.Basic.html#lifts-of-algebras) of the +[Base.Algebras.Basic][] module we will define a couple domain-specific lifting +types which have certain properties that make them useful for resolving universe +level problems when working with algebra types. + +Let us be more concrete about what is at issue here by considering a typical +example. Agda will often complain with errors like the following: +``` +Birkhoff.lagda:498,20-23 +α != 𝓞 ⊔ 𝓥 ⊔ (lsuc α) when checking that the expression... has type... +``` +This error message means that Agda encountered the universe level `lsuc α`, on +line 498 (columns 20--23) of the file `Birkhoff.lagda`, but was expecting a type +at level `𝓞 ⊔ 𝓥 ⊔ lsuc α` instead. + +The general `Lift` record type that we now describe makes such problems easier to +deal with. It takes a type inhabiting some universe and embeds it into a higher +universe and, apart from syntax and notation, it is equivalent to the `Lift` type +one finds in the `Level` module of the [Agda Standard Library][]. +```agda +record Lift {𝓦 α : Level} (A : Set α) : Set (α ⊔ 𝓦) where +``` +```agda + constructor lift +``` +```agda + field lower : A +``` +The point of having a ramified hierarchy of universes is to avoid Russell's +paradox, and this would be subverted if we were to lower the universe of a type +that wasn't previously lifted. However, we can prove that if an application of +`lower` is immediately followed by an application of `lift`, then the result is +the identity transformation. Similarly, `lift` followed by `lower` is the +identity. +\begin{code} + +lift∼lower : {A : Type α} → lift ∘ lower ≡ 𝑖𝑑 (Lift β A) +lift∼lower = refl + +lower∼lift : {A : Type α} → (lower {α}{β}) ∘ lift ≡ 𝑖𝑑 A +lower∼lift = refl + +\end{code} +The proofs are trivial. Nonetheless, we'll come across some holes these lemmas can fill. + + +#### <a id="pointwise-equality-of-dependent-functions">Pointwise equality of dependent functions</a> + +We conclude this module with a definition that conveniently represents te assertion +that two functions are (extensionally) the same in the sense that they produce +the same output when given the same input. (We will have more to say about +this notion of equality in the [Base.Equality.Extensionality][] module.) +\begin{code} + +module _ {α : Level}{A : Type α}{β : Level}{B : A → Type β } where + + _≈_ : (f g : (a : A) → B a) → Type (α ⊔ β) + f ≈ g = ∀ x → f x ≡ g x + + infix 8 _≈_ + + ≈IsEquivalence : IsEquivalence _≈_ + IsEquivalence.refl ≈IsEquivalence = λ _ → refl + IsEquivalence.sym ≈IsEquivalence f≈g = λ x → sym (f≈g x) + IsEquivalence.trans ≈IsEquivalence f≈g g≈h = λ x → trans (f≈g x) (g≈h x) + +\end{code} +The following is convenient for proving two pairs of a product type are equal +using the fact that their respective components are equal. +\begin{code} + +≡-by-parts : {A : Type α}{B : Type β}{u v : A × B} + → fst u ≡ fst v → snd u ≡ snd v → u ≡ v + +≡-by-parts refl refl = refl + +\end{code} +Lastly, we will use the following type (instead of `subst`) to transport equality +proofs. + +\begin{code} + +transport : {A : Type α } (B : A → Type β) {x y : A} → x ≡ y → B x → B y +transport B refl = id +\end{code} + +------------------------------ + +<span style="float:left;">[← Overture.Preface](Overture.Preface.html)</span> +<span style="float:right;">[Overture.Signatures →](Overture.Signatures.html)</span> + +{% include UALib.Links.md %} + + +\ No newline at end of file diff --git a/docs/Overture.Operations.html b/docs/Overture.Operations.html new file mode 100644 index 0000000..7661b7d --- /dev/null +++ b/docs/Overture.Operations.html @@ -0,0 +1,70 @@ + +
--- +layout: default +title : "Overture.Operations module (The Agda Universal Algebra Library)" +date : "2022-06-17" +author: "the agda-algebras development team" +--- + +### <a id="Operations">Operations</a> + +This is the [Overture.Operations][] module of the [Agda Universal Algebra Library][]. + +For consistency and readability, we reserve two universe variables for special +purposes. + +The first of these is `𝓞` which we used in the [Overture.Signatures][] +as the universe of the type of *operation symbols* of a signature. + +The second is `𝓥` which we reserve for types representing *arities* of relations or operations. + +The type `Op` encodes the arity of an operation as an arbitrary type `I : Type 𝓥`, +which gives us a very general way to represent an operation as a function type with +domain `I → A` (the type of "tuples") and codomain `A`. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Overture.Operations where + +-- Imports from Agda and the Agda Standard Library ----------------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Level using ( Level ; _⊔_ ) + +private variable α β ρ 𝓥 : Level + +-- The type of operations on A of arity I +Op : Type α → Type 𝓥 → Type (α ⊔ 𝓥) +Op A I = (I → A) → A + +\end{code} + +For example, the `I`-*ary projection operations* on `A` are represented as inhabitants of the type `Op A I` as follows. + +\begin{code} + +-- Example (projections) +π : {I : Type 𝓥} {A : Type α } → I → Op A I +π i = λ x → x i + +\end{code} + +Occasionally we want to extract the arity of a given operation symbol. + +\begin{code} + +-- return the arity of a given operation symbol +arity[_] : {I : Type 𝓥} {A : Type α } → Op A I → Type 𝓥 +arity[_] {I = I} f = I +\end{code} + +----------- + +<span style="float:left;">[← Overture.Signatures](Overture.Signatures.html)</span> +<span style="float:right;">[Base →](Base.html)</span> + + +{% include UALib.Links.md %} + +\ No newline at end of file diff --git a/docs/Overture.Preface.html b/docs/Overture.Preface.html new file mode 100644 index 0000000..2367f7e --- /dev/null +++ b/docs/Overture.Preface.html @@ -0,0 +1,205 @@ + +
--- +layout: default +title : "Overture.Preface module (The Agda Universal Algebra Library)" +date : "2021-01-14" +author: "the agda-algebras development team" +--- + +### <a id="preface">Preface</a> + +This is the [Overture.Preface][] module of the [Agda Universal Algebra Library][]. + +\begin{code}[hide] + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Overture.Preface where + +\end{code} + +To support formalization in type theory of research level mathematics in universal +algebra and related fields, we present the [Agda Universal Algebra +Library][] (or [agda-algebras][] for short), a library for +the [Agda][] proof assistant which contains definitions, theorems and proofs from +the foundations of universal algebra. In particular, the library formalizes the +First (Noether) Isomorphism Theorem and the [Birkhoff HSP +Theorem](https://ualib.org/Setoid.Varieties.HSP.html#proof-of-the-hsp-theorem) +asserting that every variety is an equational class. + +#### <a id="vision-and-goals">Vision and goals</a> + +The idea for the [agda-algebras][] project originated with the observation that, +on the one hand a number of basic and important constructs in universal algebra +can be defined recursively, and theorems about them proved inductively, while on +the other hand the *types* +(of type theory---in particular, [dependent types][] and [inductive types][]) +make possible elegant formal representations of recursively defined objects, and +constructive (*computable*) proofs of their properties. These observations suggest +that there is much to gain from implementing universal algebra in a language that +facilitates working with dependent and inductive types. + +##### <a id="primary-goals">Primary goals</a> + +The first goal of [agda-algebras][] is to demonstrate that it is possible to +express the foundations of universal algebra in type theory and to formalize (and +formally verify) the foundations in the Agda programming language. We will +formalize a substantial portion of the edifice on which our own mathematical +research depends, and demonstrate that our research can also be expressed in type +theory and formally implemented in such a way that we and other working +mathematicians can understand and verify the results. The resulting library will +also serve to educate our peers, and encourage and help them to formally verify +their own mathematics research. + +Our field is deep and wide and codifying all of its foundations may seem like a +daunting task and a possibly risky investment of time and energy. However, we +believe our subject is well served by a new, modern, +[constructive](https://ncatlab.org/nlab/show/constructive+mathematics) +presentation of its foundations. Our new presentation expresses the foundations +of universal algebra in the language of type theory, and uses the Agda proof +assistant to codify and formally verify everything. + +##### <a id="secondary-goals">Secondary goals</a> + +We wish to emphasize that our ultimate objective is not merely to translate +existing results into a more modern and formal language. Indeed, one important +goal is to develop a system that is useful for conducting research in mathematics, +and that is how we intend to use our library once we have achieved our immediate +objective of implementing the basic foundational core of universal algebra in +Agda. + +To this end, our long-term objectives include + ++ domain specific types to express the idioms of universal algebra, ++ automated proof search for universal algebra, and ++ formalization of theorems discovered in our own (informal) mathematics research, ++ documentation of the resulting Agda library so it is usable by others. + +For our own mathematics research, we believe a proof assistant like Agda, equipped +with a specialized library for universal algebra is an extremely useful research +tool. Thus, a secondary goal is to demonstrate (to ourselves and colleagues) the +utility of such technologies for discovering new mathematics. + +#### <a id="logical-foundations">Logical foundations</a> + +The [Agda Universal Algebra Library][] is based on a minimal version of +[Martin-Löf dependent type theory][] (MLTT) as implemented in Agda. More details +on this type theory can be read at [ncatlab entry on Martin-Löf dependent type +theory](https://ncatlab.org/nlab/show/Martin-L%C3%B6f+dependent+type+theory). + + +#### <a id="intended-audience">Intended audience</a> + +The comments and source code in the library should provide enough detail so that +people familiar with functional programming and proof assistants can learn enough +about Agda and its libraries to put them to use when creating, formalizing, and +verifying mathematical theorems and proofs. + +While there are no strict prerequisites, we expect anyone with an interest in this +work will have been motivated by prior exposure to universal algebra, as presented +in, say, [Bergman (2012)][] or [McKenzie, McNulty, Taylor (2018)], or category +theory, as presented in, say, [Riehl (2017)][]. + +Some prior exposure to [type theory][] and Agda would be helpful, but even without +this background one might still be able to get something useful out of this by +referring to one or more of the resources mentioned in the references section +below to fill in gaps as needed. + + +#### <a id="attributions">Attributions</a> + +##### <a id="the-agda-algebras-development-team">The agda-algebras development team</a> + +The [agda-algebras][] library is developed and maintained by the *Agda Algebras +Development Team* led by [William DeMeo][] with major contributions by senior +advisor [Jacques Carette][] (McMaster University). + +##### <a id="Acknowledgements">Acknowledgements</a> + +We thank [Andreas Abel][], [Andrej Bauer][], [Clifford Bergman][], [Venanzio +Capretta][], [Martín Escardó][], [Ralph Freese][], [Hyeyoung Shin][], and [Siva +Somayyajula][] for helpful discussions, corrections, advice, inspiration and +encouragement. + +Most of the mathematical results formalized in the [agda-algebras][] +are well known. Regarding the source code in the [agda-algebras][] +library, this is mainly due to the contributors listed above. + + +#### <a id="references">References</a> + +The following Agda documentation and tutorials helped inform and improve the +[agda-algebras][] library, especially the first one in the list. + +* Escardo, [Introduction to Univalent Foundations of Mathematics with Agda][] +* Wadler, [Programming Language Foundations in Agda][] +* Bove and Dybjer, [Dependent Types at Work][] +* Gunther, Gadea, Pagano, [Formalization of Universal Algebra in Agda][] +* Norell and Chapman, [Dependently Typed Programming in Agda][] + +Finally, the official [Agda Wiki][], [Agda User's Manual][], [Agda Language +Reference][], and the (open source) [Agda Standard Library][] source code are also +quite useful. + + +#### <a id="citing-the-agda-algebras-library">Citing the agda-algebras library</a> + +If you find the [agda-algebras][] library useful, please cite it using the +following BibTeX entry: + +```bibtex +@misc{ualib_v2.0.1, + author = {De{M}eo, William and Carette, Jacques}, + title = {The {A}gda {U}niversal {A}lgebra {L}ibrary (agda-algebras)}, + year = 2021, + note = {Documentation available at https://ualib.org}, + version = {2.0.1}, + doi = {10.5281/zenodo.5765793}, + howpublished = {Git{H}ub.com}, + note = {Ver.~2.0.1; source code: + \href{https://zenodo.org/record/5765793/files/ualib/agda-algebras-v.2.0.1.zip?download=1} + {agda-algebras-v.2.0.1.zip}, {G}it{H}ub repo: + \href{https://github.com/ualib/agda-algebras}{github.com/ualib/agda-algebras}} +} +``` + +#### <a id="citing-the-formalization-of-birkhoffs-theorem">Citing the formalization of Birkhoff's Theorem </a> + +To cite the [formalization of Birkhoff's HSP +Theorem](https://ualib.org/Setoid.Varieties.HSP.html#proof-of-the-hsp-theorem), +please use the following BibTeX entry: + +```bibtex +@article{DeMeo:2021, + author = {De{M}eo, William and Carette, Jacques}, + title = {A {M}achine-checked {P}roof of {B}irkhoff's {V}ariety {T}heorem + in {M}artin-{L}\"of {T}ype {T}heory}, + journal = {CoRR}, + volume = {abs/2101.10166}, + year = {2021}, + eprint = {2101.2101.10166}, + archivePrefix = {arXiv}, + primaryClass = {cs.LO}, + url = {https://arxiv.org/abs/2101.10166}, + note = {Source code: + \href{https://github.com/ualib/agda-algebras/blob/master/src/Demos/HSP.lagda} + {https://github.com/ualib/agda-algebras/blob/master/src/Demos/HSP.lagda}} +} +``` + + +#### <a id="contributions-welcomed">Contributions welcomed</a> + +Readers and users are encouraged to suggest improvements to the Agda +[agda-algebras][] library and/or its documentation by submitting a +[new issue](https://github.com/ualib/agda-algebras/issues/new/choose) or +[merge request](https://github.com/ualib/agda-algebras/compare) to +[github.com/ualib/agda-algebras/](https://github.com/ualib/agda-algebras). + +------------------------------------------------ + +<span style="float:left;">[↑ Overture](Overture.html)</span> +<span style="float:right;">[Overture.Basic →](Overture.Basic.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Overture.Signatures.html b/docs/Overture.Signatures.html new file mode 100644 index 0000000..fadb5dd --- /dev/null +++ b/docs/Overture.Signatures.html @@ -0,0 +1,125 @@ + +
--- +layout: default +title : "Overture.Signatures module (Agda Universal Algebra Library)" +date : "2021-04-23" +author: "agda-algebras development team" +--- + + +### <a id="signatures">Signatures</a> + +This is the [Overture.Signatures][] module of the [Agda Universal Algebra Library][]. + + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Overture.Signatures where + +-- Imports from the Agda (Builtin) and the Agda Standard Library ----------------------- +open import Agda.Primitive using () renaming ( Set to Type ) +open import Data.Product using ( Σ-syntax ) +open import Level using ( Level ; suc ; _⊔_ ) + +variable 𝓞 𝓥 : Level + +\end{code} + +The variables `𝓞` and `𝓥` are not private since, throughout the [agda-algebras][] library, +`𝓞` denotes the universe level of *operation symbol* types, while `𝓥` denotes the universe +level of *arity* types. + +#### <a id="theoretical-background">Theoretical background</a> + +In [model theory](https://en.wikipedia.org/wiki/Model_theory), the *signature* +`𝑆 = (𝐶, 𝐹, 𝑅, ρ)` of a structure consists of three (possibly empty) sets `𝐶`, `𝐹`, +and `𝑅`---called *constant symbols*, *function symbols*, and *relation symbols*, +respectively---along with a function `ρ : 𝐶 + 𝐹 + 𝑅 → 𝑁` that assigns an +*arity* to each symbol. + +Often (but not always) `𝑁 = ℕ`, the natural numbers. + +As our focus here is universal algebra, we are more concerned with the restricted +notion of an *algebraic signature* (or *signature* for algebraic structures), by +which we mean a pair `𝑆 = (𝐹, ρ)` consisting of a collection `𝐹` of *operation +symbols* and an *arity function* `ρ : 𝐹 → 𝑁` that maps each operation symbol to +its arity; here, 𝑁 denotes the *arity type*. + +Heuristically, the arity `ρ 𝑓` of an operation symbol `𝑓 ∈ 𝐹` may be thought of as +the "number of arguments" that `𝑓` takes as "input". + +If the arity of `𝑓` is `n`, then we call `𝑓` an `n`-*ary* operation symbol. In +case `n` is 0 (or 1 or 2 or 3, respectively) we call the function *nullary* (or +*unary* or *binary* or *ternary*, respectively). + +If `A` is a set and `𝑓` is a (`ρ 𝑓`)-ary operation on `A`, we often indicate this +by writing `𝑓 : A`<sup>ρ 𝑓</sup> `→ A`. On the other hand, the arguments of such +an operation form a (`ρ 𝑓`)-tuple, say, `(a 0, a 1, …, a (ρf-1))`, which may be +viewed as the graph of the function `a : ρ𝑓 → A`. + +When the codomain of `ρ` is `ℕ`, we may view `ρ 𝑓` as the finite set `{0, 1, …, ρ𝑓 - 1}`. + +Thus, by identifying the `ρ𝑓`-th power `A`<sup>ρ 𝑓</sup> with the type `ρ 𝑓 → A` of +functions from `{0, 1, …, ρ𝑓 - 1}` to `A`, we identify the type +`A`<sup>ρ f</sup> `→ A` with the function type `(ρ𝑓 → A) → A`. + +**Example**. + +Suppose `𝑔 : (m → A) → A` is an `m`-ary operation on `A`. + +Let `a : m → A` be an `m`-tuple on `A`. + +Then `𝑔 a` may be viewed as `𝑔 (a 0, a 1, …, a (m-1))`, which has type `A`. + +Suppose further that `𝑓 : (ρ𝑓 → B) → B` is a `ρ𝑓`-ary operation on `B`. + +Let `a : ρ𝑓 → A` be a `ρ𝑓`-tuple on `A`, and let `h : A → B` be a function. + +Then the following typing judgments obtain: + +`h ∘ a : ρ𝑓 → B` and `𝑓 (h ∘ a) : B`. + + + +#### <a id="the-signature-type">The signature type</a> + +In the [agda-algebras][] library we represent the *signature* of an algebraic +structure using the following type. + +\begin{code} + +Signature : (𝓞 𝓥 : Level) → Type (suc (𝓞 ⊔ 𝓥)) +Signature 𝓞 𝓥 = Σ[ F ∈ Type 𝓞 ] (F → Type 𝓥) + +\end{code} + +Occasionally it is useful to obtain the universe level of a given signature. + +\begin{code} + +Level-of-Signature : {𝓞 𝓥 : Level} → Signature 𝓞 𝓥 → Level +Level-of-Signature {𝓞}{𝓥} _ = suc (𝓞 ⊔ 𝓥) + +\end{code} + +In the [Base.Functions][] module of the [agda-algebras][] library, special syntax +is defined for the first and second projections---namely, `∣_∣` and `∥_∥`, resp. + +Consequently, if `𝑆 : Signature 𝓞 𝓥` is a signature, then + +* `∣ 𝑆 ∣` denotes the set of operation symbols, and +* `∥ 𝑆 ∥` denotes the arity function. + +If `𝑓 : ∣ 𝑆 ∣` is an operation symbol in the signature `𝑆`, then `∥ 𝑆 ∥ 𝑓` is the +arity of `𝑓`. + +---------------------- + +<span style="float:left;">[← Overture.Basic](Overture.Basic.html)</span> +<span style="float:right;">[Overture.Operations →](Overture.Operations.html)</span> + + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Overture.html b/docs/Overture.html new file mode 100644 index 0000000..3b9839b --- /dev/null +++ b/docs/Overture.html @@ -0,0 +1,31 @@ + +
--- +layout: default +title : "Overture module" +date : "2022-17-06" +author: "the agda-algebras development team" +--- + +## <a id="overture">Overture</a> + +This is the [Overture][] module of the [Agda Universal Algebra Library][]. + +\begin{code} + +{-# OPTIONS --without-K --exact-split --safe #-} + +module Overture where + +open import Overture.Preface public +open import Overture.Basic public +open import Overture.Signatures public +open import Overture.Operations public +\end{code} + +-------------------------------------- + +<span style="float:left;">[↑ Top](index.html)</span> +<span style="float:right;">[Overture.Preface →](Overture.Preface.html)</span> + +{% include UALib.Links.md %} +\ No newline at end of file diff --git a/docs/Relation.Binary.Bundles.html b/docs/Relation.Binary.Bundles.html new file mode 100644 index 0000000..729a574 --- /dev/null +++ b/docs/Relation.Binary.Bundles.html @@ -0,0 +1,301 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Bundles for homogeneous binary relations +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via `Relation.Binary`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.Bundles where + +open import Level +open import Relation.Nullary using (¬_) +open import Relation.Binary.Core +open import Relation.Binary.Definitions +open import Relation.Binary.Structures + +------------------------------------------------------------------------ +-- Setoids +------------------------------------------------------------------------ + +record PartialSetoid a ℓ : Set (suc (a ⊔ ℓ)) where + field + Carrier : Set a + _≈_ : Rel Carrier ℓ + isPartialEquivalence : IsPartialEquivalence _≈_ + + open IsPartialEquivalence isPartialEquivalence public + + infix 4 _≉_ + _≉_ : Rel Carrier _ + x ≉ y = ¬ (x ≈ y) + + +record Setoid c ℓ : Set (suc (c ⊔ ℓ)) where + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + isEquivalence : IsEquivalence _≈_ + + open IsEquivalence isEquivalence public + + partialSetoid : PartialSetoid c ℓ + partialSetoid = record + { isPartialEquivalence = isPartialEquivalence + } + + open PartialSetoid partialSetoid public using (_≉_) + + +record DecSetoid c ℓ : Set (suc (c ⊔ ℓ)) where + infix 4 _≈_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ + isDecEquivalence : IsDecEquivalence _≈_ + + open IsDecEquivalence isDecEquivalence public + + setoid : Setoid c ℓ + setoid = record + { isEquivalence = isEquivalence + } + + open Setoid setoid public using (partialSetoid; _≉_) + + +------------------------------------------------------------------------ +-- Preorders +------------------------------------------------------------------------ + +record Preorder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _∼_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _∼_ : Rel Carrier ℓ₂ -- The relation. + isPreorder : IsPreorder _≈_ _∼_ + + open IsPreorder isPreorder public + hiding (module Eq) + + module Eq where + setoid : Setoid c ℓ₁ + setoid = record + { isEquivalence = isEquivalence + } + + open Setoid setoid public + + +record TotalPreorder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≲_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _≲_ : Rel Carrier ℓ₂ -- The relation. + isTotalPreorder : IsTotalPreorder _≈_ _≲_ + + open IsTotalPreorder isTotalPreorder public + hiding (module Eq) + + preorder : Preorder c ℓ₁ ℓ₂ + preorder = record { isPreorder = isPreorder } + + open Preorder preorder public + using (module Eq) + + +------------------------------------------------------------------------ +-- Partial orders +------------------------------------------------------------------------ + +record Poset c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ + _≤_ : Rel Carrier ℓ₂ + isPartialOrder : IsPartialOrder _≈_ _≤_ + + open IsPartialOrder isPartialOrder public + hiding (module Eq) + + preorder : Preorder c ℓ₁ ℓ₂ + preorder = record + { isPreorder = isPreorder + } + + open Preorder preorder public + using (module Eq) + + +record DecPoset c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ + _≤_ : Rel Carrier ℓ₂ + isDecPartialOrder : IsDecPartialOrder _≈_ _≤_ + + private + module DPO = IsDecPartialOrder isDecPartialOrder + open DPO public hiding (module Eq) + + poset : Poset c ℓ₁ ℓ₂ + poset = record + { isPartialOrder = isPartialOrder + } + + open Poset poset public + using (preorder) + + module Eq where + decSetoid : DecSetoid c ℓ₁ + decSetoid = record + { isDecEquivalence = DPO.Eq.isDecEquivalence + } + + open DecSetoid decSetoid public + + +record StrictPartialOrder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _<_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ + _<_ : Rel Carrier ℓ₂ + isStrictPartialOrder : IsStrictPartialOrder _≈_ _<_ + + open IsStrictPartialOrder isStrictPartialOrder public + hiding (module Eq) + + module Eq where + setoid : Setoid c ℓ₁ + setoid = record + { isEquivalence = isEquivalence + } + + open Setoid setoid public + + +record DecStrictPartialOrder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _<_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ + _<_ : Rel Carrier ℓ₂ + isDecStrictPartialOrder : IsDecStrictPartialOrder _≈_ _<_ + + private + module DSPO = IsDecStrictPartialOrder isDecStrictPartialOrder + open DSPO public hiding (module Eq) + + strictPartialOrder : StrictPartialOrder c ℓ₁ ℓ₂ + strictPartialOrder = record + { isStrictPartialOrder = isStrictPartialOrder + } + + module Eq where + + decSetoid : DecSetoid c ℓ₁ + decSetoid = record + { isDecEquivalence = DSPO.Eq.isDecEquivalence + } + + open DecSetoid decSetoid public + + +------------------------------------------------------------------------ +-- Total orders +------------------------------------------------------------------------ + +record TotalOrder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ + _≤_ : Rel Carrier ℓ₂ + isTotalOrder : IsTotalOrder _≈_ _≤_ + + open IsTotalOrder isTotalOrder public + hiding (module Eq) + + poset : Poset c ℓ₁ ℓ₂ + poset = record + { isPartialOrder = isPartialOrder + } + + open Poset poset public + using (module Eq; preorder) + + totalPreorder : TotalPreorder c ℓ₁ ℓ₂ + totalPreorder = record + { isTotalPreorder = isTotalPreorder + } + + +record DecTotalOrder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ + _≤_ : Rel Carrier ℓ₂ + isDecTotalOrder : IsDecTotalOrder _≈_ _≤_ + + private + module DTO = IsDecTotalOrder isDecTotalOrder + open DTO public hiding (module Eq) + + totalOrder : TotalOrder c ℓ₁ ℓ₂ + totalOrder = record + { isTotalOrder = isTotalOrder + } + + open TotalOrder totalOrder public using (poset; preorder) + + decPoset : DecPoset c ℓ₁ ℓ₂ + decPoset = record + { isDecPartialOrder = isDecPartialOrder + } + + open DecPoset decPoset public using (module Eq) + + +-- Note that these orders are decidable. The current implementation +-- of `Trichotomous` subsumes irreflexivity and asymmetry. Any reasonable +-- definition capturing these three properties implies decidability +-- as `Trichotomous` necessarily separates out the equality case. + +record StrictTotalOrder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _<_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ + _<_ : Rel Carrier ℓ₂ + isStrictTotalOrder : IsStrictTotalOrder _≈_ _<_ + + open IsStrictTotalOrder isStrictTotalOrder public + hiding (module Eq) + + strictPartialOrder : StrictPartialOrder c ℓ₁ ℓ₂ + strictPartialOrder = record + { isStrictPartialOrder = isStrictPartialOrder + } + + open StrictPartialOrder strictPartialOrder public + using (module Eq) + + decSetoid : DecSetoid c ℓ₁ + decSetoid = record + { isDecEquivalence = isDecEquivalence + } + {-# WARNING_ON_USAGE decSetoid + "Warning: decSetoid was deprecated in v1.3. + Please use Eq.decSetoid instead." + #-} +\ No newline at end of file diff --git a/docs/Relation.Binary.Consequences.html b/docs/Relation.Binary.Consequences.html new file mode 100644 index 0000000..203bc5f --- /dev/null +++ b/docs/Relation.Binary.Consequences.html @@ -0,0 +1,287 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Some properties imply others +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.Consequences where + +open import Data.Maybe.Base using (just; nothing; decToMaybe) +open import Data.Sum.Base as Sum using (inj₁; inj₂) +open import Data.Product using (_,_) +open import Data.Empty.Irrelevant using (⊥-elim) +open import Function.Base using (_∘_; _$_; flip) +open import Level using (Level) +open import Relation.Binary.Core +open import Relation.Binary.Definitions +open import Relation.Nullary using (yes; no; recompute) +open import Relation.Nullary.Decidable.Core using (map′) +open import Relation.Unary using (∁; Pred) + +private + variable + a ℓ ℓ₁ ℓ₂ ℓ₃ ℓ₄ p : Level + A B : Set a + +------------------------------------------------------------------------ +-- Substitutive properties + +module _ {_∼_ : Rel A ℓ} (R : Rel A p) where + + subst⇒respˡ : Substitutive _∼_ p → R Respectsˡ _∼_ + subst⇒respˡ subst {y} x′∼x Px′y = subst (flip R y) x′∼x Px′y + + subst⇒respʳ : Substitutive _∼_ p → R Respectsʳ _∼_ + subst⇒respʳ subst {x} y′∼y Pxy′ = subst (R x) y′∼y Pxy′ + + subst⇒resp₂ : Substitutive _∼_ p → R Respects₂ _∼_ + subst⇒resp₂ subst = subst⇒respʳ subst , subst⇒respˡ subst + +module _ {_∼_ : Rel A ℓ} {P : Pred A p} where + + resp⇒¬-resp : Symmetric _∼_ → P Respects _∼_ → (∁ P) Respects _∼_ + resp⇒¬-resp sym resp x∼y ¬Px Py = ¬Px (resp (sym x∼y) Py) + +------------------------------------------------------------------------ +-- Proofs for non-strict orders + +module _ {_≈_ : Rel A ℓ₁} {_≤_ : Rel A ℓ₂} where + + total⇒refl : _≤_ Respects₂ _≈_ → Symmetric _≈_ → + Total _≤_ → _≈_ ⇒ _≤_ + total⇒refl (respʳ , respˡ) sym total {x} {y} x≈y with total x y + ... | inj₁ x∼y = x∼y + ... | inj₂ y∼x = respʳ x≈y (respˡ (sym x≈y) y∼x) + + total∧dec⇒dec : _≈_ ⇒ _≤_ → Antisymmetric _≈_ _≤_ → + Total _≤_ → Decidable _≈_ → Decidable _≤_ + total∧dec⇒dec refl antisym total _≟_ x y with total x y + ... | inj₁ x≤y = yes x≤y + ... | inj₂ y≤x = map′ refl (flip antisym y≤x) (x ≟ y) + +module _ (≈₁ : Rel A ℓ₁) (≈₂ : Rel B ℓ₂) {≤₁ : Rel A ℓ₃} {≤₂ : Rel B ℓ₄} where + + mono⇒cong : Symmetric ≈₁ → ≈₁ ⇒ ≤₁ → Antisymmetric ≈₂ ≤₂ → + ∀ {f} → f Preserves ≤₁ ⟶ ≤₂ → f Preserves ≈₁ ⟶ ≈₂ + mono⇒cong sym reflexive antisym mono x≈y = antisym + (mono (reflexive x≈y)) + (mono (reflexive (sym x≈y))) + + antimono⇒cong : Symmetric ≈₁ → ≈₁ ⇒ ≤₁ → Antisymmetric ≈₂ ≤₂ → + ∀ {f} → f Preserves ≤₁ ⟶ (flip ≤₂) → f Preserves ≈₁ ⟶ ≈₂ + antimono⇒cong sym reflexive antisym antimono p≈q = antisym + (antimono (reflexive (sym p≈q))) + (antimono (reflexive p≈q)) + +------------------------------------------------------------------------ +-- Proofs for strict orders + +module _ {_≈_ : Rel A ℓ₁} {_<_ : Rel A ℓ₂} where + + trans∧irr⇒asym : Reflexive _≈_ → Transitive _<_ → + Irreflexive _≈_ _<_ → Asymmetric _<_ + trans∧irr⇒asym refl trans irrefl x<y y<x = + irrefl refl (trans x<y y<x) + + irr∧antisym⇒asym : Irreflexive _≈_ _<_ → Antisymmetric _≈_ _<_ → + Asymmetric _<_ + irr∧antisym⇒asym irrefl antisym x<y y<x = + irrefl (antisym x<y y<x) x<y + + asym⇒antisym : Asymmetric _<_ → Antisymmetric _≈_ _<_ + asym⇒antisym asym x<y y<x = ⊥-elim (asym x<y y<x) + + asym⇒irr : _<_ Respects₂ _≈_ → Symmetric _≈_ → + Asymmetric _<_ → Irreflexive _≈_ _<_ + asym⇒irr (respʳ , respˡ) sym asym {x} {y} x≈y x<y = + asym x<y (respʳ (sym x≈y) (respˡ x≈y x<y)) + + tri⇒asym : Trichotomous _≈_ _<_ → Asymmetric _<_ + tri⇒asym tri {x} {y} x<y x>y with tri x y + ... | tri< _ _ x≯y = x≯y x>y + ... | tri≈ _ _ x≯y = x≯y x>y + ... | tri> x≮y _ _ = x≮y x<y + + tri⇒irr : Trichotomous _≈_ _<_ → Irreflexive _≈_ _<_ + tri⇒irr compare {x} {y} x≈y x<y with compare x y + ... | tri< _ x≉y y≮x = x≉y x≈y + ... | tri> x≮y x≉y y<x = x≉y x≈y + ... | tri≈ x≮y _ y≮x = x≮y x<y + + tri⇒dec≈ : Trichotomous _≈_ _<_ → Decidable _≈_ + tri⇒dec≈ compare x y with compare x y + ... | tri< _ x≉y _ = no x≉y + ... | tri≈ _ x≈y _ = yes x≈y + ... | tri> _ x≉y _ = no x≉y + + tri⇒dec< : Trichotomous _≈_ _<_ → Decidable _<_ + tri⇒dec< compare x y with compare x y + ... | tri< x<y _ _ = yes x<y + ... | tri≈ x≮y _ _ = no x≮y + ... | tri> x≮y _ _ = no x≮y + + trans∧tri⇒respʳ : Symmetric _≈_ → Transitive _≈_ → + Transitive _<_ → Trichotomous _≈_ _<_ → + _<_ Respectsʳ _≈_ + trans∧tri⇒respʳ sym ≈-tr <-tr tri {x} {y} {z} y≈z x<y with tri x z + ... | tri< x<z _ _ = x<z + ... | tri≈ _ x≈z _ = ⊥-elim (tri⇒irr tri (≈-tr x≈z (sym y≈z)) x<y) + ... | tri> _ _ z<x = ⊥-elim (tri⇒irr tri (sym y≈z) (<-tr z<x x<y)) + + trans∧tri⇒respˡ : Transitive _≈_ → + Transitive _<_ → Trichotomous _≈_ _<_ → + _<_ Respectsˡ _≈_ + trans∧tri⇒respˡ ≈-tr <-tr tri {z} {_} {y} x≈y x<z with tri y z + ... | tri< y<z _ _ = y<z + ... | tri≈ _ y≈z _ = ⊥-elim (tri⇒irr tri (≈-tr x≈y y≈z) x<z) + ... | tri> _ _ z<y = ⊥-elim (tri⇒irr tri x≈y (<-tr x<z z<y)) + + trans∧tri⇒resp : Symmetric _≈_ → Transitive _≈_ → + Transitive _<_ → Trichotomous _≈_ _<_ → + _<_ Respects₂ _≈_ + trans∧tri⇒resp sym ≈-tr <-tr tri = + trans∧tri⇒respʳ sym ≈-tr <-tr tri , + trans∧tri⇒respˡ ≈-tr <-tr tri + +------------------------------------------------------------------------ +-- Without Loss of Generality + +module _ {_R_ : Rel A ℓ₁} {Q : Rel A ℓ₂} where + + wlog : Total _R_ → Symmetric Q → + (∀ a b → a R b → Q a b) → + ∀ a b → Q a b + wlog r-total q-sym prf a b with r-total a b + ... | inj₁ aRb = prf a b aRb + ... | inj₂ bRa = q-sym (prf b a bRa) + +------------------------------------------------------------------------ +-- Other proofs + +module _ {R : REL A B p} where + + dec⇒weaklyDec : Decidable R → WeaklyDecidable R + dec⇒weaklyDec dec x y = decToMaybe (dec x y) + + dec⇒recomputable : Decidable R → Recomputable R + dec⇒recomputable dec {a} {b} = recompute $ dec a b + +module _ {R : REL A B ℓ₁} {S : REL A B ℓ₂} where + + map-NonEmpty : R ⇒ S → NonEmpty R → NonEmpty S + map-NonEmpty f x = nonEmpty (f (NonEmpty.proof x)) + +module _ {R : REL A B ℓ₁} {S : REL B A ℓ₂} where + + flip-Connex : Connex R S → Connex S R + flip-Connex f x y = Sum.swap (f y x) + + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.6 + +subst⟶respˡ = subst⇒respˡ +{-# WARNING_ON_USAGE subst⟶respˡ +"Warning: subst⟶respˡ was deprecated in v1.6. +Please use subst⇒respˡ instead." +#-} +subst⟶respʳ = subst⇒respʳ +{-# WARNING_ON_USAGE subst⟶respʳ +"Warning: subst⟶respʳ was deprecated in v1.6. +Please use subst⇒respʳ instead." +#-} +subst⟶resp₂ = subst⇒resp₂ +{-# WARNING_ON_USAGE subst⟶resp₂ +"Warning: subst⟶resp₂ was deprecated in v1.6. +Please use subst⇒resp₂ instead." +#-} +P-resp⟶¬P-resp = resp⇒¬-resp +{-# WARNING_ON_USAGE P-resp⟶¬P-resp +"Warning: P-resp⟶¬P-resp was deprecated in v1.6. +Please use resp⇒¬-resp instead." +#-} +total⟶refl = total⇒refl +{-# WARNING_ON_USAGE total⟶refl +"Warning: total⟶refl was deprecated in v1.6. +Please use total⇒refl instead." +#-} +total+dec⟶dec = total∧dec⇒dec +{-# WARNING_ON_USAGE total+dec⟶dec +"Warning: total+dec⟶dec was deprecated in v1.6. +Please use total∧dec⇒dec instead." +#-} +trans∧irr⟶asym = trans∧irr⇒asym +{-# WARNING_ON_USAGE trans∧irr⟶asym +"Warning: trans∧irr⟶asym was deprecated in v1.6. +Please use trans∧irr⇒asym instead." +#-} +irr∧antisym⟶asym = irr∧antisym⇒asym +{-# WARNING_ON_USAGE irr∧antisym⟶asym +"Warning: irr∧antisym⟶asym was deprecated in v1.6. +Please use irr∧antisym⇒asym instead." +#-} +asym⟶antisym = asym⇒antisym +{-# WARNING_ON_USAGE asym⟶antisym +"Warning: asym⟶antisym was deprecated in v1.6. +Please use asym⇒antisym instead." +#-} +asym⟶irr = asym⇒irr +{-# WARNING_ON_USAGE asym⟶irr +"Warning: asym⟶irr was deprecated in v1.6. +Please use asym⇒irr instead." +#-} +tri⟶asym = tri⇒asym +{-# WARNING_ON_USAGE tri⟶asym +"Warning: tri⟶asym was deprecated in v1.6. +Please use tri⇒asym instead." +#-} +tri⟶irr = tri⇒irr +{-# WARNING_ON_USAGE tri⟶irr +"Warning: tri⟶irr was deprecated in v1.6. +Please use tri⇒irr instead." +#-} +tri⟶dec≈ = tri⇒dec≈ +{-# WARNING_ON_USAGE tri⟶dec≈ +"Warning: tri⟶dec≈ was deprecated in v1.6. +Please use tri⇒dec≈ instead." +#-} +tri⟶dec< = tri⇒dec< +{-# WARNING_ON_USAGE tri⟶dec< +"Warning: tri⟶dec< was deprecated in v1.6. +Please use tri⇒dec< instead." +#-} +trans∧tri⟶respʳ≈ = trans∧tri⇒respʳ +{-# WARNING_ON_USAGE trans∧tri⟶respʳ≈ +"Warning: trans∧tri⟶respʳ≈ was deprecated in v1.6. +Please use trans∧tri⇒respʳ instead." +#-} +trans∧tri⟶respˡ≈ = trans∧tri⇒respˡ +{-# WARNING_ON_USAGE trans∧tri⟶respˡ≈ +"Warning: trans∧tri⟶respˡ≈ was deprecated in v1.6. +Please use trans∧tri⇒respˡ instead." +#-} +trans∧tri⟶resp≈ = trans∧tri⇒resp +{-# WARNING_ON_USAGE trans∧tri⟶resp≈ +"Warning: trans∧tri⟶resp≈ was deprecated in v1.6. +Please use trans∧tri⇒resp instead." +#-} +dec⟶weaklyDec = dec⇒weaklyDec +{-# WARNING_ON_USAGE dec⟶weaklyDec +"Warning: dec⟶weaklyDec was deprecated in v1.6. +Please use dec⇒weaklyDec instead." +#-} +dec⟶recomputable = dec⇒recomputable +{-# WARNING_ON_USAGE dec⟶recomputable +"Warning: dec⟶recomputable was deprecated in v1.6. +Please use dec⇒recomputable instead." +#-} +\ No newline at end of file diff --git a/docs/Relation.Binary.Construct.Converse.html b/docs/Relation.Binary.Construct.Converse.html new file mode 100644 index 0000000..2e04880 --- /dev/null +++ b/docs/Relation.Binary.Construct.Converse.html @@ -0,0 +1,211 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Many properties which hold for `∼` also hold for `flip ∼`. Unlike +-- the module `Relation.Binary.Construct.Flip` this module does not +-- flip the underlying equality. +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Relation.Binary.Construct.Converse where + +open import Function.Base using (flip; _∘_) +open import Data.Product + +------------------------------------------------------------------------ +-- Properties + +module _ {a ℓ} {A : Set a} (∼ : Rel A ℓ) where + + refl : Reflexive ∼ → Reflexive (flip ∼) + refl refl = refl + + sym : Symmetric ∼ → Symmetric (flip ∼) + sym sym = sym + + trans : Transitive ∼ → Transitive (flip ∼) + trans trans = flip trans + + asym : Asymmetric ∼ → Asymmetric (flip ∼) + asym asym = asym + + total : Total ∼ → Total (flip ∼) + total total x y = total y x + + resp : ∀ {p} (P : A → Set p) → Symmetric ∼ → + P Respects ∼ → P Respects (flip ∼) + resp _ sym resp ∼ = resp (sym ∼) + + max : ∀ {⊥} → Minimum ∼ ⊥ → Maximum (flip ∼) ⊥ + max min = min + + min : ∀ {⊤} → Maximum ∼ ⊤ → Minimum (flip ∼) ⊤ + min max = max + +module _ {a ℓ₁ ℓ₂} {A : Set a} {≈ : Rel A ℓ₁} (∼ : Rel A ℓ₂) where + + reflexive : Symmetric ≈ → (≈ ⇒ ∼) → (≈ ⇒ flip ∼) + reflexive sym impl = impl ∘ sym + + irrefl : Symmetric ≈ → Irreflexive ≈ ∼ → Irreflexive ≈ (flip ∼) + irrefl sym irrefl x≈y y∼x = irrefl (sym x≈y) y∼x + + antisym : Antisymmetric ≈ ∼ → Antisymmetric ≈ (flip ∼) + antisym antisym = flip antisym + + compare : Trichotomous ≈ ∼ → Trichotomous ≈ (flip ∼) + compare cmp x y with cmp x y + ... | tri< x<y x≉y y≮x = tri> y≮x x≉y x<y + ... | tri≈ x≮y x≈y y≮x = tri≈ y≮x x≈y x≮y + ... | tri> x≮y x≉y y<x = tri< y<x x≉y x≮y + +module _ {a ℓ₁ ℓ₂} {A : Set a} (∼₁ : Rel A ℓ₁) (∼₂ : Rel A ℓ₂) where + + resp₂ : ∼₁ Respects₂ ∼₂ → (flip ∼₁) Respects₂ ∼₂ + resp₂ (resp₁ , resp₂) = resp₂ , resp₁ + +module _ {a b ℓ} {A : Set a} {B : Set b} (∼ : REL A B ℓ) where + + dec : Decidable ∼ → Decidable (flip ∼) + dec dec = flip dec + +------------------------------------------------------------------------ +-- Structures + +module _ {a ℓ} {A : Set a} {≈ : Rel A ℓ} where + + isEquivalence : IsEquivalence ≈ → IsEquivalence (flip ≈) + isEquivalence eq = record + { refl = refl ≈ Eq.refl + ; sym = sym ≈ Eq.sym + ; trans = trans ≈ Eq.trans + } + where module Eq = IsEquivalence eq + + isDecEquivalence : IsDecEquivalence ≈ → IsDecEquivalence (flip ≈) + isDecEquivalence eq = record + { isEquivalence = isEquivalence Dec.isEquivalence + ; _≟_ = dec ≈ Dec._≟_ + } + where module Dec = IsDecEquivalence eq + +module _ {a ℓ₁ ℓ₂} {A : Set a} {≈ : Rel A ℓ₁} {∼ : Rel A ℓ₂} where + + isPreorder : IsPreorder ≈ ∼ → IsPreorder ≈ (flip ∼) + isPreorder O = record + { isEquivalence = O.isEquivalence + ; reflexive = reflexive ∼ O.Eq.sym O.reflexive + ; trans = trans ∼ O.trans + } + where module O = IsPreorder O + + isTotalPreorder : IsTotalPreorder ≈ ∼ → IsTotalPreorder ≈ (flip ∼) + isTotalPreorder O = record + { isPreorder = isPreorder O.isPreorder + ; total = total _ O.total + } where module O = IsTotalPreorder O + + isPartialOrder : IsPartialOrder ≈ ∼ → IsPartialOrder ≈ (flip ∼) + isPartialOrder O = record + { isPreorder = isPreorder O.isPreorder + ; antisym = antisym ∼ O.antisym + } + where module O = IsPartialOrder O + + isTotalOrder : IsTotalOrder ≈ ∼ → IsTotalOrder ≈ (flip ∼) + isTotalOrder O = record + { isPartialOrder = isPartialOrder O.isPartialOrder + ; total = total ∼ O.total + } + where module O = IsTotalOrder O + + isDecTotalOrder : IsDecTotalOrder ≈ ∼ → IsDecTotalOrder ≈ (flip ∼) + isDecTotalOrder O = record + { isTotalOrder = isTotalOrder O.isTotalOrder + ; _≟_ = O._≟_ + ; _≤?_ = dec ∼ O._≤?_ + } + where module O = IsDecTotalOrder O + + isStrictPartialOrder : IsStrictPartialOrder ≈ ∼ → + IsStrictPartialOrder ≈ (flip ∼) + isStrictPartialOrder O = record + { isEquivalence = O.isEquivalence + ; irrefl = irrefl ∼ O.Eq.sym O.irrefl + ; trans = trans ∼ O.trans + ; <-resp-≈ = resp₂ ∼ ≈ O.<-resp-≈ + } + where module O = IsStrictPartialOrder O + + isStrictTotalOrder : IsStrictTotalOrder ≈ ∼ → + IsStrictTotalOrder ≈ (flip ∼) + isStrictTotalOrder O = record + { isEquivalence = O.isEquivalence + ; trans = trans ∼ O.trans + ; compare = compare ∼ O.compare + } + where module O = IsStrictTotalOrder O + +module _ {a ℓ} where + + setoid : Setoid a ℓ → Setoid a ℓ + setoid S = record + { isEquivalence = isEquivalence S.isEquivalence + } + where module S = Setoid S + + decSetoid : DecSetoid a ℓ → DecSetoid a ℓ + decSetoid S = record + { isDecEquivalence = isDecEquivalence S.isDecEquivalence + } + where module S = DecSetoid S + +module _ {a ℓ₁ ℓ₂} where + + preorder : Preorder a ℓ₁ ℓ₂ → Preorder a ℓ₁ ℓ₂ + preorder O = record + { isPreorder = isPreorder O.isPreorder + } + where module O = Preorder O + + totalPreorder : TotalPreorder a ℓ₁ ℓ₂ → TotalPreorder a ℓ₁ ℓ₂ + totalPreorder O = record + { isTotalPreorder = isTotalPreorder O.isTotalPreorder + } where module O = TotalPreorder O + + poset : Poset a ℓ₁ ℓ₂ → Poset a ℓ₁ ℓ₂ + poset O = record + { isPartialOrder = isPartialOrder O.isPartialOrder + } + where module O = Poset O + + totalOrder : TotalOrder a ℓ₁ ℓ₂ → TotalOrder a ℓ₁ ℓ₂ + totalOrder O = record + { isTotalOrder = isTotalOrder O.isTotalOrder + } + where module O = TotalOrder O + + decTotalOrder : DecTotalOrder a ℓ₁ ℓ₂ → DecTotalOrder a ℓ₁ ℓ₂ + decTotalOrder O = record + { isDecTotalOrder = isDecTotalOrder O.isDecTotalOrder + } + where module O = DecTotalOrder O + + strictPartialOrder : StrictPartialOrder a ℓ₁ ℓ₂ → + StrictPartialOrder a ℓ₁ ℓ₂ + strictPartialOrder O = record + { isStrictPartialOrder = isStrictPartialOrder O.isStrictPartialOrder + } + where module O = StrictPartialOrder O + + strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂ → + StrictTotalOrder a ℓ₁ ℓ₂ + strictTotalOrder O = record + { isStrictTotalOrder = isStrictTotalOrder O.isStrictTotalOrder + } + where module O = StrictTotalOrder O +\ No newline at end of file diff --git a/docs/Relation.Binary.Construct.NaturalOrder.Left.html b/docs/Relation.Binary.Construct.NaturalOrder.Left.html new file mode 100644 index 0000000..4b012b2 --- /dev/null +++ b/docs/Relation.Binary.Construct.NaturalOrder.Left.html @@ -0,0 +1,186 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Conversion of binary operators to binary relations via the left +-- natural order. +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary +open import Algebra.Core + +module Relation.Binary.Construct.NaturalOrder.Left + {a ℓ} {A : Set a} (_≈_ : Rel A ℓ) (_∙_ : Op₂ A) where + +open import Algebra.Definitions _≈_ +open import Algebra.Structures _≈_ +open import Data.Product using (_,_; _×_) +open import Data.Sum.Base using (inj₁; inj₂) +open import Relation.Nullary using (¬_) +import Relation.Binary.Reasoning.Setoid as EqReasoning +open import Relation.Binary.Lattice using (Infimum) + +------------------------------------------------------------------------ +-- Definition + +infix 4 _≤_ + +_≤_ : Rel A ℓ +x ≤ y = x ≈ (x ∙ y) + +------------------------------------------------------------------------ +-- Relational properties + +reflexive : IsMagma _∙_ → Idempotent _∙_ → _≈_ ⇒ _≤_ +reflexive magma idem {x} {y} x≈y = begin + x ≈⟨ sym (idem x) ⟩ + x ∙ x ≈⟨ ∙-cong refl x≈y ⟩ + x ∙ y ∎ + where open IsMagma magma; open EqReasoning setoid + +refl : Symmetric _≈_ → Idempotent _∙_ → Reflexive _≤_ +refl sym idem {x} = sym (idem x) + +antisym : IsEquivalence _≈_ → Commutative _∙_ → Antisymmetric _≈_ _≤_ +antisym isEq comm {x} {y} x≤y y≤x = begin + x ≈⟨ x≤y ⟩ + x ∙ y ≈⟨ comm x y ⟩ + y ∙ x ≈⟨ sym y≤x ⟩ + y ∎ + where open IsEquivalence isEq; open EqReasoning (record { isEquivalence = isEq }) + +total : Symmetric _≈_ → Transitive _≈_ → Selective _∙_ → Commutative _∙_ → Total _≤_ +total sym trans sel comm x y with sel x y +... | inj₁ x∙y≈x = inj₁ (sym x∙y≈x) +... | inj₂ x∙y≈y = inj₂ (sym (trans (comm y x) x∙y≈y)) + +trans : IsSemigroup _∙_ → Transitive _≤_ +trans semi {x} {y} {z} x≤y y≤z = begin + x ≈⟨ x≤y ⟩ + x ∙ y ≈⟨ ∙-cong S.refl y≤z ⟩ + x ∙ (y ∙ z) ≈⟨ sym (assoc x y z) ⟩ + (x ∙ y) ∙ z ≈⟨ ∙-cong (sym x≤y) S.refl ⟩ + x ∙ z ∎ + where open module S = IsSemigroup semi; open EqReasoning S.setoid + +respʳ : IsMagma _∙_ → _≤_ Respectsʳ _≈_ +respʳ magma {x} {y} {z} y≈z x≤y = begin + x ≈⟨ x≤y ⟩ + x ∙ y ≈⟨ ∙-cong M.refl y≈z ⟩ + x ∙ z ∎ + where open module M = IsMagma magma; open EqReasoning M.setoid + +respˡ : IsMagma _∙_ → _≤_ Respectsˡ _≈_ +respˡ magma {x} {y} {z} y≈z y≤x = begin + z ≈⟨ sym y≈z ⟩ + y ≈⟨ y≤x ⟩ + y ∙ x ≈⟨ ∙-cong y≈z M.refl ⟩ + z ∙ x ∎ + where open module M = IsMagma magma; open EqReasoning M.setoid + +resp₂ : IsMagma _∙_ → _≤_ Respects₂ _≈_ +resp₂ magma = respʳ magma , respˡ magma + +dec : Decidable _≈_ → Decidable _≤_ +dec _≟_ x y = x ≟ (x ∙ y) + +module _ (semi : IsSemilattice _∙_) where + + private open module S = IsSemilattice semi + open EqReasoning setoid + + x∙y≤x : ∀ x y → (x ∙ y) ≤ x + x∙y≤x x y = begin + x ∙ y ≈⟨ ∧-cong (sym (idem x)) S.refl ⟩ + (x ∙ x) ∙ y ≈⟨ assoc x x y ⟩ + x ∙ (x ∙ y) ≈⟨ comm x (x ∙ y) ⟩ + (x ∙ y) ∙ x ∎ + + x∙y≤y : ∀ x y → (x ∙ y) ≤ y + x∙y≤y x y = begin + x ∙ y ≈⟨ ∧-cong S.refl (sym (idem y)) ⟩ + x ∙ (y ∙ y) ≈⟨ sym (assoc x y y) ⟩ + (x ∙ y) ∙ y ∎ + + ∙-presʳ-≤ : ∀ {x y} z → z ≤ x → z ≤ y → z ≤ (x ∙ y) + ∙-presʳ-≤ {x} {y} z z≤x z≤y = begin + z ≈⟨ z≤y ⟩ + z ∙ y ≈⟨ ∧-cong z≤x S.refl ⟩ + (z ∙ x) ∙ y ≈⟨ assoc z x y ⟩ + z ∙ (x ∙ y) ∎ + + infimum : Infimum _≤_ _∙_ + infimum x y = x∙y≤x x y , x∙y≤y x y , ∙-presʳ-≤ + +------------------------------------------------------------------------ +-- Structures + +isPreorder : IsBand _∙_ → IsPreorder _≈_ _≤_ +isPreorder band = record + { isEquivalence = isEquivalence + ; reflexive = reflexive isMagma idem + ; trans = trans isSemigroup + } + where open IsBand band hiding (reflexive; trans) + +isPartialOrder : IsSemilattice _∙_ → IsPartialOrder _≈_ _≤_ +isPartialOrder semilattice = record + { isPreorder = isPreorder isBand + ; antisym = antisym isEquivalence comm + } + where open IsSemilattice semilattice + +isDecPartialOrder : IsSemilattice _∙_ → Decidable _≈_ → + IsDecPartialOrder _≈_ _≤_ +isDecPartialOrder semilattice _≟_ = record + { isPartialOrder = isPartialOrder semilattice + ; _≟_ = _≟_ + ; _≤?_ = dec _≟_ + } + +isTotalOrder : IsSemilattice _∙_ → Selective _∙_ → IsTotalOrder _≈_ _≤_ +isTotalOrder latt sel = record + { isPartialOrder = isPartialOrder latt + ; total = total sym S.trans sel comm + } + where open module S = IsSemilattice latt + +isDecTotalOrder : IsSemilattice _∙_ → Selective _∙_ → + Decidable _≈_ → IsDecTotalOrder _≈_ _≤_ +isDecTotalOrder latt sel _≟_ = record + { isTotalOrder = isTotalOrder latt sel + ; _≟_ = _≟_ + ; _≤?_ = dec _≟_ + } + +------------------------------------------------------------------------ +-- Bundles + +preorder : IsBand _∙_ → Preorder a ℓ ℓ +preorder band = record + { isPreorder = isPreorder band + } + +poset : IsSemilattice _∙_ → Poset a ℓ ℓ +poset latt = record + { isPartialOrder = isPartialOrder latt + } + +decPoset : IsSemilattice _∙_ → Decidable _≈_ → DecPoset a ℓ ℓ +decPoset latt dec = record + { isDecPartialOrder = isDecPartialOrder latt dec + } + +totalOrder : IsSemilattice _∙_ → Selective _∙_ → TotalOrder a ℓ ℓ +totalOrder latt sel = record + { isTotalOrder = isTotalOrder latt sel + } + +decTotalOrder : IsSemilattice _∙_ → Selective _∙_ → + Decidable _≈_ → DecTotalOrder a ℓ ℓ +decTotalOrder latt sel dec = record + { isDecTotalOrder = isDecTotalOrder latt sel dec + } +\ No newline at end of file diff --git a/docs/Relation.Binary.Construct.NonStrictToStrict.html b/docs/Relation.Binary.Construct.NonStrictToStrict.html new file mode 100644 index 0000000..0e7767e --- /dev/null +++ b/docs/Relation.Binary.Construct.NonStrictToStrict.html @@ -0,0 +1,196 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Conversion of _≤_ to _<_ +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Relation.Binary.Construct.NonStrictToStrict + {a ℓ₁ ℓ₂} {A : Set a} (_≈_ : Rel A ℓ₁) (_≤_ : Rel A ℓ₂) where + +open import Data.Product using (_×_; _,_; proj₁; proj₂) +open import Data.Sum.Base using (inj₁; inj₂) +open import Function.Base using (_∘_; flip) +open import Relation.Nullary using (¬_; yes; no) +open import Relation.Nullary.Negation using (contradiction; ¬?) +open import Relation.Nullary.Product using (_×-dec_) + +private + _≉_ : Rel A ℓ₁ + x ≉ y = ¬ (x ≈ y) + +------------------------------------------------------------------------ +-- _≤_ can be turned into _<_ as follows: + +infix 4 _<_ + +_<_ : Rel A _ +x < y = x ≤ y × x ≉ y + +------------------------------------------------------------------------ +-- Relationship between relations + +<⇒≤ : _<_ ⇒ _≤_ +<⇒≤ = proj₁ + +<⇒≉ : ∀ {x y} → x < y → x ≉ y +<⇒≉ = proj₂ + +≤∧≉⇒< : ∀ {x y} → x ≤ y → x ≉ y → x < y +≤∧≉⇒< = _,_ + +<⇒≱ : Antisymmetric _≈_ _≤_ → ∀ {x y} → x < y → ¬ (y ≤ x) +<⇒≱ antisym (x≤y , x≉y) y≤x = x≉y (antisym x≤y y≤x) + +≤⇒≯ : Antisymmetric _≈_ _≤_ → ∀ {x y} → x ≤ y → ¬ (y < x) +≤⇒≯ antisym x≤y y<x = <⇒≱ antisym y<x x≤y + +≰⇒> : Symmetric _≈_ → (_≈_ ⇒ _≤_) → Total _≤_ → + ∀ {x y} → ¬ (x ≤ y) → y < x +≰⇒> sym refl total {x} {y} x≰y with total x y +... | inj₁ x≤y = contradiction x≤y x≰y +... | inj₂ y≤x = y≤x , x≰y ∘ refl ∘ sym + +≮⇒≥ : Symmetric _≈_ → Decidable _≈_ → _≈_ ⇒ _≤_ → Total _≤_ → + ∀ {x y} → ¬ (x < y) → y ≤ x +≮⇒≥ sym _≟_ ≤-refl _≤?_ {x} {y} x≮y with x ≟ y | y ≤? x +... | yes x≈y | _ = ≤-refl (sym x≈y) +... | _ | inj₁ y≤x = y≤x +... | no x≉y | inj₂ x≤y = contradiction (x≤y , x≉y) x≮y + +------------------------------------------------------------------------ +-- Relational properties + +<-irrefl : Irreflexive _≈_ _<_ +<-irrefl x≈y (_ , x≉y) = x≉y x≈y + +<-trans : IsPartialOrder _≈_ _≤_ → Transitive _<_ +<-trans po (x≤y , x≉y) (y≤z , y≉z) = + (trans x≤y y≤z , x≉y ∘ antisym x≤y ∘ trans y≤z ∘ reflexive ∘ Eq.sym) + where open IsPartialOrder po + +<-≤-trans : Symmetric _≈_ → Transitive _≤_ → Antisymmetric _≈_ _≤_ → + _≤_ Respectsʳ _≈_ → Trans _<_ _≤_ _<_ +<-≤-trans sym trans antisym respʳ (x≤y , x≉y) y≤z = + trans x≤y y≤z , (λ x≈z → x≉y (antisym x≤y (respʳ (sym x≈z) y≤z))) + +≤-<-trans : Transitive _≤_ → Antisymmetric _≈_ _≤_ → + _≤_ Respectsˡ _≈_ → Trans _≤_ _<_ _<_ +≤-<-trans trans antisym respʳ x≤y (y≤z , y≉z) = + trans x≤y y≤z , (λ x≈z → y≉z (antisym y≤z (respʳ x≈z x≤y))) + +<-asym : Antisymmetric _≈_ _≤_ → Asymmetric _<_ +<-asym antisym (x≤y , x≉y) (y≤x , _) = x≉y (antisym x≤y y≤x) + +<-respˡ-≈ : Transitive _≈_ → _≤_ Respectsˡ _≈_ → _<_ Respectsˡ _≈_ +<-respˡ-≈ trans respˡ y≈z (y≤x , y≉x) = + respˡ y≈z y≤x , y≉x ∘ trans y≈z + +<-respʳ-≈ : Symmetric _≈_ → Transitive _≈_ → + _≤_ Respectsʳ _≈_ → _<_ Respectsʳ _≈_ +<-respʳ-≈ sym trans respʳ y≈z (x≤y , x≉y) = + (respʳ y≈z x≤y) , λ x≈z → x≉y (trans x≈z (sym y≈z)) + +<-resp-≈ : IsEquivalence _≈_ → _≤_ Respects₂ _≈_ → _<_ Respects₂ _≈_ +<-resp-≈ eq (respʳ , respˡ) = + <-respʳ-≈ sym trans respʳ , <-respˡ-≈ trans respˡ + where open IsEquivalence eq + +<-trichotomous : Symmetric _≈_ → Decidable _≈_ → + Antisymmetric _≈_ _≤_ → Total _≤_ → + Trichotomous _≈_ _<_ +<-trichotomous ≈-sym _≟_ antisym total x y with x ≟ y +... | yes x≈y = tri≈ (<-irrefl x≈y) x≈y (<-irrefl (≈-sym x≈y)) +... | no x≉y with total x y +... | inj₁ x≤y = tri< (x≤y , x≉y) x≉y (x≉y ∘ antisym x≤y ∘ proj₁) +... | inj₂ y≤x = tri> (x≉y ∘ flip antisym y≤x ∘ proj₁) x≉y (y≤x , x≉y ∘ ≈-sym) + +<-decidable : Decidable _≈_ → Decidable _≤_ → Decidable _<_ +<-decidable _≟_ _≤?_ x y = x ≤? y ×-dec ¬? (x ≟ y) + +------------------------------------------------------------------------ +-- Structures + +<-isStrictPartialOrder : IsPartialOrder _≈_ _≤_ → + IsStrictPartialOrder _≈_ _<_ +<-isStrictPartialOrder po = record + { isEquivalence = isEquivalence + ; irrefl = <-irrefl + ; trans = <-trans po + ; <-resp-≈ = <-resp-≈ isEquivalence ≤-resp-≈ + } where open IsPartialOrder po + +<-isDecStrictPartialOrder : IsDecPartialOrder _≈_ _≤_ → + IsDecStrictPartialOrder _≈_ _<_ +<-isDecStrictPartialOrder dpo = record + { isStrictPartialOrder = <-isStrictPartialOrder isPartialOrder + ; _≟_ = _≟_ + ; _<?_ = <-decidable _≟_ _≤?_ + } where open IsDecPartialOrder dpo + +<-isStrictTotalOrder₁ : Decidable _≈_ → IsTotalOrder _≈_ _≤_ → + IsStrictTotalOrder _≈_ _<_ +<-isStrictTotalOrder₁ ≟ tot = record + { isEquivalence = isEquivalence + ; trans = <-trans isPartialOrder + ; compare = <-trichotomous Eq.sym ≟ antisym total + } where open IsTotalOrder tot + +<-isStrictTotalOrder₂ : IsDecTotalOrder _≈_ _≤_ → + IsStrictTotalOrder _≈_ _<_ +<-isStrictTotalOrder₂ dtot = <-isStrictTotalOrder₁ _≟_ isTotalOrder + where open IsDecTotalOrder dtot + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 0.16 + +irrefl = <-irrefl +{-# WARNING_ON_USAGE irrefl +"Warning: irrefl was deprecated in v0.16. +Please use <-irrefl instead." +#-} +trans = <-trans +{-# WARNING_ON_USAGE trans +"Warning: trans was deprecated in v0.16. +Please use <-trans instead." +#-} +antisym⟶asym = <-asym +{-# WARNING_ON_USAGE antisym⟶asym +"Warning: antisym⟶asym was deprecated in v0.16. +Please use <-asym instead." +#-} +decidable = <-decidable +{-# WARNING_ON_USAGE decidable +"Warning: decidable was deprecated in v0.16. +Please use <-decidable instead." +#-} +trichotomous = <-trichotomous +{-# WARNING_ON_USAGE trichotomous +"Warning: trichotomous was deprecated in v0.16. +Please use <-trichotomous instead." +#-} +isPartialOrder⟶isStrictPartialOrder = <-isStrictPartialOrder +{-# WARNING_ON_USAGE isPartialOrder⟶isStrictPartialOrder +"Warning: isPartialOrder⟶isStrictPartialOrder was deprecated in v0.16. +Please use <-isStrictPartialOrder instead." +#-} +isTotalOrder⟶isStrictTotalOrder = <-isStrictTotalOrder₁ +{-# WARNING_ON_USAGE isTotalOrder⟶isStrictTotalOrder +"Warning: isTotalOrder⟶isStrictTotalOrder was deprecated in v0.16. +Please use <-isStrictTotalOrder₁ instead." +#-} +isDecTotalOrder⟶isStrictTotalOrder = <-isStrictTotalOrder₂ +{-# WARNING_ON_USAGE isDecTotalOrder⟶isStrictTotalOrder +"Warning: isDecTotalOrder⟶isStrictTotalOrder was deprecated in v0.16. +Please use <-isStrictTotalOrder₂ instead." +#-} +\ No newline at end of file diff --git a/docs/Relation.Binary.Core.html b/docs/Relation.Binary.Core.html new file mode 100644 index 0000000..c411b35 --- /dev/null +++ b/docs/Relation.Binary.Core.html @@ -0,0 +1,68 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of binary relations +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via `Relation.Binary`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.Core where + +open import Data.Product using (_×_) +open import Function.Base using (_on_) +open import Level using (Level; _⊔_; suc) + +private + variable + a b c ℓ ℓ₁ ℓ₂ ℓ₃ : Level + A : Set a + B : Set b + C : Set c + +------------------------------------------------------------------------ +-- Definitions +------------------------------------------------------------------------ + +-- Heterogeneous binary relations + +REL : Set a → Set b → (ℓ : Level) → Set (a ⊔ b ⊔ suc ℓ) +REL A B ℓ = A → B → Set ℓ + +-- Homogeneous binary relations + +Rel : Set a → (ℓ : Level) → Set (a ⊔ suc ℓ) +Rel A ℓ = REL A A ℓ + +------------------------------------------------------------------------ +-- Relationships between relations +------------------------------------------------------------------------ + +infix 4 _⇒_ _⇔_ _=[_]⇒_ + +-- Implication/containment - could also be written _⊆_. +-- and corresponding notion of equivalence + +_⇒_ : REL A B ℓ₁ → REL A B ℓ₂ → Set _ +P ⇒ Q = ∀ {x y} → P x y → Q x y + +_⇔_ : REL A B ℓ₁ → REL A B ℓ₂ → Set _ +P ⇔ Q = P ⇒ Q × Q ⇒ P + +-- Generalised implication - if P ≡ Q it can be read as "f preserves P". + +_=[_]⇒_ : Rel A ℓ₁ → (A → B) → Rel B ℓ₂ → Set _ +P =[ f ]⇒ Q = P ⇒ (Q on f) + +-- A synonym for _=[_]⇒_. + +_Preserves_⟶_ : (A → B) → Rel A ℓ₁ → Rel B ℓ₂ → Set _ +f Preserves P ⟶ Q = P =[ f ]⇒ Q + +-- A binary variant of _Preserves_⟶_. + +_Preserves₂_⟶_⟶_ : (A → B → C) → Rel A ℓ₁ → Rel B ℓ₂ → Rel C ℓ₃ → Set _ +_∙_ Preserves₂ P ⟶ Q ⟶ R = ∀ {x y u v} → P x y → Q u v → R (x ∙ u) (y ∙ v) +\ No newline at end of file diff --git a/docs/Relation.Binary.Definitions.html b/docs/Relation.Binary.Definitions.html new file mode 100644 index 0000000..8f997e0 --- /dev/null +++ b/docs/Relation.Binary.Definitions.html @@ -0,0 +1,225 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of binary relations +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via `Relation.Binary`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.Definitions where + +open import Agda.Builtin.Equality using (_≡_) + +open import Data.Maybe.Base using (Maybe) +open import Data.Product using (_×_) +open import Data.Sum.Base using (_⊎_) +open import Function.Base using (_on_; flip) +open import Level +open import Relation.Binary.Core +open import Relation.Nullary using (Dec; ¬_) + +private + variable + a b c ℓ ℓ₁ ℓ₂ ℓ₃ : Level + A : Set a + B : Set b + C : Set c + +------------------------------------------------------------------------ +-- Definitions +------------------------------------------------------------------------ + +-- Reflexivity - defined without an underlying equality. It could +-- alternatively be defined as `_≈_ ⇒ _∼_` for some equality `_≈_`. + +-- Confusingly the convention in the library is to use the name "refl" +-- for proofs of Reflexive and `reflexive` for proofs of type `_≈_ ⇒ _∼_`, +-- e.g. in the definition of `IsEquivalence` later in this file. This +-- convention is a legacy from the early days of the library. + +Reflexive : Rel A ℓ → Set _ +Reflexive _∼_ = ∀ {x} → x ∼ x + +-- Generalised symmetry. + +Sym : REL A B ℓ₁ → REL B A ℓ₂ → Set _ +Sym P Q = P ⇒ flip Q + +-- Symmetry. + +Symmetric : Rel A ℓ → Set _ +Symmetric _∼_ = Sym _∼_ _∼_ + +-- Generalised transitivity. + +Trans : REL A B ℓ₁ → REL B C ℓ₂ → REL A C ℓ₃ → Set _ +Trans P Q R = ∀ {i j k} → P i j → Q j k → R i k + +-- A flipped variant of generalised transitivity. + +TransFlip : REL A B ℓ₁ → REL B C ℓ₂ → REL A C ℓ₃ → Set _ +TransFlip P Q R = ∀ {i j k} → Q j k → P i j → R i k + +-- Transitivity. + +Transitive : Rel A ℓ → Set _ +Transitive _∼_ = Trans _∼_ _∼_ _∼_ + +-- Generalised antisymmetry + +Antisym : REL A B ℓ₁ → REL B A ℓ₂ → REL A B ℓ₃ → Set _ +Antisym R S E = ∀ {i j} → R i j → S j i → E i j + +-- Antisymmetry. + +Antisymmetric : Rel A ℓ₁ → Rel A ℓ₂ → Set _ +Antisymmetric _≈_ _≤_ = Antisym _≤_ _≤_ _≈_ + +-- Irreflexivity - this is defined terms of the underlying equality. + +Irreflexive : REL A B ℓ₁ → REL A B ℓ₂ → Set _ +Irreflexive _≈_ _<_ = ∀ {x y} → x ≈ y → ¬ (x < y) + +-- Asymmetry. + +Asymmetric : Rel A ℓ → Set _ +Asymmetric _<_ = ∀ {x y} → x < y → ¬ (y < x) + +-- Generalised connex - exactly one of the two relations holds. + +Connex : REL A B ℓ₁ → REL B A ℓ₂ → Set _ +Connex P Q = ∀ x y → P x y ⊎ Q y x + +-- Totality. + +Total : Rel A ℓ → Set _ +Total _∼_ = Connex _∼_ _∼_ + +-- Generalised trichotomy - exactly one of three types has a witness. + +data Tri (A : Set a) (B : Set b) (C : Set c) : Set (a ⊔ b ⊔ c) where + tri< : ( a : A) (¬b : ¬ B) (¬c : ¬ C) → Tri A B C + tri≈ : (¬a : ¬ A) ( b : B) (¬c : ¬ C) → Tri A B C + tri> : (¬a : ¬ A) (¬b : ¬ B) ( c : C) → Tri A B C + +-- Trichotomy. + +Trichotomous : Rel A ℓ₁ → Rel A ℓ₂ → Set _ +Trichotomous _≈_ _<_ = ∀ x y → Tri (x < y) (x ≈ y) (x > y) + where _>_ = flip _<_ + +-- Generalised maximum element. + +Max : REL A B ℓ → B → Set _ +Max _≤_ T = ∀ x → x ≤ T + +-- Maximum element. + +Maximum : Rel A ℓ → A → Set _ +Maximum = Max + +-- Generalised minimum element. + +Min : REL A B ℓ → A → Set _ +Min R = Max (flip R) + +-- Minimum element. + +Minimum : Rel A ℓ → A → Set _ +Minimum = Min + +-- Unary relations respecting a binary relation. + +_⟶_Respects_ : (A → Set ℓ₁) → (B → Set ℓ₂) → REL A B ℓ₃ → Set _ +P ⟶ Q Respects _∼_ = ∀ {x y} → x ∼ y → P x → Q y + +-- Unary relation respects a binary relation. + +_Respects_ : (A → Set ℓ₁) → Rel A ℓ₂ → Set _ +P Respects _∼_ = P ⟶ P Respects _∼_ + +-- Right respecting - relatedness is preserved on the right by equality. + +_Respectsʳ_ : REL A B ℓ₁ → Rel B ℓ₂ → Set _ +_∼_ Respectsʳ _≈_ = ∀ {x} → (x ∼_) Respects _≈_ + +-- Left respecting - relatedness is preserved on the left by equality. + +_Respectsˡ_ : REL A B ℓ₁ → Rel A ℓ₂ → Set _ +P Respectsˡ _∼_ = ∀ {y} → (flip P y) Respects _∼_ + +-- Respecting - relatedness is preserved on both sides by equality + +_Respects₂_ : Rel A ℓ₁ → Rel A ℓ₂ → Set _ +P Respects₂ _∼_ = (P Respectsʳ _∼_) × (P Respectsˡ _∼_) + +-- Substitutivity - any two related elements satisfy exactly the same +-- set of unary relations. Note that only the various derivatives +-- of propositional equality can satisfy this property. + +Substitutive : Rel A ℓ₁ → (ℓ₂ : Level) → Set _ +Substitutive {A = A} _∼_ p = (P : A → Set p) → P Respects _∼_ + +-- Decidability - it is possible to determine whether a given pair of +-- elements are related. + +Decidable : REL A B ℓ → Set _ +Decidable _∼_ = ∀ x y → Dec (x ∼ y) + +-- Weak decidability - it is sometimes possible to determine if a given +-- pair of elements are related. + +WeaklyDecidable : REL A B ℓ → Set _ +WeaklyDecidable _∼_ = ∀ x y → Maybe (x ∼ y) + +-- Propositional equality is decidable for the type. + +DecidableEquality : (A : Set a) → Set _ +DecidableEquality A = Decidable {A = A} _≡_ + +-- Irrelevancy - all proofs that a given pair of elements are related +-- are indistinguishable. + +Irrelevant : REL A B ℓ → Set _ +Irrelevant _∼_ = ∀ {x y} (a b : x ∼ y) → a ≡ b + +-- Recomputability - we can rebuild a relevant proof given an +-- irrelevant one. + +Recomputable : REL A B ℓ → Set _ +Recomputable _∼_ = ∀ {x y} → .(x ∼ y) → x ∼ y + +-- Universal - all pairs of elements are related + +Universal : REL A B ℓ → Set _ +Universal _∼_ = ∀ x y → x ∼ y + +-- Non-emptiness - at least one pair of elements are related. + +record NonEmpty {A : Set a} {B : Set b} + (T : REL A B ℓ) : Set (a ⊔ b ⊔ ℓ) where + constructor nonEmpty + field + {x} : A + {y} : B + proof : T x y + + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.1 + +Conn = Connex +{-# WARNING_ON_USAGE Conn +"Warning: Conn was deprecated in v1.1. +Please use Connex instead." +#-} +\ No newline at end of file diff --git a/docs/Relation.Binary.Indexed.Heterogeneous.Bundles.html b/docs/Relation.Binary.Indexed.Heterogeneous.Bundles.html new file mode 100644 index 0000000..006451c --- /dev/null +++ b/docs/Relation.Binary.Indexed.Heterogeneous.Bundles.html @@ -0,0 +1,45 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Indexed binary relations +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via +-- `Relation.Binary.Indexed.Heterogeneous`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.Indexed.Heterogeneous.Bundles where + +open import Function.Base +open import Level using (suc; _⊔_) +open import Relation.Binary using (_⇒_) +open import Relation.Binary.PropositionalEquality.Core as P using (_≡_) +open import Relation.Binary.Indexed.Heterogeneous.Core +open import Relation.Binary.Indexed.Heterogeneous.Structures + +------------------------------------------------------------------------ +-- Definitions + +record IndexedSetoid {i} (I : Set i) c ℓ : Set (suc (i ⊔ c ⊔ ℓ)) where + infix 4 _≈_ + field + Carrier : I → Set c + _≈_ : IRel Carrier ℓ + isEquivalence : IsIndexedEquivalence Carrier _≈_ + + open IsIndexedEquivalence isEquivalence public + + +record IndexedPreorder {i} (I : Set i) c ℓ₁ ℓ₂ : + Set (suc (i ⊔ c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _∼_ + field + Carrier : I → Set c + _≈_ : IRel Carrier ℓ₁ -- The underlying equality. + _∼_ : IRel Carrier ℓ₂ -- The relation. + isPreorder : IsIndexedPreorder Carrier _≈_ _∼_ + + open IsIndexedPreorder isPreorder public +\ No newline at end of file diff --git a/docs/Relation.Binary.Indexed.Heterogeneous.Construct.Trivial.html b/docs/Relation.Binary.Indexed.Heterogeneous.Construct.Trivial.html new file mode 100644 index 0000000..d9f9452 --- /dev/null +++ b/docs/Relation.Binary.Indexed.Heterogeneous.Construct.Trivial.html @@ -0,0 +1,60 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Creates trivially indexed records from their non-indexed counterpart. +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.Indexed.Heterogeneous.Construct.Trivial + {i} {I : Set i} where + +open import Relation.Binary +open import Relation.Binary.Indexed.Heterogeneous hiding (Rel) + hiding (IsEquivalence; Setoid) + +------------------------------------------------------------------------ +-- Structures + +module _ {a} {A : Set a} where + + private + Aᵢ : I → Set a + Aᵢ i = A + + isIndexedEquivalence : ∀ {ℓ} {_≈_ : Rel A ℓ} → IsEquivalence _≈_ → + IsIndexedEquivalence Aᵢ _≈_ + isIndexedEquivalence isEq = record + { refl = refl + ; sym = sym + ; trans = trans + } + where open IsEquivalence isEq + + isIndexedPreorder : ∀ {ℓ₁ ℓ₂} {_≈_ : Rel A ℓ₁} {_∼_ : Rel A ℓ₂} → + IsPreorder _≈_ _∼_ → + IsIndexedPreorder Aᵢ _≈_ _∼_ + isIndexedPreorder isPreorder = record + { isEquivalence = isIndexedEquivalence isEquivalence + ; reflexive = reflexive + ; trans = trans + } + where open IsPreorder isPreorder + +------------------------------------------------------------------------ +-- Bundles + +indexedSetoid : ∀ {a ℓ} → Setoid a ℓ → IndexedSetoid I a ℓ +indexedSetoid S = record + { isEquivalence = isIndexedEquivalence isEquivalence + } + where open Setoid S + +indexedPreorder : ∀ {a ℓ₁ ℓ₂} → Preorder a ℓ₁ ℓ₂ → + IndexedPreorder I a ℓ₁ ℓ₂ +indexedPreorder O = record + { isPreorder = isIndexedPreorder isPreorder + } + where open Preorder O +\ No newline at end of file diff --git a/docs/Relation.Binary.Indexed.Heterogeneous.Core.html b/docs/Relation.Binary.Indexed.Heterogeneous.Core.html new file mode 100644 index 0000000..47921bf --- /dev/null +++ b/docs/Relation.Binary.Indexed.Heterogeneous.Core.html @@ -0,0 +1,42 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Indexed binary relations +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via +-- `Relation.Binary.Indexed.Heterogeneous`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.Indexed.Heterogeneous.Core where + +open import Level +import Relation.Binary.Core as B +import Relation.Binary.Definitions as B +import Relation.Binary.PropositionalEquality.Core as P + +------------------------------------------------------------------------ +-- Indexed binary relations + +-- Heterogeneous types + +IREL : ∀ {i₁ i₂ a₁ a₂} {I₁ : Set i₁} {I₂ : Set i₂} → + (I₁ → Set a₁) → (I₂ → Set a₂) → (ℓ : Level) → Set _ +IREL A₁ A₂ ℓ = ∀ {i₁ i₂} → A₁ i₁ → A₂ i₂ → Set ℓ + +-- Homogeneous types + +IRel : ∀ {i a} {I : Set i} → (I → Set a) → (ℓ : Level) → Set _ +IRel A ℓ = IREL A A ℓ + +------------------------------------------------------------------------ +-- Generalised implication. + +infixr 4 _=[_]⇒_ + +_=[_]⇒_ : ∀ {a b ℓ₁ ℓ₂} {A : Set a} {B : A → Set b} → + B.Rel A ℓ₁ → ((x : A) → B x) → IRel B ℓ₂ → Set _ +P =[ f ]⇒ Q = ∀ {i j} → P i j → Q (f i) (f j) +\ No newline at end of file diff --git a/docs/Relation.Binary.Indexed.Heterogeneous.Definitions.html b/docs/Relation.Binary.Indexed.Heterogeneous.Definitions.html new file mode 100644 index 0000000..1ff0edd --- /dev/null +++ b/docs/Relation.Binary.Indexed.Heterogeneous.Definitions.html @@ -0,0 +1,37 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Indexed binary relations +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via +-- `Relation.Binary.Indexed.Heterogeneous`. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.Indexed.Heterogeneous.Definitions where + +open import Level +import Relation.Binary.Core as B +import Relation.Binary.Definitions as B +import Relation.Binary.PropositionalEquality.Core as P +open import Relation.Binary.Indexed.Heterogeneous.Core + +private + variable + i a ℓ : Level + I : Set i + +------------------------------------------------------------------------ +-- Simple properties of indexed binary relations + +Reflexive : (A : I → Set a) → IRel A ℓ → Set _ +Reflexive _ _∼_ = ∀ {i} → B.Reflexive (_∼_ {i}) + +Symmetric : (A : I → Set a) → IRel A ℓ → Set _ +Symmetric _ _∼_ = ∀ {i j} → B.Sym (_∼_ {i} {j}) _∼_ + +Transitive : (A : I → Set a) → IRel A ℓ → Set _ +Transitive _ _∼_ = ∀ {i j k} → B.Trans _∼_ (_∼_ {j}) (_∼_ {i} {k}) +\ No newline at end of file diff --git a/docs/Relation.Binary.Indexed.Heterogeneous.Structures.html b/docs/Relation.Binary.Indexed.Heterogeneous.Structures.html new file mode 100644 index 0000000..cafbe01 --- /dev/null +++ b/docs/Relation.Binary.Indexed.Heterogeneous.Structures.html @@ -0,0 +1,48 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Indexed binary relations +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via +-- `Relation.Binary.Indexed.Heterogeneous`. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary.Indexed.Heterogeneous.Core + +module Relation.Binary.Indexed.Heterogeneous.Structures + {i a ℓ} {I : Set i} (A : I → Set a) (_≈_ : IRel A ℓ) + where + +open import Function.Base +open import Level using (suc; _⊔_) +open import Relation.Binary using (_⇒_) +open import Relation.Binary.PropositionalEquality.Core as P using (_≡_) +open import Relation.Binary.Indexed.Heterogeneous.Definitions + +------------------------------------------------------------------------ +-- Equivalences + +record IsIndexedEquivalence : Set (i ⊔ a ⊔ ℓ) where + field + refl : Reflexive A _≈_ + sym : Symmetric A _≈_ + trans : Transitive A _≈_ + + reflexive : ∀ {i} → _≡_ ⟨ _⇒_ ⟩ _≈_ {i} + reflexive P.refl = refl + + +record IsIndexedPreorder {ℓ₂} (_∼_ : IRel A ℓ₂) : Set (i ⊔ a ⊔ ℓ ⊔ ℓ₂) where + field + isEquivalence : IsIndexedEquivalence + reflexive : ∀ {i j} → (_≈_ {i} {j}) ⟨ _⇒_ ⟩ _∼_ + trans : Transitive A _∼_ + + module Eq = IsIndexedEquivalence isEquivalence + + refl : Reflexive A _∼_ + refl = reflexive Eq.refl +\ No newline at end of file diff --git a/docs/Relation.Binary.Indexed.Heterogeneous.html b/docs/Relation.Binary.Indexed.Heterogeneous.html new file mode 100644 index 0000000..b2ae26d --- /dev/null +++ b/docs/Relation.Binary.Indexed.Heterogeneous.html @@ -0,0 +1,49 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Heterogeneously-indexed binary relations +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.Indexed.Heterogeneous where + +------------------------------------------------------------------------ +-- Publicly export core definitions + +open import Relation.Binary.Indexed.Heterogeneous.Core public +open import Relation.Binary.Indexed.Heterogeneous.Definitions public +open import Relation.Binary.Indexed.Heterogeneous.Structures public +open import Relation.Binary.Indexed.Heterogeneous.Bundles public + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 0.17 + +REL = IREL +{-# WARNING_ON_USAGE REL +"Warning: REL was deprecated in v0.17. +Please use IREL instead." +#-} +Rel = IRel +{-# WARNING_ON_USAGE Rel +"Warning: Rel was deprecated in v0.17. +Please use IRel instead." +#-} +Setoid = IndexedSetoid +{-# WARNING_ON_USAGE Setoid +"Warning: Setoid was deprecated in v0.17. +Please use IndexedSetoid instead." +#-} +IsEquivalence = IsIndexedEquivalence +{-# WARNING_ON_USAGE IsEquivalence +"Warning: IsEquivalence was deprecated in v0.17. +Please use IsIndexedEquivalence instead." +#-} +\ No newline at end of file diff --git a/docs/Relation.Binary.Lattice.html b/docs/Relation.Binary.Lattice.html new file mode 100644 index 0000000..f870be6 --- /dev/null +++ b/docs/Relation.Binary.Lattice.html @@ -0,0 +1,426 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Order-theoretic lattices +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.Lattice where + +open import Algebra.Core +open import Algebra.Definitions +open import Data.Product using (_×_; _,_) +open import Function.Base using (flip) +open import Level using (suc; _⊔_) +open import Relation.Binary + +------------------------------------------------------------------------ +-- Relationships between orders and operators + +open import Relation.Binary public using (Maximum; Minimum) + +Supremum : ∀ {a ℓ} {A : Set a} → Rel A ℓ → Op₂ A → Set _ +Supremum _≤_ _∨_ = + ∀ x y → x ≤ (x ∨ y) × y ≤ (x ∨ y) × ∀ z → x ≤ z → y ≤ z → (x ∨ y) ≤ z + +Infimum : ∀ {a ℓ} {A : Set a} → Rel A ℓ → Op₂ A → Set _ +Infimum _≤_ = Supremum (flip _≤_) + +Exponential : ∀ {a ℓ} {A : Set a} → Rel A ℓ → Op₂ A → Op₂ A → Set _ +Exponential _≤_ _∧_ _⇨_ = + ∀ w x y → ((w ∧ x) ≤ y → w ≤ (x ⇨ y)) × (w ≤ (x ⇨ y) → (w ∧ x) ≤ y) + +------------------------------------------------------------------------ +-- Join semilattices + +record IsJoinSemilattice {a ℓ₁ ℓ₂} {A : Set a} + (_≈_ : Rel A ℓ₁) -- The underlying equality. + (_≤_ : Rel A ℓ₂) -- The partial order. + (_∨_ : Op₂ A) -- The join operation. + : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isPartialOrder : IsPartialOrder _≈_ _≤_ + supremum : Supremum _≤_ _∨_ + + x≤x∨y : ∀ x y → x ≤ (x ∨ y) + x≤x∨y x y = let pf , _ , _ = supremum x y in pf + + y≤x∨y : ∀ x y → y ≤ (x ∨ y) + y≤x∨y x y = let _ , pf , _ = supremum x y in pf + + ∨-least : ∀ {x y z} → x ≤ z → y ≤ z → (x ∨ y) ≤ z + ∨-least {x} {y} {z} = let _ , _ , pf = supremum x y in pf z + + open IsPartialOrder isPartialOrder public + +record JoinSemilattice c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + infixr 6 _∨_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _≤_ : Rel Carrier ℓ₂ -- The partial order. + _∨_ : Op₂ Carrier -- The join operation. + isJoinSemilattice : IsJoinSemilattice _≈_ _≤_ _∨_ + + open IsJoinSemilattice isJoinSemilattice public + + poset : Poset c ℓ₁ ℓ₂ + poset = record { isPartialOrder = isPartialOrder } + + open Poset poset public using (preorder) + +record IsBoundedJoinSemilattice {a ℓ₁ ℓ₂} {A : Set a} + (_≈_ : Rel A ℓ₁) -- The underlying equality. + (_≤_ : Rel A ℓ₂) -- The partial order. + (_∨_ : Op₂ A) -- The join operation. + (⊥ : A) -- The minimum. + : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isJoinSemilattice : IsJoinSemilattice _≈_ _≤_ _∨_ + minimum : Minimum _≤_ ⊥ + + open IsJoinSemilattice isJoinSemilattice public + +record BoundedJoinSemilattice c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + infixr 6 _∨_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _≤_ : Rel Carrier ℓ₂ -- The partial order. + _∨_ : Op₂ Carrier -- The join operation. + ⊥ : Carrier -- The minimum. + isBoundedJoinSemilattice : IsBoundedJoinSemilattice _≈_ _≤_ _∨_ ⊥ + + open IsBoundedJoinSemilattice isBoundedJoinSemilattice public + + joinSemilattice : JoinSemilattice c ℓ₁ ℓ₂ + joinSemilattice = record { isJoinSemilattice = isJoinSemilattice } + + joinSemiLattice = joinSemilattice + {-# WARNING_ON_USAGE joinSemiLattice + "Warning: joinSemiLattice was deprecated in v0.17. + Please use joinSemilattice instead." + #-} + + open JoinSemilattice joinSemilattice public using (preorder; poset) + +------------------------------------------------------------------------ +-- Meet semilattices + +record IsMeetSemilattice {a ℓ₁ ℓ₂} {A : Set a} + (_≈_ : Rel A ℓ₁) -- The underlying equality. + (_≤_ : Rel A ℓ₂) -- The partial order. + (_∧_ : Op₂ A) -- The meet operation. + : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isPartialOrder : IsPartialOrder _≈_ _≤_ + infimum : Infimum _≤_ _∧_ + + x∧y≤x : ∀ x y → (x ∧ y) ≤ x + x∧y≤x x y = let pf , _ , _ = infimum x y in pf + + x∧y≤y : ∀ x y → (x ∧ y) ≤ y + x∧y≤y x y = let _ , pf , _ = infimum x y in pf + + ∧-greatest : ∀ {x y z} → x ≤ y → x ≤ z → x ≤ (y ∧ z) + ∧-greatest {x} {y} {z} = let _ , _ , pf = infimum y z in pf x + + open IsPartialOrder isPartialOrder public + +record MeetSemilattice c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + infixr 7 _∧_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _≤_ : Rel Carrier ℓ₂ -- The partial order. + _∧_ : Op₂ Carrier -- The meet operation. + isMeetSemilattice : IsMeetSemilattice _≈_ _≤_ _∧_ + + open IsMeetSemilattice isMeetSemilattice public + + poset : Poset c ℓ₁ ℓ₂ + poset = record { isPartialOrder = isPartialOrder } + + open Poset poset public using (preorder) + +record IsBoundedMeetSemilattice {a ℓ₁ ℓ₂} {A : Set a} + (_≈_ : Rel A ℓ₁) -- The underlying equality. + (_≤_ : Rel A ℓ₂) -- The partial order. + (_∧_ : Op₂ A) -- The join operation. + (⊤ : A) -- The maximum. + : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isMeetSemilattice : IsMeetSemilattice _≈_ _≤_ _∧_ + maximum : Maximum _≤_ ⊤ + + open IsMeetSemilattice isMeetSemilattice public + +record BoundedMeetSemilattice c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + infixr 7 _∧_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _≤_ : Rel Carrier ℓ₂ -- The partial order. + _∧_ : Op₂ Carrier -- The join operation. + ⊤ : Carrier -- The maximum. + isBoundedMeetSemilattice : IsBoundedMeetSemilattice _≈_ _≤_ _∧_ ⊤ + + open IsBoundedMeetSemilattice isBoundedMeetSemilattice public + + meetSemilattice : MeetSemilattice c ℓ₁ ℓ₂ + meetSemilattice = record { isMeetSemilattice = isMeetSemilattice } + + meetSemiLattice = meetSemilattice + {-# WARNING_ON_USAGE meetSemiLattice + "Warning: meetSemiLattice was deprecated in v0.17. + Please use meetSemilattice instead." + #-} + + open MeetSemilattice meetSemilattice public using (preorder; poset) + +------------------------------------------------------------------------ +-- Lattices + +record IsLattice {a ℓ₁ ℓ₂} {A : Set a} + (_≈_ : Rel A ℓ₁) -- The underlying equality. + (_≤_ : Rel A ℓ₂) -- The partial order. + (_∨_ : Op₂ A) -- The join operation. + (_∧_ : Op₂ A) -- The meet operation. + : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isPartialOrder : IsPartialOrder _≈_ _≤_ + supremum : Supremum _≤_ _∨_ + infimum : Infimum _≤_ _∧_ + + isJoinSemilattice : IsJoinSemilattice _≈_ _≤_ _∨_ + isJoinSemilattice = record + { isPartialOrder = isPartialOrder + ; supremum = supremum + } + + isMeetSemilattice : IsMeetSemilattice _≈_ _≤_ _∧_ + isMeetSemilattice = record + { isPartialOrder = isPartialOrder + ; infimum = infimum + } + + open IsJoinSemilattice isJoinSemilattice public + using (x≤x∨y; y≤x∨y; ∨-least) + open IsMeetSemilattice isMeetSemilattice public + using (x∧y≤x; x∧y≤y; ∧-greatest) + open IsPartialOrder isPartialOrder public + +record Lattice c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + infixr 6 _∨_ + infixr 7 _∧_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _≤_ : Rel Carrier ℓ₂ -- The partial order. + _∨_ : Op₂ Carrier -- The join operation. + _∧_ : Op₂ Carrier -- The meet operation. + isLattice : IsLattice _≈_ _≤_ _∨_ _∧_ + + open IsLattice isLattice public + + setoid : Setoid c ℓ₁ + setoid = record { isEquivalence = isEquivalence } + + joinSemilattice : JoinSemilattice c ℓ₁ ℓ₂ + joinSemilattice = record { isJoinSemilattice = isJoinSemilattice } + + meetSemilattice : MeetSemilattice c ℓ₁ ℓ₂ + meetSemilattice = record { isMeetSemilattice = isMeetSemilattice } + + open JoinSemilattice joinSemilattice public using (poset; preorder) + +record IsDistributiveLattice {a ℓ₁ ℓ₂} {A : Set a} + (_≈_ : Rel A ℓ₁) -- The underlying equality. + (_≤_ : Rel A ℓ₂) -- The partial order. + (_∨_ : Op₂ A) -- The join operation. + (_∧_ : Op₂ A) -- The meet operation. + : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isLattice : IsLattice _≈_ _≤_ _∨_ _∧_ + ∧-distribˡ-∨ : _DistributesOverˡ_ _≈_ _∧_ _∨_ + + open IsLattice isLattice public + +record DistributiveLattice c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + infixr 6 _∨_ + infixr 7 _∧_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _≤_ : Rel Carrier ℓ₂ -- The partial order. + _∨_ : Op₂ Carrier -- The join operation. + _∧_ : Op₂ Carrier -- The meet operation. + isDistributiveLattice : IsDistributiveLattice _≈_ _≤_ _∨_ _∧_ + + open IsDistributiveLattice isDistributiveLattice using (∧-distribˡ-∨) public + open IsDistributiveLattice isDistributiveLattice using (isLattice) + + lattice : Lattice c ℓ₁ ℓ₂ + lattice = record { isLattice = isLattice } + + open Lattice lattice hiding (Carrier; _≈_; _≤_; _∨_; _∧_) public + +record IsBoundedLattice {a ℓ₁ ℓ₂} {A : Set a} + (_≈_ : Rel A ℓ₁) -- The underlying equality. + (_≤_ : Rel A ℓ₂) -- The partial order. + (_∨_ : Op₂ A) -- The join operation. + (_∧_ : Op₂ A) -- The meet operation. + (⊤ : A) -- The maximum. + (⊥ : A) -- The minimum. + : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isLattice : IsLattice _≈_ _≤_ _∨_ _∧_ + maximum : Maximum _≤_ ⊤ + minimum : Minimum _≤_ ⊥ + + open IsLattice isLattice public + + isBoundedJoinSemilattice : IsBoundedJoinSemilattice _≈_ _≤_ _∨_ ⊥ + isBoundedJoinSemilattice = record + { isJoinSemilattice = isJoinSemilattice + ; minimum = minimum + } + + isBoundedMeetSemilattice : IsBoundedMeetSemilattice _≈_ _≤_ _∧_ ⊤ + isBoundedMeetSemilattice = record + { isMeetSemilattice = isMeetSemilattice + ; maximum = maximum + } + +record BoundedLattice c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + infixr 6 _∨_ + infixr 7 _∧_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _≤_ : Rel Carrier ℓ₂ -- The partial order. + _∨_ : Op₂ Carrier -- The join operation. + _∧_ : Op₂ Carrier -- The meet operation. + ⊤ : Carrier -- The maximum. + ⊥ : Carrier -- The minimum. + isBoundedLattice : IsBoundedLattice _≈_ _≤_ _∨_ _∧_ ⊤ ⊥ + + open IsBoundedLattice isBoundedLattice public + + boundedJoinSemilattice : BoundedJoinSemilattice c ℓ₁ ℓ₂ + boundedJoinSemilattice = record + { isBoundedJoinSemilattice = isBoundedJoinSemilattice } + + boundedMeetSemilattice : BoundedMeetSemilattice c ℓ₁ ℓ₂ + boundedMeetSemilattice = record + { isBoundedMeetSemilattice = isBoundedMeetSemilattice } + + lattice : Lattice c ℓ₁ ℓ₂ + lattice = record { isLattice = isLattice } + + open Lattice lattice public + using (joinSemilattice; meetSemilattice; poset; preorder; setoid) + +------------------------------------------------------------------------ +-- Heyting algebras (a bounded lattice with exponential operator) + +record IsHeytingAlgebra {a ℓ₁ ℓ₂} {A : Set a} + (_≈_ : Rel A ℓ₁) -- The underlying equality. + (_≤_ : Rel A ℓ₂) -- The partial order. + (_∨_ : Op₂ A) -- The join operation. + (_∧_ : Op₂ A) -- The meet operation. + (_⇨_ : Op₂ A) -- The exponential operation. + (⊤ : A) -- The maximum. + (⊥ : A) -- The minimum. + : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isBoundedLattice : IsBoundedLattice _≈_ _≤_ _∨_ _∧_ ⊤ ⊥ + exponential : Exponential _≤_ _∧_ _⇨_ + + transpose-⇨ : ∀ {w x y} → (w ∧ x) ≤ y → w ≤ (x ⇨ y) + transpose-⇨ {w} {x} {y} = let pf , _ = exponential w x y in pf + + transpose-∧ : ∀ {w x y} → w ≤ (x ⇨ y) → (w ∧ x) ≤ y + transpose-∧ {w} {x} {y} = let _ , pf = exponential w x y in pf + + open IsBoundedLattice isBoundedLattice public + +record HeytingAlgebra c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + infixr 5 _⇨_ + infixr 6 _∨_ + infixr 7 _∧_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _≤_ : Rel Carrier ℓ₂ -- The partial order. + _∨_ : Op₂ Carrier -- The join operation. + _∧_ : Op₂ Carrier -- The meet operation. + _⇨_ : Op₂ Carrier -- The exponential operation. + ⊤ : Carrier -- The maximum. + ⊥ : Carrier -- The minimum. + isHeytingAlgebra : IsHeytingAlgebra _≈_ _≤_ _∨_ _∧_ _⇨_ ⊤ ⊥ + + boundedLattice : BoundedLattice c ℓ₁ ℓ₂ + boundedLattice = record + { isBoundedLattice = IsHeytingAlgebra.isBoundedLattice isHeytingAlgebra } + + open IsHeytingAlgebra isHeytingAlgebra + using (exponential; transpose-⇨; transpose-∧) public + open BoundedLattice boundedLattice + hiding (Carrier; _≈_; _≤_; _∨_; _∧_; ⊤; ⊥) public + +------------------------------------------------------------------------ +-- Boolean algebras (a specialized Heyting algebra) + +record IsBooleanAlgebra {a ℓ₁ ℓ₂} {A : Set a} + (_≈_ : Rel A ℓ₁) -- The underlying equality. + (_≤_ : Rel A ℓ₂) -- The partial order. + (_∨_ : Op₂ A) -- The join operation. + (_∧_ : Op₂ A) -- The meet operation. + (¬_ : Op₁ A) -- The negation operation. + (⊤ : A) -- The maximum. + (⊥ : A) -- The minimum. + : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + infixr 5 _⇨_ + _⇨_ : Op₂ A + x ⇨ y = (¬ x) ∨ y + + field + isHeytingAlgebra : IsHeytingAlgebra _≈_ _≤_ _∨_ _∧_ _⇨_ ⊤ ⊥ + + open IsHeytingAlgebra isHeytingAlgebra public + +record BooleanAlgebra c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) where + infix 4 _≈_ _≤_ + infixr 6 _∨_ + infixr 7 _∧_ + infix 8 ¬_ + field + Carrier : Set c + _≈_ : Rel Carrier ℓ₁ -- The underlying equality. + _≤_ : Rel Carrier ℓ₂ -- The partial order. + _∨_ : Op₂ Carrier -- The join operation. + _∧_ : Op₂ Carrier -- The meet operation. + ¬_ : Op₁ Carrier -- The negation operation. + ⊤ : Carrier -- The maximum. + ⊥ : Carrier -- The minimum. + isBooleanAlgebra : IsBooleanAlgebra _≈_ _≤_ _∨_ _∧_ ¬_ ⊤ ⊥ + + open IsBooleanAlgebra isBooleanAlgebra using (isHeytingAlgebra) + + heytingAlgebra : HeytingAlgebra c ℓ₁ ℓ₂ + heytingAlgebra = record { isHeytingAlgebra = isHeytingAlgebra } + + open HeytingAlgebra heytingAlgebra public + hiding (Carrier; _≈_; _≤_; _∨_; _∧_; ⊤; ⊥) +\ No newline at end of file diff --git a/docs/Relation.Binary.Morphism.Definitions.html b/docs/Relation.Binary.Morphism.Definitions.html new file mode 100644 index 0000000..f22e00b --- /dev/null +++ b/docs/Relation.Binary.Morphism.Definitions.html @@ -0,0 +1,34 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Basic definitions for morphisms between algebraic structures +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary.Core + +module Relation.Binary.Morphism.Definitions + {a} (A : Set a) -- The domain of the morphism + {b} (B : Set b) -- The codomain of the morphism + where + +open import Level using (Level) + +private + variable + ℓ₁ ℓ₂ : Level + +------------------------------------------------------------------------ +-- Morphism definition in Function.Core + +open import Function.Core public + using (Morphism) + +------------------------------------------------------------------------ +-- Basic definitions + +Homomorphic₂ : Rel A ℓ₁ → Rel B ℓ₂ → (A → B) → Set _ +Homomorphic₂ _∼₁_ _∼₂_ ⟦_⟧ = ∀ {x y} → x ∼₁ y → ⟦ x ⟧ ∼₂ ⟦ y ⟧ +\ No newline at end of file diff --git a/docs/Relation.Binary.Morphism.Structures.html b/docs/Relation.Binary.Morphism.Structures.html new file mode 100644 index 0000000..0fb783f --- /dev/null +++ b/docs/Relation.Binary.Morphism.Structures.html @@ -0,0 +1,119 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Order morphisms +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary.Core + +module Relation.Binary.Morphism.Structures + {a b} {A : Set a} {B : Set b} + where + +open import Data.Product using (_,_) +open import Function.Definitions +open import Level +open import Relation.Binary.Morphism.Definitions A B + +private + variable + ℓ₁ ℓ₂ ℓ₃ ℓ₄ : Level + +------------------------------------------------------------------------ +-- Relations +------------------------------------------------------------------------ + +record IsRelHomomorphism (_∼₁_ : Rel A ℓ₁) (_∼₂_ : Rel B ℓ₂) + (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + cong : Homomorphic₂ _∼₁_ _∼₂_ ⟦_⟧ + + +record IsRelMonomorphism (_∼₁_ : Rel A ℓ₁) (_∼₂_ : Rel B ℓ₂) + (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + field + isHomomorphism : IsRelHomomorphism _∼₁_ _∼₂_ ⟦_⟧ + injective : Injective _∼₁_ _∼₂_ ⟦_⟧ + + open IsRelHomomorphism isHomomorphism public + + +record IsRelIsomorphism (_∼₁_ : Rel A ℓ₁) (_∼₂_ : Rel B ℓ₂) + (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where + field + isMonomorphism : IsRelMonomorphism _∼₁_ _∼₂_ ⟦_⟧ + surjective : Surjective _∼₁_ _∼₂_ ⟦_⟧ + + open IsRelMonomorphism isMonomorphism public + + bijective : Bijective _∼₁_ _∼₂_ ⟦_⟧ + bijective = injective , surjective + + +------------------------------------------------------------------------ +-- Orders +------------------------------------------------------------------------ + +record IsOrderHomomorphism (_≈₁_ : Rel A ℓ₁) (_≈₂_ : Rel B ℓ₂) + (_∼₁_ : Rel A ℓ₃) (_∼₂_ : Rel B ℓ₄) + (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃ ⊔ ℓ₄) + where + field + cong : Homomorphic₂ _≈₁_ _≈₂_ ⟦_⟧ + mono : Homomorphic₂ _∼₁_ _∼₂_ ⟦_⟧ + + module Eq where + isRelHomomorphism : IsRelHomomorphism _≈₁_ _≈₂_ ⟦_⟧ + isRelHomomorphism = record { cong = cong } + + isRelHomomorphism : IsRelHomomorphism _∼₁_ _∼₂_ ⟦_⟧ + isRelHomomorphism = record { cong = mono } + + +record IsOrderMonomorphism (_≈₁_ : Rel A ℓ₁) (_≈₂_ : Rel B ℓ₂) + (_∼₁_ : Rel A ℓ₃) (_∼₂_ : Rel B ℓ₄) + (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃ ⊔ ℓ₄) + where + field + isOrderHomomorphism : IsOrderHomomorphism _≈₁_ _≈₂_ _∼₁_ _∼₂_ ⟦_⟧ + injective : Injective _≈₁_ _≈₂_ ⟦_⟧ + cancel : Injective _∼₁_ _∼₂_ ⟦_⟧ + + open IsOrderHomomorphism isOrderHomomorphism public + hiding (module Eq) + + module Eq where + isRelMonomorphism : IsRelMonomorphism _≈₁_ _≈₂_ ⟦_⟧ + isRelMonomorphism = record + { isHomomorphism = IsOrderHomomorphism.Eq.isRelHomomorphism isOrderHomomorphism + ; injective = injective + } + + isRelMonomorphism : IsRelMonomorphism _∼₁_ _∼₂_ ⟦_⟧ + isRelMonomorphism = record + { isHomomorphism = isRelHomomorphism + ; injective = cancel + } + + +record IsOrderIsomorphism (_≈₁_ : Rel A ℓ₁) (_≈₂_ : Rel B ℓ₂) + (_∼₁_ : Rel A ℓ₃) (_∼₂_ : Rel B ℓ₄) + (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃ ⊔ ℓ₄) + where + field + isOrderMonomorphism : IsOrderMonomorphism _≈₁_ _≈₂_ _∼₁_ _∼₂_ ⟦_⟧ + surjective : Surjective _≈₁_ _≈₂_ ⟦_⟧ + + open IsOrderMonomorphism isOrderMonomorphism public + hiding (module Eq) + + module Eq where + isRelIsomorphism : IsRelIsomorphism _≈₁_ _≈₂_ ⟦_⟧ + isRelIsomorphism = record + { isMonomorphism = IsOrderMonomorphism.Eq.isRelMonomorphism isOrderMonomorphism + ; surjective = surjective + } +\ No newline at end of file diff --git a/docs/Relation.Binary.Properties.Poset.html b/docs/Relation.Binary.Properties.Poset.html new file mode 100644 index 0000000..2b49826 --- /dev/null +++ b/docs/Relation.Binary.Properties.Poset.html @@ -0,0 +1,143 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties satisfied by posets +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Function.Base using (flip; _∘_) +open import Relation.Binary +import Relation.Binary.Consequences as Consequences +open import Relation.Nullary using (¬_) + +module Relation.Binary.Properties.Poset + {p₁ p₂ p₃} (P : Poset p₁ p₂ p₃) where + +open Poset P renaming (Carrier to A) + +import Relation.Binary.Construct.NonStrictToStrict _≈_ _≤_ as ToStrict +import Relation.Binary.Properties.Preorder preorder as PreorderProperties +open Eq using (_≉_) + +------------------------------------------------------------------------ +-- The _≥_ relation is also a poset. + +infix 4 _≥_ + +_≥_ : Rel A p₃ +x ≥ y = y ≤ x + +open PreorderProperties public + using () + renaming + ( invIsPreorder to ≥-isPreorder + ; invPreorder to ≥-preorder + ) + +≥-isPartialOrder : IsPartialOrder _≈_ _≥_ +≥-isPartialOrder = record + { isPreorder = PreorderProperties.invIsPreorder + ; antisym = flip antisym + } + +≥-poset : Poset p₁ p₂ p₃ +≥-poset = record + { isPartialOrder = ≥-isPartialOrder + } + +open Poset ≥-poset public + using () + renaming + ( refl to ≥-refl + ; reflexive to ≥-reflexive + ; trans to ≥-trans + ; antisym to ≥-antisym + ) + +------------------------------------------------------------------------ +-- Negated order + +infix 4 _≰_ + +_≰_ : Rel A p₃ +x ≰ y = ¬ (x ≤ y) + +≰-respˡ-≈ : _≰_ Respectsˡ _≈_ +≰-respˡ-≈ x≈y = _∘ ≤-respˡ-≈ (Eq.sym x≈y) + +≰-respʳ-≈ : _≰_ Respectsʳ _≈_ +≰-respʳ-≈ x≈y = _∘ ≤-respʳ-≈ (Eq.sym x≈y) + +------------------------------------------------------------------------ +-- Partial orders can be turned into strict partial orders + +infix 4 _<_ + +_<_ : Rel A _ +_<_ = ToStrict._<_ + +<-isStrictPartialOrder : IsStrictPartialOrder _≈_ _<_ +<-isStrictPartialOrder = ToStrict.<-isStrictPartialOrder isPartialOrder + +<-strictPartialOrder : StrictPartialOrder _ _ _ +<-strictPartialOrder = record + { isStrictPartialOrder = <-isStrictPartialOrder + } + +open StrictPartialOrder <-strictPartialOrder public + using ( <-resp-≈; <-respʳ-≈; <-respˡ-≈) + renaming + ( irrefl to <-irrefl + ; asym to <-asym + ; trans to <-trans + ) + +<⇒≉ : ∀ {x y} → x < y → x ≉ y +<⇒≉ = ToStrict.<⇒≉ + +≤∧≉⇒< : ∀ {x y} → x ≤ y → x ≉ y → x < y +≤∧≉⇒< = ToStrict.≤∧≉⇒< + +<⇒≱ : ∀ {x y} → x < y → ¬ (y ≤ x) +<⇒≱ = ToStrict.<⇒≱ antisym + +≤⇒≯ : ∀ {x y} → x ≤ y → ¬ (y < x) +≤⇒≯ = ToStrict.≤⇒≯ antisym + +------------------------------------------------------------------------ +-- Other properties + +mono⇒cong : ∀ {f} → f Preserves _≤_ ⟶ _≤_ → f Preserves _≈_ ⟶ _≈_ +mono⇒cong = Consequences.mono⇒cong _≈_ _≈_ Eq.sym reflexive antisym + +antimono⇒cong : ∀ {f} → f Preserves _≤_ ⟶ _≥_ → f Preserves _≈_ ⟶ _≈_ +antimono⇒cong = Consequences.antimono⇒cong _≈_ _≈_ Eq.sym reflexive antisym + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.2 + +invIsPartialOrder = ≥-isPartialOrder +{-# WARNING_ON_USAGE invIsPartialOrder +"Warning: invIsPartialOrder was deprecated in v1.2. +Please use ≥-isPartialOrder instead." +#-} + +invPoset = ≥-poset +{-# WARNING_ON_USAGE invPoset +"Warning: invPoset was deprecated in v1.2. +Please use ≥-poset instead." +#-} + +strictPartialOrder = <-strictPartialOrder +{-# WARNING_ON_USAGE strictPartialOrder +"Warning: strictPartialOrder was deprecated in v1.2. +Please use <-strictPartialOrder instead." +#-} +\ No newline at end of file diff --git a/docs/Relation.Binary.Properties.Preorder.html b/docs/Relation.Binary.Properties.Preorder.html new file mode 100644 index 0000000..dc3b480 --- /dev/null +++ b/docs/Relation.Binary.Properties.Preorder.html @@ -0,0 +1,47 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties satisfied by preorders +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Relation.Binary.Properties.Preorder + {p₁ p₂ p₃} (P : Preorder p₁ p₂ p₃) where + +open import Function +open import Data.Product as Prod + +open Preorder P + +------------------------------------------------------------------------ +-- The inverse relation is also a preorder. + +invIsPreorder : IsPreorder _≈_ (flip _∼_) +invIsPreorder = record + { isEquivalence = isEquivalence + ; reflexive = reflexive ∘ Eq.sym + ; trans = flip trans + } + +invPreorder : Preorder p₁ p₂ p₃ +invPreorder = record + { isPreorder = invIsPreorder + } + +------------------------------------------------------------------------ +-- For every preorder there is an induced equivalence + +InducedEquivalence : Setoid _ _ +InducedEquivalence = record + { _≈_ = λ x y → x ∼ y × y ∼ x + ; isEquivalence = record + { refl = (refl , refl) + ; sym = swap + ; trans = Prod.zip trans (flip trans) + } + } +\ No newline at end of file diff --git a/docs/Relation.Binary.Properties.TotalOrder.html b/docs/Relation.Binary.Properties.TotalOrder.html new file mode 100644 index 0000000..4eacfa3 --- /dev/null +++ b/docs/Relation.Binary.Properties.TotalOrder.html @@ -0,0 +1,104 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties satisfied by total orders +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Relation.Binary.Properties.TotalOrder + {t₁ t₂ t₃} (T : TotalOrder t₁ t₂ t₃) where + +open TotalOrder T + +open import Data.Product using (proj₁) +open import Data.Sum.Base using (inj₁; inj₂) +import Relation.Binary.Construct.Converse as Converse +import Relation.Binary.Construct.NonStrictToStrict _≈_ _≤_ as ToStrict +import Relation.Binary.Properties.Poset poset as PosetProperties +open import Relation.Binary.Consequences +open import Relation.Nullary using (¬_) +open import Relation.Nullary.Negation using (contradiction) + +------------------------------------------------------------------------ +-- Total orders are almost decidable total orders + +decTotalOrder : Decidable _≈_ → DecTotalOrder _ _ _ +decTotalOrder ≟ = record + { isDecTotalOrder = record + { isTotalOrder = isTotalOrder + ; _≟_ = ≟ + ; _≤?_ = total∧dec⇒dec reflexive antisym total ≟ + } + } + +------------------------------------------------------------------------ +-- _≥_ - the flipped relation is also a total order + +open PosetProperties public + using + ( _≥_ + ; ≥-refl + ; ≥-reflexive + ; ≥-trans + ; ≥-antisym + ; ≥-isPreorder + ; ≥-isPartialOrder + ; ≥-preorder + ; ≥-poset + ) + +≥-isTotalOrder : IsTotalOrder _≈_ _≥_ +≥-isTotalOrder = Converse.isTotalOrder isTotalOrder + +≥-totalOrder : TotalOrder _ _ _ +≥-totalOrder = record + { isTotalOrder = ≥-isTotalOrder + } + +open TotalOrder ≥-totalOrder public + using () renaming (total to ≥-total) + +------------------------------------------------------------------------ +-- _<_ - the strict version is a strict partial order + +-- Note that total orders can NOT be turned into strict total orders as +-- in order to distinguish between the _≤_ and _<_ cases we must have +-- decidable equality _≈_. + +open PosetProperties public + using + ( _<_ + ; <-resp-≈ + ; <-respʳ-≈ + ; <-respˡ-≈ + ; <-irrefl + ; <-asym + ; <-trans + ; <-isStrictPartialOrder + ; <-strictPartialOrder + ; <⇒≉ + ; ≤∧≉⇒< + ; <⇒≱ + ; ≤⇒≯ + ) + +------------------------------------------------------------------------ +-- _≰_ - the negated order + +open PosetProperties public + using + ( _≰_ + ; ≰-respʳ-≈ + ; ≰-respˡ-≈ + ) + +≰⇒> : ∀ {x y} → x ≰ y → y < x +≰⇒> = ToStrict.≰⇒> Eq.sym reflexive total + +≰⇒≥ : ∀ {x y} → x ≰ y → y ≤ x +≰⇒≥ x≰y = proj₁ (≰⇒> x≰y) +\ No newline at end of file diff --git a/docs/Relation.Binary.PropositionalEquality.Algebra.html b/docs/Relation.Binary.PropositionalEquality.Algebra.html new file mode 100644 index 0000000..d8fb8c6 --- /dev/null +++ b/docs/Relation.Binary.PropositionalEquality.Algebra.html @@ -0,0 +1,35 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Propositional (intensional) equality - Algebraic structures +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.PropositionalEquality.Algebra where + +open import Algebra +open import Level +open import Relation.Binary.PropositionalEquality.Core +open import Relation.Binary.PropositionalEquality.Properties + +private + variable + a : Level + A : Set a + +------------------------------------------------------------------------ +-- Any operation forms a magma over _≡_ + +isMagma : (_∙_ : Op₂ A) → IsMagma _≡_ _∙_ +isMagma _∙_ = record + { isEquivalence = isEquivalence + ; ∙-cong = cong₂ _∙_ + } + +magma : (_∙_ : Op₂ A) → Magma _ _ +magma _∙_ = record + { isMagma = isMagma _∙_ + } +\ No newline at end of file diff --git a/docs/Relation.Binary.PropositionalEquality.Core.html b/docs/Relation.Binary.PropositionalEquality.Core.html new file mode 100644 index 0000000..a8f8e8e --- /dev/null +++ b/docs/Relation.Binary.PropositionalEquality.Core.html @@ -0,0 +1,127 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Propositional equality +-- +-- This file contains some core definitions which are re-exported by +-- Relation.Binary.PropositionalEquality. +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.PropositionalEquality.Core where + +open import Data.Product using (_,_) +open import Function.Base using (_∘_) +open import Level +open import Relation.Binary.Core +open import Relation.Binary.Definitions +open import Relation.Nullary using (¬_) + +private + variable + a b ℓ : Level + A B C : Set a + +------------------------------------------------------------------------ +-- Propositional equality + +open import Agda.Builtin.Equality public + +infix 4 _≢_ +_≢_ : {A : Set a} → Rel A a +x ≢ y = ¬ x ≡ y + +------------------------------------------------------------------------ +-- A variant of `refl` where the argument is explicit + +pattern erefl x = refl {x = x} + +------------------------------------------------------------------------ +-- Congruence lemmas + +cong : ∀ (f : A → B) {x y} → x ≡ y → f x ≡ f y +cong f refl = refl + +cong′ : ∀ {f : A → B} x → f x ≡ f x +cong′ _ = refl + +icong : ∀ {f : A → B} {x y} → x ≡ y → f x ≡ f y +icong = cong _ + +icong′ : ∀ {f : A → B} x → f x ≡ f x +icong′ _ = refl + +cong₂ : ∀ (f : A → B → C) {x y u v} → x ≡ y → u ≡ v → f x u ≡ f y v +cong₂ f refl refl = refl + +cong-app : ∀ {A : Set a} {B : A → Set b} {f g : (x : A) → B x} → + f ≡ g → (x : A) → f x ≡ g x +cong-app refl x = refl + +------------------------------------------------------------------------ +-- Properties of _≡_ + +sym : Symmetric {A = A} _≡_ +sym refl = refl + +trans : Transitive {A = A} _≡_ +trans refl eq = eq + +subst : Substitutive {A = A} _≡_ ℓ +subst P refl p = p + +subst₂ : ∀ (_∼_ : REL A B ℓ) {x y u v} → x ≡ y → u ≡ v → x ∼ u → y ∼ v +subst₂ _ refl refl p = p + +resp : ∀ (P : A → Set ℓ) → P Respects _≡_ +resp P refl p = p + +respˡ : ∀ (∼ : Rel A ℓ) → ∼ Respectsˡ _≡_ +respˡ _∼_ refl x∼y = x∼y + +respʳ : ∀ (∼ : Rel A ℓ) → ∼ Respectsʳ _≡_ +respʳ _∼_ refl x∼y = x∼y + +resp₂ : ∀ (∼ : Rel A ℓ) → ∼ Respects₂ _≡_ +resp₂ _∼_ = respʳ _∼_ , respˡ _∼_ + +------------------------------------------------------------------------ +-- Properties of _≢_ + +≢-sym : Symmetric {A = A} _≢_ +≢-sym x≢y = x≢y ∘ sym + +------------------------------------------------------------------------ +-- Convenient syntax for equational reasoning + +-- This is a special instance of `Relation.Binary.Reasoning.Setoid`. +-- Rather than instantiating the latter with (setoid A), we reimplement +-- equation chains from scratch since then goals are printed much more +-- readably. + +module ≡-Reasoning {A : Set a} where + + infix 3 _∎ + infixr 2 _≡⟨⟩_ step-≡ step-≡˘ + infix 1 begin_ + + begin_ : ∀{x y : A} → x ≡ y → x ≡ y + begin_ x≡y = x≡y + + _≡⟨⟩_ : ∀ (x {y} : A) → x ≡ y → x ≡ y + _ ≡⟨⟩ x≡y = x≡y + + step-≡ : ∀ (x {y z} : A) → y ≡ z → x ≡ y → x ≡ z + step-≡ _ y≡z x≡y = trans x≡y y≡z + + step-≡˘ : ∀ (x {y z} : A) → y ≡ z → y ≡ x → x ≡ z + step-≡˘ _ y≡z y≡x = trans (sym y≡x) y≡z + + _∎ : ∀ (x : A) → x ≡ x + _∎ _ = refl + + syntax step-≡ x y≡z x≡y = x ≡⟨ x≡y ⟩ y≡z + syntax step-≡˘ x y≡z y≡x = x ≡˘⟨ y≡x ⟩ y≡z +\ No newline at end of file diff --git a/docs/Relation.Binary.PropositionalEquality.Properties.html b/docs/Relation.Binary.PropositionalEquality.Properties.html new file mode 100644 index 0000000..f5fc251 --- /dev/null +++ b/docs/Relation.Binary.PropositionalEquality.Properties.html @@ -0,0 +1,146 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Propositional equality +-- +-- This file contains some core properies of propositional equality which +-- are re-exported by Relation.Binary.PropositionalEquality. They are +-- ``equality rearrangement'' lemmas. +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.PropositionalEquality.Properties where + +open import Function.Base using (id; _∘_) +open import Level +open import Relation.Binary +open import Relation.Binary.PropositionalEquality.Core +open import Relation.Unary using (Pred) + +private + variable + a p : Level + A B C : Set a + +------------------------------------------------------------------------ +-- Various equality rearrangement lemmas + +trans-reflʳ : ∀ {x y : A} (p : x ≡ y) → trans p refl ≡ p +trans-reflʳ refl = refl + +trans-assoc : ∀ {x y z u : A} (p : x ≡ y) {q : y ≡ z} {r : z ≡ u} → + trans (trans p q) r ≡ trans p (trans q r) +trans-assoc refl = refl + +trans-symˡ : ∀ {x y : A} (p : x ≡ y) → trans (sym p) p ≡ refl +trans-symˡ refl = refl + +trans-symʳ : ∀ {x y : A} (p : x ≡ y) → trans p (sym p) ≡ refl +trans-symʳ refl = refl + +trans-injectiveˡ : ∀ {x y z : A} {p₁ p₂ : x ≡ y} (q : y ≡ z) → + trans p₁ q ≡ trans p₂ q → p₁ ≡ p₂ +trans-injectiveˡ refl = subst₂ _≡_ (trans-reflʳ _) (trans-reflʳ _) + +trans-injectiveʳ : ∀ {x y z : A} (p : x ≡ y) {q₁ q₂ : y ≡ z} → + trans p q₁ ≡ trans p q₂ → q₁ ≡ q₂ +trans-injectiveʳ refl eq = eq + +cong-id : ∀ {x y : A} (p : x ≡ y) → cong id p ≡ p +cong-id refl = refl + +cong-∘ : ∀ {x y : A} {f : B → C} {g : A → B} (p : x ≡ y) → + cong (f ∘ g) p ≡ cong f (cong g p) +cong-∘ refl = refl + +trans-cong : ∀ {x y z : A} {f : A → B} (p : x ≡ y) {q : y ≡ z} → + trans (cong f p) (cong f q) ≡ cong f (trans p q) +trans-cong refl = refl + +cong₂-reflˡ : ∀ {_∙_ : A → B → C} {x u v} → (p : u ≡ v) → + cong₂ _∙_ refl p ≡ cong (x ∙_) p +cong₂-reflˡ refl = refl + +cong₂-reflʳ : ∀ {_∙_ : A → B → C} {x y u} → (p : x ≡ y) → + cong₂ _∙_ p refl ≡ cong (_∙ u) p +cong₂-reflʳ refl = refl + +module _ {P : Pred A p} {x y : A} where + + subst-injective : ∀ (x≡y : x ≡ y) {p q : P x} → + subst P x≡y p ≡ subst P x≡y q → p ≡ q + subst-injective refl p≡q = p≡q + + subst-subst : ∀ {z} (x≡y : x ≡ y) {y≡z : y ≡ z} {p : P x} → + subst P y≡z (subst P x≡y p) ≡ subst P (trans x≡y y≡z) p + subst-subst refl = refl + + subst-subst-sym : (x≡y : x ≡ y) {p : P y} → + subst P x≡y (subst P (sym x≡y) p) ≡ p + subst-subst-sym refl = refl + + subst-sym-subst : (x≡y : x ≡ y) {p : P x} → + subst P (sym x≡y) (subst P x≡y p) ≡ p + subst-sym-subst refl = refl + +subst-∘ : ∀ {x y : A} {P : Pred B p} {f : A → B} + (x≡y : x ≡ y) {p : P (f x)} → + subst (P ∘ f) x≡y p ≡ subst P (cong f x≡y) p +subst-∘ refl = refl + +subst-application : ∀ {a₁ a₂ b₁ b₂} {A₁ : Set a₁} {A₂ : Set a₂} + (B₁ : A₁ → Set b₁) {B₂ : A₂ → Set b₂} + {f : A₂ → A₁} {x₁ x₂ : A₂} {y : B₁ (f x₁)} + (g : ∀ x → B₁ (f x) → B₂ x) (eq : x₁ ≡ x₂) → + subst B₂ eq (g x₁ y) ≡ g x₂ (subst B₁ (cong f eq) y) +subst-application _ _ refl = refl + +------------------------------------------------------------------------ +-- Structure of equality as a binary relation + +isEquivalence : IsEquivalence {A = A} _≡_ +isEquivalence = record + { refl = refl + ; sym = sym + ; trans = trans + } + +isDecEquivalence : Decidable _≡_ → IsDecEquivalence {A = A} _≡_ +isDecEquivalence _≟_ = record + { isEquivalence = isEquivalence + ; _≟_ = _≟_ + } + +isPreorder : IsPreorder {A = A} _≡_ _≡_ +isPreorder = record + { isEquivalence = isEquivalence + ; reflexive = id + ; trans = trans + } + +------------------------------------------------------------------------ +-- Bundles for equality as a binary relation + +setoid : Set a → Setoid _ _ +setoid A = record + { Carrier = A + ; _≈_ = _≡_ + ; isEquivalence = isEquivalence + } + +decSetoid : Decidable {A = A} _≡_ → DecSetoid _ _ +decSetoid _≟_ = record + { _≈_ = _≡_ + ; isDecEquivalence = isDecEquivalence _≟_ + } + +preorder : Set a → Preorder _ _ _ +preorder A = record + { Carrier = A + ; _≈_ = _≡_ + ; _∼_ = _≡_ + ; isPreorder = isPreorder + } +\ No newline at end of file diff --git a/docs/Relation.Binary.PropositionalEquality.html b/docs/Relation.Binary.PropositionalEquality.html new file mode 100644 index 0000000..04db64d --- /dev/null +++ b/docs/Relation.Binary.PropositionalEquality.html @@ -0,0 +1,148 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Propositional (intensional) equality +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary.PropositionalEquality where + +import Axiom.Extensionality.Propositional as Ext +open import Axiom.UniquenessOfIdentityProofs +open import Function.Base using (id; _∘_) +open import Function.Equality using (Π; _⟶_; ≡-setoid) +open import Level using (Level; _⊔_) +open import Data.Product using (∃) + +open import Relation.Nullary using (yes ; no) +open import Relation.Nullary.Decidable.Core +open import Relation.Binary +open import Relation.Binary.Indexed.Heterogeneous + using (IndexedSetoid) +import Relation.Binary.Indexed.Heterogeneous.Construct.Trivial + as Trivial + +private + variable + a b c ℓ p : Level + A : Set a + B : Set b + C : Set c + +------------------------------------------------------------------------ +-- Re-export contents modules that make up the parts + +open import Relation.Binary.PropositionalEquality.Core public +open import Relation.Binary.PropositionalEquality.Properties public +open import Relation.Binary.PropositionalEquality.Algebra public + +------------------------------------------------------------------------ +-- Pointwise equality + +infix 4 _≗_ + +_→-setoid_ : ∀ (A : Set a) (B : Set b) → Setoid _ _ +A →-setoid B = ≡-setoid A (Trivial.indexedSetoid (setoid B)) + +_≗_ : (f g : A → B) → Set _ +_≗_ {A = A} {B = B} = Setoid._≈_ (A →-setoid B) + +:→-to-Π : ∀ {A : Set a} {B : IndexedSetoid A b ℓ} → + ((x : A) → IndexedSetoid.Carrier B x) → Π (setoid A) B +:→-to-Π {B = B} f = record + { _⟨$⟩_ = f + ; cong = λ { refl → IndexedSetoid.refl B } + } + where open IndexedSetoid B using (_≈_) + +→-to-⟶ : ∀ {A : Set a} {B : Setoid b ℓ} → + (A → Setoid.Carrier B) → setoid A ⟶ B +→-to-⟶ = :→-to-Π + +------------------------------------------------------------------------ +-- Inspect + +-- Inspect can be used when you want to pattern match on the result r +-- of some expression e, and you also need to "remember" that r ≡ e. + +-- See README.Inspect for an explanation of how/why to use this. + +record Reveal_·_is_ {A : Set a} {B : A → Set b} + (f : (x : A) → B x) (x : A) (y : B x) : + Set (a ⊔ b) where + constructor [_] + field eq : f x ≡ y + +inspect : ∀ {A : Set a} {B : A → Set b} + (f : (x : A) → B x) (x : A) → Reveal f · x is f x +inspect f x = [ refl ] + +------------------------------------------------------------------------ +-- Propositionality + +isPropositional : Set a → Set a +isPropositional A = (a b : A) → a ≡ b + +------------------------------------------------------------------------ +-- More complex rearrangement lemmas + +-- A lemma that is very similar to Lemma 2.4.3 from the HoTT book. + +naturality : ∀ {x y} {x≡y : x ≡ y} {f g : A → B} + (f≡g : ∀ x → f x ≡ g x) → + trans (cong f x≡y) (f≡g y) ≡ trans (f≡g x) (cong g x≡y) +naturality {x = x} {x≡y = refl} f≡g = + f≡g x ≡⟨ sym (trans-reflʳ _) ⟩ + trans (f≡g x) refl ∎ + where open ≡-Reasoning + +-- A lemma that is very similar to Corollary 2.4.4 from the HoTT book. + +cong-≡id : ∀ {f : A → A} {x : A} (f≡id : ∀ x → f x ≡ x) → + cong f (f≡id x) ≡ f≡id (f x) +cong-≡id {f = f} {x} f≡id = + cong f fx≡x ≡⟨ sym (trans-reflʳ _) ⟩ + trans (cong f fx≡x) refl ≡⟨ cong (trans _) (sym (trans-symʳ fx≡x)) ⟩ + trans (cong f fx≡x) (trans fx≡x (sym fx≡x)) ≡⟨ sym (trans-assoc (cong f fx≡x)) ⟩ + trans (trans (cong f fx≡x) fx≡x) (sym fx≡x) ≡⟨ cong (λ p → trans p (sym _)) (naturality f≡id) ⟩ + trans (trans f²x≡x (cong id fx≡x)) (sym fx≡x) ≡⟨ cong (λ p → trans (trans f²x≡x p) (sym fx≡x)) (cong-id _) ⟩ + trans (trans f²x≡x fx≡x) (sym fx≡x) ≡⟨ trans-assoc f²x≡x ⟩ + trans f²x≡x (trans fx≡x (sym fx≡x)) ≡⟨ cong (trans _) (trans-symʳ fx≡x) ⟩ + trans f²x≡x refl ≡⟨ trans-reflʳ _ ⟩ + f≡id (f x) ∎ + where open ≡-Reasoning; fx≡x = f≡id x; f²x≡x = f≡id (f x) + +module _ (_≟_ : Decidable {A = A} _≡_) {x y : A} where + + ≡-≟-identity : (eq : x ≡ y) → x ≟ y ≡ yes eq + ≡-≟-identity eq = dec-yes-irr (x ≟ y) (Decidable⇒UIP.≡-irrelevant _≟_) eq + + ≢-≟-identity : x ≢ y → ∃ λ ¬eq → x ≟ y ≡ no ¬eq + ≢-≟-identity ¬eq = dec-no (x ≟ y) ¬eq + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.0 + +Extensionality = Ext.Extensionality +{-# WARNING_ON_USAGE Extensionality +"Warning: Extensionality was deprecated in v1.0. +Please use Extensionality from `Axiom.Extensionality.Propositional` instead." +#-} +extensionality-for-lower-levels = Ext.lower-extensionality +{-# WARNING_ON_USAGE extensionality-for-lower-levels +"Warning: extensionality-for-lower-levels was deprecated in v1.0. +Please use lower-extensionality from `Axiom.Extensionality.Propositional` instead." +#-} +∀-extensionality = Ext.∀-extensionality +{-# WARNING_ON_USAGE ∀-extensionality +"Warning: ∀-extensionality was deprecated in v1.0. +Please use ∀-extensionality from `Axiom.Extensionality.Propositional` instead." +#-} +\ No newline at end of file diff --git a/docs/Relation.Binary.Reasoning.Base.Double.html b/docs/Relation.Binary.Reasoning.Base.Double.html new file mode 100644 index 0000000..fea2339 --- /dev/null +++ b/docs/Relation.Binary.Reasoning.Base.Double.html @@ -0,0 +1,117 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- The basic code for equational reasoning with two relations: +-- equality and some other ordering. +------------------------------------------------------------------------ +-- +-- See `Data.Nat.Properties` or `Relation.Binary.Reasoning.PartialOrder` +-- for examples of how to instantiate this module. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Relation.Binary.Reasoning.Base.Double {a ℓ₁ ℓ₂} {A : Set a} + {_≈_ : Rel A ℓ₁} {_∼_ : Rel A ℓ₂} (isPreorder : IsPreorder _≈_ _∼_) + where + +open import Data.Product using (proj₁; proj₂) +open import Level using (Level; _⊔_; Lift; lift) +open import Function.Base using (case_of_; id) +open import Relation.Binary.PropositionalEquality.Core + using (_≡_; refl; sym) +open import Relation.Nullary using (Dec; yes; no) +open import Relation.Nullary.Decidable using (True; toWitness) + +open IsPreorder isPreorder + +------------------------------------------------------------------------ +-- A datatype to hide the current relation type + +infix 4 _IsRelatedTo_ + +data _IsRelatedTo_ (x y : A) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + nonstrict : (x∼y : x ∼ y) → x IsRelatedTo y + equals : (x≈y : x ≈ y) → x IsRelatedTo y + +------------------------------------------------------------------------ +-- A record that is used to ensure that the final relation proved by the +-- chain of reasoning can be converted into the required relation. + +data IsEquality {x y} : x IsRelatedTo y → Set (a ⊔ ℓ₁ ⊔ ℓ₂) where + isEquality : ∀ x≈y → IsEquality (equals x≈y) + +IsEquality? : ∀ {x y} (x≲y : x IsRelatedTo y) → Dec (IsEquality x≲y) +IsEquality? (nonstrict _) = no λ() +IsEquality? (equals x≈y) = yes (isEquality x≈y) + +extractEquality : ∀ {x y} {x≲y : x IsRelatedTo y} → IsEquality x≲y → x ≈ y +extractEquality (isEquality x≈y) = x≈y + +------------------------------------------------------------------------ +-- Reasoning combinators + +-- See `Relation.Binary.Reasoning.Base.Partial` for the design decisions +-- behind these combinators. + +infix 1 begin_ begin-equality_ +infixr 2 step-∼ step-≈ step-≈˘ step-≡ step-≡˘ _≡⟨⟩_ +infix 3 _∎ + +-- Beginnings of various types of proofs + +begin_ : ∀ {x y} (r : x IsRelatedTo y) → x ∼ y +begin (nonstrict x∼y) = x∼y +begin (equals x≈y) = reflexive x≈y + +begin-equality_ : ∀ {x y} (r : x IsRelatedTo y) → {s : True (IsEquality? r)} → x ≈ y +begin-equality_ r {s} = extractEquality (toWitness s) + +-- Step with the main relation + +step-∼ : ∀ (x : A) {y z} → y IsRelatedTo z → x ∼ y → x IsRelatedTo z +step-∼ x (nonstrict y∼z) x∼y = nonstrict (trans x∼y y∼z) +step-∼ x (equals y≈z) x∼y = nonstrict (∼-respʳ-≈ y≈z x∼y) + +-- Step with the setoid equality + +step-≈ : ∀ (x : A) {y z} → y IsRelatedTo z → x ≈ y → x IsRelatedTo z +step-≈ x (nonstrict y∼z) x≈y = nonstrict (∼-respˡ-≈ (Eq.sym x≈y) y∼z) +step-≈ x (equals y≈z) x≈y = equals (Eq.trans x≈y y≈z) + +-- Flipped step with the setoid equality + +step-≈˘ : ∀ x {y z} → y IsRelatedTo z → y ≈ x → x IsRelatedTo z +step-≈˘ x y∼z x≈y = step-≈ x y∼z (Eq.sym x≈y) + +-- Step with non-trivial propositional equality + +step-≡ : ∀ (x : A) {y z} → y IsRelatedTo z → x ≡ y → x IsRelatedTo z +step-≡ x (nonstrict y∼z) x≡y = nonstrict (case x≡y of λ where refl → y∼z) +step-≡ x (equals y≈z) x≡y = equals (case x≡y of λ where refl → y≈z) + +-- Flipped step with non-trivial propositional equality + +step-≡˘ : ∀ x {y z} → y IsRelatedTo z → y ≡ x → x IsRelatedTo z +step-≡˘ x y∼z x≡y = step-≡ x y∼z (sym x≡y) + +-- Step with trivial propositional equality + +_≡⟨⟩_ : ∀ (x : A) {y} → x IsRelatedTo y → x IsRelatedTo y +x ≡⟨⟩ x≲y = x≲y + +-- Termination step + +_∎ : ∀ x → x IsRelatedTo x +x ∎ = equals Eq.refl + +-- Syntax declarations + +syntax step-∼ x y∼z x∼y = x ∼⟨ x∼y ⟩ y∼z +syntax step-≈ x y∼z x≈y = x ≈⟨ x≈y ⟩ y∼z +syntax step-≈˘ x y∼z y≈x = x ≈˘⟨ y≈x ⟩ y∼z +syntax step-≡ x y∼z x≡y = x ≡⟨ x≡y ⟩ y∼z +syntax step-≡˘ x y∼z y≡x = x ≡˘⟨ y≡x ⟩ y∼z +\ No newline at end of file diff --git a/docs/Relation.Binary.Reasoning.Base.Single.html b/docs/Relation.Binary.Reasoning.Base.Single.html new file mode 100644 index 0000000..c43c82c --- /dev/null +++ b/docs/Relation.Binary.Reasoning.Base.Single.html @@ -0,0 +1,90 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- The basic code for equational reasoning with a single relation +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Relation.Binary.Reasoning.Base.Single + {a ℓ} {A : Set a} (_∼_ : Rel A ℓ) + (refl : Reflexive _∼_) (trans : Transitive _∼_) + where + +-- TODO: the following part is copied from Relation.Binary.Reasoning.Base.Partial +-- in order to avoid larger refactors. We will refactor this part later +-- so taht we use the same framework as Relation.Binary.Reasoning.Base.Partial. + +open import Level using (_⊔_) +open import Relation.Binary.PropositionalEquality.Core as P + using (_≡_) + +infix 4 _IsRelatedTo_ + +------------------------------------------------------------------------ +-- Definition of "related to" + +-- This seemingly unnecessary type is used to make it possible to +-- infer arguments even if the underlying equality evaluates. + +data _IsRelatedTo_ (x y : A) : Set ℓ where + relTo : (x∼y : x ∼ y) → x IsRelatedTo y + +------------------------------------------------------------------------ +-- Reasoning combinators + +-- Note that the arguments to the `step`s are not provided in their +-- "natural" order and syntax declarations are later used to re-order +-- them. This is because the `step` ordering allows the type-checker to +-- better infer the middle argument `y` from the `_IsRelatedTo_` +-- argument (see issue 622). +-- +-- This has two practical benefits. First it speeds up type-checking by +-- approximately a factor of 5. Secondly it allows the combinators to be +-- used with macros that use reflection, e.g. `Tactic.RingSolver`, where +-- they need to be able to extract `y` using reflection. + +infix 1 begin_ +infixr 2 step-∼ step-≡ step-≡˘ +infixr 2 _≡⟨⟩_ +infix 3 _∎ + +-- Beginning of a proof + +begin_ : ∀ {x y} → x IsRelatedTo y → x ∼ y +begin relTo x∼y = x∼y + +-- Standard step with the relation + +step-∼ : ∀ x {y z} → y IsRelatedTo z → x ∼ y → x IsRelatedTo z +step-∼ _ (relTo y∼z) x∼y = relTo (trans x∼y y∼z) + +-- Step with a non-trivial propositional equality + +step-≡ : ∀ x {y z} → y IsRelatedTo z → x ≡ y → x IsRelatedTo z +step-≡ _ x∼z P.refl = x∼z + +-- Step with a flipped non-trivial propositional equality + +step-≡˘ : ∀ x {y z} → y IsRelatedTo z → y ≡ x → x IsRelatedTo z +step-≡˘ _ x∼z P.refl = x∼z + +-- Step with a trivial propositional equality + +_≡⟨⟩_ : ∀ x {y} → x IsRelatedTo y → x IsRelatedTo y +_ ≡⟨⟩ x∼y = x∼y + +-- Termination + +_∎ : ∀ x → x IsRelatedTo x +x ∎ = relTo refl + +-- Syntax declarations + +syntax step-∼ x y∼z x∼y = x ∼⟨ x∼y ⟩ y∼z +syntax step-≡ x y≡z x≡y = x ≡⟨ x≡y ⟩ y≡z +syntax step-≡˘ x y≡z y≡x = x ≡˘⟨ y≡x ⟩ y≡z +\ No newline at end of file diff --git a/docs/Relation.Binary.Reasoning.Base.Triple.html b/docs/Relation.Binary.Reasoning.Base.Triple.html new file mode 100644 index 0000000..63f6f9c --- /dev/null +++ b/docs/Relation.Binary.Reasoning.Base.Triple.html @@ -0,0 +1,153 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- The basic code for equational reasoning with three relations: +-- equality, strict ordering and non-strict ordering. +------------------------------------------------------------------------ +-- +-- See `Data.Nat.Properties` or `Relation.Binary.Reasoning.PartialOrder` +-- for examples of how to instantiate this module. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Relation.Binary.Reasoning.Base.Triple {a ℓ₁ ℓ₂ ℓ₃} {A : Set a} + {_≈_ : Rel A ℓ₁} {_≤_ : Rel A ℓ₂} {_<_ : Rel A ℓ₃} + (isPreorder : IsPreorder _≈_ _≤_) + (<-trans : Transitive _<_) (<-resp-≈ : _<_ Respects₂ _≈_) (<⇒≤ : _<_ ⇒ _≤_) + (<-≤-trans : Trans _<_ _≤_ _<_) (≤-<-trans : Trans _≤_ _<_ _<_) + where + +open import Data.Product using (proj₁; proj₂) +open import Function.Base using (case_of_; id) +open import Level using (Level; _⊔_; Lift; lift) +open import Relation.Binary.PropositionalEquality.Core + using (_≡_; refl; sym) +open import Relation.Nullary using (Dec; yes; no) +open import Relation.Nullary.Decidable using (True; toWitness) + +open IsPreorder isPreorder + renaming + ( reflexive to ≤-reflexive + ; trans to ≤-trans + ; ∼-resp-≈ to ≤-resp-≈ + ) + +------------------------------------------------------------------------ +-- A datatype to abstract over the current relation + +infix 4 _IsRelatedTo_ + +data _IsRelatedTo_ (x y : A) : Set (a ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃) where + strict : (x<y : x < y) → x IsRelatedTo y + nonstrict : (x≤y : x ≤ y) → x IsRelatedTo y + equals : (x≈y : x ≈ y) → x IsRelatedTo y + +------------------------------------------------------------------------ +-- Types that are used to ensure that the final relation proved by the +-- chain of reasoning can be converted into the required relation. + +data IsStrict {x y} : x IsRelatedTo y → Set (a ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃) where + isStrict : ∀ x<y → IsStrict (strict x<y) + +IsStrict? : ∀ {x y} (x≲y : x IsRelatedTo y) → Dec (IsStrict x≲y) +IsStrict? (strict x<y) = yes (isStrict x<y) +IsStrict? (nonstrict _) = no λ() +IsStrict? (equals _) = no λ() + +extractStrict : ∀ {x y} {x≲y : x IsRelatedTo y} → IsStrict x≲y → x < y +extractStrict (isStrict x<y) = x<y + +data IsEquality {x y} : x IsRelatedTo y → Set (a ⊔ ℓ₁ ⊔ ℓ₂ ⊔ ℓ₃) where + isEquality : ∀ x≈y → IsEquality (equals x≈y) + +IsEquality? : ∀ {x y} (x≲y : x IsRelatedTo y) → Dec (IsEquality x≲y) +IsEquality? (strict _) = no λ() +IsEquality? (nonstrict _) = no λ() +IsEquality? (equals x≈y) = yes (isEquality x≈y) + +extractEquality : ∀ {x y} {x≲y : x IsRelatedTo y} → IsEquality x≲y → x ≈ y +extractEquality (isEquality x≈y) = x≈y + +------------------------------------------------------------------------ +-- Reasoning combinators + +-- See `Relation.Binary.Reasoning.Base.Partial` for the design decisions +-- behind these combinators. + +infix 1 begin_ begin-strict_ begin-equality_ +infixr 2 step-< step-≤ step-≈ step-≈˘ step-≡ step-≡˘ _≡⟨⟩_ +infix 3 _∎ + +-- Beginnings of various types of proofs + +begin_ : ∀ {x y} → x IsRelatedTo y → x ≤ y +begin (strict x<y) = <⇒≤ x<y +begin (nonstrict x≤y) = x≤y +begin (equals x≈y) = ≤-reflexive x≈y + +begin-strict_ : ∀ {x y} (r : x IsRelatedTo y) → {s : True (IsStrict? r)} → x < y +begin-strict_ r {s} = extractStrict (toWitness s) + +begin-equality_ : ∀ {x y} (r : x IsRelatedTo y) → {s : True (IsEquality? r)} → x ≈ y +begin-equality_ r {s} = extractEquality (toWitness s) + +-- Step with the strict relation + +step-< : ∀ (x : A) {y z} → y IsRelatedTo z → x < y → x IsRelatedTo z +step-< x (strict y<z) x<y = strict (<-trans x<y y<z) +step-< x (nonstrict y≤z) x<y = strict (<-≤-trans x<y y≤z) +step-< x (equals y≈z) x<y = strict (proj₁ <-resp-≈ y≈z x<y) + +-- Step with the non-strict relation + +step-≤ : ∀ (x : A) {y z} → y IsRelatedTo z → x ≤ y → x IsRelatedTo z +step-≤ x (strict y<z) x≤y = strict (≤-<-trans x≤y y<z) +step-≤ x (nonstrict y≤z) x≤y = nonstrict (≤-trans x≤y y≤z) +step-≤ x (equals y≈z) x≤y = nonstrict (proj₁ ≤-resp-≈ y≈z x≤y) + +-- Step with the setoid equality + +step-≈ : ∀ (x : A) {y z} → y IsRelatedTo z → x ≈ y → x IsRelatedTo z +step-≈ x (strict y<z) x≈y = strict (proj₂ <-resp-≈ (Eq.sym x≈y) y<z) +step-≈ x (nonstrict y≤z) x≈y = nonstrict (proj₂ ≤-resp-≈ (Eq.sym x≈y) y≤z) +step-≈ x (equals y≈z) x≈y = equals (Eq.trans x≈y y≈z) + +-- Flipped step with the setoid equality + +step-≈˘ : ∀ x {y z} → y IsRelatedTo z → y ≈ x → x IsRelatedTo z +step-≈˘ x y∼z x≈y = step-≈ x y∼z (Eq.sym x≈y) + +-- Step with non-trivial propositional equality + +step-≡ : ∀ (x : A) {y z} → y IsRelatedTo z → x ≡ y → x IsRelatedTo z +step-≡ x (strict y<z) x≡y = strict (case x≡y of λ where refl → y<z) +step-≡ x (nonstrict y≤z) x≡y = nonstrict (case x≡y of λ where refl → y≤z) +step-≡ x (equals y≈z) x≡y = equals (case x≡y of λ where refl → y≈z) + +-- Flipped step with non-trivial propositional equality + +step-≡˘ : ∀ x {y z} → y IsRelatedTo z → y ≡ x → x IsRelatedTo z +step-≡˘ x y∼z x≡y = step-≡ x y∼z (sym x≡y) + +-- Step with trivial propositional equality + +_≡⟨⟩_ : ∀ (x : A) {y} → x IsRelatedTo y → x IsRelatedTo y +x ≡⟨⟩ x≲y = x≲y + +-- Termination step + +_∎ : ∀ x → x IsRelatedTo x +x ∎ = equals Eq.refl + +-- Syntax declarations + +syntax step-< x y∼z x<y = x <⟨ x<y ⟩ y∼z +syntax step-≤ x y∼z x≤y = x ≤⟨ x≤y ⟩ y∼z +syntax step-≈ x y∼z x≈y = x ≈⟨ x≈y ⟩ y∼z +syntax step-≈˘ x y∼z y≈x = x ≈˘⟨ y≈x ⟩ y∼z +syntax step-≡ x y∼z x≡y = x ≡⟨ x≡y ⟩ y∼z +syntax step-≡˘ x y∼z y≡x = x ≡˘⟨ y≡x ⟩ y∼z +\ No newline at end of file diff --git a/docs/Relation.Binary.Reasoning.Preorder.html b/docs/Relation.Binary.Reasoning.Preorder.html new file mode 100644 index 0000000..ac517c4 --- /dev/null +++ b/docs/Relation.Binary.Reasoning.Preorder.html @@ -0,0 +1,55 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Convenient syntax for "equational reasoning" using a preorder +------------------------------------------------------------------------ + +-- Example uses: +-- +-- u∼y : u ∼ y +-- u∼y = begin +-- u ≈⟨ u≈v ⟩ +-- v ≡⟨ v≡w ⟩ +-- w ∼⟨ w∼y ⟩ +-- y ≈⟨ z≈y ⟩ +-- z ∎ +-- +-- u≈w : u ≈ w +-- u≈w = begin-equality +-- u ≈⟨ u≈v ⟩ +-- v ≡⟨ v≡w ⟩ +-- w ≡˘⟨ x≡w ⟩ +-- x ∎ + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Relation.Binary.Reasoning.Preorder + {p₁ p₂ p₃} (P : Preorder p₁ p₂ p₃) where + +open Preorder P + +------------------------------------------------------------------------ +-- Publicly re-export the contents of the base module + +open import Relation.Binary.Reasoning.Base.Double isPreorder public + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.0 + +infixr 2 _≈⟨⟩_ + +_≈⟨⟩_ = _≡⟨⟩_ +{-# WARNING_ON_USAGE _≈⟨⟩_ +"Warning: _≈⟨⟩_ was deprecated in v1.0. +Please use _≡⟨⟩_ instead." +#-} +\ No newline at end of file diff --git a/docs/Relation.Binary.Reasoning.Setoid.html b/docs/Relation.Binary.Reasoning.Setoid.html new file mode 100644 index 0000000..1bb9ef2 --- /dev/null +++ b/docs/Relation.Binary.Reasoning.Setoid.html @@ -0,0 +1,49 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Convenient syntax for reasoning with a setoid +------------------------------------------------------------------------ + +-- Example use: + +-- n*0≡0 : ∀ n → n * 0 ≡ 0 +-- n*0≡0 zero = refl +-- n*0≡0 (suc n) = begin +-- suc n * 0 ≈⟨ refl ⟩ +-- n * 0 + 0 ≈⟨ ... ⟩ +-- n * 0 ≈⟨ n*0≡0 n ⟩ +-- 0 ∎ + +-- Module `≡-Reasoning` in `Relation.Binary.PropositionalEquality` +-- is recommended for equational reasoning when the underlying equality is +-- `_≡_`. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary + +module Relation.Binary.Reasoning.Setoid {s₁ s₂} (S : Setoid s₁ s₂) where + +open Setoid S + +------------------------------------------------------------------------ +-- Reasoning combinators + +-- open import Relation.Binary.Reasoning.PartialSetoid partialSetoid public +open import Relation.Binary.Reasoning.Base.Single _≈_ refl trans as Base public + hiding (step-∼) + +infixr 2 step-≈ step-≈˘ + +-- A step using an equality + +step-≈ = Base.step-∼ +syntax step-≈ x y≈z x≈y = x ≈⟨ x≈y ⟩ y≈z + +-- A step using a symmetric equality + +step-≈˘ : ∀ x {y z} → y IsRelatedTo z → y ≈ x → x IsRelatedTo z +step-≈˘ x y∼z y≈x = x ≈⟨ sym y≈x ⟩ y∼z +syntax step-≈˘ x y≈z y≈x = x ≈˘⟨ y≈x ⟩ y≈z +\ No newline at end of file diff --git a/docs/Relation.Binary.Structures.html b/docs/Relation.Binary.Structures.html new file mode 100644 index 0000000..ebdf04b --- /dev/null +++ b/docs/Relation.Binary.Structures.html @@ -0,0 +1,288 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Structures for homogeneous binary relations +------------------------------------------------------------------------ + +-- The contents of this module should be accessed via `Relation.Binary`. + +{-# OPTIONS --cubical-compatible --safe #-} + +open import Relation.Binary.Core + +module Relation.Binary.Structures + {a ℓ} {A : Set a} -- The underlying set + (_≈_ : Rel A ℓ) -- The underlying equality relation + where + +open import Data.Product using (proj₁; proj₂; _,_) +open import Level using (Level; _⊔_) +open import Relation.Nullary using (¬_) +open import Relation.Binary.PropositionalEquality.Core as P using (_≡_) +open import Relation.Binary.Consequences +open import Relation.Binary.Definitions + +private + variable + ℓ₂ : Level + +------------------------------------------------------------------------ +-- Equivalences +------------------------------------------------------------------------ +-- Note all the following equivalences refer to the equality provided +-- as a module parameter at the top of this file. + +record IsPartialEquivalence : Set (a ⊔ ℓ) where + field + sym : Symmetric _≈_ + trans : Transitive _≈_ + +-- The preorders of this library are defined in terms of an underlying +-- equivalence relation, and hence equivalence relations are not +-- defined in terms of preorders. + +-- To preserve backwards compatability, equivalence relations are +-- not defined in terms of their partial counterparts. + +record IsEquivalence : Set (a ⊔ ℓ) where + field + refl : Reflexive _≈_ + sym : Symmetric _≈_ + trans : Transitive _≈_ + + reflexive : _≡_ ⇒ _≈_ + reflexive P.refl = refl + + isPartialEquivalence : IsPartialEquivalence + isPartialEquivalence = record + { sym = sym + ; trans = trans + } + + +record IsDecEquivalence : Set (a ⊔ ℓ) where + infix 4 _≟_ + field + isEquivalence : IsEquivalence + _≟_ : Decidable _≈_ + + open IsEquivalence isEquivalence public + + +------------------------------------------------------------------------ +-- Preorders +------------------------------------------------------------------------ + +record IsPreorder (_∼_ : Rel A ℓ₂) : Set (a ⊔ ℓ ⊔ ℓ₂) where + field + isEquivalence : IsEquivalence + -- Reflexivity is expressed in terms of the underlying equality: + reflexive : _≈_ ⇒ _∼_ + trans : Transitive _∼_ + + module Eq = IsEquivalence isEquivalence + + refl : Reflexive _∼_ + refl = reflexive Eq.refl + + ∼-respˡ-≈ : _∼_ Respectsˡ _≈_ + ∼-respˡ-≈ x≈y x∼z = trans (reflexive (Eq.sym x≈y)) x∼z + + ∼-respʳ-≈ : _∼_ Respectsʳ _≈_ + ∼-respʳ-≈ x≈y z∼x = trans z∼x (reflexive x≈y) + + ∼-resp-≈ : _∼_ Respects₂ _≈_ + ∼-resp-≈ = ∼-respʳ-≈ , ∼-respˡ-≈ + + +record IsTotalPreorder (_≲_ : Rel A ℓ₂) : Set (a ⊔ ℓ ⊔ ℓ₂) where + field + isPreorder : IsPreorder _≲_ + total : Total _≲_ + + open IsPreorder isPreorder public + renaming + ( ∼-respˡ-≈ to ≲-respˡ-≈ + ; ∼-respʳ-≈ to ≲-respʳ-≈ + ; ∼-resp-≈ to ≲-resp-≈ + ) + + +------------------------------------------------------------------------ +-- Partial orders +------------------------------------------------------------------------ + +record IsPartialOrder (_≤_ : Rel A ℓ₂) : Set (a ⊔ ℓ ⊔ ℓ₂) where + field + isPreorder : IsPreorder _≤_ + antisym : Antisymmetric _≈_ _≤_ + + open IsPreorder isPreorder public + renaming + ( ∼-respˡ-≈ to ≤-respˡ-≈ + ; ∼-respʳ-≈ to ≤-respʳ-≈ + ; ∼-resp-≈ to ≤-resp-≈ + ) + + +record IsDecPartialOrder (_≤_ : Rel A ℓ₂) : Set (a ⊔ ℓ ⊔ ℓ₂) where + infix 4 _≟_ _≤?_ + field + isPartialOrder : IsPartialOrder _≤_ + _≟_ : Decidable _≈_ + _≤?_ : Decidable _≤_ + + open IsPartialOrder isPartialOrder public + hiding (module Eq) + + module Eq where + + isDecEquivalence : IsDecEquivalence + isDecEquivalence = record + { isEquivalence = isEquivalence + ; _≟_ = _≟_ + } + + open IsDecEquivalence isDecEquivalence public + + +record IsStrictPartialOrder (_<_ : Rel A ℓ₂) : Set (a ⊔ ℓ ⊔ ℓ₂) where + field + isEquivalence : IsEquivalence + irrefl : Irreflexive _≈_ _<_ + trans : Transitive _<_ + <-resp-≈ : _<_ Respects₂ _≈_ + + module Eq = IsEquivalence isEquivalence + + asym : Asymmetric _<_ + asym {x} {y} = trans∧irr⇒asym Eq.refl trans irrefl {x = x} {y} + + <-respʳ-≈ : _<_ Respectsʳ _≈_ + <-respʳ-≈ = proj₁ <-resp-≈ + + <-respˡ-≈ : _<_ Respectsˡ _≈_ + <-respˡ-≈ = proj₂ <-resp-≈ + + asymmetric = asym + {-# WARNING_ON_USAGE asymmetric + "Warning: asymmetric was deprecated in v0.16. + Please use asym instead." + #-} + + +record IsDecStrictPartialOrder (_<_ : Rel A ℓ₂) : Set (a ⊔ ℓ ⊔ ℓ₂) where + infix 4 _≟_ _<?_ + field + isStrictPartialOrder : IsStrictPartialOrder _<_ + _≟_ : Decidable _≈_ + _<?_ : Decidable _<_ + + private + module SPO = IsStrictPartialOrder isStrictPartialOrder + + open SPO public hiding (module Eq) + + module Eq where + + isDecEquivalence : IsDecEquivalence + isDecEquivalence = record + { isEquivalence = SPO.isEquivalence + ; _≟_ = _≟_ + } + + open IsDecEquivalence isDecEquivalence public + + +------------------------------------------------------------------------ +-- Total orders +------------------------------------------------------------------------ + +record IsTotalOrder (_≤_ : Rel A ℓ₂) : Set (a ⊔ ℓ ⊔ ℓ₂) where + field + isPartialOrder : IsPartialOrder _≤_ + total : Total _≤_ + + open IsPartialOrder isPartialOrder public + + isTotalPreorder : IsTotalPreorder _≤_ + isTotalPreorder = record + { isPreorder = isPreorder + ; total = total + } + + +record IsDecTotalOrder (_≤_ : Rel A ℓ₂) : Set (a ⊔ ℓ ⊔ ℓ₂) where + infix 4 _≟_ _≤?_ + field + isTotalOrder : IsTotalOrder _≤_ + _≟_ : Decidable _≈_ + _≤?_ : Decidable _≤_ + + open IsTotalOrder isTotalOrder public + hiding (module Eq) + + isDecPartialOrder : IsDecPartialOrder _≤_ + isDecPartialOrder = record + { isPartialOrder = isPartialOrder + ; _≟_ = _≟_ + ; _≤?_ = _≤?_ + } + + module Eq where + + isDecEquivalence : IsDecEquivalence + isDecEquivalence = record + { isEquivalence = isEquivalence + ; _≟_ = _≟_ + } + + open IsDecEquivalence isDecEquivalence public + + +-- Note that these orders are decidable. The current implementation +-- of `Trichotomous` subsumes irreflexivity and asymmetry. Any reasonable +-- definition capturing these three properties implies decidability +-- as `Trichotomous` necessarily separates out the equality case. + +record IsStrictTotalOrder (_<_ : Rel A ℓ₂) : Set (a ⊔ ℓ ⊔ ℓ₂) where + field + isEquivalence : IsEquivalence + trans : Transitive _<_ + compare : Trichotomous _≈_ _<_ + + infix 4 _≟_ _<?_ + + _≟_ : Decidable _≈_ + _≟_ = tri⇒dec≈ compare + + _<?_ : Decidable _<_ + _<?_ = tri⇒dec< compare + + isDecEquivalence : IsDecEquivalence + isDecEquivalence = record + { isEquivalence = isEquivalence + ; _≟_ = _≟_ + } + + module Eq = IsDecEquivalence isDecEquivalence + + isStrictPartialOrder : IsStrictPartialOrder _<_ + isStrictPartialOrder = record + { isEquivalence = isEquivalence + ; irrefl = tri⇒irr compare + ; trans = trans + ; <-resp-≈ = trans∧tri⇒resp Eq.sym Eq.trans trans compare + } + + isDecStrictPartialOrder : IsDecStrictPartialOrder _<_ + isDecStrictPartialOrder = record + { isStrictPartialOrder = isStrictPartialOrder + ; _≟_ = _≟_ + ; _<?_ = _<?_ + } + + open IsStrictPartialOrder isStrictPartialOrder public + using (irrefl; asym; <-respʳ-≈; <-respˡ-≈; <-resp-≈) +\ No newline at end of file diff --git a/docs/Relation.Binary.html b/docs/Relation.Binary.html new file mode 100644 index 0000000..8e69597 --- /dev/null +++ b/docs/Relation.Binary.html @@ -0,0 +1,19 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of homogeneous binary relations +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Binary where + +------------------------------------------------------------------------ +-- Re-export various components of the binary relation hierarchy + +open import Relation.Binary.Core public +open import Relation.Binary.Definitions public +open import Relation.Binary.Structures public +open import Relation.Binary.Bundles public +\ No newline at end of file diff --git a/docs/Relation.Nullary.Decidable.Core.html b/docs/Relation.Nullary.Decidable.Core.html new file mode 100644 index 0000000..02f7a05 --- /dev/null +++ b/docs/Relation.Nullary.Decidable.Core.html @@ -0,0 +1,132 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Operations on and properties of decidable relations +-- +-- This file contains some core definitions which are re-exported by +-- Relation.Nullary.Decidable +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Nullary.Decidable.Core where + +open import Level using (Level; Lift) +open import Data.Bool.Base using (Bool; false; true; not; T) +open import Data.Unit.Base using (⊤) +open import Data.Empty +open import Data.Product +open import Function.Base + +open import Agda.Builtin.Equality +open import Relation.Nullary.Reflects +open import Relation.Nullary + +private + variable + p q : Level + P : Set p + Q : Set q + +-- `isYes` is a stricter version of `does`. The lack of computation means that +-- we can recover the proposition `P` from `isYes P?` by unification. This is +-- useful when we are using the decision procedure for proof automation. + +isYes : Dec P → Bool +isYes ( true because _) = true +isYes (false because _) = false + +isYes≗does : (P? : Dec P) → isYes P? ≡ does P? +isYes≗does ( true because _) = refl +isYes≗does (false because _) = refl + +-- The traditional name for isYes is ⌊_⌋, indicating the stripping of evidence. +⌊_⌋ = isYes + +isNo : Dec P → Bool +isNo = not ∘ isYes + +True : Dec P → Set +True Q = T (isYes Q) + +False : Dec P → Set +False Q = T (isNo Q) + +-- Gives a witness to the "truth". + +toWitness : {Q : Dec P} → True Q → P +toWitness {Q = true because [p]} _ = invert [p] +toWitness {Q = false because _ } () + +-- Establishes a "truth", given a witness. + +fromWitness : {Q : Dec P} → P → True Q +fromWitness {Q = true because _ } = const _ +fromWitness {Q = false because [¬p]} = invert [¬p] + +-- Variants for False. + +toWitnessFalse : {Q : Dec P} → False Q → ¬ P +toWitnessFalse {Q = true because _ } () +toWitnessFalse {Q = false because [¬p]} _ = invert [¬p] + +fromWitnessFalse : {Q : Dec P} → ¬ P → False Q +fromWitnessFalse {Q = true because [p]} = flip _$_ (invert [p]) +fromWitnessFalse {Q = false because _ } = const _ + +-- If a decision procedure returns "yes", then we can extract the +-- proof using from-yes. + +module _ {p} {P : Set p} where + + From-yes : Dec P → Set p + From-yes (true because _) = P + From-yes (false because _) = Lift p ⊤ + + from-yes : (p : Dec P) → From-yes p + from-yes (true because [p]) = invert [p] + from-yes (false because _ ) = _ + +-- If a decision procedure returns "no", then we can extract the proof +-- using from-no. + + From-no : Dec P → Set p + From-no (false because _) = ¬ P + From-no (true because _) = Lift p ⊤ + + from-no : (p : Dec P) → From-no p + from-no (false because [¬p]) = invert [¬p] + from-no (true because _ ) = _ + +------------------------------------------------------------------------ +-- Result of decidability + +dec-true : (p? : Dec P) → P → does p? ≡ true +dec-true (true because _ ) p = refl +dec-true (false because [¬p]) p = ⊥-elim (invert [¬p] p) + +dec-false : (p? : Dec P) → ¬ P → does p? ≡ false +dec-false (false because _ ) ¬p = refl +dec-false (true because [p]) ¬p = ⊥-elim (¬p (invert [p])) + +dec-yes : (p? : Dec P) → P → ∃ λ p′ → p? ≡ yes p′ +dec-yes p? p with dec-true p? p +dec-yes (yes p′) p | refl = p′ , refl + +dec-no : (p? : Dec P) → ¬ P → ∃ λ ¬p′ → p? ≡ no ¬p′ +dec-no p? ¬p with dec-false p? ¬p +dec-no (no ¬p′) ¬p | refl = ¬p′ , refl + +dec-yes-irr : (p? : Dec P) → Irrelevant P → (p : P) → p? ≡ yes p +dec-yes-irr p? irr p with dec-yes p? p +... | p′ , eq rewrite irr p p′ = eq + +------------------------------------------------------------------------ +-- Maps + +map′ : (P → Q) → (Q → P) → Dec P → Dec Q +does (map′ P→Q Q→P p?) = does p? +proof (map′ P→Q Q→P (true because [p])) = ofʸ (P→Q (invert [p])) +proof (map′ P→Q Q→P (false because [¬p])) = ofⁿ (invert [¬p] ∘ Q→P) +\ No newline at end of file diff --git a/docs/Relation.Nullary.Decidable.html b/docs/Relation.Nullary.Decidable.html new file mode 100644 index 0000000..6051f94 --- /dev/null +++ b/docs/Relation.Nullary.Decidable.html @@ -0,0 +1,65 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Operations on and properties of decidable relations +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Nullary.Decidable where + +open import Level using (Level) +open import Data.Bool.Base using (true; false) +open import Data.Empty using (⊥-elim) +open import Function.Base +open import Function.Equality using (_⟨$⟩_; module Π) +open import Function using (_↔_; mk↔′) +open import Function.Equivalence using (_⇔_; equivalence; module Equivalence) +open import Function.Injection using (Injection; module Injection) +open import Relation.Binary using (Setoid; module Setoid; Decidable) +open import Relation.Nullary +open import Relation.Nullary.Reflects using (invert) +open import Relation.Binary.PropositionalEquality using (cong′) + +private + variable + p q : Level + P : Set p + Q : Set q + +------------------------------------------------------------------------ +-- Re-exporting the core definitions + +open import Relation.Nullary.Decidable.Core public + +------------------------------------------------------------------------ +-- Maps + +map : P ⇔ Q → Dec P → Dec Q +map P⇔Q = map′ (to ⟨$⟩_) (from ⟨$⟩_) + where open Equivalence P⇔Q + +module _ {a₁ a₂ b₁ b₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} + (inj : Injection A B) + where + + open Injection inj + open Setoid A using () renaming (_≈_ to _≈A_) + open Setoid B using () renaming (_≈_ to _≈B_) + + -- If there is an injection from one setoid to another, and the + -- latter's equivalence relation is decidable, then the former's + -- equivalence relation is also decidable. + + via-injection : Decidable _≈B_ → Decidable _≈A_ + via-injection dec x y = + map′ injective (Π.cong to) (dec (to ⟨$⟩ x) (to ⟨$⟩ y)) + +------------------------------------------------------------------------ +-- A lemma relating True and Dec + +True-↔ : (dec : Dec P) → Irrelevant P → True dec ↔ P +True-↔ (true because [p]) irr = mk↔′ (λ _ → invert [p]) _ (irr (invert [p])) cong′ +True-↔ (false because ofⁿ ¬p) _ = mk↔′ (λ ()) (invert (ofⁿ ¬p)) (⊥-elim ∘ ¬p) λ () +\ No newline at end of file diff --git a/docs/Relation.Nullary.Negation.Core.html b/docs/Relation.Nullary.Negation.Core.html new file mode 100644 index 0000000..58a57b1 --- /dev/null +++ b/docs/Relation.Nullary.Negation.Core.html @@ -0,0 +1,98 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Core properties related to negation +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Nullary.Negation.Core where + +open import Data.Bool.Base using (not) +open import Data.Empty +open import Data.Product +open import Data.Sum.Base using (_⊎_; inj₁; inj₂) +open import Function.Base using (flip; _$_; _∘_; const) +open import Level +open import Relation.Nullary +open import Relation.Unary using (Pred) + +private + variable + a p q w : Level + A : Set a + P : Set p + Q : Set q + Whatever : Set w + +------------------------------------------------------------------------ +-- Uses of negation + +contradiction : P → ¬ P → Whatever +contradiction p ¬p = ⊥-elim (¬p p) + +contradiction₂ : P ⊎ Q → ¬ P → ¬ Q → Whatever +contradiction₂ (inj₁ p) ¬p ¬q = contradiction p ¬p +contradiction₂ (inj₂ q) ¬p ¬q = contradiction q ¬q + +contraposition : (P → Q) → ¬ Q → ¬ P +contraposition f ¬q p = contradiction (f p) ¬q + +-- Note also the following use of flip: + +private + note : (P → ¬ Q) → Q → ¬ P + note = flip + +-- If we can decide P, then we can decide its negation. + +¬-reflects : ∀ {b} → Reflects P b → Reflects (¬ P) (not b) +¬-reflects (ofʸ p) = ofⁿ (_$ p) +¬-reflects (ofⁿ ¬p) = ofʸ ¬p + +¬? : Dec P → Dec (¬ P) +does (¬? p?) = not (does p?) +proof (¬? p?) = ¬-reflects (proof p?) + +------------------------------------------------------------------------ +-- Quantifier juggling + +module _ {P : Pred A p} where + + ∃⟶¬∀¬ : ∃ P → ¬ (∀ x → ¬ P x) + ∃⟶¬∀¬ = flip uncurry + + ∀⟶¬∃¬ : (∀ x → P x) → ¬ ∃ λ x → ¬ P x + ∀⟶¬∃¬ ∀xPx (x , ¬Px) = ¬Px (∀xPx x) + + ¬∃⟶∀¬ : ¬ ∃ (λ x → P x) → ∀ x → ¬ P x + ¬∃⟶∀¬ = curry + + ∀¬⟶¬∃ : (∀ x → ¬ P x) → ¬ ∃ (λ x → P x) + ∀¬⟶¬∃ = uncurry + + ∃¬⟶¬∀ : ∃ (λ x → ¬ P x) → ¬ (∀ x → P x) + ∃¬⟶¬∀ = flip ∀⟶¬∃¬ + +------------------------------------------------------------------------ +-- Double-negation + +¬¬-map : (P → Q) → ¬ ¬ P → ¬ ¬ Q +¬¬-map f = contraposition (contraposition f) + +-- Stability under double-negation. + +Stable : Set p → Set p +Stable P = ¬ ¬ P → P + +-- Everything is stable in the double-negation monad. + +stable : ¬ ¬ Stable P +stable ¬[¬¬p→p] = ¬[¬¬p→p] (λ ¬¬p → ⊥-elim (¬¬p (¬[¬¬p→p] ∘ const))) + +-- Negated predicates are stable. + +negated-stable : Stable (¬ P) +negated-stable ¬¬¬P P = ¬¬¬P (λ ¬P → ¬P P) +\ No newline at end of file diff --git a/docs/Relation.Nullary.Negation.html b/docs/Relation.Nullary.Negation.html new file mode 100644 index 0000000..6f3a53b --- /dev/null +++ b/docs/Relation.Nullary.Negation.html @@ -0,0 +1,138 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties related to negation +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Nullary.Negation where + +open import Category.Monad +open import Data.Bool.Base using (Bool; false; true; if_then_else_; not) +open import Data.Empty +open import Data.Product as Prod +open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂; [_,_]) +open import Function +open import Level +open import Relation.Nullary +open import Relation.Nullary.Decidable +open import Relation.Unary + +private + variable + a p q r w : Level + A : Set a + P : Set p + Q : Set q + R : Set r + Whatever : Set w + +------------------------------------------------------------------------ +-- Re-export public definitions + +open import Relation.Nullary.Negation.Core public + +------------------------------------------------------------------------ +-- Other properties + +-- Decidable predicates are stable. + +decidable-stable : Dec P → Stable P +decidable-stable (yes p) ¬¬p = p +decidable-stable (no ¬p) ¬¬p = ⊥-elim (¬¬p ¬p) + +¬-drop-Dec : Dec (¬ ¬ P) → Dec (¬ P) +¬-drop-Dec ¬¬p? = map′ negated-stable contradiction (¬? ¬¬p?) + +-- Double-negation is a monad (if we assume that all elements of ¬ ¬ P +-- are equal). + +¬¬-Monad : RawMonad (λ (P : Set p) → ¬ ¬ P) +¬¬-Monad = record + { return = contradiction + ; _>>=_ = λ x f → negated-stable (¬¬-map f x) + } + +¬¬-push : ∀ {P : Set p} {Q : P → Set q} → + ¬ ¬ ((x : P) → Q x) → (x : P) → ¬ ¬ Q x +¬¬-push ¬¬P⟶Q P ¬Q = ¬¬P⟶Q (λ P⟶Q → ¬Q (P⟶Q P)) + +-- A double-negation-translated variant of excluded middle (or: every +-- nullary relation is decidable in the double-negation monad). + +excluded-middle : ¬ ¬ Dec P +excluded-middle ¬h = ¬h (no (λ p → ¬h (yes p))) + +-- If Whatever is instantiated with ¬ ¬ something, then this function +-- is call with current continuation in the double-negation monad, or, +-- if you will, a double-negation translation of Peirce's law. +-- +-- In order to prove ¬ ¬ P one can assume ¬ P and prove ⊥. However, +-- sometimes it is nice to avoid leaving the double-negation monad; in +-- that case this function can be used (with Whatever instantiated to +-- ⊥). + +call/cc : ((P → Whatever) → ¬ ¬ P) → ¬ ¬ P +call/cc hyp ¬p = hyp (λ p → ⊥-elim (¬p p)) ¬p + +-- The "independence of premise" rule, in the double-negation monad. +-- It is assumed that the index set (Q) is inhabited. + +independence-of-premise : ∀ {P : Set p} {Q : Set q} {R : Q → Set r} → + Q → (P → Σ Q R) → ¬ ¬ (Σ[ x ∈ Q ] (P → R x)) +independence-of-premise {P = P} q f = ¬¬-map helper excluded-middle + where + helper : Dec P → _ + helper (yes p) = Prod.map id const (f p) + helper (no ¬p) = (q , ⊥-elim ∘′ ¬p) + +-- The independence of premise rule for binary sums. + +independence-of-premise-⊎ : (P → Q ⊎ R) → ¬ ¬ ((P → Q) ⊎ (P → R)) +independence-of-premise-⊎ {P = P} f = ¬¬-map helper excluded-middle + where + helper : Dec P → _ + helper (yes p) = Sum.map const const (f p) + helper (no ¬p) = inj₁ (⊥-elim ∘′ ¬p) + +private + + -- Note that independence-of-premise-⊎ is a consequence of + -- independence-of-premise (for simplicity it is assumed that Q and + -- R have the same type here): + + corollary : {P : Set p} {Q R : Set q} → + (P → Q ⊎ R) → ¬ ¬ ((P → Q) ⊎ (P → R)) + corollary {P = P} {Q} {R} f = + ¬¬-map helper (independence-of-premise + true ([ _,_ true , _,_ false ] ∘′ f)) + where + helper : ∃ (λ b → P → if b then Q else R) → (P → Q) ⊎ (P → R) + helper (true , f) = inj₁ f + helper (false , f) = inj₂ f + + +------------------------------------------------------------------------ +-- DEPRECATED NAMES +------------------------------------------------------------------------ +-- Please use the new names as continuing support for the old names is +-- not guaranteed. + +-- Version 1.0 + +Excluded-Middle : (ℓ : Level) → Set (suc ℓ) +Excluded-Middle p = {P : Set p} → Dec P +{-# WARNING_ON_USAGE Excluded-Middle +"Warning: Excluded-Middle was deprecated in v1.0. +Please use ExcludedMiddle from `Axiom.ExcludedMiddle` instead." +#-} + +Double-Negation-Elimination : (ℓ : Level) → Set (suc ℓ) +Double-Negation-Elimination p = {P : Set p} → Stable P +{-# WARNING_ON_USAGE Double-Negation-Elimination +"Warning: Double-Negation-Elimination was deprecated in v1.0. +Please use DoubleNegationElimination from `Axiom.DoubleNegationElimination` instead." +#-} +\ No newline at end of file diff --git a/docs/Relation.Nullary.Product.html b/docs/Relation.Nullary.Product.html new file mode 100644 index 0000000..8a94a72 --- /dev/null +++ b/docs/Relation.Nullary.Product.html @@ -0,0 +1,39 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Products of nullary relations +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Nullary.Product where + +open import Data.Bool.Base +open import Data.Product +open import Function.Base using (_∘_) +open import Level +open import Relation.Nullary.Reflects +open import Relation.Nullary + +private + variable + p q : Level + P : Set p + Q : Set q + +------------------------------------------------------------------------ +-- Some properties which are preserved by _×_. + +infixr 2 _×-reflects_ _×-dec_ + +_×-reflects_ : ∀ {bp bq} → Reflects P bp → Reflects Q bq → + Reflects (P × Q) (bp ∧ bq) +ofʸ p ×-reflects ofʸ q = ofʸ (p , q) +ofʸ p ×-reflects ofⁿ ¬q = ofⁿ (¬q ∘ proj₂) +ofⁿ ¬p ×-reflects _ = ofⁿ (¬p ∘ proj₁) + +_×-dec_ : Dec P → Dec Q → Dec (P × Q) +does (p? ×-dec q?) = does p? ∧ does q? +proof (p? ×-dec q?) = proof p? ×-reflects proof q? +\ No newline at end of file diff --git a/docs/Relation.Nullary.Reflects.html b/docs/Relation.Nullary.Reflects.html new file mode 100644 index 0000000..46f134c --- /dev/null +++ b/docs/Relation.Nullary.Reflects.html @@ -0,0 +1,53 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of the `Reflects` construct +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Nullary.Reflects where + +open import Agda.Builtin.Equality +open import Data.Bool.Base +open import Data.Empty +open import Level +open import Relation.Nullary + +private + variable + p : Level + P : Set p + +------------------------------------------------------------------------ +-- `Reflects P b` is equivalent to `if b then P else ¬ P`. + +-- These lemmas are intended to be used mostly when `b` is a value, so +-- that the `if` expressions have already been evaluated away. +-- In this case, `of` works like the relevant constructor (`ofⁿ` or +-- `ofʸ`), and `invert` strips off the constructor to just give either +-- the proof of `P` or the proof of `¬ P`. + +of : ∀ {b} → if b then P else ¬ P → Reflects P b +of {b = false} ¬p = ofⁿ ¬p +of {b = true } p = ofʸ p + +invert : ∀ {b} → Reflects P b → if b then P else ¬ P +invert (ofʸ p) = p +invert (ofⁿ ¬p) = ¬p + +------------------------------------------------------------------------ +-- Other lemmas + +fromEquivalence : ∀ {b} → (T b → P) → (P → T b) → Reflects P b +fromEquivalence {b = true} sound complete = ofʸ (sound _) +fromEquivalence {b = false} sound complete = ofⁿ complete + +-- `Reflects` is deterministic. +det : ∀ {b b′} → Reflects P b → Reflects P b′ → b ≡ b′ +det (ofʸ p) (ofʸ p′) = refl +det (ofʸ p) (ofⁿ ¬p′) = ⊥-elim (¬p′ p) +det (ofⁿ ¬p) (ofʸ p′) = ⊥-elim (¬p p′) +det (ofⁿ ¬p) (ofⁿ ¬p′) = refl +\ No newline at end of file diff --git a/docs/Relation.Nullary.Sum.html b/docs/Relation.Nullary.Sum.html new file mode 100644 index 0000000..1da0048 --- /dev/null +++ b/docs/Relation.Nullary.Sum.html @@ -0,0 +1,42 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Sums of nullary relations +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Nullary.Sum where + +open import Data.Bool.Base +open import Data.Sum.Base +open import Data.Empty +open import Level +open import Relation.Nullary.Reflects +open import Relation.Nullary + +private + variable + p q : Level + P : Set p + Q : Set q + +------------------------------------------------------------------------ +-- Some properties which are preserved by _⊎_. + +infixr 1 _¬-⊎_ _⊎-reflects_ _⊎-dec_ + +_¬-⊎_ : ¬ P → ¬ Q → ¬ (P ⊎ Q) +_¬-⊎_ = [_,_] + +_⊎-reflects_ : ∀ {bp bq} → Reflects P bp → Reflects Q bq → + Reflects (P ⊎ Q) (bp ∨ bq) +ofʸ p ⊎-reflects _ = ofʸ (inj₁ p) +ofⁿ ¬p ⊎-reflects ofʸ q = ofʸ (inj₂ q) +ofⁿ ¬p ⊎-reflects ofⁿ ¬q = ofⁿ (¬p ¬-⊎ ¬q) + +_⊎-dec_ : Dec P → Dec Q → Dec (P ⊎ Q) +does (p? ⊎-dec q?) = does p? ∨ does q? +proof (p? ⊎-dec q?) = proof p? ⊎-reflects proof q? +\ No newline at end of file diff --git a/docs/Relation.Nullary.html b/docs/Relation.Nullary.html new file mode 100644 index 0000000..374c30b --- /dev/null +++ b/docs/Relation.Nullary.html @@ -0,0 +1,72 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Operations on nullary relations (like negation and decidability) +------------------------------------------------------------------------ + +-- Some operations on/properties of nullary relations, i.e. sets. + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Nullary where + +open import Agda.Builtin.Equality +open import Agda.Builtin.Bool + +open import Data.Empty hiding (⊥-elim) +open import Data.Empty.Irrelevant +open import Level + +------------------------------------------------------------------------ +-- Negation. + +infix 3 ¬_ +infix 2 _because_ + +¬_ : ∀ {ℓ} → Set ℓ → Set ℓ +¬ P = P → ⊥ + +------------------------------------------------------------------------ +-- `Reflects` idiom. + +-- The truth value of P is reflected by a boolean value. + +data Reflects {p} (P : Set p) : Bool → Set p where + ofʸ : ( p : P) → Reflects P true + ofⁿ : (¬p : ¬ P) → Reflects P false + +------------------------------------------------------------------------ +-- Decidability. + +-- Decidability proofs have two parts: the `does` term which contains +-- the boolean result and the `proof` term which contains a proof that +-- reflects the boolean result. This definition allows the boolean +-- part of the decision procedure to compute independently from the +-- proof. This leads to better computational behaviour when we only care +-- about the result and not the proof. See README.Decidability for +-- further details. + +record Dec {p} (P : Set p) : Set p where + constructor _because_ + field + does : Bool + proof : Reflects P does + +open Dec public + +pattern yes p = true because ofʸ p +pattern no ¬p = false because ofⁿ ¬p + +-- Given an irrelevant proof of a decidable type, a proof can +-- be recomputed and subsequently used in relevant contexts. +recompute : ∀ {a} {A : Set a} → Dec A → .A → A +recompute (yes x) _ = x +recompute (no ¬p) x = ⊥-elim (¬p x) + +------------------------------------------------------------------------ +-- Irrelevant types + +Irrelevant : ∀ {p} → Set p → Set p +Irrelevant P = ∀ (p₁ p₂ : P) → p₁ ≡ p₂ +\ No newline at end of file diff --git a/docs/Relation.Unary.Properties.html b/docs/Relation.Unary.Properties.html new file mode 100644 index 0000000..eccda4f --- /dev/null +++ b/docs/Relation.Unary.Properties.html @@ -0,0 +1,102 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Properties of constructions over unary relations +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Unary.Properties where + +open import Data.Product using (_×_; _,_; swap; proj₁) +open import Data.Sum.Base using (inj₁; inj₂) +open import Data.Unit.Base using (tt) +open import Level +open import Relation.Binary.Core +open import Relation.Binary.Definitions hiding (Decidable; Universal) +open import Relation.Unary +open import Relation.Nullary using (yes; no) +open import Relation.Nullary.Product using (_×-dec_) +open import Relation.Nullary.Sum using (_⊎-dec_) +open import Relation.Nullary.Negation.Core using (¬?) +open import Function.Base using (_$_; _∘_) + +private + variable + a b ℓ ℓ₁ ℓ₂ : Level + A : Set a + B : Set b + +---------------------------------------------------------------------- +-- The empty set + +∅? : Decidable {A = A} ∅ +∅? _ = no λ() + +∅-Empty : Empty {A = A} ∅ +∅-Empty x () + +∁∅-Universal : Universal {A = A} (∁ ∅) +∁∅-Universal = λ x x∈∅ → x∈∅ + +---------------------------------------------------------------------- +-- The universe + +U? : Decidable {A = A} U +U? _ = yes tt + +U-Universal : Universal {A = A} U +U-Universal = λ _ → _ + +∁U-Empty : Empty {A = A} (∁ U) +∁U-Empty = λ x x∈∁U → x∈∁U _ + +---------------------------------------------------------------------- +-- Subset properties + +∅-⊆ : (P : Pred A ℓ) → ∅ ⊆ P +∅-⊆ P () + +⊆-U : (P : Pred A ℓ) → P ⊆ U +⊆-U P _ = _ + +⊆-refl : Reflexive (_⊆_ {A = A} {ℓ}) +⊆-refl x∈P = x∈P + +⊆-trans : Transitive (_⊆_ {A = A} {ℓ}) +⊆-trans P⊆Q Q⊆R x∈P = Q⊆R (P⊆Q x∈P) + +⊂-asym : Asymmetric (_⊂_ {A = A} {ℓ}) +⊂-asym (_ , Q⊈P) = Q⊈P ∘ proj₁ + +---------------------------------------------------------------------- +-- Decidability properties + +∁? : {P : Pred A ℓ} → Decidable P → Decidable (∁ P) +∁? P? x = ¬? (P? x) + +_∪?_ : {P : Pred A ℓ₁} {Q : Pred A ℓ₂} → + Decidable P → Decidable Q → Decidable (P ∪ Q) +_∪?_ P? Q? x = (P? x) ⊎-dec (Q? x) + +_∩?_ : {P : Pred A ℓ₁} {Q : Pred A ℓ₂} → + Decidable P → Decidable Q → Decidable (P ∩ Q) +_∩?_ P? Q? x = (P? x) ×-dec (Q? x) + +_×?_ : {P : Pred A ℓ₁} {Q : Pred B ℓ₂} → + Decidable P → Decidable Q → Decidable (P ⟨×⟩ Q) +_×?_ P? Q? (a , b) = (P? a) ×-dec (Q? b) + +_⊙?_ : {P : Pred A ℓ₁} {Q : Pred B ℓ₂} → + Decidable P → Decidable Q → Decidable (P ⟨⊙⟩ Q) +_⊙?_ P? Q? (a , b) = (P? a) ⊎-dec (Q? b) + +_⊎?_ : {P : Pred A ℓ} {Q : Pred B ℓ} → + Decidable P → Decidable Q → Decidable (P ⟨⊎⟩ Q) +_⊎?_ P? Q? (inj₁ a) = P? a +_⊎?_ P? Q? (inj₂ b) = Q? b + +_~? : {P : Pred (A × B) ℓ} → Decidable P → Decidable (P ~) +_~? P? = P? ∘ swap +\ No newline at end of file diff --git a/docs/Relation.Unary.html b/docs/Relation.Unary.html new file mode 100644 index 0000000..dadabb7 --- /dev/null +++ b/docs/Relation.Unary.html @@ -0,0 +1,299 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Unary relations +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Relation.Unary where + +open import Data.Empty +open import Data.Unit.Base using (⊤) +open import Data.Product +open import Data.Sum.Base using (_⊎_; [_,_]) +open import Function.Base +open import Level +open import Relation.Nullary hiding (Irrelevant) +open import Relation.Nullary.Decidable.Core using (True) +open import Relation.Binary.PropositionalEquality.Core using (_≡_) + +private + variable + a b c ℓ ℓ₁ ℓ₂ : Level + A : Set a + B : Set b + C : Set c + +------------------------------------------------------------------------ +-- Definition + +-- Unary relations are known as predicates and `Pred A ℓ` can be viewed +-- as some property that elements of type A might satisfy. + +-- Consequently `P : Pred A ℓ` can also be seen as a subset of A +-- containing all the elements of A that satisfy property P. This view +-- informs much of the notation used below. + +Pred : ∀ {a} → Set a → (ℓ : Level) → Set (a ⊔ suc ℓ) +Pred A ℓ = A → Set ℓ + +------------------------------------------------------------------------ +-- Special sets + +-- The empty set. + +∅ : Pred A 0ℓ +∅ = λ _ → ⊥ + +-- The singleton set. + +｛_｝ : A → Pred A _ +｛ x ｝ = x ≡_ + +-- The universal set. + +U : Pred A 0ℓ +U = λ _ → ⊤ + +------------------------------------------------------------------------ +-- Membership + +infix 4 _∈_ _∉_ + +_∈_ : A → Pred A ℓ → Set _ +x ∈ P = P x + +_∉_ : A → Pred A ℓ → Set _ +x ∉ P = ¬ x ∈ P + +------------------------------------------------------------------------ +-- Subset relations + +infix 4 _⊆_ _⊇_ _⊈_ _⊉_ _⊂_ _⊃_ _⊄_ _⊅_ + +_⊆_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊆ Q = ∀ {x} → x ∈ P → x ∈ Q + +_⊇_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊇ Q = Q ⊆ P + +_⊈_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊈ Q = ¬ (P ⊆ Q) + +_⊉_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊉ Q = ¬ (P ⊇ Q) + +_⊂_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊂ Q = P ⊆ Q × Q ⊈ P + +_⊃_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊃ Q = Q ⊂ P + +_⊄_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊄ Q = ¬ (P ⊂ Q) + +_⊅_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊅ Q = ¬ (P ⊃ Q) + +-- The following primed variants of _⊆_ can be used when 'x' can't +-- be inferred from 'x ∈ P'. + +infix 4 _⊆′_ _⊇′_ _⊈′_ _⊉′_ _⊂′_ _⊃′_ _⊄′_ _⊅′_ + +_⊆′_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊆′ Q = ∀ x → x ∈ P → x ∈ Q + +_⊇′_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +Q ⊇′ P = P ⊆′ Q + +_⊈′_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊈′ Q = ¬ (P ⊆′ Q) + +_⊉′_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊉′ Q = ¬ (P ⊇′ Q) + +_⊂′_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊂′ Q = P ⊆′ Q × Q ⊈′ P + +_⊃′_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊃′ Q = Q ⊂′ P + +_⊄′_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊄′ Q = ¬ (P ⊂′ Q) + +_⊅′_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ⊅′ Q = ¬ (P ⊃′ Q) + +------------------------------------------------------------------------ +-- Properties of sets + +infix 10 Satisfiable Universal IUniversal + +-- Emptiness - no element satisfies P. + +Empty : Pred A ℓ → Set _ +Empty P = ∀ x → x ∉ P + +-- Satisfiable - at least one element satisfies P. + +Satisfiable : Pred A ℓ → Set _ +Satisfiable P = ∃ λ x → x ∈ P + +syntax Satisfiable P = ∃⟨ P ⟩ + +-- Universality - all elements satisfy P. + +Universal : Pred A ℓ → Set _ +Universal P = ∀ x → x ∈ P + +syntax Universal P = Π[ P ] + +-- Implicit universality - all elements satisfy P. + +IUniversal : Pred A ℓ → Set _ +IUniversal P = ∀ {x} → x ∈ P + +syntax IUniversal P = ∀[ P ] + +-- Decidability - it is possible to determine if an arbitrary element +-- satisfies P. + +Decidable : Pred A ℓ → Set _ +Decidable P = ∀ x → Dec (P x) + +-- Erasure: A decidable predicate gives rise to another one, more +-- amenable to η-expansion + +⌊_⌋ : {P : Pred A ℓ} → Decidable P → Pred A ℓ +⌊ P? ⌋ a = Lift _ (True (P? a)) + +-- Irrelevance - any two proofs that an element satifies P are +-- indistinguishable. + +Irrelevant : Pred A ℓ → Set _ +Irrelevant P = ∀ {x} (a : P x) (b : P x) → a ≡ b + +-- Recomputability - we can rebuild a relevant proof given an +-- irrelevant one. + +Recomputable : Pred A ℓ → Set _ +Recomputable P = ∀ {x} → .(P x) → P x + +------------------------------------------------------------------------ +-- Operations on sets + +infix 10 ⋃ ⋂ +infixr 9 _⊢_ +infixr 8 _⇒_ +infixr 7 _∩_ +infixr 6 _∪_ +infix 4 _≬_ + +-- Complement. + +∁ : Pred A ℓ → Pred A ℓ +∁ P = λ x → x ∉ P + +-- Implication. + +_⇒_ : Pred A ℓ₁ → Pred A ℓ₂ → Pred A _ +P ⇒ Q = λ x → x ∈ P → x ∈ Q + +-- Union. + +_∪_ : Pred A ℓ₁ → Pred A ℓ₂ → Pred A _ +P ∪ Q = λ x → x ∈ P ⊎ x ∈ Q + +-- Intersection. + +_∩_ : Pred A ℓ₁ → Pred A ℓ₂ → Pred A _ +P ∩ Q = λ x → x ∈ P × x ∈ Q + +-- Infinitary union. + +⋃ : ∀ {i} (I : Set i) → (I → Pred A ℓ) → Pred A _ +⋃ I P = λ x → Σ[ i ∈ I ] P i x + +syntax ⋃ I (λ i → P) = ⋃[ i ∶ I ] P + +-- Infinitary intersection. + +⋂ : ∀ {i} (I : Set i) → (I → Pred A ℓ) → Pred A _ +⋂ I P = λ x → (i : I) → P i x + +syntax ⋂ I (λ i → P) = ⋂[ i ∶ I ] P + +-- Positive version of non-disjointness, dual to inclusion. + +_≬_ : Pred A ℓ₁ → Pred A ℓ₂ → Set _ +P ≬ Q = ∃ λ x → x ∈ P × x ∈ Q + +-- Update. + +_⊢_ : (A → B) → Pred B ℓ → Pred A ℓ +f ⊢ P = λ x → P (f x) + +------------------------------------------------------------------------ +-- Predicate combinators + +-- These differ from the set operations above, as the carrier set of the +-- resulting predicates are not the same as the carrier set of the +-- component predicates. + +infixr 2 _⟨×⟩_ +infixr 2 _⟨⊙⟩_ +infixr 1 _⟨⊎⟩_ +infixr 0 _⟨→⟩_ +infixl 9 _⟨·⟩_ +infix 10 _~ +infixr 9 _⟨∘⟩_ +infixr 2 _//_ _\\_ + +-- Product. + +_⟨×⟩_ : Pred A ℓ₁ → Pred B ℓ₂ → Pred (A × B) _ +(P ⟨×⟩ Q) (x , y) = x ∈ P × y ∈ Q + +-- Sum over one element. + +_⟨⊎⟩_ : Pred A ℓ → Pred B ℓ → Pred (A ⊎ B) _ +P ⟨⊎⟩ Q = [ P , Q ] + +-- Sum over two elements. + +_⟨⊙⟩_ : Pred A ℓ₁ → Pred B ℓ₂ → Pred (A × B) _ +(P ⟨⊙⟩ Q) (x , y) = x ∈ P ⊎ y ∈ Q + +-- Implication. + +_⟨→⟩_ : Pred A ℓ₁ → Pred B ℓ₂ → Pred (A → B) _ +(P ⟨→⟩ Q) f = P ⊆ Q ∘ f + +-- Product. + +_⟨·⟩_ : (P : Pred A ℓ₁) (Q : Pred B ℓ₂) → + (P ⟨×⟩ (P ⟨→⟩ Q)) ⊆ Q ∘ uncurry (flip _$_) +(P ⟨·⟩ Q) (p , f) = f p + +-- Converse. + +_~ : Pred (A × B) ℓ → Pred (B × A) ℓ +P ~ = P ∘ swap + +-- Composition. + +_⟨∘⟩_ : Pred (A × B) ℓ₁ → Pred (B × C) ℓ₂ → Pred (A × C) _ +(P ⟨∘⟩ Q) (x , z) = ∃ λ y → (x , y) ∈ P × (y , z) ∈ Q + +-- Post-division. + +_//_ : Pred (A × C) ℓ₁ → Pred (B × C) ℓ₂ → Pred (A × B) _ +(P // Q) (x , y) = Q ∘ (y ,_) ⊆ P ∘ (x ,_) + +-- Pre-division. + +_\\_ : Pred (A × C) ℓ₁ → Pred (A × B) ℓ₂ → Pred (B × C) _ +P \\ Q = (P ~ // Q ~) ~ +\ No newline at end of file diff --git a/docs/Strict.html b/docs/Strict.html new file mode 100644 index 0000000..577b795 --- /dev/null +++ b/docs/Strict.html @@ -0,0 +1,33 @@ + +
------------------------------------------------------------------------ +-- The Agda standard library +-- +-- Strictness combinators +------------------------------------------------------------------------ + +{-# OPTIONS --cubical-compatible --safe #-} + +module Strict where + +open import Level +open import Agda.Builtin.Equality + +open import Agda.Builtin.Strict + renaming ( primForce to force + ; primForceLemma to force-≡) public + +-- Derived combinators +module _ {ℓ ℓ′ : Level} {A : Set ℓ} {B : Set ℓ′} where + + force′ : A → (A → B) → B + force′ = force + + force′-≡ : (a : A) (f : A → B) → force′ a f ≡ f a + force′-≡ = force-≡ + + seq : A → B → B + seq a b = force a (λ _ → b) + + seq-≡ : (a : A) (b : B) → seq a b ≡ b + seq-≡ a b = force-≡ a (λ _ → b) +\ No newline at end of file diff --git a/docs/_config.yml b/docs/_config.yml deleted file mode 100644 index 4db2edd..0000000 --- a/docs/_config.yml +++ /dev/null @@ -1,53 +0,0 @@ -# Welcome to Jekyll! -# -# This config file is meant for settings that affect your whole blog, values -# which you are expected to set up once and rarely edit after that. If you find -# yourself editing this file very often, consider using Jekyll's data files -# feature for the data you need to update frequently. -# -# For technical reasons, this file is *NOT* reloaded automatically when you use -# 'bundle exec jekyll serve'. If you change this file, please restart the server process. -# -# If you need help with YAML syntax, here are some quick references for you: -# https://learn-the-web.algonquindesign.ca/topics/markdown-yaml-cheat-sheet/#yaml -# https://learnxinyminutes.com/docs/yaml/ -# -# Site settings -# These are used to personalize your new site. If you look in the HTML files, -# you will see them accessed via {{ site.title }}, {{ site.email }}, and so on. -# You can create any custom variable you would like, and they will be accessible -# in the templates via {{ site.myvariable }}. - -title: Agda Clones -email: gjzigaran@gmail.com -description: >- # this means to ignore newlines until "baseurl:" - Formalizing the clone theory in type theory and Agda -baseurl: "" # the subpath of your site, e.g. /blog -url: "" # the base hostname & protocol for your site, e.g. http://example.com -github_username: gonzigaran - -# Build settings -theme: minima -plugins: - - jekyll-feed - -# Exclude from processing. -# The following items will not be processed, by default. -# Any item listed under the `exclude:` key here will be automatically added to -# the internal "default list". -# -# Excluded items can be processed by explicitly listing the directories or -# their entries' file path in the `include:` list. -# -exclude: - - "*.agdai" - - .sass-cache/ -# - .jekyll-cache/ -# - gemfiles/ -# - Gemfile -# - Gemfile.lock -# - node_modules/ -# - vendor/bundle/ -# - vendor/cache/ -# - vendor/gems/ -# - vendor/ruby/ diff --git a/docs/index.html b/docs/index.html new file mode 100644 index 0000000..c08506b --- /dev/null +++ b/docs/index.html @@ -0,0 +1,11 @@ + + + + + +