diff --git a/src/Monad/Instance/K/Commutative.lagda.md b/src/Monad/Instance/K/Commutative.lagda.md index 5bed959..8d48f54 100644 --- a/src/Monad/Instance/K/Commutative.lagda.md +++ b/src/Monad/Instance/K/Commutative.lagda.md @@ -29,15 +29,15 @@ module Monad.Instance.K.Commutative {o ℓ e} (ambient : Ambient o ℓ e) (MK : # K is a commutative monad The proof is analogous to the ones for strength, this is the relevant diagram is: - - + + ```agda KCommutative : CommutativeMonad {C = C} {V = monoidal} symmetric KStrong KCommutative = record { commutes = commutes' } where open monadK using (μ) - open StrongMonad KStrong + open StrongMonad KStrong using (strengthen) open IsStableFreeUniformIterationAlgebra using (♯-law; ♯-preserving; ♯-unique) open Uniform-Iteration-Algebra using (#-Uniformity; #-Fixpoint; #-resp-≈) @@ -48,10 +48,19 @@ The proof is analogous to the ones for strength, this is the relevant diagram is σ : ∀ ((X , Y) : Obj ×f Obj) → K.₀ X × Y ⇒ K.₀ (X × Y) σ _ = K.₁ swap ∘ (τ _) ∘ swap + + σ-preserve : ∀ {X Y Z : Obj} (h : Z ⇒ K.₀ Y + Z) → σ (Y , X) ∘ (h # ⁂ idC) ≈ ((σ _ +₁ idC) ∘ distributeʳ⁻¹ ∘ (h ⁂ idC))# + {- + K.₁ swap ∘ τ ∘ swap ∘ (h # ⁂ idC) + ≈ K.₁ swap ∘ τ ∘ (idC ⁂ h #) ∘ swap + ≈ K.₁ swap ∘ ()# ∘ swap + ≈ ((K.₁ swap +₁ τ) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h))# ∘ swap + -} + σ-preserve {Z} h = {! !} commutes' : ∀ {X Y : Obj} → μ.η _ ∘ K.₁ (σ _) ∘ τ (K.₀ X , Y) ≈ μ.η _ ∘ K.₁ (τ _) ∘ σ _ commutes' {X} {Y} = begin μ.η _ ∘ K.₁ (σ _) ∘ τ _ ≈⟨ ♯-unique (stable _) (σ _) (μ.η (X × Y) ∘ K.₁ (σ _) ∘ τ _) comm₁ comm₂ ⟩ - (σ _) ♯ ≈⟨ sym (♯-unique (stable _) (σ _) (μ.η _ ∘ K.₁ (τ _) ∘ σ _) comm₃ {! !}) ⟩ + (σ _) ♯ ≈⟨ sym (♯-unique (stable _) (σ _) (μ.η _ ∘ K.₁ (τ _) ∘ σ _) comm₃ comm₄) ⟩ μ.η _ ∘ K.₁ (τ _) ∘ σ _ ∎ where comm₁ : σ _ ≈ (μ.η _ ∘ K.₁ (σ _) ∘ τ _) ∘ (idC ⁂ η _) @@ -71,14 +80,54 @@ The proof is analogous to the ones for strength, this is the relevant diagram is ((μ.η _ ∘ K.₁ (σ _) ∘ τ _ +₁ idC) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h))# ∎ comm₃ : σ _ ≈ (μ.η _ ∘ K.₁ (τ _) ∘ σ _) ∘ (idC ⁂ η _) comm₃ = sym (begin - -- idea use swap epi and K.₁ swap mono: - {- - K.₁ swap ∘ (μ.η _ ∘ K.₁ (K.₁ swap ∘ τ _) ∘ σ _) ∘ (idC ⁂ η _) ∘ swap - ≈ (μ.η _ ∘ K.₁ (σ _) ∘ (τ _)) ∘ (η _ ⁂ idC) - -} - (μ.η _ ∘ K.₁ (τ _) ∘ σ _) ∘ (idC ⁂ η _) ≈⟨ {! !} ⟩ - {! !} ≈⟨ {! !} ⟩ - {! !} ≈⟨ {! !} ⟩ - {! !} ≈⟨ {! !} ⟩ + (μ.η _ ∘ K.₁ (τ _) ∘ σ _) ∘ (idC ⁂ η _) ≈⟨ pullʳ (pullʳ (pullʳ (pullʳ swap∘⁂))) ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ K.₁ swap ∘ τ _ ∘ (η _ ⁂ idC) ∘ swap ≈⟨ refl⟩∘⟨ refl⟩∘⟨ refl⟩∘⟨ refl⟩∘⟨ ⁂-cong₂ refl (sym K.identity) ⟩∘⟨refl ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ K.₁ swap ∘ τ _ ∘ (η _ ⁂ K.₁ idC) ∘ swap ≈⟨ refl⟩∘⟨ refl⟩∘⟨ refl⟩∘⟨ pullˡ (strengthen.commute (η _ , idC)) ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ K.₁ swap ∘ (K.₁ (η _ ⁂ idC) ∘ τ _) ∘ swap ≈⟨ refl⟩∘⟨ refl⟩∘⟨ pullˡ (pullˡ (sym K.homomorphism)) ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ (K.₁ (swap ∘ (η _ ⁂ idC)) ∘ τ _) ∘ swap ≈⟨ refl⟩∘⟨ (pullˡ (pullˡ (sym K.homomorphism))) ⟩ + μ.η _ ∘ (K.₁ (τ _ ∘ swap ∘ (η _ ⁂ idC)) ∘ τ _) ∘ swap ≈⟨ refl⟩∘⟨ (((K.F-resp-≈ (refl⟩∘⟨ swap∘⁂)) ⟩∘⟨refl) ⟩∘⟨refl) ⟩ + μ.η _ ∘ (K.₁ (τ _ ∘ (idC ⁂ η _) ∘ swap) ∘ τ _) ∘ swap ≈⟨ refl⟩∘⟨ (K.F-resp-≈ (pullˡ (τ-η _))) ⟩∘⟨refl ⟩∘⟨refl ⟩ + μ.η _ ∘ (K.₁ (η _ ∘ swap) ∘ τ _) ∘ swap ≈⟨ refl⟩∘⟨ ((K.homomorphism ⟩∘⟨refl) ⟩∘⟨refl) ⟩ + μ.η _ ∘ ((K.₁ (η _) ∘ K.₁ swap) ∘ τ _) ∘ swap ≈⟨ pullˡ (pullˡ (cancelˡ monadK.identityˡ)) ⟩ + (K.₁ swap ∘ τ _) ∘ swap ≈⟨ assoc ⟩ σ _ ∎) + comm₄ : ∀ {Z : Obj} (h : Z ⇒ K.₀ Y + Z) → (μ.η _ ∘ K.₁ (τ _) ∘ σ _) ∘ (idC ⁂ h #) ≈ ((μ.η _ ∘ K.₁ (τ _) ∘ σ _ +₁ idC) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h))# + comm₄ {Z} h = begin + (μ.η _ ∘ K.₁ (τ _) ∘ σ _) ∘ (idC ⁂ h #) ≈⟨ {! !} ⟩ + μ.η (X × Y) ∘ K.₁ (τ _) ∘ K.₁ swap ∘ τ _ ∘ (h # ⁂ idC) ∘ swap ≈⟨ {! !} ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ K.₁ swap ∘ τ _ ∘ (h # ⁂ K.₁ idC) ∘ swap ≈⟨ {! !} ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ K.₁ swap ∘ K.₁ (h # ⁂ idC) ∘ τ _ ∘ swap ≈⟨ {! !} ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ K.₁ (swap ∘ (h # ⁂ idC)) ∘ τ _ ∘ swap ≈⟨ {! !} ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ K.₁ ((idC ⁂ h #) ∘ swap) ∘ τ _ ∘ swap ≈⟨ {! !} ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ (K.₁ (idC ⁂ h #) ∘ K.₁ swap) ∘ τ _ ∘ swap ≈⟨ {! !} ⟩ + μ.η _ ∘ (K.₁ (τ _ ∘ (idC ⁂ h #)) ∘ K.₁ swap) ∘ τ _ ∘ swap ≈⟨ {! !} ⟩ + μ.η _ ∘ (K.₁ (((τ _ +₁ idC) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h)) #) ∘ K.₁ swap) ∘ τ _ ∘ swap ≈⟨ {! !} ⟩ + μ.η _ ∘ K.₁ (((τ _ +₁ idC) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h)) #) ∘ σ _ ≈⟨ {! !} ⟩ + {! !} ≈⟨ {! !} ⟩ + {! !} ≈⟨ {! !} ⟩ + {! !} ≈⟨ {! !} ⟩ + {! !} ≈⟨ {! !} ⟩ + μ.η (X × Y) ∘ K.₁ (τ _) ∘ K.₁ swap ∘ ((τ _ +₁ idC) ∘ distributeʳ⁻¹ ∘ (h ⁂ idC)) # ∘ swap ≈⟨ {! !} ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ K.₁ swap ∘ ((τ _ ∘ swap +₁ idC) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h))# ≈⟨ {! !} ⟩ + μ.η _ ∘ K.₁ (τ _) ∘ ((σ _ +₁ idC) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h))# ≈⟨ {! !} ⟩ + μ.η _ ∘ ((K.₁ (τ _) ∘ σ _ +₁ idC) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h))# ≈⟨ {! !} ⟩ + ((μ.η _ ∘ K.₁ (τ _) ∘ σ _ +₁ idC) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h))# ∎ + where + test : ((τ (X , Y) +₁ idC) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h))# ∘ swap ≈ ((τ (X , Y) ∘ swap +₁ idC) ∘ distributeʳ⁻¹ ∘ (h ⁂ idC)) # + test = sym (#-Uniformity (algebras _) (sym (begin + ((τ (X , Y) +₁ idC) ∘ distributeˡ⁻¹ ∘ (idC ⁂ h)) ∘ swap ≈⟨ pullʳ (pullʳ (sym swap∘⁂)) ⟩ + (τ (X , Y) +₁ idC) ∘ distributeˡ⁻¹ ∘ swap ∘ (h ⁂ idC) ≈⟨ refl⟩∘⟨ (pullˡ distributeˡ⁻¹∘swap) ⟩ + (τ (X , Y) +₁ idC) ∘ ((swap +₁ swap) ∘ distributeʳ⁻¹) ∘ (h ⁂ idC) ≈⟨ pullˡ (pullˡ (+₁∘+₁ ○ +₁-cong₂ (sym identityˡ) id-comm-sym)) ⟩ + ((idC ∘ τ (X , Y) ∘ swap +₁ swap ∘ idC) ∘ distributeʳ⁻¹) ∘ (h ⁂ idC) ≈⟨ assoc ○ (sym +₁∘+₁) ⟩∘⟨refl ⟩ + ((idC +₁ swap) ∘ (τ (X , Y) ∘ swap +₁ idC)) ∘ distributeʳ⁻¹ ∘ (h ⁂ idC) ≈⟨ assoc ⟩ + (idC +₁ swap) ∘ (τ (X , Y) ∘ swap +₁ idC) ∘ distributeʳ⁻¹ ∘ (h ⁂ idC) ∎))) + helper : τ _ ∘ (h # ⁂ idC) ∘ swap ≈ ((τ _ +₁ idC) ∘ distributeʳ⁻¹ ∘ (h ⁂ idC)) # ∘ swap + helper = {! !} + τ∘swap-preserving : τ (K.₀ Y , X) ∘ (h # ⁂ idC) ≈ ((τ _ +₁ idC) ∘ distributeʳ⁻¹ ∘ (h ⁂ idC)) # + τ∘swap-preserving = begin + τ (K.₀ Y , X) ∘ (h # ⁂ idC) ≈⟨ {! !} ⟩ + τ (K.₀ Y , X) ∘ (h # ⁂ K.₁ idC) ≈⟨ {! !} ⟩ + K.₁ (h # ⁂ idC) ∘ τ _ ≈⟨ {! !} ⟩ + {! !} ≈⟨ {! !} ⟩ + ((τ _ +₁ idC) ∘ distributeʳ⁻¹ ∘ (h ⁂ idC)) # ∎ ``` \ No newline at end of file