Martin Escardo, 5th September 2018. Modified 27 September 2023 to
support the object of truth values to live in a different universe
than that of which the powerset is taken.
Univalence gives the usual mathematical notion of equality for the
subsets of a type: two subsets of a type are equal precisely when they
have the same elements, like in ZF (C). And *not* when they are
isomorphic, for any reasonable notion of isomorphism between subsets
of a given type.
A subset of a type X in a universe π€ is an embedding of some given
type into X, or, equivalently, a map of X into the subtype classifier
Ξ© π€ of the universe π€ (see the module UF.Classifiers).
We generalize this to allow the powerset to have values in Ξ© π₯. The
module UF.Powerset specializes this module to the case π€=π₯.
\begin{code}
{-# OPTIONS --safe --without-K #-}
module UF.Powerset-MultiUniverse where
open import MLTT.Spartan
open import UF.FunExt
open import UF.Lower-FunExt
open import UF.PropTrunc
open import UF.Sets
open import UF.Sets-Properties
open import UF.Subsingletons
open import UF.Subsingletons-FunExt
open import UF.SubtypeClassifier
open import UF.SubtypeClassifier-Properties
open import UF.UA-FunExt
open import UF.Univalence
π : {π₯ π€ : Universe} β π€ Μ β π€ β (π₯ βΊ) Μ
π {π₯} {π€} X = X β Ξ© π₯
powersets-are-sets'' : funext π€ (π₯ βΊ)
β funext π₯ π₯
β propext π₯
β {X : π€ Μ } β is-set (π {π₯} X)
powersets-are-sets'' fe fe' pe = Ξ -is-set fe (Ξ» x β Ξ©-is-set fe' pe)
powersets-are-sets : funext π₯ (π₯ βΊ)
β propext π₯
β {X : π₯ Μ } β is-set (X β Ξ© π₯)
powersets-are-sets {π₯} fe = powersets-are-sets'' fe (lower-funext π₯ (π₯ βΊ) fe)
π-is-set' : funext π€ (π€ βΊ)
β propext π€
β {X : π€ Μ }
β is-set (π {π€} X)
π-is-set' = powersets-are-sets
π-is-set : Univalence
β {X : π€ Μ }
β is-set (π X)
π-is-set {π€} ua = π-is-set'
(univalence-gives-funext' π€ (π€ βΊ) (ua π€) (ua (π€ βΊ)))
(univalence-gives-propext (ua π€))
comprehension : (X : π€ Μ ) β π {π₯} X β π {π₯} X
comprehension X A = A
syntax comprehension X (Ξ» x β A) = β
x κ X β£ A β
β
: {X : π€ Μ } β π {π₯} X
β
_ = π , π-is-prop
full : {X : π€ Μ } β π {π₯} X
full _ = π , π-is-prop
_ββ_ : {X : π€ Μ} β X β (X β Ξ© π₯) β Ξ© π₯
x ββ A = A x
_β_ : {X : π€ Μ } β X β π {π₯} X β π₯ Μ
x β A = x ββ A holds
_β_ : {X : π€ Μ } β X β π {π₯} X β π₯ Μ
x β A = Β¬ (x β A)
is-empty-subset : {X : π€ Μ } β π {π₯} X β π€ β π₯ Μ
is-empty-subset {π€} {π₯} {X} A = (x : X) β x β A
being-empty-subset-is-prop : Fun-Ext
β {X : π€ Μ } (A : π {π₯} X)
β is-prop (is-empty-subset A)
being-empty-subset-is-prop fe {X} A = Ξ -is-prop fe (Ξ» x β negations-are-props fe)
are-disjoint : {X : π€ Μ } β π {π₯} X β π {π¦} X β π€ β π₯ β π¦ Μ
are-disjoint {π€} {π₯} {π¦} {X} A B = (x : X) β Β¬((x β A) Γ (x β B))
being-disjoint-is-prop : Fun-Ext
β {X : π€ Μ } (A : π {π₯} X) (B : π {π¦} X)
β is-prop (are-disjoint A B)
being-disjoint-is-prop fe A B = Ξ -is-prop fe (Ξ» _ β negations-are-props fe)
_β_ _β_ : {X : π€ Μ } β π {π₯} X β π {π¦} X β π€ β π₯ β π¦ Μ
A β B = β x β x β A β x β B
A β B = B β A
β-is-prop : {X : π€ Μ } (A : π {π₯} X) (x : X) β is-prop (x β A)
β-is-prop A x = holds-is-prop (A x)
β-is-prop : funext π₯ π€β β {X : π€ Μ } (A : π {π₯} X) (x : X) β is-prop (x β A)
β-is-prop fe A x = negations-are-props fe
module subset-complement (fe : Fun-Ext) where
_β_ : {X : π€ Μ } β π {π₯} X β π {π¦} X β π {π₯ β π¦} X
A β B = Ξ» x β (x β A Γ x β B) , Γ-is-prop (β-is-prop A x) (β-is-prop fe B x)
infix 45 _β_
β-elimβ : {X : π€ Μ } (A : π {π₯} X) (B : π {π¦} X) {x : X} β x β A β B β x β A
β-elimβ A B = prβ
β-elimβ : {X : π€ Μ } (A : π {π₯} X) (B : π {π¦} X) {x : X} β x β A β B β x β B
β-elimβ A B = prβ
module inhabited-subsets (pt : propositional-truncations-exist) where
open PropositionalTruncation pt
is-inhabited : {X : π€ Μ } β π {π₯} X β π€ β π₯ Μ
is-inhabited {π€} {π₯} {X} A = β x κ X , x β A
being-inhabited-is-prop : {X : π€ Μ } (A : π {π₯} X)
β is-prop (is-inhabited A)
being-inhabited-is-prop {π€} {π₯} {X} A = β-is-prop
πβΊ : π€ Μ β π€ βΊ Μ
πβΊ {π€} X = Ξ£ A κ π X , is-inhabited A
πβΊ-is-set' : funext π€ (π€ βΊ) β propext π€ β {X : π€ Μ } β is-set (πβΊ X)
πβΊ-is-set' fe pe {X} = subsets-of-sets-are-sets (π X)
is-inhabited
(π-is-set' fe pe)
(Ξ» {A} β being-inhabited-is-prop A)
πβΊ-is-set : Univalence β {X : π€ Μ } β is-set (πβΊ X)
πβΊ-is-set {π€} ua = πβΊ-is-set'
(univalence-gives-funext' π€ (π€ βΊ) (ua π€) (ua (π€ βΊ)))
(univalence-gives-propext (ua π€) )
_ββΊ_ : {X : π€ Μ } β X β πβΊ X β π€ Μ
x ββΊ (A , _) = x β A
_ββΊ_ : {X : π€ Μ } β X β πβΊ X β π€ Μ
x ββΊ A = Β¬ (x ββΊ A)
infix 40 _ββΊ_
infix 40 _ββΊ_
open import UF.ClassicalLogic
non-empty-subsets-are-inhabited : Excluded-Middle
β {X : π€ Μ } (B : π {π₯} X)
β Β¬ is-empty-subset B
β is-inhabited B
non-empty-subsets-are-inhabited em B = not-Ξ -not-implies-β pt em
uninhabited-subsets-are-empty : {X : π€ Μ } (B : π {π₯} X)
β Β¬ is-inhabited B
β is-empty-subset B
uninhabited-subsets-are-empty B Ξ½ x m = Ξ½ β£ x , m β£
complement : {X : π€ Μ } β funext π€ π€β β π X β π X
complement fe A = Ξ» x β (x β A) , (β-is-prop fe A x)
β-is-prop' : funext π€ π₯
β funext π₯ π₯
β {X : π€ Μ } (A B : π {π₯} X) β is-prop (A β B)
β-is-prop' fe fe' A B = Ξ -is-prop fe
(Ξ» x β Ξ -is-prop fe'
(Ξ» _ β β-is-prop B x))
β-is-prop : funext π€ π€
β {X : π€ Μ } (A B : π X) β is-prop (A β B)
β-is-prop fe = β-is-prop' fe fe
module PropositionalSubsetInclusionNotation (fe : Fun-Ext) where
_ββ_ _ββ_ : {X : π€ Μ} β π {π€} X β π {π€} X β Ξ© π€
A ββ B = (A β B) , β-is-prop fe A B
A ββ B = (A β B) , β-is-prop fe B A
β
-is-least' : {X : π€ Μ } (A : π {π₯} X) β β
{π€} {π₯} β A
β
-is-least' _ x = π-induction
β
-is-least : {X : π€ Μ } (A : π X) β β
{π€} {π€} β A
β
-is-least = β
-is-least'
β-refl' : {X : π€ Μ } (A : π {π₯} X) β A β A
β-refl' A x = id
β-refl : {X : π€ Μ } (A : π {π₯} X) β A β A
β-refl = β-refl'
β-trans' : {X : π€ Μ } (A B C : π {π₯} X) β A β B β B β C β A β C
β-trans' A B C s t x a = t x (s x a)
β-trans : {X : π€ Μ } (A B C : π {π₯} X) β A β B β B β C β A β C
β-trans = β-trans'
β-refl-consequence : {X : π€ Μ } (A B : π {π₯} X)
β A οΌ B β (A β B) Γ (B β A)
β-refl-consequence A A (refl) = β-refl A , β-refl A
subset-extensionality'' : propext π₯
β funext π€ (π₯ βΊ)
β funext π₯ π₯
β {X : π€ Μ } {A B : π {π₯} X}
β A β B β B β A β A οΌ B
subset-extensionality'' {π₯} {π€} pe fe fe' {X} {A} {B} h k = dfunext fe Ο
where
Ο : (x : X) β A x οΌ B x
Ο x = to-subtype-οΌ
(Ξ» _ β being-prop-is-prop fe')
(pe (holds-is-prop (A x)) (holds-is-prop (B x))
(h x) (k x))
subset-extensionality : propext π€
β funext π€ (π€ βΊ)
β {X : π€ Μ } {A B : π X}
β A β B β B β A β A οΌ B
subset-extensionality {π€} pe fe = subset-extensionality'' pe fe (lower-funext π€ (π€ βΊ) fe)
subset-extensionality' : Univalence
β {X : π€ Μ } {A B : π X}
β A β B β B β A β A οΌ B
subset-extensionality' {π€} ua = subset-extensionality
(univalence-gives-propext (ua π€))
(univalence-gives-funext' π€ (π€ βΊ) (ua π€) (ua (π€ βΊ)))
\end{code}
Tom de Jong, 24 January 2022
(Based on code from FreeJoinSemiLattice.lagda written 18-24 December 2020.)
Notation for the "total space" of a subset.
\begin{code}
module _
{X : π€ Μ }
where
π : π {π₯} X β π€ β π₯ Μ
π A = Ξ£ x κ X , x β A
π-to-carrier : (A : π {π₯} X) β π A β X
π-to-carrier A = prβ
π-to-membership : (A : π {π₯} X) β (t : π A) β π-to-carrier A t β A
π-to-membership A = prβ
\end{code}
We use a named module when defining singleton subsets, so that we can write
β΄ x β΅ without having to keep supplying the proof that the ambient type is a set.
\begin{code}
module singleton-subsets
{X : π€ Μ }
(X-is-set : is-set X)
where
β΄_β΅ : X β π X
β΄ x β΅ = Ξ» y β ((x οΌ y) , X-is-set)
β-β΄β΅ : {x : X} β x β β΄ x β΅
β-β΄β΅ {x} = refl
β΄β΅-subset-characterization : {x : X} (A : π {π₯} X) β x β A β β΄ x β΅ β A
β΄β΅-subset-characterization {π₯} {x} A = β¦
ββ¦ , β¦
ββ¦
where
β¦
ββ¦ : x β A β β΄ x β΅ β A
β¦
ββ¦ a _ refl = a
β¦
ββ¦ : β΄ x β΅ β A β x β A
β¦
ββ¦ s = s x β-β΄β΅
β΄β΅-is-singleton : {x : X} β is-singleton (π β΄ x β΅)
β΄β΅-is-singleton {x} = singleton-types-are-singletons x
\end{code}
Next, we consider binary intersections and unions in the powerset. For the
latter, we need propositional truncations.
\begin{code}
module _
{X : π€ Μ }
where
_β©_ : π {π₯} X β π {π₯} X β π {π₯} X
(A β© B) x = (x β A Γ x β B) , Γ-is-prop (β-is-prop A x) (β-is-prop B x)
β©-is-lowerboundβ : (A B : π {π₯} X) β (A β© B) β A
β©-is-lowerboundβ A B x = prβ
β©-is-lowerboundβ : (A B : π {π₯} X) β (A β© B) β B
β©-is-lowerboundβ A B x = prβ
β©-is-upperbound-of-lowerbounds : (A B C : π {π₯} X)
β C β A β C β B β C β (A β© B)
β©-is-upperbound-of-lowerbounds A B C s t x c = (s x c , t x c)
module binary-unions-of-subsets
(pt : propositional-truncations-exist)
where
open PropositionalTruncation pt
module _
{X : π€ Μ }
where
_βͺ_ : π {π₯} X β π {π₯} X β π {π₯} X
(A βͺ B) x = β₯ x β A + x β B β₯ , β₯β₯-is-prop
βͺ-is-upperboundβ : (A B : π {π₯} X) β A β (A βͺ B)
βͺ-is-upperboundβ A B x a = β£ inl a β£
βͺ-is-upperboundβ : (A B : π {π₯} X) β B β (A βͺ B)
βͺ-is-upperboundβ A B x b = β£ inr b β£
βͺ-is-lowerbound-of-upperbounds : (A B C : π {π₯} X)
β A β C β B β C β (A βͺ B) β C
βͺ-is-lowerbound-of-upperbounds A B C s t x = β₯β₯-rec (β-is-prop C x) Ξ³
where
Ξ³ : (x β A + x β B) β x β C
Ξ³ (inl a) = s x a
Ξ³ (inr b) = t x b
β
-left-neutral-for-βͺ' : propext π₯
β funext π€ (π₯ βΊ)
β funext π₯ π₯
β (A : π {π₯} X) β β
βͺ A οΌ A
β
-left-neutral-for-βͺ' pe fe fe' A =
subset-extensionality'' pe fe fe' s (βͺ-is-upperboundβ β
A)
where
s : (β
βͺ A) β A
s x = β₯β₯-rec (β-is-prop A x) Ξ³
where
Ξ³ : x β β
+ x β A β x β A
Ξ³ (inl p) = π-elim p
Ξ³ (inr a) = a
β
-left-neutral-for-βͺ : propext π€
β funext π€ (π€ βΊ)
β (A : π X) β β
βͺ A οΌ A
β
-left-neutral-for-βͺ pe fe =
β
-left-neutral-for-βͺ' pe fe (lower-funext π€ (π€ βΊ) fe)
β
-right-neutral-for-βͺ' : propext π₯
β funext π€ (π₯ βΊ)
β funext π₯ π₯
β (A : π {π₯} X) β A οΌ A βͺ β
β
-right-neutral-for-βͺ' pe fe fe' A =
subset-extensionality'' pe fe fe' (βͺ-is-upperboundβ A β
) s
where
s : (A βͺ β
) β A
s x = β₯β₯-rec (β-is-prop A x) Ξ³
where
Ξ³ : x β A + x β β
β x β A
Ξ³ (inl a) = a
Ξ³ (inr p) = π-elim p
β
-right-neutral-for-βͺ : propext π€
β funext π€ (π€ βΊ)
β (A : π X) β A οΌ A βͺ β
β
-right-neutral-for-βͺ pe fe =
β
-right-neutral-for-βͺ' pe fe (lower-funext π€ (π€ βΊ) fe)
βͺ-assoc' : propext π₯
β funext π€ (π₯ βΊ)
β funext π₯ π₯
β associative {π₯ βΊ β π€} {π {π₯} X} (_βͺ_)
βͺ-assoc' pe fe fe' A B C = subset-extensionality'' pe fe fe' s t
where
s : ((A βͺ B) βͺ C) β (A βͺ (B βͺ C))
s x = β₯β₯-rec i sβ
where
i : is-prop (x β (A βͺ (B βͺ C)))
i = β-is-prop (A βͺ (B βͺ C)) x
sβ : x β (A βͺ B) + x β C
β x β (A βͺ (B βͺ C))
sβ (inl u) = β₯β₯-rec i sβ u
where
sβ : x β A + x β B
β x β (A βͺ (B βͺ C))
sβ (inl a) = βͺ-is-upperboundβ A (B βͺ C) x a
sβ (inr b) = βͺ-is-upperboundβ A (B βͺ C) x (βͺ-is-upperboundβ B C x b)
sβ (inr c) = βͺ-is-upperboundβ A (B βͺ C) x (βͺ-is-upperboundβ B C x c)
t : (A βͺ (B βͺ C)) β ((A βͺ B) βͺ C)
t x = β₯β₯-rec i tβ
where
i : is-prop (x β ((A βͺ B) βͺ C))
i = β-is-prop ((A βͺ B) βͺ C) x
tβ : x β A + x β (B βͺ C)
β x β ((A βͺ B) βͺ C)
tβ (inl a) = βͺ-is-upperboundβ (A βͺ B) C x (βͺ-is-upperboundβ A B x a)
tβ (inr u) = β₯β₯-rec i tβ u
where
tβ : x β B + x β C
β x β ((A βͺ B) βͺ C)
tβ (inl b) = βͺ-is-upperboundβ (A βͺ B) C x (βͺ-is-upperboundβ A B x b)
tβ (inr c) = βͺ-is-upperboundβ (A βͺ B) C x c
βͺ-assoc : propext π€
β funext π€ (π€ βΊ)
β associative {π€ βΊ} {π X} (_βͺ_)
βͺ-assoc pe fe = βͺ-assoc' pe fe (lower-funext π€ (π€ βΊ) fe)
\end{code}
Again assuming propositional truncations, we can construct arbitrary suprema in
π (X : π€) of families indexed by types in π€.
\begin{code}
module unions-of-small-families
(pt : propositional-truncations-exist)
(π₯ : Universe)
(π£ : Universe)
(X : π€ Μ )
{I : π₯ Μ }
where
open PropositionalTruncation pt
β : (Ξ± : I β π {π₯ β π£} X) β π {π₯ β π£} X
β Ξ± x = (β i κ I , x β Ξ± i) , β-is-prop
β-is-upperbound : (Ξ± : I β π {π₯ β π£} X) (i : I)
β Ξ± i β β Ξ±
β-is-upperbound Ξ± i x a = β£ i , a β£
β-is-lowerbound-of-upperbounds : (Ξ± : I β π {π₯ β π£} X) (A : π {π₯ β π£} X)
β ((i : I) β Ξ± i β A)
β β Ξ± β A
β-is-lowerbound-of-upperbounds Ξ± A ub x u =
β₯β₯-rec (β-is-prop A x) Ξ³ u
where
Ξ³ : (Ξ£ i κ I , x β Ξ± i) β x β A
Ξ³ (i , a) = ub i x a
\end{code}
Fixities.
\begin{code}
infix 40 _ββ_
infix 40 _β_
infix 40 _β_
\end{code}