changeset 716:35457f9568f3

composition done
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Fri, 24 Nov 2017 13:20:14 +0900
parents 1be42267eeee
children a41b2b9b0407
files monoidal.agda
diffstat 1 files changed, 71 insertions(+), 42 deletions(-) [+]
line wrap: on
line diff
--- a/monoidal.agda	Fri Nov 24 11:32:41 2017 +0900
+++ b/monoidal.agda	Fri Nov 24 13:20:14 2017 +0900
@@ -560,15 +560,47 @@
              ∎  )
            where
                   open Relation.Binary.PropositionalEquality.≡-Reasoning
-          unit→F : {a : Obj Sets } {u : FObj F a} → u ≡ FMap F id u 
-          unit→F {a} {u} =  sym ( ≡-cong ( λ k → k u ) ( IsFunctor.identity ( isFunctor F ) ) )
+          u→F : {a : Obj Sets } {u : FObj F a} → u ≡ FMap F id u 
+          u→F {a} {u} =  sym ( ≡-cong ( λ k → k u ) ( IsFunctor.identity ( isFunctor F ) ) )
+          φunitr : {a : Obj Sets } {u : FObj F a} → φ ( unit , u) ≡ FMap F (Iso.≅← (IsMonoidal.mλ-iso isM)) u
+          φunitr {a} {u} = sym ( begin 
+                  FMap F (Iso.≅← (IsMonoidal.mλ-iso isM)) u
+               ≡⟨  ≡-cong ( λ k → FMap F (Iso.≅← (IsMonoidal.mλ-iso isM)) k ) (sym (IsHaskellMonoidalFunctor.idlφ mono)) ⟩
+                  FMap F (Iso.≅← (IsMonoidal.mλ-iso isM)) ( FMap F (Iso.≅→ (IsMonoidal.mλ-iso isM)) ( φ ( unit , u) ) )
+               ≡⟨ right ( sym ( IsFunctor.distr ( isFunctor F ) )) ⟩
+                  (FMap F ( (Iso.≅← (IsMonoidal.mλ-iso isM)) o   (Iso.≅→ (IsMonoidal.mλ-iso isM)))) ( φ ( unit , u) )
+               ≡⟨ ≡-cong ( λ k → FMap F k ( φ ( unit , u) )) (Iso.iso→ ( (IsMonoidal.mλ-iso isM) ))  ⟩
+                  FMap F id ( φ ( unit , u) )
+               ≡⟨ right ( IsFunctor.identity ( isFunctor F ) ) ⟩
+                  id ( φ ( unit , u) )
+               ≡⟨⟩
+                  φ ( unit , u)
+             ∎  )
+           where
+                  open Relation.Binary.PropositionalEquality.≡-Reasoning
+          φunitl : {a : Obj Sets } {u : FObj F a} → φ ( u , unit ) ≡ FMap F (Iso.≅← (IsMonoidal.mρ-iso isM)) u
+          φunitl {a} {u} = sym ( begin 
+                  FMap F (Iso.≅← (IsMonoidal.mρ-iso isM)) u
+               ≡⟨  ≡-cong ( λ k → FMap F (Iso.≅← (IsMonoidal.mρ-iso isM)) k ) (sym (IsHaskellMonoidalFunctor.idrφ mono)) ⟩
+                  FMap F (Iso.≅← (IsMonoidal.mρ-iso isM)) ( FMap F (Iso.≅→ (IsMonoidal.mρ-iso isM)) ( φ ( u , unit ) ) )
+               ≡⟨ right ( sym ( IsFunctor.distr ( isFunctor F ) )) ⟩
+                  (FMap F ( (Iso.≅← (IsMonoidal.mρ-iso isM)) o   (Iso.≅→ (IsMonoidal.mρ-iso isM)))) ( φ ( u , unit ) )
+               ≡⟨ ≡-cong ( λ k → FMap F k ( φ ( u , unit ) )) (Iso.iso→ ( (IsMonoidal.mρ-iso isM) ))  ⟩
+                  FMap F id ( φ ( u , unit ) )
+               ≡⟨ right ( IsFunctor.identity ( isFunctor F ) ) ⟩
+                  id ( φ ( u , unit ) )
+               ≡⟨⟩
+                  φ ( u , unit )
+             ∎  )
+           where
+                  open Relation.Binary.PropositionalEquality.≡-Reasoning
           open IsMonoidal
           identity : { a : Obj Sets } { u : FObj F a } → pure ( id1 Sets a )  <*> u ≡ u
           identity {a} {u} = begin 
                  pure id <*> u
                ≡⟨⟩
                  ( FMap F ( λ r →  ( proj₁ r )  ( proj₂  r )) ) ( φ (  FMap F ( λ y → id ) unit  , u ) )
-               ≡⟨   ≡-cong ( λ k → ( FMap F ( λ r →  ( proj₁ r )  ( proj₂  r )) ) ( φ ( FMap F ( λ y → id ) unit  ,  k  ))) unit→F  ⟩
+               ≡⟨   ≡-cong ( λ k → ( FMap F ( λ r →  ( proj₁ r )  ( proj₂  r )) ) ( φ ( FMap F ( λ y → id ) unit  ,  k  ))) u→F  ⟩
                  ( FMap F ( λ r →  ( proj₁ r )  ( proj₂  r )) ) ( φ (  FMap F ( λ y → id ) unit  , FMap F id u ) )
                ≡⟨ φ→F ⟩
                    FMap F (λ x → proj₂ x ) (φ (unit , u ) )
@@ -584,57 +616,54 @@
           composition {a} {b} {c} {u} {v} {w} = begin
                  FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ
                    (FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ y f g x → f (g x)) unit , u)) , v)) , w))
-                ≡⟨  {!!} ⟩
+                ≡⟨  ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ y f g x → f (g x)) unit , k)) , v)) , w))  ) u→F  ⟩
                  FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ
-                   (FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ y f g x → f (g x)) unit , FMap F id u)) , FMap F id v)) , FMap F id w))
-                ≡⟨  {!!} ⟩
+                   (FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ y f g x → f (g x)) unit , FMap F id u )) , v)) , w))
+                ≡⟨  ≡-cong ( λ k →  FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ ( k  , v)) , w))  ) φ→F ⟩
                  FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ
-                   (FMap F (λ r → proj₁ r (proj₂ r)) (FMap F (map (λ y f g x → f (g x)) id ) (φ ( unit , u))) , FMap F id v)) , FMap F id w))
-                ≡⟨  {!!} ⟩
+                   (FMap F ( λ x → (λ r → proj₁ r (proj₂ r)) ((map (λ y f g x → f (g x)) id ) x)) (φ ( unit , u)) , v)) , w))
+                ≡⟨  ≡-cong ( λ k → ( FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ
+                   (FMap F ( λ x → (λ r → proj₁ r (proj₂ r)) ((map (λ y f g x → f (g x)) id ) x)) k , v)) , w))  ) ) φunitr ⟩
                  FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ
-                   (FMap F ( λ x → (λ r → proj₁ r (proj₂ r)) ((map (λ y f g x → f (g x)) id ) x)) (φ ( unit , u)) , FMap F id v)) , FMap F id w))
+                   ( (FMap F ( λ x → (λ r → proj₁ r (proj₂ r)) ((map (λ y f g x → f (g x)) id ) x)) (FMap F (Iso.≅← (mλ-iso isM)) u) ) , v)) , w))
+                ≡⟨  ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ
+                   (k u , v)) , w)) )  (sym ( IsFunctor.distr (isFunctor F )))  ⟩
+                 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ
+                   ( FMap F (λ x → ((λ y f g x₁ → f (g x₁)) unit x) ) u , v)) , w))
                 ≡⟨⟩
                  FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ
-                   (FMap F ( λ y → (λ f g x → f (g x)) (proj₂ y ) ) (φ ( unit , u)) , FMap F id v)) , FMap F id w))
-                ≡⟨  {!!} ⟩
-                 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (
-                   FMap F ( map (  λ y → (λ f g x → f (g x)) (proj₂ y ) ) id ) ( φ ( φ ( unit , u) , v))) , FMap F id w))
-                ≡⟨  {!!} ⟩
-                 FMap F (λ r → proj₁ r (proj₂ r)) (φ (
-                     FMap F ( λ x → (λ r → proj₁ r (proj₂ r)) ((  map (  λ y → (λ f g x → f (g x)) (proj₂ y ) ) id ) x)) ( φ ( φ ( unit , u) , v))
-                       , FMap F id w))
+                   ( FMap F (λ x g h → x (g h) ) u , v)) , w))
+                ≡⟨  ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ ( FMap F (λ x g h → x (g h) ) u , k)) , w))   ) u→F  ⟩
+                     FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ x g h → x (g h)) u , FMap F id v)) , w))
+                ≡⟨  ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (k , w))  )  φ→F  ⟩
+                     FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F ((λ r → proj₁ r (proj₂ r)) o map (λ x g h → x (g h)) id) (φ (u , v)) , w))
                 ≡⟨⟩
-                 FMap F (λ r → proj₁ r (proj₂ r)) (φ (
-                     FMap F ( λ z → ((( λ f g x → f (g x)) (proj₂ (proj₁ z))) ( proj₂ z ))) ( φ ( φ ( unit , u) , v))
-                       , FMap F id w))
+                     FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ x h → proj₁ x (proj₂ x h)) (φ (u , v)) , w))
+                ≡⟨  ≡-cong ( λ k →  FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ x h → proj₁ x (proj₂ x h)) (φ (u , v)) , k))  ) u→F  ⟩
+                     FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ x h → proj₁ x (proj₂ x h)) (φ (u , v)) , FMap F id w))
+                ≡⟨  φ→F  ⟩
+                     FMap F ((λ r → proj₁ r (proj₂ r)) o map (λ x h → proj₁ x (proj₂ x h)) id) (φ (φ (u , v) , w))
                 ≡⟨⟩
-                 FMap F (λ r → proj₁ r (proj₂ r)) (φ (
-                     FMap F ( λ z → ( λ x → (proj₂ (proj₁ z)) (( proj₂ z ) x ))) ( φ ( φ ( unit , u) , v))
-                       , FMap F id w))
-                ≡⟨  {!!} ⟩
-                 FMap F (λ r → proj₁ r (proj₂ r)) (
-                     FMap F ( map ( λ z → ( λ x → (proj₂ (proj₁ z)) (( proj₂ z ) x ))) id ) ( φ ( φ ( φ ( unit , u) , v) , w )))
-                ≡⟨  {!!} ⟩
-                 FMap F ( λ y → (λ r → proj₁ r (proj₂ r)) (
-                     ( map ( λ z → ( λ x → (proj₂ (proj₁ z)) (( proj₂ z ) x ))) id ) y))  ( φ ( φ ( φ ( unit , u) , v) , w ))
+                    FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (φ (φ (u , v) , w))
+                ≡⟨  ≡-cong ( λ k → FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (k (φ (φ (u , v) , w)) )) (sym (IsFunctor.identity (isFunctor F ))) ⟩
+                    FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (FMap F id (φ (φ (u , v) , w)) )
+                ≡⟨  ≡-cong ( λ k → FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (FMap F k (φ (φ (u , v) , w)) )  ) (sym (Iso.iso→ (mα-iso isM)))  ⟩
+                    FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (FMap F ( (Iso.≅← (mα-iso isM)) o  (Iso.≅→ (mα-iso isM))) (φ (φ (u , v) , w)) )
+                ≡⟨  ≡-cong ( λ k →  FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (k (φ (φ (u , v) , w)))) ( IsFunctor.distr (isFunctor F ))  ⟩
+                    FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (FMap F  (Iso.≅← (mα-iso isM)) ( FMap F  (Iso.≅→ (mα-iso isM)) (φ (φ (u , v) , w)) ))
+                ≡⟨ ≡-cong ( λ k →   FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (FMap F  (Iso.≅← (mα-iso isM)) k) ) (sym ( IsHaskellMonoidalFunctor.assocφ mono ) ) ⟩
+                     FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (FMap F (Iso.≅← (mα-iso isM)) (φ (u , φ (v , w))))
                 ≡⟨⟩
-                 FMap F ( λ y → (( λ z → ( λ x → (proj₂ (proj₁ z)) (( proj₂ z ) x ))) (proj₁ y)) (proj₂ y) )
-                      ( φ ( φ ( φ ( unit , u) , v) , w ))
+                     FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (FMap F (λ r → (proj₁ r , proj₁ (proj₂ r)) , proj₂ (proj₂ r)) (φ (u , φ (v , w))))
+                ≡⟨ right (sym ( IsFunctor.distr (isFunctor F ))) ⟩
+                      FMap F (λ y → (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) ((λ r → (proj₁ r , proj₁ (proj₂ r)) , proj₂ (proj₂ r)) y )) (φ (u , φ (v , w)))
                 ≡⟨⟩
-                 FMap F ( λ x → (proj₂ (proj₁ (proj₁ x))) (( proj₂ (proj₁ x) ) (proj₂ x))) ( φ ( φ ( φ ( unit , u) , v) , w ))
-                ≡⟨ {!!} ⟩
-                 FMap F ( λ x → (proj₁ (proj₁ x)) (( proj₂ (proj₁ x) ) (proj₂ x))) ( φ ( φ ( u , v) , w ))
-                ≡⟨ {!!} ⟩
-                   {!!}
-                ≡⟨ ≡-cong ( λ k → (FMap F ( λ x → (proj₁ x) ((proj₁ (proj₂ x) )(proj₂ (proj₂ x)))) ) k )  ( sym ( IsHaskellMonoidalFunctor.assocφ mono ) ) ⟩
-                 FMap F ( λ x → (proj₁ x) ((proj₁ (proj₂ x) )(proj₂ (proj₂ x))))  ( φ ( u , (φ (v , w))))
+                     FMap F (λ y → proj₁ y (proj₁ (proj₂ y) (proj₂ (proj₂ y)))) (φ (u , φ (v , w)))
                 ≡⟨⟩
                  FMap F ( λ x → (proj₁ x) ((λ r → proj₁ r (proj₂ r)) (  proj₂ x)))  ( φ ( u , (φ (v , w))))
-                ≡⟨  {!!} ⟩
-                 FMap F (λ r → proj₁ r (proj₂ r)) (FMap F (map id (λ r → proj₁ r (proj₂ r))) ( φ ( u , (φ (v , w)))))
-                ≡⟨  {!!} ⟩
+                ≡⟨ sym φ→F ⟩
                  FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F id u , FMap F (λ r → proj₁ r (proj₂ r)) (φ (v , w))))
-                ≡⟨  {!!} ⟩
+                ≡⟨   ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (k , FMap F (λ r → proj₁ r (proj₂ r)) (φ (v , w)))) ) (sym u→F ) ⟩
                  FMap F (λ r → proj₁ r (proj₂ r)) (φ (u , FMap F (λ r → proj₁ r (proj₂ r)) (φ (v , w))))

            where