Mercurial > hg > Members > kono > Proof > category
comparison yoneda.agda @ 830:232cea484067
graph to CCC again
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 15 Mar 2020 14:26:39 +0900 |
parents | bded2347efa4 |
children |
comparison
equal
deleted
inserted
replaced
829:6c5cfb9b333e | 830:232cea484067 |
---|---|
89 ; Id = Yid A | 89 ; Id = Yid A |
90 ; isCategory = isSetsAop A | 90 ; isCategory = isSetsAop A |
91 } | 91 } |
92 | 92 |
93 -- A is Locally small | 93 -- A is Locally small |
94 postulate ≈-≡ : { c₁ c₂ ℓ : Level} { A : Category c₁ c₂ ℓ } {a b : Obj A } { x y : Hom A a b } → (x≈y : A [ x ≈ y ]) → x ≡ y | 94 postulate ≡←≈ : { c₁ c₂ ℓ : Level} { A : Category c₁ c₂ ℓ } {a b : Obj A } { x y : Hom A a b } → (x≈y : A [ x ≈ y ]) → x ≡ y |
95 | 95 |
96 import Relation.Binary.PropositionalEquality | 96 import Relation.Binary.PropositionalEquality |
97 -- 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 ) | 97 -- 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 ) |
98 postulate extensionality : { c₁ c₂ ℓ : Level} ( A : Category c₁ c₂ ℓ ) → Relation.Binary.PropositionalEquality.Extensionality c₂ c₂ | 98 postulate extensionality : { c₁ c₂ ℓ : Level} ( A : Category c₁ c₂ ℓ ) → Relation.Binary.PropositionalEquality.Extensionality c₂ c₂ |
99 | 99 |
115 distr = λ {a} {b} {c} {f} {g} → extensionality A ( λ x → lemma-y-obj2 a b c f g x ) ; | 115 distr = λ {a} {b} {c} {f} {g} → extensionality A ( λ x → lemma-y-obj2 a b c f g x ) ; |
116 ≈-cong = λ eq → extensionality A ( λ x → lemma-y-obj3 x eq ) | 116 ≈-cong = λ eq → extensionality A ( λ x → lemma-y-obj3 x eq ) |
117 } | 117 } |
118 } where | 118 } where |
119 lemma-y-obj1 : {b : Obj A } → (x : Hom A b a) → (Category.op A) [ id1 A b o x ] ≡ x | 119 lemma-y-obj1 : {b : Obj A } → (x : Hom A b a) → (Category.op A) [ id1 A b o x ] ≡ x |
120 lemma-y-obj1 {b} x = let open ≈-Reasoning (Category.op A) in ≈-≡ {_} {_} {_} {A} idL | 120 lemma-y-obj1 {b} x = let open ≈-Reasoning (Category.op A) in ≡←≈ {_} {_} {_} {A} idL |
121 lemma-y-obj2 : (a₁ b c : Obj A) (f : Hom A b a₁) (g : Hom A c b ) → (x : Hom A a₁ a )→ | 121 lemma-y-obj2 : (a₁ b c : Obj A) (f : Hom A b a₁) (g : Hom A c b ) → (x : Hom A a₁ a )→ |
122 Category.op A [ Category.op A [ g o f ] o x ] ≡ (Sets [ _[_o_] (Category.op A) g o _[_o_] (Category.op A) f ]) x | 122 Category.op A [ Category.op A [ g o f ] o x ] ≡ (Sets [ _[_o_] (Category.op A) g o _[_o_] (Category.op A) f ]) x |
123 lemma-y-obj2 a₁ b c f g x = let open ≈-Reasoning (Category.op A) in ≈-≡ {_} {_} {_} {A} ( begin | 123 lemma-y-obj2 a₁ b c f g x = let open ≈-Reasoning (Category.op A) in ≡←≈ {_} {_} {_} {A} ( begin |
124 Category.op A [ Category.op A [ g o f ] o x ] | 124 Category.op A [ Category.op A [ g o f ] o x ] |
125 ≈↑⟨ assoc ⟩ | 125 ≈↑⟨ assoc ⟩ |
126 Category.op A [ g o Category.op A [ f o x ] ] | 126 Category.op A [ g o Category.op A [ f o x ] ] |
127 ≈⟨⟩ | 127 ≈⟨⟩ |
128 ( λ x → Category.op A [ g o x ] ) ( ( λ x → Category.op A [ f o x ] ) x ) | 128 ( λ x → Category.op A [ g o x ] ) ( ( λ x → Category.op A [ f o x ] ) x ) |
129 ∎ ) | 129 ∎ ) |
130 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 ] | 130 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 ] |
131 lemma-y-obj3 {_} {_} {f} {g} x eq = let open ≈-Reasoning (Category.op A) in ≈-≡ {_} {_} {_} {A} ( begin | 131 lemma-y-obj3 {_} {_} {f} {g} x eq = let open ≈-Reasoning (Category.op A) in ≡←≈ {_} {_} {_} {A} ( begin |
132 Category.op A [ f o x ] | 132 Category.op A [ f o x ] |
133 ≈⟨ resp refl-hom eq ⟩ | 133 ≈⟨ resp refl-hom eq ⟩ |
134 Category.op A [ g o x ] | 134 Category.op A [ g o x ] |
135 ∎ ) | 135 ∎ ) |
136 | 136 |
148 y-map : { c₁ c₂ ℓ : Level} ( A : Category c₁ c₂ ℓ ) {a b : Obj A } → (f : Hom A a b ) → YHom A (y-obj A a) (y-obj A b) | 148 y-map : { c₁ c₂ ℓ : Level} ( A : Category c₁ c₂ ℓ ) {a b : Obj A } → (f : Hom A a b ) → YHom A (y-obj A a) (y-obj A b) |
149 y-map {_} {c₂} {_} A {a} {b} f = record { TMap = y-tmap A a b f ; isNTrans = isNTrans1 {a} {b} f } where | 149 y-map {_} {c₂} {_} A {a} {b} f = record { TMap = y-tmap A a b f ; isNTrans = isNTrans1 {a} {b} f } where |
150 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 ) → | 150 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 ) → |
151 Sets [ Sets [ FMap (y-obj A b) g o y-tmap A a b f a₁ ] ≈ | 151 Sets [ Sets [ FMap (y-obj A b) g o y-tmap A a b f a₁ ] ≈ |
152 Sets [ y-tmap A a b f b₁ o FMap (y-obj A a) g ] ] | 152 Sets [ y-tmap A a b f b₁ o FMap (y-obj A a) g ] ] |
153 lemma-y-obj4 {a₁} {b₁} {g} {a} {b} f = let open ≈-Reasoning A in extensionality A ( λ x → ≈-≡ {_} {_} {_} {A} ( begin | 153 lemma-y-obj4 {a₁} {b₁} {g} {a} {b} f = let open ≈-Reasoning A in extensionality A ( λ x → ≡←≈ {_} {_} {_} {A} ( begin |
154 A [ A [ f o x ] o g ] | 154 A [ A [ f o x ] o g ] |
155 ≈↑⟨ assoc ⟩ | 155 ≈↑⟨ assoc ⟩ |
156 A [ f o A [ x o g ] ] | 156 A [ f o A [ x o g ] ] |
157 ∎ ) ) | 157 ∎ ) ) |
158 isNTrans1 : {a b : Obj A } → (f : Hom A a b ) → IsNTrans (Category.op A) (Sets {c₂}) (y-obj A a) (y-obj A b) (y-tmap A a b f ) | 158 isNTrans1 : {a b : Obj A } → (f : Hom A a b ) → IsNTrans (Category.op A) (Sets {c₂}) (y-obj A a) (y-obj A b) (y-tmap A a b f ) |
175 | 175 |
176 } | 176 } |
177 } where | 177 } where |
178 ≈-cong : {a b : Obj A} {f g : Hom A a b} → A [ f ≈ g ] → SetsAop A [ y-map A f ≈ y-map A g ] | 178 ≈-cong : {a b : Obj A} {f g : Hom A a b} → A [ f ≈ g ] → SetsAop A [ y-map A f ≈ y-map A g ] |
179 ≈-cong {a} {b} {f} {g} eq = let open ≈-Reasoning (A) in -- (λ x g₁ → A [ f o g₁ ] ) ≡ (λ x g₁ → A [ g o g₁ ] ) | 179 ≈-cong {a} {b} {f} {g} eq = let open ≈-Reasoning (A) in -- (λ x g₁ → A [ f o g₁ ] ) ≡ (λ x g₁ → A [ g o g₁ ] ) |
180 extensionality A ( λ h → ≈-≡ {_} {_} {_} {A} ( begin | 180 extensionality A ( λ h → ≡←≈ {_} {_} {_} {A} ( begin |
181 A [ f o h ] | 181 A [ f o h ] |
182 ≈⟨ resp refl-hom eq ⟩ | 182 ≈⟨ resp refl-hom eq ⟩ |
183 A [ g o h ] | 183 A [ g o h ] |
184 ∎ | 184 ∎ |
185 ) ) | 185 ) ) |
186 identity : {a : Obj A} → SetsAop A [ y-map A (id1 A a) ≈ id1 (SetsAop A) (y-obj A a ) ] | 186 identity : {a : Obj A} → SetsAop A [ y-map A (id1 A a) ≈ id1 (SetsAop A) (y-obj A a ) ] |
187 identity {a} = let open ≈-Reasoning (A) in -- (λ x g → A [ id1 A a o g ] ) ≡ (λ a₁ x → x) | 187 identity {a} = let open ≈-Reasoning (A) in -- (λ x g → A [ id1 A a o g ] ) ≡ (λ a₁ x → x) |
188 extensionality A ( λ g → ≈-≡ {_} {_} {_} {A} ( begin | 188 extensionality A ( λ g → ≡←≈ {_} {_} {_} {A} ( begin |
189 A [ id1 A a o g ] | 189 A [ id1 A a o g ] |
190 ≈⟨ idL ⟩ | 190 ≈⟨ idL ⟩ |
191 g | 191 g |
192 ∎ | 192 ∎ |
193 ) ) | 193 ) ) |
194 distr1 : {a b c : Obj A} {f : Hom A a b} {g : Hom A b c} → SetsAop A [ y-map A (A [ g o f ]) ≈ SetsAop A [ y-map A g o y-map A f ] ] | 194 distr1 : {a b c : Obj A} {f : Hom A a b} {g : Hom A b c} → SetsAop A [ y-map A (A [ g o f ]) ≈ SetsAop A [ y-map A g o y-map A f ] ] |
195 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₁ ] ] ) | 195 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₁ ] ] ) |
196 extensionality A ( λ h → ≈-≡ {_} {_} {_} {A} ( begin | 196 extensionality A ( λ h → ≡←≈ {_} {_} {_} {A} ( begin |
197 A [ A [ g o f ] o h ] | 197 A [ A [ g o f ] o h ] |
198 ≈↑⟨ assoc ⟩ | 198 ≈↑⟨ assoc ⟩ |
199 A [ g o A [ f o h ] ] | 199 A [ g o A [ f o h ] ] |
200 ∎ | 200 ∎ |
201 ) ) | 201 ) ) |
275 FMap F g (TMap ha a (Category.Category.Id A)) | 275 FMap F g (TMap ha a (Category.Category.Id A)) |
276 ≡⟨ ≡-cong (λ f → f (Category.Category.Id A)) (IsNTrans.commute (isNTrans ha)) ⟩ | 276 ≡⟨ ≡-cong (λ f → f (Category.Category.Id A)) (IsNTrans.commute (isNTrans ha)) ⟩ |
277 TMap ha b (FMap (y-obj A a) g (Category.Category.Id A)) | 277 TMap ha b (FMap (y-obj A a) g (Category.Category.Id A)) |
278 ≡⟨⟩ | 278 ≡⟨⟩ |
279 TMap ha b ( (A Category.o Category.Category.Id A) g ) | 279 TMap ha b ( (A Category.o Category.Category.Id A) g ) |
280 ≡⟨ ≡-cong ( TMap ha b ) ( ≈-≡ {_} {_} {_} {A} (IsCategory.identityL ( Category.isCategory A ))) ⟩ | 280 ≡⟨ ≡-cong ( TMap ha b ) ( ≡←≈ {_} {_} {_} {A} (IsCategory.identityL ( Category.isCategory A ))) ⟩ |
281 TMap ha b g | 281 TMap ha b g |
282 ∎ | 282 ∎ |
283 )) ⟩ | 283 )) ⟩ |
284 TMap ha b | 284 TMap ha b |
285 ∎ | 285 ∎ |