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 fiber of Ξ£ are non-dependent function types. \begin{code} {-# OPTIONS --without-K --exact-split --safe --auto-inline #-} module UF.Classifiers where open import MLTT.Spartan open import UF.Base open import UF.Embeddings open import UF.Equiv open import UF.Univalence open import UF.FunExt open import UF.UA-FunExt open import UF.Subsingletons open import UF.Subsingletons-FunExt open import UF.Powerset hiding (π) open import UF.EquivalenceExamples open import UF.Retracts \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 : π€ Μ ) β Subtypes' (π€ β π₯) Y β (Y β Ξ© (π€ β π₯)) Ξ©-is-subtype-classifier' {π€} {π₯} ua fe = special-classification ua fe is-subsingleton where open special-classifier π€ π₯ (π€ β π₯) Ξ©-is-subtype-classifier : is-univalent π€ β funext π€ (π€ βΊ) β (Y : π€ Μ ) β Subtypes Y β (Y β Ξ© π€) Ξ©-is-subtype-classifier {π€} = Ξ©-is-subtype-classifier' {π€} {π€} subtypes-form-set : Univalence β (Y : π€ Μ ) β is-set (Subtypes' (π€ β π₯) 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) β