Skip to content

Commit 071e312

Browse files
authored
Spectrum maps and fiber spectrum (#1231)
* fiber spectrum * fix whitespace * require --safe * trunc spectra too * fix whitespace
1 parent 7a6d419 commit 071e312

File tree

6 files changed

+238
-1
lines changed

6 files changed

+238
-1
lines changed

Cubical/Data/Int/Properties.agda

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1503,3 +1503,9 @@ sumFinℤ0 n = sumFinGen0 _+_ 0 (λ _ → refl) n (λ _ → 0) λ _ → refl
15031503
sumFinℤHom : {n : ℕ} (f g : Fin n ℤ)
15041504
sumFinℤ {n = n} (λ x f x + g x) ≡ sumFinℤ {n = n} f + sumFinℤ {n = n} g
15051505
sumFinℤHom {n = n} = sumFinGenHom _+_ 0 (λ _ refl) +Comm +Assoc n
1506+
1507+
{- clamp negative numbers to 0 -}
1508+
1509+
clamp :
1510+
clamp (pos n) = n
1511+
clamp (negsuc n) = zero
Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,53 @@
1+
{-# OPTIONS --safe #-}
2+
module Cubical.Foundations.Pointed.Fiber where
3+
4+
open import Cubical.Data.Sigma
5+
open import Cubical.Foundations.Equiv.Base
6+
open import Cubical.Foundations.GroupoidLaws
7+
open import Cubical.Foundations.Isomorphism
8+
open import Cubical.Foundations.Pointed
9+
open import Cubical.Foundations.Prelude
10+
11+
private variable ℓ ℓ' : Level
12+
13+
{- pointed version of fibers -}
14+
15+
fiber∙ : {A : Pointed ℓ} {B : Pointed ℓ'} (f : A →∙ B) Pointed (ℓ-max ℓ ℓ')
16+
fiber∙ {ℓ} {ℓ'} {A = A} {B} f .fst = fiber (f .fst) (B .snd)
17+
fiber∙ {ℓ} {ℓ'} {A = A} {B} f .snd = (A .snd) , f .snd
18+
19+
fiber∙-respects-∙∼ : {A : Pointed ℓ} {B : Pointed ℓ'}
20+
{f g : A →∙ B}
21+
(h : f ∙∼ g)
22+
fiber∙ f ≃∙ fiber∙ g
23+
fiber∙-respects-∙∼ {A = A} {B} {f} {g} h = isoToEquiv (iso fwd bwd sec ret) , prf where
24+
fwd : fst (fiber∙ f) fst (fiber∙ g)
25+
fwd (a , f[a]≡b₀) = a , (sym (h .fst a) ∙ f[a]≡b₀)
26+
27+
bwd : fst (fiber∙ g) fst (fiber∙ f)
28+
bwd (a , g[a]≡b₀) = a , h .fst a ∙ g[a]≡b₀
29+
30+
sec : section fwd bwd
31+
sec (a , g[a]≡b₀) = ΣPathP (refl , (
32+
sym (h .fst a) ∙ h .fst a ∙ g[a]≡b₀ ≡⟨ assoc _ _ _ ⟩
33+
(sym (h .fst a) ∙ h .fst a) ∙ g[a]≡b₀ ≡⟨ cong (_∙ g[a]≡b₀) (lCancel _) ⟩
34+
refl ∙ g[a]≡b₀ ≡⟨ sym (lUnit _) ⟩
35+
g[a]≡b₀ ∎))
36+
37+
ret : retract fwd bwd
38+
ret (a , f[a]≡b₀) = ΣPathP (refl , (
39+
h .fst a ∙ sym (h .fst a) ∙ f[a]≡b₀ ≡⟨ assoc _ _ _ ⟩
40+
(h .fst a ∙ sym (h .fst a)) ∙ f[a]≡b₀ ≡⟨ cong (_∙ f[a]≡b₀) (rCancel _) ⟩
41+
refl ∙ f[a]≡b₀ ≡⟨ sym (lUnit _) ⟩
42+
f[a]≡b₀ ∎))
43+
44+
prf : fwd (A .snd , f .snd) ≡ (A .snd , g .snd)
45+
prf = ΣPathP (refl , (
46+
sym (h .fst (A .snd)) ∙ f .snd ≡⟨ cong (λ p sym p ∙ f .snd) (h .snd) ⟩
47+
sym (f .snd ∙ sym (g .snd)) ∙ f .snd ≡⟨ cong (_∙ f .snd) (symDistr _ _) ⟩
48+
(sym (sym (g .snd)) ∙ sym (f .snd)) ∙ f .snd ≡⟨ sym (assoc _ _ _) ⟩
49+
sym (sym (g .snd)) ∙ sym (f .snd) ∙ f .snd ≡⟨ cong (sym (sym (g .snd)) ∙_) (lCancel _) ⟩
50+
sym (sym (g .snd)) ∙ refl ≡⟨ sym (rUnit _) ⟩
51+
sym (sym (g .snd)) ≡⟨ sym (symInvo _) ⟩
52+
g .snd ∎))
53+

Cubical/HITs/Truncation/Properties.agda

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ open import Cubical.Data.NatMinusOne
55
open import Cubical.HITs.Truncation.Base
66

77
open import Cubical.Foundations.Prelude
8+
open import Cubical.Foundations.Pointed
89
open import Cubical.Foundations.GroupoidLaws
910
open import Cubical.Foundations.Function
1011
open import Cubical.Foundations.Equiv
@@ -591,3 +592,29 @@ transportTrunc : {n : HLevel}{p : A ≡ B}
591592
transport (λ i hLevelTrunc n (p i)) ∣ a ∣ₕ ≡ ∣ transport (λ i p i) a ∣ₕ
592593
transportTrunc {n = zero} a = refl
593594
transportTrunc {n = suc n} a = refl
595+
596+
{- pointed version of truncation -}
597+
598+
trunc-respects-≃ : {X Y : Type ℓ} (n : ℕ) (H : X ≃ Y) ∥ X ∥ n ≃ ∥ Y ∥ n
599+
trunc-respects-≃ n H = isoToEquiv (iso f g fg gf) where
600+
f = map (H .fst)
601+
g = map (invEq H)
602+
603+
fg : section f g
604+
fg x = elim (λ x isOfHLevelTruncPath {x = f (g x)} {y = x})
605+
(λ y
606+
cong f (recUniq (isOfHLevelTrunc n) (∣_∣ₕ ∘ invEq H) y)
607+
∙ recUniq (isOfHLevelTrunc n) (∣_∣ₕ ∘ H .fst) (invEq H y)
608+
∙ cong ∣_∣ₕ (secEq H y)) x
609+
610+
gf : retract f g
611+
gf x = elim (λ x isOfHLevelTruncPath {x = g (f x)} {y = x})
612+
(λ x cong g (recUniq (isOfHLevelTrunc n) (∣_∣ₕ ∘ H .fst) x)
613+
∙ recUniq (isOfHLevelTrunc n) (∣_∣ₕ ∘ invEq H) (H .fst x)
614+
∙ cong ∣_∣ₕ (retEq H x)) x
615+
616+
hLevelTrunc∙-≃ : {X Y : Pointed ℓ} (n : ℕ) (H : X ≃∙ Y) hLevelTrunc∙ n X ≃∙ hLevelTrunc∙ n Y
617+
hLevelTrunc∙-≃ {X = X} {Y} n H = (trunc-respects-≃ n (H .fst)) , prf X Y n H where
618+
prf : (X Y : Pointed ℓ) (n : ℕ) (H : X ≃∙ Y) fst (trunc-respects-≃ n (H .fst)) (pt (hLevelTrunc∙ n X)) ≡ pt (hLevelTrunc∙ n Y)
619+
prf X Y zero H = refl
620+
prf X Y (suc n) H = cong ∣_∣ₕ (H .snd)

Cubical/Homotopy/Spectrum.agda

Lines changed: 24 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,20 +5,43 @@
55
module Cubical.Homotopy.Spectrum where
66

77
open import Cubical.Foundations.Prelude
8+
open import Cubical.Foundations.Pointed
89
open import Cubical.Data.Unit.Pointed
910
open import Cubical.Foundations.Equiv
11+
open import Cubical.Structures.Successor
1012

1113
open import Cubical.Data.Int
1214

1315
open import Cubical.Homotopy.Prespectrum
16+
open import Cubical.Homotopy.Loopspace
1417

1518
private
1619
variable
17-
: Level
20+
ℓ' : Level
1821

1922
record Spectrum (ℓ : Level) : Type (ℓ-suc ℓ) where
2023
open GenericPrespectrum
2124
field
2225
prespectrum : Prespectrum ℓ
2326
equiv : (k : ℤ) isEquiv (fst (map prespectrum k))
2427
open GenericPrespectrum prespectrum public
28+
29+
open Spectrum
30+
open GenericPrespectrum
31+
32+
module _ where
33+
open SuccStr ℤ+
34+
35+
mkSpectrum : (X : Index Pointed ℓ') (e : (n : Index) X n ≃∙ Ω (X (succ n))) Spectrum ℓ'
36+
mkSpectrum {ℓ'} X e .prespectrum .space = X
37+
mkSpectrum {ℓ'} X e .prespectrum .map n = ≃∙map (e n)
38+
mkSpectrum {ℓ'} X e .equiv n = e n .fst .snd
39+
40+
spectrumEquiv : (E : Spectrum ℓ) (n : ℤ) E .space n ≃∙ Ω (E .space (succ n))
41+
spectrumEquiv E n = (E .map n .fst , E .equiv n) , E .map n .snd
42+
43+
isSpectrumMap : (X Y : Spectrum ℓ) (f : (n : ℤ) (X .space n →∙ Y .space n)) Type ℓ
44+
isSpectrumMap X Y f = (n : ℤ) (Y .map n ∘∙ f n) ∙∼ (Ω→ (f (sucℤ n)) ∘∙ X .map n)
45+
46+
_→Sp_ : (X Y : Spectrum ℓ) Type ℓ
47+
X →Sp Y = Σ ((n : ℤ) (X .space n →∙ Y .space n)) (isSpectrumMap X Y)
Lines changed: 88 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,88 @@
1+
{-# OPTIONS --safe #-}
2+
module Cubical.Homotopy.Spectrum.Fiber where
3+
4+
open import Cubical.Data.Int
5+
open import Cubical.Data.Sigma
6+
open import Cubical.Foundations.Equiv
7+
open import Cubical.Foundations.Function
8+
open import Cubical.Foundations.GroupoidLaws
9+
open import Cubical.Foundations.Isomorphism
10+
open import Cubical.Foundations.Pointed
11+
open import Cubical.Foundations.Pointed.Fiber
12+
open import Cubical.Foundations.Prelude
13+
open import Cubical.Foundations.Structure
14+
open import Cubical.Foundations.Univalence
15+
open import Cubical.Homotopy.Group.LES
16+
open import Cubical.Homotopy.Loopspace
17+
open import Cubical.Homotopy.Prespectrum
18+
open import Cubical.Homotopy.Spectrum
19+
20+
private variable ℓ ℓ' : Level
21+
22+
open Spectrum
23+
open GenericPrespectrum
24+
25+
module _ {X Y : Spectrum ℓ} (f : X →Sp Y) where
26+
FiberSpSpace : Pointed ℓ
27+
FiberSpSpace n = fiber∙ (f .fst n)
28+
29+
-- This is just EquivJ but the other way around
30+
EquivJ' : {ℓ ℓ' : Level} {A B : Type ℓ} (P : (B : Type ℓ) (e : A ≃ B) Type ℓ')
31+
(r : P A (idEquiv A)) (e : A ≃ B) P B e
32+
EquivJ' {A = A} {B} P r e =
33+
let r' = subst (λ z P A z) (sym pathToEquivRefl) r in
34+
let zz = J (λ B' p' P B' (pathToEquiv p')) r' (ua e) in
35+
subst (λ z P B z) (pathToEquiv-ua e) zz
36+
37+
Equiv∙J' : {ℓ ℓ' : Level} {A : Pointed ℓ} (C : (B : Pointed ℓ) A ≃∙ B Type ℓ')
38+
C A (idEquiv (fst A) , refl)
39+
{B : _} (e : A ≃∙ B) C B e
40+
Equiv∙J' {ℓ = ℓ} {ℓ'} {A} C ind {B} (e , e₀) = let
41+
ind2 =
42+
EquivJ'
43+
(λ B' e' (a' : ⟨ A ⟩) (b' : B')
44+
(p' : e' .fst a' ≡ b')
45+
(C' : (B'' : Pointed ℓ) A .fst , a' ≃∙ B'' Type ℓ')
46+
C' (A .fst , a') ((idEquiv (A .fst)) , refl)
47+
C' (B' , b') (e' , p'))
48+
(λ a' b' p' C' ind' J (λ b'' p'' C' (A .fst , b'') ((idEquiv (A .fst)) , p'')) ind' p')
49+
in ind2 e (A .snd) (B .snd) e₀ C ind
50+
51+
FiberSpMap : (n : ℤ) FiberSpSpace n ≃∙ Ω (FiberSpSpace (sucℤ n))
52+
FiberSpMap n = compEquiv∙ fib[fn]≡fib[Ωfn+1] Ωfib[fn+1]≡fib[Ωfn+1] where
53+
preEquivFiber : {ℓ : Level} {A B C : Pointed ℓ} (e : A ≃∙ B) (f : B →∙ C) fiber∙ f ≃∙ fiber∙ (f ∘∙ ≃∙map e)
54+
preEquivFiber {A = A} {B} {C} e∙ @ (e , e₀) f∙ @ (f , f₀) =
55+
Equiv∙J' (λ B' e' (f' : B' →∙ C) fiber∙ f' ≃∙ fiber∙ (f' ∘∙ ≃∙map e')) reflCase e∙ f∙ where
56+
reflCase : (f' : (fst A , A .snd) →∙ C) fiber∙ f' ≃∙ fiber∙ (f' ∘∙ ≃∙map (idEquiv (fst A) , refl))
57+
reflCase f' .fst = isoToEquiv (iso (idfun _) (idfun _) (λ _ refl) (λ _ refl))
58+
reflCase f' .snd = ΣPathP (refl , (lUnit _))
59+
60+
postEquivFiber : {ℓ : Level} {A B C : Pointed ℓ} (f : A →∙ B) (e : B ≃∙ C) fiber∙ f ≃∙ fiber∙ (≃∙map e ∘∙ f)
61+
postEquivFiber {A = A} {B} {C} f∙ @ (f , f₀) e∙ @ (e , e₀) =
62+
Equiv∙J (λ B' e' (f' : A →∙ B') fiber∙ f' ≃∙ fiber∙ (≃∙map e' ∘∙ f')) reflCase e∙ f∙ where
63+
reflCase : (f' : A →∙ C) fiber∙ f' ≃∙ fiber∙ (≃∙map (idEquiv (fst C) , refl) ∘∙ f')
64+
reflCase f' .fst = isoToEquiv (iso (idfun _) (idfun _) (λ _ refl) (λ _ refl))
65+
reflCase f' .snd = ΣPathP (refl , rUnit (f' .snd))
66+
67+
fib[fn]≡fib[Ωfn+1] : fiber∙ (f .fst n) ≃∙ fiber∙ (Ω→ (f .fst (sucℤ n)))
68+
fib[fn]≡fib[Ωfn+1] = compEquiv∙ seg1 (compEquiv∙ seg2 (invEquiv∙ seg3)) where
69+
seg1 : fiber∙ (f .fst n) ≃∙ fiber∙ (≃∙map (spectrumEquiv Y n) ∘∙ f .fst n)
70+
seg1 = postEquivFiber (f .fst n) (spectrumEquiv Y n)
71+
72+
seg3 : fiber∙ (Ω→ (f .fst (sucℤ n))) ≃∙ fiber∙ (Ω→ (f .fst (sucℤ n)) ∘∙ ≃∙map (spectrumEquiv X n))
73+
seg3 = preEquivFiber (spectrumEquiv X n) (Ω→ (f .fst (sucℤ n)))
74+
75+
pathToEquiv∙ : {A B : Pointed ℓ} (A ≡ B) A ≃∙ B
76+
pathToEquiv∙ p .fst = pathToEquiv (cong fst p)
77+
pathToEquiv∙ p .snd = fromPathP (cong snd p)
78+
79+
seg2 : fiber∙ (≃∙map (spectrumEquiv Y n) ∘∙ f .fst n) ≃∙ fiber∙ (Ω→ (f .fst (sucℤ n)) ∘∙ ≃∙map (spectrumEquiv X n))
80+
seg2 = fiber∙-respects-∙∼ (f .snd n)
81+
82+
Ωfib[fn+1]≡fib[Ωfn+1] : fiber∙ (Ω→ (f .fst (sucℤ n))) ≃∙ Ω (FiberSpSpace (sucℤ n))
83+
Ωfib[fn+1]≡fib[Ωfn+1] = invEquiv∙ ((isoToEquiv (ΩFibreIso (f .fst (sucℤ n)))) , ΩFibreIso∙ (f .fst (sucℤ n)))
84+
85+
FiberSp : Spectrum ℓ
86+
FiberSp .prespectrum .space = FiberSpSpace
87+
FiberSp .prespectrum .map n = ≃∙map (FiberSpMap n)
88+
FiberSp .equiv n = FiberSpMap n .fst .snd
Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
{-# OPTIONS --safe #-}
2+
module Cubical.Homotopy.Spectrum.Truncation where
3+
4+
open import Cubical.Data.Int
5+
open import Cubical.Data.Nat
6+
open import Cubical.Data.Unit
7+
open import Cubical.Foundations.Equiv
8+
open import Cubical.Foundations.Function
9+
open import Cubical.Foundations.HLevels
10+
open import Cubical.Foundations.Isomorphism
11+
open import Cubical.Foundations.Pointed
12+
open import Cubical.Foundations.Prelude
13+
open import Cubical.HITs.Truncation as T
14+
open import Cubical.Homotopy.Loopspace
15+
open import Cubical.Homotopy.Prespectrum
16+
open import Cubical.Homotopy.Spectrum
17+
18+
private variable ℓ ℓ' : Level
19+
20+
open Spectrum
21+
open GenericPrespectrum
22+
23+
hLevelTrunc∙-Ω-zero : (X : Pointed ℓ) Ω (hLevelTrunc∙ zero X) ≃∙ hLevelTrunc∙ zero (Ω X)
24+
hLevelTrunc∙-Ω-zero X .fst = isContr→≃Unit* (isContr→isContrPath isContrUnit* tt* tt*)
25+
hLevelTrunc∙-Ω-zero X .snd = refl
26+
27+
hLevelTrunc∙-Ω-suc : (X : Pointed ℓ) (n : ℕ) Ω (hLevelTrunc∙ (suc n) X) ≃∙ hLevelTrunc∙ n (Ω X)
28+
hLevelTrunc∙-Ω-suc X n .fst = isoToEquiv (T.PathIdTruncIso n)
29+
hLevelTrunc∙-Ω-suc X zero .snd = refl
30+
hLevelTrunc∙-Ω-suc X (suc n) .snd = sym (T.ΩTrunc.encode-fill ∣ X .snd ∣ ∣ X .snd ∣ refl)
31+
32+
hLevelTrunc∙-≃-clamp : (X : Pointed ℓ) (k : ℤ) Ω (hLevelTrunc∙ (clamp (sucℤ k)) X) ≃∙ hLevelTrunc∙ (clamp k) (Ω X)
33+
hLevelTrunc∙-≃-clamp X (pos n) = hLevelTrunc∙-Ω-suc X n
34+
hLevelTrunc∙-≃-clamp X (negsuc zero) = hLevelTrunc∙-Ω-zero X
35+
hLevelTrunc∙-≃-clamp X (negsuc (suc n)) = hLevelTrunc∙-Ω-zero X
36+
37+
∥_∥ₛ : (n : ℤ) (E : Spectrum ℓ) Spectrum ℓ
38+
∥_∥ₛ n E = mkSpectrum
39+
(λ x hLevelTrunc∙ (clamp x) (E .space x))
40+
(λ x compEquiv∙ (hLevelTrunc∙-≃ (clamp x) (spectrumEquiv E x)) (invEquiv∙ (hLevelTrunc∙-≃-clamp (E .space (sucℤ x)) x)))

0 commit comments

Comments
 (0)