Move proof of equivalence to IsMonad making them lemmas

This commit is contained in:
Frederik Hanghøj Iversen 2018-02-28 18:55:32 +01:00
parent 1aaf81552c
commit 70221377d3

View file

@ -47,10 +47,10 @@ module Monoidal {a b : Level} ( : Category a b) where
IsInverse = {X : Object}
μ X η (R.func* X) 𝟙
× μ X R.func→ (η X) 𝟙
IsNatural' = {X Y f} μ Y R.func→ f η X f
IsDistributive' = {X Y Z} {f : Arrow X (R.func* Y)} {g : Arrow Y (R.func* Z)}
μ Z R.func→ (μ Z R.func→ g f)
μ Z R.func→ g (μ Y R.func→ f)
IsNatural = {X Y} f μ Y R.func→ f η X f
IsDistributive = {X Y Z} (g : Arrow Y (R.func* Z)) (f : Arrow X (R.func* Y))
μ Z R.func→ g (μ Y R.func→ f)
μ Z R.func→ (μ Z R.func→ g f)
record IsMonad (raw : RawMonad) : Set where
open RawMonad raw public
@ -62,8 +62,8 @@ module Monoidal {a b : Level} ( : Category a b) where
module R = Functor R
module = Category
isNatural' : IsNatural'
isNatural' {X} {Y} {f} = begin
isNatural : IsNatural
isNatural {X} {Y} f = begin
μ Y R.func→ f η X ≡⟨ sym .isAssociative
μ Y (R.func→ f η X) ≡⟨ cong (λ φ μ Y φ) (sym (ηNat f))
μ Y (η (R.func* Y) f) ≡⟨ .isAssociative
@ -71,16 +71,8 @@ module Monoidal {a b : Level} ( : Category a b) where
𝟙 f ≡⟨ proj₂ .isIdentity
f
isDistributive' : IsDistributive'
isDistributive' {X} {Y} {Z} {f} {g} = begin
μ Z R.func→ (μ Z R.func→ g f) ≡⟨ cong (λ φ μ Z φ) distrib
μ Z (R.func→ (μ Z) R.func→ (R.func→ g) R.func→ f) ≡⟨⟩
μ Z (R.func→ (μ Z) R².func→ g R.func→ f) ≡⟨ {!!} -- ●-solver?
(μ Z R.func→ (μ Z)) (R².func→ g R.func→ f) ≡⟨ cong (λ φ φ (R².func→ g R.func→ f)) lemmm
(μ Z μ (R.func* Z)) (R².func→ g R.func→ f) ≡⟨ {!!} -- ●-solver?
μ Z μ (R.func* Z) R².func→ g R.func→ f ≡⟨ {!!} -- ●-solver + lem4
μ Z R.func→ g μ Y R.func→ f ≡⟨ sym (Category.isAssociative )
μ Z R.func→ g (μ Y R.func→ f)
isDistributive : IsDistributive
isDistributive {X} {Y} {Z} g f = sym done
where
module R² = Functor F[ R R ]
distrib : {A B C D} {a : Arrow C D} {b : Arrow B C} {c : Arrow A B}
@ -95,6 +87,15 @@ module Monoidal {a b : Level} ( : Category a b) where
lemmm = isAssociative
lem4 : μ (R.func* Z) R².func→ g R.func→ g μ Y
lem4 = μNat g
done = begin
μ Z R.func→ (μ Z R.func→ g f) ≡⟨ cong (λ φ μ Z φ) distrib
μ Z (R.func→ (μ Z) R.func→ (R.func→ g) R.func→ f) ≡⟨⟩
μ Z (R.func→ (μ Z) R².func→ g R.func→ f) ≡⟨ {!!} -- ●-solver?
(μ Z R.func→ (μ Z)) (R².func→ g R.func→ f) ≡⟨ cong (λ φ φ (R².func→ g R.func→ f)) lemmm
(μ Z μ (R.func* Z)) (R².func→ g R.func→ f) ≡⟨ {!!} -- ●-solver?
μ Z μ (R.func* Z) R².func→ g R.func→ f ≡⟨ {!!} -- ●-solver + lem4
μ Z R.func→ g μ Y R.func→ f ≡⟨ sym (Category.isAssociative )
μ Z R.func→ g (μ Y R.func→ f)
record Monad : Set where
field
@ -233,42 +234,12 @@ module _ {a b : Level} { : Category a b} where
Kraw.bind forthRaw = bind
module _ {raw : M.RawMonad} (m : M.IsMonad raw) where
private
open M.IsMonad m
open K.RawMonad (forthRaw raw)
module R = Functor R
isIdentity : IsIdentity
isIdentity {X} = begin
bind pure ≡⟨⟩
bind (η X) ≡⟨⟩
μ X func→ R (η X) ≡⟨ proj₂ isInverse
𝟙
isNatural : IsNatural
isNatural {X} {Y} f = begin
bind f pure ≡⟨⟩
bind f η X ≡⟨⟩
μ Y R.func→ f η X ≡⟨ isNatural'
f
where
open NaturalTransformation
module = Category
ηN : Natural F.identity R η
ηN = proj₂ ηNatTrans
isDistributive : IsDistributive
isDistributive {X} {Y} {Z} g f = begin
bind g bind f ≡⟨⟩
μ Z R.func→ g (μ Y R.func→ f) ≡⟨ sym isDistributive'
μ Z R.func→ (μ Z R.func→ g f) ≡⟨⟩
μ Z R.func→ (bind g f)
module MI = M.IsMonad m
module KI = K.IsMonad
forthIsMonad : K.IsMonad (forthRaw raw)
KI.isIdentity forthIsMonad = isIdentity
KI.isNatural forthIsMonad = isNatural
KI.isDistributive forthIsMonad = isDistributive
KI.isIdentity forthIsMonad = proj₂ MI.isInverse
KI.isNatural forthIsMonad = MI.isNatural
KI.isDistributive forthIsMonad = MI.isDistributive
forth : M.Monad K.Monad
Kleisli.Monad.raw (forth m) = forthRaw (M.Monad.raw m)