Mercurial > hg > Members > kono > Proof > category
annotate yoneda.agda @ 265:367e8fde93ee
add limit
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 22 Sep 2013 11:08:41 +0900 |
parents | 24e83b8b81be |
children | 8c72f5284bc8 |
rev | line source |
---|---|
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
1 --- |
189 | 2 -- |
3 -- A → Sets^A^op : Yoneda Functor | |
4 -- Contravariant Functor h_a | |
5 -- Nat(h_a,F) | |
6 -- Shinji KONO <kono@ie.u-ryukyu.ac.jp> | |
7 ---- | |
8 | |
178 | 9 open import Category -- https://github.com/konn/category-agda |
10 open import Level | |
11 open import Category.Sets | |
12 module yoneda { c₁ c₂ ℓ : Level} { A : Category c₁ c₂ ℓ } where | |
13 | |
14 open import HomReasoning | |
15 open import cat-utility | |
179 | 16 open import Relation.Binary.Core |
17 open import Relation.Binary | |
18 | |
178 | 19 |
20 -- Contravariant Functor : op A → Sets ( Obj of Sets^{A^op} ) | |
197 | 21 -- Obj and Hom of Sets^A^op |
181 | 22 |
197 | 23 open Functor |
183
ea6fc610b480
Contravariant functor done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
182
diff
changeset
|
24 |
184 | 25 YObj = Functor (Category.op A) (Sets {c₂}) |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
26 YHom = λ (f : YObj ) → λ (g : YObj ) → NTrans (Category.op A) (Sets {c₂}) f g |
184 | 27 |
28 open NTrans | |
29 Yid : {a : YObj} → YHom a a | |
30 Yid {a} = record { TMap = \a -> \x -> x ; isNTrans = isNTrans1 {a} } where | |
31 isNTrans1 : {a : YObj } → IsNTrans (Category.op A) (Sets {c₂}) a a (\a -> \x -> x ) | |
32 isNTrans1 {a} = record { commute = refl } | |
33 | |
34 _+_ : {a b c : YObj} → YHom b c → YHom a b → YHom a c | |
185 | 35 _+_{a} {b} {c} f g = record { TMap = λ x → Sets [ TMap f x o TMap g x ] ; isNTrans = isNTrans1 } where |
36 commute1 : (a b c : YObj ) (f : YHom b c) (g : YHom a b ) | |
37 (a₁ b₁ : Obj (Category.op A)) (h : Hom (Category.op A) a₁ b₁) → | |
38 Sets [ Sets [ FMap c h o Sets [ TMap f a₁ o TMap g a₁ ] ] ≈ | |
39 Sets [ Sets [ TMap f b₁ o TMap g b₁ ] o FMap a h ] ] | |
40 commute1 a b c f g a₁ b₁ h = let open ≈-Reasoning (Sets {c₂})in begin | |
41 Sets [ FMap c h o Sets [ TMap f a₁ o TMap g a₁ ] ] | |
42 ≈⟨ assoc {_} {_} {_} {_} {FMap c h } {TMap f a₁} {TMap g a₁} ⟩ | |
43 Sets [ Sets [ FMap c h o TMap f a₁ ] o TMap g a₁ ] | |
44 ≈⟨ car (nat f) ⟩ | |
45 Sets [ Sets [ TMap f b₁ o FMap b h ] o TMap g a₁ ] | |
46 ≈↑⟨ assoc {_} {_} {_} {_} { TMap f b₁} {FMap b h } {TMap g a₁}⟩ | |
47 Sets [ TMap f b₁ o Sets [ FMap b h o TMap g a₁ ] ] | |
48 ≈⟨ cdr {_} {_} {_} {_} {_} { TMap f b₁} (nat g) ⟩ | |
49 Sets [ TMap f b₁ o Sets [ TMap g b₁ o FMap a h ] ] | |
50 ≈↑⟨ assoc {_} {_} {_} {_} {TMap f b₁} {TMap g b₁} { FMap a h} ⟩ | |
51 Sets [ Sets [ TMap f b₁ o TMap g b₁ ] o FMap a h ] | |
52 ∎ | |
53 isNTrans1 : IsNTrans (Category.op A) (Sets {c₂}) a c (λ x → Sets [ TMap f x o TMap g x ]) | |
54 isNTrans1 = record { commute = λ {a₁ b₁ h} → commute1 a b c f g a₁ b₁ h } | |
184 | 55 |
186
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
56 _==_ : {a b : YObj} → YHom a b → YHom a b → Set (c₂ ⊔ c₁) |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
57 _==_ f g = ∀{x : Obj (Category.op A)} → (Sets {c₂}) [ TMap f x ≈ TMap g x ] |
186
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
58 |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
59 infix 4 _==_ |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
60 |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
61 isSetsAop : IsCategory YObj YHom _==_ _+_ Yid |
189 | 62 isSetsAop = |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
63 record { isEquivalence = record {refl = refl ; trans = \{i j k} → trans1 {_} {_} {i} {j} {k} ; sym = \{i j} → sym1 {_} {_} {i} {j}} |
189 | 64 ; identityL = refl |
65 ; identityR = refl | |
66 ; o-resp-≈ = λ{a b c f g h i } → o-resp-≈ {a} {b} {c} {f} {g} {h} {i} | |
67 ; associative = refl | |
68 } where | |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
69 sym1 : {a b : YObj } {i j : YHom a b } → i == j → j == i |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
70 sym1 {a} {b} {i} {j} eq {x} = let open ≈-Reasoning (Sets {c₂}) in begin |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
71 TMap j x |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
72 ≈⟨ sym eq ⟩ |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
73 TMap i x |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
74 ∎ |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
75 trans1 : {a b : YObj } {i j k : YHom a b} → i == j → j == k → i == k |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
76 trans1 {a} {b} {i} {j} {k} i=j j=k {x} = let open ≈-Reasoning (Sets {c₂}) in begin |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
77 TMap i x |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
78 ≈⟨ i=j ⟩ |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
79 TMap j x |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
80 ≈⟨ j=k ⟩ |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
81 TMap k x |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
82 ∎ |
189 | 83 o-resp-≈ : {A₁ B C : YObj} {f g : YHom A₁ B} {h i : YHom B C} → |
84 f == g → h == i → h + f == i + g | |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
85 o-resp-≈ {a} {b} {c} {f} {g} {h} {i} f=g h=i {x} = let open ≈-Reasoning (Sets {c₂}) in begin |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
86 (Sets {c₂}) [ TMap h x o TMap f x ] |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
87 ≈⟨ resp f=g h=i ⟩ |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
88 (Sets {c₂}) [ TMap i x o TMap g x ] |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
89 ∎ |
186
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
90 |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
91 SetsAop : Category (suc ℓ ⊔ (suc (suc c₂) ⊔ suc c₁)) (suc ℓ ⊔ (suc (suc c₂) ⊔ suc c₁)) (c₂ ⊔ c₁) |
186
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
92 SetsAop = |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
93 record { Obj = YObj |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
94 ; Hom = YHom |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
95 ; _o_ = _+_ |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
96 ; _≈_ = _==_ |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
97 ; Id = Yid |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
98 ; isCategory = isSetsAop |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
99 } |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
100 |
197 | 101 -- A is Locally small |
102 postulate ≈-≡ : {a b : Obj A } { x y : Hom A a b } → (x≈y : A [ x ≈ y ]) → x ≡ y | |
103 | |
104 import Relation.Binary.PropositionalEquality | |
105 -- 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 ) | |
106 postulate extensionality : Relation.Binary.PropositionalEquality.Extensionality c₂ c₂ | |
107 | |
108 | |
109 ---- | |
110 -- | |
111 -- Object mapping in Yoneda Functor | |
112 -- | |
113 ---- | |
114 | |
115 open import Function | |
116 | |
117 y-obj : (a : Obj A) → Functor (Category.op A) (Sets {c₂}) | |
118 y-obj a = record { | |
119 FObj = λ b → Hom (Category.op A) a b ; | |
120 FMap = λ {b c : Obj A } → λ ( f : Hom A c b ) → λ (g : Hom A b a ) → (Category.op A) [ f o g ] ; | |
121 isFunctor = record { | |
122 identity = \{b} → extensionality ( λ x → lemma-y-obj1 {b} x ) ; | |
123 distr = λ {a} {b} {c} {f} {g} → extensionality ( λ x → lemma-y-obj2 a b c f g x ) ; | |
124 ≈-cong = λ eq → extensionality ( λ x → lemma-y-obj3 x eq ) | |
125 } | |
126 } where | |
127 lemma-y-obj1 : {b : Obj A } → (x : Hom A b a) → (Category.op A) [ id1 A b o x ] ≡ x | |
128 lemma-y-obj1 {b} x = let open ≈-Reasoning (Category.op A) in ≈-≡ idL | |
129 lemma-y-obj2 : (a₁ b c : Obj A) (f : Hom A b a₁) (g : Hom A c b ) → (x : Hom A a₁ a )→ | |
130 Category.op A [ Category.op A [ g o f ] o x ] ≡ (Sets [ _[_o_] (Category.op A) g o _[_o_] (Category.op A) f ]) x | |
131 lemma-y-obj2 a₁ b c f g x = let open ≈-Reasoning (Category.op A) in ≈-≡ ( begin | |
132 Category.op A [ Category.op A [ g o f ] o x ] | |
133 ≈↑⟨ assoc ⟩ | |
134 Category.op A [ g o Category.op A [ f o x ] ] | |
135 ≈⟨⟩ | |
136 ( λ x → Category.op A [ g o x ] ) ( ( λ x → Category.op A [ f o x ] ) x ) | |
137 ∎ ) | |
138 lemma-y-obj3 : {b c : Obj A} {f g : Hom A c b } → (x : Hom A b a ) → A [ f ≈ g ] → Category.op A [ f o x ] ≡ Category.op A [ g o x ] | |
139 lemma-y-obj3 {_} {_} {f} {g} x eq = let open ≈-Reasoning (Category.op A) in ≈-≡ ( begin | |
140 Category.op A [ f o x ] | |
141 ≈⟨ resp refl-hom eq ⟩ | |
142 Category.op A [ g o x ] | |
143 ∎ ) | |
144 | |
145 | |
146 ---- | |
147 -- | |
148 -- Hom mapping in Yoneda Functor | |
149 -- | |
150 ---- | |
151 | |
152 y-tmap : ( a b : Obj A ) → (f : Hom A a b ) → (x : Obj (Category.op A)) → FObj (y-obj a) x → FObj (y-obj b ) x | |
153 y-tmap a b f x = λ ( g : Hom A x a ) → A [ f o g ] -- ( h : Hom A x b ) | |
154 | |
155 y-map : {a b : Obj A } → (f : Hom A a b ) → YHom (y-obj a) (y-obj b) | |
156 y-map {a} {b} f = record { TMap = y-tmap a b f ; isNTrans = isNTrans1 {a} {b} f } where | |
157 lemma-y-obj4 : {a₁ b₁ : Obj (Category.op A)} {g : Hom (Category.op A) a₁ b₁} → {a b : Obj A } → (f : Hom A a b ) → | |
158 Sets [ Sets [ FMap (y-obj b) g o y-tmap a b f a₁ ] ≈ | |
159 Sets [ y-tmap a b f b₁ o FMap (y-obj a) g ] ] | |
160 lemma-y-obj4 {a₁} {b₁} {g} {a} {b} f = let open ≈-Reasoning A in extensionality ( λ x → ≈-≡ ( begin | |
161 A [ A [ f o x ] o g ] | |
162 ≈↑⟨ assoc ⟩ | |
163 A [ f o A [ x o g ] ] | |
164 ∎ ) ) | |
165 isNTrans1 : {a b : Obj A } → (f : Hom A a b ) → IsNTrans (Category.op A) (Sets {c₂}) (y-obj a) (y-obj b) (y-tmap a b f ) | |
166 isNTrans1 {a} {b} f = record { commute = λ{a₁ b₁ g } → lemma-y-obj4 {a₁} {b₁} {g} {a} {b} f } | |
167 | |
168 ----- | |
169 -- | |
170 -- Yoneda Functor itself | |
171 -- | |
172 ----- | |
173 | |
186
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
174 YonedaFunctor : Functor A SetsAop |
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
175 YonedaFunctor = record { |
197 | 176 FObj = λ a → y-obj a |
177 ; FMap = λ f → y-map f | |
186
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
178 ; isFunctor = record { |
187 | 179 identity = identity |
180 ; distr = distr1 | |
181 ; ≈-cong = ≈-cong | |
196
c040369bd6d4
give up injective on Object?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
195
diff
changeset
|
182 |
186
b2e01aa0924d
y-nat (FMap of Yoneda Functor )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
185
diff
changeset
|
183 } |
187 | 184 } where |
197 | 185 ≈-cong : {a b : Obj A} {f g : Hom A a b} → A [ f ≈ g ] → SetsAop [ y-map f ≈ y-map g ] |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
186 ≈-cong {a} {b} {f} {g} eq = let open ≈-Reasoning (A) in -- (λ x g₁ → A [ f o g₁ ] ) ≡ (λ x g₁ → A [ g o g₁ ] ) |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
187 extensionality ( λ h → ≈-≡ ( begin |
188
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
188 A [ f o h ] |
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
189 ≈⟨ resp refl-hom eq ⟩ |
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
190 A [ g o h ] |
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
191 ∎ |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
192 ) ) |
197 | 193 identity : {a : Obj A} → SetsAop [ y-map (id1 A a) ≈ id1 SetsAop (y-obj a ) ] |
188
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
194 identity {a} = let open ≈-Reasoning (A) in -- (λ x g → A [ id1 A a o g ] ) ≡ (λ a₁ x → x) |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
195 extensionality ( λ g → ≈-≡ ( begin |
188
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
196 A [ id1 A a o g ] |
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
197 ≈⟨ idL ⟩ |
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
198 g |
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
199 ∎ |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
200 ) ) |
197 | 201 distr1 : {a b c : Obj A} {f : Hom A a b} {g : Hom A b c} → SetsAop [ y-map (A [ g o f ]) ≈ SetsAop [ y-map g o y-map f ] ] |
191 | 202 distr1 {a} {b} {c} {f} {g} = let open ≈-Reasoning (A) in -- (λ x g₁ → (A [ (A [ g o f] o g₁ ]))) ≡ (λ x x₁ → A [ g o A [ f o x₁ ] ] ) |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
203 extensionality ( λ h → ≈-≡ ( begin |
188
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
204 A [ A [ g o f ] o h ] |
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
205 ≈↑⟨ assoc ⟩ |
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
206 A [ g o A [ f o h ] ] |
f4c9d7cbcbb9
Yoneda Functor Constructed
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
187
diff
changeset
|
207 ∎ |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
208 ) ) |
184 | 209 |
185 | 210 |
190 | 211 ------ |
212 -- | |
213 -- F : A → Sets ∈ Obj SetsAop | |
214 -- | |
199 | 215 -- F(a) -> Nat(h_a,F) |
191 | 216 -- x ∈ F(a) , (g : Hom A b a) → ( FMap F g ) x |
190 | 217 ------ |
187 | 218 |
197 | 219 F2Natmap : {a : Obj A} → {F : Obj SetsAop} → {x : FObj F a} → (b : Obj (Category.op A)) → Hom Sets (FObj (y-obj a) b) (FObj F b) |
191 | 220 F2Natmap {a} {F} {x} b = λ ( g : Hom A b a ) → ( FMap F g ) x |
190 | 221 |
197 | 222 F2Nat : {a : Obj A} → {F : Obj SetsAop} → FObj F a → Hom SetsAop (y-obj a) F |
191 | 223 F2Nat {a} {F} x = record { TMap = F2Natmap {a} {F} {x} ; isNTrans = isNTrans1 } where |
192
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
224 commute1 : {a₁ b : Obj (Category.op A)} {f : Hom (Category.op A) a₁ b} (g : Hom A a₁ a) → |
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
225 (Sets [ FMap F f o FMap F g ]) x ≡ FMap F (A [ g o f ] ) x |
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
226 commute1 g = let open ≈-Reasoning (Sets) in |
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
227 cong ( λ f → f x ) ( sym ( distr F ) ) |
191 | 228 commute : {a₁ b : Obj (Category.op A)} {f : Hom (Category.op A) a₁ b} → |
197 | 229 Sets [ Sets [ FMap F f o F2Natmap {a} {F} {x} a₁ ] ≈ Sets [ F2Natmap {a} {F} {x} b o FMap (y-obj a) f ] ] |
192
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
230 commute {a₁} {b} {f} = let open ≈-Reasoning (Sets) in |
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
231 begin |
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
232 Sets [ FMap F f o F2Natmap {a} {F} {x} a₁ ] |
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
233 ≈⟨⟩ |
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
234 Sets [ FMap F f o (λ ( g : Hom A a₁ a ) → ( FMap F g ) x) ] |
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
235 ≈⟨ extensionality ( λ (g : Hom A a₁ a) → commute1 {a₁} {b} {f} g ) ⟩ |
197 | 236 Sets [ (λ ( g : Hom A b a ) → ( FMap F g ) x) o FMap (y-obj a) f ] |
192
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
237 ≈⟨⟩ |
197 | 238 Sets [ F2Natmap {a} {F} {x} b o FMap (y-obj a) f ] |
192
d7e4b7b441be
F(a) → Nat(h_a,F) done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
191
diff
changeset
|
239 ∎ |
197 | 240 isNTrans1 : IsNTrans (Category.op A) (Sets {c₂}) (y-obj a) F (F2Natmap {a} {F}) |
191 | 241 isNTrans1 = record { commute = λ {a₁ b f} → commute {a₁} {b} {f} } |
190 | 242 |
243 | |
199 | 244 -- F(a) <- Nat(h_a,F) |
197 | 245 Nat2F : {a : Obj A} → {F : Obj SetsAop} → Hom SetsAop (y-obj a) F → FObj F a |
193
4e6f080f0107
isomorphic problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
192
diff
changeset
|
246 Nat2F {a} {F} ha = ( TMap ha a ) (id1 A a) |
190 | 247 |
199 | 248 ---- |
249 -- | |
250 -- Prove Bijection (as routine exercise ...) | |
251 -- | |
252 ---- | |
253 | |
193
4e6f080f0107
isomorphic problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
192
diff
changeset
|
254 F2Nat→Nat2F : {a : Obj A } → {F : Obj SetsAop} → (fa : FObj F a) → Nat2F {a} {F} (F2Nat {a} {F} fa) ≡ fa |
194 | 255 F2Nat→Nat2F {a} {F} fa = let open ≈-Reasoning (Sets) in cong ( λ f → f fa ) ( |
199 | 256 -- FMap F (Category.Category.Id A) fa ≡ fa |
194 | 257 begin |
258 ( FMap F (id1 A _ )) | |
259 ≈⟨ IsFunctor.identity (isFunctor F) ⟩ | |
260 id1 Sets (FObj F a) | |
261 ∎ ) | |
262 | |
263 open import Relation.Binary.PropositionalEquality | |
264 | |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
265 ≡-cong = Relation.Binary.PropositionalEquality.cong |
193
4e6f080f0107
isomorphic problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
192
diff
changeset
|
266 |
195 | 267 -- F : op A → Sets |
197 | 268 -- ha : NTrans (op A) Sets (y-obj {a}) F |
269 -- FMap F g o TMap ha a ≈ TMap ha b o FMap (y-obj {a}) g | |
195 | 270 |
197 | 271 Nat2F→F2Nat : {a : Obj A } → {F : Obj SetsAop} → (ha : Hom SetsAop (y-obj a) F) → SetsAop [ F2Nat {a} {F} (Nat2F {a} {F} ha) ≈ ha ] |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
272 Nat2F→F2Nat {a} {F} ha {b} = let open ≡-Reasoning in |
194 | 273 begin |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
274 TMap (F2Nat {a} {F} (Nat2F {a} {F} ha)) b |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
275 ≡⟨⟩ |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
276 (λ g → FMap F g (TMap ha a (Category.Category.Id A))) |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
277 ≡⟨ extensionality (λ g → ( |
195 | 278 begin |
279 FMap F g (TMap ha a (Category.Category.Id A)) | |
203 | 280 ≡⟨ ≡-cong (λ f → f (Category.Category.Id A)) (IsNTrans.commute (isNTrans ha)) ⟩ |
197 | 281 TMap ha b (FMap (y-obj a) g (Category.Category.Id A)) |
195 | 282 ≡⟨⟩ |
283 TMap ha b ( (A Category.o Category.Category.Id A) g ) | |
203 | 284 ≡⟨ ≡-cong ( TMap ha b ) ( ≈-≡ (IsCategory.identityL ( Category.isCategory A ))) ⟩ |
195 | 285 TMap ha b g |
286 ∎ | |
202
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
287 )) ⟩ |
58ee98bbb333
remove an extensionality
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
199
diff
changeset
|
288 TMap ha b |
195 | 289 ∎ |
194 | 290 |
196
c040369bd6d4
give up injective on Object?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
195
diff
changeset
|
291 -- Yoneda's Lemma |
199 | 292 -- Yoneda Functor is full and faithfull |
196
c040369bd6d4
give up injective on Object?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
195
diff
changeset
|
293 -- that is FMapp Yoneda is injective and surjective |
194 | 294 |
196
c040369bd6d4
give up injective on Object?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
195
diff
changeset
|
295 -- λ b g → (A Category.o f₁) g |
c040369bd6d4
give up injective on Object?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
195
diff
changeset
|
296 YondaLemma1 : {a a' : Obj A } {f : FObj (FObj YonedaFunctor a) a' } → SetsAop [ F2Nat {a'} {FObj YonedaFunctor a} f ≈ FMap YonedaFunctor f ] |
c040369bd6d4
give up injective on Object?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
195
diff
changeset
|
297 YondaLemma1 {a} {a'} {f} = refl |
195 | 298 |
196
c040369bd6d4
give up injective on Object?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
195
diff
changeset
|
299 -- F2Nat is bijection so FMap YonedaFunctor also ( using functional extensionality ) |
c040369bd6d4
give up injective on Object?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
195
diff
changeset
|
300 |
204 | 301 -- Full embedding of Yoneda Functor requires injective on Object, |
302 -- | |
303 -- But we cannot prove like this | |
196
c040369bd6d4
give up injective on Object?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
195
diff
changeset
|
304 -- FObj YonedaFunctor a ≡ FObj YonedaFunctor b → a ≡ b |
204 | 305 -- YondaLemma2 : {a b x : Obj A } → (FObj (FObj YonedaFunctor a) x) ≡ (FObj (FObj YonedaFunctor b ) x) → |
306 -- a ≡ b | |
307 -- YondaLemma2 {a} {b} eq = {!!} | |
253 | 308 -- N.B = ≡-cong gives you ! a ≡ b, so we cannot cong inv to prove a ≡ b |
204 | 309 -- |
253 | 310 -- Instead we prove only |
204 | 311 -- inv ( FObj YonedaFunctor a ) ≡ a |
196
c040369bd6d4
give up injective on Object?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
195
diff
changeset
|
312 |
204 | 313 inv : {a x : Obj A} ( f : FObj (FObj YonedaFunctor a) x) → Obj A |
314 inv {a} f = Category.cod A f | |
203 | 315 |
253 | 316 YonedaLemma21 : {a x : Obj A} ( f : ( FObj (FObj YonedaFunctor a) x) ) → inv f ≡ a |
317 YonedaLemma21 {a} {x} f = refl | |
203 | 318 |