{-# OPTIONS --without-K #-}
{-# OPTIONS --rewriting #-}
module lec3-exercises where
open import Agda.Primitive
open import Agda.Builtin.Unit
open import Agda.Builtin.Bool
open import Agda.Builtin.Equality renaming (_≡_ to _==_)
record Σ {a b} (A : Set a) (B : A -> Set b) : Set (a ⊔ b) where
constructor _,_
field
fst : A
snd : B fst
open Σ
infixr 4 _,_
syntax Σ A (λ x → B) = Σ[ x ∈ A ] B
_×_ : ∀ {a b} → (A : Set a) (B : Set b) -> Set (a ⊔ b)
A × B = Σ A (λ _ → B)
data ⊥ : Set where
¬_ : Set -> Set
¬ A = A -> ⊥
data _+_ (A B : Set) : Set where
inl : A -> A + B
inr : B -> A + B
infixr 1 _+_
id : ∀ {ℓ} → {A : Set ℓ} -> A -> A
id x = x
_∘_ : ∀ {ℓ ℓ' ℓ''} → {A : Set ℓ}{B : Set ℓ'}{C : Set ℓ''} ->
(B -> C) -> (A -> B) -> A -> C
(f ∘ g) x = f (g x)
infixr 80 _·_
_·_ : ∀ {ℓ} → {A : Set ℓ} -> {a b c : A} -> a == b -> b == c -> a == c
refl · q = q
_⁻¹ : ∀ {ℓ} → {A : Set ℓ} {a b : A} -> a == b -> b == a
refl ⁻¹ = refl
ap : ∀ {ℓ ℓ'} → {A : Set ℓ}{B : Set ℓ'}(f : A -> B){x y : A} ->
x == y -> f x == f y
ap f refl = refl
transport : ∀ {ℓ ℓ'} → {A : Set ℓ}{B : A -> Set ℓ'}{x y : A} ->
x == y -> B x -> B y
transport refl = id
pair= : {A : Set}{B : A -> Set} -> {a a' : A}{b : B a}{b' : B a'} ->
(p : a == a') -> transport p b == b' -> (a , b) == (a' , b')
pair= refl refl = refl
lunit : ∀ {ℓ} → {A : Set ℓ} -> {x y : A} -> (p : x == y) -> p · refl == p
lunit refl = refl
runit : ∀ {ℓ} → {A : Set ℓ} -> {x y : A} -> (p : x == y) -> refl · p == p
runit refl = refl
linverse : ∀ {ℓ} → {A : Set ℓ} -> {x y : A} -> (p : x == y) -> (p ⁻¹) · p == refl
linverse refl = refl
rinverse : ∀ {ℓ} → {A : Set ℓ} -> {x y : A} -> (p : x == y) -> p · (p ⁻¹) == refl
rinverse refl = refl
inverse-unique : ∀ {ℓ} → {A : Set ℓ} -> {x y : A} -> (p : x == y) -> (p ⁻¹) ⁻¹ == p
inverse-unique refl = refl
assoc : ∀ {ℓ} → {A : Set ℓ} -> {x y z w : A} -> (p : x == y)(q : y == z)(r : z == w) ->
p · (q · r) == (p · q) · r
assoc refl refl refl = refl
isContr : Set -> Set
isContr A = Σ[ x ∈ A ] ((y : A) -> x == y)
isProp : Set -> Set
isProp A = (x y : A) -> x == y
isSet : Set -> Set
isSet A = (x y : A) -> isProp (x == y)
isEquiv : ∀ {ℓ ℓ'} → {A : Set ℓ}{B : Set ℓ'} -> (A -> B) -> Set (ℓ ⊔ ℓ')
isEquiv {A = A} {B} f = Σ[ g ∈ (B -> A) ] (
Σ[ η ∈ ((x : A) → g (f x) == x) ] (
Σ[ ε ∈ ((y : B) → f (g y) == y) ] (
(x : A) -> ap f (η x) == ε (f x))))
qinv : ∀ {ℓ ℓ'} → {A : Set ℓ}{B : Set ℓ'} -> (A -> B) -> Set (ℓ ⊔ ℓ')
qinv {A = A} {B} f = Σ[ g ∈ (B -> A) ] (
Σ[ η ∈ ((x : A) → g (f x) == x) ]
((y : B) → f (g y) == y))
infix 30 _≃_
_≃_ : Set -> Set -> Set
A ≃ B = Σ (A -> B) λ f → isEquiv f
idtoeqv : {A B : Set} -> A == B -> A ≃ B
idtoeqv refl = (id , id , (λ x → refl) , ((λ y → refl) , (λ x → refl)))
postulate
univalence : {A B : Set} -> isEquiv (idtoeqv {A} {B})
ua : {A B : Set} -> A ≃ B -> A == B
ua = fst univalence
data ∥_∥ (A : Set) : Set where
∣_∣ : A -> ∥ A ∥
postulate
prop-trunc-rec : {A : Set} -> (P : Set) -> isProp P ->
(g : A -> P) -> (∥ A ∥ -> P)
prop-trunc-rec-β : {A P : Set}(p : isProp P)(g : A -> P) ->
(a : A) -> prop-trunc-rec P p g ∣ a ∣ == g a
{-# BUILTIN REWRITE _==_ #-}
{-# REWRITE prop-trunc-rec-β #-}
LEM→DNE : {A : Set} -> ((A : Set) -> A + ¬ A) -> ((A : Set) -> ¬ ¬ A -> A)
LEM→DNE {A} f = {!!}
DNE→LEM : {A : Set} -> ((A : Set) -> ¬ ¬ A -> A) -> ((A : Set) -> A + ¬ A)
DNE→LEM {A} g = {!!}
prop-trunc-ind : {!!}
prop-trunc-ind = {!!}
disjoint-isProp : {A B : Set} ->
isProp A -> isProp B -> ¬ (A × B) -> isProp (A + B)
disjoint-isProp = {!!}
ac-equiv : {A : Set}{B : Set}{R : A -> B -> Set} ->
((x : A) -> Σ[ y ∈ B ] R x y)
≃ (Σ[ f ∈ (A -> B) ] ((x : A) -> R x (f x)))
ac-equiv = {!!}
open import Agda.Builtin.Nat hiding (_==_) renaming (Nat to ℕ)
True : Bool -> Set
True true = ⊤
True false = ⊥
isPropTruncOf : (A : Set) -> (||A|| : Set) -> Set1
isPropTruncOf A ||A|| = isProp ||A|| ×
(Σ[ η ∈ (A -> ||A||) ]
Σ[ g-bar ∈ ((P : Set) -> isProp P -> (g : A -> P) -> ||A|| -> P) ]
(∀ {P p g} -> (a : A) -> g-bar P p g (η a) == g a))
minimise : {f : ℕ -> ℕ} ->
isPropTruncOf (Σ[ n ∈ ℕ ] (f n == 0))
(Σ[ n ∈ ℕ ] ((f n == 0) ×
((m : ℕ) -> f m == 0 -> True (n < m))))
minimise = {!!}