Mercurial > hg > Members > kono > Proof > category
annotate freyd.agda @ 459:9d24fb809746
freyd trbouled again
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Thu, 02 Mar 2017 20:22:42 +0900 |
parents | f526f4b68565 |
children | 961c236807f1 |
rev | line source |
---|---|
304
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
1 open import Category -- https://github.com/konn/category-agda |
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
2 open import Level |
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
3 |
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
4 module freyd {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) |
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
5 where |
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
6 |
307
9872bddec072
small full subcategory done.
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
306
diff
changeset
|
7 open import cat-utility |
312
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
8 open import HomReasoning |
304
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
9 open import Relation.Binary.Core |
307
9872bddec072
small full subcategory done.
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
306
diff
changeset
|
10 open Functor |
304
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
11 |
311 | 12 -- C is small full subcategory of A ( C is image of F ) |
304
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
13 |
307
9872bddec072
small full subcategory done.
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
306
diff
changeset
|
14 record SmallFullSubcategory {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) |
9872bddec072
small full subcategory done.
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
306
diff
changeset
|
15 : Set (suc ℓ ⊔ (suc c₁ ⊔ suc c₂)) where |
306
92475fe5f59e
Small Full Subcategory (underconstruction)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
305
diff
changeset
|
16 field |
442 | 17 SFSF : Functor A A |
18 SFSFMap← : { a b : Obj A } → Hom A (FObj SFSF a) (FObj SFSF b ) → Hom A a b | |
19 full→ : { a b : Obj A } { x : Hom A (FObj SFSF a) (FObj SFSF b) } → A [ FMap SFSF ( SFSFMap← x ) ≈ x ] | |
20 | |
21 -- ≈→≡ : {a b : Obj A } → { x y : Hom A (FObj SFSF a) (FObj SFSF b) } → | |
22 -- (x≈y : A [ FMap SFSF x ≈ FMap SFSF y ]) → FMap SFSF x ≡ FMap SFSF y -- codomain of FMap is local small | |
305 | 23 |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
24 -- pre-initial |
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
25 |
311 | 26 record PreInitial {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) |
27 (F : Functor A A ) : Set (suc ℓ ⊔ (suc c₁ ⊔ suc c₂)) where | |
308 | 28 field |
314 | 29 preinitialObj : ∀{ a : Obj A } → Obj A |
30 preinitialArrow : ∀{ a : Obj A } → Hom A ( FObj F (preinitialObj {a} )) a | |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
31 |
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
32 -- initial object |
308 | 33 |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
34 record HasInitialObject {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) (i : Obj A) : Set (suc ℓ ⊔ (suc c₁ ⊔ suc c₂)) where |
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
35 field |
314 | 36 initial : ∀( a : Obj A ) → Hom A i a |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
37 uniqueness : ( a : Obj A ) → ( f : Hom A i a ) → A [ f ≈ initial a ] |
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
38 |
315 | 39 -- A complete catagory has initial object if it has PreInitial-SmallFullSubcategory |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
40 |
312
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
41 open NTrans |
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
42 open Limit |
313 | 43 open SmallFullSubcategory |
44 open PreInitial | |
440 | 45 open Complete |
46 open Equalizer | |
443 | 47 open IsEqualizer |
312
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
48 |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
49 initialFromPreInitialFullSubcategory : {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) |
440 | 50 (comp : Complete A A) |
442 | 51 (SFS : SmallFullSubcategory A ) → |
52 (PI : PreInitial A (SFSF SFS )) → { a0 : Obj A } → HasInitialObject A (limit-c comp (SFSF SFS)) | |
53 initialFromPreInitialFullSubcategory A comp SFS PI = record { | |
314 | 54 initial = initialArrow ; |
312
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
55 uniqueness = λ a f → lemma1 a f |
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
56 } where |
442 | 57 F : Functor A A |
58 F = SFSF SFS | |
59 FMap← : { a b : Obj A } → Hom A (FObj F a) (FObj F b ) → Hom A a b | |
60 FMap← = SFSFMap← SFS | |
459 | 61 a0 : Obj A |
62 a0 = limit-c comp F | |
63 uΓ : ( Γ : Functor A A ) → NTrans A A (K A A (limit-c comp Γ)) Γ | |
64 uΓ Γ = {!!} | |
65 lim : ( Γ : Functor A A ) → Limit A A Γ (limit-c comp Γ) (uΓ Γ) | |
66 lim Γ = isLimit comp Γ (uΓ Γ) | |
67 u : NTrans A A (K A A a0) F | |
68 u = T0 ( lim F ) | |
443 | 69 equ : {a b : Obj A} → (f g : Hom A a b) → IsEqualizer A (equalizer-e comp f g ) f g |
70 equ f g = Complete.isEqualizer comp f g | |
442 | 71 ep : {a b : Obj A} → {f g : Hom A a b} → Obj A |
72 ep {a} {b} {f} {g} = equalizer-p comp f g | |
73 ee : {a b : Obj A} → {f g : Hom A a b} → Hom A (ep {a} {b} {f} {g} ) a | |
74 ee {a} {b} {f} {g} = equalizer-e comp f g | |
75 f : {a : Obj A} → Hom A a0 (FObj F (preinitialObj PI {a} ) ) | |
440 | 76 f {a} = TMap u (preinitialObj PI {a} ) |
314 | 77 initialArrow : ∀( a : Obj A ) → Hom A a0 a |
437 | 78 initialArrow a = A [ preinitialArrow PI {a} o f ] |
442 | 79 equ-fi : { a : Obj A} → {f' : Hom A a0 a} → |
443 | 80 IsEqualizer A ee ( A [ preinitialArrow PI {a} o f ] ) f' |
440 | 81 equ-fi {a} {f'} = equ ( A [ preinitialArrow PI {a} o f ] ) f' |
442 | 82 e=id : {e : Hom A a0 a0} → ( {c : Obj A} → A [ A [ TMap u c o e ] ≈ TMap u c ] ) → A [ e ≈ id1 A a0 ] |
438 | 83 e=id {e} uce=uc = let open ≈-Reasoning (A) in |
437 | 84 begin |
85 e | |
442 | 86 ≈↑⟨ limit-uniqueness (lim F) e ( λ {i} → uce=uc ) ⟩ |
440 | 87 limit (lim F) a0 u |
442 | 88 ≈⟨ limit-uniqueness (lim F) (id1 A a0) ( λ {i} → idR ) ⟩ |
437 | 89 id1 A a0 |
90 ∎ | |
442 | 91 kfuc=uc : {c k1 : Obj A} → {p : Hom A k1 a0} → A [ A [ TMap u c o |
440 | 92 A [ p o A [ preinitialArrow PI {k1} o TMap u (preinitialObj PI) ] ] ] |
93 ≈ TMap u c ] | |
441
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
94 kfuc=uc {c} {k1} {p} = let open ≈-Reasoning (A) in |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
95 begin |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
96 TMap u c o ( p o ( preinitialArrow PI {k1} o TMap u (preinitialObj PI) )) |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
97 ≈⟨ cdr assoc ⟩ |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
98 TMap u c o ((p o preinitialArrow PI) o TMap u (preinitialObj PI)) |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
99 ≈⟨ assoc ⟩ |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
100 (TMap u c o ( p o ( preinitialArrow PI {k1} ))) o TMap u (preinitialObj PI) |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
101 ≈↑⟨ car ( full→ SFS ) ⟩ |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
102 FMap F (FMap← (TMap u c o p o preinitialArrow PI)) o TMap u (preinitialObj PI) |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
103 ≈⟨ nat u ⟩ |
442 | 104 TMap u c o FMap (K A A a0) (FMap← (TMap u c o p o preinitialArrow PI)) |
441
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
105 ≈⟨⟩ |
442 | 106 TMap u c o id1 A a0 |
441
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
107 ≈⟨ idR ⟩ |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
108 TMap u c |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
109 ∎ |
442 | 110 kfuc=1 : {k1 : Obj A} → {p : Hom A k1 a0} → A [ A [ p o A [ preinitialArrow PI {k1} o TMap u (preinitialObj PI) ] ] ≈ id1 A a0 ] |
439 | 111 kfuc=1 {k1} {p} = e=id ( kfuc=uc ) |
435
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
112 -- if equalizer has right inverse, f = g |
438 | 113 lemma2 : (a b : Obj A) {c : Obj A} ( f g : Hom A a b ) |
443 | 114 {e : Hom A c a } {e' : Hom A a c } ( equ : IsEqualizer A e f g ) (inv-e : A [ A [ e o e' ] ≈ id1 A a ] ) |
442 | 115 → A [ f ≈ g ] |
438 | 116 lemma2 a b {c} f g {e} {e'} equ inv-e = let open ≈-Reasoning (A) in |
435
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
117 let open Equalizer in |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
118 begin |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
119 f |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
120 ≈↑⟨ idR ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
121 f o id1 A a |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
122 ≈↑⟨ cdr inv-e ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
123 f o ( e o e' ) |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
124 ≈⟨ assoc ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
125 ( f o e ) o e' |
441
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
126 ≈⟨ car ( fe=ge equ ) ⟩ ( g o e ) o e' |
435
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
127 ≈↑⟨ assoc ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
128 g o ( e o e' ) |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
129 ≈⟨ cdr inv-e ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
130 g o id1 A a |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
131 ≈⟨ idR ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
132 g |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
133 ∎ |
439 | 134 lemma1 : (a : Obj A) (f' : Hom A a0 a) → A [ f' ≈ initialArrow a ] |
438 | 135 lemma1 a f' = let open ≈-Reasoning (A) in |
436
ef37decef1ca
initialFullSubCategory
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
435
diff
changeset
|
136 sym ( |
ef37decef1ca
initialFullSubCategory
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
435
diff
changeset
|
137 begin |
ef37decef1ca
initialFullSubCategory
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
435
diff
changeset
|
138 initialArrow a |
ef37decef1ca
initialFullSubCategory
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
435
diff
changeset
|
139 ≈⟨⟩ |
440 | 140 preinitialArrow PI {a} o f |
442 | 141 ≈⟨ lemma2 a0 a (A [ preinitialArrow PI {a} o f ]) f' {ee {a0} {a} {A [ preinitialArrow PI {a} o f ]} {f'} } (equ-fi ) |
142 (kfuc=1 {ep} {ee} ) ⟩ | |
438 | 143 f' |
436
ef37decef1ca
initialFullSubCategory
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
435
diff
changeset
|
144 ∎ ) |
435
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
145 |