Martin Escardo & Tom de Jong, June 2023.
Iterative sets.
We define the type of iterative sets as a subtype of that of multisets.
* H. R. Gylterud, "From multisets to sets in homotopy type theory".
The Journal of Symbolic Logic, vol. 83, no. 3, pp. 1132β1146,
2018. https://doi.org/10.1017/jsl.2017.84
See the module Iterative.index for further bibliographic references.
The previous module Iterative.Multisets doesn't make significant use
of univalence, and so we assumed it only for specific
constructions. But here the use of univalence is more pervasive, and
so we assume it globally.
\begin{code}
{-# OPTIONS --safe --without-K --lossy-unification #-}
open import MLTT.Spartan
open import UF.Univalence
module Iterative.Sets
(ua : Univalence)
(π€ : Universe)
where
open import UF.FunExt
open import UF.UA-FunExt
private
π€βΊ : Universe
π€βΊ = π€ βΊ
fe : Fun-Ext
fe = Univalence-gives-Fun-Ext ua
fe' : FunExt
fe' π€ π₯ = fe {π€} {π₯}
open import Iterative.Multisets π€
open import Ordinals.Notions
open import UF.Base
open import UF.DiscreteAndSeparated
open import UF.Embeddings
open import UF.Equiv
open import UF.EquivalenceExamples
open import UF.PairFun
open import UF.Retracts
open import UF.Sets
open import UF.Size
open import UF.Subsingletons
open import UF.Subsingletons-FunExt
open import W.Type
\end{code}
An iterative set is a multiset whose subforests are all
embeddings. The effect of that is that the membership relation on
iterative sets is proposition-valued, rather than just type-valued, as
is the case for general multisets.
\begin{code}
is-iterative-set : π β π€βΊ Μ
is-iterative-set (ssup X Ο) = is-embedding Ο
Γ ((x : X) β is-iterative-set (Ο x))
\end{code}
It is convenient to name the projections for the sake of clarity:
\begin{code}
π-forest-is-embedding : (M : π)
β is-iterative-set M
β is-embedding (π-forest M)
π-forest-is-embedding (ssup _ _) = prβ
π-subtrees-are-iterative : (M : π)
β is-iterative-set M
β (x : π-root M) β is-iterative-set (π-forest M x)
π-subtrees-are-iterative (ssup _ _) = prβ
\end{code}
It is crucial that the notion of iterative set is property rather than
data:
\begin{code}
being-iset-is-prop : (M : π) β is-prop (is-iterative-set M)
being-iset-is-prop (ssup X Ο) =
Γ-is-prop
(being-embedding-is-prop fe Ο)
(Ξ -is-prop fe (Ξ» x β being-iset-is-prop (Ο x)))
\end{code}
The type of iterative sets as a subtype of that of iterative
multisets:
\begin{code}
π : π€βΊ Μ
π = Ξ£ M κ π , is-iterative-set M
π-is-locally-small : is-locally-small π
π-is-locally-small = subtype-is-locally-small
being-iset-is-prop
(π-is-locally-small ua)
\end{code}
We again name the projections for the sake of clarity:
\begin{code}
underlying-mset : π β π
underlying-mset = prβ
isets-are-iterative : (A : π) β is-iterative-set (underlying-mset A)
isets-are-iterative = prβ
\end{code}
Because the notion of iterative set is property, we get that π is
indeed a subtype of π.
\begin{code}
underlying-mset-is-embedding : is-embedding underlying-mset
underlying-mset-is-embedding = prβ-is-embedding being-iset-is-prop
\end{code}
We define the root and the forest of an iterative set in terms of
those for multisets, but we need to add a "proof obligation" in the
case of the forest.
\begin{code}
π-root : π β π€ Μ
π-root A = π-root (underlying-mset A)
π-forest : (A : π) β π-root A β π
π-forest A x = π-forest (underlying-mset A) x ,
π-subtrees-are-iterative
(underlying-mset A)
(isets-are-iterative A)
x
\end{code}
A criterion for equality in π:
\begin{code}
to-π-οΌ : {X Y : π€ Μ }
{Ο : X β π}
{Ξ³ : Y β π}
β (Ξ£ p κ X οΌ Y , Ο οΌ Ξ³ β Idtofun p)
β (i : is-iterative-set (ssup X Ο))
(j : is-iterative-set (ssup Y Ξ³))
β (ssup X Ο , i) οΌ[ π ] (ssup Y Ξ³ , j)
to-π-οΌ Ο i j = to-subtype-οΌ being-iset-is-prop (to-π-οΌ Ο)
\end{code}
We define membership of iterative sets in terms of that for multisets:
\begin{code}
_β_ : π β π β π€βΊ Μ
A β B = underlying-mset A β
underlying-mset B
\end{code}
As is the case for iterative multisets, there is a resized down,
equivalent definition of membership.
\begin{code}
_ββ»_ : π β π β π€ Μ
A ββ» B = underlying-mset A β
β» underlying-mset B
ββ»ββ : (A B : π) β (A β B) β (A ββ» B)
ββ»ββ A B = β
β»ββ
ua (underlying-mset A) (underlying-mset B)
\end{code}
As discussed above, the membership relation becomes a proposition
precisely because we required forests to be embeddings to define the
subtype of iterative sets.
\begin{code}
β-is-prop-valued : (A B : π) β is-prop (A β B)
β-is-prop-valued (M , _) (ssup X Ο , Ο-emb , _) = Ο-emb M
π-forest-β : (A : π) (x : π-root A) β π-forest A x β A
π-forest-β A x = π-forest-β
(underlying-mset A) x
\end{code}
The subset relation is defined in the usual way and is
proposition-valued:
\begin{code}
_β_ : π β π β π€βΊ Μ
A β B = (C : π) β C β A β C β B
β-is-prop-valued : (A B : π) β is-prop (A β B)
β-is-prop-valued A B = Ξ β-is-prop fe (Ξ» C _ β β-is-prop-valued C B)
\end{code}
It is in the following that the univalence axiom is used for the first
time, to establish the extensionality axiom for iterative sets:
\begin{code}
β-is-extensional : (A B : π) β A β B β B β A β A οΌ B
β-is-extensional A@(M@(ssup X Ο) , Ο-emb , g)
B@(N@(ssup Y Ξ³) , Ξ³-emb , h) u v = V
where
have-uv : (A β B) Γ (B β A)
have-uv = u , v
I : (x : X) β Ξ£ y κ Y , Ξ³ y οΌ Ο x
I x = u (Ο x , g x) (π-forest-β
M x)
II : (y : Y) β Ξ£ x κ X , Ο x οΌ Ξ³ y
II y = v (Ξ³ y , h y) (π-forest-β
N y)
f : X β Y
f x = prβ (I x)
fβ»ΒΉ : Y β X
fβ»ΒΉ y = prβ (II y)
Ξ· : fβ»ΒΉ β f βΌ id
Ξ· x = embeddings-are-lc Ο Ο-emb
(Ο (fβ»ΒΉ (f x)) οΌβ¨ prβ (II (f x)) β©
Ξ³ (f x) οΌβ¨ prβ (I x) β©
Ο x β)
Ξ΅ : f β fβ»ΒΉ βΌ id
Ξ΅ y = embeddings-are-lc Ξ³ Ξ³-emb
(Ξ³ (f (fβ»ΒΉ y)) οΌβ¨ prβ (I (fβ»ΒΉ y)) β©
Ο (fβ»ΒΉ y) οΌβ¨ prβ (II y) β©
Ξ³ y β)
π : X β Y
π = qinveq f (fβ»ΒΉ , Ξ· , Ξ΅)
p : X οΌ Y
p = eqtoid (ua π€) X Y π
III : Idtofun p οΌ f
III = Idtofun-eqtoid (ua π€) π
IV = Ξ» x β
Ο x οΌβ¨ (prβ (I x))β»ΒΉ β©
Ξ³ (f x) οΌβ¨ ap (Ξ» - β Ξ³ (- x)) (III β»ΒΉ) β©
Ξ³ (Idtofun p x) β
V : A οΌ B
V = to-π-οΌ (p , dfunext fe IV) (Ο-emb , g) (Ξ³-emb , h)
\end{code}
It follows that π is 0-type, or set, in the sense of the HoTT
book. But notice that we now have two notions of set in this
discussion: the "material" (iterative set) one and the "structural"
one (0-type or set). The reader should keep this distinction in mind
for the comments and code below.
The following uses the fact that any type with an extensional order is
automatically a set.
\begin{code}
π-is-set : is-set π
π-is-set = extensionally-ordered-types-are-sets _β_ fe'
β-is-prop-valued
β-is-extensional
\end{code}
Here is a second, more direct, proof of this fact.
The following says that ssup Ο οΌ M is a proposition for every M : π
if Ο is an embedding.
The following doesn't seem to have been observed before in the
literature.
\begin{code}
π-ssup-is-h-isolated : (X : π€ Μ ) (Ο : X β π)
β is-embedding Ο
β is-h-isolated (ssup X Ο)
π-ssup-is-h-isolated X Ο Ο-emb {M} = III
where
I = (ssup X Ο οΌ M) ββ¨ οΌ-flip β©
(M οΌ ssup X Ο) ββ¨ π-οΌ' M (ssup X Ο) β©
fiber ((Ο β_) β Idtofun) (π-forest M) β
II : is-embedding ((Ο β_) β Idtofun)
II = β-is-embedding
(Idtofun-is-embedding (ua π€) fe)
(postcomp-is-embedding fe' Ο Ο-emb)
III : is-prop (ssup X Ο οΌ M)
III = equiv-to-prop I (II (π-forest M))
\end{code}
And a particular case of this is that if M is an iterative set then
M οΌ N is a proposition for every *multiset* N.
\begin{code}
isets-are-h-isolated : (M : π)
β is-iterative-set M
β is-h-isolated M
isets-are-h-isolated (ssup X Ο) (Ο-emb , _) = π-ssup-is-h-isolated X Ο Ο-emb
\end{code}
Because a subtype of any type whatsoever consisting of h-isolated
elements is a 0-type, we get a second proof that the type of iterative
sets is a 0-type.
\begin{code}
π-is-set' : is-set π
π-is-set' {M , M-is-is-set} =
equiv-to-prop
(β-sym (to-subtype-οΌ-β being-iset-is-prop))
(isets-are-h-isolated M M-is-is-set)
\end{code}
By definition, an iterative multiset is an iterative set if its
π-forests are all embeddings. The π-forests are also embeddings:
\begin{code}
π-forest-is-embedding : (A : π) β is-embedding (π-forest A)
π-forest-is-embedding A@(ssup X Ο , Ο-emb , Ο-iter) =
pair-fun-is-embedding-special Ο Ο-iter Ο-emb being-iset-is-prop
\end{code}
We construct elements of π using the constructor ssup. We now
introduce a corresponding constructor π-ssup to construct elements of
the type π.
\begin{code}
π-ssup : (X : π€ Μ ) (Ο : X β π) β is-embedding Ο β π
π-ssup X Ο Ο-emb = ssup X Ο , Ο-emb , Ο-iset
where
Ο : X β π
Ο = underlying-mset β Ο
Ο-iset : (x : X) β is-iterative-set (Ο x)
Ο-iset = isets-are-iterative β Ο
Ο-emb : is-embedding Ο
Ο-emb = β-is-embedding Ο-emb underlying-mset-is-embedding
\end{code}
It behaves as expected with respect to the corresponding destructors:
\begin{code}
π-ssup-root : (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β π-root (π-ssup X Ο e) οΌ X
π-ssup-root X Ο e = refl
π-ssup-forest : (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β π-forest (π-ssup X Ο e) οΌ Ο
π-ssup-forest X Ο e = refl
\end{code}
Notice that the identifications are definitional.
We have the following Ξ· rules for π, where the first is more general
and the second is more natural. In both cases the identifications are
not definitional.
\begin{code}
π-Ξ·' : (A : π) (e : is-embedding (π-forest A))
β π-ssup (π-root A) (π-forest A) e οΌ A
π-Ξ·' (ssup _ _ , _) _ = to-subtype-οΌ being-iset-is-prop refl
π-Ξ· : (A : π) β π-ssup (π-root A) (π-forest A) (π-forest-is-embedding A) οΌ A
π-Ξ· A = π-Ξ·' A (π-forest-is-embedding A)
\end{code}
Here are two characterizations of the membership relation:
\begin{code}
β-behaviour : (A : π) (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β A β π-ssup X Ο e β (Ξ£ x κ X , Ο x οΌ A)
β-behaviour A X Ο e =
(A β π-ssup X Ο e) ββ¨by-definitionβ©
(Ξ£ x κ X , underlying-mset (Ο x) οΌ underlying-mset A) ββ¨ Ξ£-cong I β©
(Ξ£ x κ X , Ο x οΌ A) β
where
I : (x : X) β (underlying-mset (Ο x) οΌ underlying-mset A) β (Ο x οΌ A)
I x = embedding-criterion-converse
underlying-mset
underlying-mset-is-embedding
(Ο x)
A
β-behaviour' : (A B : π) β A β B β (Ξ£ x κ π-root B , π-forest B x οΌ A)
β-behaviour' A B =
transport
(Ξ» - β A β - β (Ξ£ x κ π-root - , π-forest - x οΌ A))
(π-Ξ· B)
(β-behaviour A (π-root B) (π-forest B) (π-forest-is-embedding B))
private
β-remark : (A B : π) β A β B β fiber (π-forest B) A
β-remark = β-behaviour'
\end{code}
It also follows from the facts that π is a set and that π-forest is an
embedding that the root of any iterative set is a 0-type:
\begin{code}
π-root-is-set : (A : π) β is-set (π-root A)
π-root-is-set A = subtypes-of-sets-are-sets
(π-forest A)
(π-forest-is-embedding A)
π-is-set
\end{code}
It would be nice if we could define π inductively as follows:
data π : π€βΊ Μ where
π-ssup : (X : π€ Μ ) (Ο : X β π) β is-embedding Ο β π
However, this is not a strictly positive definition, for the criterion
of strict positivity adopted by Agda, and so it is not accepted.
Nevertheless, all iterative sets *are* generated by the "constructor"
π-ssup, in the following sense, so that we can view π as really
inductively defined by the above data declaration.
The following result, implementing the above idea, seems to be new.
\begin{code}
π-Induction'
: (P : π β π₯ Μ )
(f : (A : π) β ((x : π-root A) β P (π-forest A x)) β P A)
β Ξ£ h κ ((A : π) β P A)
, ((A : π) β h A οΌ f A (Ξ» x β h (π-forest A x)))
π-Induction' P f = (Ξ» (M , i) β H M i) , p
where
H : (M : π) (i : is-iterative-set M) β P (M , i)
H M@(ssup X Ο) i@(_ , Ο-iter) = f (M , i) (Ξ» x β H (Ο x) (Ο-iter x))
p : (A : π) β _ οΌ _
p (M@(ssup X Ο) , i@(_ , Ο-iter)) = refl
π-Induction
: (P : π β π₯ Μ )
β (f : (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β ((x : X) β P (Ο x))
β P (π-ssup X Ο e))
β Ξ£ h κ ((A : π) β P A)
, ((X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β h (π-ssup X Ο e) οΌ f X Ο e (Ξ» x β h (Ο x)))
π-Induction {π₯} P f = h , IV
where
f' : (A : π) β ((x : π-root A) β P (π-forest A x)) β P A
f' A@(M@(ssup X Ο) , i@(Ο-emb , Ο-iter)) g = II
where
I : P (π-ssup X (π-forest A) (π-forest-is-embedding A))
I = f X (π-forest A) (π-forest-is-embedding A) g
II : P A
II = transport P (π-Ξ· A) I
h : (A : π) β P A
h = prβ (π-Induction' P f')
III : (A : π) β h A οΌ f' A (Ξ» x β h (π-forest A x))
III = prβ (π-Induction' P f')
IV : (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β h (π-ssup X Ο e) οΌ f X Ο e (Ξ» x β h (Ο x))
IV X Ο e =
h A οΌβ¨ III A β©
f' A (Ξ» x β h (Ο x)) οΌβ¨reflβ©
t P (π-Ξ· A) (f X Ο e' (Ξ» x β h (Ο x))) οΌβ¨ i β©
t P (ap (π-ssup X Ο) p) (f X Ο e' (Ξ» x β h (Ο x))) οΌβ¨ ii β©
t (P β π-ssup X Ο) p (f X Ο e' (Ξ» x β h (Ο x))) οΌβ¨ iii β©
f X Ο e (Ξ» x β h (Ο x)) β
where
t = transport
A = π-ssup X Ο e
e' = π-forest-is-embedding A
p : e' οΌ e
p = being-embedding-is-prop fe Ο e' e
q : π-Ξ· A οΌ ap (π-ssup X Ο) p
q = π-is-set _ _
i = ap (Ξ» - β t P - (f X Ο e' (Ξ» x β h (Ο x)))) q
ii = (transport-ap P (π-ssup X Ο) p)β»ΒΉ
iii = apd (Ξ» - β f X Ο - (Ξ» x β h (Ο x))) p
π-induction : (P : π β π₯ Μ )
β ((X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β ((x : X) β P (Ο x))
β P (π-ssup X Ο e))
β (A : π) β P A
π-induction P f = prβ (π-Induction P f)
π-induction-behaviour
: (P : π β π₯ Μ )
β (f : (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β ((x : X) β P (Ο x))
β P (π-ssup X Ο e))
β (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β π-induction P f (π-ssup X Ο e) οΌ f X Ο e (Ξ» x β π-induction P f (Ο x))
π-induction-behaviour P f = prβ (π-Induction P f)
π-recursion : (P : π₯ Μ )
β ((X : π€ Μ ) (Ο : X β π)
β is-embedding Ο
β (X β P)
β P)
β π β P
π-recursion P = π-induction (Ξ» _ β P)
π-recursion-behaviour
: (P : π₯ Μ )
β (f : (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β (X β P)
β P)
β (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β π-recursion P f (π-ssup X Ο e) οΌ f X Ο e (Ξ» x β π-recursion P f (Ο x))
π-recursion-behaviour P = π-induction-behaviour (Ξ» _ β P)
π-iteration : (P : π₯ Μ )
β ((X : π€ Μ ) β (X β P) β P)
β π β P
π-iteration P f = π-recursion P (Ξ» X Ο e β f X)
π-iteration-behaviour
: (P : π₯ Μ )
β (f : (X : π€ Μ ) β (X β P) β P)
β (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β π-iteration P f (π-ssup X Ο e) οΌ f X (Ξ» x β π-iteration P f (Ο x))
π-iteration-behaviour P f = π-recursion-behaviour P (Ξ» X Ο e β f X)
\end{code}
So we are essentially working with (an encoding) of the above
non-strictly positive data type.
The usual induction principle for iterative sets follows directly from
the above form of induction. This consequence is already in Gylterud [4].
\begin{code}
β-induction : (P : π β π₯ Μ )
β ((A : π) β ((B : π) β B β A β P B) β P A)
β (A : π) β P A
β-induction P IH = π-induction P f
where
f : (X : π€ Μ ) (Ο : X β π) (e : is-embedding Ο)
β ((x : X) β P (Ο x))
β P (π-ssup X Ο e)
f X Ο e IH' = IH A s
where
A : π
A = π-ssup X Ο e
s : (B : π) β B β A β P B
s B@(.(underlying-mset (Ο x)) , j) (x , refl) = II
where
I : P (Ο x)
I = IH' x
II : P (underlying-mset (Ο x) , j)
II = transport P (to-subtype-οΌ being-iset-is-prop refl) I
\end{code}
And then it follows immediately that the membership relation is
accessible:
\begin{code}
β-is-accessible : (A : π) β is-accessible _β_ A
β-is-accessible = β-induction (is-accessible _β_) (Ξ» _ β acc)
\end{code}
Singleton sets can be constructed as follows.
\begin{code}
β΄_β΅ : (A : π) β π
β΄ A β΅ = π-ssup π (Ξ» _ β A) (global-point-is-embedding (Ξ» _ β A) π-is-set)
β΄β΅-behaviour : (A : π) (B : π) β B β β΄ A β΅ β (B οΌ A)
β΄β΅-behaviour A B = B β β΄ A β΅ ββ¨ β-behaviour' B β΄ A β΅ β©
π Γ (A οΌ B) ββ¨ π-lneutral β©
(A οΌ B) ββ¨ οΌ-flip β©
(B οΌ A) β
\end{code}
Given a family of iterative sets indexed by a small type, we construct
its union as in [4].
We make use of propositional truncations (to define the image of a
map) and of set replacement (which follows from having set quotients).
\begin{code}
open import UF.PropTrunc
module _ (pt : propositional-truncations-exist) where
open PropositionalTruncation pt
open import UF.ImageAndSurjection pt
module unions-of-iterative-sets (sr : Set-Replacement pt) where
private
module union-construction
{I : π€ Μ }
(π : I β π)
where
im : π€βΊ Μ
im = image π
im-is-small : image π is π€ small
im-is-small = sr π (I , β-refl I) π-is-locally-small π-is-set
imβ» : π€ Μ
imβ» = resized im im-is-small
imβ»-β-im : imβ» β im
imβ»-β-im = resizing-condition im-is-small
Ο : im β π
Ο = restriction π
Οβ» : imβ» β π
Οβ» = Ο β β imβ»-β-im β
Ο-is-embedding : is-embedding Ο
Ο-is-embedding = restrictions-are-embeddings π
Οβ»-is-embedding : is-embedding Οβ»
Οβ»-is-embedding = β-is-embedding
(equivs-are-embeddings
β imβ»-β-im β
(ββ-is-equiv imβ»-β-im))
Ο-is-embedding
β : {I : π€ Μ } (π : I β π) β π
β {I} π = π-ssup imβ» Οβ» Οβ»-is-embedding
where
open union-construction π
β-behaviour : {I : π€ Μ } (π : I β π) (B : π)
β B β β π β (β i κ I , B οΌ π i)
β-behaviour {I} π B =
B β β π ββ¨ β-behaviour' B (β π) β©
(Ξ£ j κ imβ» , Οβ» j οΌ B) ββ¨ eβ β©
(Ξ£ j κ im , Ο j οΌ B) ββ¨ Ξ£-assoc β©
(Ξ£ C κ π , C βimage π Γ (C οΌ B)) ββ¨ Ξ£-cong (Ξ» C β Γ-comm) β©
(Ξ£ C κ π , (C οΌ B) Γ (C βimage π)) ββ¨ β-sym Ξ£-assoc β©
(Ξ£ s κ singleton-type' B , prβ s βimage π) ββ¨ β-sym eβ β©
π {π€} Γ B βimage π ββ¨ π-lneutral β©
(β i κ I , π i οΌ B) ββ¨ β-cong pt (Ξ» i β οΌ-flip) β©
(β i κ I , B οΌ π i) β
where
open union-construction π
eβ = Ξ£-change-of-variable-β _ imβ»-β-im
eβ = Ξ£-change-of-variable-β _
(singleton-β-π' (singleton-types'-are-singletons B))
\end{code}
Any iterative set is the union of its π-forest.
\begin{code}
β-Ξ· : (A : π) β β (π-forest A) οΌ A
β-Ξ· A = β-is-extensional (β (π-forest A)) A i j
where
i : β (π-forest A) β A
i B m = β₯β₯-rec (β-is-prop-valued B A) f (β β-behaviour (π-forest A) B β m)
where
f : (Ξ£ a κ π-root A , B οΌ π-forest A a) β B β A
f (a , refl) = π-forest-β A a
j : A β β (π-forest A)
j B m = β β-behaviour (π-forest A) B ββ»ΒΉ β£ a , e β£
where
abstract
m' : Ξ£ a κ π-root A , π-forest A a οΌ B
m' = β β-behaviour' B A β m
a : π-root A
a = prβ m'
e : B οΌ π-forest A a
e = (prβ m') β»ΒΉ
\end{code}
Unions allow us to construct a retraction of the inclusion π βͺ π, and
this seems to be a new result.
\begin{code}
π-to-π : π β π
π-to-π (ssup X Ο) = β (π-to-π β Ο)
π-to-π-is-retraction-of-inclusion : π-to-π β underlying-mset οΌ id
π-to-π-is-retraction-of-inclusion = dfunext fe (β-induction _ f)
where
f : (A : π) β ((B : π) β B β A β (π-to-π β underlying-mset) B οΌ B)
β (π-to-π β underlying-mset) A οΌ A
f A IH = π-to-π Aβ οΌβ¨ I β©
π-to-π (ssup (π-root A) (π-forest Aβ)) οΌβ¨reflβ©
β (π-to-π β π-forest Aβ) οΌβ¨reflβ©
β (π-to-π β underlying-mset β π-forest A) οΌβ¨ II β©
β (π-forest A) οΌβ¨ β-Ξ· A β©
A β
where
Aβ : π
Aβ = underlying-mset A
I = ap (π-to-π β underlying-mset) (π-Ξ· A β»ΒΉ)
II = ap β (dfunext fe (Ξ» a β IH (π-forest A a) (π-forest-β A a)))
π-is-retract-of-π : retract π of π
π-is-retract-of-π = π-to-π ,
underlying-mset ,
happly π-to-π-is-retraction-of-inclusion
\end{code}