Mercurial > hg > Members > kono > Proof > category
changeset 737:a4792945cd9b
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 04 Dec 2017 12:36:43 +0900 |
parents | c1362961132a |
children | 15ded3383319 |
files | monad→monoidal.agda |
diffstat | 1 files changed, 25 insertions(+), 4 deletions(-) [+] |
line wrap: on
line diff
--- a/monad→monoidal.agda Sat Dec 02 09:18:20 2017 +0900 +++ b/monad→monoidal.agda Mon Dec 04 12:36:43 2017 +0900 @@ -125,7 +125,7 @@ left {_} {_} {_} {_} {_} {h} eq = ≡-cong ( λ k → k h ) eq ≡cong = Relation.Binary.PropositionalEquality.cong identity : { a : Obj Sets } { u : FObj F a } → pure ( id1 Sets a ) <*> u ≡ u - identity {a} {u} = Relation.Binary.PropositionalEquality.cong ( λ h → h u ) ( begin + identity {a} {u} = ≡cong ( λ h → h u ) ( begin ( λ u → pure ( id1 Sets a ) <*> u ) ≈⟨⟩ ( λ u → μ a (FMap F (λ k → FMap F k u) (η (a → a) (λ x → x)))) @@ -148,7 +148,7 @@ open ≈-Reasoning Sets hiding ( _o_ ) composition : { a b c : Obj Sets } { u : FObj F ( b → c ) } { v : FObj F (a → b ) } { w : FObj F a } → (( pure _・_ <*> u ) <*> v ) <*> w ≡ u <*> (v <*> w) - composition {a} {b} {c} {u} {v} {w} = Relation.Binary.PropositionalEquality.cong ( λ h → h w ) ( begin + composition {a} {b} {c} {u} {v} {w} = ≡cong ( λ h → h w ) ( begin ( λ w → (( pure _・_ <*> u ) <*> v ) <*> w ) ≈⟨⟩ ( λ w → μ c (FMap F (λ k → FMap F k w) (μ (a → c) (FMap F (λ k → FMap F k v) @@ -161,7 +161,28 @@ where open ≈-Reasoning Sets homomorphism : { a b : Obj Sets } { f : Hom Sets a b } { x : a } → pure f <*> pure x ≡ pure (f x) - homomorphism = {!!} + homomorphism {a} {b} {f} {x} = ≡cong ( λ h → h x ) ( begin + ( λ x → pure f <*> pure x ) + ≈⟨⟩ + ( λ x → μ b (FMap F (λ k → FMap F k (η a x)) ((η (a → b) f)) )) + ≈⟨ {!!} ⟩ + ( λ x → η b (f x) ) + ≈⟨⟩ + ( λ x → pure (f x )) + ∎ ) + where + open ≈-Reasoning Sets interchange : { a b : Obj Sets } { u : FObj F ( a → b ) } { x : a } → u <*> pure x ≡ pure (λ f → f x) <*> u - interchange = {!!} + interchange {a} {b} {u} {x} = ≡cong ( λ h → h x ) ( begin + ( λ x → u <*> pure x ) + ≈⟨⟩ + ( λ x → μ b (FMap F (λ k → FMap F k (η a x)) u)) + ≈⟨ {!!} ⟩ + ( λ x → μ b (FMap F (λ k → FMap F k u) (η ((f : a → b) → b) (λ f → f x))) ) + ≈⟨⟩ + ( λ x → pure (λ f → f x) <*> u ) + ∎ ) + where + open ≈-Reasoning Sets +