lean2/hott/init/path.hlean

719 lines
25 KiB
Text
Raw Normal View History

2014-12-12 04:14:53 +00:00
-- Copyright (c) 2014 Microsoft Corporation. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
2014-12-12 18:17:50 +00:00
-- Author: Jeremy Avigad, Jakob von Raumer
2014-12-12 04:14:53 +00:00
-- Ported from Coq HoTT
--
-- TODO: things to test:
-- o To what extent can we use opaque definitions outside the file?
-- o Try doing these proofs with tactics.
-- o Try using the simplifier on some of these proofs.
2014-12-12 18:17:50 +00:00
prelude
import .function .datatypes .relation .tactic
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
open function eq
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
-- Path equality
-- ---- --------
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
namespace eq
2014-12-12 04:14:53 +00:00
variables {A B C : Type} {P : A → Type} {x y z t : A}
2014-12-12 18:17:50 +00:00
--notation a = b := eq a b
notation x = y `:>`:50 A:49 := @eq A x y
definition idp {a : A} := refl a
2014-12-12 04:14:53 +00:00
-- unbased path induction
2014-12-12 18:17:50 +00:00
definition rec' [reducible] {P : Π (a b : A), (a = b) -> Type}
(H : Π (a : A), P a a idp) {a b : A} (p : a = b) : P a b p :=
eq.rec (H a) p
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition rec_on' [reducible] {P : Π (a b : A), (a = b) -> Type} {a b : A} (p : a = b)
2014-12-12 04:14:53 +00:00
(H : Π (a : A), P a a idp) : P a b p :=
2014-12-12 18:17:50 +00:00
eq.rec (H a) p
2014-12-12 04:14:53 +00:00
-- Concatenation and inverse
-- -------------------------
2014-12-12 18:17:50 +00:00
definition concat (p : x = y) (q : y = z) : x = z :=
eq.rec (λu, u) q p
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition inverse (p : x = y) : y = x :=
eq.rec (refl x) p
2014-12-12 04:14:53 +00:00
notation p₁ ⬝ p₂ := concat p₁ p₂
notation p ⁻¹ := inverse p
-- The 1-dimensional groupoid structure
-- ------------------------------------
-- The identity path is a right unit.
2014-12-12 18:17:50 +00:00
definition concat_p1 (p : x = y) : p ⬝ idp = p :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- The identity path is a right unit.
2014-12-12 18:17:50 +00:00
definition concat_1p (p : x = y) : idp ⬝ p = p :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- Concatenation is associative.
2014-12-12 18:17:50 +00:00
definition concat_p_pp (p : x = y) (q : y = z) (r : z = t) :
p ⬝ (q ⬝ r) = (p ⬝ q) ⬝ r :=
eq.rec_on r (eq.rec_on q idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_pp_p (p : x = y) (q : y = z) (r : z = t) :
(p ⬝ q) ⬝ r = p ⬝ (q ⬝ r) :=
eq.rec_on r (eq.rec_on q idp)
2014-12-12 04:14:53 +00:00
-- The left inverse law.
2014-12-12 18:17:50 +00:00
definition concat_pV (p : x = y) : p ⬝ p⁻¹ = idp :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- The right inverse law.
2014-12-12 18:17:50 +00:00
definition concat_Vp (p : x = y) : p⁻¹ ⬝ p = idp :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- Several auxiliary theorems about canceling inverses across associativity. These are somewhat
-- redundant, following from earlier theorems.
2014-12-12 18:17:50 +00:00
definition concat_V_pp (p : x = y) (q : y = z) : p⁻¹ ⬝ (p ⬝ q) = q :=
eq.rec_on q (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_p_Vp (p : x = y) (q : x = z) : p ⬝ (p⁻¹ ⬝ q) = q :=
eq.rec_on q (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_pp_V (p : x = y) (q : y = z) : (p ⬝ q) ⬝ q⁻¹ = p :=
eq.rec_on q (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_pV_p (p : x = z) (q : y = z) : (p ⬝ q⁻¹) ⬝ q = p :=
eq.rec_on q (take p, eq.rec_on p idp) p
2014-12-12 04:14:53 +00:00
-- Inverse distributes over concatenation
2014-12-12 18:17:50 +00:00
definition inv_pp (p : x = y) (q : y = z) : (p ⬝ q)⁻¹ = q⁻¹ ⬝ p⁻¹ :=
eq.rec_on q (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition inv_Vp (p : y = x) (q : y = z) : (p⁻¹ ⬝ q)⁻¹ = q⁻¹ ⬝ p :=
eq.rec_on q (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
-- universe metavariables
2014-12-12 18:17:50 +00:00
definition inv_pV (p : x = y) (q : z = y) : (p ⬝ q⁻¹)⁻¹ = q ⬝ p⁻¹ :=
eq.rec_on p (take q, eq.rec_on q idp) q
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition inv_VV (p : y = x) (q : z = y) : (p⁻¹ ⬝ q⁻¹)⁻¹ = q ⬝ p :=
eq.rec_on p (eq.rec_on q idp)
2014-12-12 04:14:53 +00:00
-- Inverse is an involution.
2014-12-12 18:17:50 +00:00
definition inv_V (p : x = y) : p⁻¹⁻¹ = p :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- Theorems for moving things around in equations
-- ----------------------------------------------
2014-12-12 18:17:50 +00:00
definition moveR_Mp (p : x = z) (q : y = z) (r : y = x) :
p = (r⁻¹ ⬝ q) → (r ⬝ p) = q :=
eq.rec_on r (take p h, concat_1p _ ⬝ h ⬝ concat_1p _) p
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveR_pM (p : x = z) (q : y = z) (r : y = x) :
r = q ⬝ p⁻¹ → r ⬝ p = q :=
eq.rec_on p (take q h, (concat_p1 _ ⬝ h ⬝ concat_p1 _)) q
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveR_Vp (p : x = z) (q : y = z) (r : x = y) :
p = r ⬝ q → r⁻¹ ⬝ p = q :=
eq.rec_on r (take q h, concat_1p _ ⬝ h ⬝ concat_1p _) q
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveR_pV (p : z = x) (q : y = z) (r : y = x) :
r = q ⬝ p → r ⬝ p⁻¹ = q :=
eq.rec_on p (take r h, concat_p1 _ ⬝ h ⬝ concat_p1 _) r
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveL_Mp (p : x = z) (q : y = z) (r : y = x) :
r⁻¹ ⬝ q = p → q = r ⬝ p :=
eq.rec_on r (take p h, (concat_1p _)⁻¹ ⬝ h ⬝ (concat_1p _)⁻¹) p
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveL_pM (p : x = z) (q : y = z) (r : y = x) :
q ⬝ p⁻¹ = r → q = r ⬝ p :=
eq.rec_on p (take q h, (concat_p1 _)⁻¹ ⬝ h ⬝ (concat_p1 _)⁻¹) q
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveL_Vp (p : x = z) (q : y = z) (r : x = y) :
r ⬝ q = p → q = r⁻¹ ⬝ p :=
eq.rec_on r (take q h, (concat_1p _)⁻¹ ⬝ h ⬝ (concat_1p _)⁻¹) q
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveL_pV (p : z = x) (q : y = z) (r : y = x) :
q ⬝ p = r → q = r ⬝ p⁻¹ :=
eq.rec_on p (take r h, (concat_p1 _)⁻¹ ⬝ h ⬝ (concat_p1 _)⁻¹) r
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveL_1M (p q : x = y) :
p ⬝ q⁻¹ = idp → p = q :=
eq.rec_on q (take p h, (concat_p1 _)⁻¹ ⬝ h) p
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveL_M1 (p q : x = y) :
q⁻¹ ⬝ p = idp → p = q :=
eq.rec_on q (take p h, (concat_1p _)⁻¹ ⬝ h) p
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveL_1V (p : x = y) (q : y = x) :
p ⬝ q = idp → p = q⁻¹ :=
eq.rec_on q (take p h, (concat_p1 _)⁻¹ ⬝ h) p
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveL_V1 (p : x = y) (q : y = x) :
q ⬝ p = idp → p = q⁻¹ :=
eq.rec_on q (take p h, (concat_1p _)⁻¹ ⬝ h) p
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveR_M1 (p q : x = y) :
idp = p⁻¹ ⬝ q → p = q :=
eq.rec_on p (take q h, h ⬝ (concat_1p _)) q
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveR_1M (p q : x = y) :
idp = q ⬝ p⁻¹ → p = q :=
eq.rec_on p (take q h, h ⬝ (concat_p1 _)) q
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveR_1V (p : x = y) (q : y = x) :
idp = q ⬝ p → p⁻¹ = q :=
eq.rec_on p (take q h, h ⬝ (concat_p1 _)) q
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveR_V1 (p : x = y) (q : y = x) :
idp = p ⬝ q → p⁻¹ = q :=
eq.rec_on p (take q h, h ⬝ (concat_1p _)) q
2014-12-12 04:14:53 +00:00
-- Transport
-- ---------
2014-12-12 18:17:50 +00:00
definition transport [reducible] (P : A → Type) {x y : A} (p : x = y) (u : P x) : P y :=
eq.rec_on p u
2014-12-12 04:14:53 +00:00
-- This idiom makes the operation right associative.
notation p `▹`:65 x:64 := transport _ p x
2014-12-12 18:17:50 +00:00
definition ap ⦃A B : Type⦄ (f : A → B) {x y:A} (p : x = y) : f x = f y :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
definition ap01 := ap
definition homotopy [reducible] (f g : Πx, P x) : Type :=
2014-12-12 18:17:50 +00:00
Πx : A, f x = g x
2014-12-12 04:14:53 +00:00
notation f g := homotopy f g
2014-12-12 18:17:50 +00:00
definition apD10 {f g : Πx, P x} (H : f = g) : f g :=
λx, eq.rec_on H idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap10 {f g : A → B} (H : f = g) : f g := apD10 H
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap11 {f g : A → B} (H : f = g) {x y : A} (p : x = y) : f x = g y :=
eq.rec_on H (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition apD (f : Πa:A, P a) {x y : A} (p : x = y) : p ▹ (f x) = f y :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- calc enviroment
-- ---------------
calc_subst transport
calc_trans concat
2014-12-12 18:17:50 +00:00
calc_refl refl
2014-12-12 04:14:53 +00:00
calc_symm inverse
-- More theorems for moving things around in equations
-- ---------------------------------------------------
2014-12-12 18:17:50 +00:00
definition moveR_transport_p (P : A → Type) {x y : A} (p : x = y) (u : P x) (v : P y) :
u = p⁻¹ ▹ v → p ▹ u = v :=
eq.rec_on p (take v, id) v
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveR_transport_V (P : A → Type) {x y : A} (p : y = x) (u : P x) (v : P y) :
u = p ▹ v → p⁻¹ ▹ u = v :=
eq.rec_on p (take u, id) u
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveL_transport_V (P : A → Type) {x y : A} (p : x = y) (u : P x) (v : P y) :
p ▹ u = v → u = p⁻¹ ▹ v :=
eq.rec_on p (take v, id) v
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition moveL_transport_p (P : A → Type) {x y : A} (p : y = x) (u : P x) (v : P y) :
p⁻¹ ▹ u = v → u = p ▹ v :=
eq.rec_on p (take u, id) u
2014-12-12 04:14:53 +00:00
-- Functoriality of functions
-- --------------------------
-- Here we prove that functions behave like functors between groupoids, and that [ap] itself is
-- functorial.
-- Functions take identity paths to identity paths
2014-12-12 18:17:50 +00:00
definition ap_1 (x : A) (f : A → B) : (ap f idp) = idp :> (f x = f x) := idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition apD_1 (x : A) (f : Π x : A, P x) : apD f idp = idp :> (f x = f x) := idp
2014-12-12 04:14:53 +00:00
-- Functions commute with concatenation.
2014-12-12 18:17:50 +00:00
definition ap_pp (f : A → B) {x y z : A} (p : x = y) (q : y = z) :
ap f (p ⬝ q) = (ap f p) ⬝ (ap f q) :=
eq.rec_on q (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap_p_pp (f : A → B) {w x y z : A} (r : f w = f x) (p : x = y) (q : y = z) :
r ⬝ (ap f (p ⬝ q)) = (r ⬝ ap f p) ⬝ (ap f q) :=
eq.rec_on q (take p, eq.rec_on p (concat_p_pp r idp idp)) p
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap_pp_p (f : A → B) {w x y z : A} (p : x = y) (q : y = z) (r : f z = f w) :
(ap f (p ⬝ q)) ⬝ r = (ap f p) ⬝ (ap f q ⬝ r) :=
eq.rec_on q (eq.rec_on p (take r, concat_pp_p _ _ _)) r
2014-12-12 04:14:53 +00:00
-- Functions commute with path inverses.
2014-12-12 18:17:50 +00:00
definition inverse_ap (f : A → B) {x y : A} (p : x = y) : (ap f p)⁻¹ = ap f (p⁻¹) :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap_V {A B : Type} (f : A → B) {x y : A} (p : x = y) : ap f (p⁻¹) = (ap f p)⁻¹ :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- [ap] itself is functorial in the first argument.
2014-12-12 18:17:50 +00:00
definition ap_idmap (p : x = y) : ap id p = p :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap_compose (f : A → B) (g : B → C) {x y : A} (p : x = y) :
ap (g ∘ f) p = ap g (ap f p) :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- Sometimes we don't have the actual function [compose].
2014-12-12 18:17:50 +00:00
definition ap_compose' (f : A → B) (g : B → C) {x y : A} (p : x = y) :
ap (λa, g (f a)) p = ap g (ap f p) :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- The action of constant maps.
2014-12-12 18:17:50 +00:00
definition ap_const (p : x = y) (z : B) :
ap (λu, z) p = idp :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- Naturality of [ap].
2014-12-12 18:17:50 +00:00
definition concat_Ap {f g : A → B} (p : Π x, f x = g x) {x y : A} (q : x = y) :
(ap f q) ⬝ (p y) = (p x) ⬝ (ap g q) :=
eq.rec_on q (concat_1p _ ⬝ (concat_p1 _)⁻¹)
2014-12-12 04:14:53 +00:00
-- Naturality of [ap] at identity.
2014-12-12 18:17:50 +00:00
definition concat_A1p {f : A → A} (p : Πx, f x = x) {x y : A} (q : x = y) :
(ap f q) ⬝ (p y) = (p x) ⬝ q :=
eq.rec_on q (concat_1p _ ⬝ (concat_p1 _)⁻¹)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_pA1 {f : A → A} (p : Πx, x = f x) {x y : A} (q : x = y) :
(p x) ⬝ (ap f q) = q ⬝ (p y) :=
eq.rec_on q (concat_p1 _ ⬝ (concat_1p _)⁻¹)
2014-12-12 04:14:53 +00:00
-- Naturality with other paths hanging around.
2014-12-12 18:17:50 +00:00
definition concat_pA_pp {f g : A → B} (p : Πx, f x = g x) {x y : A} (q : x = y)
{w z : B} (r : w = f x) (s : g y = z) :
(r ⬝ ap f q) ⬝ (p y ⬝ s) = (r ⬝ p x) ⬝ (ap g q ⬝ s) :=
eq.rec_on s (eq.rec_on q idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_pA_p {f g : A → B} (p : Πx, f x = g x) {x y : A} (q : x = y)
{w : B} (r : w = f x) :
(r ⬝ ap f q) ⬝ p y = (r ⬝ p x) ⬝ ap g q :=
eq.rec_on q idp
2014-12-12 04:14:53 +00:00
-- TODO: try this using the simplifier, and compare proofs
2014-12-12 18:17:50 +00:00
definition concat_A_pp {f g : A → B} (p : Πx, f x = g x) {x y : A} (q : x = y)
{z : B} (s : g y = z) :
(ap f q) ⬝ (p y ⬝ s) = (p x) ⬝ (ap g q ⬝ s) :=
eq.rec_on s (eq.rec_on q
2014-12-12 04:14:53 +00:00
(calc
2014-12-12 18:17:50 +00:00
(ap f idp) ⬝ (p x ⬝ idp) = idp ⬝ p x : idp
... = p x : concat_1p _
... = (p x) ⬝ (ap g idp ⬝ idp) : idp))
2014-12-12 04:14:53 +00:00
-- This also works:
-- eq.rec_on s (eq.rec_on q (concat_1p _ ▹ idp))
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_pA1_pp {f : A → A} (p : Πx, f x = x) {x y : A} (q : x = y)
{w z : A} (r : w = f x) (s : y = z) :
(r ⬝ ap f q) ⬝ (p y ⬝ s) = (r ⬝ p x) ⬝ (q ⬝ s) :=
eq.rec_on s (eq.rec_on q idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_pp_A1p {g : A → A} (p : Πx, x = g x) {x y : A} (q : x = y)
{w z : A} (r : w = x) (s : g y = z) :
(r ⬝ p x) ⬝ (ap g q ⬝ s) = (r ⬝ q) ⬝ (p y ⬝ s) :=
eq.rec_on s (eq.rec_on q idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_pA1_p {f : A → A} (p : Πx, f x = x) {x y : A} (q : x = y)
{w : A} (r : w = f x) :
(r ⬝ ap f q) ⬝ p y = (r ⬝ p x) ⬝ q :=
eq.rec_on q idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_A1_pp {f : A → A} (p : Πx, f x = x) {x y : A} (q : x = y)
{z : A} (s : y = z) :
(ap f q) ⬝ (p y ⬝ s) = (p x) ⬝ (q ⬝ s) :=
eq.rec_on s (eq.rec_on q (concat_1p _ ▹ idp))
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_pp_A1 {g : A → A} (p : Πx, x = g x) {x y : A} (q : x = y)
{w : A} (r : w = x) :
(r ⬝ p x) ⬝ ap g q = (r ⬝ q) ⬝ p y :=
eq.rec_on q idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_p_A1p {g : A → A} (p : Πx, x = g x) {x y : A} (q : x = y)
{z : A} (s : g y = z) :
p x ⬝ (ap g q ⬝ s) = q ⬝ (p y ⬝ s) :=
2014-12-12 04:14:53 +00:00
begin
apply (eq.rec_on s),
apply (eq.rec_on q),
2014-12-12 04:14:53 +00:00
apply (concat_1p (p x) ▹ idp)
end
-- Action of [apD10] and [ap10] on paths
-- -------------------------------------
-- Application of paths between functions preserves the groupoid structure
2014-12-12 18:17:50 +00:00
definition apD10_1 (f : Πx, P x) (x : A) : apD10 (refl f) x = idp := idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition apD10_pp {f f' f'' : Πx, P x} (h : f = f') (h' : f' = f'') (x : A) :
apD10 (h ⬝ h') x = apD10 h x ⬝ apD10 h' x :=
eq.rec_on h (take h', eq.rec_on h' idp) h'
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition apD10_V {f g : Πx : A, P x} (h : f = g) (x : A) :
apD10 (h⁻¹) x = (apD10 h x)⁻¹ :=
eq.rec_on h idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap10_1 {f : A → B} (x : A) : ap10 (refl f) x = idp := idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap10_pp {f f' f'' : A → B} (h : f = f') (h' : f' = f'') (x : A) :
ap10 (h ⬝ h') x = ap10 h x ⬝ ap10 h' x := apD10_pp h h' x
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap10_V {f g : A → B} (h : f = g) (x : A) : ap10 (h⁻¹) x = (ap10 h x)⁻¹ :=
2014-12-12 04:14:53 +00:00
apD10_V h x
-- [ap10] also behaves nicely on paths produced by [ap]
2014-12-12 18:17:50 +00:00
definition ap_ap10 (f g : A → B) (h : B → C) (p : f = g) (a : A) :
ap h (ap10 p a) = ap10 (ap (λ f', h ∘ f') p) a:=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- Transport and the groupoid structure of paths
-- ---------------------------------------------
definition transport_1 (P : A → Type) {x : A} (u : P x) :
2014-12-12 18:17:50 +00:00
idp ▹ u = u := idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition transport_pp (P : A → Type) {x y z : A} (p : x = y) (q : y = z) (u : P x) :
p ⬝ q ▹ u = q ▹ p ▹ u :=
eq.rec_on q (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition transport_pV (P : A → Type) {x y : A} (p : x = y) (z : P y) :
p ▹ p⁻¹ ▹ z = z :=
2014-12-12 04:14:53 +00:00
(transport_pp P (p⁻¹) p z)⁻¹ ⬝ ap (λr, transport P r z) (concat_Vp p)
2014-12-12 18:17:50 +00:00
definition transport_Vp (P : A → Type) {x y : A} (p : x = y) (z : P x) :
p⁻¹ ▹ p ▹ z = z :=
2014-12-12 04:14:53 +00:00
(transport_pp P p (p⁻¹) z)⁻¹ ⬝ ap (λr, transport P r z) (concat_pV p)
definition transport_p_pp (P : A → Type)
2014-12-12 18:17:50 +00:00
{x y z w : A} (p : x = y) (q : y = z) (r : z = w) (u : P x) :
2014-12-12 04:14:53 +00:00
ap (λe, e ▹ u) (concat_p_pp p q r) ⬝ (transport_pp P (p ⬝ q) r u) ⬝
ap (transport P r) (transport_pp P p q u)
2014-12-12 18:17:50 +00:00
= (transport_pp P p (q ⬝ r) u) ⬝ (transport_pp P q r (p ▹ u))
:> ((p ⬝ (q ⬝ r)) ▹ u = r ▹ q ▹ p ▹ u) :=
eq.rec_on r (eq.rec_on q (eq.rec_on p idp))
2014-12-12 04:14:53 +00:00
-- Here is another coherence lemma for transport.
2014-12-12 18:17:50 +00:00
definition transport_pVp (P : A → Type) {x y : A} (p : x = y) (z : P x) :
transport_pV P p (transport P p z) = ap (transport P p) (transport_Vp P p z) :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- Dependent transport in a doubly dependent type.
-- should P, Q and y all be explicit here?
definition transportD (P : A → Type) (Q : Π a : A, P a → Type)
2014-12-12 18:17:50 +00:00
{a a' : A} (p : a = a') (b : P a) (z : Q a b) : Q a' (p ▹ b) :=
eq.rec_on p z
2014-12-12 04:14:53 +00:00
-- In Coq the variables B, C and y are explicit, but in Lean we can probably have them implicit using the following notation
notation p `▹D`:65 x:64 := transportD _ _ p _ x
-- Transporting along higher-dimensional paths
2014-12-12 18:17:50 +00:00
definition transport2 (P : A → Type) {x y : A} {p q : x = y} (r : p = q) (z : P x) :
p ▹ z = q ▹ z :=
2014-12-12 04:14:53 +00:00
ap (λp', p' ▹ z) r
notation p `▹2`:65 x:64 := transport2 _ p _ x
-- An alternative definition.
2014-12-12 18:17:50 +00:00
definition transport2_is_ap10 (Q : A → Type) {x y : A} {p q : x = y} (r : p = q)
2014-12-12 04:14:53 +00:00
(z : Q x) :
2014-12-12 18:17:50 +00:00
transport2 Q r z = ap10 (ap (transport Q) r) z :=
eq.rec_on r idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition transport2_p2p (P : A → Type) {x y : A} {p1 p2 p3 : x = y}
(r1 : p1 = p2) (r2 : p2 = p3) (z : P x) :
transport2 P (r1 ⬝ r2) z = transport2 P r1 z ⬝ transport2 P r2 z :=
eq.rec_on r1 (eq.rec_on r2 idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition transport2_V (Q : A → Type) {x y : A} {p q : x = y} (r : p = q) (z : Q x) :
transport2 Q (r⁻¹) z = ((transport2 Q r z)⁻¹) :=
eq.rec_on r idp
2014-12-12 04:14:53 +00:00
definition transportD2 (B C : A → Type) (D : Π(a:A), B a → C a → Type)
2014-12-12 18:17:50 +00:00
{x1 x2 : A} (p : x1 = x2) (y : B x1) (z : C x1) (w : D x1 y z) : D x2 (p ▹ y) (p ▹ z) :=
eq.rec_on p w
2014-12-12 04:14:53 +00:00
notation p `▹D2`:65 x:64 := transportD2 _ _ _ p _ _ x
2014-12-12 18:17:50 +00:00
definition concat_AT (P : A → Type) {x y : A} {p q : x = y} {z w : P x} (r : p = q)
(s : z = w) :
ap (transport P p) s ⬝ transport2 P r w = transport2 P r z ⬝ ap (transport P q) s :=
eq.rec_on r (concat_p1 _ ⬝ (concat_1p _)⁻¹)
2014-12-12 04:14:53 +00:00
-- TODO (from Coq library): What should this be called?
2014-12-12 18:17:50 +00:00
definition ap_transport {P Q : A → Type} {x y : A} (p : x = y) (f : Πx, P x → Q x) (z : P x) :
f y (p ▹ z) = (p ▹ (f x z)) :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- Transporting in particular fibrations
-- -------------------------------------
/-
From the Coq HoTT library:
One frequently needs lemmas showing that transport in a certain dependent type is equal to some
more explicitly defined operation, defined according to the structure of that dependent type.
For most dependent types, we prove these lemmas in the appropriate file in the types/
subdirectory. Here we consider only the most basic cases.
-/
-- Transporting in a constant fibration.
2014-12-12 18:17:50 +00:00
definition transport_const (p : x = y) (z : B) : transport (λx, B) p z = z :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition transport2_const {p q : x = y} (r : p = q) (z : B) :
transport_const p z = transport2 (λu, B) r z ⬝ transport_const q z :=
eq.rec_on r (concat_1p _)⁻¹
2014-12-12 04:14:53 +00:00
-- Transporting in a pulled back fibration.
-- TODO: P can probably be implicit
2014-12-12 18:17:50 +00:00
definition transport_compose (P : B → Type) (f : A → B) (p : x = y) (z : P (f x)) :
transport (P ∘ f) p z = transport P (ap f p) z :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition transport_precompose (f : A → B) (g g' : B → C) (p : g = g') :
transport (λh : B → C, g ∘ f = h ∘ f) p idp = ap (λh, h ∘ f) p :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition apD10_ap_precompose (f : A → B) (g g' : B → C) (p : g = g') (a : A) :
apD10 (ap (λh : B → C, h ∘ f) p) a = apD10 p (f a) :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition apD10_ap_postcompose (f : B → C) (g g' : A → B) (p : g = g') (a : A) :
apD10 (ap (λh : A → B, f ∘ h) p) a = ap f (apD10 p a) :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- A special case of [transport_compose] which seems to come up a lot.
2014-12-12 18:17:50 +00:00
definition transport_idmap_ap (P : A → Type) x y (p : x = y) (u : P x) :
transport P p u = transport (λz, z) (ap P p) u :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- The behavior of [ap] and [apD]
-- ------------------------------
-- In a constant fibration, [apD] reduces to [ap], modulo [transport_const].
2014-12-12 18:17:50 +00:00
definition apD_const (f : A → B) (p: x = y) :
apD f p = transport_const p (f x) ⬝ ap f p :=
eq.rec_on p idp
2014-12-12 04:14:53 +00:00
-- The 2-dimensional groupoid structure
-- ------------------------------------
-- Horizontal composition of 2-dimensional paths.
2014-12-12 18:17:50 +00:00
definition concat2 {p p' : x = y} {q q' : y = z} (h : p = p') (h' : q = q') :
p ⬝ q = p' ⬝ q' :=
eq.rec_on h (eq.rec_on h' idp)
2014-12-12 04:14:53 +00:00
infixl `◾`:75 := concat2
-- 2-dimensional path inversion
2014-12-12 18:17:50 +00:00
definition inverse2 {p q : x = y} (h : p = q) : p⁻¹ = q⁻¹ :=
eq.rec_on h idp
2014-12-12 04:14:53 +00:00
-- Whiskering
-- ----------
2014-12-12 18:17:50 +00:00
definition whiskerL (p : x = y) {q r : y = z} (h : q = r) : p ⬝ q = p ⬝ r :=
2014-12-12 04:14:53 +00:00
idp ◾ h
2014-12-12 18:17:50 +00:00
definition whiskerR {p q : x = y} (h : p = q) (r : y = z) : p ⬝ r = q ⬝ r :=
2014-12-12 04:14:53 +00:00
h ◾ idp
-- Unwhiskering, a.k.a. cancelling
2014-12-12 18:17:50 +00:00
definition cancelL {x y z : A} (p : x = y) (q r : y = z) : (p ⬝ q = p ⬝ r) → (q = r) :=
eq.rec_on p (take r, eq.rec_on r (take q a, (concat_1p q)⁻¹ ⬝ a)) r q
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition cancelR {x y z : A} (p q : x = y) (r : y = z) : (p ⬝ r = q ⬝ r) → (p = q) :=
eq.rec_on r (eq.rec_on p (take q a, a ⬝ concat_p1 q)) q
2014-12-12 04:14:53 +00:00
-- Whiskering and identity paths.
2014-12-12 18:17:50 +00:00
definition whiskerR_p1 {p q : x = y} (h : p = q) :
(concat_p1 p)⁻¹ ⬝ whiskerR h idp ⬝ concat_p1 q = h :=
eq.rec_on h (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition whiskerR_1p (p : x = y) (q : y = z) :
whiskerR idp q = idp :> (p ⬝ q = p ⬝ q) :=
eq.rec_on q idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition whiskerL_p1 (p : x = y) (q : y = z) :
whiskerL p idp = idp :> (p ⬝ q = p ⬝ q) :=
eq.rec_on q idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition whiskerL_1p {p q : x = y} (h : p = q) :
(concat_1p p) ⁻¹ ⬝ whiskerL idp h ⬝ concat_1p q = h :=
eq.rec_on h (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat2_p1 {p q : x = y} (h : p = q) :
h ◾ idp = whiskerR h idp :> (p ⬝ idp = q ⬝ idp) :=
eq.rec_on h idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat2_1p {p q : x = y} (h : p = q) :
idp ◾ h = whiskerL idp h :> (idp ⬝ p = idp ⬝ q) :=
eq.rec_on h idp
2014-12-12 04:14:53 +00:00
-- TODO: note, 4 inductions
-- The interchange law for concatenation.
2014-12-12 18:17:50 +00:00
definition concat_concat2 {p p' p'' : x = y} {q q' q'' : y = z}
(a : p = p') (b : p' = p'') (c : q = q') (d : q' = q'') :
(a ◾ c) ⬝ (b ◾ d) = (a ⬝ b) ◾ (c ⬝ d) :=
eq.rec_on d (eq.rec_on c (eq.rec_on b (eq.rec_on a idp)))
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition concat_whisker {x y z : A} (p p' : x = y) (q q' : y = z) (a : p = p') (b : q = q') :
(whiskerR a q) ⬝ (whiskerL p' b) = (whiskerL p b) ⬝ (whiskerR a q') :=
eq.rec_on b (eq.rec_on a (concat_1p _)⁻¹)
2014-12-12 04:14:53 +00:00
-- Structure corresponding to the coherence equations of a bicategory.
-- The "pentagonator": the 3-cell witnessing the associativity pentagon.
2014-12-12 18:17:50 +00:00
definition pentagon {v w x y z : A} (p : v = w) (q : w = x) (r : x = y) (s : y = z) :
2014-12-12 04:14:53 +00:00
whiskerL p (concat_p_pp q r s)
⬝ concat_p_pp p (q ⬝ r) s
⬝ whiskerR (concat_p_pp p q r) s
2014-12-12 18:17:50 +00:00
= concat_p_pp p q (r ⬝ s) ⬝ concat_p_pp (p ⬝ q) r s :=
eq.rec_on s (eq.rec_on r (eq.rec_on q (eq.rec_on p idp)))
2014-12-12 04:14:53 +00:00
-- The 3-cell witnessing the left unit triangle.
2014-12-12 18:17:50 +00:00
definition triangulator (p : x = y) (q : y = z) :
concat_p_pp p idp q ⬝ whiskerR (concat_p1 p) q = whiskerL p (concat_1p q) :=
eq.rec_on q (eq.rec_on p idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition eckmann_hilton {x:A} (p q : idp = idp :> (x = x)) : p ⬝ q = q ⬝ p :=
2014-12-12 04:14:53 +00:00
(!whiskerR_p1 ◾ !whiskerL_1p)⁻¹
⬝ (!concat_p1 ◾ !concat_p1)
⬝ (!concat_1p ◾ !concat_1p)
⬝ !concat_whisker
⬝ (!concat_1p ◾ !concat_1p)⁻¹
⬝ (!concat_p1 ◾ !concat_p1)⁻¹
⬝ (!whiskerL_1p ◾ !whiskerR_p1)
-- The action of functions on 2-dimensional paths
2014-12-12 18:17:50 +00:00
definition ap02 (f:A → B) {x y : A} {p q : x = y} (r : p = q) : ap f p = ap f q :=
eq.rec_on r idp
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap02_pp (f : A → B) {x y : A} {p p' p'' : x = y} (r : p = p') (r' : p' = p'') :
ap02 f (r ⬝ r') = ap02 f r ⬝ ap02 f r' :=
eq.rec_on r (eq.rec_on r' idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition ap02_p2p (f : A → B) {x y z : A} {p p' : x = y} {q q' :y = z} (r : p = p')
(s : q = q') :
ap02 f (r ◾ s) = ap_pp f p q
2014-12-12 04:14:53 +00:00
⬝ (ap02 f r ◾ ap02 f s)
⬝ (ap_pp f p' q')⁻¹ :=
eq.rec_on r (eq.rec_on s (eq.rec_on q (eq.rec_on p idp)))
-- eq.rec_on r (eq.rec_on s (eq.rec_on p (eq.rec_on q idp)))
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
definition apD02 {p q : x = y} (f : Π x, P x) (r : p = q) :
apD f p = transport2 P r (f x) ⬝ apD f q :=
eq.rec_on r (concat_1p _)⁻¹
2014-12-12 04:14:53 +00:00
-- And now for a lemma whose statement is much longer than its proof.
definition apD02_pp (P : A → Type) (f : Π x:A, P x) {x y : A}
2014-12-12 18:17:50 +00:00
{p1 p2 p3 : x = y} (r1 : p1 = p2) (r2 : p2 = p3) :
apD02 f (r1 ⬝ r2) = apD02 f r1
2014-12-12 04:14:53 +00:00
⬝ whiskerL (transport2 P r1 (f x)) (apD02 f r2)
⬝ concat_p_pp _ _ _
⬝ (whiskerR ((transport2_p2p P r1 r2 (f x))⁻¹) (apD f p3)) :=
eq.rec_on r2 (eq.rec_on r1 (eq.rec_on p1 idp))
2014-12-12 18:17:50 +00:00
end eq
namespace eq
2014-12-12 04:14:53 +00:00
variables {A B C D E : Type} {a a' : A} {b b' : B} {c c' : C} {d d' : D}
2014-12-12 18:17:50 +00:00
theorem congr_arg2 (f : A → B → C) (Ha : a = a') (Hb : b = b') : f a b = f a' b' :=
eq.rec_on Ha (eq.rec_on Hb idp)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
theorem congr_arg3 (f : A → B → C → D) (Ha : a = a') (Hb : b = b') (Hc : c = c')
: f a b c = f a' b' c' :=
eq.rec_on Ha (congr_arg2 (f a) Hb Hc)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
theorem congr_arg4 (f : A → B → C → D → E) (Ha : a = a') (Hb : b = b') (Hc : c = c') (Hd : d = d')
: f a b c d = f a' b' c' d' :=
eq.rec_on Ha (congr_arg3 (f a) Hb Hc Hd)
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
end eq
2014-12-12 04:14:53 +00:00
2014-12-12 18:17:50 +00:00
namespace eq
2014-12-12 04:14:53 +00:00
variables {A : Type} {B : A → Type} {C : Πa, B a → Type} {D : Πa b, C a b → Type}
{E : Πa b c, D a b c → Type} {F : Type}
variables {a a' : A}
{b : B a} {b' : B a'}
{c : C a b} {c' : C a' b'}
{d : D a b c} {d' : D a' b' c'}
2014-12-12 18:17:50 +00:00
theorem dcongr_arg2 (f : Πa, B a → F) (Ha : a = a') (Hb : (Ha ▹ b) = b')
: f a b = f a' b' :=
eq.rec_on Hb (eq.rec_on Ha idp)
2014-12-12 04:14:53 +00:00
/- From the Coq version:
-- ** Tactics, hints, and aliases
-- [concat], with arguments flipped. Useful mainly in the idiom [apply (concatR (expression))].
-- Given as a notation not a definition so that the resultant terms are literally instances of
-- [concat], with no unfolding required.
Notation concatR := (λp q, concat q p).
Hint Resolve
concat_1p concat_p1 concat_p_pp
inv_pp inv_V
: path_hints.
(* First try at a paths db
We want the RHS of the equation to become strictly simpler
Hint Rewrite
⬝concat_p1
⬝concat_1p
⬝concat_p_pp (* there is a choice here !*)
⬝concat_pV
⬝concat_Vp
⬝concat_V_pp
⬝concat_p_Vp
⬝concat_pp_V
⬝concat_pV_p
(*⬝inv_pp*) (* I am not sure about this one
⬝inv_V
⬝moveR_Mp
⬝moveR_pM
⬝moveL_Mp
⬝moveL_pM
⬝moveL_1M
⬝moveL_M1
⬝moveR_M1
⬝moveR_1M
⬝ap_1
(* ⬝ap_pp
⬝ap_p_pp ?*)
⬝inverse_ap
⬝ap_idmap
(* ⬝ap_compose
⬝ap_compose'*)
⬝ap_const
(* Unsure about naturality of [ap], was absent in the old implementation*)
⬝apD10_1
:paths.
Ltac hott_simpl :=
autorewrite with paths in * |- * ; auto with path_hints.
-/
2014-12-12 18:17:50 +00:00
end eq