------------------------------------------------------------------------
-- The Agda standard library
--
-- Properties of a min operator derived from a spec over a total order.
------------------------------------------------------------------------

{-# OPTIONS --without-K --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)   

Generated from commit 2fd14c996b195ef101dff8919e837907ca0a08aa.