├── .gitignore ├── CONTRIBUTING.md ├── README.md ├── arend.yaml ├── hStacks.iml └── src ├── Foundation └── Set.ard ├── S4_2_0013.ard ├── S4_3_001L.ard ├── S4_4_001R.ard └── S4_5_04AN.ard /.gitignore: -------------------------------------------------------------------------------- 1 | .bin 2 | .idea 3 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | Overview 2 | === 3 | Formalize each and every tag in Stacks project. Each section should be in a separate file. For example, Section 4.2 with tag 0013 should be named `S4_2_0013.ard`. The stacks project is mostly self-contained, but if some preliminary is required (e.g., basic facts about groups), put the file under the `Foundation` directory. 4 | 5 | Naming convention 6 | === 7 | Follow the [naming convention](https://github.com/arend-lang/arend-contrib/blob/master/CONTRIBUTING.md) of arend-contrib. 8 | 9 | Comments 10 | === 11 | 12 | Each tag in Stacks project should be discussed. Use `-- tag(1234)` on a separate line to mark corresponding parts in the source. When referring to a tag in a comment, use `@tag(5678)`. If some items are not applicable (e.g., automatic in the type-theoretic setting), explain why no code is needed in comments. 13 | 14 | If the formalization is notably different from the set-theoretic setting, explain how hPOV simplifies or complicates things with comments starting with "hPOV:". We currently do not distinguish the more precise cause (constructivity, infinite hierarchy of universes, or the homotopy interpretation of path types). 15 | 16 | If there is some space for improvement on the Arend side, mark them with comments starting with "Arend:" and report issues on [their GitHub repository](https://github.com/JetBrains/Arend). 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # hStacks 2 | Stacks project, from a homotopy type theory point-of-view (hPOV) 3 | 4 | We aim to formalize the entire [Stacks project](https://stacks.math.columbia.edu/) tag by tag in [Arend](https://arend-lang.github.io/). 5 | 6 | The purpose of this project is three-fold: 7 | 8 | 1. Explore how hPOV affects algebraic geometry and related subjects; 9 | 2. Provide the math community with a formally verified library on algebraic geometry; 10 | 3. Provide the Arend community with "real-world" use cases, and try to find possible improvements. 11 | 12 | This project is in its very early stage, so expect a lot of design/structural changes. 13 | -------------------------------------------------------------------------------- /arend.yaml: -------------------------------------------------------------------------------- 1 | langVersion: 1.5 2 | sourcesDir: src 3 | binariesDir: .bin 4 | dependencies: [arend-lib] -------------------------------------------------------------------------------- /hStacks.iml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /src/Foundation/Set.ard: -------------------------------------------------------------------------------- 1 | \import Paths 2 | 3 | -- hPOV: this definition is only useful for Sets; for types of higher h-level we need to use embeddings, i.e., maps that 4 | -- induces an equivalence on path types, instead. see HoTTbook, Section 4.6 5 | \func isInjective {A B : \Set} (f : A -> B) : \Prop => \Pi (x x' : A) -> f x = f x' -> x = x' 6 | \func retract->isInjective {A B : \Set} (f : A -> B) (g : B -> A) (r : \Pi (x : A) -> g (f x) = x) : isInjective f => 7 | \lam x x' p => inv (r x) *> pmap g p *> r x' 8 | -- hPOV: this is the constructive version of surjectivity, "every fiber is inhabited" 9 | -- NOTE: this usage is different from HoTTbook, where "surjective" means "every fiber is merely inhabited," and the 10 | -- notion defined here is called "split surjective" 11 | \func isSurjective {A B : \Set} (f : A -> B) : \Set => \Pi (y : B) -> \Sigma (x : A) (f x = y) 12 | -------------------------------------------------------------------------------- /src/S4_2_0013.ard: -------------------------------------------------------------------------------- 1 | \import Algebra.Group 2 | \import Equiv 3 | \import Function () 4 | \import HLevel 5 | \import Homotopy.Truncation 6 | \import Paths 7 | \import Foundation.Set 8 | 9 | -- tag(0014) 10 | \class Precategory (A : \Type) { 11 | | mor : A -> A -> \Set 12 | | ide (x : A) : mor x x 13 | | \infixr 8 o {x y z : A} : mor y z -> mor x y -> mor x z 14 | \property id-left {x y : A} (f : mor x y) : ide _ o f = f 15 | \property id-right {x y : A} (f : mor x y) : f o ide _ = f 16 | \property o-assoc {x y z w : A} (f : mor z w) (g : mor y z) (h : mor x y) : (f o g) o h = f o (g o h) 17 | } 18 | \func id {C : Precategory} {x : C} => ide x 19 | 20 | -- tag(0015) 21 | -- hPOV: the "size" issue disappears due to the infinite hierarchy of p-levels 22 | \instance Precategory-Set : Precategory \Set 23 | | mor A B => A -> B 24 | | ide _ => Function.id 25 | | o => Function.o 26 | | id-left _ => idp 27 | | id-right _ => idp 28 | | o-assoc _ _ _ => idp 29 | -- TODO: finish the list of examples 30 | 31 | -- tag(0016) 32 | -- implicit in the definition @tag(0014) 33 | 34 | -- tag(0017) 35 | \record Isomorphism {C : Precategory} (x y : C) (f : mor x y) { 36 | | f^-1 : mor y x 37 | \property inv-left : f^-1 o f = id 38 | \property inv-right : f o f^-1 = id 39 | } \where { 40 | \func inv-unique {C : Precategory} {x y : C} {f : mor x y} (e : Isomorphism x y f) (e' : Isomorphism x y f) : e.f^-1 = e'.f^-1 => 41 | f^-1 ==< inv (C.id-left f^-1) >== 42 | id o f^-1 ==< pmap (`o f^-1) (inv (e'.inv-left)) >== 43 | (e'.f^-1 o f) o f^-1 ==< C.o-assoc _ _ _ >== 44 | e'.f^-1 o (f o f^-1) ==< pmap (e'.f^-1 o) (e.inv-right) >== 45 | e'.f^-1 o id ==< C.id-right e'.f^-1 >== 46 | e'.f^-1 `qed 47 | \use \level levelProp {C : Precategory} {x y : C} (f : mor x y) (e e' : Isomorphism x y f) : e = e' => 48 | \let p => inv-unique e e' 49 | \in path (\lam i => \new Isomorphism x y f { 50 | | f^-1 => p @ i 51 | | inv-left => (pathInProp (\lam j => p @ j o f = id) e.inv-left e'.inv-left) @ i 52 | | inv-right => (pathInProp (\lam j => f o p @ j = id) e.inv-right e'.inv-right) @ i 53 | } ) 54 | } 55 | \func \infix 1 ~= {C : Precategory} (x y : C) : \Set => Isomorphism x y 56 | \func isIsomorphism {C : Precategory} {x y : C} (f : mor x y) : \Prop => Isomorphism x y f 57 | \func iso-id {C : Precategory} (x : C) : Isomorphism x x id \cowith 58 | | f^-1 => id 59 | | inv-left => id-left id 60 | | inv-right => id-right id 61 | \func iso-inv {C : Precategory} {x y : C} (iso : Isomorphism x y) : Isomorphism y x \cowith 62 | | f => iso.f^-1 63 | | f^-1 => iso.f 64 | | inv-left => iso.inv-right 65 | | inv-right => iso.inv-left 66 | 67 | \func eq->Iso {C : Precategory} (x y : C) (p : x = y) : x ~= y \elim p 68 | | idp => iso-id _ 69 | 70 | -- hPOV: categories are more interesting from hPOV as there are non-trivial interactions between category theorry and equalities 71 | \class Category \extends Precategory 72 | | eq~=Iso (x y : A) : Equiv (eq->Iso x y) 73 | 74 | -- tag(0018) 75 | \class Groupoid \extends Precategory 76 | | isIso {x y : A} (f : mor x y) : isIsomorphism f 77 | 78 | -- tag(0019) 79 | -- hPOV: this can be used as an alternative definition of groups; one might even argue that this is the more natural one 80 | \class Group' \extends Groupoid 81 | | A => \Sigma 82 | \func Group->Group' (G : Group) : Group' \cowith 83 | | mor _ _ => G 84 | | ide _ => G.ide 85 | | o x y => x G.* y 86 | | id-left _ => G.ide-left 87 | | id-right _ => G.ide-right 88 | | o-assoc _ _ _ => G.*-assoc 89 | | isIso x => \new Isomorphism _ _ _ { 90 | | f^-1 => G.inverse x 91 | | inv-left => G.inverse-left x 92 | | inv-right => G.inverse-right x 93 | } 94 | \func Group'->Group (G : Group') : Group \cowith 95 | | E => G.mor () () 96 | | ide => G.ide () 97 | | * => G.o 98 | | ide-left {_} => G.id-left _ 99 | | ide-right {_} => G.id-right _ 100 | | *-assoc {x} {y} {z} => o-assoc _ _ _ 101 | | inverse x => Isomorphism.f^-1 {isIso x} 102 | | inverse-left x => Isomorphism.inv-left {isIso x} 103 | | inverse-right x => Isomorphism.inv-right {isIso x} 104 | -- hPOV: one may proceed to show that in fact Group = Group' with univalence 105 | 106 | -- tag(001A) 107 | \func DiscreteCategory (A : \Set) : Precategory A \cowith 108 | | mor x y => x = y 109 | | ide _ => idp 110 | | o p q => q *> p 111 | | id-left _ => idp 112 | | id-right => idp_*> 113 | | o-assoc p q r => inv (*>-assoc r q p) 114 | 115 | -- tag(001B) 116 | \class Functor (A B : Precategory) (\classifying F : A -> B) 117 | | fmap {x y : A} (f : mor x y) : mor (F x) (F y) 118 | | fmap-id (x : A) : fmap (ide x) = id 119 | | fmap-o {x y z : A} (f : mor y z) (g : mor x y) : fmap (f o g) = fmap f o fmap g 120 | 121 | \func functor-id (A : Precategory) : Functor A A Function.id \cowith 122 | | fmap f => f 123 | | fmap-id _ => idp 124 | | fmap-o _ _ => idp 125 | 126 | \func functor-comp {A B C : Precategory} (F : Functor B C) (G : Functor A B) : Functor A C (F.F Function.`o` G.F) \cowith { 127 | -- Arend: why the classifying field of Functor doesn't work? 128 | | fmap f => F.fmap (G.fmap f) 129 | | fmap-id x => pmap F.fmap (G.fmap-id x) *> F.fmap-id _ 130 | | fmap-o f g => pmap F.fmap (G.fmap-o f g) *> F.fmap-o _ _ 131 | } 132 | 133 | 134 | -- tag(001C) 135 | \func isFaithful {A B : Precategory} (F : Functor A B) : \Prop => \Pi (x y : A) -> isInjective (F.fmap {x} {y}) 136 | \func isFull {A B : Precategory} (F : Functor A B) : \Set => \Pi (x y : A) -> isSurjective (F.fmap {x} {y}) 137 | -- hPOV: this is the constructive version of essential surjectivity, or "split essential surjectivity" in HoTTbook 138 | -- see the notes in the definition of "isSurjective" in Foundation/Set.ard 139 | \func isEssentiallySurjective {A B : Precategory} (F : Functor A B) => \Pi (y : B) -> \Sigma (x : A) (F.F x ~= y) 140 | 141 | -- tag(001D) 142 | -- TODO: these require a definition for subsets (and they look boring), leave them for now 143 | 144 | -- tag(001E) 145 | -- hPOV: this becomes a claim about p-levels, which is automatically inferred by Arend 146 | 147 | -- tag(001F) 148 | -- TODO: define group homomorphisms in the usual way and show the two definitions coincide 149 | \func GroupHom' (G H : Group') => Functor G H 150 | 151 | -- tag(001G) 152 | -- commutative triangle in a precategory 153 | \record CommTri {C : Precategory} (s m t : C) { 154 | | f : mor m t 155 | | g : mor s m 156 | | h : mor s t 157 | \property comm : f o g = h 158 | } 159 | \func commtri-g-id {C : Precategory} {s t : C} (f : mor s t) : CommTri s s t f id f \cowith 160 | | comm => id-right f 161 | \func commtri-g-comp {C : Precategory} {l m r d : C} {p : mor m d} (c : CommTri m r d { | h => p } ) (c' : CommTri l m d { | f => p }) : CommTri l r d \cowith 162 | | f => c.f 163 | | g => c.g o c'.g 164 | | h => c'.h 165 | | comm => inv (o-assoc c.f c.g c'.g) *> pmap (`o c'.g) c.comm *> c'.comm 166 | 167 | \func commtri-g-id-left {C : Precategory} {s m t : C} (c : CommTri s m t) : commtri-g-comp (commtri-g-id c.f) c = {CommTri _ _ _ { | f => c.f | h => c.h }} c => 168 | \let p => id-left c.g 169 | \in path (\lam i => \new CommTri s m t { 170 | | f => c.f 171 | | g => p @ i 172 | | h => c.h 173 | | comm => coe2 (c.f o (p @ __) = c.h) right comm i -- hPOV: pathInProp can also be used, but this construction seems generalizable to higher categories 174 | }) 175 | \func commtri-g-id-right {C : Precategory} {s m t : C} (c : CommTri s m t) : commtri-g-comp c (commtri-g-id c.h) = {CommTri _ _ _ { | f => c.f | h => c.h }} c => 176 | \let p => id-right c.g 177 | \in path (\lam i => \new CommTri s m t { 178 | | f => c.f 179 | | g => p @ i 180 | | h => c.h 181 | | comm => coe2 (c.f o (p @ __) = c.h) right comm i 182 | }) 183 | \func commtri-g-comp-assoc {C : Precategory} {l m n r d : C} {p : mor m d} {q : mor n d} (c : CommTri n r d { | h => q }) (c' : CommTri m n d { | f => q | h => p }) (c'' : CommTri l m d { | f => p }) : 184 | commtri-g-comp (commtri-g-comp c c') c'' = commtri-g-comp c (commtri-g-comp c' c'') => 185 | \let p => o-assoc c.g c'.g c''.g 186 | \in path (\lam i => \new CommTri l r d { 187 | | f => c.f 188 | | g => p @ i 189 | | h => c''.h 190 | | comm => coe (c.f o (p @ __) = c''.h) (CommTri.comm {commtri-g-comp (commtri-g-comp c c') c''}) i 191 | }) 192 | 193 | \func SliceOver \alias \infix 1 /* (C : Precategory) (x : C) : Precategory \cowith 194 | | A => \Sigma (y : C) (mor y x) 195 | | mor y y' => CommTri _ _ _ { | f => y'.2 | h => y.2 } 196 | | ide y => commtri-g-id y.2 197 | | o f f' => commtri-g-comp f f' 198 | | id-left f => commtri-g-id-left f 199 | | id-right f => commtri-g-id-right f 200 | | o-assoc f g h => commtri-g-comp-assoc f g h 201 | \func SliceOver->C (C : Precategory) (x : C) : Functor (C /* x) C \cowith 202 | | F y => y.1 203 | | fmap c => CommTri.g {c} 204 | | fmap-id _ => idp 205 | | fmap-o _ _ => idp 206 | 207 | -- tag(001H) 208 | \func commtri-f-id {C : Precategory} {s t : C} (g : mor s t) : CommTri s t t id g g \cowith 209 | | comm => id-left g 210 | \func commtri-f-comp {C : Precategory} {l m r u : C} {p : mor u m} (c : CommTri u m r { | g => p } ) (c' : CommTri u l m { | h => p }) : CommTri u l r \cowith 211 | | f => c.f o c'.f 212 | | g => c'.g 213 | | h => c.h 214 | | comm => (o-assoc c.f c'.f c'.g) *> pmap (c.f o) c'.comm *> c.comm 215 | 216 | \func commtri-f-id-left {C : Precategory} {s m t : C} (c : CommTri s m t) : commtri-f-comp (commtri-f-id c.h) c = {CommTri _ _ _ { | g => c.g | h => c.h }} c => 217 | \let p => id-left c.f 218 | \in path (\lam i => \new CommTri s m t { 219 | | f => p @ i 220 | | g => c.g 221 | | h => c.h 222 | | comm => coe2 ((p @ __) o c.g = c.h) right comm i 223 | }) 224 | \func commtri-f-id-right {C : Precategory} {s m t : C} (c : CommTri s m t) : commtri-f-comp c (commtri-f-id c.g) = {CommTri _ _ _ { | g => c.g | h => c.h }} c => 225 | \let p => id-right c.f 226 | \in path (\lam i => \new CommTri s m t { 227 | | f => p @ i 228 | | g => c.g 229 | | h => c.h 230 | | comm => coe2 ((p @ __) o c.g = h) right comm i 231 | }) 232 | \func commtri-f-comp-assoc {C : Precategory} {l m n r u : C} {p : mor u m} {q : mor u n} (c : CommTri u n r { | g => q }) (c' : CommTri u m n { | g => p | h => q }) (c'' : CommTri u l m { | h => p }) : 233 | commtri-f-comp (commtri-f-comp c c') c'' = commtri-f-comp c (commtri-f-comp c' c'') => 234 | \let p => o-assoc c.f c'.f c''.f 235 | \in path (\lam i => \new CommTri u l r { 236 | | f => p @ i 237 | | g => c''.g 238 | | h => c.h 239 | | comm => coe ((p @ __) o c''.g = c.h) (CommTri.comm {commtri-f-comp (commtri-f-comp c c') c''}) i 240 | }) 241 | 242 | \func SliceUnder (C : Precategory) (x : C) : Precategory \cowith 243 | | A => \Sigma (y : C) (mor x y) 244 | | mor y y' => CommTri _ _ _ { | g => y.2 | h => y'.2 } 245 | | ide y => commtri-f-id y.2 246 | | o f f' => commtri-f-comp f f' 247 | | id-left f => commtri-f-id-left f 248 | | id-right f => commtri-f-id-right f 249 | | o-assoc f g h => commtri-f-comp-assoc f g h 250 | 251 | \func \infix 1 */ {A : \Type} (x : A) (C : Precategory A) => SliceUnder C x 252 | \func SliceUnder->C (C : Precategory) (x : C) : Functor (x */ C) C \cowith 253 | | F y => y.1 254 | | fmap c => CommTri.f {c} 255 | | fmap-id _ => idp 256 | | fmap-o _ _ => idp 257 | 258 | -- tag(001I) 259 | \class NatTrans {A B : Precategory} (F G : Functor A B) (\classifying t : \Pi (x : A) -> mor (F.F x) (G.F x)) { 260 | \property natural {x y : A} (f : mor x y) : G.fmap f o t x = t y o F.fmap f 261 | } \where { 262 | -- Arend: (feature request) infer that properties are "irrelavant" when proving equality 263 | \func equals {A B : Precategory} {F G : Functor A B} (s t : NatTrans F G) (e : s.t = t.t) : s = t => 264 | equals' F G s t e 265 | \func equals' {A B : Precategory} (F G : Functor A B) (s t : NatTrans F G) (e : s.t = t.t) => 266 | path (\lam i => \new NatTrans F G { 267 | | t => e @ i 268 | | natural f => pathInProp (\lam j => G.fmap f o (e @ j) _ = (e @ j) _ o F.fmap f) (s.natural f) (t.natural f) @ i 269 | }) 270 | -- this is more useful than above 271 | \func equalsExt {A B : Precategory} {F G : Functor A B} (s t : NatTrans F G) (e : \Pi (x : A) -> s.t x = t.t x) : s = t => 272 | equalsExt' F G s t e 273 | \func equalsExt' {A B : Precategory} (F G : Functor A B) (s t : NatTrans F G) (e : \Pi (x : A) -> s.t x = t.t x) : s = t => 274 | equals s t (funExt (\lam x => mor (F.F x) (G.F x)) s.t t.t e) 275 | } 276 | \func nat-trans-id {A B : Precategory} (F : Functor A B) : NatTrans F F \cowith 277 | | t x => id 278 | | natural f => id-right (fmap f) *> inv (id-left (fmap f)) 279 | \func nat-trans-comp {A B : Precategory} {E F G : Functor A B} (t : NatTrans F G) (s : NatTrans E F) : NatTrans E G => 280 | nat-trans-comp' E F G t s 281 | \func nat-trans-comp' {A B : Precategory} (E F G : Functor A B) (t : NatTrans F G) (s : NatTrans E F) : NatTrans E G \cowith 282 | | t x => t.t x o s.t x 283 | | natural f => 284 | -- the following paragraph looks evil 285 | G.fmap f o t.t _ o s.t _ ==< inv (o-assoc _ _ _) >== 286 | (G.fmap f o t.t _) o s.t _ ==< pmap (`o s.t _) (t.natural f) >== 287 | (t.t _ o F.fmap f) o s.t _ ==< o-assoc _ _ _ >== 288 | t.t _ o F.fmap f o s.t _ ==< pmap (t.t _ o) (s.natural f) >== 289 | t.t _ o s.t _ o E.fmap f ==< inv (o-assoc _ _ _) >== 290 | (t.t _ o s.t _) o E.fmap f `qed 291 | 292 | \instance Precategory-Functor {A B : Precategory} : Precategory (Functor A B) 293 | | mor F G => NatTrans F G 294 | | ide F => nat-trans-id F 295 | | o s t => nat-trans-comp s t 296 | | id-left s => NatTrans.equalsExt _ _ (\lam x => id-left (NatTrans.t {s} x)) 297 | | id-right s => NatTrans.equalsExt _ _ (\lam x => id-right (NatTrans.t {s} x)) 298 | | o-assoc s t u => NatTrans.equalsExt _ _ (\lam x => o-assoc (NatTrans.t {s} x) (NatTrans.t {t} x) (NatTrans.t {u} x)) 299 | 300 | -- the following lemma is very useful in dealing with isomorphisms between functors: 301 | -- a natural transformation is an isomorphism in this precategory iff it is a pointwise isomorphism 302 | \func pointwise->Isomorphism {A B : Precategory} {F G : Functor A B} (s : NatTrans F G) (i : \Pi (x : A) -> isIsomorphism (s.t x)) : isIsomorphism s => 303 | \let t => \new NatTrans G F { 304 | | t x => Isomorphism.f^-1 {i x} 305 | | natural {x} {y} f => 306 | \let | sx : Isomorphism => i x | sy : Isomorphism => i y 307 | | p : (s.t y) o F.fmap f o sx.f^-1 = G.fmap f => 308 | (s.t y) o F.fmap f o sx.f^-1 ==< inv (o-assoc _ _ _) >== 309 | (s.t y o F.fmap f) o sx.f^-1 ==< inv (pmap (`o sx.f^-1) (s.natural f)) >== 310 | (G.fmap f o s.t x) o sx.f^-1 ==< o-assoc _ _ _ >== 311 | G.fmap f o s.t x o sx.f^-1 ==< pmap (G.fmap f o) sx.inv-right >== 312 | G.fmap f o id ==< id-right _ >== 313 | G.fmap f `qed 314 | \in 315 | F.fmap f o sx.f^-1 ==< inv (id-left _) >== 316 | id o F.fmap f o sx.f^-1 ==< inv (pmap (`o F.fmap f o sx.f^-1) sy.inv-left) >== 317 | (sy.f^-1 o (s.t y)) o F.fmap f o sx.f^-1 ==< o-assoc _ _ _ >== 318 | sy.f^-1 o s.t y o F.fmap f o sx.f^-1 ==< pmap (sy.f^-1 o) p >== 319 | sy.f^-1 o G.fmap f `qed 320 | } 321 | \in \new Isomorphism F G s { 322 | | f^-1 => t 323 | | inv-left => NatTrans.equalsExt (nat-trans-comp t s) id (\lam x => Isomorphism.inv-left {i x}) 324 | | inv-right => NatTrans.equalsExt (nat-trans-comp s t) id (\lam x => Isomorphism.inv-right {i x}) 325 | } 326 | \func Isomorphism->pointwise {A B : Precategory} {F G : Functor A B} (iso : Isomorphism F G) (x : A) : isIsomorphism (NatTrans.t {iso.f} x) => 327 | \let s : NatTrans F G => iso.f | t : NatTrans G F => iso.f^-1 328 | \in \new Isomorphism _ _ (s.t x) { 329 | | f^-1 => t.t x 330 | | inv-left => pmap (\lam (u : NatTrans F F) => u.t x) iso.inv-left 331 | | inv-right => pmap (\lam (u : NatTrans G G) => u.t x) iso.inv-right 332 | } 333 | 334 | -- tag(02C2) 335 | -- hPOV: see @tag(0015) 336 | 337 | -- tag(001J) 338 | \record CatEquiv {A B : Precategory} (F : Functor A B) { 339 | | F^-1 : Functor B A 340 | | inv-left : functor-comp {A} {B} {A} F^-1 F ~= functor-id A -- FIXME: why are implicit parameters necessary here? 341 | | inv-right : functor-comp {B} {A} {B} F F^-1 ~= functor-id B 342 | } 343 | \func cat-equiv-inv {A B : Precategory} (F : Functor A B) (G : Functor B A) (e : CatEquiv F G) : CatEquiv G F \cowith 344 | | inv-left => e.inv-right 345 | | inv-right => e.inv-left 346 | 347 | -- tag(05SG) 348 | -- some useful results concerning pointwise isomorphisms 349 | \func conjugate {A : Precategory} (F G : A -> A) (i : \Pi (x : A) -> F x ~= G x) {x y : A} (f : mor (F x) (F y)) : mor (G x) (G y) => 350 | Isomorphism.f {i y} o f o Isomorphism.f^-1 {i x} 351 | \func conjugate-id {A : Precategory} (F G : A -> A) (i : \Pi (x : A) -> F x ~= G x) (x : A) : conjugate F G i (ide (F x)) = id => 352 | (pmap (_ o)) (id-left _) *> Isomorphism.inv-right {i x} 353 | \func conjugate-o {A : Precategory} (F G : A -> A) (i : \Pi (x : A) -> F x ~= G x) {x y z : A} (f : mor (F y) (F z)) (g : mor (F x) (F y)) : conjugate F G i (f o g) = conjugate F G i f o conjugate F G i g => 354 | -- Arend: this is where metas could come in handy 355 | \let | companion => conjugate F G i 356 | | ix : Isomorphism => i x | iy : Isomorphism => i y | iz : Isomorphism => i z 357 | -- Arend: it would be really really nice to be able to write (i x).f, etc. 358 | \in inv ( 359 | companion f o iy.f o g o ix.f^-1 ==< inv (o-assoc _ _ _) >== 360 | (companion f o iy.f) o g o ix.f^-1 ==< pmap (`o (g o ix.f^-1)) (o-assoc _ _ _) >== 361 | (iz.f o (f o iy.f^-1) o iy.f) o g o ix.f^-1 ==< pmap ((iz.f o __) o g o ix.f^-1) (o-assoc _ _ _) >== 362 | (iz.f o f o iy.f^-1 o iy.f) o g o ix.f^-1 ==< pmap ((iz.f o f o __) o g o ix.f^-1) iy.inv-left >== 363 | (iz.f o f o id) o g o ix.f^-1 ==< pmap ((iz.f o __) o g o ix.f^-1) (id-right _) >== 364 | (iz.f o f) o g o ix.f^-1 ==< o-assoc _ _ _ >== 365 | iz.f o f o g o ix.f^-1 ==< pmap (iz.f o) (inv (o-assoc _ _ _)) >== 366 | iz.f o (f o g) o ix.f^-1 `qed 367 | ) 368 | \func conjugate->comm {A : Precategory} (F G : A -> A) (i : \Pi (x : A) -> F x ~= G x) {x y : A} (f : mor (F x) (F y)) : conjugate F G i f o Isomorphism.f {i x} = Isomorphism.f {i y} o f => 369 | \let | ix : Isomorphism => i x | iy : Isomorphism => i y 370 | \in 371 | (iy.f o f o ix.f^-1) o ix.f ==< o-assoc _ _ _ >== 372 | iy.f o (f o ix.f^-1) o ix.f ==< pmap (iy.f o) (o-assoc _ _ _) >== 373 | iy.f o f o ix.f^-1 o ix.f ==< pmap (iy.f o f o __) (ix.inv-left) >== 374 | iy.f o f o id ==< pmap (iy.f o) (id-right _) >== 375 | iy.f o f `qed 376 | \func comm->conjugate {A : Precategory} (F G : A -> A) (i : \Pi (x : A) -> F x ~= G x) {x y : A} (f : mor (F x) (F y)) (g : mor (G x) (G y)) (comm : Isomorphism.f {i y} o f = g o Isomorphism.f {i x}) : conjugate F G i f = g => 377 | \let | ix : Isomorphism => i x | iy : Isomorphism => i y 378 | \in 379 | iy.f o f o ix.f^-1 ==< inv (o-assoc _ _ _) >== 380 | (iy.f o f) o ix.f^-1 ==< pmap (`o ix.f^-1) comm >== 381 | (g o ix.f) o ix.f^-1 ==< o-assoc _ _ _ >== 382 | g o ix.f o ix.f^-1 ==< pmap (g o) ix.inv-right >== 383 | g o id ==< id-right _ >== 384 | g `qed 385 | \func conjugate_retract {A : Precategory} (F G : A -> A) (i : \Pi (x : A) -> F x ~= G x) {x y : A} (f : mor (F x) (F y)) : conjugate G F (\lam x => iso-inv (i x)) (conjugate F G i f) = f => 386 | \let | ix : Isomorphism => i x | iy : Isomorphism => i y 387 | \in comm->conjugate G F (\lam x => iso-inv (i x)) _ _ ( 388 | iy.f^-1 o conjugate F G i f ==< pmap (iy.f^-1 o) (inv (id-right _)) >== 389 | iy.f^-1 o conjugate F G i f o id ==< pmap (iy.f^-1 o conjugate F G i f o __) (inv ix.inv-right) >== 390 | iy.f^-1 o conjugate F G i f o ix.f o ix.f^-1 ==< pmap (iy.f^-1 o) (inv (o-assoc _ _ _)) >== 391 | iy.f^-1 o (conjugate F G i f o ix.f) o ix.f^-1 ==< pmap (iy.f^-1 o __ o ix.f^-1) (conjugate->comm F G i f) >== 392 | iy.f^-1 o (iy.f o f) o ix.f^-1 ==< pmap (iy.f^-1 o) (o-assoc _ _ _) >== 393 | iy.f^-1 o iy.f o f o ix.f^-1 ==< inv (o-assoc _ _ _) >== 394 | (iy.f^-1 o iy.f) o f o ix.f^-1 ==< pmap (__ o f o ix.f^-1) iy.inv-left >== 395 | id o f o ix.f^-1 ==< id-left _ >== 396 | f o ix.f^-1 `qed 397 | ) 398 | \func isInjective-conjugate {A : Precategory} (F G : A -> A) (i : \Pi (x : A) -> F x ~= G x) (x y : A) : isInjective (conjugate F G i {x} {y}) => 399 | retract->isInjective (conjugate F G i) (conjugate G F (\lam x => iso-inv (i x))) (conjugate_retract F G i) 400 | 401 | 402 | -- hPOV: @tag(05SG) is the same as half of @tag(02C3) since our definition of essential surjectivity is constructive 403 | -- I also have to remark that this lemma is a bit far from "proving itself" 404 | \func FFES->CatEquiv {A B : Precategory} (F : Functor A B) (full : isFull F) (faithful : isFaithful F) (essSurj : isEssentiallySurjective F) : CatEquiv F => 405 | \let | j (y : B) : A => (essSurj y).1 406 | | i (y : B) : Isomorphism => (essSurj y).2 | i' y => iso-inv (i y) 407 | | companion => conjugate Function.id (F.F Function.o j) i' 408 | | j-fmap {x y : B} (f : mor x y) : mor (j x) (j y) => (full _ _ (companion f)).1 409 | | Fj=companion {x y : B} (f : mor x y) : F.fmap (j-fmap f) = companion f => (full _ _ (companion f)).2 410 | | j* => \new Functor B A { 411 | | F => j 412 | | fmap => j-fmap 413 | | fmap-id x => faithful (j x) (j x) _ _ (Fj=companion id *> (conjugate-id Function.id (F.F Function.o j) i' x) *> inv (F.fmap-id _)) 414 | | fmap-o {x} {y} {z} f g => faithful (j x) (j z) (j-fmap (f o g)) (j-fmap f o j-fmap g) ( 415 | F.fmap (j-fmap (f o g)) ==< Fj=companion _ >== 416 | companion (f o g) ==< conjugate-o Function.id (F.F Function.o j) i' f g >== 417 | companion f o companion g ==< inv (pmap2 (o) (Fj=companion f) (Fj=companion g)) >== 418 | F.fmap (j-fmap f) o F.fmap (j-fmap g) ==< inv (F.fmap-o _ _) >== 419 | F.fmap (j-fmap f o j-fmap g) `qed 420 | ) 421 | } 422 | | Fj*->id => \new NatTrans (functor-comp F j*) (functor-id B) { 423 | | t y => Isomorphism.f {i y} 424 | | natural {x} {y} f => 425 | \let | ix : Isomorphism => i x | iy : Isomorphism => i y 426 | \in inv ( 427 | iy.f o F.fmap (j-fmap f) ==< pmap (iy.f o) (Fj=companion f) >== 428 | iy.f o companion f ==< inv (conjugate->comm (F.F Function.o j) Function.id i (companion f)) >== 429 | conjugate (F.F Function.o j) Function.id i (companion f) o ix.f ==< pmap (`o ix.f) (conjugate_retract Function.id (F.F Function.o j) i' f) >== 430 | f o ix.f `qed 431 | ) 432 | } 433 | | k (x : A) : mor (j (F.F x)) x => (full (j (F.F x)) x (Isomorphism.f {i (F.F x)})).1 434 | | k' (x : A) : mor x (j (F.F x)) => (full x (j (F.F x)) (Isomorphism.f^-1 {i (F.F x)})).1 435 | | Fk=iF (x : A) : F.fmap (k x) = Isomorphism.f {i (F.F x)} => (full _ _ (Isomorphism.f {i (F.F x)})).2 436 | | Fk'=i'F (x : A) : F.fmap (k' x) = Isomorphism.f^-1 {i (F.F x)} => (full _ _ (Isomorphism.f^-1 {i (F.F x)})).2 437 | | k-isIso (x : A) : isIsomorphism (k x) => 438 | \let iFx : Isomorphism => i (F.F x) 439 | \in \new Isomorphism _ _ (k x) { 440 | | f^-1 => k' x 441 | | inv-left => faithful _ _ (k' x o k x) id ( 442 | F.fmap (k' x o k x) ==< F.fmap-o _ _ >== 443 | F.fmap (k' x) o F.fmap (k x) ==< pmap2 (o) (Fk'=i'F x) (Fk=iF x) >== 444 | iFx.f^-1 o iFx.f ==< iFx.inv-left >== 445 | id ==< inv (F.fmap-id _) >== 446 | F.fmap id `qed 447 | ) 448 | | inv-right => faithful _ _ (k x o k' x) id ( 449 | F.fmap (k x o k' x) ==< F.fmap-o _ _ >== 450 | F.fmap (k x) o F.fmap (k' x) ==< pmap2 (o) (Fk=iF x) (Fk'=i'F x) >== 451 | iFx.f o iFx.f^-1 ==< iFx.inv-right >== 452 | id ==< inv (F.fmap-id _) >== 453 | F.fmap id `qed 454 | ) 455 | } 456 | | j*F->id => \new NatTrans (functor-comp j* F) (functor-id A) { 457 | | t x => k x 458 | | natural {x} {y} f => 459 | \let | iFx : Isomorphism => i (F.F x) | iFy : Isomorphism => i (F.F y) 460 | \in faithful (j (F.F x)) y (f o k x) (k y o j-fmap (F.fmap f)) ( 461 | F.fmap (f o k x) ==< F.fmap-o _ _ >== 462 | F.fmap f o F.fmap (k x) ==< pmap (F.fmap f o) (Fk=iF x) >== 463 | F.fmap f o iFx.f ==< Fj*->id.natural (F.fmap f) >== 464 | iFy.f o F.fmap (j-fmap (F.fmap f)) ==< pmap (`o F.fmap (j-fmap (F.fmap f))) (inv (Fk=iF y)) >== 465 | F.fmap (k y) o F.fmap (j-fmap (F.fmap f)) ==< inv (F.fmap-o _ _) >== 466 | F.fmap (k y o j-fmap (F.fmap f)) `qed 467 | ) 468 | } 469 | \in \new CatEquiv F { 470 | | F^-1 => j* 471 | | inv-left => pointwise->Isomorphism j*F->id k-isIso 472 | | inv-right => pointwise->Isomorphism Fj*->id (\lam y => i y) -- Arend: replace this with `i` results in a type mismatch, which doesn't seem reasonable 473 | } 474 | 475 | -- tag(02C3) 476 | \func CatEquiv->Faithful_retract {A B : Precategory} (F : Functor A B) (G : Functor B A) (e : CatEquiv F G) (x y : A) (f : mor x y) : 477 | conjugate (G.F Function.o F.F) Function.id (Isomorphism->pointwise e.inv-left) (G.fmap (F.fmap f)) = f => 478 | comm->conjugate (G.F Function.o F.F) Function.id (Isomorphism->pointwise e.inv-left) (G.fmap (F.fmap f)) f (inv (NatTrans.natural {e.inv-left.f} f)) 479 | \func CatEquiv->Faithful {A B : Precategory} (F : Functor A B) (G : Functor B A) (e : CatEquiv F G) : isFaithful F => 480 | \lam x y => retract->isInjective F.fmap (\lam f' => conjugate (G.F Function.o F.F) Function.id (Isomorphism->pointwise e.inv-left) (G.fmap f')) (CatEquiv->Faithful_retract F e.F^-1 e x y) 481 | \func CatEquiv->Full {A B : Precategory} (F : Functor A B) (G : Functor B A) (e : CatEquiv F G) : isFull F => 482 | \lam x y f' => 483 | \let | companion => conjugate (G.F Function.o F.F) Function.id (Isomorphism->pointwise e.inv-left) 484 | | f => companion (G.fmap f') 485 | | p : companion (G.fmap (F.fmap f)) = f => CatEquiv->Faithful_retract F G e x y f 486 | | q : G.fmap (F.fmap f) = G.fmap f' => isInjective-conjugate (G.F Function.o F.F) Function.id (Isomorphism->pointwise e.inv-left) _ _ (G.fmap (F.fmap f)) (G.fmap f') p 487 | \in (f, CatEquiv->Faithful G F (cat-equiv-inv F G e) _ _ (F.fmap f) f' q) 488 | \func CatEquiv->EssentiallySurjective {A B : Precategory} (F : Functor A B) (G : Functor B A) (e : CatEquiv F G) : isEssentiallySurjective F => 489 | \lam y => (G.F y, Isomorphism->pointwise e.inv-right y) 490 | 491 | -- tag(001K) 492 | \func ProductCategory (A B : Precategory) : Precategory (\Sigma A B) \cowith 493 | | mor x y => \Sigma (mor x.1 y.1) (mor x.2 y.2) 494 | | ide x => (id, id) 495 | | o f g => (f.1 o g.1, f.2 o g.2) 496 | | id-left f => path (\lam i => ((id-left f.1) @ i, (id-left f.2) @ i)) 497 | | id-right f => path (\lam i => ((id-right f.1) @ i, (id-right f.2) @ i)) 498 | | o-assoc f g h => path (\lam i => ((o-assoc f.1 g.1 h.1) @ i, (o-assoc f.2 g.2 h.2) @ i)) 499 | -------------------------------------------------------------------------------- /src/S4_3_001L.ard: -------------------------------------------------------------------------------- 1 | \import Paths 2 | \import Foundation.Set 3 | \import S4_2_0013 4 | 5 | -- tag(001M) 6 | \func opp (C : Precategory) : Precategory \cowith 7 | | A => C.A 8 | | mor x y => mor y x 9 | | ide x => id 10 | | o f g => g o f 11 | | id-left f => id-right f 12 | | id-right f => id-left f 13 | | o-assoc f g h => inv (o-assoc h g f) 14 | 15 | -- tag(001N) 16 | \func ContravariantFunctor (C S : Precategory) : Precategory => Precategory-Functor {C `opp} {S} 17 | 18 | -- tag(02X6) 19 | \func Presheaf (C : Precategory) : Precategory => ContravariantFunctor C Precategory-Set 20 | 21 | -- tag(001O) 22 | \func functor-of-points \alias Yoneda {C : Precategory} (u : C) : Presheaf C => \new Functor _ _ { 23 | | F x => mor x u 24 | | fmap f => `o f 25 | | fmap-id x => path (\lam i p => id-right p @ i) 26 | | fmap-o f g => path (\lam i p => inv (o-assoc p g f) @ i) 27 | } 28 | \func mor->rep-psh-nat-trans {C : Precategory} {u v : C} (p : mor u v) : NatTrans (Yoneda u) (Yoneda v) \cowith 29 | | t x => p o 30 | | natural f => path (\lam i g => o-assoc p g f @ i) 31 | \func YonedaEmbedding (C : Precategory) : Functor C (Presheaf C) \cowith 32 | | F => Yoneda 33 | | fmap => mor->rep-psh-nat-trans 34 | | fmap-id x => NatTrans.equalsExt (mor->rep-psh-nat-trans id) id (\lam _ => path (\lam i f => id-left f @ i)) 35 | | fmap-o {x} {y} {z} f g => 36 | \let | fnt : NatTrans (Yoneda y) (Yoneda z) => mor->rep-psh-nat-trans f 37 | | gnt : NatTrans (Yoneda x) (Yoneda y) => mor->rep-psh-nat-trans g 38 | | fgnt : NatTrans (Yoneda x) (Yoneda z) => mor->rep-psh-nat-trans (f o g) 39 | | ntfg : NatTrans (Yoneda x) (Yoneda z) => nat-trans-comp' (Yoneda x) (Yoneda y) (Yoneda z) fnt gnt 40 | \in NatTrans.equalsExt' (Yoneda x) (Yoneda z) fgnt ntfg (\lam _ => path (\lam i p => o-assoc f g p @ i)) 41 | 42 | -- tag(001P) 43 | -- TODO: I'm running out of good, descriptive names here 44 | \func Yoneda-isFaithful_retract {C : Precategory} (x y : C) (f : mor x y) : NatTrans.t {Functor.fmap {YonedaEmbedding C} f} x id = f => id-right f 45 | \func Yoneda-isFaithful (C : Precategory) : isFaithful (YonedaEmbedding C) => 46 | \lam x y => retract->isInjective (Functor.fmap {YonedaEmbedding C}) (\lam (t : NatTrans (Yoneda x) (Yoneda y)) => t.t x id) (Yoneda-isFaithful_retract x y) 47 | \func Yoneda-isFull (C : Precategory) : isFull (YonedaEmbedding C) => \lam x y (t : NatTrans) => 48 | \let | f => t.t x id 49 | | p z (g : mor z x) => path (\lam i => (t.natural g @ i) id) *> pmap (t.t z) (id-left g) 50 | \in (f, NatTrans.equalsExt' (Yoneda x) (Yoneda y) _ _ (\lam z => path (\lam i g => p z g @ i))) 51 | \func Yoneda-lemma {C : Precategory} (F : Presheaf C) (u : C) (t : NatTrans (Yoneda u) F) : Functor.F {F} u => t.t u id 52 | \func Yoneda-lemma-inv {C : Precategory} (F : Presheaf C) (u : C) (k : Functor.F {F} u) : NatTrans (Yoneda u) F \cowith 53 | | t _ f => Functor.fmap {F} f k 54 | | natural f => path (\lam i g => ((inv (Functor.fmap-o {F} f g)) @ i) k) 55 | \func Yoneda-lemma_retract {C : Precategory} {F : Presheaf C} {u : C} (t : NatTrans (Yoneda u) F) : Yoneda-lemma-inv F u (Yoneda-lemma F u t) = t => 56 | NatTrans.equalsExt' (Yoneda u) F (Yoneda-lemma-inv F u (Yoneda-lemma F u t)) t (\lam x => path (\lam i f => (t.natural f @ i) id) *> path (\lam i f => t.t x (id-left f @ i))) 57 | \func Yoneda-lemma_section (C : Precategory) {F : Presheaf C} {u : C} (k : Functor.F {F} u) : Yoneda-lemma F u (Yoneda-lemma-inv F u k) = k => 58 | path (\lam i => (Functor.fmap-id {F} u @ i) k) 59 | 60 | -- tag(001Q) 61 | \func isRepresentable {C : Precategory} (F : Presheaf C) => \Sigma (u : C) (Yoneda u ~= F) 62 | -------------------------------------------------------------------------------- /src/S4_4_001R.ard: -------------------------------------------------------------------------------- 1 | \import HLevel 2 | \import Paths 3 | \import S4_2_0013 4 | \import S4_3_001L 5 | 6 | -- tag(001S) 7 | -- alternatively, define general limits over functors first, and then construct binary products as a special case 8 | \record Product2 {C : Precategory} (x y : C) { 9 | | u : C 10 | | p : mor u x 11 | | q : mor u y 12 | | universal {t : C} (f : mor t x) (g : mor t y) : Contr (\Sigma (h : mor t u) (p o h = f) (q o h = g)) 13 | } 14 | 15 | \func psh-product2 {C : Precategory} (P Q : Presheaf C) : Presheaf C => \new Functor _ _ { 16 | | F x => \Sigma (Functor.F {P} x) (Functor.F {Q} x) 17 | | fmap f t => (fmap {P} f t.1, fmap {Q} f t.2) 18 | | fmap-id x => path (\lam i t => ((fmap-id {P} x @ i) t.1, (fmap-id {Q} x @ i) t.2)) 19 | | fmap-o f g => path (\lam i t => ((fmap-o {P} f g @ i) t.1, (fmap-o {Q} f g @ i) t.2)) 20 | } 21 | 22 | \func Product2-Yoneda {C : Precategory} (x y : C) (p : Product2 x y) : Yoneda p.u ~= psh-product2 (Yoneda x) (Yoneda y) => 23 | pointwise->Isomorphism {C `opp} {Precategory-Set} (\new NatTrans _ _ { 24 | | t w f => (p.p C.o {w} f, p.q C.o {w} f) -- Arend: FIXME: why is the implicit argument w needed here? 25 | | natural f => path (\lam i g => (o-assoc p.p g f @ i, o-assoc p.q g f @ i)) 26 | }) (\lam w => \new Isomorphism {Precategory-Set} (mor w p.u) (\Sigma (mor w x) (mor w y)) _ { 27 | | f^-1 (fg : \Sigma (mor w x) (mor w y)) => (Contr.center {p.universal fg.1 fg.2}).1 28 | -- Arend: FIXME: omitting the type annotation for fg causes weird error 29 | | inv-left => path (\lam i h => (Contr.contraction {p.universal (p.p o h) (p.q o h)} (h, idp, idp) @ i).1) 30 | | inv-right => path (\lam i (fg : \Sigma (mor w x) (mor w y)) => 31 | \let c => Contr.center {p.universal fg.1 fg.2} \in (c.2 @ i, c.3 @ i)) 32 | -- Arend: FIXME: same problem above. Arend seems to insist that fg has some functor type; moreover, the 33 | -- type of fg is inferred correctly in the Arend Errors window when using a goal 34 | }) 35 | 36 | -- tag(001T) 37 | -- hPOV: as a general rule of thumb, for existence claims to work well with precategories one needs the constructive 38 | -- (untruncated) version since the existence is usually unique only up to isomorphism, while in categories the 39 | -- truncated version is expected to work thanks to uniqueness. 40 | \func hasProduct2 (C : Precategory) (x y : C) => Product2 x y 41 | -------------------------------------------------------------------------------- /src/S4_5_04AN.ard: -------------------------------------------------------------------------------- 1 | \import Data.Or 2 | \import Function () 3 | \import HLevel 4 | \import Paths 5 | \import S4_2_0013 6 | \import S4_3_001L 7 | \import S4_4_001R 8 | 9 | -- tag(04AO) 10 | -- coproducts are just products in the opposite category 11 | \func Coproduct2 {C : Precategory} (x y : C) => Product2 {C `opp} x y 12 | -- alternative definition 13 | \record Coproduct2' {C : Precategory} (x y : C) { 14 | | u : C 15 | | i : mor x u 16 | | j : mor y u 17 | | universal {t : C} (f : mor x t) (g : mor y t) : Contr (\Sigma (h : mor u t) (h o i = f) (h o j = g)) 18 | } 19 | -- TODO: show that these two definitions are the same 20 | 21 | -- tag(04AP) 22 | \func hasCoproduct2 (C : Precategory) (x y : C) => Coproduct2 x y 23 | --------------------------------------------------------------------------------