annotate nat.agda @ 73:b75b5792bd81

on going
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Fri, 26 Jul 2013 15:52:24 +0900
parents cbc30519e961
children 49e6eb3ef9c0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
1
0
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
2
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 -- Monad
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4 -- Category A
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 -- A = Category
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
6 -- Functor T : A → A
0
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 --T(a) = t(a)
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 --T(f) = tf(f)
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9
2
7ce421d5ee2b unity1 unity2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 1
diff changeset
10 open import Category -- https://github.com/konn/category-agda
0
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 open import Level
56
83ff8d48fdca add unitility
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 31
diff changeset
12 --open import Category.HomReasoning
83ff8d48fdca add unitility
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 31
diff changeset
13 open import HomReasoning
83ff8d48fdca add unitility
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 31
diff changeset
14 open import cat-utility
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
15 open import Category.Cat
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
16
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
17 module nat { c₁ c₂ ℓ : Level} { A : Category c₁ c₂ ℓ }
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
18 { T : Functor A A }
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
19 { η : NTrans A A identityFunctor T }
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
20 { μ : NTrans A A (T ○ T) T }
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
21 { M : Monad A T η μ }
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
22 { K : Kleisli A T η μ M } where
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
23
0
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
24
1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
25 --T(g f) = T(g) T(f)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
26
31
17b8bafebad7 add universal mapping
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 30
diff changeset
27 open Functor
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
28 Lemma1 : {c₁ c₂ l : Level} {A : Category c₁ c₂ l} (T : Functor A A) → {a b c : Obj A} {g : Hom A b c} { f : Hom A a b }
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
29 → A [ ( FMap T (A [ g o f ] )) ≈ (A [ FMap T g o FMap T f ]) ]
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
30 Lemma1 = \t → IsFunctor.distr ( isFunctor t )
0
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
31
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
32
7
79d9c30e995a Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
33 open NTrans
1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 0
diff changeset
34 Lemma2 : {c₁ c₂ l : Level} {A : Category c₁ c₂ l} {F G : Functor A A}
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
35 → (μ : NTrans A A F G) → {a b : Obj A} { f : Hom A a b }
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
36 → A [ A [ FMap G f o TMap μ a ] ≈ A [ TMap μ b o FMap F f ] ]
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
37 Lemma2 = \n → IsNTrans.naturality ( isNTrans n )
0
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
38
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
39 -- η : 1_A → T
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
40 -- μ : TT → T
0
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
41 -- μ(a)η(T(a)) = a
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
42 -- μ(a)T(η(a)) = a
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
43 -- μ(a)(μ(T(a))) = μ(a)T(μ(a))
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
44
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
45
2
7ce421d5ee2b unity1 unity2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 1
diff changeset
46 open Monad
7ce421d5ee2b unity1 unity2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 1
diff changeset
47 Lemma3 : {c₁ c₂ ℓ : Level} {A : Category c₁ c₂ ℓ}
7ce421d5ee2b unity1 unity2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 1
diff changeset
48 { T : Functor A A }
7
79d9c30e995a Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
49 { η : NTrans A A identityFunctor T }
79d9c30e995a Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
50 { μ : NTrans A A (T ○ T) T }
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
51 { a : Obj A } →
2
7ce421d5ee2b unity1 unity2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 1
diff changeset
52 ( M : Monad A T η μ )
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
53 → A [ A [ TMap μ a o TMap μ ( FObj T a ) ] ≈ A [ TMap μ a o FMap T (TMap μ a) ] ]
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
54 Lemma3 = \m → IsMonad.assoc ( isMonad m )
2
7ce421d5ee2b unity1 unity2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 1
diff changeset
55
7ce421d5ee2b unity1 unity2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 1
diff changeset
56
7ce421d5ee2b unity1 unity2
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 1
diff changeset
57 Lemma4 : {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) {a b : Obj A } { f : Hom A a b}
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
58 → A [ A [ Id {_} {_} {_} {A} b o f ] ≈ f ]
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
59 Lemma4 = \a → IsCategory.identityL ( Category.isCategory a )
0
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
60
3
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
61 Lemma5 : {c₁ c₂ ℓ : Level} {A : Category c₁ c₂ ℓ}
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
62 { T : Functor A A }
7
79d9c30e995a Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
63 { η : NTrans A A identityFunctor T }
79d9c30e995a Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
64 { μ : NTrans A A (T ○ T) T }
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
65 { a : Obj A } →
3
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
66 ( M : Monad A T η μ )
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
67 → A [ A [ TMap μ a o TMap η ( FObj T a ) ] ≈ Id {_} {_} {_} {A} (FObj T a) ]
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
68 Lemma5 = \m → IsMonad.unity1 ( isMonad m )
3
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
69
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
70 Lemma6 : {c₁ c₂ ℓ : Level} {A : Category c₁ c₂ ℓ}
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
71 { T : Functor A A }
7
79d9c30e995a Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
72 { η : NTrans A A identityFunctor T }
79d9c30e995a Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
73 { μ : NTrans A A (T ○ T) T }
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
74 { a : Obj A } →
3
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
75 ( M : Monad A T η μ )
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
76 → A [ A [ TMap μ a o (FMap T (TMap η a )) ] ≈ Id {_} {_} {_} {A} (FObj T a) ]
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
77 Lemma6 = \m → IsMonad.unity2 ( isMonad m )
3
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
78
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
79 -- T = M x A
0
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
80 -- nat of η
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
81 -- g ○ f = μ(c) T(g) f
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
82 -- η(b) ○ f = f
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
83 -- f ○ η(a) = f
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
84 -- h ○ (g ○ f) = (h ○ g) ○ f
0
302941542c0f category agda
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
85
7
79d9c30e995a Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
86
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
87 lemma12 : {c₁ c₂ ℓ : Level} (L : Category c₁ c₂ ℓ) { a b c : Obj L } →
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
88 ( x : Hom L c a ) → ( y : Hom L b c ) → L [ L [ x o y ] ≈ L [ x o y ] ]
18
da1b8250e72a reasoning worked.
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 17
diff changeset
89 lemma12 L x y =
da1b8250e72a reasoning worked.
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 17
diff changeset
90 let open ≈-Reasoning ( L ) in
da1b8250e72a reasoning worked.
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 17
diff changeset
91 begin L [ x o y ] ∎
11
2cbecadc56c1 reasoning test
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 10
diff changeset
92
4
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 3
diff changeset
93 open Kleisli
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
94 -- η(b) ○ f = f
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
95 Lemma7 : { a : Obj A } { b : Obj A } ( f : Hom A a ( FObj T b) )
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
96 → A [ join K (TMap η b) f ≈ f ]
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
97 Lemma7 {_} {b} f =
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
98 let open ≈-Reasoning (A) in
21
a7b0f7ab9881 unity law 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 19
diff changeset
99 begin
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
100 join K (TMap η b) f
21
a7b0f7ab9881 unity law 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 19
diff changeset
101 ≈⟨ refl-hom ⟩
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
102 A [ TMap μ b o A [ FMap T ((TMap η b)) o f ] ]
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
103 ≈⟨ IsCategory.associative (Category.isCategory A) ⟩
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
104 A [ A [ TMap μ b o FMap T ((TMap η b)) ] o f ]
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
105 ≈⟨ car ( IsMonad.unity2 ( isMonad ( monad K )) ) ⟩
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
106 A [ id (FObj T b) o f ]
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
107 ≈⟨ IsCategory.identityL (Category.isCategory A) ⟩
21
a7b0f7ab9881 unity law 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 19
diff changeset
108 f
a7b0f7ab9881 unity law 1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 19
diff changeset
109
7
79d9c30e995a Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 6
diff changeset
110
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
111 -- f ○ η(a) = f
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
112 Lemma8 : { a : Obj A } { b : Obj A }
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
113 ( f : Hom A a ( FObj T b) )
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
114 → A [ join K f (TMap η a) ≈ f ]
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
115 Lemma8 {a} {b} f =
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
116 begin
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
117 join K f (TMap η a)
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
118 ≈⟨ refl-hom ⟩
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
119 A [ TMap μ b o A [ FMap T f o (TMap η a) ] ]
66
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 63
diff changeset
120 ≈⟨ cdr ( nat η ) ⟩
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
121 A [ TMap μ b o A [ (TMap η ( FObj T b)) o f ] ]
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
122 ≈⟨ IsCategory.associative (Category.isCategory A) ⟩
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
123 A [ A [ TMap μ b o (TMap η ( FObj T b)) ] o f ]
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
124 ≈⟨ car ( IsMonad.unity1 ( isMonad ( monad K )) ) ⟩
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
125 A [ id (FObj T b) o f ]
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
126 ≈⟨ IsCategory.identityL (Category.isCategory A) ⟩
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
127 f
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
128 ∎ where
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
129 open ≈-Reasoning (A)
5
16572013c362 Kleisli Proposition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 4
diff changeset
130
22
b3cb592d7b9d add some law
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 21
diff changeset
131 -- h ○ (g ○ f) = (h ○ g) ○ f
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
132 Lemma9 : { a b c d : Obj A }
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
133 ( h : Hom A c ( FObj T d) )
23
736df1a35807 join assoc on going...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 22
diff changeset
134 ( g : Hom A b ( FObj T c) )
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
135 ( f : Hom A a ( FObj T b) )
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
136 → A [ join K h (join K g f) ≈ join K ( join K h g) f ]
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
137 Lemma9 {a} {b} {c} {d} h g f =
24
171c31acf78e on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
138 begin
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
139 join K h (join K g f)
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
140 ≈⟨⟩
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
141 join K h ( ( TMap μ c o ( FMap T g o f ) ) )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
142 ≈⟨ refl-hom ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
143 ( TMap μ d o ( FMap T h o ( TMap μ c o ( FMap T g o f ) ) ) )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
144 ≈⟨ cdr ( cdr ( assoc )) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
145 ( TMap μ d o ( FMap T h o ( ( TMap μ c o FMap T g ) o f ) ) )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
146 ≈⟨ assoc ⟩ --- ( f o ( g o h ) ) = ( ( f o g ) o h )
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
147 ( ( TMap μ d o FMap T h ) o ( (TMap μ c o FMap T g ) o f ) )
25
8117bafdec7a on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
148 ≈⟨ assoc ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
149 ( ( ( TMap μ d o FMap T h ) o (TMap μ c o FMap T g ) ) o f )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
150 ≈⟨ car (sym assoc) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
151 ( ( TMap μ d o ( FMap T h o ( TMap μ c o FMap T g ) ) ) o f )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
152 ≈⟨ car ( cdr (assoc) ) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
153 ( ( TMap μ d o ( ( FMap T h o TMap μ c ) o FMap T g ) ) o f )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
154 ≈⟨ car assoc ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
155 ( ( ( TMap μ d o ( FMap T h o TMap μ c ) ) o FMap T g ) o f )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
156 ≈⟨ car (car ( cdr ( begin
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
157 ( FMap T h o TMap μ c )
66
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 63
diff changeset
158 ≈⟨ nat μ ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
159 ( TMap μ (FObj T d) o FMap T (FMap T h) )
25
8117bafdec7a on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
160
8117bafdec7a on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 24
diff changeset
161 ))) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
162 ( ( ( TMap μ d o ( TMap μ ( FObj T d) o FMap T ( FMap T h ) ) ) o FMap T g ) o f )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
163 ≈⟨ car (sym assoc) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
164 ( ( TMap μ d o ( ( TMap μ ( FObj T d) o FMap T ( FMap T h ) ) o FMap T g ) ) o f )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
165 ≈⟨ car ( cdr (sym assoc) ) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
166 ( ( TMap μ d o ( TMap μ ( FObj T d) o ( FMap T ( FMap T h ) o FMap T g ) ) ) o f )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
167 ≈⟨ car ( cdr (cdr (sym (distr T )))) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
168 ( ( TMap μ d o ( TMap μ ( FObj T d) o FMap T ( ( FMap T h o g ) ) ) ) o f )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
169 ≈⟨ car assoc ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
170 ( ( ( TMap μ d o TMap μ ( FObj T d) ) o FMap T ( ( FMap T h o g ) ) ) o f )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
171 ≈⟨ car ( car (
27
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
172 begin
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
173 ( TMap μ d o TMap μ (FObj T d) )
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
174 ≈⟨ IsMonad.assoc ( isMonad M) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
175 ( TMap μ d o FMap T (TMap μ d) )
27
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
176
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 26
diff changeset
177 )) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
178 ( ( ( TMap μ d o FMap T ( TMap μ d) ) o FMap T ( ( FMap T h o g ) ) ) o f )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
179 ≈⟨ car (sym assoc) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
180 ( ( TMap μ d o ( FMap T ( TMap μ d ) o FMap T ( ( FMap T h o g ) ) ) ) o f )
24
171c31acf78e on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
181 ≈⟨ sym assoc ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
182 ( TMap μ d o ( ( FMap T ( TMap μ d ) o FMap T ( ( FMap T h o g ) ) ) o f ) )
28
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 27
diff changeset
183 ≈⟨ cdr ( car ( sym ( distr T ))) ⟩
30
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 29
diff changeset
184 ( TMap μ d o ( FMap T ( ( ( TMap μ d ) o ( FMap T h o g ) ) ) o f ) )
23
736df1a35807 join assoc on going...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 22
diff changeset
185 ≈⟨ refl-hom ⟩
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
186 join K ( ( TMap μ d o ( FMap T h o g ) ) ) f
23
736df1a35807 join assoc on going...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 22
diff changeset
187 ≈⟨ refl-hom ⟩
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
188 join K ( join K h g) f
24
171c31acf78e on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 23
diff changeset
189 ∎ where open ≈-Reasoning (A)
3
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
190
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
191 record KHom (a : Obj A) (b : Obj A)
70
fb3c48b375b3 Kleisli Category ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
192 : Set (suc (c₂ ⊔ c₁)) where
fb3c48b375b3 Kleisli Category ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
193 field
fb3c48b375b3 Kleisli Category ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
194 KMap : Hom A a ( FObj T b )
69
84a150c980ce generalized distr and assco1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 68
diff changeset
195
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
196 K-id : {a : Obj A} → KHom a a
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
197 K-id {a = a} = record { KMap = TMap η a }
56
83ff8d48fdca add unitility
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 31
diff changeset
198
69
84a150c980ce generalized distr and assco1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 68
diff changeset
199 open import Relation.Binary.Core
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
200 open KHom
56
83ff8d48fdca add unitility
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 31
diff changeset
201
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
202 _⋍_ : { a : Obj A } { b : Obj A } (f g : KHom a b ) -> Set ℓ -- (suc ((c₂ ⊔ c₁) ⊔ ℓ))
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
203 _⋍_ {a} {b} f g = A [ KMap f ≈ KMap g ]
71
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
204
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
205 _*_ : { a b : Obj A } → { c : Obj A } →
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
206 ( KHom b c) → ( KHom a b) → KHom a c
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
207 _*_ {a} {b} {c} g f = record { KMap = join K {a} {b} {c} (KMap g) (KMap f) }
70
fb3c48b375b3 Kleisli Category ...
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
208
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
209 isKleisliCategory : IsCategory ( Obj A ) KHom _⋍_ _*_ K-id
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
210 isKleisliCategory = record { isEquivalence = isEquivalence
71
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
211 ; identityL = KidL
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
212 ; identityR = KidR
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
213 ; o-resp-≈ = Ko-resp
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
214 ; associative = Kassoc
69
84a150c980ce generalized distr and assco1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 68
diff changeset
215 }
84a150c980ce generalized distr and assco1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 68
diff changeset
216 where
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
217 open ≈-Reasoning (A)
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
218 isEquivalence : { a b : Obj A } ->
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
219 IsEquivalence {_} {_} {KHom a b} _⋍_
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
220 isEquivalence {C} {D} =
71
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
221 record { refl = λ {F} → ⋍-refl {F}
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
222 ; sym = λ {F} {G} → ⋍-sym {F} {G}
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
223 ; trans = λ {F} {G} {H} → ⋍-trans {F} {G} {H}
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
224 } where
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
225 ⋍-refl : {F : KHom C D} → F ⋍ F
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
226 ⋍-refl = refl-hom
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
227 ⋍-sym : {F G : KHom C D} → F ⋍ G → G ⋍ F
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
228 ⋍-sym = sym
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
229 ⋍-trans : {F G H : KHom C D} → F ⋍ G → G ⋍ H → F ⋍ H
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
230 ⋍-trans = trans-hom
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
231 KidL : {C D : Obj A} -> {f : KHom C D} → (K-id * f) ⋍ f
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
232 KidL {_} {_} {f} = Lemma7 (KMap f)
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
233 KidR : {C D : Obj A} -> {f : KHom C D} → (f * K-id) ⋍ f
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
234 KidR {_} {_} {f} = Lemma8 (KMap f)
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
235 Ko-resp : {a b c : Obj A} -> {f g : KHom a b } → {h i : KHom b c } →
71
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
236 f ⋍ g → h ⋍ i → (h * f) ⋍ (i * g)
69
84a150c980ce generalized distr and assco1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 68
diff changeset
237 Ko-resp = {!!}
72
cbc30519e961 stack overflow solved by moving implicit parameters to module parameters
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 71
diff changeset
238 Kassoc : {a b c d : Obj A} -> {f : KHom c d } → {g : KHom b c } → {h : KHom a b } →
71
709c1bde54dc Kleisli category problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
239 (f * (g * h)) ⋍ ((f * g) * h)
73
b75b5792bd81 on going
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 72
diff changeset
240 Kassoc {_} {_} {_} {_} {f} {g} {h} = Lemma9 (KMap f) (KMap g) (KMap h)
3
dce706edd66b Kleisli
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
241
56
83ff8d48fdca add unitility
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 31
diff changeset
242