Stuff about voe-2-3

This commit is contained in:
Frederik Hanghøj Iversen 2018-03-06 23:18:23 +01:00
parent 110e3510c5
commit 085e6eb3d7

View file

@ -390,6 +390,7 @@ module Kleisli {a b : Level} ( : Category a b) where
-- | The monoidal- and kleisli presentation of monads are equivalent. -- | The monoidal- and kleisli presentation of monads are equivalent.
-- --
-- This is *not* problem 2.3 in [voe].
-- This is problem 2.3 in [voe]. -- This is problem 2.3 in [voe].
module _ {a b : Level} { : Category a b} where module _ {a b : Level} { : Category a b} where
private private
@ -540,7 +541,7 @@ module _ {a b : Level} { : Category a b} where
backRawEq : backRaw (forth m) M.Monad.raw m backRawEq : backRaw (forth m) M.Monad.raw m
-- stuck -- stuck
M.RawMonad.R (backRawEq i) = Req i M.RawMonad.R (backRawEq i) = Req i
M.RawMonad.pureNT (backRawEq i) = pureNTEq i -- pureNTEq i M.RawMonad.pureNT (backRawEq i) = pureNTEq i
M.RawMonad.joinNT (backRawEq i) = joinNTEq i M.RawMonad.joinNT (backRawEq i) = joinNTEq i
backeq : (m : M.Monad) back (forth m) m backeq : (m : M.Monad) back (forth m) m
@ -551,3 +552,129 @@ module _ {a b : Level} { : Category a b} where
Monoidal≃Kleisli : M.Monad K.Monad Monoidal≃Kleisli : M.Monad K.Monad
Monoidal≃Kleisli = forth , eqv Monoidal≃Kleisli = forth , eqv
module voe-2-3 {a b : Level} { : Category a b} where
private
= a b
module = Category
open using (Object ; Arrow ; _∘_)
open NaturalTransformation
module M = Monoidal
module K = Kleisli
module _ (omap : Omap ) (pure : {X : Object} Arrow X (omap X)) where
record voe-2-3-1 : Set where
open M
field
fmap : Fmap omap
join : {A : Object} [ omap (omap A) , omap A ]
Rraw : RawFunctor
Rraw = record
{ func* = omap
; func→ = fmap
}
field
RisFunctor : IsFunctor Rraw
R : EndoFunctor
R = record
{ raw = Rraw
; isFunctor = RisFunctor
}
pureT : (X : Object) Arrow X (omap X)
pureT X = pure {X}
field
pureN : Natural F.identity R pureT
pureNT : NaturalTransformation F.identity R
pureNT = pureT , pureN
joinT : (A : Object) [ omap (omap A) , omap A ]
joinT A = join {A}
field
joinN : Natural F[ R R ] R joinT
joinNT : NaturalTransformation F[ R R ] R
joinNT = joinT , joinN
rawMnd : RawMonad
rawMnd = record
{ R = R
; pureNT = pureNT
; joinNT = joinNT
}
field
isMnd : IsMonad rawMnd
mnd : Monad
mnd = record
{ raw = rawMnd
; isMonad = isMnd
}
record voe-2-3-2 : Set where
open K
field
bind : {X Y : Object} [ X , omap Y ] [ omap X , omap Y ]
rawMnd : RawMonad
rawMnd = record
{ omap = omap
; pure = pure
; bind = bind
}
field
isMnd : IsMonad rawMnd
mnd : Monad
mnd = record
{ raw = rawMnd
; isMonad = isMnd
}
module _ {a b : Level} { : Category a b} where
private
= a b
module = Category
open using (Object ; Arrow ; _∘_)
open NaturalTransformation
module M = Monoidal
module K = Kleisli
open voe-2-3 { = }
forth
: {omap : Omap } {pure : {X : Object} Arrow X (omap X)}
voe-2-3-1 omap pure M.Monad
forth = voe-2-3-1.mnd
back : (m : M.Monad) voe-2-3-1 (M.Monad.Romap m) (λ {X} M.Monad.pureT m X)
back m = record
{ fmap = Functor.func→ R
; RisFunctor = Functor.isFunctor R
; pureN = pureN
; join = λ {X} joinT X
; joinN = joinN
; isMnd = M.Monad.isMonad m
}
where
raw = M.Monad.raw m
R = M.RawMonad.R raw
pureT = M.RawMonad.pureT raw
pureN = M.RawMonad.pureN raw
joinT = M.RawMonad.joinT raw
joinN = M.RawMonad.joinN raw
-- Unfortunately the two above definitions don't really give rise to a
-- bijection - at least not directly. Q: What to put in the indices for
-- `voe-2-3-1`?
equiv-2-3-1 : voe-2-3-1 {!!} {!!} M.Monad
equiv-2-3-1 = {!!}