|
779
|
1 open import Level
|
|
950
|
2 open import Category
|
|
779
|
3 module CCC where
|
|
|
4
|
|
950
|
5
|
|
779
|
6 open import HomReasoning
|
|
|
7 open import cat-utility
|
|
780
|
8 open import Relation.Binary.PropositionalEquality
|
|
779
|
9
|
|
783
|
10
|
|
|
11 open import HomReasoning
|
|
|
12
|
|
784
|
13 record IsCCC {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ)
|
|
783
|
14 ( １ : Obj A )
|
|
|
15 ( ○ : (a : Obj A ) → Hom A a １ )
|
|
|
16 ( _∧_ : Obj A → Obj A → Obj A )
|
|
|
17 ( <_,_> : {a b c : Obj A } → Hom A c a → Hom A c b → Hom A c (a ∧ b) )
|
|
|
18 ( π : {a b : Obj A } → Hom A (a ∧ b) a )
|
|
|
19 ( π' : {a b : Obj A } → Hom A (a ∧ b) b )
|
|
|
20 ( _<=_ : (a b : Obj A ) → Obj A )
|
|
|
21 ( _* : {a b c : Obj A } → Hom A (a ∧ b) c → Hom A a (c <= b) )
|
|
|
22 ( ε : {a b : Obj A } → Hom A ((a <= b ) ∧ b) a )
|
|
|
23 : Set ( c₁ ⊔ c₂ ⊔ ℓ ) where
|
|
|
24 field
|
|
|
25 -- cartesian
|
|
793
|
26 e2 : {a : Obj A} → ∀ { f : Hom A a １ } → A [ f ≈ ○ a ]
|
|
783
|
27 e3a : {a b c : Obj A} → { f : Hom A c a }{ g : Hom A c b } → A [ A [ π o < f , g > ] ≈ f ]
|
|
|
28 e3b : {a b c : Obj A} → { f : Hom A c a }{ g : Hom A c b } → A [ A [ π' o < f , g > ] ≈ g ]
|
|
|
29 e3c : {a b c : Obj A} → { h : Hom A c (a ∧ b) } → A [ < A [ π o h ] , A [ π' o h ] > ≈ h ]
|
|
785
|
30 π-cong : {a b c : Obj A} → { f f' : Hom A c a }{ g g' : Hom A c b } → A [ f ≈ f' ] → A [ g ≈ g' ] → A [ < f , g > ≈ < f' , g' > ]
|
|
783
|
31 -- closed
|
|
|
32 e4a : {a b c : Obj A} → { h : Hom A (c ∧ b) a } → A [ A [ ε o < A [ (h *) o π ] , π' > ] ≈ h ]
|
|
|
33 e4b : {a b c : Obj A} → { k : Hom A c (a <= b ) } → A [ ( A [ ε o < A [ k o π ] , π' > ] ) * ≈ k ]
|
|
787
|
34 *-cong : {a b c : Obj A} → { f f' : Hom A (a ∧ b) c } → A [ f ≈ f' ] → A [ f * ≈ f' * ]
|
|
967
|
35 open ≈-Reasoning A
|
|
|
36 e'2 : ○ １ ≈ id1 A １
|
|
|
37 e'2 = begin
|
|
783
|
38 ○ １
|
|
793
|
39 ≈↑⟨ e2 ⟩
|
|
783
|
40 id1 A １
|
|
|
41 ∎
|
|
967
|
42 e''2 : {a b : Obj A} {f : Hom A a b } → ( ○ b o f ) ≈ ○ a
|
|
|
43 e''2 {a} {b} {f} = begin
|
|
783
|
44 ○ b o f
|
|
793
|
45 ≈⟨ e2 ⟩
|
|
783
|
46 ○ a
|
|
|
47 ∎
|
|
967
|
48 π-id : {a b : Obj A} → < π , π' > ≈ id1 A (a ∧ b )
|
|
|
49 π-id {a} {b} = begin
|
|
789
|
50 < π , π' >
|
|
|
51 ≈↑⟨ π-cong idR idR ⟩
|
|
|
52 < π o id1 A (a ∧ b) , π' o id1 A (a ∧ b) >
|
|
|
53 ≈⟨ e3c ⟩
|
|
|
54 id1 A (a ∧ b )
|
|
|
55 ∎
|
|
967
|
56 distr-π : {a b c d : Obj A} {f : Hom A c a }{g : Hom A c b } {h : Hom A d c } → ( < f , g > o h ) ≈ < ( f o h ) , ( g o h ) >
|
|
|
57 distr-π {a} {b} {c} {d} {f} {g} {h} = begin
|
|
783
|
58 < f , g > o h
|
|
|
59 ≈↑⟨ e3c ⟩
|
|
|
60 < π o < f , g > o h , π' o < f , g > o h >
|
|
785
|
61 ≈⟨ π-cong assoc assoc ⟩
|
|
|
62 < ( π o < f , g > ) o h , (π' o < f , g > ) o h >
|
|
|
63 ≈⟨ π-cong (car e3a ) (car e3b) ⟩
|
|
783
|
64 < f o h , g o h >
|
|
|
65 ∎
|
|
794
|
66 _×_ : { a b c d : Obj A } ( f : Hom A a c ) (g : Hom A b d ) → Hom A (a ∧ b) ( c ∧ d )
|
|
967
|
67 f × g = < ( f o π ) , (g o π' ) >
|
|
|
68 π-exchg : {a b c : Obj A} {f : Hom A c a }{g : Hom A c b } → < π' , π > o < f , g > ≈ < g , f >
|
|
|
69 π-exchg {a} {b} {c} {f} {g} = begin
|
|
|
70 < π' , π > o < f , g >
|
|
|
71 ≈⟨ distr-π ⟩
|
|
|
72 < π' o < f , g > , π o < f , g > >
|
|
|
73 ≈⟨ π-cong e3b e3a ⟩
|
|
|
74 < g , f >
|
|
|
75 ∎
|
|
|
76 π'π : {a b : Obj A} → < π' , π > o < π' , π > ≈ id1 A (a ∧ b)
|
|
|
77 π'π = trans-hom π-exchg π-id
|
|
|
78 exchg-π : {a b c d : Obj A} {f : Hom A c a }{g : Hom A d b } → < f o π , g o π' > o < π' , π > ≈ < f o π' , g o π >
|
|
|
79 exchg-π {a} {b} {c} {d} {f} {g} = begin
|
|
|
80 < f o π , g o π' > o < π' , π >
|
|
|
81 ≈⟨ distr-π ⟩
|
|
|
82 < (f o π) o < π' , π > , (g o π' ) o < π' , π > >
|
|
|
83 ≈↑⟨ π-cong assoc assoc ⟩
|
|
|
84 < f o (π o < π' , π > ) , g o (π' o < π' , π >)>
|
|
|
85 ≈⟨ π-cong (cdr e3a) (cdr e3b) ⟩
|
|
|
86 < f o π' , g o π >
|
|
|
87 ∎
|
|
|
88 distr-* : {a b c d : Obj A } { h : Hom A (a ∧ b) c } { k : Hom A d a } → ( h * o k ) ≈ ( h o < ( k o π ) , π' > ) *
|
|
794
|
89 distr-* {a} {b} {c} {d} {h} {k} = begin
|
|
|
90 h * o k
|
|
|
91 ≈↑⟨ e4b ⟩
|
|
|
92 ( ε o < (h * o k ) o π , π' > ) *
|
|
|
93 ≈⟨ *-cong ( begin
|
|
|
94 ε o < (h * o k ) o π , π' >
|
|
|
95 ≈↑⟨ cdr ( π-cong assoc refl-hom ) ⟩
|
|
|
96 ε o ( < h * o ( k o π ) , π' > )
|
|
|
97 ≈↑⟨ cdr ( π-cong (cdr e3a) e3b ) ⟩
|
|
|
98 ε o ( < h * o ( π o < k o π , π' > ) , π' o < k o π , π' > > )
|
|
|
99 ≈⟨ cdr ( π-cong assoc refl-hom) ⟩
|
|
|
100 ε o ( < (h * o π) o < k o π , π' > , π' o < k o π , π' > > )
|
|
|
101 ≈↑⟨ cdr ( distr-π ) ⟩
|
|
|
102 ε o ( < h * o π , π' > o < k o π , π' > )
|
|
|
103 ≈⟨ assoc ⟩
|
|
|
104 ( ε o < h * o π , π' > ) o < k o π , π' >
|
|
|
105 ≈⟨ car e4a ⟩
|
|
|
106 h o < k o π , π' >
|
|
|
107 ∎ ) ⟩
|
|
|
108 ( h o < k o π , π' > ) *
|
|
967
|
109 ∎
|
|
794
|
110 α : {a b c : Obj A } → Hom A (( a ∧ b ) ∧ c ) ( a ∧ ( b ∧ c ) )
|
|
967
|
111 α = < ( π o π ) , < ( π' o π ) , π' > >
|
|
794
|
112 α' : {a b c : Obj A } → Hom A ( a ∧ ( b ∧ c ) ) (( a ∧ b ) ∧ c )
|
|
967
|
113 α' = < < π , ( π o π' ) > , ( π' o π' ) >
|
|
|
114 β : {a b c d : Obj A } { f : Hom A a b} { g : Hom A a c } { h : Hom A a d } → ( α o < < f , g > , h > ) ≈ < f , < g , h > >
|
|
794
|
115 β {a} {b} {c} {d} {f} {g} {h} = begin
|
|
|
116 α o < < f , g > , h >
|
|
|
117 ≈⟨⟩
|
|
|
118 ( < ( π o π ) , < ( π' o π ) , π' > > ) o < < f , g > , h >
|
|
|
119 ≈⟨ distr-π ⟩
|
|
|
120 < ( ( π o π ) o < < f , g > , h > ) , ( < ( π' o π ) , π' > o < < f , g > , h > ) >
|
|
|
121 ≈⟨ π-cong refl-hom distr-π ⟩
|
|
|
122 < ( ( π o π ) o < < f , g > , h > ) , ( < ( ( π' o π ) o < < f , g > , h > ) , ( π' o < < f , g > , h > ) > ) >
|
|
|
123 ≈↑⟨ π-cong assoc ( π-cong assoc refl-hom ) ⟩
|
|
|
124 < ( π o (π o < < f , g > , h >) ) , ( < ( π' o ( π o < < f , g > , h > ) ) , ( π' o < < f , g > , h > ) > ) >
|
|
|
125 ≈⟨ π-cong (cdr e3a ) ( π-cong (cdr e3a ) e3b ) ⟩
|
|
|
126 < ( π o < f , g > ) , < ( π' o < f , g > ) , h > >
|
|
|
127 ≈⟨ π-cong e3a ( π-cong e3b refl-hom ) ⟩
|
|
|
128 < f , < g , h > >
|
|
967
|
129 ∎
|
|
794
|
130
|
|
783
|
131
|
|
784
|
132 record CCC {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) : Set ( c₁ ⊔ c₂ ⊔ ℓ ) where
|
|
781
|
133 field
|
|
783
|
134 １ : Obj A
|
|
|
135 ○ : (a : Obj A ) → Hom A a １
|
|
|
136 _∧_ : Obj A → Obj A → Obj A
|
|
|
137 <_,_> : {a b c : Obj A } → Hom A c a → Hom A c b → Hom A c (a ∧ b)
|
|
|
138 π : {a b : Obj A } → Hom A (a ∧ b) a
|
|
|
139 π' : {a b : Obj A } → Hom A (a ∧ b) b
|
|
|
140 _<=_ : (a b : Obj A ) → Obj A
|
|
|
141 _* : {a b c : Obj A } → Hom A (a ∧ b) c → Hom A a (c <= b)
|
|
|
142 ε : {a b : Obj A } → Hom A ((a <= b ) ∧ b) a
|
|
784
|
143 isCCC : IsCCC A １ ○ _∧_ <_,_> π π' _<=_ _* ε
|
|
781
|
144
|
|
952
|
145 ----
|
|
|
146 --
|
|
|
147 -- Sub Object Classifier as Topos
|
|
954
|
148 -- pull back on
|
|
963
|
149 -- ○ b
|
|
|
150 -- b -----------→ 1
|
|
|
151 -- | |
|
|
|
152 -- m | | ⊤
|
|
|
153 -- ↓ char m ↓
|
|
|
154 -- a -----------→ Ω
|
|
|
155 -- h
|
|
952
|
156 --
|
|
950
|
157 open Equalizer
|
|
963
|
158 open import equalizer
|
|
950
|
159
|
|
952
|
160 record Mono {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) {b a : Obj A} (mono : Hom A b a) : Set (c₁ ⊔ c₂ ⊔ ℓ) where
|
|
|
161 field
|
|
|
162 isMono : {c : Obj A} ( f g : Hom A c b ) → A [ A [ mono o f ] ≈ A [ mono o g ] ] → A [ f ≈ g ]
|
|
|
163
|
|
|
164 open Mono
|
|
|
165
|
|
975
|
166 record IsTopos {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) (c : CCC A)
|
|
952
|
167 ( Ω : Obj A )
|
|
975
|
168 ( ⊤ : Hom A (CCC.１ c) Ω )
|
|
|
169 (Ker : {a : Obj A} → ( h : Hom A a Ω ) → Equalizer A h (A [ ⊤ o (CCC.○ c a) ]))
|
|
952
|
170 (char : {a b : Obj A} → (m : Hom A b a) → Mono A m → Hom A a Ω) : Set ( suc c₁ ⊔ suc c₂ ⊔ suc ℓ ) where
|
|
950
|
171 field
|
|
975
|
172 char-ker : {a b : Obj A } {h : Hom A a Ω} (m : Hom A b a) → (mono : Mono A m)
|
|
|
173 → A [ char m mono ≈ h ]
|
|
954
|
174 ker-char : {a b : Obj A} → (m : Hom A b a) → (mono : Mono A m) → Iso A b ( equalizer-c (Ker ( char m mono )))
|
|
950
|
175
|
|
975
|
176 record Topos {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) (c : CCC A) : Set ( suc c₁ ⊔ suc c₂ ⊔ suc ℓ ) where
|
|
952
|
177 field
|
|
950
|
178 Ω : Obj A
|
|
975
|
179 ⊤ : Hom A (CCC.１ c) Ω
|
|
|
180 Ker : {a : Obj A} → ( h : Hom A a Ω ) → Equalizer A h (A [ ⊤ o (CCC.○ c a) ])
|
|
952
|
181 char : {a b : Obj A} → (m : Hom A b a ) → Mono A m → Hom A a Ω
|
|
975
|
182 isTopos : IsTopos A c Ω ⊤ Ker char
|
|
950
|
183 ker : {a : Obj A} → ( h : Hom A a Ω ) → Hom A ( equalizer-c (Ker h) ) a
|
|
|
184 ker h = equalizer (Ker h)
|
|
973
|
185 Monik : {a : Obj A} (h : Hom A a Ω) → Mono A (equalizer (Ker h))
|
|
|
186 Monik h = record { isMono = λ f g → monic (Ker h ) }
|
|
975
|
187 char-m=⊤ : {a b : Obj A} → (m : Hom A b a) → (mono : Mono A m) → A [ A [ char m mono o m ] ≈ A [ ⊤ o CCC.○ c b ] ]
|
|
|
188 char-m=⊤ {a} {b} m mono = begin
|
|
|
189 char m mono o m ≈⟨ car (IsTopos.char-ker isTopos m mono) ⟩
|
|
|
190 (⊤ o CCC.○ c a) o m ≈↑⟨ assoc ⟩
|
|
|
191 ⊤ o (CCC.○ c a o m ) ≈⟨ cdr (IsCCC.e2 (CCC.isCCC c)) ⟩
|
|
|
192 ⊤ o CCC.○ c b ∎ where open ≈-Reasoning A
|
|
783
|
193
|
|
963
|
194 record NatD {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) ( １ : Obj A) : Set ( suc c₁ ⊔ suc c₂ ⊔ suc ℓ ) where
|
|
|
195 field
|
|
|
196 Nat : Obj A
|
|
|
197 nzero : Hom A １ Nat
|
|
|
198 nsuc : Hom A Nat Nat
|
|
|
199
|
|
|
200 open NatD
|
|
|
201
|
|
|
202 record IsToposNat {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) ( １ : Obj A) (TNat : NatD A １ )
|
|
|
203 ( gNat : (nat : NatD A １ ) → Hom A (Nat TNat) (Nat nat) )
|
|
|
204 : Set ( suc c₁ ⊔ suc c₂ ⊔ suc ℓ ) where
|
|
|
205 field
|
|
|
206 izero : (nat : NatD A １ ) → A [ A [ gNat nat o nzero TNat ] ≈ nzero nat ]
|
|
|
207 isuc : (nat : NatD A １ ) → A [ A [ gNat nat o nsuc TNat ] ≈ A [ nsuc nat o gNat nat ] ]
|
|
|
208
|
|
|
209 record ToposNat {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) ( １ : Obj A) : Set ( suc c₁ ⊔ suc c₂ ⊔ suc ℓ ) where
|
|
|
210 field
|
|
|
211 TNat : NatD A １
|
|
|
212 gNat : (nat : NatD A １ ) → Hom A (Nat TNat) (Nat nat)
|
|
|
213 isToposN : IsToposNat A １ TNat gNat
|
|
783
|
214
|
