{-# OPTIONS --without-K #-} -- this disables uniqueness of identity proofs module lec2-exercises where open import Agda.Primitive open import Agda.Builtin.Sigma open import Agda.Builtin.Unit open import Agda.Builtin.Equality renaming (_≡_ to _==_) ----- Functions ------------------------------------------- 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) ----- Paths ----------------------------------------------- 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 ----- Groupoid laws --------------------------------------- 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 r = refl ----- hlevels --------------------------------------------- isContr : Set -> Set isContr A = Σ A (λ x → (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) ----- Equivalences and univalence ------------------------- isEquiv : ∀ {ℓ ℓ'} → {A : Set ℓ}{B : Set ℓ'} -> (A -> B) -> Set (ℓ ⊔ ℓ') isEquiv {A = A} {B} f = Σ (B -> A) (λ g → Σ ((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 = Σ (B -> A) (λ g → Σ ((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 {---- Part 1: hlevels ------------------------------------} -- Exercise 1: prove the theorem on slide 5 contr→prop : {A : Set} -> isContr A -> isProp A contr→prop p = {!!} contr-if-inhabited→prop : {A : Set} -> (A -> isContr A) -> isProp A contr-if-inhabited→prop g x y = {!!} prop→set : {A : Set} -> isProp A -> isSet A prop→set f x y p q = {!!} -- Exercise 2: here is another characterisation of propositions: prop→all-contr : {A : Set} -> isProp A -> ((x y : A) -> isContr (x == y)) prop→all-contr f x y = {!!} all-contr→prop : {A : Set} -> ((x y : A) -> isContr (x == y)) -> isProp A all-contr→prop g = {!!} -- does this suggest a pattern in the definition of homotopy n-types? -- Exercise 3: prove the vacuum cord principle on slide 8 vacuum-cord : {A : Set} -> (a : A) -> isContr (Σ A λ x → x == a) vacuum-cord a = {!!} -- Exercise 4: Closure properties (harder) contr-is-contr : {A : Set} -> isContr A -> isContr (isContr A) contr-is-contr p = {!!} prop-is-prop-always : {A : Set} -> isProp (isProp A) prop-is-prop-always = {!!} {---- Part 2: Equivalences -------------------------------} -- Exercise 5: Prove that quasi-equivalences can be upgraded to equivalences adjointify : {A B : Set} -> (f : A -> B) -> qinv f -> isEquiv f adjointify f p = {!!} -- Exercise 6: Prove that A is contractible iff A ≃ 1 contr→trivial : {A : Set} -> isContr A -> A ≃ ⊤ contr→trivial p = {!!} trivial→contr : {A : Set} -> A ≃ ⊤ -> isContr A trivial→contr q = {!!} -- Exercise 7: Extract an equivalence from a Voevodsky equivalence fib : {A B : Set} -> (f : A -> B) -> B -> Set fib {A} f y = Σ A λ x → f x == y voevoedsky→equiv : {A B : Set} -> (f : A -> B) -> ((y : B) -> isContr (fib f y)) -> isEquiv f voevoedsky→equiv f p = {!!} -- Exercise 8: Construct a "bi-functional relation" from an equivalence equiv→bifun : {A B : Set} -> (f : A -> B) -> isEquiv f -> Σ (A -> B -> Set) λ R → Σ ((a : A) → isContr (Σ B λ b → R a b)) λ _ → ((b : B) → isContr (Σ A λ a → R a b)) equiv→bifun f p = {!!}