|
| 1 | +(** ** Set-Based Polynomial Functors are omega-continuous |
| 2 | +
|
| 3 | + Author : Antoine Fisse (@AextraT), 2025 |
| 4 | +*) |
| 5 | + |
| 6 | +Require Import UniMath.Foundations.PartD. |
| 7 | +Require Import UniMath.Foundations.Sets. |
| 8 | +Require Import UniMath.MoreFoundations.All. |
| 9 | + |
| 10 | +Require Import UniMath.Induction.FunctorCoalgebras_legacy. |
| 11 | +Require Import UniMath.Induction.PolynomialFunctors. |
| 12 | +Require Import UniMath.Induction.M.Core. |
| 13 | +Require Import UniMath.Induction.M.MWithSets. |
| 14 | + |
| 15 | +Require Import UniMath.CategoryTheory.Categories.Type.Core. |
| 16 | +Require Import UniMath.CategoryTheory.Core.Categories. |
| 17 | +Require Import UniMath.CategoryTheory.Core.Functors. |
| 18 | +Require Import UniMath.CategoryTheory.DisplayedCats.Core. |
| 19 | +Require Import UniMath.CategoryTheory.Categories.HSET.All. |
| 20 | +Require Import UniMath.CategoryTheory.Chains.CoAdamek. |
| 21 | +Require Import UniMath.CategoryTheory.Chains.Chains. |
| 22 | +Require Import UniMath.CategoryTheory.Chains.Cochains. |
| 23 | +Require Import UniMath.CategoryTheory.Limits.Graphs.Diagrams. |
| 24 | +Require Import UniMath.CategoryTheory.Limits.Graphs.Limits. |
| 25 | +Require Import UniMath.CategoryTheory.Limits.Terminal. |
| 26 | +Require Import UniMath.CategoryTheory.FunctorCoalgebras. |
| 27 | + |
| 28 | +Local Open Scope cat. |
| 29 | +Local Open Scope functions. |
| 30 | + |
| 31 | +Section OmegaContinuity. |
| 32 | + |
| 33 | + Context {A : ob HSET} (B : pr1hSet A → ob HSET). |
| 34 | + |
| 35 | + Local Definition F' := MWithSets.F' B. |
| 36 | + |
| 37 | + Lemma comp_right_eq_hset |
| 38 | + {X Y Z : UU} |
| 39 | + {f g : X -> Y} |
| 40 | + (h : Y -> Z) |
| 41 | + (p : f = g) |
| 42 | + : h ∘ f = h ∘ g. |
| 43 | + Proof. |
| 44 | + induction p. |
| 45 | + apply idpath. |
| 46 | + Defined. |
| 47 | + |
| 48 | + Lemma pullback_cone_edge |
| 49 | + {X Y0 Y1 Y2: SET} |
| 50 | + (x : pr1hSet X) |
| 51 | + {f : SET ⟦ Y1, Y2 ⟧} |
| 52 | + {g0 : SET ⟦ X, F' Y0 ⟧} |
| 53 | + {g1 : SET ⟦ X, F' Y1 ⟧} |
| 54 | + {g2 : SET ⟦ X, F' Y2 ⟧} |
| 55 | + (p : (#F' f) ∘ g1 = g2) |
| 56 | + (q1 : pr1 ∘ g0 = pr1 ∘ g1) |
| 57 | + (q2 : pr1 ∘ g0 = pr1 ∘ g2) |
| 58 | + : (λ b, f (pr2 (g1 x) (transportf (λ φ, pr1hSet (B (φ x))) q1 b))) = (λ b, pr2 (g2 x) (transportf (λ φ, pr1hSet (B (φ x))) q2 b)). |
| 59 | + Proof. |
| 60 | + induction p. |
| 61 | + cbn. |
| 62 | + assert (r : q1 = q2). |
| 63 | + { apply (setproperty (SET ⟦ X, A ⟧,, isaset_forall_hSet (pr1hSet X) (λ _, A)) (pr1 ∘ g0) (pr1 ∘ g1)). |
| 64 | + } |
| 65 | + induction r. |
| 66 | + apply idpath. |
| 67 | + Qed. |
| 68 | + |
| 69 | + Lemma pathtozero_cone |
| 70 | + {c0 : SET} |
| 71 | + {c : cochain SET} |
| 72 | + (cc0 : cone (mapdiagram F' c) c0) |
| 73 | + (v : nat) |
| 74 | + : pr1 ∘ (pr1 cc0 0) = pr1 ∘ (pr1 cc0 v). |
| 75 | + Proof. |
| 76 | + induction v. |
| 77 | + - apply idpath. |
| 78 | + - symmetry. |
| 79 | + etrans. |
| 80 | + + apply (comp_right_eq_hset (λ x : pr1hSet (F' (dob c v)), pr1 x) (pr2 cc0 (S v) v (idpath (S v)))). |
| 81 | + + symmetry. apply IHv. |
| 82 | + Qed. |
| 83 | + |
| 84 | + Lemma pullback_cone |
| 85 | + {c0 : SET} |
| 86 | + (x : pr1hSet c0) |
| 87 | + {c : cochain SET} |
| 88 | + (cc0 : cone (mapdiagram F' c) c0) |
| 89 | + : cone c (B (pr1 (pr1 cc0 0 x))). |
| 90 | + Proof. |
| 91 | + unfold cone. |
| 92 | + unfold cone in cc0. |
| 93 | + unfold forms_cone in cc0. |
| 94 | + set (f := λ v : vertex conat_graph, (λ b, pr2 (pr1 cc0 v x) (transportf (λ φ, pr1hSet (B (φ x))) (pathtozero_cone cc0 v) b)) : SET ⟦ B (pr1 (pr1 cc0 0 x)), dob c v ⟧). |
| 95 | + assert (p : forms_cone c f). |
| 96 | + { |
| 97 | + unfold forms_cone. |
| 98 | + simpl. |
| 99 | + intros u v e. |
| 100 | + induction e. |
| 101 | + set (p := pullback_cone_edge x (pr2 cc0 (S v) v (idpath (S v))) (pathtozero_cone cc0 (S v)) (pathtozero_cone cc0 v)). |
| 102 | + apply p. |
| 103 | + } |
| 104 | + exact (f,, p). |
| 105 | + Defined. |
| 106 | + |
| 107 | + Lemma exists_fun_mapdiagram |
| 108 | + {c : cochain SET} |
| 109 | + {L : SET} |
| 110 | + {cc : cone c L} |
| 111 | + (c_limcone : isLimCone c L cc) |
| 112 | + (c0 : SET) |
| 113 | + (cc0 : cone (mapdiagram F' c) c0) |
| 114 | + : SET ⟦ c0, F' L ⟧. |
| 115 | + Proof. |
| 116 | + intro x. |
| 117 | + cbn. |
| 118 | + unfold polynomial_functor_obj. |
| 119 | + set (a := pr1 (pr1 cc0 0 x) : pr1hSet A). |
| 120 | + set (cx := B a). |
| 121 | + set (ccx := pullback_cone x cc0). |
| 122 | + set (f2x := pr11 (c_limcone cx ccx)). |
| 123 | + exact (a,, f2x). |
| 124 | + Defined. |
| 125 | + |
| 126 | + Lemma is_mor_mapdiagram2_point |
| 127 | + {X Y c : UU} |
| 128 | + (x : X) |
| 129 | + {φ1 φ2 : X -> pr1hSet A} |
| 130 | + {f : pr1hSet (B (φ1 x)) -> c} |
| 131 | + {g : c -> Y} |
| 132 | + {h : pr1hSet (B (φ2 x)) -> Y} |
| 133 | + (q : φ1 = φ2) |
| 134 | + (p : g ∘ f = λ b, h (transportf (λ ψ, pr1hSet (B (ψ x))) q b)) |
| 135 | + : transportf (λ a, pr1hSet (B a) -> Y) (toforallpaths _ _ _ q x) (g ∘ f) = h. |
| 136 | + Proof. |
| 137 | + induction q. |
| 138 | + apply p. |
| 139 | + Defined. |
| 140 | + |
| 141 | + Lemma fun_mapdiagram_is_mor |
| 142 | + {c : cochain SET} |
| 143 | + {L : SET} |
| 144 | + {cc : cone c L} |
| 145 | + (c_limcone : isLimCone c L cc) |
| 146 | + (c0 : SET) |
| 147 | + (cc0 : cone (mapdiagram F' c) c0) |
| 148 | + (f := exists_fun_mapdiagram c_limcone c0 cc0) |
| 149 | + : is_cone_mor cc0 (mapcone F' c cc) f. |
| 150 | + Proof. |
| 151 | + unfold is_cone_mor. |
| 152 | + intro v. |
| 153 | + apply funextfun. |
| 154 | + intro x. |
| 155 | + use total2_paths_f. |
| 156 | + - unfold coneOut. |
| 157 | + unfold mapcone. |
| 158 | + cbn. |
| 159 | + apply (toforallpaths _ _ _ (pathtozero_cone cc0 v) x). |
| 160 | + - cbn. |
| 161 | + unfold coneOut. |
| 162 | + set (a := pr1 (pr1 cc0 0 x) : pr1hSet A). |
| 163 | + set (cx := B a). |
| 164 | + set (ccx := pullback_cone x cc0). |
| 165 | + set (p := pr2 (pr1 (c_limcone cx ccx)) v). |
| 166 | + cbn in p. |
| 167 | + unfold coneOut in p. |
| 168 | + apply (is_mor_mapdiagram2_point x (pathtozero_cone cc0 v) p). |
| 169 | + Qed. |
| 170 | + |
| 171 | + Lemma exists_mor_mapdiagram |
| 172 | + {c : cochain SET} |
| 173 | + {L : SET} |
| 174 | + {cc : cone c L} |
| 175 | + (c_limcone : isLimCone c L cc) |
| 176 | + (c0 : SET) |
| 177 | + (cc0 : cone (mapdiagram F' c) c0) |
| 178 | + : ∑ f : SET ⟦ c0, F' L ⟧, is_cone_mor cc0 (mapcone F' c cc) f. |
| 179 | + Proof. |
| 180 | + set (f := exists_fun_mapdiagram c_limcone c0 cc0). |
| 181 | + set (p := fun_mapdiagram_is_mor c_limcone c0 cc0). |
| 182 | + exact (f,, p). |
| 183 | + Defined. |
| 184 | + |
| 185 | + Lemma move_proof |
| 186 | + {X Y Z : SET} |
| 187 | + {x : pr1hSet X} |
| 188 | + (h1 h2 : SET⟦ X, A ⟧) |
| 189 | + (f : SET ⟦ B (h2 x), Y ⟧) |
| 190 | + (g : SET ⟦ Y, Z ⟧ ) |
| 191 | + (q : h1 = h2) |
| 192 | + : g ∘ (transportf (λ a, SET ⟦ B a, Y ⟧) (pathsinv0 (toforallpaths _ _ _ q x)) f) = λ b, g (f (transportf (λ φ, pr1hSet (B (φ x))) q b)). |
| 193 | + Proof. |
| 194 | + induction q. |
| 195 | + cbn. |
| 196 | + apply idpath. |
| 197 | + Qed. |
| 198 | + |
| 199 | + Lemma proj_is_cone_mor_point |
| 200 | + {X Y Z0 Z : SET} |
| 201 | + (x : pr1hSet X) |
| 202 | + {f : SET ⟦ X, F' Y ⟧} |
| 203 | + {g : SET⟦ Y, Z ⟧} |
| 204 | + (h0 : SET⟦ X, F' Z0 ⟧) |
| 205 | + (h1 : SET⟦ X, F' Z ⟧) |
| 206 | + (p : #F' g ∘ f = h1) |
| 207 | + (q : pr1 (f x) = pr1 (h0 x)) |
| 208 | + (q' : pr1 ∘ h0 = pr1 ∘ h1) |
| 209 | + : g ∘ (transportf _ q (pr2 (f x))) = λ b, (pr2 (h1 x)) (transportf (λ φ, pr1hSet (B (φ x))) q' b). |
| 210 | + Proof. |
| 211 | + induction p. |
| 212 | + cbn. |
| 213 | + set (q'x := toforallpaths _ _ _ q' x). |
| 214 | + cbn in q'x. |
| 215 | + set (q'x' := pathsinv0 q'x). |
| 216 | + assert (r : q'x' = q) by apply (setproperty A). |
| 217 | + induction r. |
| 218 | + apply (move_proof (pr1 ∘ h0) (pr1 ∘ # F' g ∘ f) (pr2 (f x)) g q'). |
| 219 | + Qed. |
| 220 | + |
| 221 | + Lemma proj_is_cone_mor |
| 222 | + {c : cochain SET} |
| 223 | + {c0 L : SET} |
| 224 | + {x : pr1hSet c0} |
| 225 | + {cc : cone c L} |
| 226 | + {cc0 : cone (mapdiagram F' c) c0} |
| 227 | + (f : SET ⟦ c0, F' L ⟧) |
| 228 | + {p : pr1 (f x) = pr1 (pr1 cc0 0 x)} |
| 229 | + (pf : is_cone_mor cc0 (mapcone F' c cc) f) |
| 230 | + : is_cone_mor (pullback_cone x cc0) cc (transportf _ p (pr2 (f x))). |
| 231 | + Proof. |
| 232 | + set (ccx := pullback_cone x cc0). |
| 233 | + cbn. |
| 234 | + unfold is_cone_mor. |
| 235 | + intro v. |
| 236 | + unfold is_cone_mor in pf. |
| 237 | + unfold coneOut in pf. |
| 238 | + apply (proj_is_cone_mor_point x (pr1 cc0 0) (pr1 cc0 v) (pf v) p (pathtozero_cone cc0 v)). |
| 239 | + Qed. |
| 240 | + |
| 241 | + Lemma morph_unicity_pushout |
| 242 | + {c : cochain SET} |
| 243 | + {c0 L : SET} |
| 244 | + {cc : cone c L} |
| 245 | + (c_limcone : isLimCone c L cc) |
| 246 | + (cc0 : cone (mapdiagram F' c) c0) |
| 247 | + {f' : SET⟦ c0, F' L ⟧} |
| 248 | + (pf' : is_cone_mor cc0 (mapcone F' c cc) f') |
| 249 | + : f' = pr1 (exists_mor_mapdiagram c_limcone c0 cc0). |
| 250 | + Proof. |
| 251 | + set (f_pf := exists_mor_mapdiagram c_limcone c0 cc0). |
| 252 | + set (f := pr1 f_pf). |
| 253 | + set (pf := pr2 f_pf). |
| 254 | + apply funextfun. |
| 255 | + intro x. |
| 256 | + set (p := maponpaths (λ z, pr1 z) (toforallpaths _ _ _ (pf' 0) x)). |
| 257 | + use total2_paths_f. |
| 258 | + - unfold is_cone_mor in pf'. |
| 259 | + unfold mapcone in pf'. |
| 260 | + unfold coneOut in pf'. |
| 261 | + cbn in pf'. |
| 262 | + apply p. |
| 263 | + - cbn. |
| 264 | + set (a := pr1 (pr1 cc0 0 x) : pr1hSet A). |
| 265 | + set (cx := B a). |
| 266 | + set (ccx := pullback_cone x cc0). |
| 267 | + set (f'2 := transportf _ p (pr2 (f' x)) : SET ⟦ cx, L ⟧). |
| 268 | + set (f'2_cone_mor := proj_is_cone_mor f' pf' : is_cone_mor ccx cc f'2). |
| 269 | + apply (maponpaths (λ z, pr1 z) (pr2 (c_limcone cx ccx) (f'2,, f'2_cone_mor))). |
| 270 | + Qed. |
| 271 | + |
| 272 | + Lemma PolyFunctor_omega_cont : is_omega_cont F'. |
| 273 | + Proof. |
| 274 | + unfold is_omega_cont. |
| 275 | + unfold preserves_limit. |
| 276 | + unfold isLimCone. |
| 277 | + intros c L cc c_limcone c0 cc0. |
| 278 | + use tpair. |
| 279 | + - exact (exists_mor_mapdiagram c_limcone c0 cc0). |
| 280 | + - set (f_pf := exists_mor_mapdiagram c_limcone c0 cc0). |
| 281 | + set (f := pr1 f_pf). |
| 282 | + set (pf := pr2 f_pf). |
| 283 | + intro t. |
| 284 | + destruct t as [f' pf']. |
| 285 | + use total2_paths_f. |
| 286 | + + apply (morph_unicity_pushout c_limcone cc0 pf'). |
| 287 | + + set (p1 := morph_unicity_pushout c_limcone cc0 pf'). |
| 288 | + set (tpf' := transportf (is_cone_mor cc0 (mapcone F' c cc)) p1 pf'). |
| 289 | + unfold is_cone_mor in pf. |
| 290 | + use funextsec. |
| 291 | + intro v. |
| 292 | + apply (isaset_forall_hSet (pr1hSet c0) (λ _, F' (dob c v))). |
| 293 | + Defined. |
| 294 | + |
| 295 | +End OmegaContinuity. |
0 commit comments