Martin Escardo 8th May 2020. An old version of this file is at UF.Classifiers-Old. This version is ported from the Midlands Graduate School 2019 lecture notes https://www.cs.bham.ac.uk/~mhe/HoTT-UF.in-Agda-Lecture-Notes/HoTT-UF-Agda.html https://github.com/martinescardo/HoTT-UF.Agda-Lecture-Notes but with the universe levels generalized and Ξ£-fibers added in September 2022. * Universes are map classifiers. * Ξ© π€ is the embedding classifier. * The type of pointed types is the retraction classifier. * The type inhabited types is the surjection classifier. * The fibers of Ξ£ are non-dependent function types. \begin{code} {-# OPTIONS --safe --without-K #-} module UF.Classifiers where open import MLTT.Spartan open import UF.Base open import UF.Embeddings open import UF.Equiv open import UF.EquivalenceExamples open import UF.FunExt open import UF.Powerset hiding (π) open import UF.Retracts open import UF.Sets open import UF.Sets-Properties open import UF.Subsingletons open import UF.SubtypeClassifier open import UF.UA-FunExt open import UF.Univalence \end{code} The slice type: \begin{code} _/_ : (π€ : Universe) β π₯ Μ β π€ βΊ β π₯ Μ π€ / Y = Ξ£ X κ π€ Μ , (X β Y) \end{code} A modification of the slice type, where P doesn't need to be proposition-valued and so can add structure. An example is P = id, which is studied below in connection with retractions. \begin{code} _/[_]_ : (π€ : Universe) β (π€ β π₯ Μ β π¦ Μ ) β π₯ Μ β π€ βΊ β π₯ β π¦ Μ π€ /[ P ] Y = Ξ£ X κ π€ Μ , Ξ£ f κ (X β Y) , ((y : Y) β P (fiber f y)) \end{code} We first consider the original situation of the MGS development with a single universe for comparison. \begin{code} module classifier-single-universe (π€ : Universe) where Ο : (Y : π€ Μ ) β π€ / Y β (Y β π€ Μ ) Ο Y (X , f) = fiber f universe-is-classifier : π€ βΊ Μ universe-is-classifier = (Y : π€ Μ ) β is-equiv (Ο Y) π : (Y : π€ Μ ) β (Y β π€ Μ ) β π€ / Y π Y A = Ξ£ A , prβ ΟΞ· : is-univalent π€ β (Y : π€ Μ ) (Ο : π€ / Y) β π Y (Ο Y Ο) οΌ Ο ΟΞ· ua Y (X , f) = r where e : Ξ£ (fiber f) β X e = total-fiber-is-domain f p : Ξ£ (fiber f) οΌ X p = eqtoid ua (Ξ£ (fiber f)) X e NB : β e ββ»ΒΉ οΌ (Ξ» x β f x , x , refl) NB = refl q = transport (Ξ» - β - β Y) p prβ οΌβ¨ transport-is-pre-comp' ua e prβ β© prβ β β e ββ»ΒΉ οΌβ¨ refl β© f β r : (Ξ£ (fiber f) , prβ) οΌ (X , f) r = to-Ξ£-οΌ (p , q) ΟΞ΅ : is-univalent π€ β funext π€ (π€ βΊ) β (Y : π€ Μ ) (A : Y β π€ Μ ) β Ο Y (π Y A) οΌ A ΟΞ΅ ua fe Y A = dfunext fe Ξ³ where f : β y β fiber prβ y β A y f y ((y , a) , refl) = a g : β y β A y β fiber prβ y g y a = (y , a) , refl Ξ· : β y Ο β g y (f y Ο) οΌ Ο Ξ· y ((y , a) , refl) = refl Ξ΅ : β y a β f y (g y a) οΌ a Ξ΅ y a = refl Ξ³ : β y β fiber prβ y οΌ A y Ξ³ y = eqtoid ua _ _ (qinveq (f y) (g y , Ξ· y , Ξ΅ y)) universes-are-classifiers : is-univalent π€ β funext π€ (π€ βΊ) β universe-is-classifier universes-are-classifiers ua fe Y = qinvs-are-equivs (Ο Y) (π Y , ΟΞ· ua Y , ΟΞ΅ ua fe Y) classification : is-univalent π€ β funext π€ (π€ βΊ) β (Y : π€ Μ ) β π€ / Y β (Y β π€ Μ ) classification ua fe Y = Ο Y , universes-are-classifiers ua fe Y module special-classifier-single-universe (π€ : Universe) where open classifier-single-universe π€ Ο-special : (P : π€ Μ β π₯ Μ ) (Y : π€ Μ ) β π€ /[ P ] Y β (Y β Ξ£ P) Ο-special P Y (X , f , Ο) y = fiber f y , Ο y universe-is-special-classifier : (π€ Μ β π₯ Μ ) β π€ βΊ β π₯ Μ universe-is-special-classifier P = (Y : π€ Μ ) β is-equiv (Ο-special P Y) classifier-gives-special-classifier : universe-is-classifier β (P : π€ Μ β π₯ Μ ) β universe-is-special-classifier P classifier-gives-special-classifier s P Y = Ξ³ where e = (π€ /[ P ] Y) ββ¨ a β© (Ξ£ Ο κ π€ / Y , ((y : Y) β P ((Ο Y) Ο y))) ββ¨ b β© (Ξ£ A κ (Y β π€ Μ ), ((y : Y) β P (A y))) ββ¨ c β© (Y β Ξ£ P) β where a = β-sym Ξ£-assoc b = Ξ£-change-of-variable (Ξ» A β Ξ (P β A)) (Ο Y) (s Y) c = β-sym Ξ Ξ£-distr-β NB : Ο-special P Y οΌ β e β NB = refl Ξ³ : is-equiv (Ο-special P Y) Ξ³ = ββ-is-equiv e Ο-special-is-equiv : is-univalent π€ β funext π€ (π€ βΊ) β (P : π€ Μ β π₯ Μ ) (Y : π€ Μ ) β is-equiv (Ο-special P Y) Ο-special-is-equiv ua fe P Y = classifier-gives-special-classifier (universes-are-classifiers ua fe) P Y special-classification : is-univalent π€ β funext π€ (π€ βΊ) β (P : π€ Μ β π₯ Μ ) (Y : π€ Μ ) β π€ /[ P ] Y β (Y β Ξ£ P) special-classification ua fe P Y = Ο-special P Y , Ο-special-is-equiv ua fe P Y \end{code} Some examples of special classifiers follow. The universe of pointed types classifies retractions: \begin{code} module retraction-classifier (π€ : Universe) where open special-classifier-single-universe π€ retractions-into : π€ Μ β π€ βΊ Μ retractions-into Y = Ξ£ X κ π€ Μ , Y β X pointed-types : (π€ : Universe) β π€ βΊ Μ pointed-types π€ = Ξ£ X κ π€ Μ , X retraction-classifier : Univalence β (Y : π€ Μ ) β retractions-into Y β (Y β pointed-types π€) retraction-classifier ua Y = retractions-into Y ββ¨ i β© ((π€ /[ id ] Y)) ββ¨ ii β© (Y β pointed-types π€) β where i = β-sym (Ξ£-cong (Ξ» X β Ξ£-cong (Ξ» f β Ξ Ξ£-distr-β))) ii = special-classification (ua π€) (univalence-gives-funext' π€ (π€ βΊ) (ua π€) (ua (π€ βΊ))) id Y \end{code} The universe of inhabited types classifies surjections: \begin{code} module surjection-classifier (π€ : Universe) where open special-classifier-single-universe π€ open import UF.PropTrunc module _ (pt : propositional-truncations-exist) where open PropositionalTruncation pt public open import UF.ImageAndSurjection pt public surjections-into : π€ Μ β π€ βΊ Μ surjections-into Y = Ξ£ X κ π€ Μ , X β Y inhabited-types : π€ βΊ Μ inhabited-types = Ξ£ X κ π€ Μ , β₯ X β₯ surjection-classification : Univalence β (Y : π€ Μ ) β surjections-into Y β (Y β inhabited-types) surjection-classification ua = special-classification (ua π€) (univalence-gives-funext' π€ (π€ βΊ) (ua π€) (ua (π€ βΊ))) β₯_β₯ \end{code} Added 11th September 2022. We now generalize the universe levels of the classifier and special classifier modules. \begin{code} module classifier (π€ π₯ : Universe) where Ο : (Y : π€ Μ ) β (π€ β π₯) / Y β (Y β π€ β π₯ Μ ) Ο Y (X , f) = fiber f \end{code} Definition of when the given pair of universes is a classifier, \begin{code} universe-is-classifier : (π€ β π₯)βΊ Μ universe-is-classifier = (Y : π€ Μ ) β is-equiv (Ο Y) π : (Y : π€ Μ ) β (Y β π€ β π₯ Μ ) β (π€ β π₯) / Y π Y A = Ξ£ A , prβ ΟΞ· : is-univalent (π€ β π₯) β (Y : π€ Μ ) (Ο : (π€ β π₯) / Y) β π Y (Ο Y Ο) οΌ Ο ΟΞ· ua Y (X , f) = r where e : Ξ£ (fiber f) β X e = total-fiber-is-domain f p : Ξ£ (fiber f) οΌ X p = eqtoid ua (Ξ£ (fiber f)) X e NB : β e ββ»ΒΉ οΌ (Ξ» x β f x , x , refl) NB = refl q = transport (Ξ» - β - β Y) p prβ οΌβ¨ transport-is-pre-comp' ua e prβ β© prβ β β e ββ»ΒΉ οΌβ¨ refl β© f β r : (Ξ£ (fiber f) , prβ) οΌ (X , f) r = to-Ξ£-οΌ (p , q) ΟΞ΅ : is-univalent (π€ β π₯) β funext π€ ((π€ β π₯)βΊ) β (Y : π€ Μ ) (A : Y β π€ β π₯ Μ ) β Ο Y (π Y A) οΌ A ΟΞ΅ ua fe Y A = dfunext fe Ξ³ where f : β y β fiber prβ y β A y f y ((y , a) , refl) = a g : β y β A y β fiber prβ y g y a = (y , a) , refl Ξ· : β y Ο β g y (f y Ο) οΌ Ο Ξ· y ((y , a) , refl) = refl Ξ΅ : β y a β f y (g y a) οΌ a Ξ΅ y a = refl Ξ³ : β y β fiber prβ y οΌ A y Ξ³ y = eqtoid ua _ _ (qinveq (f y) (g y , Ξ· y , Ξ΅ y)) universes-are-classifiers : is-univalent (π€ β π₯) β funext π€ ((π€ β π₯)βΊ) β universe-is-classifier universes-are-classifiers ua fe Y = qinvs-are-equivs (Ο Y) (π Y , ΟΞ· ua Y , ΟΞ΅ ua fe Y) classification : is-univalent (π€ β π₯) β funext π€ ((π€ β π₯)βΊ) β (Y : π€ Μ ) β (π€ β π₯) / Y β (Y β π€ β π₯ Μ ) classification ua fe Y = Ο Y , universes-are-classifiers ua fe Y \end{code} In the case of special classifiers we now need to assume a further universe π¦. \begin{code} module special-classifier (π€ π₯ π¦ : Universe) where open classifier π€ π₯ public Ο-special : (P : π€ β π₯ Μ β π¦ Μ ) (Y : π€ Μ ) β (π€ β π₯) /[ P ] Y β (Y β Ξ£ P) Ο-special P Y (X , f , Ο) y = fiber f y , Ο y universe-is-special-classifier : (π€ β π₯ Μ β π¦ Μ ) β (π€ β π₯)βΊ β π¦ Μ universe-is-special-classifier P = (Y : π€ Μ ) β is-equiv (Ο-special P Y) classifier-gives-special-classifier : universe-is-classifier β (P : π€ β π₯ Μ β π¦ Μ ) β universe-is-special-classifier P classifier-gives-special-classifier s P Y = Ξ³ where e = ((π€ β π₯) /[ P ] Y) ββ¨ a β© (Ξ£ Ο κ (π€ β π₯) / Y , ((y : Y) β P ((Ο Y) Ο y))) ββ¨ b β© (Ξ£ A κ (Y β π€ β π₯ Μ ), ((y : Y) β P (A y))) ββ¨ c β© (Y β Ξ£ P) β where a = β-sym Ξ£-assoc b = Ξ£-change-of-variable (Ξ» A β Ξ (P β A)) (Ο Y) (s Y) c = β-sym Ξ Ξ£-distr-β NB : Ο-special P Y οΌ β e β NB = refl Ξ³ : is-equiv (Ο-special P Y) Ξ³ = ββ-is-equiv e Ο-special-is-equiv : is-univalent (π€ β π₯) β funext π€ ((π€ β π₯)βΊ) β (P : π€ β π₯ Μ β π¦ Μ ) (Y : π€ Μ ) β is-equiv (Ο-special P Y) Ο-special-is-equiv ua fe P Y = classifier-gives-special-classifier (universes-are-classifiers ua fe) P Y special-classification : is-univalent (π€ β π₯) β funext π€ ((π€ β π₯)βΊ) β (P : π€ β π₯ Μ β π¦ Μ ) (Y : π€ Μ ) β (π€ β π₯) /[ P ] Y β (Y β Ξ£ P) special-classification ua fe P Y = Ο-special P Y , Ο-special-is-equiv ua fe P Y \end{code} The subtype classifier with general universes: \begin{code} Ξ©-is-subtype-classifier' : is-univalent (π€ β π₯) β funext π€ ((π€ β π₯)βΊ) β (Y : π€ Μ ) β Subtype' (π€ β π₯) Y β (Y β Ξ© (π€ β π₯)) Ξ©-is-subtype-classifier' {π€} {π₯} ua fe = special-classification ua fe is-subsingleton where open special-classifier π€ π₯ (π€ β π₯) Ξ©-is-subtype-classifier : is-univalent π€ β funext π€ (π€ βΊ) β (Y : π€ Μ ) β Subtype Y β (Y β Ξ© π€) Ξ©-is-subtype-classifier {π€} = Ξ©-is-subtype-classifier' {π€} {π€} subtypes-form-set : Univalence β (Y : π€ Μ ) β is-set (Subtype' (π€ β π₯) Y) subtypes-form-set {π€} {π₯} ua Y = equiv-to-set (Ξ©-is-subtype-classifier' {π€} {π₯} (ua (π€ β π₯)) (univalence-gives-funext' π€ ((π€ β π₯)βΊ) (ua π€) (ua ((π€ β π₯)βΊ))) Y) (powersets-are-sets'' (univalence-gives-funext' _ _ (ua π€) (ua ((π€ β π₯)βΊ))) (univalence-gives-funext' _ _ (ua (π€ β π₯)) (ua (π€ β π₯))) (univalence-gives-propext (ua (π€ β π₯)))) \end{code} 9th September 2022, with universe levels generalized 11 September. Here is an application of the above. \begin{code} Ξ£-fibers-β : {π€ π₯ : Universe} β is-univalent (π€ β π₯) β funext π€ ((π€ β π₯)βΊ) β {X : π€ β π₯ Μ } {Y : π€ Μ } β (Ξ£ A κ (Y β π€ β π₯ Μ ) , Ξ£ A β X) β (X β Y) Ξ£-fibers-β {π€} {π₯} ua feβΊ {X} {Y} = (Ξ£ A κ (Y β π€ β π₯ Μ ) , Ξ£ A β X) ββ¨ I β© (Ξ£ (Z , g) κ (π€ β π₯) / Y , (Ξ£ y κ Y , fiber g y) β X) ββ¨ II β© (Ξ£ Z κ π€ β π₯ Μ , Ξ£ g κ (Z β Y) , (Ξ£ y κ Y , fiber g y) β X) ββ¨ III β© (Ξ£ Z κ π€ β π₯ Μ , (Z β Y) Γ (Z β X)) ββ¨ IV β© (Ξ£ Z κ π€ β π₯ Μ , (Z β X) Γ (Z β Y)) ββ¨ V β© (Ξ£ Z κ π€ β π₯ Μ , (X β Z) Γ (Z β Y)) ββ¨ VI β© (Ξ£ (Z , _) κ (Ξ£ Z κ π€ β π₯ Μ , X β Z) , (Z β Y)) ββ¨ VII β© (X β Y) β where open classifier π€ π₯ open import UF.Equiv-FunExt open import UF.PropIndexedPiSigma open import UF.Yoneda fe : funext (π€ β π₯) (π€ β π₯) fe = univalence-gives-funext ua I = β-sym (Ξ£-change-of-variable (Ξ» A β Ξ£ A β X) (Ο Y) (universes-are-classifiers ua feβΊ Y)) II = Ξ£-assoc III = Ξ£-cong (Ξ» Z β Ξ£-cong (Ξ» g β β-cong-left' fe fe fe fe fe (total-fiber-is-domain g))) IV = Ξ£-cong (Ξ» Z β Γ-comm) V = Ξ£-cong (Ξ» Z β Γ-cong (β-Sym' fe fe fe fe) (β-refl (Z β Y))) VI = β-sym Ξ£-assoc VII = prop-indexed-sum (singletons-are-props (univalence-via-singletonsβ ua X)) (X , β-refl X) private β : {π€ π₯ : Universe} (X : π€ Μ ) (Y : X β π₯ Μ ) β π€ β π₯ Μ β X Y = Ξ£ Y \end{code} The use of equality rather than equivalence prevents us from having more general universes in the following: \begin{code} Ξ£-fibers : is-univalent π€ β funext π€ (π€ βΊ) β {X Y : π€ Μ } β fiber (β Y) X β (X β Y) Ξ£-fibers {π€} ua feβΊ {X} {Y} = (Ξ£ A κ (Y β π€ Μ ) , Ξ£ A οΌ X) ββ¨ Ξ£-cong (Ξ» A β univalence-β ua (Ξ£ A) X) β© (Ξ£ A κ (Y β π€ Μ ) , Ξ£ A β X) ββ¨ Ξ£-fibers-β {π€} {π€} ua feβΊ β© (X β Y) β \end{code}