We show that ๐ is locally small, following Section 10.5 of the HoTT Book.
\begin{code}
{-# OPTIONS --without-K --exact-split --safe --auto-inline #-}
open import UF.FunExt
open import UF.Subsingletons
open import UF.PropTrunc
module CumulativeHierarchy-LocallySmall
(pt : propositional-truncations-exist)
(fe : Fun-Ext)
(pe : Prop-Ext)
where
open import MLTT.Spartan
open import UF.Base hiding (_โ_)
open import UF.Equiv
open import UF.EquivalenceExamples
open import UF.Equiv-FunExt
open import UF.Logic
open import UF.Size
open import UF.Subsingletons-FunExt
open AllCombinators pt fe
open PropositionalTruncation pt
\end{code}
The idea is to have a ๐ค-valued equality relation on ๐ by defining:
๐-set {A} f ๏ผโป ๐-set {B} g
inductively as
(ฮ a : A , โ b : B , f a ๏ผโป g b)
ร (ฮ b : B , โ a : A , g b ๏ผโป f a).
Of course, we need to formally check that this definition respects the ๐-set-ext
constructor of ๐ in both arguments, which is provided by the setup below.
\begin{code}
open import CumulativeHierarchy pt fe pe
module ๐-is-locally-small
{๐ค : Universe}
(ch : cumulative-hierarchy-exists ๐ค)
where
open cumulative-hierarchy-exists ch
private
module _
{A : ๐ค ฬ }
(f : A โ ๐)
(r : A โ ๐ โ ฮฉ ๐ค)
where
๏ผโป-auxโ : {B : ๐ค ฬ } โ (B โ ๐) โ ฮฉ ๐ค
๏ผโป-auxโ {B} g = (โฑฏ a โถ A , ฦ b โถ B , r a (g b) holds)
โง (โฑฏ b โถ B , ฦ a โถ A , r a (g b) holds)
๏ผโป-auxโ-respects-โ : {B' B : ๐ค ฬ} (g' : B' โ ๐) (g : B โ ๐)
โ g' โ g
โ ๏ผโป-auxโ g' holds
โ ๏ผโป-auxโ g holds
๏ผโป-auxโ-respects-โ {B'} {B} g' g (s , t) (u , v) = โฆ
1โฆ , โฆ
2โฆ
where
โฆ
1โฆ : (a : A) โ โ b ๊ B , r a (g b) holds
โฆ
1โฆ a = โฅโฅ-rec โ-is-prop hโ (u a)
where
hโ : (ฮฃ b' ๊ B' , r a (g' b') holds) โ โ b ๊ B , r a (g b) holds
hโ (b' , p) = โฅโฅ-functor hโ (s b')
where
hโ : (ฮฃ b ๊ B , g b ๏ผ g' b') โ ฮฃ b ๊ B , r a (g b) holds
hโ (b , e) = b , transport (ฮป - โ (r a -) holds) (e โปยน) p
โฆ
2โฆ : (b : B) โ โ a ๊ A , r a (g b) holds
โฆ
2โฆ b = โฅโฅ-rec โ-is-prop hโ (t b)
where
hโ : (ฮฃ b' ๊ B' , g' b' ๏ผ g b) โ โ a ๊ A , r a (g b) holds
hโ (b' , e) = โฅโฅ-functor hโ (v b')
where
hโ : (ฮฃ a ๊ A , r a (g' b') holds) โ ฮฃ a ๊ A , r a (g b) holds
hโ (a , p) = a , transport (ฮป - โ (r a -) holds) e p
๏ผโป-auxโ-respects-โ' : {B' B : ๐ค ฬ} (g' : B' โ ๐) (g : B โ ๐)
โ g' โ g
โ ๏ผโป-auxโ g' ๏ผ ๏ผโป-auxโ g
๏ผโป-auxโ-respects-โ' {B'} {B} g' g e =
ฮฉ-extensionality fe pe
(๏ผโป-auxโ-respects-โ g' g e)
(๏ผโป-auxโ-respects-โ g g' (โ-sym e))
๏ผโป-auxโ : ๐ โ ฮฉ ๐ค
๏ผโป-auxโ = ๐-recursion (ฮฉ-is-set fe pe) (ฮป g _ โ ๏ผโป-auxโ g)
(ฮป g' g _ _ _ _ e โ ๏ผโป-auxโ-respects-โ' g' g e)
๏ผโป-auxโ-behaviour : {B : ๐ค ฬ } (g : B โ ๐) โ ๏ผโป-auxโ (๐-set g) ๏ผ ๏ผโป-auxโ g
๏ผโป-auxโ-behaviour g =
๐-recursion-computes (ฮฉ-is-set fe pe) (ฮป gโ _ โ ๏ผโป-auxโ gโ)
(ฮป g' g _ _ _ _ e โ ๏ผโป-auxโ-respects-โ' g' g e)
g (ฮป _ โ ๐ , ๐-is-prop)
๏ผโป-auxโ-respects-โ : {A B : ๐ค ฬ } (f : A โ ๐) (g : B โ ๐)
โ (rโ : A โ ๐ โ ฮฉ ๐ค) (rโ : B โ ๐ โ ฮฉ ๐ค)
โ ((a : A) โ โ b ๊ B , (f a ๏ผ g b) ร (rโ a ๏ผ rโ b))
โ ((b : B) โ โ a ๊ A , (g b ๏ผ f a) ร (rโ b ๏ผ rโ a))
โ {C : ๐ค ฬ } (h : C โ ๐)
โ ๏ผโป-auxโ f rโ h holds
โ ๏ผโป-auxโ g rโ h holds
๏ผโป-auxโ-respects-โ {A} {B} f g rโ rโ s t {C} h (u , v) = โฆ
1โฆ , โฆ
2โฆ
where
โฆ
1โฆ : (b : B) โ โ c ๊ C , rโ b (h c) holds
โฆ
1โฆ b = โฅโฅ-rec โ-is-prop m (t b)
where
m : (ฮฃ a ๊ A , (g b ๏ผ f a) ร (rโ b ๏ผ rโ a))
โ โ c ๊ C , rโ b (h c) holds
m (a , _ , q) = โฅโฅ-functor n (u a)
where
n : (ฮฃ c ๊ C , rโ a (h c) holds)
โ ฮฃ c ๊ C , rโ b (h c) holds
n (c , w) = c , Idtofun (ap _holds (happly (q โปยน) (h c))) w
โฆ
2โฆ : (c : C) โ โ b ๊ B , rโ b (h c) holds
โฆ
2โฆ c = โฅโฅ-rec โ-is-prop n (v c)
where
n : (ฮฃ a ๊ A , rโ a (h c) holds)
โ โ b ๊ B , rโ b (h c) holds
n (a , w) = โฅโฅ-functor m (s a)
where
m : (ฮฃ b ๊ B , (f a ๏ผ g b) ร (rโ a ๏ผ rโ b))
โ ฮฃ b ๊ B , rโ b (h c) holds
m (b , _ , q) = b , Idtofun (ap _holds (happly q (h c))) w
๏ผโป-auxโ-respects-โ' : {A B : ๐ค ฬ} (f : A โ ๐) (g : B โ ๐)
(rโ : A โ ๐ โ ฮฉ ๐ค) (rโ : B โ ๐ โ ฮฉ ๐ค)
โ ((a : A) โ โ b ๊ B , (f a ๏ผ g b) ร (rโ a ๏ผ rโ b))
โ ((b : B) โ โ a ๊ A , (g b ๏ผ f a) ร (rโ b ๏ผ rโ a))
โ f โ g
โ ๏ผโป-auxโ f rโ ๏ผ ๏ผโป-auxโ g rโ
๏ผโป-auxโ-respects-โ' {A} {B} f g rโ rโ IHโ IHโ _ =
dfunext fe (๐-prop-simple-induction (ฮป x โ ๏ผโป-auxโ f rโ x ๏ผ ๏ผโป-auxโ g rโ x)
(ฮป _ โ ฮฉ-is-set fe pe)
ฯ)
where
ฯ : {C : ๐ค ฬ } (h : C โ ๐)
โ ๏ผโป-auxโ f rโ (๐-set h) ๏ผ ๏ผโป-auxโ g rโ (๐-set h)
ฯ h = ๏ผโป-auxโ f rโ (๐-set h) ๏ผโจ ๏ผโป-auxโ-behaviour f rโ h โฉ
๏ผโป-auxโ f rโ h ๏ผโจ e โฉ
๏ผโป-auxโ g rโ h ๏ผโจ (๏ผโป-auxโ-behaviour g rโ h) โปยน โฉ
๏ผโป-auxโ g rโ (๐-set h) โ
where
e = ฮฉ-extensionality fe pe
(๏ผโป-auxโ-respects-โ f g rโ rโ IHโ IHโ h)
(๏ผโป-auxโ-respects-โ g f rโ rโ IHโ IHโ h)
\end{code}
We package up the above in the following definition which records the behaviour
of the relation on the ๐-set constructor.
\begin{code}
๏ผโป[ฮฉ]-packaged : ฮฃ ฯ ๊ (๐ โ ๐ โ ฮฉ ๐ค) , ({A : ๐ค ฬ} (f : A โ ๐)
(r : A โ ๐ โ ฮฉ ๐ค)
โ ฯ (๐-set f) ๏ผ ๏ผโป-auxโ f r)
๏ผโป[ฮฉ]-packaged = ๐-recursion-with-computation
(ฮ -is-set fe (ฮป _ โ ฮฉ-is-set fe pe))
๏ผโป-auxโ
๏ผโป-auxโ-respects-โ'
_๏ผโป[ฮฉ]_ : ๐ โ ๐ โ ฮฉ ๐ค
_๏ผโป[ฮฉ]_ = prโ ๏ผโป[ฮฉ]-packaged
_๏ผโป_ : ๐ โ ๐ โ ๐ค ฬ
x ๏ผโป y = (x ๏ผโป[ฮฉ] y) holds
๏ผโป-is-prop-valued : {x y : ๐} โ is-prop (x ๏ผโป y)
๏ผโป-is-prop-valued {x} {y} = holds-is-prop (x ๏ผโป[ฮฉ] y)
\end{code}
The following lemma shows that the relation ๏ผโป indeed implements the idea
announced in the comment above.
\begin{code}
private
๏ผโป-behaviour : {A B : ๐ค ฬ } (f : A โ ๐) (g : B โ ๐)
โ (๐-set f ๏ผโป ๐-set g)
๏ผ ( ((a : A) โ โ b ๊ B , f a ๏ผโป g b)
ร ((b : B) โ โ a ๊ A , f a ๏ผโป g b))
๏ผโป-behaviour {A} {B} f g =
(๐-set f ๏ผโป ๐-set g) ๏ผโจ โฆ
1โฆ โฉ
(๏ผโป-auxโ f r (๐-set g) holds) ๏ผโจ โฆ
2โฆ โฉ
T โ
where
T : ๐ค ฬ
T = ((a : A) โ โ b ๊ B , f a ๏ผโป g b)
ร ((b : B) โ โ a ๊ A , f a ๏ผโป g b)
r : A โ ๐ โ ฮฉ ๐ค
r a y = f a ๏ผโป[ฮฉ] y
โฆ
1โฆ = ap _holds (happly (prโ ๏ผโป[ฮฉ]-packaged f r) (๐-set g))
โฆ
2โฆ = ap _holds (๏ผโป-auxโ-behaviour f r g)
\end{code}
Finally, we show that ๏ผโป and ๏ผ are equivalent, making ๐ a locally small type.
\begin{code}
๏ผโป-to-๏ผ : {x y : ๐} โ x ๏ผโป y โ x ๏ผ y
๏ผโป-to-๏ผ {x} {y} =
๐-prop-induction (ฮป u โ ((v : ๐) โ u ๏ผโป v โ u ๏ผ v))
(ฮป _ โ ฮ โ-is-prop fe (ฮป _ _ โ ๐-is-large-set))
(ฮป {A} f r โ ๐-prop-simple-induction _
(ฮป _ โ ฮ -is-prop fe (ฮป _ โ ๐-is-large-set))
(ฮป {B} g โ h f g r))
x y
where
h : {A B : ๐ค ฬ } (f : A โ ๐) (g : B โ ๐)
โ ((a : A) (v : ๐) โ f a ๏ผโป v โ f a ๏ผ v)
โ ๐-set f ๏ผโป ๐-set g โ ๐-set f ๏ผ ๐-set g
h {A} {B} f g r e = ๐-set-ext f g (โฆ
1โฆ , โฆ
2โฆ)
where
u : (a : A) โ โ b ๊ B , f a ๏ผโป g b
u = prโ (Idtofun (๏ผโป-behaviour f g) e)
v : (b : B)ย โ โ a ๊ A , f a ๏ผโป g b
v = prโ (Idtofun (๏ผโป-behaviour f g) e)
โฆ
1โฆ : (a : A) โ โ b ๊ B , g b ๏ผ f a
โฆ
1โฆ a = โฅโฅ-functor (ฮป (b , p) โ b , ((r a (g b) p) โปยน)) (u a)
โฆ
2โฆ : (b : B) โ โ a ๊ A , f a ๏ผ g b
โฆ
2โฆ b = โฅโฅ-functor (ฮป (a , p) โ a , r a (g b) p) (v b)
๏ผโป-is-reflexive : {x : ๐} โ x ๏ผโป x
๏ผโป-is-reflexive {x} = ๐-prop-induction (ฮป - โ - ๏ผโป -)
(ฮป _ โ ๏ผโป-is-prop-valued)
h x
where
h : {A : ๐ค ฬ } (f : A โ ๐)
โ ((a : A) โ f a ๏ผโป f a)
โ ๐-set f ๏ผโป ๐-set f
h {A} f r = back-Idtofun (๏ผโป-behaviour f f)
((ฮป a โ โฃ a , r a โฃ) , (ฮป a โ โฃ a , r a โฃ))
๏ผ-to-๏ผโป : {x y : ๐} โ x ๏ผ y โ x ๏ผโป y
๏ผ-to-๏ผโป refl = ๏ผโป-is-reflexive
๏ผโป-โ-๏ผ : {x y : ๐} โ (x ๏ผโป y) โ (x ๏ผ y)
๏ผโป-โ-๏ผ = logically-equivalent-props-are-equivalent
๏ผโป-is-prop-valued
๐-is-large-set
๏ผโป-to-๏ผ
๏ผ-to-๏ผโป
๐-is-locally-small : is-locally-small ๐
๐-is-locally-small x y = (x ๏ผโป y) , ๏ผโป-โ-๏ผ
๏ผโป-is-transitive : {x y z : ๐} โ x ๏ผโป y โ y ๏ผโป z โ x ๏ผโป z
๏ผโป-is-transitive {x} {y} {z} u v = ๏ผ-to-๏ผโป (๏ผโป-to-๏ผ u โ ๏ผโป-to-๏ผ v)
๏ผโป-is-symmetric : {x y : ๐} โ x ๏ผโป y โ y ๏ผโป x
๏ผโป-is-symmetric {x} {y} e = ๏ผ-to-๏ผโป ((๏ผโป-to-๏ผ e)โปยน)
\end{code}
We now make use of the fact that ๐ is locally small by introducing a
small-valued membership relation on ๐.
\begin{code}
_โโป[ฮฉ]_ : ๐ โ ๐ โ ฮฉ ๐ค
_โโป[ฮฉ]_ x = ๐-prop-simple-recursion
(ฮป {A} f โ (โ a ๊ A , f a ๏ผโป x) , โ-is-prop) e
where
e : {A B : ๐ค ฬ } (f : A โ ๐) (g : B โ ๐)
โ f โฒ g โ (โ a ๊ A , f a ๏ผโป x) โ (โ b ๊ B , g b ๏ผโป x)
e {A} {B} f g s =
โฅโฅ-rec โ-is-prop
(ฮป (a , p) โ โฅโฅ-functor (ฮป (b , q)
โ b , ๏ผ-to-๏ผโป (q โ ๏ผโป-to-๏ผ p))
(s a))
_โโป_ : ๐ โ ๐ โ ๐ค ฬ
x โโป y = (x โโป[ฮฉ] y) holds
โโป-for-๐-sets : (x : ๐) {A : ๐ค ฬ } (f : A โ ๐)
โ (x โโป ๐-set f) ๏ผ (โ a ๊ A , f a ๏ผโป x)
โโป-for-๐-sets x f = ap prโ (๐-prop-simple-recursion-computes _ _ f)
โโป-is-prop-valued : {x y : ๐} โ is-prop (x โโป y)
โโป-is-prop-valued {x} {y} = holds-is-prop (x โโป[ฮฉ] y)
โโป-โ-โ : {x y : ๐} โ x โโป y โ x โ y
โโป-โ-โ {x} {y} =
๐-prop-simple-induction _ (ฮป _ โ โ-is-prop (ฮป _ _ โ fe) โ-is-prop-valued) h y
where
h : {A : ๐ค ฬ } (f : A โ ๐) โ (x โโป ๐-set f) โ (x โ ๐-set f)
h {A} f = x โโป ๐-set f โโจ โฆ
1โฆ โฉ
(โ a ๊ A , f a ๏ผโป x) โโจ โฆ
2โฆ โฉ
(โ a ๊ A , f a ๏ผ x) โโจ โฆ
3โฆ โฉ
x โ ๐-set f โ
where
โฆ
1โฆ = idtoeq _ _ (โโป-for-๐-sets x f)
โฆ
2โฆ = โ-cong pt (ฮป a โ ๏ผโป-โ-๏ผ)
โฆ
3โฆ = idtoeq _ _ ((โ-for-๐-sets x f) โปยน)
โโป-to-โ : {x y : ๐} โ x โโป y โ x โ y
โโป-to-โ {x} {y} = โ โโป-โ-โ โ
โ-to-โโป : {x y : ๐} โ x โ y โ x โโป y
โ-to-โโป {x} {y} = โ โโป-โ-โ โโปยน
\end{code}