The Nearly-Inverse of the Truncation Map ∣_∣ : ℕ → ∥ ℕ ∥
   =======================================================

For a nontrivial class of types ("homogeneous" types) which 
includes the natural numbers ℕ, I show how the map ∣_∣ from 
the type into its propositional truncation can "nearly" be 
inverted, in the following sense:

I define a term "myst" such that

  id-factored : ℕ → ℕ
  id-factored = myst ∘ ∣_∣

is a factorization of the identity map on ℕ through ℕ, and the 
proof is very simple:
  
  proof : (n : ℕ) → id-factored n == n
  proof n = idp

Note that "idp" is the identity-path (aka refl). 
This also implies that, if n is privately defined to be 17 and
only x ≡ ∣ n ∣ is accessible, the number 17 can be recovered by
applying 'myst' to 'x'.

I find this extremly counterintuitive as ∥ ℕ ∥ is equivalent to 
the unit type, and ∣_∣ is (as I used to understand it) assumed 
to hide information. My construction shows that ∣_∣ does not 
do a good job at hiding.

My construction is correct with respect to the definitions in
the book. In this Agda file, I use propositional truncation as
defined in the HoTT-library. Martin Escardo has checked that the
construction also works if the truncation is defined in the 
style of Voevodsky, i.e. by quantifying over all propositions. 
The construction is inspired by Martin's insight on "judgmental 
factorization of constant functions" and my earlier attempts to
related problems that used pointed types.

[Nicolai Kraus, October 2013]

\begin{code}
{-# OPTIONS --without-K #-} 

module trunc-inverse where

open import lib.types.Nat
open import lib.Basics 
open import lib.Univalence
open import lib.Funext
open import lib.types.Truncation


{- == Pointed types ==
   A pointed type is a type (base) together with a chosen 
   element (pt). -}
Type• : (i : ULevel)  Type (lsucc i)
Type• i = Σ (Type i) (idf _)

module _ {i} (X : Type• i) where
  base = fst X
  pt   = snd X

  -- I later consider the type of pointed types that are
  -- equal to X:
  pathto : Type (lsucc i)
  pathto = Σ (Type• i)  Y  Y == X) 

  -- As it is well-known, this type is contractible and 
  -- thereby propositional:
  pathto-prop : is-prop pathto
  pathto-prop = raise-level ⟨-2⟩ (pathto-is-contr X)

  -- Let me call a pointed type (base,pt) 'homogeneous' iff, 
  -- for any x:base, the expressions (base,x) and (base,pt) 
  -- are equal as pointed types:
  is-homogeneous : Type (lsucc i)
  is-homogeneous = (x : base)  (base , x) == X

{- == Truncation ==
   I only use propositional truncation. For a type X,  
   write ∥ X ∥ for its truncation, and ∣_∣ : X → ∥ X ∥ for the
   constructor.  -}
module _ {i} where
  ∥_∥ : Type i  Type i
  ∥_∥ = Trunc ⟨-1⟩ 

  ∣_∣ : {A : Type i}  A   A 
  ∣_∣ = [_]

{- == The "mysterious" construction for any homogeneous type == -}
module hom-myst {i} (ptX : Type• i) (t : is-homogeneous ptX) where

  X  = base ptX
  x₀ = pt ptX

  f : X  pathto (X , x₀)
  f x = (X , x) , t x

  f-lifted :  X   pathto (X , x₀)
  f-lifted = Trunc-rec (pathto-prop _) f

  myst : (x :  X )  (fst  fst  f-lifted) x
  myst = snd  fst  f-lifted

  -- (the following two proofs will not be used later)
  id-factor : (x : X)  myst  x  == x
  id-factor x = idp 

  id-factor' : myst  ∣_∣ == idf _
  id-factor' = λ= id-factor

{- My first example of homogeneous types is the class of all tyoes 
   with decidable equality. -}
module dec-hom {i} (ptX : Type• i) (dec : has-dec-eq (base ptX)) where

  X  = base ptX
  x₀ = pt ptX

  module _ (x : X) where

    -- I define a function X → X that switches x and x₀.
    switch : X  X
    switch = λ y  match dec y x₀ 
                     withl  _  x) 
                     withr  _  match dec y x
                                    withl  _  x₀)
                                    withr  _  y))

    -- Rather tedious to prove, but completely straightforward:
    -- this map is its own inverse.
    switch-selfinverse : (y : X)  switch (switch y) == y
    switch-selfinverse y with dec y x₀
    switch-selfinverse y | inl _ with dec x x₀
    switch-selfinverse y | inl y-x₀  | inl x-x₀ = x-x₀  ! y-x₀
    switch-selfinverse y | inl _     | inr _ with dec x x
    switch-selfinverse y | inl y-x₀  | inr _    | inl _ = ! y-x₀
    switch-selfinverse y | inl _     | inr _    | inr ¬x-x = Empty-elim {A = λ _  x == y} (¬x-x idp)
    switch-selfinverse y | inr _ with dec y x 
    switch-selfinverse y | inr _     | inl _ with dec x x₀ 
    switch-selfinverse y | inr ¬x-x₀ | inl y-x  | inl x-x₀ = Empty-elim (¬x-x₀ (y-x  x-x₀))
    switch-selfinverse y | inr _     | inl _    | inr _ with dec x₀ x₀ 
    switch-selfinverse y | inr _     | inl y-x  | inr _ | inl _ = ! y-x
    switch-selfinverse y | inr _     | inl _    | inr _ | inr ¬x₀-x₀ = Empty-elim {A = λ _  _ == y} (¬x₀-x₀ idp) 
    switch-selfinverse y | inr _     | inr _ with dec y x₀
    switch-selfinverse y | inr ¬y-x₀ | inr _    | inl y-x₀ = Empty-elim {A = λ _  x == y} (¬y-x₀ y-x₀)
    switch-selfinverse y | inr _     | inr _    | inr _  with dec y x
    switch-selfinverse y | inr _     | inr ¬y-x | inr _ | inl y-x = Empty-elim {A = λ _  x₀ == y} (¬y-x y-x)
    switch-selfinverse y | inr _     | inr _    | inr _ | inr _ = idp

    switch-maps : switch x == x₀
    switch-maps with dec x x₀ 
    switch-maps | inl x-x₀ = x-x₀
    switch-maps | inr _ with dec x x
    switch-maps | inr _ | inl _ = idp
    switch-maps | inr _ | inr ¬x-x = Empty-elim {A = λ _  x == x₀} (¬x-x idp)

    -- switch is an equivalence
    switch-eq : X  X
    switch-eq = equiv switch switch 
                      switch-selfinverse switch-selfinverse

  -- It is easy to see how to use the above construction for 
  -- showing that X is homogeneous. 
  is-hom : is-homogeneous ptX
  is-hom x = pair= (ua X-X) x-x₀ where
    X-X : X  X
    X-X = switch-eq x
    x-x₀ : PathOver (idf (Type i)) (ua X-X) x (snd ptX)
    x-x₀ = ↓-idf-ua-in X-X (switch-maps x)

-- As an example, we do the case of ℕ explicitely.
module example-ℕ where
  open hom-myst ( , 0)
  open dec-hom ( , 0)

  myst-ℕ = myst (dec-hom.is-hom _ ℕ-has-dec-eq)

  -- I can now "factor" the identity map on ℕ:
  id-factored :   
  id-factored = myst-ℕ  ∣_∣

  proof : (n : )  id-factored n == n
  proof n = idp

  proof' : id-factored == idf 
  proof' = λ= proof

-- A very simple lemma: composing with an equality is an equivalence.
module _ {i} (A : Type i) (a b : A) where
  ∙-is-eq : (x : A) (p : x == a)  is-equiv (_∙_ {z = b} p)
  ∙-is-eq .a idp = idf-is-equiv _

{- My second example of homogeneous types is the class of (inhabited)
   path spaces. -}
module path-hom {i} (A : Type i) (a₁ a₂ : A) (p : a₁ == a₂) where

  is-hom : is-homogeneous (a₁ == a₂ , p)
  is-hom q = pair= (ua eq) p-q where
    eq : (a₁ == a₂)  (a₁ == a₂)
    eq = _∙_ (p  ! q) , ∙-is-eq A a₁ a₂ a₁ (p  ! q) 

    p-q : PathOver _ (ua eq) q p
    p-q = ↓-idf-ua-in _ (–> eq q =⟨ idp 
                         (p  ! q)  q  =⟨ ∙-assoc p (! q) q 
                          p  ! q  q   =⟨ (ap (_∙_ p) (!-inv-l q))  ∙-unit-r _ 
                          p )

-- As an example, take any type X with any point x. The path space
-- x == x is trivially inhabited.
module example-path {i} (X : Type i) (x : X) where
  open hom-myst (x == x , idp)
  open path-hom X x x idp

  myst-path = myst is-hom

  -- again, the identity map on the path space can be factored through
  -- ∣_∣, and we have never assumed that X is an h-set.
  id-factored : (x == x)  (x == x)
  id-factored = myst-path  ∣_∣

  proof : (p : x == x)  id-factored p == p
  proof p = idp

  proof' : id-factored == idf (x == x)
  proof' = λ= proof


{- Let us go back to the example with natural numbers. The term 'myst'
   can be used to reveal a secret that was hidden with ∣_∣. -}
module _ where
  open example-ℕ 

  -- let us hide a number
  module _ where
    private
      -- a hidden number:
      seventeen : 
      seventeen = 17
      -- a hidden number that is not even an actual number:
      postulate a : 
    
    -- to the outside, only the truncated versions are revealed.
    hidden₁ :   
    hidden₁ =  seventeen 
    hidden₂ :   
    hidden₂ =  a 

  -- It is impossble to refer to seventeen and a as they are 
  -- not visible any more. We can still reveal their secrets.
  reveal : 
  reveal = myst-ℕ hidden₁ 
  uncover : 
  uncover = myst-ℕ hidden₂

  {- In Agda, we can normalize an expression with ctrl-c ctrl-n.

     As it should be, we cannot check seventeen and a:

       ctrl-c ctrl-n seventeen
       result: [...] not in scope [...]

       ctrl-c ctrl-n a
       result: [...] not in scope [...]

     However, I can still reveal the hidden information:

       ctrl-c ctrl-n reveal 
       result: 17

       ctrl-c ctrl-n uncover
       result: .trunc-inverse._._.a
  -}


\end{code}

The crux is, of course, that the type of 'myst' is not
∥ X ∥ → X. In fact, the type of 'myst' is rather complicated', 
and it was already given above:

  myst : (x : ∥ X ∥) → (fst ∘ fst ∘ f-lifted) x

The reason why the whole construction works is that, whenever x
is instantiated with ∣ a ∣ (which are actually the only elements
of ∥ X ∥ that we have), the expression in the "codomain" of myst
reduces to X (and, in particular, does not depend on ∣ a ∣).

Further, note that the term 'myst' is independent of the proof
that X is homogeneous. We can thus reveal information that was 
hidden by ∣_∣ for any type. In general, we will not be able to 
close all holes as we cannot show that an arbitrary type is
homogeneous, but the secret will be revealed nevertheless.