Mercurial > hg > Members > kono > Proof > category
annotate freyd.agda @ 695:7a6ee564e3a8
fix
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 13 Nov 2017 13:31:35 +0900 |
parents | 984518c56e96 |
children |
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 |
628 | 4 module freyd where |
304
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
5 |
307
9872bddec072
small full subcategory done.
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
306
diff
changeset
|
6 open import cat-utility |
312
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
7 open import HomReasoning |
304
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
8 open import Relation.Binary.Core |
307
9872bddec072
small full subcategory done.
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
306
diff
changeset
|
9 open Functor |
304
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
10 |
311 | 11 -- C is small full subcategory of A ( C is image of F ) |
693 | 12 -- but we don't use smallness in this proof |
304
bd7b3f3d1d4c
Freyd Adjoint Functor Theorem
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
13 |
693 | 14 record FullSubcategory {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) |
307
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 |
693 | 17 FSF : Functor A A |
18 FSFMap← : { a b : Obj A } → Hom A (FObj FSF a) (FObj FSF b ) → Hom A a b | |
19 full→ : { a b : Obj A } { x : Hom A (FObj FSF a) (FObj FSF b) } → A [ FMap FSF ( FSFMap← x ) ≈ x ] | |
20 full← : { a b : Obj A } { x : Hom A (FObj FSF a) (FObj FSF b) } → A [ FSFMap← ( FMap FSF x ) ≈ x ] | |
305 | 21 |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
22 -- pre-initial |
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
23 |
311 | 24 record PreInitial {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) |
629 | 25 (F : Functor A A) : Set (suc ℓ ⊔ (suc c₁ ⊔ suc c₂)) where |
308 | 26 field |
629 | 27 preinitialObj : Obj A |
28 preinitialArrow : ∀{a : Obj A } → Hom A ( FObj F preinitialObj ) a | |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
29 |
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
30 -- initial object |
671 | 31 -- now in cat-utility |
32 -- record HasInitialObject {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) (i : Obj A) : Set (suc ℓ ⊔ (suc c₁ ⊔ suc c₂)) where | |
33 -- field | |
34 -- initial : ∀( a : Obj A ) → Hom A i a | |
35 -- uniqueness : { a : Obj A } → ( f : Hom A i a ) → A [ f ≈ initial a ] | |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
36 |
693 | 37 -- A complete catagory has initial object if it has PreInitial-FullSubcategory |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
38 |
312
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
39 open NTrans |
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
40 open Limit |
487 | 41 open IsLimit |
693 | 42 open FullSubcategory |
313 | 43 open PreInitial |
440 | 44 open Complete |
45 open Equalizer | |
443 | 46 open IsEqualizer |
312
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
47 |
309
e213595b845e
preinitial problem written
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
308
diff
changeset
|
48 initialFromPreInitialFullSubcategory : {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) |
440 | 49 (comp : Complete A A) |
693 | 50 (SFS : FullSubcategory A ) → |
695 | 51 (PI : PreInitial A (FSF SFS )) → HasInitialObject A (limit-c comp (FSF SFS)) |
442 | 52 initialFromPreInitialFullSubcategory A comp SFS PI = record { |
314 | 53 initial = initialArrow ; |
636 | 54 uniqueness = λ {a} f → lemma1 a f |
312
702adc45704f
is this right direction?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
311
diff
changeset
|
55 } where |
442 | 56 F : Functor A A |
693 | 57 F = FSF SFS |
442 | 58 FMap← : { a b : Obj A } → Hom A (FObj F a) (FObj F b ) → Hom A a b |
693 | 59 FMap← = FSFMap← SFS |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
60 a00 : Obj A |
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
61 a00 = limit-c comp F |
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
62 lim : ( Γ : Functor A A ) → Limit A A Γ |
487 | 63 lim Γ = climit comp Γ |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
64 u : NTrans A A (K A A a00) F |
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
65 u = t0 ( lim F ) |
443 | 66 equ : {a b : Obj A} → (f g : Hom A a b) → IsEqualizer A (equalizer-e comp f g ) f g |
672 | 67 equ f g = isEqualizer ( Complete.cequalizer comp f g ) |
442 | 68 ep : {a b : Obj A} → {f g : Hom A a b} → Obj A |
69 ep {a} {b} {f} {g} = equalizer-p comp f g | |
70 ee : {a b : Obj A} → {f g : Hom A a b} → Hom A (ep {a} {b} {f} {g} ) a | |
71 ee {a} {b} {f} {g} = equalizer-e comp f g | |
617
34540494fdcf
initital obj uniquness done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
608
diff
changeset
|
72 f : Hom A a00 (FObj F (preinitialObj PI ) ) |
34540494fdcf
initital obj uniquness done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
608
diff
changeset
|
73 f = TMap u (preinitialObj PI ) |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
74 initialArrow : ∀( a : Obj A ) → Hom A a00 a |
437 | 75 initialArrow a = A [ preinitialArrow PI {a} o f ] |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
76 equ-fi : { a : Obj A} → {f' : Hom A a00 a} → |
443 | 77 IsEqualizer A ee ( A [ preinitialArrow PI {a} o f ] ) f' |
440 | 78 equ-fi {a} {f'} = equ ( A [ preinitialArrow PI {a} o f ] ) f' |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
79 e=id : {e : Hom A a00 a00} → ( {c : Obj A} → A [ A [ TMap u c o e ] ≈ TMap u c ] ) → A [ e ≈ id1 A a00 ] |
438 | 80 e=id {e} uce=uc = let open ≈-Reasoning (A) in |
437 | 81 begin |
82 e | |
495 | 83 ≈↑⟨ limit-uniqueness (isLimit (lim F)) ( λ {i} → uce=uc ) ⟩ |
487 | 84 limit (isLimit (lim F)) a00 u |
495 | 85 ≈⟨ limit-uniqueness (isLimit (lim F)) ( λ {i} → idR ) ⟩ |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
86 id1 A a00 |
437 | 87 ∎ |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
88 kfuc=uc : {c k1 : Obj A} → {p : Hom A k1 a00} → A [ A [ TMap u c o |
440 | 89 A [ p o A [ preinitialArrow PI {k1} o TMap u (preinitialObj PI) ] ] ] |
90 ≈ TMap u c ] | |
441
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
91 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
|
92 begin |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
93 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
|
94 ≈⟨ cdr assoc ⟩ |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
95 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
|
96 ≈⟨ assoc ⟩ |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
97 (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
|
98 ≈↑⟨ car ( full→ SFS ) ⟩ |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
99 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
|
100 ≈⟨ nat u ⟩ |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
101 TMap u c o FMap (K A A a00) (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
|
102 ≈⟨⟩ |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
103 TMap u c o id1 A a00 |
441
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
104 ≈⟨ idR ⟩ |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
105 TMap u c |
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
106 ∎ |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
107 kfuc=1 : {k1 : Obj A} → {p : Hom A k1 a00} → A [ A [ p o A [ preinitialArrow PI {k1} o TMap u (preinitialObj PI) ] ] ≈ id1 A a00 ] |
439 | 108 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
|
109 -- if equalizer has right inverse, f = g |
438 | 110 lemma2 : (a b : Obj A) {c : Obj A} ( f g : Hom A a b ) |
443 | 111 {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 | 112 → A [ f ≈ g ] |
438 | 113 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
|
114 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
|
115 begin |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
116 f |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
117 ≈↑⟨ idR ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
118 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
|
119 ≈↑⟨ cdr inv-e ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
120 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
|
121 ≈⟨ assoc ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
122 ( f o e ) o e' |
441
61550782be4a
preinital full subcategory done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
440
diff
changeset
|
123 ≈⟨ 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
|
124 ≈↑⟨ assoc ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
125 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
|
126 ≈⟨ cdr inv-e ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
127 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
|
128 ≈⟨ idR ⟩ |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
129 g |
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
130 ∎ |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
131 lemma1 : (a : Obj A) (f' : Hom A a00 a) → A [ f' ≈ initialArrow a ] |
438 | 132 lemma1 a f' = let open ≈-Reasoning (A) in |
436
ef37decef1ca
initialFullSubCategory
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
435
diff
changeset
|
133 sym ( |
ef37decef1ca
initialFullSubCategory
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
435
diff
changeset
|
134 begin |
ef37decef1ca
initialFullSubCategory
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
435
diff
changeset
|
135 initialArrow a |
ef37decef1ca
initialFullSubCategory
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
435
diff
changeset
|
136 ≈⟨⟩ |
440 | 137 preinitialArrow PI {a} o f |
484
fcae3025d900
fix Limit pu a0 and t0 in record definition
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
481
diff
changeset
|
138 ≈⟨ lemma2 a00 a (A [ preinitialArrow PI {a} o f ]) f' {ee {a00} {a} {A [ preinitialArrow PI {a} o f ]} {f'} } (equ-fi ) |
442 | 139 (kfuc=1 {ep} {ee} ) ⟩ |
438 | 140 f' |
436
ef37decef1ca
initialFullSubCategory
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
435
diff
changeset
|
141 ∎ ) |
435
9f014f34b988
f=g if equalizer k has right inverse
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
350
diff
changeset
|
142 |
481
65e6906782bb
Completeness of Comma Category begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
460
diff
changeset
|
143 |
65e6906782bb
Completeness of Comma Category begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
460
diff
changeset
|
144 |