diff --git a/ElgotAlgebra.agda b/ElgotAlgebra.agda index 3f90e72..cad0edd 100644 --- a/ElgotAlgebra.agda +++ b/ElgotAlgebra.agda @@ -14,7 +14,7 @@ private o β„“ e : Level -module _ {Cπ’ž : CocartesianCategory o β„“ e} where +module _ (Cπ’ž : CocartesianCategory o β„“ e) where open CocartesianCategory Cπ’ž renaming (U to π’ž; id to idC) --* @@ -103,171 +103,10 @@ module _ {Cπ’ž : CocartesianCategory o β„“ e} where [ (idC +₁ i₁) ∘ f , iβ‚‚ ∘ h ] ∘ [ i₁ , h ] ∎))) ⟩ ([ (idC +₁ i₁) ∘ f , iβ‚‚ ∘ iβ‚‚ ] ∘ [ i₁ , h ])# ∘ iβ‚‚ ∎ - -- divergence constant - βŠ₯β‚‘ : βŠ₯ β‡’ A - βŠ₯β‚‘ = iβ‚‚ # + -- every elgot-algebra comes with a divergence constant + !β‚‘ : βŠ₯ β‡’ A + !β‚‘ = iβ‚‚ # - --* - -- let's define the category of elgot-algebras - --* - - -- iteration preversing morphism between two elgot-algebras - module _ (E₁ Eβ‚‚ : Elgot-Algebra) where - open Elgot-Algebra E₁ renaming (_# to _#₁) - open Elgot-Algebra Eβ‚‚ renaming (_# to _#β‚‚; A to B) - record Elgot-Algebra-Morphism : Set (o βŠ” β„“ βŠ” e) where - field - h : A β‡’ B - preserves : βˆ€ {X} {f : X β‡’ A + X} β†’ h ∘ (f #₁) β‰ˆ ((h +₁ idC) ∘ f)#β‚‚ - - -- the category of elgot algebras for a given category - Elgot-Algebras : Category (o βŠ” β„“ βŠ” e) (o βŠ” β„“ βŠ” e) e - Elgot-Algebras = record - { Obj = Elgot-Algebra - ; _β‡’_ = Elgot-Algebra-Morphism - ; _β‰ˆ_ = Ξ» f g β†’ Elgot-Algebra-Morphism.h f β‰ˆ Elgot-Algebra-Morphism.h g - ; id = Ξ» {EB} β†’ let open Elgot-Algebra EB in - record { h = idC; preserves = Ξ» {X : Obj} {f : X β‡’ A + X} β†’ begin - idC ∘ f # β‰ˆβŸ¨ identityΛ‘ ⟩ - (f #) β‰ˆβŸ¨ sym $ #-resp-β‰ˆ identityΛ‘ ⟩ - ((idC ∘ f) #) β‰ˆβŸ¨ sym (#-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ +-Ξ·)) ⟩ - (([ i₁ , iβ‚‚ ] ∘ f)#) β‰ˆβŸ¨ sym $ #-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ ([]-congβ‚‚ identityΚ³ identityΚ³)) ⟩ - (([ i₁ ∘ idC , iβ‚‚ ∘ idC ] ∘ f)#) β‰ˆβŸ¨ sym $ #-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ []∘+₁) ⟩ - ((([ i₁ , iβ‚‚ ] ∘ (idC +₁ idC)) ∘ f)#) β‰ˆβŸ¨ #-resp-β‰ˆ assoc ⟩ - (([ i₁ , iβ‚‚ ] ∘ (idC +₁ idC) ∘ f)#) β‰ˆβŸ¨ #-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ +-Ξ·) ⟩ - ((idC ∘ (idC +₁ idC) ∘ f)#) β‰ˆβŸ¨ #-resp-β‰ˆ identityΛ‘ ⟩ - ((idC +₁ idC) ∘ f) # ∎ } - ; _∘_ = Ξ» {EA} {EB} {EC} f g β†’ let - open Elgot-Algebra-Morphism f renaming (h to hαΆ ; preserves to preservesαΆ ) - open Elgot-Algebra-Morphism g renaming (h to hᡍ; preserves to preservesᡍ) - open Elgot-Algebra EA using (A) renaming (_# to _#ᡃ) - open Elgot-Algebra EB using () renaming (_# to _#ᡇ; A to B) - open Elgot-Algebra EC using () renaming (_# to _#ᢜ; A to C; #-resp-β‰ˆ to #ᢜ-resp-β‰ˆ) - in record { h = hαΆ  ∘ hᡍ; preserves = Ξ» {X} {f : X β‡’ A + X} β†’ begin - (hαΆ  ∘ hᡍ) ∘ (f #ᡃ) β‰ˆβŸ¨ assoc ⟩ - (hαΆ  ∘ hᡍ ∘ (f #ᡃ)) β‰ˆβŸ¨ ∘-resp-β‰ˆΚ³ preservesᡍ ⟩ - (hαΆ  ∘ (((hᡍ +₁ idC) ∘ f) #ᡇ)) β‰ˆβŸ¨ preservesαΆ  ⟩ - (((hαΆ  +₁ idC) ∘ (hᡍ +₁ idC) ∘ f) #ᢜ) β‰ˆβŸ¨ #ᢜ-resp-β‰ˆ sym-assoc ⟩ - ((((hαΆ  +₁ idC) ∘ (hᡍ +₁ idC)) ∘ f) #ᢜ) β‰ˆβŸ¨ #ᢜ-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁) ⟩ - ((((hαΆ  ∘ hᡍ) +₁ (idC ∘ idC)) ∘ f) #ᢜ) β‰ˆβŸ¨ #ᢜ-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ refl (identityΒ²))) ⟩ - ((hαΆ  ∘ hᡍ +₁ idC) ∘ f) #ᢜ ∎ } - ; identityΛ‘ = identityΛ‘ - ; identityΚ³ = identityΚ³ - ; identityΒ² = identityΒ² - ; assoc = assoc - ; sym-assoc = sym-assoc - ; equiv = record - { refl = refl - ; sym = sym - ; trans = trans} - ; ∘-resp-β‰ˆ = ∘-resp-β‰ˆ - } - where - open Elgot-Algebra-Morphism - open HomReasoning - open Equiv - - --* - -- products and exponentials of elgot-algebras - --* - - -- if the carriers of the algebra form a product, so do the algebras - Product-Elgot-Algebra : βˆ€ {EA EB : Elgot-Algebra} β†’ Product π’ž (Elgot-Algebra.A EA) (Elgot-Algebra.A EB) β†’ Elgot-Algebra - Product-Elgot-Algebra {EA} {EB} p = record - { A = AΓ—B - ; _# = Ξ» {X : Obj} (h : X β‡’ AΓ—B + X) β†’ ⟨ ((π₁ +₁ idC) ∘ h)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ h)#ᡇ ⟩ - ; #-Fixpoint = Ξ» {X} {f} β†’ begin - ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ β‰ˆβŸ¨ ⟨⟩-congβ‚‚ #ᡃ-Fixpoint #ᡇ-Fixpoint ⟩ - ⟨ [ idC , ((π₁ +₁ idC) ∘ f)#ᡃ ] ∘ ((π₁ +₁ idC) ∘ f) , [ idC , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ] ∘ ((Ο€β‚‚ +₁ idC) ∘ f) ⟩ β‰ˆβŸ¨ ⟨⟩-congβ‚‚ sym-assoc sym-assoc ⟩ - ⟨ ([ idC , ((π₁ +₁ idC) ∘ f)#ᡃ ] ∘ (π₁ +₁ idC)) ∘ f , ([ idC , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ] ∘ (Ο€β‚‚ +₁ idC)) ∘ f ⟩ β‰ˆβŸ¨ ⟨⟩-congβ‚‚ (∘-resp-β‰ˆΛ‘ []∘+₁) (∘-resp-β‰ˆΛ‘ []∘+₁) ⟩ - ⟨ [ idC ∘ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ∘ idC ] ∘ f , [ idC ∘ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ∘ idC ] ∘ f ⟩ β‰ˆβŸ¨ sym ∘-distribΚ³-⟨⟩ ⟩ - (⟨ [ idC ∘ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ∘ idC ] , [ idC ∘ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ∘ idC ] ⟩ ∘ f) β‰ˆβŸ¨ ∘-resp-β‰ˆΛ‘ (uniqueβ€² - (begin - π₁ ∘ ⟨ [ idC ∘ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ∘ idC ] , [ idC ∘ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ∘ idC ] ⟩ β‰ˆβŸ¨ project₁ ⟩ - [ idC ∘ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ∘ idC ] β‰ˆβŸ¨ []-congβ‚‚ identityΛ‘ identityΚ³ ⟩ - [ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ] β‰ˆβŸ¨ sym ([]-congβ‚‚ identityΚ³ project₁) ⟩ - [ π₁ ∘ idC , π₁ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ ] β‰ˆβŸ¨ sym ∘[] ⟩ - π₁ ∘ [ idC , ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ ] ∎) - (begin - Ο€β‚‚ ∘ ⟨ [ idC ∘ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ∘ idC ] , [ idC ∘ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ∘ idC ] ⟩ β‰ˆβŸ¨ projectβ‚‚ ⟩ - [ idC ∘ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ∘ idC ] β‰ˆβŸ¨ []-congβ‚‚ identityΛ‘ identityΚ³ ⟩ - [ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ] β‰ˆβŸ¨ sym ([]-congβ‚‚ identityΚ³ projectβ‚‚) ⟩ - [ Ο€β‚‚ ∘ idC , Ο€β‚‚ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ ] β‰ˆβŸ¨ sym ∘[] ⟩ - Ο€β‚‚ ∘ [ idC , ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ ] ∎) )⟩ - ([ idC , ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ ] ∘ f) ∎ - ; #-Uniformity = Ξ» {X Y f g h} uni β†’ uniqueβ€² ( - begin - π₁ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ β‰ˆβŸ¨ project₁ ⟩ - (((π₁ +₁ idC) ∘ f)#ᡃ) β‰ˆβŸ¨ #ᡃ-Uniformity ( - begin - (idC +₁ h) ∘ (π₁ +₁ idC) ∘ f β‰ˆβŸ¨ sym-assoc ⟩ - ((idC +₁ h) ∘ (π₁ +₁ idC)) ∘ f β‰ˆβŸ¨ ∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁ ⟩ - (idC ∘ π₁ +₁ h ∘ idC) ∘ f β‰ˆβŸ¨ ∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΛ‘ identityΚ³) ⟩ - ((π₁ +₁ h) ∘ f) β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΚ³ identityΛ‘)) ⟩ - (((π₁ ∘ idC +₁ idC ∘ h)) ∘ f) β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁) ⟩ - ((π₁ +₁ idC) ∘ (idC +₁ h)) ∘ f β‰ˆβŸ¨ assoc ⟩ - (π₁ +₁ idC) ∘ ((idC +₁ h) ∘ f) β‰ˆβŸ¨ ∘-resp-β‰ˆΚ³ uni ⟩ - (π₁ +₁ idC) ∘ g ∘ h β‰ˆβŸ¨ sym-assoc ⟩ - ((π₁ +₁ idC) ∘ g) ∘ h ∎ - )⟩ - (((π₁ +₁ idC) ∘ g)#ᡃ ∘ h) β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ project₁) ⟩ - ((π₁ ∘ ⟨ ((π₁ +₁ idC) ∘ g)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ g)#ᡇ ⟩) ∘ h) β‰ˆβŸ¨ assoc ⟩ - π₁ ∘ ⟨ ((π₁ +₁ idC) ∘ g)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ g)#ᡇ ⟩ ∘ h ∎ - ) ( - begin - Ο€β‚‚ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ β‰ˆβŸ¨ projectβ‚‚ ⟩ - ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ β‰ˆβŸ¨ #ᡇ-Uniformity ( - begin - (idC +₁ h) ∘ (Ο€β‚‚ +₁ idC) ∘ f β‰ˆβŸ¨ sym-assoc ⟩ - (((idC +₁ h) ∘ (Ο€β‚‚ +₁ idC)) ∘ f) β‰ˆβŸ¨ ∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁ ⟩ - ((idC ∘ Ο€β‚‚ +₁ h ∘ idC) ∘ f) β‰ˆβŸ¨ ∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΛ‘ identityΚ³) ⟩ - ((Ο€β‚‚ +₁ h) ∘ f) β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΚ³ identityΛ‘)) ⟩ - ((((Ο€β‚‚ ∘ idC +₁ idC ∘ h)) ∘ f)) β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁) ⟩ - ((Ο€β‚‚ +₁ idC) ∘ ((idC +₁ h))) ∘ f β‰ˆβŸ¨ assoc ⟩ - (Ο€β‚‚ +₁ idC) ∘ ((idC +₁ h)) ∘ f β‰ˆβŸ¨ ∘-resp-β‰ˆΚ³ uni ⟩ - (Ο€β‚‚ +₁ idC) ∘ g ∘ h β‰ˆβŸ¨ sym-assoc ⟩ - ((Ο€β‚‚ +₁ idC) ∘ g) ∘ h ∎ - )⟩ - ((Ο€β‚‚ +₁ idC) ∘ g)#ᡇ ∘ h β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ projectβ‚‚) ⟩ - ((Ο€β‚‚ ∘ ⟨ ((π₁ +₁ idC) ∘ g)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ g)#ᡇ ⟩) ∘ h) β‰ˆβŸ¨ assoc ⟩ - Ο€β‚‚ ∘ ⟨ ((π₁ +₁ idC) ∘ g)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ g)#ᡇ ⟩ ∘ h ∎ - ) - ; #-Folding = Ξ» {X} {Y} {f} {h} β†’ ⟨⟩-congβ‚‚ (foldingΛ‘ {X} {Y}) (foldingΚ³ {X} {Y}) - ; #-resp-β‰ˆ = Ξ» fg β†’ ⟨⟩-congβ‚‚ (#ᡃ-resp-β‰ˆ (∘-resp-β‰ˆΚ³ fg)) (#ᡇ-resp-β‰ˆ (∘-resp-β‰ˆΚ³ fg)) - } - where - open Elgot-Algebra EA using (A) renaming (_# to _#ᡃ; #-Fixpoint to #ᡃ-Fixpoint; #-Uniformity to #ᡃ-Uniformity; #-Folding to #ᡃ-Folding; #-resp-β‰ˆ to #ᡃ-resp-β‰ˆ) - open Elgot-Algebra EB using () renaming (A to B; _# to _#ᡇ; #-Fixpoint to #ᡇ-Fixpoint; #-Uniformity to #ᡇ-Uniformity; #-Folding to #ᡇ-Folding; #-resp-β‰ˆ to #ᡇ-resp-β‰ˆ) - open Product π’ž p - open HomReasoning - open Equiv - foldingΛ‘ : βˆ€ {X} {Y} {f} {h} β†’ (((π₁ +₁ idC) ∘ (⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ h))#ᡃ) β‰ˆ ((π₁ +₁ idC) ∘ [ (idC +₁ i₁) ∘ f , iβ‚‚ ∘ h ])#ᡃ - foldingΛ‘ {X} {Y} {f} {h} = begin - ((π₁ +₁ idC) ∘ (⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ h))#ᡃ β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ +β‚βˆ˜+₁ ⟩ - ((π₁ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ idC ∘ h)#ᡃ) β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ (+₁-congβ‚‚ project₁ identityΛ‘) ⟩ - ((((π₁ +₁ idC) ∘ f)#ᡃ +₁ h)#ᡃ) β‰ˆβŸ¨ #ᡃ-Folding ⟩ - ([ (idC +₁ i₁) ∘ ((π₁ +₁ idC) ∘ f) , iβ‚‚ ∘ h ] #ᡃ) β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ ([]-congΚ³ sym-assoc) ⟩ - ([ ((idC +₁ i₁) ∘ (π₁ +₁ idC)) ∘ f , iβ‚‚ ∘ h ] #ᡃ) β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ ([]-congΚ³ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁)) ⟩ - ([ ((idC ∘ π₁ +₁ i₁ ∘ idC)) ∘ f , iβ‚‚ ∘ h ] #ᡃ) β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ ([]-congΚ³ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΛ‘ identityΚ³))) ⟩ - ([ ((π₁ +₁ i₁)) ∘ f , iβ‚‚ ∘ h ] #ᡃ) β‰ˆβŸ¨ sym (#ᡃ-resp-β‰ˆ ([]-congβ‚‚ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΚ³ identityΛ‘)) (∘-resp-β‰ˆΛ‘ identityΚ³))) ⟩ - (([ (π₁ ∘ idC +₁ idC ∘ i₁) ∘ f , (iβ‚‚ ∘ idC) ∘ h ])#ᡃ) β‰ˆβŸ¨ sym (#ᡃ-resp-β‰ˆ ([]-congβ‚‚ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁) (∘-resp-β‰ˆΛ‘ +β‚βˆ˜iβ‚‚))) ⟩ - (([ ((π₁ +₁ idC) ∘ (idC +₁ i₁)) ∘ f , ((π₁ +₁ idC) ∘ iβ‚‚) ∘ h ])#ᡃ) β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ ([]-congβ‚‚ assoc assoc) ⟩ - (([ (π₁ +₁ idC) ∘ (idC +₁ i₁) ∘ f , (π₁ +₁ idC) ∘ iβ‚‚ ∘ h ])#ᡃ) β‰ˆβŸ¨ sym (#ᡃ-resp-β‰ˆ ∘[]) ⟩ - ((π₁ +₁ idC) ∘ [ (idC +₁ i₁) ∘ f , iβ‚‚ ∘ h ])#ᡃ ∎ - foldingΚ³ : βˆ€ {X} {Y} {f} {h} β†’ ((Ο€β‚‚ +₁ idC) ∘ (⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ h))#ᡇ β‰ˆ ((Ο€β‚‚ +₁ idC) ∘ [ (idC +₁ i₁) ∘ f , iβ‚‚ ∘ h ])#ᡇ - foldingΚ³ {X} {Y} {f} {h} = begin - ((Ο€β‚‚ +₁ idC) ∘ (⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ h))#ᡇ β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ +β‚βˆ˜+₁ ⟩ - ((Ο€β‚‚ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ idC ∘ h)#ᡇ) β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ (+₁-congβ‚‚ projectβ‚‚ identityΛ‘) ⟩ - ((((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ +₁ h)#ᡇ) β‰ˆβŸ¨ #ᡇ-Folding ⟩ - [ (idC +₁ i₁) ∘ ((Ο€β‚‚ +₁ idC) ∘ f) , iβ‚‚ ∘ h ] #ᡇ β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ ([]-congΚ³ sym-assoc) ⟩ - ([ ((idC +₁ i₁) ∘ (Ο€β‚‚ +₁ idC)) ∘ f , iβ‚‚ ∘ h ] #ᡇ) β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ ([]-congΚ³ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁)) ⟩ - ([ ((idC ∘ Ο€β‚‚ +₁ i₁ ∘ idC)) ∘ f , iβ‚‚ ∘ h ] #ᡇ) β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ ([]-congΚ³ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΛ‘ identityΚ³))) ⟩ - ([ ((Ο€β‚‚ +₁ i₁)) ∘ f , iβ‚‚ ∘ h ] #ᡇ) β‰ˆβŸ¨ sym (#ᡇ-resp-β‰ˆ ([]-congβ‚‚ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΚ³ identityΛ‘)) (∘-resp-β‰ˆΛ‘ identityΚ³))) ⟩ - (([ (Ο€β‚‚ ∘ idC +₁ idC ∘ i₁) ∘ f , (iβ‚‚ ∘ idC) ∘ h ])#ᡇ) β‰ˆβŸ¨ sym (#ᡇ-resp-β‰ˆ ([]-congβ‚‚ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁) (∘-resp-β‰ˆΛ‘ +β‚βˆ˜iβ‚‚))) ⟩ - (([ ((Ο€β‚‚ +₁ idC) ∘ (idC +₁ i₁)) ∘ f , ((Ο€β‚‚ +₁ idC) ∘ iβ‚‚) ∘ h ])#ᡇ) β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ ([]-congβ‚‚ assoc assoc) ⟩ - (([ (Ο€β‚‚ +₁ idC) ∘ (idC +₁ i₁) ∘ f , (Ο€β‚‚ +₁ idC) ∘ iβ‚‚ ∘ h ])#ᡇ) β‰ˆβŸ¨ sym (#ᡇ-resp-β‰ˆ ∘[]) ⟩ - ((Ο€β‚‚ +₁ idC) ∘ [ (idC +₁ i₁) ∘ f , iβ‚‚ ∘ h ])#ᡇ ∎ - --* -- Here follows the proof of equivalence for unguarded and Id-guarded Elgot-Algebras --* diff --git a/ElgotAlgebras.agda b/ElgotAlgebras.agda new file mode 100644 index 0000000..d5daf7b --- /dev/null +++ b/ElgotAlgebras.agda @@ -0,0 +1,242 @@ +open import Level renaming (suc to β„“-suc) +open import Function using (_$_) renaming (id to idf; _∘_ to _∘ᢠ_) +open import Data.Product using (_,_) renaming (_Γ—_ to _∧_) + +open import Categories.Category.Cocartesian.Bundle using (CocartesianCategory) +open import Categories.Category.Cartesian +open import Categories.Functor renaming (id to idF) +open import Categories.Functor.Algebra +open import Categories.Object.Terminal +open import Categories.Object.Product +open import Categories.Object.Coproduct +open import Categories.Category.BinaryProducts +open import Categories.Category +open import ElgotAlgebra + +module ElgotAlgebras where + +private + variable + o β„“ e : Level + +module _ (CC : CocartesianCategory o β„“ e) where + open CocartesianCategory CC renaming (U to C; id to idC) + + --* + -- let's define the category of elgot-algebras + --* + + -- iteration preversing morphism between two elgot-algebras + module _ (E₁ Eβ‚‚ : Elgot-Algebra CC) where + open Elgot-Algebra E₁ renaming (_# to _#₁) + open Elgot-Algebra Eβ‚‚ renaming (_# to _#β‚‚; A to B) + record Elgot-Algebra-Morphism : Set (o βŠ” β„“ βŠ” e) where + field + h : A β‡’ B + preserves : βˆ€ {X} {f : X β‡’ A + X} β†’ h ∘ (f #₁) β‰ˆ ((h +₁ idC) ∘ f)#β‚‚ + + -- the category of elgot algebras for a given (cocartesian-)category + Elgot-Algebras : Category (o βŠ” β„“ βŠ” e) (o βŠ” β„“ βŠ” e) e + Elgot-Algebras = record + { Obj = Elgot-Algebra CC + ; _β‡’_ = Elgot-Algebra-Morphism + ; _β‰ˆ_ = Ξ» f g β†’ Elgot-Algebra-Morphism.h f β‰ˆ Elgot-Algebra-Morphism.h g + ; id = Ξ» {EB} β†’ let open Elgot-Algebra EB in + record { h = idC; preserves = Ξ» {X : Obj} {f : X β‡’ A + X} β†’ begin + idC ∘ f # β‰ˆβŸ¨ identityΛ‘ ⟩ + (f #) β‰ˆβŸ¨ sym $ #-resp-β‰ˆ identityΛ‘ ⟩ + ((idC ∘ f) #) β‰ˆβŸ¨ sym (#-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ +-Ξ·)) ⟩ + (([ i₁ , iβ‚‚ ] ∘ f)#) β‰ˆβŸ¨ sym $ #-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ ([]-congβ‚‚ identityΚ³ identityΚ³)) ⟩ + (([ i₁ ∘ idC , iβ‚‚ ∘ idC ] ∘ f)#) β‰ˆβŸ¨ sym $ #-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ []∘+₁) ⟩ + ((([ i₁ , iβ‚‚ ] ∘ (idC +₁ idC)) ∘ f)#) β‰ˆβŸ¨ #-resp-β‰ˆ assoc ⟩ + (([ i₁ , iβ‚‚ ] ∘ (idC +₁ idC) ∘ f)#) β‰ˆβŸ¨ #-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ +-Ξ·) ⟩ + ((idC ∘ (idC +₁ idC) ∘ f)#) β‰ˆβŸ¨ #-resp-β‰ˆ identityΛ‘ ⟩ + ((idC +₁ idC) ∘ f) # ∎ } + ; _∘_ = Ξ» {EA} {EB} {EC} f g β†’ let + open Elgot-Algebra-Morphism f renaming (h to hαΆ ; preserves to preservesαΆ ) + open Elgot-Algebra-Morphism g renaming (h to hᡍ; preserves to preservesᡍ) + open Elgot-Algebra EA using (A) renaming (_# to _#ᡃ) + open Elgot-Algebra EB using () renaming (_# to _#ᡇ; A to B) + open Elgot-Algebra EC using () renaming (_# to _#ᢜ; A to C; #-resp-β‰ˆ to #ᢜ-resp-β‰ˆ) + in record { h = hαΆ  ∘ hᡍ; preserves = Ξ» {X} {f : X β‡’ A + X} β†’ begin + (hαΆ  ∘ hᡍ) ∘ (f #ᡃ) β‰ˆβŸ¨ assoc ⟩ + (hαΆ  ∘ hᡍ ∘ (f #ᡃ)) β‰ˆβŸ¨ ∘-resp-β‰ˆΚ³ preservesᡍ ⟩ + (hαΆ  ∘ (((hᡍ +₁ idC) ∘ f) #ᡇ)) β‰ˆβŸ¨ preservesαΆ  ⟩ + (((hαΆ  +₁ idC) ∘ (hᡍ +₁ idC) ∘ f) #ᢜ) β‰ˆβŸ¨ #ᢜ-resp-β‰ˆ sym-assoc ⟩ + ((((hαΆ  +₁ idC) ∘ (hᡍ +₁ idC)) ∘ f) #ᢜ) β‰ˆβŸ¨ #ᢜ-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁) ⟩ + ((((hαΆ  ∘ hᡍ) +₁ (idC ∘ idC)) ∘ f) #ᢜ) β‰ˆβŸ¨ #ᢜ-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ refl (identityΒ²))) ⟩ + ((hαΆ  ∘ hᡍ +₁ idC) ∘ f) #ᢜ ∎ } + ; identityΛ‘ = identityΛ‘ + ; identityΚ³ = identityΚ³ + ; identityΒ² = identityΒ² + ; assoc = assoc + ; sym-assoc = sym-assoc + ; equiv = record + { refl = refl + ; sym = sym + ; trans = trans} + ; ∘-resp-β‰ˆ = ∘-resp-β‰ˆ + } + where + open Elgot-Algebra-Morphism + open HomReasoning + open Equiv + + --* + -- products and exponentials of elgot-algebras + --* + + -- if the carrier contains a terminal, so does elgot-algebras + Terminal-Elgot-Algebras : Terminal C β†’ Terminal Elgot-Algebras + Terminal-Elgot-Algebras T = record { + ⊀ = record + { A = ⊀ + ; _# = Ξ» x β†’ ! + ; #-Fixpoint = Ξ» {_ f} β†’ !-unique ([ idC , ! ] ∘ f) + ; #-Uniformity = Ξ» {_ _ _ _ h} _ β†’ !-unique (! ∘ h) + ; #-Folding = refl + ; #-resp-β‰ˆ = Ξ» _ β†’ refl + } ; + ⊀-is-terminal = record + { ! = Ξ» {A} β†’ record { h = ! ; preserves = Ξ» {X} {f} β†’ sym (!-unique (! ∘ (A Elgot-Algebra.#) f)) } + ; !-unique = Ξ» {A} f β†’ !-unique (Elgot-Algebra-Morphism.h f) } } + where + open Terminal T + open Equiv + + -- if the carriers of the algebra form a product, so do the algebras + AΓ—B-Helper : βˆ€ {EA EB : Elgot-Algebra CC} β†’ Product C (Elgot-Algebra.A EA) (Elgot-Algebra.A EB) β†’ Elgot-Algebra CC + AΓ—B-Helper {EA} {EB} p = record + { A = AΓ—B + ; _# = Ξ» {X : Obj} (h : X β‡’ AΓ—B + X) β†’ ⟨ ((π₁ +₁ idC) ∘ h)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ h)#ᡇ ⟩ + ; #-Fixpoint = Ξ» {X} {f} β†’ begin + ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ β‰ˆβŸ¨ ⟨⟩-congβ‚‚ #ᡃ-Fixpoint #ᡇ-Fixpoint ⟩ + ⟨ [ idC , ((π₁ +₁ idC) ∘ f)#ᡃ ] ∘ ((π₁ +₁ idC) ∘ f) , [ idC , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ] ∘ ((Ο€β‚‚ +₁ idC) ∘ f) ⟩ β‰ˆβŸ¨ ⟨⟩-congβ‚‚ sym-assoc sym-assoc ⟩ + ⟨ ([ idC , ((π₁ +₁ idC) ∘ f)#ᡃ ] ∘ (π₁ +₁ idC)) ∘ f , ([ idC , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ] ∘ (Ο€β‚‚ +₁ idC)) ∘ f ⟩ β‰ˆβŸ¨ ⟨⟩-congβ‚‚ (∘-resp-β‰ˆΛ‘ []∘+₁) (∘-resp-β‰ˆΛ‘ []∘+₁) ⟩ + ⟨ [ idC ∘ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ∘ idC ] ∘ f , [ idC ∘ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ∘ idC ] ∘ f ⟩ β‰ˆβŸ¨ sym ∘-distribΚ³-⟨⟩ ⟩ + (⟨ [ idC ∘ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ∘ idC ] , [ idC ∘ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ∘ idC ] ⟩ ∘ f) β‰ˆβŸ¨ ∘-resp-β‰ˆΛ‘ (uniqueβ€² + (begin + π₁ ∘ ⟨ [ idC ∘ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ∘ idC ] , [ idC ∘ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ∘ idC ] ⟩ β‰ˆβŸ¨ project₁ ⟩ + [ idC ∘ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ∘ idC ] β‰ˆβŸ¨ []-congβ‚‚ identityΛ‘ identityΚ³ ⟩ + [ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ] β‰ˆβŸ¨ sym ([]-congβ‚‚ identityΚ³ project₁) ⟩ + [ π₁ ∘ idC , π₁ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ ] β‰ˆβŸ¨ sym ∘[] ⟩ + π₁ ∘ [ idC , ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ ] ∎) + (begin + Ο€β‚‚ ∘ ⟨ [ idC ∘ π₁ , ((π₁ +₁ idC) ∘ f)#ᡃ ∘ idC ] , [ idC ∘ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ∘ idC ] ⟩ β‰ˆβŸ¨ projectβ‚‚ ⟩ + [ idC ∘ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ∘ idC ] β‰ˆβŸ¨ []-congβ‚‚ identityΛ‘ identityΚ³ ⟩ + [ Ο€β‚‚ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ] β‰ˆβŸ¨ sym ([]-congβ‚‚ identityΚ³ projectβ‚‚) ⟩ + [ Ο€β‚‚ ∘ idC , Ο€β‚‚ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ ] β‰ˆβŸ¨ sym ∘[] ⟩ + Ο€β‚‚ ∘ [ idC , ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ ] ∎) )⟩ + ([ idC , ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ ] ∘ f) ∎ + ; #-Uniformity = Ξ» {X Y f g h} uni β†’ uniqueβ€² ( + begin + π₁ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ β‰ˆβŸ¨ project₁ ⟩ + (((π₁ +₁ idC) ∘ f)#ᡃ) β‰ˆβŸ¨ #ᡃ-Uniformity ( + begin + (idC +₁ h) ∘ (π₁ +₁ idC) ∘ f β‰ˆβŸ¨ sym-assoc ⟩ + ((idC +₁ h) ∘ (π₁ +₁ idC)) ∘ f β‰ˆβŸ¨ ∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁ ⟩ + (idC ∘ π₁ +₁ h ∘ idC) ∘ f β‰ˆβŸ¨ ∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΛ‘ identityΚ³) ⟩ + ((π₁ +₁ h) ∘ f) β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΚ³ identityΛ‘)) ⟩ + (((π₁ ∘ idC +₁ idC ∘ h)) ∘ f) β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁) ⟩ + ((π₁ +₁ idC) ∘ (idC +₁ h)) ∘ f β‰ˆβŸ¨ assoc ⟩ + (π₁ +₁ idC) ∘ ((idC +₁ h) ∘ f) β‰ˆβŸ¨ ∘-resp-β‰ˆΚ³ uni ⟩ + (π₁ +₁ idC) ∘ g ∘ h β‰ˆβŸ¨ sym-assoc ⟩ + ((π₁ +₁ idC) ∘ g) ∘ h ∎ + )⟩ + (((π₁ +₁ idC) ∘ g)#ᡃ ∘ h) β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ project₁) ⟩ + ((π₁ ∘ ⟨ ((π₁ +₁ idC) ∘ g)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ g)#ᡇ ⟩) ∘ h) β‰ˆβŸ¨ assoc ⟩ + π₁ ∘ ⟨ ((π₁ +₁ idC) ∘ g)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ g)#ᡇ ⟩ ∘ h ∎ + ) ( + begin + Ο€β‚‚ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ β‰ˆβŸ¨ projectβ‚‚ ⟩ + ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ β‰ˆβŸ¨ #ᡇ-Uniformity ( + begin + (idC +₁ h) ∘ (Ο€β‚‚ +₁ idC) ∘ f β‰ˆβŸ¨ sym-assoc ⟩ + (((idC +₁ h) ∘ (Ο€β‚‚ +₁ idC)) ∘ f) β‰ˆβŸ¨ ∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁ ⟩ + ((idC ∘ Ο€β‚‚ +₁ h ∘ idC) ∘ f) β‰ˆβŸ¨ ∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΛ‘ identityΚ³) ⟩ + ((Ο€β‚‚ +₁ h) ∘ f) β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΚ³ identityΛ‘)) ⟩ + ((((Ο€β‚‚ ∘ idC +₁ idC ∘ h)) ∘ f)) β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁) ⟩ + ((Ο€β‚‚ +₁ idC) ∘ ((idC +₁ h))) ∘ f β‰ˆβŸ¨ assoc ⟩ + (Ο€β‚‚ +₁ idC) ∘ ((idC +₁ h)) ∘ f β‰ˆβŸ¨ ∘-resp-β‰ˆΚ³ uni ⟩ + (Ο€β‚‚ +₁ idC) ∘ g ∘ h β‰ˆβŸ¨ sym-assoc ⟩ + ((Ο€β‚‚ +₁ idC) ∘ g) ∘ h ∎ + )⟩ + ((Ο€β‚‚ +₁ idC) ∘ g)#ᡇ ∘ h β‰ˆβŸ¨ sym (∘-resp-β‰ˆΛ‘ projectβ‚‚) ⟩ + ((Ο€β‚‚ ∘ ⟨ ((π₁ +₁ idC) ∘ g)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ g)#ᡇ ⟩) ∘ h) β‰ˆβŸ¨ assoc ⟩ + Ο€β‚‚ ∘ ⟨ ((π₁ +₁ idC) ∘ g)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ g)#ᡇ ⟩ ∘ h ∎ + ) + ; #-Folding = Ξ» {X} {Y} {f} {h} β†’ ⟨⟩-congβ‚‚ (foldingΛ‘ {X} {Y}) (foldingΚ³ {X} {Y}) + ; #-resp-β‰ˆ = Ξ» fg β†’ ⟨⟩-congβ‚‚ (#ᡃ-resp-β‰ˆ (∘-resp-β‰ˆΚ³ fg)) (#ᡇ-resp-β‰ˆ (∘-resp-β‰ˆΚ³ fg)) + } + where + open Elgot-Algebra EA using (A) renaming (_# to _#ᡃ; #-Fixpoint to #ᡃ-Fixpoint; #-Uniformity to #ᡃ-Uniformity; #-Folding to #ᡃ-Folding; #-resp-β‰ˆ to #ᡃ-resp-β‰ˆ) + open Elgot-Algebra EB using () renaming (A to B; _# to _#ᡇ; #-Fixpoint to #ᡇ-Fixpoint; #-Uniformity to #ᡇ-Uniformity; #-Folding to #ᡇ-Folding; #-resp-β‰ˆ to #ᡇ-resp-β‰ˆ) + open Product C p + open HomReasoning + open Equiv + foldingΛ‘ : βˆ€ {X} {Y} {f} {h} β†’ (((π₁ +₁ idC) ∘ (⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ h))#ᡃ) β‰ˆ ((π₁ +₁ idC) ∘ [ (idC +₁ i₁) ∘ f , iβ‚‚ ∘ h ])#ᡃ + foldingΛ‘ {X} {Y} {f} {h} = begin + ((π₁ +₁ idC) ∘ (⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ h))#ᡃ β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ +β‚βˆ˜+₁ ⟩ + ((π₁ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ idC ∘ h)#ᡃ) β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ (+₁-congβ‚‚ project₁ identityΛ‘) ⟩ + ((((π₁ +₁ idC) ∘ f)#ᡃ +₁ h)#ᡃ) β‰ˆβŸ¨ #ᡃ-Folding ⟩ + ([ (idC +₁ i₁) ∘ ((π₁ +₁ idC) ∘ f) , iβ‚‚ ∘ h ] #ᡃ) β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ ([]-congΚ³ sym-assoc) ⟩ + ([ ((idC +₁ i₁) ∘ (π₁ +₁ idC)) ∘ f , iβ‚‚ ∘ h ] #ᡃ) β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ ([]-congΚ³ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁)) ⟩ + ([ ((idC ∘ π₁ +₁ i₁ ∘ idC)) ∘ f , iβ‚‚ ∘ h ] #ᡃ) β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ ([]-congΚ³ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΛ‘ identityΚ³))) ⟩ + ([ ((π₁ +₁ i₁)) ∘ f , iβ‚‚ ∘ h ] #ᡃ) β‰ˆβŸ¨ sym (#ᡃ-resp-β‰ˆ ([]-congβ‚‚ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΚ³ identityΛ‘)) (∘-resp-β‰ˆΛ‘ identityΚ³))) ⟩ + (([ (π₁ ∘ idC +₁ idC ∘ i₁) ∘ f , (iβ‚‚ ∘ idC) ∘ h ])#ᡃ) β‰ˆβŸ¨ sym (#ᡃ-resp-β‰ˆ ([]-congβ‚‚ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁) (∘-resp-β‰ˆΛ‘ +β‚βˆ˜iβ‚‚))) ⟩ + (([ ((π₁ +₁ idC) ∘ (idC +₁ i₁)) ∘ f , ((π₁ +₁ idC) ∘ iβ‚‚) ∘ h ])#ᡃ) β‰ˆβŸ¨ #ᡃ-resp-β‰ˆ ([]-congβ‚‚ assoc assoc) ⟩ + (([ (π₁ +₁ idC) ∘ (idC +₁ i₁) ∘ f , (π₁ +₁ idC) ∘ iβ‚‚ ∘ h ])#ᡃ) β‰ˆβŸ¨ sym (#ᡃ-resp-β‰ˆ ∘[]) ⟩ + ((π₁ +₁ idC) ∘ [ (idC +₁ i₁) ∘ f , iβ‚‚ ∘ h ])#ᡃ ∎ + foldingΚ³ : βˆ€ {X} {Y} {f} {h} β†’ ((Ο€β‚‚ +₁ idC) ∘ (⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ h))#ᡇ β‰ˆ ((Ο€β‚‚ +₁ idC) ∘ [ (idC +₁ i₁) ∘ f , iβ‚‚ ∘ h ])#ᡇ + foldingΚ³ {X} {Y} {f} {h} = begin + ((Ο€β‚‚ +₁ idC) ∘ (⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ h))#ᡇ β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ +β‚βˆ˜+₁ ⟩ + ((Ο€β‚‚ ∘ ⟨ ((π₁ +₁ idC) ∘ f)#ᡃ , ((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ ⟩ +₁ idC ∘ h)#ᡇ) β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ (+₁-congβ‚‚ projectβ‚‚ identityΛ‘) ⟩ + ((((Ο€β‚‚ +₁ idC) ∘ f)#ᡇ +₁ h)#ᡇ) β‰ˆβŸ¨ #ᡇ-Folding ⟩ + [ (idC +₁ i₁) ∘ ((Ο€β‚‚ +₁ idC) ∘ f) , iβ‚‚ ∘ h ] #ᡇ β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ ([]-congΚ³ sym-assoc) ⟩ + ([ ((idC +₁ i₁) ∘ (Ο€β‚‚ +₁ idC)) ∘ f , iβ‚‚ ∘ h ] #ᡇ) β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ ([]-congΚ³ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁)) ⟩ + ([ ((idC ∘ Ο€β‚‚ +₁ i₁ ∘ idC)) ∘ f , iβ‚‚ ∘ h ] #ᡇ) β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ ([]-congΚ³ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΛ‘ identityΚ³))) ⟩ + ([ ((Ο€β‚‚ +₁ i₁)) ∘ f , iβ‚‚ ∘ h ] #ᡇ) β‰ˆβŸ¨ sym (#ᡇ-resp-β‰ˆ ([]-congβ‚‚ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ identityΚ³ identityΛ‘)) (∘-resp-β‰ˆΛ‘ identityΚ³))) ⟩ + (([ (Ο€β‚‚ ∘ idC +₁ idC ∘ i₁) ∘ f , (iβ‚‚ ∘ idC) ∘ h ])#ᡇ) β‰ˆβŸ¨ sym (#ᡇ-resp-β‰ˆ ([]-congβ‚‚ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁) (∘-resp-β‰ˆΛ‘ +β‚βˆ˜iβ‚‚))) ⟩ + (([ ((Ο€β‚‚ +₁ idC) ∘ (idC +₁ i₁)) ∘ f , ((Ο€β‚‚ +₁ idC) ∘ iβ‚‚) ∘ h ])#ᡇ) β‰ˆβŸ¨ #ᡇ-resp-β‰ˆ ([]-congβ‚‚ assoc assoc) ⟩ + (([ (Ο€β‚‚ +₁ idC) ∘ (idC +₁ i₁) ∘ f , (Ο€β‚‚ +₁ idC) ∘ iβ‚‚ ∘ h ])#ᡇ) β‰ˆβŸ¨ sym (#ᡇ-resp-β‰ˆ ∘[]) ⟩ + ((Ο€β‚‚ +₁ idC) ∘ [ (idC +₁ i₁) ∘ f , iβ‚‚ ∘ h ])#ᡇ ∎ + + Product-Elgot-Algebras : βˆ€ (EA EB : Elgot-Algebra CC) β†’ Product C (Elgot-Algebra.A EA) (Elgot-Algebra.A EB) β†’ Product Elgot-Algebras EA EB + Product-Elgot-Algebras EA EB p = record + { AΓ—B = AΓ—B-Helper {EA} {EB} p + ; π₁ = record { h = π₁ ; preserves = Ξ» {X} {f} β†’ project₁ } + ; Ο€β‚‚ = record { h = Ο€β‚‚ ; preserves = Ξ» {X} {f} β†’ projectβ‚‚ } + ; ⟨_,_⟩ = Ξ» {E} f g β†’ let + open Elgot-Algebra-Morphism f renaming (h to fβ€²; preserves to preservesαΆ ) + open Elgot-Algebra-Morphism g renaming (h to gβ€²; preserves to preservesᡍ) + open Elgot-Algebra E renaming (_# to _#ᡉ) in record { h = ⟨ fβ€² , gβ€² ⟩ ; preserves = Ξ» {X} {h} β†’ + begin + ⟨ fβ€² , gβ€² ⟩ ∘ (h #ᡉ) β‰ˆβŸ¨ ∘-distribΚ³-⟨⟩ ⟩ + ⟨ fβ€² ∘ (h #ᡉ) , gβ€² ∘ (h #ᡉ) ⟩ β‰ˆβŸ¨ ⟨⟩-congβ‚‚ preservesαΆ  preservesᡍ ⟩ + ⟨ ((fβ€² +₁ idC) ∘ h) #ᡃ , ((gβ€² +₁ idC) ∘ h) #ᡇ ⟩ β‰ˆβŸ¨ sym (⟨⟩-congβ‚‚ (#ᡃ-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ project₁ identityΒ²))) (#ᡇ-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ (+₁-congβ‚‚ projectβ‚‚ identityΒ²)))) ⟩ + ⟨ ((π₁ ∘ ⟨ fβ€² , gβ€² ⟩ +₁ idC ∘ idC) ∘ h) #ᡃ , ((Ο€β‚‚ ∘ ⟨ fβ€² , gβ€² ⟩ +₁ idC ∘ idC) ∘ h) #ᡇ ⟩ β‰ˆβŸ¨ sym (⟨⟩-congβ‚‚ (#ᡃ-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁)) (#ᡇ-resp-β‰ˆ (∘-resp-β‰ˆΛ‘ +β‚βˆ˜+₁))) ⟩ + ⟨ (((π₁ +₁ idC) ∘ (⟨ fβ€² , gβ€² ⟩ +₁ idC)) ∘ h) #ᡃ , (((Ο€β‚‚ +₁ idC) ∘ (⟨ fβ€² , gβ€² ⟩ +₁ idC)) ∘ h) #ᡇ ⟩ β‰ˆβŸ¨ (⟨⟩-congβ‚‚ (#ᡃ-resp-β‰ˆ assoc) (#ᡇ-resp-β‰ˆ assoc)) ⟩ + ⟨ ((π₁ +₁ idC) ∘ (⟨ fβ€² , gβ€² ⟩ +₁ idC) ∘ h) #ᡃ , ((Ο€β‚‚ +₁ idC) ∘ (⟨ fβ€² , gβ€² ⟩ +₁ idC) ∘ h) #ᡇ ⟩ ∎ } + ; project₁ = project₁ + ; projectβ‚‚ = projectβ‚‚ + ; unique = unique + } + where + open Elgot-Algebra EA using (A) renaming (_# to _#ᡃ; #-Fixpoint to #ᡃ-Fixpoint; #-Uniformity to #ᡃ-Uniformity; #-Folding to #ᡃ-Folding; #-resp-β‰ˆ to #ᡃ-resp-β‰ˆ) + open Elgot-Algebra EB using () renaming (A to B; _# to _#ᡇ; #-Fixpoint to #ᡇ-Fixpoint; #-Uniformity to #ᡇ-Uniformity; #-Folding to #ᡇ-Folding; #-resp-β‰ˆ to #ᡇ-resp-β‰ˆ) + open Elgot-Algebra (AΓ—B-Helper {EA} {EB} p) using () renaming (_# to _#α΅–) + open Product C p + open HomReasoning + open Equiv + + + -- if the carrier is cartesian, so is the category of algebras + Cartesian-Elgot-Algebras : Cartesian C β†’ Cartesian Elgot-Algebras + Cartesian-Elgot-Algebras CaC = record { + terminal = Terminal-Elgot-Algebras terminal; + products = record { product = Ξ» {EA EB} β†’ Product-Elgot-Algebras EA EB product } + } + where + open Cartesian CaC using (terminal; products) + open BinaryProducts products using (product) + open Equiv \ No newline at end of file