Prove IsAssociative

This commit is contained in:
Frederik Hanghøj Iversen 2018-02-24 19:07:58 +01:00
parent 5d9c820fa2
commit be505cdfbe

View file

@ -36,28 +36,12 @@ module Monoidal {a b : Level} ( : Category a b) where
module R = Functor R module R = Functor R
module RR = Functor F[ R R ] module RR = Functor F[ R R ]
module _ {X : Object} where module _ {X : Object} where
-- module IdRX = Functor (F.identity {C = RX})
ηX : [ X , R.func* X ]
ηX = η X
RηX : [ R.func* X , R.func* (R.func* X) ] -- [ R.func* X , {!R.func* (R.func* X))!} ]
RηX = R.func→ ηX
ηRX = η (R.func* X)
IdRX : Arrow (R.func* X) (R.func* X)
IdRX = 𝟙 {R.func* X}
μX : [ RR.func* X , R.func* X ]
μX = μ X
RμX : [ R.func* (RR.func* X) , RR.func* X ]
RμX = R.func→ μX
μRX : [ RR.func* (R.func* X) , R.func* (R.func* X) ]
μRX = μ (R.func* X)
IsAssociative' : Set _ IsAssociative' : Set _
IsAssociative' = [ μX RμX ] [ μX μRX ] IsAssociative' = μ X R.func→ (μ X) μ X μ (R.func* X)
IsInverse' : Set _ IsInverse' : Set _
IsInverse' IsInverse'
= [ μX ηRX ] IdRX = μ X η (R.func* X) 𝟙
× [ μX RηX ] IdRX × μ X R.func→ (η X) 𝟙
-- We don't want the objects to be indexes of the type, but rather just -- We don't want the objects to be indexes of the type, but rather just
-- universally quantify over *all* objects of the category. -- universally quantify over *all* objects of the category.
@ -123,33 +107,28 @@ module Kleisli {a b : Level} ( : Category a b) where
-- Problem 2.3 -- Problem 2.3
module _ {a b : Level} { : Category a b} where module _ {a b : Level} { : Category a b} where
private private
open Category using (Object ; Arrow ; 𝟙) open Category using (Object ; Arrow ; 𝟙 ; _∘_)
open Functor using (func* ; func→) open Functor using (func* ; func→)
module M = Monoidal module M = Monoidal
module K = Kleisli module K = Kleisli
-- Note similarity with locally defined things in Kleisly.RawMonad!!
module _ (m : M.RawMonad) where module _ (m : M.RawMonad) where
private private
open M.RawMonad m open M.RawMonad m
module Kraw = K.RawMonad module Kraw = K.RawMonad
RR : Object Object RR : Object Object
RR = func* R RR = func* R
R→ : {A B : Object} [ A , B ] [ RR A , RR B ] R→ : {A B : Object} [ A , B ] [ RR A , RR B ]
R→ = func→ R R→ = func→ R
ζ : {X : Object} [ X , RR X ] ζ : {X : Object} [ X , RR X ]
ζ = {!!} ζ {X} = η X
rr : {X Y : Object} [ X , RR Y ] [ RR X , RR Y ] rr : {X Y : Object} [ X , RR Y ] [ RR X , RR Y ]
-- Order is different now! rr {X} {Y} f = [ μ Y func→ R f ]
rr {X} {Y} f = [ f {!!} ]
where
μY : [ func* F[ R R ] Y , func* R Y ]
μY = μ Y
ζY : [ Y , RR Y ]
ζY = ζ {Y}
forthRaw : K.RawMonad forthRaw : K.RawMonad
Kraw.RR forthRaw = RR Kraw.RR forthRaw = RR
@ -158,15 +137,34 @@ module _ {a b : Level} { : Category a b} where
module _ {raw : M.RawMonad} (m : M.IsMonad raw) where module _ {raw : M.RawMonad} (m : M.IsMonad raw) where
open M.IsMonad m open M.IsMonad m
module Kraw = K.RawMonad (forthRaw raw) open K.RawMonad (forthRaw raw)
module Kis = K.IsMonad module Kis = K.IsMonad
isIdentity : Kraw.IsIdentity
isIdentity = {!!}
isNatural : Kraw.IsNatural isIdentity : IsIdentity
isNatural = {!!} isIdentity {X} = begin
rr ζ ≡⟨⟩
rr (η X) ≡⟨⟩
[ μ X func→ R (η X) ] ≡⟨ proj₂ isInverse
𝟙
isDistributive : Kraw.IsDistributive module R = Functor R
isNatural : IsNatural
isNatural {X} {Y} f = begin
rr f ζ ≡⟨⟩
rr f η X ≡⟨⟩
μ Y R.func→ f η X ≡⟨ sym .isAssociative
μ Y (R.func→ f η X) ≡⟨ cong (λ φ μ Y φ) (sym (ηN f))
μ Y (η (R.func* Y) f) ≡⟨ .isAssociative
μ Y η (R.func* Y) f ≡⟨ cong (λ φ φ f) (proj₁ isInverse)
𝟙 f ≡⟨ proj₂ .isIdentity
f
where
module = Category
open NaturalTransformation
ηN : Natural F.identity R η
ηN = proj₂ ηNat
isDistributive : IsDistributive
isDistributive = {!!} isDistributive = {!!}
forthIsMonad : K.IsMonad (forthRaw raw) forthIsMonad : K.IsMonad (forthRaw raw)
@ -178,8 +176,18 @@ module _ {a b : Level} { : Category a b} where
Kleisli.Monad.raw (forth m) = forthRaw (M.Monad.raw m) Kleisli.Monad.raw (forth m) = forthRaw (M.Monad.raw m)
Kleisli.Monad.isMonad (forth m) = forthIsMonad (M.Monad.isMonad m) Kleisli.Monad.isMonad (forth m) = forthIsMonad (M.Monad.isMonad m)
back : K.Monad M.Monad
back = {!!}
fortheq : (m : K.Monad) forth (back m) m
fortheq = {!!}
backeq : (m : M.Monad) back (forth m) m
backeq = {!!}
open import Cubical.GradLemma
eqv : isEquiv M.Monad K.Monad forth eqv : isEquiv M.Monad K.Monad forth
eqv = {!!} eqv = gradLemma forth back fortheq backeq
Monoidal≃Kleisli : M.Monad K.Monad Monoidal≃Kleisli : M.Monad K.Monad
Monoidal≃Kleisli = forth , eqv Monoidal≃Kleisli = forth , eqv