Skip to content

Commit 37baea1

Browse files
authored
Merge pull request #1851 from Alizter/ps/branch/flattening_lemma_for_graphquotient
Flattening lemma for GraphQuotient
2 parents 7227fb9 + 8786878 commit 37baea1

File tree

2 files changed

+168
-6
lines changed

2 files changed

+168
-6
lines changed

theories/Colimits/GraphQuotient.v

Lines changed: 166 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,14 @@
1-
Require Import Basics.Overture Basics.Tactics Basics.PathGroupoids.
1+
Require Import Basics.Overture Basics.Tactics Basics.PathGroupoids Basics.Equivalences.
2+
Require Import Types.Universe Types.Paths Types.Arrow Types.Sigma Types.Forall Cubical.DPath.
23

34
(** * Quotient of a graph *)
45

6+
(** ** Definition *)
7+
8+
(** The quotient of a graph is one of the simplest HITs that can be found in HoTT. It consists of a base type and a relation on it, and for every witness of a relation between two points of the type, a path.
9+
10+
We use graph quotients to build up all our other non-recursive HITs. Their simplicity means that we can easily prove results about them and generalise them to other HITs. *)
11+
512
Local Unset Elimination Schemes.
613

714
Module Export GraphQuotient.
@@ -38,7 +45,6 @@ End GraphQuotient.
3845

3946
Arguments gq {A R} a.
4047

41-
4248
Definition GraphQuotient_rec {A R P} (c : A -> P) (g : forall a b, R a b -> c a = c b)
4349
: GraphQuotient R -> P.
4450
Proof.
@@ -58,3 +64,161 @@ Proof.
5864
refine ((apD_const _ _)^ @ _).
5965
rapply GraphQuotient_ind_beta_gqglue.
6066
Defined.
67+
68+
(** ** The flattening lemma *)
69+
70+
(** Univalence tells us that type families over a colimit correspond to cartesian families over the indexing diagram. The flattening lemma gives an explicit description of the family over a colimit that corresponds to a given cartesian family, again using univalence. Together, these are known as descent, a fundamental result in higher topos theory which has many implications. *)
71+
72+
Section Flattening.
73+
74+
Context `{Univalence} {A : Type} {R : A -> A -> Type}.
75+
(** We consider a type family over [A] which is "equifibrant" or "cartesian": the fibers are equivalent when the base points are related by [R]. *)
76+
Context (F : A -> Type) (e : forall x y, R x y -> F x <~> F y).
77+
78+
(** By univalence, the equivalences give equalities, which means that [F] induces a map on the quotient. *)
79+
Definition DGraphQuotient : GraphQuotient R -> Type
80+
:= GraphQuotient_rec F (fun x y s => path_universe (e x y s)).
81+
82+
(** The transport of [DGraphQuotient] along [gqglue] equals the equivalence [e] applied to the original point. This lemma is required a few times in the following proofs. *)
83+
Definition transport_DGraphQuotient {x y} (s : R x y) (a : F x)
84+
: transport DGraphQuotient (gqglue s) a = e x y s a.
85+
Proof.
86+
lhs nrapply transport_idmap_ap.
87+
lhs nrapply (transport2 idmap).
88+
1: apply GraphQuotient_rec_beta_gqglue.
89+
rapply transport_path_universe.
90+
Defined.
91+
92+
(** The family [DGraphQuotient] we have defined over [GraphQuotient R] has a total space which we will describe as a [GraphQuotient] of [sig F] by an appropriate relation. *)
93+
94+
(** We mimic the constructors of [GraphQuotient] for the total space. Here is the point constructor. *)
95+
Definition flatten_gq {x} : F x -> sig DGraphQuotient.
96+
Proof.
97+
intros p.
98+
exact (gq x; p).
99+
Defined.
100+
101+
(** And here is the path constructor. *)
102+
Definition flatten_gqglue {x y} (s : R x y) (a : F x)
103+
: flatten_gq a = flatten_gq (e x y s a).
104+
Proof.
105+
snrapply path_sigma'.
106+
- by apply gqglue.
107+
- apply transport_DGraphQuotient.
108+
Defined.
109+
110+
(** This lemma is the same as [transport_DGraphQuotient] but adapted instead for [DPath]. The use of [DPath] will be apparent there. *)
111+
Lemma equiv_dp_dgraphquotient (x y : A) (s : R x y) (a : F x) (b : F y)
112+
: DPath DGraphQuotient (gqglue s) a b <~> (e x y s a = b).
113+
Proof.
114+
refine (_ oE dp_path_transport^-1).
115+
refine (equiv_concat_l _^ _).
116+
apply transport_DGraphQuotient.
117+
Defined.
118+
119+
(** We can also prove an induction principle for [sig DGraphQuotient]. We won't show that it satisfies the relevant computation rules as these will not be needed. Instead we will prove the non-dependent eliminator directly so that we can better reason about it. In order to get through the path algebra here, we have opted to use dependent paths. This makes the reasoning slightly easier, but it should not matter too much. *)
120+
Definition flatten_ind {Q : sig DGraphQuotient -> Type}
121+
(Qgq : forall a (x : F a), Q (flatten_gq x))
122+
(Qgqglue : forall a b (s : R a b) (x : F a),
123+
flatten_gqglue s x # Qgq _ x = Qgq _ (e _ _ _ x))
124+
: forall x, Q x.
125+
Proof.
126+
apply sig_ind.
127+
snrapply GraphQuotient_ind.
128+
1: exact Qgq.
129+
intros a b s.
130+
apply equiv_dp_path_transport.
131+
apply dp_forall.
132+
intros x y.
133+
srapply (equiv_ind (equiv_dp_dgraphquotient a b s x y)^-1).
134+
intros q.
135+
destruct q.
136+
apply equiv_dp_path_transport.
137+
refine (transport2 _ _ _ @ Qgqglue a b s x).
138+
refine (ap (path_sigma_uncurried DGraphQuotient _ _) _).
139+
snrapply path_sigma.
140+
1: reflexivity.
141+
apply moveR_equiv_V.
142+
simpl; f_ap.
143+
lhs rapply concat_p1.
144+
rapply inv_V.
145+
Defined.
146+
147+
(** Rather than use [flatten_ind] to define [flatten_rec] we reprove this simple case. This means we can later reason about it and derive the computation rules easily. The full computation rule for [flatten_ind] takes some work to derive and is not actually needed. *)
148+
Definition flatten_rec {Q : Type} (Qgq : forall a, F a -> Q)
149+
(Qgqglue : forall a b (s : R a b) (x : F a), Qgq a x = Qgq b (e _ _ s x))
150+
: sig DGraphQuotient -> Q.
151+
Proof.
152+
apply sig_rec.
153+
snrapply GraphQuotient_ind.
154+
1: exact Qgq.
155+
intros a b s.
156+
nrapply dpath_arrow.
157+
intros y.
158+
lhs nrapply transport_const.
159+
lhs nrapply (Qgqglue a b s).
160+
f_ap; symmetry.
161+
apply transport_DGraphQuotient.
162+
Defined.
163+
164+
(** The non-dependent eliminator computes as expected on our "path constructor". *)
165+
Definition flatten_rec_beta_gqglue {Q : Type} (Qgq : forall a, F a -> Q)
166+
(Qgqglue : forall a b (r : R a b) (x : F a), Qgq a x = Qgq b (e _ _ r x))
167+
(a b : A) (s : R a b) (x : F a)
168+
: ap (flatten_rec Qgq Qgqglue) (flatten_gqglue s x) = Qgqglue a b s x.
169+
Proof.
170+
lhs nrapply ap_sig_rec_path_sigma; cbn.
171+
rewrite GraphQuotient_ind_beta_gqglue.
172+
apply moveR_pM.
173+
apply moveL_pM.
174+
rewrite 3 concat_pp_p.
175+
apply moveR_Vp.
176+
rewrite (ap10_dpath_arrow DGraphQuotient (fun _ => Q) (gqglue s)).
177+
hott_simpl.
178+
lhs nrapply concat_pp_p.
179+
apply moveR_Mp.
180+
rhs nrapply concat_Vp.
181+
apply moveR_pM.
182+
rhs nrapply concat_1p.
183+
nrapply ap_V.
184+
Defined.
185+
186+
(** Now that we've shown that [sig DGraphQuotient] acts like a [GraphQuotient] of [sig F] by an appropriate relation, we can use this to prove the flattening lemma. The maps back and forth are very easy so this could almost be a formal consequence of the induction principle. *)
187+
Lemma equiv_gq_flatten
188+
: sig DGraphQuotient
189+
<~> GraphQuotient (fun a b => {r : R a.1 b.1 & e _ _ r a.2 = b.2}).
190+
Proof.
191+
snrapply equiv_adjointify.
192+
- snrapply flatten_rec.
193+
+ exact (fun a x => gq (a; x)).
194+
+ intros a b r x.
195+
apply gqglue.
196+
exists r.
197+
reflexivity.
198+
- snrapply GraphQuotient_rec.
199+
+ exact (fun '(a; x) => (gq a; x)).
200+
+ intros [a x] [b y] [r p].
201+
simpl in p, r.
202+
destruct p.
203+
apply flatten_gqglue.
204+
- snrapply GraphQuotient_ind.
205+
1: reflexivity.
206+
intros [a x] [b y] [r p].
207+
simpl in p, r.
208+
destruct p.
209+
simpl.
210+
lhs nrapply transport_paths_FFlr.
211+
rewrite GraphQuotient_rec_beta_gqglue.
212+
refine ((_ @@ 1) @ concat_Vp _).
213+
lhs nrapply concat_p1.
214+
apply inverse2.
215+
nrapply flatten_rec_beta_gqglue.
216+
- snrapply flatten_ind.
217+
1: reflexivity.
218+
intros a b r x.
219+
nrapply (transport_paths_FFlr' (g := GraphQuotient_rec _ _)); apply equiv_p1_1q.
220+
rewrite flatten_rec_beta_gqglue.
221+
exact (GraphQuotient_rec_beta_gqglue _ _ (a; x) (b; e a b r x) (r; 1)).
222+
Defined.
223+
224+
End Flattening.

theories/Types/Sigma.v

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -311,15 +311,13 @@ Proof.
311311
Defined.
312312

313313

314-
(** Applying a function constructed with [sig_ind] to a [path_sigma] can be computed. Technically this computation should probably go by way of a 2-variable [ap], and should be done in the dependently typed case. *)
315-
314+
(** Applying a function constructed with [sig_rec] to a [path_sigma] can be computed. Technically this computation should probably go by way of a 2-variable [ap], and should be done in the dependently typed case. *)
316315
Definition ap_sig_rec_path_sigma {A : Type} (P : A -> Type) {Q : Type}
317316
(x1 x2:A) (p:x1=x2) (y1:P x1) (y2:P x2) (q:p # y1 = y2)
318317
(d : forall a, P a -> Q)
319-
: ap (sig_ind (fun _ => Q) d) (path_sigma' P p q)
318+
: ap (sig_rec _ _ Q d) (path_sigma' P p q)
320319
= (transport_const p _)^
321320
@ (ap ((transport (fun _ => Q) p) o (d x1)) (transport_Vp _ p y1))^
322-
323321
@ (transport_arrow p _ _)^
324322
@ ap10 (apD d p) (p # y1)
325323
@ ap (d x2) q.

0 commit comments

Comments
 (0)