Chuangjie Xu 2013

\begin{code}

{-# OPTIONS --without-K #-}

module Preliminaries.SetsAndFunctions where

open import Agda.Primitive using (Level ; lzero ; lsuc ; _⊔_)

\end{code}

Identity function and function composition

\begin{code}

id : {i : Level}{X : Set i}  X  X
id x = x

infixl 30 _∘_ 

_∘_ : {i j k : Level}{X : Set i}{Y : X  Set j}{Z : (x : X)  Y x  Set k} 
      ({x : X}  (y : Y x)  Z x y)  (f : (x : X)  Y x) 
      (x : X)  Z x (f x)
g  f = λ x  g(f x)

\end{code}

Subset relation

\begin{code}

Subset : {i : Level}  Set i  Set(lsuc i)
Subset {i} X = X  Set i

_∈_ : {i : Level}{X : Set i}  X  Subset X  Set i
x  A = A x

\end{code}

Universe polymorphic sigma type

\begin{code}

infixr 3 _,_

record Σ {i j : Level} {A : Set i} (B : A  Set j) : Set (i  j) where
  constructor _,_
  field
   pr₁ : A
   pr₂ : B pr₁

open Σ public

\end{code}

Cartesian products and conjunctions are defined using Σ types.

\begin{code}

infixr 20 _×_

_×_ : {i j : Level}  Set i  Set j  Set(i  j)
X × Y = Σ \(x : X)  Y

\end{code}

Identity type and related lemmas:

\begin{code}

infix  30 _≡_
infixr 40 _·_
infixl 50 _⁻¹

data _≡_ {i : Level} {A : Set i} : A  A  Set i where
  refl : {a : A}  a  a

J : {i j : Level} {A : Set i} (C : (a b : A)  a  b  Set j)
   ((a : A)  C a a refl)
   (a b : A)  (p : a  b)  C a b p
J C c a .a refl = c a

_⁻¹ : {i : Level}{A : Set i}  {x y : A}  x  y  y  x
refl ⁻¹ = refl

_·_ : {i : Level}{A : Set i}  {x y z : A}  x  y  y  z  x  z
refl · refl = refl

transport : {i j : Level}{X : Set i}{x x' : X}  (Y : X  Set j)  x  x'  Y x  Y x'
transport Y refl y = y

transport² : {i j k : Level} {X : Set i} (Y : X  Set j) (Z : (x : X)  Y x  Set k) {x x' : X} {y : Y x}
            (p : x  x')  Z x y  Z x' (transport Y p y)
transport² Y Z refl z = z

ap : {i j : Level}{X : Set i}{Y : Set j}  ∀(f : X  Y)  {x₀ x₁ : X}  x₀  x₁  f x₀  f x₁
ap f refl = refl

fun-ap : {i j : Level}{X : Set i}{Y : X  Set j}  ∀{f g : (x : X)  Y x}  f  g  ∀(x : X)  f x  g x
fun-ap r x = ap  h  h x) r

apd² : {i j k : Level} {X : Set i} {Y : X  Set j} {Z : Set k}
       {x₀ x₁ : X} {y₀ : Y x₀} {y₁ : Y x₁}
      (f : (x : X)  Y x  Z)  (p : x₀  x₁)  transport Y p y₀  y₁
      f x₀ y₀  f x₁ y₁
apd² f refl refl = refl

sym-is-inverse : {X : Set} {x y : X} (p : x  y)  refl  p ⁻¹ · p
sym-is-inverse refl = refl

pair⁼ : {i j : Level}{X : Set i}{Y : X  Set j}{x x' : X}{y : Y x}{y' : Y x'}
       (p : x  x')  transport Y p y  y'  (x , y)  (x' , y')
pair⁼ refl refl = refl

pairˣ⁼ : {i : Level}{A₀ A₁ : Set i}{a₀ a₀' : A₀}{a₁ a₁' : A₁}
        a₀  a₀'  a₁  a₁'  (a₀ , a₁)  (a₀' , a₁')
pairˣ⁼ refl refl = refl

pr₁⁼ : {i j : Level}{X : Set i}{Y : X  Set j}{w w' : Σ \(x : X)  Y x}
      w  w'  pr₁ w  pr₁ w'
pr₁⁼ refl = refl

pr₂⁼ : {i j : Level}{X : Set i}{Y : X  Set j}{w w' : Σ \(x : X)  Y x}
      (p : w  w')  transport Y (pr₁⁼ p) (pr₂ w)  pr₂ w'
pr₂⁼ refl = refl

pair⁼-η : {i j : Level} {A : Set i} {B : A  Set j} {w₀ w₁ : Σ B}
         (p : w₀  w₁)  p  pair⁼ (pr₁⁼ p) (pr₂⁼ p)
pair⁼-η refl = refl

pr₂ˣ⁼ : {i : Level}{A₀ A₁ : Set i}{w w' : A₀ × A₁}
       w  w'  pr₂ w  pr₂ w'
pr₂ˣ⁼ refl = refl

\end{code}

Constancy

\begin{code}

constant : {i j : Level} {X : Set i} {Y : Set j}  (X  Y)  Set(i  j)
constant f =  x x'  f x  f x'

Lemma[∘-constant] : {X Y Z : Set}  (f : X  Y)  (g : Y  Z)
                   constant f  constant (g  f)
Lemma[∘-constant] f g cf x x' = ap g (cf x x')

\end{code}

Empty type:

\begin{code}

data  : Set where

∅-elim : {i : Level}{A : Set i}    A
∅-elim ()

¬ : {i : Level}  Set i  Set i
¬ X = X  

infix 30 _≠_

_≠_ : {i : Level} {A : Set i}  A  A  Set i
x  y = ¬ (x  y)

\end{code}

Singleton type:

\begin{code}

data  : Set where
  : 

unit : {X : Set}  X  
unit x = 

singleton : ∀(x x' : )  x  x'
singleton   = refl

\end{code}

Disjoint union:

\begin{code}

infixr 20 _+_

data _+_ (X₀ X₁ : Set) : Set where
  inl : X₀  X₀ + X₁
  inr : X₁  X₀ + X₁

case : {X₀ X₁ Y : Set}  (X₀  Y)  (X₁  Y)  X₀ + X₁  Y
case f₀ f₁ (inl x₀) = f₀ x₀
case f₀ f₁ (inr x₁) = f₁ x₁

equality-cases : {X₀ X₁ : Set}  {A : Set}  
    ∀(y : X₀ + X₁)  (∀ x₀  y  inl x₀  A)  (∀ x₁  y  inr x₁  A)  A
equality-cases (inl x₀) f₀ f₁ = f₀ x₀ refl
equality-cases (inr x₁) f₀ f₁ = f₁ x₁ refl

cases : {X₀ X₁ Y₀ Y₁ : Set}  (X₀  Y₀)  (X₁  Y₁)  X₀ + X₁  Y₀ + Y₁
cases f₀ f₁ (inl x₀) = inl (f₀ x₀)
cases f₀ f₁ (inr x₁) = inr (f₁ x₁)

Lemma[+] : {X₀ X₁ : Set}  (x : X₀ + X₁) 
             (Σ \(x₀ : X₀)  x  inl x₀) + (Σ \(x₁ : X₁)  x  inr x₁)
Lemma[+] (inl x₀) = inl (x₀ , refl)
Lemma[+] (inr x₁) = inr (x₁ , refl)

\end{code}

Decidability, disrectess, hproposition and hset:

\begin{code}

decidable : Set  Set
decidable A = A + ¬ A

discrete : Set  Set
discrete A = ∀(a a' : A)  decidable (a  a')

hprop : Set  Set
hprop X = (x y : X)  x  y

hprop-valued : {A : Set}  (A  Set)  Set
hprop-valued P =  a  hprop(P a)

⒈-hprop : hprop 
⒈-hprop   = refl

Σ-hprop : {A : Set} {B : A  Set}
         hprop A  hprop-valued B  hprop (Σ B)
Σ-hprop {A} {B} hA hB (a₀ , b₀) (a₁ , b₁) = pair⁼ (hA a₀ a₁) (hB a₁ (transport B (hA a₀ a₁) b₀) b₁)

hset : Set  Set
hset X = {x y : X}  hprop (x  y)

hset-valued : {A : Set}  (A  Set)  Set
hset-valued P =  a  hset(P a)

Σ-hset : {A : Set} {B : A  Set}
        hset A  hset-valued B  hset (Σ B)
Σ-hset {A} {B} hA hB {w₀} {w₁} p q = (pair⁼-η p) · claim₂ · (pair⁼-η q)⁻¹
 where
   : pr₁ w₀  pr₁ w₁  Set
   r = transport B r (pr₂ w₀)  pr₂ w₁
  claim₀ : pr₁⁼ p  pr₁⁼ q
  claim₀ = hA (pr₁⁼ p) (pr₁⁼ q)
  claim₁ : transport  claim₀ (pr₂⁼ p)  pr₂⁼ q
  claim₁ = hB (pr₁ w₁) (transport  claim₀ (pr₂⁼ p)) (pr₂⁼ q)
  claim₂ : pair⁼ (pr₁⁼ p) (pr₂⁼ p)  pair⁼ (pr₁⁼ q) (pr₂⁼ q)
  claim₂ = apd² pair⁼ claim₀ claim₁

\end{code}

The type of function extensionality

\begin{code}

Funext : Set₁
Funext = {X : Set} {Y : X  Set} {f g : (x : X)  Y x}
        (∀(x : X)  f x  g x)  f  g

\end{code}