Mercurial > hg > Members > kono > Proof > category
annotate monoidal.agda @ 765:171f5386e87e
Applicative→HaskellMonoidal begin
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 12 Dec 2017 00:20:07 +0900 |
parents | 2439a142aba2 |
children | c30ca91f3a76 |
rev | line source |
---|---|
696
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
1 open import Level |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
2 open import Category |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
3 module monoidal where |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
4 |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
5 open import Data.Product renaming (_×_ to _*_) |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
6 open import Category.Constructions.Product |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
7 open import HomReasoning |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
8 open import cat-utility |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
9 open import Relation.Binary.Core |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
10 open import Relation.Binary |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
11 |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
12 open Functor |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
13 |
731
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
14 -- record Iso {c₁ c₂ ℓ : Level} (C : Category c₁ c₂ ℓ) |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
15 -- (x y : Obj C ) |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
16 -- : Set ( suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁)) where |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
17 -- field |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
18 -- ≅→ : Hom C x y |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
19 -- ≅← : Hom C y x |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
20 -- iso→ : C [ C [ ≅← o ≅→ ] ≈ id1 C x ] |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
21 -- iso← : C [ C [ ≅→ o ≅← ] ≈ id1 C y ] |
696
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
22 |
730 | 23 -- Monoidal Category |
698 | 24 |
25 record IsMonoidal {c₁ c₂ ℓ : Level} (C : Category c₁ c₂ ℓ) (I : Obj C) ( BI : Functor ( C × C ) C ) | |
26 : Set ( suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁)) where | |
27 open Iso | |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
28 infixr 9 _□_ _■_ |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
29 _□_ : ( x y : Obj C ) → Obj C |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
30 _□_ x y = FObj BI ( x , y ) |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
31 _■_ : {a b c d : Obj C } ( f : Hom C a c ) ( g : Hom C b d ) → Hom C ( a □ b ) ( c □ d ) |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
32 _■_ f g = FMap BI ( f , g ) |
698 | 33 field |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
34 mα-iso : {a b c : Obj C} → Iso C ( ( a □ b) □ c) ( a □ ( b □ c ) ) |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
35 mλ-iso : {a : Obj C} → Iso C ( I □ a) a |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
36 mρ-iso : {a : Obj C} → Iso C ( a □ I) a |
698 | 37 mα→nat1 : {a a' b c : Obj C} → ( f : Hom C a a' ) → |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
38 C [ C [ ( f ■ id1 C ( b □ c )) o ≅→ (mα-iso {a} {b} {c}) ] ≈ |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
39 C [ ≅→ (mα-iso ) o ( (f ■ id1 C b ) ■ id1 C c ) ] ] |
698 | 40 mα→nat2 : {a b b' c : Obj C} → ( f : Hom C b b' ) → |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
41 C [ C [ ( id1 C a ■ ( f ■ id1 C c ) ) o ≅→ (mα-iso {a} {b} {c} ) ] ≈ |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
42 C [ ≅→ (mα-iso ) o ( (id1 C a ■ f ) ■ id1 C c ) ] ] |
698 | 43 mα→nat3 : {a b c c' : Obj C} → ( f : Hom C c c' ) → |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
44 C [ C [ ( id1 C a ■ ( id1 C b ■ f ) ) o ≅→ (mα-iso {a} {b} {c} ) ] ≈ |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
45 C [ ≅→ (mα-iso ) o ( id1 C ( a □ b ) ■ f ) ] ] |
698 | 46 mλ→nat : {a a' : Obj C} → ( f : Hom C a a' ) → |
47 C [ C [ f o ≅→ (mλ-iso {a} ) ] ≈ | |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
48 C [ ≅→ (mλ-iso ) o ( id1 C I ■ f ) ] ] |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
49 mρ→nat : {a a' : Obj C} → ( f : Hom C a a' ) → |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
50 C [ C [ f o ≅→ (mρ-iso {a} ) ] ≈ |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
51 C [ ≅→ (mρ-iso ) o ( f ■ id1 C I ) ] ] |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
52 -- we should write naturalities for ≅← (maybe derived from above ) |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
53 αABC□1D : {a b c d e : Obj C } → Hom C (((a □ b) □ c ) □ d) ((a □ (b □ c)) □ d) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
54 αABC□1D {a} {b} {c} {d} {e} = ( ≅→ mα-iso ■ id1 C d ) |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
55 αAB□CD : {a b c d e : Obj C } → Hom C ((a □ (b □ c)) □ d) (a □ ((b □ c ) □ d)) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
56 αAB□CD {a} {b} {c} {d} {e} = ≅→ mα-iso |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
57 1A□BCD : {a b c d e : Obj C } → Hom C (a □ ((b □ c ) □ d)) (a □ (b □ ( c □ d) )) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
58 1A□BCD {a} {b} {c} {d} {e} = ( id1 C a ■ ≅→ mα-iso ) |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
59 αABC□D : {a b c d e : Obj C } → Hom C (a □ (b □ ( c □ d) )) ((a □ b ) □ (c □ d)) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
60 αABC□D {a} {b} {c} {d} {e} = ≅← mα-iso |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
61 αA□BCD : {a b c d e : Obj C } → Hom C (((a □ b) □ c ) □ d) ((a □ b ) □ (c □ d)) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
62 αA□BCD {a} {b} {c} {d} {e} = ≅→ mα-iso |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
63 αAIB : {a b : Obj C } → Hom C (( a □ I ) □ b ) (a □ ( I □ b )) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
64 αAIB {a} {b} = ≅→ mα-iso |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
65 1A□λB : {a b : Obj C } → Hom C (a □ ( I □ b )) ( a □ b ) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
66 1A□λB {a} {b} = id1 C a ■ ≅→ mλ-iso |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
67 ρA□IB : {a b : Obj C } → Hom C (( a □ I ) □ b ) ( a □ b ) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
68 ρA□IB {a} {b} = ≅→ mρ-iso ■ id1 C b |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
69 |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
70 field |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
71 comm-penta : {a b c d e : Obj C} |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
72 → C [ C [ αABC□D {a} {b} {c} {d} {e} o C [ 1A□BCD {a} {b} {c} {d} {e} o C [ αAB□CD {a} {b} {c} {d} {e} o αABC□1D {a} {b} {c} {d} {e} ] ] ] |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
73 ≈ αA□BCD {a} {b} {c} {d} {e} ] |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
74 comm-unit : {a b : Obj C} |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
75 → C [ C [ 1A□λB {a} {b} o αAIB ] ≈ ρA□IB {a} {b} ] |
696
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
76 |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
77 record Monoidal {c₁ c₂ ℓ : Level} (C : Category c₁ c₂ ℓ) |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
78 : Set ( suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁)) where |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
79 field |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
80 m-i : Obj C |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
81 m-bi : Functor ( C × C ) C |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
82 isMonoidal : IsMonoidal C m-i m-bi |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
83 |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
84 --------- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
85 -- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
86 -- Lax Monoidal Functor |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
87 -- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
88 -- N → M |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
89 -- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
90 --------- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
91 |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
92 --------- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
93 -- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
94 -- Two implementations of Functor ( C × C ) → D from F : Functor C → D (given) |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
95 -- dervied from F and two Monoidal Categories |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
96 -- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
97 -- F x ● F y |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
98 -- F ( x ⊗ y ) |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
99 -- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
100 -- and a given natural transformation for them |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
101 -- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
102 -- φ : F x ● F y → F ( x ⊗ y ) |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
103 -- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
104 -- TMap φ : ( x y : Obj C ) → Hom D ( F x ● F y ) ( F ( x ⊗ y )) |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
105 -- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
106 -- a given unit arrow |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
107 -- |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
108 -- ψ : IN → IM |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
109 |
703 | 110 Functor● : {c₁ c₂ ℓ : Level} (C D : Category c₁ c₂ ℓ) ( N : Monoidal D ) |
111 ( MF : Functor C D ) → Functor ( C × C ) D | |
112 Functor● C D N MF = record { | |
113 FObj = λ x → (FObj MF (proj₁ x) ) ● (FObj MF (proj₂ x) ) | |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
114 ; FMap = λ {x : Obj ( C × C ) } {y} f → ( FMap MF (proj₁ f ) ■ FMap MF (proj₂ f) ) |
703 | 115 ; isFunctor = record { |
116 ≈-cong = ≈-cong | |
117 ; identity = identity | |
118 ; distr = distr | |
119 } | |
120 } where | |
121 _●_ : (x y : Obj D ) → Obj D | |
122 _●_ x y = (IsMonoidal._□_ (Monoidal.isMonoidal N) ) x y | |
704 | 123 _■_ : {a b c d : Obj D } ( f : Hom D a c ) ( g : Hom D b d ) → Hom D ( a ● b ) ( c ● d ) |
124 _■_ f g = FMap (Monoidal.m-bi N) ( f , g ) | |
125 F : { a b : Obj C } → ( f : Hom C a b ) → Hom D (FObj MF a) (FObj MF b ) | |
126 F f = FMap MF f | |
703 | 127 ≈-cong : {a b : Obj (C × C)} {f g : Hom (C × C) a b} → (C × C) [ f ≈ g ] → |
704 | 128 D [ (F (proj₁ f) ■ F (proj₂ f)) ≈ (F (proj₁ g) ■ F (proj₂ g)) ] |
703 | 129 ≈-cong {a} {b} {f} {g} f≈g = let open ≈-Reasoning D in begin |
704 | 130 F (proj₁ f) ■ F (proj₂ f) |
703 | 131 ≈⟨ fcong (Monoidal.m-bi N) ( fcong MF ( proj₁ f≈g ) , fcong MF ( proj₂ f≈g )) ⟩ |
704 | 132 F (proj₁ g) ■ F (proj₂ g) |
703 | 133 ∎ |
704 | 134 identity : {a : Obj (C × C)} → D [ (F (proj₁ (id1 (C × C) a)) ■ F (proj₂ (id1 (C × C) a))) |
703 | 135 ≈ id1 D (FObj MF (proj₁ a) ● FObj MF (proj₂ a)) ] |
136 identity {a} = let open ≈-Reasoning D in begin | |
704 | 137 F (proj₁ (id1 (C × C) a)) ■ F (proj₂ (id1 (C × C) a)) |
703 | 138 ≈⟨ fcong (Monoidal.m-bi N) ( IsFunctor.identity (isFunctor MF ) , IsFunctor.identity (isFunctor MF )) ⟩ |
704 | 139 id1 D (FObj MF (proj₁ a)) ■ id1 D (FObj MF (proj₂ a)) |
703 | 140 ≈⟨ IsFunctor.identity (isFunctor (Monoidal.m-bi N)) ⟩ |
141 id1 D (FObj MF (proj₁ a) ● FObj MF (proj₂ a)) | |
142 ∎ | |
143 distr : {a b c : Obj (C × C)} {f : Hom (C × C) a b} {g : Hom (C × C) b c} → | |
704 | 144 D [ (F (proj₁ ((C × C) [ g o f ])) ■ F (proj₂ ((C × C) [ g o f ]))) |
145 ≈ D [ (F (proj₁ g) ■ F (proj₂ g)) o (F (proj₁ f) ■ F (proj₂ f)) ] ] | |
703 | 146 distr {a} {b} {c} {f} {g} = let open ≈-Reasoning D in begin |
704 | 147 (F (proj₁ ((C × C) [ g o f ])) ■ F (proj₂ ((C × C) [ g o f ]))) |
703 | 148 ≈⟨ fcong (Monoidal.m-bi N) ( IsFunctor.distr ( isFunctor MF) , IsFunctor.distr ( isFunctor MF )) ⟩ |
704 | 149 ( F (proj₁ g) o F (proj₁ f) ) ■ ( F (proj₂ g) o F (proj₂ f) ) |
703 | 150 ≈⟨ IsFunctor.distr ( isFunctor (Monoidal.m-bi N)) ⟩ |
704 | 151 (F (proj₁ g) ■ F (proj₂ g)) o (F (proj₁ f) ■ F (proj₂ f)) |
703 | 152 ∎ |
696
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
153 |
703 | 154 Functor⊗ : {c₁ c₂ ℓ : Level} (C D : Category c₁ c₂ ℓ) ( M : Monoidal C ) |
155 ( MF : Functor C D ) → Functor ( C × C ) D | |
156 Functor⊗ C D M MF = record { | |
157 FObj = λ x → FObj MF ( proj₁ x ⊗ proj₂ x ) | |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
158 ; FMap = λ {a} {b} f → F ( proj₁ f □ proj₂ f ) |
703 | 159 ; isFunctor = record { |
160 ≈-cong = ≈-cong | |
161 ; identity = identity | |
162 ; distr = distr | |
163 } | |
164 } where | |
165 _⊗_ : (x y : Obj C ) → Obj C | |
166 _⊗_ x y = (IsMonoidal._□_ (Monoidal.isMonoidal M) ) x y | |
704 | 167 _□_ : {a b c d : Obj C } ( f : Hom C a c ) ( g : Hom C b d ) → Hom C ( a ⊗ b ) ( c ⊗ d ) |
168 _□_ f g = FMap (Monoidal.m-bi M) ( f , g ) | |
169 F : { a b : Obj C } → ( f : Hom C a b ) → Hom D (FObj MF a) (FObj MF b ) | |
170 F f = FMap MF f | |
703 | 171 ≈-cong : {a b : Obj (C × C)} {f g : Hom (C × C) a b} → (C × C) [ f ≈ g ] → |
704 | 172 D [ F ( (proj₁ f □ proj₂ f)) ≈ F ( (proj₁ g □ proj₂ g)) ] |
703 | 173 ≈-cong {a} {b} {f} {g} f≈g = IsFunctor.≈-cong (isFunctor MF ) ( IsFunctor.≈-cong (isFunctor (Monoidal.m-bi M) ) f≈g ) |
704 | 174 identity : {a : Obj (C × C)} → D [ F ( (proj₁ (id1 (C × C) a) □ proj₂ (id1 (C × C) a))) |
703 | 175 ≈ id1 D (FObj MF (proj₁ a ⊗ proj₂ a)) ] |
176 identity {a} = let open ≈-Reasoning D in begin | |
704 | 177 F ( (proj₁ (id1 (C × C) a) □ proj₂ (id1 (C × C) a))) |
703 | 178 ≈⟨⟩ |
704 | 179 F (FMap (Monoidal.m-bi M) (id1 (C × C) a ) ) |
703 | 180 ≈⟨ fcong MF ( IsFunctor.identity (isFunctor (Monoidal.m-bi M) )) ⟩ |
704 | 181 F (id1 C (proj₁ a ⊗ proj₂ a)) |
703 | 182 ≈⟨ IsFunctor.identity (isFunctor MF) ⟩ |
183 id1 D (FObj MF (proj₁ a ⊗ proj₂ a)) | |
184 ∎ | |
185 distr : {a b c : Obj (C × C)} {f : Hom (C × C) a b} {g : Hom (C × C) b c} → D [ | |
704 | 186 F ( (proj₁ ((C × C) [ g o f ]) □ proj₂ ((C × C) [ g o f ]))) |
187 ≈ D [ F ( (proj₁ g □ proj₂ g)) o F ( (proj₁ f □ proj₂ f)) ] ] | |
703 | 188 distr {a} {b} {c} {f} {g} = let open ≈-Reasoning D in begin |
704 | 189 F ( (proj₁ ((C × C) [ g o f ]) □ proj₂ ((C × C) [ g o f ]))) |
703 | 190 ≈⟨⟩ |
704 | 191 F (FMap (Monoidal.m-bi M) ( (C × C) [ g o f ] )) |
703 | 192 ≈⟨ fcong MF ( IsFunctor.distr (isFunctor (Monoidal.m-bi M))) ⟩ |
704 | 193 F (C [ FMap (Monoidal.m-bi M) g o FMap (Monoidal.m-bi M) f ]) |
703 | 194 ≈⟨ IsFunctor.distr ( isFunctor MF ) ⟩ |
704 | 195 F ( proj₁ g □ proj₂ g) o F ( proj₁ f □ proj₂ f) |
703 | 196 ∎ |
197 | |
696
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
198 |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
199 record IsMonoidalFunctor {c₁ c₂ ℓ : Level} {C D : Category c₁ c₂ ℓ} ( M : Monoidal C ) ( N : Monoidal D ) |
698 | 200 ( MF : Functor C D ) |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
201 ( ψ : Hom D (Monoidal.m-i N) (FObj MF (Monoidal.m-i M) ) ) |
696
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
202 : Set ( suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁)) where |
698 | 203 _⊗_ : (x y : Obj C ) → Obj C |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
204 _⊗_ x y = (IsMonoidal._□_ (Monoidal.isMonoidal M) ) x y |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
205 _□_ : {a b c d : Obj C } ( f : Hom C a c ) ( g : Hom C b d ) → Hom C ( a ⊗ b ) ( c ⊗ d ) |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
206 _□_ f g = FMap (Monoidal.m-bi M) ( f , g ) |
698 | 207 _●_ : (x y : Obj D ) → Obj D |
700
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
208 _●_ x y = (IsMonoidal._□_ (Monoidal.isMonoidal N) ) x y |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
209 _■_ : {a b c d : Obj D } ( f : Hom D a c ) ( g : Hom D b d ) → Hom D ( a ● b ) ( c ● d ) |
cfd2d402c486
monodial cateogry and functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
699
diff
changeset
|
210 _■_ f g = FMap (Monoidal.m-bi N) ( f , g ) |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
211 F● : Functor ( C × C ) D |
703 | 212 F● = Functor● C D N MF |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
213 F⊗ : Functor ( C × C ) D |
703 | 214 F⊗ = Functor⊗ C D M MF |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
215 field |
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
216 φab : NTrans ( C × C ) D F● F⊗ |
698 | 217 open Iso |
218 open Monoidal | |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
219 open IsMonoidal hiding ( _■_ ; _□_ ) |
699 | 220 αC : {a b c : Obj C} → Hom C (( a ⊗ b ) ⊗ c ) ( a ⊗ ( b ⊗ c ) ) |
221 αC {a} {b} {c} = ≅→ (mα-iso (isMonoidal M) {a} {b} {c}) | |
222 αD : {a b c : Obj D} → Hom D (( a ● b ) ● c ) ( a ● ( b ● c ) ) | |
223 αD {a} {b} {c} = ≅→ (mα-iso (isMonoidal N) {a} {b} {c}) | |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
224 F : Obj C → Obj D |
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
225 F x = FObj MF x |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
226 φ : ( x y : Obj C ) → Hom D ( FObj F● (x , y) ) ( FObj F⊗ ( x , y )) |
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
227 φ x y = NTrans.TMap φab ( x , y ) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
228 1●φBC : {a b c : Obj C} → Hom D ( F a ● ( F b ● F c ) ) ( F a ● ( F ( b ⊗ c ) )) |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
229 1●φBC {a} {b} {c} = id1 D (F a) ■ φ b c |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
230 φAB⊗C : {a b c : Obj C} → Hom D ( F a ● ( F ( b ⊗ c ) )) (F ( a ⊗ ( b ⊗ c ))) |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
231 φAB⊗C {a} {b} {c} = φ a (b ⊗ c ) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
232 φAB●1 : {a b c : Obj C} → Hom D ( ( F a ● F b ) ● F c ) ( F ( a ⊗ b ) ● F c ) |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
233 φAB●1 {a} {b} {c} = φ a b ■ id1 D (F c) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
234 φA⊗BC : {a b c : Obj C} → Hom D ( F ( a ⊗ b ) ● F c ) (F ( (a ⊗ b ) ⊗ c )) |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
235 φA⊗BC {a} {b} {c} = φ ( a ⊗ b ) c |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
236 FαC : {a b c : Obj C} → Hom D (F ( (a ⊗ b ) ⊗ c )) (F ( a ⊗ ( b ⊗ c ))) |
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
237 FαC {a} {b} {c} = FMap MF ( ≅→ (mα-iso (isMonoidal M) {a} {b} {c}) ) |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
238 1●ψ : { a b : Obj C } → Hom D (F a ● Monoidal.m-i N ) ( F a ● F ( Monoidal.m-i M ) ) |
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
239 1●ψ{a} {b} = id1 D (F a) ■ ψ |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
240 φAIC : { a b : Obj C } → Hom D ( F a ● F ( Monoidal.m-i M ) ) (F ( a ⊗ Monoidal.m-i M )) |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
241 φAIC {a} {b} = φ a ( Monoidal.m-i M ) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
242 FρC : { a b : Obj C } → Hom D (F ( a ⊗ Monoidal.m-i M ))( F a ) |
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
243 FρC {a} {b} = FMap MF ( ≅→ (mρ-iso (isMonoidal M) {a} ) ) |
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
244 ρD : { a b : Obj C } → Hom D (F a ● Monoidal.m-i N ) ( F a ) |
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
245 ρD {a} {b} = ≅→ (mρ-iso (isMonoidal N) {F a} ) |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
246 ψ●1 : { a b : Obj C } → Hom D (Monoidal.m-i N ● F b ) ( F ( Monoidal.m-i M ) ● F b ) |
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
247 ψ●1 {a} {b} = ψ ■ id1 D (F b) |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
248 φICB : { a b : Obj C } → Hom D ( F ( Monoidal.m-i M ) ● F b ) ( F ( ( Monoidal.m-i M ) ⊗ b ) ) |
702
d16327b48b83
Monoidal Functor ( two functor remains )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
701
diff
changeset
|
249 φICB {a} {b} = φ ( Monoidal.m-i M ) b |
701
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
250 FλD : { a b : Obj C } → Hom D ( F ( ( Monoidal.m-i M ) ⊗ b ) ) (F b ) |
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
251 FλD {a} {b} = FMap MF ( ≅→ (mλ-iso (isMonoidal M) {b} ) ) |
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
252 λD : { a b : Obj C } → Hom D (Monoidal.m-i N ● F b ) (F b ) |
7a729bb62ce3
Monoidal Functor on going ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
700
diff
changeset
|
253 λD {a} {b} = ≅→ (mλ-iso (isMonoidal N) {F b} ) |
696
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
254 field |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
255 associativity : {a b c : Obj C } → D [ D [ φAB⊗C {a} {b} {c} o D [ 1●φBC o αD ] ] ≈ D [ FαC o D [ φA⊗BC o φAB●1 ] ] ] |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
256 unitarity-idr : {a b : Obj C } → D [ D [ FρC {a} {b} o D [ φAIC {a} {b} o 1●ψ{a} {b} ] ] ≈ ρD {a} {b} ] |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
257 unitarity-idl : {a b : Obj C } → D [ D [ FλD {a} {b} o D [ φICB {a} {b} o ψ●1 {a} {b} ] ] ≈ λD {a} {b} ] |
696
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
258 |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
259 record MonoidalFunctor {c₁ c₂ ℓ : Level} {C D : Category c₁ c₂ ℓ} ( M : Monoidal C ) ( N : Monoidal D ) |
10ccac3bc285
Monoidal category and applicative functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
260 : Set ( suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁)) where |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
261 field |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
262 MF : Functor C D |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
263 ψ : Hom D (Monoidal.m-i N) (FObj MF (Monoidal.m-i M) ) |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
264 isMonodailFunctor : IsMonoidalFunctor M N MF ψ |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
265 |
731
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
266 ----- |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
267 -- they say it is not possible to prove FreeTheorem in Agda nor Coq |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
268 -- https://stackoverflow.com/questions/24718567/is-it-possible-to-get-hold-of-free-theorems-as-propositional-equalities |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
269 -- so we postulate this |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
270 -- and we cannot indent postulate ... |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
271 postulate FreeTheorem : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (C : Category c₁ c₂ ℓ) (D : Category c₁' c₂' ℓ') {a b c : Obj C } → (F : Functor C D ) → ( fmap : {a : Obj C } {b : Obj C } → Hom C a b → Hom D (FObj F a) ( FObj F b) ) → {h f : Hom C a b } → {g k : Hom C b c } → C [ C [ g o h ] ≈ C [ k o f ] ] → D [ D [ FMap F g o fmap h ] ≈ D [ fmap k o FMap F f ] ] |
732
2439a142aba2
add Monad to Monoidal Functor / Applicative
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
731
diff
changeset
|
272 |
731
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
273 UniquenessOfFunctor : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (C : Category c₁ c₂ ℓ) (D : Category c₁' c₂' ℓ') (F : Functor C D) |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
274 {a b : Obj C } { f : Hom C a b } → ( fmap : {a : Obj C } {b : Obj C } → Hom C a b → Hom D (FObj F a) ( FObj F b) ) |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
275 → ( {b : Obj C } → D [ fmap (id1 C b) ≈ id1 D (FObj F b) ] ) |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
276 → D [ fmap f ≈ FMap F f ] |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
277 UniquenessOfFunctor C D F {a} {b} {f} fmap eq = begin |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
278 fmap f |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
279 ≈↑⟨ idL ⟩ |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
280 id1 D (FObj F b) o fmap f |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
281 ≈↑⟨ car ( IsFunctor.identity (isFunctor F )) ⟩ |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
282 FMap F (id1 C b) o fmap f |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
283 ≈⟨ FreeTheorem C D F fmap (IsEquivalence.refl (IsCategory.isEquivalence ( Category.isCategory C ))) ⟩ |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
284 fmap (id1 C b) o FMap F f |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
285 ≈⟨ car eq ⟩ |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
286 id1 D (FObj F b) o FMap F f |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
287 ≈⟨ idL ⟩ |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
288 FMap F f |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
289 ∎ |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
290 where open ≈-Reasoning D |
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
291 |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
292 open import Category.Sets |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
293 |
706 | 294 import Relation.Binary.PropositionalEquality |
295 -- Extensionality a b = {A : Set a} {B : A → Set b} {f g : (x : A) → B x} → (∀ x → f x ≡ g x) → f ≡ g → ( λ x → f x ≡ λ x → g x ) | |
296 postulate extensionality : { c₁ c₂ ℓ : Level} ( A : Category c₁ c₂ ℓ ) → Relation.Binary.PropositionalEquality.Extensionality c₂ c₂ | |
297 | |
730 | 298 ------ |
299 -- Data.Product as a Tensor Product for Monoidal Category | |
300 -- | |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
301 |
708 | 302 SetsTensorProduct : {c : Level} → Functor ( Sets {c} × Sets {c} ) (Sets {c}) |
303 SetsTensorProduct = record { | |
304 FObj = λ x → proj₁ x * proj₂ x | |
305 ; FMap = λ {x : Obj ( Sets × Sets ) } {y} f → map (proj₁ f) (proj₂ f) | |
306 ; isFunctor = record { | |
307 ≈-cong = ≈-cong | |
308 ; identity = refl | |
309 ; distr = refl | |
706 | 310 } |
708 | 311 } where |
312 ≈-cong : {a b : Obj (Sets × Sets)} {f g : Hom (Sets × Sets) a b} → | |
313 (Sets × Sets) [ f ≈ g ] → Sets [ map (proj₁ f) (proj₂ f) ≈ map (proj₁ g) (proj₂ g) ] | |
314 ≈-cong (refl , refl) = refl | |
315 | |
730 | 316 ----- |
317 -- | |
318 -- Sets as Monoidal Category | |
319 -- | |
320 -- almost all comutativities are refl | |
321 -- | |
322 -- | |
323 -- | |
708 | 324 |
730 | 325 data One {c : Level} : Set c where |
326 OneObj : One -- () in Haskell ( or any one object set ) | |
708 | 327 |
328 MonoidalSets : {c : Level} → Monoidal (Sets {c}) | |
727
ea84cc6c1797
monoidal functor and applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
726
diff
changeset
|
329 MonoidalSets {c} = record { |
ea84cc6c1797
monoidal functor and applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
726
diff
changeset
|
330 m-i = One {c} ; |
708 | 331 m-bi = SetsTensorProduct ; |
332 isMonoidal = record { | |
333 mα-iso = record { ≅→ = mα→ ; ≅← = mα← ; iso→ = refl ; iso← = refl } ; | |
334 mλ-iso = record { ≅→ = mλ→ ; ≅← = mλ← ; iso→ = extensionality Sets ( λ x → mλiso x ) ; iso← = refl } ; | |
335 mρ-iso = record { ≅→ = mρ→ ; ≅← = mρ← ; iso→ = extensionality Sets ( λ x → mρiso x ) ; iso← = refl } ; | |
336 mα→nat1 = λ f → refl ; | |
337 mα→nat2 = λ f → refl ; | |
338 mα→nat3 = λ f → refl ; | |
339 mλ→nat = λ f → refl ; | |
340 mρ→nat = λ f → refl ; | |
341 comm-penta = refl ; | |
342 comm-unit = refl | |
343 } | |
344 } where | |
345 _⊗_ : ( a b : Obj Sets ) → Obj Sets | |
346 _⊗_ a b = FObj SetsTensorProduct (a , b ) | |
730 | 347 -- association operations |
708 | 348 mα→ : {a b c : Obj Sets} → Hom Sets ( ( a ⊗ b ) ⊗ c ) ( a ⊗ ( b ⊗ c ) ) |
349 mα→ ((a , b) , c ) = (a , ( b , c ) ) | |
350 mα← : {a b c : Obj Sets} → Hom Sets ( a ⊗ ( b ⊗ c ) ) ( ( a ⊗ b ) ⊗ c ) | |
351 mα← (a , ( b , c ) ) = ((a , b) , c ) | |
730 | 352 -- (One , a) ⇔ a |
708 | 353 mλ→ : {a : Obj Sets} → Hom Sets ( One ⊗ a ) a |
354 mλ→ (_ , a) = a | |
355 mλ← : {a : Obj Sets} → Hom Sets a ( One ⊗ a ) | |
356 mλ← a = ( OneObj , a ) | |
357 mλiso : {a : Obj Sets} (x : One ⊗ a) → (Sets [ mλ← o mλ→ ]) x ≡ id1 Sets (One ⊗ a) x | |
358 mλiso (OneObj , _ ) = refl | |
730 | 359 -- (a , One) ⇔ a |
708 | 360 mρ→ : {a : Obj Sets} → Hom Sets ( a ⊗ One ) a |
361 mρ→ (a , _) = a | |
362 mρ← : {a : Obj Sets} → Hom Sets a ( a ⊗ One ) | |
363 mρ← a = ( a , OneObj ) | |
364 mρiso : {a : Obj Sets} (x : a ⊗ One ) → (Sets [ mρ← o mρ→ ]) x ≡ id1 Sets (a ⊗ One) x | |
365 mρiso (_ , OneObj ) = refl | |
366 | |
710 | 367 ≡-cong = Relation.Binary.PropositionalEquality.cong |
706 | 368 |
713 | 369 |
370 record IsHaskellMonoidalFunctor {c₁ : Level} ( F : Functor (Sets {c₁}) (Sets {c₁}) ) | |
371 ( unit : FObj F One ) | |
372 ( φ : {a b : Obj Sets} → Hom Sets ((FObj F a) * (FObj F b )) ( FObj F ( a * b ) ) ) | |
373 : Set (suc (suc c₁)) where | |
374 isM : IsMonoidal (Sets {c₁}) One SetsTensorProduct | |
375 isM = Monoidal.isMonoidal MonoidalSets | |
376 open IsMonoidal | |
377 field | |
715 | 378 natφ : { a b c d : Obj Sets } { x : FObj F a} { y : FObj F b} { f : a → c } { g : b → d } |
713 | 379 → FMap F (map f g) (φ (x , y)) ≡ φ (FMap F f x , FMap F g y) |
715 | 380 assocφ : { x y z : Obj Sets } { a : FObj F x } { b : FObj F y }{ c : FObj F z } |
713 | 381 → φ (a , φ (b , c)) ≡ FMap F (Iso.≅→ (mα-iso isM)) (φ (φ (a , b) , c)) |
715 | 382 idrφ : {a : Obj Sets } { x : FObj F a } → FMap F (Iso.≅→ (mρ-iso isM)) (φ (x , unit)) ≡ x |
383 idlφ : {a : Obj Sets } { x : FObj F a } → FMap F (Iso.≅→ (mλ-iso isM)) (φ (unit , x)) ≡ x | |
713 | 384 |
714 | 385 -- http://www.staff.city.ac.uk/~ross/papers/Applicative.pdf |
386 -- naturality of φ fmap(f × g)(φ u v) = φ ( fmap f u) ( fmap g v ) | |
387 -- left identity fmap snd (φ unit v) = v | |
388 -- right identity fmap fst (φ u unit) = u | |
389 -- associativity fmap assoc (φ u (φ v w)) = φ (φ u v) w | |
390 | |
391 | |
730 | 392 record HaskellMonoidalFunctor {c₁ : Level} ( F : Functor (Sets {c₁}) (Sets {c₁}) ) |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
393 : Set (suc (suc c₁)) where |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
394 field |
730 | 395 unit : FObj F One |
396 φ : {a b : Obj Sets} → Hom Sets ((FObj F a) * (FObj F b )) ( FObj F ( a * b ) ) | |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
397 |
730 | 398 HaskellMonoidalFunctor→MonoidalFunctor : {c : Level} ( F : Functor (Sets {c}) (Sets {c}) ) → (mf : HaskellMonoidalFunctor F ) |
713 | 399 → IsHaskellMonoidalFunctor F ( HaskellMonoidalFunctor.unit mf ) ( HaskellMonoidalFunctor.φ mf ) |
400 → MonoidalFunctor {_} {c} {_} {Sets} {Sets} MonoidalSets MonoidalSets | |
730 | 401 HaskellMonoidalFunctor→MonoidalFunctor {c} F mf ismf = record { |
709 | 402 MF = F |
403 ; ψ = λ _ → HaskellMonoidalFunctor.unit mf | |
404 ; isMonodailFunctor = record { | |
711 | 405 φab = record { TMap = λ x → φ ; isNTrans = record { commute = comm0 } } |
406 ; associativity = λ {a b c} → comm1 {a} {b} {c} | |
710 | 407 ; unitarity-idr = λ {a b} → comm2 {a} {b} |
408 ; unitarity-idl = λ {a b} → comm3 {a} {b} | |
709 | 409 } |
410 } where | |
411 open Monoidal | |
412 open IsMonoidal hiding ( _■_ ; _□_ ) | |
730 | 413 M : Monoidal (Sets {c}) |
709 | 414 M = MonoidalSets |
730 | 415 isM : IsMonoidal (Sets {c}) One SetsTensorProduct |
709 | 416 isM = Monoidal.isMonoidal MonoidalSets |
730 | 417 unit : FObj F One |
709 | 418 unit = HaskellMonoidalFunctor.unit mf |
419 _⊗_ : (x y : Obj Sets ) → Obj Sets | |
420 _⊗_ x y = (IsMonoidal._□_ (Monoidal.isMonoidal M) ) x y | |
421 _□_ : {a b c d : Obj Sets } ( f : Hom Sets a c ) ( g : Hom Sets b d ) → Hom Sets ( a ⊗ b ) ( c ⊗ d ) | |
422 _□_ f g = FMap (m-bi M) ( f , g ) | |
711 | 423 φ : {x : Obj (Sets × Sets) } → Hom Sets (FObj (Functor● Sets Sets MonoidalSets F) x) (FObj (Functor⊗ Sets Sets MonoidalSets F) x) |
424 φ z = HaskellMonoidalFunctor.φ mf z | |
710 | 425 comm00 : {a b : Obj (Sets × Sets)} { f : Hom (Sets × Sets) a b} (x : ( FObj F (proj₁ a) * FObj F (proj₂ a)) ) → |
711 | 426 (Sets [ FMap (Functor⊗ Sets Sets MonoidalSets F) f o φ ]) x ≡ (Sets [ φ o FMap (Functor● Sets Sets MonoidalSets F) f ]) x |
710 | 427 comm00 {a} {b} {(f , g)} (x , y) = begin |
711 | 428 (FMap (Functor⊗ Sets Sets MonoidalSets F) (f , g) ) (φ (x , y)) |
710 | 429 ≡⟨⟩ |
711 | 430 (FMap F ( f □ g ) ) (φ (x , y)) |
710 | 431 ≡⟨⟩ |
711 | 432 FMap F ( map f g ) (φ (x , y)) |
715 | 433 ≡⟨ IsHaskellMonoidalFunctor.natφ ismf ⟩ |
711 | 434 φ ( FMap F f x , FMap F g y ) |
710 | 435 ≡⟨⟩ |
711 | 436 φ ( ( FMap F f □ FMap F g ) (x , y) ) |
710 | 437 ≡⟨⟩ |
711 | 438 φ ((FMap (Functor● Sets Sets MonoidalSets F) (f , g) ) (x , y) ) |
710 | 439 ∎ |
440 where | |
713 | 441 open Relation.Binary.PropositionalEquality.≡-Reasoning |
711 | 442 comm0 : {a b : Obj (Sets × Sets)} { f : Hom (Sets × Sets) a b} → Sets [ Sets [ FMap (Functor⊗ Sets Sets MonoidalSets F) f o φ ] |
443 ≈ Sets [ φ o FMap (Functor● Sets Sets MonoidalSets F) f ] ] | |
710 | 444 comm0 {a} {b} {f} = extensionality Sets ( λ (x : ( FObj F (proj₁ a) * FObj F (proj₂ a)) ) → comm00 x ) |
711 | 445 comm10 : {a b c : Obj Sets} → (x : ((FObj F a ⊗ FObj F b) ⊗ FObj F c) ) → (Sets [ φ o Sets [ id1 Sets (FObj F a) □ φ o Iso.≅→ (mα-iso isM) ] ]) x ≡ |
446 (Sets [ FMap F (Iso.≅→ (mα-iso isM)) o Sets [ φ o φ □ id1 Sets (FObj F c) ] ]) x | |
710 | 447 comm10 {x} {y} {f} ((a , b) , c ) = begin |
711 | 448 φ (( id1 Sets (FObj F x) □ φ ) ( ( Iso.≅→ (mα-iso isM) ) ((a , b) , c))) |
710 | 449 ≡⟨⟩ |
711 | 450 φ ( a , φ (b , c)) |
715 | 451 ≡⟨ IsHaskellMonoidalFunctor.assocφ ismf ⟩ |
711 | 452 ( FMap F (Iso.≅→ (mα-iso isM))) (φ (( φ (a , b)) , c )) |
710 | 453 ≡⟨⟩ |
711 | 454 ( FMap F (Iso.≅→ (mα-iso isM))) (φ (( φ □ id1 Sets (FObj F f) ) ((a , b) , c))) |
710 | 455 ∎ |
456 where | |
713 | 457 open Relation.Binary.PropositionalEquality.≡-Reasoning |
711 | 458 comm1 : {a b c : Obj Sets} → Sets [ Sets [ φ |
459 o Sets [ (id1 Sets (FObj F a) □ φ ) o Iso.≅→ (mα-iso isM) ] ] | |
460 ≈ Sets [ FMap F (Iso.≅→ (mα-iso isM)) o Sets [ φ o (φ □ id1 Sets (FObj F c)) ] ] ] | |
710 | 461 comm1 {a} {b} {c} = extensionality Sets ( λ x → comm10 x ) |
712 | 462 comm20 : {a b : Obj Sets} ( x : FObj F a * One ) → ( Sets [ |
463 FMap F (Iso.≅→ (mρ-iso isM)) o Sets [ φ o | |
464 FMap (m-bi MonoidalSets) (id1 Sets (FObj F a) , (λ _ → unit )) ] ] ) x ≡ Iso.≅→ (mρ-iso isM) x | |
465 comm20 {a} {b} (x , OneObj ) = begin | |
466 (FMap F (Iso.≅→ (mρ-iso isM))) ( φ ( x , unit ) ) | |
715 | 467 ≡⟨ IsHaskellMonoidalFunctor.idrφ ismf ⟩ |
712 | 468 x |
469 ≡⟨⟩ | |
470 Iso.≅→ (mρ-iso isM) ( x , OneObj ) | |
471 ∎ | |
472 where | |
713 | 473 open Relation.Binary.PropositionalEquality.≡-Reasoning |
709 | 474 comm2 : {a b : Obj Sets} → Sets [ Sets [ |
711 | 475 FMap F (Iso.≅→ (mρ-iso isM)) o Sets [ φ o |
709 | 476 FMap (m-bi MonoidalSets) (id1 Sets (FObj F a) , (λ _ → unit )) ] ] ≈ Iso.≅→ (mρ-iso isM) ] |
712 | 477 comm2 {a} {b} = extensionality Sets ( λ x → comm20 {a} {b} x ) |
478 comm30 : {a b : Obj Sets} ( x : One * FObj F b ) → ( Sets [ | |
479 FMap F (Iso.≅→ (mλ-iso isM)) o Sets [ φ o | |
480 FMap (m-bi MonoidalSets) ((λ _ → unit ) , id1 Sets (FObj F b) ) ] ] ) x ≡ Iso.≅→ (mλ-iso isM) x | |
481 comm30 {a} {b} ( OneObj , x) = begin | |
482 (FMap F (Iso.≅→ (mλ-iso isM))) ( φ ( unit , x ) ) | |
715 | 483 ≡⟨ IsHaskellMonoidalFunctor.idlφ ismf ⟩ |
712 | 484 x |
485 ≡⟨⟩ | |
486 Iso.≅→ (mλ-iso isM) ( OneObj , x ) | |
487 ∎ | |
711 | 488 where |
713 | 489 open Relation.Binary.PropositionalEquality.≡-Reasoning |
709 | 490 comm3 : {a b : Obj Sets} → Sets [ Sets [ FMap F (Iso.≅→ (mλ-iso isM)) o |
711 | 491 Sets [ φ o FMap (m-bi MonoidalSets) ((λ _ → unit ) , id1 Sets (FObj F b)) ] ] ≈ Iso.≅→ (mλ-iso isM) ] |
712 | 492 comm3 {a} {b} = extensionality Sets ( λ x → comm30 {a} {b} x ) |
709 | 493 |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
494 |
720 | 495 _・_ : {c₁ : Level} { a b c : Obj (Sets {c₁} ) } → (b → c) → (a → b) → a → c |
496 _・_ f g = λ x → f ( g x ) | |
713 | 497 |
498 record IsApplicative {c₁ : Level} ( f : Functor (Sets {c₁}) (Sets {c₁}) ) | |
499 ( pure : {a : Obj Sets} → Hom Sets a ( FObj f a ) ) | |
500 ( _<*>_ : {a b : Obj Sets} → FObj f ( a → b ) → FObj f a → FObj f b ) | |
501 : Set (suc (suc c₁)) where | |
502 field | |
503 identity : { a : Obj Sets } { u : FObj f a } → pure ( id1 Sets a ) <*> u ≡ u | |
504 composition : { a b c : Obj Sets } { u : FObj f ( b → c ) } { v : FObj f (a → b ) } { w : FObj f a } | |
505 → (( pure _・_ <*> u ) <*> v ) <*> w ≡ u <*> (v <*> w) | |
506 homomorphism : { a b : Obj Sets } { f : Hom Sets a b } { x : a } → pure f <*> pure x ≡ pure (f x) | |
507 interchange : { a b : Obj Sets } { u : FObj f ( a → b ) } { x : a } → u <*> pure x ≡ pure (λ f → f x) <*> u | |
730 | 508 -- from http://www.staff.city.ac.uk/~ross/papers/Applicative.pdf |
713 | 509 |
510 record Applicative {c₁ : Level} ( F : Functor (Sets {c₁}) (Sets {c₁}) ) | |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
511 : Set (suc (suc c₁)) where |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
512 field |
713 | 513 pure : {a : Obj Sets} → Hom Sets a ( FObj F a ) |
514 <*> : {a b : Obj Sets} → FObj F ( a → b ) → FObj F a → FObj F b | |
730 | 515 |
516 ------ | |
517 -- | |
518 -- Applicative ⇔ Monoidal | |
519 -- | |
520 -- | |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
521 |
713 | 522 lemma1 : {c₁ : Level} ( F : Functor (Sets {c₁}) (Sets {c₁}) ) → Applicative F → HaskellMonoidalFunctor F |
523 lemma1 F app = record { unit = unit ; φ = φ } | |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
524 where |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
525 open Applicative |
713 | 526 unit : FObj F One |
706 | 527 unit = pure app OneObj |
713 | 528 φ : {a b : Obj Sets} → Hom Sets ((FObj F a) * (FObj F b )) ( FObj F ( a * b ) ) |
529 φ {a} {b} ( x , y ) = <*> app (FMap F (λ j k → (j , k)) x) y | |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
530 |
713 | 531 lemma2 : {c₁ : Level} ( F : Functor (Sets {c₁}) (Sets {c₁}) ) → HaskellMonoidalFunctor F → Applicative F |
532 lemma2 F mono = record { pure = pure ; <*> = <*> } | |
705
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
533 where |
73a998711118
add Applicative and HaskellMonoidal Functor
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
704
diff
changeset
|
534 open HaskellMonoidalFunctor |
713 | 535 pure : {a : Obj Sets} → Hom Sets a ( FObj F a ) |
536 pure {a} x = FMap F ( λ y → x ) (unit mono) | |
730 | 537 <*> : {a b : Obj Sets} → FObj F ( a → b ) → FObj F a → FObj F b |
715 | 538 <*> {a} {b} x y = FMap F ( λ r → ( proj₁ r ) ( proj₂ r ) ) (φ mono ( x , y )) |
713 | 539 |
730 | 540 ------ |
541 -- | |
542 -- Appllicative Functor is a Monoidal Functor | |
543 -- | |
544 | |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
545 Applicative→Monoidal : {c : Level} ( F : Functor (Sets {c}) (Sets {c}) ) → (mf : Applicative F ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
546 → IsApplicative F ( Applicative.pure mf ) ( Applicative.<*> mf ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
547 → MonoidalFunctor {_} {c} {_} {Sets} {Sets} MonoidalSets MonoidalSets |
727
ea84cc6c1797
monoidal functor and applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
726
diff
changeset
|
548 Applicative→Monoidal {l} F mf ismf = record { |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
549 MF = F |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
550 ; ψ = λ x → unit |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
551 ; isMonodailFunctor = record { |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
552 φab = record { TMap = λ x → φ ; isNTrans = record { commute = comm0 } } |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
553 ; associativity = λ {a b c} → comm1 {a} {b} {c} |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
554 ; unitarity-idr = λ {a b} → comm2 {a} {b} |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
555 ; unitarity-idl = λ {a b} → comm3 {a} {b} |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
556 } |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
557 } where |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
558 open Monoidal |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
559 open IsMonoidal hiding ( _■_ ; _□_ ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
560 M = MonoidalSets |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
561 isM = Monoidal.isMonoidal MonoidalSets |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
562 unit = Applicative.pure mf OneObj |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
563 _⊗_ : (x y : Obj Sets ) → Obj Sets |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
564 _⊗_ x y = (IsMonoidal._□_ (Monoidal.isMonoidal M) ) x y |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
565 _□_ : {a b c d : Obj Sets } ( f : Hom Sets a c ) ( g : Hom Sets b d ) → Hom Sets ( a ⊗ b ) ( c ⊗ d ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
566 _□_ f g = FMap (m-bi M) ( f , g ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
567 φ : {x : Obj (Sets × Sets) } → Hom Sets (FObj (Functor● Sets Sets MonoidalSets F) x) (FObj (Functor⊗ Sets Sets MonoidalSets F) x) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
568 φ x = Applicative.<*> mf (FMap F (λ j k → (j , k)) (proj₁ x )) (proj₂ x) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
569 _<*>_ : {a b : Obj Sets} → FObj F ( a → b ) → FObj F a → FObj F b |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
570 _<*>_ = Applicative.<*> mf |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
571 left : {a b : Obj Sets} → {x y : FObj F ( a → b )} → {h : FObj F a } → ( x ≡ y ) → x <*> h ≡ y <*> h |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
572 left {_} {_} {_} {_} {h} eq = ≡-cong ( λ k → k <*> h ) eq |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
573 right : {a b : Obj Sets} → {h : FObj F ( a → b )} → {x y : FObj F a } → ( x ≡ y ) → h <*> x ≡ h <*> y |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
574 right {_} {_} {h} {_} {_} eq = ≡-cong ( λ k → h <*> k ) eq |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
575 id : { a : Obj Sets } → a → a |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
576 id x = x |
720 | 577 pure : {a : Obj Sets } → Hom Sets a ( FObj F a ) |
578 pure a = Applicative.pure mf a | |
725 | 579 -- special case |
580 F→pureid : {a b : Obj Sets } → (x : FObj F a ) → FMap F id x ≡ pure id <*> x | |
581 F→pureid {a} {b} x = sym ( begin | |
722
69f01b82dfc9
uniquness of functor fmap
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
721
diff
changeset
|
582 pure id <*> x |
69f01b82dfc9
uniquness of functor fmap
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
721
diff
changeset
|
583 ≡⟨ IsApplicative.identity ismf ⟩ |
69f01b82dfc9
uniquness of functor fmap
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
721
diff
changeset
|
584 x |
69f01b82dfc9
uniquness of functor fmap
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
721
diff
changeset
|
585 ≡⟨ ≡-cong ( λ k → k x ) (sym ( IsFunctor.identity (isFunctor F ) )) ⟩ FMap F id x |
69f01b82dfc9
uniquness of functor fmap
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
721
diff
changeset
|
586 ∎ ) |
69f01b82dfc9
uniquness of functor fmap
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
721
diff
changeset
|
587 where |
69f01b82dfc9
uniquness of functor fmap
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
721
diff
changeset
|
588 open Relation.Binary.PropositionalEquality |
69f01b82dfc9
uniquness of functor fmap
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
721
diff
changeset
|
589 open Relation.Binary.PropositionalEquality.≡-Reasoning |
725 | 590 F→pure : {a b : Obj Sets } → { f : a → b } → {x : FObj F a } → FMap F f x ≡ pure f <*> x |
591 F→pure {a} {b} {f} {x} = sym ( begin | |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
592 pure f <*> x |
731
117e5b392673
Generalize Free Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
730
diff
changeset
|
593 ≡⟨ ≡-cong ( λ k → k x ) (UniquenessOfFunctor Sets Sets F ( λ f x → pure f <*> x ) ( extensionality Sets ( λ x → IsApplicative.identity ismf ))) ⟩ |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
594 FMap F f x |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
595 ∎ ) |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
596 where |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
597 open Relation.Binary.PropositionalEquality |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
598 open Relation.Binary.PropositionalEquality.≡-Reasoning |
725 | 599 p*p : { a b : Obj Sets } { f : Hom Sets a b } { x : a } → pure f <*> pure x ≡ pure (f x) |
600 p*p = IsApplicative.homomorphism ismf | |
601 comp = IsApplicative.composition ismf | |
602 inter = IsApplicative.interchange ismf | |
729 | 603 pureAssoc : {a b c : Obj Sets } ( f : b → c ) ( g : a → b ) ( h : FObj F a ) → pure f <*> ( pure g <*> h ) ≡ pure ( f ・ g ) <*> h |
604 pureAssoc f g h = trans ( trans (sym comp) (left (left p*p) )) ( left p*p ) | |
605 where | |
606 open Relation.Binary.PropositionalEquality | |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
607 comm00 : {a b : Obj (Sets × Sets)} { f : Hom (Sets × Sets) a b} (x : ( FObj F (proj₁ a) * FObj F (proj₂ a)) ) → |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
608 (Sets [ FMap (Functor⊗ Sets Sets MonoidalSets F) f o φ ]) x ≡ (Sets [ φ o FMap (Functor● Sets Sets MonoidalSets F) f ]) x |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
609 comm00 {a} {b} {(f , g)} (x , y) = begin |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
610 ( FMap (Functor⊗ Sets Sets MonoidalSets F) (f , g) ) ( φ (x , y) ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
611 ≡⟨⟩ |
725 | 612 FMap F (λ xy → f (proj₁ xy) , g (proj₂ xy)) ((FMap F (λ j k → j , k) x) <*> y) |
613 ≡⟨⟩ | |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
614 FMap F (map f g) ((FMap F (λ j k → j , k) x) <*> y) |
725 | 615 ≡⟨ F→pure ⟩ |
616 (pure (map f g) <*> (FMap F (λ j k → j , k) x <*> y)) | |
617 ≡⟨ right ( left F→pure ) ⟩ | |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
618 (pure (map f g)) <*> ((pure (λ j k → j , k) <*> x) <*> y) |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
619 ≡⟨ sym ( IsApplicative.composition ismf ) ⟩ |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
620 (( pure _・_ <*> (pure (map f g))) <*> (pure (λ j k → j , k) <*> x)) <*> y |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
621 ≡⟨ left ( sym ( IsApplicative.composition ismf )) ⟩ |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
622 ((( pure _・_ <*> (( pure _・_ <*> (pure (map f g))))) <*> pure (λ j k → j , k)) <*> x) <*> y |
725 | 623 ≡⟨ trans ( trans (left ( left (left (right p*p )))) ( left ( left ( left p*p)))) (left (left p*p)) ⟩ |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
624 (pure (( _・_ (( _・_ ((map f g))))) (λ j k → j , k)) <*> x) <*> y |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
625 ≡⟨⟩ |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
626 (pure (λ j k → f j , g k) <*> x) <*> y |
725 | 627 ≡⟨⟩ |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
628 ( pure ((_・_ (( _・_ ( ( λ h → h g ))) ( _・_ ))) ((λ j k → f j , k))) <*> x ) <*> y |
725 | 629 ≡⟨ sym ( trans (left (left (left p*p))) (left ( left p*p)) ) ⟩ |
630 ((((pure _・_ <*> pure ((λ h → h g) ・ _・_)) <*> pure (λ j k → f j , k)) <*> x) <*> y) | |
631 ≡⟨ sym (trans ( left ( left ( left (right (left p*p) )))) (left ( left (left (right p*p ))))) ⟩ | |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
632 (((pure _・_ <*> (( pure _・_ <*> ( pure ( λ h → h g ))) <*> ( pure _・_ ))) <*> (pure (λ j k → f j , k))) <*> x ) <*> y |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
633 ≡⟨ left ( ( IsApplicative.composition ismf )) ⟩ |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
634 ((( pure _・_ <*> ( pure ( λ h → h g ))) <*> ( pure _・_ )) <*> (pure (λ j k → f j , k) <*> x )) <*> y |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
635 ≡⟨ left (IsApplicative.composition ismf ) ⟩ |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
636 ( pure ( λ h → h g ) <*> ( pure _・_ <*> (pure (λ j k → f j , k) <*> x )) ) <*> y |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
637 ≡⟨ left (sym (IsApplicative.interchange ismf )) ⟩ |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
638 (( pure _・_ <*> (pure (λ j k → f j , k) <*> x )) <*> pure g) <*> y |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
639 ≡⟨ IsApplicative.composition ismf ⟩ |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
640 (pure (λ j k → f j , k) <*> x) <*> (pure g <*> y) |
725 | 641 ≡⟨ sym ( trans (left F→pure ) ( right F→pure ) ) ⟩ |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
642 (FMap F (λ j k → f j , k) x) <*> (FMap F g y) |
720 | 643 ≡⟨ ≡-cong ( λ k → k x <*> (FMap F g y)) ( IsFunctor.distr (isFunctor F )) ⟩ |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
644 (FMap F (λ j k → j , k) (FMap F f x)) <*> (FMap F g y) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
645 ≡⟨⟩ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
646 φ ( ( FMap (Functor● Sets Sets MonoidalSets F) (f , g) ) ( x , y ) ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
647 ∎ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
648 where |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
649 open Relation.Binary.PropositionalEquality |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
650 open Relation.Binary.PropositionalEquality.≡-Reasoning |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
651 comm0 : {a b : Obj (Sets × Sets)} { f : Hom (Sets × Sets) a b} → Sets [ Sets [ FMap (Functor⊗ Sets Sets MonoidalSets F) f o φ ] |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
652 ≈ Sets [ φ o FMap (Functor● Sets Sets MonoidalSets F) f ] ] |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
653 comm0 {a} {b} {f} = extensionality Sets ( λ (x : ( FObj F (proj₁ a) * FObj F (proj₂ a)) ) → comm00 x ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
654 comm10 : {a b c : Obj Sets} → (x : ((FObj F a ⊗ FObj F b) ⊗ FObj F c) ) → (Sets [ φ o Sets [ id1 Sets (FObj F a) □ φ o Iso.≅→ (mα-iso isM) ] ]) x ≡ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
655 (Sets [ FMap F (Iso.≅→ (mα-iso isM)) o Sets [ φ o φ □ id1 Sets (FObj F c) ] ]) x |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
656 comm10 {x} {y} {f} ((a , b) , c ) = begin |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
657 φ (( id □ φ ) ( ( Iso.≅→ (mα-iso isM) ) ((a , b) , c))) |
720 | 658 ≡⟨⟩ |
659 (FMap F (λ j k → j , k) a) <*> ( (FMap F (λ j k → j , k) b) <*> c) | |
726 | 660 ≡⟨ trans (left F→pure) (right (left F→pure) ) ⟩ |
725 | 661 (pure (λ j k → j , k) <*> a) <*> ( (pure (λ j k → j , k) <*> b) <*> c) |
726 | 662 ≡⟨ sym comp ⟩ |
725 | 663 ( ( pure _・_ <*> (pure (λ j k → j , k) <*> a)) <*> (pure (λ j k → j , k) <*> b)) <*> c |
726 | 664 ≡⟨ sym ( left comp ) ⟩ |
725 | 665 (( ( pure _・_ <*> ( pure _・_ <*> (pure (λ j k → j , k) <*> a))) <*> (pure (λ j k → j , k))) <*> b) <*> c |
726 | 666 ≡⟨ sym ( left ( left ( left (right comp )))) ⟩ |
725 | 667 (( ( pure _・_ <*> (( (pure _・_ <*> pure _・_ ) <*> (pure (λ j k → j , k))) <*> a)) <*> (pure (λ j k → j , k))) <*> b) <*> c |
726 | 668 ≡⟨ trans (left ( left (left ( right (left ( left p*p )))))) (left ( left ( left (right (left p*p))))) ⟩ |
725 | 669 (( ( pure _・_ <*> ((pure ((_・_ ( _・_ )) ((λ j k → j , k)))) <*> a)) <*> (pure (λ j k → j , k))) <*> b) <*> c |
726 | 670 ≡⟨ sym (left ( left ( left comp ) )) ⟩ |
725 | 671 (((( ( pure _・_ <*> (pure _・_ )) <*> (pure ((_・_ ( _・_ )) ((λ j k → j , k))))) <*> a) <*> (pure (λ j k → j , k))) <*> b) <*> c |
726 | 672 ≡⟨ trans (left ( left ( left (left (left p*p))))) (left ( left ( left (left p*p )))) ⟩ |
725 | 673 ((((pure ( ( _・_ (_・_ )) (((_・_ ( _・_ )) ((λ j k → j , k)))))) <*> a) <*> (pure (λ j k → j , k))) <*> b) <*> c |
674 ≡⟨⟩ | |
675 ((((pure (λ f g x y → f , g x y)) <*> a) <*> (pure (λ j k → j , k))) <*> b) <*> c | |
726 | 676 ≡⟨ left ( left inter ) ⟩ |
725 | 677 (((pure (λ f → f (λ j k → j , k))) <*> ((pure (λ f g x y → f , g x y)) <*> a) ) <*> b) <*> c |
726 | 678 ≡⟨ sym ( left ( left comp )) ⟩ |
725 | 679 (((( pure _・_ <*> (pure (λ f → f (λ j k → j , k)))) <*> (pure (λ f g x y → f , g x y))) <*> a ) <*> b) <*> c |
726 | 680 ≡⟨ trans (left ( left (left (left p*p) ))) (left (left (left p*p ) )) ⟩ |
725 | 681 ((pure (( _・_ (λ f → f (λ j k → j , k))) (λ f g x y → f , g x y)) <*> a ) <*> b) <*> c |
682 ≡⟨⟩ | |
683 (((pure (λ f g h → f , g , h)) <*> a) <*> b) <*> c | |
684 ≡⟨⟩ | |
685 ((pure ((_・_ ((_・_ ((_・_ ( (λ abc → proj₁ (proj₁ abc) , proj₂ (proj₁ abc) , proj₂ abc))))))) | |
686 (( _・_ ( _・_ ((λ j k → j , k)))) (λ j k → j , k))) <*> a) <*> b) <*> c | |
726 | 687 ≡⟨ sym (trans ( left ( left ( left (left (right (right p*p))) ) )) (trans (left (left( left (left (right p*p))))) |
688 (trans (left (left (left (left p*p)))) (trans ( left (left (left (right (left (right p*p )))))) | |
689 (trans (left (left (left (right (left p*p))))) (trans (left (left (left (right p*p)))) (left (left (left p*p)))) ) ) ) | |
690 ) ) ⟩ | |
725 | 691 ((((pure _・_ <*> ((pure _・_ <*> ((pure _・_ <*> ( pure (λ abc → proj₁ (proj₁ abc) , proj₂ (proj₁ abc) , proj₂ abc))))))) <*> |
692 (( pure _・_ <*> ( pure _・_ <*> (pure (λ j k → j , k)))) <*> pure (λ j k → j , k))) <*> a) <*> b) <*> c | |
726 | 693 ≡⟨ left (left comp ) ⟩ |
725 | 694 (((pure _・_ <*> ((pure _・_ <*> ( pure (λ abc → proj₁ (proj₁ abc) , proj₂ (proj₁ abc) , proj₂ abc))))) <*> |
695 ((( pure _・_ <*> ( pure _・_ <*> (pure (λ j k → j , k)))) <*> pure (λ j k → j , k)) <*> a)) <*> b) <*> c | |
726 | 696 ≡⟨ left comp ⟩ |
725 | 697 ((pure _・_ <*> ( pure (λ abc → proj₁ (proj₁ abc) , proj₂ (proj₁ abc) , proj₂ abc))) <*> |
698 (((( pure _・_ <*> ( pure _・_ <*> (pure (λ j k → j , k)))) <*> pure (λ j k → j , k)) <*> a) <*> b)) <*> c | |
726 | 699 ≡⟨ left ( right (left comp )) ⟩ |
725 | 700 ((pure _・_ <*> ( pure (λ abc → proj₁ (proj₁ abc) , proj₂ (proj₁ abc) , proj₂ abc))) <*> |
701 ((( pure _・_ <*> (pure (λ j k → j , k))) <*> (pure (λ j k → j , k) <*> a)) <*> b)) <*> c | |
726 | 702 ≡⟨ left ( right comp ) ⟩ |
725 | 703 ((pure _・_ <*> ( pure (λ abc → proj₁ (proj₁ abc) , proj₂ (proj₁ abc) , proj₂ abc))) <*> |
704 (pure (λ j k → j , k) <*> ( (pure (λ j k → j , k) <*> a) <*> b))) <*> c | |
726 | 705 ≡⟨ comp ⟩ |
725 | 706 pure (λ abc → proj₁ (proj₁ abc) , proj₂ (proj₁ abc) , proj₂ abc) <*> ( (pure (λ j k → j , k) <*> ( (pure (λ j k → j , k) <*> a) <*> b)) <*> c) |
726 | 707 ≡⟨ sym ( trans ( trans F→pure (right (left F→pure ))) ( right ( left (right (left F→pure ))))) ⟩ |
720 | 708 FMap F (λ abc → proj₁ (proj₁ abc) , proj₂ (proj₁ abc) , proj₂ abc) ( (FMap F (λ j k → j , k) ( (FMap F (λ j k → j , k) a) <*> b)) <*> c) |
709 ≡⟨⟩ | |
710 ( FMap F (Iso.≅→ (mα-iso isM))) (φ (( φ □ id1 Sets (FObj F f) ) ((a , b) , c))) | |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
711 ∎ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
712 where |
720 | 713 open Relation.Binary.PropositionalEquality |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
714 open Relation.Binary.PropositionalEquality.≡-Reasoning |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
715 comm1 : {a b c : Obj Sets} → Sets [ Sets [ φ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
716 o Sets [ (id1 Sets (FObj F a) □ φ ) o Iso.≅→ (mα-iso isM) ] ] |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
717 ≈ Sets [ FMap F (Iso.≅→ (mα-iso isM)) o Sets [ φ o (φ □ id1 Sets (FObj F c)) ] ] ] |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
718 comm1 {a} {b} {c} = extensionality Sets ( λ x → comm10 x ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
719 comm20 : {a b : Obj Sets} ( x : FObj F a * One ) → ( Sets [ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
720 FMap F (Iso.≅→ (mρ-iso isM)) o Sets [ φ o |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
721 FMap (m-bi MonoidalSets) (id1 Sets (FObj F a) , (λ _ → unit )) ] ] ) x ≡ Iso.≅→ (mρ-iso isM) x |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
722 comm20 {a} {b} (x , OneObj ) = begin |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
723 (FMap F (Iso.≅→ (mρ-iso isM))) ( φ (( FMap (m-bi MonoidalSets) (id1 Sets (FObj F a) , (λ _ → unit))) (x , OneObj) )) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
724 ≡⟨⟩ |
720 | 725 FMap F proj₁ ((FMap F (λ j k → j , k) x) <*> (pure OneObj)) |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
726 ≡⟨ ≡-cong ( λ k → FMap F proj₁ k) ( IsApplicative.interchange ismf ) ⟩ |
720 | 727 FMap F proj₁ ((pure (λ f → f OneObj)) <*> (FMap F (λ j k → j , k) x)) |
725 | 728 ≡⟨ ( trans F→pure (right ( right F→pure )) ) ⟩ |
729 pure proj₁ <*> ((pure (λ f → f OneObj)) <*> (pure (λ j k → j , k) <*> x)) | |
730 ≡⟨ sym ( right comp ) ⟩ | |
731 pure proj₁ <*> (((pure _・_ <*> (pure (λ f → f OneObj))) <*> pure (λ j k → j , k)) <*> x) | |
732 ≡⟨ sym comp ⟩ | |
733 ( ( pure _・_ <*> (pure proj₁ ) ) <*> ((pure _・_ <*> (pure (λ f → f OneObj))) <*> pure (λ j k → j , k))) <*> x | |
734 ≡⟨ trans ( trans ( trans ( left ( left p*p)) ( left ( right (left p*p) ))) (left (right p*p) ) ) (left p*p) ⟩ | |
727
ea84cc6c1797
monoidal functor and applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
726
diff
changeset
|
735 pure ( ( _・_ (proj₁ {l} {l})) ((_・_ ((λ f → f OneObj))) (λ j k → j , k))) <*> x |
725 | 736 ≡⟨⟩ |
737 pure id <*> x | |
738 ≡⟨ IsApplicative.identity ismf ⟩ | |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
739 x |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
740 ≡⟨⟩ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
741 Iso.≅→ (mρ-iso isM) (x , OneObj) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
742 ∎ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
743 where |
725 | 744 open Relation.Binary.PropositionalEquality |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
745 open Relation.Binary.PropositionalEquality.≡-Reasoning |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
746 comm2 : {a b : Obj Sets} → Sets [ Sets [ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
747 FMap F (Iso.≅→ (mρ-iso isM)) o Sets [ φ o |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
748 FMap (m-bi MonoidalSets) (id1 Sets (FObj F a) , (λ _ → unit )) ] ] ≈ Iso.≅→ (mρ-iso isM) ] |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
749 comm2 {a} {b} = extensionality Sets ( λ x → comm20 {a} {b} x ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
750 comm30 : {a b : Obj Sets} ( x : One * FObj F b ) → ( Sets [ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
751 FMap F (Iso.≅→ (mλ-iso isM)) o Sets [ φ o |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
752 FMap (m-bi MonoidalSets) ((λ _ → unit ) , id1 Sets (FObj F b) ) ] ] ) x ≡ Iso.≅→ (mλ-iso isM) x |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
753 comm30 {a} {b} ( OneObj , x) = begin |
720 | 754 (FMap F (Iso.≅→ (mλ-iso isM))) ( φ ( unit , x ) ) |
755 ≡⟨⟩ | |
756 FMap F proj₂ ((FMap F (λ j k → j , k) (pure OneObj)) <*> x) | |
725 | 757 ≡⟨ ( trans F→pure (right ( left F→pure )) ) ⟩ |
758 pure proj₂ <*> ((pure (λ j k → j , k) <*> (pure OneObj)) <*> x) | |
759 ≡⟨ sym comp ⟩ | |
760 ((pure _・_ <*> (pure proj₂)) <*> (pure (λ j k → j , k) <*> (pure OneObj))) <*> x | |
761 ≡⟨ trans (trans (left (left p*p )) (left ( right p*p)) ) (left p*p) ⟩ | |
727
ea84cc6c1797
monoidal functor and applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
726
diff
changeset
|
762 pure ((_・_ (proj₂ {l}) )((λ (j : One {l}) (k : b ) → j , k) OneObj)) <*> x |
725 | 763 ≡⟨⟩ |
764 pure id <*> x | |
765 ≡⟨ IsApplicative.identity ismf ⟩ | |
720 | 766 x |
767 ≡⟨⟩ | |
768 Iso.≅→ (mλ-iso isM) ( OneObj , x ) | |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
769 ∎ |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
770 where |
725 | 771 open Relation.Binary.PropositionalEquality |
719
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
772 open Relation.Binary.PropositionalEquality.≡-Reasoning |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
773 comm3 : {a b : Obj Sets} → Sets [ Sets [ FMap F (Iso.≅→ (mλ-iso isM)) o |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
774 Sets [ φ o FMap (m-bi MonoidalSets) ((λ _ → unit ) , id1 Sets (FObj F b)) ] ] ≈ Iso.≅→ (mλ-iso isM) ] |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
775 comm3 {a} {b} = extensionality Sets ( λ x → comm30 {a} {b} x ) |
a017ed40dd77
Applicative law → Monoidal law begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
717
diff
changeset
|
776 |
730 | 777 ---- |
778 -- | |
779 -- Monoidal laws imples Applicative laws | |
780 -- | |
713 | 781 |
782 HaskellMonoidal→Applicative : {c₁ : Level} ( F : Functor (Sets {c₁}) (Sets {c₁}) ) | |
783 ( unit : FObj F One ) | |
784 ( φ : {a b : Obj Sets} → Hom Sets ((FObj F a) * (FObj F b )) ( FObj F ( a * b ) ) ) | |
785 ( mono : IsHaskellMonoidalFunctor F unit φ ) | |
715 | 786 → IsApplicative F (λ x → FMap F ( λ y → x ) unit) (λ x y → FMap F ( λ r → ( proj₁ r ) ( proj₂ r ) ) (φ ( x , y ))) |
713 | 787 HaskellMonoidal→Applicative {c₁} F unit φ mono = record { |
788 identity = identity | |
789 ; composition = composition | |
790 ; homomorphism = homomorphism | |
791 ; interchange = interchange | |
792 } | |
793 where | |
714 | 794 id : { a : Obj Sets } → a → a |
795 id x = x | |
713 | 796 isM : IsMonoidal (Sets {c₁}) One SetsTensorProduct |
797 isM = Monoidal.isMonoidal MonoidalSets | |
798 pure : {a : Obj Sets} → Hom Sets a ( FObj F a ) | |
799 pure {a} x = FMap F ( λ y → x ) (unit ) | |
800 _<*>_ : {a b : Obj Sets} → FObj F ( a → b ) → FObj F a → FObj F b | |
715 | 801 _<*>_ {a} {b} x y = FMap F ( λ r → ( proj₁ r ) ( proj₂ r ) ) (φ ( x , y )) |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
802 -- right does not work right it makes yellows. why? |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
803 -- right : {n : Level} { a b : Set n} → { x y : a } { h : a → b } → ( x ≡ y ) → h x ≡ h y |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
804 -- right {_} {_} {_} {_} {_} {h} eq = ≡-cong ( λ k → h k ) eq |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
805 left : {n : Level} { a b : Set n} → { x y : a → b } { h : a } → ( x ≡ y ) → x h ≡ y h |
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
806 left {_} {_} {_} {_} {_} {h} eq = ≡-cong ( λ k → k h ) eq |
715 | 807 open Relation.Binary.PropositionalEquality |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
808 FφF→F : { a b c d e : Obj Sets } { g : Hom Sets a c } { h : Hom Sets b d } |
715 | 809 { f : Hom Sets (c * d) e } |
810 { x : FObj F a } { y : FObj F b } | |
811 → FMap F f ( φ ( FMap F g x , FMap F h y ) ) ≡ FMap F ( f o map g h ) ( φ ( x , y ) ) | |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
812 FφF→F {a} {b} {c} {d} {e} {g} {h} {f} {x} {y} = sym ( begin |
715 | 813 FMap F ( f o map g h ) ( φ ( x , y ) ) |
814 ≡⟨ ≡-cong ( λ k → k ( φ ( x , y ))) ( IsFunctor.distr (isFunctor F) ) ⟩ | |
815 FMap F f (( FMap F ( map g h ) ) ( φ ( x , y ))) | |
816 ≡⟨ ≡-cong ( λ k → FMap F f k ) ( IsHaskellMonoidalFunctor.natφ mono ) ⟩ | |
817 FMap F f ( φ ( FMap F g x , FMap F h y ) ) | |
818 ∎ ) | |
819 where | |
820 open Relation.Binary.PropositionalEquality.≡-Reasoning | |
716 | 821 u→F : {a : Obj Sets } {u : FObj F a} → u ≡ FMap F id u |
822 u→F {a} {u} = sym ( ≡-cong ( λ k → k u ) ( IsFunctor.identity ( isFunctor F ) ) ) | |
823 φunitr : {a : Obj Sets } {u : FObj F a} → φ ( unit , u) ≡ FMap F (Iso.≅← (IsMonoidal.mλ-iso isM)) u | |
824 φunitr {a} {u} = sym ( begin | |
825 FMap F (Iso.≅← (IsMonoidal.mλ-iso isM)) u | |
826 ≡⟨ ≡-cong ( λ k → FMap F (Iso.≅← (IsMonoidal.mλ-iso isM)) k ) (sym (IsHaskellMonoidalFunctor.idlφ mono)) ⟩ | |
827 FMap F (Iso.≅← (IsMonoidal.mλ-iso isM)) ( FMap F (Iso.≅→ (IsMonoidal.mλ-iso isM)) ( φ ( unit , u) ) ) | |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
828 ≡⟨ left ( sym ( IsFunctor.distr ( isFunctor F ) )) ⟩ |
716 | 829 (FMap F ( (Iso.≅← (IsMonoidal.mλ-iso isM)) o (Iso.≅→ (IsMonoidal.mλ-iso isM)))) ( φ ( unit , u) ) |
830 ≡⟨ ≡-cong ( λ k → FMap F k ( φ ( unit , u) )) (Iso.iso→ ( (IsMonoidal.mλ-iso isM) )) ⟩ | |
831 FMap F id ( φ ( unit , u) ) | |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
832 ≡⟨ left ( IsFunctor.identity ( isFunctor F ) ) ⟩ |
716 | 833 id ( φ ( unit , u) ) |
834 ≡⟨⟩ | |
835 φ ( unit , u) | |
836 ∎ ) | |
837 where | |
838 open Relation.Binary.PropositionalEquality.≡-Reasoning | |
839 φunitl : {a : Obj Sets } {u : FObj F a} → φ ( u , unit ) ≡ FMap F (Iso.≅← (IsMonoidal.mρ-iso isM)) u | |
840 φunitl {a} {u} = sym ( begin | |
841 FMap F (Iso.≅← (IsMonoidal.mρ-iso isM)) u | |
842 ≡⟨ ≡-cong ( λ k → FMap F (Iso.≅← (IsMonoidal.mρ-iso isM)) k ) (sym (IsHaskellMonoidalFunctor.idrφ mono)) ⟩ | |
843 FMap F (Iso.≅← (IsMonoidal.mρ-iso isM)) ( FMap F (Iso.≅→ (IsMonoidal.mρ-iso isM)) ( φ ( u , unit ) ) ) | |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
844 ≡⟨ left ( sym ( IsFunctor.distr ( isFunctor F ) )) ⟩ |
716 | 845 (FMap F ( (Iso.≅← (IsMonoidal.mρ-iso isM)) o (Iso.≅→ (IsMonoidal.mρ-iso isM)))) ( φ ( u , unit ) ) |
846 ≡⟨ ≡-cong ( λ k → FMap F k ( φ ( u , unit ) )) (Iso.iso→ ( (IsMonoidal.mρ-iso isM) )) ⟩ | |
847 FMap F id ( φ ( u , unit ) ) | |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
848 ≡⟨ left ( IsFunctor.identity ( isFunctor F ) ) ⟩ |
716 | 849 id ( φ ( u , unit ) ) |
850 ≡⟨⟩ | |
851 φ ( u , unit ) | |
852 ∎ ) | |
853 where | |
854 open Relation.Binary.PropositionalEquality.≡-Reasoning | |
715 | 855 open IsMonoidal |
713 | 856 identity : { a : Obj Sets } { u : FObj F a } → pure ( id1 Sets a ) <*> u ≡ u |
857 identity {a} {u} = begin | |
714 | 858 pure id <*> u |
713 | 859 ≡⟨⟩ |
715 | 860 ( FMap F ( λ r → ( proj₁ r ) ( proj₂ r )) ) ( φ ( FMap F ( λ y → id ) unit , u ) ) |
716 | 861 ≡⟨ ≡-cong ( λ k → ( FMap F ( λ r → ( proj₁ r ) ( proj₂ r )) ) ( φ ( FMap F ( λ y → id ) unit , k ))) u→F ⟩ |
715 | 862 ( FMap F ( λ r → ( proj₁ r ) ( proj₂ r )) ) ( φ ( FMap F ( λ y → id ) unit , FMap F id u ) ) |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
863 ≡⟨ FφF→F ⟩ |
713 | 864 FMap F (λ x → proj₂ x ) (φ (unit , u ) ) |
865 ≡⟨⟩ | |
866 FMap F (Iso.≅→ (mλ-iso isM)) (φ (unit , u )) | |
715 | 867 ≡⟨ IsHaskellMonoidalFunctor.idlφ mono ⟩ |
713 | 868 u |
869 ∎ | |
870 where | |
871 open Relation.Binary.PropositionalEquality.≡-Reasoning | |
872 composition : { a b c : Obj Sets } { u : FObj F ( b → c ) } { v : FObj F (a → b ) } { w : FObj F a } | |
873 → (( pure _・_ <*> u ) <*> v ) <*> w ≡ u <*> (v <*> w) | |
874 composition {a} {b} {c} {u} {v} {w} = begin | |
715 | 875 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ |
876 (FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ y f g x → f (g x)) unit , u)) , v)) , w)) | |
716 | 877 ≡⟨ ≡-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 ⟩ |
715 | 878 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ |
716 | 879 (FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ y f g x → f (g x)) unit , FMap F id u )) , v)) , w)) |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
880 ≡⟨ ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ ( k , v)) , w)) ) FφF→F ⟩ |
715 | 881 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ |
716 | 882 (FMap F ( λ x → (λ r → proj₁ r (proj₂ r)) ((map (λ y f g x → f (g x)) id ) x)) (φ ( unit , u)) , v)) , w)) |
883 ≡⟨ ≡-cong ( λ k → ( FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ | |
884 (FMap F ( λ x → (λ r → proj₁ r (proj₂ r)) ((map (λ y f g x → f (g x)) id ) x)) k , v)) , w)) ) ) φunitr ⟩ | |
715 | 885 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ |
716 | 886 ( (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)) |
887 ≡⟨ ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ | |
888 (k u , v)) , w)) ) (sym ( IsFunctor.distr (isFunctor F ))) ⟩ | |
889 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ | |
890 ( FMap F (λ x → ((λ y f g x₁ → f (g x₁)) unit x) ) u , v)) , w)) | |
714 | 891 ≡⟨⟩ |
715 | 892 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ r → proj₁ r (proj₂ r)) (φ |
716 | 893 ( FMap F (λ x g h → x (g h) ) u , v)) , w)) |
894 ≡⟨ ≡-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 ⟩ | |
895 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)) | |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
896 ≡⟨ ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (k , w)) ) FφF→F ⟩ |
716 | 897 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)) |
715 | 898 ≡⟨⟩ |
716 | 899 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ x h → proj₁ x (proj₂ x h)) (φ (u , v)) , w)) |
900 ≡⟨ ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ x h → proj₁ x (proj₂ x h)) (φ (u , v)) , k)) ) u→F ⟩ | |
901 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ x h → proj₁ x (proj₂ x h)) (φ (u , v)) , FMap F id w)) | |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
902 ≡⟨ FφF→F ⟩ |
716 | 903 FMap F ((λ r → proj₁ r (proj₂ r)) o map (λ x h → proj₁ x (proj₂ x h)) id) (φ (φ (u , v) , w)) |
714 | 904 ≡⟨⟩ |
716 | 905 FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (φ (φ (u , v) , w)) |
906 ≡⟨ ≡-cong ( λ k → FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (k (φ (φ (u , v) , w)) )) (sym (IsFunctor.identity (isFunctor F ))) ⟩ | |
907 FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (FMap F id (φ (φ (u , v) , w)) ) | |
908 ≡⟨ ≡-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))) ⟩ | |
909 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)) ) | |
910 ≡⟨ ≡-cong ( λ k → FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (k (φ (φ (u , v) , w)))) ( IsFunctor.distr (isFunctor F )) ⟩ | |
911 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)) )) | |
912 ≡⟨ ≡-cong ( λ k → FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (FMap F (Iso.≅← (mα-iso isM)) k) ) (sym ( IsHaskellMonoidalFunctor.assocφ mono ) ) ⟩ | |
913 FMap F (λ x → proj₁ (proj₁ x) (proj₂ (proj₁ x) (proj₂ x))) (FMap F (Iso.≅← (mα-iso isM)) (φ (u , φ (v , w)))) | |
715 | 914 ≡⟨⟩ |
716 | 915 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)))) |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
916 ≡⟨ left (sym ( IsFunctor.distr (isFunctor F ))) ⟩ |
716 | 917 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))) |
715 | 918 ≡⟨⟩ |
716 | 919 FMap F (λ y → proj₁ y (proj₁ (proj₂ y) (proj₂ (proj₂ y)))) (φ (u , φ (v , w))) |
715 | 920 ≡⟨⟩ |
921 FMap F ( λ x → (proj₁ x) ((λ r → proj₁ r (proj₂ r)) ( proj₂ x))) ( φ ( u , (φ (v , w)))) | |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
922 ≡⟨ sym FφF→F ⟩ |
715 | 923 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F id u , FMap F (λ r → proj₁ r (proj₂ r)) (φ (v , w)))) |
716 | 924 ≡⟨ ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (k , FMap F (λ r → proj₁ r (proj₂ r)) (φ (v , w)))) ) (sym u→F ) ⟩ |
715 | 925 FMap F (λ r → proj₁ r (proj₂ r)) (φ (u , FMap F (λ r → proj₁ r (proj₂ r)) (φ (v , w)))) |
713 | 926 ∎ |
927 where | |
928 open Relation.Binary.PropositionalEquality.≡-Reasoning | |
929 homomorphism : { a b : Obj Sets } { f : Hom Sets a b } { x : a } → pure f <*> pure x ≡ pure (f x) | |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
930 homomorphism {a} {b} {f} {x} = begin |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
931 pure f <*> pure x |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
932 ≡⟨⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
933 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ y → f) unit , FMap F (λ y → x) unit)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
934 ≡⟨ FφF→F ⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
935 FMap F ((λ r → proj₁ r (proj₂ r)) o map (λ y → f) (λ y → x)) (φ (unit , unit)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
936 ≡⟨⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
937 FMap F (λ y → f x) (φ (unit , unit)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
938 ≡⟨ ≡-cong ( λ k → FMap F (λ y → f x) k ) φunitl ⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
939 FMap F (λ y → f x) (FMap F (Iso.≅← (mρ-iso isM)) unit) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
940 ≡⟨⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
941 FMap F (λ y → f x) (FMap F (λ y → (y , OneObj)) unit) |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
942 ≡⟨ left ( sym ( IsFunctor.distr (isFunctor F ))) ⟩ |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
943 FMap F (λ y → f x) unit |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
944 ≡⟨⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
945 pure (f x) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
946 ∎ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
947 where |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
948 open Relation.Binary.PropositionalEquality.≡-Reasoning |
713 | 949 interchange : { a b : Obj Sets } { u : FObj F ( a → b ) } { x : a } → u <*> pure x ≡ pure (λ f → f x) <*> u |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
950 interchange {a} {b} {u} {x} = begin |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
951 u <*> pure x |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
952 ≡⟨⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
953 FMap F (λ r → proj₁ r (proj₂ r)) (φ (u , FMap F (λ y → x) unit)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
954 ≡⟨ ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (k , FMap F (λ y → x) unit)) ) u→F ⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
955 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F id u , FMap F (λ y → x) unit)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
956 ≡⟨ FφF→F ⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
957 FMap F ((λ r → proj₁ r (proj₂ r)) o map id (λ y → x)) (φ (u , unit)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
958 ≡⟨⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
959 FMap F (λ r → proj₁ r x) (φ (u , unit)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
960 ≡⟨ ≡-cong ( λ k → FMap F (λ r → proj₁ r x) k ) φunitl ⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
961 FMap F (λ r → proj₁ r x) (( FMap F (Iso.≅← (mρ-iso isM))) u ) |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
962 ≡⟨ left ( sym ( IsFunctor.distr (isFunctor F )) ) ⟩ |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
963 FMap F (( λ r → proj₁ r x) o ((Iso.≅← (mρ-iso isM) ))) u |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
964 ≡⟨⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
965 FMap F (( λ r → proj₂ r x) o ((Iso.≅← (mλ-iso isM) ))) u |
721
a8b595fb4905
use FMap F f x ≡ pure f <*> x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
720
diff
changeset
|
966 ≡⟨ left ( IsFunctor.distr (isFunctor F )) ⟩ |
717
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
967 FMap F (λ r → proj₂ r x) (FMap F (Iso.≅← (IsMonoidal.mλ-iso isM)) u) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
968 ≡⟨ ≡-cong ( λ k → FMap F (λ r → proj₂ r x) k ) (sym φunitr ) ⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
969 FMap F (λ r → proj₂ r x) (φ (unit , u)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
970 ≡⟨⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
971 FMap F ((λ r → proj₁ r (proj₂ r)) o map (λ y f → f x) id) (φ (unit , u)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
972 ≡⟨ sym FφF→F ⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
973 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ y f → f x) unit , FMap F id u)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
974 ≡⟨ ≡-cong ( λ k → FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ y f → f x) unit , k)) ) (sym u→F) ⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
975 FMap F (λ r → proj₁ r (proj₂ r)) (φ (FMap F (λ y f → f x) unit , u)) |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
976 ≡⟨⟩ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
977 pure (λ f → f x) <*> u |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
978 ∎ |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
979 where |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
980 open Relation.Binary.PropositionalEquality.≡-Reasoning |
a41b2b9b0407
Haskell Monoidal Funtor to Applicative done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
716
diff
changeset
|
981 |
765
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
982 ---- |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
983 -- |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
984 -- Applicative laws imples Monoidal laws |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
985 -- |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
986 |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
987 Applicative→HaskellMonoidal : {c₁ : Level} ( F : Functor (Sets {c₁}) (Sets {c₁}) ) |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
988 ( pure : {a : Obj Sets} → Hom Sets a ( FObj F a ) ) |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
989 ( <*> : {a b : Obj Sets} → FObj F ( a → b ) → FObj F a → FObj F b ) |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
990 ( app : IsApplicative F pure <*> ) |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
991 → IsHaskellMonoidalFunctor F (pure OneObj) (λ x → <*> (FMap F (λ j k → (j , k)) ( proj₁ x)) ( proj₂ x) ) |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
992 Applicative→HaskellMonoidal {l} F pure <*> app = record { |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
993 natφ = natφ |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
994 ; assocφ = assocφ |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
995 ; idrφ = idrφ |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
996 ; idlφ = idlφ |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
997 } where |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
998 unit : FObj F One |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
999 unit = pure OneObj |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1000 φ : {a b : Obj Sets} → Hom Sets ((FObj F a) * (FObj F b )) ( FObj F ( a * b ) ) |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1001 φ = λ x → <*> (FMap F (λ j k → (j , k)) ( proj₁ x)) ( proj₂ x) |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1002 isM : IsMonoidal (Sets {l}) One SetsTensorProduct |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1003 isM = Monoidal.isMonoidal MonoidalSets |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1004 natφ : { a b c d : Obj Sets } { x : FObj F a} { y : FObj F b} { f : a → c } { g : b → d } |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1005 → FMap F (map f g) (φ (x , y)) ≡ φ (FMap F f x , FMap F g y) |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1006 natφ = {!!} |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1007 assocφ : { x y z : Obj Sets } { a : FObj F x } { b : FObj F y }{ c : FObj F z } |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1008 → φ (a , φ (b , c)) ≡ FMap F (Iso.≅→ (IsMonoidal.mα-iso isM)) (φ (φ (a , b) , c)) |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1009 assocφ = {!!} |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1010 idrφ : {a : Obj Sets } { x : FObj F a } → FMap F (Iso.≅→ (IsMonoidal.mρ-iso isM)) (φ (x , unit)) ≡ x |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1011 idrφ = {!!} |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1012 idlφ : {a : Obj Sets } { x : FObj F a } → FMap F (Iso.≅→ (IsMonoidal.mλ-iso isM)) (φ (unit , x)) ≡ x |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1013 idlφ = {!!} |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1014 |
171f5386e87e
Applicative→HaskellMonoidal begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
732
diff
changeset
|
1015 |