------------------------------------------------------------------------ -- 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.Core using (Rel) open import Relation.Binary.Bundles using (Setoid) open import Relation.Binary.Definitions using (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.Base using (_,_) open import Function.Base using (_$_; id; _∘_) open import Function.Definitions 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 ------------------------------------------------------------------------ -- MiddleFourExchange module _ {_∙_ : Op₂ A} (cong : Congruent₂ _∙_) where comm∧assoc⇒middleFour : Commutative _∙_ Associative _∙_ _∙_ MiddleFourExchange _∙_ comm∧assoc⇒middleFour comm assoc w x y z = begin (w x) (y z) ≈⟨ assoc w x (y z) w (x (y z)) ≈⟨ cong refl (sym (assoc x y z)) w ((x y) z) ≈⟨ cong refl (cong (comm x y) refl) w ((y x) z) ≈⟨ cong refl (assoc y x z) w (y (x z)) ≈⟨ sym (assoc w y (x z)) (w y) (x z) identity∧middleFour⇒assoc : {e : A} Identity e _∙_ _∙_ MiddleFourExchange _∙_ Associative _∙_ identity∧middleFour⇒assoc {e} (identityˡ , identityʳ) middleFour x y z = begin (x y) z ≈⟨ cong refl (sym (identityˡ z)) (x y) (e z) ≈⟨ middleFour x y e z (x e) (y z) ≈⟨ cong (identityʳ x) refl x (y z) identity∧middleFour⇒comm : {_+_ : Op₂ A} {e : A} Identity e _+_ _∙_ MiddleFourExchange _+_ Commutative _∙_ identity∧middleFour⇒comm {_+_} {e} (identityˡ , identityʳ) middleFour x y = begin x y ≈⟨ sym (cong (identityˡ x) (identityʳ y)) (e + x) (y + e) ≈⟨ middleFour e x y e (e + y) (x + e) ≈⟨ cong (identityˡ y) (identityʳ x) y x ------------------------------------------------------------------------ -- SelfInverse module _ {f : Op₁ A} (self : SelfInverse f) where selfInverse⇒involutive : Involutive f selfInverse⇒involutive = reflexive∧selfInverse⇒involutive _≈_ refl self selfInverse⇒congruent : Congruent _≈_ _≈_ f selfInverse⇒congruent {x} {y} x≈y = sym (self (begin f (f x) ≈⟨ selfInverse⇒involutive x x ≈⟨ x≈y y )) selfInverse⇒inverseᵇ : Inverseᵇ _≈_ _≈_ f f selfInverse⇒inverseᵇ = self sym , self sym selfInverse⇒surjective : Surjective _≈_ _≈_ f selfInverse⇒surjective y = f y , self sym selfInverse⇒injective : Injective _≈_ _≈_ f selfInverse⇒injective {x} {y} x≈y = begin x ≈⟨ self x≈y f (f y) ≈⟨ selfInverse⇒involutive y y selfInverse⇒bijective : Bijective _≈_ _≈_ f selfInverse⇒bijective = selfInverse⇒injective , selfInverse⇒surjective ------------------------------------------------------------------------ -- Magma-like structures module _ {_∙_ : Op₂ A} (comm : Commutative _∙_) where comm∧cancelˡ⇒cancelʳ : LeftCancellative _∙_ RightCancellative _∙_ comm∧cancelˡ⇒cancelʳ cancelˡ x y z eq = cancelˡ x y z $ 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ʳ x 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∧idˡ⇒id : LeftIdentity e _∙_ Identity e _∙_ comm∧idˡ⇒id idˡ = idˡ , comm∧idˡ⇒idʳ idˡ comm∧idʳ⇒id : RightIdentity e _∙_ Identity e _∙_ comm∧idʳ⇒id idʳ = comm∧idʳ⇒idˡ idʳ , idʳ 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∧zeˡ⇒ze : LeftZero e _∙_ Zero e _∙_ comm∧zeˡ⇒ze zeˡ = zeˡ , comm∧zeˡ⇒zeʳ zeˡ comm∧zeʳ⇒ze : RightZero e _∙_ Zero e _∙_ comm∧zeʳ⇒ze zeʳ = comm∧zeʳ⇒zeˡ zeʳ , zeʳ comm∧almostCancelˡ⇒almostCancelʳ : AlmostLeftCancellative e _∙_ AlmostRightCancellative e _∙_ comm∧almostCancelˡ⇒almostCancelʳ cancelˡ-nonZero x y z x≉e yx≈zx = cancelˡ-nonZero x 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 x 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 : LeftInverse e _⁻¹ _∙_ Inverse e _⁻¹ _∙_ comm∧invˡ⇒inv invˡ = invˡ , comm∧invˡ⇒invʳ invˡ comm∧invʳ⇒invˡ : RightInverse e _⁻¹ _∙_ LeftInverse e _⁻¹ _∙_ comm∧invʳ⇒invˡ invʳ x = begin (x ⁻¹) x ≈⟨ comm (x ⁻¹) x x (x ⁻¹) ≈⟨ invʳ x e comm∧invʳ⇒inv : RightInverse e _⁻¹ _∙_ Inverse e _⁻¹ _∙_ comm∧invʳ⇒inv invʳ = comm∧invʳ⇒invˡ invʳ , invʳ 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∧distrˡ⇒distr : _∙_ DistributesOverˡ _◦_ _∙_ DistributesOver _◦_ comm∧distrˡ⇒distr distrˡ = distrˡ , comm∧distrˡ⇒distrʳ distrˡ comm∧distrʳ⇒distr : _∙_ DistributesOverʳ _◦_ _∙_ DistributesOver _◦_ comm∧distrʳ⇒distr distrʳ = comm∧distrʳ⇒distrˡ distrʳ , distrʳ 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) module _ {_∙_ _◦_ : Op₂ A} (∙-cong : Congruent₂ _∙_) (∙-assoc : Associative _∙_) (◦-comm : Commutative _◦_) where distrib∧absorbs⇒distribˡ : _∙_ Absorbs _◦_ _◦_ Absorbs _∙_ _◦_ DistributesOver _∙_ _∙_ DistributesOverˡ _◦_ distrib∧absorbs⇒distribˡ ∙-absorbs-◦ ◦-absorbs-∙ (◦-distribˡ-∙ , ◦-distribʳ-∙) x y z = begin x (y z) ≈⟨ ∙-cong (∙-absorbs-◦ _ _) refl (x (x y)) (y z) ≈⟨ ∙-cong (∙-cong refl (◦-comm _ _)) refl (x (y x)) (y z) ≈⟨ ∙-assoc _ _ _ x ((y x) (y z)) ≈⟨ ∙-cong refl (◦-distribˡ-∙ _ _ _) x (y (x z)) ≈⟨ ∙-cong (◦-absorbs-∙ _ _) refl (x (x z)) (y (x z)) ≈⟨ ◦-distribʳ-∙ _ _ _ (x y) (x z) ------------------------------------------------------------------------ -- 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 ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 2.0 comm+assoc⇒middleFour = comm∧assoc⇒middleFour {-# WARNING_ON_USAGE comm+assoc⇒middleFour "Warning: comm+assoc⇒middleFour was deprecated in v2.0. Please use comm∧assoc⇒middleFour instead." #-} identity+middleFour⇒assoc = identity∧middleFour⇒assoc {-# WARNING_ON_USAGE identity+middleFour⇒assoc "Warning: identity+middleFour⇒assoc was deprecated in v2.0. Please use identity∧middleFour⇒assoc instead." #-} identity+middleFour⇒comm = identity∧middleFour⇒comm {-# WARNING_ON_USAGE identity+middleFour⇒comm "Warning: identity+middleFour⇒comm was deprecated in v2.0. Please use identity∧middleFour⇒comm instead." #-} comm+cancelˡ⇒cancelʳ = comm∧cancelˡ⇒cancelʳ {-# WARNING_ON_USAGE comm+cancelˡ⇒cancelʳ "Warning: comm+cancelˡ⇒cancelʳ was deprecated in v2.0. Please use comm∧cancelˡ⇒cancelʳ instead." #-} comm+cancelʳ⇒cancelˡ = comm∧cancelʳ⇒cancelˡ {-# WARNING_ON_USAGE comm+cancelʳ⇒cancelˡ "Warning: comm+cancelʳ⇒cancelˡ was deprecated in v2.0. Please use comm∧cancelʳ⇒cancelˡ instead." #-} comm+idˡ⇒idʳ = comm∧idˡ⇒idʳ {-# WARNING_ON_USAGE comm+idˡ⇒idʳ "Warning: comm+idˡ⇒idʳ was deprecated in v2.0. Please use comm∧idˡ⇒idʳ instead." #-} comm+idʳ⇒idˡ = comm∧idʳ⇒idˡ {-# WARNING_ON_USAGE comm+idʳ⇒idˡ "Warning: comm+idʳ⇒idˡ was deprecated in v2.0. Please use comm∧idʳ⇒idˡ instead." #-} comm+zeˡ⇒zeʳ = comm∧zeˡ⇒zeʳ {-# WARNING_ON_USAGE comm+zeˡ⇒zeʳ "Warning: comm+zeˡ⇒zeʳ was deprecated in v2.0. Please use comm∧zeˡ⇒zeʳ instead." #-} comm+zeʳ⇒zeˡ = comm∧zeʳ⇒zeˡ {-# WARNING_ON_USAGE comm+zeʳ⇒zeˡ "Warning: comm+zeʳ⇒zeˡ was deprecated in v2.0. Please use comm∧zeʳ⇒zeˡ instead." #-} comm+almostCancelˡ⇒almostCancelʳ = comm∧almostCancelˡ⇒almostCancelʳ {-# WARNING_ON_USAGE comm+almostCancelˡ⇒almostCancelʳ "Warning: comm+almostCancelˡ⇒almostCancelʳ was deprecated in v2.0. Please use comm∧almostCancelˡ⇒almostCancelʳ instead." #-} comm+almostCancelʳ⇒almostCancelˡ = comm∧almostCancelʳ⇒almostCancelˡ {-# WARNING_ON_USAGE comm+almostCancelʳ⇒almostCancelˡ "Warning: comm+almostCancelʳ⇒almostCancelˡ was deprecated in v2.0. Please use comm∧almostCancelʳ⇒almostCancelˡ instead." #-} comm+invˡ⇒invʳ = comm∧invˡ⇒invʳ {-# WARNING_ON_USAGE comm+invˡ⇒invʳ "Warning: comm+invˡ⇒invʳ was deprecated in v2.0. Please use comm∧invˡ⇒invʳ instead." #-} comm+invʳ⇒invˡ = comm∧invʳ⇒invˡ {-# WARNING_ON_USAGE comm+invʳ⇒invˡ "Warning: comm+invʳ⇒invˡ was deprecated in v2.0. Please use comm∧invʳ⇒invˡ instead." #-} comm+invˡ⇒inv = comm∧invˡ⇒inv {-# WARNING_ON_USAGE comm+invˡ⇒inv "Warning: comm+invˡ⇒inv was deprecated in v2.0. Please use comm∧invˡ⇒inv instead." #-} comm+invʳ⇒inv = comm∧invʳ⇒inv {-# WARNING_ON_USAGE comm+invʳ⇒inv "Warning: comm+invʳ⇒inv was deprecated in v2.0. Please use comm∧invʳ⇒inv instead." #-} comm+distrˡ⇒distrʳ = comm∧distrˡ⇒distrʳ {-# WARNING_ON_USAGE comm+distrˡ⇒distrʳ "Warning: comm+distrˡ⇒distrʳ was deprecated in v2.0. Please use comm∧distrˡ⇒distrʳ instead." #-} comm+distrʳ⇒distrˡ = comm∧distrʳ⇒distrˡ {-# WARNING_ON_USAGE comm+distrʳ⇒distrˡ "Warning: comm+distrʳ⇒distrˡ was deprecated in v2.0. Please use comm∧distrʳ⇒distrˡ instead." #-} assoc+distribʳ+idʳ+invʳ⇒zeˡ = assoc∧distribʳ∧idʳ∧invʳ⇒zeˡ {-# WARNING_ON_USAGE assoc+distribʳ+idʳ+invʳ⇒zeˡ "Warning: assoc+distribʳ+idʳ+invʳ⇒zeˡ was deprecated in v2.0. Please use assoc∧distribʳ∧idʳ∧invʳ⇒zeˡ instead." #-} assoc+distribˡ+idʳ+invʳ⇒zeʳ = assoc∧distribˡ∧idʳ∧invʳ⇒zeʳ {-# WARNING_ON_USAGE assoc+distribˡ+idʳ+invʳ⇒zeʳ "Warning: assoc+distribˡ+idʳ+invʳ⇒zeʳ was deprecated in v2.0. Please use assoc∧distribˡ∧idʳ∧invʳ⇒zeʳ instead." #-} assoc+id+invʳ⇒invˡ-unique = assoc∧id∧invʳ⇒invˡ-unique {-# WARNING_ON_USAGE assoc+id+invʳ⇒invˡ-unique "Warning: assoc+id+invʳ⇒invˡ-unique was deprecated in v2.0. Please use assoc∧id∧invʳ⇒invˡ-unique instead." #-} assoc+id+invˡ⇒invʳ-unique = assoc∧id∧invˡ⇒invʳ-unique {-# WARNING_ON_USAGE assoc+id+invˡ⇒invʳ-unique "Warning: assoc+id+invˡ⇒invʳ-unique was deprecated in v2.0. Please use assoc∧id∧invˡ⇒invʳ-unique instead." #-} subst+comm⇒sym = subst∧comm⇒sym {-# WARNING_ON_USAGE subst+comm⇒sym "Warning: subst+comm⇒sym was deprecated in v2.0. Please use subst∧comm⇒sym instead." #-}