diff --git a/.dockerignore b/.dockerignore index b722c5a..1334a88 100644 --- a/.dockerignore +++ b/.dockerignore @@ -1,2 +1,3 @@ _build -README.md \ No newline at end of file +*.md +*.txt diff --git a/.github/workflows/agda.yml b/.github/workflows/agda.yml index 1c6702d..6dec329 100644 --- a/.github/workflows/agda.yml +++ b/.github/workflows/agda.yml @@ -3,7 +3,13 @@ on: push: branches: - main + paths-ignore: + - '**.md' + - '**.txt' pull_request: + paths-ignore: + - '**.md' + - '**.txt' jobs: build: runs-on: ubuntu-latest diff --git a/Colimit-code/Aux/AuxPaths-v2.agda b/Colimit-code/Aux/AuxPaths-v2.agda index fa8cc13..a578eb5 100644 --- a/Colimit-code/Aux/AuxPaths-v2.agda +++ b/Colimit-code/Aux/AuxPaths-v2.agda @@ -2,15 +2,9 @@ open import lib.Basics open import FTID -open import AuxPaths module AuxPaths-v2 where -module _ {i j k l} {A : Type i} {B : Type j} {C : Type k} {D : Type l} {f : A → B} {h : C → A} {v : C → D} {u : D → B} where - - pth-tri-∘ : (q : u ∘ v ∼ f ∘ h) {x y : C} (p : x == y) → ! (ap u (ap v p)) ∙ q x ∙ ap f (ap h p) == q y - pth-tri-∘ q {x = x} idp = ∙-unit-r (q x) - module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} {f : A → B} {x : A} {z : B} where E₁-v2 : ∀ {ℓ₃} {C : Type ℓ₃} {g : C → A} {c d : C} {R : g c == x} {S : f (g d) == z} (Q : c == d) diff --git a/Colimit-code/Aux/AuxPaths.agda b/Colimit-code/Aux/AuxPaths.agda index 8b2acff..90b34e6 100644 --- a/Colimit-code/Aux/AuxPaths.agda +++ b/Colimit-code/Aux/AuxPaths.agda @@ -16,6 +16,12 @@ module _ {ℓ₁ ℓ₂ k l} {A : Type ℓ₁} {B : Type ℓ₂} {f : A → B} { → ! (ap u S) ∙ q x ∙ L x ∙ ap f (ap h p) == q y ∙ L y E₃ q {x = x} idp idp L = ap (λ p → q x ∙ p) (∙-unit-r (L x)) +module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (h : A → C) (g : C → B) where + + !-!-ap-∘ : {x y : A} (p : x == y) {b : B} (q : b == g (h y)) + → ! (q ∙ ap g (! (ap h p))) == ap (g ∘ h) p ∙ ! q + !-!-ap-∘ idp q = ap ! (∙-unit-r q) + module _ {i j} {A : Type i} {B : Type j} {f g h : A → B} {F : (x : A) → f x == g x} {G : (x : A) → g x == h x} where apd-∙-r : {x y : A} (κ : x == y) → transport (λ z → f z == h z) κ (F x ∙ G x) == transport (λ z → f z == g z) κ (F x) ∙ G y @@ -31,3 +37,6 @@ module _ {i j k} {A : Type i} {B : Type j} {C : Type k} {g h : A → B} {f : A apd-ap-∙-l-coher : {x y : A} (κ : x == y) → apd-tr (λ z → F z ∙ ap ψ (! (G z))) κ ◃∎ =ₛ apd-ap-∙-l κ ◃∙ ap (λ p → F y ∙ ap ψ (! p)) (apd-tr G κ) ◃∎ apd-ap-∙-l-coher idp = =ₛ-in idp + + apd-ap-∙-l-! : {x y : A} (κ : x == y) → transport (λ z → ψ (h z) == f z) κ (! (F x ∙ ap ψ (! (G x)))) == ! (F y ∙ ap ψ (! (transport (λ z → h z == g z) κ (G x)))) + apd-ap-∙-l-! idp = idp diff --git a/Colimit-code/Aux/Cocone-switch.agda b/Colimit-code/Aux/Cocone-switch.agda index a726579..451573d 100644 --- a/Colimit-code/Aux/Cocone-switch.agda +++ b/Colimit-code/Aux/Cocone-switch.agda @@ -1,10 +1,8 @@ {-# OPTIONS --without-K --rewriting #-} open import lib.Basics -open import lib.types.Sigma open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim diff --git a/Colimit-code/Aux/Cocone-v2.agda b/Colimit-code/Aux/Cocone-v2.agda index 9df7144..5261811 100644 --- a/Colimit-code/Aux/Cocone-v2.agda +++ b/Colimit-code/Aux/Cocone-v2.agda @@ -8,7 +8,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -37,18 +36,22 @@ module CC-v2-Constr {ℓv ℓe ℓ ℓd} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( → E₁ {f = right} {g = cin j} idp q == E₂-v2 {f = right} {p = ap ψ (cglue g a)} idp q E-eq-helper idp = idp - E-eq : (q : (z : Colim (ConsDiag Γ A)) → right {d = SpCos} (ψ z) == left ([id] z)) {x : ty (F # j)} (σ : x == fun (F # j) a) (T₁ : ap [id] (cglue g a) == idp) - (R : cin j x == ψ (cin i a)) (T₂ : ap ψ (cglue g a) == ! (ap (cin j) σ) ∙ R) - → E₁ σ (q (cin j a)) ◃∙ ! (ap (λ p → ! (ap right (! (ap (cin j) σ) ∙ R)) ∙ q (cin j a) ∙ p) (ap (ap left) T₁)) ◃∙ E₃ q (cglue g a) T₂ (λ z → idp) ◃∙ ∙-unit-r (q (cin i a)) ◃∎ + E-eq : (q : (z : Colim (ConsDiag Γ A)) → right {d = SpCos} (ψ z) == left ([id] z)) {x : ty (F # j)} (σ : x == fun (F # j) a) + (T₁ : ap [id] (cglue g a) == idp) (R : cin j x == ψ (cin i a)) (T₂ : ap ψ (cglue g a) == ! (ap (cin j) σ) ∙ R) + → E₁ σ (q (cin j a)) ◃∙ ! (ap (λ p → ! (ap right (! (ap (cin j) σ) ∙ R)) ∙ q (cin j a) ∙ p) (ap (ap left) T₁)) ◃∙ + E₃ q (cglue g a) T₂ (λ z → idp) ◃∙ + ∙-unit-r (q (cin i a)) ◃∎ =ₛ E₁-v2 σ ◃∙ E₂-v2 T₂ (q (cin j a)) ◃∙ E₃-v2 {f = left} q (cglue g a) T₁ ◃∎ E-eq q idp T₁ R T₂ = =ₛ-in (lemma R T₂) where lemma : (r : ψ (cin j a) == ψ (cin i a)) (τ : ap ψ (cglue g a) == r) - → E₁ {f = right} {g = cin j} idp (q (cin j a)) ∙ ! (ap (λ p → ! (ap right r) ∙ q (cin j a) ∙ p) (ap (ap left) T₁)) ∙ E₃ q (cglue g a) τ (λ z → idp) ∙ ∙-unit-r (q (cin i a)) + → E₁ {f = right} {g = cin j} idp (q (cin j a)) ∙ ! (ap (λ p → ! (ap right r) ∙ q (cin j a) ∙ p) (ap (ap left) T₁)) ∙ + E₃ q (cglue g a) τ (λ z → idp) ∙ ∙-unit-r (q (cin i a)) == E₂-v2 τ (q (cin j a)) ∙ E₃-v2 {f = left} {u = right} q (cglue g a) T₁ - lemma r idp = ap (λ p → p ∙ ! (ap (λ p → ! (ap right (ap ψ (cglue g a))) ∙ q (cin j a) ∙ p) (ap (ap left) T₁)) ∙ E₃ q (cglue g a) idp (λ z → idp) ∙ ∙-unit-r (q (cin i a))) - (E-eq-helper (q (cin j a))) ∙ ap (λ p → E₂-v2 {f = right} {p = ap ψ (cglue g a)} idp (q (cin j a)) ∙ p) (lemma2 (cglue g a) T₁) + lemma r idp = ap (λ p → p ∙ ! (ap (λ p → ! (ap right (ap ψ (cglue g a))) ∙ q (cin j a) ∙ p) (ap (ap left) T₁)) ∙ + E₃ q (cglue g a) idp (λ z → idp) ∙ ∙-unit-r (q (cin i a))) (E-eq-helper (q (cin j a))) ∙ + ap (λ p → E₂-v2 {f = right} {p = ap ψ (cglue g a)} idp (q (cin j a)) ∙ p) (lemma2 (cglue g a) T₁) where lemma2 : {y : Colim (ConsDiag Γ A)} (c : (cin j a) == y) {v : a == [id] y} (t : ap [id] c == v) → ! (ap (λ p → ! (ap right (ap ψ c)) ∙ q (cin j a) ∙ p) (ap (ap left) t)) ∙ E₃ q c idp (λ z → idp) ∙ ∙-unit-r (q y) == E₃-v2 q c t diff --git a/Colimit-code/Aux/Cocone.agda b/Colimit-code/Aux/Cocone.agda index 02a7405..04705ab 100644 --- a/Colimit-code/Aux/Cocone.agda +++ b/Colimit-code/Aux/Cocone.agda @@ -3,10 +3,8 @@ {- Formation of A-cocone structure on pushout -} open import lib.Basics -open import lib.types.Sigma open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -16,12 +14,14 @@ module Cocone where module _ {ℓ₁ ℓ₂} {B : Type ℓ₁} {D : Type ℓ₂} {u : D → B} where - H₁ : ∀ {k l} {C : Type k} {A : Type l} {h : C → A} {f : A → B} {v : C → D} {c d : C} (Q : c == d) (s : f (h c) == u (v c)) {q : v c == v d} (R : ap v Q == q) - → transport (λ x → f (h x) == u (v x)) Q s == ! (ap f (ap h Q)) ∙ s ∙ ap u q + H₁ : ∀ {k l} {C : Type k} {A : Type l} {h : C → A} {f : A → B} {v : C → D} {c d : C} (Q : c == d) (s : f (h c) == u (v c)) + {q : v c == v d} (R : ap v Q == q) → + transport (λ x → f (h x) == u (v x)) Q s == ! (ap f (ap h Q)) ∙ s ∙ ap u q H₁ idp s idp = ! (∙-unit-r s) - H₂ : ∀ {ℓ₃} {E : Type ℓ₃} {x y : B} {g : E → D} {d e : E} (t : d == e) (q : u (g e) == y) {p : x == y} {z : D} (s : g d == z) {R : u (g d) == u z} (T : ap u s == R) - → p ∙ ! q ∙ ap u (! (ap g t) ∙ s) == p ∙ ! (! R ∙ ap (u ∘ g) t ∙ q) + H₂ : ∀ {ℓ₃} {E : Type ℓ₃} {x y : B} {g : E → D} {d e : E} (t : d == e) (q : u (g e) == y) {p : x == y} {z : D} (s : g d == z) + {R : u (g d) == u z} (T : ap u s == R) → + p ∙ ! q ∙ ap u (! (ap g t) ∙ s) == p ∙ ! (! R ∙ ap (u ∘ g) t ∙ q) H₂ idp q {p = p} idp idp = ap (λ r → p ∙ r) (∙-unit-r (! q)) module Id {ℓv ℓe ℓ} (Γ : Graph ℓv ℓe) (A : Type ℓ) where @@ -58,15 +58,17 @@ module Id {ℓv ℓe ℓ} (Γ : Graph ℓv ℓe) (A : Type ℓ) where module _ where ϵ : ∀ {i j} (g : Hom Γ i j) (a : A) → ! (ap right (cglue g (fun (F # i) a))) ∙ ap (right ∘ cin j) (snd (F <#> g) a) ∙ ! (glue (cin j a)) =-= ! (glue (cin i a)) - ϵ {i} {j} g a = ! (ap right (cglue g (fun (F # i) a))) ∙ (ap (right ∘ cin j) (snd (F <#> g) a)) ∙ (! (glue (cin j a))) - =⟪ E₁ (snd (F <#> g) a) (! (glue (cin j a))) ⟫ - ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ idp - =⟪ ! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))) ⟫ - ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ ap left (ap [id] (cglue g a)) - =⟪ E₃ (λ x → ! (glue x)) (cglue g a) (ψ-βr g a) (λ x → idp) ⟫ - ! (glue (cin i a)) ∙ idp - =⟪ ∙-unit-r (! (glue (cin i a))) ⟫ - ! (glue (cin i a)) ∎∎ + ϵ {i} {j} g a = + ! (ap right (cglue g (fun (F # i) a))) ∙ (ap (right ∘ cin j) (snd (F <#> g) a)) ∙ (! (glue (cin j a))) + =⟪ E₁ (snd (F <#> g) a) (! (glue (cin j a))) ⟫ + ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ idp + =⟪ ! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a))) ⟫ + ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ ap left (ap [id] (cglue g a)) + =⟪ E₃ (λ x → ! (glue x)) (cglue g a) (ψ-βr g a) (λ x → idp) ⟫ + ! (glue (cin i a)) ∙ idp + =⟪ ∙-unit-r (! (glue (cin i a))) ⟫ + ! (glue (cin i a)) ∎∎ module Recc {ℓc} (T : Coslice ℓc ℓ A) where @@ -86,18 +88,19 @@ module Id {ℓv ℓe ℓ} (Γ : Graph ℓv ℓe) (A : Type ℓ) where σ = colimE (λ i → (λ a → ! (snd (r i) a))) (λ i → (λ j → (λ g → (λ a → from-transp-g (λ z → fun T ([id] z) == recc (ψ z)) (cglue g a) (↯ (η i j g a)))))) module _ where - η : (i j : Obj Γ) (g : Hom Γ i j) (a : A) → transport (λ z → fun T ([id] z) == recc (ψ z)) (cglue g a) (! (snd (r j) a)) =-= ! (snd (r i) a) + η : (i j : Obj Γ) (g : Hom Γ i j) (a : A) → + transport (λ z → fun T ([id] z) == recc (ψ z)) (cglue g a) (! (snd (r j) a)) =-= ! (snd (r i) a) η i j g a = - transport (λ z → fun T ([id] z) == recc (ψ z)) (cglue g a) (! (snd (r j) a)) - =⟪ H₁ (cglue g a) (! (snd (r j) a)) (ψ-βr g a) ⟫ - ! (ap (fun T) (ap [id] (cglue g a))) ∙ (! (snd (r j) a)) ∙ ap recc (! (ap (cin j) (snd (F <#> g) a)) ∙ (cglue g (fun (F # i) a))) - =⟪ H₂ (snd (F <#> g) a) (snd (r j) a) (cglue g (fun (F # i) a)) (recc-βr (r & K) g (fun (F # i) a)) ⟫ - ! (ap (fun T) (ap [id] (cglue g a))) ∙ ! (! (fst (K g) (fun (F # i) a)) ∙ ap (recc ∘ cin j) (snd (F <#> g) a) ∙ (snd (r j) a)) - =⟪ ap (λ p → p ∙ ! (! (fst (K g) (fun (F # i) a)) ∙ ap (recc ∘ cin j) (snd (F <#> g) a) ∙ (snd (r j) a))) - (ap (λ p → ! (ap (fun T) p)) (id-βr g a)) ⟫ - ! (! (fst (K g) (fun (F # i) a)) ∙ ap (recc ∘ cin j) (snd (F <#> g) a) ∙ (snd (r j) a)) - =⟪ ap ! (snd (K g) a) ⟫ - ! (snd (r i) a) ∎∎ + transport (λ z → fun T ([id] z) == recc (ψ z)) (cglue g a) (! (snd (r j) a)) + =⟪ H₁ (cglue g a) (! (snd (r j) a)) (ψ-βr g a) ⟫ + ! (ap (fun T) (ap [id] (cglue g a))) ∙ (! (snd (r j) a)) ∙ ap recc (! (ap (cin j) (snd (F <#> g) a)) ∙ (cglue g (fun (F # i) a))) + =⟪ H₂ (snd (F <#> g) a) (snd (r j) a) (cglue g (fun (F # i) a)) (recc-βr (r & K) g (fun (F # i) a)) ⟫ + ! (ap (fun T) (ap [id] (cglue g a))) ∙ ! (! (fst (K g) (fun (F # i) a)) ∙ ap (recc ∘ cin j) (snd (F <#> g) a) ∙ (snd (r j) a)) + =⟪ ap (λ p → p ∙ ! (! (fst (K g) (fun (F # i) a)) ∙ ap (recc ∘ cin j) (snd (F <#> g) a) ∙ (snd (r j) a))) + (ap (λ p → ! (ap (fun T) p)) (id-βr g a)) ⟫ + ! (! (fst (K g) (fun (F # i) a)) ∙ ap (recc ∘ cin j) (snd (F <#> g) a) ∙ (snd (r j) a)) + =⟪ ap ! (snd (K g) a) ⟫ + ! (snd (r i) a) ∎∎ snd (recCosCoc x) a = idp FPrecc-βr = λ (C : CosCocone A F T) → PushoutRec.glue-β {d = SpCos} (fun T) (recc (comp C) (comTri C)) (σ (comp C) (comTri C)) @@ -110,5 +113,5 @@ module Id {ℓv ℓe ℓ} (Γ : Graph ℓv ℓe) (A : Type ℓ) where σ-β {i} {j} g a = apd-to-tr (λ x → fun T ([id] x) == recc (comp C) (comTri C) (ψ x)) (σ (comp C) (comTri C)) (cglue g a) (↯ (η (comp C) (comTri C) i j g a)) (cglue-β (λ i → (λ a → ! (snd (comp C i) a))) - (λ i → (λ j → ( λ g → (λ a → from-transp-g (λ z → fun T ([id] z) == recc (comp C) (comTri C) (ψ z)) + (λ i → (λ j → ( λ g → (λ a → from-transp-g (λ z → fun T ([id] z) == recc (comp C) (comTri C) (ψ z)) (cglue g a) (↯ (η (comp C) (comTri C) i j g a)))))) g a) diff --git a/Colimit-code/Aux/Coslice.agda b/Colimit-code/Aux/Coslice.agda index da40aaa..24cc01d 100644 --- a/Colimit-code/Aux/Coslice.agda +++ b/Colimit-code/Aux/Coslice.agda @@ -3,7 +3,6 @@ {- Coslice categories of the universe -} open import lib.Basics -open import lib.types.Sigma module Coslice where diff --git a/Colimit-code/Aux/Diagram.agda b/Colimit-code/Aux/Diagram.agda index 6b5787d..a09ab61 100644 --- a/Colimit-code/Aux/Diagram.agda +++ b/Colimit-code/Aux/Diagram.agda @@ -97,7 +97,7 @@ open CosCocone public -- Some operations on coslice cocones -module _ {ℓi ℓj k} {A : Type ℓj} {Γ : Graph ℓv ℓe} {F : CosDiag ℓi ℓj A Γ} {C : Coslice k ℓj A} where +module _ {ℓi ℓj k} {A : Type ℓj} {Γ : Graph ℓv ℓe} {F : CosDiag ℓi ℓj A Γ} {C : Coslice k ℓj A} where ForgCoc : (CosCocone A F C) → Cocone (DiagForg A Γ F) (ty C) comp (ForgCoc (K & _)) i = fst (K i) @@ -106,5 +106,5 @@ module _ {ℓi ℓj k} {A : Type ℓj} {Γ : Graph ℓv ℓe} {F : CosDiag ℓi PostComp : ∀ {k'} {D : Coslice k' ℓj A} → CosCocone A F C → (< A > C *→ D) → CosCocone A F D comp (PostComp K (f , fₚ)) i = f ∘ (fst (comp K i)) , λ a → ap f (snd (comp K i) a) ∙ fₚ a comTri (PostComp K (f , fₚ)) {y = j} {x = i} g = (λ x → ap f (fst (comTri K g) x)) , - λ a → ap-cp-revR f (fst (comp K j)) (snd (F <#> g) a) (fst (comTri K g) (fun (F # i) a)) - ∙ ap (λ p → p ∙ fₚ a) (ap (ap f) (snd (comTri K g) a)) + λ a → ap-cp-revR f (fst (comp K j)) (snd (F <#> g) a) (fst (comTri K g) (fun (F # i) a)) ∙ + ap (λ p → p ∙ fₚ a) (ap (ap f) (snd (comTri K g) a)) diff --git a/Colimit-code/Aux/FTID-Cos.agda b/Colimit-code/Aux/FTID-Cos.agda index a5be47e..7cc133a 100644 --- a/Colimit-code/Aux/FTID-Cos.agda +++ b/Colimit-code/Aux/FTID-Cos.agda @@ -5,29 +5,15 @@ open import lib.Basics open import lib.types.Sigma open import lib.types.Pi +open import Helper-paths open import FTID open import Coslice open import Diagram module FTID-Cos where -module _ {ℓ} {B : Type ℓ} where - - neg-rid-trip : {a b : B} (q : a == b) → ! q == ((! q ∙ idp) ∙ idp) ∙ idp - neg-rid-trip idp = idp - - db-neg-rid-db : {a b c : B} (q : a == b) (p : c == b) → ! (((q ∙ ! p) ∙ idp) ∙ idp) ∙ q == p - db-neg-rid-db idp idp = idp - - !-∙-!-rid-∙-rid : {x y w z : B} (p : x == y) (q : w == z) (r : x == z) - → ! (((q ∙ ! r) ∙ idp) ∙ p ∙ idp) ∙ q == ! p ∙ r - !-∙-!-rid-∙-rid idp q r = db-neg-rid-db q r - module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} {f g : A → B} where - hmtpy-nat-rev : (H : f ∼ g) {x y : A} (p : x == y) {z : B} (q : f y == z) → ! (H x) == ap g p ∙ ((! (H y) ∙ q) ∙ ! q) ∙ ! (ap f p) - hmtpy-nat-rev H {x = x} idp idp = neg-rid-trip (H x) - long-path-red : {x y : A} (p : x == y) {z : B} (q₁ : g y == z) (q₂ : f y == z) {w : B} (P : f x == w) {v : B} (C : w == v) → ! ((ap g p ∙ (q₁ ∙ ! q₂) ∙ ! (ap f p)) ∙ P ∙ C) ∙ ap g p ∙ q₁ == ! C ∙ ! P ∙ ap f p ∙ q₂ long-path-red idp q₁ q₂ P idp = !-∙-!-rid-∙-rid P q₁ q₂ @@ -39,25 +25,30 @@ module _ {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} (F : Co field W : (i : Obj Γ) → fst (comp K₁ i) ∼ fst (comp K₂ i) field u : (i : Obj Γ) (a : A) → ! (W i (fun (F # i) a)) ∙ snd (comp K₁ i) a == snd (comp K₂ i) a Ξ : (i j : Obj Γ) (g : Hom Γ i j) (a : A) → ! (! (W j (fst (F <#> g) (fun (F # i) a))) ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ - ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a =-= snd (comp K₂ i) a - Ξ i j g a = ! (! (W j (fst (F <#> g) (fun (F # i) a))) ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a - =⟪ ap (λ p → ! (p ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a) - (hmtpy-nat-rev (W j) (snd (F <#> g) a) (snd (comp K₁ j) a)) ⟫ - ! ((ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ ((! (W j (fun (F # j) a)) ∙ snd (comp K₁ j) a) ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) (snd (F <#> g) a))) ∙ - fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a - =⟪ ap (λ p → ! ((ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) (snd (F <#> g) a))) ∙ - fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a) (u j a) ⟫ - ! ((ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ (snd (comp K₂ j) a ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) (snd (F <#> g) a))) ∙ - fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a - =⟪ long-path-red (snd (F <#> g) a) (snd (comp K₂ j) a) (snd (comp K₁ j) a) (fst (comTri K₁ g) (fun (F # i) a)) (W i (fun (F # i) a)) ⟫ - ! (W i (fun (F # i) a)) ∙ ! (fst (comTri K₁ g) (fun (F # i) a)) ∙ ap (fst (comp K₁ j)) (snd (F <#> g) a) ∙ snd (comp K₁ j) a - =⟪ ap (λ p → ! (W i (fun (F # i) a)) ∙ p) (snd (comTri K₁ g) a) ⟫ - ! (W i (fun (F # i) a)) ∙ snd (comp K₁ i) a - =⟪ u i a ⟫ - snd (comp K₂ i) a ∎∎ + ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a =-= snd (comp K₂ i) a + Ξ i j g a = + ! (! (W j (fst (F <#> g) (fun (F # i) a))) ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ ap (fst (comp K₂ j)) + (snd (F <#> g) a) ∙ snd (comp K₂ j) a + =⟪ ap (λ p → ! (p ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a) + (hmtpy-nat-rev (W j) (snd (F <#> g) a) (snd (comp K₁ j) a)) ⟫ + ! ((ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ ((! (W j (fun (F # j) a)) ∙ snd (comp K₁ j) a) ∙ ! (snd (comp K₁ j) a)) ∙ + ! (ap (fst (comp K₁ j)) (snd (F <#> g) a))) ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ + ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a + =⟪ ap (λ p → ! ((ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) (snd (F <#> g) a))) ∙ + fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a) (u j a) ⟫ + ! ((ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ (snd (comp K₂ j) a ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) (snd (F <#> g) a))) ∙ + fst (comTri K₁ g) (fun (F # i) a) ∙ W i (fun (F # i) a)) ∙ ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a + =⟪ long-path-red (snd (F <#> g) a) (snd (comp K₂ j) a) (snd (comp K₁ j) a) (fst (comTri K₁ g) (fun (F # i) a)) (W i (fun (F # i) a)) ⟫ + ! (W i (fun (F # i) a)) ∙ ! (fst (comTri K₁ g) (fun (F # i) a)) ∙ ap (fst (comp K₁ j)) (snd (F <#> g) a) ∙ snd (comp K₁ j) a + =⟪ ap (λ p → ! (W i (fun (F # i) a)) ∙ p) (snd (comTri K₁ g) a) ⟫ + ! (W i (fun (F # i) a)) ∙ snd (comp K₁ i) a + =⟪ u i a ⟫ + snd (comp K₂ i) a ∎∎ field - Λ : {i j : Obj Γ} (g : Hom Γ i j) → Σ ((x : ty (F # i)) → ! (W j (fst (F <#> g) x)) ∙ fst (comTri K₁ g) x ∙ W i x == fst (comTri K₂ g) x) - (λ R → ((a : A) → ! (ap (λ p → ! p ∙ ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a) (R (fun (F # i) a))) ◃∙ Ξ i j g a =ₛ snd (comTri K₂ g) a ◃∎)) + Λ : {i j : Obj Γ} (g : Hom Γ i j) → + Σ ((x : ty (F # i)) → ! (W j (fst (F <#> g) x)) ∙ fst (comTri K₁ g) x ∙ W i x == fst (comTri K₂ g) x) (λ R → ((a : A) → + ! (ap (λ p → ! p ∙ ap (fst (comp K₂ j)) (snd (F <#> g) a) ∙ snd (comp K₂ j) a) (R (fun (F # i) a))) ◃∙ + Ξ i j g a =ₛ snd (comTri K₂ g) a ◃∎)) open CosCocEq public @@ -66,9 +57,9 @@ module _ {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} (F : Co u center-CCEq = λ i a → idp Λ center-CCEq {i} {j} g = (λ x → ∙-unit-r (fst (comTri K₁ g) x)) , (λ a → =ₛ-in (lemma a (snd (F <#> g) a) (snd (comp K₁ j) a) (snd (comTri K₁ g) a))) where - lemma : (a : A) → {w : ty (F # j)} (σ₁ : fst (F <#> g) (fun (F # i) a) == w) {z : ty T} (σ₂ : fst (comp K₁ j) w == z) {v : fst (comp K₁ i) (fun (F # i) a) == z} - (τ : ! (fst (comTri K₁ g) (fun (F # i) a)) ∙ ap (fst (comp K₁ j)) σ₁ ∙ σ₂ == v) - → ! (ap (λ p → ! p ∙ ap (fst (comp K₁ j)) σ₁ ∙ σ₂) (∙-unit-r (fst (comTri K₁ g) (fun (F # i) a)))) ∙ + lemma : (a : A) → {w : ty (F # j)} (σ₁ : fst (F <#> g) (fun (F # i) a) == w) {z : ty T} (σ₂ : fst (comp K₁ j) w == z) + {v : fst (comp K₁ i) (fun (F # i) a) == z} (τ : ! (fst (comTri K₁ g) (fun (F # i) a)) ∙ ap (fst (comp K₁ j)) σ₁ ∙ σ₂ == v) → + ! (ap (λ p → ! p ∙ ap (fst (comp K₁ j)) σ₁ ∙ σ₂) (∙-unit-r (fst (comTri K₁ g) (fun (F # i) a)))) ∙ ap (λ p → ! (p ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K₁ j)) σ₁ ∙ σ₂) (hmtpy-nat-rev (λ x → idp) σ₁ σ₂) ∙ long-path-red σ₁ σ₂ σ₂ (fst (comTri K₁ g) (fun (F # i) a)) idp ∙ @@ -83,9 +74,10 @@ module _ {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} (F : Co open MapsCos A CosCocEq-tot : Type (lmax ℓc (lmax (lmax ℓv ℓe) (lmax ℓd ℓ))) - CosCocEq-tot = Σ ((i : Obj Γ) → (Σ (F # i *→ T) (λ g → < F # i > comp K₁ i ∼ g))) (λ H → ((i j : Obj Γ) (g : Hom Γ i j) → - Σ (Σ (fst (fst (H j)) ∘ fst (F <#> g) ∼ fst (fst (H i))) - (λ K → (x : ty (F # i)) → ! (fst (snd (H j)) (fst (F <#> g) x)) ∙ fst (comTri K₁ g) x ∙ fst (snd (H i)) x == K x)) + CosCocEq-tot = + Σ ((i : Obj Γ) → (Σ (F # i *→ T) (λ g → < F # i > comp K₁ i ∼ g))) (λ H → ((i j : Obj Γ) (g : Hom Γ i j) → + Σ (Σ (fst (fst (H j)) ∘ fst (F <#> g) ∼ fst (fst (H i))) + (λ K → (x : ty (F # i)) → ! (fst (snd (H j)) (fst (F <#> g) x)) ∙ fst (comTri K₁ g) x ∙ fst (snd (H i)) x == K x)) (λ (K , R) → Σ ((a : A) → ! (K (fun (F # i) a)) ∙ ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a == snd (fst (H i)) a) (λ J → ((a : A) → ! (ap (λ p → ! p ∙ ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a) (R (fun (F # i) a))) ∙ ↯ (ϕ H i j g a) == J a))))) module CCEq-Σ where @@ -93,37 +85,42 @@ module _ {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} (F : Co ! (! (fst (snd (H j)) (fst (F <#> g) (fun (F # i) a))) ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a =-= snd (fst (H i)) a - ϕ H i j g a = ! (! (fst (snd (H j)) (fst (F <#> g) (fun (F # i) a))) ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ ap (fst (fst (H j))) - (snd (F <#> g) a) ∙ snd (fst (H j)) a - =⟪ ap (λ p → ! (p ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a) - (hmtpy-nat-rev (fst (snd (H j))) (snd (F <#> g) a) (snd (comp K₁ j) a)) ⟫ - ! ((ap (fst (fst (H j))) (snd (F <#> g) a) ∙ ((! (fst (snd (H j)) (fun (F # j) a)) ∙ snd (comp K₁ j) a) ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) - (snd (F <#> g) a))) ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a - =⟪ ap (λ p → ! ((ap (fst (fst (H j))) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) (snd (F <#> g) a))) ∙ - fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a) (snd (snd (H j)) a) ⟫ - ! ((ap (fst (fst (H j))) (snd (F <#> g) a) ∙ (snd (fst (H j)) a ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) (snd (F <#> g) a))) ∙ - fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a - =⟪ long-path-red (snd (F <#> g) a) (snd (fst (H j)) a) (snd (comp K₁ j) a) (fst (comTri K₁ g) (fun (F # i) a)) (fst (snd (H i)) (fun (F # i) a)) ⟫ - ! (fst (snd (H i)) (fun (F # i) a)) ∙ ! (fst (comTri K₁ g) (fun (F # i) a)) ∙ ap (fst (comp K₁ j)) (snd (F <#> g) a) ∙ snd (comp K₁ j) a - =⟪ ap (λ p → ! (fst (snd (H i)) (fun (F # i) a)) ∙ p) (snd (comTri K₁ g) a) ⟫ - ! (fst (snd (H i)) (fun (F # i) a)) ∙ snd (comp K₁ i) a - =⟪ snd (snd (H i)) a ⟫ - snd (fst (H i)) a ∎∎ + ϕ H i j g a = + ! (! (fst (snd (H j)) (fst (F <#> g) (fun (F # i) a))) ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ + ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a + =⟪ ap (λ p → ! (p ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a) + (hmtpy-nat-rev (fst (snd (H j))) (snd (F <#> g) a) (snd (comp K₁ j) a)) ⟫ + ! ((ap (fst (fst (H j))) (snd (F <#> g) a) ∙ ((! (fst (snd (H j)) (fun (F # j) a)) ∙ snd (comp K₁ j) a) ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) + (snd (F <#> g) a))) ∙ fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a + =⟪ ap (λ p → ! ((ap (fst (fst (H j))) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) (snd (F <#> g) a))) ∙ + fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ + ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a) (snd (snd (H j)) a) ⟫ + ! ((ap (fst (fst (H j))) (snd (F <#> g) a) ∙ (snd (fst (H j)) a ∙ ! (snd (comp K₁ j) a)) ∙ ! (ap (fst (comp K₁ j)) (snd (F <#> g) a))) ∙ + fst (comTri K₁ g) (fun (F # i) a) ∙ fst (snd (H i)) (fun (F # i) a)) ∙ ap (fst (fst (H j))) (snd (F <#> g) a) ∙ snd (fst (H j)) a + =⟪ long-path-red (snd (F <#> g) a) (snd (fst (H j)) a) (snd (comp K₁ j) a) (fst (comTri K₁ g) (fun (F # i) a)) (fst (snd (H i)) (fun (F # i) a)) ⟫ + ! (fst (snd (H i)) (fun (F # i) a)) ∙ ! (fst (comTri K₁ g) (fun (F # i) a)) ∙ ap (fst (comp K₁ j)) (snd (F <#> g) a) ∙ snd (comp K₁ j) a + =⟪ ap (λ p → ! (fst (snd (H i)) (fun (F # i) a)) ∙ p) (snd (comTri K₁ g) a) ⟫ + ! (fst (snd (H i)) (fun (F # i) a)) ∙ snd (comp K₁ i) a + =⟪ snd (snd (H i)) a ⟫ + snd (fst (H i)) a ∎∎ CosCocEq-tot-contr : is-contr (CosCocEq-tot) - CosCocEq-tot-contr = equiv-preserves-level ((Σ-contr-red (Π-level (λ i → PtFunHomContr (comp K₁ i))))⁻¹) {{Π-level (λ i → (Π-level (λ j → (Π-level (λ g → - equiv-preserves-level ((Σ-contr-red (FunHomContr {f = λ z → (fst (comTri K₁ g) z) ∙ idp}))⁻¹) - {{FunHomContr {f = λ a → ↯ (CCEq-Σ.ϕ (λ i → (comp K₁ i , (λ x → idp) , (λ a → idp))) i j g a)}}})))))}} + CosCocEq-tot-contr = + equiv-preserves-level ((Σ-contr-red (Π-level (λ i → PtFunHomContr (comp K₁ i))))⁻¹) + {{Π-level (λ i → (Π-level (λ j → (Π-level (λ g → equiv-preserves-level ((Σ-contr-red (FunHomContr {f = λ z → (fst (comTri K₁ g) z) ∙ idp}))⁻¹) + {{FunHomContr {f = λ a → ↯ (CCEq-Σ.ϕ (λ i → (comp K₁ i , (λ x → idp) , (λ a → idp))) i j g a)}}})))))}} CosCocEq-eq : CosCocEq-tot ≃ Σ (CosCocone A F T) (λ K₂ → CosCocEq K₂) - CosCocEq-eq = equiv (λ x → ((λ i → fst (fst x i)) & (λ {j} {i} g → (fst (fst (snd x i j g))) , (fst (snd (snd x i j g))))) , CocEq (λ i x₁ → fst (snd (fst x i)) x₁) - (λ i a → snd (snd (fst x i)) a) (λ {i} {j} g → (λ x₁ → snd (fst (snd x i j g)) x₁ ) , λ a → =ₛ-in (snd (snd (snd x i j g)) a))) - (λ ((r & K) , e) → (λ i → r i , (CosCocEq.W e i) , (CosCocEq.u e i)) , λ i j g → (fst (K g) , fst (CosCocEq.Λ e g)) , (snd (K g)) , (λ a → =ₛ-out (snd (CosCocEq.Λ e g) a))) - (λ b → idp) λ a → idp + CosCocEq-eq = + equiv (λ x → ((λ i → fst (fst x i)) & (λ {j} {i} g → (fst (fst (snd x i j g))) , (fst (snd (snd x i j g))))) , + CocEq (λ i x₁ → fst (snd (fst x i)) x₁) + (λ i a → snd (snd (fst x i)) a) (λ {i} {j} g → (λ x₁ → snd (fst (snd x i j g)) x₁ ) , λ a → =ₛ-in (snd (snd (snd x i j g)) a))) + (λ ((r & K) , e) → (λ i → r i , (CosCocEq.W e i) , (CosCocEq.u e i)) , λ i j g → (fst (K g) , fst (CosCocEq.Λ e g)) , (snd (K g)) , + (λ a → =ₛ-out (snd (CosCocEq.Λ e g) a))) + (λ b → idp) λ a → idp CosCocEq-IDsys : ID-sys (CosCocone A F T) (λ K → CosCocEq K) K₁ center-CCEq CosCocEq-IDsys p = contr-has-all-paths {{(equiv-preserves-level CosCocEq-eq {{CosCocEq-tot-contr}}) }} (K₁ , center-CCEq) p CosCocEq-ind : {K₂ : CosCocone A F T} → CosCocEq K₂ → K₁ == K₂ CosCocEq-ind {K₂} e = ind (ID-ind {P = λ K s → K₁ == K} CosCocEq-IDsys) idp K₂ e - diff --git a/Colimit-code/Aux/FTID.agda b/Colimit-code/Aux/FTID.agda index 9980297..691b5f1 100644 --- a/Colimit-code/Aux/FTID.agda +++ b/Colimit-code/Aux/FTID.agda @@ -73,7 +73,8 @@ module _ {ℓ₁ ℓ₂ ℓ₃ ℓ₄ ℓ₅} {A : Type ℓ₁} {B : Type ℓ₂ ap k s ∙ ! (ap f (! (ap u (ap v p)) ∙ r x ∙ ap τ s) ∙ fₚ (h y)) cmp-helper {x = x} {y = y} p s r {k = k} fₚ = IndFunHom {P = λ m F → ! (ap (f ∘ u) (ap v p)) ∙ (ap (f ∘ u) (ap v p) ∙ (ap f (r y) ∙ F (h y)) ∙ ! (ap m s)) ∙ ap m s ∙ ! (ap f (r y) ∙ F (h y)) - == ! (ap (f ∘ u) (ap v p)) ∙ (ap f (r x) ∙ F (h x)) ∙ ap m s ∙ ! (ap f (! (ap u (ap v p)) ∙ r x ∙ ap τ s) ∙ F (h y))} (coher1 s p (r y) ∙ coher2 s p (r x)) k fₚ + == ! (ap (f ∘ u) (ap v p)) ∙ (ap f (r x) ∙ F (h x)) ∙ ap m s ∙ ! (ap f (! (ap u (ap v p)) ∙ r x ∙ ap τ s) ∙ F (h y))} + (coher1 s p (r y) ∙ coher2 s p (r x)) k fₚ module CMPH where coher1 : {a b : A} (σ : a == b) {c d : C} (P : c == d) (R : u (v d) == τ b) → ! (ap (f ∘ u) (ap v P)) ∙ (ap (f ∘ u) (ap v P) ∙ (ap f R ∙ idp) ∙ ! (ap (f ∘ τ) σ)) ∙ ap (f ∘ τ) σ ∙ ! (ap f R ∙ idp) == idp @@ -101,7 +102,7 @@ module _ {i j k} {A : Type j} {X : Coslice i j A} {Y : Coslice k j A} (f : < A > Σ ((a : A) → h (fun X a) == fun Y a) (λ p → ((a : A) → ! (K (fun X a)) ∙ (snd f a) == p a)))) PtFunHomContr-aux = equiv-preserves-level ((Σ-contr-red {P = (λ (h , K) → Σ ((a : A) → h (fun X a) == fun Y a) (λ p → ((a : A) → ! (K (fun X a)) ∙ (snd f a) == p a)))} - (FunHomContr {f = fst f}))⁻¹) {{equiv-preserves-level ((Σ-emap-r (λ q → app=-equiv))) {{pathfrom-is-contr (snd f)}} }} + (FunHomContr {f = fst f}))⁻¹) {{ equiv-preserves-level ((Σ-emap-r (λ q → app=-equiv))) {{pathfrom-is-contr (snd f)}} }} open MapsCos A diff --git a/Colimit-code/Aux/Helper-paths.agda b/Colimit-code/Aux/Helper-paths.agda index 3a08318..11c2695 100644 --- a/Colimit-code/Aux/Helper-paths.agda +++ b/Colimit-code/Aux/Helper-paths.agda @@ -9,11 +9,37 @@ module _ {ℓ₁} {A : Type ℓ₁} where ap-idf-rid : {x y : A} (p : x == y) → p == ap (λ z → z) p ∙ idp ap-idf-rid idp = idp + ap-idp-unit-r : {x y : A} (p : x == y) + → ap ! (∙-unit-r p) ∙ ! (ap (λ q → q) (∙-unit-r (! p))) ∙ idp == !-∙ p idp ∙ ! (∙-unit-r (! p)) + ap-idp-unit-r idp = idp + + neg-rid-trip : {a b : A} (q : a == b) → ! q == ((! q ∙ idp) ∙ idp) ∙ idp + neg-rid-trip idp = idp + + !-∙-!-!-rid : {a b c : A} (q₁ : a == b) (q₂ : a == c) → ! q₂ == ((! q₂ ∙ q₁) ∙ ! q₁) ∙ idp + !-∙-!-!-rid idp q₂ = neg-rid-trip q₂ + + neg-rid-trip-inv : {a b c : A} (q₁ : a == b) (q₂ : b == c) → ! (((q₁ ∙ q₂) ∙ ! q₂) ∙ q₂) ∙ q₁ == ! q₂ + neg-rid-trip-inv idp idp = idp + + db-neg-rid-db : {a b c : A} (q : a == b) (p : c == b) → ! (((q ∙ ! p) ∙ idp) ∙ idp) ∙ q == p + db-neg-rid-db q idp = neg-rid-trip-inv q idp + + !-∙-!-rid-∙-rid : {x y w z : A} (p : x == y) (q : w == z) (r : x == z) + → ! (((q ∙ ! r) ∙ idp) ∙ p ∙ idp) ∙ q == ! p ∙ r + !-∙-!-rid-∙-rid idp q r = db-neg-rid-db q r + module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} (f : A → B) where ap-inv-rid : {x y : A} (p : x == y) → ap f (! p) ∙ idp == ! (ap f p) ap-inv-rid idp = idp +module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} {f g : A → B} where + + hmtpy-nat-rev : (H : f ∼ g) {x y : A} (p : x == y) {z : B} (q : f y == z) → + ! (H x) == ap g p ∙ ((! (H y) ∙ q) ∙ ! q) ∙ ! (ap f p) + hmtpy-nat-rev H {x = x} idp q = !-∙-!-!-rid q (H x) + module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f : A → B) (g : B → C) where ap-inv-cmp-rid : {x y : A} (p : x == y) → ap g (ap f p) ∙ idp == ap (g ∘ f) p @@ -22,27 +48,28 @@ module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ap-inv-cmp-rid2 : {x y z : A} (p₁ : x == y) (p₂ : y == z) → ap g (ap f p₁ ∙ ap f p₂) ∙ idp == ap (g ∘ f) p₁ ∙ ap (g ∘ f) p₂ ap-inv-cmp-rid2 idp idp = idp -module _ {ℓ₁ ℓ₂} {B : Type ℓ₁} {C : Type ℓ₂} (g : B → C) where +module _ {ℓ₁ ℓ₂ ℓ₃} {B : Type ℓ₁} {C : Type ℓ₂} {E : Type ℓ₃} (g : B → C) where - ap-cmp-inv-loop : ∀ {ℓ} {E : Type ℓ} (k : E → B) {x : E} {y : B} (q : y == k x) (Q : x == x) → ap g (q ∙ ap k Q ∙ ap k Q) ∙ idp == (ap g q ∙ ap (g ∘ k) Q) ∙ ap (g ∘ k) Q + ap-cmp-inv-loop : (k : E → B) {x : E} {y : B} (q : y == k x) (Q : x == x) → ap g (q ∙ ap k Q ∙ ap k Q) ∙ idp == (ap g q ∙ ap (g ∘ k) Q) ∙ ap (g ∘ k) Q ap-cmp-inv-loop k idp Q = ap-inv-cmp-rid2 k g Q Q module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f : A → B) (g : B → C) where - long-path-red2 : ∀ {ℓ₄ ℓ₅} {D : Type ℓ₄} {E : Type ℓ₅} (h : D → A) (k : E → B) {x y : D} (s : x == y) {a : A} (t : h x == a) {z : E} (q : k z == f (h y)) (Q : z == z) - → ap g (! (ap f (! (ap h s) ∙ t)) ∙ ! q ∙ ap k Q ∙ ap k Q) ∙ idp == (! (ap (g ∘ f) t) ∙ ap (g ∘ f ∘ h) s ∙ (ap g (! q) ∙ ap (g ∘ k) Q)) ∙ ap (g ∘ k) Q + long-path-red2 : ∀ {ℓ₄ ℓ₅} {D : Type ℓ₄} {E : Type ℓ₅} (h : D → A) (k : E → B) {x y : D} (s : x == y) {a : A} (t : h x == a) + {z : E} (q : k z == f (h y)) (Q : z == z) → + ap g (! (ap f (! (ap h s) ∙ t)) ∙ ! q ∙ ap k Q ∙ ap k Q) ∙ idp == (! (ap (g ∘ f) t) ∙ ap (g ∘ f ∘ h) s ∙ (ap g (! q) ∙ ap (g ∘ k) Q)) ∙ ap (g ∘ k) Q long-path-red2 h k idp idp q Q = ap-cmp-inv-loop g k (! q) Q module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} (f g : A → B) where - tranp-inv-comm : {x y : A} (p : x == y) (q : f x == g x) → transport (λ z → g z == f z) p (! q) == ! (transport (λ z → f z == g z) p q) - tranp-inv-comm idp q = idp + transp-inv-comm : {x y : A} (p : x == y) (q : f x == g x) → transport (λ z → g z == f z) p (! q) == ! (transport (λ z → f z == g z) p q) + transp-inv-comm idp q = idp - apd-tr-inv-fn : (q : (z : A) → f z == g z) {x y : A} (p : x == y) → apd-tr (λ z → ! (q z)) p ◃∎ =ₛ tranp-inv-comm p (q x) ◃∙ ap ! (apd-tr q p) ◃∎ + apd-tr-inv-fn : (q : (z : A) → f z == g z) {x y : A} (p : x == y) → apd-tr (λ z → ! (q z)) p ◃∎ =ₛ transp-inv-comm p (q x) ◃∙ ap ! (apd-tr q p) ◃∎ apd-tr-inv-fn q idp = =ₛ-in idp module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : A → Type ℓ₂} where apd-tr-coher : (f g : (x : A) → B x) {x y : A} (p : x == y) (q : (z : A) → f z == g z) → q y == ! (apd-tr f p) ∙ ap (transport B p) (q x) ∙ apd-tr g p - apd-tr-coher f g {x = x} idp q = ap-idf-rid (q x) + apd-tr-coher f g {x = x} idp q = ap-idf-rid (q x) diff --git a/Colimit-code/L-R-L/CC-Equiv-LRL-0.agda b/Colimit-code/L-R-L/CC-Equiv-LRL-0.agda index 0e1910a..f4cfdf9 100644 --- a/Colimit-code/L-R-L/CC-Equiv-LRL-0.agda +++ b/Colimit-code/L-R-L/CC-Equiv-LRL-0.agda @@ -1,10 +1,8 @@ {-# OPTIONS --without-K --rewriting #-} open import lib.Basics -open import lib.types.Sigma open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim diff --git a/Colimit-code/L-R-L/CC-Equiv-LRL-1.agda b/Colimit-code/L-R-L/CC-Equiv-LRL-1.agda index 8fff5a8..742908c 100644 --- a/Colimit-code/L-R-L/CC-Equiv-LRL-1.agda +++ b/Colimit-code/L-R-L/CC-Equiv-LRL-1.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -28,10 +27,11 @@ module Constr2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( abstract γ-β : apd-tr (RfunEq (f , fₚ)) (cglue g (fun (F # i) a)) == ↯ (V f fₚ i j g (fun (F # i) a)) - γ-β = apd-to-tr (λ x → f (right x) == H (right x)) (RfunEq (f , fₚ)) (cglue g (fun (F # i) a)) - (↯ (V f fₚ i j g (fun (F # i) a))) (cglue-β (λ i x → idp) - (λ i → λ j → λ g → λ x → from-transp-g (λ z → (f ∘ right) z == (fst (RLfun (f , fₚ)) ∘ right) z) - (cglue g x) (↯ (V f fₚ i j g x))) g (fun (F # i) a)) + γ-β = + apd-to-tr (λ x → f (right x) == H (right x)) (RfunEq (f , fₚ)) (cglue g (fun (F # i) a)) + (↯ (V f fₚ i j g (fun (F # i) a))) (cglue-β (λ i x → idp) + (λ i → λ j → λ g → λ x → from-transp-g (λ z → (f ∘ right) z == (fst (RLfun (f , fₚ)) ∘ right) z) + (cglue g x) (↯ (V f fₚ i j g x))) g (fun (F # i) a)) module _ where @@ -73,10 +73,12 @@ module Constr2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( transport (λ x → f (right (ψ x)) == f (right (ψ x))) (cglue g a) s ∎∎ MidRW : ap (λ s → transport (λ x → f (right (ψ x)) == H (right (ψ x))) (cglue g a) s) - (ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∎ - =ₛ ↯ (transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a))) ◃∙ - ap (λ s → transport (λ x → f (right (ψ x)) == f (right (ψ x))) (cglue g a) s) - (ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ ! (↯ (transpEq-s idp)) ◃∎ + (ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∎ + =ₛ + ↯ (transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a))) ◃∙ + ap (λ s → transport (λ x → f (right (ψ x)) == f (right (ψ x))) (cglue g a) s) + (ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ + ! (↯ (transpEq-s idp)) ◃∎ MidRW = =ₛ-in (apeq-rev (λ s → ↯ (transpEq-s s)) (ap-inv-canc f (glue (cin j a)) (fₚ a))) @@ -114,8 +116,8 @@ module Constr2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( == ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ (ap f (! (glue (cin j a))) ∙ F a) ∙ ! (ap f (! (ap right (ap ψ (cglue g a))) ∙ ! (glue (cin j a)) ∙ idp) ∙ F a)} (CMPH.coher1 {τ = left} {h = [id]} {v = ψ} {u = right} (cglue g a) idp (λ x → ! (glue x)) (λ x₁ → idp) idp (cglue g a) (! (glue (cin i a))) ∙ CMPH.coher2 {τ = left} {h = [id]} {v = ψ} {u = right} (cglue g a) idp (λ x → ! (glue x)) (λ x₁ → idp) idp (cglue g a) (! (glue (cin j a))) ) ⟩ - (! (O₅ idp (cglue g a) (ap f (! (glue (cin i a))) ∙ idp)) ◃∙ - (CMPH.coher1 {τ = left} {h = [id]} {v = ψ} {u = right} (cglue g a) idp (λ x → ! (glue x)) (λ x₁ → idp) idp (cglue g a) (! (glue (cin i a))) ∙ + (! (O₅ idp (cglue g a) (ap f (! (glue (cin i a))) ∙ idp)) ◃∙ + (CMPH.coher1 {τ = left} {h = [id]} {v = ψ} {u = right} (cglue g a) idp (λ x → ! (glue x)) (λ x₁ → idp) idp (cglue g a) (! (glue (cin i a))) ∙ CMPH.coher2 {τ = left} {h = [id]} {v = ψ} {u = right} (cglue g a) idp (λ x → ! (glue x)) (λ x₁ → idp) idp (cglue g a) (! (glue (cin j a)))) ◃∙ inv-canc-cmp f right (ap ψ (cglue g a)) (! (glue (cin j a))) idp ◃∎) =ₛ₁⟨ CoherLemma (cglue g a) ⟩ @@ -158,8 +160,10 @@ module Constr2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( → p₁ ∙ p₂ ∙ p₃ ∙ p₄ == p₁ ∙ (p₂ ∙ p₃) ∙ p₄ assoc4 idp idp idp p₄ = idp - RightRW₂ : seq-! (transpEq-s idp) ∙∙ apd-comp-ap {γ = RfunEq (f , fₚ)} (cglue g a) ◃∙ ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ - apd-helper {F = λ x → f (right x) == H (right x)} {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ ↯ (V f fₚ i j g (fun (F # i) a)) ◃∎ + RightRW₂ : seq-! (transpEq-s idp) ∙∙ apd-comp-ap {γ = RfunEq (f , fₚ)} (cglue g a) ◃∙ + ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ + apd-helper {F = λ x → f (right x) == H (right x)} {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ + ↯ (V f fₚ i j g (fun (F # i) a)) ◃∎ =ₛ ! (O₅ idp (cglue g a) (ap f (! (glue (cin i a))) ∙ fₚ a)) ◃∙ ! (ap (λ p → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ p ∙ ! (ap f (! (glue (cin i a))) ∙ fₚ a)) (O₄ (λ x → ap f (! (glue x)) ∙ fₚ ([id] x)) (cglue g a) (id-βr g a)) ) ◃∙ @@ -180,8 +184,10 @@ module Constr2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( (transp-pth (cglue g (fun (F # i) a)) idp ∙ ap (_∙_ (! (ap (f ∘ right) (cglue g (fun (F # i) a))))) (recc-βr (PostComp ColCoC (f , fₚ)) g (fun (F # i) a)) ∙ cmp-inv-l {f = right} {g = f} (cglue g (fun (F # i) a))) ◃∎ - RightRW₂ = seq-! (transpEq-s idp) ∙∙ apd-comp-ap {γ = RfunEq (f , fₚ)} (cglue g a) ◃∙ ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ - apd-helper {F = λ x → f (right x) == H (right x)} {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ ↯ (V f fₚ i j g (fun (F # i) a)) ◃∎ + RightRW₂ = seq-! (transpEq-s idp) ∙∙ apd-comp-ap {γ = RfunEq (f , fₚ)} (cglue g a) ◃∙ + ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ + apd-helper {F = λ x → f (right x) == H (right x)} {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ + ↯ (V f fₚ i j g (fun (F # i) a)) ◃∎ =ₛ⟨ 2 & 1 & PathSeq2 F g a T f fₚ ⟩ ! (O₅ idp (cglue g a) (ap f (! (glue (cin i a))) ∙ fₚ a)) ◃∙ ! (ap (λ p → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ p ∙ ! (ap f (! (glue (cin i a))) ∙ fₚ a)) (O₄ (λ x → ap f (! (glue x)) ∙ fₚ ([id] x)) @@ -201,15 +207,16 @@ module Constr2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ apd-helper {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ (transp-pth (cglue g (fun (F # i) a)) idp ∙ - ap (_∙_ (! (ap (f ∘ right) (cglue g (fun (F # i) a))))) (recc-βr (PostComp ColCoC (f , fₚ)) g (fun (F # i) a)) ∙ - cmp-inv-l {f = right} {g = f} (cglue g (fun (F # i) a))) ◃∎ ∎ₛ + ap (_∙_ (! (ap (f ∘ right) (cglue g (fun (F # i) a))))) (recc-βr (PostComp ColCoC (f , fₚ)) g (fun (F # i) a)) ∙ + cmp-inv-l {f = right} {g = f} (cglue g (fun (F # i) a))) ◃∎ ∎ₛ module _ where abstract - ζ₁ : {x : Colim (ConsDiag Γ A)} (Q : cin j a == x) {w : ty (F # j)} (u : w == fun (F # j) a) (v : cin j w == ψ x) (T₁ : ap ψ Q == ! (ap (cin j) u) ∙ v) - {L : f (right (cin j w)) == reccForg K (ψ x)} (T₂ : ap (reccForg K) v == L) {z : ty T} (σ : f (right (cin j (fun (F # j) a))) == z) + ζ₁ : {x : Colim (ConsDiag Γ A)} (Q : cin j a == x) {w : ty (F # j)} (u : w == fun (F # j) a) (v : cin j w == ψ x) + (T₁ : ap ψ Q == ! (ap (cin j) u) ∙ v) {L : f (right (cin j w)) == reccForg K (ψ x)} (T₂ : ap (reccForg K) v == L) + {z : ty T} (σ : f (right (cin j (fun (F # j) a))) == z) → (! (O₂ {p = ! (ap (f ∘ right) (ap ψ Q))} {g = cin j} {q = idp} u σ v T₂)) ∙ (! (O₁ {g = H ∘ right} idp Q T₁)) ∙ apd-comp-ap {γ = RfunEq (f , fₚ)} Q ∙ ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) T₁ ∙ @@ -250,7 +257,7 @@ module Constr2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( (transp-pth (cglue g (fun (F # i) a)) idp ∙ ap (_∙_ (! (ap (f ∘ right) (cglue g (fun (F # i) a))))) (recc-βr (PostComp ColCoC (f , fₚ)) g (fun (F # i) a)) ∙ cmp-inv-l {f = right} {g = f} (cglue g (fun (F # i) a))) ◃∎ - =ₛ (! (O₅ idp (cglue g a) (ap f (! (glue (cin i a))) ∙ fₚ a)) ∙ + =ₛ (! (O₅ idp (cglue g a) (ap f (! (glue (cin i a))) ∙ fₚ a)) ∙ ! (ap (λ p → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ p ∙ ! (ap f (! (glue (cin i a))) ∙ fₚ a)) (O₄ (λ x → ap f (! (glue x)) ∙ fₚ ([id] x)) (cglue g a) (id-βr g a)) ) ∙ ! (ap (λ q → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) (ap ! (ap (λ q → q ∙ fₚ a) (ap (ap f) @@ -276,13 +283,23 @@ module Constr2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( abstract - RightRW₁ : ! (↯ (transpEq-s idp)) ◃∙ apd-tr (λ x → RfunEq (f , fₚ) (ψ x)) (cglue g a) ◃∎ - =ₛ seq-! (transpEq-s idp) ∙∙ apd-comp-ap {γ = RfunEq (f , fₚ)} (cglue g a) ◃∙ ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ - apd-helper {F = λ x → f (right x) == H (right x)} {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ ↯ (V f fₚ i j g (fun (F # i) a)) ◃∎ - RightRW₁ = ! (↯ (transpEq-s idp)) ◃∙ apd-tr (λ x → RfunEq (f , fₚ) (ψ x)) (cglue g a) ◃∎ - =ₛ⟨ 1 & 1 & apdRW2 ⟩ - ! (↯ (transpEq-s idp)) ◃∙ apd-comp-ap {γ = RfunEq (f , fₚ)} (cglue g a) ◃∙ ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ - apd-helper {F = λ x → f (right x) == H (right x)} {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ ↯ (V f fₚ i j g (fun (F # i) a)) ◃∎ - =ₛ⟨ 0 & 1 & !-∙-seq (transpEq-s idp) ⟩ - seq-! (transpEq-s idp) ∙∙ apd-comp-ap {γ = RfunEq (f , fₚ)} (cglue g a) ◃∙ ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ - apd-helper {F = λ x → f (right x) == H (right x)} {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ ↯ (V f fₚ i j g (fun (F # i) a)) ◃∎ ∎ₛ + RightRW₁ : + ! (↯ (transpEq-s idp)) ◃∙ apd-tr (λ x → RfunEq (f , fₚ) (ψ x)) (cglue g a) ◃∎ + =ₛ + seq-! (transpEq-s idp) ∙∙ apd-comp-ap {γ = RfunEq (f , fₚ)} (cglue g a) ◃∙ + ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ + apd-helper {F = λ x → f (right x) == H (right x)} {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ + ↯ (V f fₚ i j g (fun (F # i) a)) ◃∎ + RightRW₁ = + ! (↯ (transpEq-s idp)) ◃∙ apd-tr (λ x → RfunEq (f , fₚ) (ψ x)) (cglue g a) ◃∎ + =ₛ⟨ 1 & 1 & apdRW2 ⟩ + ! (↯ (transpEq-s idp)) ◃∙ + apd-comp-ap {γ = RfunEq (f , fₚ)} (cglue g a) ◃∙ + ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ + apd-helper {F = λ x → f (right x) == H (right x)} {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ + ↯ (V f fₚ i j g (fun (F # i) a)) ◃∎ + =ₛ⟨ 0 & 1 & !-∙-seq (transpEq-s idp) ⟩ + seq-! (transpEq-s idp) ∙∙ apd-comp-ap {γ = RfunEq (f , fₚ)} (cglue g a) ◃∙ + ap (λ p → transport (λ x → f (right x) == H (right x)) p idp) (ψ-βr g a) ◃∙ + apd-helper {F = λ x → f (right x) == H (right x)} {γ = RfunEq (f , fₚ)} (! (ap (cin j) (snd (F <#> g) a))) ◃∙ + ↯ (V f fₚ i j g (fun (F # i) a)) ◃∎ ∎ₛ diff --git a/Colimit-code/L-R-L/CC-Equiv-LRL-2.agda b/Colimit-code/L-R-L/CC-Equiv-LRL-2.agda index ba9347c..b161174 100644 --- a/Colimit-code/L-R-L/CC-Equiv-LRL-2.agda +++ b/Colimit-code/L-R-L/CC-Equiv-LRL-2.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -24,7 +23,7 @@ module Constr3 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( abstract - SliceRW : ! (ap (λ q → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) + SliceRW : ! (ap (λ q → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) (ap ! (ap (λ q → q ∙ fₚ a) (ap (ap f) (E₂-v2 (ψ-βr g a) (! (glue (cin j (idf A a))))))))) ◃∙ ! (ap (λ q → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) (ap ! (ap (λ q → q ∙ fₚ a) (ap (ap f) (E₁-v2 (snd (F <#> g) a)))))) ◃∙ @@ -41,7 +40,7 @@ module Constr3 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( cmp-inv-l {f = right} {g = f} (cglue g (fun (F # i) a)) ◃∎ =ₛ inv-canc-cmp f right (ap ψ (cglue g a)) (! (glue (cin j (idf A a)))) (fₚ a) ◃∎ - SliceRW = ! (ap (λ q → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) + SliceRW = ! (ap (λ q → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) (ap ! (ap (λ q → q ∙ fₚ a) (ap (ap f) (E₂-v2 (ψ-βr g a) (! (glue (cin j (idf A a))))))))) ◃∙ ! (ap (λ q → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) (ap ! (ap (λ q → q ∙ fₚ a) (ap (ap f) (E₁-v2 (snd (F <#> g) a)))))) ◃∙ @@ -92,34 +91,20 @@ module Constr3 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( ap (_∙_ (! (ap (f ∘ right) (cglue g (fun (F # i) a))))) (recc-βr (PostComp ColCoC (f , fₚ)) g (fun (F # i) a)) ∙ cmp-inv-l {f = right} {g = f} (cglue g (fun (F # i) a)))) ◃∎ =ₛ - ! (O₅ idp (cglue g a) (ap f (! (glue (cin i a))) ∙ fₚ a)) ◃∙ + ! (O₅ idp (cglue g a) (ap f (! (glue (cin i a))) ∙ fₚ a)) ◃∙ ! (ap (λ p → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ p ∙ ! (ap f (! (glue (cin i a))) ∙ fₚ a)) (O₄ {f = f ∘ right} {h = ψ} {u = fun T} (λ x → ap f (! (glue x)) ∙ fₚ ([id] x)) (cglue g a) (id-βr g a))) ◃∙ ! (ap (λ q → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) (ap ! (ap (λ q → q ∙ fₚ a) (ap (ap f) (E₃-v2 {f = left} {v = ψ} {u = right} (λ x → ! (glue x)) (cglue g a) (id-βr g a)))))) ◃∙ inv-canc-cmp f right (ap ψ (cglue g a)) (! (glue (cin j (idf A a)))) (fₚ a) ◃∎ -- apd-tr-refl {f = f ∘ right} {h = ψ} (cglue g a) ◃∎ RightRW1 = =ₛ-in - (ap - (λ r → - ! (O₅ idp (cglue g a) (ap f (! (glue (cin i a))) ∙ fₚ a)) ∙ - ! - (ap - (λ p → - ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ - p ∙ ! (ap f (! (glue (cin i a))) ∙ fₚ a)) - (O₄ (λ x → ap f (! (glue x)) ∙ fₚ ([id] x)) (cglue g a) - (id-βr g a))) - ∙ - ! - (ap - (λ q → - ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ - (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) - (ap ! - (ap (λ q → q ∙ fₚ a) - (ap (ap f) (E₃-v2 (λ x → ! (glue x)) (cglue g a) (id-βr g a)))))) - ∙ r) - (=ₛ-out SliceRW)) + (ap (λ r → ! (O₅ idp (cglue g a) (ap f (! (glue (cin i a))) ∙ fₚ a)) ∙ + ! (ap (λ p → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ + p ∙ ! (ap f (! (glue (cin i a))) ∙ fₚ a)) (O₄ (λ x → ap f (! (glue x)) ∙ + fₚ ([id] x)) (cglue g a) (id-βr g a))) ∙ ! (ap (λ q → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ + (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) (ap ! (ap (λ q → q ∙ fₚ a) (ap (ap f) + (E₃-v2 (λ x → ! (glue x)) (cglue g a) (id-βr g a)))))) ∙ r) + (=ₛ-out SliceRW)) module _ where diff --git a/Colimit-code/L-R-L/CC-Equiv-LRL-3.agda b/Colimit-code/L-R-L/CC-Equiv-LRL-3.agda index f518c90..f28b106 100644 --- a/Colimit-code/L-R-L/CC-Equiv-LRL-3.agda +++ b/Colimit-code/L-R-L/CC-Equiv-LRL-3.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Cocone @@ -49,10 +48,12 @@ module Constr4 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( ω=ω-switch-ap-inv = !-=ₛ (ap-seq-=ₛ (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω=ω-switch) - PathSeq1 : (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin i a))) ∙ fₚ a) =-= - transport (λ x → f (right (ψ x)) == f (right (ψ x))) (cglue g a) ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) - PathSeq1 = ω-ap-inv ∙∙ (! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ - transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a))) + PathSeq1 : + (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin i a))) ∙ fₚ a) =-= + transport (λ x → f (right (ψ x)) == f (right (ψ x))) (cglue g a) ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) + PathSeq1 = + ω-ap-inv ∙∙ (! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a))) abstract @@ -107,8 +108,8 @@ module Constr4 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( lemma2 idp = lemma3 s where lemma3 : {c : Colim (DiagForg A Γ F)} (S : cin j (fst (F <#> g) (fun (F # i) a)) == c) - → (! (ap (λ q → q) (H₂ {g = cin j} idp idp S idp)) ◃∙ idp ◃∙ O₂ {p = idp} {g = cin j} {q = idp} idp idp S idp ◃∎) =ₛ R2lemma {R = ap (reccForg K) s} idp idp - (! (! (ap (reccForg K) S) ∙ idp)) ◃∎ + → (! (ap (λ q → q) (H₂ {g = cin j} idp idp S idp)) ◃∙ idp ◃∙ O₂ {p = idp} {g = cin j} {q = idp} idp idp S idp ◃∎) =ₛ + R2lemma {R = ap (reccForg K) s} idp idp (! (! (ap (reccForg K) S) ∙ idp)) ◃∎ lemma3 idp = =ₛ-in idp Reduce3 : {x : Colim (ConsDiag Γ A)} (p : cin j a == x) {t : ty T} (V : fun T a == t) @@ -135,8 +136,9 @@ module Constr4 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( ap f (! (glue (cin j a))) ∙ fₚ a)) r s w ◃∎ lemma idp idp w = =ₛ-in idp - Reduce4 : {x : Colim (ConsDiag Γ A)} (p : cin j a == x) {z : A} (e : z == [id] x) {w : ty T} (u : w == fun T z) → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ ! (ap (fun T) e) ∙ ! u - == ! (ap (f ∘ right) (ap ψ p)) ∙ ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) ∙ + Reduce4 : {x : Colim (ConsDiag Γ A)} (p : cin j a == x) {z : A} (e : z == [id] x) {w : ty T} (u : w == fun T z) → + (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ ! (ap (fun T) e) ∙ ! u + == ! (ap (f ∘ right) (ap ψ p)) ∙ ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) ∙ (ap (f ∘ right) (ap ψ p) ∙ (ap f (! (glue x)) ∙ fₚ ([id] x)) ∙ ! (ap (fun T) e)) ∙ ! u Reduce4 idp {z = z} e u = R4lemma (glue (cin j a)) (fₚ a) (! (ap (fun T) e)) (! u) module _ where @@ -179,7 +181,8 @@ module Constr4 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( ω-ap-inv-switch ∙∙ (! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a))) =ₛ⟨ 3 & 3 & CommSq1 (cglue g a) (ψ-βr g a) ⟩ - (range 0 3 ω-ap-inv-switch) ∙∙ (Reduce1 (cglue g a) ◃∙ (range 1 4 (transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a))))) + (range 0 3 ω-ap-inv-switch) ∙∙ (Reduce1 (cglue g a) ◃∙ (range 1 4 (transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ + ! (ap f (! (glue (cin j a))) ∙ fₚ a))))) =ₛ⟨ 2 & 3 & CommSq2 (cglue g a) (recc-βr K g (fun (F # i) a)) ⟩ (range 0 2 ω-ap-inv-switch) ∙∙ (Reduce2 (cglue g a) {R = ap f (ap right (cglue g (fun (F # i) a)))} ◃∙ (range 2 3 (transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a))))) @@ -194,7 +197,8 @@ module Constr4 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( abstract - apdRW1 : apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ σ (comp K) (comTri K) x) (cglue g a) ◃∎ =ₛ + apdRW1 : + apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ σ (comp K) (comTri K) x) (cglue g a) ◃∎ =ₛ apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a) ◃∙ ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (↯ ω) ◃∎ apdRW1 = apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ σ (comp K) (comTri K) x) (cglue g a) ◃∎ diff --git a/Colimit-code/L-R-L/CC-Equiv-LRL-4.agda b/Colimit-code/L-R-L/CC-Equiv-LRL-4.agda index 52fe567..e1d8986 100644 --- a/Colimit-code/L-R-L/CC-Equiv-LRL-4.agda +++ b/Colimit-code/L-R-L/CC-Equiv-LRL-4.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -21,48 +20,58 @@ module Constr5 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( abstract - LeftRW₁ : (! (ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (↯ ω))) ◃∙ ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} - (cglue g a)) ◃∙ - transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) - =ₛ - (! (↯ (ap-seq (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω))) ◃∙ ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} - (cglue g a)) ◃∙ - transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) - LeftRW₁ = (! (ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (↯ ω))) ◃∙ ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} - (cglue g a)) ◃∙ - transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) - =ₛ⟨ =ₛ-in (ap (λ r → r ∙ ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ∙ - ↯ (transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)))) - (ap ! (=ₛ-out (ap-seq-∙ (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω)))) ⟩ - (! (↯ (ap-seq (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω))) ◃∙ ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} - (cglue g a)) ◃∙ - transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) ∎ₛ + LeftRW₁ : + (! (ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (↯ ω))) ◃∙ + ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) + =ₛ + (! (↯ (ap-seq (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω))) ◃∙ + ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) + LeftRW₁ = + (! (ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (↯ ω))) ◃∙ + ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) + =ₛ⟨ =ₛ-in (ap (λ r → r ∙ ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ∙ + ↯ (transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)))) + (ap ! (=ₛ-out (ap-seq-∙ (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω)))) ⟩ + (! (↯ (ap-seq (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω))) ◃∙ + ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) ∎ₛ - LeftRW₀ : (! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ σ (comp K) (comTri K) x) (cglue g a))) ◃∙ transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ - ! (ap f (! (glue (cin j a))) ∙ fₚ a)) + LeftRW₀ : + (! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ σ (comp K) (comTri K) x) (cglue g a))) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) =ₛ - (! (ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (↯ ω))) ◃∙ ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ + (! (ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (↯ ω))) ◃∙ + ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) + LeftRW₀ = + (! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ σ (comp K) (comTri K) x) (cglue g a))) ◃∙ transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) - LeftRW₀ = (! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ σ (comp K) (comTri K) x) (cglue g a))) ◃∙ transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ - ! (ap f (! (glue (cin j a))) ∙ fₚ a)) - =ₛ⟨ 0 & 1 & !-=ₛ apdRW1 ⟩ - (! (ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (↯ ω))) ◃∙ - ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ - transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) ∎ₛ + =ₛ⟨ 0 & 1 & !-=ₛ apdRW1 ⟩ + (! (ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (↯ ω))) ◃∙ + ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) ∎ₛ - LeftRW₂ : (! (↯ (ap-seq (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω))) ◃∙ ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} - {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ - transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) - =ₛ PathSeq1 - LeftRW₂ = (! (↯ (ap-seq (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω))) ◃∙ ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} - {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ - transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) - =ₛ⟨ 0 & 1 & !-∙-seq (ap-seq (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω) ⟩ - PathSeq1 ∎ₛ + LeftRW₂ : + (! (↯ (ap-seq (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω))) ◃∙ + ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) + =ₛ + PathSeq1 + LeftRW₂ = + (! (↯ (ap-seq (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω))) ◃∙ + ! (apd-concat-pres {F = λ x → ! (ap f (glue x)) ∙ fₚ ([id] x)} {G = σ (comp K) (comTri K)} (cglue g a)) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) + =ₛ⟨ 0 & 1 & !-∙-seq (ap-seq (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) ω) ⟩ + PathSeq1 ∎ₛ abstract - LeftRW : (! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ σ (comp K) (comTri K) x) (cglue g a))) ◃∙ transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ - ! (ap f (! (glue (cin j a))) ∙ fₚ a)) - =ₛ ! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ ! (ap f (! (glue x)) ∙ fₚ ([id] x))) (cglue g a)) ◃∎ + LeftRW : + (! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ σ (comp K) (comTri K) x) (cglue g a))) ◃∙ + transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a)) + =ₛ + ! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ ! (ap f (! (glue x)) ∙ fₚ ([id] x))) (cglue g a)) ◃∎ LeftRW = LeftRW₀ ∙ₛ (LeftRW₁ ∙ₛ (LeftRW₂ ∙ₛ BigReduct1)) diff --git a/Colimit-code/L-R-L/CC-Equiv-LRL-5.agda b/Colimit-code/L-R-L/CC-Equiv-LRL-5.agda index 0a26936..11f0f9d 100644 --- a/Colimit-code/L-R-L/CC-Equiv-LRL-5.agda +++ b/Colimit-code/L-R-L/CC-Equiv-LRL-5.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -20,7 +19,9 @@ module Constr6 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( 𝕣 : (f* : < A > Cos P left *→ T) (i : Obj Γ) (a : A) → (! (ap (fst f*) (glue (cin i a))) ∙ snd f* a) ∙ ap (fst (RLfun f*)) (glue (cin i a)) =-= idp - 𝕣 (f , fₚ) i a = ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (FPrecc-βr (PostComp ColCoC (f , fₚ)) (cin i a)) ◃∙ ap-inv-canc f (glue (cin i a)) (fₚ a) ◃∎ + 𝕣 (f , fₚ) i a = + ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ a) ∙ p) (FPrecc-βr (PostComp ColCoC (f , fₚ)) (cin i a)) ◃∙ + ap-inv-canc f (glue (cin i a)) (fₚ a) ◃∎ module DiagCoher6 (i j : Obj Γ) (f : P → ty T) (fₚ : (a : A) → f (left a) == fun T a) (g : Hom Γ i j) (a : A) where @@ -43,20 +44,22 @@ module Constr6 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( where lemma : {u v : f (right (ψ (cin j a))) == f (right (ψ (cin j a)))} (q : u == v) → ap (λ z → z) q ∙ idp == q lemma idp = idp - RLfunHtpy1 : transport (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ ap (fst (RLfun (f , fₚ))) (glue z) == RfunEq (f , fₚ) (ψ z)) (cglue g a) 𝕣₂ ◃∎ =ₛ - ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ - ! (apd-tr (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ σ (comp K) (comTri K) z) (cglue g a)) ◃∙ - ! (ap (transport (λ z → f (right (ψ z)) == fst (RLfun (f , fₚ)) (right (ψ z))) (cglue g a)) - (ap (λ p → (! (ap f (glue (cin j (idf A a)))) ∙ fₚ ([id] (cin j (idf A a)))) ∙ p) (FPrecc-βr K (cin j (idf A a))))) ◃∙ - ap (transport (λ z → f (right (ψ z)) == fst (RLfun (f , fₚ)) (right (ψ z))) (cglue g a)) - (ap (λ p → (! (ap f (glue (cin j a))) ∙ fₚ a) ∙ p) (FPrecc-βr K (cin j a))) ◃∙ - ap (transport (λ z → f (right (ψ z)) == fst (RLfun (f , fₚ)) (right (ψ z))) (cglue g a))(ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ - apd-tr (λ z → RfunEq (f , fₚ) (ψ z)) (cglue g a) ◃∎ + RLfunHtpy1 : + transport (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ ap (fst (RLfun (f , fₚ))) (glue z) == RfunEq (f , fₚ) (ψ z)) (cglue g a) 𝕣₂ ◃∎ =ₛ + ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ + ! (apd-tr (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ σ (comp K) (comTri K) z) (cglue g a)) ◃∙ + ! (ap (transport (λ z → f (right (ψ z)) == fst (RLfun (f , fₚ)) (right (ψ z))) (cglue g a)) + (ap (λ p → (! (ap f (glue (cin j (idf A a)))) ∙ fₚ ([id] (cin j (idf A a)))) ∙ p) (FPrecc-βr K (cin j (idf A a))))) ◃∙ + ap (transport (λ z → f (right (ψ z)) == fst (RLfun (f , fₚ)) (right (ψ z))) (cglue g a)) + (ap (λ p → (! (ap f (glue (cin j a))) ∙ fₚ a) ∙ p) (FPrecc-βr K (cin j a))) ◃∙ + ap (transport (λ z → f (right (ψ z)) == fst (RLfun (f , fₚ)) (right (ψ z))) (cglue g a))(ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ + apd-tr (λ z → RfunEq (f , fₚ) (ψ z)) (cglue g a) ◃∎ RLfunHtpy1 = transport (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ ap (fst (RLfun (f , fₚ))) (glue z) == RfunEq (f , fₚ) (ψ z)) (cglue g a) 𝕣₂ ◃∎ =ₛ⟨ transp-id-concat (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ ap (fst (RLfun (f , fₚ))) (glue z)) (λ z → RfunEq (f , fₚ) (ψ z)) (cglue g a) (ap (λ p → (! (ap f (glue (cin j a))) ∙ fₚ a) ∙ p) (FPrecc-βr K (cin j a))) (ap-inv-canc f (glue (cin j a)) (fₚ a)) (dtransp-nat (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ ap (fst (RLfun (f , fₚ))) (glue z)) - (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ σ (comp K) (comTri K) z) (λ z → ap (λ p → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ p) (FPrecc-βr K z)) (cglue g a)) ⟩ + (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ σ (comp K) (comTri K) z) (λ z → ap (λ p → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ p) + (FPrecc-βr K z)) (cglue g a)) ⟩ (ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ∙ ! (apd-tr (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ σ (comp K) (comTri K) z) (cglue g a)) ∙ ! (ap (transport (λ z → f (right (ψ z)) == fst (RLfun (f , fₚ)) (right (ψ z))) (cglue g a)) @@ -78,7 +81,7 @@ module Constr6 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( ap (transport (λ z → f (right (ψ z)) == fst (RLfun (f , fₚ)) (right (ψ z))) (cglue g a))(ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ apd-tr (λ z → RfunEq (f , fₚ) (ψ z)) (cglue g a) ◃∎ ∎ₛ - RLfunHtpy2 : ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ + RLfunHtpy2 : ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ ! (apd-tr (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ σ (comp K) (comTri K) z) (cglue g a)) ◃∙ ! (ap (transport (λ z → f (right (ψ z)) == fst (RLfun (f , fₚ)) (right (ψ z))) (cglue g a)) (ap (λ p → (! (ap f (glue (cin j (idf A a)))) ∙ fₚ ([id] (cin j (idf A a)))) ∙ p) (FPrecc-βr K (cin j (idf A a))))) ◃∙ diff --git a/Colimit-code/L-R-L/CC-Equiv-LRL-6.agda b/Colimit-code/L-R-L/CC-Equiv-LRL-6.agda index 987c2f7..53368f2 100644 --- a/Colimit-code/L-R-L/CC-Equiv-LRL-6.agda +++ b/Colimit-code/L-R-L/CC-Equiv-LRL-6.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -20,7 +19,7 @@ module Constr7 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( open Constr6.DiagCoher6 F T i j f fₚ g a - RLfunHtpy3 : ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ + RLfunHtpy3 : ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ ! (apd-tr (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ σ (comp K) (comTri K) z) (cglue g a)) ◃∙ idp ◃∙ ap (transport (λ z → f (right (ψ z)) == fst (RLfun (f , fₚ)) (right (ψ z))) (cglue g a))(ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ @@ -47,7 +46,7 @@ module Constr7 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( ! (↯ (transpEq-s idp)) ◃∙ apd-tr (λ z → RfunEq (f , fₚ) (ψ z)) (cglue g a) ◃∎ ∎ₛ - RLfunHtpy4 : ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ + RLfunHtpy4 : ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ ! (apd-tr (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ σ (comp K) (comTri K) z) (cglue g a)) ◃∙ ↯ (transpEq-s ((! (ap f (glue (cin j a))) ∙ fₚ a) ∙ ! (ap f (! (glue (cin j a))) ∙ fₚ a))) ◃∙ ap (transport (λ z → f (right (ψ z)) == f (right (ψ z))) (cglue g a))(ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ @@ -65,14 +64,14 @@ module Constr7 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( ap (transport (λ z → f (right (ψ z)) == f (right (ψ z))) (cglue g a))(ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ ! (↯ (transpEq-s idp)) ◃∙ apd-tr (λ z → RfunEq (f , fₚ) (ψ z)) (cglue g a) ◃∎ - =ₑ⟨ 1 & 2 & (! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ ! (ap f (! (glue x)) ∙ fₚ ([id] x))) (cglue g a)) ◃∎) % =ₛ-in (=ₛ-out (LeftRW)) ⟩ + =ₑ⟨ 1 & 2 & (! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ ! (ap f (! (glue x)) ∙ fₚ ([id] x))) (cglue g a)) ◃∎) % =ₛ-in (=ₛ-out (LeftRW)) ⟩ ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ ! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ ! (ap f (! (glue x)) ∙ fₚ ([id] x))) (cglue g a)) ◃∙ ap (transport (λ z → f (right (ψ z)) == f (right (ψ z))) (cglue g a)) (ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ ! (↯ (transpEq-s idp)) ◃∙ apd-tr (λ z → RfunEq (f , fₚ) (ψ z)) (cglue g a) ◃∎ ∎ₛ - RLfunHtpy5 : ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ + RLfunHtpy5 : ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) (FPrecc-βr K (cin i a)) ◃∙ ! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ ! (ap f (! (glue x)) ∙ fₚ ([id] x))) (cglue g a)) ◃∙ ap (transport (λ z → f (right (ψ z)) == f (right (ψ z))) (cglue g a)) (ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ ! (↯ (transpEq-s idp)) ◃∙ @@ -86,20 +85,12 @@ module Constr7 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ( apd-tr (λ z → RfunEq (f , fₚ) (ψ z)) (cglue g a) ◃∎ =ₑ⟨ 3 & 2 & (apd-tr-refl {f = f ∘ right} {h = ψ} (cglue g a) ◃∎) % RightRW ⟩ ap (λ p → (! (ap f (glue (cin i a))) ∙ fₚ ([id] (cin i a))) ∙ p) - (FPrecc-βr K (cin i a)) - ◃∙ - ! - (apd-tr - (λ x → - (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ - ! (ap f (! (glue x)) ∙ fₚ ([id] x))) - (cglue g a)) - ◃∙ - ap - (transport (λ z → f (right (ψ z)) == f (right (ψ z))) (cglue g a)) - (ap-inv-canc f (glue (cin j a)) (fₚ a)) - ◃∙ apd-tr-refl {f = f ∘ right} {h = ψ} (cglue g a) ◃∎ - =ₑ⟨ 1 & 3 & (ap-inv-canc f (glue (cin i a)) (fₚ a) ◃∎) % RL-transfer (cglue g a) ⟩ 𝕣₁ ∎ₛ + (FPrecc-βr K (cin i a)) ◃∙ + ! (apd-tr (λ x → (! (ap f (glue x)) ∙ fₚ ([id] x)) ∙ ! (ap f (! (glue x)) ∙ fₚ ([id] x))) (cglue g a)) ◃∙ + ap (transport (λ z → f (right (ψ z)) == f (right (ψ z))) (cglue g a)) (ap-inv-canc f (glue (cin j a)) (fₚ a)) ◃∙ + apd-tr-refl {f = f ∘ right} {h = ψ} (cglue g a) ◃∎ + =ₑ⟨ 1 & 3 & (ap-inv-canc f (glue (cin i a)) (fₚ a) ◃∎) % RL-transfer (cglue g a) ⟩ + 𝕣₁ ∎ₛ abstract diff --git a/Colimit-code/L-R-L/CC-Equiv-LRL-7.agda b/Colimit-code/L-R-L/CC-Equiv-LRL-7.agda index 62e7d32..9148507 100644 --- a/Colimit-code/L-R-L/CC-Equiv-LRL-7.agda +++ b/Colimit-code/L-R-L/CC-Equiv-LRL-7.agda @@ -1,10 +1,8 @@ {-# OPTIONS --without-K --rewriting #-} open import lib.Basics -open import lib.types.Sigma open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import FTID @@ -22,9 +20,12 @@ module _ {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} (F : Co module _ (f : P → ty T) (fₚ : (a : A) → f (left a) == fun T a) where RLfunEqFun : f ∼ fst (RLfun (f , fₚ)) - RLfunEqFun = PushoutMapEq f (fst (RLfun (f , fₚ))) fₚ (RfunEq (f , fₚ)) (colimE (λ i a → ↯ (Constr6.𝕣 F T (f , fₚ) i a)) - (λ i j g a → from-transp-g (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ ap (fst (RLfun (f , fₚ))) (glue z) == RfunEq (f , fₚ) (ψ z)) (cglue g a) - (=ₛ-out (Constr7.DiagCoher7.RLfunHtpy F T i j f fₚ g a)))) + RLfunEqFun = + PushoutMapEq f (fst (RLfun (f , fₚ))) fₚ (RfunEq (f , fₚ)) + (colimE (λ i a → ↯ (Constr6.𝕣 F T (f , fₚ) i a)) + (λ i j g a → from-transp-g (λ z → (! (ap f (glue z)) ∙ fₚ ([id] z)) ∙ + ap (fst (RLfun (f , fₚ))) (glue z) == RfunEq (f , fₚ) (ψ z)) (cglue g a) + (=ₛ-out (Constr7.DiagCoher7.RLfunHtpy F T i j f fₚ g a)))) RLfunEqBP : (a : A) → ! (RLfunEqFun (left a)) ∙ fₚ a == idp RLfunEqBP a = !-inv-l (fₚ a) diff --git a/Colimit-code/L-R-L/CC-v2-rewrite.agda b/Colimit-code/L-R-L/CC-v2-rewrite.agda index c773806..b2161f2 100644 --- a/Colimit-code/L-R-L/CC-v2-rewrite.agda +++ b/Colimit-code/L-R-L/CC-v2-rewrite.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -22,9 +21,10 @@ module _ {ℓv ℓe ℓ ℓd} {Γ : Graph ℓv ℓe} {A : Type ℓ} (F : CosDiag κ = PostComp ColCoC (f , fₚ) Ω : ! (fst (comTri κ g) (fun (F # i) a)) ∙ snd (< A > comp κ j ∘ F <#> g) a =-= snd (comp κ i) a - Ω = (ap-cp-revR f (right ∘ cin j ) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ (ap (λ q → q ∙ fₚ a) (ap (ap f) (E₁-v2 {g = cin j} {R = cglue g (fun (F # i) a)} - (snd (F <#> g) a)))) ◃∙ (ap (λ q → q ∙ fₚ a) (ap (ap f) (E₂-v2 {p = ap ψ (cglue g a)} (ψ-βr g a) (! (glue (cin j a)))))) ◃∙ - (ap (λ q → q ∙ fₚ a) (ap (ap f) (E₃-v2 {f = left} {v = ψ} {u = right} (λ x → ! (glue x)) (cglue g a) (id-βr g a)))) ◃∎ + Ω = (ap-cp-revR f (right ∘ cin j ) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ (ap (λ q → q ∙ fₚ a) + (ap (ap f) (E₁-v2 {g = cin j} {R = cglue g (fun (F # i) a)} + (snd (F <#> g) a)))) ◃∙ (ap (λ q → q ∙ fₚ a) (ap (ap f) (E₂-v2 {p = ap ψ (cglue g a)} (ψ-βr g a) (! (glue (cin j a)))))) ◃∙ + (ap (λ q → q ∙ fₚ a) (ap (ap f) (E₃-v2 {f = left} {v = ψ} {u = right} (λ x → ! (glue x)) (cglue g a) (id-βr g a)))) ◃∎ Ω-pth4 : ! (↯ (ap-seq (λ q → (! (ap (f ∘ right) (ap ψ (cglue g a)))) ∙ (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) (ap-seq ! Ω))) ◃∎ =ₛ ! (ap (λ q → ! (ap (f ∘ right) (ap ψ (cglue g a))) ∙ (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ q) (ap ! (ap (λ q → q ∙ fₚ a) diff --git a/Colimit-code/Main-Theorem/CosColim-Adjunction.agda b/Colimit-code/Main-Theorem/CosColim-Adjunction.agda index 98fedaf..2b354db 100644 --- a/Colimit-code/Main-Theorem/CosColim-Adjunction.agda +++ b/Colimit-code/Main-Theorem/CosColim-Adjunction.agda @@ -6,10 +6,11 @@ open import lib.types.Span open import Coslice open import Diagram open import Cocone +open import CosColim-Iso open import CC-Equiv-LRL-7 open import CC-Equiv-RLR-4 open import CosColimitMap00 -open import CosColimitMap22 +open import CosColimitMap18 open import CosColimitPstCmp open import CosColimitPreCmp @@ -17,11 +18,9 @@ module CosColim-Adjunction where {- - This module contains our final proof, which shows that our pushout - construction satisfies the universal property of an A-colimit, - namely that it's left adjoint to the constant diagram functor. - We construct such an adjunction by presenting the expected - natural isomorphism. + This module shows that our pushout construction satisfies the universal property of an A-colimit, + namely that it's left adjoint to the constant diagram functor. We construct such an adjunction + by presenting the expected natural isomorphism. -} @@ -33,24 +32,20 @@ module _ {ℓv ℓe ℓ} {Γ : Graph ℓv ℓe} {A : Type ℓ} where open Maps --- The isomorphism itself +-- The first naturality square, arising from post-composition with the coslice map - Colim-Iso : ∀ {ℓd ℓc} (F : CosDiag ℓd ℓ A Γ) (T : Coslice ℓc ℓ A) → is-equiv (PostComp {D = T} (ColCoC F)) - Colim-Iso F T = is-eq (PostComp {D = T} (ColCoC F)) (Recc.recCosCoc F T) (λ K → LRfunEq K) λ (f , fₚ) → ! (RLfunEq F T f fₚ) - --- The first naturality square, arising from post-composition with coslice map - - Iso-Nat-PostCmp : ∀ {ℓd ℓc₁ ℓc₂} (F : CosDiag ℓd ℓ A Γ) {T : Coslice ℓc₁ ℓ A} {U : Coslice ℓc₂ ℓ A} (φ : T *→ U) (f* : (Cos (P F) left) *→ T) - → Map-to-Lim-map F φ (PostComp (ColCoC F) f*) == PostComp (ColCoC F) (φ ∘* f*) + Iso-Nat-PostCmp : ∀ {ℓd ℓc₁ ℓc₂} (F : CosDiag ℓd ℓ A Γ) {T : Coslice ℓc₁ ℓ A} {U : Coslice ℓc₂ ℓ A} + (φ : T *→ U) (f* : (Cos (P F) left) *→ T) → + Map-to-Lim-map F φ (PostComp (ColCoC F) f*) == PostComp (ColCoC F) (φ ∘* f*) Iso-Nat-PostCmp F φ (f , fₚ) = CosColim-NatSq1-eq F φ f fₚ --- The second naturality square, arising from pre-composition with diagram map +-- The second naturality square, arising from pre-composition with the diagram map module _ {ℓF ℓG} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where open ConstrMap δ - open ConstrMap23 δ + open ConstrMap19 δ Iso-Nat-PreCmp : ∀ {ℓc} {T : Coslice ℓc ℓ A} (f* : (Cos P₂ left) *→ T) → Diag-to-Lim-map (PostComp (ColCoC G) f*) == PostComp (ColCoC F) (f* ∘* 𝕕) diff --git a/Colimit-code/Main-Theorem/CosColim-Iso.agda b/Colimit-code/Main-Theorem/CosColim-Iso.agda new file mode 100644 index 0000000..c9e2c4a --- /dev/null +++ b/Colimit-code/Main-Theorem/CosColim-Iso.agda @@ -0,0 +1,29 @@ +{-# OPTIONS --without-K --rewriting #-} + +open import lib.Basics +open import lib.Equivalence2 +open import lib.types.Pushout +open import lib.types.Span +open import Coslice +open import Diagram +open import Colim +open import Cocone +open import CC-Equiv-LRL-7 +open import CC-Equiv-RLR-4 + +module CosColim-Iso where + +{- + This module shows that the post-composition map on our A-cocone construction is an equivalence. +-} + +module _ {ℓv ℓe ℓ} {Γ : Graph ℓv ℓe} {A : Type ℓ} where + + open MapsCos A + + open Id Γ A + + open Maps + + Colim-Iso : ∀ {ℓd ℓc} (F : CosDiag ℓd ℓ A Γ) (T : Coslice ℓc ℓ A) → is-equiv (PostComp {D = T} (ColCoC F)) + Colim-Iso F T = is-eq (PostComp {D = T} (ColCoC F)) (Recc.recCosCoc F T) (λ K → LRfunEq K) λ (f , fₚ) → ! (RLfunEq F T f fₚ) diff --git a/Colimit-code/Map-Nat/CosColimitMap00.agda b/Colimit-code/Map-Nat/CosColimitMap00.agda index bec4004..47a9a4c 100644 --- a/Colimit-code/Map-Nat/CosColimitMap00.agda +++ b/Colimit-code/Map-Nat/CosColimitMap00.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -11,13 +10,7 @@ open import Cocone module CosColimitMap00 where -module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} (f g : A → B) (H : f ∼ g) where - - apCommSq : {x y : A} (p : x == y) → ! (H x) ∙ ap f p ∙ H y == ap g p - apCommSq {x = x} idp = !-inv-l (H x) - - apCommSq2 : {x y : A} (p : x == y) → H x == ap f p ∙ H y ∙ ! (ap g p) - apCommSq2 {x = x} idp = ! (∙-unit-r (H x)) +-- A long list of helper paths module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f : A → B) (h : C → A) where @@ -31,15 +24,16 @@ module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type !-!-ap-cmp-rid3 : {x y : C} (p : x == y) {a : A} (q : h y == a) → ! (ap f (! (ap h (! p ∙ idp)) ∙ q ∙ idp)) ∙ ap (f ∘ h) p ∙ idp == ! (ap f q) ∙ idp !-!-ap-cmp-rid3 idp idp = idp - transp-pth-cmpL : (g : C → B) {x y : C} (p : x == y) (q : f (h x) == g x) → transport (λ z → f (h z) == g z) p q == ! (ap f (ap h p)) ∙ q ∙ ap g p - transp-pth-cmpL g idp q = ! (∙-unit-r q) - module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} (f : A → B) where ap-!-!-!-rid : {x y : A} (p₂ : x == y) {b₁ b₂ : B} (p₅ : f x == b₁) (p₆ : f x == b₂) → ! (! (ap f (p₂ ∙ idp)) ∙ p₅) ∙ ! (ap f p₂) ∙ p₆ == ! p₅ ∙ p₆ ap-!-!-!-rid idp p₅ p₆ = idp + ap-!-!-!-!-rid : {x y z : A} (p₃ : x == y) (p₂ : z == y) {b₁ b₂ : B} (p₅ : f z == b₁) (p₆ : f z == b₂) + → ! (! (ap f (p₂ ∙ ! p₃ ∙ idp)) ∙ p₅) ∙ ap f p₃ ∙ ! (ap f p₂) ∙ p₆ == ! p₅ ∙ p₆ + ap-!-!-!-!-rid idp p₂ p₅ p₆ = ap-!-!-!-rid p₂ p₅ p₆ + ap-!-!-rid-rid : {x y : A} (p : x == y) {b : B} (q : f y == b) → ! (! (ap f (! p ∙ idp)) ∙ idp) ∙ ap f p ∙ q == q ap-!-!-rid-rid idp q = idp @@ -51,7 +45,7 @@ module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ap-∘-!-!-rid-rid : {a₁ a₂ : A} (p₁ : a₁ == a₂) {b z : B} (p₃ : z == b) (p₂ : f a₂ == b) {c₁ c₂ : C} (p₅ : m (f a₁) == c₁) (p₆ : m (f a₂) == c₂) → ! (! (ap m (ap f p₁ ∙ p₂ ∙ ! p₃ ∙ idp)) ∙ p₅) ∙ ap m p₃ ∙ ! (ap m p₂) ∙ p₆ == ! p₅ ∙ ap (m ∘ f) p₁ ∙ p₆ - ap-∘-!-!-rid-rid idp idp p₂ p₅ p₆ = ap-!-!-!-rid m p₂ p₅ p₆ + ap-∘-!-!-rid-rid idp p₃ p₂ p₅ p₆ = ap-!-!-!-!-rid m p₃ p₂ p₅ p₆ module _ {ℓ₁ ℓ₂ ℓ₃ ℓ₄} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} {D : Type ℓ₄} (f : A → B) (h : C → A) (k : C → B) (m : B → D) where @@ -73,6 +67,8 @@ module _ {ℓ₁ ℓ₂ ℓ₃ ℓ₄} {A : Type ℓ₁} {B : Type ℓ₂} {C : ap (m ∘ k) p₁ ∙ ! (ap m p₅) ∙ ap (m ∘ f) p₂ ∙ p₆ long-red-ap-!-∙ k m p₁ p₂ idp p₃ p₅ p₆ = !-!-!-∘-∘-∘-rid f h k m p₁ p₂ p₃ p₆ p₅ +-- Start of map naturality proof + module ConstrMap {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where open Id.Maps Γ A @@ -119,7 +115,8 @@ module ConstrMap {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} ! (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ap (cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a) =⟪ ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) - (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a)) ⟫ + (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) + (fun (F # i) a))) (comSq-coher δ g a)) ⟫ ! (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a) @@ -160,33 +157,33 @@ module ConstrMap {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} =⟪ ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (↯ (ϵ G g g a)) ⟫ ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a)) ∎∎ - K : CosCocone A F (Cos P₂ left) - fst (comp K i) = right ∘ cin i ∘ (fst (nat δ i)) - snd (comp K i) a = ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a)) - fst (comTri K {j} {i} g) x = ap right (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x)) - snd (comTri K g) a = ↯ (Θ g a) + K-diag : CosCocone A F (Cos P₂ left) + fst (comp K-diag i) = right ∘ cin i ∘ (fst (nat δ i)) + snd (comp K-diag i) a = ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a)) + fst (comTri K-diag {j} {i} g) x = ap right (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x)) + snd (comTri K-diag g) a = ↯ (Θ g a) ℂ : δ₀ ∘ ψ₁ ∼ ψ₂ ℂ = colimE (λ i a → ap (cin i) (snd (nat δ i) a)) - (λ i j g a → from-transp-g (λ z → δ₀ (ψ₁ z) == ψ₂ z) (cglue g a) (↯ (ζ g a))) + (λ i j g a → from-transp-g (λ z → δ₀ (ψ₁ z) == ψ₂ z) (cglue g a) (↯ (ζ g a))) ℂ-β : {i j : Obj Γ} (g : Hom Γ i j) (a : A) → apd-tr ℂ (cglue g a) ◃∎ =ₛ ζ g a ℂ-β {i} {j} g a = =ₛ-in ( - apd-to-tr (λ z → δ₀ (ψ₁ z) == ψ₂ z) ℂ (cglue g a) - (↯ (ζ g a)) - (cglue-β (λ i a → ap (cin i) (snd (nat δ i) a)) - (λ i j g a → from-transp-g (λ z → δ₀ (ψ₁ z) == ψ₂ z) - (cglue g a) (↯ (ζ g a))) g a)) - - span-mapFG : SpanMap-Rev SpCos₁ SpCos₂ - SpanMap-Rev.hA span-mapFG = idf A - SpanMap-Rev.hB span-mapFG = δ₀ - SpanMap-Rev.hC span-mapFG = idf (Colim (ConsDiag Γ A)) - SpanMap-Rev.f-commutes span-mapFG = comm-sqr λ z → idp - SpanMap-Rev.g-commutes span-mapFG = comm-sqr (λ z → ! (ℂ z)) + apd-to-tr (λ z → δ₀ (ψ₁ z) == ψ₂ z) ℂ (cglue g a) + (↯ (ζ g a)) + (cglue-β (λ i a → ap (cin i) (snd (nat δ i) a)) + (λ i j g a → from-transp-g (λ z → δ₀ (ψ₁ z) == ψ₂ z) + (cglue g a) (↯ (ζ g a))) g a) ) + + span-map-forg : SpanMap-Rev SpCos₁ SpCos₂ + SpanMap-Rev.hA span-map-forg = idf A + SpanMap-Rev.hB span-map-forg = δ₀ + SpanMap-Rev.hC span-map-forg = idf (Colim (ConsDiag Γ A)) + SpanMap-Rev.f-commutes span-map-forg = comm-sqr λ z → idp + SpanMap-Rev.g-commutes span-map-forg = comm-sqr (λ z → ! (ℂ z)) private - module PM = PushoutMap span-mapFG + module PM = PushoutMap span-map-forg 𝕕 : < A > Cos P₁ left *→ Cos P₂ left 𝕕 = PM.f , (λ a → idp) diff --git a/Colimit-code/Map-Nat/CosColimitMap01.agda b/Colimit-code/Map-Nat/CosColimitMap01.agda index 9e0022b..26cb56e 100644 --- a/Colimit-code/Map-Nat/CosColimitMap01.agda +++ b/Colimit-code/Map-Nat/CosColimitMap01.agda @@ -3,91 +3,154 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram +open import AuxPaths +open import Helper-paths +open import FTID-Cos open import Colim open import Cocone open import CosColimitMap00 module CosColimitMap01 where -module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f : A → B) (h : A → C) (g : C → B) (H : f ∼ g ∘ h) where - - CommSq-swap-∘-! : {x y : A} (p : x == y) → ! (ap f p) == H y ∙ ! (ap g (ap h p)) ∙ ! (H x) - CommSq-swap-∘-! {x = x} idp = ! (!-inv-r (H x)) - -module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (h : A → C) (g : C → B) where - - ap-∘-!-!-rid : {x y : A} (p : x == y) {b : B} (q : b == g (h y)) - → ! (ap (g ∘ h) p ∙ ! q) ∙ idp == q ∙ ap g (! (ap h p)) - ap-∘-!-!-rid idp idp = idp - module ConstrMap2 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap δ public - - open Id.Maps.Recc Γ A F (Cos P₂ left) public - - 𝕃 : ForgMap ∼ right ∘ δ₀ - 𝕃 = ColimMapEq ForgMap (right ∘ δ₀) (λ i x → idp) (λ i j g x → =ₛ-out (ρ i j g x)) - where - ρ : (i j : Obj Γ) (g : Hom Γ i j) (x : ty (F # i)) → ! (ap ForgMap (cglue g x)) ◃∙ ap (right ∘ δ₀) (cglue g x) ◃∎ =ₛ idp ◃∎ - ρ i j g x = - ! (ap ForgMap (cglue g x)) ◃∙ ap (right ∘ δ₀) (cglue g x) ◃∎ - =ₛ₁⟨ 1 & 1 & ap-∘ right δ₀ (cglue g x) ⟩ - ! (ap ForgMap (cglue g x)) ◃∙ ap right (ap δ₀ (cglue g x)) ◃∎ - =ₛ₁⟨ 0 & 1 & ap ! (FM-βr g x) ⟩ - ! (ap right (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x))) ◃∙ ap right (ap δ₀ (cglue g x)) ◃∎ - =ₛ₁⟨ 1 & 1 & ap (ap right) (δ₀-βr g x) ⟩ - ! (ap right (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x))) ◃∙ ap right (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x)) ◃∎ - =ₛ₁⟨ !-inv-l (ap right (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x))) ⟩ - idp ◃∎ ∎ₛ - - module _ {i j : Obj Γ} (g : Hom Γ i j) (a : A) where - - Θ♯ = ! (ap (right {d = SpCos₂}) (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)) - =⟪ ap (λ p → ! p ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! (FM-βr g (fun (F # i) a))) ⟫ - ! (ap ForgMap (cglue g (fun (F # i) a))) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)) - =⟪ ap (λ p → p ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g (fun (F # i) a))) ⟫ - (! (ap right (ap δ₀ (cglue g (fun (F # i) a)))) ∙ idp) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)) - =⟪ ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ (cglue g (fun (F # i) a)))))) ⟫ - ! (ap right (ap δ₀ (cglue g (fun (F # i) a)))) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)) - =⟪ ap (λ p → ! (ap right p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (δ₀-βr g (fun (F # i) a)) ⟫ - ! (ap (right {d = SpCos₂}) (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)) ∎∎ - - Θ-combined : {i j : Obj Γ} (g : Hom Γ i j) (a : A) - → ! (ap (right {d = SpCos₂}) (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)) - =-= - ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a)) - Θ-combined g a = (Θ♯ g a) ∙∙ (Θ g a) - - 𝕂 : CosCocone A F (Cos P₂ left) - fst (comp 𝕂 i) = right ∘ cin i ∘ (fst (nat δ i)) - snd (comp 𝕂 i) a = ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a)) - fst (comTri 𝕂 {j} {i} g) x = ap right (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x)) - snd (comTri 𝕂 g) a = ↯ (Θ-combined g a) - - 𝕂₀ = fst (recCosCoc 𝕂) - - module _ (i : Obj Γ) (a : A) where - - 𝔻 : ap 𝕂₀ (glue (cin i a)) ∙ idp =-= ap 𝕕₀ (glue (cin i a)) - 𝔻 = ap 𝕂₀ (glue (cin i a)) ∙ idp - =⟪ ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin i a)) ⟫ - ! (ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a))) ∙ idp - =⟪ ap-∘-!-!-rid (cin i) right (snd (nat δ i) a) (glue (cin i a)) ⟫ - glue (cin i a) ∙ ap right (! (ap (cin i) (snd (nat δ i) a))) - =⟪ ! (𝕕-βr (cin i a)) ⟫ - ap 𝕕₀ (glue (cin i a)) ∎∎ + open ConstrMap δ + + open Id Γ A + + open Maps + + module MapCoher {i j : Obj Γ} (g : Hom Γ i j) (a : A) where + + 𝕤 = E₁ (snd (F <#> g) a) (! (glue {d = SpCos₁} (cin j a))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ + cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a))) ◃∙ + E₃ (λ x → ! (glue x)) (cglue g a) (ψ-βr F g a) (λ x → idp) ◃∙ + ∙-unit-r (! (glue (cin i a))) ◃∎ + + fib-coher0 = + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a))) ∙ + ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (↯ 𝕤))) ◃∙ + ap-inv-rid 𝕕₀ (glue (cin i a)) ◃∙ + ap ! (𝕕-βr (cin i a)) ◃∙ + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ + =ₑ⟨ 4 & 1 & (ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) + (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (↯ 𝕤))) ◃∎) + % =ₛ-in (ap-∙ (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) + (ap right (cglue g (fun (F # i) a)))) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (↯ 𝕤)))) ⟩ + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (↯ 𝕤))) ◃∙ + ap-inv-rid 𝕕₀ (glue (cin i a)) ◃∙ + ap ! (𝕕-βr (cin i a)) ◃∙ + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ ∎ₛ + + fib-coher-𝕤 = + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (↯ 𝕤))) ◃∎ + =ₛ₁⟨ ap (λ v → ap (λ q → q) (ap (λ p → p ∙ idp) v)) (=ₛ-out (ap-seq-∙ (ap 𝕕₀) 𝕤)) ⟩ + ap (λ q → q) (ap (λ p → p ∙ idp) (↯ (ap-seq (ap 𝕕₀) 𝕤))) ◃∎ + =ₛ₁⟨ ap (λ v → (ap (λ q → q) v)) (=ₛ-out (ap-seq-∙ (λ p → p ∙ idp) (ap-seq (ap 𝕕₀) 𝕤))) ⟩ + ap (λ q → q) (↯ (ap-seq (λ p → p ∙ idp) (ap-seq (ap 𝕕₀) 𝕤))) ◃∎ + =ₛ⟨ ap-seq-∙ (λ q → q) (ap-seq (λ p → p ∙ idp) (ap-seq (ap 𝕕₀) 𝕤)) ⟩ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ (λ x → ! (glue x)) (cglue g a) + (ψ-βr F g a) (λ x → idp)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue (cin i a)))))) ◃∎ ∎ₛ + + fib-coher1 = + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (↯ 𝕤))) ◃∙ + ap-inv-rid 𝕕₀ (glue (cin i a)) ◃∙ + ap ! (𝕕-βr (cin i a)) ◃∙ + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ + =ₛ⟨ 5 & 1 & fib-coher-𝕤 ⟩ + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ (λ x → ! (glue x)) (cglue g a) + (ψ-βr F g a) (λ x → idp)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue (cin i a)))))) ◃∙ + ap-inv-rid 𝕕₀ (glue (cin i a)) ◃∙ -- transfer + ap ! (𝕕-βr (cin i a)) ◃∙ -- transfer + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ ∎ₛ + diff --git a/Colimit-code/Map-Nat/CosColimitMap02.agda b/Colimit-code/Map-Nat/CosColimitMap02.agda index d5136e5..681ddab 100644 --- a/Colimit-code/Map-Nat/CosColimitMap02.agda +++ b/Colimit-code/Map-Nat/CosColimitMap02.agda @@ -3,11 +3,11 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import AuxPaths -open import AuxPaths-v2 +open import Helper-paths +open import FTID-Cos open import Colim open import Cocone open import CosColimitMap00 @@ -15,278 +15,165 @@ open import CosColimitMap01 module CosColimitMap02 where -module _ {ℓ} {A : Type ℓ} where - - ∙-rid-rid : {x y z : A} (p : x == y) (q : y == z) → (p ∙ q) ∙ idp == (p ∙ q ∙ idp) ∙ idp - ∙-rid-rid idp idp = idp - - !-!-rid : {x y : A} (q : x == y) → (! (! q) ∙ idp) ∙ idp == q ∙ idp - !-!-rid idp = idp - - !-!-rid2 : {x y : A} (p : x == y) → ! (! p) ∙ idp == (p ∙ idp) ∙ idp - !-!-rid2 idp = idp - - rid-coher : {x y : A} (p : x == y) → ∙-rid-rid idp (! (! p)) ∙ !-!-rid p == !-!-rid2 p ∙ ! (ap (λ q → q ∙ idp) (! (∙-unit-r p))) ∙ idp - rid-coher idp = idp - - ap-!-loop : {x y : A} (q : x == y) (p : y == y) → p ∙ ! (q ∙ p) =-= ! p ∙ p ∙ ! q - ap-!-loop idp p = !-inv-r p ◃∙ ! (!-inv-l p) ◃∙ ap (λ z → ! p ∙ z) (! (∙-unit-r p)) ◃∎ - -module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} (f : A → B) where - - !-!-∙-rid : {x y : A} (p : x == y) {b : B} (q : b == f x) → ! (! q) ∙ idp == (q ∙ ap f p) ∙ ap f (! p) - !-!-∙-rid idp q = !-!-rid2 q - module ConstrMap3 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open Id Γ A - - open ConstrMap2 δ - - module MapCoher (i j : Obj Γ) (g : Hom Γ i j) (a : A) where - - id-free-helper : {x y z : P₂} (U : x == y) (p : z == y) → ! (U ∙ ! p ∙ idp) =-= ! (U ∙ ! p) - id-free-helper idp p = ap ! (∙-unit-r (! p)) ◃∎ - - id-free : (q : (z : Colim (ConsDiag Γ A)) → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) {x y : Colim (ConsDiag Γ A)} (p : x == y) {u : P₂} (U : u == right (ψ₂ y)) - → ! (ap left (ap [id] p)) ∙ ! (U ∙ ! (ap right (ap ψ₂ p)) ∙ ! (q x) ∙ idp) =-= idp ∙ ! (U ∙ ! (q y)) - id-free q {x = x} idp U = id-free-helper U (q x) - - cglue-switch : (q : (z : Colim (ConsDiag Γ A)) → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) {x y : Colim (ConsDiag Γ A)} (p : x == y) - {u : P₂} (U : u == right (ψ₂ y)) {a₁ a₂ : P₂} (V₁ : left ([id] x) == a₁) (V₂ : a₂ == left ([id] y)) - → ! (ap left (ap [id] p)) ∙ V₁ ∙ ! (U ∙ ! (ap right (ap ψ₂ p)) ∙ ! (q x) ∙ V₁) =-= ! V₂ ∙ V₂ ∙ ! (U ∙ ! (q y)) - cglue-switch q {x = x} idp idp idp idp = ap ! (∙-unit-r (! (q x))) ◃∎ - - id-free=switch : (q : (z : Colim (ConsDiag Γ A)) → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) {x y : Colim (ConsDiag Γ A)} (p : x == y) - → cglue-switch q p idp idp idp =ₛ ↯ (id-free q p idp) ◃∎ - id-free=switch q idp = =ₛ-in idp - - E₃-v2-red : (q : (z : Colim (ConsDiag Γ A)) → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) {y : Colim (ConsDiag Γ A)} (p : cin j a == y) {V : a == [id] y} (T : ap [id] p == V) - → ap (λ c → ! (ap left (ap [id] p)) ∙ ap left V ∙ c) (ap ! (ap (λ z → z) (E₃-v2 {f = left} {v = ψ₂} {u = right} (λ z → ! (q z)) p T))) ◃∙ - ap (λ n → n ∙ ap left V ∙ ! (! (q y))) (ap (λ m → ! (ap left m)) T) ◃∎ - =ₛ cglue-switch q p idp (ap left V) (ap left V) - E₃-v2-red q idp idp = =ₛ-in (∙-unit-r (ap (λ c → c) (ap ! (ap (λ z → z) (∙-unit-r (! (q (cin j a))))))) ∙ - ap-idf (ap ! (ap (λ z → z) (∙-unit-r (! (q (cin j a)))))) ∙ - ap (ap !) (ap-idf (∙-unit-r (! (q (cin j a)))))) - - abstract - - id-red : {u : P₂} (V : u == right (ψ₂ (cin i a))) (s : cin j a == cin i a) (R : ap [id] s == idp) - → ap (λ p → ! (ap left (ap [id] s)) ∙ p) (ap ! (ap (λ p → V ∙ p) (E₃-v2 {f = left} (λ x → ! (glue x)) s R))) ◃∙ - ap (λ p → p ∙ ! (V ∙ ! (glue (cin i a)))) (ap (λ p → ! (ap left p)) R) ◃∎ - =ₛ - ↯ (id-free glue s V) ◃∎ - id-red idp s R = - ap (_∙_ (! (ap left (ap [id] s)))) (ap ! (ap (λ q → q) (E₃-v2 (λ x → ! (glue x)) s R))) ◃∙ - ap (λ p → p ∙ ! (! (glue (cin i a)))) (ap (λ p → ! (ap left p)) R) ◃∎ - =ₛ⟨ E₃-v2-red glue s R ⟩ - cglue-switch glue s idp idp idp - =ₛ⟨ id-free=switch glue s ⟩ - (↯ (id-free glue s idp) ◃∎) ∎ₛ - --- s = cglue g a --- V = ap (right ∘ cin i) (snd (nat δ i) a) - - - recc-free : {x y : Colim (ConsDiag Γ A)} (p : x == y) {u₁ u₂ : ty (F # j)} (s₃ : u₁ == u₂) {e : Colim ForgF} (c : cin j u₁ == e) - {v : ty (G # j)} (s₁ : fst (nat δ j) u₂ == v) (s₂ : left ([id] x) == right (cin j v)) → - ! (ap left (ap [id] p)) ∙ ! (ap (right ∘ cin j) s₁ ∙ ! s₂) ∙ ap ForgMap (! (ap (cin j) s₃) ∙ c) - =-= - ! (ap left (ap [id] p)) ∙ (! (! (ap ForgMap c) ∙ - ap (ForgMap ∘ cin j) s₃ ∙ ap (right ∘ cin j) s₁ ∙ ! s₂)) - recc-free p idp idp s₁ s₂ = ap (λ r → ! (ap left (ap [id] p)) ∙ r) (∙-unit-r (! (ap (right ∘ cin j) s₁ ∙ ! s₂))) ◃∎ - --- p = cglue g a --- c = cglue g (fun (F # i) a) --- s₁ = (snd (nat δ j) a) --- s₂ = (glue (cin j a)) --- s₃ = (snd (F <#> g) a) + open ConstrMap δ - abstract - - recc-red : {u₁ u₂ : ty (F # j)} (s₃ : u₁ == u₂) {e : Colim ForgF} (c : cin j u₁ == e) - {v : ty (G # j)} (s₁ : fst (nat δ j) u₂ == v) (s₂ : left a == right (cin j v)) {R : ForgMap (cin j u₁) == ForgMap e} (φ : ap ForgMap c == R) → - H₂ s₃ (ap (right ∘ cin j) s₁ ∙ ! s₂) c φ ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) s₃ ∙ ap (right ∘ cin j) s₁ ∙ ! s₂) (! φ))) ◃∎ - =ₛ - ↯ (recc-free (cglue g a) s₃ c s₁ s₂) ◃∎ - recc-red idp idp idp s₂ idp = =ₛ-in (∙-unit-r (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (∙-unit-r (! (! s₂))))) - --- φ = (FM-βr g (fun (F # i) a)) - - ψ₁-free-coher : {y : Colim (ConsDiag Γ A)} (p : cin j a == y) {u : ty (F # j)} (s : fst (nat δ j) u == fun (G # j) a) → - (! (ap left (ap [id] p)) ∙ ! (ap (right {d = SpCos₂} ∘ cin j) s ∙ ! (glue (cin j a))) ∙ idp) ∙ idp - =-= glue y ∙ ap right (! (ap (cin j) s ∙ ap ψ₂ p)) - ψ₁-free-coher idp s = ψ₁-free-coher2 s - module _ where - ψ₁-free-coher2 : {v : ty (G # j)} (σ : v == fun (G # j) a) - → (! (ap (right ∘ cin j) σ ∙ ! (glue (cin j a))) ∙ idp) ∙ idp =-= glue (cin j a) ∙ ap right (! (ap (cin j) σ ∙ idp)) - ψ₁-free-coher2 idp = !-!-rid (glue (cin j a)) ◃∎ - - ψ₁-free : {y : Colim (ConsDiag Γ A)} (p : cin j a == y) {u e : ty (F # j)} (s₃ : e == u) {z : Colim ForgF} (c : cin j e == z) (s₁ : fst (nat δ j) u == fun (G # j) a) → - (! (ap left (ap [id] p)) ∙ (! (ap (right ∘ cin j) s₁ ∙ ! (glue (cin j a)))) ∙ ap ForgMap (! (ap (cin j) s₃) ∙ c)) ∙ 𝕃 z - =-= - glue y ∙ ap right (! (! (ap δ₀ (! (ap (cin j) s₃) ∙ c)) ∙ ap (cin j) s₁ ∙ ap ψ₂ p)) - ψ₁-free p idp idp s₁ = ψ₁-free-coher p s₁ - - abstract - - ψ₁-red : {y : Colim (ConsDiag Γ A)} (q : cin j a == y) {e : ty (F # j)} (s₃ : e == fun (F # j) a) (c : cin j e == ψ₁ y) (T : ap ψ₁ q == ! (ap (cin j) s₃) ∙ c) → - ! (ap (λ p → p ∙ 𝕃 (ψ₁ y)) (H₁ q (! (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)))) T)) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} q) ◃∙ - ap (transport (λ z → left ([id] z) == right (δ₀ (ψ₁ z))) q) (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} q ◃∙ - ap (λ p → glue y ∙ ap right (! p)) (transp-pth-cmpL δ₀ ψ₁ ψ₂ q (ap (cin j) (snd (nat δ j) a))) ◃∙ - ap (λ p → glue y ∙ ap right (! p)) (ap (λ p → ! (ap δ₀ p) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ q) T) ◃∎ - =ₛ - ↯ (ψ₁-free q s₃ c (snd (nat δ j) a)) ◃∎ - ψ₁-red idp idp c T = =ₛ-in (lemma T) - where - lemma : {C : cin j (fun (F # j) a) == ψ₁ (cin j a)} (τ : idp == C) → - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin j a))) (H₁ {u = ForgMap} {h = [id]} {f = left} {v = ψ₁} {c = cin j a} idp (! (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)))) τ)) ∙ - ap (λ z → z) (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ∙ - ap (λ p → glue (cin j a) ∙ ap right (! p)) (! (∙-unit-r (ap (cin j) (snd (nat δ j) a)))) ∙ - ap (λ p → glue (cin j a) ∙ ap right (! p)) (ap (λ p → ! (ap δ₀ p) ∙ ap (cin j) (snd (nat δ j) a) ∙ idp) τ) - == - ↯ (ψ₁-free idp idp C (snd (nat δ j) a)) - lemma idp = lemma2 (snd (nat δ j) a) - where - lemma2 : {v : ty (G # j)} (σ : v == fun (G # j) a) → - ! (ap (λ p → p ∙ idp) (! (∙-unit-r (! (ap (right ∘ cin j) σ ∙ ! (glue (cin j a))))))) ∙ - ap (λ z → z) (ap-∘-!-!-rid (cin j) right σ (glue (cin j a))) ∙ - ap (λ p → glue (cin j a) ∙ ap right (! p)) (! (∙-unit-r (ap (cin j) σ))) ∙ idp - == - ↯ (ψ₁-free-coher2 (snd (nat δ j) a) σ) - lemma2 idp = lemma3 (glue (cin j a)) - where - lemma3 : {r : P₂} (γ : r == right (ψ₂ (cin j a))) - → ! (ap (λ p → p ∙ idp) (! (∙-unit-r (! (! γ))))) ∙ - ap (λ z → z) (ap-∘-!-!-rid (cin j) right idp γ) ∙ idp - == !-!-rid γ - lemma3 idp = idp - - δ₀-free : {y : Colim (ConsDiag Γ A)} (q : cin j a == y) {u e : ty (F # j)} (s₃ : e == u) (s₁ : fst (nat δ j) u == fun (G # j) a) - {v : Colim ForgG} (D : cin j (fst (nat δ j) e) == v) {m : P₂} (ξ : m == right v) → - (! (ap left (ap [id] q)) ∙ ! ((ξ ∙ ! (ap (right {d = SpCos₂}) D)) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) s₃ ∙ ap (right ∘ cin j) s₁ ∙ ! (glue (cin j a)))) ∙ ξ - =-= - glue y ∙ ap right (! (! D ∙ ap (cin j ∘ fst (nat δ j)) s₃ ∙ ap (cin j) s₁ ∙ ap ψ₂ q)) - δ₀-free q idp s₁ idp idp = ∙-rid-rid (! (ap left (ap [id] q))) (! (ap (right ∘ cin j) s₁ ∙ ! (glue (cin j a)))) ◃∙ ψ₁-free-coher q s₁ - --- D = ! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ cglue g (fst (nat δ i) (fun (F # i) a)) - - δ₀-red3 : {z : Colim ForgF} (c : cin j (fun (F # j) a) == z) - → ! (ap (λ p → p ∙ 𝕃 z) (ap (λ q → q) (ap ! (ap (λ p → (𝕃 z ∙ p) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ c)))))))) ∙ - ! (ap (λ p → p ∙ 𝕃 z) (ap (λ q → q) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 c))))) ∙ - ! (ap (λ p → p ∙ 𝕃 z) (↯ (recc-free {x = cin j a} idp idp c (snd (nat δ j) a) (glue (cin j a))))) ∙ - ↯ (ψ₁-free idp idp c (snd (nat δ j) a)) ∙ idp - == ↯ (δ₀-free idp idp (snd (nat δ j) a) (ap δ₀ c) (𝕃 z)) - δ₀-red3 idp = lemma (snd (nat δ j) a) - where - lemma : {x : ty (G # j)} (σ : x == fun (G # j) a) - → ! (ap (λ p → p ∙ idp) (ap (λ q → q) (∙-unit-r - (! (ap (right ∘ cin j) σ ∙ ! (glue (cin j a))))))) ∙ - ↯ (ψ₁-free-coher2 (snd (nat δ j) a) σ) ∙ idp - == ↯ (∙-rid-rid idp (! (ap (right ∘ cin j) σ ∙ ! (glue (cin j a)))) - ◃∙ ψ₁-free-coher2 (snd (nat δ j) a) σ) - lemma idp = lemma2 (glue (cin j a)) - where - lemma2 : {x y : P₂} (γ : x == y) - → ! (ap (λ p → p ∙ idp) (ap (λ q → q) (∙-unit-r (! (! γ))))) - ∙ !-!-rid γ ∙ idp - == ∙-rid-rid idp (! (! γ)) ∙ !-!-rid γ - lemma2 idp = idp - - δ₀-red2 : {y : Colim (ConsDiag Γ A)} (q : cin j a == y) (c : cin j (fun (F # j) a) == ψ₁ (cin i a)) → - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ c)))))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! (ap (λ p → - p ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 c))))) ∙ - ! (ap (λ p → p ∙ idp) (↯ (recc-free q idp c (snd (nat δ j) a) (glue (cin j a))))) ∙ - ↯ (ψ₁-free q idp c (snd (nat δ j) a)) ∙ idp - == ↯ (δ₀-free q idp (snd (nat δ j) a) (ap δ₀ c) idp) - δ₀-red2 idp c = δ₀-red3 c - - abstract - - δ₀-red : {e : ty (F # j)} (s₃ : e == fun (F # j) a) (c : cin j e == ψ₁ (cin i a)) {R : δ₀ (cin j e) == δ₀ (ψ₁ (cin i a))} (T : ap δ₀ c == R) → - ! (ap (λ p → p ∙ idp) (ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! (ap right p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) s₃ ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) T)))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) s₃ ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (∙-unit-r (! (ap right (ap δ₀ c)))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → p ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) s₃ ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 c))))) ◃∙ - ! (ap (λ p → p ∙ idp) (↯ (recc-free (cglue g a) s₃ c (snd (nat δ j) a) (glue (cin j a))))) ◃∙ - ↯ (ψ₁-free (cglue g a) s₃ c (snd (nat δ j) a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (pre-cmp-!-!-∙ δ₀ (cin j) s₃ c (ap (cin j) (snd (nat δ j) a) ∙ - ap ψ₂ (cglue g a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ (fst (nat δ j))) s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ - ap ψ₂ (cglue g a)) T) ◃∎ - =ₛ - ↯ (δ₀-free (cglue g a) s₃ (snd (nat δ j) a) R idp) ◃∎ - δ₀-red idp c idp = =ₛ-in (δ₀-red2 (cglue g a) c) - - commSq-red : {e : ty (F # j)} (s₃ : e == fun (F # j) a) {R₁ R₂ : δ₀ (cin j e) == δ₀ (ψ₁ (cin i a))} (T : R₁ == R₂) → - ! (ap (λ p → p ∙ idp) (ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! (ap (right {d = SpCos₂}) p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) s₃ ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) T)))) ◃∙ - ↯ (δ₀-free (cglue g a) s₃ (snd (nat δ j) a) R₁ idp) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) - s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) T) ◃∎ - =ₛ - ↯ (δ₀-free (cglue g a) s₃ (snd (nat δ j) a) R₂ idp) ◃∎ - commSq-red s₃ {R₁ = R₁} idp = =ₛ-in (∙-unit-r (↯ (δ₀-free (cglue g a) s₃ (snd (nat δ j) a) R₁ idp))) - --- T = ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a) - - δ₀-free-helper-pre2 : {e : ty (G # j)} (s : e == fun (G # j) a) {w z : Colim ForgG} (D : cin j e == w) (τ : cin j (fun (G # j) a) == z) - {t : P₂} (κ : t == right (cin j (fun (G # j) a))) - → ! (! (ap right D) ∙ ap (right ∘ cin j) s ∙ ! κ) ∙ idp == (κ ∙ ap right τ) ∙ ap right (! (! D ∙ ap (cin j) s ∙ τ)) - δ₀-free-helper-pre2 idp idp τ κ = !-!-∙-rid right τ κ - - δ₀-free-helper2-delay : {y : Colim (ConsDiag Γ A)} (q : cin j a == y) {e : ty (G # j)} (s : e == fun (G # j) a) - {w z : Colim ForgG} (D : cin j e == w) (τ : cin j (fun (G # j) a) == z) - → (! (ap left (ap [id] q)) ∙ ! (! (ap right D) ∙ ap (right {d = SpCos₂} ∘ cin j) s ∙ ! (glue (cin j a)))) ∙ idp - == (! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right τ) ∙ ap right (! (! D ∙ ap (cin j) s ∙ τ)) - δ₀-free-helper2-delay idp s D τ = δ₀-free-helper-pre2 s D τ (glue (cin j a)) - - δ₀-free-helper : {y : Colim (ConsDiag Γ A)} (q : cin j a == y) {u e : ty (F # j)} (σ : e == u) (s : fst (nat δ j) u == fun (G # j) a) - {w z : Colim ForgG} (D : cin j (fst (nat δ j) e) == w) (τ : cin j (fun (G # j) a) == z) - → (! (ap left (ap [id] q)) ∙ ! ((! (ap (right {d = SpCos₂}) D)) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) σ ∙ ap (right ∘ cin j) s ∙ ! (glue (cin j a)))) ∙ idp - == - (! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right τ) ∙ ap right (! (! D ∙ ap (cin j ∘ fst (nat δ j)) σ ∙ ap (cin j) s ∙ τ)) - δ₀-free-helper q idp s D τ = δ₀-free-helper2-delay q s D τ - --- τ = ap ψ₂ q - - δ₀-free-v2 : {y : Colim (ConsDiag Γ A)} (q : cin j a == y) {u e : ty (F # j)} (s₃ : e == u) (s₁ : fst (nat δ j) u == fun (G # j) a) - {v : Colim ForgG} (D : cin j (fst (nat δ j) e) == v) {m : P₂} (ξ : m == right v) → - (! (ap left (ap [id] q)) ∙ ! ((ξ ∙ ! (ap (right {d = SpCos₂}) D)) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) s₃ ∙ ap (right ∘ cin j) s₁ ∙ ! (glue (cin j a)))) ∙ ξ - =-= - glue y ∙ ap right (! (! D ∙ ap (cin j ∘ fst (nat δ j)) s₃ ∙ ap (cin j) s₁ ∙ ap ψ₂ q)) - δ₀-free-v2 {y} q s₃ s₁ D idp = - (! (ap left (ap [id] q)) ∙ ! ((! (ap (right {d = SpCos₂}) D)) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) s₃ ∙ ap (right ∘ cin j) s₁ ∙ ! (glue (cin j a)))) ∙ idp - =⟪ δ₀-free-helper q s₃ s₁ D (ap ψ₂ q) ⟫ - (! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right (ap ψ₂ q)) ∙ ap right (! (! D ∙ ap (cin j ∘ fst (nat δ j)) s₃ ∙ ap (cin j) s₁ ∙ ap ψ₂ q)) - =⟪ ! (ap (λ p → p ∙ ap right (! (! D ∙ ap (cin j ∘ fst (nat δ j)) s₃ ∙ ap (cin j) s₁ ∙ ap ψ₂ q))) (transp-pth-cmp q (glue (cin j a)))) ⟫ - (transport (λ z → left ([id] z) == right (ψ₂ z)) q (glue (cin j a))) ∙ ap right (! (! D ∙ ap (cin j ∘ fst (nat δ j)) s₃ ∙ ap (cin j) s₁ ∙ ap ψ₂ q)) - =⟪ ap (λ p → p ∙ ap right (! (! D ∙ ap (cin j ∘ fst (nat δ j)) s₃ ∙ ap (cin j) s₁ ∙ ap ψ₂ q))) (apd-tr glue q) ⟫ - glue y ∙ ap right (! (! D ∙ ap (cin j ∘ fst (nat δ j)) s₃ ∙ ap (cin j) s₁ ∙ ap ψ₂ q)) ∎∎ - - abstract + open Id Γ A - δ₀-free-eq : {y : Colim (ConsDiag Γ A)} (q : cin j a == y) {u e : ty (F # j)} (s₃ : e == u) (s₁ : fst (nat δ j) u == fun (G # j) a) - {v : Colim ForgG} (D : cin j (fst (nat δ j) e) == v) {m : P₂} (ξ : m == right v) → - ↯ (δ₀-free q s₃ s₁ D ξ) ◃∎ =ₛ δ₀-free-v2 q s₃ s₁ D ξ - δ₀-free-eq idp idp s₁ idp idp = lemma s₁ - where - lemma : {u : ty (G # j)} (s : u == fun (G # j) a) - → (↯ (∙-rid-rid idp (! (ap (right ∘ cin j) s ∙ ! (glue (cin j a)))) ◃∙ ψ₁-free-coher2 s₁ s) ◃∎) =ₛ - δ₀-free-helper-pre2 s idp idp (glue (cin j a)) ◃∙ - ! (ap (λ p → p ∙ ap right (! (ap (cin j) s ∙ idp))) (! (∙-unit-r (glue (cin j a))))) ◃∙ - idp ◃∎ - lemma idp = =ₛ-in (rid-coher (glue (cin j a))) + open Maps + + module MapCoher2 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where + + 𝕕-recc-transf1 = + ap-inv-rid 𝕕₀ (glue (cin i a)) ◃∙ ap ! (𝕕-βr (cin i a)) ◃∎ + =ₛ⟨ =ₛ-in (apd-tr-coher (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (λ z → ! (glue z ∙ ap right (! (ℂ z)))) + (cglue g a) (λ z → ap-inv-rid 𝕕₀ (glue z) ∙ ap ! (𝕕-βr z))) ⟩ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + apd-tr (λ z → ! (glue z ∙ ap right (! (ℂ z)))) (cglue g a) ◃∎ + =ₛ⟨ 2 & 1 & apd-tr-inv-fn (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (λ z → glue z ∙ ap right (! (ℂ z))) (cglue g a) ⟩ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-tr (λ z → glue z ∙ ap right (! (ℂ z))) (cglue g a)) ◃∎ + =ₛ⟨ 3 & 1 & ap-seq-=ₛ ! (apd-ap-∙-l-coher right {F = glue} {G = ℂ} (cglue g a)) ⟩ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (apd-tr ℂ (cglue g a))) ◃∎ + =ₛ₁⟨ 4 & 1 & ap (λ z → ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) z)) (=ₛ-out (ℂ-β g a)) ⟩ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (↯ (ζ g a))) ◃∎ ∎ₛ + + 𝕕-recc-transf2 = + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (↯ (ζ g a))) ◃∎ + =ₛ⟨ 4 & 1 & =ₛ-in (ap (ap !) (=ₛ-out (ap-seq-∙ (λ p → glue (cin i a) ∙ ap right (! p)) (ζ g a)))) ⟩ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap ! (↯ (ap-seq (λ p → glue (cin i a) ∙ ap right (! p)) (ζ g a))) ◃∎ + =ₛ⟨ 4 & 1 & ap-seq-∙ ! (ap-seq (λ p → glue (cin i a) ∙ ap right (! p)) (ζ g a)) ⟩ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap-seq ! (ap-seq (λ p → glue (cin i a) ∙ ap right (! p)) (ζ g a)) ∎ₛ + + 𝕕-recc-transf = 𝕕-recc-transf1 ∙ₛ 𝕕-recc-transf2 + + fib-coher2 = + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ (λ x → ! (glue x)) (cglue g a) + (ψ-βr F g a) (λ x → idp)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue (cin i a)))))) ◃∙ + ap-inv-rid 𝕕₀ (glue (cin i a)) ◃∙ + ap ! (𝕕-βr (cin i a)) ◃∙ + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ + =ₛ⟨ 9 & 2 & 𝕕-recc-transf ⟩ + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ (λ x → ! (glue x)) (cglue g a) + (ψ-βr F g a) (λ x → idp)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue (cin i a)))))) ◃∙ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (transp-pth-cmpL δ₀ ψ₁ ψ₂ (cglue g a) + (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! (ap δ₀ p) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (ψ₁-βr g a))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (pre-cmp-!-!-∙ δ₀ (cin j) (snd (F <#> g) a) + (cglue g (fun (F # i) a)) (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) + (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) + (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) + (comSq-coher δ g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! (! (ap (cin j) (ap (fst (G <#> g)) + (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) + (snd (F <#> g) a)))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ p) + (ψ₂-βr g a))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) + (cglue g (fun (G # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ ∎ₛ + + open ConstrMap2.MapCoher δ g a + + fib-coher-conc = fib-coher0 ∙ₛ (fib-coher1 ∙ₛ fib-coher2) diff --git a/Colimit-code/Map-Nat/CosColimitMap03.agda b/Colimit-code/Map-Nat/CosColimitMap03.agda index 98c0c66..7644667 100644 --- a/Colimit-code/Map-Nat/CosColimitMap03.agda +++ b/Colimit-code/Map-Nat/CosColimitMap03.agda @@ -1,14 +1,13 @@ -{-# OPTIONS --without-K --rewriting #-} +{-# OPTIONS --without-K --rewriting #-} open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram -open import FTID +open import Helper-paths +open import FTID-Cos open import AuxPaths -open import AuxPaths-v2 open import Colim open import Cocone open import CosColimitMap00 @@ -17,315 +16,138 @@ open import CosColimitMap02 module CosColimitMap03 where -module _ {ℓ} {A : Type ℓ} where - - four-!-!-!-rid-rid : {x y z w u : A} (p₁ : x == y) (p₄ : y == z) (p₃ : z == w) (p₂ : u == w) - → (p₁ ∙ ! (p₂ ∙ ! p₃ ∙ ! p₄ ∙ idp)) ∙ idp == (p₁ ∙ p₄ ∙ p₃) ∙ ! p₂ - four-!-!-!-rid-rid idp idp idp idp = idp - -module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f : B → C) (g : A → B) where - - ap-∘-∙ : {x y : A} (p : x == y) {z : B} (q : g y == z) → ap (f ∘ g) p ∙ ap f q == ap f (ap g p ∙ q) - ap-∘-∙ idp q = idp - -module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} {f g : A → B} (H : f ∼ g) where - - ∼-nat : {x y : A} (p : x == y) → H x ∙ ap g p ∙ ! (H y) == ap f p - ∼-nat {x = x} idp = !-inv-r (H x) - -module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} (f : A → B) where - - ap-!-!-!-!-rid-rid : {x y : A} (p : x == y) → idp == ap f (! (! (! (! p ∙ idp) ∙ idp) ∙ p)) - ap-!-!-!-!-rid-rid idp = idp - module ConstrMap4 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open Id Γ A public - - open ConstrMap2 δ - - open ConstrMap3 δ - - module MapCoher2 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where - - ψ₂-free-helper-pre3 : {x y z : Colim ForgG} (c₁ : x == y) (c₂ : z == y) - → idp == ap (right {d = SpCos₂}) (! (! (! ((c₁ ∙ ! c₂) ∙ idp) ∙ c₁) ∙ c₂)) - ψ₂-free-helper-pre3 idp c₂ = ap-!-!-!-!-rid-rid right c₂ - - ψ₂-free-helper3 : (f : ty (G # i) → Colim ForgG) {y z : ty (G # i)} {u w : ty (G # j)} {x : Colim ForgG} - (τ₁ : y == z) (c₁ : x == f y) (τ₂ : w == u) (c₂ : cin j w == f z) - → ! (ap (right {d = SpCos₂} ∘ f) τ₁) == ap right (! (! (! ((c₁ ∙ ap f τ₁ ∙ ! c₂) ∙ ap (cin j) (τ₂ ∙ idp)) ∙ c₁) ∙ ! (ap (cin j) τ₂) ∙ c₂)) - ψ₂-free-helper3 f idp c₁ idp c₂ = ψ₂-free-helper-pre3 c₁ c₂ - - ψ₂-free-helper2 : {y z : ty (G # i)} {u w v : ty (G # j)} {x : Colim ForgG} - (τ₁ : y == z) (c₁ : x == cin i y) (τ₂ : w == u) (σ₁ : v == u) (c₂ : cin j w == cin i z) - → ! (ap (right {d = SpCos₂} ∘ cin i) τ₁) == - ap right (! (! (! ((c₁ ∙ ap (cin i) τ₁ ∙ ! c₂) ∙ ap (cin j) (τ₂ ∙ ! σ₁ ∙ idp)) ∙ c₁) - ∙ ap (cin j) σ₁ ∙ ! (ap (cin j) τ₂) ∙ c₂)) - ψ₂-free-helper2 τ₁ c₁ τ₂ idp c₂ = ψ₂-free-helper3 (cin i) τ₁ c₁ τ₂ c₂ - - ψ₂-free-helper : {y z : ty (G # i)} {u w : ty (G # j)} {x : Colim ForgG} {k v : ty (F # j)} - (τ₁ : y == z) (c₁ : x == cin i y) (τ₂ : w == u) (σ₃ : k == v) (σ₁ : fst (nat δ j) v == u) (c₂ : cin j w == cin i z) - → ! (ap (right {d = SpCos₂} ∘ cin i) τ₁) == - ap right (! (! (! ((c₁ ∙ ap (cin i) τ₁ ∙ ! c₂) ∙ ap (cin j) (τ₂ ∙ ! σ₁ ∙ ! (ap (fst (nat δ j)) σ₃))) ∙ c₁) ∙ - ap (cin j ∘ fst (nat δ j)) σ₃ ∙ ap (cin j) σ₁ ∙ ! (ap (cin j) τ₂) ∙ c₂)) - ψ₂-free-helper τ₁ c₁ τ₂ idp σ₁ c₂ = ψ₂-free-helper2 τ₁ c₁ τ₂ σ₁ c₂ - --- τ₁ = snd (nat δ i) a --- τ₂ = snd (G <#> g) a --- c₁ = cglue g (fst (nat δ i) (fun (F # i) a)) --- c₂ = cglue g (fun (G # i) a) - - open MapCoher i j g a - - δ₀-free-helper2 : {x y z : Colim ForgG} (D : x == y) (τ : x == z) → ! (! (ap (right {d = SpCos₂}) D) ∙ idp) ∙ idp == ap right τ ∙ ap right (! (! D ∙ τ)) - δ₀-free-helper2 idp idp = idp - - abstract - - δ₀-free-helper-coher : {w z : Colim ForgG} (D : cin j (fun (G # j) a) == w) (τ : cin j (fun (G # j) a) == z) - → δ₀-free-helper-pre2 idp D τ idp == δ₀-free-helper2 D τ - δ₀-free-helper-coher idp idp = idp - - ψ₂-free : (q : cin j a == cin i a) {e : ty (F # j)} (s₃ : e == fun (F # j) a) (μ : ψ₂ (cin j a) == ψ₂ (cin i a)) - (τ₁ : transport (λ z → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) q (glue (cin j a)) == ! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right μ) - (τ₂ : transport (λ z → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) q (glue (cin j a)) == glue (cin i a)) - → (! (ap left (ap [id] q)) ∙ ! (ap (right {d = SpCos₂} ∘ cin i) (snd (nat δ i) a) ∙ ! (ap right μ) ∙ ! (glue (cin j a)) ∙ idp)) ∙ idp - =-= glue (cin i a) ∙ ap right (! (! (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ - ! (ap (fst (nat δ j)) s₃))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ap (cin j ∘ fst (nat δ j)) - s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) - ψ₂-free q s₃ μ τ₁ τ₂ = - (! (ap left (ap [id] q)) ∙ ! (ap (right {d = SpCos₂} ∘ cin i) (snd (nat δ i) a) ∙ ! (ap right μ) ∙ ! (glue (cin j a)) ∙ idp)) ∙ idp - =⟪ four-!-!-!-rid-rid (! (ap left (ap [id] q))) (glue (cin j a)) (ap right μ) (ap (right {d = SpCos₂} ∘ cin i) (snd (nat δ i) a)) ⟫ - (! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right μ) ∙ ! (ap (right {d = SpCos₂} ∘ cin i) (snd (nat δ i) a)) - =⟪ ! (ap (λ p → p ∙ ! (ap (right {d = SpCos₂} ∘ cin i) (snd (nat δ i) a))) τ₁) ⟫ - transport (λ z → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) q (glue (cin j a)) ∙ ! (ap (right {d = SpCos₂} ∘ cin i) (snd (nat δ i) a)) - =⟪ ap (λ p → p ∙ ! (ap (right {d = SpCos₂} ∘ cin i) (snd (nat δ i) a))) τ₂ ⟫ - glue (cin i a) ∙ ! (ap (right {d = SpCos₂} ∘ cin i) (snd (nat δ i) a)) - =⟪ ap (λ p → glue (cin i a) ∙ p) (ψ₂-free-helper (snd (nat δ i) a) (cglue g (fst (nat δ i) (fun (F # i) a))) (snd (G <#> g) a) s₃ - (snd (nat δ j) a) (cglue g (fun (G # i) a))) ⟫ - glue (cin i a) ∙ ap right (! (! (! ((cglue g (fst (nat δ i) (fun (F # i) a)) ∙ ap (cin i) (snd (nat δ i) a) ∙ ! (cglue g (fun (G # i) a))) ∙ - ap (cin j) (snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ - ! (ap (fst (nat δ j)) s₃))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ap (cin j ∘ fst (nat δ j)) - s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) - =⟪ ap (λ p → glue (cin i a) ∙ ap right (! (! (! (p ∙ ap (cin j) (snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ - ! (ap (fst (nat δ j)) s₃))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ap (cin j ∘ fst (nat δ j)) - s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a)))) (∼-nat (cglue g) (snd (nat δ i) a)) ⟫ - glue (cin i a) ∙ ap right (! (! (! (ap (cin j ∘ fst (G <#> g)) (snd (nat δ i) a) ∙ ap (cin j) (snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ - ! (ap (fst (nat δ j)) s₃))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ap (cin j ∘ fst (nat δ j)) - s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) - =⟪ ap (λ p → glue (cin i a) ∙ ap right (! (! (! p ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ap (cin j ∘ fst (nat δ j)) - s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a)))) - (ap-∘-∙ (cin j) (fst (G <#> g)) (snd (nat δ i) a) (snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) s₃))) ⟫ - glue (cin i a) ∙ ap right (! (! (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ - ! (ap (fst (nat δ j)) s₃))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ap (cin j ∘ fst (nat δ j)) - s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∎∎ - --- τ₁ = transp-pth-cmp (cglue g a) (glue (cin j a)) --- τ₂ = apd-tr glue (cglue g a) --- μ = ap ψ₂ (cglue g a) - - ψ₂-red-helper3 : {z : P₂} (κ : z == right (ψ₂ (cin j a))) {t : ty (G # i)} (e : fst (G <#> g) t == fun (G # j) a) - → ! (ap (λ p → p ∙ idp) (ap (λ q₁ → q₁) (ap ! (ap (λ q₁₁ → q₁₁) (E₂-v2 {f = right {d = SpCos₂}} idp (! κ)))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ q₁ → q₁) (ap ! (ap (λ q₁₁ → q₁₁) (E₁-v2 {f = right {d = SpCos₂}} {g = cin j} e))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ q₁ → q₁) (ap ! (!-!-!-∘-rid (cin j) right e idp (! κ) idp)))) ◃∙ - δ₀-free-helper-pre2 idp (! (ap (cin j) (e ∙ idp)) ∙ idp) (! (ap (cin j) e) ∙ idp) κ ◃∙ - idp ◃∎ - =ₛ - four-!-!-!-rid-rid idp κ (ap right (! (ap (cin j) e) ∙ idp)) idp ◃∙ - ap (_∙_ (κ ∙ ap right (! (ap (cin j) e) ∙ idp))) (ψ₂-free-helper3 (λ z → cin j (fst (G <#> g) z)) idp idp e idp) - ◃∙ idp ◃∎ - ψ₂-red-helper3 idp {t = t} e = - idp ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ q₁ → q₁) (ap ! (ap (λ q₁₁ → q₁₁) (E₁-v2 e))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ q₁ → q₁) (ap ! (!-!-!-∘-rid (cin j) right e idp (! idp) idp)))) ◃∙ - δ₀-free-helper-pre2 idp (! (ap (cin j) (e ∙ idp)) ∙ idp) (! (ap (cin j) e) ∙ idp) idp ◃∙ - idp ◃∎ - =ₛ₁⟨ 3 & 1 & δ₀-free-helper-coher (! (ap (cin j) (e ∙ idp)) ∙ idp) (! (ap (cin j) e) ∙ idp) ⟩ - idp ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ q₁ → q₁) (ap ! (ap (λ q₁₁ → q₁₁) (E₁-v2 e))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ q₁ → q₁) (ap ! (!-!-!-∘-rid (cin j) right e idp (! idp) idp)))) ◃∙ - δ₀-free-helper2 (! (ap (cin j) (e ∙ idp)) ∙ idp) (! (ap (cin j) e) ∙ idp) ◃∙ - idp ◃∎ - =ₛ⟨ lemma e ⟩ - four-!-!-!-rid-rid idp idp (ap right (! (ap (cin j) e) ∙ idp)) idp ◃∙ - ap (_∙_ (ap right (! (ap (cin j) e) ∙ idp))) (ψ₂-free-helper3 (λ z → cin j (fst (G <#> g) z)) idp idp e idp) ◃∙ idp ◃∎ ∎ₛ - where - lemma : {w : ty (G # j)} (m : fst (G <#> g) t == w) - → idp ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ q₁ → q₁) (ap ! (ap (λ q₁₁ → q₁₁) (E₁-v2 m))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ q₁ → q₁) (ap ! (!-!-!-∘-rid (cin j) right m idp idp idp)))) ◃∙ - δ₀-free-helper2 (! (ap (cin j) (m ∙ idp)) ∙ idp) (! (ap (cin j) m) ∙ idp) ◃∙ - idp ◃∎ - =ₛ - four-!-!-!-rid-rid idp idp (ap right (! (ap (cin j) m) ∙ idp)) idp ◃∙ - ap (_∙_ (ap right (! (ap (cin j) m) ∙ idp))) (ψ₂-free-helper3 (λ z → cin j (fst (G <#> g) z)) idp idp m idp) ◃∙ idp ◃∎ - lemma idp = =ₛ-in idp - - module _ (q : cin j a == cin i a) where - - ψ₂-red-helper2 : {f : ty (G # i) → Colim ForgG} (H : cin j ∘ fst (G <#> g) ∼ f) {ρ γ : left a == right (f (fun (G # i) a))} - (τ₁ : ρ == ! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ H (fun (G # i) a))) (τ₂ : ρ == γ) - → ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! (ap (_∙_ (ap (right ∘ f) (snd (nat δ i) a))) (E₂-v2 {f = right {d = SpCos₂}} idp (! (glue (cin j a)))))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! (ap (_∙_ (ap (right ∘ f) (snd (nat δ i) a))) (E₁-v2 {f = right {d = SpCos₂}} {g = cin j} - (snd (G <#> g) a)))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! (!-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) f right - (snd (nat δ i) a) (snd (G <#> g) a) idp (! (glue (cin j a))) (H (fun (G # i) a)))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ idp)) ∙ p)) ∙ - ! (glue (cin j a))) (apCommSq2 (cin j ∘ fst (G <#> g)) f H (snd (nat δ i) a)))))) ∙ - δ₀-free-helper2-delay q idp (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ idp)) ∙ - H (fst (nat δ i) (fun (F # i) a))) (! (ap (cin j) (snd (G <#> g) a)) ∙ H (fun (G # i) a)) ∙ - ! (ap (λ p → p ∙ ap right (! (! (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ idp)) ∙ - H (fst (nat δ i) (fun (F # i) a))) ∙ - ! (ap (cin j) (snd (G <#> g) a)) ∙ H (fun (G # i) a)))) τ₁) ∙ - ap (λ p → p ∙ ap right (! (! (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ idp)) ∙ - H (fst (nat δ i) (fun (F # i) a))) ∙ - ! (ap (cin j) (snd (G <#> g) a)) ∙ H (fun (G # i) a)))) τ₂ ∙ idp - == - four-!-!-!-rid-rid (! (ap left (ap [id] q))) (glue (cin j a)) - (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ H (fun (G # i) a))) - (ap (right ∘ f) (snd (nat δ i) a)) ∙ - ! (ap (λ p → p ∙ ! (ap (right ∘ f) (snd (nat δ i) a))) τ₁) ∙ - ap (λ p → p ∙ ! (ap (right ∘ f) (snd (nat δ i) a))) τ₂ ∙ - ap (_∙_ γ) (ψ₂-free-helper3 f (snd (nat δ i) a) - (H (fst (nat δ i) (fun (F # i) a))) (snd (G <#> g) a) (H (fun (G # i) a))) ∙ - ap (λ p → γ ∙ ap right (! (! (! (p ∙ ap (cin j) (snd (G <#> g) a ∙ idp)) ∙ - H (fst (nat δ i) (fun (F # i) a))) ∙ ! (ap (cin j) (snd (G <#> g) a)) ∙ H (fun (G # i) a)))) - (∼-nat H (snd (nat δ i) a)) ∙ - ap (λ p → γ ∙ ap right (! (! (! p ∙ H (fst (nat δ i) (fun (F # i) a))) ∙ - ! (ap (cin j) (snd (G <#> g) a)) ∙ H (fun (G # i) a)))) - (ap-∘-∙ (cin j) (fst (G <#> g)) (snd (nat δ i) a) (snd (G <#> g) a ∙ idp)) - ψ₂-red-helper2 {f} H idp idp = IndFunHom {P = λ f₁ H₁ → - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! (ap (_∙_ (ap (right ∘ f₁) (snd (nat δ i) a))) - (E₂-v2 {f = right {d = SpCos₂}} idp (! (glue (cin j a)))))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) - (ap ! (ap (_∙_ (ap (right ∘ f₁) (snd (nat δ i) a))) (E₁-v2 {f = right {d = SpCos₂}} {g = cin j} (snd (G <#> g) a)))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! - (!-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) f₁ right (snd (nat δ i) a) - (snd (G <#> g) a) idp (! (glue (cin j a))) (H₁ (fun (G # i) a)))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) - (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ idp)) ∙ p)) ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) f₁ H₁ (snd (nat δ i) a)))))) ∙ δ₀-free-helper2-delay q idp - (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ idp)) ∙ H₁ (fst (nat δ i) (fun (F # i) a))) - (! (ap (cin j) (snd (G <#> g) a)) ∙ H₁ (fun (G # i) a)) ∙ idp - == - four-!-!-!-rid-rid (! (ap left (ap [id] q))) (glue (cin j a)) - (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ H₁ (fun (G # i) a))) - (ap (right ∘ f₁) (snd (nat δ i) a)) ∙ - ap (_∙_ (! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ H₁ (fun (G # i) a)))) - (ψ₂-free-helper3 f₁ (snd (nat δ i) a) - (H₁ (fst (nat δ i) (fun (F # i) a))) (snd (G <#> g) a) - (H₁ (fun (G # i) a))) ∙ ap (λ p → (! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ - ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ H₁ (fun (G # i) a))) ∙ - ap right (! (! (! (p ∙ ap (cin j) (snd (G <#> g) a ∙ idp)) ∙ H₁ (fst (nat δ i) (fun (F # i) a))) ∙ - ! (ap (cin j) (snd (G <#> g) a)) ∙ H₁ (fun (G # i) a)))) (∼-nat H₁ (snd (nat δ i) a)) ∙ - ap (λ p → (! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ - ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ H₁ (fun (G # i) a))) ∙ - ap right (! (! (! p ∙ H₁ (fst (nat δ i) (fun (F # i) a))) ∙ - ! (ap (cin j) (snd (G <#> g) a)) ∙ H₁ (fun (G # i) a)))) - (ap-∘-∙ (cin j) (fst (G <#> g)) (snd (nat δ i) a) (snd (G <#> g) a ∙ idp))} (lemma (snd (nat δ i) a) (snd (G <#> g) a)) f H - where - lemma : {t : ty (G # i)} (c : fst (nat δ i) (fun (F # i) a) == t) (e : fst (G <#> g) t == fun (G # j) a) → - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) - (ap ! (ap (_∙_ (ap (right ∘ (λ z → cin j (fst (G <#> g) z))) c)) - (E₂-v2 {f = right {d = SpCos₂}} idp (! (glue (cin j a)))))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) - (ap ! (ap (_∙_ (ap (right ∘ (λ z → cin j (fst (G <#> g) z))) c)) (E₁-v2 {f = right {d = SpCos₂}} {g = cin j} e))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) - (ap ! (!-!-!-∘-∘-∘-rid (cin j) (λ v → fst (G <#> g) v) - (λ z → cin j (fst (G <#> g) z)) right c e idp (! (glue (cin j a))) idp)))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) c ∙ e ∙ idp)) ∙ p)) ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) (λ z → cin j (fst (G <#> g) z)) (λ x → idp) c))))) ∙ - δ₀-free-helper2-delay q idp (! (ap (cin j) (ap (fst (G <#> g)) c ∙ e ∙ idp)) ∙ idp) (! (ap (cin j) e) ∙ idp) ∙ idp - == - four-!-!-!-rid-rid (! (ap left (ap [id] q))) (glue (cin j a)) - (ap right (! (ap (cin j) e) ∙ idp)) - (ap (right ∘ (λ z → cin j (fst (G <#> g) z))) c) ∙ - ap (_∙_ (! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right (! (ap (cin j) e) ∙ idp))) - (ψ₂-free-helper3 (λ z → cin j (fst (G <#> g) z)) c idp e idp) ∙ - ap (λ p → (! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right (! (ap (cin j) e) ∙ idp)) ∙ - ap right (! (! (! (p ∙ ap (cin j) (e ∙ idp)) ∙ idp) ∙ ! (ap (cin j) e) ∙ idp))) (∼-nat (λ x → idp) c) ∙ - ap (λ p → (! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right (! (ap (cin j) e) ∙ idp)) ∙ - ap right (! (! (! p ∙ idp) ∙ ! (ap (cin j) e) ∙ idp))) - (ap-∘-∙ (cin j) (λ v → fst (G <#> g) v) c (e ∙ idp)) - lemma idp e = lemma2 q - where - lemma2 : {y : Colim (ConsDiag Γ A)} (q₁ : cin j a == y) - → ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q₁)))) (ap ! (ap (λ q₁₁ → q₁₁) (E₂-v2 {f = right {d = SpCos₂}} idp (! (glue (cin j a)))))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q₁)))) (ap ! (ap (λ q₁₁ → q₁₁) (E₁-v2 {f = right {d = SpCos₂}} {g = cin j} e))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q₁)))) (ap ! (!-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) - (λ z → cin j (fst (G <#> g) z)) right idp e idp (! (glue (cin j a))) idp)))) ∙ - δ₀-free-helper2-delay q₁ idp (! (ap (cin j) (e ∙ idp)) ∙ idp) (! (ap (cin j) e) ∙ idp) ∙ idp - == - four-!-!-!-rid-rid (! (ap left (ap [id] q₁))) (glue (cin j a)) - (ap right (! (ap (cin j) e) ∙ idp)) idp ∙ - ap (_∙_ (! (ap left (ap [id] q₁)) ∙ glue (cin j a) ∙ ap right (! (ap (cin j) e) ∙ idp))) - (ψ₂-free-helper3 (λ z → cin j (fst (G <#> g) z)) idp idp e idp) ∙ idp - lemma2 idp = =ₛ-out (ψ₂-red-helper3 (glue (cin j a)) e) - --- γ = glue (cin i a) --- ρ = transport (λ z → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) q (glue (cin j a)) - - - 𝕗 = λ {e : ty (F # j)} (s₃ : e == fun (F # j) a) → - ! (ap (cin {D = ForgG} j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) s₃))) ∙ cglue g (fst (nat δ i) (fun (F # i) a)) - - module _ (q : cin j a == cin i a) (τ₂ : transport (λ z → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) q (glue (cin j a)) == glue (cin i a)) where - - ψ₂-red-helper : {u : ty (G # j)} (s : u == fun (G # j) a) (τ : transport (λ z → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) q (glue (cin j a)) - == ! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) - → ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) (E₂-v2 {f = right {d = SpCos₂}} idp - (! (glue (cin j a)))))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) (E₁-v2 {f = right {d = SpCos₂}} {g = cin j} - (snd (G <#> g) a)))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! (!-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) (cin i) (right {d = SpCos₂}) (snd (nat δ i) a) (snd (G <#> g) a) s - (! (glue (cin j a))) (cglue g (fun (G # i) a)))))) ∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] q)))) (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ ! s ∙ idp)) ∙ p)) ∙ ap (right ∘ cin j) s ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)))))) ∙ - δ₀-free-helper2-delay q s (! (ap (cin {D = ForgG} j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! s ∙ idp)) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a)) ∙ - ! (ap (λ p → p ∙ ap right (! (! (! (ap (cin {D = ForgG} j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! s ∙ idp)) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ - ap (cin j) s ∙ ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a)))) τ) ∙ - ap (λ p → p ∙ ap right (! (! (! (ap (cin {D = ForgG} j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! s ∙ idp)) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ - ap (cin j) s ∙ ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a)))) τ₂ ∙ idp - == - four-!-!-!-rid-rid (! (ap left (ap [id] q))) (glue (cin j a)) (ap (right {d = SpCos₂}) (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) - (ap (right ∘ cin i) (snd (nat δ i) a)) ∙ - ! (ap (λ p → p ∙ ! (ap (right ∘ cin i) (snd (nat δ i) a))) τ) ∙ - ap (λ p → p ∙ ! (ap (right ∘ cin i) (snd (nat δ i) a))) τ₂ ∙ - ap (_∙_ (glue (cin i a))) (ψ₂-free-helper2 (snd (nat δ i) a) - (cglue g (fst (nat δ i) (fun (F # i) a))) (snd (G <#> g) a) s (cglue g (fun (G # i) a))) ∙ - ap (λ p → glue (cin i a) ∙ - ap right (! (! (! (p ∙ ap (cin j) (snd (G <#> g) a ∙ ! s ∙ idp)) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))) ∙ - ap (cin j) s ∙ - ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a)))) (∼-nat (cglue g) (snd (nat δ i) a)) ∙ - ap (λ p → glue (cin i a) ∙ ap right (! (! (! p ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ap (cin j) s ∙ - ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a)))) - (ap-∘-∙ (cin j) (fst (G <#> g)) (snd (nat δ i) a) (snd (G <#> g) a ∙ ! s ∙ idp)) - ψ₂-red-helper idp τ = ψ₂-red-helper2 q (cglue g) τ τ₂ - - abstract - - ψ₂-red : {e : ty (F # j)} (s₃ : e == fun (F # j) a) {μ : ψ₂ (cin j a) == ψ₂ (cin i a)} (T : μ == ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a)) - (τ₁ : transport (λ z → left ([id] z) == right {d = SpCos₂} (ψ₂ z)) q (glue (cin j a)) == ! (ap left (ap [id] q)) ∙ glue (cin j a) ∙ ap right μ) - → ! (ap (λ p → p ∙ idp) (ap (λ p → ! (ap left (ap [id] q)) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₂-v2 T (! (glue (cin j a)))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ p → ! (ap left (ap [id] q)) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₁-v2 (snd (G <#> g) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ p → ! (ap left (ap [id] q)) ∙ p) (ap ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) - (fst (G <#> g)) (cin i) right (snd (nat δ i) a) (snd (G <#> g) a) s₃ - (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (λ p → ! (ap left (ap [id] q)) ∙ p) (ap ! (ap (λ p → ! (ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) s₃))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) s₃ ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ - ! (glue (cin j a))) (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)))))) ◃∙ - δ₀-free-helper q s₃ (snd (nat δ j) a) (𝕗 s₃) μ ◃∙ - ! (ap (λ p → p ∙ ap right (! (! (𝕗 s₃) ∙ ap (cin j ∘ fst (nat δ j)) s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ μ))) τ₁) ◃∙ - ap (λ p → p ∙ ap right (! (! (𝕗 s₃) ∙ ap (cin j ∘ fst (nat δ j)) s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ μ))) τ₂ ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ - ! (ap (fst (nat δ j)) s₃))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ap (cin j ∘ fst (nat δ j)) - s₃ ∙ ap (cin j) (snd (nat δ j) a) ∙ p) T) ◃∎ - =ₛ ↯ (ψ₂-free q s₃ μ τ₁ τ₂) ◃∎ - ψ₂-red idp idp τ₁ = =ₛ-in (ψ₂-red-helper (snd (nat δ j) a) τ₁) + open ConstrMap δ + + open Id Γ A + + open Maps + + module MapCoher3 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where + + open ConstrMap2.MapCoher δ g a + + open ConstrMap3.MapCoher2 δ g a + + fib-coher3 = + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a))) ∙ + ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (↯ 𝕤))) ◃∙ + ap-inv-rid 𝕕₀ (glue (cin i a)) ◃∙ + ap ! (𝕕-βr (cin i a)) ◃∙ + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (∙-unit-r (! (glue (cin i a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₃ (λ x → ! (glue x)) (cglue g a) (ψ-βr G g a) (λ x → idp))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a))) ◃∎ + =ₛ⟨ 0 & 8 & fib-coher-conc ⟩ + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ (λ x → ! (glue x)) (cglue g a) + (ψ-βr F g a) (λ x → idp)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue (cin i a)))))) ◃∙ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (transp-pth-cmpL δ₀ ψ₁ ψ₂ (cglue g a) + (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! (ap δ₀ p) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (ψ₁-βr g a))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (pre-cmp-!-!-∙ δ₀ (cin j) (snd (F <#> g) a) + (cglue g (fun (F # i) a)) (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) + (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) + (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) + (comSq-coher δ g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! (! (ap (cin j) (ap (fst (G <#> g)) + (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) + (snd (F <#> g) a)))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ p) + (ψ₂-βr g a))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) + (cglue g (fun (G # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (∙-unit-r (! (glue (cin i a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₃ (λ x → ! (glue x)) (cglue g a) (ψ-βr G g a) (λ x → idp))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a))) ◃∎ ∎ₛ diff --git a/Colimit-code/Map-Nat/CosColimitMap04.agda b/Colimit-code/Map-Nat/CosColimitMap04.agda index 1ec8bff..7c353a1 100644 --- a/Colimit-code/Map-Nat/CosColimitMap04.agda +++ b/Colimit-code/Map-Nat/CosColimitMap04.agda @@ -3,133 +3,141 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram -open import AuxPaths-v2 +open import Helper-paths +open import AuxPaths open import Colim open import Cocone open import CosColimitMap00 -open import CosColimitMap01 -open import CosColimitMap02 -open import CosColimitMap03 module CosColimitMap04 where +module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (h : B → C) {k : A → B} where + + !-!-ap-idp-!-inv : {a₁ a₂ : A} (p₂ : a₁ == a₂) {b : B} (p₃ : k a₂ == b) {c : C} (p₁ : c == h (k a₂)) + → ! (p₁ ∙ ap h (! (! (! (ap k (! p₂ ∙ idp)) ∙ p₃) ∙ ap k p₂ ∙ idp))) + =-= + ! (ap h p₃) ∙ ! p₁ ∙ p₁ ∙ ! p₁ + !-!-ap-idp-!-inv idp idp p₁ = (!-∙ p₁ idp) ◃∙ ! (∙-unit-r (! p₁)) ◃∙ ap (λ p → ! p₁ ∙ p) (! (!-inv-r p₁)) ◃∎ + module ConstrMap5 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where open ConstrMap δ + + open Id Γ A + + open Maps + + module MapCoher4 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where + + ψ₂-free-aux3 : {x : P₂} (γ : x == right (cin j (fun (G # j) a))) + {κ : x == x} (ρ : κ == γ ∙ ! γ) + {z : Colim ForgG} (m₂ : cin j (fun (G # j) a) == z) {w : ty (G # j)} (σ : w == fun (G # j) a) + → ! (γ ∙ ap right (! (! (! (ap (cin j) (! σ ∙ idp)) ∙ m₂) ∙ ap (cin j) σ ∙ idp))) + =-= + ! (ap right m₂) ∙ ! γ ∙ κ + ψ₂-free-aux3 γ idp m₂ σ = !-!-ap-idp-!-inv right σ m₂ γ + + ψ₂-free-aux2 : {x : Colim (ConsDiag Γ A)} (q : cin j a == x) + {κ : left a == left ([id] x)} (ρ : κ == glue (cin j a) ∙ ap right (ap ψ₂ q) ∙ ! (glue x)) + {z : Colim ForgG} (m₂ : cin j (fun (G # j) a) == z) {w : ty (G # j)} (σ : w == fun (G # j) a) + → ! (glue {d = SpCos₂} x ∙ ap right (! (! (! (ap (cin j) (! σ ∙ idp)) ∙ m₂) ∙ ap (cin j) σ ∙ ap ψ₂ q))) + =-= ! (ap right m₂) ∙ ! (glue (cin j a)) ∙ κ + ψ₂-free-aux2 idp ρ m₂ σ = ψ₂-free-aux3 (glue (cin j a)) ρ m₂ σ + +{- + κ = ap left (ap [id] (cglue g a) + ρ = apCommSq-cmp left right glue (cglue g a) +-} + + ψ₂-free-aux : {x : Colim (ConsDiag Γ A)} (q : cin j a == x) {w₁ w₂ : ty (G # j)} (m₁ : w₁ == fun (G # j) a) + {z : Colim ForgG} (m₂ : cin j w₁ == z) (σ : w₂ == fun (G # j) a) + → ! (glue {d = SpCos₂} x ∙ ap right (! (! (! (ap (cin j) (m₁ ∙ ! σ ∙ idp)) ∙ m₂) ∙ + ap (cin j) σ ∙ ap ψ₂ q))) + =-= + ! (ap right (! (ap (cin j) m₁) ∙ m₂)) ∙ + ! (glue (cin j a)) ∙ ap left (ap [id] q) + ψ₂-free-aux q idp m₂ σ = ψ₂-free-aux2 q (apCommSq-cmp left right glue q) m₂ σ + + ψ₂-free : (q : cin j a == cin i a) {e : ty (F # j)} (s : e == fun (F # j) a) {x₁ x₂ : ty (G # i)} (d : x₁ == x₂) + (m : fst (G <#> g) x₂ == fun (G # j) a) + → ! (glue {d = SpCos₂} (cin i a) ∙ ap right (! (! (! (ap (cin j) + (ap (fst (G <#> g)) d ∙ m ∙ ! (snd (nat δ j) a) ∙ + ! (ap (fst (nat δ j)) s))) ∙ cglue g x₁) ∙ + ap (cin j ∘ fst (nat δ j)) s ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ q))) + =-= + ap (right ∘ cin i) d ∙ ! (ap right (! (ap (cin j) m) ∙ cglue g x₂)) ∙ + ! (glue (cin j a)) ∙ ap left (ap [id] q) + ψ₂-free q idp {x₂ = x₂} idp m = ψ₂-free-aux q m (cglue g x₂) (snd (nat δ j) a) - open ConstrMap3 δ - - open ConstrMap4 δ - - module _ (i j : Obj Γ) (g : Hom Γ i j) (a : A) where - - open MapCoher i j g a - - open MapCoher2 i j g a - - MainRed-helper : (q : cin {D = ConsDiag Γ A} j a == cin i a) {u : ty (G # j)} (s : u == fun (G # j) a) - → (! (ap (λ p → p ∙ idp) (↯ (id-free glue q (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - (four-!-!-!-rid-rid (! (ap left (ap (Id.[id] Γ A) q))) (glue (cin j a)) (ap right (ap ψ₂ q)) (ap (right ∘ cin i) (snd (nat δ i) a)) ∙ - ! (ap (λ p → p ∙ ! (ap (right ∘ cin i) (snd (nat δ i) a))) (transp-pth-cmp q (glue (cin j a)))) ∙ - ap (λ p → p ∙ ! (ap (right ∘ cin i) (snd (nat δ i) a))) (apd-tr glue q) ∙ - ap (_∙_ (glue (cin i a))) (ψ₂-free-helper2 (snd (nat δ i) a) (cglue g (fst (nat δ i) (fun (F # i) a))) (snd (G <#> g) a) - s (cglue g (fun (G # i) a))) ∙ - ap (λ p → glue (cin i a) ∙ ap right (! (! (! (p ∙ ap (cin j) (snd (G <#> g) a ∙ - ! s ∙ idp)) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))) ∙ - ap (cin j) s ∙ - ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a)))) - (∼-nat (cglue g) (snd (nat δ i) a)) ∙ - ap (λ p → glue (cin i a) ∙ ap right - (! (! (! p ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ - ap (cin j) s ∙ - ! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a)))) - (ap-∘-∙ (cin j) (fst (G <#> g)) (snd (nat δ i) a) - (snd (G <#> g) a ∙ ! s ∙ idp))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap-∘-!-!-rid-rid (fst (G <#> g)) (cin j) - (snd (nat δ i) a) s (snd (G <#> g) a) - (cglue g (fst (nat δ i) (fun (F # i) a))) - (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)) ◃∎) + ψ₂-red-aux3 : {x : P₂} (p : x == right (cin j (fun (G # j) a))) → + ap ! (∙-unit-r p) ∙ ! (ap (λ q → q) (∙-unit-r (! p))) ∙ idp + == + ↯ (ψ₂-free-aux3 p (! (!-inv-r p)) idp idp) + ψ₂-red-aux3 idp = idp + + ψ₂-red-aux2 : {x : Colim (ConsDiag Γ A)} (q : cin j a == x) {w : ty (G # j)} (σ : w == fun (G # j) a) + {m₂ : cin j (fun (G # j) a) == ψ₂ x} (τ : ap ψ₂ q == m₂) → + ap ! (ap (λ p → glue x ∙ ap right (! p)) + (ap (λ p → ! (! (ap (cin j) (! σ ∙ idp)) ∙ m₂) ∙ ap (cin j) σ ∙ p) τ)) ◃∙ + ap ! (ap (λ p → glue x ∙ ap right (! p)) (ap-!-!-!-!-rid (cin j) σ idp m₂ m₂)) ◃∙ + ap ! (ap (λ p → glue x ∙ ap right (! p)) (!-inv-l m₂)) ◃∙ + ap ! (∙-unit-r (glue x)) ◃∙ + ! (ap (λ q → q) (∙-unit-r (! (glue x)))) ◃∙ + ! (ap (λ q → q) (E₃ (λ x → ! (glue x)) q τ (λ x → idp))) ◃∎ =ₛ - (ap-∘-!-!-rid (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎) - MainRed-helper q idp = lemma q (snd (nat δ i) a) (snd (G <#> g) a) - where - lemma : {x : Colim (ConsDiag Γ A)} (q₁ : x == cin i a) (c : fst (nat δ i) (fun (F # i) a) == fun (G # i) a) (e : fst (G <#> g) (fun (G # i) a) == fun (G # j) a) - → (! (ap (λ p → p ∙ idp) (↯ (id-free glue q₁ (ap (right ∘ cin i) c)))) ◃∙ - (four-!-!-!-rid-rid (! (ap left (ap [id] q₁))) (glue x) (ap right (ap ψ₂ q₁)) (ap (right ∘ cin i) c) ∙ - ! (ap (λ p → p ∙ ! (ap (right ∘ cin i) c)) (transp-pth-cmp q₁ (glue x))) ∙ - ap (λ p → p ∙ ! (ap (right ∘ cin i) c)) (apd-tr glue q₁) ∙ - ap (_∙_ (glue (cin i a))) (ψ₂-free-helper2 c (cglue g (fst (nat δ i) (fun (F # i) a))) - e idp (cglue g (fun (G # i) a))) ∙ - ap (λ p → glue (cin i a) ∙ ap right (! (! (! (p ∙ ap (cin j) (e ∙ idp)) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ! (ap (cin j) e) ∙ cglue g (fun (G # i) a)))) (∼-nat (cglue g) c) ∙ - ap (λ p → glue (cin i a) ∙ ap right (! (! (! p ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ - ! (ap (cin j) e) ∙ cglue g (fun (G # i) a)))) - (ap-∘-∙ (cin j) (fst (G <#> g)) c (e ∙ idp))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap-∘-!-!-rid-rid (fst (G <#> g)) (cin j) c idp - e (cglue g (fst (nat δ i) (fun (F # i) a))) (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) c) ◃∎) - =ₛ - (ap-∘-!-!-rid (cin i) right c (glue (cin i a)) ◃∎) - lemma idp c e = =ₛ-in (lemma2 (glue (cin i a))) - where - lemma2 : {w : P₂} (γ : w == right {d = SpCos₂} (cin i (fun (G # i) a))) - → ! (ap (λ p → p ∙ idp) (↯ (id-free-helper (ap (right ∘ cin i) c) γ))) ∙ - (four-!-!-!-rid-rid idp γ idp (ap (right ∘ cin i) c) ∙ - ! (ap (λ p → p ∙ ! (ap (right ∘ cin i) c)) (! (∙-unit-r γ))) ∙ - ap (_∙_ γ) (ψ₂-free-helper2 c (cglue g (fst (nat δ i) (fun (F # i) a))) - e idp (cglue g (fun (G # i) a))) ∙ - ap (λ p → γ ∙ ap right (! (! (! (p ∙ ap (cin j) (e ∙ idp)) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))) ∙ ! (ap (cin j) e) ∙ cglue g (fun (G # i) a)))) (∼-nat (cglue g) c) ∙ - ap (λ p → γ ∙ ap right (! (! (! p ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ - ! (ap (cin j) e) ∙ cglue g (fun (G # i) a)))) - (ap-∘-∙ (cin j) (fst (G <#> g)) c (e ∙ idp))) ∙ - ap (λ p → γ ∙ ap right (! p)) (ap-∘-!-!-rid-rid (fst (G <#> g)) (cin j) c idp - e (cglue g (fst (nat δ i) (fun (F # i) a))) (cglue g (fun (G # i) a))) ∙ - ap (λ p → γ ∙ ap right (! p)) (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) c) - == - ap-∘-!-!-rid (cin i) right c γ - lemma2 idp = lemma3 e c - where - lemma3 : {t : ty (G # j)} (e : fst (G <#> g) (fun (G # i) a) == t) {w : ty (G # i)} (c : w == fun (G # i) a) - → ! (ap (λ p → p ∙ idp) (↯ (id-free-helper (ap (right ∘ cin i) c) idp))) ∙ - (four-!-!-!-rid-rid idp idp idp (ap (right ∘ cin i) c) ∙ - ap (_∙_ idp) (ψ₂-free-helper3 (cin i) c (cglue g w) - e (cglue g (fun (G # i) a))) ∙ - ap (λ p → ap right (! (! (! (p ∙ ap (cin j) (e ∙ idp)) ∙ - cglue g w) ∙ ! (ap (cin j) e) ∙ cglue g (fun (G # i) a)))) (∼-nat (cglue g) c) ∙ - ap (λ p → ap right (! (! (! p ∙ cglue g w) ∙ - ! (ap (cin j) e) ∙ cglue g (fun (G # i) a)))) - (ap-∘-∙ (cin j) (fst (G <#> g)) c (e ∙ idp))) ∙ - ap (λ p → ap right (! p)) (ap-∘-!-!-rid-rid (fst (G <#> g)) (cin j) c idp - e (cglue g w) (cglue g (fun (G # i) a))) ∙ - ap (λ p → ap right (! p)) (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) c) - == - ap-∘-!-!-rid (cin i) right c idp - lemma3 idp idp = lemma4 (cglue g (fun (G # i) a)) - where - lemma4 : {x y : Colim ForgG} (α : x == y) - → (ap (λ q₁ → q₁) (ψ₂-free-helper-pre3 α α) ∙ - ap (λ p → ap right (! (! (! (p ∙ idp) ∙ α) ∙ α))) (!-inv-r α) ∙ idp) ∙ - ap (λ p → ap right (! p)) (!-inv-l α) - == idp - lemma4 idp = idp + ↯ (ψ₂-free-aux2 q (apCommSq-cmp left right glue q) m₂ σ) ◃∎ + ψ₂-red-aux2 idp idp idp = =ₛ-in (ψ₂-red-aux3 (glue (cin j a))) - abstract +-- q = cglue g a - map-MainRed0 : (q : cin {D = ConsDiag Γ A} j a == cin i a) {e : ty (F # j)} (s₃ : e == fun (F # j) a) - → ! (ap (λ p → p ∙ idp) (↯ (id-free glue q (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - ↯ (ψ₂-free q s₃ (ap ψ₂ q) (transp-pth-cmp q (glue (cin j a))) (apd-tr glue q)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (snd (nat δ i) a) (snd (G <#> g) a) s₃ (snd (nat δ j) a) - (cglue g (fst (nat δ i) (fun (F # i) a))) (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)) ◃∎ + ψ₂-red-aux : {w₁ w₂ : ty (G # j)} (m₁ : w₁ == fun (G # j) a) (m₂ : cin j w₁ == ψ₂ (cin i a)) + (σ : w₂ == fun (G # j) a) (τ : ap ψ₂ (cglue g a) == ! (ap (cin j) m₁) ∙ m₂) → + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! (! (ap (cin j) (m₁ ∙ ! σ ∙ idp)) ∙ + m₂) ∙ ap (cin j) σ ∙ p) τ)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap-!-!-!-!-rid (cin j) σ m₁ m₂ m₂)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (!-inv-l m₂)) ◃∙ + ap ! (∙-unit-r (glue (cin i a))) ◃∙ + ! (ap (λ q → q) (∙-unit-r (! (glue (cin i a))))) ◃∙ + ! (ap (λ q → q) (E₃ (λ x → ! (glue x)) (cglue g a) τ (λ x → idp))) ◃∎ =ₛ - ap-∘-!-!-rid (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ - map-MainRed0 q idp = MainRed-helper q (snd (nat δ j) a) + ↯ (ψ₂-free-aux (cglue g a) m₁ m₂ σ) ◃∎ + ψ₂-red-aux idp m₂ σ τ = ψ₂-red-aux2 (cglue g a) σ τ + +{- + m₁ = snd (G <#> g) a + m₂ = cglue g (fun (G # i) a) + σ = snd (nat δ j) a + τ = ψ₂-βr g a +-} + + abstract + + ψ₂-red : {e : ty (F # j)} (s : e == fun (F # j) a) {x : ty (G # i)} (d : x == fun (G # i) a) → + ap ! (ap (λ p → glue {d = SpCos₂} (cin i a) ∙ ap right (! p)) (ap (λ p → ! (! (ap (cin j) + (ap (fst (G <#> g)) d ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ + ! (ap (fst (nat δ j)) s))) ∙ cglue g x) ∙ ap (cin j ∘ fst (nat δ j)) s ∙ + ap (cin j) (snd (nat δ j) a) ∙ p) (ψ₂-βr g a))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) + d (snd (G <#> g) a) s + (snd (nat δ j) a) (cglue g x) (cglue g (fun (G # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) d)) ◃∙ + !-!-ap-∘ (cin i) right d (glue (cin i a)) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) d ∙ p) (∙-unit-r (! (glue (cin i a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) d ∙ p) + (E₃ {f = left} {u = right} (λ x → ! (glue x)) (cglue g a) (ψ₂-βr g a) (λ x → idp))) ◃∎ + =ₛ + ↯ (ψ₂-free (cglue g a) s d (snd (G <#> g) a)) ◃∎ + ψ₂-red idp idp = ψ₂-red-aux (snd (G <#> g) a) (cglue g (fun (G # i) a)) (snd (nat δ j) a) (ψ₂-βr g a) + +{- + s = snd (F <#> g) a + d = snd (nat δ i) a +-} diff --git a/Colimit-code/Map-Nat/CosColimitMap05.agda b/Colimit-code/Map-Nat/CosColimitMap05.agda index 95759f8..8f9019a 100644 --- a/Colimit-code/Map-Nat/CosColimitMap05.agda +++ b/Colimit-code/Map-Nat/CosColimitMap05.agda @@ -3,69 +3,152 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram -open import AuxPaths-v2 +open import Helper-paths +open import AuxPaths open import Colim open import Cocone open import CosColimitMap00 -open import CosColimitMap01 -open import CosColimitMap02 module CosColimitMap05 where +module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} (f : A → B) where + + !-ap-!-∙ : {a₁ a₂ : A} (p₂ : a₁ == a₂) {b : B} (p₁ : b == f a₂) {κ : b == b} (ρ : κ == p₁ ∙ ! p₁) + → ! (p₁ ∙ ap f (! p₂)) ∙ κ == ! (p₁ ∙ ap f (! (p₂ ∙ idp))) + !-ap-!-∙ idp idp idp = idp + +module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f₁ : B → C) {f₂ : A → B} where + + ap2-!-!-rid : {a₁ a₂ : A} (p₁ : a₁ == a₂) {b : B} (p₂ : b == f₂ a₁) + → ap f₁ (! (ap f₂ p₁) ∙ ! p₂ ∙ idp) ∙ idp == ! (ap (f₁ ∘ f₂) p₁) ∙ ! (ap f₁ p₂) ∙ idp + ap2-!-!-rid idp p₂ = ap (λ p → ap f₁ p ∙ idp) (∙-unit-r (! p₂)) ∙ ap (λ p → p ∙ idp) (ap-! f₁ p₂) + +module _ {ℓ₁ ℓ₂ ℓ₃ ℓ₄} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} {D : Type ℓ₄} (f₁ : C → D) {f₂ : B → C} {f₃ : A → C} where + + ap3-!-! : {a₁ a₂ : A} (p₄ : a₁ == a₂) {b₁ b₂ : B} (p₂ : b₁ == b₂) (p₃ : f₃ a₁ == f₂ b₁) → + ap f₁ (! (ap f₂ p₂) ∙ ! p₃ ∙ ap f₃ p₄) ∙ idp == ! (ap (f₁ ∘ f₂) p₂) ∙ ! (ap f₁ p₃) ∙ ap (f₁ ∘ f₃) p₄ + ap3-!-! idp p₂ p₃ = ap2-!-!-rid f₁ p₂ p₃ + +module _ {ℓ₁ ℓ₂ ℓ₃ ℓ₄ ℓ₅} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} {D : Type ℓ₄} {E : Type ℓ₅} + (f₁ : C → D) {f₂ : B → C} {f₃ : A → B} {f₄ : E → C} where + + ap4-!-!-!-rid : {a₁ a₂ : A} (p₁ : a₁ == a₂) {b : B} (p₂ : f₃ a₁ == b) {g₁ g₂ : E} (p₄ : g₁ == g₂) (p₃ : f₄ g₁ == f₂ (f₃ a₂)) + → ap f₁ (! (ap f₂ (! (ap f₃ p₁) ∙ p₂)) ∙ ! p₃ ∙ ap f₄ p₄) ∙ idp == + ! (ap (f₁ ∘ f₂) (! (ap f₃ p₁) ∙ p₂)) ∙ ! (ap f₁ p₃) ∙ ap (f₁ ∘ f₄) p₄ + ap4-!-!-!-rid idp p₂ p₄ p₃ = ap3-!-! f₁ p₄ p₂ p₃ + module ConstrMap6 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where + open ConstrMap δ + open Id Γ A - open ConstrMap2 δ - - open ConstrMap3 δ - - module MapCoher3 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where - - open MapCoher i j g a - - η-switch-red1 = - H₁ (cglue g a) (! (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)))) (ψ₁-βr g a) ◃∙ - H₂ (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (cglue g (fun (F # i) a)) (FM-βr g (fun (F # i) a)) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! (FM-βr g (fun (F # i) a))))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g (fun (F # i) a))) )) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (∙-unit-r (! (ap right (ap δ₀ (cglue g (fun (F # i) a)))))))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (δ₀-βr g (fun (F # i) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! ( ap (λ p → ! (ap (right {d = SpCos₂}) p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! (ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right - (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a))))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₁-v2 (snd (G <#> g) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))) ◃∙ - ↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))) ◃∎ - =ₛ⟨ 1 & 2 & recc-red (snd (F <#> g) a) (cglue g (fun (F # i) a)) (snd (nat δ j) a) (glue (cin j a)) (FM-βr g (fun (F # i) a)) ⟩ - H₁ (cglue g a) (! (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)))) (ψ₁-βr g a) ◃∙ - ↯ (recc-free (cglue g a) (snd (F <#> g) a) (cglue g (fun (F # i) a)) (snd (nat δ j) a) (glue (cin j a))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g (fun (F # i) a))) )) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (∙-unit-r (! (ap right (ap δ₀ (cglue g (fun (F # i) a)))))))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (δ₀-βr g (fun (F # i) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! ( ap (λ p → ! (ap (right {d = SpCos₂}) p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! (ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right - (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a))))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₁-v2 (snd (G <#> g) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))) ◃∙ - ↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))) ◃∎ ∎ₛ + open Maps + + module MapCoher5 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where + + ψ₁-free-aux3 : {x : Colim ForgF} (m₂ : cin j (fun (F # j) a) == x) + {κ : left a == left a} (ρ : κ == glue (cin j a) ∙ ! (glue (cin j a))) → + ! (ap (right {d = SpCos₂} ∘ δ₀) m₂) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ κ + == + ! (glue (cin j a) ∙ ap right (! (! (ap δ₀ m₂) ∙ ap (cin j) (snd (nat δ j) a) ∙ idp))) + ψ₁-free-aux3 idp ρ = !-ap-!-∙ right (ap (cin j) (snd (nat δ j) a)) (glue (cin j a)) ρ + + ψ₁-free-aux2 : {x : Colim (ConsDiag Γ A)} (q : cin j a == x) (m₂ : cin j (fun (F # j) a) == ψ₁ x) + {κ : left a == left ([id] x)} (ρ : κ == glue (cin j a) ∙ ap right (ap ψ₂ q) ∙ ! (glue x)) → + ! (ap (right {d = SpCos₂} ∘ δ₀) m₂) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ κ + == + ! (glue x ∙ ap right (! (! (ap δ₀ m₂) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ q))) + ψ₁-free-aux2 idp m₂ ρ = ψ₁-free-aux3 m₂ ρ + +{- + κ = ap left (ap [id] (cglue g a) + ρ = apCommSq-cmp left right glue (cglue g a) +-} + + ψ₁-free-aux : {x : Colim (ConsDiag Γ A)} (q : cin j a == x) {w : ty (F # j)} (m₁ : w == fun (F # j) a) + (m₂ : cin j w == ψ₁ x) → + ! (ap (right {d = SpCos₂} ∘ δ₀) (! (ap (cin j) m₁) ∙ m₂)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ ap left (ap [id] q) + == + ! (glue x ∙ ap right (! (! (ap δ₀ (! (ap (cin j) m₁) ∙ m₂)) ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ q))) + ψ₁-free-aux q idp m₂ = ψ₁-free-aux2 q m₂ (apCommSq-cmp left right glue q) + + ψ₁-red-aux3 : {x₁ x₂ : Colim ForgG} (t : x₁ == x₂) {y : P₂} + (r₂ : y == right x₂) {v : y == right x₁} (s : v == r₂ ∙ ap right (! t)) → + ap (λ q → q) (ap ! s) ∙ + ap ! (ap (λ p → r₂ ∙ ap (right {d = SpCos₂}) (! p)) + (! (∙-unit-r t))) ∙ idp + == + ! (∙-unit-r (! v)) ∙ + ap (λ p → ! p ∙ idp) s ∙ + !-ap-!-∙ right t r₂ (! (!-inv-r r₂)) + ψ₁-red-aux3 idp idp idp = idp + + ψ₁-red-aux2 : {x : P₁} (r₁ : x == right (ψ₁ (cin j a))) (r₂ : 𝕕₀ x == right (ψ₂ (cin j a))) + (s : ap 𝕕₀ r₁ == r₂ ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) → + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! r₁)))) ∙ + ap (λ q → q) (ap-inv-rid 𝕕₀ r₁ ∙ ap ! s) ∙ + ap ! (ap (λ p → r₂ ∙ ap right (! p)) + (! (∙-unit-r (ap (cin j) (snd (nat δ j) a))))) ∙ idp + == + (ap (λ p → ap 𝕕₀ p ∙ idp) (∙-unit-r (! r₁)) ∙ + ap (λ p → p ∙ idp) (ap-! 𝕕₀ r₁)) ∙ + ap (λ p → ! p ∙ idp) s ∙ + !-ap-!-∙ right (ap (cin j) (snd (nat δ j) a)) r₂ (! (!-inv-r r₂)) + ψ₁-red-aux2 idp r₂ s = ψ₁-red-aux3 (ap (cin j) (snd (nat δ j) a)) r₂ s + +{- + r₁ = glue {d = SpCos₁} (cin j a) + r₂ = glue {d = SpCos₂} (cin j a) + s = 𝕕-βr (cin j a) + t = ap (cin j) (snd (nat δ j) a) +-} + + ψ₁-red-aux : {m₂ : cin j (fun (F # j) a) == cin j (fun (F # j) a)} (τ : idp == m₂) → + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ {f = left} {h = [id]} {u = right} (λ x → ! (glue x)) + idp τ (λ x → idp)))) ∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue (cin j a)))))) ∙ + ap (λ q → q) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ∙ + ap ! (ap (λ p → glue (cin j a) ∙ ap right (! p)) (! (∙-unit-r (ap (cin j) (snd (nat δ j) a))))) ∙ + ap ! (ap (λ p → glue (cin j a) ∙ ap right (! p)) + (ap (λ p → ! (ap δ₀ p) ∙ ap (cin j) (snd (nat δ j) a) ∙ idp) τ)) + == + ap2-!-!-rid 𝕕₀ m₂ (glue (cin j a)) ∙ + ap (λ p → ! (ap (right ∘ δ₀) m₂) ∙ ! p ∙ idp) (𝕕-βr (cin j a)) ∙ + ψ₁-free-aux3 m₂ (apCommSq-cmp left right glue idp) + ψ₁-red-aux idp = ψ₁-red-aux2 (glue {d = SpCos₁} (cin j a)) (glue {d = SpCos₂} (cin j a)) (𝕕-βr (cin j a)) + + abstract + + ψ₁-red : {x : Colim (ConsDiag Γ A)} (q : cin j a == x) {w : ty (F # j)} (m₁ : w == fun (F # j) a) + {m₂ : cin j w == ψ₁ x} (τ : ap ψ₁ q == ! (ap (cin j) m₁) ∙ m₂) → + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ {f = left} {h = [id]} {u = right} (λ x → ! (glue x)) q + τ (λ x → idp)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue x))))) ◃∙ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) q) ◃∙ + ap (transport (λ z → right (δ₀ (ψ₁ z)) == left ([id] z)) q) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ₁) q + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} q) ◃∙ + ap ! (ap (λ p → glue x ∙ ap right (! p)) (transp-pth-cmpL δ₀ ψ₁ ψ₂ q + (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (ap (λ p → glue x ∙ ap right (! p)) + (ap (λ p → ! (ap δ₀ p) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ q) τ)) ◃∎ + =ₛ + ap4-!-!-!-rid 𝕕₀ m₁ m₂ (ap [id] q) (glue (cin j a)) ◃∙ + ap (λ p → ! (ap (right ∘ δ₀) (! (ap (cin j) m₁) ∙ m₂)) ∙ + ! p ∙ ap left (ap [id] q)) (𝕕-βr (cin j a)) ◃∙ + ψ₁-free-aux q m₁ m₂ ◃∎ + ψ₁-red idp idp τ = =ₛ-in (ψ₁-red-aux τ) + +{- + q = cglue g a + m₁ = snd (F <#> g) a + m₂ = cglue g (fun (F # i) a) + τ = ψ₁-βr g a +-} diff --git a/Colimit-code/Map-Nat/CosColimitMap06.agda b/Colimit-code/Map-Nat/CosColimitMap06.agda index 28d2260..7eb94e8 100644 --- a/Colimit-code/Map-Nat/CosColimitMap06.agda +++ b/Colimit-code/Map-Nat/CosColimitMap06.agda @@ -3,73 +3,415 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram -open import AuxPaths -open import AuxPaths-v2 open import Colim open import Cocone -open import Cocone-switch -open import Cocone-v2 open import CosColimitMap00 -open import CosColimitMap01 +open import CosColimitMap04 +open import CosColimitMap05 module CosColimitMap06 where +module _ {ℓ} {A : Type ℓ} where + + ap-!-rid-unit-r : {a₁ a₂ : A} (q₁ q₂ : a₁ == a₂) (α : q₂ == q₁ ∙ idp) → + ap (λ p → ! p ∙ idp) α ∙ ap (λ p → ! p ∙ idp) (∙-unit-r q₁) + == + ∙-unit-r (! q₂) ∙ ap ! α ∙ ap (λ v → v) (ap ! (∙-unit-r q₁) ∙ ! (∙-unit-r (! q₁))) ∙ idp + ap-!-rid-unit-r idp q₂ idp = idp + +module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} {f : A → B} where + + ap-!-!-rid-∙ : {a₁ a₂ : A} (p₁ : a₁ == a₂) {b₁ b₂ : B} (p₂ : b₁ == f a₁) (p₃ : b₁ == b₂) + → ! (ap f p₁) ∙ ! (p₂ ∙ idp) ∙ p₃ == ! (ap f p₁) ∙ ! p₂ ∙ p₃ + ap-!-!-rid-∙ idp p₂ p₃ = ap (λ p → ! p ∙ p₃) (∙-unit-r p₂) + + long-coher : {a₁ a₂ : A} (p₁ : a₁ == a₂) (p₂ : f a₁ == f a₂) (α : ap f p₁ == p₂ ∙ idp) → + (ap (λ p → ap f p ∙ idp) (∙-unit-r (! p₁)) ∙ + ap (λ p → p ∙ idp) (ap-! f p₁)) ∙ + ap (λ p → ! p ∙ idp) α ∙ + ap (λ p → ! p ∙ idp) (∙-unit-r p₂) + == + (∙-unit-r (ap f (! p₁ ∙ idp)) ∙ + ap (ap f) (∙-unit-r (! p₁)) ∙ ap-! f p₁) ∙ + ap ! α ∙ + ap (λ q → q) (ap ! (∙-unit-r p₂) ∙ ! (∙-unit-r (! p₂))) ∙ idp + long-coher idp p₂ α = ap-!-rid-unit-r p₂ idp α + +module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f₁ : B → C) {f₂ : A → B} where + + ap2-!5-rid : {a₁ a₂ : A} (p₁ : a₁ == a₂) {b : B} (p₂ : f₂ a₂ == b) {c : C} (p₃ : c == f₁ (f₂ a₂)) → + ! (ap f₁ (! (ap f₂ (! p₁ ∙ idp)) ∙ p₂ ∙ idp)) ∙ + ! (p₃ ∙ ap f₁ (! (ap f₂ p₁))) + == + ! (ap f₁ p₂) ∙ ! p₃ ∙ idp + ap2-!5-rid idp p₂ p₃ = + ap (λ p → ! (ap f₁ p) ∙ ! (p₃ ∙ idp)) (∙-unit-r p₂) ∙ + ap (λ p → ! (ap f₁ p₂) ∙ p) (ap ! (∙-unit-r p₃) ∙ ! (∙-unit-r (! p₃))) + + ap2-!5-rid-del : {a₁ a₂ a₃ : A} (p₀ : a₁ == a₂) (p₁ : a₃ == a₂) {b : B} (p₂ : f₂ a₁ == b) + {c : C} (p₃ : c == f₁ (f₂ a₂)) → + ! (ap f₁ (! (ap f₂ (p₀ ∙ ! p₁ ∙ idp)) ∙ p₂ ∙ idp)) ∙ + ! (p₃ ∙ ap f₁ (! (ap f₂ p₁))) + == + ! (ap f₁ (! (ap f₂ p₀) ∙ p₂)) ∙ ! p₃ ∙ idp + ap2-!5-rid-del idp p₁ p₂ p₃ = ap2-!5-rid p₁ p₂ p₃ + + ap2-!-!-rid2 : {a₁ a₂ : A} (p₁ : a₁ == a₂) {b : B} (p₂ : b == f₂ a₁) → + ap f₁ (! (ap f₂ p₁) ∙ ! p₂ ∙ idp) ∙ idp + == + ! (ap (f₁ ∘ f₂) p₁) ∙ ! (ap f₁ p₂) + ap2-!-!-rid2 idp p₂ = ∙-unit-r (ap f₁ (! p₂ ∙ idp)) ∙ ap (ap f₁) (∙-unit-r (! p₂)) ∙ ap-! f₁ p₂ + + ap-!5-rid-∙ : {a₁ a₂ : A} (p₁ : a₁ == a₂) {b : B} (p₂ : f₂ a₂ == b) {c₁ c₂ : C} (p₃ : c₁ == f₁ (f₂ a₂)) + (p₄ : c₁ == c₂) → + ! (ap f₁ (! (ap f₂ (! p₁ ∙ idp)) ∙ p₂)) ∙ ! (p₃ ∙ ap f₁ (! (ap f₂ p₁))) ∙ p₄ + == + ! (ap f₁ p₂) ∙ ! p₃ ∙ p₄ + ap-!5-rid-∙ idp p₂ p₃ p₄ = ap-!-!-rid-∙ p₂ p₃ p₄ + + long-coher2 : {a₁ a₂ : A} (p₁ : a₁ == a₂) {c : C} (p₂ : c == f₁ (f₂ a₂)) (p₃ : f₂ a₂ == f₂ a₁) + (t : idp == ! (ap f₂ (! p₁ ∙ idp)) ∙ p₃) → + !-ap-!-∙ f₁ (ap f₂ p₁) p₂ idp ∙ + ap ! (ap (λ p → p₂ ∙ ap f₁ (! p)) + (ap (λ p → ! p ∙ ap f₂ p₁ ∙ idp) t)) ∙ + ↯ (!-!-ap-idp-!-inv f₁ p₁ p₃ p₂) ∙ idp + == + ap (λ p → ! (ap f₁ p) ∙ ! (p₂ ∙ ap f₁ (! (ap f₂ p₁))) ∙ p₂ ∙ ! p₂) t ∙ + ap-!5-rid-∙ p₁ p₃ p₂ (p₂ ∙ ! p₂) + long-coher2 {a₁ = a₁} idp idp p₃ t = lemma t + where + lemma : {q : f₂ a₁ == f₂ a₁} (u : idp == q) → + ap ! (ap (λ p → ap f₁ (! p)) (ap (λ p → ! p ∙ idp) u)) ∙ ↯ (!-!-ap-idp-!-inv f₁ {k = f₂} idp q idp) ∙ idp + == + ap (λ p → ! (ap f₁ p) ∙ idp) u ∙ ap-!5-rid-∙ idp q idp idp + lemma idp = idp + +module _ {ℓ₁ ℓ₂ ℓ₃ ℓ₄} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} {D : Type ℓ₄} (f₁ : C → D) {f₂ : B → C} {f₃ : A → B} where + + ap2-!-!-!-rid2 : {a₁ a₂ : A} (p₁ : a₁ == a₂) {b : B} (p₂ : f₃ a₁ == b) {c : C} (p₃ : c == f₂ (f₃ a₂)) → + ap f₁ (! (ap f₂ (! (ap f₃ p₁) ∙ p₂)) ∙ ! p₃ ∙ idp) ∙ idp + == + ! (! (ap (f₁ ∘ f₂ ∘ f₃) p₁) ∙ ap (f₁ ∘ f₂) p₂) ∙ ! (ap f₁ p₃) + ap2-!-!-!-rid2 idp p₂ p₃ = ap2-!-!-rid2 f₁ p₂ p₃ + +module _ {ℓ₁ ℓ₂ ℓ₃ ℓ₄ ℓ₅} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} {D : Type ℓ₄} {E : Type ℓ₅} + (f₁ : C → D) {f₂ : B → C} {f₃ : A → B} {f₄ : E → B} {f₅ : E → C} where + + long-red-ap5-rid : {a₁ a₂ : A} (p₁ : a₁ == a₂) {e₁ e₂ : E} (p₂ : e₁ == e₂) {b : B} (p₃ : f₄ e₂ == b) (p₄ : f₃ a₂ == b) + (p₅ : f₂ (f₄ e₂) == f₅ e₂) {d : D} (p₆ : d == f₁ (f₂ b)) → + ! (! (ap (f₁ ∘ f₂ ∘ f₃) p₁) ∙ + ap f₁ (! (ap f₂ (ap f₄ p₂ ∙ p₃ ∙ ! p₄ ∙ ! (ap f₃ p₁))) ∙ + ap (f₂ ∘ f₄) p₂ ∙ + p₅ ∙ ! (ap f₅ p₂))) ∙ + ! (p₆ ∙ ap f₁ (! (ap f₂ p₄))) + == + ap (f₁ ∘ f₅) p₂ ∙ ! (ap f₁ (! (ap f₂ p₃) ∙ p₅)) ∙ ! p₆ ∙ idp + long-red-ap5-rid idp idp p₃ p₄ p₅ p₆ = ap2-!5-rid-del f₁ p₃ p₄ p₅ p₆ + module ConstrMap7 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap2 δ public + open ConstrMap δ + + open Id Γ A + + open Maps + + module MapCoher6 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where + + open ConstrMap5.MapCoher4 δ g a + + open ConstrMap6.MapCoher5 δ g a + + id-free-aux4-aux2 : {x : Colim ForgF} (r : cin j (fun (F # j) a) == x) + (c : cin j (fun (G # j) a) == δ₀ x) + (t₂ : ap δ₀ r == ! (ap (cin j) (! (snd (nat δ j) a) ∙ idp)) ∙ c) → + ψ₁-free-aux3 r idp ∙ + ap ! (ap (λ p → glue (cin j a) ∙ ap right (! p)) + (ap (λ p → ! p ∙ ap (cin j) (snd (nat δ j) a) ∙ idp) t₂)) ∙ + ↯ (!-!-ap-idp-!-inv right (snd (nat δ j) a) c (glue (cin j a))) ∙ idp + == + ap (λ p → ! p ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ + glue (cin j a) ∙ ! (glue (cin j a))) (ap-∘ right δ₀ r) ∙ + ap (λ p → ! (ap right p) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ + glue (cin j a) ∙ ! (glue (cin j a))) t₂ ∙ + ap-!5-rid-∙ right (snd (nat δ j) a) c (glue (cin j a)) (glue (cin j a) ∙ ! (glue (cin j a))) + id-free-aux4-aux2 idp c t₂ = long-coher2 right (snd (nat δ j) a) (glue (cin j a)) c t₂ + + id-free-aux4-aux-pre : {x : Colim (ConsDiag Γ A)} (q : cin j a == x) + (r : cin j (fun (F # j) a) == ψ₁ x) + (c : cin j (fun (G # j) a) == δ₀ (ψ₁ x)) + (t₂ : ap δ₀ r == ! (ap (cin j) (! (snd (nat δ j) a) ∙ idp)) ∙ c) + {κ : left a == left ([id] x)} (ξ : κ == glue (cin j a) ∙ ap right (ap ψ₂ q) ∙ ! (glue x)) + {z : left a == (right {d = SpCos₂} ∘ δ₀) (cin j (fun (F # j) a))} + (α : z == glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) → + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p ∙ κ) α ◃∙ + ψ₁-free-aux2 q r ξ ◃∙ + ap ! (ap (λ p → glue x ∙ ap right (! p)) + (ap (λ p → ! p ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ q) t₂)) ◃∙ + ↯ (ψ₂-free-aux2 q ξ c (snd (nat δ j) a)) ◃∙ + idp ◃∎ + =ₛ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p ∙ κ) α ◃∙ + ap (λ p → ! p ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ κ) (ap-∘ right δ₀ r) ◃∙ + ap (λ p → ! (ap right p) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ κ) t₂ ◃∙ + ap-!5-rid-∙ right (snd (nat δ j) a) c (glue (cin j a)) κ ◃∎ + id-free-aux4-aux-pre idp r c t₂ idp idp = =ₛ-in (id-free-aux4-aux2 r c t₂) - open CC-switch F (Cos P₂ left) + id-free-aux4-aux-post-aux2 : {x : ty (F # j)} (γ₁ : left {d = SpCos₁} a == right (cin j x)) + (γ₂ : left {d = SpCos₂} a == right (cin j (fst (nat δ j) x))) + (α : ap 𝕕₀ γ₁ == γ₂ ∙ idp) + {c : cin j (fst (nat δ j) x) == cin j (fst (nat δ j) x)} (t₂ : idp == c) → + (ap (λ p → ap 𝕕₀ p ∙ idp) (∙-unit-r (! γ₁)) ∙ + ap (λ p → p ∙ idp) (ap-! 𝕕₀ γ₁)) ∙ + ap (λ p → ! p ∙ idp) α ∙ + ap (λ p → ! (ap right p) ∙ ! (γ₂ ∙ idp) ∙ idp) t₂ ∙ + ap-!-!-rid-∙ c γ₂ idp + == + (∙-unit-r (ap 𝕕₀ (! γ₁ ∙ idp)) ∙ + ap (ap 𝕕₀) (∙-unit-r (! γ₁)) ∙ ap-! 𝕕₀ γ₁) ∙ + ap ! α ∙ + ap (λ p → ! (ap right p) ∙ ! (γ₂ ∙ idp)) t₂ ∙ + ap (λ p → ! (ap right p) ∙ ! (γ₂ ∙ idp)) (! (∙-unit-r c)) ∙ + (ap (λ p → ! (ap right p) ∙ ! (γ₂ ∙ idp)) (∙-unit-r c) ∙ + ap (_∙_ (! (ap right c))) (ap ! (∙-unit-r γ₂) ∙ ! (∙-unit-r (! γ₂)))) ∙ + idp + id-free-aux4-aux-post-aux2 γ₁ γ₂ α idp = long-coher γ₁ γ₂ α - module MapCoher4 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where + id-free-aux4-aux-post-aux : {x : ty (F # j)} (γ₁ : left {d = SpCos₁} a == right (cin j x)) + {y : ty (G # j)} (σ : fst (nat δ j) x == y) (c : cin j y == cin j (fst (nat δ j) x)) + (γ₂ : left {d = SpCos₂} a == right (cin j y)) + (α : ap 𝕕₀ γ₁ == γ₂ ∙ ap right (! (ap (cin j) σ))) + (t₂ : idp == ! (ap (cin j) (! σ ∙ idp)) ∙ c) → + (ap (λ p → ap 𝕕₀ p ∙ idp) (∙-unit-r (! γ₁)) ∙ + ap (λ p → p ∙ idp) (ap-! 𝕕₀ γ₁)) ∙ + ap (λ p → ! p ∙ idp) α ∙ + ap (λ p → ! (ap right p) ∙ ! (γ₂ ∙ ap right (! (ap (cin j) σ))) ∙ idp) t₂ ∙ + ap-!5-rid-∙ right σ c γ₂ idp + == + (∙-unit-r (ap 𝕕₀ (! γ₁ ∙ idp)) ∙ ap (ap 𝕕₀) (∙-unit-r (! γ₁)) ∙ ap-! 𝕕₀ γ₁) ∙ + ap (λ p → ! p) α ∙ + ap (λ p → ! (ap right p) ∙ ! (γ₂ ∙ ap right (! (ap (cin j) σ)))) t₂ ∙ + ap (λ p → ! (ap right (! (ap (cin j) (! σ ∙ idp)) ∙ p)) ∙ + ! (γ₂ ∙ ap right (! (ap (cin j) σ)))) (! (∙-unit-r c)) ∙ + ap2-!5-rid right σ c γ₂ ∙ idp + id-free-aux4-aux-post-aux γ₁ idp c γ₂ α t₂ = id-free-aux4-aux-post-aux2 γ₁ γ₂ α t₂ - open CC-v2-Constr G i j g a public + id-free-aux4-aux-post : {x : Colim ForgF} (r : cin j (fun (F # j) a) == x) + (c : cin j (fun (G # j) a) == δ₀ x) + (t₂ : ap δ₀ r == ! (ap (cin j) (! (snd (nat δ j) a) ∙ idp)) ∙ c) → + ap2-!-!-rid 𝕕₀ {f₂ = right {d = SpCos₁}} r (glue (cin j a)) ∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p ∙ idp) (𝕕-βr (cin j a)) ∙ + ap (λ p → ! p ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ idp) + (ap-∘ right δ₀ r) ∙ + ap (λ p → ! (ap right p) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ idp) t₂ ∙ + ap-!5-rid-∙ right (snd (nat δ j) a) c (glue (cin j a)) idp + == + ap2-!-!-rid2 𝕕₀ r (glue (cin j a)) ∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p) (𝕕-βr (cin j a)) ∙ + ap (λ p → ! p ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ r) ∙ + ap (λ p → ! (ap right p) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) t₂ ∙ + ap (λ p → ! (ap right (! (ap (cin j) (! (snd (nat δ j) a) ∙ idp)) ∙ p)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (! (∙-unit-r c)) ∙ + ap2-!5-rid right (snd (nat δ j) a) c (glue (cin j a)) ∙ idp + id-free-aux4-aux-post idp c t₂ = + id-free-aux4-aux-post-aux (glue {d = SpCos₁} (cin j a)) (snd (nat δ j) a) c (glue {d = SpCos₂} (cin j a)) (𝕕-βr (cin j a)) t₂ - θ-prefix = - ! (ap (right {d = SpCos₂}) (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)) - =⟪ ap (λ p → ! (ap (right {d = SpCos₂}) p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a)) ⟫ - ! (ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)) - =⟪ ap (λ p → ! (ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)) ⟫ - ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ - ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ ap (cin j ∘ fst (G <#> g)) (snd (nat δ i) a) ∙ - cglue g (fun (G # i) a) ∙ ! (ap (cin i) (snd (nat δ i) a)))) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)) - =⟪ long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a))) ⟫ - ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (ap right (cglue g (fun (G # i) a))) ∙ ap (right ∘ cin j) (snd (G <#> g) a) ∙ ! (glue (cin j a)) ∎∎ + id-free-aux4 : (r : cin j (fun (F # j) a) == ψ₁ (cin i a)) + (c : cin j (fun (G # j) a) == δ₀ (ψ₁ (cin i a))) + (t₂ : ap δ₀ r == ! (ap (cin j) (! (snd (nat δ j) a) ∙ idp)) ∙ c) + (ξ : idp == glue (cin j a) ∙ ap right (ap ψ₂ (cglue g a)) ∙ ! (glue (cin i a))) → + ap2-!-!-rid 𝕕₀ {f₂ = right {d = SpCos₁}} r (glue (cin j a)) ◃∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p ∙ idp) (𝕕-βr (cin j a)) ◃∙ + ψ₁-free-aux2 (cglue g a) r ξ ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! p ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) t₂)) ◃∙ + ↯ (ψ₂-free-aux2 (cglue g a) ξ c (snd (nat δ j) a)) ◃∙ + idp ◃∎ + =ₛ + ap2-!-!-rid2 𝕕₀ r (glue (cin j a)) ◃∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p) (𝕕-βr (cin j a)) ◃∙ + ap (λ p → ! p ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ r) ◃∙ + ap (λ p → ! (ap right p) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) t₂ ◃∙ + ap (λ p → ! (ap right (! (ap (cin j) (! (snd (nat δ j) a) ∙ idp)) ∙ p)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (! (∙-unit-r c)) ◃∙ + ap2-!5-rid right (snd (nat δ j) a) c (glue (cin j a)) ◃∙ + idp ◃∎ + id-free-aux4 r c t₂ ξ = + ap2-!-!-rid 𝕕₀ r (glue (cin j a)) ◃∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p ∙ idp) (𝕕-βr (cin j a)) ◃∙ + ψ₁-free-aux2 (cglue g a) r ξ ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! p ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) t₂)) ◃∙ + ↯ (ψ₂-free-aux2 (cglue g a) ξ c (snd (nat δ j) a)) ◃∙ + idp ◃∎ + =ₛ⟨ 1 & 5 & id-free-aux4-aux-pre (cglue g a) r c t₂ ξ (𝕕-βr (cin j a)) ⟩ + ap2-!-!-rid 𝕕₀ r (glue (cin j a)) ◃∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p ∙ idp) (𝕕-βr (cin j a)) ◃∙ + ap (λ p → ! p ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ idp) + (ap-∘ right δ₀ r) ◃∙ + ap (λ p → ! (ap right p) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ∙ idp) t₂ ◃∙ + ap-!5-rid-∙ right (snd (nat δ j) a) c (glue (cin j a)) idp ◃∎ + =ₛ⟨ =ₛ-in (id-free-aux4-aux-post r c t₂) ⟩ + ap2-!-!-rid2 𝕕₀ r (glue (cin j a)) ◃∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p) (𝕕-βr (cin j a)) ◃∙ + ap (λ p → ! p ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ r) ◃∙ + ap (λ p → ! (ap right p) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) t₂ ◃∙ + ap (λ p → ! (ap right (! (ap (cin j) (! (snd (nat δ j) a) ∙ idp)) ∙ p)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (! (∙-unit-r c)) ◃∙ + ap2-!5-rid right (snd (nat δ j) a) c (glue (cin j a)) ◃∙ + idp ◃∎ ∎ₛ - ap-ap-Θ-prefix = ap-seq (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (θ-prefix)) + module _ {a' : A} {m m' : a == a'} where - η-switch = κ-switch 𝕂 g a + pre-loop : (ρ : m == m') {e : ty (F # j)} (s : e == fun (F # j) a) + {x : Colim ForgF} (d : cin j e == x) → + ap 𝕕₀ (! (ap right (! (ap (cin j) s) ∙ d)) ∙ + ! (glue (cin j a)) ∙ ap left m) ∙ idp + == + ap 𝕕₀ (! (ap right (! (ap (cin j) s) ∙ + d)) ∙ ! (glue (cin j a)) ∙ ap left m') ∙ idp + pre-loop idp s d = idp + + post-loop : (ρ : m == m') {e : ty (G # j)} (s : e == fun (G # j) a) + {x₁ x₂ : ty (G # i)} (v : x₁ == x₂) (d : cin j e == cin i x₂) → + ap (right {d = SpCos₂} ∘ cin i) v ∙ + ! (ap right (! (ap (cin j) s) ∙ d)) ∙ + ! (glue (cin j a)) ∙ ap left m' + == + ap (right ∘ cin i) v ∙ + ! (ap right (! (ap (cin j) s) ∙ d)) ∙ + ! (glue (cin j a)) ∙ ap left m + post-loop idp s v d = idp + id-free-aux3 : {u : a == a} (ρ : u == idp) (r : cin j (fun (F # j) a) == ψ₁ (cin i a)) + (c : cin j (fun (G # j) a) == δ₀ (ψ₁ (cin i a))) + (t₂ : ap δ₀ r == ! (ap (cin j) (! (snd (nat δ j) a) ∙ idp)) ∙ c) + (ξ : ap left u == glue (cin j a) ∙ ap right (ap ψ₂ (cglue g a)) ∙ ! (glue (cin i a))) → + ap3-!-! 𝕕₀ {f₂ = right} u r (glue (cin j a)) ∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p ∙ ap left u) (𝕕-βr (cin j a)) ∙ + ψ₁-free-aux2 (cglue g a) r ξ ∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! p ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) t₂)) ∙ + ↯ (ψ₂-free-aux2 (cglue g a) ξ c (snd (nat δ j) a)) ∙ idp + == + pre-loop ρ idp r ∙ + ap2-!-!-rid2 𝕕₀ r (glue (cin j a)) ∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p) (𝕕-βr (cin j a)) ∙ + ap (λ p → ! p ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (ap-∘ right δ₀ r) ∙ + ap (λ p → ! (ap right p) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) t₂ ∙ + ap (λ p → ! (ap right (! (ap (cin j) (! (snd (nat δ j) a) ∙ idp)) ∙ p)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (! (∙-unit-r c)) ∙ + ap2-!5-rid right (snd (nat δ j) a) c (glue (cin j a)) ∙ + post-loop ρ idp idp c + id-free-aux3 idp r c t₂ ξ = =ₛ-out (id-free-aux4 r c t₂ ξ) - η=η-switch : η-switch =ₛ η (comp 𝕂) (comTri 𝕂) i j g a - η=η-switch = κ=κ-switch 𝕂 g a + id-free-aux2 : (ρ : ap [id] (cglue g a) == idp) (r : cin j (fun (F # j) a) == cin i (fun (F # i) a)) + {x : ty (G # j)} (e : x == fun (G # j) a) (c : cin j x == cin i (fst (nat δ i) (fun (F # i) a))) + (t₂ : ap δ₀ r == ! (ap (cin j) (e ∙ ! (snd (nat δ j) a) ∙ idp)) ∙ c) → + ap4-!-!-!-rid 𝕕₀ {f₂ = right} {f₃ = cin j} idp r (ap [id] (cglue g a)) (glue {d = SpCos₁} (cin j a)) ∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p ∙ ap left (ap [id] (cglue g a))) (𝕕-βr (cin j a)) ∙ + ψ₁-free-aux2 (cglue g a) r (apCommSq-cmp left right glue (cglue g a)) ∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! p ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) t₂)) ∙ + ↯ (ψ₂-free-aux (cglue g a) e c (snd (nat δ j) a)) ∙ + idp + == + pre-loop ρ idp r ∙ + ap2-!-!-!-rid2 𝕕₀ {f₂ = right} {f₃ = cin j} idp r (glue {d = SpCos₁} (cin j a)) ∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p) (𝕕-βr (cin j a)) ∙ + ap (λ p → ! p ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ r) ∙ + ap (λ p → ! (ap right p) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) t₂ ∙ + ap (λ p → ! (ap right (! (ap (cin j) (e ∙ ! (snd (nat δ j) a) ∙ idp)) ∙ p)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (! (∙-unit-r c)) ∙ + ap2-!5-rid-del right e (snd (nat δ j) a) c (glue (cin j a)) ∙ + post-loop ρ e idp c + id-free-aux2 ρ r idp c t₂ = id-free-aux3 ρ r c t₂ (apCommSq-cmp left right glue (cglue g a)) + id-red-aux : (ρ : ap [id] (cglue g a) == idp) (r : cin j (fun (F # j) a) == cin i (fun (F # i) a)) + {x : ty (G # i)} (d : fst (nat δ i) (fun (F # i) a) == x) (e : fst (G <#> g) x == fun (G # j) a) + (t₂ : ap δ₀ r == ! (ap (cin j) (ap (fst (G <#> g)) d ∙ e ∙ ! (snd (nat δ j) a) ∙ idp)) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) → + ap4-!-!-!-rid 𝕕₀ {f₂ = right} {f₃ = cin j} idp r (ap [id] (cglue g a)) (glue {d = SpCos₁} (cin j a)) ∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p ∙ ap left (ap [id] (cglue g a))) (𝕕-βr (cin j a)) ∙ + ψ₁-free-aux2 (cglue g a) r (apCommSq-cmp left right glue (cglue g a)) ∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! p ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) t₂)) ∙ + ↯ (ψ₂-free (cglue g a) idp d e) ∙ idp + == + pre-loop ρ idp r ∙ + ap2-!-!-!-rid2 𝕕₀ {f₂ = right} {f₃ = cin j} idp r (glue {d = SpCos₁} (cin j a)) ∙ + ap (λ p → ! (ap (right ∘ δ₀) r) ∙ ! p) (𝕕-βr (cin j a)) ∙ + ap (λ p → ! p ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ r) ∙ + ap (λ p → ! (ap right p) ∙ ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) t₂ ∙ + ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) d ∙ e ∙ ! (snd (nat δ j) a) ∙ idp)) ∙ p)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) d) ∙ + long-red-ap5-rid right {f₃ = fst (nat δ j)} idp d e (snd (nat δ j) a) (cglue g x) (glue (cin j a)) ∙ + post-loop ρ e d (cglue g x) + id-red-aux ρ r idp e t₂ = id-free-aux2 ρ r e (cglue g (fst (nat δ i) (fun (F # i) a))) t₂ - η-switch-bot-red1 = - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (snd (comTri 𝕂 g) a)) ◃∙ - ap (λ p → p ∙ (! (ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a))))) (ap (λ p → ! (ap left p)) (id-βr g a)) ◃∎ - =ₛ₁⟨ 0 & 1 & ap (ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p)) (=ₛ-out (ap-seq-∙ ! (Θ-combined g a))) ⟩ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (↯ (ap-seq ! (Θ-combined g a))) ◃∙ - ap (λ p → p ∙ (! (ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a))))) (ap (λ p → ! (ap left p)) (id-βr g a)) ◃∎ - =ₛ⟨ 0 & 1 & ap-seq-∙ (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (Θ-combined g a)) ⟩ - ap-seq (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (Θ-combined g a)) ∙∙ - (ap (λ p → p ∙ (! (ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a))))) (ap (λ p → ! (ap left p)) (id-βr g a)) ◃∎) ∎ₛ + abstract - γₛ = seq-! (ap-seq (λ p → p ∙ idp) (η (comp 𝕂) (comTri 𝕂) i j g a)) + id-red : {m : a == a} (τ : ap [id] (cglue g a) == m) (ρ : m == idp) + {e : ty (F # j)} (s : e == fun (F # j) a) (r : cin j e == cin i (fun (F # i) a)) + {w : fst (G <#> g) (fst (nat δ i) (fun (F # i) a)) == fst (nat δ j) e} + (t₁ : w == ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) s)) + (t₂ : ap δ₀ r == ! (ap (cin j) w) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) → + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + s) ∙ r)) ∙ ! (glue (cin j a)) ∙ p) (ap (ap left) τ))))) ◃∙ + ap4-!-!-!-rid 𝕕₀ s r (ap [id] (cglue g a)) (glue (cin j a)) ◃∙ + ap (λ p → ! (ap (right ∘ δ₀) (! (ap (cin j) s) ∙ r)) ∙ + ! p ∙ ap left (ap [id] (cglue g a))) (𝕕-βr (cin j a)) ◃∙ -- 𝕕 + ψ₁-free-aux (cglue g a) s r ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (pre-cmp-!-!-∙ δ₀ (cin j) s + r (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ + ap (cin j ∘ fst (nat δ j)) s ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) t₂)) ◃∙ -- δ₀ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) + s ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) + (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) t₁))) ◃∙ -- comSq + ↯ (ψ₂-free (cglue g a) s (snd (nat δ i) a) (snd (G <#> g) a)) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) τ)))) ◃∎ + =ₛ + pre-loop ρ s r ◃∙ + ap2-!-!-!-rid2 𝕕₀ s r (glue (cin j a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) s) ∙ ap (right ∘ δ₀) r) ∙ ! p) + (𝕕-βr (cin j a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) s) ∙ p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ r) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) s) ∙ ap right p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) t₂ ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) s) ∙ + ap right (! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) t₁ ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) s) ∙ + ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) s))) ∙ p)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)) ◃∙ + long-red-ap5-rid right s (snd (nat δ i) a) (snd (G <#> g) a) (snd (nat δ j) a) + (cglue g (fun (G # i) a)) (glue (cin j a)) ◃∙ + post-loop ρ (snd (G <#> g) a) (snd (nat δ i) a) (cglue g (fun (G # i) a)) ◃∎ + id-red idp ρ idp r idp t₂ = =ₛ-in (id-red-aux ρ r (snd (nat δ i) a) (snd (G <#> g) a) t₂) - γₑ = ap-seq (λ p → glue {d = SpCos₂} (cin i a) ∙ ap right (! p)) (ζ g a) - - 𝕪 = γₛ ∙∙ (! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ap (transport (λ z → left ([id] z) == right (δ₀ (ψ₁ z))) (cglue g a)) (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue {d = SpCos₂}} {G = ℂ} (cglue g a) ◃∙ γₑ) +{- + s = snd (F <#> g) a + r = cglue g (fun (F # i) a) + t₁ = comSq-coher δ g a + t₂ = δ₀-βr g (fun (F # i) a) + τ = id-βr g a + ρ = idp +-} diff --git a/Colimit-code/Map-Nat/CosColimitMap07.agda b/Colimit-code/Map-Nat/CosColimitMap07.agda index 7e81b56..5b7f450 100644 --- a/Colimit-code/Map-Nat/CosColimitMap07.agda +++ b/Colimit-code/Map-Nat/CosColimitMap07.agda @@ -3,50 +3,100 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram -open import AuxPaths-v2 +open import AuxPaths open import Colim open import Cocone -open import CosColimitMap02 +open import CosColimitMap00 open import CosColimitMap06 module CosColimitMap07 where +module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f₁ : B → C) (f₂ : A → B) where + + ap2-!5-2 : {b₁ b₂ b₃ : B} (p₁ : b₁ == b₂) (κ : b₁ == b₃) {a₁ a₂ : A} (p₄ : a₁ == a₂) (p₂ : f₁ b₃ == f₁ (f₂ a₁)) + {c : C} (p₃ : c == f₁ (f₂ a₂)) → + ! (! p₂ ∙ ap f₁ (! κ ∙ p₁)) ∙ ! (p₃ ∙ ap f₁ (! (ap f₂ p₄))) + =-= + ! (ap f₁ (! κ ∙ p₁)) ∙ p₂ ∙ ap (f₁ ∘ f₂) p₄ ∙ ! p₃ + ap2-!5-2 idp idp idp p₂ p₃ = + ap (λ p → p ∙ ! (p₃ ∙ idp)) (!-∙ (! p₂) idp ∙ !-! p₂) ◃∙ + ap (λ p → p₂ ∙ ! p) (∙-unit-r p₃) ◃∎ + + ap2-E₁-coher : {a₁ a₂ a₃ : A} (p₁ : a₁ == a₂) (d : a₃ == a₂) {b : B} (p₂ : f₂ a₁ == b) → + ap2-!5-rid-del f₁ p₁ d p₂ idp ∙ + ! (ap (λ q → q) (E₁ p₁ idp)) ∙ + ! (!-!-!-∘-rid f₂ f₁ p₁ d idp p₂) ∙ idp + == + ↯ (ap2-!5-2 (p₂ ∙ idp) (ap f₂ (p₁ ∙ ! d ∙ idp)) d idp idp) + ap2-E₁-coher idp idp idp = idp + module ConstrMap8 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap7 δ - - module MapCoher5 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where - - open ConstrMap3.MapCoher δ i j g a public - - open MapCoher4 i j g a - - η-switch-bot-red2 = - ap-seq (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (Θ-combined g a)) ∙∙ - (ap (λ p → p ∙ (! (ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a))))) (ap (λ p → ! (ap left p)) (id-βr g a)) ◃∎) - =ₛ₁⟨ 7 & 1 & ap (ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p)) (ap (ap !) (ap (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p)) (=ₛ-out (ϵ-Eq)))) ⟩ - ap-seq (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (Θ♯ g a)) ∙∙ (ap-ap-Θ-prefix ∙∙ ( - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (↯ ϵ-v2))) ◃∙ - ap (λ p → p ∙ (! (ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a))))) (ap (λ p → ! (ap left p)) (id-βr g a)) ◃∎ )) - =ₛ₁⟨ 7 & 1 & ap (ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p)) (ap (ap !) (=ₛ-out (ap-seq-∙ (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) ϵ-v2))) ⟩ - ap-seq (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (Θ♯ g a)) ∙∙ (ap-ap-Θ-prefix ∙∙ ( - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (↯ (ap-seq (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) ϵ-v2))) ◃∙ - ap (λ p → p ∙ (! (ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a))))) (ap (λ p → ! (ap left p)) (id-βr g a)) ◃∎ )) - =ₛ₁⟨ 7 & 1 & ap (ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p)) (=ₛ-out (ap-seq-∙ ! (ap-seq (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) ϵ-v2))) ⟩ - ap-seq (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (Θ♯ g a)) ∙∙ (ap-ap-Θ-prefix ∙∙ ( - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (↯ (ap-seq ! (ap-seq (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) ϵ-v2))) ◃∙ - ap (λ p → p ∙ (! (ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a))))) (ap (λ p → ! (ap left p)) (id-βr g a)) ◃∎ )) - =ₛ⟨ 7 & 1 & ap-seq-∙ (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (ap-seq (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) ϵ-v2)) ⟩ - ap-seq (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (Θ♯ g a)) ∙∙ (ap-ap-Θ-prefix ∙∙ ( - ap-seq (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (ap-seq (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) ϵ-v2)) ∙∙ - (ap (λ p → p ∙ (! (ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a))))) (ap (λ p → ! (ap left p)) (id-βr g a)) ◃∎))) - =ₛ⟨ 9 & 2 & id-red (ap (right ∘ cin i) (snd (nat δ i) a)) (cglue g a) (id-βr g a) ⟩ - ap-seq (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap-seq ! (Θ♯ g a)) ∙∙ (ap-ap-Θ-prefix ∙∙ ( - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₁-v2 (snd (G <#> g) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))) ◃∙ - ↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))) ◃∎ )) ∎ₛ - - η-switch-bot-red = η-switch-bot-red1 ∙ₛ η-switch-bot-red2 + open ConstrMap δ + + open Id Γ A + + open Maps + + module MapCoher7 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where + + comSq-red-aux : {y : ty (G # i)} (c₁ : fst (G <#> g) y == fun (G # j) a) + (c₂ : cin j (fst (G <#> g) y) == cin i y) + {x₁ x₂ : ty (F # j)} (σ : x₁ == x₂) (d : fst (nat δ j) x₂ == fun (G # j) a) + {x₃ : P₂} (γ : x₃ == right (cin j (fun (G # j) a))) → + long-red-ap5-rid (right {d = SpCos₂}) {f₄ = fst (G <#> g)} {f₅ = cin i} σ idp c₁ d c₂ γ ∙ + ! (ap (λ q → q) (E₁ c₁ (! γ))) ∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) + right idp c₁ σ d c₂ (! γ)) ∙ idp + == + ↯ (ap2-!5-2 right (cin j) (c₂ ∙ idp) (ap (cin j) (c₁ ∙ ! d ∙ + ! (ap (fst (nat δ j)) σ))) d + (ap (right ∘ cin j ∘ fst (nat δ j)) σ) γ) + comSq-red-aux c₁ c₂ idp d idp = ap2-E₁-coher right (cin j) c₁ d c₂ + + abstract + + comSq-red : + {y₁ y₂ : ty (G # i)} (c₃ : y₁ == y₂) (c₄ : fst (G <#> g) y₂ == fun (G # j) a) + (c₂ : cin j (fst (G <#> g) y₂) == cin i y₂) + {c₁ : cin j (fst (G <#> g) y₁) == cin i y₁} + (ω : c₁ == ap (cin j ∘ fst (G <#> g)) c₃ ∙ c₂ ∙ ! (ap (λ v → cin i v) c₃)) + {κ : fst (G <#> g) y₁ == fst (nat δ j) (fst (F <#> g) (fun (F # i) a))} + (ρ : κ == ap (fst (G <#> g)) c₃ ∙ c₄ ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a))) → + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ + ap right (! (ap (cin j) p) ∙ c₁)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) ρ ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ + ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) c₃ ∙ + c₄ ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) ω ◃∙ + long-red-ap5-rid right (snd (F <#> g) a) c₃ c₄ (snd (nat δ j) a) + c₂ (glue (cin j a)) ◃∙ + idp ◃∙ + ! (ap (λ p → ap (right ∘ cin i) c₃ ∙ p) + (E₁ c₄ (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right + c₃ c₄ (snd (F <#> g) a) + (snd (nat δ j) a) c₂ (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) c₃ ∙ + c₄ ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ω) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ c₁) ρ)) ◃∎ + =ₛ + ↯ (ap2-!5-2 right (cin j) c₁ (ap (cin j) κ) (snd (nat δ j) a) + (ap (right {d = SpCos₂} ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) (glue (cin j a))) ◃∎ + comSq-red idp c₄ c₂ idp idp = =ₛ-in (comSq-red-aux c₄ c₂ (snd (F <#> g) a) (snd (nat δ j) a) (glue (cin j a))) + +{- + c₁ = cglue g (fst (nat δ i) (fun (F # i) a)) + c₂ = cglue g (fun (G # i) a) + c₃ = snd (nat δ i) a + c₄ = snd (G <#> g) a + κ = comSq δ g (fun (F # i) a) + ρ = comSq-coher δ g a + ω = apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a) +-} diff --git a/Colimit-code/Map-Nat/CosColimitMap08.agda b/Colimit-code/Map-Nat/CosColimitMap08.agda index af442e1..8971b7f 100644 --- a/Colimit-code/Map-Nat/CosColimitMap08.agda +++ b/Colimit-code/Map-Nat/CosColimitMap08.agda @@ -3,73 +3,221 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram -open import AuxPaths-v2 +open import AuxPaths +open import Helper-paths +open import FTID-Cos open import Colim open import Cocone open import CosColimitMap00 -open import CosColimitMap01 open import CosColimitMap06 open import CosColimitMap07 module CosColimitMap08 where +module _ {ℓ} {A : Type ℓ} where + + !-∙-!-!-unit-r : {a₁ a₂ : A} (p : a₁ == a₂) → + (! (!-∙ (! p) idp ∙ ap (λ q → q) (!-! p ∙ ! (∙-unit-r p))) ∙ + ! (∙-unit-r (! (! p ∙ idp)))) ∙ + ap (λ p → p ∙ idp) (!-∙ (! p) idp ∙ !-! p) ∙ idp + == + idp + !-∙-!-!-unit-r idp = idp + + !-!-!-∙-! : {a₁ a₂ : A} (p₁ p₁' : a₁ == a₂) + → ! (((! p₁' ∙ p₁') ∙ ! p₁') ∙ p₁') ∙ ! p₁ == ! p₁ + !-!-!-∙-! p₁ idp = idp + + loop-!-!-unit-r : {a₁ a₂ : A} (p₁ p₁' : a₁ == a₂) (p₂ : p₁' == p₁ ∙ idp) → + ap (λ p → ! (((p ∙ p₁') ∙ ! p₁') ∙ p₁') ∙ ! p₁) + (ap ! p₂ ∙ ap ! (∙-unit-r p₁)) ∙ + neg-rid-trip-inv (! p₁) p₁' ∙ ap (λ p → ! p) p₂ + == + !-!-!-∙-! p₁ p₁' ∙ ap (λ p → ! p) (! (∙-unit-r p₁)) + loop-!-!-unit-r idp p₁' idp = idp + +module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f₁ : B → C) (f₂ : A → B) where + + long-coher3 : {a₁ a₂ : A} (p₄ : a₁ == a₂) {c₁ c₂ c₃ c₄ : C} (p₁ : c₁ == f₁ (f₂ a₁)) + (p₂ : f₁ (f₂ a₁) == c₃) (p₃ : c₂ == f₁ (f₂ a₂)) (p₅ : c₁ == c₄) → + ! ((p₁ ∙ (p₂ ∙ ! p₂) ∙ ! p₁) ∙ p₅ ∙ idp) ∙ p₁ ∙ + ap (f₁ ∘ f₂) p₄ ∙ ! p₃ + =-= + ! (! p₁ ∙ p₅) ∙ ! (p₃ ∙ ap f₁ (! (ap f₂ p₄))) + long-coher3 idp idp idp p₂ p₃ = ap (λ p → ! p ∙ ! p₂) (∙-unit-r p₃) ◃∙ ap (λ p → ! p₃ ∙ ! p) (! (∙-unit-r p₂)) ◃∎ + module ConstrMap9 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap7 δ public - - open ConstrMap8 δ - - module MapCoher6 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where - - open MapCoher4 i j g a public - - open MapCoher5 i j g a - - η-switch-red0 = - η-switch - =ₛ⟨ 2 & 2 & η-switch-bot-red ⟩ - H₁ (cglue g a) (! (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)))) (ψ₁-βr g a) ◃∙ - H₂ (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (cglue g (fun (F # i) a)) (FM-βr g (fun (F # i) a)) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! (FM-βr g (fun (F # i) a))))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g (fun (F # i) a))) )) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (∙-unit-r (! (ap right (ap δ₀ (cglue g (fun (F # i) a)))))))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (δ₀-βr g (fun (F # i) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! ( ap (λ p → ! (ap (right {d = SpCos₂}) p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! (ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right - (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a))))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₁-v2 (snd (G <#> g) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))) ◃∙ - ↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))) ◃∎ ∎ₛ - - η-switch-v2 = - H₁ (cglue g a) (! (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a)))) (ψ₁-βr g a) ◃∙ - ↯ (recc-free (cglue g a) (snd (F <#> g) a) (cglue g (fun (F # i) a)) (snd (nat δ j) a) (glue (cin j a))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g (fun (F # i) a))) )) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (∙-unit-r (! (ap right (ap δ₀ (cglue g (fun (F # i) a)))))))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (δ₀-βr g (fun (F # i) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! ( ap (λ p → ! (ap (right {d = SpCos₂}) p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ! (ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right - (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a))))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₁-v2 (snd (G <#> g) a)))) ◃∙ - ap (λ p → ! (ap left (ap [id] (cglue g a))) ∙ p) (ap ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))) ◃∙ - ↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))) ◃∎ + open ConstrMap δ + + open Id Γ A + + open Maps + + module MapCoher8 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where + + 𝕕-red-aux : {x : Colim ForgF} (c : cin j (fst (F <#> g) (fun (F # i) a)) == x) + (d₂ : right (cin j (fst (nat δ j) (fst (F <#> g) (fun (F # i) a)))) == + right (cin j (fst (nat δ j) (fst (F <#> g) (fun (F # i) a))))) + (ρ : idp == d₂ ∙ idp) → + ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ + ap 𝕕₀ (ap right c) ∙ idp) ∙ ! d₂) + (ap ! ρ ∙ ap ! (∙-unit-r d₂)) ∙ + !-∙-!-rid-∙-rid (ap 𝕕₀ (ap (right {d = SpCos₁}) c)) (! d₂) idp ∙ + ap (λ q → q) (!-ap-∙-s 𝕕₀ (ap right c)) ∙ + ap2-!-!-rid2 𝕕₀ c idp ∙ + ap (λ p → ! (ap (𝕕₀ ∘ right) c) ∙ ! p) ρ + == + ap (λ p → ! (p ∙ idp) ∙ ! d₂) + (∘-ap 𝕕₀ (right {d = SpCos₁}) c) ∙ + ap (λ p → ! p ∙ ! d₂) (∙-unit-r (ap (right ∘ δ₀) c)) ∙ + ap (λ p → ! (ap (right ∘ δ₀) c) ∙ ! p) (! (∙-unit-r d₂)) + 𝕕-red-aux idp d₂ ρ = loop-!-!-unit-r d₂ idp ρ + + 𝕕-red : {z : ty (F # j)} (d₄ : fst (F <#> g) (fun (F # i) a) == z) + {x : ty (G # j)} (d₁ : fst (nat δ j) z == x) + {y : P₁} (d₃ : y == right (cin j z)) (d₂ : 𝕕₀ y == right (cin j x)) + (ρ : ap 𝕕₀ d₃ == d₂ ∙ ap right (! (ap (cin j) d₁))) → + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) d₄ ∙ + (p ∙ ! (ap 𝕕₀ (! d₃) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) d₄)) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) d₄ ∙ ap (right ∘ cin j) d₁ ∙ ! d₂) + (ap-inv-rid 𝕕₀ d₃ ∙ ap ! ρ ∙ + !-!-ap-∘ (cin j) right d₁ d₂) ◃∙ + long-path-red d₄ (ap (right ∘ cin j) d₁ ∙ ! d₂) + (ap 𝕕₀ (! d₃) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) d₄ (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ d₄ (! d₃)))) ◃∙ + idp ◃∙ + ap2-!-!-!-rid2 𝕕₀ d₄ (cglue g (fun (F # i) a)) d₃ ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) d₄) ∙ + ap (𝕕₀ ∘ right) (cglue g (fun (F # i) a))) ∙ ! p) ρ ◃∎ + =ₛ + ap (λ p → ! ((ap (right ∘ cin j ∘ fst (nat δ j)) d₄ ∙ + ((ap 𝕕₀ (! d₃) ∙ idp) ∙ + ! (ap 𝕕₀ (! d₃) ∙ idp)) ∙ + ! (ap (right ∘ δ₀ ∘ cin j) d₄)) ∙ p ∙ idp) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) d₄ ∙ + ap (right ∘ cin j) d₁ ∙ ! d₂) (∘-ap 𝕕₀ right (cglue g (fun (F # i) a))) ◃∙ + ↯ (long-coher3 (right {d = SpCos₂}) (cin j) d₁ (ap (right ∘ cin j ∘ fst (nat δ j)) d₄) + (ap 𝕕₀ (! d₃) ∙ idp) d₂ (ap (right ∘ δ₀) (cglue g (fun (F # i) a)))) ◃∎ + 𝕕-red idp idp idp d₂ ρ = =ₛ-in (𝕕-red-aux (cglue g (fun (F # i) a)) d₂ ρ) + +{- + d₁ = snd (nat δ j) a + d₂ = glue {d = SpCos₂} (cin j a) + d₃ = glue {d = SpCos₁} (cin j a) + d₄ = snd (F <#> g) a + ρ = 𝕕-βr (cin j a) +-} + + δ₀-free : {x₁ x₂ : Colim ForgG} (κ : x₁ == x₂) {z₁ z₂ : ty (G # j)} + (p₂ : z₁ == z₂) {y : P₂} (p₃ : y == right (cin j z₂)) + (p₁ : right x₁ == right (cin j z₁)) → + ! (ap (right {d = SpCos₂}) κ) ∙ + p₁ ∙ + ap (right ∘ cin j) p₂ ∙ ! p₃ + =-= + ! (! p₁ ∙ ap right κ) ∙ + ! (p₃ ∙ ap right (! (ap (cin j) p₂))) + δ₀-free κ idp idp p₁ = + ! (!-∙ (! p₁) (ap right κ) ∙ ap (λ p → ! (ap right κ) ∙ p) (!-! p₁ ∙ ! (∙-unit-r p₁))) ◃∙ + ! (∙-unit-r (! (! p₁ ∙ ap right κ))) ◃∎ + + δ₀-red-aux2 : {v : ty (F # j)} {x : P₁} (e₁ : x == right (cin j v)) + {z : ty (G # j)} (d : fst (nat δ j) v == z) {y : P₂} (e₂ : y == right (cin j z)) → + ap (λ p → ! (p ∙ idp) ∙ + ap (right ∘ cin j) d ∙ ! e₂) + (!-∙-!-!-rid (ap 𝕕₀ (! e₁) ∙ idp) idp) ∙ + ↯ (long-coher3 right (cin j) d idp + (ap 𝕕₀ (! e₁) ∙ idp) e₂ idp) ∙ idp + == + ↯ (δ₀-free idp d e₂ idp) + δ₀-red-aux2 idp idp idp = idp + + δ₀-red-aux : {z : ty (F # j)} (s : z == fun (F # j) a) + {x : Colim ForgF} (c : cin j z == x) → + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) s ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (∙-unit-r (ap 𝕕₀ (ap right c)) ∙ + ∘-ap 𝕕₀ right c ∙ + ap-∘ right δ₀ c ∙ idp)) ∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right c) ∙ idp) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) s ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (hmtpy-nat-rev (λ x → idp) s + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ fst (nat δ j)) s ∙ + ((ap 𝕕₀ (! (glue (cin j a))) ∙ idp) ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (right ∘ δ₀ ∘ cin j) s)) ∙ p ∙ idp) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) s ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (∘-ap 𝕕₀ right c) ∙ + ↯ (long-coher3 right (cin j) (snd (nat δ j) a) + (ap (right ∘ cin j ∘ fst (nat δ j)) s) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) (glue (cin j a)) + (ap (right ∘ δ₀) c)) ∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) s) ∙ p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ c) ∙ idp + == + ↯ (δ₀-free (ap δ₀ c) (snd (nat δ j) a) (glue (cin j a)) (ap (right ∘ cin j ∘ fst (nat δ j)) s)) + δ₀-red-aux idp idp = δ₀-red-aux2 (glue (cin j a)) (snd (nat δ j) a) (glue (cin j a)) + + δ₀-red : {κ : cin j (fst (nat δ j) (fst (F <#> g) (fun (F # i) a))) == + cin i (fst (nat δ i) (fun (F # i) a))} (τ : ap δ₀ (cglue g (fun (F # i) a)) == κ) → + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) τ)) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ((ap 𝕕₀ (! (glue {d = SpCos₁} (cin j a))) ∙ idp) ∙ + ! (ap 𝕕₀ (! (glue {d = SpCos₁} (cin j a))) ∙ idp)) ∙ + ! (ap (right ∘ δ₀ ∘ cin j) (snd (F <#> g) a))) ∙ p ∙ idp) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue {d = SpCos₂} (cin j a))) (∘-ap 𝕕₀ right (cglue g (fun (F # i) a))) ◃∙ + ↯ (long-coher3 (right {d = SpCos₂}) (cin j) (snd (nat δ j) a) (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) + (ap 𝕕₀ (! (glue {d = SpCos₁} (cin j a))) ∙ idp) (glue {d = SpCos₂} (cin j a)) (ap (right ∘ δ₀) + (cglue g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ (cglue g (fun (F # i) a))) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap right p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) τ ◃∎ + =ₛ + ↯ (δ₀-free κ (snd (nat δ j) a) (glue (cin j a)) + (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a))) ◃∎ + δ₀-red idp = =ₛ-in (δ₀-red-aux (snd (F <#> g) a) (cglue g (fun (F # i) a))) + +{- + κ = ! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ + cglue g (fst (nat δ i) (fun (F # i) a)) + τ = δ₀-βr g (fun (F # i) a) +-} + + abstract + + δ₀-comSq-red : {x₁ x₂ x₃ : Colim ForgG} (c₁ : x₁ == x₂) (c₂ : x₁ == x₃) + {y₁ y₂ : ty (G # j)} (c₃ : y₁ == y₂) (c₄ : right x₃ == right (cin j y₁)) + {z : P₂} (c₅ : z == right (cin j y₂)) → + ↯ (δ₀-free (! c₂ ∙ c₁) c₃ c₅ c₄) ◃∙ + ↯ (ap2-!5-2 right (cin j) c₁ c₂ c₃ c₄ c₅) ◃∎ + =ₛ + idp ◃∎ + δ₀-comSq-red idp idp idp c₄ idp = =ₛ-in (!-∙-!-!-unit-r c₄) + +{- + c₁ = cglue g (fst (nat δ i) (fun (F # i) a)) + c₂ = ap (cin j) (comSq δ g (fun (F # i) a)) + c₃ = snd (nat δ j) a + c₄ = ap (right {d = SpCos₂} ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) + c₅ = glue (cin j a) +-} diff --git a/Colimit-code/Map-Nat/CosColimitMap09.agda b/Colimit-code/Map-Nat/CosColimitMap09.agda index 7b6a449..db460b9 100644 --- a/Colimit-code/Map-Nat/CosColimitMap09.agda +++ b/Colimit-code/Map-Nat/CosColimitMap09.agda @@ -3,41 +3,168 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram -open import AuxPaths open import Colim open import Cocone -open import CosColimitMap01 -open import CosColimitMap05 -open import CosColimitMap08 +open import AuxPaths +open import Helper-paths +open import FTID-Cos +open import CosColimitMap00 +open import CosColimitMap04 module CosColimitMap09 where module ConstrMap10 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap9 δ - - module MapCoher7 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where - - open MapCoher6 i j g a public - - open ConstrMap6.MapCoher3 δ i j g a public + open ConstrMap δ - η-switch-red : η (comp 𝕂) (comTri 𝕂) i j g a =ₛ η-switch-v2 - η-switch-red = (!ₛ η=η-switch) ∙ₛ (η-switch-red0 ∙ₛ η-switch-red1) + open Id Γ A - γₛ-switch-v2 = seq-! (ap-seq (λ p → p ∙ idp) η-switch-v2) + open Maps - abstract + module MapCoher9 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where - γₛ=γₛ-switch-v2 : γₛ =ₛ γₛ-switch-v2 - γₛ=γₛ-switch-v2 = !-=ₛ (ap-seq-=ₛ (λ p → p ∙ idp) η-switch-red) + open ConstrMap5.MapCoher4 δ g a - 𝕪-red0 = - 𝕪 - =ₛ⟨ 0 & 4 & γₛ=γₛ-switch-v2 ⟩ - γₛ-switch-v2 ∙∙ (! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ap (transport (λ z → left ([id] z) == right (δ₀ (ψ₁ z))) (cglue g a)) (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue {d = SpCos₂}} {G = ℂ} (cglue g a) ◃∙ γₑ) ∎ₛ + fib-coher-pre0 = + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ (λ x → ! (glue x)) (cglue g a) + (ψ₁-βr g a) (λ x → idp)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue (cin i a)))))) ◃∙ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (transp-pth-cmpL δ₀ ψ₁ ψ₂ (cglue g a) + (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! (ap δ₀ p) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (ψ₁-βr g a))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (pre-cmp-!-!-∙ δ₀ (cin j) (snd (F <#> g) a) + (cglue g (fun (F # i) a)) (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) + (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) + (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) + (comSq-coher δ g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! (! (ap (cin j) (ap (fst (G <#> g)) + (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) + (snd (F <#> g) a)))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ p) + (ψ₂-βr g a))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) + (cglue g (fun (G # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (∙-unit-r (! (glue (cin i a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₃ (λ x → ! (glue x)) (cglue g a) (ψ₂-βr g a) (λ x → idp))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a))) ◃∎ + =ₛ⟨ 18 & 6 & ψ₂-red (snd (F <#> g) a) (snd (nat δ i) a) ⟩ + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ (λ x → ! (glue x)) (cglue g a) + (ψ₁-βr g a) (λ x → idp)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue (cin i a)))))) ◃∙ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (transp-pth-cmpL δ₀ ψ₁ ψ₂ (cglue g a) + (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! (ap δ₀ p) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (ψ₁-βr g a))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (pre-cmp-!-!-∙ δ₀ (cin j) (snd (F <#> g) a) + (cglue g (fun (F # i) a)) (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) + (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) + (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) + (comSq-coher δ g a)))) ◃∙ + ↯ (ψ₂-free (cglue g a) (snd (F <#> g) a) (snd (nat δ i) a) (snd (G <#> g) a)) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a))) ◃∎ ∎ₛ diff --git a/Colimit-code/Map-Nat/CosColimitMap10.agda b/Colimit-code/Map-Nat/CosColimitMap10.agda index 48f5b4e..58a151e 100644 --- a/Colimit-code/Map-Nat/CosColimitMap10.agda +++ b/Colimit-code/Map-Nat/CosColimitMap10.agda @@ -1,130 +1,150 @@ -{-# OPTIONS --without-K --rewriting #-} +{-# OPTIONS --without-K --rewriting #-} open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram +open import Helper-paths +open import FTID-Cos open import AuxPaths -open import AuxPaths-v2 open import Colim +open import Cocone open import CosColimitMap00 -open import CosColimitMap01 -open import CosColimitMap02 -open import CosColimitMap09 +open import CosColimitMap04 +open import CosColimitMap05 module CosColimitMap10 where module ConstrMap11 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap2 δ + open ConstrMap δ - module MapCoher8 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where + open Id Γ A - open ConstrMap10.MapCoher7 δ i j g a + open Maps - open ConstrMap3.MapCoher δ i j g a + module MapCoher10 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where - 𝕪-red1 = - γₛ-switch-v2 ∙∙ (! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ap (transport (λ z → left ([id] z) == right (δ₀ (ψ₁ z))) (cglue g a)) (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue {d = SpCos₂}} {G = ℂ} (cglue g a) ◃∙ γₑ) -- seq length 22 - =ₛ⟨ 10 & 6 & ψ₁-red (cglue g a) (snd (F <#> g) a) (cglue g (fun (F # i) a)) (ψ₁-βr g a) ⟩ - ! (ap (λ p → p ∙ idp) (↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₁-v2 (snd (G <#> g) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! - (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) - right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fun (G # i) a)) - (! (glue (cin j a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + open ConstrMap5.MapCoher4 δ g a + + open ConstrMap6.MapCoher5 δ g a + + fib-coher-pre1 = + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ (λ x → ! (glue x)) (cglue g a) + (ψ₁-βr g a) (λ x → idp)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue (cin i a)))))) ◃∙ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (transp-pth-cmpL δ₀ ψ₁ ψ₂ (cglue g a) + (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! (ap δ₀ p) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (ψ₁-βr g a))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (pre-cmp-!-!-∙ δ₀ (cin j) (snd (F <#> g) a) + (cglue g (fun (F # i) a)) (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) + (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) + (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) + (comSq-coher δ g a)))) ◃∙ + ↯ (ψ₂-free (cglue g a) (snd (F <#> g) a) (snd (nat δ i) a) (snd (G <#> g) a)) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! - (ap - (λ p → - ! (ap right p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (ap - (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - (comSq-coher δ g a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! - (ap - (λ p → - ! (ap right p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (δ₀-βr g (fun (F # i) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! - (ap - (λ p → - p ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ (cglue g (fun (F # i) a)))))))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! - (ap - (λ p → - p ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g (fun (F # i) a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (↯ - (recc-free (cglue g a) (snd (F <#> g) a) (cglue g (fun (F # i) a)) - (snd (nat δ j) a) (glue (cin j a))))) ◃∙ - ↯ (ψ₁-free (cglue g a) (snd (F <#> g) a) (cglue g (fun (F # i) a)) - (snd (nat δ j) a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (pre-cmp-!-!-∙ δ₀ (cin j) (snd (F <#> g) a) - (cglue g (fun (F # i) a)) - (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → - ! p ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) - (δ₀-βr g (fun (F # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → - ! p ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) - (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - (comSq-coher δ g a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → ! - (! - (ap (cin j) - (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) - ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ p) (ψ₂-βr g a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a))) ◃∎ + =ₛ⟨ 7 & 8 & ψ₁-red (cglue g a) (snd (F <#> g) a) (ψ₁-βr g a) ⟩ + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ + ap4-!-!-!-rid 𝕕₀ (snd (F <#> g) a) (cglue g (fun (F # i) a)) (ap [id] (cglue g a)) + (glue (cin j a)) ◃∙ + ap (λ p → ! (ap (right ∘ δ₀) (! (ap (cin j) (snd (F <#> g) a)) ∙ (cglue g (fun (F # i) a)))) ∙ + ! p ∙ ap left (ap [id] (cglue g a))) (𝕕-βr (cin j a)) ◃∙ + ψ₁-free-aux (cglue g a) (snd (F <#> g) a) (cglue g (fun (F # i) a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (pre-cmp-!-!-∙ δ₀ (cin j) (snd (F <#> g) a) + (cglue g (fun (F # i) a)) (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) + (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) + (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) + (comSq-coher δ g a)))) ◃∙ + ↯ (ψ₂-free (cglue g a) (snd (F <#> g) a) (snd (nat δ i) a) (snd (G <#> g) a)) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) - (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)) ◃∎ ∎ₛ + (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a))) ◃∎ ∎ₛ diff --git a/Colimit-code/Map-Nat/CosColimitMap11.agda b/Colimit-code/Map-Nat/CosColimitMap11.agda index c849fca..c8839a5 100644 --- a/Colimit-code/Map-Nat/CosColimitMap11.agda +++ b/Colimit-code/Map-Nat/CosColimitMap11.agda @@ -1,183 +1,146 @@ -{-# OPTIONS --without-K --rewriting #-} +{-# OPTIONS --without-K --rewriting #-} open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram +open import Helper-paths +open import FTID-Cos open import AuxPaths -open import AuxPaths-v2 open import Colim +open import Cocone open import CosColimitMap00 -open import CosColimitMap01 -open import CosColimitMap02 -open import CosColimitMap09 +open import CosColimitMap04 +open import CosColimitMap05 +open import CosColimitMap06 module CosColimitMap11 where module ConstrMap12 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap2 δ + open ConstrMap δ - module MapCoher9 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where + open Id Γ A - open ConstrMap10.MapCoher7 δ i j g a + open Maps - open ConstrMap3.MapCoher δ i j g a + module MapCoher11 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where - 𝕪-red2 = - ! (ap (λ p → p ∙ idp) (↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₁-v2 (snd (G <#> g) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! - (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) - right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fun (G # i) a)) - (! (glue (cin j a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + open ConstrMap5.MapCoher4 δ g a + + open ConstrMap6.MapCoher5 δ g a + + open ConstrMap7.MapCoher6 δ g a + + fib-coher-pre2 = + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ + ap4-!-!-!-rid 𝕕₀ (snd (F <#> g) a) (cglue g (fun (F # i) a)) (ap [id] (cglue g a)) + (glue (cin j a)) ◃∙ + ap (λ p → ! (ap (right ∘ δ₀) (! (ap (cin j) (snd (F <#> g) a)) ∙ (cglue g (fun (F # i) a)))) ∙ + ! p ∙ ap left (ap [id] (cglue g a))) (𝕕-βr (cin j a)) ◃∙ + ψ₁-free-aux (cglue g a) (snd (F <#> g) a) (cglue g (fun (F # i) a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (pre-cmp-!-!-∙ δ₀ (cin j) (snd (F <#> g) a) + (cglue g (fun (F # i) a)) (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) + (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) + (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) + (comSq-coher δ g a)))) ◃∙ + ↯ (ψ₂-free (cglue g a) (snd (F <#> g) a) (snd (nat δ i) a) (snd (G <#> g) a)) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! - (ap - (λ p → - ! (ap right p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (ap - (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - (comSq-coher δ g a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! - (ap - (λ p → - ! (ap right p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (δ₀-βr g (fun (F # i) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! - (ap - (λ p → - p ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ (cglue g (fun (F # i) a)))))))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! - (ap - (λ p → - p ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g (fun (F # i) a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (↯ - (recc-free (cglue g a) (snd (F <#> g) a) (cglue g (fun (F # i) a)) - (snd (nat δ j) a) (glue (cin j a))))) ◃∙ - ↯ (ψ₁-free (cglue g a) (snd (F <#> g) a) (cglue g (fun (F # i) a)) - (snd (nat δ j) a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (pre-cmp-!-!-∙ δ₀ (cin j) (snd (F <#> g) a) - (cglue g (fun (F # i) a)) - (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → - ! p ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) - (δ₀-βr g (fun (F # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → - ! p ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) - (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - (comSq-coher δ g a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → ! - (! - (ap (cin j) - (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) - ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ p) (ψ₂-βr g a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a))) ◃∎ + =ₛ⟨ 6 & 9 & id-red (id-βr g a) idp (snd (F <#> g) a) (cglue g (fun (F # i) a)) + (comSq-coher δ g a) (δ₀-βr g (fun (F # i) a)) ⟩ + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + idp ◃∙ + ap2-!-!-!-rid2 𝕕₀ (snd (F <#> g) a) (cglue g (fun (F # i) a)) (glue (cin j a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap (right ∘ δ₀) (cglue g (fun (F # i) a))) ∙ ! p) + (𝕕-βr (cin j a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ (cglue g (fun (F # i) a))) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap right p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (δ₀-βr g (fun (F # i) a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ + ap right (! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (comSq-coher δ g a) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ + ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)) ◃∙ + long-red-ap5-rid right (snd (F <#> g) a) (snd (nat δ i) a) (snd (G <#> g) a) (snd (nat δ j) a) + (cglue g (fun (G # i) a)) (glue (cin j a)) ◃∙ + idp ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) - (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)) ◃∎ - =ₛ⟨ 6 & 7 & δ₀-red (snd (F <#> g) a) (cglue g (fun (F # i) a)) (δ₀-βr g (fun (F # i) a)) ⟩ - ! (ap (λ p → p ∙ idp) (↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₁-v2 (snd (G <#> g) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! - (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) - right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fun (G # i) a)) - (! (glue (cin j a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! - (ap - (λ p → - ! (ap right p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (ap - (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - (comSq-coher δ g a)))))) ◃∙ - ↯ (δ₀-free (cglue g a) (snd (F <#> g) a) (snd (nat δ j) a) (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))) idp) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → - ! p ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) - (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - (comSq-coher δ g a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → ! - (! - (ap (cin j) - (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) - ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ p) (ψ₂-βr g a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) - (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) - (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)) ◃∎ ∎ₛ + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a))) ◃∎ ∎ₛ diff --git a/Colimit-code/Map-Nat/CosColimitMap12.agda b/Colimit-code/Map-Nat/CosColimitMap12.agda index 0d85315..bd4be07 100644 --- a/Colimit-code/Map-Nat/CosColimitMap12.agda +++ b/Colimit-code/Map-Nat/CosColimitMap12.agda @@ -3,125 +3,120 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram +open import Helper-paths +open import FTID-Cos open import AuxPaths -open import AuxPaths-v2 open import Colim +open import Cocone open import CosColimitMap00 -open import CosColimitMap01 -open import CosColimitMap02 -open import CosColimitMap09 +open import CosColimitMap06 +open import CosColimitMap07 module CosColimitMap12 where module ConstrMap13 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap2 δ + open ConstrMap δ - module MapCoher10 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where + open Id Γ A - open ConstrMap10.MapCoher7 δ i j g a + open Maps - open ConstrMap3.MapCoher δ i j g a - - 𝕪-red3 = - ! (ap (λ p → p ∙ idp) (↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₁-v2 (snd (G <#> g) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! - (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) - right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fun (G # i) a)) - (! (glue (cin j a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + module MapCoher12 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where + + open ConstrMap7.MapCoher6 δ g a + + open ConstrMap8.MapCoher7 δ g a + + fib-coher-pre3 = + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + idp ◃∙ + ap2-!-!-!-rid2 𝕕₀ (snd (F <#> g) a) (cglue g (fun (F # i) a)) (glue (cin j a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap (right ∘ δ₀) (cglue g (fun (F # i) a))) ∙ ! p) + (𝕕-βr (cin j a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ (cglue g (fun (F # i) a))) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap right p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (δ₀-βr g (fun (F # i) a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ + ap right (! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (comSq-coher δ g a) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ + ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) - (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! - (ap - (λ p → - ! (ap right p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (ap - (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - (comSq-coher δ g a)))))) ◃∙ - ↯ (δ₀-free (cglue g a) (snd (F <#> g) a) (snd (nat δ j) a) (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))) idp) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → - ! p ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) - (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - (comSq-coher δ g a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → ! - (! - (ap (cin j) - (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) - ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ p) (ψ₂-βr g a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)) ◃∙ + long-red-ap5-rid right (snd (F <#> g) a) (snd (nat δ i) a) (snd (G <#> g) a) (snd (nat δ j) a) + (cglue g (fun (G # i) a)) (glue (cin j a)) ◃∙ + idp ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) - (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)) ◃∎ - =ₛ⟨ 5 & 3 & commSq-red (snd (F <#> g) a) (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a)) ⟩ - ! (ap (λ p → p ∙ idp) (↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₁-v2 (snd (G <#> g) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! - (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) - right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fun (G # i) a)) - (! (glue (cin j a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)))))) ◃∙ - ↯ (δ₀-free (cglue g a) (snd (F <#> g) a) (snd (nat δ j) a) - (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))) idp) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → ! - (! - (ap (cin j) - (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) - ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ p) (ψ₂-βr g a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) - (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) - (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)) ◃∎ ∎ₛ + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a))) ◃∎ + =ₛ⟨ 11 & 8 & comSq-red (snd (nat δ i) a) (snd (G <#> g) a) (cglue g (fun (G # i) a)) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)) + (comSq-coher δ g a) ⟩ + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + idp ◃∙ + ap2-!-!-!-rid2 𝕕₀ (snd (F <#> g) a) (cglue g (fun (F # i) a)) (glue (cin j a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap (right ∘ δ₀) (cglue g (fun (F # i) a))) ∙ ! p) + (𝕕-βr (cin j a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ (cglue g (fun (F # i) a))) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap right p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (δ₀-βr g (fun (F # i) a)) ◃∙ + ↯ (ap2-!5-2 right (cin j) (cglue g (fst (nat δ i) (fun (F # i) a))) + (ap (cin j) (comSq δ g (fun (F # i) a))) (snd (nat δ j) a) + (ap (right {d = SpCos₂} ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) (glue (cin j a))) ◃∎ ∎ₛ diff --git a/Colimit-code/Map-Nat/CosColimitMap13.agda b/Colimit-code/Map-Nat/CosColimitMap13.agda index 19a75cc..38c58c5 100644 --- a/Colimit-code/Map-Nat/CosColimitMap13.agda +++ b/Colimit-code/Map-Nat/CosColimitMap13.agda @@ -3,117 +3,131 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram +open import Helper-paths +open import FTID-Cos open import AuxPaths -open import AuxPaths-v2 open import Colim +open import Cocone open import CosColimitMap00 -open import CosColimitMap01 -open import CosColimitMap02 -open import CosColimitMap09 +open import CosColimitMap06 +open import CosColimitMap07 +open import CosColimitMap08 module CosColimitMap13 where module ConstrMap14 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap2 δ + open ConstrMap δ - module MapCoher11 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where + open Id Γ A - open ConstrMap10.MapCoher7 δ i j g a + open Maps - open ConstrMap3.MapCoher δ i j g a + module MapCoher13 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where - 𝕪-red4 = let - 𝕗 = λ {e : ty (F # j)} (s₃ : e == fun (F # j) a) → - ! (ap (cin {D = ForgG} j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) s₃))) ∙ cglue g (fst (nat δ i) (fun (F # i) a)) - in - ! (ap (λ p → p ∙ idp) (↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₁-v2 (snd (G <#> g) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! - (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) - right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fun (G # i) a)) - (! (glue (cin j a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + open ConstrMap7.MapCoher6 δ g a + + open ConstrMap8.MapCoher7 δ g a + + open ConstrMap9.MapCoher8 δ g a + + fib-coher-pre4 = + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + idp ◃∙ + ap2-!-!-!-rid2 𝕕₀ (snd (F <#> g) a) (cglue g (fun (F # i) a)) (glue (cin j a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap (right ∘ δ₀) (cglue g (fun (F # i) a))) ∙ ! p) + (𝕕-βr (cin j a)) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ (cglue g (fun (F # i) a))) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap right p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (δ₀-βr g (fun (F # i) a)) ◃∙ + ↯ (ap2-!5-2 right (cin j) (cglue g (fst (nat δ i) (fun (F # i) a))) + (ap (cin j) (comSq δ g (fun (F # i) a))) (snd (nat δ j) a) + (ap (right {d = SpCos₂} ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) (glue (cin j a))) ◃∎ + =ₛ⟨ 2 & 7 & 𝕕-red (snd (F <#> g) a) (snd (nat δ j) a) (glue {d = SpCos₁} (cin j a)) + (glue {d = SpCos₂} (cin j a)) (𝕕-βr (cin j a)) ⟩ + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ((ap 𝕕₀ (! (glue (cin j a))) ∙ idp) ∙ + ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (right ∘ δ₀ ∘ cin j) (snd (F <#> g) a))) ∙ p ∙ idp) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)))))) ◃∙ - ↯ (δ₀-free (cglue g a) (snd (F <#> g) a) (snd (nat δ j) a) - (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))) idp) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → ! - (! - (ap (cin j) - (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) - ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ p) (ψ₂-βr g a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) - (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) - (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)) ◃∎ - =ₛ⟨ 5 & 1 & δ₀-free-eq (cglue g a) (snd (F <#> g) a) (snd (nat δ j) a) - (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))) idp ⟩ - ! (ap (λ p → p ∙ idp) (↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₁-v2 (snd (G <#> g) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! - (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) - right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fun (G # i) a)) - (! (glue (cin j a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (∘-ap 𝕕₀ right (cglue g (fun (F # i) a))) ◃∙ + ↯ (long-coher3 (right {d = SpCos₂}) (cin j) (snd (nat δ j) a) (ap (right ∘ cin j ∘ fst (nat δ j)) + (snd (F <#> g) a)) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) (glue (cin j a)) + (ap (right ∘ δ₀) (cglue g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ (cglue g (fun (F # i) a))) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap right p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (δ₀-βr g (fun (F # i) a)) ◃∙ + ↯ (ap2-!5-2 right (cin j) (cglue g (fst (nat δ i) (fun (F # i) a))) + (ap (cin j) (comSq δ g (fun (F # i) a))) (snd (nat δ j) a) + (ap (right {d = SpCos₂} ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) (glue (cin j a))) ◃∎ ∎ₛ + + fib-coher-pre5 = + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ((ap 𝕕₀ (! (glue (cin j a))) ∙ idp) ∙ + ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (right ∘ δ₀ ∘ cin j) (snd (F <#> g) a))) ∙ p ∙ idp) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)))))) ◃∙ - δ₀-free-helper (cglue g a) (snd (F <#> g) a) (snd (nat δ j) a) (𝕗 (snd (F <#> g) a)) (ap ψ₂ (cglue g a)) ◃∙ - ! (ap (λ p → p ∙ ap right (! (! (𝕗 (snd (F <#> g) a)) ∙ ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) - (transp-pth-cmp (cglue g a) (glue (cin j a)))) ◃∙ - ap (λ p → p ∙ ap right (! (! (𝕗 (snd (F <#> g) a)) ∙ ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) - (apd-tr glue (cglue g a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → ! - (! - (ap (cin j) - (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) - ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ p) (ψ₂-βr g a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) - (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) - (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)) ◃∎ ∎ₛ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (∘-ap 𝕕₀ right (cglue g (fun (F # i) a))) ◃∙ + ↯ (long-coher3 (right {d = SpCos₂}) (cin j) (snd (nat δ j) a) (ap (right ∘ cin j ∘ fst (nat δ j)) + (snd (F <#> g) a)) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) (glue (cin j a)) + (ap (right ∘ δ₀) (cglue g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) + (ap-∘ right δ₀ (cglue g (fun (F # i) a))) ◃∙ + ap (λ p → ! (! (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) ∙ ap right p) ∙ + ! (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a))))) (δ₀-βr g (fun (F # i) a)) ◃∙ + ↯ (ap2-!5-2 right (cin j) (cglue g (fst (nat δ i) (fun (F # i) a))) + (ap (cin j) (comSq δ g (fun (F # i) a))) (snd (nat δ j) a) + (ap (right {d = SpCos₂} ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) (glue (cin j a))) ◃∎ + =ₛ⟨ 0 & 6 & δ₀-red (δ₀-βr g (fun (F # i) a)) ⟩ + ↯ (δ₀-free (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) + (snd (nat δ j) a) (glue (cin j a)) (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a))) ◃∙ + ↯ (ap2-!5-2 right (cin j) (cglue g (fst (nat δ i) (fun (F # i) a))) + (ap (cin j) (comSq δ g (fun (F # i) a))) (snd (nat δ j) a) + (ap (right {d = SpCos₂} ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) (glue (cin j a))) ◃∎ + =ₛ⟨ δ₀-comSq-red (cglue g (fst (nat δ i) (fun (F # i) a))) (ap (cin j) (comSq δ g (fun (F # i) a))) + (snd (nat δ j) a) (ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a)) (glue (cin j a)) ⟩ + idp ◃∎ ∎ₛ diff --git a/Colimit-code/Map-Nat/CosColimitMap14.agda b/Colimit-code/Map-Nat/CosColimitMap14.agda index 90dcbdc..fdbac96 100644 --- a/Colimit-code/Map-Nat/CosColimitMap14.agda +++ b/Colimit-code/Map-Nat/CosColimitMap14.agda @@ -1,88 +1,33 @@ -{-# OPTIONS --without-K --rewriting #-} +{-# OPTIONS --without-K --rewriting #-} open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram -open import AuxPaths-v2 open import Colim +open import Cocone open import CosColimitMap00 -open import CosColimitMap01 -open import CosColimitMap02 -open import CosColimitMap03 -open import CosColimitMap04 open import CosColimitMap09 +open import CosColimitMap10 +open import CosColimitMap11 module CosColimitMap14 where module ConstrMap15 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap2 δ + open ConstrMap δ - open ConstrMap5 δ + open Id Γ A - module MapCoher12 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where + open Maps - open ConstrMap10.MapCoher7 δ i j g a + module MapCoher14 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where - open ConstrMap4.MapCoher2 δ i j g a + open ConstrMap10.MapCoher9 δ g a - open ConstrMap3.MapCoher δ i j g a - - 𝕪-red5 = - ! (ap (λ p → p ∙ idp) (↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₂-v2 (ψ₂-βr g a) (! (glue (cin j a)))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! (ap (_∙_ (ap (right ∘ cin i) (snd (nat δ i) a))) - (E₁-v2 (snd (G <#> g) a)))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) (ap ! - (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) - right (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fun (G # i) a)) - (! (glue (cin j a))))))) ◃∙ - ! (ap (λ p → p ∙ idp) (ap (_∙_ (! (ap left (ap [id] (cglue g a))))) - (ap ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)))))) ◃∙ - δ₀-free-helper (cglue g a) (snd (F <#> g) a) (snd (nat δ j) a) (𝕗 (snd (F <#> g) a)) (ap ψ₂ (cglue g a)) ◃∙ - ! (ap (λ p → p ∙ ap right (! (! (𝕗 (snd (F <#> g) a)) ∙ ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) - (transp-pth-cmp (cglue g a) (glue (cin j a)))) ◃∙ - ap (λ p → p ∙ ap right (! (! (𝕗 (snd (F <#> g) a)) ∙ ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) - (apd-tr glue (cglue g a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (ap (λ p → ! - (! - (ap (cin j) - (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) - ∙ cglue g (fst (nat δ i) (fun (F # i) a))) - ∙ - ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ - ap (cin j) (snd (nat δ j) a) ∙ p) (ψ₂-βr g a)) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) - (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) - (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)) ◃∎ - =ₛ⟨ 1 & 8 & ψ₂-red (cglue g a) (apd-tr glue (cglue g a)) (snd (F <#> g) a) (ψ₂-βr g a) (transp-pth-cmp (cglue g a) (glue (cin j a))) ⟩ - ! (ap (λ p → p ∙ idp) (↯ (id-free glue (cglue g a) (ap (right ∘ cin i) (snd (nat δ i) a))))) ◃∙ - ↯ (ψ₂-free (cglue g a) (snd (F <#> g) a) (ap ψ₂ (cglue g a)) (transp-pth-cmp (cglue g a) (glue (cin j a))) (apd-tr glue (cglue g a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) - (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) - (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) - (cglue g (fun (G # i) a))) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) - (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) - (snd (nat δ i) a)) ◃∎ - =ₛ⟨ map-MainRed0 i j g a (cglue g a) (snd (F <#> g) a) ⟩ - ap-∘-!-!-rid (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ ∎ₛ + open ConstrMap11.MapCoher10 δ g a + + open ConstrMap12.MapCoher11 δ g a + + fib-coher-pre012 = (fib-coher-pre0 ∙ₛ fib-coher-pre1) ∙ₛ fib-coher-pre2 diff --git a/Colimit-code/Map-Nat/CosColimitMap15.agda b/Colimit-code/Map-Nat/CosColimitMap15.agda index 5f0d153..134a8ec 100644 --- a/Colimit-code/Map-Nat/CosColimitMap15.agda +++ b/Colimit-code/Map-Nat/CosColimitMap15.agda @@ -1,38 +1,117 @@ -{-# OPTIONS --without-K --rewriting #-} +{-# OPTIONS --without-K --rewriting #-} open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim -open import CosColimitMap01 -open import CosColimitMap09 -open import CosColimitMap10 -open import CosColimitMap11 +open import Cocone +open import CosColimitMap00 open import CosColimitMap12 open import CosColimitMap13 open import CosColimitMap14 module CosColimitMap15 where -module _ {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where +module ConstrMap16 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - module _ (i j : Obj Γ) (g : Hom Γ i j) (a : A) where + open ConstrMap δ - open ConstrMap10.MapCoher7 δ i j g a + open Id Γ A - open ConstrMap11.MapCoher8 δ i j g a + open Maps - open ConstrMap12.MapCoher9 δ i j g a + module MapCoher15 {i j : Obj Γ} (g : Hom Γ i j) (a : A) where - open ConstrMap13.MapCoher10 δ i j g a + open ConstrMap13.MapCoher12 δ g a - open ConstrMap14.MapCoher11 δ i j g a + open ConstrMap14.MapCoher13 δ g a - open ConstrMap15.MapCoher12 δ i j g a + fib-coher-pre345 = (fib-coher-pre3 ∙ₛ fib-coher-pre4) ∙ₛ fib-coher-pre5 --- 𝕪-red : 𝕪 =ₛ ap-∘-!-!-rid (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ - 𝕪-red = 𝕪-red0 ∙ₛ (𝕪-red1 ∙ₛ (𝕪-red2 ∙ₛ (𝕪-red3 ∙ₛ (𝕪-red4 ∙ₛ 𝕪-red5)))) + open ConstrMap15.MapCoher14 δ g a + fib-coher-pre = fib-coher-pre012 ∙ₛ fib-coher-pre345 +{- + fib-coher-pre : + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) ( + ∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ -- δ₀ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ -- 𝕕 + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) (ap right (cglue g (fun (F # i) a)))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₁ (snd (F <#> g) a) (! (glue (cin j a)))))) ◃∙ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (! (ap (λ p → ! (ap right (! (ap (cin j) + (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))))) ◃∙ -- id + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (E₃ (λ x → ! (glue x)) (cglue g a) + (ψ₁-βr g a) (λ x → idp)))) ◃∙ -- ψ₁ + ap (λ q → q) (ap (λ p → p ∙ idp) (ap (ap 𝕕₀) (∙-unit-r (! (glue (cin i a)))))) ◃∙ + ! (apd-tr (λ z → ap 𝕕₀ (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → right (δ₀ (ψ F z)) == left ([id] z)) (cglue g a)) + (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a))) ◃∙ -- 𝕕 + transp-inv-comm (left ∘ [id]) (right ∘ δ₀ ∘ ψ F) (cglue g a) + (glue (cin j a) ∙ ap right (! (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a)) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (transp-pth-cmpL δ₀ ψ₁ ψ₂ (cglue g a) + (ap (cin j) (snd (nat δ j) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (ap (λ p → ! (ap δ₀ p) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (ψ₁-βr g a))) ◃∙ -- ψ₁ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (pre-cmp-!-!-∙ δ₀ (cin j) (snd (F <#> g) a) + (cglue g (fun (F # i) a)) (ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) (δ₀-βr g (fun (F # i) a)))) ◃∙ -- δ₀ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! p ∙ ap (cin j ∘ fst (nat δ j)) + (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ ap ψ₂ (cglue g a)) + (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) + (comSq-coher δ g a)))) ◃∙ -- comSq + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) (ap (λ p → ! (! (ap (cin j) (ap (fst (G <#> g)) + (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) + (snd (F <#> g) a)))) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) ∙ + ap (cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (cin j) (snd (nat δ j) a) ∙ p) + (ψ₂-βr g a))) ◃∙ -- ψ₂ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (long-red-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fst (nat δ i) (fun (F # i) a))) + (cglue g (fun (G # i) a)))) ◃∙ + ap ! (ap (λ p → glue (cin i a) ∙ ap right (! p)) + (apCommSq (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (∙-unit-r (! (glue (cin i a))))) ◃∙ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₃ (λ x → ! (glue x)) (cglue g a) (ψ₂-βr g a) (λ x → idp))) ◃∙ -- ψ₂ + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ -- id + ! (ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))))) ◃∙ + ! (long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right + (snd (nat δ i) a) (snd (G <#> g) a) (snd (F <#> g) a) + (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a)))) ◃∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a))) ◃∙ + ! (ap (λ p → ! (ap right p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a))) ◃∎ -- comSq + =ₛ + idp ◃∎ ∎ₛ +-} diff --git a/Colimit-code/Map-Nat/CosColimitMap16.agda b/Colimit-code/Map-Nat/CosColimitMap16.agda index 0d7c355..9dd2c2c 100644 --- a/Colimit-code/Map-Nat/CosColimitMap16.agda +++ b/Colimit-code/Map-Nat/CosColimitMap16.agda @@ -1,152 +1,128 @@ -{-# OPTIONS --without-K --rewriting #-} +{-# OPTIONS --without-K --rewriting #-} open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram -open import AuxPaths open import Colim -open import CosColimitMap01 -open import CosColimitMap06 +open import Cocone +open import FTID-Cos +open import AuxPaths +open import Helper-paths +open import CosColimitMap00 +open import CosColimitMap03 open import CosColimitMap15 module CosColimitMap16 where -module _ {i j} {A : Type i} {B : Type j} {f g h : A → B} (F : (x : A) → f x == g x) (G : (x : A) → g x == h x) where - - apd-∙-r-coher-! : {x y : A} (κ : x == y) → ! (apd-tr (λ z → F z ∙ G z) κ) ◃∎ =ₛ ! (ap (λ p → p ∙ G y) (apd-tr F κ)) ◃∙ ! (apd-∙-r {F = F} {G = G} κ) ◃∎ - apd-∙-r-coher-! idp = =ₛ-in idp - -module _ {i j} {A : Type i} {B : Type j} (f : A → B) where - - ap-!-inv-l : {x y : A} (p : x == y) → ap f (! p) ∙ ap f p == idp - ap-!-inv-l idp = idp - module _ {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap7 δ + open ConstrMap δ + + open Id Γ A - module MapRed (i j : Obj Γ) (g : Hom Γ i j) (a : A) where + open Maps - open MapCoher4 i j g a public + module _ {i j : Obj Γ} (g : Hom Γ i j) (a : A) where - abstract - 𝕪-red-abs : 𝕪 =ₛ ap-∘-!-!-rid (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ - 𝕪-red-abs = 𝕪-red δ i j g a + open ConstrMap4.MapCoher3 δ g a - map-MainRed1 = transport (λ z → ap 𝕂₀ (glue {d = SpCos₁} z) ∙ 𝕃 (ψ₁ z) == ap 𝕕₀ (glue {d = SpCos₁} z)) (cglue g a) (↯ (𝔻 j a)) ◃∎ - =ₛ⟨ dtransp-pth-s (λ z → ap 𝕂₀ (glue {d = SpCos₁} z) ∙ 𝕃 (ψ₁ z)) (λ z → ap 𝕕₀ (glue {d = SpCos₁} z)) (cglue g a) (↯ (𝔻 j a)) ⟩ - (! (apd-tr (λ z → ap 𝕂₀ (glue z) ∙ 𝕃 (ψ₁ z)) (cglue g a)) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin j a)) ∙ - ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a)) ∙ - ! (𝕕-βr (cin j a))) ◃∙ - apd-tr (λ z → ap 𝕕₀ (glue z)) (cglue g a) ◃∎) - =ₛ⟨ 0 & 1 & dtransp-nat-rev-s (λ z → ap 𝕂₀ (glue z) ∙ 𝕃 (ψ₁ z)) (λ z → σ (comp 𝕂) (comTri 𝕂) z ∙ 𝕃 (ψ₁ z)) - (λ z → ap (λ p → p ∙ 𝕃 (ψ₁ z)) (FPrecc-βr 𝕂 z)) (cglue g a) ⟩ - (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (apd-tr (λ z → σ (comp 𝕂) (comTri 𝕂) z ∙ 𝕃 (ψ₁ z)) (cglue g a)) ◃∙ - ! (ap (transport (λ z → 𝕂₀ (left ([id] z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap (λ p → p ∙ 𝕃 (ψ₁ (cin j (idf A a)))) (FPrecc-βr 𝕂 (cin j (idf A a))))) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin j a)) ∙ - ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a)) ∙ ! (𝕕-βr (cin j a))) ◃∙ - apd-tr (λ z → ap 𝕕₀ (glue z)) (cglue g a) ◃∎) - =ₛ⟨ 1 & 1 & apd-∙-r-coher-! (σ (comp 𝕂) (comTri 𝕂)) (λ z → 𝕃 (ψ₁ z)) (cglue g a) ⟩ - (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (apd-tr (σ (comp 𝕂) (comTri 𝕂)) (cglue g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ! (ap (transport (λ z → 𝕂₀ (left ([id] z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) (ap (λ p → p ∙ 𝕃 (ψ₁ (cin j (idf A a)))) - (FPrecc-βr 𝕂 (cin j (idf A a))))) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin j a)) ∙ - ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a)) ∙ ! (𝕕-βr (cin j a))) ◃∙ - apd-tr (λ z → ap 𝕕₀ (glue z)) (cglue g a) ◃∎) - =ₛ⟨ 4 & 1 & ap-seq-∙ (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) (𝔻 j a) ⟩ - (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (apd-tr (σ (comp 𝕂) (comTri 𝕂)) (cglue g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ! (ap (transport (λ z → 𝕂₀ (left ([id] z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap (λ p → p ∙ 𝕃 (ψ₁ (cin j (idf A a)))) (FPrecc-βr 𝕂 (cin j a)))) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin j a))) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) (! (𝕕-βr (cin j a))) ◃∙ - apd-tr (λ z → ap 𝕕₀ (glue z)) (cglue g a) ◃∎) - =ₛ₁⟨ 3 & 2 & !-inv-l (ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin j a)))) ⟩ - (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (apd-tr (σ (comp 𝕂) (comTri 𝕂)) (cglue g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - idp ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) (! (𝕕-βr (cin j a))) ◃∙ - apd-tr (λ z → ap 𝕕₀ (glue z)) (cglue g a) ◃∎) - =ₛ⟨ 6 & 1 & dtransp-nat-s (λ z → ap 𝕕₀ (glue z)) (λ z → glue z ∙ ap right (! (ℂ z))) 𝕕-βr (cglue g a) ⟩ - (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (apd-tr (σ (comp 𝕂) (comTri 𝕂)) (cglue g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - idp ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) (! (𝕕-βr (cin j a))) ◃∙ - ap (transport (λ z → 𝕕₀ (left ([id] z)) == 𝕕₀ (right (Maps.ψ F z))) (cglue g a)) (𝕕-βr (cin j (idf A a))) ◃∙ - apd-tr (λ z → glue z ∙ ap right (! (ℂ z))) (cglue g a) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) ∎ₛ + open ConstrMap16.MapCoher15 δ g a - map-MainRed2 = (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (apd-tr (σ (comp 𝕂) (comTri 𝕂)) (cglue g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - idp ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) (! (𝕕-βr (cin j a))) ◃∙ - ap (transport (λ z → 𝕕₀ (left ([id] z)) == 𝕕₀ (right (Maps.ψ F z))) (cglue g a)) (𝕕-βr (cin j (idf A a))) ◃∙ - apd-tr (λ z → glue z ∙ ap right (! (ℂ z))) (cglue g a) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) - =ₛ⟨ 7 & 1 & apd-ap-∙-l-coher right {F = glue} {G = ℂ} (cglue g a) ⟩ - (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (apd-tr (σ (comp 𝕂) (comTri 𝕂)) (cglue g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - idp ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) (! (𝕕-βr (cin j a))) ◃∙ - ap (transport (λ z → 𝕕₀ (left ([id] z)) == 𝕕₀ (right (Maps.ψ F z))) (cglue g a)) (𝕕-βr (cin j a)) ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (apd-tr ℂ (cglue g a)) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) - =ₛ₁⟨ 5 & 2 & ap-!-inv-l (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) (𝕕-βr (cin j a)) ⟩ - (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (apd-tr (σ (comp 𝕂) (comTri 𝕂)) (cglue g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - idp ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) (right {d = SpCos₂}) (snd (nat δ j) a) (glue (cin j a))) ◃∙ - idp ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (apd-tr ℂ (cglue g a)) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) ∎ₛ + fib-coher : + ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (∙-unit-r (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) ∙ + ∘-ap 𝕕₀ right (cglue g (fun (F # i) a)) ∙ + ap-∘ right δ₀ (cglue g (fun (F # i) a)) ∙ + ap (ap right) (δ₀-βr g (fun (F # i) a)))) ◃∙ + ap (λ p → ! (p ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (hmtpy-nat-rev (λ x → idp) (snd (F <#> g) a) (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ◃∙ + ap (λ p → ! ((ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ + (p ∙ ! (ap 𝕕₀ (! (glue (cin j a))) ∙ idp)) ∙ + ! (ap (𝕕₀ ∘ right ∘ cin j) (snd (F <#> g) a))) ∙ ap 𝕕₀ (ap right (cglue g (fun (F # i) a))) ∙ idp) ∙ + ap (right ∘ cin j ∘ (fst (nat δ j))) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (ap-inv-rid 𝕕₀ (glue (cin j a)) ∙ ap ! (𝕕-βr (cin j a)) ∙ + !-!-ap-∘ (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ + long-path-red (snd (F <#> g) a) (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) + (ap 𝕕₀ (! (glue (cin j a))) ∙ idp) + (ap 𝕕₀ (ap right (cglue g (fun (F # i) a)))) idp ◃∙ + ap (λ q → q) (ap-cp-revR 𝕕₀ (right ∘ cin j) (snd (F <#> g) a) + (ap right (cglue g (fun (F # i) a))) ∙ + ap (λ p → p ∙ idp) (ap (ap 𝕕₀) ( + E₁ (snd (F <#> g) a) (! (glue {d = SpCos₁} (cin j a))) ∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ + cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a))) ∙ + E₃ (λ x → ! (glue x)) (cglue g a) (ψ₁-βr g a) (λ x → idp) ∙ + ∙-unit-r (! (glue (cin i a)))))) ◃∙ + ap-inv-rid 𝕕₀ (glue (cin i a)) ◃∙ + ap ! (𝕕-βr (cin i a)) ◃∙ + !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ◃∎ + =ₛ + ap (λ p → ! (ap (right {d = SpCos₂}) p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))) (comSq-coher δ g a)) ◃∙ + ap (λ p → ! (ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ + ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ + ! (glue (cin j a))) (apCommSq2 (cin j ∘ fst (G <#> g)) (cin i) (cglue g) (snd (nat δ i) a)) ◃∙ + long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right (snd (nat δ i) a) + (snd (G <#> g) a) (snd (F <#> g) a) (snd (nat δ j) a) (cglue g (fun (G # i) a)) + (! (glue (cin j a))) ◃∙ + ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (E₁ (snd (G <#> g) a) (! (glue (cin j a)))) ◃∙ + ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ + cglue g (fun (G # i) a))) ∙ ! (glue (cin j a)) ∙ p) + (ap (ap left) (id-βr g a)))) ◃∙ + ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) + (E₃ (λ x → ! (glue x)) (cglue g a) (ψ₂-βr g a) (λ x → idp)) ◃∙ + ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (∙-unit-r (! (glue (cin i a)))) ◃∎ + fib-coher = post-rotate'-seq-out-idp (fib-coher3 ∙ₛ fib-coher-pre) + fib-coher-post = + ap (λ p → ! (ap (right {d = SpCos₂}) p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) + (fun (F # i) a))) (comSq-coher δ g a)) ◃∙ + ap (λ p → ! (ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ + ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) + (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (apCommSq2 (cin j ∘ fst (G <#> g)) + (cin i) (cglue g) (snd (nat δ i) a)) ◃∙ + long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right (snd (nat δ i) a) (snd (G <#> g) a) + (snd (F <#> g) a) (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a))) ◃∙ + ap-seq (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (ϵ G g g a) + =ₛ⟨ 3 & 4 & ∙-ap-seq (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (ϵ G g g a) ⟩ + ap (λ p → ! (ap (right {d = SpCos₂}) p) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g) a) ∙ + ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) + (fun (F # i) a))) (comSq-coher δ g a)) ◃∙ + ap (λ p → ! (ap (right {d = SpCos₂}) (! (ap (cin j) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ snd (G <#> g) a ∙ + ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a)))) ∙ p)) ∙ ap (right ∘ cin j ∘ fst (nat δ j)) + (snd (F <#> g) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (apCommSq2 (cin j ∘ fst (G <#> g)) + (cin i) (cglue g) (snd (nat δ i) a)) ◃∙ + long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) right (snd (nat δ i) a) (snd (G <#> g) a) + (snd (F <#> g) a) (snd (nat δ j) a) (cglue g (fun (G # i) a)) (! (glue (cin j a))) ◃∙ + ap (λ p → ap (right ∘ cin i) (snd (nat δ i) a) ∙ p) (↯ (ϵ G g g a)) ◃∎ ∎ₛ - map-MainRed3 = (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (apd-tr (σ (comp 𝕂) (comTri 𝕂)) (cglue g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - idp ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) (right {d = SpCos₂}) (snd (nat δ j) a) (glue (cin j a))) ◃∙ - idp ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (apd-tr ℂ (cglue g a)) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) - =ₛ⟨ =ₛ-in idp ⟩ - (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (apd-tr (σ (comp 𝕂) (comTri 𝕂)) (cglue g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (apd-tr ℂ (cglue g a)) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) ∎ₛ + fib-inhab : CosCocEq F (Cos P₂ left) (PostComp (ColCoC F) 𝕕) K-diag + W fib-inhab i x = idp + u fib-inhab i a = ↯ ( + ap 𝕕₀ (! (glue (cin i a))) ∙ idp + =⟪ ap-inv-rid 𝕕₀ (glue (cin i a)) ⟫ + ! (ap 𝕕₀ (glue (cin i a))) + =⟪ ap ! (𝕕-βr (cin i a)) ⟫ + ! (glue (cin i a) ∙ ap right (! (ap (cin i) (snd (nat δ i) a)))) + =⟪ !-!-ap-∘ (cin i) right (snd (nat δ i) a) (glue (cin i a)) ⟫ + ap (right ∘ cin i) (snd (nat δ i) a) ∙ ! (glue (cin i a)) ∎∎ ) + fst (Λ fib-inhab {i} {j} g) x = ↯ ( + ap 𝕕₀ (ap right (cglue g x)) ∙ idp + =⟪ ∙-unit-r (ap 𝕕₀ (ap right (cglue g x))) ⟫ + ap 𝕕₀ (ap right (cglue g x)) + =⟪ ∘-ap 𝕕₀ right (cglue g x) ⟫ + ap (right ∘ δ₀) (cglue g x) + =⟪ ap-∘ right δ₀ (cglue g x) ⟫ + ap right (ap δ₀ (cglue g x)) + =⟪ ap (ap right) (δ₀-βr g x) ⟫ + ap right (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x)) ∎∎ ) + snd (Λ fib-inhab {i} {j} g) a = =ₛ-in (=ₛ-out (fib-coher g a ∙ₛ fib-coher-post g a)) diff --git a/Colimit-code/Map-Nat/CosColimitMap17.agda b/Colimit-code/Map-Nat/CosColimitMap17.agda index 0863d3b..20d2722 100644 --- a/Colimit-code/Map-Nat/CosColimitMap17.agda +++ b/Colimit-code/Map-Nat/CosColimitMap17.agda @@ -1,48 +1,33 @@ {-# OPTIONS --without-K --rewriting #-} open import lib.Basics +open import lib.Equivalence2 open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram -open import AuxPaths -open import Colim -open import CosColimitMap01 -open import CosColimitMap06 +open import Cocone +open import FTID-Cos +open import CosColim-Iso +open import CC-Equiv-RLR-4 +open import CosColimitMap00 open import CosColimitMap16 module CosColimitMap17 where module _ {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap7 δ - - module MapRed2 (i j : Obj Γ) (g : Hom Γ i j) (a : A) where - - map-MainRed4 = (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ 𝕃 (ψ₁ (cin i a))) (apd-tr (σ (comp 𝕂) (comTri 𝕂)) (cglue g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (apd-tr ℂ (cglue g a)) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) - =ₛ₁⟨ 1 & 1 & ap ! (ap (ap (λ p → p ∙ idp)) (σ-β 𝕂 g a)) ⟩ - (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ idp) (↯ (η (comp 𝕂) (comTri 𝕂) i j g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (apd-tr ℂ (cglue g a)) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) - =ₛ₁⟨ 5 & 1 & ap (ap (λ p → glue (cin i a) ∙ ap right (! p))) (=ₛ-out (ℂ-β g a)) ⟩ - (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ idp) (↯ (η (comp 𝕂) (comTri 𝕂) i j g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (↯ (ζ g a)) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) ∎ₛ + open ConstrMap δ + + open Id Γ A + + open Maps + + colim-contr : is-contr-map (PostComp {D = Cos P₂ left} (ColCoC F)) + colim-contr = equiv-is-contr-map (Colim-Iso F (Cos P₂ left)) + + K-diag-𝕕-eq : (Recc.recCosCoc F (Cos P₂ left)) K-diag == 𝕕 + K-diag-𝕕-eq = ap fst (contr-has-all-paths {{colim-contr K-diag}} + ((Recc.recCosCoc F (Cos P₂ left)) K-diag , LRfunEq K-diag) + (𝕕 , CosCocEq-ind F (Cos P₂ left) (PostComp (ColCoC F) 𝕕) (fib-inhab δ))) + diff --git a/Colimit-code/Map-Nat/CosColimitMap18.agda b/Colimit-code/Map-Nat/CosColimitMap18.agda index 64c05c2..fbf0ca8 100644 --- a/Colimit-code/Map-Nat/CosColimitMap18.agda +++ b/Colimit-code/Map-Nat/CosColimitMap18.agda @@ -3,57 +3,321 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq +open import AuxPaths +open import Helper-paths +open import FTID +open import FTID-Cos open import Coslice open import Diagram -open import AuxPaths open import Colim -open import CosColimitMap01 -open import CosColimitMap06 -open import CosColimitMap16 -open import CosColimitMap17 +open import Cocone +open import CosColimitMap00 +open import CosColimitPstCmp module CosColimitMap18 where -module _ {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - - open ConstrMap7 δ - - module _ (i j : Obj Γ) (g : Hom Γ i j) (a : A) where - - open MapRed δ i j g a - - open MapRed2 δ i j g a - - map-MainRed5 = (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (ap (λ p → p ∙ idp) (↯ (η (comp 𝕂) (comTri 𝕂) i j g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (↯ (ζ g a)) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) - =ₛ₁⟨ 1 & 1 & ap ! (=ₛ-out (ap-seq-∙ (λ p → p ∙ idp) (η (comp 𝕂) (comTri 𝕂) i j g a))) ⟩ - (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - ! (↯ (ap-seq (λ p → p ∙ idp) (η (comp 𝕂) (comTri 𝕂) i j g a))) ◃∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (↯ (ζ g a)) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) - =ₛ⟨ 1 & 1 & !-∙-seq (ap-seq (λ p → p ∙ idp) (η (comp 𝕂) (comTri 𝕂) i j g a)) ⟩ - (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin i a)) ◃∙ - seq-! (ap-seq (λ p → p ∙ idp) (η (comp 𝕂) (comTri 𝕂) i j g a)) ∙∙ - ! (apd-∙-r {F = σ (comp 𝕂) (comTri 𝕂)} {G = λ z → 𝕃 (ψ₁ z)} (cglue g a)) ◃∙ - ap (transport (λ z → 𝕂₀ (left (Span.f SpCos₁ z)) == (right ∘ δ₀) (ψ₁ z)) (cglue g a)) - (ap-∘-!-!-rid (cin j) right (snd (nat δ j) a) (glue (cin j a))) ◃∙ - apd-ap-∙-l right {F = glue} {G = ℂ} (cglue g a) ◃∙ - ap (λ p → glue (cin i a) ∙ ap right (! p)) (↯ (ζ g a)) ◃∙ - ! (𝕕-βr (cin i a)) ◃∎) - =ₛ⟨ 8 & 1 & ap-seq-∙ (λ p → glue (cin i a) ∙ ap right (! p)) (ζ g a) ⟩ - (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin i a)) ◃∙ 𝕪 ∙∙ ! (𝕕-βr (cin i a)) ◃∎) - =ₛ⟨ 1 & 15 & 𝕪-red-abs ⟩ - 𝔻 i a ∎ₛ - - map-MainRed = map-MainRed1 ∙ₛ (map-MainRed2 ∙ₛ (map-MainRed3 ∙ₛ (map-MainRed4 ∙ₛ map-MainRed5))) +module _ {ℓ} {A : Type ℓ} where + + !-!-∙-pth : {x y z w : A} (p : x == y) (q : x == z) {c : y == w} → ! (! p ∙ q) ∙ c == ! q ∙ p ∙ c + !-!-∙-pth idp idp = idp + +module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} (f : A → B) where + + ap-rid-∙ : {x y : A} (s : x == y) {w : B} (r : f y == w) → ap f (s ∙ idp) ∙ r == ap f s ∙ r + ap-rid-∙ idp r = idp + + rid-ap-!-!-rid-ap : {y v z : A} {x w : B} (q : z == v) (p : x == f y) (s : y == v) (r : f v == w) + → (p ∙ idp) ∙ ap f (s ∙ ! q ∙ idp) ∙ ap f q ∙ r == p ∙ ap f s ∙ r + rid-ap-!-!-rid-ap idp idp s r = ap-rid-∙ s r + +module _ {ℓ₁ ℓ₂ ℓ₃ ℓ₄} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} {D : Type ℓ₄} (f : C → D) (g : B → C) (h : A → B) where + + ap-∘-∘-!-∙-rid : {x y : A} (p₁ : x == y) {z : B} (p₂ : h x == z) + → ap f (ap g (! (ap h p₁) ∙ p₂)) ∙ idp == ! (ap (f ∘ g ∘ h) p₁) ∙ ap f (ap g p₂) + ap-∘-∘-!-∙-rid idp idp = idp + +module _ {ℓ₀ ℓ₁ ℓ₂ ℓ₃} {A₁ : Type ℓ₀} {A₂ : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f : B → C) (h : A₂ → B) (g : A₁ → B) where + + long-path-red-V : {c₁ c₂ : C} (p₁ : c₁ == c₂) {a₁ a₂ : A₂} (p₂ : a₁ == a₂) (p₃ : c₂ == f (h a₂)) + {b : B} (p₄ : h a₂ == b) {z₁ z₂ : A₁} (p₆ : z₁ == z₂) (p₅ : g z₂ == b) {c : C} (p₇ : f b == c) + → (p₁ ∙ p₃ ∙ ! (ap (f ∘ h) p₂)) ∙ ap f (ap h p₂ ∙ p₄ ∙ ! p₅ ∙ ! (ap g p₆)) ∙ ap (f ∘ g) p₆ ∙ ap f p₅ ∙ p₇ + == p₁ ∙ p₃ ∙ ap f p₄ ∙ p₇ + long-path-red-V idp idp p₃ p₄ idp p₅ p₇ = rid-ap-!-!-rid-ap f p₅ p₃ p₄ p₇ + +module ConstrMap19 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where + + open MapsCos A + + Diag-to-Lim-map : ∀ {ℓc} {T : Coslice ℓc ℓ A} → CosCocone A G T → CosCocone A F T + Diag-to-Lim-map (comp₁ & comTri₁) = (λ i → < A > comp₁ i ∘ nat δ i) & + λ {j} {i} g → (λ x → ! (ap (fst (comp₁ j)) (comSq δ g x)) ∙ fst (comTri₁ g) (fst (nat δ i) x)) , λ a → ↯ (V g a) + where + V : {j i : Obj Γ} (g : Hom Γ i j) (a : A) → + ! (! (ap (fst (comp₁ j)) (comSq δ g (fun (F # i) a))) ∙ fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ∙ + snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a + =-= snd (< A > comp₁ i ∘ nat δ i) a + V {j} {i} g a = + ! (! (ap (fst (comp₁ j)) (comSq δ g (fun (F # i) a))) ∙ fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ∙ + snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a + =⟪ !-!-∙-pth (ap (fst (comp₁ j)) (comSq δ g (fun (F # i) a))) (fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ⟫ + ! (fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ∙ ap (fst (comp₁ j)) (comSq δ g (fun (F # i) a)) ∙ + snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a + =⟪ ap (λ p → ! (fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ∙ ap (fst (comp₁ j)) p ∙ + snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a) (comSq-coher δ g a) ⟫ + ! (fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ∙ + ap (fst (comp₁ j)) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ + ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a))) ∙ + snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a + =⟪ ap (λ p → p ∙ ap (fst (comp₁ j)) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ + ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a))) ∙ + snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a) (hmtpy-nat-! (fst (comTri₁ g)) (snd (nat δ i) a)) ⟫ + (ap (λ z → fst (comp₁ i) z) (snd (nat δ i) a) ∙ + ! (fst (comTri₁ g) (fun (G # i) a)) ∙ + ! (ap (λ z → fst (< A > comp₁ j ∘ G <#> g) z) (snd (nat δ i) a))) ∙ + ap (fst (comp₁ j)) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ + snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a))) ∙ + snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a + =⟪ long-path-red-V (fst (comp₁ j)) (fst (G <#> g)) (fst (nat δ j)) (ap (fst (comp₁ i)) (snd (nat δ i) a)) + (snd (nat δ i) a) (! (fst (comTri₁ g) (fun (G # i) a))) + (snd (G <#> g) a) (snd (F <#> g) a) (snd (nat δ j) a) (snd (comp₁ j) a) ⟫ + ap (fst (comp₁ i)) (snd (nat δ i) a) ∙ + ! (fst (comTri₁ g) (fun (G # i) a)) ∙ + snd (< A > comp₁ j ∘ G <#> g) a + =⟪ ap (λ p → ap (fst (comp₁ i)) (snd (nat δ i) a) ∙ p) (snd (comTri₁ g) a) ⟫ + snd (< A > comp₁ i ∘ nat δ i) a ∎∎ + + open Id Γ A + + open Maps G + + open ConstrMap δ + + module _ {ℓc} (T : Coslice ℓc ℓ A) (f : P₂ → ty T) (fₚ : (a : A) → f (left a) == fun T a) where + + module _ {i j : Obj Γ} (g : Hom Γ i j) (a : A) where + + NatSq2-Λ-coher-aux3 : {w y : ty (G # i)} (τ₁₀ : w == y) + {z : ty (F # j)} (τ₁₃ : fst (G <#> g) y == fst (nat δ j) z) → + ! (ap (λ p → ! p ∙ idp) (ap-∘-∘-!-∙-rid f right (cin j) + (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) idp)) ∙ + long-path-red {f = f ∘ right ∘ cin j ∘ fst (nat δ j)} {g = f ∘ right ∘ cin j ∘ fst (nat δ j)} + idp idp idp (ap f (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ idp))) idp ∙ + ap (λ q → q) (ap-cp-revR f (right ∘ cin j ∘ fst (nat δ j)) idp + (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ idp)) ∙ + ap (λ p → ap f p ∙ idp) (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ p)) ∙ idp) + (apCommSq2 (λ x → cin j (fst (G <#> g) x)) (λ v → cin j (fst (G <#> g) v)) (λ x → idp) τ₁₀) ∙ + !-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) (λ v → cin j (fst (G <#> g) v)) right τ₁₀ τ₁₃ idp idp idp ∙ idp)) ∙ + ap-∘-∙ f (right ∘ (λ v → cin j (fst (G <#> g) v))) τ₁₀ (ap (right ∘ cin j) τ₁₃ ∙ idp) + == + !-!-∙-pth (ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) idp ∙ + ap (λ p → p ∙ ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) ∙ idp) (hmtpy-nat-! (λ x → idp) τ₁₀) ∙ + long-path-red-V (λ x → f (right (cin j x))) (fst (G <#> g)) (fst (nat δ j)) + (ap (λ x → f (right (cin j (fst (G <#> g) x)))) τ₁₀) τ₁₀ idp τ₁₃ idp idp idp ∙ + ap (_∙_ (ap (λ x → f (right (cin j (fst (G <#> g) x)))) τ₁₀)) + (ap-cp-revR f (λ x → right (cin j x)) τ₁₃ idp ∙ idp) + NatSq2-Λ-coher-aux3 {w} idp τ₁₃ = lemma τ₁₃ + where + lemma : {z : ty (G # j)} (τ : fst (G <#> g) w == z) + → + ! (ap (λ p → ! p ∙ idp) (ap-∘-∘-!-∙-rid f right (cin j) (τ ∙ idp) idp)) ∙ + !-∙-!-rid-∙-rid (ap f (ap right (! (ap (cin j) (τ ∙ idp)) ∙ idp))) idp idp ∙ + ap (λ q → q) (!-ap-∙-s f (ap right (! (ap (cin j) (τ ∙ idp)) ∙ idp)) ∙ + ap (λ p → ap f p ∙ idp) (!-!-!-∘-rid (cin j) right τ idp idp idp ∙ idp)) ∙ idp + == + !-!-∙-pth (ap (λ x → f (right (cin j x))) (τ ∙ idp)) idp ∙ + ap-rid-∙ (λ x → f (right (cin j x))) τ idp ∙ + ap (λ q → q) (ap-cp-revR f (λ x → right (cin j x)) τ idp ∙ idp) + lemma idp = idp + + NatSq2-Λ-coher-aux2 : (τ₁₀ : fst (nat δ i) (fun (F # i) a) == fun (G # i) a) + {x : ty (F # j)} (τ₁₃ : fst (G <#> g) (fun (G # i) a) == fst (nat δ j) x) → + ! (ap (λ p → ! p ∙ idp) (ap-∘-∘-!-∙-rid f right (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) + (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ + long-path-red {f = f ∘ right ∘ cin j ∘ fst (nat δ j)} {g = f ∘ right ∘ cin j ∘ fst (nat δ j)} idp idp idp (ap f + (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ + cglue g (fst (nat δ i) (fun (F # i) a))))) idp ∙ + ap (λ q → q) (ap-cp-revR f (right ∘ cin j ∘ fst (nat δ j)) idp + (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ + ap (λ p → ap f p ∙ idp) + (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ p)) ∙ idp) + (apCommSq2 (λ x → cin j (fst (G <#> g) x)) (cin i) (cglue g) τ₁₀) ∙ + !-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) (cin i) right τ₁₀ τ₁₃ idp + idp (cglue g (fun (G # i) a)) ∙ idp)) ∙ + ap-∘-∙ f (right ∘ cin i) τ₁₀ (! (ap right (cglue g (fun (G # i) a))) ∙ ap (right ∘ cin j) τ₁₃ ∙ idp) + == + !-!-∙-pth (ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) + (ap f (ap right (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ + ap (λ p → p ∙ ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) ∙ idp) + (hmtpy-nat-! (λ x → ap f (ap right (cglue g x))) τ₁₀) ∙ + long-path-red-V (λ x → f (right (cin j x))) (fst (G <#> g)) + (fst (nat δ j)) (ap (λ x → f (right (cin i x))) τ₁₀) τ₁₀ + (! (ap f (ap right (cglue g (fun (G # i) a))))) τ₁₃ idp idp idp ∙ + ap (_∙_ (ap (λ x → f (right (cin i x))) τ₁₀)) (ap-cp-revR f (λ x → right (cin j x)) τ₁₃ + (ap right (cglue g (fun (G # i) a))) ∙ idp) + NatSq2-Λ-coher-aux2 τ₁₀ τ₁₃ = IndFunHom {P = λ h H → + ! (ap (λ p → ! p ∙ idp) (ap-∘-∘-!-∙-rid f right (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) + (H (fst (nat δ i) (fun (F # i) a))))) ∙ + long-path-red {f = f ∘ right ∘ cin j ∘ fst (nat δ j)} {g = f ∘ right ∘ cin j ∘ fst (nat δ j)} idp idp idp + (ap f (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ + H (fst (nat δ i) (fun (F # i) a))))) idp ∙ + ap (λ q → q) (ap-cp-revR f (right ∘ cin j ∘ fst (nat δ j)) idp + (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ H (fst (nat δ i) (fun (F # i) a)))) ∙ + ap (λ p → ap f p ∙ idp) + (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ p)) ∙ idp) + (apCommSq2 (λ x → cin j (fst (G <#> g) x)) h H τ₁₀) ∙ + !-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) h right τ₁₀ τ₁₃ idp + idp (H (fun (G # i) a)) ∙ idp)) ∙ + ap-∘-∙ f (right ∘ h) τ₁₀ (! (ap right (H (fun (G # i) a))) ∙ ap (right ∘ cin j) τ₁₃ ∙ idp) + == + !-!-∙-pth (ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) + (ap f (ap right (H (fst (nat δ i) (fun (F # i) a))))) ∙ + ap (λ p → p ∙ ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) ∙ idp) + (hmtpy-nat-! (λ x → ap f (ap right (H x))) τ₁₀) ∙ + long-path-red-V (λ x → f (right (cin j x))) (fst (G <#> g)) + (fst (nat δ j)) (ap (λ x → f (right (h x))) τ₁₀) τ₁₀ + (! (ap f (ap right (H (fun (G # i) a))))) τ₁₃ idp idp idp ∙ + ap (_∙_ (ap (λ x → f (right (h x))) τ₁₀)) (ap-cp-revR f (λ x → right (cin j x)) τ₁₃ + (ap right (H (fun (G # i) a))) ∙ idp)} (NatSq2-Λ-coher-aux3 τ₁₀ τ₁₃) (cin i) (cglue g) + + NatSq2-Λ-coher-aux : (τ₁₀ : fst (nat δ i) (fun (F # i) a) == fun (G # i) a) + (τ₁₃ : fst (G <#> g) (fun (G # i) a) == fst (nat δ j) (fst (F <#> g) (fun (F # i) a))) + {σ₁ : fst (G <#> g) (fst (nat δ i) (fun (F # i) a)) == fst (nat δ j) (fst (F <#> g) (fun (F # i) a))} + (τ₁₄ : σ₁ == ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) → + ! (ap (λ p → ! p ∙ idp) (ap-∘-∘-!-∙-rid f right (cin j) σ₁ + (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ + long-path-red {f = f ∘ right ∘ cin j ∘ fst (nat δ j)} {g = f ∘ right ∘ cin j ∘ fst (nat δ j)} idp idp idp + (ap f (ap right (! (ap (cin j) σ₁) ∙ cglue g (fst (nat δ i) (fun (F # i) a))))) idp ∙ + ap (λ q → q) (ap-cp-revR f (right ∘ cin j ∘ fst (nat δ j)) idp + (ap right (! (ap (cin j) σ₁) ∙ + cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ + ap (λ p → ap f p ∙ idp) (ap (λ p → ! (ap right p) ∙ idp) + (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) τ₁₄) ∙ + ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ p)) ∙ idp) + (apCommSq2 (λ x → cin j (fst (G <#> g) x)) (cin i) (cglue g) τ₁₀) ∙ + !-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) (cin i) right τ₁₀ τ₁₃ idp idp (cglue g (fun (G # i) a)) ∙ idp)) ∙ + ap-∘-∙ f (right ∘ cin i) τ₁₀ (! (ap right (cglue g (fun (G # i) a))) ∙ + ap (right ∘ cin j) τ₁₃ ∙ idp) + == + !-!-∙-pth (ap (λ x → f (right (cin j x))) σ₁) + (ap f (ap right (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ + ap (λ p → ! (ap f (ap right (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ + ap (λ x → f (right (cin j x))) p ∙ idp) τ₁₄ ∙ + ap (λ p → p ∙ ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) ∙ idp) + (hmtpy-nat-! (λ x → ap f (ap right (cglue g x))) τ₁₀) ∙ + long-path-red-V (λ x → f (right (cin j x))) (fst (G <#> g)) + (fst (nat δ j)) (ap (λ x → f (right (cin i x))) τ₁₀) τ₁₀ + (! (ap f (ap right (cglue g (fun (G # i) a))))) τ₁₃ idp idp idp ∙ + ap (_∙_ (ap (λ x → f (right (cin i x))) τ₁₀)) (ap-cp-revR f (λ x → right (cin j x)) τ₁₃ + (ap right (cglue g (fun (G # i) a))) ∙ idp) + NatSq2-Λ-coher-aux τ₁₀ τ₁₃ idp = NatSq2-Λ-coher-aux2 τ₁₀ τ₁₃ + + NatSq2-Λ-coher : {x : ty (F # j)} (τ₅ : fst (F <#> g) (fun (F # i) a) == x) {y : ty (G # j)} (τ₆ : fst (nat δ j) x == y) + {z : P₂} (τ₇ : right (cin j y) == z) {w : ty T} (τ₈ : f z == w) + (τ₁₀ : fst (nat δ i) (fun (F # i) a) == fun (G # i) a) (τ₁₃ : fst (G <#> g) (fun (G # i) a) == y) + (τ₁₄ : comSq δ g (fun (F # i) a) == (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ ! τ₆ ∙ ! (ap (fst (nat δ j)) τ₅))) + {τ₁₁ : right (cin i (fun (G # i) a)) == z} + (τ₁ : ! (ap right (cglue g (fun (G # i) a))) ∙ ap (right ∘ cin j) τ₁₃ ∙ τ₇ == τ₁₁) → + ! (ap (λ p → ! p ∙ ap (f ∘ right ∘ cin j ∘ fst (nat δ j)) τ₅ ∙ + ap (f ∘ right ∘ cin j) τ₆ ∙ ap f τ₇ ∙ τ₈) + (ap-∘-∘-!-∙-rid f right (cin j) (comSq δ g (fun (F # i) a)) + (cglue g (fst (nat δ i) (fun (F # i) a))))) ◃∙ + ap (λ p → ! (p ∙ ap f (ap right (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ + (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ idp) ∙ + ap (f ∘ right ∘ cin j ∘ fst (nat δ j)) + τ₅ ∙ + ap (f ∘ right ∘ cin j) τ₆ ∙ ap f τ₇ ∙ τ₈) + (hmtpy-nat-rev (λ x → idp) τ₅ + (ap f (ap (λ x → right (cin j x)) τ₆ ∙ + τ₇) ∙ τ₈)) ◃∙ + ap (λ p → ! ((ap (f ∘ right ∘ cin j ∘ fst (nat δ j)) + τ₅ ∙ + (p ∙ ! (ap f (ap (λ x → right (cin j x)) τ₆ ∙ + τ₇) ∙ τ₈)) ∙ + ! (ap (f ∘ right ∘ cin j ∘ fst (nat δ j)) τ₅)) ∙ + ap f (ap right (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ + (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ idp) ∙ + ap (f ∘ right ∘ cin j ∘ fst (nat δ j)) τ₅ ∙ + ap (f ∘ right ∘ cin j) τ₆ ∙ ap f τ₇ ∙ τ₈) + (ap-∘-∙ f (right ∘ cin j) τ₆ τ₇) ◃∙ + long-path-red τ₅ + (ap (f ∘ right ∘ cin j) τ₆ ∙ ap f τ₇ ∙ τ₈) + (ap f (ap (λ x → right (cin j x)) τ₆ ∙ + τ₇) ∙ τ₈) + (ap f (ap right (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ + (cglue g (fst (nat δ i) (fun (F # i) a)))))) idp ◃∙ + ap (λ q → q) (ap-cp-revR f (right ∘ cin j ∘ fst (nat δ j)) τ₅ + (ap right (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ + (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ + ap (λ p → ap f p ∙ τ₈) + (ap (λ p → ! (ap right p) ∙ + ap (λ x → right (cin j (fst (nat δ j) x))) τ₅ ∙ + ap (λ x → right (cin j x)) τ₆ ∙ τ₇) + (ap (λ p → ! (ap (cin j) p) ∙ (cglue g (fst (nat δ i) (fun (F # i) a)))) τ₁₄) ∙ + ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ + τ₁₃ ∙ ! τ₆ ∙ ! (ap (fst (nat δ j)) τ₅))) ∙ p)) ∙ + ap (λ x → right (cin j (fst (nat δ j) x))) τ₅ ∙ + ap (λ x → right (cin j x)) τ₆ ∙ τ₇) + (apCommSq2 (λ x → cin j (fst (G <#> g) x)) (cin i) (cglue g) τ₁₀) ∙ + long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) + right τ₁₀ τ₁₃ τ₅ + τ₆ (cglue g (fun (G # i) a)) τ₇ ∙ + ap (_∙_ (ap (λ x → right (cin i x)) τ₁₀)) τ₁)) ◃∙ + ap-∘-∙ f (right ∘ cin i) τ₁₀ τ₁₁ ◃∎ + =ₛ + (!-!-∙-pth (ap (λ x → f (right (cin j x))) (comSq δ g (fun (F # i) a))) + (ap f (ap right (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ + ap (λ p → + ! (ap f (ap right (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ + ap (λ x → f (right (cin j x))) p ∙ + ap (λ x → f (right (cin j (fst (nat δ j) x)))) τ₅ ∙ + ap (λ x → f (right (cin j x))) τ₆ ∙ + ap f τ₇ ∙ τ₈) τ₁₄ ∙ + ap (λ p → p ∙ ap (λ x → f (right (cin j x))) + (ap (fst (G <#> g)) τ₁₀ ∙ + τ₁₃ ∙ + ! τ₆ ∙ ! (ap (fst (nat δ j)) τ₅)) ∙ + ap (λ x → f (right (cin j (fst (nat δ j) x)))) τ₅ ∙ + ap (λ x → f (right (cin j x))) τ₆ ∙ + ap f τ₇ ∙ τ₈) (hmtpy-nat-! (λ x → ap f (ap right (cglue g x))) τ₁₀) ∙ + long-path-red-V (λ x → f (right (cin j x))) (fst (G <#> g)) + (fst (nat δ j)) (ap (λ x → f (right (cin i x))) τ₁₀) + τ₁₀ (! (ap f (ap right (cglue g (fun (G # i) a))))) + τ₁₃ τ₅ τ₆ + (ap f τ₇ ∙ τ₈) ∙ + ap (_∙_ (ap (λ x → f (right (cin i x))) τ₁₀)) + (ap-cp-revR f (λ x → right (cin j x)) τ₁₃ + (ap right (cglue g (fun (G # i) a))) ∙ + ap (λ p → p ∙ τ₈) (ap (ap f) τ₁))) ◃∎ + NatSq2-Λ-coher idp idp idp idp τ₁₀ τ₁₃ τ₁₄ idp = =ₛ-in (NatSq2-Λ-coher-aux τ₁₀ τ₁₃ τ₁₄) +{- + τ₁ = E₁ (snd (G <#> g) a) (! (glue (cin j a))) ∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))) ∙ + E₃ (λ x → ! (glue x)) (cglue g a) (ψ₂-βr g a) (λ x → idp) ∙ + ∙-unit-r (! (glue (cin i a))) + τ₅ = snd (F <#> g) a + τ₆ = snd (nat δ j) a + τ₇ = ! (glue (cin j a)) + τ₈ = fₚ a + τ₁₀ = snd (nat δ i) a + τ₁₁ = ! (glue (cin i a)) + τ₁₃ = snd (G <#> g) a + τ₁₄ = comSq-coher δ g a +-} + + CosColim-NatSq2 : CosCocEq F T (Map-to-Lim-map F (f , fₚ) K-diag) (Diag-to-Lim-map (PostComp ColCoC (f , fₚ))) + W CosColim-NatSq2 i x = idp + u CosColim-NatSq2 i a = ap-∘-∙ f (right ∘ cin i) (snd (nat δ i) a) (! (glue (cin i a))) + Λ CosColim-NatSq2 {i} {j} g = (λ x → ap-∘-∘-!-∙-rid f right (cin j) (comSq δ g x) (cglue g (fst (nat δ i) x))) , + λ a → NatSq2-Λ-coher g a (snd (F <#> g) a) (snd (nat δ j) a) (! (glue (cin j a))) (fₚ a) (snd (nat δ i) a) + (snd (G <#> g) a) (comSq-coher δ g a) + (E₁ (snd (G <#> g) a) (! (glue (cin j a))) ∙ + ! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ + ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))) ∙ + E₃ (λ x → ! (glue x)) (cglue g a) (ψ₂-βr g a) (λ x → idp) ∙ + ∙-unit-r (! (glue (cin i a)))) + + CosColim-NatSq2-eq : Map-to-Lim-map F (f , fₚ) K-diag == Diag-to-Lim-map (PostComp ColCoC (f , fₚ)) + CosColim-NatSq2-eq = CosCocEq-ind F T (Map-to-Lim-map F (f , fₚ) K-diag) (CosColim-NatSq2) diff --git a/Colimit-code/Map-Nat/CosColimitMap19.agda b/Colimit-code/Map-Nat/CosColimitMap19.agda deleted file mode 100644 index a4877db..0000000 --- a/Colimit-code/Map-Nat/CosColimitMap19.agda +++ /dev/null @@ -1,38 +0,0 @@ -{-# OPTIONS --without-K --rewriting #-} - -open import lib.Basics -open import lib.types.Pushout -open import lib.types.Span -open import lib.PathSeq -open import Coslice -open import Diagram -open import Colim -open import FTID -open import CosColimitMap01 -open import CosColimitMap18 - -module CosColimitMap19 where - -module _ {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - - open ConstrMap2 δ - - 𝕂₀-𝕕₀-pathover : (i j : Obj Γ) (g : Hom Γ i j) (x : A) → - PathOver (λ z → ap 𝕂₀ (glue z) ∙ 𝕃 (ψ₁ z) == ap 𝕕₀ (glue z)) - (cglue g x) - (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin j (idf A x))) ∙ - ap-∘-!-!-rid (cin j) right (snd (nat δ j) (idf A x)) - (glue (cin j (idf A x))) - ∙ ! (𝕕-βr (cin j (idf A x)))) - (ap (λ p → p ∙ idp) (FPrecc-βr 𝕂 (cin i x)) ∙ - ap-∘-!-!-rid (cin i) right (snd (nat δ i) x) (glue (cin i x)) ∙ - ! (𝕕-βr (cin i x))) - 𝕂₀-𝕕₀-pathover i j g a = from-transp-g (λ z → ap 𝕂₀ (glue {d = SpCos₁} z) ∙ 𝕃 (ψ₁ z) == ap 𝕕₀ (glue {d = SpCos₁} z)) (cglue g a) (=ₛ-out (map-MainRed δ i j g a)) - - 𝕂₀-𝕕₀-∼ : [ A , (Cos P₁ left) ] recCosCoc 𝕂 ∼ 𝕕 - 𝕂₀-𝕕₀-∼ = ( - PushoutMapEq-v2 𝕂₀ 𝕕₀ (λ x → idp) 𝕃 (colimE {P = λ z → ap 𝕂₀ (glue {d = SpCos₁} z) ∙ 𝕃 (ψ₁ z) == ap 𝕕₀ (glue {d = SpCos₁} z)} (λ i a → ↯ (𝔻 i a)) 𝕂₀-𝕕₀-pathover)) , ( - λ a → idp) - - 𝕂₀-𝕕₀-eq : recCosCoc 𝕂 == 𝕕 - 𝕂₀-𝕕₀-eq = PtFunEq (recCosCoc 𝕂) 𝕂₀-𝕕₀-∼ diff --git a/Colimit-code/Map-Nat/CosColimitMap20.agda b/Colimit-code/Map-Nat/CosColimitMap20.agda deleted file mode 100644 index 55ca86d..0000000 --- a/Colimit-code/Map-Nat/CosColimitMap20.agda +++ /dev/null @@ -1,211 +0,0 @@ -{-# OPTIONS --without-K --rewriting #-} - -open import lib.Basics -open import lib.types.Pushout -open import lib.types.Span -open import lib.PathSeq -open import Coslice -open import Diagram -open import FTID-Cos -open import Colim -open import CosColimitMap01 - -module CosColimitMap20 where - -module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f : A → B) (h : A → C) (g : C → B) (H : f ∼ g ∘ h) where - - CommSq-swap-∘ : {x y : A} (p : x == y) → ap f p == H x ∙ ap g (ap h p) ∙ ! (H y) - CommSq-swap-∘ {x} idp = ! (!-inv-r (H x)) - -module _ {ℓ} {A : Type ℓ} {x y z : A} where - - !-∙-!-rid : (p : x == y) (q : z == y) → ! (p ∙ ! q) == q ∙ ! p ∙ idp - !-∙-!-rid idp idp = idp - -module ConstrMap21 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - - open ConstrMap2 δ public - - module _ {i j : Obj Γ} (g : Hom Γ i j) (x : ty (F # i)) where - - Θ-left : ap (right {d = SpCos₂}) (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x)) =-= - ap (right {d = SpCos₂}) (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x)) - Θ-left = ap (right {d = SpCos₂}) (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x)) - =⟪ ! (FM-βr g x) ⟫ - ap ForgMap (cglue g x) - =⟪ CommSq-swap-∘ ForgMap δ₀ right 𝕃 (cglue g x) ⟫ - ap right (ap δ₀ (cglue g x)) ∙ idp - =⟪ ∙-unit-r (ap right (ap δ₀ (cglue g x))) ⟫ - ap right (ap δ₀ (cglue g x)) - =⟪ ap (ap right) (δ₀-βr g x) ⟫ - ap (right {d = SpCos₂}) (! (ap (cin j) (comSq δ g x)) ∙ cglue g (fst (nat δ i) x)) ∎∎ - - module _ (i j : Obj Γ) (g₁ : Hom Γ i j) (a : A) where - - 𝕂-K-eq-helper3 : {t : ty (F # j)} (σ : t == fun (F # j) a) (𝐌 : fst (G <#> g₁) (fst (nat δ i) (fun (F # i) a)) == fst (nat δ j) t) - → ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) σ ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (! (ap (cin j) 𝐌) ∙ cglue g₁ (fst (nat δ i) (fun (F # i) a)))))) ∙ - ap (λ p → ! (p ∙ ap right (! (ap (cin j) 𝐌) ∙ cglue g₁ (fst (nat δ i) (fun (F # i) a))) ∙ idp) ∙ ap (fst (comp K j)) σ ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ x₁ → idp) σ (snd (comp 𝕂 j) a)) ∙ - long-path-red σ (snd (comp K j) a) (snd (comp 𝕂 j) a) - (ap right (! (ap (cin j) 𝐌) ∙ cglue g₁ (fst (nat δ i) (fun (F # i) a)))) idp ∙ - idp - == idp - 𝕂-K-eq-helper3 idp 𝐌 = lemma (ap right (! (ap (cin j) 𝐌) ∙ cglue g₁ (fst (nat δ i) (fun (F # i) a)))) - where - lemma : {z : P₂} (𝐦 : right (cin j (fst (nat δ j) (fun (F # j) a))) == z) - → ! (ap (λ p → ! p ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r 𝐦)) ∙ - ap (λ p → ! (p ∙ 𝐦 ∙ idp) ∙ - snd (comp K j) a) (hmtpy-nat-rev {f = fst (comp 𝕂 j)} (λ x₁ → idp) idp (snd (comp 𝕂 j) a)) ∙ - long-path-red {f = fst (comp K j)} {g = fst (comp 𝕂 j)} idp (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (snd (comp 𝕂 j) a) 𝐦 idp ∙ - idp - == idp - lemma idp = lemma2 (ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - where - lemma2 : {v : P₂} (τ : right (cin j (fst (nat δ j) (fun (F # j) a))) == v) - → ap (λ p → ! (p ∙ idp) ∙ τ) (hmtpy-nat-rev {f = fst (comp 𝕂 j)} (λ x₁ → idp) idp τ) ∙ - db-neg-rid-db τ τ ∙ - idp - == idp - lemma2 idp = idp - --- σ = (snd (F <#> g₁) a) --- 𝐌 = comSq δ g₁ (fun (F # i) a)) - - 𝕂-K-eq-helper2 : {e : ForgMap (cin j (fst (F <#> g₁) (fun (F # i) a))) == ForgMap (cin i (fun (F # i) a))} (𝐌 : e == fst (comTri 𝕂 g₁) (fun (F # i) a)) - → ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! 𝐌)) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (! (ap (cin j) (comSq δ g₁ (fun (F # i) a))) ∙ - cglue g₁ (fst (nat δ i) (fun (F # i) a)))))) ◃∙ - ap (λ p → ! (p ∙ fst (comTri 𝕂 g₁) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ x₁ → idp) (snd (F <#> g₁) a) (snd (comp 𝕂 j) a)) ◃∙ - idp ◃∙ - long-path-red (snd (F <#> g₁) a) (snd (comp K j) a) (snd (comp 𝕂 j) a) (fst (comTri 𝕂 g₁) (fun (F # i) a)) idp ◃∙ - ap (λ q → q) (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! 𝐌)) ◃∎ - =ₛ (idp ◃∎) - 𝕂-K-eq-helper2 idp = =ₛ-in (𝕂-K-eq-helper3 (snd (F <#> g₁) a) (comSq δ g₁ (fun (F # i) a))) - --- 𝐌 = (FM-βr g₁ (fun (F # i) a)) - - 𝕂-K-eq-helper-aux : {v : Colim ForgF} (γ : cin j (fst (F <#> g₁) (fun (F # i) a)) == v) - → - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘ ForgMap δ₀ right 𝕃 γ)) ◃∙ - idp ◃∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 γ)) ◃∎ - =ₛ (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (!-∙-!-rid (ap right (ap δ₀ γ)) (𝕃 v)) ◃∎) - 𝕂-K-eq-helper-aux idp = =ₛ-in idp - --- γ = cglue g₁ (fun (F # i) a) - - 𝕂-K-eq-helper-aux2 : {v : Colim ForgF} (γ : cin j (fst (F <#> g₁) (fun (F # i) a)) == v) - → ! (ap (λ p → ! p ∙ ap ((right {d = SpCos₂}) ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (∙-unit-r (ap right (ap δ₀ γ)))) ∙ - ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (!-∙-!-rid (ap right (ap δ₀ γ)) idp) ∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ γ))))) ∙ - idp - == idp - 𝕂-K-eq-helper-aux2 idp = idp - --- γ = cglue g₁ (fun (F # i) a) - - 𝕂-K-eq-helper : {t : δ₀ (cin j (fst (F <#> g₁) (fun (F # i) a))) == δ₀ (cin i (fun (F # i) a))} (𝐌 : ap δ₀ (cglue g₁ (fun (F # i) a)) == t) - → ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (ap right) 𝐌)) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (ap δ₀ (cglue g₁ (fun (F # i) a)))))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘ ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! (FM-βr g₁ (fun (F # i) a)))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (! (ap (cin j) (comSq δ g₁ (fun (F # i) a))) ∙ - cglue g₁ (fst (nat δ i) (fun (F # i) a)))))) ◃∙ - ap (λ p → ! (p ∙ fst (comTri 𝕂 g₁) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ x₁ → idp) (snd (F <#> g₁) a) (snd (comp 𝕂 j) a)) ◃∙ - idp ◃∙ - long-path-red (snd (F <#> g₁) a) (snd (comp K j) a) (snd (comp 𝕂 j) a) (fst (comTri 𝕂 g₁) (fun (F # i) a)) idp ◃∙ - ap (λ q → q) (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! (FM-βr g₁ (fun (F # i) a)))) ◃∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)))) ◃∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ (cglue g₁ (fun (F # i) a))))))) ◃∙ - ap (λ q → q) (ap (λ p → ! (ap right p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) 𝐌) ◃∎ - =ₛ idp ◃∎ - 𝕂-K-eq-helper idp = - idp ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (ap δ₀ (cglue g₁ (fun (F # i) a)))))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘ ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! (FM-βr g₁ (fun (F # i) a)))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (! (ap (cin j) (comSq δ g₁ (fun (F # i) a))) ∙ - cglue g₁ (fst (nat δ i) (fun (F # i) a)))))) ◃∙ - ap (λ p → ! (p ∙ fst (comTri 𝕂 g₁) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ x₁ → idp) (snd (F <#> g₁) a) (snd (comp 𝕂 j) a)) ◃∙ - idp ◃∙ - long-path-red (snd (F <#> g₁) a) (snd (comp K j) a) (snd (comp 𝕂 j) a) (fst (comTri 𝕂 g₁) (fun (F # i) a)) idp ◃∙ - ap (λ q → q) (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! (FM-βr g₁ (fun (F # i) a)))) ◃∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)))) ◃∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ (cglue g₁ (fun (F # i) a))))))) ◃∙ - idp ◃∎ - =ₛ⟨ 3 & 6 & 𝕂-K-eq-helper2 (FM-βr g₁ (fun (F # i) a)) ⟩ - idp ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (ap δ₀ (cglue g₁ (fun (F # i) a)))))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘ ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)))) ◃∙ - idp ◃∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)))) ◃∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ (cglue g₁ (fun (F # i) a))))))) ◃∙ - idp ◃∎ - =ₛ⟨ 2 & 3 & 𝕂-K-eq-helper-aux (cglue g₁ (fun (F # i) a)) ⟩ - idp ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (ap δ₀ (cglue g₁ (fun (F # i) a)))))) ◃∙ - ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (!-∙-!-rid (ap right (ap δ₀ (cglue g₁ (fun (F # i) a)))) idp) ◃∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ (cglue g₁ (fun (F # i) a))))))) ◃∙ - idp ◃∎ - =ₛ₁⟨ 𝕂-K-eq-helper-aux2 (cglue g₁ (fun (F # i) a)) ⟩ - idp ◃∎ ∎ₛ diff --git a/Colimit-code/Map-Nat/CosColimitMap21.agda b/Colimit-code/Map-Nat/CosColimitMap21.agda deleted file mode 100644 index b2c9fc6..0000000 --- a/Colimit-code/Map-Nat/CosColimitMap21.agda +++ /dev/null @@ -1,127 +0,0 @@ -{-# OPTIONS --without-K --rewriting #-} - -open import lib.Basics -open import lib.types.Pushout -open import lib.types.Span -open import lib.PathSeq -open import Coslice -open import Diagram -open import FTID-Cos -open import Colim -open import CosColimitMap01 -open import CosColimitMap20 - -module CosColimitMap21 where - -module ConstrMap22 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - - open ConstrMap21 δ - - module _ (i j : Obj Γ) (g₁ : Hom Γ i j) (a : A) where - - 𝕂-K-coher = - (! (ap (λ p → ! p ∙ ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (∙-unit-r (ap right (! (ap (cin j) (comSq δ g₁ (fun (F # i) a))) ∙ - cglue g₁ (fst (nat δ i) (fun (F # i) a)))) ∙ - ! (FM-βr g₁ (fun (F # i) a)) ∙ - CommSq-swap-∘ ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)) ∙ - ∙-unit-r (ap right (ap δ₀ (cglue g₁ (fun (F # i) a)))) ∙ - ap (ap right) (δ₀-βr g₁ (fun (F # i) a))))) ◃∙ - ap (λ p → ! (p ∙ fst (comTri 𝕂 g₁) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ x₁ → idp) (snd (F <#> g₁) a) (snd (comp 𝕂 j) a)) ◃∙ - idp ◃∙ - long-path-red (snd (F <#> g₁) a) (snd (comp K j) a) (snd (comp 𝕂 j) a) (fst (comTri 𝕂 g₁) (fun (F # i) a)) idp ◃∙ - ap (λ q → q) (snd (comTri 𝕂 g₁) a) ◃∙ - idp ◃∎ - =ₛ₁⟨ 0 & 1 & ap ! (=ₛ-out (ap-seq-∙ (λ p → ! p ∙ ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (∙-unit-r (ap right (! (ap (cin j) (comSq δ g₁ (fun (F # i) a))) ∙ - cglue g₁ (fst (nat δ i) (fun (F # i) a)))) ◃∙ Θ-left g₁ (fun (F # i) a)))) ⟩ - (! (↯ (ap-seq (λ p → ! p ∙ ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (∙-unit-r (ap right (! (ap (cin j) (comSq δ g₁ (fun (F # i) a))) ∙ - cglue g₁ (fst (nat δ i) (fun (F # i) a)))) ◃∙ - ! (FM-βr g₁ (fun (F # i) a)) ◃∙ - CommSq-swap-∘ ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)) ◃∙ - ∙-unit-r (ap right (ap δ₀ (cglue g₁ (fun (F # i) a)))) ◃∙ - ap (ap right) (δ₀-βr g₁ (fun (F # i) a)) ◃∎)))) ◃∙ - ap (λ p → ! (p ∙ fst (comTri 𝕂 g₁) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ x₁ → idp) (snd (F <#> g₁) a) (snd (comp 𝕂 j) a)) ◃∙ - idp ◃∙ - long-path-red (snd (F <#> g₁) a) (snd (comp K j) a) (snd (comp 𝕂 j) a) (fst (comTri 𝕂 g₁) (fun (F # i) a)) idp ◃∙ - ap (λ q → q) (snd (comTri 𝕂 g₁) a) ◃∙ - idp ◃∎ - =ₛ⟨ 0 & 1 & !-∙-seq (ap-seq (λ p → ! p ∙ ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (∙-unit-r (ap right (! (ap (cin j) (comSq δ g₁ (fun (F # i) a))) ∙ - cglue g₁ (fst (nat δ i) (fun (F # i) a)))) ◃∙ - ! (FM-βr g₁ (fun (F # i) a)) ◃∙ - CommSq-swap-∘ ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)) ◃∙ - ∙-unit-r (ap right (ap δ₀ (cglue g₁ (fun (F # i) a)))) ◃∙ - ap (ap right) (δ₀-βr g₁ (fun (F # i) a)) ◃∎)) ⟩ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (ap right) (δ₀-βr g₁ (fun (F # i) a)))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (ap δ₀ (cglue g₁ (fun (F # i) a)))))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘ ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! (FM-βr g₁ (fun (F # i) a)))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (! (ap (cin j) (comSq δ g₁ (fun (F # i) a))) ∙ - cglue g₁ (fst (nat δ i) (fun (F # i) a)))))) ◃∙ - ap (λ p → ! (p ∙ fst (comTri 𝕂 g₁) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ x₁ → idp) (snd (F <#> g₁) a) (snd (comp 𝕂 j) a)) ◃∙ - idp ◃∙ - long-path-red (snd (F <#> g₁) a) (snd (comp K j) a) (snd (comp 𝕂 j) a) (fst (comTri 𝕂 g₁) (fun (F # i) a)) idp ◃∙ - ap (λ q → q) (snd (comTri 𝕂 g₁) a) ◃∙ - idp ◃∎ - =ₛ⟨ 8 & 1 & ap-seq-∙ (λ q → q) (Θ-combined g₁ a) ⟩ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (ap (ap right) (δ₀-βr g₁ (fun (F # i) a)))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (ap δ₀ (cglue g₁ (fun (F # i) a)))))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘ ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! (FM-βr g₁ (fun (F # i) a)))) ◃∙ - ! (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (ap right (! (ap (cin j) (comSq δ g₁ (fun (F # i) a))) ∙ - cglue g₁ (fst (nat δ i) (fun (F # i) a)))))) ◃∙ - ap (λ p → ! (p ∙ fst (comTri 𝕂 g₁) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g₁) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ x₁ → idp) (snd (F <#> g₁) a) (snd (comp 𝕂 j) a)) ◃∙ - idp ◃∙ - long-path-red (snd (F <#> g₁) a) (snd (comp K j) a) (snd (comp 𝕂 j) a) (fst (comTri 𝕂 g₁) (fun (F # i) a)) idp ◃∙ - ap (λ q → q) (ap (λ p → ! p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (! (FM-βr g₁ (fun (F # i) a)))) ◃∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (CommSq-swap-∘-! ForgMap δ₀ right 𝕃 (cglue g₁ (fun (F # i) a)))) ◃∙ - ap (λ q → q) (ap (λ p → p ∙ ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) - (∙-unit-r (! (ap right (ap δ₀ (cglue g₁ (fun (F # i) a))))))) ◃∙ - ap (λ q → q) (ap (λ p → ! (ap right p) ∙ - ap (right ∘ cin j ∘ fst (nat δ j)) (snd (F <#> g₁) a) ∙ - ap (right ∘ cin j) (snd (nat δ j) a) ∙ ! (glue (cin j a))) (δ₀-βr g₁ (fun (F # i) a))) ◃∙ - (ap-seq (λ q → q) (Θ g₁ a) ∙∙ idp ◃∎) - =ₛ⟨ 0 & 12 & 𝕂-K-eq-helper i j g₁ a (δ₀-βr g₁ (fun (F # i) a)) ⟩ - idp ◃∙ (ap-seq (λ q → q) (Θ g₁ a) ∙∙ idp ◃∎) - =ₛ⟨ 1 & 4 & ∙-ap-seq (λ q → q) (Θ g₁ a) ⟩ - idp ◃∙ ap (λ q → q) (↯ (Θ g₁ a)) ◃∙ idp ◃∎ - =ₛ₁⟨ ∙-unit-r (ap (λ q → q) (↯ (Θ g₁ a))) ∙ ap-idf (↯ (Θ g₁ a)) ⟩ - ↯ (Θ g₁ a) ◃∎ ∎ₛ - - 𝕂-K-∼ : CosCocEq F (Cos P₂ left) 𝕂 K - W 𝕂-K-∼ = λ i₁ x₁ → idp - u 𝕂-K-∼ = λ i₁ a → idp - Λ 𝕂-K-∼ {i} {j} = λ g₁ → (λ x₁ → ∙-unit-r (fst (comTri 𝕂 g₁) x₁) ∙ ↯ (Θ-left g₁ x₁)) , λ a → 𝕂-K-coher i j g₁ a - - 𝕂-K-eq : 𝕂 == K - 𝕂-K-eq = CosCocEq-ind F (Cos P₂ left) 𝕂 𝕂-K-∼ diff --git a/Colimit-code/Map-Nat/CosColimitMap22.agda b/Colimit-code/Map-Nat/CosColimitMap22.agda deleted file mode 100644 index e5f3ab2..0000000 --- a/Colimit-code/Map-Nat/CosColimitMap22.agda +++ /dev/null @@ -1,324 +0,0 @@ -{-# OPTIONS --without-K --rewriting #-} - -open import lib.Basics -open import lib.types.Pushout -open import lib.types.Span -open import lib.PathSeq -open import AuxPaths -open import FTID -open import FTID-Cos -open import Coslice -open import Diagram -open import Colim -open import Cocone -open import CosColimitMap00 -open import CosColimitPstCmp - -module CosColimitMap22 where - -module _ {ℓ} {A : Type ℓ} where - - !-!-∙-pth : {x y z w : A} (p : x == y) (q : x == z) {c : y == w} → ! (! p ∙ q) ∙ c == ! q ∙ p ∙ c - !-!-∙-pth idp idp = idp - -module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} {f g : A → B} where - - hmtpy-nat-! : (H : f ∼ g) {x y : A} (p : x == y) → ! (H x) == ap g p ∙ ! (H y) ∙ ! (ap f p) - hmtpy-nat-! H {x = x} idp = ! (∙-unit-r (! (H x))) - -module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} (f : A → B) where - - ap-rid-∙ : {x y : A} (s : x == y) {w : B} (r : f y == w) → ap f (s ∙ idp) ∙ r == ap f s ∙ r - ap-rid-∙ idp r = idp - - rid-ap-!-!-rid-ap : {y v z : A} {x w : B} (q : z == v) (p : x == f y) (s : y == v) (r : f v == w) - → (p ∙ idp) ∙ ap f (s ∙ ! q ∙ idp) ∙ ap f q ∙ r == p ∙ ap f s ∙ r - rid-ap-!-!-rid-ap idp idp s r = ap-rid-∙ s r - -module _ {ℓ₀ ℓ₁ ℓ₂ ℓ₃} {A₁ : Type ℓ₀} {A₂ : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (f : B → C) (h : A₂ → B) (g : A₁ → B) where - - long-path-red-V : {c₁ c₂ : C} (p₁ : c₁ == c₂) {a₁ a₂ : A₂} (p₂ : a₁ == a₂) (p₃ : c₂ == f (h a₂)) - {b : B} (p₄ : h a₂ == b) {z₁ z₂ : A₁} (p₆ : z₁ == z₂) (p₅ : g z₂ == b) {c : C} (p₇ : f b == c) - → (p₁ ∙ p₃ ∙ ! (ap (f ∘ h) p₂)) ∙ ap f (ap h p₂ ∙ p₄ ∙ ! p₅ ∙ ! (ap g p₆)) ∙ ap (f ∘ g) p₆ ∙ ap f p₅ ∙ p₇ == p₁ ∙ p₃ ∙ ap f p₄ ∙ p₇ - long-path-red-V idp idp p₃ p₄ idp p₅ p₇ = rid-ap-!-!-rid-ap f p₅ p₃ p₄ p₇ - -module _ {ℓ₁ ℓ₂ ℓ₃ ℓ₄} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} {D : Type ℓ₄} (f : C → D) (g : B → C) (h : A → B) where - - ap-∘-∘-!-∙-rid : {x y : A} (p₁ : x == y) {z : B} (p₂ : h x == z) - → ap f (ap g (! (ap h p₁) ∙ p₂)) ∙ idp == ! (ap (f ∘ g ∘ h) p₁) ∙ ap f (ap g p₂) - ap-∘-∘-!-∙-rid idp idp = idp - --- p₁ = (comSq δ g x) --- p₂ = (cglue g (fst (nat δ i) x)) - -module ConstrMap23 {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - - open MapsCos A - - Diag-to-Lim-map : ∀ {ℓc} {T : Coslice ℓc ℓ A} → CosCocone A G T → CosCocone A F T - Diag-to-Lim-map (comp₁ & comTri₁) = (λ i → < A > comp₁ i ∘ nat δ i) & - λ {j} {i} g → (λ x → ! (ap (fst (comp₁ j)) (comSq δ g x)) ∙ fst (comTri₁ g) (fst (nat δ i) x)) , λ a → ↯ (V g a) - where - V : {j i : Obj Γ} (g : Hom Γ i j) (a : A) → - ! (! (ap (fst (comp₁ j)) (comSq δ g (fun (F # i) a))) ∙ fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ∙ snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a - =-= snd (< A > comp₁ i ∘ nat δ i) a - V {j} {i} g a = - ! (! (ap (fst (comp₁ j)) (comSq δ g (fun (F # i) a))) ∙ fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ∙ snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a - =⟪ !-!-∙-pth (ap (fst (comp₁ j)) (comSq δ g (fun (F # i) a))) (fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ⟫ - ! (fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ∙ ap (fst (comp₁ j)) (comSq δ g (fun (F # i) a)) ∙ snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a - =⟪ ap (λ p → ! (fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ∙ ap (fst (comp₁ j)) p ∙ snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a) (comSq-coher δ g a) ⟫ - ! (fst (comTri₁ g) (fst (nat δ i) (fun (F # i) a))) ∙ - ap (fst (comp₁ j)) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a))) ∙ - snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a - =⟪ ap (λ p → p ∙ ap (fst (comp₁ j)) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ - ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a))) ∙ - snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a) (hmtpy-nat-! (fst (comTri₁ g)) (snd (nat δ i) a)) ⟫ - (ap (λ z → fst (comp₁ i) z) (snd (nat δ i) a) ∙ - ! (fst (comTri₁ g) (fun (G # i) a)) ∙ - ! (ap (λ z → fst (< A > comp₁ j ∘ G <#> g) z) (snd (nat δ i) a))) ∙ - ap (fst (comp₁ j)) (ap (fst (G <#> g)) (snd (nat δ i) a) ∙ - snd (G <#> g) a ∙ ! (snd (nat δ j) a) ∙ ! (ap (fst (nat δ j)) (snd (F <#> g) a))) ∙ - snd (< A > < A > comp₁ j ∘ nat δ j ∘ F <#> g) a - =⟪ long-path-red-V (fst (comp₁ j)) (fst (G <#> g)) (fst (nat δ j)) (ap (fst (comp₁ i)) (snd (nat δ i) a)) (snd (nat δ i) a) - (! (fst (comTri₁ g) (fun (G # i) a))) (snd (G <#> g) a) (snd (F <#> g) a) (snd (nat δ j) a) (snd (comp₁ j) a) ⟫ - ap (fst (comp₁ i)) (snd (nat δ i) a) ∙ - ! (fst (comTri₁ g) (fun (G # i) a)) ∙ - snd (< A > comp₁ j ∘ G <#> g) a - =⟪ ap (λ p → ap (fst (comp₁ i)) (snd (nat δ i) a) ∙ p) (snd (comTri₁ g) a) ⟫ - snd (< A > comp₁ i ∘ nat δ i) a ∎∎ - - open Id Γ A - - open Maps G - - open ConstrMap δ - - module _ {ℓc} (T : Coslice ℓc ℓ A) (f : P₂ → ty T) (fₚ : (a : A) → f (left a) == fun T a) where - - module _ {i j : Obj Γ} (g : Hom Γ i j) (a : A) where - - NatSq2-Λ-coher-aux3 : {w y : ty (G # i)} (τ₁₀ : w == y) {z : ty (F # j)} (τ₁₃ : fst (G <#> g) y == fst (nat δ j) z) - → - ! (ap (λ p → ! p ∙ idp) (ap-∘-∘-!-∙-rid f right (cin j) - (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) idp)) ∙ - long-path-red {f = f ∘ right ∘ cin j ∘ fst (nat δ j)} {g = f ∘ right ∘ cin j ∘ fst (nat δ j)} - idp idp idp (ap f (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ idp))) idp ∙ - ap (λ q → q) (ap-cp-revR f (right ∘ cin j ∘ fst (nat δ j)) idp - (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ idp)) ∙ - ap (λ p → ap f p ∙ idp) (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ p)) ∙ idp) - (apCommSq2 (λ x → cin j (fst (G <#> g) x)) (λ v → cin j (fst (G <#> g) v)) (λ x → idp) τ₁₀) ∙ - !-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) (λ v → cin j (fst (G <#> g) v)) right τ₁₀ τ₁₃ idp idp idp ∙ idp)) ∙ - ap-∘-∙-s f (right ∘ (λ v → cin j (fst (G <#> g) v))) τ₁₀ (ap (right ∘ cin j) τ₁₃ ∙ idp) - == - !-!-∙-pth (ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) idp ∙ - ap (λ p → p ∙ ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) ∙ idp) (hmtpy-nat-! (λ x → idp) τ₁₀) ∙ - long-path-red-V (λ x → f (right (cin j x))) (fst (G <#> g)) (fst (nat δ j)) - (ap (λ x → f (right (cin j (fst (G <#> g) x)))) τ₁₀) τ₁₀ idp τ₁₃ idp idp idp ∙ - ap (_∙_ (ap (λ x → f (right (cin j (fst (G <#> g) x)))) τ₁₀)) - (ap-cp-revR f (λ x → right (cin j x)) τ₁₃ idp ∙ idp) - NatSq2-Λ-coher-aux3 {w} idp τ₁₃ = lemma τ₁₃ - where - lemma : {z : ty (G # j)} (τ : fst (G <#> g) w == z) - → - ! (ap (λ p → ! p ∙ idp) (ap-∘-∘-!-∙-rid f right (cin j) (τ ∙ idp) idp)) ∙ - !-∙-!-rid-∙-rid (ap f (ap right (! (ap (cin j) (τ ∙ idp)) ∙ idp))) idp idp ∙ - ap (λ q → q) (!-ap-∙-s f (ap right (! (ap (cin j) (τ ∙ idp)) ∙ idp)) ∙ - ap (λ p → ap f p ∙ idp) (!-!-!-∘-rid (cin j) right τ idp idp idp ∙ idp)) ∙ idp - == - !-!-∙-pth (ap (λ x → f (right (cin j x))) (τ ∙ idp)) idp ∙ - ap-rid-∙ (λ x → f (right (cin j x))) τ idp ∙ - ap (λ q → q) (ap-cp-revR f (λ x → right (cin j x)) τ idp ∙ idp) - lemma idp = idp - - NatSq2-Λ-coher-aux2 : (τ₁₀ : fst (nat δ i) (fun (F # i) a) == fun (G # i) a) {x : ty (F # j)} (τ₁₃ : fst (G <#> g) (fun (G # i) a) == fst (nat δ j) x) - → - ! (ap (λ p → ! p ∙ idp) (ap-∘-∘-!-∙-rid f right (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) - (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ - long-path-red {f = f ∘ right ∘ cin j ∘ fst (nat δ j)} {g = f ∘ right ∘ cin j ∘ fst (nat δ j)} idp idp idp (ap f - (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))))) idp ∙ - ap (λ q → q) (ap-cp-revR f (right ∘ cin j ∘ fst (nat δ j)) idp - (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ - ap (λ p → ap f p ∙ idp) - (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ p)) ∙ idp) - (apCommSq2 (λ x → cin j (fst (G <#> g) x)) (cin i) (cglue g) τ₁₀) ∙ - !-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) (cin i) right τ₁₀ τ₁₃ idp - idp (cglue g (fun (G # i) a)) ∙ idp)) ∙ - ap-∘-∙-s f (right ∘ cin i) τ₁₀ (! (ap right (cglue g (fun (G # i) a))) ∙ ap (right ∘ cin j) τ₁₃ ∙ idp) - == - !-!-∙-pth (ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) - (ap f (ap right (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ - ap (λ p → p ∙ ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) ∙ idp) - (hmtpy-nat-! (λ x → ap f (ap right (cglue g x))) τ₁₀) ∙ - long-path-red-V (λ x → f (right (cin j x))) (fst (G <#> g)) - (fst (nat δ j)) (ap (λ x → f (right (cin i x))) τ₁₀) τ₁₀ - (! (ap f (ap right (cglue g (fun (G # i) a))))) τ₁₃ idp idp idp ∙ - ap (_∙_ (ap (λ x → f (right (cin i x))) τ₁₀)) (ap-cp-revR f (λ x → right (cin j x)) τ₁₃ - (ap right (cglue g (fun (G # i) a))) ∙ idp) - NatSq2-Λ-coher-aux2 τ₁₀ τ₁₃ = IndFunHom {P = λ h H → - ! (ap (λ p → ! p ∙ idp) (ap-∘-∘-!-∙-rid f right (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) - (H (fst (nat δ i) (fun (F # i) a))))) ∙ - long-path-red {f = f ∘ right ∘ cin j ∘ fst (nat δ j)} {g = f ∘ right ∘ cin j ∘ fst (nat δ j)} idp idp idp (ap f - (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ - H (fst (nat δ i) (fun (F # i) a))))) idp ∙ - ap (λ q → q) (ap-cp-revR f (right ∘ cin j ∘ fst (nat δ j)) idp - (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ H (fst (nat δ i) (fun (F # i) a)))) ∙ - ap (λ p → ap f p ∙ idp) - (ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ p)) ∙ idp) - (apCommSq2 (λ x → cin j (fst (G <#> g) x)) h H τ₁₀) ∙ - !-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) h right τ₁₀ τ₁₃ idp - idp (H (fun (G # i) a)) ∙ idp)) ∙ - ap-∘-∙-s f (right ∘ h) τ₁₀ (! (ap right (H (fun (G # i) a))) ∙ ap (right ∘ cin j) τ₁₃ ∙ idp) - == - !-!-∙-pth (ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) - (ap f (ap right (H (fst (nat δ i) (fun (F # i) a))))) ∙ - ap (λ p → p ∙ ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) ∙ idp) - (hmtpy-nat-! (λ x → ap f (ap right (H x))) τ₁₀) ∙ - long-path-red-V (λ x → f (right (cin j x))) (fst (G <#> g)) - (fst (nat δ j)) (ap (λ x → f (right (h x))) τ₁₀) τ₁₀ - (! (ap f (ap right (H (fun (G # i) a))))) τ₁₃ idp idp idp ∙ - ap (_∙_ (ap (λ x → f (right (h x))) τ₁₀)) (ap-cp-revR f (λ x → right (cin j x)) τ₁₃ - (ap right (H (fun (G # i) a))) ∙ idp)} (NatSq2-Λ-coher-aux3 τ₁₀ τ₁₃) (cin i) (cglue g) - - NatSq2-Λ-coher-aux : (τ₁₀ : fst (nat δ i) (fun (F # i) a) == fun (G # i) a) (τ₁₃ : fst (G <#> g) (fun (G # i) a) == fst (nat δ j) (fst (F <#> g) (fun (F # i) a))) - {σ₁ : fst (G <#> g) (fst (nat δ i) (fun (F # i) a)) == fst (nat δ j) (fst (F <#> g) (fun (F # i) a))} (τ₁₄ : σ₁ == ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) - → - ! (ap (λ p → ! p ∙ idp) (ap-∘-∘-!-∙-rid f right (cin j) σ₁ - (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ - long-path-red {f = f ∘ right ∘ cin j ∘ fst (nat δ j)} {g = f ∘ right ∘ cin j ∘ fst (nat δ j)} idp idp idp (ap f (ap right (! (ap (cin j) σ₁) ∙ - cglue g (fst (nat δ i) (fun (F # i) a))))) idp ∙ - ap (λ q → q) (ap-cp-revR f (right ∘ cin j ∘ fst (nat δ j)) idp - (ap right (! (ap (cin j) σ₁) ∙ - cglue g (fst (nat δ i) (fun (F # i) a)))) ∙ - ap (λ p → ap f p ∙ idp) (ap (λ p → ! (ap right p) ∙ idp) - (ap (λ p → ! (ap (cin j) p) ∙ cglue g (fst (nat δ i) (fun (F # i) a))) τ₁₄) ∙ - ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp)) ∙ p)) ∙ idp) - (apCommSq2 (λ x → cin j (fst (G <#> g) x)) (cin i) (cglue g) τ₁₀) ∙ - !-!-!-∘-∘-∘-rid (cin j) (fst (G <#> g)) (cin i) right τ₁₀ τ₁₃ idp idp (cglue g (fun (G # i) a)) ∙ idp)) ∙ - ap-∘-∙-s f (right ∘ cin i) τ₁₀ (! (ap right (cglue g (fun (G # i) a))) ∙ - ap (right ∘ cin j) τ₁₃ ∙ idp) - == - !-!-∙-pth (ap (λ x → f (right (cin j x))) σ₁) - (ap f (ap right (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ - ap (λ p → ! (ap f (ap right (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ - ap (λ x → f (right (cin j x))) p ∙ idp) τ₁₄ ∙ - ap (λ p → p ∙ ap (λ x → f (right (cin j x))) (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ idp) ∙ idp) - (hmtpy-nat-! (λ x → ap f (ap right (cglue g x))) τ₁₀) ∙ - long-path-red-V (λ x → f (right (cin j x))) (fst (G <#> g)) - (fst (nat δ j)) (ap (λ x → f (right (cin i x))) τ₁₀) τ₁₀ - (! (ap f (ap right (cglue g (fun (G # i) a))))) τ₁₃ idp idp idp ∙ - ap (_∙_ (ap (λ x → f (right (cin i x))) τ₁₀)) (ap-cp-revR f (λ x → right (cin j x)) τ₁₃ (ap right (cglue g (fun (G # i) a))) ∙ idp) - NatSq2-Λ-coher-aux τ₁₀ τ₁₃ idp = NatSq2-Λ-coher-aux2 τ₁₀ τ₁₃ - --- σ₁ = (comSq δ g (fun (F # i) a)) - - NatSq2-Λ-coher : {x : ty (F # j)} (τ₅ : fst (F <#> g) (fun (F # i) a) == x) {y : ty (G # j)} (τ₆ : fst (nat δ j) x == y) {z : P₂} (τ₇ : right (cin j y) == z) - {w : ty T} (τ₈ : f z == w) (τ₁₀ : fst (nat δ i) (fun (F # i) a) == fun (G # i) a) (τ₁₃ : fst (G <#> g) (fun (G # i) a) == y) - (τ₁₄ : comSq δ g (fun (F # i) a) == (ap (fst (G <#> g)) τ₁₀ ∙ τ₁₃ ∙ ! τ₆ ∙ ! (ap (fst (nat δ j)) τ₅))) - {τ₁₁ : right (cin i (fun (G # i) a)) == z} (τ₁ : ! (ap right (cglue g (fun (G # i) a))) ∙ ap (right ∘ cin j) τ₁₃ ∙ τ₇ == τ₁₁) - → - ! (ap (λ p → ! p ∙ ap (f ∘ right ∘ cin j ∘ fst (nat δ j)) τ₅ ∙ - ap (f ∘ right ∘ cin j) τ₆ ∙ ap f τ₇ ∙ τ₈) - (ap-∘-∘-!-∙-rid f right (cin j) (comSq δ g (fun (F # i) a)) - (cglue g (fst (nat δ i) (fun (F # i) a))))) ◃∙ - ap (λ p → ! (p ∙ ap f (ap right (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ - (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ idp) ∙ - ap (f ∘ right ∘ cin j ∘ fst (nat δ j)) - τ₅ ∙ - ap (f ∘ right ∘ cin j) τ₆ ∙ ap f τ₇ ∙ τ₈) - (hmtpy-nat-rev (λ x → idp) τ₅ - (ap f (ap (λ x → right (cin j x)) τ₆ ∙ - τ₇) ∙ τ₈)) ◃∙ - ap (λ p → ! ((ap (f ∘ right ∘ cin j ∘ fst (nat δ j)) - τ₅ ∙ - (p ∙ ! (ap f (ap (λ x → right (cin j x)) τ₆ ∙ - τ₇) ∙ τ₈)) ∙ - ! (ap (f ∘ right ∘ cin j ∘ fst (nat δ j)) τ₅)) ∙ - ap f (ap right (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ - (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ idp) ∙ - ap (f ∘ right ∘ cin j ∘ fst (nat δ j)) τ₅ ∙ - ap (f ∘ right ∘ cin j) τ₆ ∙ ap f τ₇ ∙ τ₈) - (ap-∘-∙-s f (right ∘ cin j) τ₆ τ₇) ◃∙ - long-path-red τ₅ - (ap (f ∘ right ∘ cin j) τ₆ ∙ ap f τ₇ ∙ τ₈) - (ap f (ap (λ x → right (cin j x)) τ₆ ∙ - τ₇) ∙ τ₈) - (ap f (ap right (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ - (cglue g (fst (nat δ i) (fun (F # i) a)))))) idp ◃∙ - ap (λ q → q) (ap-cp-revR f (right ∘ cin j ∘ fst (nat δ j)) τ₅ - (ap right (! (ap (cin j) (comSq δ g (fun (F # i) a))) ∙ - (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ - ap (λ p → ap f p ∙ τ₈) - (ap (λ p → ! (ap right p) ∙ - ap (λ x → right (cin j (fst (nat δ j) x))) τ₅ ∙ - ap (λ x → right (cin j x)) τ₆ ∙ τ₇) - (ap (λ p → ! (ap (cin j) p) ∙ (cglue g (fst (nat δ i) (fun (F # i) a)))) τ₁₄) ∙ - ap (λ p → ! (ap right (! (ap (cin j) (ap (fst (G <#> g)) τ₁₀ ∙ - τ₁₃ ∙ ! τ₆ ∙ ! (ap (fst (nat δ j)) τ₅))) ∙ p)) ∙ - ap (λ x → right (cin j (fst (nat δ j) x))) τ₅ ∙ - ap (λ x → right (cin j x)) τ₆ ∙ τ₇) - (apCommSq2 (λ x → cin j (fst (G <#> g) x)) (cin i) (cglue g) τ₁₀) ∙ - long-red-ap-!-∙ (cin j) (fst (nat δ j)) (fst (G <#> g)) (cin i) - right τ₁₀ τ₁₃ τ₅ - τ₆ (cglue g (fun (G # i) a)) τ₇ ∙ - ap (_∙_ (ap (λ x → right (cin i x)) τ₁₀)) τ₁)) ◃∙ - ap-∘-∙-s f (right ∘ cin i) τ₁₀ τ₁₁ ◃∎ - =ₛ - (!-!-∙-pth (ap (λ x → f (right (cin j x))) (comSq δ g (fun (F # i) a))) - (ap f (ap right (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ - ap (λ p → - ! (ap f (ap right (cglue g (fst (nat δ i) (fun (F # i) a))))) ∙ - ap (λ x → f (right (cin j x))) p ∙ - ap (λ x → f (right (cin j (fst (nat δ j) x)))) τ₅ ∙ - ap (λ x → f (right (cin j x))) τ₆ ∙ - ap f τ₇ ∙ τ₈) τ₁₄ ∙ - ap (λ p → p ∙ ap (λ x → f (right (cin j x))) - (ap (fst (G <#> g)) τ₁₀ ∙ - τ₁₃ ∙ - ! τ₆ ∙ ! (ap (fst (nat δ j)) τ₅)) ∙ - ap (λ x → f (right (cin j (fst (nat δ j) x)))) τ₅ ∙ - ap (λ x → f (right (cin j x))) τ₆ ∙ - ap f τ₇ ∙ τ₈) (hmtpy-nat-! (λ x → ap f (ap right (cglue g x))) τ₁₀) ∙ - long-path-red-V (λ x → f (right (cin j x))) (fst (G <#> g)) - (fst (nat δ j)) (ap (λ x → f (right (cin i x))) τ₁₀) - τ₁₀ (! (ap f (ap right (cglue g (fun (G # i) a))))) - τ₁₃ τ₅ τ₆ - (ap f τ₇ ∙ τ₈) ∙ - ap (_∙_ (ap (λ x → f (right (cin i x))) τ₁₀)) - (ap-cp-revR f (λ x → right (cin j x)) τ₁₃ - (ap right (cglue g (fun (G # i) a))) ∙ - ap (λ p → p ∙ τ₈) (ap (ap f) τ₁))) ◃∎ - NatSq2-Λ-coher idp idp idp idp τ₁₀ τ₁₃ τ₁₄ idp = =ₛ-in (NatSq2-Λ-coher-aux τ₁₀ τ₁₃ τ₁₄) -{- - τ₁ = (E₁ (snd (G <#> g) a) (! (glue (cin j a))) ∙ - ! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ - ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))) ∙ - E₃ (λ x → ! (glue x)) (cglue g a) (ψ₂-βr g a) (λ x → idp) ∙ - ∙-unit-r (! (glue (cin i a)))) - τ₅ = (snd (F <#> g) a) - τ₆ = (snd (nat δ j) a) - τ₇ = (! (glue (cin j a))) - τ₈ = (fₚ a) - τ₁₀ = (snd (nat δ i) a) - τ₁₁ = (! (glue (cin i a))) - τ₁₃ = (snd (G <#> g) a) - τ₁₄ = (comSq-coher δ g a) --} - - CosColim-NatSq2 : CosCocEq F T (Map-to-Lim-map F (f , fₚ) K) (Diag-to-Lim-map (PostComp ColCoC (f , fₚ))) - W CosColim-NatSq2 i x = idp - u CosColim-NatSq2 i a = ap-∘-∙-s f (right ∘ cin i) (snd (nat δ i) a) (! (glue (cin i a))) - Λ CosColim-NatSq2 {i} {j} g = (λ x → ap-∘-∘-!-∙-rid f right (cin j) (comSq δ g x) (cglue g (fst (nat δ i) x))) , - λ a → NatSq2-Λ-coher g a (snd (F <#> g) a) (snd (nat δ j) a) (! (glue (cin j a))) (fₚ a) (snd (nat δ i) a) - (snd (G <#> g) a) (comSq-coher δ g a) - (E₁ (snd (G <#> g) a) (! (glue (cin j a))) ∙ - ! (ap (λ p → ! (ap right (! (ap (cin j) (snd (G <#> g) a)) ∙ cglue g (fun (G # i) a))) ∙ - ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))) ∙ - E₃ (λ x → ! (glue x)) (cglue g a) (ψ₂-βr g a) (λ x → idp) ∙ - ∙-unit-r (! (glue (cin i a)))) - - CosColim-NatSq2-eq : Map-to-Lim-map F (f , fₚ) K == Diag-to-Lim-map (PostComp ColCoC (f , fₚ)) - CosColim-NatSq2-eq = CosCocEq-ind F T (Map-to-Lim-map F (f , fₚ) K) (CosColim-NatSq2) diff --git a/Colimit-code/Map-Nat/CosColimitPreCmp.agda b/Colimit-code/Map-Nat/CosColimitPreCmp.agda index 5f88636..21db037 100644 --- a/Colimit-code/Map-Nat/CosColimitPreCmp.agda +++ b/Colimit-code/Map-Nat/CosColimitPreCmp.agda @@ -5,29 +5,26 @@ open import lib.types.Pushout open import lib.types.Span open import Coslice open import Diagram -open import Colim open import Cocone open import CC-Equiv-RLR-4 open import CosColimitMap00 -open import CosColimitMap01 -open import CosColimitMap19 -open import CosColimitMap21 -open import CosColimitMap22 +open import CosColimitMap17 +open import CosColimitMap18 open import CosColimitPstCmp module CosColimitPreCmp where module _ {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : CosDiag ℓF ℓ A Γ} {G : CosDiag ℓG ℓ A Γ} (δ : CosDiagMor A F G) where - open ConstrMap2 δ + open ConstrMap δ open Id.Maps Γ A - open ConstrMap22 δ + open MapsCos A - open ConstrMap23 δ + open Recc F (Cos P₂ left) - open MapsCos A + open ConstrMap19 δ module _ {ℓc} {T : Coslice ℓc ℓ A} where @@ -35,19 +32,16 @@ module _ {ℓv ℓe ℓ ℓF ℓG} {Γ : Graph ℓv ℓe} {A : Type ℓ} {F : Co NatSq-PreCmp1 = Diag-to-Lim-map (PostComp (ColCoC G) (f , fₚ)) - =⟨ ! (CosColim-NatSq2-eq T f fₚ) ⟩ - Map-to-Lim-map F (f , fₚ) K - =⟨ ap (Map-to-Lim-map F (f , fₚ)) (! (LRfunEq K)) ⟩ - Map-to-Lim-map F (f , fₚ) (PostComp (ColCoC F) (recCosCoc K)) - =⟨ CosColim-NatSq1-eq F (f , fₚ) (fst (recCosCoc K)) (snd (recCosCoc K)) ⟩ - PostComp (ColCoC F) (f , fₚ ∘* recCosCoc K) =∎ - --- NatSq-PreCmp2 : PostComp (ColCoC F) (f , fₚ ∘* recCosCoc K) == PostComp (ColCoC F) (f , fₚ ∘* recCosCoc 𝕂) - NatSq-PreCmp2 = ap (λ κ → PostComp (ColCoC F) (f , fₚ ∘* recCosCoc κ)) (! 𝕂-K-eq) + =⟨ ! (CosColim-NatSq2-eq T f fₚ) ⟩ + Map-to-Lim-map F (f , fₚ) K-diag + =⟨ ap (Map-to-Lim-map F (f , fₚ)) (! (LRfunEq K-diag)) ⟩ + Map-to-Lim-map F (f , fₚ) (PostComp (ColCoC F) (recCosCoc K-diag)) + =⟨ CosColim-NatSq1-eq F (f , fₚ) (fst (recCosCoc K-diag)) (snd (recCosCoc K-diag)) ⟩ + PostComp (ColCoC F) (f , fₚ ∘* recCosCoc K-diag) =∎ - NatSq-PreCmp3 : PostComp (ColCoC F) (f , fₚ ∘* recCosCoc 𝕂) == PostComp (ColCoC F) (f , fₚ ∘* 𝕕) - NatSq-PreCmp3 = ap (λ h → PostComp (ColCoC F) (f , fₚ ∘* h)) (𝕂₀-𝕕₀-eq δ) + NatSq-PreCmp2 : PostComp (ColCoC F) (f , fₚ ∘* recCosCoc K-diag) == PostComp (ColCoC F) (f , fₚ ∘* 𝕕) + NatSq-PreCmp2 = ap (λ h → PostComp (ColCoC F) (f , fₚ ∘* h)) (K-diag-𝕕-eq δ) NatSq-PreCmp : (f* : (Cos P₂ left) *→ T) → Diag-to-Lim-map (PostComp (ColCoC G) f*) == PostComp (ColCoC F) (f* ∘* 𝕕) - NatSq-PreCmp (f , fₚ) = NatSq-PreCmp1 f fₚ ∙ NatSq-PreCmp2 f fₚ ∙ NatSq-PreCmp3 f fₚ + NatSq-PreCmp (f , fₚ) = NatSq-PreCmp1 f fₚ ∙ NatSq-PreCmp2 f fₚ diff --git a/Colimit-code/Map-Nat/CosColimitPstCmp.agda b/Colimit-code/Map-Nat/CosColimitPstCmp.agda index 4dbd44d..827fe1f 100644 --- a/Colimit-code/Map-Nat/CosColimitPstCmp.agda +++ b/Colimit-code/Map-Nat/CosColimitPstCmp.agda @@ -3,7 +3,7 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq +open import Helper-paths open import FTID-Cos open import Coslice open import Diagram @@ -14,9 +14,9 @@ module CosColimitPstCmp where module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} (h : B → C) (f : A → B) where - ap-∘-∙-s : {x y : A} (p₁ : x == y) {z : B} (p₂ : f y == z) {c : C} {s : h z == c} + ap-∘-∙ : {x y : A} (p₁ : x == y) {z : B} (p₂ : f y == z) {c : C} {s : h z == c} → ap h (ap f p₁ ∙ p₂) ∙ s == ap (h ∘ f) p₁ ∙ ap h p₂ ∙ s - ap-∘-∙-s idp p₂ = idp + ap-∘-∙ idp p₂ = idp ap-∘-rid : {x y : A} (p : x == y) → ap h (ap f p) ∙ idp == ap (h ∘ f) p ap-∘-rid idp = idp @@ -71,7 +71,7 @@ module _ {ℓv ℓe ℓ ℓd ℓc₁ ℓc₂} {Γ : Graph ℓv ℓe} {A : Type ap φ₁ (ap f p₁) ∙ idp) ∙ ap (φ₁ ∘ f ∘ right ∘ cin j) p₂ ∙ ap (φ₁ ∘ f) p₃ ∙ ap φ₁ p₄ ∙ p₅)) - (ap-∘-∙-s φ₁ f p₃ p₄) ◃∙ + (ap-∘-∙ φ₁ f p₃ p₄) ◃∙ long-path-red p₂ (ap (φ₁ ∘ f) p₃ ∙ ap φ₁ p₄ ∙ p₅) @@ -98,7 +98,7 @@ module _ {ℓv ℓe ℓ ℓd ℓc₁ ℓc₂} {Γ : Graph ℓv ℓe} {A : Type ap (λ p → ap φ₁ p ∙ φ₂ a) (ap-cp-revR f (right ∘ cin j) p₂ p₁ ∙ ap (λ p → p ∙ fₚ a) (ap (ap f) τ))) ◃∙ - ap-∘-∙-s φ₁ f σ (fₚ a) ◃∎ + ap-∘-∙ φ₁ f σ (fₚ a) ◃∎ =ₛ (ap-cp-revR (φ₁ ∘ f) (right ∘ cin j) p₂ p₁ ∙ @@ -107,14 +107,14 @@ module _ {ℓv ℓe ℓ ℓd ℓc₁ ℓc₂} {Γ : Graph ℓv ℓe} {A : Type NatSq-1-Λ-red2 {i} {j} g a idp idp p₃ idp = =ₛ-in (lemma p₃ (fₚ a)) where lemma : {z : P} (p : right (cin j (fst (F <#> g) (fun (F # i) a))) == z) (c : f z == fun T a) - → ↯ (NatSq-1-Λ-aux g a idp idp p c (φ₂ a)) ∙ ap-∘-∙-s φ₁ f p c == idp + → ↯ (NatSq-1-Λ-aux g a idp idp p c (φ₂ a)) ∙ ap-∘-∙ φ₁ f p c == idp lemma idp c = idp -- τ = (snd (comTri ColCoC g) a) CosColim-NatSq1 : CosCocEq F U (Map-to-Lim-map (PostComp ColCoC (f , fₚ))) (PostComp ColCoC (φ ∘* (f , fₚ))) W CosColim-NatSq1 = λ i x → idp - u CosColim-NatSq1 = λ i a → ap-∘-∙-s φ₁ f (! (glue (cin i a))) (fₚ a) + u CosColim-NatSq1 = λ i a → ap-∘-∙ φ₁ f (! (glue (cin i a))) (fₚ a) Λ CosColim-NatSq1 {i} {j} g = (λ x → ap-∘-rid φ₁ f (fst (comTri ColCoC g) x)) , λ a → lemma a where lemma : (a : A) → @@ -133,7 +133,7 @@ module _ {ℓv ℓe ℓ ℓd ℓc₁ ℓc₂} {Γ : Graph ℓv ℓe} {A : Type ap φ₁ (ap f (fst (comTri ColCoC g) (fun (F # i) a))) ∙ idp) ∙ ap (φ₁ ∘ f ∘ fst (comp ColCoC j)) (snd (F <#> g) a) ∙ ap (φ₁ ∘ f) (snd (comp ColCoC j) a) ∙ - snd (φ ∘* f , fₚ) a) (ap-∘-∙-s φ₁ f (! (glue (cin j a))) (fₚ a)) ◃∙ + snd (φ ∘* f , fₚ) a) (ap-∘-∙ φ₁ f (! (glue (cin j a))) (fₚ a)) ◃∙ long-path-red (snd (F <#> g) a) (ap (φ₁ ∘ f) (! (glue (cin j a))) ∙ ap (fst φ) (fₚ a) ∙ snd φ a) (ap (fst φ) (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ snd φ a) (ap φ₁ (ap f (ap right (cglue g (fun (F # i) a))))) idp ◃∙ -- here @@ -143,7 +143,7 @@ module _ {ℓv ℓe ℓ ℓd ℓc₁ ℓc₂} {Γ : Graph ℓv ℓe} {A : Type (ap-cp-revR f (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ∙ ap (λ p → p ∙ fₚ a) (ap (ap f) (snd (comTri ColCoC g) a)))) ◃∙ - ap-∘-∙-s φ₁ f (! (glue (cin i a))) (fₚ a) ◃∎ + ap-∘-∙ φ₁ f (! (glue (cin i a))) (fₚ a) ◃∎ =ₛ (ap-cp-revR (φ₁ ∘ f) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ∙ @@ -165,7 +165,7 @@ module _ {ℓv ℓe ℓ ℓd ℓc₁ ℓc₂} {Γ : Graph ℓv ℓe} {A : Type ap φ₁ (ap f (fst (comTri ColCoC g) (fun (F # i) a))) ∙ idp) ∙ ap (φ₁ ∘ f ∘ fst (comp ColCoC j)) (snd (F <#> g) a) ∙ ap (φ₁ ∘ f) (snd (comp ColCoC j) a) ∙ - snd (φ ∘* f , fₚ) a) (ap-∘-∙-s φ₁ f (! (glue (cin j a))) (fₚ a)) ◃∙ + snd (φ ∘* f , fₚ) a) (ap-∘-∙ φ₁ f (! (glue (cin j a))) (fₚ a)) ◃∙ long-path-red (snd (F <#> g) a) (ap (φ₁ ∘ f) (! (glue (cin j a))) ∙ ap (fst φ) (fₚ a) ∙ snd φ a) (ap (fst φ) (ap f (! (glue (cin j a))) ∙ fₚ a) ∙ snd φ a) (ap φ₁ (ap f (ap right (cglue g (fun (F # i) a))))) idp ◃∙ @@ -175,7 +175,7 @@ module _ {ℓv ℓe ℓ ℓd ℓc₁ ℓc₂} {Γ : Graph ℓv ℓe} {A : Type (ap-cp-revR f (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ∙ ap (λ p → p ∙ fₚ a) (ap (ap f) (snd (comTri ColCoC g) a)))) ◃∙ - ap-∘-∙-s φ₁ f (! (glue (cin i a))) (fₚ a) ◃∎ + ap-∘-∙ φ₁ f (! (glue (cin i a))) (fₚ a) ◃∎ =ₛ⟨ 0 & 4 & NatSq-1-Λ-red g a (ap right (cglue g (fun (F # i) a))) (snd (F <#> g) a) (! (glue (cin j a))) (fₚ a) (φ₂ a) ⟩ ↯ (NatSq-1-Λ-aux g a (ap right (cglue g (fun (F # i) a))) (snd (F <#> g) a) (! (glue (cin j a))) (fₚ a) (φ₂ a)) ◃∙ ap (λ q → q) (ap-cp-revR φ₁ (f ∘ fst (comp ColCoC j)) (snd (F <#> g) a) @@ -184,7 +184,7 @@ module _ {ℓv ℓe ℓ ℓd ℓc₁ ℓc₂} {Γ : Graph ℓv ℓe} {A : Type (ap-cp-revR f (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ∙ ap (λ p → p ∙ fₚ a) (ap (ap f) (snd (comTri ColCoC g) a)))) ◃∙ - ap-∘-∙-s φ₁ f (! (glue (cin i a))) (fₚ a) ◃∎ + ap-∘-∙ φ₁ f (! (glue (cin i a))) (fₚ a) ◃∎ =ₛ⟨ NatSq-1-Λ-red2 g a (ap right (cglue g (fun (F # i) a))) (snd (F <#> g) a) (! (glue (cin j a))) (snd (comTri ColCoC g) a) ⟩ (ap-cp-revR (φ₁ ∘ f) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ∙ diff --git a/Colimit-code/R-L-R/CC-Equiv-RLR-0.agda b/Colimit-code/R-L-R/CC-Equiv-RLR-0.agda index 1d7f310..9f1ede1 100644 --- a/Colimit-code/R-L-R/CC-Equiv-RLR-0.agda +++ b/Colimit-code/R-L-R/CC-Equiv-RLR-0.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -27,9 +26,9 @@ module ConstrE2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} CompEq : (i : Obj Γ) (a : A) → snd (comp LRfun i) a =-= snd (comp K i) a CompEq i a = ap (fst (recCosCoc K)) (! (glue (cin i a))) ∙ idp - =⟪ ap-inv-rid (fst (recCosCoc K)) (glue (cin i a)) ⟫ + =⟪ ap-inv-rid (fst (recCosCoc K)) (glue (cin i a))⟫ ! (ap (fst (recCosCoc K)) (glue (cin i a))) - =⟪ ap ! (FPrecc-βr K (cin i a)) ⟫ + =⟪ ap ! (FPrecc-βr K (cin i a)) ⟫ ! (! (snd (comp K i) a)) =⟪ !-! (snd (comp K i) a) ⟫ snd (comp K i) a ∎∎ @@ -38,40 +37,50 @@ module ConstrE2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} FunHomEq g x = ap (fst (recCosCoc K)) (ap right (cglue g x)) ∙ idp =⟪ ap-inv-cmp-rid right (fst (recCosCoc K)) (cglue g x) ⟫ ap (reccForg K) (cglue g x) - =⟪ recc-βr K g x ⟫ + =⟪ recc-βr K g x ⟫ fst (comTri K g) x ∎∎ abstract - FPrecc-transf : (i j : Obj Γ) (g : Hom Γ i j) (a : A) → ap-inv-rid (fst (recCosCoc K)) (glue (cin i a)) ◃∙ ap ! (FPrecc-βr K (cin i a)) ◃∎ =ₛ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) - (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + FPrecc-transf : (i j : Obj Γ) (g : Hom Γ i j) (a : A) + → ap-inv-rid (fst (recCosCoc K)) (glue (cin i a)) ◃∙ ap ! (FPrecc-βr K (cin i a)) ◃∎ =ₛ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) + (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ ap-seq ! (η (comp K) (comTri K) i j g a) - FPrecc-transf i j g a = ap-inv-rid (fst (recCosCoc K)) (glue (cin i a)) ◃∙ ap ! (FPrecc-βr K (cin i a)) ◃∎ - =ₛ⟨ =ₛ-in (apd-tr-coher (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (λ z → ! (σ (comp K) (comTri K) z)) (cglue g a) - (λ z → ap-inv-rid (fst (recCosCoc K)) (glue z) ∙ ap ! (FPrecc-βr K z))) ⟩ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) - (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ apd-tr (λ z → ! (σ (comp K) (comTri K) z)) (cglue g a) ◃∎ - =ₛ⟨ 2 & 1 & apd-tr-inv-fn (fun T ∘ [id]) (reccForg K ∘ ψ) (σ (comp K) (comTri K)) (cglue g a) ⟩ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) - (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap ! (apd-tr (σ (comp K) (comTri K)) (cglue g a)) ◃∎ - =ₛ⟨ 3 & 1 & =ₛ-in (ap (ap !) (σ-β K g a)) ⟩ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) - (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap ! (↯ (η (comp K) (comTri K) i j g a)) ◃∎ - =ₛ⟨ 3 & 1 & ap-seq-∙ ! (η (comp K) (comTri K) i j g a) ⟩ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) - (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap-seq ! (η (comp K) (comTri K) i j g a) ∎ₛ + FPrecc-transf i j g a = + ap-inv-rid (fst (recCosCoc K)) (glue (cin i a)) ◃∙ ap ! (FPrecc-βr K (cin i a)) ◃∎ + =ₛ⟨ =ₛ-in (apd-tr-coher (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) + (λ z → ! (σ (comp K) (comTri K) z)) (cglue g a) + (λ z → ap-inv-rid (fst (recCosCoc K)) (glue z) ∙ ap ! (FPrecc-βr K z))) ⟩ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) + (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + apd-tr (λ z → ! (σ (comp K) (comTri K) z)) (cglue g a) ◃∎ + =ₛ⟨ 2 & 1 & apd-tr-inv-fn (fun T ∘ [id]) (reccForg K ∘ ψ) (σ (comp K) (comTri K)) (cglue g a) ⟩ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) + (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap ! (apd-tr (σ (comp K) (comTri K)) (cglue g a)) ◃∎ + =ₛ⟨ 3 & 1 & =ₛ-in (ap (ap !) (σ-β K g a)) ⟩ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) + (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap ! (↯ (η (comp K) (comTri K) i j g a)) ◃∎ + =ₛ⟨ 3 & 1 & ap-seq-∙ ! (η (comp K) (comTri K) i j g a) ⟩ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) + (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap-seq ! (η (comp K) (comTri K) i j g a) ∎ₛ module Equiv2a (i j : Obj Γ) (g : Hom Γ i j) (a : A) where - Ξ-inst = ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + Ξ-inst = + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (↯ (CompEq j a)) ◃∙ @@ -79,242 +88,247 @@ module ConstrE2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} ap (λ p → p) (snd (comTri LRfun g) a) ◃∙ CompEq i a - Ξ-RW1 = Ξ-inst - =ₛ⟨ 1 & 1 & ap-seq-∙ (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (CompEq j a) ⟩ - ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - ap (λ p → p) (snd (comTri LRfun g) a) ◃∙ - CompEq i a ∎ₛ + Ξ-RW1 = + Ξ-inst + =ₛ⟨ 1 & 1 & ap-seq-∙ (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (CompEq j a) ⟩ + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + ap (λ p → p) (snd (comTri LRfun g) a) ◃∙ + CompEq i a ∎ₛ - Ξ-RW2 = ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - ap (λ p → p) (snd (comTri LRfun g) a) ◃∙ - CompEq i a - =ₑ⟨ 5 & 1 & (snd (comTri LRfun g) a ◃∎) % =ₛ-in ((ap-idf (snd (comTri LRfun g) a))) ⟩ - ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - snd (comTri LRfun g) a ◃∙ - CompEq i a ∎ₛ + Ξ-RW2 = + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + ap (λ p → p) (snd (comTri LRfun g) a) ◃∙ + CompEq i a + =ₑ⟨ 5 & 1 & (snd (comTri LRfun g) a ◃∎) % =ₛ-in ((ap-idf (snd (comTri LRfun g) a))) ⟩ + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + snd (comTri LRfun g) a ◃∙ + CompEq i a ∎ₛ - Ξ-RW3 = ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - snd (comTri LRfun g) a ◃∙ - CompEq i a - =ₑ⟨ 6 & 2 & (↯ (! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) - (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap-seq ! (η (comp K) (comTri K) i j g a)) ◃∎) % =ₛ-in (=ₛ-out (FPrecc-transf i j g a)) ⟩ - ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - snd (comTri LRfun g) a ◃∙ - ↯ (! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) + Ξ-RW3 = + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + snd (comTri LRfun g) a ◃∙ + CompEq i a + =ₑ⟨ 6 & 2 & (↯ (! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap-seq ! (η (comp K) (comTri K) i j g a)) ◃∙ - !-! (snd (comp K i) a) ◃∎ ∎ₛ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap-seq ! (η (comp K) (comTri K) i j g a)) ◃∎) % =ₛ-in (=ₛ-out (FPrecc-transf i j g a)) ⟩ + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + snd (comTri LRfun g) a ◃∙ + ↯ (! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) + (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap-seq ! (η (comp K) (comTri K) i j g a)) ◃∙ + !-! (snd (comp K i) a) ◃∎ ∎ₛ - Ξ-RW4 = ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - snd (comTri LRfun g) a ◃∙ - ↯ (! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) - (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap-seq ! (η (comp K) (comTri K) i j g a)) ◃∙ - !-! (snd (comp K i) a) ◃∎ - =ₑ⟨ 6 & 1 & (! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ - ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ - ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ - (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ - ap ! (ap ! (snd (comTri K g) a)) ◃∎) % =ₛ-in idp ⟩ - ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - snd (comTri LRfun g) a ◃∙ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ - ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ - ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ - (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ - ap ! (ap ! (snd (comTri K g) a)) ◃∙ - !-! (snd (comp K i) a) ◃∎ ∎ₛ + Ξ-RW4 = + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + snd (comTri LRfun g) a ◃∙ + ↯ (! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) + (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap-seq ! (η (comp K) (comTri K) i j g a)) ◃∙ + !-! (snd (comp K i) a) ◃∎ + =ₑ⟨ 6 & 1 & (! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ + ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ + ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ + (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ + ap ! (ap ! (snd (comTri K g) a)) ◃∎) % =ₛ-in idp ⟩ + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + snd (comTri LRfun g) a ◃∙ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ + ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ + ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ + (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ + ap ! (ap ! (snd (comTri K g) a)) ◃∙ + !-! (snd (comp K i) a) ◃∎ ∎ₛ + + Ξ-RW5 = + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + snd (comTri LRfun g) a ◃∙ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ + ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ + ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ + (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ + ap ! (ap ! (snd (comTri K g) a)) ◃∙ + !-! (snd (comp K i) a) ◃∎ + =ₑ⟨ 5 & 1 & (ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (↯ (ϵ g g a))) ◃∎) % =ₛ-in idp ⟩ + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (↯ (ϵ g g a))) ◃∙ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ + ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ + ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ + (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ + ap ! (ap ! (snd (comTri K g) a)) ◃∙ + !-! (snd (comp K i) a) ◃∎ ∎ₛ - Ξ-RW5 = ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - snd (comTri LRfun g) a ◃∙ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ - ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ - ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ - (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ - ap ! (ap ! (snd (comTri K g) a)) ◃∙ - !-! (snd (comp K i) a) ◃∎ - =ₑ⟨ 5 & 1 & (ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (↯ (ϵ g g a))) ◃∎) % =ₛ-in idp ⟩ - ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (↯ (ϵ g g a))) ◃∙ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ - ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ - ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ - (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ - ap ! (ap ! (snd (comTri K g) a)) ◃∙ - !-! (snd (comp K i) a) ◃∎ ∎ₛ - Ξ-RW6 = - ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (↯ (ϵ g g a))) ◃∙ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ - ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ - ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ - (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ - ap ! (ap ! (snd (comTri K g) a)) ◃∙ - !-! (snd (comp K i) a) ◃∎ - =ₛ⟨ 6 & 1 & =ₛ-in (ap (ap (λ p → p ∙ (snd (recCosCoc K) a))) (=ₛ-out (ap-seq-∙ (ap (fst (recCosCoc K))) (ϵ g g a)))) ∙ₛ ap-seq-∙ (λ p → p ∙ - (snd (recCosCoc K) a)) (ap-seq (ap (fst (recCosCoc K))) (ϵ g g a)) ⟩ - ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) - (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (E₁ (snd (F <#> g) a) (! (glue (cin j a))))) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) - (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (E₃ (λ z → ! (glue z)) (cglue g a) (ψ-βr g a) (λ z → idp))) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (∙-unit-r (! (glue (cin i a))))) ◃∙ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ - ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ - ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ - (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ - ap ! (ap ! (snd (comTri K g) a)) ◃∙ - !-! (snd (comp K i) a) ◃∎ ∎ₛ + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (↯ (ϵ g g a))) ◃∙ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ + ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ + ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ + (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ + ap ! (ap ! (snd (comTri K g) a)) ◃∙ + !-! (snd (comp K i) a) ◃∎ + =ₛ⟨ 6 & 1 & =ₛ-in (ap (ap (λ p → p ∙ (snd (recCosCoc K) a))) (=ₛ-out (ap-seq-∙ (ap (fst (recCosCoc K))) (ϵ g g a)))) ∙ₛ ap-seq-∙ (λ p → p ∙ + (snd (recCosCoc K) a)) (ap-seq (ap (fst (recCosCoc K))) (ϵ g g a)) ⟩ + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) + (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (E₁ (snd (F <#> g) a) (! (glue (cin j a))))) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (E₃ (λ z → ! (glue z)) (cglue g a) (ψ-βr g a) (λ z → idp))) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (∙-unit-r (! (glue (cin i a))))) ◃∙ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ + ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ + ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ + (snd (comp K j) a))) (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ + ap ! (ap ! (snd (comTri K g) a)) ◃∙ + !-! (snd (comp K i) a) ◃∎ ∎ₛ diff --git a/Colimit-code/R-L-R/CC-Equiv-RLR-1.agda b/Colimit-code/R-L-R/CC-Equiv-RLR-1.agda index f458391..3f378f0 100644 --- a/Colimit-code/R-L-R/CC-Equiv-RLR-1.agda +++ b/Colimit-code/R-L-R/CC-Equiv-RLR-1.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -59,7 +58,8 @@ module ConstrE2Cont {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type abstract - Ξ-rewrite : Ξ-inst =ₛ + Ξ-rewrite : + Ξ-inst =ₛ ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ @@ -80,7 +80,7 @@ module ConstrE2Cont {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (∙-unit-r (! (glue (cin i a))))) ◃∙ ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ @@ -109,32 +109,32 @@ module ConstrE2Cont {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type abstract - Ξ-rewrite2 : Ξ-inst =ₛ - ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) - (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (E₁ (snd (F <#> g) a) (! (glue (cin j a))))) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) - (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ - ap (λ p → p ∙ idp) (ap (ap (fst (recCosCoc K))) (E₃ {f = left} {h = [id]} {u = right} (λ z → ! (glue z)) (cglue g a) (ψ-βr g a) (λ z → idp))) ◃∙ - ∙-unit-r (ap (fst (recCosCoc K)) (! (glue (cin i a)) ∙ idp)) ◃∙ - ap-∙-cmp2 (fst (recCosCoc K)) left (! (glue (cin i a))) idp ◃∙ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ - ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ - ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ (snd (comp K j) a))) - (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ - ap ! (ap ! (snd (comTri K g) a)) ◃∙ - !-! (snd (comp K i) a) ◃∎ + Ξ-rewrite2 : + Ξ-inst =ₛ + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (E₁ (snd (F <#> g) a) (! (glue (cin j a))))) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ + cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ + ap (λ p → p ∙ idp) (ap (ap (fst (recCosCoc K))) (E₃ {f = left} {h = [id]} {u = right} (λ z → ! (glue z)) (cglue g a) (ψ-βr g a) (λ z → idp))) ◃∙ + ∙-unit-r (ap (fst (recCosCoc K)) (! (glue (cin i a)) ∙ idp)) ◃∙ + ap-∙-cmp2 (fst (recCosCoc K)) left (! (glue (cin i a))) idp ◃∙ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ + ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ + ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ (snd (comp K j) a))) + (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ + ap ! (ap ! (snd (comTri K g) a)) ◃∙ + !-! (snd (comp K i) a) ◃∎ Ξ-rewrite2 = Ξ-inst =ₛ⟨ Ξ-rewrite ⟩ ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) @@ -157,7 +157,7 @@ module ConstrE2Cont {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (∙-unit-r (! (glue (cin i a))))) ◃∙ ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ (snd (comp K j) a))) @@ -186,7 +186,7 @@ module ConstrE2Cont {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ap-∙-cmp2 (fst (recCosCoc K)) left (! (glue (cin i a))) idp ◃∙ ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ (snd (comp K j) a))) @@ -196,43 +196,44 @@ module ConstrE2Cont {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type =ₛ₁⟨ 1 & 2 & ∙-ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a))) (ap ! (FPrecc-βr K (cin j a))) ⟩ - ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) - (snd (comp LRfun j) a)) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ - fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ - ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ - long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ - ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (E₁ (snd (F <#> g) a) (! (glue (cin j a))))) ◃∙ - ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) - (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ - ap (λ p → p ∙ idp) (ap (ap (fst (recCosCoc K))) (E₃ {f = left} {h = [id]} {u = right} (λ z → ! (glue z)) (cglue g a) (ψ-βr g a) (λ z → idp))) ◃∙ - ∙-unit-r (ap (fst (recCosCoc K)) (! (glue (cin i a)) ∙ idp)) ◃∙ - ap-∙-cmp2 (fst (recCosCoc K)) left (! (glue (cin i a))) idp ◃∙ - ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ - ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ - ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ - ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ - ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ (snd (comp K j) a))) - (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ - ap ! (ap ! (snd (comTri K g) a)) ◃∙ - !-! (snd (comp K i) a) ◃∎ ∎ₛ + ap (λ p → ! (p ∙ fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) + (hmtpy-nat-rev (λ z → idp) (snd (F <#> g) a) + (snd (comp LRfun j) a)) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ + ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + ap (λ p → ! ((ap (fst (comp K j)) (snd (F <#> g) a) ∙ (p ∙ ! (snd (comp LRfun j) a)) ∙ ! (ap (fst (comp LRfun j)) (snd (F <#> g) a))) ∙ + fst (comTri LRfun g) (fun (F # i) a) ∙ idp) ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (!-! (snd (comp K j) a)) ◃∙ + long-path-red (snd (F <#> g) a) (snd (comp K j) a) (snd (comp LRfun j) a) (fst (comTri LRfun g) (fun (F # i) a)) idp ◃∙ + ap-cp-revR (fst (recCosCoc K)) (fst (comp ColCoC j)) (snd (F <#> g) a) (fst (comTri ColCoC g) (fun (F # i) a)) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) (E₁ (snd (F <#> g) a) (! (glue (cin j a))))) ◃∙ + ap (λ p → p ∙ (snd (recCosCoc K) a)) (ap (ap (fst (recCosCoc K))) + (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ p) (ap (ap left) (id-βr g a))))) ◃∙ + ap (λ p → p ∙ idp) (ap (ap (fst (recCosCoc K))) (E₃ {f = left} {h = [id]} {u = right} (λ z → ! (glue z)) (cglue g a) (ψ-βr g a) (λ z → idp))) ◃∙ + ∙-unit-r (ap (fst (recCosCoc K)) (! (glue (cin i a)) ∙ idp)) ◃∙ + ap-∙-cmp2 (fst (recCosCoc K)) left (! (glue (cin i a))) idp ◃∙ + ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ + ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ + ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ + ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ (snd (comp K j) a))) + (ap (λ p → ! (ap (fun T) p)) (id-βr g a))) ◃∙ + ap ! (ap ! (snd (comTri K g) a)) ◃∙ + !-! (snd (comp K i) a) ◃∎ ∎ₛ - Ξ-Red0 : {x : Colim (ConsDiag Γ A)} (q : cin j a == x) (Q : a == [id] x) (U : ψ (cin j a) == ψ x) (R : fst (comp K j) (fun (F # j) a) == fun T a) (L : a == a) - (M : left a == right (ψ (cin j a))) (t : ap (fst (recCosCoc K)) (! M) ∙ ap (fun T) L == ! (! R)) + Ξ-Red0 : {x : Colim (ConsDiag Γ A)} (q : cin j a == x) (Q : a == [id] x) (U : ψ (cin j a) == ψ x) (R : fst (comp K j) (fun (F # j) a) == fun T a) + (L : a == a) (M : left a == right (ψ (cin j a))) (t : ap (fst (recCosCoc K)) (! M) ∙ ap (fun T) L == ! (! R)) → ap (fst (recCosCoc K)) (! (ap right U) ∙ (! M) ∙ ap left L ∙ ap left Q) ∙ idp =-= ! (! (ap (fun T) Q) ∙ ! R ∙ ap (recc (comp K) (comTri K)) U) - Ξ-Red0 q Q U R L M t = ap (fst (recCosCoc K)) (! (ap right U) ∙ (! M) ∙ ap left L ∙ ap left Q) ∙ idp - =⟪ Ξ-helper1-delay right (fst (recCosCoc K)) left U M Q L ⟫ - ap (fst (recCosCoc K)) (! (ap right U)) ∙ (ap (fst (recCosCoc K)) (! M) ∙ ap (fun T) L) ∙ ap (fun T) Q - =⟪ ap (λ p → ap (fst (recCosCoc K)) (! (ap right U)) ∙ p ∙ ap (fun T) Q) t ⟫ - ap (fst (recCosCoc K)) (! (ap right U)) ∙ ! (! R) ∙ ap (fun T) Q - =⟪ Ξ-helper2-delay right (fst (recCosCoc K)) left U Q R ⟫ - ! (! (ap (fun T) Q) ∙ ! R ∙ ap (recc (comp K) (comTri K)) U) ∎∎ + Ξ-Red0 q Q U R L M t = + ap (fst (recCosCoc K)) (! (ap right U) ∙ (! M) ∙ ap left L ∙ ap left Q) ∙ idp + =⟪ Ξ-helper1-delay right (fst (recCosCoc K)) left U M Q L ⟫ + ap (fst (recCosCoc K)) (! (ap right U)) ∙ (ap (fst (recCosCoc K)) (! M) ∙ ap (fun T) L) ∙ ap (fun T) Q + =⟪ ap (λ p → ap (fst (recCosCoc K)) (! (ap right U)) ∙ p ∙ ap (fun T) Q) t ⟫ + ap (fst (recCosCoc K)) (! (ap right U)) ∙ ! (! R) ∙ ap (fun T) Q + =⟪ Ξ-helper2-delay right (fst (recCosCoc K)) left U Q R ⟫ + ! (! (ap (fun T) Q) ∙ ! R ∙ ap (recc (comp K) (comTri K)) U) ∎∎ abstract @@ -243,7 +244,7 @@ module ConstrE2Cont {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ap-∙-cmp2 (fst (recCosCoc K)) left (! (glue x)) (L x) ◃∙ ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ ap (fun T) (L z)) q) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) q) t ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) q (! R) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) q (! R) ◃∙ ap ! (H₁ q (! R) E) ◃∎ =ₛ Ξ-Red0 q (ap [id] q) U R (L (cin j a)) (glue (cin j a)) t @@ -290,12 +291,13 @@ module ConstrE2Cont {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type abstract - Ξ-RedEq1 : (Q : a == a) (I : ap [id] (cglue g a) == Q) (R : fst (comp K j) (fun (F # j) a) == fun T a) (t : ap (fst (recCosCoc K)) (! (glue (cin j a))) ∙ ap (fun T) Q == ! (! R)) + Ξ-RedEq1 : (Q : a == a) (I : ap [id] (cglue g a) == Q) (R : fst (comp K j) (fun (F # j) a) == fun T a) + (t : ap (fst (recCosCoc K)) (! (glue (cin j a))) ∙ ap (fun T) Q == ! (! R)) (C : fst (comp K j) (fst (F <#> g) (fun (F # i) a)) == fst (comp K i) (fun (F # i) a)) (c : ap (recc (comp K) (comTri K)) (cglue g (fun (F # i) a)) == C) (W : fst (comp K i) (fun (F # i) a) == fun T a) (s : ! C ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ R == W) → - ap (λ p → p ∙ idp) (ap (ap (fst (recCosCoc K))) (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ ! (glue (cin j a)) ∙ ap left Q ∙ p) - (ap (ap left) I)))) ◃∙ + ap (λ p → p ∙ idp) (ap (ap (fst (recCosCoc K))) (! (ap (λ p → ! (ap right (! (ap (cin j) (snd (F <#> g) a)) ∙ cglue g (fun (F # i) a))) ∙ + ! (glue (cin j a)) ∙ ap left Q ∙ p) (ap (ap left) I)))) ◃∙ ↯ (Ξ-Red0 (cglue g a) (ap [id] (cglue g a)) (! (ap (cin j) (snd (F <#> g) a)) ∙ (cglue g (fun (F # i) a))) R Q (glue (cin j a)) t) ◃∙ ap ! (H₂ (snd (F <#> g) a) R (cglue g (fun (F # i) a)) c) ◃∙ ap ! (ap (λ p → p ∙ ! (! C ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ R)) (ap (λ p → ! (ap (fun T) p)) I)) ◃∙ diff --git a/Colimit-code/R-L-R/CC-Equiv-RLR-2.agda b/Colimit-code/R-L-R/CC-Equiv-RLR-2.agda index 4d26093..0eda61c 100644 --- a/Colimit-code/R-L-R/CC-Equiv-RLR-2.agda +++ b/Colimit-code/R-L-R/CC-Equiv-RLR-2.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -34,15 +33,16 @@ module _ {ℓ} {A : Type ℓ} where → ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) τ ◃∙ ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) (!-! r) ◃∙ db-neg-rid-db r idp ◃∙ ap (λ p → p ∙ idp) τ ◃∙ ap (λ p → p ∙ idp) (!-! r) ◃∎ =ₛ ! (∙-unit-r r) ◃∎ - coher-rid-trip r τ = ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) τ ◃∙ ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) (!-! r) ◃∙ db-neg-rid-db r idp ◃∙ - ap (λ p → p ∙ idp) τ ◃∙ ap (λ p → p ∙ idp) (!-! r) ◃∎ - =ₛ₁⟨ 0 & 2 & ∙-ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) τ (!-! r) ⟩ - ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) (τ ∙ !-! r) ◃∙ db-neg-rid-db r idp ◃∙ ap (λ p → p ∙ idp) τ ◃∙ ap (λ p → p ∙ idp) (!-! r) ◃∎ - =ₛ₁⟨ 2 & 2 & ∙-ap (λ p → p ∙ idp) τ (!-! r) ⟩ - ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) (τ ∙ !-! r) ◃∙ db-neg-rid-db r idp ◃∙ ap (λ p → p ∙ idp) (τ ∙ !-! r) ◃∎ - =ₛ⟨ helper-coher-rid r (τ ∙ !-! r) ⟩ - ! (∙-unit-r r) ◃∎ ∎ₛ - + coher-rid-trip r τ = + ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) τ ◃∙ ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) (!-! r) ◃∙ db-neg-rid-db r idp ◃∙ + ap (λ p → p ∙ idp) τ ◃∙ ap (λ p → p ∙ idp) (!-! r) ◃∎ + =ₛ₁⟨ 0 & 2 & ∙-ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) τ (!-! r) ⟩ + ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) (τ ∙ !-! r) ◃∙ db-neg-rid-db r idp ◃∙ ap (λ p → p ∙ idp) τ ◃∙ ap (λ p → p ∙ idp) (!-! r) ◃∎ + =ₛ₁⟨ 2 & 2 & ∙-ap (λ p → p ∙ idp) τ (!-! r) ⟩ + ap (λ p → ! (((p ∙ idp) ∙ idp) ∙ idp) ∙ r) (τ ∙ !-! r) ◃∙ db-neg-rid-db r idp ◃∙ ap (λ p → p ∙ idp) (τ ∙ !-! r) ◃∎ + =ₛ⟨ helper-coher-rid r (τ ∙ !-! r) ⟩ + ! (∙-unit-r r) ◃∎ ∎ₛ + module ConstrE2Cont2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ℓ} (F : CosDiag ℓd ℓ A Γ) (T : Coslice ℓc ℓ A) (K : CosCocone A F T) where open ConstrE2Cont F T K public @@ -218,7 +218,7 @@ module ConstrE2Cont2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ap-∙-cmp2 (fst (recCosCoc K)) left (! (glue (cin i a))) idp ◃∙ ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ (snd (comp K j) a))) @@ -244,7 +244,7 @@ module ConstrE2Cont2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ap-∙-cmp2 (fst (recCosCoc K)) left (! (glue (cin i a))) idp ◃∙ ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ (snd (comp K j) a))) @@ -272,7 +272,7 @@ module ConstrE2Cont2 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type ap-∙-cmp2 (fst (recCosCoc K)) left (! (glue (cin i a))) idp ◃∙ ! (apd-tr (λ z → ap (fst (recCosCoc K)) (! (glue z)) ∙ idp) (cglue g a)) ◃∙ ap (transport (λ z → reccForg K (ψ z) == fun T ([id] z)) (cglue g a)) (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) ◃∙ - tranp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ + transp-inv-comm (fun T ∘ [id]) (reccForg K ∘ ψ) (cglue g a) (! (snd (comp K j) a)) ◃∙ ap ! (H₁ (cglue g a) (! (snd (comp K j) a)) (ψ-βr g a)) ◃∙ ap ! (H₂ (snd (F <#> g) a) (snd (comp K j) a) (cglue g (fun (F # i) a)) (recc-βr K g (fun (F # i) a))) ◃∙ ap ! (ap (λ p → p ∙ ! (! (fst (comTri K g) (fun (F # i) a)) ∙ ap (recc (comp K) (comTri K) ∘ cin j) (snd (F <#> g) a) ∙ (snd (comp K j) a))) diff --git a/Colimit-code/R-L-R/CC-Equiv-RLR-3.agda b/Colimit-code/R-L-R/CC-Equiv-RLR-3.agda index c76671a..28dfd4c 100644 --- a/Colimit-code/R-L-R/CC-Equiv-RLR-3.agda +++ b/Colimit-code/R-L-R/CC-Equiv-RLR-3.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim @@ -130,7 +129,7 @@ module ConstrE2Cont3 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type (fst (comTri K g) (fun (F # i) a)) (recc-βr K g (fun (F # i) a)) (snd (comp K i) a) (snd (comTri K g) a) ∙∙ !-! (snd (comp K i) a) ◃∎) =ₑ⟨ 0 & 13 & ((snd (comTri K g) a) ◃∙ ! (!-! (snd (comp K i) a)) ◃∎) % Ξ-Red2Eq (snd (comp K j) a) - (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) (recc-βr K g (fun (F # i) a)) (snd (comTri K g) a) ⟩ + (ap-inv-rid (fst (recCosCoc K)) (glue (cin j a)) ∙ ap ! (FPrecc-βr K (cin j a))) (recc-βr K g (fun (F # i) a)) (snd (comTri K g) a) ⟩ (snd (comTri K g) a) ◃∙ ! (!-! (snd (comp K i) a)) ◃∙ !-! (snd (comp K i) a) ◃∎ ∎ₛ @@ -141,5 +140,6 @@ module ConstrE2Cont3 {ℓv ℓe ℓ ℓd ℓc} {Γ : Graph ℓv ℓe} {A : Type =ₛ⟨ =ₛ-in (ap (λ p → (snd (comTri K g) a) ∙ p) (!-inv-l (!-! (snd (comp K i) a))) ∙ ∙-unit-r (snd (comTri K g) a)) ⟩ snd (comTri K g) a ◃∎ ∎ₛ - Λ-eq : ! (ap (λ p → ! p ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (↯ (FunHomEq g (fun (F # i) a)))) ◃∙ Ξ-inst =ₛ snd (comTri K g) a ◃∎ + Λ-eq : ! (ap (λ p → ! p ∙ ap (fst (comp K j)) (snd (F <#> g) a) ∙ snd (comp K j) a) (↯ (FunHomEq g (fun (F # i) a)))) ◃∙ Ξ-inst + =ₛ snd (comTri K g) a ◃∎ Λ-eq = Λ-eq0 ∙ₛ (Λ-eq1 ∙ₛ (Λ-eq2-pre ∙ₛ (Λ-eq2 ∙ₛ (Λ-eq3 ∙ₛ Λ-eq4)))) diff --git a/Colimit-code/R-L-R/CC-Equiv-RLR-4.agda b/Colimit-code/R-L-R/CC-Equiv-RLR-4.agda index db9c483..034afb0 100644 --- a/Colimit-code/R-L-R/CC-Equiv-RLR-4.agda +++ b/Colimit-code/R-L-R/CC-Equiv-RLR-4.agda @@ -3,7 +3,6 @@ open import lib.Basics open import lib.types.Pushout open import lib.types.Span -open import lib.PathSeq open import Coslice open import Diagram open import Colim diff --git a/Dockerfile b/Dockerfile index d8132ed..a2de333 100644 --- a/Dockerfile +++ b/Dockerfile @@ -19,7 +19,7 @@ RUN \ RUN \ mkdir -p /dist && \ cabal update && \ - cabal v2-install alex happy && \ + cabal v2-install alex happy-2.0.2 && \ cabal v1-install --bindir=/dist --datadir=/dist --datasubdir=/dist/data --enable-executable-static #################################################################################################### @@ -76,10 +76,6 @@ RUN /dist/agda --library-file=/dist/libraries ./Map-Nat/CosColimitMap15.agda RUN /dist/agda --library-file=/dist/libraries ./Map-Nat/CosColimitMap16.agda RUN /dist/agda --library-file=/dist/libraries ./Map-Nat/CosColimitMap17.agda RUN /dist/agda --library-file=/dist/libraries ./Map-Nat/CosColimitMap18.agda -RUN /dist/agda --library-file=/dist/libraries ./Map-Nat/CosColimitMap19.agda -RUN /dist/agda --library-file=/dist/libraries ./Map-Nat/CosColimitMap20.agda -RUN /dist/agda --library-file=/dist/libraries ./Map-Nat/CosColimitMap21.agda -RUN /dist/agda --library-file=/dist/libraries ./Map-Nat/CosColimitMap22.agda RUN /dist/agda --library-file=/dist/libraries ./Main-Theorem/CosColim-Adjunction.agda WORKDIR /build/Pullback-stability diff --git a/HoTT-Agda/core/lib/PathFunctor.agda b/HoTT-Agda/core/lib/PathFunctor.agda index e289a20..68af853 100644 --- a/HoTT-Agda/core/lib/PathFunctor.agda +++ b/HoTT-Agda/core/lib/PathFunctor.agda @@ -84,6 +84,7 @@ module _ {i j} {A : Type i} {B : Type j} (g : A → B) where !-ap-∙-s idp = idp module _ {i j k} {A : Type i} {B : Type j} {C : Type k} (g : B → C) (f : A → B) where + ∘-ap : {x y : A} (p : x == y) → ap g (ap f p) == ap (g ∘ f) p ∘-ap idp = idp @@ -306,6 +307,7 @@ module _ {i j} {A : Type i} {B : Type j} (b : B) where {- Naturality of homotopies -} module _ {i} {A : Type i} where + homotopy-naturality : ∀ {k} {B : Type k} (f g : A → B) (h : (x : A) → f x == g x) {x y : A} (p : x == y) → ap f p ◃∙ h y ◃∎ =ₛ h x ◃∙ ap g p ◃∎ @@ -374,6 +376,25 @@ module _ {i j k} {A : Type i} {B : Type j} {C : Type k} homotopy-naturality2 {a₀ = a} {b₀ = b} idp idp = =ₛ-in (! (∙-unit-r (h a b))) +module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} (f g : A → B) (H : (x : A) → f x == g x) where + + apCommSq : {x y : A} (p : x == y) → ! (H x) ∙ ap f p ∙ H y == ap g p + apCommSq {x = x} idp = !-inv-l (H x) + + apCommSq2 : {x y : A} (p : x == y) → H x == ap f p ∙ H y ∙ ! (ap g p) + apCommSq2 {x = x} idp = ! (∙-unit-r (H x)) + +module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : Type ℓ₂} {f g : A → B} (H : (x : A) → f x == g x) where + + hmtpy-nat-! : {x y : A} (p : x == y) → ! (H x) == ap g p ∙ ! (H y) ∙ ! (ap f p) + hmtpy-nat-! {x = x} idp = ! (∙-unit-r (! (H x))) + +module _ {ℓ₁ ℓ₂ ℓ₃ ℓ₄} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} {D : Type ℓ₄} {f : A → B} {g : A → C} + (v : B → D) (u : C → D) (H : (x : A) → v (f x) == u (g x)) where + + apCommSq-cmp : {x y : A} (p : x == y) → ap v (ap f p) == H x ∙ ap u (ap g p) ∙ ! (H y) + apCommSq-cmp {x = x} idp = ! (!-inv-r (H x)) + module _ {i j k} {A : Type i} {B : Type j} {C : Type k} (f : A → B → C) where ap-comm : {a₀ a₁ : A} (p : a₀ == a₁) {b₀ b₁ : B} (q : b₀ == b₁) @@ -489,14 +510,14 @@ module _ {i j} {A : Type i} {B : Type j} {f : A → B} where → transport (λ x → u (v x) == f (h x)) p q ◃∎ =ₛ (! (ap u (ap v p))) ◃∙ q ◃∙ (ap f (ap h p)) ◃∎ transp-pth-cmp-s idp q = =ₛ-in (! (∙-unit-r q)) - transp-pth-l-s : {x y : A} {g : A → B} (p : x == y) (q : f x == g x) - → transport (λ x → f x == g x) p q ◃∎ =ₛ ((! (ap f p)) ∙ q) ◃∙ (ap g p) ◃∎ - transp-pth-l-s idp q = =ₛ-in (! (∙-unit-r q)) - transp-pth-l : {x y : A} {g : A → B} (p : x == y) (q : f x == g x) → transport (λ x → f x == g x) p q == ((! (ap f p)) ∙ q) ∙ (ap g p) transp-pth-l idp q = ! (∙-unit-r q) + transp-pth-l-s : {x y : A} {g : A → B} (p : x == y) (q : f x == g x) + → transport (λ x → f x == g x) p q ◃∎ =ₛ ((! (ap f p)) ∙ q) ◃∙ (ap g p) ◃∎ + transp-pth-l-s idp q = =ₛ-in (! (∙-unit-r q)) + transp-pth-cmpR : ∀ {k l m} {C : Type k} {D : Type l} {Z : Type m} {t : C → Z} {h : Z → A} {v : C → D} {u : D → B} {x y : C} (p : x == y) (q : u (v x) == f (h (t x))) → transport (λ x → u (v x) == f (h (t x))) p q == (! (ap u (ap v p))) ∙ q ∙ (ap f (ap h (ap t p))) @@ -513,8 +534,14 @@ module _ {i j} {A : Type i} {B : Type j} {f : A → B} where transp-pth-cmp-l idp q = ! (∙-unit-r q) transpRev : {x y : A} {g : A → B} (p : x == y) {q : f x == g x} {r : f y == g y} - → (transport (λ x → f x == g x) p q == r) → (transport (λ x → g x == f x) p (! q) == ! r) - transpRev idp t = ap (λ x → ! x) t + → (transport (λ x → f x == g x) p q == r) → transport (λ x → g x == f x) p (! q) == ! r + transpRev idp t = ap ! t + +module _ {i j k} {A : Type i} {B : Type j} {C : Type k} (f : A → B) (h : C → A) (g : C → B) where + + transp-pth-cmpL : {x y : C} (p : x == y) (q : f (h x) == g x) + → transport (λ z → f (h z) == g z) p q == ! (ap f (ap h p)) ∙ q ∙ ap g p + transp-pth-cmpL idp q = ! (∙-unit-r q) module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} {f : C → A} {h : B → C} where @@ -534,7 +561,8 @@ module _ {i j k l} {A : Type i} {B : Type j} {f : A → B} {C : Type k} {D : Typ module _ {ℓ₁ ℓ₂} {A : Type ℓ₁} {B : A → Type ℓ₂} where - transp-id-concat : (f g : (x : A) → B x) {x y : A} (p : x == y) {c : B x} (q₁ : f x == c) (q₂ : c == g x) {r : f y == transport B p (f x)} (R : ! (apd-tr f p) == r) + transp-id-concat : (f g : (x : A) → B x) {x y : A} (p : x == y) {c : B x} (q₁ : f x == c) (q₂ : c == g x) + {r : f y == transport B p (f x)} (R : ! (apd-tr f p) == r) → transport (λ z → f z == g z) p (q₁ ∙ q₂) ◃∎ =ₛ r ◃∙ ap (transport B p) q₁ ◃∙ ap (transport B p) q₂ ◃∙ apd-tr g p ◃∎ transp-id-concat f g {x = x} idp idp q₂ idp = =ₛ-in (lemma q₂) where lemma : {a b : B x} (q : a == b) → q == ap (transport B idp) q ∙ idp @@ -606,7 +634,8 @@ module _ {i j} {A : Type i} {F : A → Type j} {γ : (x : A) → F x} {x y z : A module _ {ℓ₁ ℓ₂ ℓ₃} {A : Type ℓ₁} {B : Type ℓ₂} {C : Type ℓ₃} {g : B → A} {f : A → C} where - Δ-red : {t u : B} (v : t == u) {c : C} (R : f (g t) == c) {d : C} (σ : f (g u) == d) {z : A} (D : g t == z) {W : f z == f (g u)} (τ : W == ! (ap f (! (ap g v) ∙ D))) + Δ-red : {t u : B} (v : t == u) {c : C} (R : f (g t) == c) {d : C} (σ : f (g u) == d) {z : A} (D : g t == z) + {W : f z == f (g u)} (τ : W == ! (ap f (! (ap g v) ∙ D))) → W ∙ σ ∙ ! (! R ∙ (ap (f ∘ g) v) ∙ σ) == ! (ap f D) ∙ R Δ-red idp idp idp idp idp = idp diff --git a/HoTT-Agda/core/lib/path-seq/Rotations.agda b/HoTT-Agda/core/lib/path-seq/Rotations.agda index 9a380ca..8cba730 100644 --- a/HoTT-Agda/core/lib/path-seq/Rotations.agda +++ b/HoTT-Agda/core/lib/path-seq/Rotations.agda @@ -142,6 +142,12 @@ post-rotate'-seq-out {r = r} {p = p} {q = q} e = =ₛ⟨ =ₛ-in (ap (λ v → ↯ (p ∙∙ v)) (seq-!-seq-! q)) ⟩ p ∙∙ q ∎ₛ +post-rotate'-seq-out-idp : {a a' : A} + → {r q : a =-= a'} + → r ∙∙ seq-! q =ₛ idp ◃∎ + → r =ₛ q +post-rotate'-seq-out-idp {r = r} {q = q} e = (post-rotate'-seq-out {q = q} e) ∙ₛ =ₛ-in (↯-∙∙ (idp ◃∎) q) + post-rotate-seq-out : {a a' a'' : A} → {p : a =-= a'} {q : a' =-= a''} {r : a =-= a''} → p =ₛ r ∙∙ seq-! q diff --git a/README.md b/README.md index ccfff22..e990789 100644 --- a/README.md +++ b/README.md @@ -36,7 +36,7 @@ NOTE: We have successfully tested the following Docker container on Linux but no The building itself type checks the whole development. The type-checking is partitioned into multiple stages, for otherwise the type-checking could take an unacceptably long time. The entire build may take over an hour. - The type checking of all our Agda code takes about 36 minutes on our host Ubuntu. + The type checking of all our Agda code takes about 31 minutes on our host Ubuntu. 2. Generate HTML files: