Martin Escardo, 2012-
Expanded on demand whenever a general equivalence is needed.
\begin{code}
{-# OPTIONS --safe --without-K #-}
open import MLTT.Plus-Properties
open import MLTT.Spartan
open import MLTT.Two-Properties
open import UF.Base
open import UF.Equiv
open import UF.FunExt
open import UF.Lower-FunExt
open import UF.PropIndexedPiSigma
open import UF.Retracts
open import UF.Subsingletons
open import UF.Subsingletons-FunExt
open import UF.Subsingletons-Properties
module UF.EquivalenceExamples where
curry-uncurry' : funext π€ (π₯ β π¦)
β funext (π€ β π₯) π¦
β {X : π€ Μ } {Y : X β π₯ Μ } {Z : (Ξ£ x κ X , Y x) β π¦ Μ }
β Ξ Z β (Ξ x κ X , Ξ y κ Y x , Z (x , y))
curry-uncurry' {π€} {π₯} {π¦} fe fe' {X} {Y} {Z} = qinveq c (u , uc , cu)
where
c : (w : Ξ Z) β ((x : X) (y : Y x) β Z (x , y))
c f x y = f (x , y)
u : ((x : X) (y : Y x) β Z (x , y)) β Ξ Z
u g (x , y) = g x y
cu : β g β c (u g) οΌ g
cu g = dfunext fe (Ξ» x β dfunext (lower-funext π€ π¦ fe') (Ξ» y β refl))
uc : β f β u (c f) οΌ f
uc f = dfunext fe' (Ξ» w β refl)
curry-uncurry : (fe : FunExt)
β {X : π€ Μ } {Y : X β π₯ Μ } {Z : (Ξ£ x κ X , Y x) β π¦ Μ }
β Ξ Z β (Ξ x κ X , Ξ y κ Y x , Z (x , y))
curry-uncurry {π€} {π₯} {π¦} fe = curry-uncurry' (fe π€ (π₯ β π¦)) (fe (π€ β π₯) π¦)
Ξ£-οΌ-β : {X : π€ Μ } {A : X β π₯ Μ } {Ο Ο : Ξ£ A}
β (Ο οΌ Ο) β (Ξ£ p κ prβ Ο οΌ prβ Ο , transport A p (prβ Ο) οΌ prβ Ο)
Ξ£-οΌ-β {π€} {π₯} {X} {A} {x , a} {y , b} = qinveq from-Ξ£-οΌ (to-Ξ£-οΌ , Ξ΅ , Ξ·)
where
Ξ· : (Ο : Ξ£ p κ x οΌ y , transport A p a οΌ b) β from-Ξ£-οΌ (to-Ξ£-οΌ Ο) οΌ Ο
Ξ· (refl , refl) = refl
Ξ΅ : (q : x , a οΌ y , b) β to-Ξ£-οΌ (from-Ξ£-οΌ q) οΌ q
Ξ΅ refl = refl
Γ-οΌ-β : {X : π€ Μ } {A : π₯ Μ } {Ο Ο : X Γ A}
β (Ο οΌ Ο) β (prβ Ο οΌ prβ Ο) Γ (prβ Ο οΌ prβ Ο)
Γ-οΌ-β {π€} {π₯} {X} {A} {x , a} {y , b} = qinveq from-Γ-οΌ' (to-Γ-οΌ' , (Ξ΅ , Ξ·))
where
Ξ· : (t : (x οΌ y) Γ (a οΌ b)) β from-Γ-οΌ' (to-Γ-οΌ' t) οΌ t
Ξ· (refl , refl) = refl
Ξ΅ : (u : x , a οΌ y , b) β to-Γ-οΌ' (from-Γ-οΌ' u) οΌ u
Ξ΅ refl = refl
Ξ£-assoc : {X : π€ Μ } {Y : X β π₯ Μ } {Z : Ξ£ Y β π¦ Μ }
β Ξ£ Z β (Ξ£ x κ X , Ξ£ y κ Y x , Z (x , y))
Ξ£-assoc {π€} {π₯} {π¦} {X} {Y} {Z} = qinveq c (u , (Ξ» Ο β refl) , (Ξ» Ο β refl))
where
c : Ξ£ Z β Ξ£ x κ X , Ξ£ y κ Y x , Z (x , y)
c ((x , y) , z) = (x , (y , z))
u : (Ξ£ x κ X , Ξ£ y κ Y x , Z (x , y)) β Ξ£ Z
u (x , (y , z)) = ((x , y) , z)
Ξ£-flip : {X : π€ Μ } {Y : π₯ Μ } {A : X β Y β π¦ Μ }
β (Ξ£ x κ X , Ξ£ y κ Y , A x y) β (Ξ£ y κ Y , Ξ£ x κ X , A x y)
Ξ£-flip {π€} {π₯} {π¦} {X} {Y} {A} = qinveq f (g , Ξ΅ , Ξ·)
where
f : (Ξ£ x κ X , Ξ£ y κ Y , A x y) β (Ξ£ y κ Y , Ξ£ x κ X , A x y)
f (x , y , p) = y , x , p
g : (Ξ£ y κ Y , Ξ£ x κ X , A x y) β (Ξ£ x κ X , Ξ£ y κ Y , A x y)
g (y , x , p) = x , y , p
Ξ΅ : β Ο β g (f Ο) οΌ Ο
Ξ΅ (x , y , p) = refl
Ξ· : β Ο β f (g Ο) οΌ Ο
Ξ· (y , x , p) = refl
Ξ£-interchange : {X : π€ Μ } {Y : π₯ Μ } {A : X β π¦ Μ } {B : Y β π£ Μ }
β (Ξ£ x κ X , Ξ£ y κ Y , A x Γ B y)
β ((Ξ£ x κ X , A x) Γ (Ξ£ y κ Y , B y))
Ξ£-interchange {π€} {π₯} {π¦} {π£} {X} {Y} {A} {B} = qinveq f (g , Ξ΅ , Ξ·)
where
f : (Ξ£ x κ X , Ξ£ y κ Y , A x Γ B y)
β ((Ξ£ x κ X , A x) Γ (Ξ£ y κ Y , B y))
f (x , y , a , b) = ((x , a) , (y , b))
g : codomain f β domain f
g ((x , a) , (y , b)) = (x , y , a , b)
Ξ΅ : β Ο β g (f Ο) οΌ Ο
Ξ΅ (x , y , a , b) = refl
Ξ· : β Ο β f (g Ο) οΌ Ο
Ξ· ((x , a) , (y , b)) = refl
Ξ£-cong : {X : π€ Μ } {Y : X β π₯ Μ } {Y' : X β π¦ Μ }
β ((x : X) β Y x β Y' x)
β Ξ£ Y β Ξ£ Y'
Ξ£-cong {π€} {π₯} {π¦} {X} {Y} {Y'} Ο = qinveq f (g , gf , fg)
where
f : Ξ£ Y β Ξ£ Y'
f (x , y) = x , β Ο x β y
g : Ξ£ Y' β Ξ£ Y
g (x , y') = x , β Ο x ββ»ΒΉ y'
fg : (w' : Ξ£ Y') β f (g w') οΌ w'
fg (x , y') = to-Ξ£-οΌ' (inverses-are-sections β Ο x β β Ο x β-is-equiv y')
gf : (w : Ξ£ Y) β g (f w) οΌ w
gf (x , y) = to-Ξ£-οΌ' (inverses-are-retractions β Ο x β β Ο x β-is-equiv y)
Ξ Ξ£-distr-β : {X : π€ Μ } {A : X β π₯ Μ } {P : (x : X) β A x β π¦ Μ }
β (Ξ x κ X , Ξ£ a κ A x , P x a) β (Ξ£ f κ Ξ A , Ξ x κ X , P x (f x))
Ξ Ξ£-distr-β = qinveq Ξ Ξ£-distr (Ξ Ξ£-distrβ»ΒΉ , (Ξ» _ β refl) , (Ξ» _ β refl))
Ξ Γ-distr : {X : π€ Μ } {A : X β π₯ Μ } {B : X β π¦ Μ }
β (Ξ x κ X , A x Γ B x)
β ((Ξ x κ X , A x) Γ (Ξ x κ X , B x))
Ξ Γ-distr = Ξ Ξ£-distr-β
Ξ Γ-distrβ : {X : π€ Μ } {Y : π₯ Μ }
{A : X β Y β π¦ Μ } {B : X β Y β π£ Μ }
β (Ξ x κ X , Ξ y κ Y , A x y Γ B x y)
β ((Ξ x κ X , Ξ y κ Y , A x y) Γ (Ξ x κ X , Ξ y κ Y , B x y))
Ξ Γ-distrβ = qinveq
(Ξ» f β (Ξ» x y β prβ (f x y)) , (Ξ» x y β prβ (f x y)))
((Ξ» (g , h) x y β g x y , h x y) ,
(Ξ» _ β refl) ,
(Ξ» _ β refl))
Ξ£+-distr : (X : π€ Μ ) (A : X β π₯ Μ ) (B : X β π¦ Μ )
β (Ξ£ x κ X , A x + B x)
β ((Ξ£ x κ X , A x) + (Ξ£ x κ X , B x))
Ξ£+-distr X A B = qinveq f (g , Ξ· , Ξ΅)
where
f : (Ξ£ x κ X , A x + B x) β (Ξ£ x κ X , A x) + (Ξ£ x κ X , B x)
f (x , inl a) = inl (x , a)
f (x , inr b) = inr (x , b)
g : ((Ξ£ x κ X , A x) + (Ξ£ x κ X , B x)) β (Ξ£ x κ X , A x + B x)
g (inl (x , a)) = x , inl a
g (inr (x , b)) = x , inr b
Ξ· : g β f βΌ id
Ξ· (x , inl a) = refl
Ξ· (x , inr b) = refl
Ξ΅ : f β g βΌ id
Ξ΅ (inl (x , a)) = refl
Ξ΅ (inr (x , b)) = refl
Ξ£+-split : (X : π€ Μ ) (Y : π₯ Μ ) (A : X + Y β π¦ Μ )
β (Ξ£ x κ X , A (inl x)) + (Ξ£ y κ Y , A (inr y))
β (Ξ£ z κ X + Y , A z)
Ξ£+-split X Y A = qinveq f (g , Ξ· , Ξ΅)
where
f : (Ξ£ x κ X , A (inl x)) + (Ξ£ y κ Y , A (inr y)) β (Ξ£ z κ X + Y , A z)
f (inl (x , a)) = inl x , a
f (inr (y , a)) = inr y , a
g : (Ξ£ z κ X + Y , A z) β (Ξ£ x κ X , A (inl x)) + (Ξ£ y κ Y , A (inr y))
g (inl x , a) = inl (x , a)
g (inr y , a) = inr (y , a)
Ξ· : g β f βΌ id
Ξ· (inl _) = refl
Ξ· (inr _) = refl
Ξ΅ : f β g βΌ id
Ξ΅ (inl _ , _) = refl
Ξ΅ (inr _ , _) = refl
Ξ -flip : {X : π€ Μ } {Y : π₯ Μ } {A : X β Y β π¦ Μ }
β ((x : X) (y : Y) β A x y) β ((y : Y) (x : X) β A x y)
Ξ -flip {_} {_} {_} {X} {Y} {A} = qinveq f (g , H , G)
where
f : ((x : X) (y : Y) β A x y) β ((y : Y) (x : X) β A x y)
f h y x = h x y
g : ((y : Y) (x : X) β A x y) β ((x : X) (y : Y) β A x y)
g h x y = h y x
H : (h : ((x : X) (y : Y) β A x y)) β g (f h) οΌ h
H h = refl
G : (h : ((y : Y) (x : X) β A x y)) β f (g h) οΌ h
G h = refl
Ξ -flip' : {X : π€ Μ } {Y : π₯ Μ } {A : X β Y β π¦ Μ }
β ((y : Y) (x : X) β A x y) β ((x : X) (y : Y) β A x y)
Ξ -flip' = β-sym Ξ -flip
Ξ -cong : funext π€ π₯
β funext π€ π¦
β {X : π€ Μ } {Y : X β π₯ Μ } {Y' : X β π¦ Μ }
β ((x : X) β Y x β Y' x)
β Ξ Y β Ξ Y'
Ξ -cong fe fe' {X} {Y} {Y'} Ο = qinveq f (g , gf , fg)
where
f : ((x : X) β Y x) β ((x : X) β Y' x)
f h x = β Ο x β (h x)
g : ((x : X) β Y' x) β (x : X) β Y x
g k x = β Ο x ββ»ΒΉ (k x)
fg : (k : ((x : X) β Y' x)) β f (g k) οΌ k
fg k = dfunext fe'
(Ξ» x β inverses-are-sections β Ο x β β Ο x β-is-equiv (k x))
gf : (h : ((x : X) β Y x)) β g (f h) οΌ h
gf h = dfunext fe
(Ξ» x β inverses-are-retractions β Ο x β β Ο x β-is-equiv (h x))
\end{code}
An application of Ξ -cong is the following:
\begin{code}
β-funextβ : funext π€ (π₯ β π¦)
β funext π₯ π¦
β {X : π€ Μ } {Y : X β π₯ Μ } {A : (x : X) β Y x β π¦ Μ }
(f g : (x : X) (y : Y x) β A x y)
β (f οΌ g) β (β x y β f x y οΌ g x y)
β-funextβ fe fe' {X} f g =
(f οΌ g) ββ¨ β-funext fe f g β©
(f βΌ g) ββ¨ Ξ -cong fe fe (Ξ» x β β-funext fe' (f x) (g x)) β©
(β x β f x βΌ g x) β
π-lneutral : {Y : π€ Μ } β π {π₯} Γ Y β Y
π-lneutral {π€} {π₯} {Y} = qinveq f (g , Ξ΅ , Ξ·)
where
f : π Γ Y β Y
f (o , y) = y
g : Y β π Γ Y
g y = (β , y)
Ξ· : β x β f (g x) οΌ x
Ξ· y = refl
Ξ΅ : β z β g (f z) οΌ z
Ξ΅ (o , y) = ap (_, y) (π-is-prop β o)
Γ-comm : {X : π€ Μ } {Y : π₯ Μ } β X Γ Y β Y Γ X
Γ-comm {π€} {π₯} {X} {Y} = qinveq f (g , Ξ΅ , Ξ·)
where
f : X Γ Y β Y Γ X
f (x , y) = (y , x)
g : Y Γ X β X Γ Y
g (y , x) = (x , y)
Ξ· : β z β f (g z) οΌ z
Ξ· z = refl
Ξ΅ : β t β g (f t) οΌ t
Ξ΅ t = refl
π-rneutral : {Y : π€ Μ } β Y Γ π {π₯} β Y
π-rneutral {π€} {π₯} {Y} = Y Γ π ββ¨ Γ-comm β©
π Γ Y ββ¨ π-lneutral {π€} {π₯} β©
Y β
+comm : {X : π€ Μ } {Y : π₯ Μ } β X + Y β Y + X
+comm {π€} {π₯} {X} {Y} = qinveq f (g , Ξ· , Ξ΅)
where
f : X + Y β Y + X
f (inl x) = inr x
f (inr y) = inl y
g : Y + X β X + Y
g (inl y) = inr y
g (inr x) = inl x
Ξ΅ : (t : Y + X) β (f β g) t οΌ t
Ξ΅ (inl y) = refl
Ξ΅ (inr x) = refl
Ξ· : (u : X + Y) β (g β f) u οΌ u
Ξ· (inl x) = refl
Ξ· (inr y) = refl
one-π-only : π {π€} β π {π₯}
one-π-only = qinveq π-elim (π-elim , π-induction , π-induction)
one-π-only : {π€ π₯ : Universe} β π {π€} β π {π₯}
one-π-only = qinveq unique-to-π (unique-to-π , (Ξ» β β refl) , (Ξ» β β refl))
π-rneutral : {X : π€ Μ } β X β X + π {π₯}
π-rneutral {π€} {π₯} {X} = qinveq f (g , Ξ· , Ξ΅)
where
f : X β X + π
f = inl
g : X + π β X
g (inl x) = x
g (inr y) = π-elim y
Ξ΅ : (y : X + π) β (f β g) y οΌ y
Ξ΅ (inl x) = refl
Ξ΅ (inr y) = π-elim y
Ξ· : (x : X) β (g β f) x οΌ x
Ξ· x = refl
π-rneutral' : {X : π€ Μ } β X + π {π₯} β X
π-rneutral' = β-sym π-rneutral
π-lneutral : {X : π€ Μ } β π {π₯} + X β X
π-lneutral {π€} {π₯} {X} = (π + X) ββ¨ +comm β©
(X + π) ββ¨ π-rneutral' {π€} {π₯} β©
X β
π-lneutral' : {X : π€ Μ } β X β π {π₯} + X
π-lneutral' = β-sym π-lneutral
π-lneutral'' : π {π€} β π {π₯} + π {π¦}
π-lneutral'' {π€} {π₯} {π¦} =
π {π€} ββ¨ one-π-only β©
π {π¦} ββ¨ π-lneutral' β©
(π {π₯} + π {π¦}) β
+assoc : {X : π€ Μ } {Y : π₯ Μ } {Z : π¦ Μ }
β (X + Y) + Z β X + (Y + Z)
+assoc {π€} {π₯} {π¦} {X} {Y} {Z} = qinveq f (g , Ξ· , Ξ΅)
where
f : (X + Y) + Z β X + (Y + Z)
f (inl (inl x)) = inl x
f (inl (inr y)) = inr (inl y)
f (inr z) = inr (inr z)
g : X + (Y + Z) β (X + Y) + Z
g (inl x) = inl (inl x)
g (inr (inl y)) = inl (inr y)
g (inr (inr z)) = inr z
Ξ΅ : (t : X + (Y + Z)) β (f β g) t οΌ t
Ξ΅ (inl x) = refl
Ξ΅ (inr (inl y)) = refl
Ξ΅ (inr (inr z)) = refl
Ξ· : (u : (X + Y) + Z) β (g β f) u οΌ u
Ξ· (inl (inl x)) = refl
Ξ· (inl (inr x)) = refl
Ξ· (inr x) = refl
+-cong : {X : π€ Μ } {Y : π₯ Μ } {A : π¦ Μ } {B : π£ Μ }
β X β A β Y β B β X + Y β A + B
+-cong f g = qinveq (+functor β f β β g β) (+functor β f ββ»ΒΉ β g ββ»ΒΉ , Ξ΅ , Ξ·)
where
Ξ΅ : +functor β f ββ»ΒΉ β g ββ»ΒΉ β +functor β f β β g β βΌ id
Ξ΅ (inl x) = ap inl (inverses-are-retractions β f β β f β-is-equiv x)
Ξ΅ (inr y) = ap inr (inverses-are-retractions β g β β g β-is-equiv y)
Ξ· : +functor β f β β g β β +functor β f ββ»ΒΉ β g ββ»ΒΉ βΌ id
Ξ· (inl a) = ap inl (inverses-are-sections β f β β f β-is-equiv a)
Ξ· (inr b) = ap inr (inverses-are-sections β g β β g β-is-equiv b)
Γπ : {X : π€ Μ } β π {π₯} β X Γ π {π¦}
Γπ {π€} {π₯} {π¦} {X} = qinveq
unique-from-π
((Ξ» (x , y) β π-elim y) ,
π-induction ,
(Ξ» (x , y) β π-elim y))
πdistr : {X : π€ Μ } {Y : π₯ Μ } β X Γ Y + X β X Γ (Y + π {π¦})
πdistr {π€} {π₯} {π¦} {X} {Y} = qinveq f (g , Ξ· , Ξ΅)
where
f : X Γ Y + X β X Γ (Y + π)
f (inl (x , y)) = x , inl y
f (inr x) = x , inr β
g : X Γ (Y + π) β X Γ Y + X
g (x , inl y) = inl (x , y)
g (x , inr O) = inr x
Ξ΅ : f β g βΌ id
Ξ΅ (x , inl y) = refl
Ξ΅ (x , inr β) = refl
Ξ· : g β f βΌ id
Ξ· (inl (x , y)) = refl
Ξ· (inr x) = refl
Ap+ : {X : π€ Μ } {Y : π₯ Μ } (Z : π¦ Μ ) β X β Y β X + Z β Y + Z
Ap+ {π€} {π₯} {π¦} {X} {Y} Z f =
qinveq (+functor β f β id) (+functor β f ββ»ΒΉ id , Ξ· , Ξ΅)
where
Ξ· : +functor β f ββ»ΒΉ id β +functor β f β id βΌ id
Ξ· (inl x) = ap inl (inverses-are-retractions β f β β f β-is-equiv x)
Ξ· (inr z) = ap inr refl
Ξ΅ : +functor β f β id β +functor β f ββ»ΒΉ id βΌ id
Ξ΅ (inl x) = ap inl (inverses-are-sections β f β β f β-is-equiv x)
Ξ΅ (inr z) = ap inr refl
Γcomm : {X : π€ Μ } {Y : π₯ Μ } β X Γ Y β Y Γ X
Γcomm {π€} {π₯} {X} {Y} = qinveq
(Ξ» (x , y) β (y , x))
((Ξ» (y , x) β (x , y)) ,
(Ξ» _ β refl) ,
(Ξ» _ β refl))
Γ-cong : {X : π€ Μ } {Y : π₯ Μ } {A : π¦ Μ } {B : π£ Μ }
β X β A β Y β B β X Γ Y β A Γ B
Γ-cong f g = qinveq (Γfunctor β f β β g β) (Γfunctor β f ββ»ΒΉ β g ββ»ΒΉ , Ξ΅ , Ξ·)
where
Ξ΅ : Γfunctor β f ββ»ΒΉ β g ββ»ΒΉ β Γfunctor β f β β g β βΌ id
Ξ΅ (x , y) = to-Γ-οΌ
(inverses-are-retractions β f β β f β-is-equiv x)
(inverses-are-retractions β g β β g β-is-equiv y)
Ξ· : Γfunctor β f β β g β β Γfunctor β f ββ»ΒΉ β g ββ»ΒΉ βΌ id
Ξ· (a , b) = to-Γ-οΌ
(inverses-are-sections β f β β f β-is-equiv a)
(inverses-are-sections β g β β g β-is-equiv b)
πβ : {X : π€ Μ }
β funext π¦ π€
β π {π₯} β (π {π¦} β X)
πβ {π€} {π₯} {π¦} {X} fe = qinveq f (g , Ξ· , Ξ΅)
where
f : π β (π β X)
f β y = π-elim y
g : (π β X) β π
g h = β
Ξ΅ : f β g βΌ id
Ξ΅ h = dfunext fe (Ξ» z β π-elim z)
Ξ· : g β f βΌ id
Ξ· β = refl
πβ : {X : π€ Μ }
β funext π₯ π€
β X β (π {π₯} β X)
πβ {π€} {π₯} {X} fe = qinveq f (g , Ξ· , Ξ΅)
where
f : X β π β X
f x β = x
g : (π β X) β X
g h = h β
Ξ΅ : (h : π β X) β f (g h) οΌ h
Ξ΅ h = dfunext fe Ξ³
where
Ξ³ : (t : π) β f (g h) t οΌ h t
Ξ³ β = refl
Ξ· : (x : X) β g (f x) οΌ x
Ξ· x = refl
βπ : {X : π€ Μ } β funext π€ π₯
β (X β π {π₯}) β π {π₯}
βπ {π€} {π₯} {X} fe = qinveq f (g , Ξ΅ , Ξ·)
where
f : (X β π) β π
f = unique-to-π
g : (t : π) β X β π
g t = unique-to-π
Ξ΅ : (Ξ± : X β π) β g β οΌ Ξ±
Ξ΅ Ξ± = dfunext fe Ξ» (x : X) β π-is-prop (g β x) (Ξ± x)
Ξ· : (t : π) β β οΌ t
Ξ· = π-is-prop β
Ξ Γ+ : {X : π€ Μ } {Y : π₯ Μ } {A : X + Y β π¦ Μ } β funext (π€ β π₯) π¦
β (Ξ x κ X , A (inl x)) Γ (Ξ y κ Y , A (inr y))
β (Ξ z κ X + Y , A z)
Ξ Γ+ {π€} {π₯} {π¦} {X} {Y} {A} fe = qinveq f (g , Ξ΅ , Ξ·)
where
f : (Ξ x κ X , A (inl x)) Γ (Ξ y κ Y , A (inr y)) β (Ξ z κ X + Y , A z)
f (l , r) (inl x) = l x
f (l , r) (inr y) = r y
g : (Ξ z κ X + Y , A z) β (Ξ x κ X , A (inl x)) Γ (Ξ y κ Y , A (inr y))
g h = h β inl , h β inr
Ξ· : f β g βΌ id
Ξ· h = dfunext fe Ξ³
where
Ξ³ : (z : X + Y) β (f β g) h z οΌ h z
Ξ³ (inl x) = refl
Ξ³ (inr y) = refl
Ξ΅ : g β f βΌ id
Ξ΅ (l , r) = refl
+β : {X : π€ Μ } {Y : π₯ Μ } {Z : π¦ Μ }
β funext (π€ β π₯) π¦
β (X + Y β Z) β (X β Z) Γ (Y β Z)
+β fe = β-sym (Ξ Γ+ fe)
βΓ : {A : π€ Μ } {X : A β π₯ Μ } {Y : A β π¦ Μ }
β ((a : A) β X a Γ Y a) β Ξ X Γ Ξ Y
βΓ {π€} {π₯} {π¦} {A} {X} {Y} = qinveq f (g , Ξ΅ , Ξ·)
where
f : ((a : A) β X a Γ Y a) β Ξ X Γ Ξ Y
f Ο = (Ξ» a β prβ (Ο a)) , (Ξ» a β prβ (Ο a))
g : Ξ X Γ Ξ Y β (a : A) β X a Γ Y a
g (Ξ³ , Ξ΄) a = Ξ³ a , Ξ΄ a
Ξ΅ : (Ο : (a : A) β X a Γ Y a) β g (f Ο) οΌ Ο
Ξ΅ Ο = refl
Ξ· : (Ξ± : Ξ X Γ Ξ Y) β f (g Ξ±) οΌ Ξ±
Ξ· (Ξ³ , Ξ΄) = refl
βcong : {X : π€ Μ } {Y : π₯ Μ } {A : π¦ Μ } {B : π£ Μ }
β funext π¦ π£
β funext π€ π₯
β X β A β Y β B β (X β Y) β (A β B)
βcong {π€} {π₯} {π¦} {π£} {X} {Y} {A} {B} fe fe' f g =
qinveq Ο (Ξ³ , ((Ξ» h β dfunext fe' (Ξ· h)) , (Ξ» k β dfunext fe (Ξ΅ k))))
where
Ο : (X β Y) β (A β B)
Ο h = β g β β h β β f ββ»ΒΉ
Ξ³ : (A β B) β (X β Y)
Ξ³ k = β g ββ»ΒΉ β k β β f β
Ξ΅ : (k : A β B) β Ο (Ξ³ k) βΌ k
Ξ΅ k a = β g β (β g ββ»ΒΉ (k (β f β (β f ββ»ΒΉ a)))) οΌβ¨ I β©
k (β f β (β f ββ»ΒΉ a)) οΌβ¨ II β©
k a β
where
I = inverses-are-sections β g β β g β-is-equiv _
II = ap k (inverses-are-sections β f β β f β-is-equiv a)
Ξ· : (h : X β Y) β Ξ³ (Ο h) βΌ h
Ξ· h x = β g ββ»ΒΉ (β g β (h (β f ββ»ΒΉ (β f β x)))) οΌβ¨ I β©
h (β f ββ»ΒΉ (β f β x)) οΌβ¨ II β©
h x β
where
I = inverses-are-retractions β g β β g β-is-equiv _
II = ap h (inverses-are-retractions β f β β f β-is-equiv x)
βcong' : {X : π€ Μ } {Y : π₯ Μ } {B : π£ Μ }
β funext π€ π£
β funext π€ π₯
β Y β B β (X β Y) β (X β B)
βcong' fe fe' = βcong fe fe' (β-refl _)
βcong'' : {X : π€ Μ } {Y : π₯ Μ } {A : π¦ Μ }
β funext π¦ π₯
β funext π€ π₯
β X β A β (X β Y) β (A β Y)
βcong'' fe fe' e = βcong fe fe' e (β-refl _)
prβ-β : (X : π€ Μ ) (A : X β π₯ Μ )
β ((x : X) β is-singleton (A x))
β (Ξ£ x κ X , A x) β X
prβ-β X A f = prβ , prβ-is-equiv X A f
NatΞ£-fiber-equiv : {X : π€ Μ } (A : X β π₯ Μ ) (B : X β π¦ Μ ) (ΞΆ : Nat A B)
β (x : X) (b : B x) β fiber (ΞΆ x) b β fiber (NatΞ£ ΞΆ) (x , b)
NatΞ£-fiber-equiv A B ΞΆ x b = qinveq (f b) (g b , Ξ΅ b , Ξ· b)
where
f : (b : B x) β fiber (ΞΆ x) b β fiber (NatΞ£ ΞΆ) (x , b)
f _ (a , refl) = (x , a) , refl
g : (b : B x) β fiber (NatΞ£ ΞΆ) (x , b) β fiber (ΞΆ x) b
g _ ((x , a) , refl) = a , refl
Ξ΅ : (b : B x) (w : fiber (ΞΆ x) b) β g b (f b w) οΌ w
Ξ΅ _ (a , refl) = refl
Ξ· : (b : B x) (t : fiber (NatΞ£ ΞΆ) (x , b)) β f b (g b t) οΌ t
Ξ· b (a , refl) = refl
NatΞ£-vv-equiv : {X : π€ Μ } (A : X β π₯ Μ ) (B : X β π¦ Μ ) (ΞΆ : Nat A B)
β ((x : X) β is-vv-equiv (ΞΆ x))
β is-vv-equiv (NatΞ£ ΞΆ)
NatΞ£-vv-equiv A B ΞΆ i (x , b) = equiv-to-singleton
(β-sym (NatΞ£-fiber-equiv A B ΞΆ x b))
(i x b)
NatΞ£-vv-equiv-converse : {X : π€ Μ } (A : X β π₯ Μ ) (B : X β π¦ Μ ) (ΞΆ : Nat A B)
β is-vv-equiv (NatΞ£ ΞΆ)
β ((x : X) β is-vv-equiv (ΞΆ x))
NatΞ£-vv-equiv-converse A B ΞΆ e x b = equiv-to-singleton
(NatΞ£-fiber-equiv A B ΞΆ x b)
(e (x , b))
NatΞ£-is-equiv : {X : π€ Μ } (A : X β π₯ Μ ) (B : X β π¦ Μ ) (ΞΆ : Nat A B)
β ((x : X) β is-equiv (ΞΆ x))
β is-equiv (NatΞ£ ΞΆ)
NatΞ£-is-equiv A B ΞΆ i = vv-equivs-are-equivs
(NatΞ£ ΞΆ)
(NatΞ£-vv-equiv A B ΞΆ
(Ξ» x β equivs-are-vv-equivs (ΞΆ x) (i x)))
NatΞ£-equiv-converse : {X : π€ Μ } (A : X β π₯ Μ ) (B : X β π¦ Μ ) (ΞΆ : Nat A B)
β is-equiv (NatΞ£ ΞΆ)
β ((x : X) β is-equiv (ΞΆ x))
NatΞ£-equiv-converse A B ΞΆ e x = vv-equivs-are-equivs (ΞΆ x)
(NatΞ£-vv-equiv-converse A B ΞΆ
(equivs-are-vv-equivs (NatΞ£ ΞΆ) e) x)
NatΞ£-equiv-gives-fiberwise-equiv : {X : π€ Μ } {A : X β π₯ Μ } {B : X β π¦ Μ }
(Ο : Nat A B)
β is-equiv (NatΞ£ Ο)
β is-fiberwise-equiv Ο
NatΞ£-equiv-gives-fiberwise-equiv = NatΞ£-equiv-converse _ _
Ξ£-cong' : {X : π€ Μ } (A : X β π₯ Μ ) (B : X β π¦ Μ )
β ((x : X) β A x β B x) β Ξ£ A β Ξ£ B
Ξ£-cong' A B f = NatΞ£ (Ξ» x β β f x β) ,
NatΞ£-is-equiv A B (Ξ» x β β f x β) (Ξ» x β β f x β-is-equiv)
Ξ£-change-of-variable' : {X : π€ Μ } {Y : π₯ Μ } (A : X β π¦ Μ ) (g : Y β X)
β is-hae g
β Ξ£ Ξ³ κ ((Ξ£ y κ Y , A (g y)) β Ξ£ A) , qinv Ξ³
Ξ£-change-of-variable' {π€} {π₯} {π¦} {X} {Y} A g (f , Ξ· , Ξ΅ , Ξ±) = Ξ³ , Ο , ΟΞ³ , Ξ³Ο
where
Ξ³ : (Ξ£ y κ Y , A (g y)) β Ξ£ A
Ξ³ (y , a) = (g y , a)
Ο : Ξ£ A β Ξ£ y κ Y , A (g y)
Ο (x , a) = (f x , transportβ»ΒΉ A (Ξ΅ x) a)
Ξ³Ο : (Ο : Ξ£ A) β Ξ³ (Ο Ο) οΌ Ο
Ξ³Ο (x , a) = to-Ξ£-οΌ (Ξ΅ x , p)
where
p : transport A (Ξ΅ x) (transportβ»ΒΉ A (Ξ΅ x) a) οΌ a
p = back-and-forth-transport (Ξ΅ x)
ΟΞ³ : (Ο : (Ξ£ y κ Y , A (g y))) β Ο (Ξ³ Ο) οΌ Ο
ΟΞ³ (y , a) = to-Ξ£-οΌ (Ξ· y , q)
where
q = transport (Ξ» - β A (g -)) (Ξ· y) (transportβ»ΒΉ A (Ξ΅ (g y)) a) οΌβ¨ i β©
transport A (ap g (Ξ· y)) (transportβ»ΒΉ A (Ξ΅ (g y)) a) οΌβ¨ ii β©
transport A (Ξ΅ (g y)) (transportβ»ΒΉ A (Ξ΅ (g y)) a) οΌβ¨ iii β©
a β
where
i = transport-ap A g (Ξ· y)
ii = ap (Ξ» - β transport A - (transportβ»ΒΉ A (Ξ΅ (g y)) a)) (Ξ± y)
iii = back-and-forth-transport (Ξ΅ (g y))
Ξ£-change-of-variable : {X : π€ Μ } {Y : π₯ Μ } (A : X β π¦ Μ ) (g : Y β X)
β is-equiv g
β (Ξ£ y κ Y , A (g y)) β (Ξ£ x κ X , A x)
Ξ£-change-of-variable {π€} {π₯} {π¦} {X} {Y} A g e = Ξ³ , qinvs-are-equivs Ξ³ q
where
Ξ³ : (Ξ£ y κ Y , A (g y)) β Ξ£ A
Ξ³ = prβ (Ξ£-change-of-variable' A g (equivs-are-haes g e))
q : qinv Ξ³
q = prβ (Ξ£-change-of-variable' A g (equivs-are-haes g e))
Ξ£-change-of-variable-β : {X : π€ Μ } {Y : π₯ Μ } (A : X β π¦ Μ ) (e : Y β X)
β (Ξ£ y κ Y , A (β e β y)) β (Ξ£ x κ X , A x)
Ξ£-change-of-variable-β A (g , i) = Ξ£-change-of-variable A g i
Ξ£-bicong : {X : π€ Μ } (Y : X β π₯ Μ )
{X' : π€' Μ } (Y' : X' β π₯' Μ )
(π : X β X')
β ((x : X) β Y x β Y' (β π β x))
β Ξ£ Y β Ξ£ Y'
Ξ£-bicong {π€} {π₯} {π€'} {π₯'} {X} Y {X'} Y' π Ο =
Ξ£ Y ββ¨ Ξ£-cong Ο β©
(Ξ£ x κ X , Y' (β π β x)) ββ¨ Ξ£-change-of-variable-β Y' π β©
Ξ£ Y' β
dprecomp : {X : π€ Μ } {Y : π₯ Μ } (A : Y β π¦ Μ ) (f : X β Y)
β Ξ A β Ξ (A β f)
dprecomp A f = _β f
dprecomp-is-equiv : funext π€ π¦
β funext π₯ π¦
β {X : π€ Μ } {Y : π₯ Μ } (A : Y β π¦ Μ ) (f : X β Y)
β is-equiv f
β is-equiv (dprecomp A f)
dprecomp-is-equiv fe fe' {X} {Y} A f i = qinvs-are-equivs Ο ((Ο , ΟΟ , ΟΟ))
where
g = inverse f i
Ξ· = inverses-are-retractions f i
Ξ΅ = inverses-are-sections f i
Ο : (x : X) β ap f (Ξ· x) οΌ Ξ΅ (f x)
Ο = half-adjoint-condition f i
Ο : Ξ A β Ξ (A β f)
Ο = dprecomp A f
Ο : Ξ (A β f) β Ξ A
Ο k y = transport A (Ξ΅ y) (k (g y))
ΟΟβ : (k : Ξ (A β f)) (x : X) β transport A (Ξ΅ (f x)) (k (g (f x))) οΌ k x
ΟΟβ k x = transport A (Ξ΅ (f x)) (k (g (f x))) οΌβ¨ a β©
transport A (ap f (Ξ· x))(k (g (f x))) οΌβ¨ b β©
transport (A β f) (Ξ· x) (k (g (f x))) οΌβ¨ c β©
k x β
where
a = ap (Ξ» - β transport A - (k (g (f x)))) ((Ο x)β»ΒΉ)
b = (transport-ap A f (Ξ· x)) β»ΒΉ
c = apd k (Ξ· x)
ΟΟ : Ο β Ο βΌ id
ΟΟ k = dfunext fe (ΟΟβ k)
ΟΟβ : (h : Ξ A) (y : Y) β transport A (Ξ΅ y) (h (f (g y))) οΌ h y
ΟΟβ h y = apd h (Ξ΅ y)
ΟΟ : Ο β Ο βΌ id
ΟΟ h = dfunext fe' (ΟΟβ h)
Ξ -change-of-variable : funext π€ π¦
β funext π₯ π¦
β {X : π€ Μ } {Y : π₯ Μ } (A : Y β π¦ Μ ) (f : X β Y)
β is-equiv f
β (Ξ y κ Y , A y) β (Ξ x κ X , A (f x))
Ξ -change-of-variable fe fe' A f i = dprecomp A f , dprecomp-is-equiv fe fe' A f i
Ξ -change-of-variable-β : FunExt
β {X : π€ Μ } {Y : π₯ Μ } (A : Y β π¦ Μ ) (π : X β Y)
β (Ξ x κ X , A (β π β x)) β (Ξ y κ Y , A y)
Ξ -change-of-variable-β fe A (f , i) =
β-sym (Ξ -change-of-variable (fe _ _) (fe _ _) A f i)
Ξ -bicong : FunExt
β {X : π€ Μ } (Y : X β π₯ Μ )
{X' : π€' Μ } (Y' : X' β π₯' Μ )
(π : X β X')
β ((x : X) β Y x β Y' (β π β x))
β Ξ Y β Ξ Y'
Ξ -bicong {π€} {π₯} {π€'} {π₯'} fe {X} Y {X'} Y' π Ο =
Ξ Y ββ¨ Ξ -cong (fe π€ π₯) (fe π€ π₯') Ο β©
(Ξ x κ X , Y' (β π β x)) ββ¨ Ξ -change-of-variable-β fe Y' π β©
Ξ Y' β
NatΞ -fiber-equiv : {X : π€ Μ } (A : X β π₯ Μ ) (B : X β π¦ Μ ) (ΞΆ : Nat A B)
β funext π€ π¦
β (g : Ξ B)
β (Ξ x κ X , fiber (ΞΆ x) (g x)) β fiber (NatΞ ΞΆ) g
NatΞ -fiber-equiv {π€} {π₯} {π¦} {X} A B ΞΆ fe g =
(Ξ x κ X , fiber (ΞΆ x) (g x)) ββ¨ i β©
(Ξ x κ X , Ξ£ a κ A x , ΞΆ x a οΌ g x) ββ¨ ii β©
(Ξ£ f κ Ξ A , Ξ x κ X , ΞΆ x (f x) οΌ g x) ββ¨ iii β©
(Ξ£ f κ Ξ A , (Ξ» x β ΞΆ x (f x)) οΌ g) ββ¨ iv β©
fiber (NatΞ ΞΆ) g β
where
i = β-refl _
ii = Ξ Ξ£-distr-β
iii = Ξ£-cong (Ξ» f β β-sym (β-funext fe (Ξ» x β ΞΆ x (f x)) g))
iv = β-refl _
NatΞ -vv-equiv : {X : π€ Μ } (A : X β π₯ Μ ) (B : X β π¦ Μ ) (ΞΆ : Nat A B)
β funext π€ (π₯ β π¦)
β ((x : X) β is-vv-equiv (ΞΆ x))
β is-vv-equiv (NatΞ ΞΆ)
NatΞ -vv-equiv {π€} {π₯} {π¦} A B ΞΆ fe i g = equiv-to-singleton
(β-sym (NatΞ -fiber-equiv A B ΞΆ
(lower-funext π€ π₯ fe) g))
(Ξ -is-singleton fe (Ξ» x β i x (g x)))
NatΞ -equiv : {X : π€ Μ } (A : X β π₯ Μ ) (B : X β π¦ Μ ) (ΞΆ : Nat A B)
β funext π€ (π₯ β π¦)
β ((x : X) β is-equiv (ΞΆ x))
β is-equiv (NatΞ ΞΆ)
NatΞ -equiv A B ΞΆ fe i = vv-equivs-are-equivs
(NatΞ ΞΆ)
(NatΞ -vv-equiv A B ΞΆ fe
(Ξ» x β equivs-are-vv-equivs (ΞΆ x) (i x)))
Ξ -cong' : {X : π€ Μ }
β funext π€ (π₯ β π¦)
β {A : X β π₯ Μ } {B : X β π¦ Μ }
β ((x : X) β A x β B x)
β Ξ A β Ξ B
Ξ -cong' fe {A} {B} e = NatΞ (Ξ» x β prβ (e x)) ,
NatΞ -equiv A B (Ξ» x β prβ (e x)) fe (Ξ» x β prβ (e x))
οΌ-cong : {X : π€ Μ } (x y : X) {x' y' : X}
β x οΌ x'
β y οΌ y'
β (x οΌ y) β (x' οΌ y')
οΌ-cong x y refl refl = β-refl (x οΌ y)
οΌ-cong-l : {X : π€ Μ } (x y : X) {x' : X}
β x οΌ x'
β (x οΌ y) β (x' οΌ y)
οΌ-cong-l x y refl = β-refl (x οΌ y)
οΌ-cong-r : {X : π€ Μ } (x y : X) {y' : X}
β y οΌ y'
β (x οΌ y) β (x οΌ y')
οΌ-cong-r x y refl = β-refl (x οΌ y)
οΌ-flip : {X : π€ Μ } {x y : X}
β (x οΌ y) β (y οΌ x)
οΌ-flip = _β»ΒΉ , (_β»ΒΉ , β»ΒΉ-involutive) , (_β»ΒΉ , β»ΒΉ-involutive)
singleton-β : {X : π€ Μ } {Y : π₯ Μ }
β is-singleton X
β is-singleton Y
β X β Y
singleton-β i j = (Ξ» _ β center j) , maps-of-singletons-are-equivs _ i j
singleton-β-π : {X : π€ Μ } β is-singleton X β X β π {π₯}
singleton-β-π i = singleton-β i π-is-singleton
singleton-β-π' : {X : π€ Μ } β is-singleton X β π {π₯} β X
singleton-β-π' = singleton-β π-is-singleton
π-οΌ-β : (P : π€ Μ )
β funext π€ π€
β propext π€
β is-prop P
β (π οΌ P) β P
π-οΌ-β P fe pe i = qinveq (Ξ» q β Idtofun q β) (f , Ξ΅ , Ξ·)
where
f : P β π οΌ P
f p = pe π-is-prop i (Ξ» _ β p) unique-to-π
Ξ· : (p : P) β Idtofun (f p) β οΌ p
Ξ· p = i (Idtofun (f p) β) p
Ξ΅ : (q : π οΌ P) β f (Idtofun q β) οΌ q
Ξ΅ q = identifications-with-props-are-props pe fe P i π (f (Idtofun q β)) q
empty-β-π : {X : π€ Μ } β (X β π {π₯}) β X β π {π¦}
empty-β-π i = qinveq
(π-elim β i)
(π-elim ,
(Ξ» x β π-elim (i x)) ,
(Ξ» x β π-elim x))
complement-is-equiv : is-equiv complement
complement-is-equiv = qinvs-are-equivs
complement
(complement ,
complement-involutive ,
complement-involutive)
complement-β : π β π
complement-β = (complement , complement-is-equiv)
π-β-π+π : π β π{π€} + π{π€}
π-β-π+π = f , qinvs-are-equivs f (g , gf , fg)
where
f : π β π + π
f = π-cases (inl β) (inr β)
g : π + π β π
g = cases (Ξ» x β β) (Ξ» x β β)
fg : (x : π + π) β f (g x) οΌ x
fg (inl β) = refl
fg (inr β) = refl
gf : (x : π) β g (f x) οΌ x
gf β = refl
gf β = refl
alternative-Γ : funext π€β π€
β {A : π β π€ Μ }
β (Ξ n κ π , A n) β (A β Γ A β)
alternative-Γ fe {A} = qinveq Ο (Ο , Ξ· , Ξ΅)
where
Ο : (Ξ n κ π , A n) β A β Γ A β
Ο f = (f β , f β)
Ο : A β Γ A β β Ξ n κ π , A n
Ο (aβ , aβ) β = aβ
Ο (aβ , aβ) β = aβ
Ξ· : Ο β Ο βΌ id
Ξ· f = dfunext fe (Ξ» {β β refl ; β β refl})
Ξ΅ : Ο β Ο βΌ id
Ξ΅ (aβ , aβ) = refl
alternative-+ : {A : π β π€ Μ }
β (Ξ£ n κ π , A n) β (A β + A β)
alternative-+ {π€} {A} = qinveq Ο (Ο , Ξ· , Ξ΅)
where
Ο : (Ξ£ n κ π , A n) β A β + A β
Ο (β , a) = inl a
Ο (β , a) = inr a
Ο : A β + A β β Ξ£ n κ π , A n
Ο (inl a) = β , a
Ο (inr a) = β , a
Ξ· : Ο β Ο βΌ id
Ξ· (β , a) = refl
Ξ· (β , a) = refl
Ξ΅ : Ο β Ο βΌ id
Ξ΅ (inl a) = refl
Ξ΅ (inr a) = refl
domain-is-total-fiber : {X : π€ Μ } {Y : π₯ Μ } (f : X β Y) β X β Ξ£ (fiber f)
domain-is-total-fiber {π€} {π₯} {X} {Y} f =
X ββ¨ β-sym (π-rneutral {π€} {π€}) β©
X Γ π ββ¨ I β©
(Ξ£ x κ X , Ξ£ y κ Y , f x οΌ y) ββ¨ Ξ£-flip β©
(Ξ£ y κ Y , Ξ£ x κ X , f x οΌ y) β
where
I = Ξ£-cong
(Ξ» x β singleton-β π-is-singleton
(singleton-types-are-singletons (f x)))
total-fiber-is-domain : {X : π€ Μ } {Y : π₯ Μ } (f : X β Y)
β (Ξ£ y κ Y , Ξ£ x κ X , f x οΌ y) β X
total-fiber-is-domain {π€} {π₯} {X} {Y} f = β-sym (domain-is-total-fiber f)
left-Id-equiv : {X : π€ Μ } {Y : X β π₯ Μ } (x : X)
β (Ξ£ x' κ X , (x' οΌ x) Γ Y x') β Y x
left-Id-equiv {π€} {π₯} {X} {Y} x =
(Ξ£ x' κ X , (x' οΌ x) Γ Y x') ββ¨ β-sym Ξ£-assoc β©
(Ξ£ (x' , _) κ singleton-type' x , Y x') ββ¨ a β©
Y x β
where
a = prop-indexed-sum (singleton'-center x) (singleton-types'-are-props x)
right-Id-equiv : {X : π€ Μ } {Y : X β π₯ Μ } (x : X)
β (Ξ£ x' κ X , Y x' Γ (x' οΌ x)) β Y x
right-Id-equiv {π€} {π₯} {X} {Y} x =
(Ξ£ x' κ X , Y x' Γ (x' οΌ x)) ββ¨ Ξ£-cong (Ξ» x' β Γ-comm) β©
(Ξ£ x' κ X , (x' οΌ x) Γ Y x') ββ¨ left-Id-equiv x β©
Y x β
prβ-fiber-equiv : {X : π€ Μ } {Y : X β π₯ Μ } (x : X)
β fiber (prβ {π€} {π₯} {X} {Y}) x β Y x
prβ-fiber-equiv {π€} {π₯} {X} {Y} x =
fiber prβ x ββ¨ Ξ£-assoc β©
(Ξ£ x' κ X , Y x' Γ (x' οΌ x)) ββ¨ right-Id-equiv x β©
Y x β
\end{code}
Tom de Jong, September 2019 (two lemmas used in UF.Classifiers-Old)
A nice application of Ξ£-change-of-variable is that the fiber of a map doesn't
change (up to equivalence, at least) when precomposing with an equivalence.
These two lemmas are used in UF.Classifiers-Old, but are sufficiently general to
warrant their place here.
\begin{code}
precomposition-with-equiv-does-not-change-fibers
: {X : π€ Μ } {Y : π₯ Μ } {Z : π¦ Μ }
(e : Z β X) (f : X β Y) (y : Y)
β fiber (f β β e β) y β fiber f y
precomposition-with-equiv-does-not-change-fibers (g , i) f y =
Ξ£-change-of-variable (Ξ» - β f - οΌ y) g i
retract-pointed-fibers : {X : π€ Μ } {Y : π₯ Μ } {r : Y β X}
β has-section r β (Ξ x κ X , fiber r x)
retract-pointed-fibers {π€} {π₯} {X} {Y} {r} = qinveq f (g , (p , q))
where
f : (Ξ£ s κ (X β Y) , r β s βΌ id) β Ξ (fiber r)
f (s , rs) x = (s x) , (rs x)
g : ((x : X) β fiber r x) β Ξ£ s κ (X β Y) , r β s βΌ id
g Ξ± = (Ξ» (x : X) β prβ (Ξ± x)) , (Ξ» (x : X) β prβ (Ξ± x))
p : (srs : Ξ£ s κ (X β Y) , r β s βΌ id) β g (f srs) οΌ srs
p (s , rs) = refl
q : (Ξ± : Ξ x κ X , fiber r x) β f (g Ξ±) οΌ Ξ±
q Ξ± = refl
\end{code}
Added 10 February 2020 by Tom de Jong.
\begin{code}
fiber-of-composite : {X : π€ Μ } {Y : π₯ Μ } {Z : π¦ Μ } (f : X β Y) (g : Y β Z)
β (z : Z)
β fiber (g β f) z
β (Ξ£ (y , _) κ fiber g z , fiber f y)
fiber-of-composite {π€} {π₯} {π¦} {X} {Y} {Z} f g z =
qinveq Ο (Ο , (ΟΟ , ΟΟ))
where
Ο : fiber (g β f) z
β (Ξ£ w κ (fiber g z) , fiber f (fiber-point w))
Ο (x , p) = ((f x) , p) , (x , refl)
Ο : (Ξ£ w κ (fiber g z) , fiber f (fiber-point w))
β fiber (g β f) z
Ο ((y , q) , (x , p)) = x , ((ap g p) β q)
ΟΟ : (w : fiber (g β f) z) β Ο (Ο w) οΌ w
ΟΟ (x , refl) = refl
ΟΟ : (w : Ξ£ w κ (fiber g z) , fiber f (fiber-point w))
β Ο (Ο w) οΌ w
ΟΟ ((.(f x) , refl) , (x , refl)) = refl
fiber-of-unique-to-π : {π₯ : Universe} {X : π€ Μ }
β (u : π)
β fiber (unique-to-π {_} {π₯} {X}) u β X
fiber-of-unique-to-π {π€} {π₯} {X} β =
(Ξ£ x κ X , unique-to-π x οΌ β) ββ¨ Ξ£-cong Ο β©
X Γ π{π₯} ββ¨ π-rneutral β©
X β
where
Ο : (x : X) β (β οΌ β) β π
Ο x = singleton-β-π
(pointed-props-are-singletons refl (props-are-sets π-is-prop))
βΌ-fiber-identifications-β : {X : π€ Μ } {Y : π₯ Μ } {f : X β Y} {g : X β Y}
β f βΌ g
β (y : Y) (x : X)
β (f x οΌ y) β (g x οΌ y)
βΌ-fiber-identifications-β {π€} {π₯} {X} {Y} {f} {g} H y x = qinveq Ξ± (Ξ² , (Ξ²Ξ± , Ξ±Ξ²))
where
Ξ± : f x οΌ y β g x οΌ y
Ξ± p = (H x) β»ΒΉ β p
Ξ² : g x οΌ y β f x οΌ y
Ξ² q = (H x) β q
Ξ²Ξ± : (p : f x οΌ y) β Ξ² (Ξ± p) οΌ p
Ξ²Ξ± p = Ξ² (Ξ± p) οΌβ¨reflβ©
(H x) β ((H x) β»ΒΉ β p) οΌβ¨ (βassoc (H x) ((H x) β»ΒΉ) p) β»ΒΉ β©
(H x) β (H x) β»ΒΉ β p οΌβ¨ ap (Ξ» - β - β p) ((right-inverse (H x)) β»ΒΉ) β©
refl β p οΌβ¨ refl-left-neutral β©
p β
Ξ±Ξ² : (q : g x οΌ y) β Ξ± (Ξ² q) οΌ q
Ξ±Ξ² q = Ξ± (Ξ² q) οΌβ¨reflβ©
(H x) β»ΒΉ β ((H x) β q) οΌβ¨ (βassoc ((H x) β»ΒΉ) (H x) q) β»ΒΉ β©
(H x) β»ΒΉ β (H x) β q οΌβ¨ ap (Ξ» - β - β q) (left-inverse (H x)) β©
refl β q οΌβ¨ refl-left-neutral β©
q β
βΌ-fiber-β : {X : π€ Μ } {Y : π₯ Μ } {f : X β Y} {g : X β Y}
β f βΌ g
β (y : Y) β fiber f y β fiber g y
βΌ-fiber-β H y = Ξ£-cong (βΌ-fiber-identifications-β H y)
\end{code}
Added 9 July 2024 by Tom de Jong.
\begin{code}
fiber-of-ap-β' : {A : π€ Μ } {B : π₯ Μ } (f : A β B)
{x y : A} (p : f x οΌ f y)
β fiber (ap f) p β ((x , refl) οΌ[ fiber' f (f x) ] (y , p))
fiber-of-ap-β' f {x} {y} p =
fiber (ap f) p ββ¨by-definitionβ©
(Ξ£ e κ x οΌ y , transport (Ξ» - β (f x οΌ f -)) e refl οΌ p) ββ¨ β-sym Ξ£-οΌ-β β©
((x , refl) οΌ (y , p)) β
fiber-of-ap-β : {A : π€ Μ } {B : π₯ Μ } (f : A β B)
{x y : A} (p : f x οΌ f y)
β fiber (ap f) p β ((x , p) οΌ[ fiber f (f y) ] (y , refl))
fiber-of-ap-β f {x} {y} p =
fiber (ap f) p ββ¨ Ξ£-cong I β©
(Ξ£ e κ x οΌ y , transport (Ξ» - β f - οΌ f y) e p οΌ refl) ββ¨ β-sym Ξ£-οΌ-β β©
((x , p) οΌ (y , refl)) β
where
I : (e : x οΌ y)
β (ap f e οΌ p) β (transport (Ξ» - β f - οΌ f y) e p οΌ refl)
I refl = (refl οΌ p) ββ¨ οΌ-flip β©
(p οΌ refl) ββ¨by-definitionβ©
(transport (Ξ» - β f - οΌ f x) refl p οΌ refl) β
β-is-equiv-left : {X : π€ Μ } {x y z : X} (p : z οΌ x)
β is-equiv (Ξ» (q : x οΌ y) β p β q)
β-is-equiv-left {π€} {X} {x} {y} refl =
equiv-closed-under-βΌ id (refl β_) (id-is-equiv (x οΌ y))
(Ξ» _ β refl-left-neutral)
β-is-equiv-right : {X : π€ Μ } {x y z : X} (q : x οΌ y)
β is-equiv (Ξ» (p : z οΌ x) β p β q)
β-is-equiv-right {π€} {X} {x} {y} {z} refl = id-is-equiv (z οΌ y)
\end{code}
Added by Tom de Jong, November 2021.
\begin{code}
open import UF.PropTrunc
module _ (pt : propositional-truncations-exist) where
open PropositionalTruncation pt
β₯β₯-cong : {X : π€ Μ } {Y : π₯ Μ } β X β Y β β₯ X β₯ β β₯ Y β₯
β₯β₯-cong f = logically-equivalent-props-are-equivalent β₯β₯-is-prop β₯β₯-is-prop
(β₯β₯-functor β f β) (β₯β₯-functor β f ββ»ΒΉ)
β-cong : {X : π€ Μ } {Y : X β π₯ Μ } {Y' : X β π¦ Μ }
β ((x : X) β Y x β Y' x)
β β Y β β Y'
β-cong e = β₯β₯-cong (Ξ£-cong e)
outer-β-inner-Ξ£ : {X : π€ Μ } {Y : X β π₯ Μ } {A : (x : X) β Y x β π¦ Μ }
β (β x κ X , β y κ Y x , A x y)
β (β x κ X , Ξ£ y κ Y x , A x y)
outer-β-inner-Ξ£ {π€} {π₯} {π¦} {X} {Y} {A} =
logically-equivalent-props-are-equivalent β₯β₯-is-prop β₯β₯-is-prop f g
where
g : (β x κ X , Ξ£ y κ Y x , A x y)
β (β x κ X , β y κ Y x , A x y)
g = β₯β₯-functor (Ξ» (x , y , a) β x , β£ y , a β£)
f : (β x κ X , β y κ Y x , A x y)
β (β x κ X , Ξ£ y κ Y x , A x y)
f = β₯β₯-rec β₯β₯-is-prop Ο
where
Ο : (Ξ£ x κ X , β y κ Y x , A x y)
β (β x κ X , Ξ£ y κ Y x , A x y)
Ο (x , p) = β₯β₯-functor (Ξ» (y , a) β x , y , a) p
\end{code}