diff --git a/Cubical.Algebra.AbGroup.Base.html b/Cubical.Algebra.AbGroup.Base.html index 092d5e13c5..c859e5f451 100644 --- a/Cubical.Algebra.AbGroup.Base.html +++ b/Cubical.Algebra.AbGroup.Base.html @@ -346,9 +346,9 @@ isAbGroup (snd HomGroup) = makeIsAbGroup isSetGroupHom - (λ { (f , p) (g , q) (h , r) → Σ≡Prop (λ _ → isPropIsGroupHom _ _) + (λ { (f , p) (g , q) (h , r) → Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt λ x → +AssocB _ _ _) }) - (λ { (f , p) → Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt λ y → +IdRB _)}) - ((λ { (f , p) → Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt λ y → +InvRB _)})) - (λ { (f , p) (g , q) → Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt λ x → +CommB _ _)}) + (λ { (f , p) → Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt λ y → +IdRB _)}) + ((λ { (f , p) → Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt λ y → +InvRB _)})) + (λ { (f , p) (g , q) → Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt λ x → +CommB _ _)}) \ No newline at end of file diff --git a/Cubical.Algebra.AbGroup.TensorProduct.html b/Cubical.Algebra.AbGroup.TensorProduct.html index e2da4ee854..511d1e67e9 100644 --- a/Cubical.Algebra.AbGroup.TensorProduct.html +++ b/Cubical.Algebra.AbGroup.TensorProduct.html @@ -298,7 +298,7 @@ ∙ IsGroupHom.pres· q _ _ snd (tensorFun A B T C (f , p) (g , q)) = makeIsGroupHom - λ x y → Σ≡Prop (λ _ → isPropIsGroupHom _ _) + λ x y → Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt λ b → cong g (funExt⁻ (cong fst (IsGroupHom.pres· p x y)) b) ∙ IsGroupHom.pres· q _ _) @@ -333,7 +333,7 @@ fst (fst mainF a) b = a ⊗ b snd (fst mainF a) = makeIsGroupHom (⊗DistR+⊗ a) snd mainF = makeIsGroupHom - λ x y → Σ≡Prop (λ _ → isPropIsGroupHom _ _) + λ x y → Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt (⊗DistL+⊗ x y)) isTensorProduct⨂ : (isTensorProductOf AGr and BGr) (AGr ⨂ BGr) @@ -361,10 +361,10 @@ (GroupHom (AGr *) (HomGroup (BGr *) C *)) Iso.fun mainIso = _ Iso.inv mainIso = invF - Iso.rightInv mainIso (f , p) = Σ≡Prop (λ _ → isPropIsGroupHom _ _) - (funExt λ a → Σ≡Prop (λ _ → isPropIsGroupHom _ _) refl) + Iso.rightInv mainIso (f , p) = Σ≡Prop (λ _ → isPropIsGroupHom _ _) + (funExt λ a → Σ≡Prop (λ _ → isPropIsGroupHom _ _) refl) Iso.leftInv mainIso (f , p) = - Σ≡Prop (λ _ → isPropIsGroupHom _ _) + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt (⊗elimProp (λ _ → is-set (snd C) _ _) (λ _ _ → refl) λ x y ind1 ind2 → cong₂ (_+G_ (snd C)) ind1 ind2 @@ -537,7 +537,7 @@ ((compGroupHom (lIncl⨂ (RingStr.1r (snd G))) TensorMultHom)) idGroupHom G→G⨂G→Gₗ {G = G} = - Σ≡Prop (λ _ → isPropIsGroupHom _ _) + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt (RingStr.·IdR (snd G))) G→G⨂G→Gᵣ : {G : Ring ℓ} @@ -545,6 +545,6 @@ ((compGroupHom (rIncl⨂ (RingStr.1r (snd G))) TensorMultHom)) idGroupHom G→G⨂G→Gᵣ {G = G} = - Σ≡Prop (λ _ → isPropIsGroupHom _ _) + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt (RingStr.·IdL (snd G))) \ No newline at end of file diff --git a/Cubical.Algebra.Algebra.Base.html b/Cubical.Algebra.Algebra.Base.html index 3f04428fc6..f3ffa17570 100644 --- a/Cubical.Algebra.Algebra.Base.html +++ b/Cubical.Algebra.Algebra.Base.html @@ -236,7 +236,7 @@ module N = AlgebraStr (str N) AlgebraHom≡ : {φ ψ : AlgebraHom A B} → fst φ ≡ fst ψ → φ ≡ ψ -AlgebraHom≡ = Σ≡Prop λ f → isPropIsAlgebraHom _ _ f _ +AlgebraHom≡ = Σ≡Prop λ f → isPropIsAlgebraHom _ _ f _ 𝒮ᴰ-Algebra : (R : Ring ℓ) → DUARel (𝒮-Univ ℓ') (AlgebraStr R) (ℓ-max ℓ ℓ') 𝒮ᴰ-Algebra R = diff --git a/Cubical.Algebra.Algebra.Properties.html b/Cubical.Algebra.Algebra.Properties.html index b9bd9cc2d6..ed7fe459ec 100644 --- a/Cubical.Algebra.Algebra.Properties.html +++ b/Cubical.Algebra.Algebra.Properties.html @@ -178,11 +178,11 @@ fun isoOnHoms g = g ∘a AlgebraEquiv→AlgebraHom f inv isoOnHoms h = h ∘a AlgebraEquiv→AlgebraHom f⁻¹ rightInv isoOnHoms h = - Σ≡Prop + Σ≡Prop (λ h → isPropIsAlgebraHom _ (A .snd) h (C .snd)) (isoOnTypes .rightInv (h .fst)) leftInv isoOnHoms g = - Σ≡Prop + Σ≡Prop (λ g → isPropIsAlgebraHom _ (B .snd) g (C .snd)) (isoOnTypes .leftInv (g .fst)) @@ -221,7 +221,7 @@ ∙∙ transportTransport⁻ (ua (Algebra≡ A B)) q where helper : transport (sym (ua (Algebra≡ A B))) p ≡ transport (sym (ua (Algebra≡ A B))) q - helper = Σ≡Prop + helper = Σ≡Prop (λ _ → isPropΣ (isOfHLevelPathP' 1 (is-set (snd B)) _ _) λ _ → isPropΣ (isOfHLevelPathP' 1 (is-set (snd B)) _ _) diff --git a/Cubical.Algebra.Algebra.Subalgebra.html b/Cubical.Algebra.Algebra.Subalgebra.html index a21e73513b..325392c567 100644 --- a/Cubical.Algebra.Algebra.Subalgebra.html +++ b/Cubical.Algebra.Algebra.Subalgebra.html @@ -57,7 +57,7 @@ private module algStr = AlgebraStr Subalgebra→Algebra≡ : {x y : Σ[ a ∈ ⟨ A ⟩ ] a ∈ S} → fst x ≡ fst y → x ≡ y - Subalgebra→Algebra≡ eq = Σ≡Prop (∈-isProp S) eq + Subalgebra→Algebra≡ eq = Σ≡Prop (∈-isProp S) eq Subalgebra→Algebra : Algebra R ℓ' Subalgebra→Algebra .fst = Σ[ a ∈ ⟨ A ⟩ ] a ∈ S diff --git a/Cubical.Algebra.CommAlgebra.FPAlgebra.Base.html b/Cubical.Algebra.CommAlgebra.FPAlgebra.Base.html index efa3f282d2..a42f92aa54 100644 --- a/Cubical.Algebra.CommAlgebra.FPAlgebra.Base.html +++ b/Cubical.Algebra.CommAlgebra.FPAlgebra.Base.html @@ -170,7 +170,7 @@ universal = (inducedHom , inducedHomOnGenerators) , λ {(f , mapsValues) - → Σ≡Prop (λ _ → isPropΠ (λ _ → is-set _ _)) + → Σ≡Prop (λ _ → isPropΠ (λ _ → is-set _ _)) (unique f mapsValues)} where open CommAlgebraStr (str A) @@ -216,7 +216,7 @@ Iso.fun FPHomIso = evaluateAtFP Iso.inv FPHomIso = inducedHomFP _ Iso.rightInv (FPHomIso {A}) = - λ b → Σ≡Prop + λ b → Σ≡Prop (λ x → isPropΠ (λ i → is-set (evPoly A (relation i) x) @@ -225,7 +225,7 @@ where open CommAlgebraStr (str A) Iso.leftInv (FPHomIso {A}) = - λ a → Σ≡Prop (λ f → isPropIsCommAlgebraHom {ℓ} {R} {ℓ} {ℓ} {FPAlgebra} {A} f) + λ a → Σ≡Prop (λ f → isPropIsCommAlgebraHom {ℓ} {R} {ℓ} {ℓ} {FPAlgebra} {A} f) λ i → fst (unique A (fst (evaluateAtFP {A} a)) (snd (evaluateAtFP a)) diff --git a/Cubical.Algebra.CommAlgebra.FreeCommAlgebra.Properties.html b/Cubical.Algebra.CommAlgebra.FreeCommAlgebra.Properties.html index 1a74889121..5dd6865fe0 100644 --- a/Cubical.Algebra.CommAlgebra.FreeCommAlgebra.Properties.html +++ b/Cubical.Algebra.CommAlgebra.FreeCommAlgebra.Properties.html @@ -27,7 +27,7 @@ open import Cubical.Foundations.Function hiding (const) open import Cubical.Foundations.Isomorphism -open import Cubical.Data.Sigma.Properties using (Σ≡Prop) +open import Cubical.Data.Sigma.Properties using (Σ≡Prop) open import Cubical.HITs.SetTruncation open import Cubical.Algebra.CommRing @@ -282,7 +282,7 @@ Iso.inv (homMapIso A) = inducedHom A Iso.rightInv (homMapIso A) = λ ϕ → Theory.mapRetrievable A ϕ Iso.leftInv (homMapIso {R = R} {I = I} A) = - λ f → Σ≡Prop (λ f → isPropIsCommAlgebraHom {M = R [ I ]} {N = A} f) + λ f → Σ≡Prop (λ f → isPropIsCommAlgebraHom {M = R [ I ]} {N = A} f) (Theory.homRetrievable A f) inducedHomUnique : @@ -379,7 +379,7 @@ from-to : (x : _) → from (to x) ≡ x from-to x = - Σ≡Prop (λ f → isPropIsCommAlgebraHom {M = R [ ⊥ ]} {N = B} f) + Σ≡Prop (λ f → isPropIsCommAlgebraHom {M = R [ ⊥ ]} {N = B} f) (Theory.homRetrievable B x) equiv : CommAlgebraHom (R [ ⊥ ]) B ≃ (⊥ → fst B) diff --git a/Cubical.Algebra.CommAlgebra.Instances.Initial.html b/Cubical.Algebra.CommAlgebra.Instances.Initial.html index 81f0db09e9..6fde132343 100644 --- a/Cubical.Algebra.CommAlgebra.Instances.Initial.html +++ b/Cubical.Algebra.CommAlgebra.Instances.Initial.html @@ -7,7 +7,7 @@ open import Cubical.Foundations.Isomorphism open import Cubical.Data.Unit -open import Cubical.Data.Sigma.Properties using (Σ≡Prop) +open import Cubical.Data.Sigma.Properties using (Σ≡Prop) open import Cubical.Algebra.CommRing open import Cubical.Algebra.Ring @@ -72,7 +72,7 @@ → f ≡ initialMap initialMapEq f = let open IsAlgebraHom (snd f) - in Σ≡Prop + in Σ≡Prop (isPropIsCommAlgebraHom {M = initialCAlg} {N = A}) λ i x → ((fst f) x ≡⟨ cong (fst f) (sym (·IdR _)) ⟩ diff --git a/Cubical.Algebra.CommAlgebra.Instances.Unit.html b/Cubical.Algebra.CommAlgebra.Instances.Unit.html index 33f8db9455..c7249d7fae 100644 --- a/Cubical.Algebra.CommAlgebra.Instances.Unit.html +++ b/Cubical.Algebra.CommAlgebra.Instances.Unit.html @@ -7,7 +7,7 @@ open import Cubical.Foundations.Structure open import Cubical.Data.Unit -open import Cubical.Data.Sigma.Properties using (Σ≡Prop) +open import Cubical.Data.Sigma.Properties using (Σ≡Prop) open import Cubical.Algebra.CommRing open import Cubical.Algebra.CommAlgebra.Base @@ -42,7 +42,7 @@ terminalityContr : isContr (CommAlgebraHom A UnitCommAlgebra) terminalityContr = terminalMap , path where path : (ϕ : CommAlgebraHom A UnitCommAlgebra) → terminalMap ≡ ϕ - path ϕ = Σ≡Prop (isPropIsCommAlgebraHom {M = A} {N = UnitCommAlgebra}) + path ϕ = Σ≡Prop (isPropIsCommAlgebraHom {M = A} {N = UnitCommAlgebra}) λ i _ → isPropUnit* _ _ i open CommAlgebraStr (snd A) diff --git a/Cubical.Algebra.CommAlgebra.Localisation.html b/Cubical.Algebra.CommAlgebra.Localisation.html index 331cb1b55e..f2260cff16 100644 --- a/Cubical.Algebra.CommAlgebra.Localisation.html +++ b/Cubical.Algebra.CommAlgebra.Localisation.html @@ -73,7 +73,7 @@ S⋆1⊆S⁻¹Rˣ : ∀ s → s ∈ S' → _⋆_ (snd S⁻¹RAsCommAlg) s (1a (snd S⁻¹RAsCommAlg)) ∈ S⁻¹Rˣ S⋆1⊆S⁻¹Rˣ s s∈S' = subst-∈ S⁻¹Rˣ - (cong [_] (≡-× (sym (·rRid s)) (Σ≡Prop (λ x → S' x .snd) (sym (·rRid _))))) + (cong [_] (≡-× (sym (·rRid s)) (Σ≡Prop (λ x → S' x .snd) (sym (·rRid _))))) (S/1⊆S⁻¹Rˣ s s∈S') @@ -109,7 +109,7 @@ χᴬuniqueness : (ψ : CommAlgebraHom S⁻¹RAsCommAlg B') → χᴬ ≡ ψ - χᴬuniqueness ψ = Σ≡Prop (λ _ → isPropIsAlgebraHom _ _ _ _) + χᴬuniqueness ψ = Σ≡Prop (λ _ → isPropIsAlgebraHom _ _ _ _) (cong (fst ∘ fst) (χuniqueness (ψ' , funExt ψ'r/1≡φr))) where χuniqueness = S⁻¹RHasUniversalProp B φ S⋆1⊆Bˣ .snd @@ -228,7 +228,7 @@ pres⋆ (snd center) = pres⋆ (snd χ₁) uniqueness : (φ : CommAlgebraEquiv S₁⁻¹RAsCommAlg S₂⁻¹RAsCommAlg) → center ≡ φ - uniqueness φ = Σ≡Prop (λ _ → isPropIsAlgebraHom _ _ _ _) + uniqueness φ = Σ≡Prop (λ _ → isPropIsAlgebraHom _ _ _ _) (equivEq (cong fst (S₁⁻¹RHasAlgUniversalProp S₂⁻¹RAsCommAlg S₁⊆S₂⁻¹Rˣ .snd (AlgebraEquiv→AlgebraHom φ)))) diff --git a/Cubical.Algebra.CommAlgebra.LocalisationAlgebra.html b/Cubical.Algebra.CommAlgebra.LocalisationAlgebra.html index 11df6d4a68..4e7a3cb2b6 100644 --- a/Cubical.Algebra.CommAlgebra.LocalisationAlgebra.html +++ b/Cubical.Algebra.CommAlgebra.LocalisationAlgebra.html @@ -163,7 +163,7 @@ (λ i → CommRingHom Aᵣ (S⁻¹AAsCommAlgebra→CommRing i)) (CommAlgebraHom→CommRingHom A S⁻¹AAsCommAlgebra /1AsCommAlgebraHom) RUniv./1AsCommRingHom - /1AsCommAlgebraHom→CommRingHom = ΣPathPProp (λ f → isPropIsRingHom _ f _) + /1AsCommAlgebraHom→CommRingHom = ΣPathPProp (λ f → isPropIsRingHom _ f _) (λ i → RUniv._/1) S⁻¹AHasUniversalProp : hasLocUniversalProp S⁻¹AAsCommAlgebra @@ -253,7 +253,7 @@ (fst φ) ∘ RUniv._/1 ≡ (fst ψ)) → (χₐ , χₐcomm) ≡ el χₐunique (φ' , φ'comm) = - Σ≡Prop ((λ _ → isSetΠ (λ _ → is-set) _ _)) $ AlgebraHom≡ $ + Σ≡Prop ((λ _ → isSetΠ (λ _ → is-set) _ _)) $ AlgebraHom≡ $ cong (fst ∘ fst) -- Get underlying bare function. (univ .snd (CommAlgebraHom→RingHom {A = S⁻¹AAsCommAlgebra} {B = B} φ' , φ'comm)) diff --git a/Cubical.Algebra.CommAlgebra.Properties.html b/Cubical.Algebra.CommAlgebra.Properties.html index 2ddc697031..80975b9b60 100644 --- a/Cubical.Algebra.CommAlgebra.Properties.html +++ b/Cubical.Algebra.CommAlgebra.Properties.html @@ -266,7 +266,7 @@ ∙∙ transportTransport⁻ (ua (CommAlgebra≡ A B)) q where helper : transport (sym (ua (CommAlgebra≡ A B))) p ≡ transport (sym (ua (CommAlgebra≡ A B))) q - helper = Σ≡Prop + helper = Σ≡Prop (λ _ → isPropΣ (isOfHLevelPathP' 1 (is-set (snd B)) _ _) λ _ → isPropΣ (isOfHLevelPathP' 1 (is-set (snd B)) _ _) @@ -307,8 +307,8 @@ ---------------------------------------------------------------------------- → ∀ x y → isContr (CommAlgebraEquiv (σ x) (σ y)) contrCommAlgebraHom→contrCommAlgebraEquiv σ contrHom x y = σEquiv , - λ e → Σ≡Prop (λ _ → isPropIsAlgebraHom _ _ _ _) - (Σ≡Prop isPropIsEquiv (cong fst (contrHom _ _ .snd (CommAlgebraEquiv→CommAlgebraHom e)))) + λ e → Σ≡Prop (λ _ → isPropIsAlgebraHom _ _ _ _) + (Σ≡Prop isPropIsEquiv (cong fst (contrHom _ _ .snd (CommAlgebraEquiv→CommAlgebraHom e)))) where open Iso χ₁ = contrHom x y .fst @@ -380,5 +380,5 @@ pbSliceHom : Σ[ k ∈ CommRingHom (CommAlgebra→CommRing A) (CommAlgebra→CommRing B) ] k ∘r ((snd homA) ∘r f) ≡ ((snd homB) ∘r f) - pbSliceHom = fst asSliceHom , Σ≡Prop (λ _ → isPropIsRingHom _ _ _) λ i x → fst ((snd asSliceHom) i) (fst f x) + pbSliceHom = fst asSliceHom , Σ≡Prop (λ _ → isPropIsRingHom _ _ _) λ i x → fst ((snd asSliceHom) i) (fst f x) \ No newline at end of file diff --git a/Cubical.Algebra.CommAlgebra.QuotientAlgebra.html b/Cubical.Algebra.CommAlgebra.QuotientAlgebra.html index f2a5112b9c..6f738929f6 100644 --- a/Cubical.Algebra.CommAlgebra.QuotientAlgebra.html +++ b/Cubical.Algebra.CommAlgebra.QuotientAlgebra.html @@ -10,7 +10,7 @@ open import Cubical.HITs.SetQuotients hiding (_/_) open import Cubical.Data.Unit -open import Cubical.Data.Sigma.Properties using (Σ≡Prop) +open import Cubical.Data.Sigma.Properties using (Σ≡Prop) open import Cubical.Algebra.CommRing import Cubical.Algebra.CommRing.Quotient as CommRing @@ -149,13 +149,13 @@ pres⋆ (snd inducedHom) = λ r → elimProp (λ _ → is-set _ _) (pres⋆ (snd ϕ) r) inducedHom∘quotientHom : inducedHom ∘a quotientHom A I ≡ ϕ - inducedHom∘quotientHom = Σ≡Prop (isPropIsCommAlgebraHom {M = A} {N = B}) (funExt (λ a → refl)) + inducedHom∘quotientHom = Σ≡Prop (isPropIsCommAlgebraHom {M = A} {N = B}) (funExt (λ a → refl)) injectivePrecomp : (B : CommAlgebra R ℓ) (f g : CommAlgebraHom (A / I) B) → f ∘a (quotientHom A I) ≡ g ∘a (quotientHom A I) → f ≡ g injectivePrecomp B f g p = - Σ≡Prop + Σ≡Prop (λ h → isPropIsCommAlgebraHom {M = A / I} {N = B} h) (descendMapPath (fst f) (fst g) is-set λ x → λ i → fst (p i) x) @@ -204,7 +204,7 @@ kernel≡I : kernel A (A / I) π ≡ I kernel≡I = - kernel A (A / I) π ≡⟨ Σ≡Prop + kernel A (A / I) π ≡⟨ Σ≡Prop (isPropIsCommIdeal (CommAlgebra→CommRing A)) refl ⟩ _ ≡⟨ CommRing.kernel≡I {R = CommAlgebra→CommRing A} I ⟩ diff --git a/Cubical.Algebra.CommAlgebra.UnivariatePolyList.html b/Cubical.Algebra.CommAlgebra.UnivariatePolyList.html index 5346305cd2..d49ab6f874 100644 --- a/Cubical.Algebra.CommAlgebra.UnivariatePolyList.html +++ b/Cubical.Algebra.CommAlgebra.UnivariatePolyList.html @@ -196,7 +196,7 @@ → fst f X ≡ x → f ≡ inducedHom inducedHomUnique f fX≡x = - Σ≡Prop + Σ≡Prop (λ _ → isPropIsAlgebraHom _ _ _ _) λ i p → pwEq p i where @@ -227,7 +227,7 @@ fst (fst (equiv-proof (snd indcuedHomEquivalence) x)) = inducedHom x snd (fst (equiv-proof (snd indcuedHomEquivalence) x)) = inducedMapGenerator x snd (equiv-proof (snd indcuedHomEquivalence) x) (g , gX≡x) = - Σ≡Prop (λ _ → is-set _ _) (sym (inducedHomUnique x g gX≡x)) + Σ≡Prop (λ _ → is-set _ _) (sym (inducedHomUnique x g gX≡x)) equalByUMP : (f g : AlgebraHom (CommAlgebra→Algebra ListPolyCommAlgebra) A) → fst f X ≡ fst g X diff --git a/Cubical.Algebra.CommMonoid.GrothendieckGroup.html b/Cubical.Algebra.CommMonoid.GrothendieckGroup.html index c5bf2d80e9..7ad4c120e0 100644 --- a/Cubical.Algebra.CommMonoid.GrothendieckGroup.html +++ b/Cubical.Algebra.CommMonoid.GrothendieckGroup.html @@ -29,7 +29,7 @@ module _ (M : CommMonoid ℓ) where - open BinaryRelation + open BinaryRelation M² : CommMonoid _ M² = CommMonoidProd M M @@ -53,7 +53,7 @@ _+/_ : M²/R → M²/R → M²/R x +/ y = setQuotBinOp isReflR isReflR _·_ isCongR x y where - isReflR : isRefl R + isReflR : isRefl R isReflR (a , b) = ε , cong (ε ·_) (·Comm a b) isCongR : ∀ u u' v v' → R u u' → R v v' → R (u · v) (u' · v') diff --git a/Cubical.Algebra.CommMonoid.Properties.html b/Cubical.Algebra.CommMonoid.Properties.html index e31d1a7afb..0691aadde4 100644 --- a/Cubical.Algebra.CommMonoid.Properties.html +++ b/Cubical.Algebra.CommMonoid.Properties.html @@ -35,11 +35,11 @@ IsCommMonoid.isMonoid (CommMonoidStr.isCommMonoid (snd makeSubCommMonoid)) = makeIsMonoid (isOfHLevelΣ 2 is-set λ _ → isProp→isSet (snd (P _))) - (λ x y z → Σ≡Prop (λ _ → snd (P _)) (·Assoc (fst x) (fst y) (fst z))) - (λ x → Σ≡Prop (λ _ → snd (P _)) (·IdR (fst x))) - λ x → Σ≡Prop (λ _ → snd (P _)) (·IdL (fst x)) + (λ x y z → Σ≡Prop (λ _ → snd (P _)) (·Assoc (fst x) (fst y) (fst z))) + (λ x → Σ≡Prop (λ _ → snd (P _)) (·IdR (fst x))) + λ x → Σ≡Prop (λ _ → snd (P _)) (·IdL (fst x)) IsCommMonoid.·Comm (CommMonoidStr.isCommMonoid (snd makeSubCommMonoid)) = - λ x y → Σ≡Prop (λ _ → snd (P _)) (·Comm (fst x) (fst y)) + λ x y → Σ≡Prop (λ _ → snd (P _)) (·Comm (fst x) (fst y)) module CommMonoidTheory (M' : CommMonoid ℓ) where open CommMonoidStr (snd M') diff --git a/Cubical.Algebra.CommRing.Base.html b/Cubical.Algebra.CommRing.Base.html index f473648543..9ff4481abd 100644 --- a/Cubical.Algebra.CommRing.Base.html +++ b/Cubical.Algebra.CommRing.Base.html @@ -166,7 +166,7 @@ fst (inv (CommRingEquivIsoCommRingIso R S) e) = isoToEquiv (e .fst) snd (inv (CommRingEquivIsoCommRingIso R S) e) = e .snd rightInv (CommRingEquivIsoCommRingIso R S) (e , he) = - Σ≡Prop (λ e → isPropIsRingHom (snd (CommRing→Ring R)) (e .fun) (snd (CommRing→Ring S))) + Σ≡Prop (λ e → isPropIsRingHom (snd (CommRing→Ring R)) (e .fun) (snd (CommRing→Ring S))) rem where rem : equivToIso (isoToEquiv e) ≡ e @@ -175,7 +175,7 @@ rightInv (rem i) b j = CommRingStr.is-set (snd S) (fun e (inv e b)) b (rightInv e b) (rightInv e b) i j leftInv (rem i) a j = CommRingStr.is-set (snd R) (inv e (fun e a)) a (retEq (isoToEquiv e) a) (leftInv e a) i j leftInv (CommRingEquivIsoCommRingIso R S) e = - Σ≡Prop (λ e → isPropIsRingHom (snd (CommRing→Ring R)) (e .fst) (snd (CommRing→Ring S))) + Σ≡Prop (λ e → isPropIsRingHom (snd (CommRing→Ring R)) (e .fst) (snd (CommRing→Ring S))) (equivEq refl) isGroupoidCommRing : isGroupoid (CommRing ℓ) diff --git a/Cubical.Algebra.CommRing.FiberedProduct.html b/Cubical.Algebra.CommRing.FiberedProduct.html index 330315dea1..7bf63b6aee 100644 --- a/Cubical.Algebra.CommRing.FiberedProduct.html +++ b/Cubical.Algebra.CommRing.FiberedProduct.html @@ -31,7 +31,7 @@ fbT = Σ[ ab ∈ fst A × fst B ] (fst α (fst ab) ≡ fst β (snd ab)) fbT≡ : {x y : fbT} → fst (fst x) ≡ fst (fst y) → snd (fst x) ≡ snd (fst y) → x ≡ y - fbT≡ h1 h2 = Σ≡Prop (λ _ → is-set (snd C) _ _) λ i → (h1 i) , (h2 i) + fbT≡ h1 h2 = Σ≡Prop (λ _ → is-set (snd C) _ _) λ i → (h1 i) , (h2 i) 0fbT : fbT 0fbT = (A.0r , B.0r) , α.pres0 ∙ sym β.pres0 diff --git a/Cubical.Algebra.CommRing.Ideal.Base.html b/Cubical.Algebra.CommRing.Ideal.Base.html index 7047bfce4e..b9f39424ff 100644 --- a/Cubical.Algebra.CommRing.Ideal.Base.html +++ b/Cubical.Algebra.CommRing.Ideal.Base.html @@ -79,7 +79,7 @@ subst-∈ I = subst-∈p (I .fst) CommIdeal≡Char : {I J : CommIdeal} → I ⊆ J → J ⊆ I → I ≡ J - CommIdeal≡Char I⊆J J⊆I = Σ≡Prop isPropIsCommIdeal (⊆-extensionality _ _ (I⊆J , J⊆I)) + CommIdeal≡Char I⊆J J⊆I = Σ≡Prop isPropIsCommIdeal (⊆-extensionality _ _ (I⊆J , J⊆I)) -Closed : (I : CommIdeal) (x : R) → x ∈ I → (- x) ∈ I diff --git a/Cubical.Algebra.CommRing.Ideal.SurjectiveImage.html b/Cubical.Algebra.CommRing.Ideal.SurjectiveImage.html index 5d96487e66..508c092692 100644 --- a/Cubical.Algebra.CommRing.Ideal.SurjectiveImage.html +++ b/Cubical.Algebra.CommRing.Ideal.SurjectiveImage.html @@ -21,7 +21,7 @@ ℓ : Level imageIdeal : {R S : CommRing ℓ} - (f : CommRingHom R S) (f-epi : isSurjection (fst f)) + (f : CommRingHom R S) (f-epi : isSurjection (fst f)) (I : IdealsIn R) → IdealsIn S imageIdeal f f-epi I = Ideal→CommIdeal (Ring.imageIdeal f f-epi (CommIdeal→Ideal I)) diff --git a/Cubical.Algebra.CommRing.Localisation.Base.html b/Cubical.Algebra.CommRing.Localisation.Base.html index 64c3bc932e..4813beab98 100644 --- a/Cubical.Algebra.CommRing.Localisation.Base.html +++ b/Cubical.Algebra.CommRing.Localisation.Base.html @@ -67,15 +67,15 @@ S⁻¹R = (R × S) / _≈_ -- now define addition for S⁻¹R - open BinaryRelation + open BinaryRelation - locRefl : isRefl _≈_ + locRefl : isRefl _≈_ locRefl _ = (1r , SMultClosedSubset .containsOne) , refl - locSym : isSym _≈_ + locSym : isSym _≈_ locSym (r , s , s∈S') (r' , s' , s'∈S') (u , p) = u , sym p - locTrans : isTrans _≈_ + locTrans : isTrans _≈_ locTrans (r , s , s∈S') (r' , s' , s'∈S') (r'' , s'' , s''∈S') ((u , u∈S') , p) ((v , v∈S') , q) = ((u · v · s') , SMultClosedSubset .multClosed (SMultClosedSubset .multClosed u∈S' v∈S') s'∈S') , path @@ -97,10 +97,10 @@ u · s · (v · r'' · s') ≡⟨ eq3 r s r' s' r'' s'' u v ⟩ u · v · s' · r'' · s ∎ - locIsEquivRel : isEquivRel _≈_ - isEquivRel.reflexive locIsEquivRel = locRefl - isEquivRel.symmetric locIsEquivRel = locSym - isEquivRel.transitive locIsEquivRel = locTrans + locIsEquivRel : isEquivRel _≈_ + isEquivRel.reflexive locIsEquivRel = locRefl + isEquivRel.symmetric locIsEquivRel = locSym + isEquivRel.transitive locIsEquivRel = locTrans _+ₗ_ : S⁻¹R → S⁻¹R → S⁻¹R _+ₗ_ = setQuotSymmBinOp locRefl locTrans _+ₚ_ @@ -112,7 +112,7 @@ +ₚ-symm : (a b : R × S) → (a +ₚ b) ≡ (b +ₚ a) +ₚ-symm (r₁ , s₁ , s₁∈S) (r₂ , s₂ , s₂∈S) = - ΣPathP (+Comm _ _ , Σ≡Prop (λ x → S' x .snd) (·Comm _ _)) + ΣPathP (+Comm _ _ , Σ≡Prop (λ x → S' x .snd) (·Comm _ _)) θ : (a a' b : R × S) → a ≈ a' → (a +ₚ b) ≈ (a' +ₚ b) θ (r₁ , s₁ , s₁∈S) (r'₁ , s'₁ , s'₁∈S) (r₂ , s₂ , s₂∈S) ((s , s∈S) , p) = (s , s∈S) , path @@ -148,7 +148,7 @@ where +ₗ-assoc[] : (a b c : R × S) → [ a ] +ₗ ([ b ] +ₗ [ c ]) ≡ ([ a ] +ₗ [ b ]) +ₗ [ c ] +ₗ-assoc[] (r , s , s∈S) (r' , s' , s'∈S) (r'' , s'' , s''∈S) = - cong [_] (ΣPathP ((path r s r' s' r'' s'') , Σ≡Prop (λ x → ∈-isProp S' x) (·Assoc _ _ _))) + cong [_] (ΣPathP ((path r s r' s' r'' s'') , Σ≡Prop (λ x → ∈-isProp S' x) (·Assoc _ _ _))) where path : (r s r' s' r'' s'' : R) → r · (s' · s'') + (r' · s'' + r'' · s') · s ≡ (r · s' + r' · s) · s'' + r'' · (s · s') @@ -169,7 +169,7 @@ path : [ r · 1r + 0r · s , s · 1r , SMultClosedSubset .multClosed s∈S (SMultClosedSubset .containsOne) ] ≡ [ r , s , s∈S ] - path = cong [_] (ΣPathP (eq1 r s , Σ≡Prop (λ x → ∈-isProp S' x) (·IdR _))) + path = cong [_] (ΣPathP (eq1 r s , Σ≡Prop (λ x → ∈-isProp S' x) (·IdR _))) -ₗ_ : S⁻¹R → S⁻¹R -ₗ_ = SQ.rec squash/ -ₗ[] -ₗWellDef @@ -203,7 +203,7 @@ where +ₗ-comm[] : (a b : R × S) → ([ a ] +ₗ [ b ]) ≡ ([ b ] +ₗ [ a ]) +ₗ-comm[] (r , s , s∈S) (r' , s' , s'∈S) = - cong [_] (ΣPathP ((+Comm _ _) , Σ≡Prop (λ x → ∈-isProp S' x) (·Comm _ _))) + cong [_] (ΣPathP ((+Comm _ _) , Σ≡Prop (λ x → ∈-isProp S' x) (·Comm _ _))) -- Now for multiplication @@ -217,7 +217,7 @@ ·ₚ-symm : (a b : R × S) → (a ·ₚ b) ≡ (b ·ₚ a) ·ₚ-symm (r₁ , s₁ , s₁∈S) (r₂ , s₂ , s₂∈S) = - ΣPathP (·Comm _ _ , Σ≡Prop (λ x → S' x .snd) (·Comm _ _)) + ΣPathP (·Comm _ _ , Σ≡Prop (λ x → S' x .snd) (·Comm _ _)) θ : (a a' b : R × S) → a ≈ a' → (a ·ₚ b) ≈ (a' ·ₚ b) θ (r₁ , s₁ , s₁∈S) (r'₁ , s'₁ , s'₁∈S) (r₂ , s₂ , s₂∈S) ((s , s∈S) , p) = (s , s∈S) , path @@ -243,13 +243,13 @@ where ·ₗ-assoc[] : (a b c : R × S) → [ a ] ·ₗ ([ b ] ·ₗ [ c ]) ≡ ([ a ] ·ₗ [ b ]) ·ₗ [ c ] ·ₗ-assoc[] (r , s , s∈S) (r' , s' , s'∈S) (r'' , s'' , s''∈S) = - cong [_] (ΣPathP ((·Assoc _ _ _) , Σ≡Prop (λ x → ∈-isProp S' x) (·Assoc _ _ _))) + cong [_] (ΣPathP ((·Assoc _ _ _) , Σ≡Prop (λ x → ∈-isProp S' x) (·Assoc _ _ _))) ·ₗ-rid : (x : S⁻¹R) → x ·ₗ 1ₗ ≡ x ·ₗ-rid = SQ.elimProp (λ _ → squash/ _ _) ·ₗ-rid[] where ·ₗ-rid[] : (a : R × S) → ([ a ] ·ₗ 1ₗ) ≡ [ a ] - ·ₗ-rid[] (r , s , s∈S) = cong [_] (ΣPathP ((·IdR _) , Σ≡Prop (λ x → ∈-isProp S' x) (·IdR _))) + ·ₗ-rid[] (r , s , s∈S) = cong [_] (ΣPathP ((·IdR _) , Σ≡Prop (λ x → ∈-isProp S' x) (·IdR _))) ·ₗ-rdist-+ₗ : (x y z : S⁻¹R) → x ·ₗ (y +ₗ z) ≡ (x ·ₗ y) +ₗ (x ·ₗ z) @@ -270,7 +270,7 @@ where ·ₗ-comm[] : (a b : R × S) → [ a ] ·ₗ [ b ] ≡ [ b ] ·ₗ [ a ] ·ₗ-comm[] (r , s , s∈S) (r' , s' , s'∈S) = - cong [_] (ΣPathP ((·Comm _ _) , Σ≡Prop (λ x → ∈-isProp S' x) (·Comm _ _))) + cong [_] (ΣPathP ((·Comm _ _) , Σ≡Prop (λ x → ∈-isProp S' x) (·Comm _ _))) diff --git a/Cubical.Algebra.CommRing.Localisation.InvertingElements.html b/Cubical.Algebra.CommRing.Localisation.InvertingElements.html index 16213106d4..145afe7e40 100644 --- a/Cubical.Algebra.CommRing.Localisation.InvertingElements.html +++ b/Cubical.Algebra.CommRing.Localisation.InvertingElements.html @@ -130,7 +130,7 @@ []-case (r , s , s∈S[f]) = PT.rec (PisProp _) Σhelper s∈S[f] where Σhelper : Σ[ n ∈ ℕ ] s ≡ f ^ n → P [ r , s , s∈S[f] ] - Σhelper (n , p) = subst P (cong [_] (≡-× refl (Σ≡Prop (λ _ → isPropPropTrunc) (sym p)))) (base r n) + Σhelper (n , p) = subst P (cong [_] (≡-× refl (Σ≡Prop (λ _ → isPropPropTrunc) (sym p)))) (base r n) invElPropElim2 : {f g : R} {P : R[1/ f ] → R[1/ g ] → Type ℓ'} @@ -390,16 +390,16 @@ (cong₂ _+_ (sym (·IdR _) ∙ (λ i → (·IdR r (~ i)) · (·IdR 1r (~ i)))) (sym (·IdR _) ∙ (λ i → (·IdR r' (~ i)) · (·IdR 1r (~ i))))) - (Σ≡Prop (λ _ → isPropPropTrunc) + (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdL _) ∙ (λ i → (·IdL 1r (~ i)) · (·IdL 1r (~ i))))))) - (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·ᶠ-lid 1ᶠ)))) + (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·ᶠ-lid 1ᶠ)))) lem· : _ lem· r r' = cong [_] (≡-× - (cong [_] (≡-× refl (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdL _))))) - (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·ᶠ-lid 1ᶠ)))) + (cong [_] (≡-× refl (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdL _))))) + (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·ᶠ-lid 1ᶠ)))) -- this will give us a map R[1/fg] → R[1/f][1/g] by the universal property of localisation fⁿgⁿ/1/1∈R[1/f][1/g]ˣ : (s : R) → s ∈ ([_ⁿ|n≥0] R' (f · g)) → s /1/1 ∈ R[1/f][1/g]ˣ @@ -467,7 +467,7 @@ path : [ g ^ n · r , 1r , PT.∣ 0 , refl ∣₁ ] ≡ 0ᶠ path = [ g ^ n · r , 1r , PT.∣ 0 , refl ∣₁ ] - ≡⟨ cong [_] (≡-× refl (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR _)))) ⟩ + ≡⟨ cong [_] (≡-× refl (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR _)))) ⟩ [ g ^ n , 1r , PT.∣ 0 , refl ∣₁ ] ·ᶠ r/1 @@ -633,7 +633,7 @@ , g/1 ^ᶠ n , PT.∣ n , refl ∣₁ ] ·R[1/f][1/g] (x .snd .fst /1/1) base-^ᶠ-helper r m n = subst (λ y → ∃[ x ∈ R × S[fg] ] (x .fst /1/1) ≡ [ [ r , f ^ m , PT.∣ m , refl ∣₁ ] , y ] ·R[1/f][1/g] (x .snd .fst /1/1)) - (Σ≡Prop (λ _ → isPropPropTrunc) (^-respects-/1 _ n)) (baseCase r m n) + (Σ≡Prop (λ _ → isPropPropTrunc) (^-respects-/1 _ n)) (baseCase r m n) indStep : (r : R[1/_] R' f) (n : ℕ) → ∃[ x ∈ R × S[fg] ] (x .fst /1/1) ≡ [ r , g/1 ^ᶠ n , PT.∣ n , refl ∣₁ ] ·R[1/f][1/g] (x .snd .fst /1/1) @@ -833,9 +833,9 @@ ℕcase : (r : R) (n : ℕ) → φ [ r , (f · g) ^ n , PT.∣ n , refl ∣₁ ] ≡ χ [ r , (f · g) ^ n , PT.∣ n , refl ∣₁ ] ℕcase r n = cong [_] (ΣPathP --look into the components of the double-fractions - ( cong [_] (ΣPathP (eq1 , Σ≡Prop (λ x → S'[f] x .snd) (sym (·IdL _)))) - , Σ≡Prop (λ x → S'[f][g] x .snd) --ignore proof that denominator is power of g/1 - ( cong [_] (ΣPathP (sym (·IdL _) , Σ≡Prop (λ x → S'[f] x .snd) (sym (·IdL _))))))) + ( cong [_] (ΣPathP (eq1 , Σ≡Prop (λ x → S'[f] x .snd) (sym (·IdL _)))) + , Σ≡Prop (λ x → S'[f][g] x .snd) --ignore proof that denominator is power of g/1 + ( cong [_] (ΣPathP (sym (·IdL _) , Σ≡Prop (λ x → S'[f] x .snd) (sym (·IdL _))))))) where S'[f] = ([_ⁿ|n≥0] R' f) S'[f][g] = ([_ⁿ|n≥0] R[1/f]AsCommRing [ g , 1r , powersFormMultClosedSubset R' f .containsOne ]) diff --git a/Cubical.Algebra.CommRing.Localisation.Limit.html b/Cubical.Algebra.CommRing.Localisation.Limit.html index 53884448ea..a0cc171938 100644 --- a/Cubical.Algebra.CommRing.Localisation.Limit.html +++ b/Cubical.Algebra.CommRing.Localisation.Limit.html @@ -221,7 +221,7 @@ where χId : ∀ i x → χˡ i i .fst x ≡ χʳ i i .fst x χId i = invElPropElim (λ _ → squash/ _ _) - (λ r m → cong [_] (ΣPathP (refl , Σ≡Prop (∈-isProp _) refl))) + (λ r m → cong [_] (ΣPathP (refl , Σ≡Prop (∈-isProp _) refl))) aux (gt j<i) = χˡ i j .fst (x i) ≡⟨ χSwapL→R i j (x i) ⟩ @@ -234,14 +234,14 @@ χSwapL→R : ∀ i j x → χˡ i j .fst x ≡ χʳsubst i j x χSwapL→R i j = invElPropElim (λ _ → squash/ _ _) - λ r m → cong [_] (ΣPathP (sym (transportRefl _) , Σ≡Prop (∈-isProp _) + λ r m → cong [_] (ΣPathP (sym (transportRefl _) , Σ≡Prop (∈-isProp _) (sym (transportRefl _ ∙ cong (λ x → 1r · transport refl (x ^ m)) (·Comm _ _))))) χˡsubst : (i j : Fin (suc n)) → R[1/ f j ] → R[1/ f i · f j ] χˡsubst i j x = subst (λ r → R[1/ r ]) (·Comm (f j) (f i)) (χˡ j i .fst x) χSwapR→L : ∀ i j x → χʳ i j .fst x ≡ χˡsubst i j x χSwapR→L i j = invElPropElim (λ _ → squash/ _ _) - λ r m → cong [_] (ΣPathP (sym (transportRefl _) , Σ≡Prop (∈-isProp _) + λ r m → cong [_] (ΣPathP (sym (transportRefl _) , Σ≡Prop (∈-isProp _) (sym (transportRefl _ ∙ cong (λ x → 1r · transport refl (x ^ m)) (·Comm _ _))))) χ≡PropElim : {B : ((i : Fin (suc n)) → R[1/ f i ]) → Type ℓ''} (isPropB : ∀ {x} → isProp (B x)) @@ -433,7 +433,7 @@ Σhelper : Σ[ α ∈ FinVec R (suc n) ] 1r ≡ linearCombination R' α f²ᵐ⁺ˡ → ∃![ y ∈ R ] (∀ i → y /1ˢ ≡ [ r i , f i ^ m , ∣ m , refl ∣₁ ]) Σhelper (α , linCombi) = (z , z≡r/fᵐ) - , λ y' → Σ≡Prop (λ _ → isPropΠ (λ _ → squash/ _ _)) (unique _ (y' .snd)) + , λ y' → Σ≡Prop (λ _ → isPropΠ (λ _ → squash/ _ _)) (unique _ (y' .snd)) where z = ∑ λ i → α i · r i · f i ^ (m +ℕ l) @@ -538,23 +538,23 @@ open Cone open Functor - locDiagram : Functor (DLShfDiag (suc n) ℓ) CommRingsCategory - F-ob locDiagram (sing i) = R[1/ f i ]AsCommRing - F-ob locDiagram (pair i j _) = R[1/ f i · f j ]AsCommRing - F-hom locDiagram idAr = idCommRingHom _ - F-hom locDiagram singPairL = χˡ _ _ - F-hom locDiagram singPairR = χʳ _ _ + locDiagram : Functor (DLShfDiag (suc n) ℓ) CommRingsCategory + F-ob locDiagram (sing i) = R[1/ f i ]AsCommRing + F-ob locDiagram (pair i j _) = R[1/ f i · f j ]AsCommRing + F-hom locDiagram idAr = idCommRingHom _ + F-hom locDiagram singPairL = χˡ _ _ + F-hom locDiagram singPairR = χʳ _ _ F-id locDiagram = refl - F-seq locDiagram idAr _ = sym (⋆IdL _) - F-seq locDiagram singPairL idAr = sym (⋆IdR _) - F-seq locDiagram singPairR idAr = sym (⋆IdR _) + F-seq locDiagram idAr _ = sym (⋆IdL _) + F-seq locDiagram singPairL idAr = sym (⋆IdR _) + F-seq locDiagram singPairR idAr = sym (⋆IdR _) locCone : Cone locDiagram R' - coneOut locCone (sing i) = U./1AsCommRingHom i - coneOut locCone (pair i j _) = UP./1AsCommRingHom i j - coneOutCommutes locCone idAr = ⋆IdR _ - coneOutCommutes locCone singPairL = RingHom≡ (χˡUnique _ _ .fst .snd) - coneOutCommutes locCone singPairR = RingHom≡ (χʳUnique _ _ .fst .snd) + coneOut locCone (sing i) = U./1AsCommRingHom i + coneOut locCone (pair i j _) = UP./1AsCommRingHom i j + coneOutCommutes locCone idAr = ⋆IdR _ + coneOutCommutes locCone singPairL = RingHom≡ (χˡUnique _ _ .fst .snd) + coneOutCommutes locCone singPairR = RingHom≡ (χʳUnique _ _ .fst .snd) isLimConeLocCone : 1r ∈ ⟨f₀,⋯,fₙ⟩ → isLimCone _ _ locCone isLimConeLocCone 1∈⟨f₀,⋯,fₙ⟩ A' cᴬ = (ψ , isConeMorψ) , ψUniqueness @@ -564,15 +564,15 @@ _ = snd A' φ : (i : Fin (suc n)) → CommRingHom A' R[1/ f i ]AsCommRing - φ i = cᴬ .coneOut (sing i) + φ i = cᴬ .coneOut (sing i) applyEqualizerLemma : ∀ a → ∃![ r ∈ R ] ∀ i → r /1ˢ ≡ φ i .fst a applyEqualizerLemma a = equalizerLemma 1∈⟨f₀,⋯,fₙ⟩ (λ i → φ i .fst a) (χ≡Elim<Only _ χφSquare<) where χφSquare< : ∀ i j → i < j → χˡ i j .fst (φ i .fst a) ≡ χʳ i j .fst (φ j .fst a) χφSquare< i j i<j = - χˡ i j .fst (φ i .fst a) ≡⟨ cong (_$r a) (cᴬ .coneOutCommutes singPairL) ⟩ - cᴬ .coneOut (pair i j i<j) .fst a ≡⟨ cong (_$r a) (sym (cᴬ .coneOutCommutes singPairR)) ⟩ + χˡ i j .fst (φ i .fst a) ≡⟨ cong (_$r a) (cᴬ .coneOutCommutes singPairL) ⟩ + cᴬ .coneOut (pair i j i<j) .fst a ≡⟨ cong (_$r a) (sym (cᴬ .coneOutCommutes singPairR)) ⟩ χʳ i j .fst (φ j .fst a) ∎ @@ -601,18 +601,18 @@ -- TODO: Can you use lemma from other PR to eliminate pair case isConeMorψ : isConeMor cᴬ locCone ψ - isConeMorψ (sing i) = RingHom≡ (funExt (λ a → applyEqualizerLemma a .fst .snd i)) - isConeMorψ (pair i j i<j) = + isConeMorψ (sing i) = RingHom≡ (funExt (λ a → applyEqualizerLemma a .fst .snd i)) + isConeMorψ (pair i j i<j) = ψ ⋆ UP./1AsCommRingHom i j ≡⟨ cong (ψ ⋆_) (sym (RingHom≡ (χˡUnique _ _ .fst .snd))) ⟩ ψ ⋆ U./1AsCommRingHom i ⋆ χˡ i j ≡⟨ sym (⋆Assoc _ _ _) ⟩ - (ψ ⋆ U./1AsCommRingHom i) ⋆ χˡ i j ≡⟨ cong (_⋆ χˡ i j) (isConeMorψ (sing i)) ⟩ - φ i ⋆ χˡ i j ≡⟨ coneOutCommutes cᴬ singPairL ⟩ - coneOut cᴬ (pair i j i<j) ∎ + (ψ ⋆ U./1AsCommRingHom i) ⋆ χˡ i j ≡⟨ cong (_⋆ χˡ i j) (isConeMorψ (sing i)) ⟩ + φ i ⋆ χˡ i j ≡⟨ coneOutCommutes cᴬ singPairL ⟩ + coneOut cᴬ (pair i j i<j) ∎ ψUniqueness : (y : Σ[ θ ∈ CommRingHom A' R' ] isConeMor cᴬ locCone θ) → (ψ , isConeMorψ) ≡ y - ψUniqueness (θ , isConeMorθ) = Σ≡Prop (λ _ → isPropIsConeMor _ _ _) + ψUniqueness (θ , isConeMorθ) = Σ≡Prop (λ _ → isPropIsConeMor _ _ _) (RingHom≡ (funExt λ a → cong fst (applyEqualizerLemma a .snd (θtriple a)))) where θtriple : (a : A) → Σ[ x ∈ R ] ∀ i → x /1ˢ ≡ φ i .fst a - θtriple a = fst θ a , λ i → cong (_$r a) (isConeMorθ (sing i)) + θtriple a = fst θ a , λ i → cong (_$r a) (isConeMorθ (sing i)) \ No newline at end of file diff --git a/Cubical.Algebra.CommRing.Localisation.PullbackSquare.html b/Cubical.Algebra.CommRing.Localisation.PullbackSquare.html index cc6e6c427d..69f0325337 100644 --- a/Cubical.Algebra.CommRing.Localisation.PullbackSquare.html +++ b/Cubical.Algebra.CommRing.Localisation.PullbackSquare.html @@ -575,7 +575,7 @@ χUniqueness : (y : Σ[ θ ∈ CommRingHom A R' ] (ψ ≡ θ ⋆ /1ᵍAsCommRingHom) × (φ ≡ θ ⋆ /1ᶠAsCommRingHom)) → (χ , χCoh) ≡ y - χUniqueness (θ , θCoh) = Σ≡Prop (λ _ → isProp× (isSetRingHom _ _ _ _) + χUniqueness (θ , θCoh) = Σ≡Prop (λ _ → isProp× (isSetRingHom _ _ _ _) (isSetRingHom _ _ _ _)) (RingHom≡ (funExt (λ a → cong fst (applyEqualizerLemma a .snd (θtriple a))))) where diff --git a/Cubical.Algebra.CommRing.Localisation.UniversalProperty.html b/Cubical.Algebra.CommRing.Localisation.UniversalProperty.html index d8e856364d..1cc317764b 100644 --- a/Cubical.Algebra.CommRing.Localisation.UniversalProperty.html +++ b/Cubical.Algebra.CommRing.Localisation.UniversalProperty.html @@ -80,8 +80,8 @@ makeIsRingHom refl (λ r r' → cong [_] (≡-× (cong₂ (_+_) (sym (·IdR r)) (sym (·IdR r'))) - (Σ≡Prop (λ x → S' x .snd) (sym (·IdL 1r))))) - (λ _ _ → cong [_] (≡-× refl (Σ≡Prop (λ x → S' x .snd) (sym (·IdL 1r))))) + (Σ≡Prop (λ x → S' x .snd) (sym (·IdL 1r))))) + (λ _ _ → cong [_] (≡-× refl (Σ≡Prop (λ x → S' x .snd) (sym (·IdL 1r))))) S⁻¹Rˣ = S⁻¹RAsCommRing ˣ S/1⊆S⁻¹Rˣ : ∀ s → s ∈ S' → (s /1) ∈ S⁻¹Rˣ @@ -298,7 +298,7 @@ χunique : (y : Σ[ χ' ∈ CommRingHom S⁻¹RAsCommRing B' ] fst χ' ∘ _/1 ≡ ψ₀) → (χ , funExt χcomp) ≡ y - χunique (χ' , χ'/1≡ψ) = Σ≡Prop (λ x → isSetΠ (λ _ → Bset) _ _) (RingHom≡ fχ≡fχ') + χunique (χ' , χ'/1≡ψ) = Σ≡Prop (λ x → isSetΠ (λ _ → Bset) _ _) (RingHom≡ fχ≡fχ') where open CommRingHomTheory {A' = S⁻¹RAsCommRing} {B' = B'} χ' renaming (φ[x⁻¹]≡φ[x]⁻¹ to χ'[x⁻¹]≡χ'[x]⁻¹) @@ -321,7 +321,7 @@ ·ₗ-path : [ r , s , s∈S' ] ≡ [ r , 1r , SMultClosedSubset .containsOne ] ·ₗ [ 1r , s , s∈S' ] - ·ₗ-path = cong [_] (≡-× (sym (·IdR r)) (Σ≡Prop (λ x → S' x .snd) (sym (·IdL s)))) + ·ₗ-path = cong [_] (≡-× (sym (·IdR r)) (Σ≡Prop (λ x → S' x .snd) (sym (·IdL s)))) instancepath : ⦃ _ : ψ₀ s ∈ Bˣ ⦄ ⦃ _ : s /1 ∈ S⁻¹Rˣ ⦄ ⦃ _ : fst χ' (s /1) ∈ Bˣ ⦄ → ψ₀ r ·B ψ₀ s ⁻¹ ≡ fst χ' [ r , s , s∈S' ] @@ -388,7 +388,7 @@ open RingHomTheory χ S⁻¹R≃A : S⁻¹R ≃ A - S⁻¹R≃A = fst χ , isEmbedding×isSurjection→isEquiv (Embχ , Surχ) + S⁻¹R≃A = fst χ , isEmbedding×isSurjection→isEquiv (Embχ , Surχ) where Embχ : isEmbedding (fst χ) Embχ = injEmbedding Aset (ker≡0→inj λ {x} → kerχ≡0 x) @@ -413,7 +413,7 @@ path = (λ i → ·IdR (q i) i) ∙∙ sym (0LeftAnnihilates _) ∙∙ cong (_· s) (sym (0RightAnnihilates _)) - Surχ : isSurjection (fst χ) + Surχ : isSurjection (fst χ) Surχ a = PT.rec isPropPropTrunc (λ x → PT.∣ [ x .fst ] , x .snd ∣₁) (surχ a) diff --git a/Cubical.Algebra.CommRing.Properties.html b/Cubical.Algebra.CommRing.Properties.html index 7ba402a071..73080d41c9 100644 --- a/Cubical.Algebra.CommRing.Properties.html +++ b/Cubical.Algebra.CommRing.Properties.html @@ -40,7 +40,7 @@ private R = fst R' inverseUniqueness : (r : R) → isProp (Σ[ r' ∈ R ] r · r' ≡ 1r) - inverseUniqueness r (r' , rr'≡1) (r'' , rr''≡1) = Σ≡Prop (λ _ → is-set _ _) path + inverseUniqueness r (r' , rr'≡1) (r'' , rr''≡1) = Σ≡Prop (λ _ → is-set _ _) path where path : r' ≡ r'' path = r' ≡⟨ sym (·IdR _) ⟩ @@ -329,7 +329,7 @@ ∙∙ transportTransport⁻ (ua (CommRing≡ A B)) q where helper : transport (sym (ua (CommRing≡ A B))) p ≡ transport (sym (ua (CommRing≡ A B))) q - helper = Σ≡Prop + helper = Σ≡Prop (λ _ → isPropΣ (isOfHLevelPathP' 1 (is-set (snd B)) _ _) λ _ → isPropΣ (isOfHLevelPathP' 1 (is-set (snd B)) _ _) diff --git a/Cubical.Algebra.CommRing.Quotient.Base.html b/Cubical.Algebra.CommRing.Quotient.Base.html index 134b6e51a8..09db3f015b 100644 --- a/Cubical.Algebra.CommRing.Quotient.Base.html +++ b/Cubical.Algebra.CommRing.Quotient.Base.html @@ -91,7 +91,7 @@ quotientHom R I = Ring.quotientHom (CommRing→Ring R) (CommIdeal→Ideal I) quotientHomSurjective : (R : CommRing ℓ) → (I : IdealsIn R) - → isSurjection (fst (quotientHom R I)) + → isSurjection (fst (quotientHom R I)) quotientHomSurjective R I = Ring.quotientHomSurjective (CommRing→Ring R) (CommIdeal→Ideal I) module _ {R : CommRing ℓ} (I : IdealsIn R) where diff --git a/Cubical.Algebra.CommRing.Quotient.IdealSum.html b/Cubical.Algebra.CommRing.Quotient.IdealSum.html index b82b8f9fb3..e313ce051e 100644 --- a/Cubical.Algebra.CommRing.Quotient.IdealSum.html +++ b/Cubical.Algebra.CommRing.Quotient.IdealSum.html @@ -147,12 +147,12 @@ ϕ-injective - surjective : isSurjection (fst ψ) + surjective : isSurjection (fst ψ) surjective = - leftFactorSurjective + leftFactorSurjective (fst π+) (fst ψ) - (snd (compSurjection (_ , quotientHomSurjective R I) (_ , quotientHomSurjective (R / I) π₁J))) + (snd (compSurjection (_ , quotientHomSurjective R I) (_ , quotientHomSurjective (R / I) π₁J))) module _ {R : CommRing ℓ} (I J : IdealsIn R) where open Construction I J @@ -161,7 +161,7 @@ quotientIdealSumEquiv : CommRingEquiv (R / (I +i J)) ((R / I) / π₁J) fst (fst quotientIdealSumEquiv) = fst ψ snd (fst quotientIdealSumEquiv) = - fst (invEquiv isEquiv≃isEmbedding×isSurjection) + fst (invEquiv isEquiv≃isEmbedding×isSurjection) ((subst (λ ξ → isEmbedding (fst ξ)) ϕ≡ψ embedding) , surjective) snd quotientIdealSumEquiv = snd ψ diff --git a/Cubical.Algebra.CommSemiring.Instances.UpperNat.html b/Cubical.Algebra.CommSemiring.Instances.UpperNat.html index 86c05ad04a..4f8b37d8b5 100644 --- a/Cubical.Algebra.CommSemiring.Instances.UpperNat.html +++ b/Cubical.Algebra.CommSemiring.Instances.UpperNat.html @@ -56,61 +56,61 @@ -} module ConstructionUnbounded where - ℕ↑-+ = PropCompletion ℕ≤+ - ℕ↑-· = PropCompletion ℕ≤· + ℕ↑-+ = PropCompletion ℕ≤+ + ℕ↑-· = PropCompletion ℕ≤· - open OrderedCommMonoidStr (snd ℕ↑-+) - hiding (_≤_; MonotoneL; MonotoneR) + open OrderedCommMonoidStr (snd ℕ↑-+) + hiding (_≤_; MonotoneL; MonotoneR) renaming (·Assoc to +Assoc; ·Comm to +Comm; ·IdR to +Rid; - _·_ to _+_; ε to 0↑) + _·_ to _+_; ε to 0↑) - open OrderedCommMonoidStr (snd ℕ≤·) - using (MonotoneL; MonotoneR) + open OrderedCommMonoidStr (snd ℕ≤·) + using (MonotoneL; MonotoneR) - open OrderedCommMonoidStr (snd ℕ≤+) - hiding (_≤_) - renaming (_·_ to _+ℕ_; - MonotoneL to +MonotoneL; MonotoneR to +MonotoneR; + open OrderedCommMonoidStr (snd ℕ≤+) + hiding (_≤_) + renaming (_·_ to _+ℕ_; + MonotoneL to +MonotoneL; MonotoneR to +MonotoneR; ·Comm to ℕ+Comm) - open OrderedCommMonoidStr ⦃...⦄ - using (_·_ ; ·Assoc ; ·Comm ) + open OrderedCommMonoidStr ⦃...⦄ + using (_·_ ; ·Assoc ; ·Comm ) renaming (·IdR to ·Rid) private instance - _ : OrderedCommMonoidStr _ _ + _ : OrderedCommMonoidStr _ _ _ = snd ℕ↑-· - _ : OrderedCommMonoidStr _ _ + _ : OrderedCommMonoidStr _ _ _ = snd ℕ≤· ℕ↑ : Type₁ ℕ↑ = fst ℕ↑-+ - open PropCompletion ℓ-zero ℕ≤+ - using (typeAt; pathFromImplications) + open PropCompletion ℓ-zero ℕ≤+ + using (typeAt; pathFromImplications) open <-Reasoning using (_≤⟨_⟩_) +LDist· : (x y z : ℕ↑) → - x · (y + z) ≡ (x · y) + (x · z) + x · (y + z) ≡ (x · y) + (x · z) +LDist· x y z = - pathFromImplications - (x · (y + z)) ((x · y) + (x · z)) + pathFromImplications + (x · (y + z)) ((x · y) + (x · z)) (⇒) ⇐ where - ⇒ : (n : ℕ) → typeAt n (x · (y + z)) → typeAt n ((x · y) + (x · z)) + ⇒ : (n : ℕ) → typeAt n (x · (y + z)) → typeAt n ((x · y) + (x · z)) ⇒ n = PT.rec isPropPropTrunc λ {((a , b) , xa , (y+zb , a·b≤n)) → PT.rec isPropPropTrunc (λ {((a' , b') , ya' , (zb' , a'+b'≤b)) - → ∣ ((a · a') , (a · b')) , + → ∣ ((a · a') , (a · b')) , ∣ (a , a') , (xa , (ya' , ≤-refl)) ∣₁ , (∣ (a , b') , (xa , (zb' , ≤-refl)) ∣₁ , subst (_≤ n) (sym (·-distribˡ a a' b')) - (≤-trans (MonotoneL {z = a} a'+b'≤b) a·b≤n)) ∣₁ }) + (≤-trans (MonotoneL {z = a} a'+b'≤b) a·b≤n)) ∣₁ }) y+zb} ⇐ : (n : ℕ) → _ @@ -129,23 +129,23 @@ (a' , (b' +ℕ b″)) , a'x , (∣ (b' , b″) , (b'y , (zb″ , ≤-refl)) ∣₁ , - (a' · (b' +ℕ b″) ≤⟨ subst - (_≤ (a' · b') +ℕ (a' · b″)) + (a' · (b' +ℕ b″) ≤⟨ subst + (_≤ (a' · b') +ℕ (a' · b″)) (·-distribˡ a' b' b″) ≤-refl ⟩ - (a' · b') +ℕ (a' · b″) ≤⟨ +MonotoneR a'·b'≤a ⟩ - a +ℕ (a' · b″) ≤⟨ +MonotoneL - (≤-trans (MonotoneR a'≤a″) a″·b″≤b) ⟩ + (a' · b') +ℕ (a' · b″) ≤⟨ +MonotoneR a'·b'≤a ⟩ + a +ℕ (a' · b″) ≤⟨ +MonotoneL + (≤-trans (MonotoneR a'≤a″) a″·b″≤b) ⟩ a+b≤n )) ) (λ a″≤a' → (a″ , (b' +ℕ b″)) , (a″x , (∣ (b' , b″) , (b'y , (zb″ , ≤-refl)) ∣₁ , - ((a″ · (b' +ℕ b″)) ≤⟨ subst - (_≤ (a″ · b') +ℕ (a″ · b″)) + ((a″ · (b' +ℕ b″)) ≤⟨ subst + (_≤ (a″ · b') +ℕ (a″ · b″)) (·-distribˡ a″ b' b″) ≤-refl ⟩ - (a″ · b') +ℕ (a″ · b″) ≤⟨ +MonotoneR - ((a″ · b') ≤⟨ MonotoneR a″≤a' ⟩ a'·b'≤a) ⟩ - a +ℕ (a″ · b″) ≤⟨ +MonotoneL a″·b″≤b ⟩ + (a″ · b') +ℕ (a″ · b″) ≤⟨ +MonotoneR + ((a″ · b') ≤⟨ MonotoneR a″≤a' ⟩ a'·b'≤a) ⟩ + a +ℕ (a″ · b″) ≤⟨ +MonotoneL a″·b″≤b ⟩ a+b≤n))) ) ∣₁}) @@ -154,31 +154,31 @@ module ConstructionBounded where - ℕ↑-+b = BoundedPropCompletion ℕ≤+ - ℕ↑-·b = BoundedPropCompletion ℕ≤· + ℕ↑-+b = BoundedPropCompletion ℕ≤+ + ℕ↑-·b = BoundedPropCompletion ℕ≤· - open OrderedCommMonoidStr (snd ℕ≤+) - renaming (_·_ to _+ℕ_; ·IdR to +IdR; ·Comm to ℕ+Comm) - open OrderedCommMonoidStr (snd ℕ↑-+b) - renaming (_·_ to _+_; ε to 0↑) + open OrderedCommMonoidStr (snd ℕ≤+) + renaming (_·_ to _+ℕ_; ·IdR to +IdR; ·Comm to ℕ+Comm) + open OrderedCommMonoidStr (snd ℕ↑-+b) + renaming (_·_ to _+_; ε to 0↑) - open OrderedCommMonoidStr (snd ℕ↑-·b) - using (_·_) + open OrderedCommMonoidStr (snd ℕ↑-·b) + using (_·_) - open PropCompletion ℓ-zero ℕ≤+ - using (typeAt; pathFromImplications) + open PropCompletion ℓ-zero ℕ≤+ + using (typeAt; pathFromImplications) ℕ↑b : Type₁ ℕ↑b = fst ℕ↑-+b - AnnihilL : (x : ℕ↑b) → 0↑ · x ≡ 0↑ + AnnihilL : (x : ℕ↑b) → 0↑ · x ≡ 0↑ AnnihilL x = - Σ≡Prop (λ s → PropCompletion.isPropIsBounded ℓ-zero ℕ≤+ s) - (pathFromImplications (fst (0↑ · x)) (fst 0↑) (⇒) ⇐) + Σ≡Prop (λ s → PropCompletion.isPropIsBounded ℓ-zero ℕ≤+ s) + (pathFromImplications (fst (0↑ · x)) (fst 0↑) (⇒) ⇐) where - ⇒ : (n : ℕ) → typeAt n (fst (0↑ · x)) → typeAt n (fst 0↑) + ⇒ : (n : ℕ) → typeAt n (fst (0↑ · x)) → typeAt n (fst 0↑) ⇒ n _ = n , ℕ+Comm n 0 - ⇐ : (n : ℕ) → typeAt n (fst 0↑) → typeAt n (fst (0↑ · x)) + ⇐ : (n : ℕ) → typeAt n (fst 0↑) → typeAt n (fst (0↑ · x)) ⇐ n _ = PT.rec isPropPropTrunc @@ -192,20 +192,20 @@ where module CS = CommSemiringStr open IsCommMonoid - +IsCM = OrderedCommMonoidStr.isCommMonoid (snd ℕ↑-+b) - ·IsCM = OrderedCommMonoidStr.isCommMonoid (snd ℕ↑-·b) + +IsCM = OrderedCommMonoidStr.isCommMonoid (snd ℕ↑-+b) + ·IsCM = OrderedCommMonoidStr.isCommMonoid (snd ℕ↑-·b) str : CommSemiringStr ℕ↑b CS.0r str = 0↑ - CS.1r str = OrderedCommMonoidStr.ε (snd ℕ↑-·b) + CS.1r str = OrderedCommMonoidStr.ε (snd ℕ↑-·b) CS._+_ str = _+_ - CS._·_ str = _·_ + CS._·_ str = _·_ CS.isCommSemiring str = makeIsCommSemiring (is-set +IsCM) (·Assoc +IsCM) (·IdR +IsCM) (·Comm +IsCM) (·Assoc ·IsCM) (·IdR ·IsCM) - (λ x y z → Σ≡Prop (λ s → PropCompletion.isPropIsBounded ℓ-zero ℕ≤+ s) + (λ x y z → Σ≡Prop (λ s → PropCompletion.isPropIsBounded ℓ-zero ℕ≤+ s) (ConstructionUnbounded.+LDist· (fst x) (fst y) (fst z))) AnnihilL (·Comm ·IsCM) diff --git a/Cubical.Algebra.DirectSum.DirectSumFun.Properties.html b/Cubical.Algebra.DirectSum.DirectSumFun.Properties.html index 409a28f1ad..053ceadd6d 100644 --- a/Cubical.Algebra.DirectSum.DirectSumFun.Properties.html +++ b/Cubical.Algebra.DirectSum.DirectSumFun.Properties.html @@ -66,18 +66,18 @@ -- AbGroup Properties +⊕FunAssoc : (x y z : ⊕Fun G Gstr) → x +⊕Fun (y +⊕Fun z) ≡ (x +⊕Fun y) +⊕Fun z +⊕FunAssoc (f , Anf) (g , Ang) (h , Anh) = - ΣPathTransport→PathΣ _ _ + ΣPathTransport→PathΣ _ _ (funExt (λ n → Gstr n .+Assoc _ _ _) , (squash₁ _ _)) +⊕FunRid : (x : ⊕Fun G Gstr) → x +⊕Fun 0⊕Fun ≡ x - +⊕FunRid (f , Anf) = ΣPathTransport→PathΣ _ _ + +⊕FunRid (f , Anf) = ΣPathTransport→PathΣ _ _ ((funExt (λ n → +IdR (Gstr n) _)) , squash₁ _ _) +⊕FunInvR : (x : ⊕Fun G Gstr) → x +⊕Fun Inv⊕Fun x ≡ 0⊕Fun - +⊕FunInvR (f , Anf) = ΣPathTransport→PathΣ _ _ + +⊕FunInvR (f , Anf) = ΣPathTransport→PathΣ _ _ ((funExt (λ n → +InvR (Gstr n) _)) , (squash₁ _ _)) +⊕FunComm : (x y : ⊕Fun G Gstr) → x +⊕Fun y ≡ y +⊕Fun x - +⊕FunComm (f , Anf) (g , Ang) = ΣPathTransport→PathΣ _ _ + +⊕FunComm (f , Anf) (g , Ang) = ΣPathTransport→PathΣ _ _ ((funExt (λ n → Gstr n .+Comm _ _)) , (squash₁ _ _)) \ No newline at end of file diff --git a/Cubical.Algebra.DirectSum.DirectSumHIT.UniversalProperty.html b/Cubical.Algebra.DirectSum.DirectSumHIT.UniversalProperty.html index ba5a9224aa..b18056e52d 100644 --- a/Cubical.Algebra.DirectSum.DirectSumHIT.UniversalProperty.html +++ b/Cubical.Algebra.DirectSum.DirectSumHIT.UniversalProperty.html @@ -60,7 +60,7 @@ -- Universal Property up∃⊕HIT : (k : Idx) → fHhom k ≡ compGroupHom (injₖ-hom k) ⊕HIT→H-hom - up∃⊕HIT k = ΣPathTransport→PathΣ _ _ + up∃⊕HIT k = ΣPathTransport→PathΣ _ _ ((funExt (λ _ → refl)) , isPropIsGroupHom _ _ _ _) @@ -68,7 +68,7 @@ upUnicity⊕HIT : (hhom : AbGroupHom (⊕HIT-AbGr Idx G Gstr) HAbGr) → (eqInj : (k : Idx) → fHhom k ≡ compGroupHom (injₖ-hom k) hhom) → hhom ≡ ⊕HIT→H-hom - upUnicity⊕HIT (h , hstr) eqInj = ΣPathTransport→PathΣ _ _ + upUnicity⊕HIT (h , hstr) eqInj = ΣPathTransport→PathΣ _ _ (helper , isPropIsGroupHom _ _ _ _) where diff --git a/Cubical.Algebra.DirectSum.Equiv-DSHIT-DSFun.html b/Cubical.Algebra.DirectSum.Equiv-DSHIT-DSFun.html index addcded81e..7a3bf07c84 100644 --- a/Cubical.Algebra.DirectSum.Equiv-DSHIT-DSFun.html +++ b/Cubical.Algebra.DirectSum.Equiv-DSHIT-DSFun.html @@ -188,7 +188,7 @@ ⊕HIT→⊕Fun-pres0 = refl ⊕HIT→⊕Fun-pres+ : (x y : ⊕HIT ℕ G Gstr) → ⊕HIT→⊕Fun (x +⊕HIT y) ≡ ((⊕HIT→⊕Fun x) +⊕Fun (⊕HIT→⊕Fun y)) - ⊕HIT→⊕Fun-pres+ x y = ΣPathTransport→PathΣ _ _ (refl , (squash₁ _ _)) + ⊕HIT→⊕Fun-pres+ x y = ΣPathTransport→PathΣ _ _ (refl , (squash₁ _ _)) ----------------------------------------------------------------------------- @@ -272,10 +272,10 @@ ∙ sym q} inj-⊕HIT→⊕Fun : (x y : ⊕HIT ℕ G Gstr) → ⊕HIT→⊕Fun x ≡ ⊕HIT→⊕Fun y → x ≡ y - inj-⊕HIT→⊕Fun x y p = inj-⊕HIT→Fun x y (fst (PathΣ→ΣPathTransport _ _ p)) + inj-⊕HIT→⊕Fun x y p = inj-⊕HIT→Fun x y (fst (PathΣ→ΣPathTransport _ _ p)) lemProp : (g : ⊕Fun G Gstr) → isProp (Σ[ x ∈ ⊕HIT ℕ G Gstr ] ⊕HIT→⊕Fun x ≡ g ) - lemProp g (x , p) (y , q) = ΣPathTransport→PathΣ _ _ + lemProp g (x , p) (y , q) = ΣPathTransport→PathΣ _ _ ((inj-⊕HIT→⊕Fun x y (p ∙ sym q)) , isSet⊕Fun _ _ _ _) @@ -334,7 +334,7 @@ ⊕Fun→⊕HIT+ : (g : ⊕Fun G Gstr) → Σ[ x ∈ ⊕HIT ℕ G Gstr ] ⊕HIT→⊕Fun x ≡ g ⊕Fun→⊕HIT+ (g , Ang) = PT.rec (lemProp (g , Ang)) (λ { (k , ng) - → Strad g k , ΣPathTransport→PathΣ _ _ + → Strad g k , ΣPathTransport→PathΣ _ _ ((funExt (trad-section g k ng)) , (squash₁ _ _)) }) Ang where diff --git a/Cubical.Algebra.DistLattice.Basis.html b/Cubical.Algebra.DistLattice.Basis.html index 2d2564550f..f5952b0f74 100644 --- a/Cubical.Algebra.DistLattice.Basis.html +++ b/Cubical.Algebra.DistLattice.Basis.html @@ -42,17 +42,17 @@ module _ (L' : DistLattice ℓ) where private L = fst L' open DistLatticeStr (snd L') - open Join L' + open Join L' - record IsGenSublattice (M : Semilattice ℓ) (e : fst M → L) : Type ℓ where + record IsGenSublattice (M : Semilattice ℓ) (e : fst M → L) : Type ℓ where constructor isgensublattice - open SemilatticeStr (snd M) renaming (ε to 0s ; _·_ to _∧s_) + open SemilatticeStr (snd M) renaming (ε to 0s ; _·_ to _∧s_) field isInj : ∀ x y → e x ≡ e y → x ≡ y pres0 : e 0s ≡ 0l resp∧ : ∀ x y → e (x ∧s y) ≡ e x ∧l e y - ⋁Gen : ∀ (x : L) → ∃[ n ∈ ℕ ] Σ[ α ∈ FinVec (fst M) n ] (⋁ (e ∘ α) ≡ x) + ⋁Gen : ∀ (x : L) → ∃[ n ∈ ℕ ] Σ[ α ∈ FinVec (fst M) n ] (⋁ (e ∘ α) ≡ x) -- TODO: prove equivalence with the more set-theoretical definition @@ -62,19 +62,19 @@ field contains1 : 1l ∈ S ∧lClosed : ∀ (x y : L) → x ∈ S → y ∈ S → x ∧l y ∈ S - ⋁Basis : ∀ (x : L) → ∃[ n ∈ ℕ ] Σ[ α ∈ FinVec L n ] (∀ i → α i ∈ S) × (⋁ α ≡ x) + ⋁Basis : ∀ (x : L) → ∃[ n ∈ ℕ ] Σ[ α ∈ FinVec L n ] (∀ i → α i ∈ S) × (⋁ α ≡ x) open IsBasis - open SemilatticeStr hiding (is-set) - Basis→MeetSemilattice : (S : ℙ L) → IsBasis S → Semilattice ℓ + open SemilatticeStr hiding (is-set) + Basis→MeetSemilattice : (S : ℙ L) → IsBasis S → Semilattice ℓ fst (Basis→MeetSemilattice S isBasisS) = Σ[ l ∈ L ] (l ∈ S) - ε (snd (Basis→MeetSemilattice S isBasisS)) = 1l , isBasisS .contains1 - _·_ (snd (Basis→MeetSemilattice S isBasisS)) x y = fst x ∧l fst y + ε (snd (Basis→MeetSemilattice S isBasisS)) = 1l , isBasisS .contains1 + _·_ (snd (Basis→MeetSemilattice S isBasisS)) x y = fst x ∧l fst y , isBasisS .∧lClosed _ _ (snd x) (snd y) - isSemilattice (snd (Basis→MeetSemilattice S isBasisS)) = makeIsSemilattice + isSemilattice (snd (Basis→MeetSemilattice S isBasisS)) = makeIsSemilattice (isSetΣ is-set λ _ → isProp→isSet (S _ .snd)) - (λ _ _ _ → Σ≡Prop (λ _ → S _ .snd) (∧lAssoc _ _ _)) - (λ _ → Σ≡Prop (λ _ → S _ .snd) (∧lRid _)) - (λ _ _ → Σ≡Prop (λ _ → S _ .snd) (∧lComm _ _)) - λ _ → Σ≡Prop (λ _ → S _ .snd) (∧lIdem _) + (λ _ _ _ → Σ≡Prop (λ _ → S _ .snd) (∧lAssoc _ _ _)) + (λ _ → Σ≡Prop (λ _ → S _ .snd) (∧lRid _)) + (λ _ _ → Σ≡Prop (λ _ → S _ .snd) (∧lComm _ _)) + λ _ → Σ≡Prop (λ _ → S _ .snd) (∧lIdem _) \ No newline at end of file diff --git a/Cubical.Algebra.DistLattice.BigOps.html b/Cubical.Algebra.DistLattice.BigOps.html index 1c64308fc8..65076f6031 100644 --- a/Cubical.Algebra.DistLattice.BigOps.html +++ b/Cubical.Algebra.DistLattice.BigOps.html @@ -30,120 +30,120 @@ open import Cubical.Algebra.Semilattice open import Cubical.Algebra.Lattice open import Cubical.Algebra.DistLattice -open import Cubical.Relation.Binary.Poset - - -private - variable - ℓ : Level - -module KroneckerDelta (L' : DistLattice ℓ) where - private - L = fst L' - open DistLatticeStr (snd L') - - δ : {n : ℕ} (i j : Fin n) → L - δ i j = if i == j then 1l else 0l - - - -module Join (L' : DistLattice ℓ) where - private - L = fst L' - open DistLatticeStr (snd L') - open MonoidBigOp (Semilattice→Monoid (Lattice→JoinSemilattice (DistLattice→Lattice L'))) - open LatticeTheory (DistLattice→Lattice L') - open KroneckerDelta L' - - ⋁ = bigOp - ⋁Ext = bigOpExt - ⋁0l = bigOpε - ⋁Last = bigOpLast - - ⋁Split : ∀ {n} → (V W : FinVec L n) → ⋁ (λ i → V i ∨l W i) ≡ ⋁ V ∨l ⋁ W - ⋁Split = bigOpSplit ∨lComm - - ⋁Split++ : ∀ {n m : ℕ} (V : FinVec L n) (W : FinVec L m) - → ⋁ (V ++Fin W) ≡ ⋁ V ∨l ⋁ W - ⋁Split++ = bigOpSplit++ - - ⋁Meetrdist : ∀ {n} → (x : L) → (V : FinVec L n) - → x ∧l ⋁ V ≡ ⋁ λ i → x ∧l V i - ⋁Meetrdist {n = zero} x _ = 0lRightAnnihilates∧l x - ⋁Meetrdist {n = suc n} x V = - x ∧l (V zero ∨l ⋁ (V ∘ suc)) ≡⟨ ∧lLdist∨l _ _ _ ⟩ --Ldist and Rdist wrong way around? - (x ∧l V zero) ∨l (x ∧l ⋁ (V ∘ suc)) ≡⟨ (λ i → (x ∧l V zero) ∨l ⋁Meetrdist x (V ∘ suc) i) ⟩ - (x ∧l V zero) ∨l ⋁ (λ i → x ∧l V (suc i)) ∎ - - ⋁Meetldist : ∀ {n} → (x : L) → (V : FinVec L n) - → (⋁ V) ∧l x ≡ ⋁ λ i → V i ∧l x - ⋁Meetldist {n = zero} x _ = 0lLeftAnnihilates∧l x - ⋁Meetldist {n = suc n} x V = - (V zero ∨l ⋁ (V ∘ suc)) ∧l x ≡⟨ ∧lRdist∨l _ _ _ ⟩ - (V zero ∧l x) ∨l ((⋁ (V ∘ suc)) ∧l x) ≡⟨ (λ i → (V zero ∧l x) ∨l ⋁Meetldist x (V ∘ suc) i) ⟩ - (V zero ∧l x) ∨l ⋁ (λ i → V (suc i) ∧l x) ∎ - - ⋁Meetr0 : ∀ {n} → (V : FinVec L n) → ⋁ (λ i → V i ∧l 0l) ≡ 0l - ⋁Meetr0 V = sym (⋁Meetldist 0l V) ∙ 0lRightAnnihilates∧l _ - - ⋁Meet0r : ∀ {n} → (V : FinVec L n) → ⋁ (λ i → 0l ∧l V i) ≡ 0l - ⋁Meet0r V = sym (⋁Meetrdist 0l V) ∙ 0lLeftAnnihilates∧l _ - - ⋁Meetr1 : (n : ℕ) (V : FinVec L n) → (j : Fin n) → ⋁ (λ i → V i ∧l δ i j) ≡ V j - ⋁Meetr1 (suc n) V zero = (λ k → ∧lRid (V zero) k ∨l ⋁Meetr0 (V ∘ suc) k) ∙ ∨lRid (V zero) - ⋁Meetr1 (suc n) V (suc j) = - (λ i → 0lRightAnnihilates∧l (V zero) i ∨l ⋁ (λ x → V (suc x) ∧l δ x j)) - ∙∙ ∨lLid _ ∙∙ ⋁Meetr1 n (V ∘ suc) j - - ⋁Meet1r : (n : ℕ) (V : FinVec L n) → (j : Fin n) → ⋁ (λ i → (δ j i) ∧l V i) ≡ V j - ⋁Meet1r (suc n) V zero = (λ k → ∧lLid (V zero) k ∨l ⋁Meet0r (V ∘ suc) k) ∙ ∨lRid (V zero) - ⋁Meet1r (suc n) V (suc j) = - (λ i → 0lLeftAnnihilates∧l (V zero) i ∨l ⋁ (λ i → (δ j i) ∧l V (suc i))) - ∙∙ ∨lLid _ ∙∙ ⋁Meet1r n (V ∘ suc) j - - -- inequalities of big joins - open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L')) - ind≤⋁ = ind≤bigOp - ⋁IsMax = bigOpIsMax - ≤-⋁Ext = ≤-bigOpExt - - -module Meet (L' : DistLattice ℓ) where - private - L = fst L' - open DistLatticeStr (snd L') - open MonoidBigOp (Semilattice→Monoid (Lattice→MeetSemilattice (DistLattice→Lattice L'))) - -- extra DistLattice→MeetMonoid? - open LatticeTheory (DistLattice→Lattice L') - open KroneckerDelta L' - - ⋀ = bigOp - ⋀Ext = bigOpExt - ⋀1l = bigOpε - ⋀Last = bigOpLast - - ⋀Split : ∀ {n} → (V W : FinVec L n) → ⋀ (λ i → V i ∧l W i) ≡ ⋀ V ∧l ⋀ W - ⋀Split = bigOpSplit ∧lComm - - ⋀Joinrdist : ∀ {n} → (x : L) → (V : FinVec L n) - → x ∨l ⋀ V ≡ ⋀ λ i → x ∨l V i - ⋀Joinrdist {n = zero} x _ = 1lRightAnnihilates∨l x - ⋀Joinrdist {n = suc n} x V = - x ∨l (V zero ∧l ⋀ (V ∘ suc)) ≡⟨ ∨lLdist∧l _ _ _ ⟩ --Ldist and Rdist wrong way around? - (x ∨l V zero) ∧l (x ∨l ⋀ (V ∘ suc)) ≡⟨ (λ i → (x ∨l V zero) ∧l ⋀Joinrdist x (V ∘ suc) i) ⟩ - (x ∨l V zero) ∧l ⋀ (λ i → x ∨l V (suc i)) ∎ - - ⋀Joinldist : ∀ {n} → (x : L) → (V : FinVec L n) - → (⋀ V) ∨l x ≡ ⋀ λ i → V i ∨l x - ⋀Joinldist {n = zero} x _ = 1lLeftAnnihilates∨l x - ⋀Joinldist {n = suc n} x V = - (V zero ∧l ⋀ (V ∘ suc)) ∨l x ≡⟨ ∨lRdist∧l _ _ _ ⟩ - (V zero ∨l x) ∧l ((⋀ (V ∘ suc)) ∨l x) ≡⟨ (λ i → (V zero ∨l x) ∧l ⋀Joinldist x (V ∘ suc) i) ⟩ - (V zero ∨l x) ∧l ⋀ (λ i → V (suc i) ∨l x) ∎ - - ⋀Joinr1 : ∀ {n} → (V : FinVec L n) → ⋀ (λ i → V i ∨l 1l) ≡ 1l - ⋀Joinr1 V = sym (⋀Joinldist 1l V) ∙ 1lRightAnnihilates∨l _ - - ⋀Join1r : ∀ {n} → (V : FinVec L n) → ⋀ (λ i → 1l ∨l V i) ≡ 1l - ⋀Join1r V = sym (⋀Joinrdist 1l V) ∙ 1lLeftAnnihilates∨l _ +open import Cubical.Relation.Binary.Order.Poset + + +private + variable + ℓ : Level + +module KroneckerDelta (L' : DistLattice ℓ) where + private + L = fst L' + open DistLatticeStr (snd L') + + δ : {n : ℕ} (i j : Fin n) → L + δ i j = if i == j then 1l else 0l + + + +module Join (L' : DistLattice ℓ) where + private + L = fst L' + open DistLatticeStr (snd L') + open MonoidBigOp (Semilattice→Monoid (Lattice→JoinSemilattice (DistLattice→Lattice L'))) + open LatticeTheory (DistLattice→Lattice L') + open KroneckerDelta L' + + ⋁ = bigOp + ⋁Ext = bigOpExt + ⋁0l = bigOpε + ⋁Last = bigOpLast + + ⋁Split : ∀ {n} → (V W : FinVec L n) → ⋁ (λ i → V i ∨l W i) ≡ ⋁ V ∨l ⋁ W + ⋁Split = bigOpSplit ∨lComm + + ⋁Split++ : ∀ {n m : ℕ} (V : FinVec L n) (W : FinVec L m) + → ⋁ (V ++Fin W) ≡ ⋁ V ∨l ⋁ W + ⋁Split++ = bigOpSplit++ + + ⋁Meetrdist : ∀ {n} → (x : L) → (V : FinVec L n) + → x ∧l ⋁ V ≡ ⋁ λ i → x ∧l V i + ⋁Meetrdist {n = zero} x _ = 0lRightAnnihilates∧l x + ⋁Meetrdist {n = suc n} x V = + x ∧l (V zero ∨l ⋁ (V ∘ suc)) ≡⟨ ∧lLdist∨l _ _ _ ⟩ --Ldist and Rdist wrong way around? + (x ∧l V zero) ∨l (x ∧l ⋁ (V ∘ suc)) ≡⟨ (λ i → (x ∧l V zero) ∨l ⋁Meetrdist x (V ∘ suc) i) ⟩ + (x ∧l V zero) ∨l ⋁ (λ i → x ∧l V (suc i)) ∎ + + ⋁Meetldist : ∀ {n} → (x : L) → (V : FinVec L n) + → (⋁ V) ∧l x ≡ ⋁ λ i → V i ∧l x + ⋁Meetldist {n = zero} x _ = 0lLeftAnnihilates∧l x + ⋁Meetldist {n = suc n} x V = + (V zero ∨l ⋁ (V ∘ suc)) ∧l x ≡⟨ ∧lRdist∨l _ _ _ ⟩ + (V zero ∧l x) ∨l ((⋁ (V ∘ suc)) ∧l x) ≡⟨ (λ i → (V zero ∧l x) ∨l ⋁Meetldist x (V ∘ suc) i) ⟩ + (V zero ∧l x) ∨l ⋁ (λ i → V (suc i) ∧l x) ∎ + + ⋁Meetr0 : ∀ {n} → (V : FinVec L n) → ⋁ (λ i → V i ∧l 0l) ≡ 0l + ⋁Meetr0 V = sym (⋁Meetldist 0l V) ∙ 0lRightAnnihilates∧l _ + + ⋁Meet0r : ∀ {n} → (V : FinVec L n) → ⋁ (λ i → 0l ∧l V i) ≡ 0l + ⋁Meet0r V = sym (⋁Meetrdist 0l V) ∙ 0lLeftAnnihilates∧l _ + + ⋁Meetr1 : (n : ℕ) (V : FinVec L n) → (j : Fin n) → ⋁ (λ i → V i ∧l δ i j) ≡ V j + ⋁Meetr1 (suc n) V zero = (λ k → ∧lRid (V zero) k ∨l ⋁Meetr0 (V ∘ suc) k) ∙ ∨lRid (V zero) + ⋁Meetr1 (suc n) V (suc j) = + (λ i → 0lRightAnnihilates∧l (V zero) i ∨l ⋁ (λ x → V (suc x) ∧l δ x j)) + ∙∙ ∨lLid _ ∙∙ ⋁Meetr1 n (V ∘ suc) j + + ⋁Meet1r : (n : ℕ) (V : FinVec L n) → (j : Fin n) → ⋁ (λ i → (δ j i) ∧l V i) ≡ V j + ⋁Meet1r (suc n) V zero = (λ k → ∧lLid (V zero) k ∨l ⋁Meet0r (V ∘ suc) k) ∙ ∨lRid (V zero) + ⋁Meet1r (suc n) V (suc j) = + (λ i → 0lLeftAnnihilates∧l (V zero) i ∨l ⋁ (λ i → (δ j i) ∧l V (suc i))) + ∙∙ ∨lLid _ ∙∙ ⋁Meet1r n (V ∘ suc) j + + -- inequalities of big joins + open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L')) + ind≤⋁ = ind≤bigOp + ⋁IsMax = bigOpIsMax + ≤-⋁Ext = ≤-bigOpExt + + +module Meet (L' : DistLattice ℓ) where + private + L = fst L' + open DistLatticeStr (snd L') + open MonoidBigOp (Semilattice→Monoid (Lattice→MeetSemilattice (DistLattice→Lattice L'))) + -- extra DistLattice→MeetMonoid? + open LatticeTheory (DistLattice→Lattice L') + open KroneckerDelta L' + + ⋀ = bigOp + ⋀Ext = bigOpExt + ⋀1l = bigOpε + ⋀Last = bigOpLast + + ⋀Split : ∀ {n} → (V W : FinVec L n) → ⋀ (λ i → V i ∧l W i) ≡ ⋀ V ∧l ⋀ W + ⋀Split = bigOpSplit ∧lComm + + ⋀Joinrdist : ∀ {n} → (x : L) → (V : FinVec L n) + → x ∨l ⋀ V ≡ ⋀ λ i → x ∨l V i + ⋀Joinrdist {n = zero} x _ = 1lRightAnnihilates∨l x + ⋀Joinrdist {n = suc n} x V = + x ∨l (V zero ∧l ⋀ (V ∘ suc)) ≡⟨ ∨lLdist∧l _ _ _ ⟩ --Ldist and Rdist wrong way around? + (x ∨l V zero) ∧l (x ∨l ⋀ (V ∘ suc)) ≡⟨ (λ i → (x ∨l V zero) ∧l ⋀Joinrdist x (V ∘ suc) i) ⟩ + (x ∨l V zero) ∧l ⋀ (λ i → x ∨l V (suc i)) ∎ + + ⋀Joinldist : ∀ {n} → (x : L) → (V : FinVec L n) + → (⋀ V) ∨l x ≡ ⋀ λ i → V i ∨l x + ⋀Joinldist {n = zero} x _ = 1lLeftAnnihilates∨l x + ⋀Joinldist {n = suc n} x V = + (V zero ∧l ⋀ (V ∘ suc)) ∨l x ≡⟨ ∨lRdist∧l _ _ _ ⟩ + (V zero ∨l x) ∧l ((⋀ (V ∘ suc)) ∨l x) ≡⟨ (λ i → (V zero ∨l x) ∧l ⋀Joinldist x (V ∘ suc) i) ⟩ + (V zero ∨l x) ∧l ⋀ (λ i → V (suc i) ∨l x) ∎ + + ⋀Joinr1 : ∀ {n} → (V : FinVec L n) → ⋀ (λ i → V i ∨l 1l) ≡ 1l + ⋀Joinr1 V = sym (⋀Joinldist 1l V) ∙ 1lRightAnnihilates∨l _ + + ⋀Join1r : ∀ {n} → (V : FinVec L n) → ⋀ (λ i → 1l ∨l V i) ≡ 1l + ⋀Join1r V = sym (⋀Joinrdist 1l V) ∙ 1lLeftAnnihilates∨l _ \ No newline at end of file diff --git a/Cubical.Algebra.GradedRing.DirectSumFun.html b/Cubical.Algebra.GradedRing.DirectSumFun.html index 5355f5a0ff..2036056048 100644 --- a/Cubical.Algebra.GradedRing.DirectSumFun.html +++ b/Cubical.Algebra.GradedRing.DirectSumFun.html @@ -132,7 +132,7 @@ ... | no ¬p = refl ⊕HIT→⊕Fun-pres1 : ⊕HIT→⊕Fun (base 0 1⋆) ≡ 1⊕Fun - ⊕HIT→⊕Fun-pres1 = ΣPathTransport→PathΣ _ _ + ⊕HIT→⊕Fun-pres1 = ΣPathTransport→PathΣ _ _ ((funExt (λ n → ⊕HIT→Fun-pres1 n)) , (squash₁ _ _)) ----------------------------------------------------------------------------- @@ -350,7 +350,7 @@ ⊕HIT→⊕Fun-pres-prodF : (x y : ⊕HIT ℕ G Gstr) → ⊕HIT→⊕Fun (x prod y) ≡ ((⊕HIT→⊕Fun x) prodF (⊕HIT→⊕Fun y)) - ⊕HIT→⊕Fun-pres-prodF x y = ΣPathTransport→PathΣ _ _ + ⊕HIT→⊕Fun-pres-prodF x y = ΣPathTransport→PathΣ _ _ ((⊕HIT→Fun-pres-prodFun x y) , (squash₁ _ _)) diff --git a/Cubical.Algebra.GradedRing.Instances.CohomologyRing.html b/Cubical.Algebra.GradedRing.Instances.CohomologyRing.html index faa033df39..a1aa89b549 100644 --- a/Cubical.Algebra.GradedRing.Instances.CohomologyRing.html +++ b/Cubical.Algebra.GradedRing.Instances.CohomologyRing.html @@ -41,9 +41,9 @@ _⌣_ (λ {k} {l} → 0ₕ-⌣ k l) (λ {k} {l} → ⌣-0ₕ k l) - (λ _ _ _ → sym (ΣPathTransport→PathΣ _ _ ((sym (+'-assoc _ _ _)) , (sym (assoc-⌣ _ _ _ _ _ _)))) ) - (λ _ → sym (ΣPathTransport→PathΣ _ _ (sym (+'-rid _) , sym (lUnit⌣ _ _)))) - (λ _ → ΣPathTransport→PathΣ _ _ (refl , transportRefl _ ∙ rUnit⌣ _ _)) + (λ _ _ _ → sym (ΣPathTransport→PathΣ _ _ ((sym (+'-assoc _ _ _)) , (sym (assoc-⌣ _ _ _ _ _ _)))) ) + (λ _ → sym (ΣPathTransport→PathΣ _ _ (sym (+'-rid _) , sym (lUnit⌣ _ _)))) + (λ _ → ΣPathTransport→PathΣ _ _ (refl , transportRefl _ ∙ rUnit⌣ _ _)) (λ _ _ _ → leftDistr-⌣ _ _ _ _ _) ( λ _ _ _ → rightDistr-⌣ _ _ _ _ _) \ No newline at end of file diff --git a/Cubical.Algebra.GradedRing.Instances.CohomologyRingFun.html b/Cubical.Algebra.GradedRing.Instances.CohomologyRingFun.html index db1023c336..74493aa84b 100644 --- a/Cubical.Algebra.GradedRing.Instances.CohomologyRingFun.html +++ b/Cubical.Algebra.GradedRing.Instances.CohomologyRingFun.html @@ -40,9 +40,9 @@ _⌣_ (λ {k} {l} → 0ₕ-⌣ k l) (λ {k} {l} → ⌣-0ₕ k l) - (λ _ _ _ → sym (ΣPathTransport→PathΣ _ _ ((sym (+'-assoc _ _ _)) , (sym (assoc-⌣ _ _ _ _ _ _))))) - (λ _ → sym (ΣPathTransport→PathΣ _ _ (sym (+'-rid _) , sym (lUnit⌣ _ _)))) - (λ _ → ΣPathTransport→PathΣ _ _ (refl , transportRefl _ ∙ rUnit⌣ _ _)) + (λ _ _ _ → sym (ΣPathTransport→PathΣ _ _ ((sym (+'-assoc _ _ _)) , (sym (assoc-⌣ _ _ _ _ _ _))))) + (λ _ → sym (ΣPathTransport→PathΣ _ _ (sym (+'-rid _) , sym (lUnit⌣ _ _)))) + (λ _ → ΣPathTransport→PathΣ _ _ (refl , transportRefl _ ∙ rUnit⌣ _ _)) (λ _ _ _ → leftDistr-⌣ _ _ _ _ _) λ _ _ _ → rightDistr-⌣ _ _ _ _ _ \ No newline at end of file diff --git a/Cubical.Algebra.GradedRing.Instances.TrivialGradedRing.html b/Cubical.Algebra.GradedRing.Instances.TrivialGradedRing.html index 3f65c8ed39..e558eec5c2 100644 --- a/Cubical.Algebra.GradedRing.Instances.TrivialGradedRing.html +++ b/Cubical.Algebra.GradedRing.Instances.TrivialGradedRing.html @@ -62,18 +62,18 @@ _≡_ {A = Σ[ k ∈ ℕ ] G k} (k Cubical.Data.Nat.+ (l Cubical.Data.Nat.+ m) , ⋆ a (⋆ b c)) (k Cubical.Data.Nat.+ l Cubical.Data.Nat.+ m , ⋆ (⋆ a b) c) - ⋆Assoc {zero} {zero} {zero} a b c = ΣPathTransport→PathΣ _ _ (+-assoc _ _ _ , transportRefl _ ∙ ·Assoc _ _ _) - ⋆Assoc {zero} {zero} {suc m} a b c = ΣPathTransport→PathΣ _ _ (+-assoc _ _ _ , transportRefl _) - ⋆Assoc {zero} {suc l} {m} a b c = ΣPathTransport→PathΣ _ _ (+-assoc _ _ _ , transportRefl _) - ⋆Assoc {suc k} {l} {m} a b c = ΣPathTransport→PathΣ _ _ (+-assoc _ _ _ , transportRefl _) + ⋆Assoc {zero} {zero} {zero} a b c = ΣPathTransport→PathΣ _ _ (+-assoc _ _ _ , transportRefl _ ∙ ·Assoc _ _ _) + ⋆Assoc {zero} {zero} {suc m} a b c = ΣPathTransport→PathΣ _ _ (+-assoc _ _ _ , transportRefl _) + ⋆Assoc {zero} {suc l} {m} a b c = ΣPathTransport→PathΣ _ _ (+-assoc _ _ _ , transportRefl _) + ⋆Assoc {suc k} {l} {m} a b c = ΣPathTransport→PathΣ _ _ (+-assoc _ _ _ , transportRefl _) ⋆IdR : {k : ℕ} (a : G k) → _≡_ {A = Σ[ k ∈ ℕ ] G k} (k Cubical.Data.Nat.+ 0 , ⋆ a 1r) (k , a) - ⋆IdR {zero} a = ΣPathTransport→PathΣ _ _ (refl , (transportRefl _ ∙ ·IdR _)) - ⋆IdR {suc k} a = ΣPathTransport→PathΣ _ _ ((+-zero _) , (transportRefl _)) + ⋆IdR {zero} a = ΣPathTransport→PathΣ _ _ (refl , (transportRefl _ ∙ ·IdR _)) + ⋆IdR {suc k} a = ΣPathTransport→PathΣ _ _ ((+-zero _) , (transportRefl _)) ⋆IdL : {l : ℕ} (b : G l) → _≡_ {A = Σ[ k ∈ ℕ ] G k} (l , ⋆ 1r b) (l , b) - ⋆IdL {zero} b = ΣPathTransport→PathΣ _ _ (refl , (transportRefl _ ∙ ·IdL _)) - ⋆IdL {suc l} b = ΣPathTransport→PathΣ _ _ (refl , (transportRefl _)) + ⋆IdL {zero} b = ΣPathTransport→PathΣ _ _ (refl , (transportRefl _ ∙ ·IdL _)) + ⋆IdL {suc l} b = ΣPathTransport→PathΣ _ _ (refl , (transportRefl _)) ⋆DistR+ : {k l : ℕ} (a : G k) (b c : G l) → ⋆ a (Gstr l .AbGroupStr._+_ b c) ≡ Gstr (k Cubical.Data.Nat.+ l) .AbGroupStr._+_ (⋆ a b) (⋆ a c) diff --git a/Cubical.Algebra.Group.Abelianization.AbelianizationAsCoeq.html b/Cubical.Algebra.Group.Abelianization.AbelianizationAsCoeq.html index 547959142a..00060b766b 100644 --- a/Cubical.Algebra.Group.Abelianization.AbelianizationAsCoeq.html +++ b/Cubical.Algebra.Group.Abelianization.AbelianizationAsCoeq.html @@ -241,7 +241,7 @@ → (f : GroupHom G (AbGroup→Group H)) → (compGroupHom incAbAsGroupHom (inducedHom H f) ≡ f) commutativity H f = - Σ≡Prop + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (λ i x → q x i) where q : (x : fst G) @@ -254,7 +254,7 @@ → (p : compGroupHom incAbAsGroupHom g ≡ f) → (g ≡ inducedHom H f) uniqueness H f g p = - Σ≡Prop + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (λ i x → q x i) where @@ -375,7 +375,7 @@ (GroupIso→GroupHom h) (GroupIso→GroupHom (invGroupIso h))) ≡ idGroupHom leftInvGroupHom = - Σ≡Prop + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (λ i x → r x i) @@ -411,7 +411,7 @@ (HITηAsGroupHom G) (GroupIso→GroupHom (invGroupIso h)) ≡ incAbAsGroupHom isocomm = - Σ≡Prop + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (λ i x → q x i) diff --git a/Cubical.Algebra.Group.Abelianization.Properties.html b/Cubical.Algebra.Group.Abelianization.Properties.html index 8520303628..0386032a10 100644 --- a/Cubical.Algebra.Group.Abelianization.Properties.html +++ b/Cubical.Algebra.Group.Abelianization.Properties.html @@ -276,7 +276,7 @@ → (f : GroupHom G (AbGroup→Group H)) → (compGroupHom ηAsGroupHom (inducedHom H f) ≡ f) commutativity H f = - Σ≡Prop + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (λ i x → q x i) where q : (x : fst G) @@ -289,7 +289,7 @@ → (p : compGroupHom ηAsGroupHom g ≡ f) → (g ≡ inducedHom H f) uniqueness H f g p = - Σ≡Prop + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (λ i x → q x i) where diff --git a/Cubical.Algebra.Group.GroupPath.html b/Cubical.Algebra.Group.GroupPath.html index 2ad1ba7e10..b2265c2202 100644 --- a/Cubical.Algebra.Group.GroupPath.html +++ b/Cubical.Algebra.Group.GroupPath.html @@ -160,7 +160,7 @@ ∙∙ transportTransport⁻ (ua (Group≡ G H)) q where helper : transport (sym (ua (Group≡ G H))) p ≡ transport (sym (ua (Group≡ G H))) q - helper = Σ≡Prop + helper = Σ≡Prop (λ _ → isPropΣ (isOfHLevelPathP' 1 (is-set (snd H)) _ _) λ _ → isPropΣ (isOfHLevelPathP' 1 (isSetΠ2 λ _ _ → is-set (snd H)) _ _) @@ -191,8 +191,8 @@ where lem : transport (λ j → GroupEquiv G (GroupPath G H .fst e (~ j))) e ≡ idGroupEquiv - lem = Σ≡Prop (λ _ → isPropIsGroupHom _ _) - (Σ≡Prop (λ _ → isPropIsEquiv _) + lem = Σ≡Prop (λ _ → isPropIsGroupHom _ _) + (Σ≡Prop (λ _ → isPropIsEquiv _) (funExt λ x → (λ i → fst (fst (fst e .snd .equiv-proof (transportRefl (fst (fst e) (transportRefl x i)) i)))) ∙ retEq (fst e) x)) diff --git a/Cubical.Algebra.Group.Instances.IntMod.html b/Cubical.Algebra.Group.Instances.IntMod.html index 21b3975844..e4a459fa2c 100644 --- a/Cubical.Algebra.Group.Instances.IntMod.html +++ b/Cubical.Algebra.Group.Instances.IntMod.html @@ -57,9 +57,9 @@ Iso.inv (fst Bool≅ℤGroup/2) (suc (suc x) , p) = ⊥.rec (¬-<-zero (predℕ-≤-predℕ (predℕ-≤-predℕ p))) Iso.rightInv (fst Bool≅ℤGroup/2) (zero , p) = - Σ≡Prop (λ _ → isProp≤) refl + Σ≡Prop (λ _ → isProp≤) refl Iso.rightInv (fst Bool≅ℤGroup/2) (suc zero , p) = - Σ≡Prop (λ _ → isProp≤) refl + Σ≡Prop (λ _ → isProp≤) refl Iso.rightInv (fst Bool≅ℤGroup/2) (suc (suc x) , p) = ⊥.rec (¬-<-zero (predℕ-≤-predℕ (predℕ-≤-predℕ p))) Iso.leftInv (fst Bool≅ℤGroup/2) false = refl @@ -81,11 +81,11 @@ ℤ→Fin-presinv : (n : ℕ) (x : ℤ) → ℤ→Fin n (- x) ≡ -ₘ ℤ→Fin n x ℤ→Fin-presinv n (pos zero) = - Σ≡Prop (λ _ → isProp≤) ((λ _ → zero) ∙ sym (cong fst help)) + Σ≡Prop (λ _ → isProp≤) ((λ _ → zero) ∙ sym (cong fst help)) where help : (-ₘ_ {n = n} 0) ≡ 0 help = GroupTheory.inv1g (ℤGroup/ (suc n)) -ℤ→Fin-presinv n (pos (suc x)) = Σ≡Prop (λ _ → isProp≤) refl +ℤ→Fin-presinv n (pos (suc x)) = Σ≡Prop (λ _ → isProp≤) refl ℤ→Fin-presinv n (negsuc x) = sym (GroupTheory.invInv (ℤGroup/ (suc n)) _) @@ -97,7 +97,7 @@ -ₘ1-id (suc n) = cong -ₘ_ (FinPathℕ ((1 mod suc (suc n)) , mod< (suc n) 1) 1 (modIndBase (suc n) 1 (n , +-comm n 2)) .snd) - ∙ Σ≡Prop (λ _ → isProp≤) + ∙ Σ≡Prop (λ _ → isProp≤) ((+inductionBase (suc n) _ (λ x _ → ((suc (suc n)) ∸ x) mod (suc (suc n))) λ _ x → x) 1 (n , (+-comm n 2))) @@ -111,7 +111,7 @@ suc-ₘ1 (suc n) y = (λ i → ((suc y mod suc (suc n)) , mod< (suc n) (suc y)) +ₘ (-ₘ1-id (suc n) i)) - ∙ Σ≡Prop (λ _ → isProp≤) + ∙ Σ≡Prop (λ _ → isProp≤) (cong (_mod (2 +ℕ n)) (cong (_+ℕ (suc n) mod (2 +ℕ n)) (mod+mod≡mod (suc (suc n)) 1 y)) @@ -168,12 +168,12 @@ +1case (pos zero) = sym (GroupStr.·IdR (snd (ℤGroup/ (suc n))) _) +1case (pos (suc y)) = cong (ℤ→Fin n) (+Comm 1 (pos (suc y))) - ∙ Σ≡Prop (λ _ → isProp≤) (mod+mod≡mod (suc n) 1 (suc y)) + ∙ Σ≡Prop (λ _ → isProp≤) (mod+mod≡mod (suc n) 1 (suc y)) +1case (negsuc zero) = - Σ≡Prop (λ _ → isProp≤) refl + Σ≡Prop (λ _ → isProp≤) refl ∙ sym (GroupStr.·InvR (snd (ℤGroup/ (suc n))) (modInd n 1 , mod< n 1)) +1case (negsuc (suc y)) = - Σ≡Prop (λ _ → isProp≤) + Σ≡Prop (λ _ → isProp≤) (cong fst (cong (ℤ→Fin n) (+Comm 1 (negsuc (suc y)))) ∙∙ cong fst (cong -ₘ_ (refl {x = suc y mod suc n , mod< n (suc y)})) ∙∙ cong fst (sym (1-ₘsuc n (suc y))) @@ -199,7 +199,7 @@ → (modInd n 1 , mod< n 1) +ₘ (modInd n (suc x) , mod< n (suc x)) ≡ ℤ→Fin n (pos (suc (suc x))) lem x = - Σ≡Prop (λ _ → isProp≤) (sym (mod+mod≡mod (suc n) 1 (suc x))) + Σ≡Prop (λ _ → isProp≤) (sym (mod+mod≡mod (suc n) 1 (suc x))) -- ℤ/2 lemmas ℤ/2-elim : ∀ {ℓ} {A : Fin 2 → Type ℓ} → A 0 → A 1 → (x : _) → A x diff --git a/Cubical.Algebra.Group.IsomorphismTheorems.html b/Cubical.Algebra.Group.IsomorphismTheorems.html index 6e784acb4d..1538f3c691 100644 --- a/Cubical.Algebra.Group.IsomorphismTheorems.html +++ b/Cubical.Algebra.Group.IsomorphismTheorems.html @@ -74,7 +74,7 @@ f2 : ⟨ G / kerNormalSubgroup ⟩ → ⟨ imϕ ⟩ f2 = recS imG.is-set (λ y → ϕ .fst y , ∣ y , refl ∣₁) - (λ x y r → Σ≡Prop (λ _ → squash₁) + (λ x y r → Σ≡Prop (λ _ → squash₁) (rem x y r)) where rem : (x y : ⟨ G ⟩) → ϕ .fst (x G.· G.inv y) ≡ H.1g → ϕ .fst x ≡ ϕ .fst y @@ -94,7 +94,7 @@ f21 : (x : ⟨ imϕ ⟩) → f2 (f1 x) ≡ x f21 (x , hx) = elim {P = λ hx → f2 (f1 (x , hx)) ≡ (x , hx)} (λ _ → imG.is-set _ _) - (λ {(x , hx) → Σ≡Prop (λ _ → squash₁) hx}) + (λ {(x , hx) → Σ≡Prop (λ _ → squash₁) hx}) hx f1-isHom : (x y : ⟨ imϕ ⟩) → f1 (x imG.· y) ≡ f1 x kerG.· f1 y @@ -121,7 +121,7 @@ (uncurry (λ h → elim (λ _ → isPropΠ (λ _ → imG.is-set _ _)) (uncurry λ g y - → λ inker → Σ≡Prop (λ _ → squash₁) inker))) + → λ inker → Σ≡Prop (λ _ → squash₁) inker))) λ b → map (λ x → (b , ∣ x ∣₁) , refl) (surj b)) where indHom : GroupHom imϕ H diff --git a/Cubical.Algebra.Group.MorphismProperties.html b/Cubical.Algebra.Group.MorphismProperties.html index c66ee8c4bb..4c7e51ec88 100644 --- a/Cubical.Algebra.Group.MorphismProperties.html +++ b/Cubical.Algebra.Group.MorphismProperties.html @@ -157,7 +157,7 @@ isInjective→isContrKer : (f : GroupHom G H) → isInjective f → isContr (Ker f) fst (isInjective→isContrKer {G = G} f hf) = 1g (snd G) , f .snd .pres1 snd (isInjective→isContrKer {G = G} f hf) k = - Σ≡Prop (isPropIsInKer f) (sym (isInjective→isMono f hf (k .snd ∙ sym (f .snd .pres1)))) + Σ≡Prop (isPropIsInKer f) (sym (isInjective→isMono f hf (k .snd ∙ sym (f .snd .pres1)))) isContrKer→isInjective : (f : GroupHom G H) → isContr (Ker f) → isInjective f isContrKer→isInjective {G = G} f ((a , b) , c) x y = cong fst (sym (c (x , y)) ∙ rem) @@ -225,7 +225,7 @@ GroupEquivDirProd : {A : Group ℓ} {B : Group ℓ'} {C : Group ℓ''} {D : Group ℓ'''} → GroupEquiv A C → GroupEquiv B D → GroupEquiv (DirProd A B) (DirProd C D) -fst (GroupEquivDirProd eq1 eq2) = ≃-× (fst eq1) (fst eq2) +fst (GroupEquivDirProd eq1 eq2) = ≃-× (fst eq1) (fst eq2) snd (GroupEquivDirProd eq1 eq2) = GroupHomDirProd (_ , eq1 .snd) (_ , eq2 .snd) .snd GroupEquiv≡ : {f g : GroupEquiv G H} → fst f ≡ fst g → f ≡ g @@ -294,7 +294,7 @@ helper : (b : _) → isProp (Σ[ a ∈ ⟨ G ⟩ ] f a ≡ b) helper _ (a , ha) (b , hb) = - Σ≡Prop (λ _ → is-set (snd H) _ _) + Σ≡Prop (λ _ → is-set (snd H) _ _) (isInjective→isMono (fun i) (inj i) (ha ∙ sym hb) ) grIso : GroupIso G H diff --git a/Cubical.Algebra.Group.QuotientGroup.html b/Cubical.Algebra.Group.QuotientGroup.html index cbb9c1985f..338e8fbb3f 100644 --- a/Cubical.Algebra.Group.QuotientGroup.html +++ b/Cubical.Algebra.Group.QuotientGroup.html @@ -30,7 +30,7 @@ module _ (G' : Group ℓ) (H' : Subgroup G') (Hnormal : isNormal H') where - open BinaryRelation + open BinaryRelation open isSubgroup (snd H') open GroupStr (snd G') open GroupTheory G' @@ -40,7 +40,7 @@ _~_ : G → G → Type ℓ x ~ y = x · inv y ∈ ⟪ H' ⟫ - isRefl~ : isRefl _~_ + isRefl~ : isRefl _~_ isRefl~ x = subst-∈ ⟪ H' ⟫ (sym (·InvR x)) id-closed G/H : Type ℓ @@ -119,7 +119,7 @@ Code g = elim (λ _ → isSetHProp) (λ a → (g ≡ a) , is-set _ _) - λ a b r → Σ≡Prop (λ _ → isPropIsProp) (cong (g ≡_) (contrH a b r)) + λ a b r → Σ≡Prop (λ _ → isPropIsProp) (cong (g ≡_) (contrH a b r)) decode : (g : G) (x : G/H') → [ g ] ≡ x → Code g x .fst decode g x = J (λ x _ → Code g x .fst) refl diff --git a/Cubical.Algebra.Group.ZAction.html b/Cubical.Algebra.Group.ZAction.html index df14ac8f51..ce0b31e326 100644 --- a/Cubical.Algebra.Group.ZAction.html +++ b/Cubical.Algebra.Group.ZAction.html @@ -401,15 +401,15 @@ → (e ≡ idGroupEquiv) ⊎ (e ≡ negEquivℤ) characℤ≅ℤ e = ⊎-rec - (λ p → inl (Σ≡Prop (λ _ → isPropIsGroupHom _ _) - (Σ≡Prop (λ _ → isPropIsEquiv _) + (λ p → inl (Σ≡Prop (λ _ → isPropIsGroupHom _ _) + (Σ≡Prop (λ _ → isPropIsEquiv _) (funExt λ x → cong (e .fst .fst) (·Comm 1 x) ∙ GroupHomℤ→ℤPres· (fst (fst e) , snd e) x 1 ∙ cong (x *_) p ∙ ·Comm x 1)))) - (λ p → inr (Σ≡Prop (λ _ → isPropIsGroupHom _ _) - (Σ≡Prop (λ _ → isPropIsEquiv _) + (λ p → inr (Σ≡Prop (λ _ → isPropIsGroupHom _ _) + (Σ≡Prop (λ _ → isPropIsEquiv _) (funExt λ x → cong (fst (fst e)) (sym (·Rid x)) ∙ GroupHomℤ→ℤPres· ((fst (fst e)) , (snd e)) x 1 @@ -458,7 +458,7 @@ -- Characterisation of ℤ→ℤ characGroupHomℤ : (e : GroupHom ℤGroup ℤGroup) → e ≡ ℤHom (fst e (pos 1)) characGroupHomℤ e = - Σ≡Prop (λ _ → isPropIsGroupHom _ _) + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt λ { (pos n) → lem n ; (negsuc n) → presinv (snd e) (pos (suc n)) @@ -506,13 +506,13 @@ where lem : (x : ℤ) → ℤ→Fin n (pos (suc n) * x) ≡ 0 lem (pos x) = cong (ℤ→Fin n) (sym (pos· (suc n) x)) - ∙ Σ≡Prop (λ _ → isProp≤) + ∙ Σ≡Prop (λ _ → isProp≤) (cong (_mod (suc n)) (·-comm (suc n) x) ∙ zero-charac-gen (suc n) x) lem (negsuc x) = cong (ℤ→Fin n) (pos·negsuc (suc n) x ∙ cong -_ (sym (pos· (suc n) (suc x)))) - ∙∙ cong -ₘ_ (Σ≡Prop (λ _ → isProp≤) + ∙∙ cong -ₘ_ (Σ≡Prop (λ _ → isProp≤) (cong (_mod (suc n)) (·-comm (suc n) (suc x)) ∙ zero-charac-gen (suc n) (suc x))) ∙∙ GroupTheory.inv1g (ℤGroup/ (suc n)) @@ -545,7 +545,7 @@ ∙∙ cong -_ (cong pos (≡remainder+quotient (suc n) (suc x))))) ∣₁}) BijectionIso.surj (ℤHom→ℤ/im≅ℤ/im1 n p) x = ∣ [ pos (fst x) ] - , (Σ≡Prop (λ _ → isProp≤) (modIndBase n (fst x) (snd x))) ∣₁ + , (Σ≡Prop (λ _ → isProp≤) (modIndBase n (fst x) (snd x))) ∣₁ -- main result ℤ/imIso : (f : GroupHom ℤGroup ℤGroup) @@ -566,9 +566,9 @@ extendHom = compGroupHom f (fst (fst negEquivℤ) , snd negEquivℤ) lem1 : imℤHomSubGroup f ≡ imℤHomSubGroup extendHom - lem1 = Σ≡Prop (λ _ → isPropIsNormal _) - (Σ≡Prop (λ _ → isPropIsSubgroup _ _) - (funExt λ x → Σ≡Prop (λ _ → isPropIsProp) + lem1 = Σ≡Prop (λ _ → isPropIsNormal _) + (Σ≡Prop (λ _ → isPropIsSubgroup _ _) + (funExt λ x → Σ≡Prop (λ _ → isPropIsProp) (isoToPath (iso (Prop.map (λ { (x , q) → (- x) , cong -_ (presinv (snd f) x) ∙ GroupTheory.invInv ℤGroup (fst f x) @@ -587,9 +587,9 @@ private imf≡kerg : imℤHomSubGroup f ≡ kerNormalSubgroup g imf≡kerg = - Σ≡Prop (λ _ → isPropIsNormal _) - (Σ≡Prop (λ _ → isPropIsSubgroup _ _) - (funExt λ x → Σ≡Prop (λ _ → isPropIsProp) + Σ≡Prop (λ _ → isPropIsNormal _) + (Σ≡Prop (λ _ → isPropIsSubgroup _ _) + (funExt λ x → Σ≡Prop (λ _ → isPropIsProp) (isoToPath (isProp→Iso (isPropIsInIm _ _) diff --git a/Cubical.Algebra.Lattice.Base.html b/Cubical.Algebra.Lattice.Base.html index 33e0df391e..036530cf96 100644 --- a/Cubical.Algebra.Lattice.Base.html +++ b/Cubical.Algebra.Lattice.Base.html @@ -39,30 +39,30 @@ constructor islattice field - joinSemilattice : IsSemilattice 0l _∨l_ - meetSemilattice : IsSemilattice 1l _∧l_ + joinSemilattice : IsSemilattice 0l _∨l_ + meetSemilattice : IsSemilattice 1l _∧l_ absorb : (x y : L) → (x ∨l (x ∧l y) ≡ x) × (x ∧l (x ∨l y) ≡ x) - open IsSemilattice joinSemilattice public + open IsSemilattice joinSemilattice public renaming ( ·Assoc to ∨lAssoc ; ·IdL to ∨lLid ; ·IdR to ∨lRid ; ·Comm to ∨lComm - ; idem to ∨lIdem - ; isCommMonoid to ∨lIsCommMonoid + ; idem to ∨lIdem + ; isCommMonoid to ∨lIsCommMonoid ; isMonoid to ∨lIsMonoid ; isSemigroup to ∨lIsSemigroup ) - open IsSemilattice meetSemilattice public + open IsSemilattice meetSemilattice public renaming ( ·Assoc to ∧lAssoc ; ·IdL to ∧lLid ; ·IdR to ∧lRid ; ·Comm to ∧lComm - ; idem to ∧lIdem - ; isCommMonoid to ∧lIsCommMonoid + ; idem to ∧lIdem + ; isCommMonoid to ∧lIsCommMonoid ; isMonoid to ∧lIsMonoid ; isSemigroup to ∧lIsSemigroup ) hiding @@ -108,8 +108,8 @@ makeIsLattice {0l = 0l} {1l = 1l} {_∨l_ = _∨l_} {_∧l_ = _∧l_} is-setL ∨l-assoc ∨l-rid ∨l-comm ∧l-assoc ∧l-rid ∧l-comm ∨l-absorb-∧l ∧l-absorb-∨l = - islattice (makeIsSemilattice is-setL ∨l-assoc ∨l-rid ∨l-comm ∨l-idem) - (makeIsSemilattice is-setL ∧l-assoc ∧l-rid ∧l-comm ∧l-idem) + islattice (makeIsSemilattice is-setL ∨l-assoc ∨l-rid ∨l-comm ∨l-idem) + (makeIsSemilattice is-setL ∧l-assoc ∧l-rid ∧l-comm ∧l-idem) λ x y → ∨l-absorb-∧l x y , ∧l-absorb-∨l x y where ∨l-idem : ∀ x → x ∨l x ≡ x @@ -175,11 +175,11 @@ isPropIsLattice : {L : Type ℓ} (0l 1l : L) (_∨l_ _∧l_ : L → L → L) → isProp (IsLattice 0l 1l _∨l_ _∧l_) isPropIsLattice 0l 1l _∨l_ _∧l_ (islattice LJ LM LA) (islattice MJ MM MA) = - λ i → islattice (isPropIsSemilattice _ _ LJ MJ i) - (isPropIsSemilattice _ _ LM MM i) + λ i → islattice (isPropIsSemilattice _ _ LJ MJ i) + (isPropIsSemilattice _ _ LM MM i) (isPropAbsorb LA MA i) where - open IsSemilattice LJ using (is-set) + open IsSemilattice LJ using (is-set) isPropAbsorb : isProp ((x y : _) → (x ∨l (x ∧l y) ≡ x) × (x ∧l (x ∨l y) ≡ x)) isPropAbsorb = isPropΠ2 λ _ _ → isProp× (is-set _ _) (is-set _ _) @@ -216,9 +216,9 @@ LatticePath = ∫ 𝒮ᴰ-Lattice .UARel.ua -Lattice→JoinSemilattice : Lattice ℓ → Semilattice ℓ -Lattice→JoinSemilattice (A , latticestr _ _ _ _ L) = semilattice _ _ _ (L .IsLattice.joinSemilattice ) +Lattice→JoinSemilattice : Lattice ℓ → Semilattice ℓ +Lattice→JoinSemilattice (A , latticestr _ _ _ _ L) = semilattice _ _ _ (L .IsLattice.joinSemilattice ) -Lattice→MeetSemilattice : Lattice ℓ → Semilattice ℓ -Lattice→MeetSemilattice (A , latticestr _ _ _ _ L) = semilattice _ _ _ (L .IsLattice.meetSemilattice ) +Lattice→MeetSemilattice : Lattice ℓ → Semilattice ℓ +Lattice→MeetSemilattice (A , latticestr _ _ _ _ L) = semilattice _ _ _ (L .IsLattice.meetSemilattice ) \ No newline at end of file diff --git a/Cubical.Algebra.Lattice.Properties.html b/Cubical.Algebra.Lattice.Properties.html index a60c20c974..2a4e927d19 100644 --- a/Cubical.Algebra.Lattice.Properties.html +++ b/Cubical.Algebra.Lattice.Properties.html @@ -22,76 +22,76 @@ open import Cubical.Algebra.Semilattice open import Cubical.Algebra.Lattice.Base -open import Cubical.Relation.Binary.Poset +open import Cubical.Relation.Binary.Order.Poset -private - variable - ℓ : Level +private + variable + ℓ : Level -module LatticeTheory (L' : Lattice ℓ) where - private L = fst L' - open LatticeStr (snd L') +module LatticeTheory (L' : Lattice ℓ) where + private L = fst L' + open LatticeStr (snd L') - 0lLeftAnnihilates∧l : ∀ (x : L) → 0l ∧l x ≡ 0l - 0lLeftAnnihilates∧l x = 0l ∧l x ≡⟨ cong (0l ∧l_) (sym (∨lLid _)) ⟩ - 0l ∧l (0l ∨l x) ≡⟨ ∧lAbsorb∨l _ _ ⟩ - 0l ∎ + 0lLeftAnnihilates∧l : ∀ (x : L) → 0l ∧l x ≡ 0l + 0lLeftAnnihilates∧l x = 0l ∧l x ≡⟨ cong (0l ∧l_) (sym (∨lLid _)) ⟩ + 0l ∧l (0l ∨l x) ≡⟨ ∧lAbsorb∨l _ _ ⟩ + 0l ∎ - 0lRightAnnihilates∧l : ∀ (x : L) → x ∧l 0l ≡ 0l - 0lRightAnnihilates∧l _ = ∧lComm _ _ ∙ 0lLeftAnnihilates∧l _ + 0lRightAnnihilates∧l : ∀ (x : L) → x ∧l 0l ≡ 0l + 0lRightAnnihilates∧l _ = ∧lComm _ _ ∙ 0lLeftAnnihilates∧l _ - 1lLeftAnnihilates∨l : ∀ (x : L) → 1l ∨l x ≡ 1l - 1lLeftAnnihilates∨l x = 1l ∨l x ≡⟨ cong (1l ∨l_) (sym (∧lLid _)) ⟩ - 1l ∨l (1l ∧l x) ≡⟨ ∨lAbsorb∧l _ _ ⟩ - 1l ∎ + 1lLeftAnnihilates∨l : ∀ (x : L) → 1l ∨l x ≡ 1l + 1lLeftAnnihilates∨l x = 1l ∨l x ≡⟨ cong (1l ∨l_) (sym (∧lLid _)) ⟩ + 1l ∨l (1l ∧l x) ≡⟨ ∨lAbsorb∧l _ _ ⟩ + 1l ∎ - 1lRightAnnihilates∨l : ∀ (x : L) → x ∨l 1l ≡ 1l - 1lRightAnnihilates∨l _ = ∨lComm _ _ ∙ 1lLeftAnnihilates∨l _ + 1lRightAnnihilates∨l : ∀ (x : L) → x ∨l 1l ≡ 1l + 1lRightAnnihilates∨l _ = ∨lComm _ _ ∙ 1lLeftAnnihilates∨l _ -module Order (L' : Lattice ℓ) where - private L = fst L' - open LatticeStr (snd L') - open JoinSemilattice (Lattice→JoinSemilattice L') renaming (_≤_ to _≤j_ ; IndPoset to JoinPoset) - open MeetSemilattice (Lattice→MeetSemilattice L') renaming (_≤_ to _≤m_ ; IndPoset to MeetPoset) +module Order (L' : Lattice ℓ) where + private L = fst L' + open LatticeStr (snd L') + open JoinSemilattice (Lattice→JoinSemilattice L') renaming (_≤_ to _≤j_ ; IndPoset to JoinPoset) + open MeetSemilattice (Lattice→MeetSemilattice L') renaming (_≤_ to _≤m_ ; IndPoset to MeetPoset) - ≤j→≤m : ∀ x y → x ≤j y → x ≤m y - ≤j→≤m x y x∨ly≡y = x ∧l y ≡⟨ cong (x ∧l_) (sym x∨ly≡y) ⟩ - x ∧l (x ∨l y) ≡⟨ ∧lAbsorb∨l _ _ ⟩ - x ∎ + ≤j→≤m : ∀ x y → x ≤j y → x ≤m y + ≤j→≤m x y x∨ly≡y = x ∧l y ≡⟨ cong (x ∧l_) (sym x∨ly≡y) ⟩ + x ∧l (x ∨l y) ≡⟨ ∧lAbsorb∨l _ _ ⟩ + x ∎ - ≤m→≤j : ∀ x y → x ≤m y → x ≤j y - ≤m→≤j x y x∧ly≡x = x ∨l y ≡⟨ ∨lComm _ _ ⟩ - y ∨l x ≡⟨ cong (y ∨l_) (sym x∧ly≡x) ⟩ - y ∨l (x ∧l y) ≡⟨ cong (y ∨l_) (∧lComm _ _) ⟩ - y ∨l (y ∧l x) ≡⟨ ∨lAbsorb∧l _ _ ⟩ - y ∎ + ≤m→≤j : ∀ x y → x ≤m y → x ≤j y + ≤m→≤j x y x∧ly≡x = x ∨l y ≡⟨ ∨lComm _ _ ⟩ + y ∨l x ≡⟨ cong (y ∨l_) (sym x∧ly≡x) ⟩ + y ∨l (x ∧l y) ≡⟨ cong (y ∨l_) (∧lComm _ _) ⟩ + y ∨l (y ∧l x) ≡⟨ ∨lAbsorb∧l _ _ ⟩ + y ∎ - ≤Equiv : ∀ (x y : L) → (x ≤j y) ≃ (x ≤m y) - ≤Equiv x y = propBiimpl→Equiv (is-set _ _) (is-set _ _) (≤j→≤m x y) (≤m→≤j x y) + ≤Equiv : ∀ (x y : L) → (x ≤j y) ≃ (x ≤m y) + ≤Equiv x y = propBiimpl→Equiv (is-set _ _) (is-set _ _) (≤j→≤m x y) (≤m→≤j x y) - IndPosetPath : JoinPoset ≡ MeetPoset - IndPosetPath = PosetPath _ _ .fst ((idEquiv _) , isposetequiv ≤Equiv ) + IndPosetPath : JoinPoset ≡ MeetPoset + IndPosetPath = PosetPath _ _ .fst ((idEquiv _) , isposetequiv ≤Equiv ) - -- transport inequalities from ≤m to ≤j - ∧lIsMinJoin : ∀ x y z → z ≤j x → z ≤j y → z ≤j x ∧l y - ∧lIsMinJoin _ _ _ z≤jx z≤jy = ≤m→≤j _ _ (∧lIsMin _ _ _ (≤j→≤m _ _ z≤jx) (≤j→≤m _ _ z≤jy)) + -- transport inequalities from ≤m to ≤j + ∧lIsMinJoin : ∀ x y z → z ≤j x → z ≤j y → z ≤j x ∧l y + ∧lIsMinJoin _ _ _ z≤jx z≤jy = ≤m→≤j _ _ (∧lIsMin _ _ _ (≤j→≤m _ _ z≤jx) (≤j→≤m _ _ z≤jy)) - ∧≤LCancelJoin : ∀ x y → x ∧l y ≤j y - ∧≤LCancelJoin x y = ≤m→≤j _ _ (∧≤LCancel x y) + ∧≤LCancelJoin : ∀ x y → x ∧l y ≤j y + ∧≤LCancelJoin x y = ≤m→≤j _ _ (∧≤LCancel x y) -module _ {L M : Lattice ℓ} (φ ψ : LatticeHom L M) where - open LatticeStr ⦃...⦄ - open IsLatticeHom - private - instance - _ = L - _ = M - _ = snd L - _ = snd M +module _ {L M : Lattice ℓ} (φ ψ : LatticeHom L M) where + open LatticeStr ⦃...⦄ + open IsLatticeHom + private + instance + _ = L + _ = M + _ = snd L + _ = snd M - LatticeHom≡f : fst φ ≡ fst ψ → φ ≡ ψ - LatticeHom≡f = Σ≡Prop λ f → isPropIsLatticeHom _ f _ + LatticeHom≡f : fst φ ≡ fst ψ → φ ≡ ψ + LatticeHom≡f = Σ≡Prop λ f → isPropIsLatticeHom _ f _ \ No newline at end of file diff --git a/Cubical.Algebra.Matrix.CommRingCoefficient.html b/Cubical.Algebra.Matrix.CommRingCoefficient.html index 5b0e35a6d5..24add6b21e 100644 --- a/Cubical.Algebra.Matrix.CommRingCoefficient.html +++ b/Cubical.Algebra.Matrix.CommRingCoefficient.html @@ -117,7 +117,7 @@ isInv {n = n} M = Σ[ N ∈ Mat n n ] isInv' M N isPropIsInv : (M : Mat n n) → isProp (isInv M) - isPropIsInv M p q = Σ≡Prop (λ _ → isPropIsInv' M _) (invUniq M _ _ (p .snd) (q .snd)) + isPropIsInv M p q = Σ≡Prop (λ _ → isPropIsInv' M _) (invUniq M _ _ (p .snd) (q .snd)) isInv⋆ : {M M' : Mat n n} → isInv M → isInv M' → isInv (M ⋆ M') isInv⋆ (N , p) (N' , q) .fst = N' ⋆ N diff --git a/Cubical.Algebra.Monoid.Submonoid.html b/Cubical.Algebra.Monoid.Submonoid.html index 57a2bb306f..3d35c69354 100644 --- a/Cubical.Algebra.Monoid.Submonoid.html +++ b/Cubical.Algebra.Monoid.Submonoid.html @@ -28,9 +28,9 @@ ε' = ε , ε-closed _·'_ = λ where (m , m∈) (n , n∈) → m · n , ·-closed m∈ n∈ is-setM' = isSetΣSndProp is-set (∈-isProp S) - ·Assoc' = λ x y z → Σ≡Prop (∈-isProp S) (·Assoc (fst x) (fst y) (fst z)) - ·IdR' = λ x → Σ≡Prop (∈-isProp S) (·IdR (fst x)) - ·IdL' = λ x → Σ≡Prop (∈-isProp S) (·IdL (fst x)) + ·Assoc' = λ x y z → Σ≡Prop (∈-isProp S) (·Assoc (fst x) (fst y) (fst z)) + ·IdR' = λ x → Σ≡Prop (∈-isProp S) (·IdR (fst x)) + ·IdL' = λ x → Σ≡Prop (∈-isProp S) (·IdL (fst x)) in makeMonoid ε' _·'_ is-setM' ·Assoc' ·IdR' ·IdL' module _ where diff --git a/Cubical.Algebra.OrderedCommMonoid.Base.html b/Cubical.Algebra.OrderedCommMonoid.Base.html index 9bd90f1ea5..9a00734892 100644 --- a/Cubical.Algebra.OrderedCommMonoid.Base.html +++ b/Cubical.Algebra.OrderedCommMonoid.Base.html @@ -11,84 +11,84 @@ open import Cubical.Algebra.CommMonoid.Base -open import Cubical.Relation.Binary.Poset +open import Cubical.Relation.Binary.Order.Poset -private - variable - ℓ ℓ' : Level +private + variable + ℓ ℓ' : Level -record IsOrderedCommMonoid - {M : Type ℓ} - (_·_ : M → M → M) (1m : M) (_≤_ : M → M → Type ℓ') : Type (ℓ-max ℓ ℓ') - where - field - isPoset : IsPoset _≤_ - isCommMonoid : IsCommMonoid 1m _·_ - MonotoneR : {x y z : M} → x ≤ y → (x · z) ≤ (y · z) -- both versions, just for convenience - MonotoneL : {x y z : M} → x ≤ y → (z · x) ≤ (z · y) +record IsOrderedCommMonoid + {M : Type ℓ} + (_·_ : M → M → M) (1m : M) (_≤_ : M → M → Type ℓ') : Type (ℓ-max ℓ ℓ') + where + field + isPoset : IsPoset _≤_ + isCommMonoid : IsCommMonoid 1m _·_ + MonotoneR : {x y z : M} → x ≤ y → (x · z) ≤ (y · z) -- both versions, just for convenience + MonotoneL : {x y z : M} → x ≤ y → (z · x) ≤ (z · y) - open IsPoset isPoset public - open IsCommMonoid isCommMonoid public - hiding (is-set) + open IsPoset isPoset public + open IsCommMonoid isCommMonoid public + hiding (is-set) -record OrderedCommMonoidStr (ℓ' : Level) (M : Type ℓ) : Type (ℓ-suc (ℓ-max ℓ ℓ')) where - field - _≤_ : M → M → Type ℓ' - _·_ : M → M → M - ε : M - isOrderedCommMonoid : IsOrderedCommMonoid _·_ ε _≤_ +record OrderedCommMonoidStr (ℓ' : Level) (M : Type ℓ) : Type (ℓ-suc (ℓ-max ℓ ℓ')) where + field + _≤_ : M → M → Type ℓ' + _·_ : M → M → M + ε : M + isOrderedCommMonoid : IsOrderedCommMonoid _·_ ε _≤_ - open IsOrderedCommMonoid isOrderedCommMonoid public + open IsOrderedCommMonoid isOrderedCommMonoid public - infixl 4 _≤_ + infixl 4 _≤_ -OrderedCommMonoid : (ℓ ℓ' : Level) → Type (ℓ-suc (ℓ-max ℓ ℓ')) -OrderedCommMonoid ℓ ℓ' = TypeWithStr ℓ (OrderedCommMonoidStr ℓ') +OrderedCommMonoid : (ℓ ℓ' : Level) → Type (ℓ-suc (ℓ-max ℓ ℓ')) +OrderedCommMonoid ℓ ℓ' = TypeWithStr ℓ (OrderedCommMonoidStr ℓ') -module _ - {M : Type ℓ} {1m : M} {_·_ : M → M → M} {_≤_ : M → M → Type ℓ'} - (is-setM : isSet M) - (assoc : (x y z : M) → x · (y · z) ≡ (x · y) · z) - (rid : (x : M) → x · 1m ≡ x) - (lid : (x : M) → 1m · x ≡ x) - (comm : (x y : M) → x · y ≡ y · x) - (isProp≤ : (x y : M) → isProp (x ≤ y)) - (isRefl : (x : M) → x ≤ x) - (isTrans : (x y z : M) → x ≤ y → y ≤ z → x ≤ z) - (isAntisym : (x y : M) → x ≤ y → y ≤ x → x ≡ y) - (rmonotone : (x y z : M) → x ≤ y → (x · z) ≤ (y · z)) - (lmonotone : (x y z : M) → x ≤ y → (z · x) ≤ (z · y)) - where - open IsOrderedCommMonoid +module _ + {M : Type ℓ} {1m : M} {_·_ : M → M → M} {_≤_ : M → M → Type ℓ'} + (is-setM : isSet M) + (assoc : (x y z : M) → x · (y · z) ≡ (x · y) · z) + (rid : (x : M) → x · 1m ≡ x) + (lid : (x : M) → 1m · x ≡ x) + (comm : (x y : M) → x · y ≡ y · x) + (isProp≤ : (x y : M) → isProp (x ≤ y)) + (isRefl : (x : M) → x ≤ x) + (isTrans : (x y z : M) → x ≤ y → y ≤ z → x ≤ z) + (isAntisym : (x y : M) → x ≤ y → y ≤ x → x ≡ y) + (rmonotone : (x y z : M) → x ≤ y → (x · z) ≤ (y · z)) + (lmonotone : (x y z : M) → x ≤ y → (z · x) ≤ (z · y)) + where + open IsOrderedCommMonoid - makeIsOrderedCommMonoid : IsOrderedCommMonoid _·_ 1m _≤_ - isCommMonoid makeIsOrderedCommMonoid = makeIsCommMonoid is-setM assoc rid comm - isPoset makeIsOrderedCommMonoid = isposet is-setM isProp≤ isRefl isTrans isAntisym - MonotoneR makeIsOrderedCommMonoid = rmonotone _ _ _ - MonotoneL makeIsOrderedCommMonoid = lmonotone _ _ _ + makeIsOrderedCommMonoid : IsOrderedCommMonoid _·_ 1m _≤_ + isCommMonoid makeIsOrderedCommMonoid = makeIsCommMonoid is-setM assoc rid comm + isPoset makeIsOrderedCommMonoid = isposet is-setM isProp≤ isRefl isTrans isAntisym + MonotoneR makeIsOrderedCommMonoid = rmonotone _ _ _ + MonotoneL makeIsOrderedCommMonoid = lmonotone _ _ _ -module _ - {M : Type ℓ} {1m : M} {_·_ : M → M → M} {_≤_ : M → M → Type ℓ'} - (isCommMonoid : IsCommMonoid 1m _·_) - (isProp≤ : (x y : M) → isProp (x ≤ y)) - (isRefl : (x : M) → x ≤ x) - (isTrans : (x y z : M) → x ≤ y → y ≤ z → x ≤ z) - (isAntisym : (x y : M) → x ≤ y → y ≤ x → x ≡ y) - (rmonotone : (x y z : M) → x ≤ y → (x · z) ≤ (y · z)) - (lmonotone : (x y z : M) → x ≤ y → (z · x) ≤ (z · y)) - where - module CM = IsOrderedCommMonoid +module _ + {M : Type ℓ} {1m : M} {_·_ : M → M → M} {_≤_ : M → M → Type ℓ'} + (isCommMonoid : IsCommMonoid 1m _·_) + (isProp≤ : (x y : M) → isProp (x ≤ y)) + (isRefl : (x : M) → x ≤ x) + (isTrans : (x y z : M) → x ≤ y → y ≤ z → x ≤ z) + (isAntisym : (x y : M) → x ≤ y → y ≤ x → x ≡ y) + (rmonotone : (x y z : M) → x ≤ y → (x · z) ≤ (y · z)) + (lmonotone : (x y z : M) → x ≤ y → (z · x) ≤ (z · y)) + where + module CM = IsOrderedCommMonoid - IsOrderedCommMonoidFromIsCommMonoid : IsOrderedCommMonoid _·_ 1m _≤_ - CM.isPoset IsOrderedCommMonoidFromIsCommMonoid = - isposet (IsCommMonoid.is-set isCommMonoid) isProp≤ isRefl isTrans isAntisym - CM.isCommMonoid IsOrderedCommMonoidFromIsCommMonoid = isCommMonoid - CM.MonotoneR IsOrderedCommMonoidFromIsCommMonoid = rmonotone _ _ _ - CM.MonotoneL IsOrderedCommMonoidFromIsCommMonoid = lmonotone _ _ _ + IsOrderedCommMonoidFromIsCommMonoid : IsOrderedCommMonoid _·_ 1m _≤_ + CM.isPoset IsOrderedCommMonoidFromIsCommMonoid = + isposet (IsCommMonoid.is-set isCommMonoid) isProp≤ isRefl isTrans isAntisym + CM.isCommMonoid IsOrderedCommMonoidFromIsCommMonoid = isCommMonoid + CM.MonotoneR IsOrderedCommMonoidFromIsCommMonoid = rmonotone _ _ _ + CM.MonotoneL IsOrderedCommMonoidFromIsCommMonoid = lmonotone _ _ _ -OrderedCommMonoid→CommMonoid : OrderedCommMonoid ℓ ℓ' → CommMonoid ℓ -OrderedCommMonoid→CommMonoid M .fst = M .fst -OrderedCommMonoid→CommMonoid M .snd = - let open OrderedCommMonoidStr (M .snd) - in commmonoidstr _ _ isCommMonoid +OrderedCommMonoid→CommMonoid : OrderedCommMonoid ℓ ℓ' → CommMonoid ℓ +OrderedCommMonoid→CommMonoid M .fst = M .fst +OrderedCommMonoid→CommMonoid M .snd = + let open OrderedCommMonoidStr (M .snd) + in commmonoidstr _ _ isCommMonoid \ No newline at end of file diff --git a/Cubical.Algebra.OrderedCommMonoid.Instances.html b/Cubical.Algebra.OrderedCommMonoid.Instances.html index 3a86218980..0e8ea7f031 100644 --- a/Cubical.Algebra.OrderedCommMonoid.Instances.html +++ b/Cubical.Algebra.OrderedCommMonoid.Instances.html @@ -9,25 +9,25 @@ open import Cubical.Data.Nat open import Cubical.Data.Nat.Order -ℕ≤+ : OrderedCommMonoid ℓ-zero ℓ-zero +ℕ≤+ : OrderedCommMonoid ℓ-zero ℓ-zero ℕ≤+ .fst = ℕ -ℕ≤+ .snd .OrderedCommMonoidStr._≤_ = _≤_ -ℕ≤+ .snd .OrderedCommMonoidStr._·_ = _+_ -ℕ≤+ .snd .OrderedCommMonoidStr.ε = 0 -ℕ≤+ .snd .OrderedCommMonoidStr.isOrderedCommMonoid = - makeIsOrderedCommMonoid +ℕ≤+ .snd .OrderedCommMonoidStr._≤_ = _≤_ +ℕ≤+ .snd .OrderedCommMonoidStr._·_ = _+_ +ℕ≤+ .snd .OrderedCommMonoidStr.ε = 0 +ℕ≤+ .snd .OrderedCommMonoidStr.isOrderedCommMonoid = + makeIsOrderedCommMonoid isSetℕ +-assoc +-zero (λ _ → refl) +-comm (λ _ _ → isProp≤) (λ _ → ≤-refl) (λ _ _ _ → ≤-trans) (λ _ _ → ≤-antisym) (λ _ _ _ → ≤-+k) (λ _ _ _ → ≤-k+) -ℕ≤· : OrderedCommMonoid ℓ-zero ℓ-zero +ℕ≤· : OrderedCommMonoid ℓ-zero ℓ-zero ℕ≤· .fst = ℕ -ℕ≤· .snd .OrderedCommMonoidStr._≤_ = _≤_ -ℕ≤· .snd .OrderedCommMonoidStr._·_ = _·_ -ℕ≤· .snd .OrderedCommMonoidStr.ε = 1 -ℕ≤· .snd .OrderedCommMonoidStr.isOrderedCommMonoid = - makeIsOrderedCommMonoid +ℕ≤· .snd .OrderedCommMonoidStr._≤_ = _≤_ +ℕ≤· .snd .OrderedCommMonoidStr._·_ = _·_ +ℕ≤· .snd .OrderedCommMonoidStr.ε = 1 +ℕ≤· .snd .OrderedCommMonoidStr.isOrderedCommMonoid = + makeIsOrderedCommMonoid isSetℕ ·-assoc ·-identityʳ ·-identityˡ ·-comm (λ _ _ → isProp≤) (λ _ → ≤-refl) (λ _ _ _ → ≤-trans) (λ _ _ → ≤-antisym) diff --git a/Cubical.Algebra.OrderedCommMonoid.PropCompletion.html b/Cubical.Algebra.OrderedCommMonoid.PropCompletion.html index fe6c112663..a27ad999ab 100644 --- a/Cubical.Algebra.OrderedCommMonoid.PropCompletion.html +++ b/Cubical.Algebra.OrderedCommMonoid.PropCompletion.html @@ -29,241 +29,241 @@ open import Cubical.Algebra.CommMonoid.Base open import Cubical.Algebra.OrderedCommMonoid -open import Cubical.Relation.Binary.Poset - -private - variable - ℓ : Level - -module PropCompletion (ℓ : Level) (M : OrderedCommMonoid ℓ ℓ) where - open OrderedCommMonoidStr (snd M) - _≤p_ : fst M → fst M → hProp ℓ - n ≤p m = (n ≤ m) , (is-prop-valued _ _) - - isUpwardClosed : (s : fst M → hProp ℓ) → Type _ - isUpwardClosed s = (n m : fst M) → n ≤ m → fst (s n) → fst (s m) - - isPropUpwardClosed : (N : fst M → hProp ℓ) → isProp (isUpwardClosed N) - isPropUpwardClosed N = - isPropΠ4 (λ _ m _ _ → snd (N m)) - - isSetM→Prop : isSet (fst M → hProp ℓ) - isSetM→Prop = isOfHLevelΠ 2 λ _ → isSetHProp - - M↑ : Type _ - M↑ = Σ[ s ∈ (fst M → hProp ℓ)] isUpwardClosed s - - isSetM↑ : isSet M↑ - isSetM↑ = isOfHLevelΣ 2 isSetM→Prop λ s → isOfHLevelSuc 1 (isPropUpwardClosed s) - - _isUpperBoundOf_ : fst M → M↑ → Type ℓ - n isUpperBoundOf s = fst (fst s n) - - isBounded : (s : M↑) → Type _ - isBounded s = ∃[ m ∈ (fst M) ] (m isUpperBoundOf s) - - isPropIsBounded : (s : M↑) → isProp (isBounded s) - isPropIsBounded s = isPropPropTrunc - - _^↑ : fst M → M↑ - n ^↑ = n ≤p_ , isUpwardClosed≤ - where - isUpwardClosed≤ : {m : fst M} → isUpwardClosed (m ≤p_) - isUpwardClosed≤ = λ {_ _ n≤k m≤n → is-trans _ _ _ m≤n n≤k} - - isBounded^ : (m : fst M) → isBounded (m ^↑) - isBounded^ m = ∣ (m , (is-refl m)) ∣₁ - - 1↑ : M↑ - 1↑ = ε ^↑ - - _·↑_ : M↑ → M↑ → M↑ - s ·↑ l = seq , seqIsUpwardClosed - where - seq : fst M → hProp ℓ - seq n = (∃[ (a , b) ∈ (fst M) × (fst M) ] fst ((fst s a) ⊓ (fst l b) ⊓ ((a · b) ≤p n) )) , - isPropPropTrunc - seqIsUpwardClosed : isUpwardClosed seq - seqIsUpwardClosed n m n≤m = - propTruncRec - isPropPropTrunc - λ {((a , b) , wa , (wb , a·b≤n)) → ∣ (a , b) , wa , (wb , is-trans _ _ _ a·b≤n n≤m) ∣₁} - - ·presBounded : (s l : M↑) (bs : isBounded s) (bl : isBounded l) → isBounded (s ·↑ l) - ·presBounded s l = - propTruncRec2 - isPropPropTrunc - λ {(m , s≤m) (k , l≤k) - → ∣ (m · k) , ∣ (m , k) , (s≤m , (l≤k , (is-refl (m · k)))) ∣₁ ∣₁ - } - - {- convenience functions for the proof that ·↑ is the multiplication of a monoid -} - typeAt : fst M → M↑ → Type _ - typeAt n s = fst (fst s n) - - M↑Path : {s l : M↑} → ((n : fst M) → typeAt n s ≡ typeAt n l) → s ≡ l - M↑Path {s = s} {l = l} pwPath = path - where - seqPath : fst s ≡ fst l - seqPath i n = - Σ≡Prop (λ _ → isPropIsProp) {u = fst s n} {v = fst l n} (pwPath n) i - - path : s ≡ l - path = Σ≡Prop isPropUpwardClosed seqPath - - pathFromImplications : (s l : M↑) - → ((n : fst M) → typeAt n s → typeAt n l) - → ((n : fst M) → typeAt n l → typeAt n s) - → s ≡ l - pathFromImplications s l s→l l→s = - M↑Path λ n → cong fst (propPath n) - where propPath : (n : fst M) → fst s n ≡ fst l n - propPath n = ⇒∶ s→l n - ⇐∶ l→s n - - - ^↑Pres· : (x y : fst M) → (x · y) ^↑ ≡ (x ^↑) ·↑ (y ^↑) - ^↑Pres· x y = pathFromImplications ((x · y) ^↑) ((x ^↑) ·↑ (y ^↑)) (⇐) ⇒ - where - ⇐ : (n : fst M) → typeAt n ((x · y) ^↑) → typeAt n ((x ^↑) ·↑ (y ^↑)) - ⇐ n x·y≤n = ∣ (x , y) , ((is-refl _) , ((is-refl _) , x·y≤n)) ∣₁ - - ⇒ : (n : fst M) → typeAt n ((x ^↑) ·↑ (y ^↑)) → typeAt n ((x · y) ^↑) - ⇒ n = propTruncRec - (snd (fst ((x · y) ^↑) n)) - λ {((m , l) , x≤m , (y≤l , m·l≤n)) - → is-trans _ _ _ - (is-trans _ _ _ (MonotoneR x≤m) - (MonotoneL y≤l)) - m·l≤n - } - - ·↑Comm : (s l : M↑) → s ·↑ l ≡ l ·↑ s - ·↑Comm s l = M↑Path λ n → cong fst (propPath n) - where implication : (s l : M↑) (n : fst M) → fst (fst (s ·↑ l) n) → fst (fst (l ·↑ s) n) - implication s l n = propTruncRec - isPropPropTrunc - (λ {((a , b) , wa , (wb , a·b≤n)) - → ∣ (b , a) , wb , (wa , subst (λ k → fst (k ≤p n)) (·Comm a b) a·b≤n) ∣₁ }) - propPath : (n : fst M) → fst (s ·↑ l) n ≡ fst (l ·↑ s) n - propPath n = ⇒∶ implication s l n - ⇐∶ implication l s n - - ·↑Rid : (s : M↑) → s ·↑ 1↑ ≡ s - ·↑Rid s = pathFromImplications (s ·↑ 1↑) s (⇒) ⇐ - where ⇒ : (n : fst M) → typeAt n (s ·↑ 1↑) → typeAt n s - ⇒ n = propTruncRec - (snd (fst s n)) - (λ {((a , b) , sa , (1b , a·b≤n)) - → (snd s) a n ( subst (_≤ n) (·IdR a) (is-trans _ _ _ (MonotoneL 1b) a·b≤n)) sa }) - ⇐ : (n : fst M) → typeAt n s → typeAt n (s ·↑ 1↑) - ⇐ n = λ sn → ∣ (n , ε) , (sn , (is-refl _ , subst (_≤ n) (sym (·IdR n)) (is-refl _))) ∣₁ - - ·↑Assoc : (s l k : M↑) → s ·↑ (l ·↑ k) ≡ (s ·↑ l) ·↑ k - ·↑Assoc s l k = pathFromImplications (s ·↑ (l ·↑ k)) ((s ·↑ l) ·↑ k) (⇒) ⇐ - where ⇒ : (n : fst M) → typeAt n (s ·↑ (l ·↑ k)) → typeAt n ((s ·↑ l) ·↑ k) - ⇒ n = propTruncRec - isPropPropTrunc - λ {((a , b) , sa , (l·kb , a·b≤n)) - → propTruncRec - isPropPropTrunc - (λ {((a' , b') , la' , (kb' , a'·b'≤b)) - → ∣ ((a · a') , b') , ∣ (a , a') , (sa , (la' , is-refl _)) ∣₁ , kb' , - (let a·⟨a'·b'⟩≤n = (is-trans _ _ _ (MonotoneL a'·b'≤b) a·b≤n) - in subst (_≤ n) (·Assoc a a' b') a·⟨a'·b'⟩≤n) ∣₁ - }) l·kb - } - ⇐ : _ - ⇐ n = propTruncRec - isPropPropTrunc - λ {((a , b) , s·l≤a , (k≤b , a·b≤n)) - → propTruncRec - isPropPropTrunc - (λ {((a' , b') , s≤a' , (l≤b' , a'·b'≤a)) - → ∣ (a' , b' · b) , s≤a' , ( ∣ (b' , b) , l≤b' , (k≤b , is-refl _) ∣₁ , - (let ⟨a'·b'⟩·b≤n = (is-trans _ _ _ (MonotoneR a'·b'≤a) a·b≤n) - in subst (_≤ n) (sym (·Assoc a' b' b)) ⟨a'·b'⟩·b≤n) ) ∣₁ - }) s·l≤a - } - - asCommMonoid : CommMonoid (ℓ-suc ℓ) - asCommMonoid = makeCommMonoid 1↑ _·↑_ isSetM↑ ·↑Assoc ·↑Rid ·↑Comm - - {- +open import Cubical.Relation.Binary.Order.Poset + +private + variable + ℓ : Level + +module PropCompletion (ℓ : Level) (M : OrderedCommMonoid ℓ ℓ) where + open OrderedCommMonoidStr (snd M) + _≤p_ : fst M → fst M → hProp ℓ + n ≤p m = (n ≤ m) , (is-prop-valued _ _) + + isUpwardClosed : (s : fst M → hProp ℓ) → Type _ + isUpwardClosed s = (n m : fst M) → n ≤ m → fst (s n) → fst (s m) + + isPropUpwardClosed : (N : fst M → hProp ℓ) → isProp (isUpwardClosed N) + isPropUpwardClosed N = + isPropΠ4 (λ _ m _ _ → snd (N m)) + + isSetM→Prop : isSet (fst M → hProp ℓ) + isSetM→Prop = isOfHLevelΠ 2 λ _ → isSetHProp + + M↑ : Type _ + M↑ = Σ[ s ∈ (fst M → hProp ℓ)] isUpwardClosed s + + isSetM↑ : isSet M↑ + isSetM↑ = isOfHLevelΣ 2 isSetM→Prop λ s → isOfHLevelSuc 1 (isPropUpwardClosed s) + + _isUpperBoundOf_ : fst M → M↑ → Type ℓ + n isUpperBoundOf s = fst (fst s n) + + isBounded : (s : M↑) → Type _ + isBounded s = ∃[ m ∈ (fst M) ] (m isUpperBoundOf s) + + isPropIsBounded : (s : M↑) → isProp (isBounded s) + isPropIsBounded s = isPropPropTrunc + + _^↑ : fst M → M↑ + n ^↑ = n ≤p_ , isUpwardClosed≤ + where + isUpwardClosed≤ : {m : fst M} → isUpwardClosed (m ≤p_) + isUpwardClosed≤ = λ {_ _ n≤k m≤n → is-trans _ _ _ m≤n n≤k} + + isBounded^ : (m : fst M) → isBounded (m ^↑) + isBounded^ m = ∣ (m , (is-refl m)) ∣₁ + + 1↑ : M↑ + 1↑ = ε ^↑ + + _·↑_ : M↑ → M↑ → M↑ + s ·↑ l = seq , seqIsUpwardClosed + where + seq : fst M → hProp ℓ + seq n = (∃[ (a , b) ∈ (fst M) × (fst M) ] fst ((fst s a) ⊓ (fst l b) ⊓ ((a · b) ≤p n) )) , + isPropPropTrunc + seqIsUpwardClosed : isUpwardClosed seq + seqIsUpwardClosed n m n≤m = + propTruncRec + isPropPropTrunc + λ {((a , b) , wa , (wb , a·b≤n)) → ∣ (a , b) , wa , (wb , is-trans _ _ _ a·b≤n n≤m) ∣₁} + + ·presBounded : (s l : M↑) (bs : isBounded s) (bl : isBounded l) → isBounded (s ·↑ l) + ·presBounded s l = + propTruncRec2 + isPropPropTrunc + λ {(m , s≤m) (k , l≤k) + → ∣ (m · k) , ∣ (m , k) , (s≤m , (l≤k , (is-refl (m · k)))) ∣₁ ∣₁ + } + + {- convenience functions for the proof that ·↑ is the multiplication of a monoid -} + typeAt : fst M → M↑ → Type _ + typeAt n s = fst (fst s n) + + M↑Path : {s l : M↑} → ((n : fst M) → typeAt n s ≡ typeAt n l) → s ≡ l + M↑Path {s = s} {l = l} pwPath = path + where + seqPath : fst s ≡ fst l + seqPath i n = + Σ≡Prop (λ _ → isPropIsProp) {u = fst s n} {v = fst l n} (pwPath n) i + + path : s ≡ l + path = Σ≡Prop isPropUpwardClosed seqPath + + pathFromImplications : (s l : M↑) + → ((n : fst M) → typeAt n s → typeAt n l) + → ((n : fst M) → typeAt n l → typeAt n s) + → s ≡ l + pathFromImplications s l s→l l→s = + M↑Path λ n → cong fst (propPath n) + where propPath : (n : fst M) → fst s n ≡ fst l n + propPath n = ⇒∶ s→l n + ⇐∶ l→s n + + + ^↑Pres· : (x y : fst M) → (x · y) ^↑ ≡ (x ^↑) ·↑ (y ^↑) + ^↑Pres· x y = pathFromImplications ((x · y) ^↑) ((x ^↑) ·↑ (y ^↑)) (⇐) ⇒ + where + ⇐ : (n : fst M) → typeAt n ((x · y) ^↑) → typeAt n ((x ^↑) ·↑ (y ^↑)) + ⇐ n x·y≤n = ∣ (x , y) , ((is-refl _) , ((is-refl _) , x·y≤n)) ∣₁ + + ⇒ : (n : fst M) → typeAt n ((x ^↑) ·↑ (y ^↑)) → typeAt n ((x · y) ^↑) + ⇒ n = propTruncRec + (snd (fst ((x · y) ^↑) n)) + λ {((m , l) , x≤m , (y≤l , m·l≤n)) + → is-trans _ _ _ + (is-trans _ _ _ (MonotoneR x≤m) + (MonotoneL y≤l)) + m·l≤n + } + + ·↑Comm : (s l : M↑) → s ·↑ l ≡ l ·↑ s + ·↑Comm s l = M↑Path λ n → cong fst (propPath n) + where implication : (s l : M↑) (n : fst M) → fst (fst (s ·↑ l) n) → fst (fst (l ·↑ s) n) + implication s l n = propTruncRec + isPropPropTrunc + (λ {((a , b) , wa , (wb , a·b≤n)) + → ∣ (b , a) , wb , (wa , subst (λ k → fst (k ≤p n)) (·Comm a b) a·b≤n) ∣₁ }) + propPath : (n : fst M) → fst (s ·↑ l) n ≡ fst (l ·↑ s) n + propPath n = ⇒∶ implication s l n + ⇐∶ implication l s n + + ·↑Rid : (s : M↑) → s ·↑ 1↑ ≡ s + ·↑Rid s = pathFromImplications (s ·↑ 1↑) s (⇒) ⇐ + where ⇒ : (n : fst M) → typeAt n (s ·↑ 1↑) → typeAt n s + ⇒ n = propTruncRec + (snd (fst s n)) + (λ {((a , b) , sa , (1b , a·b≤n)) + → (snd s) a n ( subst (_≤ n) (·IdR a) (is-trans _ _ _ (MonotoneL 1b) a·b≤n)) sa }) + ⇐ : (n : fst M) → typeAt n s → typeAt n (s ·↑ 1↑) + ⇐ n = λ sn → ∣ (n , ε) , (sn , (is-refl _ , subst (_≤ n) (sym (·IdR n)) (is-refl _))) ∣₁ + + ·↑Assoc : (s l k : M↑) → s ·↑ (l ·↑ k) ≡ (s ·↑ l) ·↑ k + ·↑Assoc s l k = pathFromImplications (s ·↑ (l ·↑ k)) ((s ·↑ l) ·↑ k) (⇒) ⇐ + where ⇒ : (n : fst M) → typeAt n (s ·↑ (l ·↑ k)) → typeAt n ((s ·↑ l) ·↑ k) + ⇒ n = propTruncRec + isPropPropTrunc + λ {((a , b) , sa , (l·kb , a·b≤n)) + → propTruncRec + isPropPropTrunc + (λ {((a' , b') , la' , (kb' , a'·b'≤b)) + → ∣ ((a · a') , b') , ∣ (a , a') , (sa , (la' , is-refl _)) ∣₁ , kb' , + (let a·⟨a'·b'⟩≤n = (is-trans _ _ _ (MonotoneL a'·b'≤b) a·b≤n) + in subst (_≤ n) (·Assoc a a' b') a·⟨a'·b'⟩≤n) ∣₁ + }) l·kb + } + ⇐ : _ + ⇐ n = propTruncRec + isPropPropTrunc + λ {((a , b) , s·l≤a , (k≤b , a·b≤n)) + → propTruncRec + isPropPropTrunc + (λ {((a' , b') , s≤a' , (l≤b' , a'·b'≤a)) + → ∣ (a' , b' · b) , s≤a' , ( ∣ (b' , b) , l≤b' , (k≤b , is-refl _) ∣₁ , + (let ⟨a'·b'⟩·b≤n = (is-trans _ _ _ (MonotoneR a'·b'≤a) a·b≤n) + in subst (_≤ n) (sym (·Assoc a' b' b)) ⟨a'·b'⟩·b≤n) ) ∣₁ + }) s·l≤a + } + + asCommMonoid : CommMonoid (ℓ-suc ℓ) + asCommMonoid = makeCommMonoid 1↑ _·↑_ isSetM↑ ·↑Assoc ·↑Rid ·↑Comm + + {- Poset structure on M↑ -} - _≤↑_ : (s l : M↑) → Type _ - s ≤↑ l = (m : fst M) → fst ((fst l) m) → fst ((fst s) m) + _≤↑_ : (s l : M↑) → Type _ + s ≤↑ l = (m : fst M) → fst ((fst l) m) → fst ((fst s) m) - isBounded→≤↑ : (s : M↑) → isBounded s → ∃[ m ∈ fst M ] (s ≤↑ (m ^↑)) - isBounded→≤↑ s = - propTruncRec - isPropPropTrunc - λ {(m , mIsBound) - → ∣ m , (λ n m≤n → snd s m n m≤n mIsBound) ∣₁ - } + isBounded→≤↑ : (s : M↑) → isBounded s → ∃[ m ∈ fst M ] (s ≤↑ (m ^↑)) + isBounded→≤↑ s = + propTruncRec + isPropPropTrunc + λ {(m , mIsBound) + → ∣ m , (λ n m≤n → snd s m n m≤n mIsBound) ∣₁ + } - ≤↑IsProp : (s l : M↑) → isProp (s ≤↑ l) - ≤↑IsProp s l = isPropΠ2 (λ x p → snd (fst s x)) + ≤↑IsProp : (s l : M↑) → isProp (s ≤↑ l) + ≤↑IsProp s l = isPropΠ2 (λ x p → snd (fst s x)) - ≤↑IsRefl : (s : M↑) → s ≤↑ s - ≤↑IsRefl s = λ m x → x + ≤↑IsRefl : (s : M↑) → s ≤↑ s + ≤↑IsRefl s = λ m x → x - ≤↑IsTrans : (s l t : M↑) → s ≤↑ l → l ≤↑ t → s ≤↑ t - ≤↑IsTrans s l t p q x = (p x) ∘ (q x) + ≤↑IsTrans : (s l t : M↑) → s ≤↑ l → l ≤↑ t → s ≤↑ t + ≤↑IsTrans s l t p q x = (p x) ∘ (q x) - ≤↑IsAntisym : (s l : M↑) → s ≤↑ l → l ≤↑ s → s ≡ l - ≤↑IsAntisym s l p q = pathFromImplications _ _ q p + ≤↑IsAntisym : (s l : M↑) → s ≤↑ l → l ≤↑ s → s ≡ l + ≤↑IsAntisym s l p q = pathFromImplications _ _ q p - {- + {- Compatability with the monoid structure -} - ·↑IsRMonotone : (l t s : M↑) → l ≤↑ t → (l ·↑ s) ≤↑ (t ·↑ s) - ·↑IsRMonotone l t s p x = - propTruncRec - isPropPropTrunc - λ { ((a , b) , l≤a , (s≤b , a·b≤x)) → ∣ (a , b) , p a l≤a , s≤b , a·b≤x ∣₁} - - ·↑IsLMonotone : (l t s : M↑) → l ≤↑ t → (s ·↑ l) ≤↑ (s ·↑ t) - ·↑IsLMonotone l t s p x = - propTruncRec - isPropPropTrunc - λ {((a , b) , s≤a , (l≤b , a·b≤x)) → ∣ (a , b) , s≤a , p b l≤b , a·b≤x ∣₁} - - asOrderedCommMonoid : OrderedCommMonoid (ℓ-suc ℓ) ℓ - asOrderedCommMonoid .fst = _ - asOrderedCommMonoid .snd .OrderedCommMonoidStr._≤_ = _≤↑_ - asOrderedCommMonoid .snd .OrderedCommMonoidStr._·_ = _·↑_ - asOrderedCommMonoid .snd .OrderedCommMonoidStr.ε = 1↑ - asOrderedCommMonoid .snd .OrderedCommMonoidStr.isOrderedCommMonoid = - IsOrderedCommMonoidFromIsCommMonoid - (CommMonoidStr.isCommMonoid (snd asCommMonoid)) - ≤↑IsProp ≤↑IsRefl ≤↑IsTrans ≤↑IsAntisym ·↑IsRMonotone ·↑IsLMonotone - - boundedSubstructure : OrderedCommMonoid (ℓ-suc ℓ) ℓ - boundedSubstructure = - makeOrderedSubmonoid - asOrderedCommMonoid - (λ s → (isBounded s , isPropIsBounded s)) - ·presBounded - (isBounded^ ε) - -PropCompletion : - OrderedCommMonoid ℓ ℓ - → OrderedCommMonoid (ℓ-suc ℓ) ℓ -PropCompletion M = PropCompletion.asOrderedCommMonoid _ M - -BoundedPropCompletion : - OrderedCommMonoid ℓ ℓ - → OrderedCommMonoid (ℓ-suc ℓ) ℓ -BoundedPropCompletion M = PropCompletion.boundedSubstructure _ M - -isSetBoundedPropCompletion : - (M : OrderedCommMonoid ℓ ℓ) - → isSet (⟨ BoundedPropCompletion M ⟩) -isSetBoundedPropCompletion M = - isSetΣSndProp is-set - λ x → PropCompletion.isPropIsBounded _ M x - where - open OrderedCommMonoidStr (str (PropCompletion M)) + ·↑IsRMonotone : (l t s : M↑) → l ≤↑ t → (l ·↑ s) ≤↑ (t ·↑ s) + ·↑IsRMonotone l t s p x = + propTruncRec + isPropPropTrunc + λ { ((a , b) , l≤a , (s≤b , a·b≤x)) → ∣ (a , b) , p a l≤a , s≤b , a·b≤x ∣₁} + + ·↑IsLMonotone : (l t s : M↑) → l ≤↑ t → (s ·↑ l) ≤↑ (s ·↑ t) + ·↑IsLMonotone l t s p x = + propTruncRec + isPropPropTrunc + λ {((a , b) , s≤a , (l≤b , a·b≤x)) → ∣ (a , b) , s≤a , p b l≤b , a·b≤x ∣₁} + + asOrderedCommMonoid : OrderedCommMonoid (ℓ-suc ℓ) ℓ + asOrderedCommMonoid .fst = _ + asOrderedCommMonoid .snd .OrderedCommMonoidStr._≤_ = _≤↑_ + asOrderedCommMonoid .snd .OrderedCommMonoidStr._·_ = _·↑_ + asOrderedCommMonoid .snd .OrderedCommMonoidStr.ε = 1↑ + asOrderedCommMonoid .snd .OrderedCommMonoidStr.isOrderedCommMonoid = + IsOrderedCommMonoidFromIsCommMonoid + (CommMonoidStr.isCommMonoid (snd asCommMonoid)) + ≤↑IsProp ≤↑IsRefl ≤↑IsTrans ≤↑IsAntisym ·↑IsRMonotone ·↑IsLMonotone + + boundedSubstructure : OrderedCommMonoid (ℓ-suc ℓ) ℓ + boundedSubstructure = + makeOrderedSubmonoid + asOrderedCommMonoid + (λ s → (isBounded s , isPropIsBounded s)) + ·presBounded + (isBounded^ ε) + +PropCompletion : + OrderedCommMonoid ℓ ℓ + → OrderedCommMonoid (ℓ-suc ℓ) ℓ +PropCompletion M = PropCompletion.asOrderedCommMonoid _ M + +BoundedPropCompletion : + OrderedCommMonoid ℓ ℓ + → OrderedCommMonoid (ℓ-suc ℓ) ℓ +BoundedPropCompletion M = PropCompletion.boundedSubstructure _ M + +isSetBoundedPropCompletion : + (M : OrderedCommMonoid ℓ ℓ) + → isSet (⟨ BoundedPropCompletion M ⟩) +isSetBoundedPropCompletion M = + isSetΣSndProp is-set + λ x → PropCompletion.isPropIsBounded _ M x + where + open OrderedCommMonoidStr (str (PropCompletion M)) \ No newline at end of file diff --git a/Cubical.Algebra.OrderedCommMonoid.Properties.html b/Cubical.Algebra.OrderedCommMonoid.Properties.html index 5138b09371..9773aeee31 100644 --- a/Cubical.Algebra.OrderedCommMonoid.Properties.html +++ b/Cubical.Algebra.OrderedCommMonoid.Properties.html @@ -12,45 +12,45 @@ open import Cubical.Algebra.CommMonoid open import Cubical.Algebra.OrderedCommMonoid.Base -open import Cubical.Relation.Binary.Poset - - -private - variable - ℓ ℓ' ℓ'' : Level - - -module _ - (M : OrderedCommMonoid ℓ ℓ') - (P : ⟨ M ⟩ → hProp ℓ'') - where - open OrderedCommMonoidStr (snd M) - module _ - (·Closed : (x y : ⟨ M ⟩) → ⟨ P x ⟩ → ⟨ P y ⟩ → ⟨ P (x · y) ⟩) - (εContained : ⟨ P ε ⟩) - where - private - subtype = Σ[ x ∈ ⟨ M ⟩ ] ⟨ P x ⟩ - submonoid = makeSubCommMonoid (OrderedCommMonoid→CommMonoid M) P ·Closed εContained - _≤ₛ_ : (x y : ⟨ submonoid ⟩) → Type ℓ' - x ≤ₛ y = (fst x) ≤ (fst y) - pres≤ : (x y : ⟨ submonoid ⟩) (x≤y : x ≤ₛ y) → (fst x) ≤ (fst y) - pres≤ x y x≤y = x≤y - - makeOrderedSubmonoid : OrderedCommMonoid _ ℓ' - fst makeOrderedSubmonoid = subtype - OrderedCommMonoidStr._≤_ (snd makeOrderedSubmonoid) = _≤ₛ_ - OrderedCommMonoidStr._·_ (snd makeOrderedSubmonoid) = CommMonoidStr._·_ (snd submonoid) - OrderedCommMonoidStr.ε (snd makeOrderedSubmonoid) = CommMonoidStr.ε (snd submonoid) - OrderedCommMonoidStr.isOrderedCommMonoid (snd makeOrderedSubmonoid) = - IsOrderedCommMonoidFromIsCommMonoid - (CommMonoidStr.isCommMonoid (snd submonoid)) - (λ x y → is-prop-valued (fst x) (fst y)) - (λ x → is-refl (fst x)) - (λ x y z → is-trans (fst x) (fst y) (fst z)) - (λ x y x≤y y≤x - → Σ≡Prop (λ x → snd (P x)) - (is-antisym (fst x) (fst y) (pres≤ x y x≤y) (pres≤ y x y≤x))) - (λ x y z x≤y → MonotoneR (pres≤ x y x≤y)) - λ x y z x≤y → MonotoneL (pres≤ x y x≤y) +open import Cubical.Relation.Binary.Order.Poset + + +private + variable + ℓ ℓ' ℓ'' : Level + + +module _ + (M : OrderedCommMonoid ℓ ℓ') + (P : ⟨ M ⟩ → hProp ℓ'') + where + open OrderedCommMonoidStr (snd M) + module _ + (·Closed : (x y : ⟨ M ⟩) → ⟨ P x ⟩ → ⟨ P y ⟩ → ⟨ P (x · y) ⟩) + (εContained : ⟨ P ε ⟩) + where + private + subtype = Σ[ x ∈ ⟨ M ⟩ ] ⟨ P x ⟩ + submonoid = makeSubCommMonoid (OrderedCommMonoid→CommMonoid M) P ·Closed εContained + _≤ₛ_ : (x y : ⟨ submonoid ⟩) → Type ℓ' + x ≤ₛ y = (fst x) ≤ (fst y) + pres≤ : (x y : ⟨ submonoid ⟩) (x≤y : x ≤ₛ y) → (fst x) ≤ (fst y) + pres≤ x y x≤y = x≤y + + makeOrderedSubmonoid : OrderedCommMonoid _ ℓ' + fst makeOrderedSubmonoid = subtype + OrderedCommMonoidStr._≤_ (snd makeOrderedSubmonoid) = _≤ₛ_ + OrderedCommMonoidStr._·_ (snd makeOrderedSubmonoid) = CommMonoidStr._·_ (snd submonoid) + OrderedCommMonoidStr.ε (snd makeOrderedSubmonoid) = CommMonoidStr.ε (snd submonoid) + OrderedCommMonoidStr.isOrderedCommMonoid (snd makeOrderedSubmonoid) = + IsOrderedCommMonoidFromIsCommMonoid + (CommMonoidStr.isCommMonoid (snd submonoid)) + (λ x y → is-prop-valued (fst x) (fst y)) + (λ x → is-refl (fst x)) + (λ x y z → is-trans (fst x) (fst y) (fst z)) + (λ x y x≤y y≤x + → Σ≡Prop (λ x → snd (P x)) + (is-antisym (fst x) (fst y) (pres≤ x y x≤y) (pres≤ y x y≤x))) + (λ x y z x≤y → MonotoneR (pres≤ x y x≤y)) + λ x y z x≤y → MonotoneL (pres≤ x y x≤y) \ No newline at end of file diff --git a/Cubical.Algebra.Polynomials.UnivariateList.Base.html b/Cubical.Algebra.Polynomials.UnivariateList.Base.html index c602813fb5..2caff8dd31 100644 --- a/Cubical.Algebra.Polynomials.UnivariateList.Base.html +++ b/Cubical.Algebra.Polynomials.UnivariateList.Base.html @@ -165,7 +165,7 @@ shiftPolyFunPrepends0 : (p : Poly R') → shiftPolyFun (Poly→PolyFun p) ≡ Poly→PolyFun (0r ∷ p) shiftPolyFunPrepends0 p = - Σ≡Prop (λ _ → isPropPropTrunc) + Σ≡Prop (λ _ → isPropPropTrunc) λ {i zero → 0r; i (suc n) → fst (Poly→PolyFun p) n} ---------------------------------------------------- diff --git a/Cubical.Algebra.Polynomials.UnivariateList.Properties.html b/Cubical.Algebra.Polynomials.UnivariateList.Properties.html index a459e549d5..b4f15e0d06 100644 --- a/Cubical.Algebra.Polynomials.UnivariateList.Properties.html +++ b/Cubical.Algebra.Polynomials.UnivariateList.Properties.html @@ -661,7 +661,7 @@ p≡0 = p ≡⟨ sym (PolyFun→Poly→PolyFun p) ⟩ PolyFun→Poly (Poly→PolyFun p) ≡⟨ cong PolyFun→Poly - (Poly→PolyFun p ≡⟨ ( Σ≡Prop (λ (f : ℕ → R) → isPropPropTrunc) λ i n → Funp≡0 n i) ⟩ + (Poly→PolyFun p ≡⟨ ( Σ≡Prop (λ (f : ℕ → R) → isPropPropTrunc) λ i n → Funp≡0 n i) ⟩ Poly→PolyFun [] ∎) ⟩ PolyFun→Poly (Poly→PolyFun []) ≡⟨ PolyFun→Poly→PolyFun 0P ⟩ 0P ∎ diff --git a/Cubical.Algebra.Ring.Base.html b/Cubical.Algebra.Ring.Base.html index b47abbd1ec..2894b58ed9 100644 --- a/Cubical.Algebra.Ring.Base.html +++ b/Cubical.Algebra.Ring.Base.html @@ -205,7 +205,7 @@ RingHomPathP R S T p φ ψ q = ΣPathP (q , isProp→PathP (λ _ → isPropIsRingHom _ _ _) _ _) RingHom≡ : {R : Ring ℓ} {S : Ring ℓ'} {φ ψ : RingHom R S} → fst φ ≡ fst ψ → φ ≡ ψ -RingHom≡ = Σ≡Prop λ f → isPropIsRingHom _ f _ +RingHom≡ = Σ≡Prop λ f → isPropIsRingHom _ f _ 𝒮ᴰ-Ring : DUARel (𝒮-Univ ℓ) RingStr ℓ 𝒮ᴰ-Ring = diff --git a/Cubical.Algebra.Ring.DirectProd.html b/Cubical.Algebra.Ring.DirectProd.html index 70c772a721..723f787200 100644 --- a/Cubical.Algebra.Ring.DirectProd.html +++ b/Cubical.Algebra.Ring.DirectProd.html @@ -101,7 +101,7 @@ _·Y×Y'_ = _·_ (snd (DirectProd-Ring Yr Y'r)) re×re' : (re : RingEquiv Xr Yr) → (re' : RingEquiv X'r Y'r) → (X × X') ≃ (Y × Y') - re×re' re re' = ≃-× (fst re) (fst re') + re×re' re re' = ≃-× (fst re) (fst re') Coproduct-Equiv-12 : (re : RingEquiv Xr Yr) → (re' : RingEquiv X'r Y'r) → RingEquiv (DirectProd-Ring Xr X'r) (DirectProd-Ring Yr Y'r) diff --git a/Cubical.Algebra.Ring.Ideal.SurjectiveImage.html b/Cubical.Algebra.Ring.Ideal.SurjectiveImage.html index e613b20740..b130b55ff7 100644 --- a/Cubical.Algebra.Ring.Ideal.SurjectiveImage.html +++ b/Cubical.Algebra.Ring.Ideal.SurjectiveImage.html @@ -26,7 +26,7 @@ variable ℓ : Level -module _ {R S : Ring ℓ} (f : RingHom R S) (f-epi : isSurjection (fst f)) (I : IdealsIn R) where +module _ {R S : Ring ℓ} (f : RingHom R S) (f-epi : isSurjection (fst f)) (I : IdealsIn R) where open isIdeal open IsRingHom (snd f) open RingStr ⦃...⦄ diff --git a/Cubical.Algebra.Ring.Properties.html b/Cubical.Algebra.Ring.Properties.html index 49c03477d8..fd9741b543 100644 --- a/Cubical.Algebra.Ring.Properties.html +++ b/Cubical.Algebra.Ring.Properties.html @@ -304,7 +304,7 @@ ∙∙ transportTransport⁻ (ua (Ring≡ A B)) q where helper : transport (sym (ua (Ring≡ A B))) p ≡ transport (sym (ua (Ring≡ A B))) q - helper = Σ≡Prop + helper = Σ≡Prop (λ _ → isPropΣ (isOfHLevelPathP' 1 (is-set (snd B)) _ _) λ _ → isPropΣ (isOfHLevelPathP' 1 (is-set (snd B)) _ _) diff --git a/Cubical.Algebra.Ring.Quotient.html b/Cubical.Algebra.Ring.Quotient.html index ef6484ae18..483c0dfa84 100644 --- a/Cubical.Algebra.Ring.Quotient.html +++ b/Cubical.Algebra.Ring.Quotient.html @@ -9,7 +9,7 @@ open import Cubical.Foundations.Powerset using (_∈_; _⊆_; ⊆-extensionality) -- \in, \sub= open import Cubical.Functions.Surjection -open import Cubical.Data.Sigma using (Σ≡Prop) +open import Cubical.Data.Sigma using (Σ≡Prop) open import Cubical.Relation.Binary @@ -206,7 +206,7 @@ IsRingHom.pres- (snd (quotientHom R I)) _ = refl quotientHomSurjective : (R : Ring ℓ) → (I : IdealsIn R) - → isSurjection (fst (quotientHom R I)) + → isSurjection (fst (quotientHom R I)) quotientHomSurjective R I = []surjective @@ -268,7 +268,7 @@ module idealIsKernel {R : Ring ℓ} (I : IdealsIn R) where open RingStr (snd R) open isIdeal (snd I) - open BinaryRelation.isEquivRel + open BinaryRelation.isEquivRel private π = quotientHom R I @@ -282,10 +282,10 @@ I⊆ker x x∈I = eq/ _ _ (subst (_∈ fst I) (sym (x-0≡x x)) x∈I) private - _~_ : Rel ⟨ R ⟩ ⟨ R ⟩ ℓ + _~_ : Rel ⟨ R ⟩ ⟨ R ⟩ ℓ x ~ y = x - y ∈ fst I - ~IsPropValued : BinaryRelation.isPropValued _~_ + ~IsPropValued : BinaryRelation.isPropValued _~_ ~IsPropValued x y = snd (fst I (x - y)) -- _~_ is an equivalence relation. @@ -307,10 +307,10 @@ (x + 0r) + - z ≡⟨ cong (_+ - z) (+IdR _) ⟩ x - z ∎ - ~IsEquivRel : BinaryRelation.isEquivRel _~_ - reflexive ~IsEquivRel x = subst (_∈ fst I) (sym (+InvR x)) 0r-closed - symmetric ~IsEquivRel x y x~y = subst (_∈ fst I) -[x-y]≡y-x (-closed x~y) - transitive ~IsEquivRel x y z x~y y~z = subst (_∈ fst I) x-y+y-z≡x-z (+-closed x~y y~z) + ~IsEquivRel : BinaryRelation.isEquivRel _~_ + reflexive ~IsEquivRel x = subst (_∈ fst I) (sym (+InvR x)) 0r-closed + symmetric ~IsEquivRel x y x~y = subst (_∈ fst I) -[x-y]≡y-x (-closed x~y) + transitive ~IsEquivRel x y z x~y y~z = subst (_∈ fst I) x-y+y-z≡x-z (+-closed x~y y~z) ker⊆I : kernel π ⊆ fst I ker⊆I x x∈ker = subst (_∈ fst I) (x-0≡x x) x-0∈I @@ -320,6 +320,6 @@ kernel≡I : {R : Ring ℓ} (I : IdealsIn R) → kernelIdeal (quotientHom R I) ≡ I -kernel≡I {R = R} I = Σ≡Prop (isPropIsIdeal R) (⊆-extensionality _ _ (ker⊆I , I⊆ker)) +kernel≡I {R = R} I = Σ≡Prop (isPropIsIdeal R) (⊆-extensionality _ _ (ker⊆I , I⊆ker)) where open idealIsKernel I \ No newline at end of file diff --git a/Cubical.Algebra.Semilattice.Base.html b/Cubical.Algebra.Semilattice.Base.html index b3fe71440c..e51129b88e 100644 --- a/Cubical.Algebra.Semilattice.Base.html +++ b/Cubical.Algebra.Semilattice.Base.html @@ -35,231 +35,231 @@ open import Cubical.Displayed.Universe open import Cubical.Relation.Binary -open import Cubical.Relation.Binary.Poset +open import Cubical.Relation.Binary.Order.Poset -open import Cubical.Reflection.RecordEquiv - -open Iso +open import Cubical.Reflection.RecordEquiv + +open Iso -private - variable - ℓ ℓ' : Level +private + variable + ℓ ℓ' : Level -record IsSemilattice {A : Type ℓ} (ε : A) (_·_ : A → A → A) : Type ℓ where - constructor issemilattice +record IsSemilattice {A : Type ℓ} (ε : A) (_·_ : A → A → A) : Type ℓ where + constructor issemilattice - field - isCommMonoid : IsCommMonoid ε _·_ - idem : (x : A) → x · x ≡ x + field + isCommMonoid : IsCommMonoid ε _·_ + idem : (x : A) → x · x ≡ x - open IsCommMonoid isCommMonoid public + open IsCommMonoid isCommMonoid public -unquoteDecl IsSemilatticeIsoΣ = declareRecordIsoΣ IsSemilatticeIsoΣ (quote IsSemilattice) +unquoteDecl IsSemilatticeIsoΣ = declareRecordIsoΣ IsSemilatticeIsoΣ (quote IsSemilattice) -record SemilatticeStr (A : Type ℓ) : Type ℓ where - constructor semilatticestr +record SemilatticeStr (A : Type ℓ) : Type ℓ where + constructor semilatticestr - field - ε : A - _·_ : A → A → A - isSemilattice : IsSemilattice ε _·_ - - infixl 7 _·_ - - open IsSemilattice isSemilattice public - -Semilattice : ∀ ℓ → Type (ℓ-suc ℓ) -Semilattice ℓ = TypeWithStr ℓ SemilatticeStr - -semilattice : (A : Type ℓ) (ε : A) (_·_ : A → A → A) (h : IsSemilattice ε _·_) → Semilattice ℓ -semilattice A ε _·_ h = A , semilatticestr ε _·_ h - --- Easier to use constructors -makeIsSemilattice : {L : Type ℓ} {ε : L} {_·_ : L → L → L} - (is-setL : isSet L) - (assoc : (x y z : L) → x · (y · z) ≡ (x · y) · z) - (rid : (x : L) → x · ε ≡ x) - (comm : (x y : L) → x · y ≡ y · x) - (idem : (x : L) → x · x ≡ x) - → IsSemilattice ε _·_ -IsSemilattice.isCommMonoid (makeIsSemilattice is-setL assoc rid comm idem) = - makeIsCommMonoid is-setL assoc rid comm -IsSemilattice.idem (makeIsSemilattice is-setL assoc rid comm idem) = idem - -makeSemilattice : {L : Type ℓ} (ε : L) (_·_ : L → L → L) - (is-setL : isSet L) - (assoc : (x y z : L) → x · (y · z) ≡ (x · y) · z) - (rid : (x : L) → x · ε ≡ x) - (comm : (x y : L) → x · y ≡ y · x) - (idem : (x : L) → x · x ≡ x) - → Semilattice ℓ -makeSemilattice ε _·_ is-setL assoc rid comm idem = - semilattice _ ε _·_ (makeIsSemilattice is-setL assoc rid comm idem) - - -SemilatticeStr→MonoidStr : {A : Type ℓ} → SemilatticeStr A → MonoidStr A -SemilatticeStr→MonoidStr (semilatticestr _ _ H) = - monoidstr _ _ (H .IsSemilattice.isCommMonoid .IsCommMonoid.isMonoid) - -Semilattice→Monoid : Semilattice ℓ → Monoid ℓ -Semilattice→Monoid (_ , semilatticestr _ _ H) = - _ , monoidstr _ _ (H .IsSemilattice.isCommMonoid .IsCommMonoid.isMonoid) - -Semilattice→CommMonoid : Semilattice ℓ → CommMonoid ℓ -Semilattice→CommMonoid (_ , semilatticestr _ _ H) = - _ , commmonoidstr _ _ (H .IsSemilattice.isCommMonoid) - -SemilatticeHom : (L : Semilattice ℓ) (M : Semilattice ℓ') → Type (ℓ-max ℓ ℓ') -SemilatticeHom L M = MonoidHom (Semilattice→Monoid L) (Semilattice→Monoid M) - -IsSemilatticeEquiv : {A : Type ℓ} {B : Type ℓ'} - (M : SemilatticeStr A) (e : A ≃ B) (N : SemilatticeStr B) → Type (ℓ-max ℓ ℓ') -IsSemilatticeEquiv M e N = - IsMonoidHom (SemilatticeStr→MonoidStr M) (e .fst) (SemilatticeStr→MonoidStr N) - -SemilatticeEquiv : (M : Semilattice ℓ) (N : Semilattice ℓ') → Type (ℓ-max ℓ ℓ') -SemilatticeEquiv M N = Σ[ e ∈ (M .fst ≃ N .fst) ] IsSemilatticeEquiv (M .snd) e (N .snd) - -isPropIsSemilattice : {L : Type ℓ} (ε : L) (_·_ : L → L → L) - → isProp (IsSemilattice ε _·_) -isPropIsSemilattice ε _·_ (issemilattice LL LC) (issemilattice SL SC) = - λ i → issemilattice (isPropIsCommMonoid _ _ LL SL i) (isPropIdem LC SC i) - where - open IsCommMonoid LL using (is-set) - - isPropIdem : isProp ((x : _) → x · x ≡ x) - isPropIdem = isPropΠ λ _ → is-set _ _ - -𝒮ᴰ-Semilattice : DUARel (𝒮-Univ ℓ) SemilatticeStr ℓ -𝒮ᴰ-Semilattice = - 𝒮ᴰ-Record (𝒮-Univ _) IsSemilatticeEquiv - (fields: - data[ ε ∣ autoDUARel _ _ ∣ presε ] - data[ _·_ ∣ autoDUARel _ _ ∣ pres· ] - prop[ isSemilattice ∣ (λ _ _ → isPropIsSemilattice _ _) ]) - where - open SemilatticeStr - open IsMonoidHom - -SemilatticePath : (L K : Semilattice ℓ) → SemilatticeEquiv L K ≃ (L ≡ K) -SemilatticePath = ∫ 𝒮ᴰ-Semilattice .UARel.ua - - --- TODO: decide if that's the right approach -module JoinSemilattice (L' : Semilattice ℓ) where - private L = fst L' - open SemilatticeStr (snd L') renaming (_·_ to _∨l_ ; ε to 0l) - open CommMonoidTheory (Semilattice→CommMonoid L') - open MonoidBigOp (Semilattice→Monoid L') - - _≤_ : L → L → Type ℓ - x ≤ y = x ∨l y ≡ y - - infix 4 _≤_ - - IndPoset : Poset ℓ ℓ - fst IndPoset = L - PosetStr._≤_ (snd IndPoset) = _≤_ - IsPoset.is-set (PosetStr.isPoset (snd IndPoset)) = is-set - IsPoset.is-prop-valued (PosetStr.isPoset (snd IndPoset)) = λ _ _ → is-set _ _ - IsPoset.is-refl (PosetStr.isPoset (snd IndPoset)) = idem - IsPoset.is-trans (PosetStr.isPoset (snd IndPoset)) = path - where - path : (a b c : L) → a ∨l b ≡ b → b ∨l c ≡ c → a ∨l c ≡ c - path a b c a∨b≡b b∨c≡c = a ∨l c ≡⟨ cong (a ∨l_) (sym b∨c≡c) ⟩ - a ∨l (b ∨l c) ≡⟨ ·Assoc _ _ _ ⟩ - (a ∨l b) ∨l c ≡⟨ cong (_∨l c) a∨b≡b ⟩ - b ∨l c ≡⟨ b∨c≡c ⟩ - c ∎ - IsPoset.is-antisym (PosetStr.isPoset (snd IndPoset)) = - λ _ _ a∨b≡b b∨a≡a → sym b∨a≡a ∙∙ ·Comm _ _ ∙∙ a∨b≡b - - ∨lIsMax : ∀ x y z → x ≤ z → y ≤ z → x ∨l y ≤ z - ∨lIsMax x y z x≤z y≤z = cong ((x ∨l y) ∨l_) (sym (idem z)) ∙ commAssocSwap x y z z - ∙ cong₂ (_∨l_) x≤z y≤z - ∙ idem z - - ∨≤LCancel : ∀ x y → y ≤ x ∨l y - ∨≤LCancel x y = commAssocl y x y ∙ cong (x ∨l_) (idem y) - - ∨≤RCancel : ∀ x y → x ≤ x ∨l y - ∨≤RCancel x y = ·Assoc _ _ _ ∙ cong (_∨l y) (idem x) - - ≤-∨Pres : ∀ x y u w → x ≤ y → u ≤ w → x ∨l u ≤ y ∨l w - ≤-∨Pres x y u w x≤y u≤w = commAssocSwap x u y w ∙ cong₂ (_∨l_) x≤y u≤w - - ≤-∨LPres : ∀ x y z → x ≤ y → z ∨l x ≤ z ∨l y - ≤-∨LPres x y z x≤y = ≤-∨Pres _ _ _ _ (idem z) x≤y - - ≤-∨RPres : ∀ x y z → x ≤ y → x ∨l z ≤ y ∨l z - ≤-∨RPres x y z x≤y = ≤-∨Pres _ _ _ _ x≤y (idem z) - - -- inequalities of bigOps - open IsPoset (PosetStr.isPoset (snd IndPoset)) - open PosetReasoning IndPoset - - - ind≤bigOp : {n : ℕ} (U : FinVec L n) (i : Fin n) → U i ≤ bigOp U - ind≤bigOp {n = suc n} U zero = ∨≤RCancel _ _ - ind≤bigOp {n = suc n} U (suc i) = is-trans _ (bigOp (U ∘ suc)) _ (ind≤bigOp (U ∘ suc) i) - (∨≤LCancel _ _) - - bigOpIsMax : {n : ℕ} (U : FinVec L n) (x : L) → (∀ i → U i ≤ x) → bigOp U ≤ x - bigOpIsMax {n = zero} _ _ _ = ·IdL _ - bigOpIsMax {n = suc n} U x U≤x = - bigOp U ≤⟨ is-refl _ ⟩ - U zero ∨l bigOp (U ∘ suc) ≤⟨ ≤-∨LPres _ _ _ (bigOpIsMax _ _ (U≤x ∘ suc)) ⟩ - U zero ∨l x ≤⟨ ∨lIsMax _ _ _ (U≤x zero) (is-refl x) ⟩ - x ◾ - - ≤-bigOpExt : {n : ℕ} (U W : FinVec L n) → (∀ i → U i ≤ W i) → bigOp U ≤ bigOp W - ≤-bigOpExt {n = zero} U W U≤W = is-refl 0l - ≤-bigOpExt {n = suc n} U W U≤W = ≤-∨Pres _ _ _ _ (U≤W zero) (≤-bigOpExt _ _ (U≤W ∘ suc)) - -module MeetSemilattice (L' : Semilattice ℓ) where - private L = fst L' - open SemilatticeStr (snd L') renaming (_·_ to _∧l_ ; ε to 1l) - open CommMonoidTheory (Semilattice→CommMonoid L') - - _≤_ : L → L → Type ℓ - x ≤ y = x ∧l y ≡ x - - infix 4 _≤_ - - IndPoset : Poset ℓ ℓ - fst IndPoset = L - PosetStr._≤_ (snd IndPoset) = _≤_ - IsPoset.is-set (PosetStr.isPoset (snd IndPoset)) = is-set - IsPoset.is-prop-valued (PosetStr.isPoset (snd IndPoset)) = λ _ _ → is-set _ _ - IsPoset.is-refl (PosetStr.isPoset (snd IndPoset)) = idem - IsPoset.is-trans (PosetStr.isPoset (snd IndPoset)) = path - where - path : (a b c : L) → a ∧l b ≡ a → b ∧l c ≡ b → a ∧l c ≡ a - path a b c a∧b≡a b∧c≡b = a ∧l c ≡⟨ cong (_∧l c) (sym a∧b≡a) ⟩ - (a ∧l b) ∧l c ≡⟨ sym (·Assoc _ _ _) ⟩ - a ∧l (b ∧l c) ≡⟨ cong (a ∧l_) b∧c≡b ⟩ - a ∧l b ≡⟨ a∧b≡a ⟩ - a ∎ - IsPoset.is-antisym (PosetStr.isPoset (snd IndPoset)) = - λ _ _ a∧b≡a b∧a≡b → sym a∧b≡a ∙∙ ·Comm _ _ ∙∙ b∧a≡b - - ≤-∧LPres : ∀ x y z → x ≤ y → z ∧l x ≤ z ∧l y - ≤-∧LPres x y z x≤y = commAssocSwap z x z y ∙∙ cong (_∧l (x ∧l y)) (idem z) ∙∙ cong (z ∧l_) x≤y - - ≤-∧RPres : ∀ x y z → x ≤ y → x ∧l z ≤ y ∧l z - ≤-∧RPres x y z x≤y = commAssocSwap x z y z ∙∙ cong (x ∧l y ∧l_) (idem z) ∙∙ cong (_∧l z) x≤y - - ≤-∧Pres : ∀ x y z w → x ≤ y → z ≤ w → x ∧l z ≤ y ∧l w - ≤-∧Pres x y z w x≤y z≤w = commAssocSwap x z y w ∙ cong₂ _∧l_ x≤y z≤w - - ∧≤LCancel : ∀ x y → x ∧l y ≤ y - ∧≤LCancel x y = sym (·Assoc _ _ _) ∙ cong (x ∧l_) (idem y) - - ∧≤RCancel : ∀ x y → x ∧l y ≤ x - ∧≤RCancel x y = commAssocr x y x ∙ cong (_∧l y) (idem x) - - ∧lIsMin : ∀ x y z → z ≤ x → z ≤ y → z ≤ x ∧l y - ∧lIsMin x y z z≤x z≤y = cong (_∧l (x ∧l y)) (sym (idem z)) ∙ commAssocSwap z z x y - ∙ cong₂ (_∧l_) z≤x z≤y - ∙ idem z + field + ε : A + _·_ : A → A → A + isSemilattice : IsSemilattice ε _·_ + + infixl 7 _·_ + + open IsSemilattice isSemilattice public + +Semilattice : ∀ ℓ → Type (ℓ-suc ℓ) +Semilattice ℓ = TypeWithStr ℓ SemilatticeStr + +semilattice : (A : Type ℓ) (ε : A) (_·_ : A → A → A) (h : IsSemilattice ε _·_) → Semilattice ℓ +semilattice A ε _·_ h = A , semilatticestr ε _·_ h + +-- Easier to use constructors +makeIsSemilattice : {L : Type ℓ} {ε : L} {_·_ : L → L → L} + (is-setL : isSet L) + (assoc : (x y z : L) → x · (y · z) ≡ (x · y) · z) + (rid : (x : L) → x · ε ≡ x) + (comm : (x y : L) → x · y ≡ y · x) + (idem : (x : L) → x · x ≡ x) + → IsSemilattice ε _·_ +IsSemilattice.isCommMonoid (makeIsSemilattice is-setL assoc rid comm idem) = + makeIsCommMonoid is-setL assoc rid comm +IsSemilattice.idem (makeIsSemilattice is-setL assoc rid comm idem) = idem + +makeSemilattice : {L : Type ℓ} (ε : L) (_·_ : L → L → L) + (is-setL : isSet L) + (assoc : (x y z : L) → x · (y · z) ≡ (x · y) · z) + (rid : (x : L) → x · ε ≡ x) + (comm : (x y : L) → x · y ≡ y · x) + (idem : (x : L) → x · x ≡ x) + → Semilattice ℓ +makeSemilattice ε _·_ is-setL assoc rid comm idem = + semilattice _ ε _·_ (makeIsSemilattice is-setL assoc rid comm idem) + + +SemilatticeStr→MonoidStr : {A : Type ℓ} → SemilatticeStr A → MonoidStr A +SemilatticeStr→MonoidStr (semilatticestr _ _ H) = + monoidstr _ _ (H .IsSemilattice.isCommMonoid .IsCommMonoid.isMonoid) + +Semilattice→Monoid : Semilattice ℓ → Monoid ℓ +Semilattice→Monoid (_ , semilatticestr _ _ H) = + _ , monoidstr _ _ (H .IsSemilattice.isCommMonoid .IsCommMonoid.isMonoid) + +Semilattice→CommMonoid : Semilattice ℓ → CommMonoid ℓ +Semilattice→CommMonoid (_ , semilatticestr _ _ H) = + _ , commmonoidstr _ _ (H .IsSemilattice.isCommMonoid) + +SemilatticeHom : (L : Semilattice ℓ) (M : Semilattice ℓ') → Type (ℓ-max ℓ ℓ') +SemilatticeHom L M = MonoidHom (Semilattice→Monoid L) (Semilattice→Monoid M) + +IsSemilatticeEquiv : {A : Type ℓ} {B : Type ℓ'} + (M : SemilatticeStr A) (e : A ≃ B) (N : SemilatticeStr B) → Type (ℓ-max ℓ ℓ') +IsSemilatticeEquiv M e N = + IsMonoidHom (SemilatticeStr→MonoidStr M) (e .fst) (SemilatticeStr→MonoidStr N) + +SemilatticeEquiv : (M : Semilattice ℓ) (N : Semilattice ℓ') → Type (ℓ-max ℓ ℓ') +SemilatticeEquiv M N = Σ[ e ∈ (M .fst ≃ N .fst) ] IsSemilatticeEquiv (M .snd) e (N .snd) + +isPropIsSemilattice : {L : Type ℓ} (ε : L) (_·_ : L → L → L) + → isProp (IsSemilattice ε _·_) +isPropIsSemilattice ε _·_ (issemilattice LL LC) (issemilattice SL SC) = + λ i → issemilattice (isPropIsCommMonoid _ _ LL SL i) (isPropIdem LC SC i) + where + open IsCommMonoid LL using (is-set) + + isPropIdem : isProp ((x : _) → x · x ≡ x) + isPropIdem = isPropΠ λ _ → is-set _ _ + +𝒮ᴰ-Semilattice : DUARel (𝒮-Univ ℓ) SemilatticeStr ℓ +𝒮ᴰ-Semilattice = + 𝒮ᴰ-Record (𝒮-Univ _) IsSemilatticeEquiv + (fields: + data[ ε ∣ autoDUARel _ _ ∣ presε ] + data[ _·_ ∣ autoDUARel _ _ ∣ pres· ] + prop[ isSemilattice ∣ (λ _ _ → isPropIsSemilattice _ _) ]) + where + open SemilatticeStr + open IsMonoidHom + +SemilatticePath : (L K : Semilattice ℓ) → SemilatticeEquiv L K ≃ (L ≡ K) +SemilatticePath = ∫ 𝒮ᴰ-Semilattice .UARel.ua + + +-- TODO: decide if that's the right approach +module JoinSemilattice (L' : Semilattice ℓ) where + private L = fst L' + open SemilatticeStr (snd L') renaming (_·_ to _∨l_ ; ε to 0l) + open CommMonoidTheory (Semilattice→CommMonoid L') + open MonoidBigOp (Semilattice→Monoid L') + + _≤_ : L → L → Type ℓ + x ≤ y = x ∨l y ≡ y + + infix 4 _≤_ + + IndPoset : Poset ℓ ℓ + fst IndPoset = L + PosetStr._≤_ (snd IndPoset) = _≤_ + IsPoset.is-set (PosetStr.isPoset (snd IndPoset)) = is-set + IsPoset.is-prop-valued (PosetStr.isPoset (snd IndPoset)) = λ _ _ → is-set _ _ + IsPoset.is-refl (PosetStr.isPoset (snd IndPoset)) = idem + IsPoset.is-trans (PosetStr.isPoset (snd IndPoset)) = path + where + path : (a b c : L) → a ∨l b ≡ b → b ∨l c ≡ c → a ∨l c ≡ c + path a b c a∨b≡b b∨c≡c = a ∨l c ≡⟨ cong (a ∨l_) (sym b∨c≡c) ⟩ + a ∨l (b ∨l c) ≡⟨ ·Assoc _ _ _ ⟩ + (a ∨l b) ∨l c ≡⟨ cong (_∨l c) a∨b≡b ⟩ + b ∨l c ≡⟨ b∨c≡c ⟩ + c ∎ + IsPoset.is-antisym (PosetStr.isPoset (snd IndPoset)) = + λ _ _ a∨b≡b b∨a≡a → sym b∨a≡a ∙∙ ·Comm _ _ ∙∙ a∨b≡b + + ∨lIsMax : ∀ x y z → x ≤ z → y ≤ z → x ∨l y ≤ z + ∨lIsMax x y z x≤z y≤z = cong ((x ∨l y) ∨l_) (sym (idem z)) ∙ commAssocSwap x y z z + ∙ cong₂ (_∨l_) x≤z y≤z + ∙ idem z + + ∨≤LCancel : ∀ x y → y ≤ x ∨l y + ∨≤LCancel x y = commAssocl y x y ∙ cong (x ∨l_) (idem y) + + ∨≤RCancel : ∀ x y → x ≤ x ∨l y + ∨≤RCancel x y = ·Assoc _ _ _ ∙ cong (_∨l y) (idem x) + + ≤-∨Pres : ∀ x y u w → x ≤ y → u ≤ w → x ∨l u ≤ y ∨l w + ≤-∨Pres x y u w x≤y u≤w = commAssocSwap x u y w ∙ cong₂ (_∨l_) x≤y u≤w + + ≤-∨LPres : ∀ x y z → x ≤ y → z ∨l x ≤ z ∨l y + ≤-∨LPres x y z x≤y = ≤-∨Pres _ _ _ _ (idem z) x≤y + + ≤-∨RPres : ∀ x y z → x ≤ y → x ∨l z ≤ y ∨l z + ≤-∨RPres x y z x≤y = ≤-∨Pres _ _ _ _ x≤y (idem z) + + -- inequalities of bigOps + open IsPoset (PosetStr.isPoset (snd IndPoset)) + open PosetReasoning IndPoset + + + ind≤bigOp : {n : ℕ} (U : FinVec L n) (i : Fin n) → U i ≤ bigOp U + ind≤bigOp {n = suc n} U zero = ∨≤RCancel _ _ + ind≤bigOp {n = suc n} U (suc i) = is-trans _ (bigOp (U ∘ suc)) _ (ind≤bigOp (U ∘ suc) i) + (∨≤LCancel _ _) + + bigOpIsMax : {n : ℕ} (U : FinVec L n) (x : L) → (∀ i → U i ≤ x) → bigOp U ≤ x + bigOpIsMax {n = zero} _ _ _ = ·IdL _ + bigOpIsMax {n = suc n} U x U≤x = + bigOp U ≤⟨ is-refl _ ⟩ + U zero ∨l bigOp (U ∘ suc) ≤⟨ ≤-∨LPres _ _ _ (bigOpIsMax _ _ (U≤x ∘ suc)) ⟩ + U zero ∨l x ≤⟨ ∨lIsMax _ _ _ (U≤x zero) (is-refl x) ⟩ + x ◾ + + ≤-bigOpExt : {n : ℕ} (U W : FinVec L n) → (∀ i → U i ≤ W i) → bigOp U ≤ bigOp W + ≤-bigOpExt {n = zero} U W U≤W = is-refl 0l + ≤-bigOpExt {n = suc n} U W U≤W = ≤-∨Pres _ _ _ _ (U≤W zero) (≤-bigOpExt _ _ (U≤W ∘ suc)) + +module MeetSemilattice (L' : Semilattice ℓ) where + private L = fst L' + open SemilatticeStr (snd L') renaming (_·_ to _∧l_ ; ε to 1l) + open CommMonoidTheory (Semilattice→CommMonoid L') + + _≤_ : L → L → Type ℓ + x ≤ y = x ∧l y ≡ x + + infix 4 _≤_ + + IndPoset : Poset ℓ ℓ + fst IndPoset = L + PosetStr._≤_ (snd IndPoset) = _≤_ + IsPoset.is-set (PosetStr.isPoset (snd IndPoset)) = is-set + IsPoset.is-prop-valued (PosetStr.isPoset (snd IndPoset)) = λ _ _ → is-set _ _ + IsPoset.is-refl (PosetStr.isPoset (snd IndPoset)) = idem + IsPoset.is-trans (PosetStr.isPoset (snd IndPoset)) = path + where + path : (a b c : L) → a ∧l b ≡ a → b ∧l c ≡ b → a ∧l c ≡ a + path a b c a∧b≡a b∧c≡b = a ∧l c ≡⟨ cong (_∧l c) (sym a∧b≡a) ⟩ + (a ∧l b) ∧l c ≡⟨ sym (·Assoc _ _ _) ⟩ + a ∧l (b ∧l c) ≡⟨ cong (a ∧l_) b∧c≡b ⟩ + a ∧l b ≡⟨ a∧b≡a ⟩ + a ∎ + IsPoset.is-antisym (PosetStr.isPoset (snd IndPoset)) = + λ _ _ a∧b≡a b∧a≡b → sym a∧b≡a ∙∙ ·Comm _ _ ∙∙ b∧a≡b + + ≤-∧LPres : ∀ x y z → x ≤ y → z ∧l x ≤ z ∧l y + ≤-∧LPres x y z x≤y = commAssocSwap z x z y ∙∙ cong (_∧l (x ∧l y)) (idem z) ∙∙ cong (z ∧l_) x≤y + + ≤-∧RPres : ∀ x y z → x ≤ y → x ∧l z ≤ y ∧l z + ≤-∧RPres x y z x≤y = commAssocSwap x z y z ∙∙ cong (x ∧l y ∧l_) (idem z) ∙∙ cong (_∧l z) x≤y + + ≤-∧Pres : ∀ x y z w → x ≤ y → z ≤ w → x ∧l z ≤ y ∧l w + ≤-∧Pres x y z w x≤y z≤w = commAssocSwap x z y w ∙ cong₂ _∧l_ x≤y z≤w + + ∧≤LCancel : ∀ x y → x ∧l y ≤ y + ∧≤LCancel x y = sym (·Assoc _ _ _) ∙ cong (x ∧l_) (idem y) + + ∧≤RCancel : ∀ x y → x ∧l y ≤ x + ∧≤RCancel x y = commAssocr x y x ∙ cong (_∧l y) (idem x) + + ∧lIsMin : ∀ x y z → z ≤ x → z ≤ y → z ≤ x ∧l y + ∧lIsMin x y z z≤x z≤y = cong (_∧l (x ∧l y)) (sym (idem z)) ∙ commAssocSwap z z x y + ∙ cong₂ (_∧l_) z≤x z≤y + ∙ idem z \ No newline at end of file diff --git a/Cubical.Algebra.Semilattice.Instances.NatMax.html b/Cubical.Algebra.Semilattice.Instances.NatMax.html index 78adf4d717..ee58d39aa2 100644 --- a/Cubical.Algebra.Semilattice.Instances.NatMax.html +++ b/Cubical.Algebra.Semilattice.Instances.NatMax.html @@ -23,16 +23,16 @@ open import Cubical.Algebra.Semilattice.Base -open SemilatticeStr +open SemilatticeStr private variable ℓ ℓ' : Level -maxSemilatticeStr : SemilatticeStr ℕ -ε maxSemilatticeStr = 0 -_·_ maxSemilatticeStr = max -isSemilattice maxSemilatticeStr = makeIsSemilattice isSetℕ maxAssoc maxRId maxComm maxIdem +maxSemilatticeStr : SemilatticeStr ℕ +ε maxSemilatticeStr = 0 +_·_ maxSemilatticeStr = max +isSemilattice maxSemilatticeStr = makeIsSemilattice isSetℕ maxAssoc maxRId maxComm maxIdem where maxAssoc : (x y z : ℕ) → max x (max y z) ≡ max (max x y) z maxAssoc zero y z = refl @@ -51,7 +51,7 @@ --characterisation of inequality -open JoinSemilattice (ℕ , maxSemilatticeStr) renaming (_≤_ to _≤max_) +open JoinSemilattice (ℕ , maxSemilatticeStr) renaming (_≤_ to _≤max_) ≤max→≤ℕ : ∀ x y → x ≤max y → x ≤ℕ y ≤max→≤ℕ zero y _ = zero-≤ @@ -69,16 +69,16 @@ -- big max and all results with right inequality -open MonoidBigOp (Semilattice→Monoid (ℕ , maxSemilatticeStr)) +open MonoidBigOp (Semilattice→Monoid (ℕ , maxSemilatticeStr)) Max = bigOp ind≤Max : {n : ℕ} (U : FinVec ℕ n) (i : Fin n) → U i ≤ℕ Max U -ind≤Max U i = ≤max→≤ℕ _ _ (ind≤bigOp U i) +ind≤Max U i = ≤max→≤ℕ _ _ (ind≤bigOp U i) MaxIsMax : {n : ℕ} (U : FinVec ℕ n) (x : ℕ) → (∀ i → U i ≤ℕ x) → Max U ≤ℕ x -MaxIsMax U x h = ≤max→≤ℕ _ _ (bigOpIsMax U x λ i → ≤ℕ→≤max _ _ (h i)) +MaxIsMax U x h = ≤max→≤ℕ _ _ (bigOpIsMax U x λ i → ≤ℕ→≤max _ _ (h i)) ≤-MaxExt : {n : ℕ} (U W : FinVec ℕ n) → (∀ i → U i ≤ℕ W i) → Max U ≤ℕ Max W -≤-MaxExt U W h = ≤max→≤ℕ _ _ (≤-bigOpExt U W λ i → ≤ℕ→≤max _ _ (h i)) +≤-MaxExt U W h = ≤max→≤ℕ _ _ (≤-bigOpExt U W λ i → ≤ℕ→≤max _ _ (h i)) \ No newline at end of file diff --git a/Cubical.Algebra.ZariskiLattice.Base.html b/Cubical.Algebra.ZariskiLattice.Base.html index b1bdd46b83..dd2538ffaa 100644 --- a/Cubical.Algebra.ZariskiLattice.Base.html +++ b/Cubical.Algebra.ZariskiLattice.Base.html @@ -23,200 +23,200 @@ open import Cubical.Data.Unit open import Cubical.Relation.Nullary open import Cubical.Relation.Binary -open import Cubical.Relation.Binary.Poset - -open import Cubical.Algebra.Ring -open import Cubical.Algebra.Ring.Properties -open import Cubical.Algebra.Ring.BigOps -open import Cubical.Algebra.CommRing -open import Cubical.Algebra.CommRing.BinomialThm -open import Cubical.Algebra.CommRing.Ideal -open import Cubical.Algebra.CommRing.Ideal.Sum -open import Cubical.Algebra.CommRing.FGIdeal -open import Cubical.Algebra.CommRing.RadicalIdeal -open import Cubical.Tactics.CommRingSolver.Reflection -open import Cubical.Algebra.Semilattice -open import Cubical.Algebra.Lattice -open import Cubical.Algebra.DistLattice -open import Cubical.Algebra.Matrix - -open import Cubical.HITs.SetQuotients as SQ - -open Iso -open BinaryRelation -open isEquivRel - -private - variable - ℓ ℓ' : Level - - -module ZarLat (R' : CommRing ℓ) where - open CommRingStr (snd R') - open RingTheory (CommRing→Ring R') - open Sum (CommRing→Ring R') - open CommRingTheory R' - open Exponentiation R' - open BinomialThm R' - open CommIdeal R' - open RadicalIdeal R' - open isCommIdeal - open ProdFin R' - open IdealSum R' - - private - R = fst R' - A = Σ[ n ∈ ℕ ] (FinVec R n) - ⟨_⟩ : {n : ℕ} → FinVec R n → CommIdeal - ⟨ V ⟩ = ⟨ V ⟩[ R' ] - - -- This is small! - _≼_ : A → A → Type ℓ - (_ , α) ≼ (_ , β) = ∀ i → α i ∈ √ ⟨ β ⟩ - - private - isRefl≼ : ∀ {a} → a ≼ a - isRefl≼ i = ∈→∈√ _ _ (indInIdeal _ _ i) - - isTrans≼ : ∀ {a b c : A} → a ≼ b → b ≼ c → a ≼ c - isTrans≼ a≼b b≼c i = (√FGIdealCharRImpl _ _ b≼c) _ (a≼b i) - - _∼_ : A → A → Type ℓ -- \sim - α ∼ β = (α ≼ β) × (β ≼ α) - - ∼PropValued : isPropValued (_∼_) - ∼PropValued (_ , α) (_ , β) = isProp× (isPropΠ (λ i → √ ⟨ β ⟩ .fst (α i) .snd)) - (isPropΠ (λ i → √ ⟨ α ⟩ .fst (β i) .snd)) - - ∼EquivRel : isEquivRel (_∼_) - reflexive ∼EquivRel _ = isRefl≼ , isRefl≼ - symmetric ∼EquivRel _ _ = Σ-swap-Iso .fun - transitive ∼EquivRel _ _ _ a∼b b∼c = isTrans≼ (fst a∼b) (fst b∼c) , isTrans≼ (snd b∼c) (snd a∼b) - - -- lives in the same universe as R - ZL : Type ℓ - ZL = A / (_∼_) - - -- need something big in our proofs though: - _∼≡_ : A → A → Type (ℓ-suc ℓ) - (_ , α) ∼≡ (_ , β) = √ ⟨ α ⟩ ≡ √ ⟨ β ⟩ - - ≡→∼ : ∀ {a b : A} → a ∼≡ b → a ∼ b - ≡→∼ r = √FGIdealCharLImpl _ ⟨ _ ⟩ (λ x h → subst (λ p → x ∈ p) r h) - , √FGIdealCharLImpl _ ⟨ _ ⟩ (λ x h → subst (λ p → x ∈ p) (sym r) h) - - ∼→≡ : ∀ {a b : A} → a ∼ b → a ∼≡ b - ∼→≡ r = CommIdeal≡Char (√FGIdealCharRImpl _ ⟨ _ ⟩ (fst r)) - (√FGIdealCharRImpl _ ⟨ _ ⟩ (snd r)) - - ∼≃≡ : ∀ {a b : A} → (a ∼ b) ≃ (a ∼≡ b) - ∼≃≡ = propBiimpl→Equiv (∼PropValued _ _) (isSetCommIdeal _ _) ∼→≡ ≡→∼ - - 0z : ZL - 0z = [ 0 , (λ ()) ] - - 1z : ZL - 1z = [ 1 , (replicateFinVec 1 1r) ] - - _∨z_ : ZL → ZL → ZL - _∨z_ = setQuotSymmBinOp (reflexive ∼EquivRel) (transitive ∼EquivRel) - (λ (_ , α) (_ , β) → (_ , α ++Fin β)) - (λ (_ , α) (_ , β) → ≡→∼ (cong √ - (FGIdealAddLemma _ α β ∙∙ +iComm _ _ ∙∙ sym (FGIdealAddLemma _ β α)))) - λ (_ , α) (_ , β) (_ , γ) α∼β → ≡→∼ (--need to show α∨γ ∼ β∨γ - √ ⟨ α ++Fin γ ⟩ ≡⟨ cong √ (FGIdealAddLemma _ α γ) ⟩ - √ (⟨ α ⟩ +i ⟨ γ ⟩) ≡⟨ sym (√+LContr _ _) ⟩ - √ (√ ⟨ α ⟩ +i ⟨ γ ⟩) ≡⟨ cong (λ I → √ (I +i ⟨ γ ⟩)) (∼→≡ α∼β) ⟩ - √ (√ ⟨ β ⟩ +i ⟨ γ ⟩) ≡⟨ √+LContr _ _ ⟩ - √ (⟨ β ⟩ +i ⟨ γ ⟩) ≡⟨ cong √ (sym (FGIdealAddLemma _ β γ)) ⟩ - √ ⟨ β ++Fin γ ⟩ ∎) - - _∧z_ : ZL → ZL → ZL - _∧z_ = setQuotSymmBinOp (reflexive ∼EquivRel) (transitive ∼EquivRel) - (λ (_ , α) (_ , β) → (_ , α ··Fin β)) - (λ (_ , α) (_ , β) → ≡→∼ (cong √ - (FGIdealMultLemma _ α β ∙∙ ·iComm _ _ ∙∙ sym (FGIdealMultLemma _ β α)))) - λ (_ , α) (_ , β) (_ , γ) α∼β → ≡→∼ (--need to show α∧γ ∼ β∧γ - √ ⟨ α ··Fin γ ⟩ ≡⟨ cong √ (FGIdealMultLemma _ α γ) ⟩ - √ (⟨ α ⟩ ·i ⟨ γ ⟩) ≡⟨ sym (√·LContr _ _) ⟩ - √ (√ ⟨ α ⟩ ·i ⟨ γ ⟩) ≡⟨ cong (λ I → √ (I ·i ⟨ γ ⟩)) (∼→≡ α∼β) ⟩ - √ (√ ⟨ β ⟩ ·i ⟨ γ ⟩) ≡⟨ √·LContr _ _ ⟩ - √ (⟨ β ⟩ ·i ⟨ γ ⟩) ≡⟨ cong √ (sym (FGIdealMultLemma _ β γ)) ⟩ - √ ⟨ β ··Fin γ ⟩ ∎) - - -- join axioms - ∨zAssoc : ∀ (𝔞 𝔟 𝔠 : ZL) → 𝔞 ∨z (𝔟 ∨z 𝔠) ≡ (𝔞 ∨z 𝔟) ∨z 𝔠 - ∨zAssoc = SQ.elimProp3 (λ _ _ _ → squash/ _ _) - λ (_ , α) (_ , β) (_ , γ) → eq/ _ _ (≡→∼ (cong √ (IdealAddAssoc _ _ _ _))) - - ∨zComm : ∀ (𝔞 𝔟 : ZL) → 𝔞 ∨z 𝔟 ≡ 𝔟 ∨z 𝔞 - ∨zComm = SQ.elimProp2 (λ _ _ → squash/ _ _) - λ (_ , α) (_ , β) → eq/ _ _ - (≡→∼ (cong √ (FGIdealAddLemma _ α β ∙∙ +iComm _ _ ∙∙ sym (FGIdealAddLemma _ β α)))) - - ∨zLid : ∀ (𝔞 : ZL) → 0z ∨z 𝔞 ≡ 𝔞 - ∨zLid = SQ.elimProp (λ _ → squash/ _ _) λ _ → eq/ _ _ (reflexive ∼EquivRel _) - - ∨zRid : ∀ (𝔞 : ZL) → 𝔞 ∨z 0z ≡ 𝔞 - ∨zRid _ = ∨zComm _ _ ∙ ∨zLid _ - - - -- -- meet axioms - ∧zAssoc : ∀ (𝔞 𝔟 𝔠 : ZL) → 𝔞 ∧z (𝔟 ∧z 𝔠) ≡ (𝔞 ∧z 𝔟) ∧z 𝔠 - ∧zAssoc = SQ.elimProp3 (λ _ _ _ → squash/ _ _) - λ (_ , α) (_ , β) (_ , γ) → eq/ _ _ (≡→∼ - (√ ⟨ α ··Fin (β ··Fin γ) ⟩ ≡⟨ cong √ (FGIdealMultLemma _ _ _) ⟩ - √ (⟨ α ⟩ ·i ⟨ β ··Fin γ ⟩) ≡⟨ cong (λ x → √ (⟨ α ⟩ ·i x)) (FGIdealMultLemma _ _ _) ⟩ - √ (⟨ α ⟩ ·i (⟨ β ⟩ ·i ⟨ γ ⟩)) ≡⟨ cong √ (·iAssoc _ _ _) ⟩ - √ ((⟨ α ⟩ ·i ⟨ β ⟩) ·i ⟨ γ ⟩) ≡⟨ cong (λ x → √ (x ·i ⟨ γ ⟩)) (sym (FGIdealMultLemma _ _ _)) ⟩ - √ (⟨ α ··Fin β ⟩ ·i ⟨ γ ⟩) ≡⟨ cong √ (sym (FGIdealMultLemma _ _ _)) ⟩ - √ ⟨ (α ··Fin β) ··Fin γ ⟩ ∎)) - - ∧zComm : ∀ (𝔞 𝔟 : ZL) → 𝔞 ∧z 𝔟 ≡ 𝔟 ∧z 𝔞 - ∧zComm = SQ.elimProp2 (λ _ _ → squash/ _ _) - λ (_ , α) (_ , β) → eq/ _ _ (≡→∼ - (cong √ (FGIdealMultLemma _ α β ∙∙ ·iComm _ _ ∙∙ sym (FGIdealMultLemma _ β α)))) - - ∧zRid : ∀ (𝔞 : ZL) → 𝔞 ∧z 1z ≡ 𝔞 - ∧zRid = SQ.elimProp (λ _ → squash/ _ _) - λ (_ , α) → eq/ _ _ (≡→∼ (cong √ - (⟨ α ··Fin (replicateFinVec 1 1r) ⟩ ≡⟨ FGIdealMultLemma _ _ _ ⟩ - ⟨ α ⟩ ·i ⟨ (replicateFinVec 1 1r) ⟩ ≡⟨ cong (⟨ α ⟩ ·i_) (contains1Is1 _ (indInIdeal _ _ zero)) ⟩ - ⟨ α ⟩ ·i 1Ideal ≡⟨ ·iRid _ ⟩ - ⟨ α ⟩ ∎))) - - - -- absorption and distributivity - ∧zAbsorb∨z : ∀ (𝔞 𝔟 : ZL) → 𝔞 ∧z (𝔞 ∨z 𝔟) ≡ 𝔞 - ∧zAbsorb∨z = SQ.elimProp2 (λ _ _ → squash/ _ _) - λ (_ , α) (_ , β) → eq/ _ _ (≡→∼ - (√ ⟨ α ··Fin (α ++Fin β) ⟩ ≡⟨ cong √ (FGIdealMultLemma _ α (α ++Fin β)) ⟩ - √ (⟨ α ⟩ ·i ⟨ α ++Fin β ⟩) ≡⟨ cong (λ x → √ (⟨ α ⟩ ·i x)) (FGIdealAddLemma _ α β) ⟩ - √ (⟨ α ⟩ ·i (⟨ α ⟩ +i ⟨ β ⟩)) ≡⟨ √·Absorb+ _ _ ⟩ - √ ⟨ α ⟩ ∎)) - - ∧zLDist∨z : ∀ (𝔞 𝔟 𝔠 : ZL) → 𝔞 ∧z (𝔟 ∨z 𝔠) ≡ (𝔞 ∧z 𝔟) ∨z (𝔞 ∧z 𝔠) - ∧zLDist∨z = SQ.elimProp3 (λ _ _ _ → squash/ _ _) - λ (_ , α) (_ , β) (_ , γ) → eq/ _ _ (≡→∼ - (√ ⟨ α ··Fin (β ++Fin γ) ⟩ ≡⟨ cong √ (FGIdealMultLemma _ _ _) ⟩ - √ (⟨ α ⟩ ·i ⟨ β ++Fin γ ⟩) ≡⟨ cong (λ x → √ (⟨ α ⟩ ·i x)) (FGIdealAddLemma _ _ _) ⟩ - √ (⟨ α ⟩ ·i (⟨ β ⟩ +i ⟨ γ ⟩)) ≡⟨ cong √ (·iRdist+i _ _ _) ⟩ - -- L/R-dist are swapped - -- in Lattices vs Rings - √ (⟨ α ⟩ ·i ⟨ β ⟩ +i ⟨ α ⟩ ·i ⟨ γ ⟩) ≡⟨ cong₂ (λ x y → √ (x +i y)) - (sym (FGIdealMultLemma _ _ _)) - (sym (FGIdealMultLemma _ _ _)) ⟩ - √ (⟨ α ··Fin β ⟩ +i ⟨ α ··Fin γ ⟩) ≡⟨ cong √ (sym (FGIdealAddLemma _ _ _)) ⟩ - √ ⟨ (α ··Fin β) ++Fin (α ··Fin γ) ⟩ ∎)) - - - ZariskiLattice : DistLattice ℓ - fst ZariskiLattice = ZL - DistLatticeStr.0l (snd ZariskiLattice) = 0z - DistLatticeStr.1l (snd ZariskiLattice) = 1z - DistLatticeStr._∨l_ (snd ZariskiLattice) = _∨z_ - DistLatticeStr._∧l_ (snd ZariskiLattice) = _∧z_ - DistLatticeStr.isDistLattice (snd ZariskiLattice) = - makeIsDistLattice∧lOver∨l squash/ ∨zAssoc ∨zRid ∨zComm - ∧zAssoc ∧zRid ∧zComm ∧zAbsorb∨z ∧zLDist∨z +open import Cubical.Relation.Binary.Order.Poset + +open import Cubical.Algebra.Ring +open import Cubical.Algebra.Ring.Properties +open import Cubical.Algebra.Ring.BigOps +open import Cubical.Algebra.CommRing +open import Cubical.Algebra.CommRing.BinomialThm +open import Cubical.Algebra.CommRing.Ideal +open import Cubical.Algebra.CommRing.Ideal.Sum +open import Cubical.Algebra.CommRing.FGIdeal +open import Cubical.Algebra.CommRing.RadicalIdeal +open import Cubical.Tactics.CommRingSolver.Reflection +open import Cubical.Algebra.Semilattice +open import Cubical.Algebra.Lattice +open import Cubical.Algebra.DistLattice +open import Cubical.Algebra.Matrix + +open import Cubical.HITs.SetQuotients as SQ + +open Iso +open BinaryRelation +open isEquivRel + +private + variable + ℓ ℓ' : Level + + +module ZarLat (R' : CommRing ℓ) where + open CommRingStr (snd R') + open RingTheory (CommRing→Ring R') + open Sum (CommRing→Ring R') + open CommRingTheory R' + open Exponentiation R' + open BinomialThm R' + open CommIdeal R' + open RadicalIdeal R' + open isCommIdeal + open ProdFin R' + open IdealSum R' + + private + R = fst R' + A = Σ[ n ∈ ℕ ] (FinVec R n) + ⟨_⟩ : {n : ℕ} → FinVec R n → CommIdeal + ⟨ V ⟩ = ⟨ V ⟩[ R' ] + + -- This is small! + _≼_ : A → A → Type ℓ + (_ , α) ≼ (_ , β) = ∀ i → α i ∈ √ ⟨ β ⟩ + + private + isRefl≼ : ∀ {a} → a ≼ a + isRefl≼ i = ∈→∈√ _ _ (indInIdeal _ _ i) + + isTrans≼ : ∀ {a b c : A} → a ≼ b → b ≼ c → a ≼ c + isTrans≼ a≼b b≼c i = (√FGIdealCharRImpl _ _ b≼c) _ (a≼b i) + + _∼_ : A → A → Type ℓ -- \sim + α ∼ β = (α ≼ β) × (β ≼ α) + + ∼PropValued : isPropValued (_∼_) + ∼PropValued (_ , α) (_ , β) = isProp× (isPropΠ (λ i → √ ⟨ β ⟩ .fst (α i) .snd)) + (isPropΠ (λ i → √ ⟨ α ⟩ .fst (β i) .snd)) + + ∼EquivRel : isEquivRel (_∼_) + reflexive ∼EquivRel _ = isRefl≼ , isRefl≼ + symmetric ∼EquivRel _ _ = Σ-swap-Iso .fun + transitive ∼EquivRel _ _ _ a∼b b∼c = isTrans≼ (fst a∼b) (fst b∼c) , isTrans≼ (snd b∼c) (snd a∼b) + + -- lives in the same universe as R + ZL : Type ℓ + ZL = A / (_∼_) + + -- need something big in our proofs though: + _∼≡_ : A → A → Type (ℓ-suc ℓ) + (_ , α) ∼≡ (_ , β) = √ ⟨ α ⟩ ≡ √ ⟨ β ⟩ + + ≡→∼ : ∀ {a b : A} → a ∼≡ b → a ∼ b + ≡→∼ r = √FGIdealCharLImpl _ ⟨ _ ⟩ (λ x h → subst (λ p → x ∈ p) r h) + , √FGIdealCharLImpl _ ⟨ _ ⟩ (λ x h → subst (λ p → x ∈ p) (sym r) h) + + ∼→≡ : ∀ {a b : A} → a ∼ b → a ∼≡ b + ∼→≡ r = CommIdeal≡Char (√FGIdealCharRImpl _ ⟨ _ ⟩ (fst r)) + (√FGIdealCharRImpl _ ⟨ _ ⟩ (snd r)) + + ∼≃≡ : ∀ {a b : A} → (a ∼ b) ≃ (a ∼≡ b) + ∼≃≡ = propBiimpl→Equiv (∼PropValued _ _) (isSetCommIdeal _ _) ∼→≡ ≡→∼ + + 0z : ZL + 0z = [ 0 , (λ ()) ] + + 1z : ZL + 1z = [ 1 , (replicateFinVec 1 1r) ] + + _∨z_ : ZL → ZL → ZL + _∨z_ = setQuotSymmBinOp (reflexive ∼EquivRel) (transitive ∼EquivRel) + (λ (_ , α) (_ , β) → (_ , α ++Fin β)) + (λ (_ , α) (_ , β) → ≡→∼ (cong √ + (FGIdealAddLemma _ α β ∙∙ +iComm _ _ ∙∙ sym (FGIdealAddLemma _ β α)))) + λ (_ , α) (_ , β) (_ , γ) α∼β → ≡→∼ (--need to show α∨γ ∼ β∨γ + √ ⟨ α ++Fin γ ⟩ ≡⟨ cong √ (FGIdealAddLemma _ α γ) ⟩ + √ (⟨ α ⟩ +i ⟨ γ ⟩) ≡⟨ sym (√+LContr _ _) ⟩ + √ (√ ⟨ α ⟩ +i ⟨ γ ⟩) ≡⟨ cong (λ I → √ (I +i ⟨ γ ⟩)) (∼→≡ α∼β) ⟩ + √ (√ ⟨ β ⟩ +i ⟨ γ ⟩) ≡⟨ √+LContr _ _ ⟩ + √ (⟨ β ⟩ +i ⟨ γ ⟩) ≡⟨ cong √ (sym (FGIdealAddLemma _ β γ)) ⟩ + √ ⟨ β ++Fin γ ⟩ ∎) + + _∧z_ : ZL → ZL → ZL + _∧z_ = setQuotSymmBinOp (reflexive ∼EquivRel) (transitive ∼EquivRel) + (λ (_ , α) (_ , β) → (_ , α ··Fin β)) + (λ (_ , α) (_ , β) → ≡→∼ (cong √ + (FGIdealMultLemma _ α β ∙∙ ·iComm _ _ ∙∙ sym (FGIdealMultLemma _ β α)))) + λ (_ , α) (_ , β) (_ , γ) α∼β → ≡→∼ (--need to show α∧γ ∼ β∧γ + √ ⟨ α ··Fin γ ⟩ ≡⟨ cong √ (FGIdealMultLemma _ α γ) ⟩ + √ (⟨ α ⟩ ·i ⟨ γ ⟩) ≡⟨ sym (√·LContr _ _) ⟩ + √ (√ ⟨ α ⟩ ·i ⟨ γ ⟩) ≡⟨ cong (λ I → √ (I ·i ⟨ γ ⟩)) (∼→≡ α∼β) ⟩ + √ (√ ⟨ β ⟩ ·i ⟨ γ ⟩) ≡⟨ √·LContr _ _ ⟩ + √ (⟨ β ⟩ ·i ⟨ γ ⟩) ≡⟨ cong √ (sym (FGIdealMultLemma _ β γ)) ⟩ + √ ⟨ β ··Fin γ ⟩ ∎) + + -- join axioms + ∨zAssoc : ∀ (𝔞 𝔟 𝔠 : ZL) → 𝔞 ∨z (𝔟 ∨z 𝔠) ≡ (𝔞 ∨z 𝔟) ∨z 𝔠 + ∨zAssoc = SQ.elimProp3 (λ _ _ _ → squash/ _ _) + λ (_ , α) (_ , β) (_ , γ) → eq/ _ _ (≡→∼ (cong √ (IdealAddAssoc _ _ _ _))) + + ∨zComm : ∀ (𝔞 𝔟 : ZL) → 𝔞 ∨z 𝔟 ≡ 𝔟 ∨z 𝔞 + ∨zComm = SQ.elimProp2 (λ _ _ → squash/ _ _) + λ (_ , α) (_ , β) → eq/ _ _ + (≡→∼ (cong √ (FGIdealAddLemma _ α β ∙∙ +iComm _ _ ∙∙ sym (FGIdealAddLemma _ β α)))) + + ∨zLid : ∀ (𝔞 : ZL) → 0z ∨z 𝔞 ≡ 𝔞 + ∨zLid = SQ.elimProp (λ _ → squash/ _ _) λ _ → eq/ _ _ (reflexive ∼EquivRel _) + + ∨zRid : ∀ (𝔞 : ZL) → 𝔞 ∨z 0z ≡ 𝔞 + ∨zRid _ = ∨zComm _ _ ∙ ∨zLid _ + + + -- -- meet axioms + ∧zAssoc : ∀ (𝔞 𝔟 𝔠 : ZL) → 𝔞 ∧z (𝔟 ∧z 𝔠) ≡ (𝔞 ∧z 𝔟) ∧z 𝔠 + ∧zAssoc = SQ.elimProp3 (λ _ _ _ → squash/ _ _) + λ (_ , α) (_ , β) (_ , γ) → eq/ _ _ (≡→∼ + (√ ⟨ α ··Fin (β ··Fin γ) ⟩ ≡⟨ cong √ (FGIdealMultLemma _ _ _) ⟩ + √ (⟨ α ⟩ ·i ⟨ β ··Fin γ ⟩) ≡⟨ cong (λ x → √ (⟨ α ⟩ ·i x)) (FGIdealMultLemma _ _ _) ⟩ + √ (⟨ α ⟩ ·i (⟨ β ⟩ ·i ⟨ γ ⟩)) ≡⟨ cong √ (·iAssoc _ _ _) ⟩ + √ ((⟨ α ⟩ ·i ⟨ β ⟩) ·i ⟨ γ ⟩) ≡⟨ cong (λ x → √ (x ·i ⟨ γ ⟩)) (sym (FGIdealMultLemma _ _ _)) ⟩ + √ (⟨ α ··Fin β ⟩ ·i ⟨ γ ⟩) ≡⟨ cong √ (sym (FGIdealMultLemma _ _ _)) ⟩ + √ ⟨ (α ··Fin β) ··Fin γ ⟩ ∎)) + + ∧zComm : ∀ (𝔞 𝔟 : ZL) → 𝔞 ∧z 𝔟 ≡ 𝔟 ∧z 𝔞 + ∧zComm = SQ.elimProp2 (λ _ _ → squash/ _ _) + λ (_ , α) (_ , β) → eq/ _ _ (≡→∼ + (cong √ (FGIdealMultLemma _ α β ∙∙ ·iComm _ _ ∙∙ sym (FGIdealMultLemma _ β α)))) + + ∧zRid : ∀ (𝔞 : ZL) → 𝔞 ∧z 1z ≡ 𝔞 + ∧zRid = SQ.elimProp (λ _ → squash/ _ _) + λ (_ , α) → eq/ _ _ (≡→∼ (cong √ + (⟨ α ··Fin (replicateFinVec 1 1r) ⟩ ≡⟨ FGIdealMultLemma _ _ _ ⟩ + ⟨ α ⟩ ·i ⟨ (replicateFinVec 1 1r) ⟩ ≡⟨ cong (⟨ α ⟩ ·i_) (contains1Is1 _ (indInIdeal _ _ zero)) ⟩ + ⟨ α ⟩ ·i 1Ideal ≡⟨ ·iRid _ ⟩ + ⟨ α ⟩ ∎))) + + + -- absorption and distributivity + ∧zAbsorb∨z : ∀ (𝔞 𝔟 : ZL) → 𝔞 ∧z (𝔞 ∨z 𝔟) ≡ 𝔞 + ∧zAbsorb∨z = SQ.elimProp2 (λ _ _ → squash/ _ _) + λ (_ , α) (_ , β) → eq/ _ _ (≡→∼ + (√ ⟨ α ··Fin (α ++Fin β) ⟩ ≡⟨ cong √ (FGIdealMultLemma _ α (α ++Fin β)) ⟩ + √ (⟨ α ⟩ ·i ⟨ α ++Fin β ⟩) ≡⟨ cong (λ x → √ (⟨ α ⟩ ·i x)) (FGIdealAddLemma _ α β) ⟩ + √ (⟨ α ⟩ ·i (⟨ α ⟩ +i ⟨ β ⟩)) ≡⟨ √·Absorb+ _ _ ⟩ + √ ⟨ α ⟩ ∎)) + + ∧zLDist∨z : ∀ (𝔞 𝔟 𝔠 : ZL) → 𝔞 ∧z (𝔟 ∨z 𝔠) ≡ (𝔞 ∧z 𝔟) ∨z (𝔞 ∧z 𝔠) + ∧zLDist∨z = SQ.elimProp3 (λ _ _ _ → squash/ _ _) + λ (_ , α) (_ , β) (_ , γ) → eq/ _ _ (≡→∼ + (√ ⟨ α ··Fin (β ++Fin γ) ⟩ ≡⟨ cong √ (FGIdealMultLemma _ _ _) ⟩ + √ (⟨ α ⟩ ·i ⟨ β ++Fin γ ⟩) ≡⟨ cong (λ x → √ (⟨ α ⟩ ·i x)) (FGIdealAddLemma _ _ _) ⟩ + √ (⟨ α ⟩ ·i (⟨ β ⟩ +i ⟨ γ ⟩)) ≡⟨ cong √ (·iRdist+i _ _ _) ⟩ + -- L/R-dist are swapped + -- in Lattices vs Rings + √ (⟨ α ⟩ ·i ⟨ β ⟩ +i ⟨ α ⟩ ·i ⟨ γ ⟩) ≡⟨ cong₂ (λ x y → √ (x +i y)) + (sym (FGIdealMultLemma _ _ _)) + (sym (FGIdealMultLemma _ _ _)) ⟩ + √ (⟨ α ··Fin β ⟩ +i ⟨ α ··Fin γ ⟩) ≡⟨ cong √ (sym (FGIdealAddLemma _ _ _)) ⟩ + √ ⟨ (α ··Fin β) ++Fin (α ··Fin γ) ⟩ ∎)) + + + ZariskiLattice : DistLattice ℓ + fst ZariskiLattice = ZL + DistLatticeStr.0l (snd ZariskiLattice) = 0z + DistLatticeStr.1l (snd ZariskiLattice) = 1z + DistLatticeStr._∨l_ (snd ZariskiLattice) = _∨z_ + DistLatticeStr._∧l_ (snd ZariskiLattice) = _∧z_ + DistLatticeStr.isDistLattice (snd ZariskiLattice) = + makeIsDistLattice∧lOver∨l squash/ ∨zAssoc ∨zRid ∨zComm + ∧zAssoc ∧zRid ∧zComm ∧zAbsorb∨z ∧zLDist∨z \ No newline at end of file diff --git a/Cubical.Algebra.ZariskiLattice.StructureSheaf.html b/Cubical.Algebra.ZariskiLattice.StructureSheaf.html index df034593e6..9e5a95b310 100644 --- a/Cubical.Algebra.ZariskiLattice.StructureSheaf.html +++ b/Cubical.Algebra.ZariskiLattice.StructureSheaf.html @@ -35,402 +35,402 @@ open import Cubical.Data.Unit open import Cubical.Relation.Nullary open import Cubical.Relation.Binary -open import Cubical.Relation.Binary.Poset - -open import Cubical.Algebra.Ring -open import Cubical.Algebra.Ring.Properties -open import Cubical.Algebra.Ring.BigOps -open import Cubical.Algebra.Algebra -open import Cubical.Algebra.CommRing -open import Cubical.Algebra.CommRing.BinomialThm -open import Cubical.Algebra.CommRing.Ideal -open import Cubical.Algebra.CommRing.FGIdeal -open import Cubical.Algebra.CommRing.RadicalIdeal -open import Cubical.Algebra.CommRing.Localisation -open import Cubical.Algebra.CommRing.Instances.Unit -open import Cubical.Algebra.CommAlgebra.Base -open import Cubical.Algebra.CommAlgebra.Properties -open import Cubical.Algebra.CommAlgebra.Localisation -open import Cubical.Tactics.CommRingSolver.Reflection -open import Cubical.Algebra.Semilattice -open import Cubical.Algebra.Lattice -open import Cubical.Algebra.DistLattice -open import Cubical.Algebra.DistLattice.Basis -open import Cubical.Algebra.DistLattice.BigOps -open import Cubical.Algebra.ZariskiLattice.Base -open import Cubical.Algebra.ZariskiLattice.UniversalProperty - -open import Cubical.Categories.Category.Base hiding (_[_,_]) -open import Cubical.Categories.Functor -open import Cubical.Categories.NaturalTransformation -open import Cubical.Categories.Limits.Limits -open import Cubical.Categories.Limits.Terminal -open import Cubical.Categories.Limits.RightKan - -open import Cubical.Categories.Instances.CommRings -open import Cubical.Categories.Instances.CommAlgebras -open import Cubical.Categories.Instances.DistLattice -open import Cubical.Categories.Instances.Semilattice - -open import Cubical.Categories.DistLatticeSheaf.Diagram -open import Cubical.Categories.DistLatticeSheaf.Base -open import Cubical.Categories.DistLatticeSheaf.Extension - -open import Cubical.HITs.SetQuotients as SQ -open import Cubical.HITs.PropositionalTruncation as PT - -open Iso -open BinaryRelation -open isEquivRel - - -module _ {ℓ : Level} (R' : CommRing ℓ) where - open CommRingStr ⦃...⦄ - open RingTheory (CommRing→Ring R') - open CommIdeal R' - open isCommIdeal - - open ZarLat R' - open ZarLatUniversalProp R' - open IsZarMap - - open Join ZariskiLattice - open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice ZariskiLattice)) - open IsBasis - - private - R = fst R' - instance - _ = snd R' - ⟨_⟩ₛ : R → CommIdeal -- s is for singleton - ⟨ f ⟩ₛ = ⟨ replicateFinVec 1 f ⟩[ R' ] - - BasicOpens : ℙ ZL - BasicOpens 𝔞 = (∃[ f ∈ R ] (D f ≡ 𝔞)) , isPropPropTrunc - - BO : Type ℓ - BO = Σ[ 𝔞 ∈ ZL ] (𝔞 ∈ₚ BasicOpens) - - basicOpensAreBasis : IsBasis ZariskiLattice BasicOpens - contains1 basicOpensAreBasis = ∣ 1r , isZarMapD .pres1 ∣₁ - ∧lClosed basicOpensAreBasis 𝔞 𝔟 = map2 - λ (f , Df≡𝔞) (g , Dg≡𝔟) → (f · g) , isZarMapD .·≡∧ f g ∙ cong₂ (_∧z_) Df≡𝔞 Dg≡𝔟 - ⋁Basis basicOpensAreBasis = elimProp (λ _ → isPropPropTrunc) Σhelper - where - Σhelper : (a : Σ[ n ∈ ℕ ] FinVec R n) - → ∃[ n ∈ ℕ ] Σ[ α ∈ FinVec ZL n ] (∀ i → α i ∈ₚ BasicOpens) × (⋁ α ≡ [ a ]) - Σhelper (n , α) = ∣ n , (D ∘ α) , (λ i → ∣ α i , refl ∣₁) , ⋁D≡ α ∣₁ - - -- important fact that D(f)≤D(g) → isContr (R-Hom R[1/f] R[1/g]) - module _ where - open InvertingElementsBase R' - - contrHoms : (f g : R) - → D f ≤ D g - → isContr (CommAlgebraHom R[1/ g ]AsCommAlgebra R[1/ f ]AsCommAlgebra) - contrHoms f g Df≤Dg = R[1/g]HasAlgUniversalProp R[1/ f ]AsCommAlgebra - λ s s∈[gⁿ|n≥0] → subst-∈ₚ (R[1/ f ]AsCommRing ˣ) - (sym (·IdR (s /1))) --can't apply the lemma directly as we get mult with 1 somewhere - (RadicalLemma.toUnit R' f g f∈√⟨g⟩ s s∈[gⁿ|n≥0]) - where - open AlgLoc R' [ g ⁿ|n≥0] (powersFormMultClosedSubset g) - renaming (S⁻¹RHasAlgUniversalProp to R[1/g]HasAlgUniversalProp) - open S⁻¹RUniversalProp R' [ f ⁿ|n≥0] (powersFormMultClosedSubset f) using (_/1) - open RadicalIdeal R' - - private - instance - _ = snd R[1/ f ]AsCommRing - - f∈√⟨g⟩ : f ∈ √ ⟨ g ⟩ₛ - f∈√⟨g⟩ = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun Df≤Dg .fst zero - - - -- The structure presheaf on BO - ZariskiCat = DistLatticeCategory ZariskiLattice - - BOCat : Category ℓ ℓ - BOCat = ΣPropCat ZariskiCat BasicOpens - - private - P : ZL → Type _ - P 𝔞 = Σ[ f ∈ R ] (D f ≡ 𝔞) -- the untruncated defining property - - 𝓕 : Σ ZL P → CommAlgebra R' _ - 𝓕 (_ , f , _) = R[1/ f ]AsCommAlgebra -- D(f) ↦ R[1/f] - - uniqueHom : ∀ (x y : Σ ZL P) → (fst x) ≤ (fst y) → isContr (CommAlgebraHom (𝓕 y) (𝓕 x)) - uniqueHom (𝔞 , f , p) (𝔟 , g , q) 𝔞≤𝔟 = contrHoms f g Df≤Dg - where - Df≤Dg : D f ≤ D g - Df≤Dg = subst2 _≤_ (sym p) (sym q) 𝔞≤𝔟 - - - - open PreSheafFromUniversalProp ZariskiCat P 𝓕 uniqueHom - 𝓞ᴮ : Functor (BOCat ^op) CommRingsCategory - 𝓞ᴮ = funcComp (ForgetfulCommAlgebra→CommRing R') universalPShf - - -- The extension - open Functor - open PreSheafExtension ZariskiLattice CommRingsCategory LimitsCommRingsCategory BasicOpens - 𝓞 : Functor (ZariskiCat ^op) CommRingsCategory - 𝓞 = DLRan 𝓞ᴮ - - toBasisPath : ∀ f → 𝓞 .F-ob (D f) ≡ 𝓞ᴮ .F-ob (D f , ∣ f , refl ∣₁) - toBasisPath f = cong (λ F → F .F-ob (D f , ∣ f , refl ∣₁)) - (NatIsoToPath isUnivalentCommRingsCategory (DLRanNatIso 𝓞ᴮ)) - - - open InvertingElementsBase R' - private - Forgetful = ForgetfulCommAlgebra→CommRing R' {ℓ' = ℓ} - - 𝓞ᴮOb≡ : ∀ f → 𝓞ᴮ .F-ob (D f , ∣ f , refl ∣₁) ≡ R[1/ f ]AsCommRing - 𝓞ᴮOb≡ f = 𝓞ᴮ .F-ob (D f , ∣ f , refl ∣₁) ≡⟨ refl ⟩ - -- all of this should hold by refl ----------------------------------------------------------- - -- but somehow Agda takes forever to type-check if you don't use ----------------------------- - -- the lemma funcCompOb≡ (which is just refl itself) or if you leave out --------------------- - -- any of the intermediate refl steps -------------------------------------------------------- - (funcComp (ForgetfulCommAlgebra→CommRing R') universalPShf) .F-ob (D f , ∣ f , refl ∣₁) - ≡⟨ funcCompOb≡ Forgetful universalPShf _ ⟩ - Forgetful .F-ob R[1/ f ]AsCommAlgebra - ≡⟨ refl ⟩ - ---------------------------------------------------------------------------------------------- - CommAlgebra→CommRing R[1/ f ]AsCommAlgebra ≡⟨ invElCommAlgebra→CommRingPath f ⟩ - R[1/ f ]AsCommRing ∎ - - baseSections : ∀ f → 𝓞 .F-ob (D f) ≡ R[1/ f ]AsCommRing - baseSections f = toBasisPath f ∙ 𝓞ᴮOb≡ f - - globalSection : 𝓞 .F-ob (D 1r) ≡ R' - globalSection = baseSections 1r ∙ invertingUnitsPath _ _ (Units.RˣContainsOne _) - - - open SheafOnBasis ZariskiLattice (CommRingsCategory {ℓ = ℓ}) BasicOpens basicOpensAreBasis - open DistLatticeStr ⦃...⦄ - private instance _ = snd ZariskiLattice - - isSheaf𝓞ᴮ : isDLBasisSheaf 𝓞ᴮ - isSheaf𝓞ᴮ {n = zero} α isBO⋁α A cᴬ = uniqueExists - (isTerminal𝓞ᴮ[0] A .fst) - (λ {(sing ()) ; (pair () _ _) }) -- the unique morphism is a cone morphism - (isPropIsConeMor _ _) - λ φ _ → isTerminal𝓞ᴮ[0] A .snd φ - where - -- D(0) is not 0 of the Zariski lattice by refl! - p : 𝓞ᴮ .F-ob (0l , isBO⋁α) ≡ R[1/ 0r ]AsCommRing - p = 𝓞ᴮ .F-ob (0l , isBO⋁α) - ≡⟨ cong (𝓞ᴮ .F-ob) (Σ≡Prop (λ _ → ∈ₚ-isProp _ _) - (eq/ _ _ ((λ ()) , λ {zero → ∣ 1 , ∣ (λ ()) , 0LeftAnnihilates _ ∣₁ ∣₁ }))) ⟩ - 𝓞ᴮ .F-ob (D 0r , ∣ 0r , refl ∣₁) - ≡⟨ 𝓞ᴮOb≡ 0r ⟩ - R[1/ 0r ]AsCommRing ∎ - - isTerminal𝓞ᴮ[0] : isTerminal CommRingsCategory (𝓞ᴮ .F-ob (0l , isBO⋁α)) - isTerminal𝓞ᴮ[0] = subst (isTerminal CommRingsCategory) - (sym (p ∙ R[1/0]≡0)) (TerminalCommRing .snd) - - isSheaf𝓞ᴮ {n = suc n} α = curriedHelper (fst ∘ α) (snd ∘ α) - where - curriedHelper : (𝔞 : FinVec ZL (suc n)) (𝔞∈BO : ∀ i → 𝔞 i ∈ₚ BasicOpens) - (⋁𝔞∈BO : ⋁ 𝔞 ∈ₚ BasicOpens) - → isLimCone _ _ (F-cone 𝓞ᴮ - (condCone.B⋁Cone (λ i → 𝔞 i , 𝔞∈BO i) ⋁𝔞∈BO)) - curriedHelper 𝔞 = PT.elimFin (λ _ → isPropΠ (λ _ → isPropIsLimCone _ _ _)) - λ x → PT.elim (λ _ → isPropIsLimCone _ _ _) (Σhelper x) - where - Σhelper : (x : ∀ i → Σ[ f ∈ R ] D f ≡ 𝔞 i) - (y : Σ[ g ∈ R ] D g ≡ ⋁ 𝔞) - → isLimCone _ _ (F-cone 𝓞ᴮ - (condCone.B⋁Cone (λ i → 𝔞 i , ∣ x i ∣₁) ∣ y ∣₁)) - Σhelper x y = toSheaf.toLimCone theSheafCone doubleLocAlgCone - algPaths isLimConeDoubleLocAlgCone - where - f = fst ∘ x - h = fst y - Df≡𝔞 = snd ∘ x - Dh≡⋁𝔞 = snd y - - open condCone (λ i → 𝔞 i , ∣ f i , Df≡𝔞 i ∣₁) - theSheafCone = B⋁Cone ∣ h , Dh≡⋁𝔞 ∣₁ - - DHelper : D h ≡ [ suc n , f ] --⋁ (D ∘ f) - DHelper = Dh≡⋁𝔞 ∙ ⋁Ext (λ i → sym (Df≡𝔞 i)) ∙ ⋁D≡ f - - open Exponentiation R' - open RadicalIdeal R' - open DoubleLoc R' h - open isMultClosedSubset (powersFormMultClosedSubset h) - open S⁻¹RUniversalProp R' [ h ⁿ|n≥0] (powersFormMultClosedSubset h) - open CommIdeal R[1/ h ]AsCommRing using () - renaming (CommIdeal to CommIdealₕ ; _∈_ to _∈ₕ_) - - instance - _ = snd R[1/ h ]AsCommRing - - -- crucial facts about radical ideals - h∈√⟨f⟩ : h ∈ √ ⟨ f ⟩[ R' ] - h∈√⟨f⟩ = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun DHelper .fst zero - - f∈√⟨h⟩ : ∀ i → f i ∈ √ ⟨ h ⟩ₛ - f∈√⟨h⟩ i = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun - (sym DHelper) .fst i - - ff∈√⟨h⟩ : ∀ i j → f i · f j ∈ √ ⟨ h ⟩ₛ - ff∈√⟨h⟩ i j = √ ⟨ h ⟩ₛ .snd .·Closed (f i) (f∈√⟨h⟩ j) - - f/1 : FinVec (R[1/ h ]) (suc n) - f/1 i = (f i) /1 - - 1∈⟨f/1⟩ : 1r ∈ₕ ⟨ f/1 ⟩[ R[1/ h ]AsCommRing ] - 1∈⟨f/1⟩ = fromFact h∈√⟨f⟩ - where - fromFact : h ∈ √ ⟨ f ⟩[ R' ] → 1r ∈ₕ ⟨ f/1 ⟩[ R[1/ h ]AsCommRing ] - fromFact = PT.rec isPropPropTrunc (uncurry helper1) - where - helper1 : (m : ℕ) → h ^ m ∈ ⟨ f ⟩[ R' ] → 1r ∈ₕ ⟨ f/1 ⟩[ R[1/ h ]AsCommRing ] - helper1 m = PT.map helper2 - where - helper2 : Σ[ α ∈ FinVec R (suc n) ] - h ^ m ≡ linearCombination R' α f - → Σ[ β ∈ FinVec R[1/ h ] (suc n) ] - 1r ≡ linearCombination R[1/ h ]AsCommRing β f/1 - helper2 (α , hᵐ≡∑αf) = β , path - where - open Units R[1/ h ]AsCommRing - open Sum (CommRing→Ring R[1/ h ]AsCommRing) - open IsRingHom (snd /1AsCommRingHom) - open SumMap _ _ /1AsCommRingHom - instance - h⁻ᵐ : (h ^ m) /1 ∈ₚ (R[1/ h ]AsCommRing ˣ) - h⁻ᵐ = [ 1r , h ^ m , ∣ m , refl ∣₁ ] - , eq/ _ _ ((1r , containsOne) , path (h ^ m)) - where - path : ∀ x → 1r · (x · 1r) · 1r ≡ 1r · 1r · (1r · x) - path = solve R' - - β : FinVec R[1/ h ] (suc n) - β i = ((h ^ m) /1) ⁻¹ · α i /1 - - /1Path : (h ^ m) /1 ≡ ∑ (λ i → α i /1 · f i /1) - /1Path = (h ^ m) /1 - ≡⟨ cong (_/1) hᵐ≡∑αf ⟩ - (linearCombination R' α f) /1 - ≡⟨ ∑Map (λ i → α i · f i) ⟩ - ∑ (λ i → (α i · f i) /1) - ≡⟨ ∑Ext (λ i → pres· (α i) (f i)) ⟩ - ∑ (λ i → α i /1 · f i /1) ∎ - - path : 1r ≡ ∑ (λ i → β i · f/1 i) - path = 1r - ≡⟨ sym (·-linv ((h ^ m) /1)) ⟩ - ((h ^ m) /1) ⁻¹ · (h ^ m) /1 - ≡⟨ cong (((h ^ m) /1) ⁻¹ ·_) /1Path ⟩ - ((h ^ m) /1) ⁻¹ · ∑ (λ i → α i /1 · f i /1) - ≡⟨ ∑Mulrdist (((h ^ m) /1) ⁻¹) (λ i → α i /1 · f i /1) ⟩ - ∑ (λ i → ((h ^ m) /1) ⁻¹ · (α i /1 · f i /1)) - ≡⟨ ∑Ext (λ i → ·Assoc (((h ^ m) /1) ⁻¹) (α i /1) (f i /1)) ⟩ - ∑ (λ i → β i · f/1 i) ∎ - - - -- Putting everything together: - -- First, the diagram and limiting cone we get from our lemma - -- in Cubical.Algebra.Localisation.Limit with R=R[1/h] - -- ⟨ f₁/1 , ... , fₙ/1 ⟩ = R[1/h] - -- ⇒ R[1/h] = lim { R[1/h][1/fᵢ] → R[1/h][1/fᵢfⱼ] ← R[1/h][1/fⱼ] } - doubleLocDiag = locDiagram R[1/ h ]AsCommRing f/1 - doubleLocCone = locCone R[1/ h ]AsCommRing f/1 - isLimConeDoubleLocCone : isLimCone _ _ doubleLocCone - isLimConeDoubleLocCone = isLimConeLocCone R[1/ h ]AsCommRing f/1 1∈⟨f/1⟩ - - -- this gives a limiting cone in R-algebras via _/1/1 : R → R[1/h][1/fᵢ] - -- note that the pair case looks more complicated as - -- R[1/h][(fᵢfⱼ)/1/1] =/= R[1/h][(fᵢ/1 · fⱼ/1)/1] - -- definitionally - open Cone - open IsRingHom - - module D i = DoubleLoc R' h (f i) - - /1/1Cone : Cone doubleLocDiag R' - coneOut /1/1Cone (sing i) = D./1/1AsCommRingHom i - fst (coneOut /1/1Cone (pair i j i<j)) r = - [ [ r , 1r , ∣ 0 , refl ∣₁ ] , 1r , ∣ 0 , refl ∣₁ ] - pres0 (snd (coneOut /1/1Cone (pair i j i<j))) = refl - pres1 (snd (coneOut /1/1Cone (pair i j i<j))) = refl - pres+ (snd (coneOut /1/1Cone (pair i j i<j))) x y = - cong [_] (≡-× (cong [_] (≡-× - (cong₂ _+_ (useSolver x) (useSolver y)) - (Σ≡Prop (λ _ → isPropPropTrunc) (useSolver 1r)))) - (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r)))) - where - useSolver : ∀ a → a ≡ a · 1r · (1r · 1r) - useSolver = solve R' - pres· (snd (coneOut /1/1Cone (pair i j i<j))) x y = - cong [_] (≡-× (cong [_] (≡-× refl - (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r))))) - (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r)))) - pres- (snd (coneOut /1/1Cone (pair i j i<j))) _ = refl - coneOutCommutes /1/1Cone idAr = idCompCommRingHom _ - coneOutCommutes /1/1Cone singPairL = RingHom≡ (funExt - (λ x → cong [_] (≡-× (cong [_] (≡-× (cong (x ·_) (transportRefl 1r) ∙ ·IdR x) - (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r)))) - (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r))))) - coneOutCommutes /1/1Cone singPairR = RingHom≡ (funExt - (λ x → cong [_] (≡-× (cong [_] (≡-× (cong (x ·_) (transportRefl 1r) ∙ ·IdR x) - (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r)))) - (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r))))) - - open LimitFromCommRing R' R[1/ h ]AsCommRing (DLShfDiag (suc n) ℓ) - doubleLocDiag doubleLocCone /1/1Cone - - -- get the desired cone in algebras: - isConeMor/1 : isConeMor /1/1Cone doubleLocCone /1AsCommRingHom - isConeMor/1 = isConeMorSingLemma /1/1Cone doubleLocCone - (λ _ → RingHom≡ (funExt (λ _ → refl))) - - doubleLocAlgCone = algCone /1AsCommRingHom isConeMor/1 - isLimConeDoubleLocAlgCone : isLimCone _ _ doubleLocAlgCone - isLimConeDoubleLocAlgCone = reflectsLimits /1AsCommRingHom isConeMor/1 - isLimConeDoubleLocCone - - -- we only give the paths on objects - -- R[1/h][1/fᵢ] ≡ [1/fᵢ] - -- R[1/h][1/fᵢfⱼ] ≡ R[1/fᵢfⱼ] - algPaths : ∀ v → F-ob algDiag v ≡ F-ob (funcComp universalPShf BDiag) v - algPaths (sing i) = doubleLocCancel (f∈√⟨h⟩ i) - where - open DoubleAlgLoc R' h (f i) - algPaths (pair i j i<j) = path ∙ doubleLocCancel (ff∈√⟨h⟩ i j) - where - open DoubleAlgLoc R' h (f i · f j) - open CommAlgChar R' - - -- the naive def. - R[1/h][1/fᵢfⱼ]AsCommRingReg = InvertingElementsBase.R[1/_]AsCommRing - R[1/ h ]AsCommRing ((f i · f j) /1) - - path : toCommAlg ( F-ob doubleLocDiag (pair i j i<j) - , coneOut /1/1Cone (pair i j i<j)) - ≡ toCommAlg (R[1/h][1/fᵢfⱼ]AsCommRingReg , /1/1AsCommRingHom (f i · f j)) - path = cong toCommAlg (ΣPathP (p , q)) - where - eqInR[1/h] : (f i /1) · (f j /1) ≡ (f i · f j) /1 - eqInR[1/h] = sym (/1AsCommRingHom .snd .pres· (f i) (f j)) - - p : F-ob doubleLocDiag (pair i j i<j) ≡ R[1/h][1/fᵢfⱼ]AsCommRingReg - p i = InvertingElementsBase.R[1/_]AsCommRing R[1/ h ]AsCommRing (eqInR[1/h] i) - - q : PathP (λ i → CommRingHom R' (p i)) (coneOut /1/1Cone (pair i j i<j)) - (/1/1AsCommRingHom (f i · f j)) - q = toPathP (RingHom≡ (funExt ( - λ r → cong [_] (≡-× (cong [_] (≡-× (transportRefl _ ∙ transportRefl r) - (Σ≡Prop (λ _ → isPropPropTrunc) (transportRefl 1r)))) - (Σ≡Prop (λ _ → isPropPropTrunc) (transportRefl 1r)))))) - - - -- our main result - isSheaf𝓞 : isDLSheaf _ _ 𝓞 - isSheaf𝓞 = isDLSheafDLRan _ _ isSheaf𝓞ᴮ +open import Cubical.Relation.Binary.Order.Poset + +open import Cubical.Algebra.Ring +open import Cubical.Algebra.Ring.Properties +open import Cubical.Algebra.Ring.BigOps +open import Cubical.Algebra.Algebra +open import Cubical.Algebra.CommRing +open import Cubical.Algebra.CommRing.BinomialThm +open import Cubical.Algebra.CommRing.Ideal +open import Cubical.Algebra.CommRing.FGIdeal +open import Cubical.Algebra.CommRing.RadicalIdeal +open import Cubical.Algebra.CommRing.Localisation +open import Cubical.Algebra.CommRing.Instances.Unit +open import Cubical.Algebra.CommAlgebra.Base +open import Cubical.Algebra.CommAlgebra.Properties +open import Cubical.Algebra.CommAlgebra.Localisation +open import Cubical.Tactics.CommRingSolver.Reflection +open import Cubical.Algebra.Semilattice +open import Cubical.Algebra.Lattice +open import Cubical.Algebra.DistLattice +open import Cubical.Algebra.DistLattice.Basis +open import Cubical.Algebra.DistLattice.BigOps +open import Cubical.Algebra.ZariskiLattice.Base +open import Cubical.Algebra.ZariskiLattice.UniversalProperty + +open import Cubical.Categories.Category.Base hiding (_[_,_]) +open import Cubical.Categories.Functor +open import Cubical.Categories.NaturalTransformation +open import Cubical.Categories.Limits.Limits +open import Cubical.Categories.Limits.Terminal +open import Cubical.Categories.Limits.RightKan + +open import Cubical.Categories.Instances.CommRings +open import Cubical.Categories.Instances.CommAlgebras +open import Cubical.Categories.Instances.DistLattice +open import Cubical.Categories.Instances.Semilattice + +open import Cubical.Categories.DistLatticeSheaf.Diagram +open import Cubical.Categories.DistLatticeSheaf.Base +open import Cubical.Categories.DistLatticeSheaf.Extension + +open import Cubical.HITs.SetQuotients as SQ +open import Cubical.HITs.PropositionalTruncation as PT + +open Iso +open BinaryRelation +open isEquivRel + + +module _ {ℓ : Level} (R' : CommRing ℓ) where + open CommRingStr ⦃...⦄ + open RingTheory (CommRing→Ring R') + open CommIdeal R' + open isCommIdeal + + open ZarLat R' + open ZarLatUniversalProp R' + open IsZarMap + + open Join ZariskiLattice + open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice ZariskiLattice)) + open IsBasis + + private + R = fst R' + instance + _ = snd R' + ⟨_⟩ₛ : R → CommIdeal -- s is for singleton + ⟨ f ⟩ₛ = ⟨ replicateFinVec 1 f ⟩[ R' ] + + BasicOpens : ℙ ZL + BasicOpens 𝔞 = (∃[ f ∈ R ] (D f ≡ 𝔞)) , isPropPropTrunc + + BO : Type ℓ + BO = Σ[ 𝔞 ∈ ZL ] (𝔞 ∈ₚ BasicOpens) + + basicOpensAreBasis : IsBasis ZariskiLattice BasicOpens + contains1 basicOpensAreBasis = ∣ 1r , isZarMapD .pres1 ∣₁ + ∧lClosed basicOpensAreBasis 𝔞 𝔟 = map2 + λ (f , Df≡𝔞) (g , Dg≡𝔟) → (f · g) , isZarMapD .·≡∧ f g ∙ cong₂ (_∧z_) Df≡𝔞 Dg≡𝔟 + ⋁Basis basicOpensAreBasis = elimProp (λ _ → isPropPropTrunc) Σhelper + where + Σhelper : (a : Σ[ n ∈ ℕ ] FinVec R n) + → ∃[ n ∈ ℕ ] Σ[ α ∈ FinVec ZL n ] (∀ i → α i ∈ₚ BasicOpens) × (⋁ α ≡ [ a ]) + Σhelper (n , α) = ∣ n , (D ∘ α) , (λ i → ∣ α i , refl ∣₁) , ⋁D≡ α ∣₁ + + -- important fact that D(f)≤D(g) → isContr (R-Hom R[1/f] R[1/g]) + module _ where + open InvertingElementsBase R' + + contrHoms : (f g : R) + → D f ≤ D g + → isContr (CommAlgebraHom R[1/ g ]AsCommAlgebra R[1/ f ]AsCommAlgebra) + contrHoms f g Df≤Dg = R[1/g]HasAlgUniversalProp R[1/ f ]AsCommAlgebra + λ s s∈[gⁿ|n≥0] → subst-∈ₚ (R[1/ f ]AsCommRing ˣ) + (sym (·IdR (s /1))) --can't apply the lemma directly as we get mult with 1 somewhere + (RadicalLemma.toUnit R' f g f∈√⟨g⟩ s s∈[gⁿ|n≥0]) + where + open AlgLoc R' [ g ⁿ|n≥0] (powersFormMultClosedSubset g) + renaming (S⁻¹RHasAlgUniversalProp to R[1/g]HasAlgUniversalProp) + open S⁻¹RUniversalProp R' [ f ⁿ|n≥0] (powersFormMultClosedSubset f) using (_/1) + open RadicalIdeal R' + + private + instance + _ = snd R[1/ f ]AsCommRing + + f∈√⟨g⟩ : f ∈ √ ⟨ g ⟩ₛ + f∈√⟨g⟩ = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun Df≤Dg .fst zero + + + -- The structure presheaf on BO + ZariskiCat = DistLatticeCategory ZariskiLattice + + BOCat : Category ℓ ℓ + BOCat = ΣPropCat ZariskiCat BasicOpens + + private + P : ZL → Type _ + P 𝔞 = Σ[ f ∈ R ] (D f ≡ 𝔞) -- the untruncated defining property + + 𝓕 : Σ ZL P → CommAlgebra R' _ + 𝓕 (_ , f , _) = R[1/ f ]AsCommAlgebra -- D(f) ↦ R[1/f] + + uniqueHom : ∀ (x y : Σ ZL P) → (fst x) ≤ (fst y) → isContr (CommAlgebraHom (𝓕 y) (𝓕 x)) + uniqueHom (𝔞 , f , p) (𝔟 , g , q) 𝔞≤𝔟 = contrHoms f g Df≤Dg + where + Df≤Dg : D f ≤ D g + Df≤Dg = subst2 _≤_ (sym p) (sym q) 𝔞≤𝔟 + + + + open PreSheafFromUniversalProp ZariskiCat P 𝓕 uniqueHom + 𝓞ᴮ : Functor (BOCat ^op) CommRingsCategory + 𝓞ᴮ = funcComp (ForgetfulCommAlgebra→CommRing R') universalPShf + + -- The extension + open Functor + open PreSheafExtension ZariskiLattice CommRingsCategory LimitsCommRingsCategory BasicOpens + 𝓞 : Functor (ZariskiCat ^op) CommRingsCategory + 𝓞 = DLRan 𝓞ᴮ + + toBasisPath : ∀ f → 𝓞 .F-ob (D f) ≡ 𝓞ᴮ .F-ob (D f , ∣ f , refl ∣₁) + toBasisPath f = cong (λ F → F .F-ob (D f , ∣ f , refl ∣₁)) + (NatIsoToPath isUnivalentCommRingsCategory (DLRanNatIso 𝓞ᴮ)) + + + open InvertingElementsBase R' + private + Forgetful = ForgetfulCommAlgebra→CommRing R' {ℓ' = ℓ} + + 𝓞ᴮOb≡ : ∀ f → 𝓞ᴮ .F-ob (D f , ∣ f , refl ∣₁) ≡ R[1/ f ]AsCommRing + 𝓞ᴮOb≡ f = 𝓞ᴮ .F-ob (D f , ∣ f , refl ∣₁) ≡⟨ refl ⟩ + -- all of this should hold by refl ----------------------------------------------------------- + -- but somehow Agda takes forever to type-check if you don't use ----------------------------- + -- the lemma funcCompOb≡ (which is just refl itself) or if you leave out --------------------- + -- any of the intermediate refl steps -------------------------------------------------------- + (funcComp (ForgetfulCommAlgebra→CommRing R') universalPShf) .F-ob (D f , ∣ f , refl ∣₁) + ≡⟨ funcCompOb≡ Forgetful universalPShf _ ⟩ + Forgetful .F-ob R[1/ f ]AsCommAlgebra + ≡⟨ refl ⟩ + ---------------------------------------------------------------------------------------------- + CommAlgebra→CommRing R[1/ f ]AsCommAlgebra ≡⟨ invElCommAlgebra→CommRingPath f ⟩ + R[1/ f ]AsCommRing ∎ + + baseSections : ∀ f → 𝓞 .F-ob (D f) ≡ R[1/ f ]AsCommRing + baseSections f = toBasisPath f ∙ 𝓞ᴮOb≡ f + + globalSection : 𝓞 .F-ob (D 1r) ≡ R' + globalSection = baseSections 1r ∙ invertingUnitsPath _ _ (Units.RˣContainsOne _) + + + open SheafOnBasis ZariskiLattice (CommRingsCategory {ℓ = ℓ}) BasicOpens basicOpensAreBasis + open DistLatticeStr ⦃...⦄ + private instance _ = snd ZariskiLattice + + isSheaf𝓞ᴮ : isDLBasisSheaf 𝓞ᴮ + isSheaf𝓞ᴮ {n = zero} α isBO⋁α A cᴬ = uniqueExists + (isTerminal𝓞ᴮ[0] A .fst) + (λ {(sing ()) ; (pair () _ _) }) -- the unique morphism is a cone morphism + (isPropIsConeMor _ _) + λ φ _ → isTerminal𝓞ᴮ[0] A .snd φ + where + -- D(0) is not 0 of the Zariski lattice by refl! + p : 𝓞ᴮ .F-ob (0l , isBO⋁α) ≡ R[1/ 0r ]AsCommRing + p = 𝓞ᴮ .F-ob (0l , isBO⋁α) + ≡⟨ cong (𝓞ᴮ .F-ob) (Σ≡Prop (λ _ → ∈ₚ-isProp _ _) + (eq/ _ _ ((λ ()) , λ {zero → ∣ 1 , ∣ (λ ()) , 0LeftAnnihilates _ ∣₁ ∣₁ }))) ⟩ + 𝓞ᴮ .F-ob (D 0r , ∣ 0r , refl ∣₁) + ≡⟨ 𝓞ᴮOb≡ 0r ⟩ + R[1/ 0r ]AsCommRing ∎ + + isTerminal𝓞ᴮ[0] : isTerminal CommRingsCategory (𝓞ᴮ .F-ob (0l , isBO⋁α)) + isTerminal𝓞ᴮ[0] = subst (isTerminal CommRingsCategory) + (sym (p ∙ R[1/0]≡0)) (TerminalCommRing .snd) + + isSheaf𝓞ᴮ {n = suc n} α = curriedHelper (fst ∘ α) (snd ∘ α) + where + curriedHelper : (𝔞 : FinVec ZL (suc n)) (𝔞∈BO : ∀ i → 𝔞 i ∈ₚ BasicOpens) + (⋁𝔞∈BO : ⋁ 𝔞 ∈ₚ BasicOpens) + → isLimCone _ _ (F-cone 𝓞ᴮ + (condCone.B⋁Cone (λ i → 𝔞 i , 𝔞∈BO i) ⋁𝔞∈BO)) + curriedHelper 𝔞 = PT.elimFin (λ _ → isPropΠ (λ _ → isPropIsLimCone _ _ _)) + λ x → PT.elim (λ _ → isPropIsLimCone _ _ _) (Σhelper x) + where + Σhelper : (x : ∀ i → Σ[ f ∈ R ] D f ≡ 𝔞 i) + (y : Σ[ g ∈ R ] D g ≡ ⋁ 𝔞) + → isLimCone _ _ (F-cone 𝓞ᴮ + (condCone.B⋁Cone (λ i → 𝔞 i , ∣ x i ∣₁) ∣ y ∣₁)) + Σhelper x y = toSheaf.toLimCone theSheafCone doubleLocAlgCone + algPaths isLimConeDoubleLocAlgCone + where + f = fst ∘ x + h = fst y + Df≡𝔞 = snd ∘ x + Dh≡⋁𝔞 = snd y + + open condCone (λ i → 𝔞 i , ∣ f i , Df≡𝔞 i ∣₁) + theSheafCone = B⋁Cone ∣ h , Dh≡⋁𝔞 ∣₁ + + DHelper : D h ≡ [ suc n , f ] --⋁ (D ∘ f) + DHelper = Dh≡⋁𝔞 ∙ ⋁Ext (λ i → sym (Df≡𝔞 i)) ∙ ⋁D≡ f + + open Exponentiation R' + open RadicalIdeal R' + open DoubleLoc R' h + open isMultClosedSubset (powersFormMultClosedSubset h) + open S⁻¹RUniversalProp R' [ h ⁿ|n≥0] (powersFormMultClosedSubset h) + open CommIdeal R[1/ h ]AsCommRing using () + renaming (CommIdeal to CommIdealₕ ; _∈_ to _∈ₕ_) + + instance + _ = snd R[1/ h ]AsCommRing + + -- crucial facts about radical ideals + h∈√⟨f⟩ : h ∈ √ ⟨ f ⟩[ R' ] + h∈√⟨f⟩ = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun DHelper .fst zero + + f∈√⟨h⟩ : ∀ i → f i ∈ √ ⟨ h ⟩ₛ + f∈√⟨h⟩ i = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun + (sym DHelper) .fst i + + ff∈√⟨h⟩ : ∀ i j → f i · f j ∈ √ ⟨ h ⟩ₛ + ff∈√⟨h⟩ i j = √ ⟨ h ⟩ₛ .snd .·Closed (f i) (f∈√⟨h⟩ j) + + f/1 : FinVec (R[1/ h ]) (suc n) + f/1 i = (f i) /1 + + 1∈⟨f/1⟩ : 1r ∈ₕ ⟨ f/1 ⟩[ R[1/ h ]AsCommRing ] + 1∈⟨f/1⟩ = fromFact h∈√⟨f⟩ + where + fromFact : h ∈ √ ⟨ f ⟩[ R' ] → 1r ∈ₕ ⟨ f/1 ⟩[ R[1/ h ]AsCommRing ] + fromFact = PT.rec isPropPropTrunc (uncurry helper1) + where + helper1 : (m : ℕ) → h ^ m ∈ ⟨ f ⟩[ R' ] → 1r ∈ₕ ⟨ f/1 ⟩[ R[1/ h ]AsCommRing ] + helper1 m = PT.map helper2 + where + helper2 : Σ[ α ∈ FinVec R (suc n) ] + h ^ m ≡ linearCombination R' α f + → Σ[ β ∈ FinVec R[1/ h ] (suc n) ] + 1r ≡ linearCombination R[1/ h ]AsCommRing β f/1 + helper2 (α , hᵐ≡∑αf) = β , path + where + open Units R[1/ h ]AsCommRing + open Sum (CommRing→Ring R[1/ h ]AsCommRing) + open IsRingHom (snd /1AsCommRingHom) + open SumMap _ _ /1AsCommRingHom + instance + h⁻ᵐ : (h ^ m) /1 ∈ₚ (R[1/ h ]AsCommRing ˣ) + h⁻ᵐ = [ 1r , h ^ m , ∣ m , refl ∣₁ ] + , eq/ _ _ ((1r , containsOne) , path (h ^ m)) + where + path : ∀ x → 1r · (x · 1r) · 1r ≡ 1r · 1r · (1r · x) + path = solve R' + + β : FinVec R[1/ h ] (suc n) + β i = ((h ^ m) /1) ⁻¹ · α i /1 + + /1Path : (h ^ m) /1 ≡ ∑ (λ i → α i /1 · f i /1) + /1Path = (h ^ m) /1 + ≡⟨ cong (_/1) hᵐ≡∑αf ⟩ + (linearCombination R' α f) /1 + ≡⟨ ∑Map (λ i → α i · f i) ⟩ + ∑ (λ i → (α i · f i) /1) + ≡⟨ ∑Ext (λ i → pres· (α i) (f i)) ⟩ + ∑ (λ i → α i /1 · f i /1) ∎ + + path : 1r ≡ ∑ (λ i → β i · f/1 i) + path = 1r + ≡⟨ sym (·-linv ((h ^ m) /1)) ⟩ + ((h ^ m) /1) ⁻¹ · (h ^ m) /1 + ≡⟨ cong (((h ^ m) /1) ⁻¹ ·_) /1Path ⟩ + ((h ^ m) /1) ⁻¹ · ∑ (λ i → α i /1 · f i /1) + ≡⟨ ∑Mulrdist (((h ^ m) /1) ⁻¹) (λ i → α i /1 · f i /1) ⟩ + ∑ (λ i → ((h ^ m) /1) ⁻¹ · (α i /1 · f i /1)) + ≡⟨ ∑Ext (λ i → ·Assoc (((h ^ m) /1) ⁻¹) (α i /1) (f i /1)) ⟩ + ∑ (λ i → β i · f/1 i) ∎ + + + -- Putting everything together: + -- First, the diagram and limiting cone we get from our lemma + -- in Cubical.Algebra.Localisation.Limit with R=R[1/h] + -- ⟨ f₁/1 , ... , fₙ/1 ⟩ = R[1/h] + -- ⇒ R[1/h] = lim { R[1/h][1/fᵢ] → R[1/h][1/fᵢfⱼ] ← R[1/h][1/fⱼ] } + doubleLocDiag = locDiagram R[1/ h ]AsCommRing f/1 + doubleLocCone = locCone R[1/ h ]AsCommRing f/1 + isLimConeDoubleLocCone : isLimCone _ _ doubleLocCone + isLimConeDoubleLocCone = isLimConeLocCone R[1/ h ]AsCommRing f/1 1∈⟨f/1⟩ + + -- this gives a limiting cone in R-algebras via _/1/1 : R → R[1/h][1/fᵢ] + -- note that the pair case looks more complicated as + -- R[1/h][(fᵢfⱼ)/1/1] =/= R[1/h][(fᵢ/1 · fⱼ/1)/1] + -- definitionally + open Cone + open IsRingHom + + module D i = DoubleLoc R' h (f i) + + /1/1Cone : Cone doubleLocDiag R' + coneOut /1/1Cone (sing i) = D./1/1AsCommRingHom i + fst (coneOut /1/1Cone (pair i j i<j)) r = + [ [ r , 1r , ∣ 0 , refl ∣₁ ] , 1r , ∣ 0 , refl ∣₁ ] + pres0 (snd (coneOut /1/1Cone (pair i j i<j))) = refl + pres1 (snd (coneOut /1/1Cone (pair i j i<j))) = refl + pres+ (snd (coneOut /1/1Cone (pair i j i<j))) x y = + cong [_] (≡-× (cong [_] (≡-× + (cong₂ _+_ (useSolver x) (useSolver y)) + (Σ≡Prop (λ _ → isPropPropTrunc) (useSolver 1r)))) + (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r)))) + where + useSolver : ∀ a → a ≡ a · 1r · (1r · 1r) + useSolver = solve R' + pres· (snd (coneOut /1/1Cone (pair i j i<j))) x y = + cong [_] (≡-× (cong [_] (≡-× refl + (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r))))) + (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r)))) + pres- (snd (coneOut /1/1Cone (pair i j i<j))) _ = refl + coneOutCommutes /1/1Cone idAr = idCompCommRingHom _ + coneOutCommutes /1/1Cone singPairL = RingHom≡ (funExt + (λ x → cong [_] (≡-× (cong [_] (≡-× (cong (x ·_) (transportRefl 1r) ∙ ·IdR x) + (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r)))) + (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r))))) + coneOutCommutes /1/1Cone singPairR = RingHom≡ (funExt + (λ x → cong [_] (≡-× (cong [_] (≡-× (cong (x ·_) (transportRefl 1r) ∙ ·IdR x) + (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r)))) + (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r))))) + + open LimitFromCommRing R' R[1/ h ]AsCommRing (DLShfDiag (suc n) ℓ) + doubleLocDiag doubleLocCone /1/1Cone + + -- get the desired cone in algebras: + isConeMor/1 : isConeMor /1/1Cone doubleLocCone /1AsCommRingHom + isConeMor/1 = isConeMorSingLemma /1/1Cone doubleLocCone + (λ _ → RingHom≡ (funExt (λ _ → refl))) + + doubleLocAlgCone = algCone /1AsCommRingHom isConeMor/1 + isLimConeDoubleLocAlgCone : isLimCone _ _ doubleLocAlgCone + isLimConeDoubleLocAlgCone = reflectsLimits /1AsCommRingHom isConeMor/1 + isLimConeDoubleLocCone + + -- we only give the paths on objects + -- R[1/h][1/fᵢ] ≡ [1/fᵢ] + -- R[1/h][1/fᵢfⱼ] ≡ R[1/fᵢfⱼ] + algPaths : ∀ v → F-ob algDiag v ≡ F-ob (funcComp universalPShf BDiag) v + algPaths (sing i) = doubleLocCancel (f∈√⟨h⟩ i) + where + open DoubleAlgLoc R' h (f i) + algPaths (pair i j i<j) = path ∙ doubleLocCancel (ff∈√⟨h⟩ i j) + where + open DoubleAlgLoc R' h (f i · f j) + open CommAlgChar R' + + -- the naive def. + R[1/h][1/fᵢfⱼ]AsCommRingReg = InvertingElementsBase.R[1/_]AsCommRing + R[1/ h ]AsCommRing ((f i · f j) /1) + + path : toCommAlg ( F-ob doubleLocDiag (pair i j i<j) + , coneOut /1/1Cone (pair i j i<j)) + ≡ toCommAlg (R[1/h][1/fᵢfⱼ]AsCommRingReg , /1/1AsCommRingHom (f i · f j)) + path = cong toCommAlg (ΣPathP (p , q)) + where + eqInR[1/h] : (f i /1) · (f j /1) ≡ (f i · f j) /1 + eqInR[1/h] = sym (/1AsCommRingHom .snd .pres· (f i) (f j)) + + p : F-ob doubleLocDiag (pair i j i<j) ≡ R[1/h][1/fᵢfⱼ]AsCommRingReg + p i = InvertingElementsBase.R[1/_]AsCommRing R[1/ h ]AsCommRing (eqInR[1/h] i) + + q : PathP (λ i → CommRingHom R' (p i)) (coneOut /1/1Cone (pair i j i<j)) + (/1/1AsCommRingHom (f i · f j)) + q = toPathP (RingHom≡ (funExt ( + λ r → cong [_] (≡-× (cong [_] (≡-× (transportRefl _ ∙ transportRefl r) + (Σ≡Prop (λ _ → isPropPropTrunc) (transportRefl 1r)))) + (Σ≡Prop (λ _ → isPropPropTrunc) (transportRefl 1r)))))) + + + -- our main result + isSheaf𝓞 : isDLSheaf _ _ 𝓞 + isSheaf𝓞 = isDLSheafDLRan _ _ isSheaf𝓞ᴮ \ No newline at end of file diff --git a/Cubical.Algebra.ZariskiLattice.StructureSheafPullback.html b/Cubical.Algebra.ZariskiLattice.StructureSheafPullback.html index 20967c438e..0a59fe2cc9 100644 --- a/Cubical.Algebra.ZariskiLattice.StructureSheafPullback.html +++ b/Cubical.Algebra.ZariskiLattice.StructureSheafPullback.html @@ -35,187 +35,187 @@ open import Cubical.Data.Unit open import Cubical.Relation.Nullary open import Cubical.Relation.Binary -open import Cubical.Relation.Binary.Poset - -open import Cubical.Algebra.Ring -open import Cubical.Algebra.Ring.Properties -open import Cubical.Algebra.Ring.BigOps -open import Cubical.Algebra.Algebra -open import Cubical.Algebra.CommRing -open import Cubical.Algebra.CommRing.BinomialThm -open import Cubical.Algebra.CommRing.Ideal -open import Cubical.Algebra.CommRing.FGIdeal -open import Cubical.Algebra.CommRing.RadicalIdeal -open import Cubical.Algebra.CommRing.Localisation.Base -open import Cubical.Algebra.CommRing.Localisation.UniversalProperty -open import Cubical.Algebra.CommRing.Localisation.InvertingElements -open import Cubical.Algebra.CommRing.Localisation.PullbackSquare -open import Cubical.Algebra.CommAlgebra.Base -open import Cubical.Algebra.CommAlgebra.Properties -open import Cubical.Algebra.CommAlgebra.Localisation -open import Cubical.Algebra.CommAlgebra.Instances.Unit -open import Cubical.Tactics.CommRingSolver.Reflection -open import Cubical.Algebra.Semilattice -open import Cubical.Algebra.Lattice -open import Cubical.Algebra.DistLattice -open import Cubical.Algebra.DistLattice.Basis -open import Cubical.Algebra.DistLattice.BigOps -open import Cubical.Algebra.ZariskiLattice.Base -open import Cubical.Algebra.ZariskiLattice.UniversalProperty - -open import Cubical.Categories.Category.Base hiding (_[_,_]) -open import Cubical.Categories.Functor -open import Cubical.Categories.Limits.Terminal -open import Cubical.Categories.Limits.Pullback -open import Cubical.Categories.Instances.CommAlgebras -open import Cubical.Categories.Instances.DistLattice -open import Cubical.Categories.Instances.Semilattice -open import Cubical.Categories.DistLatticeSheaf.Base - -open import Cubical.HITs.SetQuotients as SQ -open import Cubical.HITs.PropositionalTruncation as PT - -open Iso -open BinaryRelation -open isEquivRel - -private - variable - ℓ ℓ' : Level - - - -module _ (R' : CommRing ℓ) where - open CommRingStr ⦃...⦄ - open RingTheory (CommRing→Ring R') - open CommIdeal R' - open isCommIdeal - - open ZarLat R' - open ZarLatUniversalProp R' - open IsZarMap - - open Join ZariskiLattice - open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice ZariskiLattice)) - open IsBasis - - private - R = fst R' - instance - _ = snd R' - ⟨_⟩ : R → CommIdeal - ⟨ f ⟩ = ⟨ replicateFinVec 1 f ⟩[ R' ] - ⟨_⟩ₚ : R × R → CommIdeal -- p is for pair - ⟨ f , g ⟩ₚ = ⟨ replicateFinVec 1 f ++Fin replicateFinVec 1 g ⟩[ R' ] - - - BasicOpens : ℙ ZL - BasicOpens 𝔞 = (∃[ f ∈ R ] (D f ≡ 𝔞)) , isPropPropTrunc - - BO : Type ℓ - BO = Σ[ 𝔞 ∈ ZL ] (𝔞 ∈ₚ BasicOpens) - - basicOpensAreBasis : IsBasis ZariskiLattice BasicOpens - contains1 basicOpensAreBasis = ∣ 1r , isZarMapD .pres1 ∣₁ - ∧lClosed basicOpensAreBasis 𝔞 𝔟 = map2 - λ (f , Df≡𝔞) (g , Dg≡𝔟) → (f · g) , isZarMapD .·≡∧ f g ∙ cong₂ (_∧z_) Df≡𝔞 Dg≡𝔟 - ⋁Basis basicOpensAreBasis = elimProp (λ _ → isPropPropTrunc) Σhelper - where - Σhelper : (a : Σ[ n ∈ ℕ ] FinVec R n) - → ∃[ n ∈ ℕ ] Σ[ α ∈ FinVec ZL n ] (∀ i → α i ∈ₚ BasicOpens) × (⋁ α ≡ [ a ]) - Σhelper (n , α) = ∣ n , (D ∘ α) , (λ i → ∣ α i , refl ∣₁) , path ∣₁ - where - path : ⋁ (D ∘ α) ≡ [ n , α ] - path = funExt⁻ (cong fst ZLUniversalPropCorollary) _ - - - -- The structure presheaf on BO - ZariskiCat = DistLatticeCategory ZariskiLattice - - BOCat : Category ℓ ℓ - BOCat = ΣPropCat ZariskiCat BasicOpens - - private - P : ZL → Type _ - P 𝔞 = Σ[ f ∈ R ] (D f ≡ 𝔞) -- the untruncated defining property - - 𝓕 : Σ ZL P → CommAlgebra R' _ - 𝓕 (_ , f , _) = R[1/ f ]AsCommAlgebra -- D(f) ↦ R[1/f] - - uniqueHom : ∀ (x y : Σ ZL P) → (fst x) ≤ (fst y) → isContr (CommAlgebraHom (𝓕 y) (𝓕 x)) - uniqueHom (𝔞 , f , p) (𝔟 , g , q) = contrHoms 𝔞 𝔟 f g p q - where - open InvertingElementsBase R' - - contrHoms : (𝔞 𝔟 : ZL) (f g : R) (p : D f ≡ 𝔞) (q : D g ≡ 𝔟) - → 𝔞 ≤ 𝔟 → isContr (CommAlgebraHom R[1/ g ]AsCommAlgebra R[1/ f ]AsCommAlgebra) - contrHoms 𝔞 𝔟 f g p q 𝔞≤𝔟 = R[1/g]HasAlgUniversalProp R[1/ f ]AsCommAlgebra - λ s s∈[gⁿ|n≥0] → subst-∈ₚ (R[1/ f ]AsCommRing ˣ) - (sym (·IdR (s /1))) --can't apply the lemma directly as we get mult with 1 somewhere - (RadicalLemma.toUnit R' f g f∈√⟨g⟩ s s∈[gⁿ|n≥0]) - where - open AlgLoc R' [ g ⁿ|n≥0] (powersFormMultClosedSubset g) - renaming (S⁻¹RHasAlgUniversalProp to R[1/g]HasAlgUniversalProp) - open S⁻¹RUniversalProp R' [ f ⁿ|n≥0] (powersFormMultClosedSubset f) using (_/1) - open RadicalIdeal R' - - private - instance - _ = snd R[1/ f ]AsCommRing - - Df≤Dg : D f ≤ D g - Df≤Dg = subst2 _≤_ (sym p) (sym q) 𝔞≤𝔟 - - f∈√⟨g⟩ : f ∈ √ ⟨ g ⟩ - f∈√⟨g⟩ = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun Df≤Dg .fst zero - - - open PreSheafFromUniversalProp ZariskiCat P 𝓕 uniqueHom - BasisStructurePShf : Functor (BOCat ^op) (CommAlgebrasCategory R') - BasisStructurePShf = universalPShf - - - -- now prove the sheaf properties - open SheafOnBasis ZariskiLattice (CommAlgebrasCategory R' {ℓ' = ℓ}) - BasicOpens basicOpensAreBasis - - -- only proof for weak notion of sheaf on a basis - isSheafBasisStructurePShf : isDLBasisSheafPullback BasisStructurePShf - fst isSheafBasisStructurePShf 0∈BO = subst (isTerminal (CommAlgebrasCategory R')) - (sym R[1/0]≡0 ∙ λ i → F-ob (0z , canonical0∈BO≡0∈BO i)) - (TerminalCommAlgebra R' .snd) - where - open Functor ⦃...⦄ - instance - _ = BasisStructurePShf - - canonical0∈BO : 0z ∈ₚ BasicOpens - canonical0∈BO = ∣ 0r , isZarMapD .pres0 ∣₁ - - canonical0∈BO≡0∈BO : canonical0∈BO ≡ 0∈BO - canonical0∈BO≡0∈BO = BasicOpens 0z .snd _ _ - - R[1/0]≡0 : R[1/ 0r ]AsCommAlgebra ≡ UnitCommAlgebra R' - R[1/0]≡0 = uaCommAlgebra (e , eIsRHom) - where - open InvertingElementsBase R' using (isContrR[1/0]) - open IsAlgebraHom - - e : R[1/ 0r ]AsCommAlgebra .fst ≃ UnitCommAlgebra R' .fst - e = isContr→Equiv isContrR[1/0] isContrUnit* - - eIsRHom : IsCommAlgebraEquiv (R[1/ 0r ]AsCommAlgebra .snd) e (UnitCommAlgebra R' .snd) - pres0 eIsRHom = refl - pres1 eIsRHom = refl - pres+ eIsRHom _ _ = refl - pres· eIsRHom _ _ = refl - pres- eIsRHom _ = refl - pres⋆ eIsRHom _ _ = refl - - snd isSheafBasisStructurePShf (𝔞 , 𝔞∈BO) (𝔟 , 𝔟∈BO) 𝔞∨𝔟∈BO = curriedHelper 𝔞 𝔟 𝔞∈BO 𝔟∈BO 𝔞∨𝔟∈BO - where - open condSquare - {- +open import Cubical.Relation.Binary.Order.Poset + +open import Cubical.Algebra.Ring +open import Cubical.Algebra.Ring.Properties +open import Cubical.Algebra.Ring.BigOps +open import Cubical.Algebra.Algebra +open import Cubical.Algebra.CommRing +open import Cubical.Algebra.CommRing.BinomialThm +open import Cubical.Algebra.CommRing.Ideal +open import Cubical.Algebra.CommRing.FGIdeal +open import Cubical.Algebra.CommRing.RadicalIdeal +open import Cubical.Algebra.CommRing.Localisation.Base +open import Cubical.Algebra.CommRing.Localisation.UniversalProperty +open import Cubical.Algebra.CommRing.Localisation.InvertingElements +open import Cubical.Algebra.CommRing.Localisation.PullbackSquare +open import Cubical.Algebra.CommAlgebra.Base +open import Cubical.Algebra.CommAlgebra.Properties +open import Cubical.Algebra.CommAlgebra.Localisation +open import Cubical.Algebra.CommAlgebra.Instances.Unit +open import Cubical.Tactics.CommRingSolver.Reflection +open import Cubical.Algebra.Semilattice +open import Cubical.Algebra.Lattice +open import Cubical.Algebra.DistLattice +open import Cubical.Algebra.DistLattice.Basis +open import Cubical.Algebra.DistLattice.BigOps +open import Cubical.Algebra.ZariskiLattice.Base +open import Cubical.Algebra.ZariskiLattice.UniversalProperty + +open import Cubical.Categories.Category.Base hiding (_[_,_]) +open import Cubical.Categories.Functor +open import Cubical.Categories.Limits.Terminal +open import Cubical.Categories.Limits.Pullback +open import Cubical.Categories.Instances.CommAlgebras +open import Cubical.Categories.Instances.DistLattice +open import Cubical.Categories.Instances.Semilattice +open import Cubical.Categories.DistLatticeSheaf.Base + +open import Cubical.HITs.SetQuotients as SQ +open import Cubical.HITs.PropositionalTruncation as PT + +open Iso +open BinaryRelation +open isEquivRel + +private + variable + ℓ ℓ' : Level + + + +module _ (R' : CommRing ℓ) where + open CommRingStr ⦃...⦄ + open RingTheory (CommRing→Ring R') + open CommIdeal R' + open isCommIdeal + + open ZarLat R' + open ZarLatUniversalProp R' + open IsZarMap + + open Join ZariskiLattice + open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice ZariskiLattice)) + open IsBasis + + private + R = fst R' + instance + _ = snd R' + ⟨_⟩ : R → CommIdeal + ⟨ f ⟩ = ⟨ replicateFinVec 1 f ⟩[ R' ] + ⟨_⟩ₚ : R × R → CommIdeal -- p is for pair + ⟨ f , g ⟩ₚ = ⟨ replicateFinVec 1 f ++Fin replicateFinVec 1 g ⟩[ R' ] + + + BasicOpens : ℙ ZL + BasicOpens 𝔞 = (∃[ f ∈ R ] (D f ≡ 𝔞)) , isPropPropTrunc + + BO : Type ℓ + BO = Σ[ 𝔞 ∈ ZL ] (𝔞 ∈ₚ BasicOpens) + + basicOpensAreBasis : IsBasis ZariskiLattice BasicOpens + contains1 basicOpensAreBasis = ∣ 1r , isZarMapD .pres1 ∣₁ + ∧lClosed basicOpensAreBasis 𝔞 𝔟 = map2 + λ (f , Df≡𝔞) (g , Dg≡𝔟) → (f · g) , isZarMapD .·≡∧ f g ∙ cong₂ (_∧z_) Df≡𝔞 Dg≡𝔟 + ⋁Basis basicOpensAreBasis = elimProp (λ _ → isPropPropTrunc) Σhelper + where + Σhelper : (a : Σ[ n ∈ ℕ ] FinVec R n) + → ∃[ n ∈ ℕ ] Σ[ α ∈ FinVec ZL n ] (∀ i → α i ∈ₚ BasicOpens) × (⋁ α ≡ [ a ]) + Σhelper (n , α) = ∣ n , (D ∘ α) , (λ i → ∣ α i , refl ∣₁) , path ∣₁ + where + path : ⋁ (D ∘ α) ≡ [ n , α ] + path = funExt⁻ (cong fst ZLUniversalPropCorollary) _ + + + -- The structure presheaf on BO + ZariskiCat = DistLatticeCategory ZariskiLattice + + BOCat : Category ℓ ℓ + BOCat = ΣPropCat ZariskiCat BasicOpens + + private + P : ZL → Type _ + P 𝔞 = Σ[ f ∈ R ] (D f ≡ 𝔞) -- the untruncated defining property + + 𝓕 : Σ ZL P → CommAlgebra R' _ + 𝓕 (_ , f , _) = R[1/ f ]AsCommAlgebra -- D(f) ↦ R[1/f] + + uniqueHom : ∀ (x y : Σ ZL P) → (fst x) ≤ (fst y) → isContr (CommAlgebraHom (𝓕 y) (𝓕 x)) + uniqueHom (𝔞 , f , p) (𝔟 , g , q) = contrHoms 𝔞 𝔟 f g p q + where + open InvertingElementsBase R' + + contrHoms : (𝔞 𝔟 : ZL) (f g : R) (p : D f ≡ 𝔞) (q : D g ≡ 𝔟) + → 𝔞 ≤ 𝔟 → isContr (CommAlgebraHom R[1/ g ]AsCommAlgebra R[1/ f ]AsCommAlgebra) + contrHoms 𝔞 𝔟 f g p q 𝔞≤𝔟 = R[1/g]HasAlgUniversalProp R[1/ f ]AsCommAlgebra + λ s s∈[gⁿ|n≥0] → subst-∈ₚ (R[1/ f ]AsCommRing ˣ) + (sym (·IdR (s /1))) --can't apply the lemma directly as we get mult with 1 somewhere + (RadicalLemma.toUnit R' f g f∈√⟨g⟩ s s∈[gⁿ|n≥0]) + where + open AlgLoc R' [ g ⁿ|n≥0] (powersFormMultClosedSubset g) + renaming (S⁻¹RHasAlgUniversalProp to R[1/g]HasAlgUniversalProp) + open S⁻¹RUniversalProp R' [ f ⁿ|n≥0] (powersFormMultClosedSubset f) using (_/1) + open RadicalIdeal R' + + private + instance + _ = snd R[1/ f ]AsCommRing + + Df≤Dg : D f ≤ D g + Df≤Dg = subst2 _≤_ (sym p) (sym q) 𝔞≤𝔟 + + f∈√⟨g⟩ : f ∈ √ ⟨ g ⟩ + f∈√⟨g⟩ = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun Df≤Dg .fst zero + + + open PreSheafFromUniversalProp ZariskiCat P 𝓕 uniqueHom + BasisStructurePShf : Functor (BOCat ^op) (CommAlgebrasCategory R') + BasisStructurePShf = universalPShf + + + -- now prove the sheaf properties + open SheafOnBasis ZariskiLattice (CommAlgebrasCategory R' {ℓ' = ℓ}) + BasicOpens basicOpensAreBasis + + -- only proof for weak notion of sheaf on a basis + isSheafBasisStructurePShf : isDLBasisSheafPullback BasisStructurePShf + fst isSheafBasisStructurePShf 0∈BO = subst (isTerminal (CommAlgebrasCategory R')) + (sym R[1/0]≡0 ∙ λ i → F-ob (0z , canonical0∈BO≡0∈BO i)) + (TerminalCommAlgebra R' .snd) + where + open Functor ⦃...⦄ + instance + _ = BasisStructurePShf + + canonical0∈BO : 0z ∈ₚ BasicOpens + canonical0∈BO = ∣ 0r , isZarMapD .pres0 ∣₁ + + canonical0∈BO≡0∈BO : canonical0∈BO ≡ 0∈BO + canonical0∈BO≡0∈BO = BasicOpens 0z .snd _ _ + + R[1/0]≡0 : R[1/ 0r ]AsCommAlgebra ≡ UnitCommAlgebra R' + R[1/0]≡0 = uaCommAlgebra (e , eIsRHom) + where + open InvertingElementsBase R' using (isContrR[1/0]) + open IsAlgebraHom + + e : R[1/ 0r ]AsCommAlgebra .fst ≃ UnitCommAlgebra R' .fst + e = isContr→Equiv isContrR[1/0] isContrUnit* + + eIsRHom : IsCommAlgebraEquiv (R[1/ 0r ]AsCommAlgebra .snd) e (UnitCommAlgebra R' .snd) + pres0 eIsRHom = refl + pres1 eIsRHom = refl + pres+ eIsRHom _ _ = refl + pres· eIsRHom _ _ = refl + pres- eIsRHom _ = refl + pres⋆ eIsRHom _ _ = refl + + snd isSheafBasisStructurePShf (𝔞 , 𝔞∈BO) (𝔟 , 𝔟∈BO) 𝔞∨𝔟∈BO = curriedHelper 𝔞 𝔟 𝔞∈BO 𝔟∈BO 𝔞∨𝔟∈BO + where + open condSquare + {- here: BFsq (𝔞 , 𝔞∈BO) (𝔟 , 𝔟∈BO) 𝔞∨𝔟∈BO BasisStructurePShf = @@ -226,107 +226,107 @@ 𝓞 (𝔟) → 𝓞 (𝔞∧𝔟) -} - curriedHelper : (𝔞 𝔟 : ZL) (𝔞∈BO : 𝔞 ∈ₚ BasicOpens) (𝔟∈BO : 𝔟 ∈ₚ BasicOpens) - (𝔞∨𝔟∈BO : 𝔞 ∨z 𝔟 ∈ₚ BasicOpens) - → isPullback (CommAlgebrasCategory R') _ _ _ - (BFsq (𝔞 , 𝔞∈BO) (𝔟 , 𝔟∈BO) 𝔞∨𝔟∈BO BasisStructurePShf) - curriedHelper 𝔞 𝔟 = elim3 (λ 𝔞∈BO 𝔟∈BO 𝔞∨𝔟∈BO → isPropIsPullback _ _ _ _ - (BFsq (𝔞 , 𝔞∈BO) (𝔟 , 𝔟∈BO) 𝔞∨𝔟∈BO BasisStructurePShf)) - Σhelper - where - -- write everything explicitly so things can type-check - thePShfCospan : (a : Σ[ f ∈ R ] D f ≡ 𝔞) (b : Σ[ g ∈ R ] D g ≡ 𝔟) - → Cospan (CommAlgebrasCategory R') - Cospan.l (thePShfCospan (f , Df≡𝔞) (g , Dg≡𝔟)) = BasisStructurePShf .Functor.F-ob (𝔟 , ∣ g , Dg≡𝔟 ∣₁) - Cospan.m (thePShfCospan (f , Df≡𝔞) (g , Dg≡𝔟)) = BasisStructurePShf .Functor.F-ob - (𝔞 ∧z 𝔟 , basicOpensAreBasis .∧lClosed 𝔞 𝔟 ∣ f , Df≡𝔞 ∣₁ ∣ g , Dg≡𝔟 ∣₁) - Cospan.r (thePShfCospan (f , Df≡𝔞) (g , Dg≡𝔟)) = BasisStructurePShf .Functor.F-ob (𝔞 , ∣ f , Df≡𝔞 ∣₁) - Cospan.s₁ (thePShfCospan (f , Df≡𝔞) (g , Dg≡𝔟)) = BasisStructurePShf .Functor.F-hom - {x = (𝔟 , ∣ g , Dg≡𝔟 ∣₁)} - {y = (𝔞 ∧z 𝔟 , basicOpensAreBasis .∧lClosed 𝔞 𝔟 ∣ f , Df≡𝔞 ∣₁ ∣ g , Dg≡𝔟 ∣₁)} - (hom-∧₂ ZariskiLattice (CommAlgebrasCategory R' {ℓ' = ℓ}) 𝔞 𝔟) - Cospan.s₂ (thePShfCospan (f , Df≡𝔞) (g , Dg≡𝔟)) = BasisStructurePShf .Functor.F-hom - {x = (𝔞 , ∣ f , Df≡𝔞 ∣₁)} - {y = (𝔞 ∧z 𝔟 , basicOpensAreBasis .∧lClosed 𝔞 𝔟 ∣ f , Df≡𝔞 ∣₁ ∣ g , Dg≡𝔟 ∣₁)} - (hom-∧₁ ZariskiLattice (CommAlgebrasCategory R' {ℓ' = ℓ}) 𝔞 𝔟) - - Σhelper : (a : Σ[ f ∈ R ] D f ≡ 𝔞) (b : Σ[ g ∈ R ] D g ≡ 𝔟) (c : Σ[ h ∈ R ] D h ≡ 𝔞 ∨z 𝔟) - → isPullback (CommAlgebrasCategory R') (thePShfCospan a b) _ _ - (BFsq (𝔞 , ∣ a ∣₁) (𝔟 , ∣ b ∣₁) ∣ c ∣₁ BasisStructurePShf) - Σhelper (f , Df≡𝔞) (g , Dg≡𝔟) (h , Dh≡𝔞∨𝔟) = toSheafPB.lemma - (𝔞 ∨z 𝔟 , ∣ h , Dh≡𝔞∨𝔟 ∣₁) - (𝔞 , ∣ f , Df≡𝔞 ∣₁) - (𝔟 , ∣ g , Dg≡𝔟 ∣₁) - (𝔞 ∧z 𝔟 , basicOpensAreBasis .∧lClosed 𝔞 𝔟 ∣ f , Df≡𝔞 ∣₁ ∣ g , Dg≡𝔟 ∣₁) - (Bsq (𝔞 , ∣ f , Df≡𝔞 ∣₁) (𝔟 , ∣ g , Dg≡𝔟 ∣₁) ∣ h , Dh≡𝔞∨𝔟 ∣₁) - theAlgebraCospan theAlgebraPullback refl gPath fPath fgPath - where - open Exponentiation R' - open RadicalIdeal R' - open InvertingElementsBase R' - open DoubleLoc R' h - open S⁻¹RUniversalProp R' [ h ⁿ|n≥0] (powersFormMultClosedSubset h) - open CommIdeal R[1/ h ]AsCommRing using () renaming (CommIdeal to CommIdealₕ ; _∈_ to _∈ₕ_) - - instance - _ = snd R[1/ h ]AsCommRing - - ⟨_⟩ₕ : R[1/ h ] × R[1/ h ] → CommIdealₕ - ⟨ x , y ⟩ₕ = ⟨ replicateFinVec 1 x ++Fin replicateFinVec 1 y ⟩[ R[1/ h ]AsCommRing ] - - -- the crucial algebraic fact: - DHelper : D h ≡ D f ∨z D g - DHelper = Dh≡𝔞∨𝔟 ∙ cong₂ (_∨z_) (sym Df≡𝔞) (sym Dg≡𝔟) - - f∈√⟨h⟩ : f ∈ √ ⟨ h ⟩ - f∈√⟨h⟩ = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun (sym DHelper) .fst zero - - g∈√⟨h⟩ : g ∈ √ ⟨ h ⟩ - g∈√⟨h⟩ = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun (sym DHelper) .fst one - - fg∈√⟨h⟩ : (f · g) ∈ √ ⟨ h ⟩ - fg∈√⟨h⟩ = √ ⟨ h ⟩ .snd .·Closed f g∈√⟨h⟩ - - 1∈fgIdeal : 1r ∈ₕ ⟨ (f /1) , (g /1) ⟩ₕ - 1∈fgIdeal = helper1 (isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun DHelper .fst zero) - where - helper1 : h ∈ √ ⟨ f , g ⟩ₚ - → 1r ∈ₕ ⟨ (f /1) , (g /1) ⟩ₕ - helper1 = PT.rec isPropPropTrunc (uncurry helper2) - where - helper2 : (n : ℕ) - → h ^ n ∈ ⟨ f , g ⟩ₚ - → 1r ∈ₕ ⟨ (f /1) , (g /1) ⟩ₕ - helper2 n = map helper3 - where - helper3 : Σ[ α ∈ FinVec R 2 ] - h ^ n ≡ linearCombination R' α (λ { zero → f ; (suc zero) → g }) - → Σ[ β ∈ FinVec R[1/ h ] 2 ] - 1r ≡ linearCombination R[1/ h ]AsCommRing β - λ { zero → f /1 ; (suc zero) → g /1 } - helper3 (α , p) = β , path - where - β : FinVec R[1/ h ] 2 - β zero = [ α zero , h ^ n , ∣ n , refl ∣₁ ] - β (suc zero) = [ α (suc zero) , h ^ n , ∣ n , refl ∣₁ ] - - path : 1r ≡ linearCombination R[1/ h ]AsCommRing β - λ { zero → f /1 ; (suc zero) → g /1 } - path = eq/ _ _ ((1r , ∣ 0 , refl ∣₁) , bigPath) - ∙ cong (β zero · (f /1) +_) (sym (+IdR (β (suc zero) · (g /1)))) - where - useSolver1 : ∀ hn → 1r · 1r · ((hn · 1r) · (hn · 1r)) ≡ hn · hn - useSolver1 = solve R' - - useSolver2 : ∀ az f hn as g → hn · (az · f + (as · g + 0r)) - ≡ 1r · (az · f · (hn · 1r) + as · g · (hn · 1r)) · 1r - useSolver2 = solve R' - - bigPath : 1r · 1r · ((h ^ n · 1r) · (h ^ n · 1r)) - ≡ 1r · (α zero · f · (h ^ n · 1r) + α (suc zero) · g · (h ^ n · 1r)) · 1r - bigPath = useSolver1 (h ^ n) ∙ cong (h ^ n ·_) p ∙ useSolver2 _ _ _ _ _ - - {- + curriedHelper : (𝔞 𝔟 : ZL) (𝔞∈BO : 𝔞 ∈ₚ BasicOpens) (𝔟∈BO : 𝔟 ∈ₚ BasicOpens) + (𝔞∨𝔟∈BO : 𝔞 ∨z 𝔟 ∈ₚ BasicOpens) + → isPullback (CommAlgebrasCategory R') _ _ _ + (BFsq (𝔞 , 𝔞∈BO) (𝔟 , 𝔟∈BO) 𝔞∨𝔟∈BO BasisStructurePShf) + curriedHelper 𝔞 𝔟 = elim3 (λ 𝔞∈BO 𝔟∈BO 𝔞∨𝔟∈BO → isPropIsPullback _ _ _ _ + (BFsq (𝔞 , 𝔞∈BO) (𝔟 , 𝔟∈BO) 𝔞∨𝔟∈BO BasisStructurePShf)) + Σhelper + where + -- write everything explicitly so things can type-check + thePShfCospan : (a : Σ[ f ∈ R ] D f ≡ 𝔞) (b : Σ[ g ∈ R ] D g ≡ 𝔟) + → Cospan (CommAlgebrasCategory R') + Cospan.l (thePShfCospan (f , Df≡𝔞) (g , Dg≡𝔟)) = BasisStructurePShf .Functor.F-ob (𝔟 , ∣ g , Dg≡𝔟 ∣₁) + Cospan.m (thePShfCospan (f , Df≡𝔞) (g , Dg≡𝔟)) = BasisStructurePShf .Functor.F-ob + (𝔞 ∧z 𝔟 , basicOpensAreBasis .∧lClosed 𝔞 𝔟 ∣ f , Df≡𝔞 ∣₁ ∣ g , Dg≡𝔟 ∣₁) + Cospan.r (thePShfCospan (f , Df≡𝔞) (g , Dg≡𝔟)) = BasisStructurePShf .Functor.F-ob (𝔞 , ∣ f , Df≡𝔞 ∣₁) + Cospan.s₁ (thePShfCospan (f , Df≡𝔞) (g , Dg≡𝔟)) = BasisStructurePShf .Functor.F-hom + {x = (𝔟 , ∣ g , Dg≡𝔟 ∣₁)} + {y = (𝔞 ∧z 𝔟 , basicOpensAreBasis .∧lClosed 𝔞 𝔟 ∣ f , Df≡𝔞 ∣₁ ∣ g , Dg≡𝔟 ∣₁)} + (hom-∧₂ ZariskiLattice (CommAlgebrasCategory R' {ℓ' = ℓ}) 𝔞 𝔟) + Cospan.s₂ (thePShfCospan (f , Df≡𝔞) (g , Dg≡𝔟)) = BasisStructurePShf .Functor.F-hom + {x = (𝔞 , ∣ f , Df≡𝔞 ∣₁)} + {y = (𝔞 ∧z 𝔟 , basicOpensAreBasis .∧lClosed 𝔞 𝔟 ∣ f , Df≡𝔞 ∣₁ ∣ g , Dg≡𝔟 ∣₁)} + (hom-∧₁ ZariskiLattice (CommAlgebrasCategory R' {ℓ' = ℓ}) 𝔞 𝔟) + + Σhelper : (a : Σ[ f ∈ R ] D f ≡ 𝔞) (b : Σ[ g ∈ R ] D g ≡ 𝔟) (c : Σ[ h ∈ R ] D h ≡ 𝔞 ∨z 𝔟) + → isPullback (CommAlgebrasCategory R') (thePShfCospan a b) _ _ + (BFsq (𝔞 , ∣ a ∣₁) (𝔟 , ∣ b ∣₁) ∣ c ∣₁ BasisStructurePShf) + Σhelper (f , Df≡𝔞) (g , Dg≡𝔟) (h , Dh≡𝔞∨𝔟) = toSheafPB.lemma + (𝔞 ∨z 𝔟 , ∣ h , Dh≡𝔞∨𝔟 ∣₁) + (𝔞 , ∣ f , Df≡𝔞 ∣₁) + (𝔟 , ∣ g , Dg≡𝔟 ∣₁) + (𝔞 ∧z 𝔟 , basicOpensAreBasis .∧lClosed 𝔞 𝔟 ∣ f , Df≡𝔞 ∣₁ ∣ g , Dg≡𝔟 ∣₁) + (Bsq (𝔞 , ∣ f , Df≡𝔞 ∣₁) (𝔟 , ∣ g , Dg≡𝔟 ∣₁) ∣ h , Dh≡𝔞∨𝔟 ∣₁) + theAlgebraCospan theAlgebraPullback refl gPath fPath fgPath + where + open Exponentiation R' + open RadicalIdeal R' + open InvertingElementsBase R' + open DoubleLoc R' h + open S⁻¹RUniversalProp R' [ h ⁿ|n≥0] (powersFormMultClosedSubset h) + open CommIdeal R[1/ h ]AsCommRing using () renaming (CommIdeal to CommIdealₕ ; _∈_ to _∈ₕ_) + + instance + _ = snd R[1/ h ]AsCommRing + + ⟨_⟩ₕ : R[1/ h ] × R[1/ h ] → CommIdealₕ + ⟨ x , y ⟩ₕ = ⟨ replicateFinVec 1 x ++Fin replicateFinVec 1 y ⟩[ R[1/ h ]AsCommRing ] + + -- the crucial algebraic fact: + DHelper : D h ≡ D f ∨z D g + DHelper = Dh≡𝔞∨𝔟 ∙ cong₂ (_∨z_) (sym Df≡𝔞) (sym Dg≡𝔟) + + f∈√⟨h⟩ : f ∈ √ ⟨ h ⟩ + f∈√⟨h⟩ = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun (sym DHelper) .fst zero + + g∈√⟨h⟩ : g ∈ √ ⟨ h ⟩ + g∈√⟨h⟩ = isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun (sym DHelper) .fst one + + fg∈√⟨h⟩ : (f · g) ∈ √ ⟨ h ⟩ + fg∈√⟨h⟩ = √ ⟨ h ⟩ .snd .·Closed f g∈√⟨h⟩ + + 1∈fgIdeal : 1r ∈ₕ ⟨ (f /1) , (g /1) ⟩ₕ + 1∈fgIdeal = helper1 (isEquivRel→effectiveIso ∼PropValued ∼EquivRel _ _ .fun DHelper .fst zero) + where + helper1 : h ∈ √ ⟨ f , g ⟩ₚ + → 1r ∈ₕ ⟨ (f /1) , (g /1) ⟩ₕ + helper1 = PT.rec isPropPropTrunc (uncurry helper2) + where + helper2 : (n : ℕ) + → h ^ n ∈ ⟨ f , g ⟩ₚ + → 1r ∈ₕ ⟨ (f /1) , (g /1) ⟩ₕ + helper2 n = map helper3 + where + helper3 : Σ[ α ∈ FinVec R 2 ] + h ^ n ≡ linearCombination R' α (λ { zero → f ; (suc zero) → g }) + → Σ[ β ∈ FinVec R[1/ h ] 2 ] + 1r ≡ linearCombination R[1/ h ]AsCommRing β + λ { zero → f /1 ; (suc zero) → g /1 } + helper3 (α , p) = β , path + where + β : FinVec R[1/ h ] 2 + β zero = [ α zero , h ^ n , ∣ n , refl ∣₁ ] + β (suc zero) = [ α (suc zero) , h ^ n , ∣ n , refl ∣₁ ] + + path : 1r ≡ linearCombination R[1/ h ]AsCommRing β + λ { zero → f /1 ; (suc zero) → g /1 } + path = eq/ _ _ ((1r , ∣ 0 , refl ∣₁) , bigPath) + ∙ cong (β zero · (f /1) +_) (sym (+IdR (β (suc zero) · (g /1)))) + where + useSolver1 : ∀ hn → 1r · 1r · ((hn · 1r) · (hn · 1r)) ≡ hn · hn + useSolver1 = solve R' + + useSolver2 : ∀ az f hn as g → hn · (az · f + (as · g + 0r)) + ≡ 1r · (az · f · (hn · 1r) + as · g · (hn · 1r)) · 1r + useSolver2 = solve R' + + bigPath : 1r · 1r · ((h ^ n · 1r) · (h ^ n · 1r)) + ≡ 1r · (α zero · f · (h ^ n · 1r) + α (suc zero) · g · (h ^ n · 1r)) · 1r + bigPath = useSolver1 (h ^ n) ∙ cong (h ^ n ·_) p ∙ useSolver2 _ _ _ _ _ + + {- We get the following pullback square in CommRings @@ -355,99 +355,99 @@ -} - theRingCospan = fgCospan R[1/ h ]AsCommRing (f /1) (g /1) - theRingPullback = fgPullback R[1/ h ]AsCommRing (f /1) (g /1) 1∈fgIdeal - - R[1/h][1/f] = InvertingElementsBase.R[1/_] R[1/ h ]AsCommRing (f /1) - R[1/h][1/f]AsCommRing = InvertingElementsBase.R[1/_]AsCommRing R[1/ h ]AsCommRing (f /1) - R[1/h][1/g] = InvertingElementsBase.R[1/_] R[1/ h ]AsCommRing (g /1) - R[1/h][1/g]AsCommRing = InvertingElementsBase.R[1/_]AsCommRing R[1/ h ]AsCommRing (g /1) - R[1/h][1/fg] = InvertingElementsBase.R[1/_] R[1/ h ]AsCommRing ((f /1) · (g /1)) - R[1/h][1/fg]AsCommRing = InvertingElementsBase.R[1/_]AsCommRing - R[1/ h ]AsCommRing ((f /1) · (g /1)) - - open IsRingHom - /1/1AsCommRingHomFG : CommRingHom R' R[1/h][1/fg]AsCommRing - fst /1/1AsCommRingHomFG r = [ [ r , 1r , ∣ 0 , refl ∣₁ ] , 1r , ∣ 0 , refl ∣₁ ] - pres0 (snd /1/1AsCommRingHomFG) = refl - pres1 (snd /1/1AsCommRingHomFG) = refl - pres+ (snd /1/1AsCommRingHomFG) x y = cong [_] (≡-× (cong [_] (≡-× - (cong₂ _+_ (useSolver x) (useSolver y)) - (Σ≡Prop (λ _ → isPropPropTrunc) (useSolver 1r)))) - (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r)))) - where - useSolver : ∀ a → a ≡ a · 1r · (1r · 1r) - useSolver = solve R' - pres· (snd /1/1AsCommRingHomFG) x y = cong [_] (≡-× (cong [_] (≡-× refl - (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r))))) - (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r)))) - pres- (snd /1/1AsCommRingHomFG) x = refl - - open Cospan - open Pullback - open RingHoms - isRHomR[1/h]→R[1/h][1/f] : theRingPullback .pbPr₂ ∘r /1AsCommRingHom ≡ /1/1AsCommRingHom f - isRHomR[1/h]→R[1/h][1/f] = RingHom≡ (funExt (λ x → refl)) - - isRHomR[1/h]→R[1/h][1/g] : theRingPullback .pbPr₁ ∘r /1AsCommRingHom ≡ /1/1AsCommRingHom g - isRHomR[1/h]→R[1/h][1/g] = RingHom≡ (funExt (λ x → refl)) - - isRHomR[1/h][1/f]→R[1/h][1/fg] : theRingCospan .s₂ ∘r /1/1AsCommRingHom f ≡ /1/1AsCommRingHomFG - isRHomR[1/h][1/f]→R[1/h][1/fg] = RingHom≡ (funExt - (λ x → cong [_] (≡-× (cong [_] (≡-× (cong (x ·_) (transportRefl 1r) ∙ ·IdR x) - (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r)))) - (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r))))) - - isRHomR[1/h][1/g]→R[1/h][1/fg] : theRingCospan .s₁ ∘r /1/1AsCommRingHom g ≡ /1/1AsCommRingHomFG - isRHomR[1/h][1/g]→R[1/h][1/fg] = RingHom≡ (funExt - (λ x → cong [_] (≡-× (cong [_] (≡-× (cong (x ·_) (transportRefl 1r) ∙ ·IdR x) - (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r)))) - (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r))))) - - - open PullbackFromCommRing R' theRingCospan theRingPullback - /1AsCommRingHom (/1/1AsCommRingHom f) (/1/1AsCommRingHom g) /1/1AsCommRingHomFG - theAlgebraCospan = algCospan isRHomR[1/h]→R[1/h][1/f] - isRHomR[1/h]→R[1/h][1/g] - isRHomR[1/h][1/f]→R[1/h][1/fg] - isRHomR[1/h][1/g]→R[1/h][1/fg] - theAlgebraPullback = algPullback isRHomR[1/h]→R[1/h][1/f] - isRHomR[1/h]→R[1/h][1/g] - isRHomR[1/h][1/f]→R[1/h][1/fg] - isRHomR[1/h][1/g]→R[1/h][1/fg] - - --and the three remaining paths - fPath : theAlgebraCospan .r ≡ R[1/ f ]AsCommAlgebra - fPath = doubleLocCancel f∈√⟨h⟩ - where - open DoubleAlgLoc R' h f - - gPath : theAlgebraCospan .l ≡ R[1/ g ]AsCommAlgebra - gPath = doubleLocCancel g∈√⟨h⟩ - where - open DoubleAlgLoc R' h g - - fgPath : theAlgebraCospan .m ≡ R[1/ (f · g) ]AsCommAlgebra - fgPath = path ∙ doubleLocCancel fg∈√⟨h⟩ - where - open DoubleAlgLoc R' h (f · g) - open CommAlgChar R' - - R[1/h][1/fg]AsCommRing' = InvertingElementsBase.R[1/_]AsCommRing R[1/ h ]AsCommRing ((f · g) /1) - - path : toCommAlg (R[1/h][1/fg]AsCommRing , /1/1AsCommRingHomFG) - ≡ toCommAlg (R[1/h][1/fg]AsCommRing' , /1/1AsCommRingHom (f · g)) - path = cong toCommAlg (ΣPathP (p , q)) - where - eqInR[1/h] : (f /1) · (g /1) ≡ (f · g) /1 - eqInR[1/h] = sym (/1AsCommRingHom .snd .pres· f g) - - p : R[1/h][1/fg]AsCommRing ≡ R[1/h][1/fg]AsCommRing' - p i = InvertingElementsBase.R[1/_]AsCommRing R[1/ h ]AsCommRing (eqInR[1/h] i) - - q : PathP (λ i → CommRingHom R' (p i)) /1/1AsCommRingHomFG (/1/1AsCommRingHom (f · g)) - q = toPathP (RingHom≡ (funExt ( - λ x → cong [_] (≡-× (cong [_] (≡-× (transportRefl _ ∙ transportRefl x) - (Σ≡Prop (λ _ → isPropPropTrunc) (transportRefl 1r)))) - (Σ≡Prop (λ _ → isPropPropTrunc) (transportRefl 1r)))))) + theRingCospan = fgCospan R[1/ h ]AsCommRing (f /1) (g /1) + theRingPullback = fgPullback R[1/ h ]AsCommRing (f /1) (g /1) 1∈fgIdeal + + R[1/h][1/f] = InvertingElementsBase.R[1/_] R[1/ h ]AsCommRing (f /1) + R[1/h][1/f]AsCommRing = InvertingElementsBase.R[1/_]AsCommRing R[1/ h ]AsCommRing (f /1) + R[1/h][1/g] = InvertingElementsBase.R[1/_] R[1/ h ]AsCommRing (g /1) + R[1/h][1/g]AsCommRing = InvertingElementsBase.R[1/_]AsCommRing R[1/ h ]AsCommRing (g /1) + R[1/h][1/fg] = InvertingElementsBase.R[1/_] R[1/ h ]AsCommRing ((f /1) · (g /1)) + R[1/h][1/fg]AsCommRing = InvertingElementsBase.R[1/_]AsCommRing + R[1/ h ]AsCommRing ((f /1) · (g /1)) + + open IsRingHom + /1/1AsCommRingHomFG : CommRingHom R' R[1/h][1/fg]AsCommRing + fst /1/1AsCommRingHomFG r = [ [ r , 1r , ∣ 0 , refl ∣₁ ] , 1r , ∣ 0 , refl ∣₁ ] + pres0 (snd /1/1AsCommRingHomFG) = refl + pres1 (snd /1/1AsCommRingHomFG) = refl + pres+ (snd /1/1AsCommRingHomFG) x y = cong [_] (≡-× (cong [_] (≡-× + (cong₂ _+_ (useSolver x) (useSolver y)) + (Σ≡Prop (λ _ → isPropPropTrunc) (useSolver 1r)))) + (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r)))) + where + useSolver : ∀ a → a ≡ a · 1r · (1r · 1r) + useSolver = solve R' + pres· (snd /1/1AsCommRingHomFG) x y = cong [_] (≡-× (cong [_] (≡-× refl + (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r))))) + (Σ≡Prop (λ _ → isPropPropTrunc) (sym (·IdR 1r)))) + pres- (snd /1/1AsCommRingHomFG) x = refl + + open Cospan + open Pullback + open RingHoms + isRHomR[1/h]→R[1/h][1/f] : theRingPullback .pbPr₂ ∘r /1AsCommRingHom ≡ /1/1AsCommRingHom f + isRHomR[1/h]→R[1/h][1/f] = RingHom≡ (funExt (λ x → refl)) + + isRHomR[1/h]→R[1/h][1/g] : theRingPullback .pbPr₁ ∘r /1AsCommRingHom ≡ /1/1AsCommRingHom g + isRHomR[1/h]→R[1/h][1/g] = RingHom≡ (funExt (λ x → refl)) + + isRHomR[1/h][1/f]→R[1/h][1/fg] : theRingCospan .s₂ ∘r /1/1AsCommRingHom f ≡ /1/1AsCommRingHomFG + isRHomR[1/h][1/f]→R[1/h][1/fg] = RingHom≡ (funExt + (λ x → cong [_] (≡-× (cong [_] (≡-× (cong (x ·_) (transportRefl 1r) ∙ ·IdR x) + (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r)))) + (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r))))) + + isRHomR[1/h][1/g]→R[1/h][1/fg] : theRingCospan .s₁ ∘r /1/1AsCommRingHom g ≡ /1/1AsCommRingHomFG + isRHomR[1/h][1/g]→R[1/h][1/fg] = RingHom≡ (funExt + (λ x → cong [_] (≡-× (cong [_] (≡-× (cong (x ·_) (transportRefl 1r) ∙ ·IdR x) + (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r)))) + (Σ≡Prop (λ _ → isPropPropTrunc) (cong (1r ·_) (transportRefl 1r) ∙ ·IdR 1r))))) + + + open PullbackFromCommRing R' theRingCospan theRingPullback + /1AsCommRingHom (/1/1AsCommRingHom f) (/1/1AsCommRingHom g) /1/1AsCommRingHomFG + theAlgebraCospan = algCospan isRHomR[1/h]→R[1/h][1/f] + isRHomR[1/h]→R[1/h][1/g] + isRHomR[1/h][1/f]→R[1/h][1/fg] + isRHomR[1/h][1/g]→R[1/h][1/fg] + theAlgebraPullback = algPullback isRHomR[1/h]→R[1/h][1/f] + isRHomR[1/h]→R[1/h][1/g] + isRHomR[1/h][1/f]→R[1/h][1/fg] + isRHomR[1/h][1/g]→R[1/h][1/fg] + + --and the three remaining paths + fPath : theAlgebraCospan .r ≡ R[1/ f ]AsCommAlgebra + fPath = doubleLocCancel f∈√⟨h⟩ + where + open DoubleAlgLoc R' h f + + gPath : theAlgebraCospan .l ≡ R[1/ g ]AsCommAlgebra + gPath = doubleLocCancel g∈√⟨h⟩ + where + open DoubleAlgLoc R' h g + + fgPath : theAlgebraCospan .m ≡ R[1/ (f · g) ]AsCommAlgebra + fgPath = path ∙ doubleLocCancel fg∈√⟨h⟩ + where + open DoubleAlgLoc R' h (f · g) + open CommAlgChar R' + + R[1/h][1/fg]AsCommRing' = InvertingElementsBase.R[1/_]AsCommRing R[1/ h ]AsCommRing ((f · g) /1) + + path : toCommAlg (R[1/h][1/fg]AsCommRing , /1/1AsCommRingHomFG) + ≡ toCommAlg (R[1/h][1/fg]AsCommRing' , /1/1AsCommRingHom (f · g)) + path = cong toCommAlg (ΣPathP (p , q)) + where + eqInR[1/h] : (f /1) · (g /1) ≡ (f · g) /1 + eqInR[1/h] = sym (/1AsCommRingHom .snd .pres· f g) + + p : R[1/h][1/fg]AsCommRing ≡ R[1/h][1/fg]AsCommRing' + p i = InvertingElementsBase.R[1/_]AsCommRing R[1/ h ]AsCommRing (eqInR[1/h] i) + + q : PathP (λ i → CommRingHom R' (p i)) /1/1AsCommRingHomFG (/1/1AsCommRingHom (f · g)) + q = toPathP (RingHom≡ (funExt ( + λ x → cong [_] (≡-× (cong [_] (≡-× (transportRefl _ ∙ transportRefl x) + (Σ≡Prop (λ _ → isPropPropTrunc) (transportRefl 1r)))) + (Σ≡Prop (λ _ → isPropPropTrunc) (transportRefl 1r)))))) \ No newline at end of file diff --git a/Cubical.Algebra.ZariskiLattice.UniversalProperty.html b/Cubical.Algebra.ZariskiLattice.UniversalProperty.html index 9f361a9e47..66c43b2a6d 100644 --- a/Cubical.Algebra.ZariskiLattice.UniversalProperty.html +++ b/Cubical.Algebra.ZariskiLattice.UniversalProperty.html @@ -24,296 +24,296 @@ open import Cubical.Data.Unit open import Cubical.Relation.Nullary open import Cubical.Relation.Binary -open import Cubical.Relation.Binary.Poset - -open import Cubical.Algebra.Ring -open import Cubical.Algebra.Ring.Properties -open import Cubical.Algebra.Ring.BigOps -open import Cubical.Algebra.CommRing -open import Cubical.Algebra.CommRing.BinomialThm -open import Cubical.Algebra.CommRing.Ideal -open import Cubical.Algebra.CommRing.FGIdeal -open import Cubical.Algebra.CommRing.RadicalIdeal -open import Cubical.Tactics.CommRingSolver.Reflection -open import Cubical.Algebra.Semilattice -open import Cubical.Algebra.Lattice -open import Cubical.Algebra.DistLattice -open import Cubical.Algebra.DistLattice.Basis -open import Cubical.Algebra.DistLattice.BigOps -open import Cubical.Algebra.Matrix - -open import Cubical.Algebra.ZariskiLattice.Base - -open import Cubical.HITs.SetQuotients as SQ -open import Cubical.HITs.PropositionalTruncation as PT - -private - variable - ℓ ℓ' : Level - - -module _ (R' : CommRing ℓ) (L' : DistLattice ℓ') where - - open CommRingStr (R' .snd) - open RingTheory (CommRing→Ring R') - open Sum (CommRing→Ring R') - open CommRingTheory R' - open Exponentiation R' - - open DistLatticeStr (L' .snd) renaming (is-set to isSetL) - open Join L' - open LatticeTheory (DistLattice→Lattice L') - open Order (DistLattice→Lattice L') - open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L')) - open PosetReasoning IndPoset - open PosetStr (IndPoset .snd) hiding (_≤_) - private - R = fst R' - L = fst L' - - record IsZarMap (d : R → L) : Type (ℓ-max ℓ ℓ') where - constructor iszarmap - - field - pres0 : d 0r ≡ 0l - pres1 : d 1r ≡ 1l - ·≡∧ : ∀ x y → d (x · y) ≡ d x ∧l d y - +≤∨ : ∀ x y → d (x + y) ≤ d x ∨l d y - - ∑≤⋁ : {n : ℕ} (U : FinVec R n) → d (∑ U) ≤ ⋁ λ i → d (U i) - ∑≤⋁ {n = zero} U = ∨lRid _ ∙ pres0 - ∑≤⋁ {n = suc n} U = d (∑ U) ≤⟨ ∨lIdem _ ⟩ - d (U zero + ∑ (U ∘ suc)) ≤⟨ +≤∨ _ _ ⟩ - d (U zero) ∨l d (∑ (U ∘ suc)) ≤⟨ ≤-∨LPres _ _ _ (∑≤⋁ (U ∘ suc)) ⟩ - d (U zero) ∨l ⋁ (d ∘ U ∘ suc) ≤⟨ ∨lIdem _ ⟩ - ⋁ (d ∘ U) ◾ - - d·LCancel : ∀ x y → d (x · y) ≤ d y - d·LCancel x y = subst (λ a → a ≤ d y) (sym (·≡∧ x y)) (∧≤LCancelJoin _ _) - - linearCombination≤LCancel : {n : ℕ} (α β : FinVec R n) - → d (linearCombination R' α β) ≤ ⋁ (d ∘ β) - linearCombination≤LCancel α β = is-trans _ _ _ (∑≤⋁ (λ i → α i · β i)) - (≤-⋁Ext _ _ λ i → d·LCancel (α i) (β i)) - - ZarMapIdem : ∀ (n : ℕ) (x : R) → d (x ^ (suc n)) ≡ d x - ZarMapIdem zero x = ·≡∧ _ _ ∙∙ cong (d x ∧l_) pres1 ∙∙ ∧lRid _ - ZarMapIdem (suc n) x = ·≡∧ _ _ ∙∙ cong (d x ∧l_) (ZarMapIdem n x) ∙∙ ∧lIdem _ - - ZarMapExpIneq : ∀ (n : ℕ) (x : R) → d x ≤ d (x ^ n) - ZarMapExpIneq zero x = cong (d x ∨l_) pres1 ∙∙ 1lRightAnnihilates∨l _ ∙∙ sym pres1 - ZarMapExpIneq (suc n) x = subst (λ y → d x ≤ y) (sym (ZarMapIdem _ x)) (∨lIdem _) - - -- the crucial lemma about "Zariski maps" - open CommIdeal R' - open RadicalIdeal R' - open isCommIdeal - private - ⟨_⟩ : {n : ℕ} → FinVec R n → CommIdeal - ⟨ V ⟩ = ⟨ V ⟩[ R' ] - - ZarMapRadicalIneq : ∀ {n : ℕ} (α : FinVec R n) (x : R) - → x ∈ √ ⟨ α ⟩ → d x ≤ ⋁ (d ∘ α) - ZarMapRadicalIneq α x = PT.elim (λ _ → isSetL _ _) - (uncurry (λ n → (PT.elim (λ _ → isSetL _ _) (uncurry (curriedHelper n))))) - where - curriedHelper : (n : ℕ) (β : FinVec R _) - → x ^ n ≡ linearCombination R' β α → d x ≤ ⋁ (d ∘ α) - curriedHelper n β xⁿ≡∑βα = d x ≤⟨ ZarMapExpIneq n x ⟩ - d (x ^ n) - ≤⟨ subst (λ y → y ≤ ⋁ (d ∘ α)) (sym (cong d xⁿ≡∑βα)) (linearCombination≤LCancel β α) ⟩ - ⋁ (d ∘ α) ◾ - -module ZarLatUniversalProp (R' : CommRing ℓ) where - open CommRingStr (snd R') - open RingTheory (CommRing→Ring R') - open Sum (CommRing→Ring R') - open CommRingTheory R' - open Exponentiation R' - open BinomialThm R' - open CommIdeal R' - open RadicalIdeal R' - open isCommIdeal - open ProdFin R' - - open ZarLat R' - open IsZarMap - - private - R = fst R' - ⟨_⟩ : {n : ℕ} → FinVec R n → CommIdeal - ⟨ V ⟩ = ⟨ V ⟩[ R' ] - - - D : R → ZL - D x = [ 1 , replicateFinVec 1 x ] -- λ x → √⟨x⟩ - - isZarMapD : IsZarMap R' ZariskiLattice D - pres0 isZarMapD = eq/ _ _ (≡→∼ (cong √ (0FGIdeal _ ∙ sym (emptyFGIdeal _ _)))) - pres1 isZarMapD = refl - ·≡∧ isZarMapD x y = cong {B = λ _ → ZL} (λ U → [ 1 , U ]) (Length1··Fin x y) - +≤∨ isZarMapD x y = eq/ _ _ (≡→∼ (cong √ (CommIdeal≡Char - (inclOfFGIdeal _ 3Vec ⟨ 2Vec ⟩ 3Vec⊆2Vec) - (inclOfFGIdeal _ 2Vec ⟨ 3Vec ⟩ 2Vec⊆3Vec)))) - where - 2Vec = replicateFinVec 1 x ++Fin replicateFinVec 1 y - 3Vec = replicateFinVec 1 (x + y) ++Fin (replicateFinVec 1 x ++Fin replicateFinVec 1 y) - - 3Vec⊆2Vec : ∀ (i : Fin 3) → 3Vec i ∈ ⟨ 2Vec ⟩ - 3Vec⊆2Vec zero = ⟨ 2Vec ⟩ .snd .+Closed (indInIdeal _ _ zero) (indInIdeal _ _ (suc zero)) - 3Vec⊆2Vec (suc zero) = indInIdeal _ _ zero - 3Vec⊆2Vec (suc (suc zero)) = indInIdeal _ _ (suc zero) - - 2Vec⊆3Vec : ∀ (i : Fin 2) → 2Vec i ∈ ⟨ 3Vec ⟩ - 2Vec⊆3Vec zero = indInIdeal _ _ (suc zero) - 2Vec⊆3Vec (suc zero) = indInIdeal _ _ (suc (suc zero)) - - - -- defintion of the universal property - hasZarLatUniversalProp : (L : DistLattice ℓ') (D : R → fst L) - → IsZarMap R' L D - → Type _ - hasZarLatUniversalProp {ℓ' = ℓ'} L D _ = ∀ (L' : DistLattice ℓ') (d : R → fst L') - → IsZarMap R' L' d - → ∃![ χ ∈ DistLatticeHom L L' ] (fst χ) ∘ D ≡ d - - isPropZarLatUniversalProp : (L : DistLattice ℓ') (D : R → fst L) (isZarMapD : IsZarMap R' L D) - → isProp (hasZarLatUniversalProp L D isZarMapD) - isPropZarLatUniversalProp L D isZarMapD = isPropΠ3 (λ _ _ _ → isPropIsContr) - - ZLHasUniversalProp : hasZarLatUniversalProp ZariskiLattice D isZarMapD - ZLHasUniversalProp L' d isZarMapd = (χ , funExt χcomp) , χunique - where - open DistLatticeStr (snd L') renaming (is-set to isSetL) - open LatticeTheory (DistLattice→Lattice L') - open Join L' - open IsLatticeHom - L = fst L' - - χ : DistLatticeHom ZariskiLattice L' - fst χ = SQ.rec isSetL (λ (_ , α) → ⋁ (d ∘ α)) - λ (_ , α) (_ , β) → curriedHelper α β - where - curriedHelper : {n m : ℕ} (α : FinVec R n) (β : FinVec R m) - → (n , α) ∼ (m , β) → ⋁ (d ∘ α) ≡ ⋁ (d ∘ β) - curriedHelper α β α∼β = is-antisym _ _ ineq1 ineq2 - where - open Order (DistLattice→Lattice L') - open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L')) - open PosetReasoning IndPoset - open PosetStr (IndPoset .snd) hiding (_≤_) - - incl1 : √ ⟨ α ⟩ ⊆ √ ⟨ β ⟩ - incl1 = ⊆-refl-consequence _ _ (cong fst (∼→≡ α∼β)) .fst - - ineq1 : ⋁ (d ∘ α) ≤ ⋁ (d ∘ β) - ineq1 = ⋁IsMax (d ∘ α) (⋁ (d ∘ β)) - λ i → ZarMapRadicalIneq isZarMapd β (α i) (√FGIdealCharLImpl α ⟨ β ⟩ incl1 i) - - incl2 : √ ⟨ β ⟩ ⊆ √ ⟨ α ⟩ - incl2 = ⊆-refl-consequence _ _ (cong fst (∼→≡ α∼β)) .snd - - ineq2 : ⋁ (d ∘ β) ≤ ⋁ (d ∘ α) - ineq2 = ⋁IsMax (d ∘ β) (⋁ (d ∘ α)) - λ i → ZarMapRadicalIneq isZarMapd α (β i) (√FGIdealCharLImpl β ⟨ α ⟩ incl2 i) - - - pres0 (snd χ) = refl - pres1 (snd χ) = ∨lRid _ ∙ isZarMapd .pres1 - pres∨l (snd χ) = elimProp2 (λ _ _ → isSetL _ _) (uncurry (λ n α → uncurry (curriedHelper n α))) - where - curriedHelper : (n : ℕ) (α : FinVec R n) (m : ℕ) (β : FinVec R m) - → ⋁ (d ∘ (α ++Fin β)) ≡ ⋁ (d ∘ α) ∨l ⋁ (d ∘ β) - curriedHelper zero α _ β = sym (∨lLid _) - curriedHelper (suc n) α _ β = - ⋁ (d ∘ (α ++Fin β)) ≡⟨ refl ⟩ - d (α zero) ∨l ⋁ (d ∘ ((α ∘ suc) ++Fin β)) +open import Cubical.Relation.Binary.Order.Poset + +open import Cubical.Algebra.Ring +open import Cubical.Algebra.Ring.Properties +open import Cubical.Algebra.Ring.BigOps +open import Cubical.Algebra.CommRing +open import Cubical.Algebra.CommRing.BinomialThm +open import Cubical.Algebra.CommRing.Ideal +open import Cubical.Algebra.CommRing.FGIdeal +open import Cubical.Algebra.CommRing.RadicalIdeal +open import Cubical.Tactics.CommRingSolver.Reflection +open import Cubical.Algebra.Semilattice +open import Cubical.Algebra.Lattice +open import Cubical.Algebra.DistLattice +open import Cubical.Algebra.DistLattice.Basis +open import Cubical.Algebra.DistLattice.BigOps +open import Cubical.Algebra.Matrix + +open import Cubical.Algebra.ZariskiLattice.Base + +open import Cubical.HITs.SetQuotients as SQ +open import Cubical.HITs.PropositionalTruncation as PT + +private + variable + ℓ ℓ' : Level + + +module _ (R' : CommRing ℓ) (L' : DistLattice ℓ') where + + open CommRingStr (R' .snd) + open RingTheory (CommRing→Ring R') + open Sum (CommRing→Ring R') + open CommRingTheory R' + open Exponentiation R' + + open DistLatticeStr (L' .snd) renaming (is-set to isSetL) + open Join L' + open LatticeTheory (DistLattice→Lattice L') + open Order (DistLattice→Lattice L') + open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L')) + open PosetReasoning IndPoset + open PosetStr (IndPoset .snd) hiding (_≤_) + private + R = fst R' + L = fst L' + + record IsZarMap (d : R → L) : Type (ℓ-max ℓ ℓ') where + constructor iszarmap + + field + pres0 : d 0r ≡ 0l + pres1 : d 1r ≡ 1l + ·≡∧ : ∀ x y → d (x · y) ≡ d x ∧l d y + +≤∨ : ∀ x y → d (x + y) ≤ d x ∨l d y + + ∑≤⋁ : {n : ℕ} (U : FinVec R n) → d (∑ U) ≤ ⋁ λ i → d (U i) + ∑≤⋁ {n = zero} U = ∨lRid _ ∙ pres0 + ∑≤⋁ {n = suc n} U = d (∑ U) ≤⟨ ∨lIdem _ ⟩ + d (U zero + ∑ (U ∘ suc)) ≤⟨ +≤∨ _ _ ⟩ + d (U zero) ∨l d (∑ (U ∘ suc)) ≤⟨ ≤-∨LPres _ _ _ (∑≤⋁ (U ∘ suc)) ⟩ + d (U zero) ∨l ⋁ (d ∘ U ∘ suc) ≤⟨ ∨lIdem _ ⟩ + ⋁ (d ∘ U) ◾ + + d·LCancel : ∀ x y → d (x · y) ≤ d y + d·LCancel x y = subst (λ a → a ≤ d y) (sym (·≡∧ x y)) (∧≤LCancelJoin _ _) + + linearCombination≤LCancel : {n : ℕ} (α β : FinVec R n) + → d (linearCombination R' α β) ≤ ⋁ (d ∘ β) + linearCombination≤LCancel α β = is-trans _ _ _ (∑≤⋁ (λ i → α i · β i)) + (≤-⋁Ext _ _ λ i → d·LCancel (α i) (β i)) + + ZarMapIdem : ∀ (n : ℕ) (x : R) → d (x ^ (suc n)) ≡ d x + ZarMapIdem zero x = ·≡∧ _ _ ∙∙ cong (d x ∧l_) pres1 ∙∙ ∧lRid _ + ZarMapIdem (suc n) x = ·≡∧ _ _ ∙∙ cong (d x ∧l_) (ZarMapIdem n x) ∙∙ ∧lIdem _ + + ZarMapExpIneq : ∀ (n : ℕ) (x : R) → d x ≤ d (x ^ n) + ZarMapExpIneq zero x = cong (d x ∨l_) pres1 ∙∙ 1lRightAnnihilates∨l _ ∙∙ sym pres1 + ZarMapExpIneq (suc n) x = subst (λ y → d x ≤ y) (sym (ZarMapIdem _ x)) (∨lIdem _) + + -- the crucial lemma about "Zariski maps" + open CommIdeal R' + open RadicalIdeal R' + open isCommIdeal + private + ⟨_⟩ : {n : ℕ} → FinVec R n → CommIdeal + ⟨ V ⟩ = ⟨ V ⟩[ R' ] + + ZarMapRadicalIneq : ∀ {n : ℕ} (α : FinVec R n) (x : R) + → x ∈ √ ⟨ α ⟩ → d x ≤ ⋁ (d ∘ α) + ZarMapRadicalIneq α x = PT.elim (λ _ → isSetL _ _) + (uncurry (λ n → (PT.elim (λ _ → isSetL _ _) (uncurry (curriedHelper n))))) + where + curriedHelper : (n : ℕ) (β : FinVec R _) + → x ^ n ≡ linearCombination R' β α → d x ≤ ⋁ (d ∘ α) + curriedHelper n β xⁿ≡∑βα = d x ≤⟨ ZarMapExpIneq n x ⟩ + d (x ^ n) + ≤⟨ subst (λ y → y ≤ ⋁ (d ∘ α)) (sym (cong d xⁿ≡∑βα)) (linearCombination≤LCancel β α) ⟩ + ⋁ (d ∘ α) ◾ + +module ZarLatUniversalProp (R' : CommRing ℓ) where + open CommRingStr (snd R') + open RingTheory (CommRing→Ring R') + open Sum (CommRing→Ring R') + open CommRingTheory R' + open Exponentiation R' + open BinomialThm R' + open CommIdeal R' + open RadicalIdeal R' + open isCommIdeal + open ProdFin R' + + open ZarLat R' + open IsZarMap + + private + R = fst R' + ⟨_⟩ : {n : ℕ} → FinVec R n → CommIdeal + ⟨ V ⟩ = ⟨ V ⟩[ R' ] + + + D : R → ZL + D x = [ 1 , replicateFinVec 1 x ] -- λ x → √⟨x⟩ + + isZarMapD : IsZarMap R' ZariskiLattice D + pres0 isZarMapD = eq/ _ _ (≡→∼ (cong √ (0FGIdeal _ ∙ sym (emptyFGIdeal _ _)))) + pres1 isZarMapD = refl + ·≡∧ isZarMapD x y = cong {B = λ _ → ZL} (λ U → [ 1 , U ]) (Length1··Fin x y) + +≤∨ isZarMapD x y = eq/ _ _ (≡→∼ (cong √ (CommIdeal≡Char + (inclOfFGIdeal _ 3Vec ⟨ 2Vec ⟩ 3Vec⊆2Vec) + (inclOfFGIdeal _ 2Vec ⟨ 3Vec ⟩ 2Vec⊆3Vec)))) + where + 2Vec = replicateFinVec 1 x ++Fin replicateFinVec 1 y + 3Vec = replicateFinVec 1 (x + y) ++Fin (replicateFinVec 1 x ++Fin replicateFinVec 1 y) + + 3Vec⊆2Vec : ∀ (i : Fin 3) → 3Vec i ∈ ⟨ 2Vec ⟩ + 3Vec⊆2Vec zero = ⟨ 2Vec ⟩ .snd .+Closed (indInIdeal _ _ zero) (indInIdeal _ _ (suc zero)) + 3Vec⊆2Vec (suc zero) = indInIdeal _ _ zero + 3Vec⊆2Vec (suc (suc zero)) = indInIdeal _ _ (suc zero) + + 2Vec⊆3Vec : ∀ (i : Fin 2) → 2Vec i ∈ ⟨ 3Vec ⟩ + 2Vec⊆3Vec zero = indInIdeal _ _ (suc zero) + 2Vec⊆3Vec (suc zero) = indInIdeal _ _ (suc (suc zero)) + + + -- defintion of the universal property + hasZarLatUniversalProp : (L : DistLattice ℓ') (D : R → fst L) + → IsZarMap R' L D + → Type _ + hasZarLatUniversalProp {ℓ' = ℓ'} L D _ = ∀ (L' : DistLattice ℓ') (d : R → fst L') + → IsZarMap R' L' d + → ∃![ χ ∈ DistLatticeHom L L' ] (fst χ) ∘ D ≡ d + + isPropZarLatUniversalProp : (L : DistLattice ℓ') (D : R → fst L) (isZarMapD : IsZarMap R' L D) + → isProp (hasZarLatUniversalProp L D isZarMapD) + isPropZarLatUniversalProp L D isZarMapD = isPropΠ3 (λ _ _ _ → isPropIsContr) + + ZLHasUniversalProp : hasZarLatUniversalProp ZariskiLattice D isZarMapD + ZLHasUniversalProp L' d isZarMapd = (χ , funExt χcomp) , χunique + where + open DistLatticeStr (snd L') renaming (is-set to isSetL) + open LatticeTheory (DistLattice→Lattice L') + open Join L' + open IsLatticeHom + L = fst L' + + χ : DistLatticeHom ZariskiLattice L' + fst χ = SQ.rec isSetL (λ (_ , α) → ⋁ (d ∘ α)) + λ (_ , α) (_ , β) → curriedHelper α β + where + curriedHelper : {n m : ℕ} (α : FinVec R n) (β : FinVec R m) + → (n , α) ∼ (m , β) → ⋁ (d ∘ α) ≡ ⋁ (d ∘ β) + curriedHelper α β α∼β = is-antisym _ _ ineq1 ineq2 + where + open Order (DistLattice→Lattice L') + open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L')) + open PosetReasoning IndPoset + open PosetStr (IndPoset .snd) hiding (_≤_) + + incl1 : √ ⟨ α ⟩ ⊆ √ ⟨ β ⟩ + incl1 = ⊆-refl-consequence _ _ (cong fst (∼→≡ α∼β)) .fst + + ineq1 : ⋁ (d ∘ α) ≤ ⋁ (d ∘ β) + ineq1 = ⋁IsMax (d ∘ α) (⋁ (d ∘ β)) + λ i → ZarMapRadicalIneq isZarMapd β (α i) (√FGIdealCharLImpl α ⟨ β ⟩ incl1 i) + + incl2 : √ ⟨ β ⟩ ⊆ √ ⟨ α ⟩ + incl2 = ⊆-refl-consequence _ _ (cong fst (∼→≡ α∼β)) .snd + + ineq2 : ⋁ (d ∘ β) ≤ ⋁ (d ∘ α) + ineq2 = ⋁IsMax (d ∘ β) (⋁ (d ∘ α)) + λ i → ZarMapRadicalIneq isZarMapd α (β i) (√FGIdealCharLImpl β ⟨ α ⟩ incl2 i) + + + pres0 (snd χ) = refl + pres1 (snd χ) = ∨lRid _ ∙ isZarMapd .pres1 + pres∨l (snd χ) = elimProp2 (λ _ _ → isSetL _ _) (uncurry (λ n α → uncurry (curriedHelper n α))) + where + curriedHelper : (n : ℕ) (α : FinVec R n) (m : ℕ) (β : FinVec R m) + → ⋁ (d ∘ (α ++Fin β)) ≡ ⋁ (d ∘ α) ∨l ⋁ (d ∘ β) + curriedHelper zero α _ β = sym (∨lLid _) + curriedHelper (suc n) α _ β = + ⋁ (d ∘ (α ++Fin β)) ≡⟨ refl ⟩ + d (α zero) ∨l ⋁ (d ∘ ((α ∘ suc) ++Fin β)) - ≡⟨ cong (d (α zero) ∨l_) (curriedHelper _ (α ∘ suc) _ β) ⟩ + ≡⟨ cong (d (α zero) ∨l_) (curriedHelper _ (α ∘ suc) _ β) ⟩ - d (α zero) ∨l (⋁ (d ∘ α ∘ suc) ∨l ⋁ (d ∘ β)) - ≡⟨ ∨lAssoc _ _ _ ⟩ + d (α zero) ∨l (⋁ (d ∘ α ∘ suc) ∨l ⋁ (d ∘ β)) + ≡⟨ ∨lAssoc _ _ _ ⟩ - ⋁ (d ∘ α) ∨l ⋁ (d ∘ β) ∎ + ⋁ (d ∘ α) ∨l ⋁ (d ∘ β) ∎ - pres∧l (snd χ) = elimProp2 (λ _ _ → isSetL _ _) (uncurry (λ n α → uncurry (curriedHelper n α))) - where - -- have to repeat this one here so the termination checker won't complain - oldHelper : (n : ℕ) (α : FinVec R n) (m : ℕ) (β : FinVec R m) - → ⋁ (d ∘ (α ++Fin β)) ≡ ⋁ (d ∘ α) ∨l ⋁ (d ∘ β) - oldHelper zero α _ β = sym (∨lLid _) - oldHelper (suc n) α _ β = cong (d (α zero) ∨l_) (oldHelper _ (α ∘ suc) _ β) ∙ ∨lAssoc _ _ _ + pres∧l (snd χ) = elimProp2 (λ _ _ → isSetL _ _) (uncurry (λ n α → uncurry (curriedHelper n α))) + where + -- have to repeat this one here so the termination checker won't complain + oldHelper : (n : ℕ) (α : FinVec R n) (m : ℕ) (β : FinVec R m) + → ⋁ (d ∘ (α ++Fin β)) ≡ ⋁ (d ∘ α) ∨l ⋁ (d ∘ β) + oldHelper zero α _ β = sym (∨lLid _) + oldHelper (suc n) α _ β = cong (d (α zero) ∨l_) (oldHelper _ (α ∘ suc) _ β) ∙ ∨lAssoc _ _ _ - curriedHelper : (n : ℕ) (α : FinVec R n) (m : ℕ) (β : FinVec R m) - → ⋁ (d ∘ (α ··Fin β)) ≡ ⋁ (d ∘ α) ∧l ⋁ (d ∘ β) - curriedHelper zero α _ β = sym (0lLeftAnnihilates∧l _) - curriedHelper (suc n) α _ β = - ⋁ (d ∘ (α ··Fin β)) ≡⟨ refl ⟩ - ⋁ (d ∘ ((λ j → α zero · β j) ++Fin ((α ∘ suc) ··Fin β))) + curriedHelper : (n : ℕ) (α : FinVec R n) (m : ℕ) (β : FinVec R m) + → ⋁ (d ∘ (α ··Fin β)) ≡ ⋁ (d ∘ α) ∧l ⋁ (d ∘ β) + curriedHelper zero α _ β = sym (0lLeftAnnihilates∧l _) + curriedHelper (suc n) α _ β = + ⋁ (d ∘ (α ··Fin β)) ≡⟨ refl ⟩ + ⋁ (d ∘ ((λ j → α zero · β j) ++Fin ((α ∘ suc) ··Fin β))) - ≡⟨ oldHelper _ (λ j → α zero · β j) _ ((α ∘ suc) ··Fin β) ⟩ + ≡⟨ oldHelper _ (λ j → α zero · β j) _ ((α ∘ suc) ··Fin β) ⟩ - ⋁ (d ∘ (λ j → α zero · β j)) ∨l ⋁ (d ∘ ((α ∘ suc) ··Fin β)) + ⋁ (d ∘ (λ j → α zero · β j)) ∨l ⋁ (d ∘ ((α ∘ suc) ··Fin β)) - ≡⟨ cong (_∨l ⋁ (d ∘ ((α ∘ suc) ··Fin β))) (⋁Ext (λ j → isZarMapd .·≡∧ (α zero) (β j))) ⟩ + ≡⟨ cong (_∨l ⋁ (d ∘ ((α ∘ suc) ··Fin β))) (⋁Ext (λ j → isZarMapd .·≡∧ (α zero) (β j))) ⟩ - ⋁ (λ j → d (α zero) ∧l d (β j)) ∨l ⋁ (d ∘ ((α ∘ suc) ··Fin β)) + ⋁ (λ j → d (α zero) ∧l d (β j)) ∨l ⋁ (d ∘ ((α ∘ suc) ··Fin β)) - ≡⟨ cong (_∨l ⋁ (d ∘ ((α ∘ suc) ··Fin β))) (sym (⋁Meetrdist _ _)) ⟩ + ≡⟨ cong (_∨l ⋁ (d ∘ ((α ∘ suc) ··Fin β))) (sym (⋁Meetrdist _ _)) ⟩ - (d (α zero) ∧l ⋁ (d ∘ β)) ∨l ⋁ (d ∘ ((α ∘ suc) ··Fin β)) + (d (α zero) ∧l ⋁ (d ∘ β)) ∨l ⋁ (d ∘ ((α ∘ suc) ··Fin β)) - ≡⟨ cong ((d (α zero) ∧l ⋁ (d ∘ β)) ∨l_) (curriedHelper _ (α ∘ suc) _ β) ⟩ + ≡⟨ cong ((d (α zero) ∧l ⋁ (d ∘ β)) ∨l_) (curriedHelper _ (α ∘ suc) _ β) ⟩ - (d (α zero) ∧l ⋁ (d ∘ β)) ∨l (⋁ (d ∘ α ∘ suc) ∧l ⋁ (d ∘ β)) + (d (α zero) ∧l ⋁ (d ∘ β)) ∨l (⋁ (d ∘ α ∘ suc) ∧l ⋁ (d ∘ β)) - ≡⟨ sym (∧lRdist∨l _ _ _) ⟩ + ≡⟨ sym (∧lRdist∨l _ _ _) ⟩ - ⋁ (d ∘ α) ∧l ⋁ (d ∘ β) ∎ + ⋁ (d ∘ α) ∧l ⋁ (d ∘ β) ∎ - χcomp : ∀ (f : R) → χ .fst (D f) ≡ d f - χcomp f = ∨lRid (d f) + χcomp : ∀ (f : R) → χ .fst (D f) ≡ d f + χcomp f = ∨lRid (d f) - χunique : (y : Σ[ χ' ∈ DistLatticeHom ZariskiLattice L' ] fst χ' ∘ D ≡ d) - → (χ , funExt χcomp) ≡ y - χunique (χ' , χ'∘D≡d) = Σ≡Prop (λ _ → isSetΠ (λ _ → isSetL) _ _) (LatticeHom≡f _ _ - (funExt (elimProp (λ _ → isSetL _ _) (uncurry uniqHelper)))) - where - uniqHelper : (n : ℕ) (α : FinVec R n) → fst χ [ n , α ] ≡ fst χ' [ n , α ] - uniqHelper zero _ = sym (cong (λ α → fst χ' [ 0 , α ]) (funExt (λ ())) ∙ χ' .snd .pres0) - uniqHelper (suc n) α = - ⋁ (d ∘ α) ≡⟨ refl ⟩ - d (α zero) ∨l ⋁ (d ∘ α ∘ suc) + χunique : (y : Σ[ χ' ∈ DistLatticeHom ZariskiLattice L' ] fst χ' ∘ D ≡ d) + → (χ , funExt χcomp) ≡ y + χunique (χ' , χ'∘D≡d) = Σ≡Prop (λ _ → isSetΠ (λ _ → isSetL) _ _) (LatticeHom≡f _ _ + (funExt (elimProp (λ _ → isSetL _ _) (uncurry uniqHelper)))) + where + uniqHelper : (n : ℕ) (α : FinVec R n) → fst χ [ n , α ] ≡ fst χ' [ n , α ] + uniqHelper zero _ = sym (cong (λ α → fst χ' [ 0 , α ]) (funExt (λ ())) ∙ χ' .snd .pres0) + uniqHelper (suc n) α = + ⋁ (d ∘ α) ≡⟨ refl ⟩ + d (α zero) ∨l ⋁ (d ∘ α ∘ suc) - ≡⟨ cong (d (α zero) ∨l_) (uniqHelper n (α ∘ suc)) ⟩ -- the inductive step + ≡⟨ cong (d (α zero) ∨l_) (uniqHelper n (α ∘ suc)) ⟩ -- the inductive step - d (α zero) ∨l fst χ' [ n , α ∘ suc ] + d (α zero) ∨l fst χ' [ n , α ∘ suc ] - ≡⟨ cong (_∨l fst χ' [ n , α ∘ suc ]) (sym (funExt⁻ χ'∘D≡d (α zero))) ⟩ + ≡⟨ cong (_∨l fst χ' [ n , α ∘ suc ]) (sym (funExt⁻ χ'∘D≡d (α zero))) ⟩ - fst χ' (D (α zero)) ∨l fst χ' [ n , α ∘ suc ] + fst χ' (D (α zero)) ∨l fst χ' [ n , α ∘ suc ] - ≡⟨ sym (χ' .snd .pres∨l _ _) ⟩ + ≡⟨ sym (χ' .snd .pres∨l _ _) ⟩ - fst χ' (D (α zero) ∨z [ n , α ∘ suc ]) + fst χ' (D (α zero) ∨z [ n , α ∘ suc ]) - ≡⟨ cong (λ β → fst χ' [ suc n , β ]) (funExt (λ { zero → refl ; (suc i) → refl })) ⟩ + ≡⟨ cong (λ β → fst χ' [ suc n , β ]) (funExt (λ { zero → refl ; (suc i) → refl })) ⟩ - fst χ' [ suc n , α ] ∎ + fst χ' [ suc n , α ] ∎ - -- the map induced by applying the universal property to the Zariski lattice - -- itself is the identity hom - ZLUniversalPropCorollary : ZLHasUniversalProp ZariskiLattice D isZarMapD .fst .fst - ≡ idDistLatticeHom ZariskiLattice - ZLUniversalPropCorollary = cong fst - (ZLHasUniversalProp ZariskiLattice D isZarMapD .snd - (idDistLatticeHom ZariskiLattice , refl)) + -- the map induced by applying the universal property to the Zariski lattice + -- itself is the identity hom + ZLUniversalPropCorollary : ZLHasUniversalProp ZariskiLattice D isZarMapD .fst .fst + ≡ idDistLatticeHom ZariskiLattice + ZLUniversalPropCorollary = cong fst + (ZLHasUniversalProp ZariskiLattice D isZarMapD .snd + (idDistLatticeHom ZariskiLattice , refl)) - -- and another corollary - module _ where - open Join ZariskiLattice - ⋁D≡ : {n : ℕ} (α : FinVec R n) → ⋁ (D ∘ α) ≡ [ n , α ] - ⋁D≡ _ = funExt⁻ (cong fst ZLUniversalPropCorollary) _ + -- and another corollary + module _ where + open Join ZariskiLattice + ⋁D≡ : {n : ℕ} (α : FinVec R n) → ⋁ (D ∘ α) ≡ [ n , α ] + ⋁D≡ _ = funExt⁻ (cong fst ZLUniversalPropCorollary) _ \ No newline at end of file diff --git a/Cubical.Categories.Category.Base.html b/Cubical.Categories.Category.Base.html index e803cbaf0c..b0940223ae 100644 --- a/Cubical.Categories.Category.Base.html +++ b/Cubical.Categories.Category.Base.html @@ -83,7 +83,7 @@ CatIso C x y = Σ[ f ∈ C [ x , y ] ] isIso C f CatIso≡ : {C : Category ℓ ℓ'}{x y : C .ob}(f g : CatIso C x y) → f .fst ≡ g .fst → f ≡ g -CatIso≡ f g = Σ≡Prop isPropIsIso +CatIso≡ f g = Σ≡Prop isPropIsIso -- `constructor` of CatIso catiso : {C : Category ℓ ℓ'}{x y : C .ob} diff --git a/Cubical.Categories.Constructions.Elements.html b/Cubical.Categories.Constructions.Elements.html index 658c24d918..e1bed7154a 100644 --- a/Cubical.Categories.Constructions.Elements.html +++ b/Cubical.Categories.Constructions.Elements.html @@ -106,7 +106,7 @@ → (p : o1 ≡ o1') (q : o2 ≡ o2') → (eqInC : PathP (λ i → C [ fst (p i) , fst (q i) ]) (fst f) (fst g)) → PathP (λ i → (∫ᴾ F) [ p i , q i ]) f g - ∫ᴾhomEq _ _ _ _ = ΣPathPProp (λ f → snd (F ⟅ _ ⟆) _ _) + ∫ᴾhomEq _ _ _ _ = ΣPathPProp (λ f → snd (F ⟅ _ ⟆) _ _) ∫ᴾhomEqSimpl : ∀ {o1 o2} (f g : (∫ᴾ F) [ o1 , o2 ]) → fst f ≡ fst g → f ≡ g diff --git a/Cubical.Categories.Constructions.FullSubcategory.html b/Cubical.Categories.Constructions.FullSubcategory.html index 08b93cc0fb..d3d8c8b8dc 100644 --- a/Cubical.Categories.Constructions.FullSubcategory.html +++ b/Cubical.Categories.Constructions.FullSubcategory.html @@ -151,7 +151,7 @@ -- Full subcategory (injective on objects) is injective on objects. isEmbdIncl-ob : isEmbedding (FullInclusion C P .F-ob) - isEmbdIncl-ob _ _ = isEmbeddingFstΣProp isPropP + isEmbdIncl-ob _ _ = isEmbeddingFstΣProp isPropP -- Full subcategory (injective on objects) of univalent category is univalent. diff --git a/Cubical.Categories.Displayed.Cartesian.html b/Cubical.Categories.Displayed.Cartesian.html index f170962535..942aaa677f 100644 --- a/Cubical.Categories.Displayed.Cartesian.html +++ b/Cubical.Categories.Displayed.Cartesian.html @@ -96,7 +96,7 @@ -- It trivially composes to the expected morphism. , Homᴰ≡-DiscreteOpfibration _ _) -- And it's trivially equal to any other choice. - , λ _ → Σ≡Prop (λ _ → isSetHomᴰ _ _) (Homᴰ≡-DiscreteOpfibration _ _) + , λ _ → Σ≡Prop (λ _ → isSetHomᴰ _ _) (Homᴰ≡-DiscreteOpfibration _ _) where lift-g : Σ[ cᴰ ∈ ob[ c ] ] Hom[ g ][ bᴰ , cᴰ ] lift-g = unique-lift g bᴰ .fst @@ -120,7 +120,7 @@ uniqueOpcleavageDiscreteOpfibration .snd opcleavage = implicitFunExt $ implicitFunExt $ funExt λ f → funExt λ aᴰ → ΣPathP $ - map-snd (ΣPathPProp isPropIsOpcartesian) $ + map-snd (ΣPathPProp isPropIsOpcartesian) $ PathPΣ $ unique-lift f aᴰ .snd (map-snd fst (opcleavage f aᴰ)) @@ -172,7 +172,7 @@ R.[ _ ]∙[ _ ] Cᴰ.⋆IdLᴰ fgᴰ isIsoᴰ→isOpcartesian g .equiv-proof fgᴰ .snd (gᴰ , gᴰ-infib) = - Σ≡Prop (λ _ → isOfHLevelPathP' 1 Cᴰ.isSetHomᴰ _ _) $ + Σ≡Prop (λ _ → isOfHLevelPathP' 1 Cᴰ.isSetHomᴰ _ _) $ R.≡[]-rectify $ symP (R.reind-filler (basepath g) _) R.[ sym (basepath g) ]∙[ _ ] @@ -243,7 +243,7 @@ symP (R.reind-filler _ _)) (cart .fst) , λ g' → - Σ≡Prop + Σ≡Prop (λ _ → isOfHLevelPathP' 1 isSetHomᴰ _ _) (cong fst $ cart .snd $ map-snd diff --git a/Cubical.Categories.Displayed.Instances.Codomain.html b/Cubical.Categories.Displayed.Instances.Codomain.html index 294c7b7142..944477c27a 100644 --- a/Cubical.Categories.Displayed.Instances.Codomain.html +++ b/Cubical.Categories.Displayed.Instances.Codomain.html @@ -34,10 +34,10 @@ ∙ sym (C.⋆Assoc _ _ _) ∙ cong (C._⋆ _) fᴰ-comm ∙ C.⋆Assoc _ _ _ - codomainᴰ .⋆IdLᴰ (fᴰ , _) = ΣPathPProp (λ _ → C.isSetHom _ _) (C.⋆IdL fᴰ) - codomainᴰ .⋆IdRᴰ (fᴰ , _) = ΣPathPProp (λ _ → C.isSetHom _ _) (C.⋆IdR fᴰ) + codomainᴰ .⋆IdLᴰ (fᴰ , _) = ΣPathPProp (λ _ → C.isSetHom _ _) (C.⋆IdL fᴰ) + codomainᴰ .⋆IdRᴰ (fᴰ , _) = ΣPathPProp (λ _ → C.isSetHom _ _) (C.⋆IdR fᴰ) codomainᴰ .⋆Assocᴰ (fᴰ , _) (gᴰ , _) (hᴰ , _) = - ΣPathPProp (λ _ → C.isSetHom _ _) (C.⋆Assoc fᴰ gᴰ hᴰ) + ΣPathPProp (λ _ → C.isSetHom _ _) (C.⋆Assoc fᴰ gᴰ hᴰ) codomainᴰ .isSetHomᴰ = isSetΣSndProp C.isSetHom (λ _ → C.isSetHom _ _) open Covariant @@ -47,9 +47,9 @@ codomainOpcleavage _ _ .snd .fst = C.id , C.⋆IdL _ codomainOpcleavage _ _ .snd .snd _ .equiv-proof (gᴰ , gᴰ-commutes) .fst = (gᴰ , gᴰ-commutes ∙ sym (C.⋆Assoc _ _ _)) - , Σ≡Prop (λ _ → C.isSetHom _ _) (C.⋆IdL _) + , Σ≡Prop (λ _ → C.isSetHom _ _) (C.⋆IdL _) codomainOpcleavage _ _ .snd .snd _ .equiv-proof _ .snd (_ , infib) = - Σ≡Prop (λ _ → isSetΣSndProp C.isSetHom (λ _ → C.isSetHom _ _) _ _) $ - Σ≡Prop (λ _ → C.isSetHom _ _) $ + Σ≡Prop (λ _ → isSetΣSndProp C.isSetHom (λ _ → C.isSetHom _ _) _ _) $ + Σ≡Prop (λ _ → C.isSetHom _ _) $ sym (cong fst infib) ∙ C.⋆IdL _ \ No newline at end of file diff --git a/Cubical.Categories.DistLatticeSheaf.Base.html b/Cubical.Categories.DistLatticeSheaf.Base.html index 4297626ea9..b0a3beeff1 100644 --- a/Cubical.Categories.DistLatticeSheaf.Base.html +++ b/Cubical.Categories.DistLatticeSheaf.Base.html @@ -11,496 +11,496 @@ open import Cubical.Data.Nat.Order open import Cubical.Data.FinData -open import Cubical.Relation.Binary.Poset +open import Cubical.Relation.Binary.Order.Poset -open import Cubical.Algebra.Semilattice -open import Cubical.Algebra.Lattice -open import Cubical.Algebra.DistLattice -open import Cubical.Algebra.DistLattice.Basis -open import Cubical.Algebra.DistLattice.BigOps +open import Cubical.Algebra.Semilattice +open import Cubical.Algebra.Lattice +open import Cubical.Algebra.DistLattice +open import Cubical.Algebra.DistLattice.Basis +open import Cubical.Algebra.DistLattice.BigOps -open import Cubical.Categories.Category.Base -open import Cubical.Categories.Functor -open import Cubical.Categories.NaturalTransformation -open import Cubical.Categories.Limits.Pullback -open import Cubical.Categories.Limits.Terminal -open import Cubical.Categories.Limits.Limits -open import Cubical.Categories.Instances.Poset -open import Cubical.Categories.Instances.Semilattice -open import Cubical.Categories.Instances.Lattice -open import Cubical.Categories.Instances.DistLattice +open import Cubical.Categories.Category.Base +open import Cubical.Categories.Functor +open import Cubical.Categories.NaturalTransformation +open import Cubical.Categories.Limits.Pullback +open import Cubical.Categories.Limits.Terminal +open import Cubical.Categories.Limits.Limits +open import Cubical.Categories.Instances.Poset +open import Cubical.Categories.Instances.Semilattice +open import Cubical.Categories.Instances.Lattice +open import Cubical.Categories.Instances.DistLattice -open import Cubical.Categories.DistLatticeSheaf.Diagram +open import Cubical.Categories.DistLatticeSheaf.Diagram -private - variable - ℓ ℓ' ℓ'' : Level +private + variable + ℓ ℓ' ℓ'' : Level -module _ (L : DistLattice ℓ) (C : Category ℓ' ℓ'') where - open Category hiding (_⋆_ ; _∘_) - open Functor - open Order (DistLattice→Lattice L) - open DistLatticeStr (snd L) - open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L)) - open MeetSemilattice (Lattice→MeetSemilattice (DistLattice→Lattice L)) - using (∧≤RCancel ; ∧≤LCancel ; ≤-∧Pres) - open PosetStr (IndPoset .snd) hiding (_≤_) +module _ (L : DistLattice ℓ) (C : Category ℓ' ℓ'') where + open Category hiding (_⋆_ ; _∘_) + open Functor + open Order (DistLattice→Lattice L) + open DistLatticeStr (snd L) + open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L)) + open MeetSemilattice (Lattice→MeetSemilattice (DistLattice→Lattice L)) + using (∧≤RCancel ; ∧≤LCancel ; ≤-∧Pres) + open PosetStr (IndPoset .snd) hiding (_≤_) - private - DLCat : Category ℓ ℓ - DLCat = DistLatticeCategory L + private + DLCat : Category ℓ ℓ + DLCat = DistLatticeCategory L - -- C-valued presheaves on a distributive lattice - DLPreSheaf : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'') - DLPreSheaf = Functor (DLCat ^op) C + -- C-valued presheaves on a distributive lattice + DLPreSheaf : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'') + DLPreSheaf = Functor (DLCat ^op) C - module _ (x y : L .fst)where - hom-∨₁ : DLCat [ x , x ∨l y ] - hom-∨₁ = ∨≤RCancel _ _ + module _ (x y : L .fst)where + hom-∨₁ : DLCat [ x , x ∨l y ] + hom-∨₁ = ∨≤RCancel _ _ - hom-∨₂ : DLCat [ y , x ∨l y ] - hom-∨₂ = ∨≤LCancel _ _ + hom-∨₂ : DLCat [ y , x ∨l y ] + hom-∨₂ = ∨≤LCancel _ _ - hom-∧₁ : DLCat [ x ∧l y , x ] - hom-∧₁ = ≤m→≤j _ _ (∧≤RCancel _ _) + hom-∧₁ : DLCat [ x ∧l y , x ] + hom-∧₁ = ≤m→≤j _ _ (∧≤RCancel _ _) - hom-∧₂ : DLCat [ x ∧l y , y ] - hom-∧₂ = ≤m→≤j _ _ (∧≤LCancel _ _) + hom-∧₂ : DLCat [ x ∧l y , y ] + hom-∧₂ = ≤m→≤j _ _ (∧≤LCancel _ _) - {- + {- x ∧ y ----→ x | | | sq | V V y ----→ x ∨ y -} - sq : hom-∧₂ ⋆⟨ DLCat ⟩ hom-∨₂ ≡ hom-∧₁ ⋆⟨ DLCat ⟩ hom-∨₁ - sq = is-prop-valued (x ∧l y) (x ∨l y) (hom-∧₂ ⋆⟨ DLCat ⟩ hom-∨₂) (hom-∧₁ ⋆⟨ DLCat ⟩ hom-∨₁) + sq : hom-∧₂ ⋆⟨ DLCat ⟩ hom-∨₂ ≡ hom-∧₁ ⋆⟨ DLCat ⟩ hom-∨₁ + sq = is-prop-valued (x ∧l y) (x ∨l y) (hom-∧₂ ⋆⟨ DLCat ⟩ hom-∨₂) (hom-∧₁ ⋆⟨ DLCat ⟩ hom-∨₁) - {- + {- F(x ∨ y) ----→ F(x) | | | Fsq | V V F(y) ------→ F(x ∧ y) -} - Fsq : (F : DLPreSheaf) - → F .F-hom hom-∨₂ ⋆⟨ C ⟩ F .F-hom hom-∧₂ ≡ - F .F-hom hom-∨₁ ⋆⟨ C ⟩ F .F-hom hom-∧₁ - Fsq F = F-square F sq - - isDLSheafPullback : (F : DLPreSheaf) → Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'') - isDLSheafPullback F = isTerminal C (F-ob F 0l) - × ((x y : L .fst) → isPullback C _ _ _ (Fsq x y F)) - - isPropIsDLSheafPullback : ∀ F → isProp (isDLSheafPullback F) - isPropIsDLSheafPullback F = isProp× - (isPropIsTerminal _ _) - (isPropΠ2 - (λ x y → isPropIsPullback _ _ _ _ (Fsq x y F))) - - -- TODO: might be better to define this as a record - DLSheafPullback : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'') - DLSheafPullback = Σ[ F ∈ DLPreSheaf ] isDLSheafPullback F - - - -- Now for the proper version using limits of the right kind: - open Join L - isDLSheaf : (F : DLPreSheaf) → Type _ - isDLSheaf F = ∀ (n : ℕ) (α : FinVec (fst L) n) → isLimCone _ _ (F-cone F (⋁Cone L α)) - - open LimCone - isDLSheafLimCone : (F : DLPreSheaf) → isDLSheaf F - → (n : ℕ) (α : FinVec (fst L) n) → LimCone (F ∘F (FinVec→Diag L α)) - lim (isDLSheafLimCone F isSheafF n α) = _ - limCone (isDLSheafLimCone F isSheafF n α) = F-cone F (⋁Cone L α) - univProp (isDLSheafLimCone F isSheafF n α) = isSheafF n α - - isPropIsDLSheaf : ∀ F → isProp (isDLSheaf F) - isPropIsDLSheaf F = isPropΠ2 (λ _ _ → isPropIsLimCone _ _ _) - - isDLSheafProp : ℙ DLPreSheaf - isDLSheafProp F = isDLSheaf F , isPropIsDLSheaf F - - module EquivalenceOfDefs (F : DLPreSheaf) where - open isUnivalent - open Cone - open LimCone - open Pullback - open Cospan - - - ≤PathPLemma : ∀ {x y z w : ob DLCat} (p : x ≡ y) (q : z ≡ w) - (x≥z : (DLCat ^op) [ x , z ]) (y≥w : (DLCat ^op) [ y , w ]) - → PathP (λ i → (DLCat ^op) [ p i , q i ]) x≥z y≥w - ≤PathPLemma p q x≥z y≥w = isProp→PathP (λ j → is-prop-valued (q j) (p j)) x≥z y≥w - - F≤PathPLemma : ∀ {x y z w : ob DLCat} (p : x ≡ y) (q : z ≡ w) - (x≥z : (DLCat ^op) [ x , z ]) (y≥w : (DLCat ^op) [ y , w ]) - → PathP (λ i → C [ F .F-ob (p i) , F .F-ob (q i) ]) (F .F-hom x≥z) (F .F-hom y≥w) - F≤PathPLemma p q x≥z y≥w i = F .F-hom (≤PathPLemma p q x≥z y≥w i) - - L→P : isDLSheaf F → isDLSheafPullback F - fst (L→P isSheafF) = isTerminalF0 - where -- F(0) ≡ terminal obj. - isLimConeF0 : isLimCone _ (F .F-ob 0l) (F-cone F (⋁Cone L (λ ()))) - isLimConeF0 = isSheafF 0 (λ ()) - - toCone : (y : ob C) → Cone (funcComp F (FinVec→Diag L {n = 0} (λ ()))) y - coneOut (toCone y) (sing ()) - coneOut (toCone y) (pair () _ _) - coneOutCommutes (toCone y) {u = sing ()} idAr - coneOutCommutes (toCone y) {u = pair () _ _} idAr - - toConeMor : ∀ (y : ob C) (f : C [ y , F .F-ob 0l ]) - → isConeMor (toCone y) (F-cone F (⋁Cone L (λ ()))) f - toConeMor y f (sing ()) - toConeMor y f (pair () _ _) - - isTerminalF0 : isTerminal C (F .F-ob 0l) - fst (isTerminalF0 y) = isLimConeF0 _ (toCone y) .fst .fst - snd (isTerminalF0 y) f = cong fst (isLimConeF0 _ (toCone y) .snd (_ , toConeMor y f)) - - snd (L→P isSheafF) x y = LimAsPullback .univProp - where - xyVec : FinVec (fst L) 2 - xyVec zero = y - xyVec one = x - - inducedLimCone : LimCone (funcComp F (FinVec→Diag L xyVec)) - lim inducedLimCone = F .F-ob (⋁ xyVec) - limCone inducedLimCone = F-cone F (⋁Cone L xyVec) - univProp inducedLimCone = isSheafF 2 xyVec - - theCone : Cone (funcComp F (FinVec→Diag L xyVec)) (F .F-ob (x ∨l y)) - coneOut (theCone) (sing zero) = F .F-hom (hom-∨₂ x y) - coneOut (theCone) (sing one) = F .F-hom (hom-∨₁ x y) - coneOut (theCone) (pair zero zero ()) - coneOut (theCone) (pair zero one (s≤s z≤)) = - F .F-hom (hom-∨₂ x y) ⋆⟨ C ⟩ F .F-hom (hom-∧₂ x y) - coneOut (theCone) (pair one zero ()) - coneOut (theCone) (pair one one (s≤s ())) - coneOut (theCone) (pair (suc (suc _)) one (s≤s ())) - coneOutCommutes (theCone) {u = u} idAr = - cong (seq' C (coneOut (theCone) u)) (F .F-id) ∙ ⋆IdR C _ - coneOutCommutes (theCone) (singPairL {zero} {zero} {()}) - coneOutCommutes (theCone) (singPairL {zero} {one} {s≤s z≤}) = refl - coneOutCommutes (theCone) (singPairL {one} {zero} {()}) - coneOutCommutes (theCone) (singPairL {one} {one} {s≤s ()}) - coneOutCommutes (theCone) (singPairL {suc (suc _)} {one} {s≤s ()}) - coneOutCommutes (theCone) (singPairR {zero} {zero} {()}) - coneOutCommutes (theCone) (singPairR {zero} {one} {s≤s z≤}) = sym (Fsq x y F) - coneOutCommutes (theCone) (singPairR {one} {zero} {()}) - coneOutCommutes (theCone) (singPairR {one} {one} {s≤s ()}) - coneOutCommutes (theCone) (singPairR {suc (suc _)} {one} {s≤s ()}) - - theLimCone : LimCone (funcComp F (FinVec→Diag L xyVec)) - lim theLimCone = _ - limCone theLimCone = theCone - univProp theLimCone = - transport (λ i → isLimCone _ (limPath i) (limConePathP i)) (univProp inducedLimCone) - where - xyPath : ⋁ xyVec ≡ x ∨l y - xyPath = cong (y ∨l_) (∨lRid x) ∙ ∨lComm _ _ - - limPath : lim inducedLimCone ≡ lim theLimCone - limPath = cong (F .F-ob) xyPath - - limConePathP : PathP (λ i → Cone (funcComp F (FinVec→Diag L xyVec)) (limPath i)) - (limCone inducedLimCone) theCone - limConePathP = conePathPOb helperPathP - where - helperPathP : - ∀ v → PathP (λ i → C [ limPath i , F-ob (funcComp F (FinVec→Diag L xyVec)) v ]) - (coneOut (limCone inducedLimCone) v) (coneOut theCone v) - helperPathP (sing zero) = F≤PathPLemma xyPath refl (ind≤⋁ xyVec zero) (hom-∨₂ x y) - helperPathP (sing one) = F≤PathPLemma xyPath refl (ind≤⋁ xyVec one) (hom-∨₁ x y) - helperPathP (pair zero zero ()) - helperPathP (pair zero one (s≤s z≤)) = - subst (λ f → PathP (λ i → C [ limPath i , F .F-ob (x ∧l y) ]) - (coneOut (limCone inducedLimCone) (pair zero one (s≤s z≤))) f) - (F-seq F _ _) helperHelperPathP - where - helperHelperPathP : PathP (λ i → C [ limPath i , F .F-ob (x ∧l y) ]) - (coneOut (limCone inducedLimCone) (pair zero one (s≤s z≤))) - (F .F-hom (hom-∨₂ x y ⋆⟨ (DLCat ^op) ⟩ hom-∧₂ x y)) - helperHelperPathP = F≤PathPLemma xyPath refl - (is-trans _ (xyVec zero) _ (≤m→≤j _ _ (∧≤LCancel _ _)) (ind≤⋁ xyVec zero)) - (hom-∨₂ x y ⋆⟨ (DLCat ^op) ⟩ hom-∧₂ x y) - helperPathP (pair one zero ()) - helperPathP (pair one one (s≤s ())) - helperPathP (pair (suc (suc _)) one (s≤s ())) - open DLShfDiagsAsPullbacks C _ theLimCone - - - --the other direction - P→L : isDLSheafPullback F → isDLSheaf F - fst (fst (P→L (isTerminalF0 , _) ℕ.zero α c cc)) = isTerminalF0 c .fst - snd (fst (P→L (isTerminalF0 , _) ℕ.zero α c cc)) (sing ()) - snd (fst (P→L (isTerminalF0 , _) ℕ.zero α c cc)) (pair () _ _) - snd (P→L (isTerminalF0 , _) ℕ.zero α c cc) _ = - Σ≡Prop (isPropIsConeMor _ _) (isTerminalF0 c .snd _) - - P→L (F0=1 , presPBSq) (ℕ.suc n) α c cc = uniqueExists - (uniqH .fst .fst) - (toIsConeMor (uniqH .fst .fst) (uniqH .fst .snd)) - (λ _ → isPropIsConeMor _ _ _) - λ h' isConeMorH' → cong fst (uniqH .snd (h' , fromIsConeMor h' isConeMorH')) - where - β : FinVec (fst L) n - β i = α (suc i) ∧l α zero - - αβPath : (α zero) ∧l ⋁ (α ∘ suc) ≡ ⋁ β - αβPath = ∧lComm _ _ ∙ ⋁Meetldist (α zero) (α ∘ suc) - - -- the square we want - theCospan : Cospan C - l theCospan = F .F-ob (⋁ (α ∘ suc)) - m theCospan = F .F-ob (⋁ β) - r theCospan = F .F-ob (α zero) - s₁ theCospan = F .F-hom (≤-⋁Ext _ _ λ _ → hom-∧₁ _ _) - s₂ theCospan = F .F-hom (⋁IsMax _ _ λ _ → hom-∧₂ _ _) - - thePB : Pullback C theCospan - pbOb thePB = F .F-ob (⋁ α) - pbPr₁ thePB = F .F-hom (hom-∨₂ _ _) - pbPr₂ thePB = F .F-hom (hom-∨₁ _ _) - pbCommutes thePB = F-square F (is-prop-valued _ _ _ _) - univProp thePB f g square = presPBSq (α zero) (⋁ (α ∘ suc)) f g squarePath - where - squarePath : f ⋆⟨ C ⟩ F .F-hom (hom-∧₂ _ _) ≡ g ⋆⟨ C ⟩ F .F-hom (hom-∧₁ _ _) - squarePath = transport - (λ i → f ⋆⟨ C ⟩ F≤PathPLemma refl αβPath - (hom-∧₂ _ _) (≤-⋁Ext _ _ λ _ → hom-∧₁ _ _) (~ i) - ≡ g ⋆⟨ C ⟩ F≤PathPLemma refl αβPath - (hom-∧₁ _ _) (⋁IsMax _ _ λ _ → hom-∧₂ _ _) (~ i)) - square - - -- the two induced cones on which we use the ind. hyp. - ccSuc : Cone (funcComp F (FinVec→Diag L (α ∘ suc))) c - coneOut ccSuc (sing i) = coneOut cc (sing (suc i)) - coneOut ccSuc (pair i j i<j) = coneOut cc (pair (suc i) (suc j) (s≤s i<j)) - coneOutCommutes ccSuc {sing _} idAr = coneOutCommutes cc idAr - coneOutCommutes ccSuc {pair _ _ _} idAr = coneOutCommutes cc idAr - coneOutCommutes ccSuc singPairL = coneOutCommutes cc singPairL - coneOutCommutes ccSuc singPairR = coneOutCommutes cc singPairR - - cc∧Suc : Cone (funcComp F (FinVec→Diag L β)) c - coneOut cc∧Suc (sing i) = coneOut cc (pair zero (suc i) (s≤s z≤)) - coneOut cc∧Suc (pair i j i<j) = coneOut cc (pair (suc i) (suc j) (s≤s i<j)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _))) - --(αⱼ ∧ αᵢ) ≥ (αⱼ ∧ α₀) ∧ (αᵢ ∧ α₀) - coneOutCommutes cc∧Suc idAr = - cong (seq' C (coneOut cc∧Suc _)) ((funcComp F (FinVec→Diag L β)) .F-id) ∙ ⋆IdR C _ - coneOutCommutes cc∧Suc (singPairL {i = i} {j = j} {i<j = i<j}) = - coneOut cc (pair zero (suc i) (s≤s z≤)) - ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairL) - ≡⟨ cong (λ x → seq' C x (funcComp F (FinVec→Diag L β) .F-hom singPairL)) - (sym (coneOutCommutes cc singPairR)) ⟩ - (coneOut cc (sing (suc i)) ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L α) .F-hom singPairR)) - ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairL) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - coneOut cc (sing (suc i)) ⋆⟨ C ⟩ ((funcComp F (FinVec→Diag L α) .F-hom singPairR) - ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairL)) - ≡⟨ cong (λ x → coneOut cc (sing (suc i)) ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ - coneOut cc (sing (suc i)) ⋆⟨ C ⟩ F .F-hom - ((FinVec→Diag L α) .F-hom (singPairR {i<j = s≤s z≤}) - ⋆⟨ DLCat ^op ⟩ (FinVec→Diag L β) .F-hom (singPairL {i<j = i<j})) - ≡⟨ cong (λ x → coneOut cc (sing (suc i)) ⋆⟨ C ⟩ F .F-hom x) - (is-prop-valued _ _ _ _) ⟩ - coneOut cc (sing (suc i)) ⋆⟨ C ⟩ F .F-hom - ((FinVec→Diag L α) .F-hom (singPairL {i<j = s≤s i<j}) - ⋆⟨ DLCat ^op ⟩ (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) - ≡⟨ cong (λ x → coneOut cc (sing (suc i)) ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ - coneOut cc (sing (suc i)) ⋆⟨ C ⟩ ((funcComp F (FinVec→Diag L α) .F-hom singPairL) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (coneOut cc (sing (suc i)) ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L α) .F-hom singPairL)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _))) - ≡⟨ cong - (λ x → x ⋆⟨ C ⟩ F .F-hom - (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) - (coneOutCommutes cc singPairL) ⟩ - coneOut cc (pair (suc i) (suc j) (s≤s i<j)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _))) ∎ - - coneOutCommutes cc∧Suc (singPairR {i = i} {j = j} {i<j = i<j}) = - coneOut cc (pair zero (suc j) (s≤s z≤)) - ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairR) - ≡⟨ cong (λ x → seq' C x (funcComp F (FinVec→Diag L β) .F-hom singPairR)) - (sym (coneOutCommutes cc singPairR)) ⟩ - (coneOut cc (sing (suc j)) ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L α) .F-hom singPairR)) - ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairR) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - coneOut cc (sing (suc j)) ⋆⟨ C ⟩ ((funcComp F (FinVec→Diag L α) .F-hom singPairR) - ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairR)) - ≡⟨ cong (λ x → coneOut cc (sing (suc j)) ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ - coneOut cc (sing (suc j)) ⋆⟨ C ⟩ F .F-hom - ((FinVec→Diag L α) .F-hom (singPairR {i<j = s≤s z≤}) - ⋆⟨ DLCat ^op ⟩ (FinVec→Diag L β) .F-hom (singPairR {i<j = i<j})) - ≡⟨ cong (λ x → coneOut cc (sing (suc j)) ⋆⟨ C ⟩ F .F-hom x) - (is-prop-valued _ _ _ _) ⟩ - coneOut cc (sing (suc j)) ⋆⟨ C ⟩ F .F-hom - ((FinVec→Diag L α) .F-hom (singPairR {i<j = s≤s i<j}) - ⋆⟨ DLCat ^op ⟩ (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) - ≡⟨ cong (λ x → coneOut cc (sing (suc j)) ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ - coneOut cc (sing (suc j)) ⋆⟨ C ⟩ ((funcComp F (FinVec→Diag L α) .F-hom singPairR) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (coneOut cc (sing (suc j)) ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L α) .F-hom singPairR)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _))) - ≡⟨ cong - (λ x → x ⋆⟨ C ⟩ F .F-hom - (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) - (coneOutCommutes cc singPairR) ⟩ - coneOut cc (pair (suc i) (suc j) (s≤s i<j)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _))) ∎ - - - -- our morphisms: - f : C [ c , F .F-ob (α zero) ] - f = coneOut cc (sing zero) - - g : C [ c , F .F-ob (⋁ (α ∘ suc)) ] - g = P→L (F0=1 , presPBSq) n (α ∘ suc) c ccSuc .fst .fst - - k = g ⋆⟨ C ⟩ s₁ theCospan - o = f ⋆⟨ C ⟩ s₂ theCospan - - isConeMorK : isConeMor cc∧Suc (F-cone F (⋁Cone L β)) k - isConeMorK = isConeMorSingLemma cc∧Suc (F-cone F (⋁Cone L β)) singCase - where - singCase : ∀ i → k ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L β)) (sing i)) - ≡ coneOut cc∧Suc (sing i) - singCase i = - (g ⋆⟨ C ⟩ s₁ theCospan) ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L β)) (sing i)) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - g ⋆⟨ C ⟩ (s₁ theCospan ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L β)) (sing i))) - ≡⟨ cong (λ x → g ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ - g ⋆⟨ C ⟩ F .F-hom - ((≤-⋁Ext _ _ λ _ → hom-∧₁ _ _) ⋆⟨ DLCat ^op ⟩ coneOut (⋁Cone L β) (sing i)) - ≡⟨ cong (λ x → g ⋆⟨ C ⟩ F .F-hom x) (is-prop-valued _ _ _ _) ⟩ - g ⋆⟨ C ⟩ F .F-hom (coneOut (⋁Cone L (α ∘ suc)) (sing i) - ⋆⟨ DLCat ^op ⟩ (FinVec→Diag L α) .F-hom (singPairR{i<j = s≤s z≤}) ) - ≡⟨ cong (λ x → g ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ - g ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L (α ∘ suc))) (sing i) - ⋆⟨ C ⟩ funcComp F (FinVec→Diag L α) .F-hom singPairR) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (g ⋆⟨ C ⟩ coneOut (F-cone F (⋁Cone L (α ∘ suc))) (sing i)) - ⋆⟨ C ⟩ funcComp F (FinVec→Diag L α) .F-hom singPairR - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ funcComp F (FinVec→Diag L α) .F-hom singPairR) - (P→L (F0=1 , presPBSq) n (α ∘ suc) c ccSuc .fst .snd (sing i)) ⟩ - coneOut cc (sing (suc i)) ⋆⟨ C ⟩ funcComp F (FinVec→Diag L α) .F-hom singPairR - ≡⟨ coneOutCommutes cc singPairR ⟩ - coneOut cc (pair zero (suc i) (s≤s z≤)) ∎ - - - - isConeMorO : isConeMor cc∧Suc (F-cone F (⋁Cone L β)) o - isConeMorO = isConeMorSingLemma cc∧Suc (F-cone F (⋁Cone L β)) singCase - where - singCase : ∀ i → o ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L β)) (sing i)) - ≡ coneOut cc∧Suc (sing i) - singCase i = - o ⋆⟨ C ⟩ (F .F-hom (ind≤⋁ β i)) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - f ⋆⟨ C ⟩ (s₂ theCospan ⋆⟨ C ⟩ (F .F-hom (ind≤⋁ β i))) - ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ - f ⋆⟨ C ⟩ F .F-hom ((⋁IsMax _ _ λ _ → hom-∧₂ _ _) ⋆⟨ DLCat ^op ⟩ ind≤⋁ β i) - ≡⟨ cong (λ x → f ⋆⟨ C ⟩ F .F-hom x) (is-prop-valued _ _ _ _) ⟩ - f ⋆⟨ C ⟩ funcComp F (FinVec→Diag L α) .F-hom singPairL - ≡⟨ coneOutCommutes cc singPairL ⟩ - coneOut cc (pair zero (suc i) (s≤s z≤)) ∎ - - fgSquare : g ⋆⟨ C ⟩ s₁ theCospan ≡ f ⋆⟨ C ⟩ s₂ theCospan - fgSquare = cong fst (isContr→isProp (P→L (F0=1 , presPBSq) n β c cc∧Suc) - (k , isConeMorK) (o , isConeMorO)) - - uniqH : ∃![ h ∈ C [ c , F .F-ob (⋁ α) ] ] - (g ≡ h ⋆⟨ C ⟩ pbPr₁ thePB) × (f ≡ h ⋆⟨ C ⟩ pbPr₂ thePB) - uniqH = univProp thePB _ _ fgSquare - - toIsConeMor : ∀ (h : C [ c , F .F-ob (⋁ α) ]) - → (g ≡ h ⋆⟨ C ⟩ pbPr₁ thePB) × (f ≡ h ⋆⟨ C ⟩ pbPr₂ thePB) - → isConeMor cc (F-cone F (⋁Cone L α)) h - toIsConeMor h (gTriangle , fTriangle) = isConeMorSingLemma cc (F-cone F (⋁Cone L α)) singCase - where - singCase : ∀ i → h ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L α)) (sing i)) - ≡ coneOut cc (sing i) - singCase zero = sym fTriangle - singCase (suc i) = - h ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L α)) (sing (suc i))) - ≡⟨ cong (λ x → seq' C h (F .F-hom x)) (is-prop-valued _ _ _ _) ⟩ - h ⋆⟨ C ⟩ F .F-hom (hom-∨₂ _ _ ⋆⟨ DLCat ^op ⟩ ⋁Cone L (α ∘ suc) .coneOut (sing i)) - ≡⟨ cong (seq' C h) (F .F-seq _ _) ⟩ - h ⋆⟨ C ⟩ (pbPr₁ thePB ⋆⟨ C ⟩ F .F-hom (⋁Cone L (α ∘ suc) .coneOut (sing i))) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (h ⋆⟨ C ⟩ pbPr₁ thePB) ⋆⟨ C ⟩ F .F-hom (⋁Cone L (α ∘ suc) .coneOut (sing i)) - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ (F .F-hom (⋁Cone L (α ∘ suc) .coneOut (sing i)))) - (sym gTriangle) ⟩ - g ⋆⟨ C ⟩ F .F-hom (⋁Cone L (α ∘ suc) .coneOut (sing i)) - ≡⟨ P→L (F0=1 , presPBSq) n (α ∘ suc) c ccSuc .fst .snd (sing i) ⟩ - coneOut cc (sing (suc i)) ∎ - - fromIsConeMor : ∀ (h : C [ c , F .F-ob (⋁ α) ]) - → isConeMor cc (F-cone F (⋁Cone L α)) h - → (g ≡ h ⋆⟨ C ⟩ pbPr₁ thePB) × (f ≡ h ⋆⟨ C ⟩ pbPr₂ thePB) - fst (fromIsConeMor h isConeMorH) = - cong fst (P→L (F0=1 , presPBSq) n (α ∘ suc) c ccSuc .snd (s , isConeMorS)) - where - s = h ⋆⟨ C ⟩ pbPr₁ thePB - isConeMorS : isConeMor ccSuc (F-cone F (⋁Cone L (α ∘ suc))) s - isConeMorS = isConeMorSingLemma ccSuc (F-cone F (⋁Cone L (α ∘ suc))) singCase - where - singCase : ∀ i → s ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L (α ∘ suc))) (sing i)) - ≡ coneOut ccSuc (sing i) - singCase i = - (h ⋆⟨ C ⟩ pbPr₁ thePB) ⋆⟨ C ⟩ (F .F-hom (ind≤⋁ (α ∘ suc) i)) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - h ⋆⟨ C ⟩ (pbPr₁ thePB ⋆⟨ C ⟩ (F .F-hom (ind≤⋁ (α ∘ suc) i))) - ≡⟨ cong (seq' C h) (sym (F .F-seq _ _)) ⟩ - h ⋆⟨ C ⟩ F .F-hom (hom-∨₂ _ _ ⋆⟨ DLCat ^op ⟩ ind≤⋁ (α ∘ suc) i) - ≡⟨ cong (λ x → seq' C h (F .F-hom x)) (is-prop-valued _ _ _ _) ⟩ - h ⋆⟨ C ⟩ coneOut (F-cone F (⋁Cone L α)) (sing (suc i)) - ≡⟨ isConeMorH (sing (suc i)) ⟩ - coneOut cc (sing (suc i)) ∎ - - snd (fromIsConeMor h isConeMorH) = sym (isConeMorH (sing zero)) - - - - - -module SheafOnBasis (L : DistLattice ℓ) (C : Category ℓ' ℓ'') - (L' : ℙ (fst L)) (hB : IsBasis L L') where - - open Category - open Functor - - open DistLatticeStr ⦃...⦄ - open SemilatticeStr ⦃...⦄ - open IsBasis hB - - private - DLCat = DistLatticeCategory L - BasisCat = ΣPropCat DLCat L' - DLBasisPreSheaf = Functor (BasisCat ^op) C - - instance - _ = snd L - _ = snd (Basis→MeetSemilattice L L' hB) - - - module condSquare (x y : ob BasisCat) (x∨y∈L' : fst x ∨l fst y ∈ L') where - - private - x∨y : ob BasisCat -- = Σ[ x ∈ L ] (x ∈ L') - x∨y = fst x ∨l fst y , x∨y∈L' - - {- + Fsq : (F : DLPreSheaf) + → F .F-hom hom-∨₂ ⋆⟨ C ⟩ F .F-hom hom-∧₂ ≡ + F .F-hom hom-∨₁ ⋆⟨ C ⟩ F .F-hom hom-∧₁ + Fsq F = F-square F sq + + isDLSheafPullback : (F : DLPreSheaf) → Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'') + isDLSheafPullback F = isTerminal C (F-ob F 0l) + × ((x y : L .fst) → isPullback C _ _ _ (Fsq x y F)) + + isPropIsDLSheafPullback : ∀ F → isProp (isDLSheafPullback F) + isPropIsDLSheafPullback F = isProp× + (isPropIsTerminal _ _) + (isPropΠ2 + (λ x y → isPropIsPullback _ _ _ _ (Fsq x y F))) + + -- TODO: might be better to define this as a record + DLSheafPullback : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'') + DLSheafPullback = Σ[ F ∈ DLPreSheaf ] isDLSheafPullback F + + + -- Now for the proper version using limits of the right kind: + open Join L + isDLSheaf : (F : DLPreSheaf) → Type _ + isDLSheaf F = ∀ (n : ℕ) (α : FinVec (fst L) n) → isLimCone _ _ (F-cone F (⋁Cone L α)) + + open LimCone + isDLSheafLimCone : (F : DLPreSheaf) → isDLSheaf F + → (n : ℕ) (α : FinVec (fst L) n) → LimCone (F ∘F (FinVec→Diag L α)) + lim (isDLSheafLimCone F isSheafF n α) = _ + limCone (isDLSheafLimCone F isSheafF n α) = F-cone F (⋁Cone L α) + univProp (isDLSheafLimCone F isSheafF n α) = isSheafF n α + + isPropIsDLSheaf : ∀ F → isProp (isDLSheaf F) + isPropIsDLSheaf F = isPropΠ2 (λ _ _ → isPropIsLimCone _ _ _) + + isDLSheafProp : ℙ DLPreSheaf + isDLSheafProp F = isDLSheaf F , isPropIsDLSheaf F + + module EquivalenceOfDefs (F : DLPreSheaf) where + open isUnivalent + open Cone + open LimCone + open Pullback + open Cospan + + + ≤PathPLemma : ∀ {x y z w : ob DLCat} (p : x ≡ y) (q : z ≡ w) + (x≥z : (DLCat ^op) [ x , z ]) (y≥w : (DLCat ^op) [ y , w ]) + → PathP (λ i → (DLCat ^op) [ p i , q i ]) x≥z y≥w + ≤PathPLemma p q x≥z y≥w = isProp→PathP (λ j → is-prop-valued (q j) (p j)) x≥z y≥w + + F≤PathPLemma : ∀ {x y z w : ob DLCat} (p : x ≡ y) (q : z ≡ w) + (x≥z : (DLCat ^op) [ x , z ]) (y≥w : (DLCat ^op) [ y , w ]) + → PathP (λ i → C [ F .F-ob (p i) , F .F-ob (q i) ]) (F .F-hom x≥z) (F .F-hom y≥w) + F≤PathPLemma p q x≥z y≥w i = F .F-hom (≤PathPLemma p q x≥z y≥w i) + + L→P : isDLSheaf F → isDLSheafPullback F + fst (L→P isSheafF) = isTerminalF0 + where -- F(0) ≡ terminal obj. + isLimConeF0 : isLimCone _ (F .F-ob 0l) (F-cone F (⋁Cone L (λ ()))) + isLimConeF0 = isSheafF 0 (λ ()) + + toCone : (y : ob C) → Cone (funcComp F (FinVec→Diag L {n = 0} (λ ()))) y + coneOut (toCone y) (sing ()) + coneOut (toCone y) (pair () _ _) + coneOutCommutes (toCone y) {u = sing ()} idAr + coneOutCommutes (toCone y) {u = pair () _ _} idAr + + toConeMor : ∀ (y : ob C) (f : C [ y , F .F-ob 0l ]) + → isConeMor (toCone y) (F-cone F (⋁Cone L (λ ()))) f + toConeMor y f (sing ()) + toConeMor y f (pair () _ _) + + isTerminalF0 : isTerminal C (F .F-ob 0l) + fst (isTerminalF0 y) = isLimConeF0 _ (toCone y) .fst .fst + snd (isTerminalF0 y) f = cong fst (isLimConeF0 _ (toCone y) .snd (_ , toConeMor y f)) + + snd (L→P isSheafF) x y = LimAsPullback .univProp + where + xyVec : FinVec (fst L) 2 + xyVec zero = y + xyVec one = x + + inducedLimCone : LimCone (funcComp F (FinVec→Diag L xyVec)) + lim inducedLimCone = F .F-ob (⋁ xyVec) + limCone inducedLimCone = F-cone F (⋁Cone L xyVec) + univProp inducedLimCone = isSheafF 2 xyVec + + theCone : Cone (funcComp F (FinVec→Diag L xyVec)) (F .F-ob (x ∨l y)) + coneOut (theCone) (sing zero) = F .F-hom (hom-∨₂ x y) + coneOut (theCone) (sing one) = F .F-hom (hom-∨₁ x y) + coneOut (theCone) (pair zero zero ()) + coneOut (theCone) (pair zero one (s≤s z≤)) = + F .F-hom (hom-∨₂ x y) ⋆⟨ C ⟩ F .F-hom (hom-∧₂ x y) + coneOut (theCone) (pair one zero ()) + coneOut (theCone) (pair one one (s≤s ())) + coneOut (theCone) (pair (suc (suc _)) one (s≤s ())) + coneOutCommutes (theCone) {u = u} idAr = + cong (seq' C (coneOut (theCone) u)) (F .F-id) ∙ ⋆IdR C _ + coneOutCommutes (theCone) (singPairL {zero} {zero} {()}) + coneOutCommutes (theCone) (singPairL {zero} {one} {s≤s z≤}) = refl + coneOutCommutes (theCone) (singPairL {one} {zero} {()}) + coneOutCommutes (theCone) (singPairL {one} {one} {s≤s ()}) + coneOutCommutes (theCone) (singPairL {suc (suc _)} {one} {s≤s ()}) + coneOutCommutes (theCone) (singPairR {zero} {zero} {()}) + coneOutCommutes (theCone) (singPairR {zero} {one} {s≤s z≤}) = sym (Fsq x y F) + coneOutCommutes (theCone) (singPairR {one} {zero} {()}) + coneOutCommutes (theCone) (singPairR {one} {one} {s≤s ()}) + coneOutCommutes (theCone) (singPairR {suc (suc _)} {one} {s≤s ()}) + + theLimCone : LimCone (funcComp F (FinVec→Diag L xyVec)) + lim theLimCone = _ + limCone theLimCone = theCone + univProp theLimCone = + transport (λ i → isLimCone _ (limPath i) (limConePathP i)) (univProp inducedLimCone) + where + xyPath : ⋁ xyVec ≡ x ∨l y + xyPath = cong (y ∨l_) (∨lRid x) ∙ ∨lComm _ _ + + limPath : lim inducedLimCone ≡ lim theLimCone + limPath = cong (F .F-ob) xyPath + + limConePathP : PathP (λ i → Cone (funcComp F (FinVec→Diag L xyVec)) (limPath i)) + (limCone inducedLimCone) theCone + limConePathP = conePathPOb helperPathP + where + helperPathP : + ∀ v → PathP (λ i → C [ limPath i , F-ob (funcComp F (FinVec→Diag L xyVec)) v ]) + (coneOut (limCone inducedLimCone) v) (coneOut theCone v) + helperPathP (sing zero) = F≤PathPLemma xyPath refl (ind≤⋁ xyVec zero) (hom-∨₂ x y) + helperPathP (sing one) = F≤PathPLemma xyPath refl (ind≤⋁ xyVec one) (hom-∨₁ x y) + helperPathP (pair zero zero ()) + helperPathP (pair zero one (s≤s z≤)) = + subst (λ f → PathP (λ i → C [ limPath i , F .F-ob (x ∧l y) ]) + (coneOut (limCone inducedLimCone) (pair zero one (s≤s z≤))) f) + (F-seq F _ _) helperHelperPathP + where + helperHelperPathP : PathP (λ i → C [ limPath i , F .F-ob (x ∧l y) ]) + (coneOut (limCone inducedLimCone) (pair zero one (s≤s z≤))) + (F .F-hom (hom-∨₂ x y ⋆⟨ (DLCat ^op) ⟩ hom-∧₂ x y)) + helperHelperPathP = F≤PathPLemma xyPath refl + (is-trans _ (xyVec zero) _ (≤m→≤j _ _ (∧≤LCancel _ _)) (ind≤⋁ xyVec zero)) + (hom-∨₂ x y ⋆⟨ (DLCat ^op) ⟩ hom-∧₂ x y) + helperPathP (pair one zero ()) + helperPathP (pair one one (s≤s ())) + helperPathP (pair (suc (suc _)) one (s≤s ())) + open DLShfDiagsAsPullbacks C _ theLimCone + + + --the other direction + P→L : isDLSheafPullback F → isDLSheaf F + fst (fst (P→L (isTerminalF0 , _) ℕ.zero α c cc)) = isTerminalF0 c .fst + snd (fst (P→L (isTerminalF0 , _) ℕ.zero α c cc)) (sing ()) + snd (fst (P→L (isTerminalF0 , _) ℕ.zero α c cc)) (pair () _ _) + snd (P→L (isTerminalF0 , _) ℕ.zero α c cc) _ = + Σ≡Prop (isPropIsConeMor _ _) (isTerminalF0 c .snd _) + + P→L (F0=1 , presPBSq) (ℕ.suc n) α c cc = uniqueExists + (uniqH .fst .fst) + (toIsConeMor (uniqH .fst .fst) (uniqH .fst .snd)) + (λ _ → isPropIsConeMor _ _ _) + λ h' isConeMorH' → cong fst (uniqH .snd (h' , fromIsConeMor h' isConeMorH')) + where + β : FinVec (fst L) n + β i = α (suc i) ∧l α zero + + αβPath : (α zero) ∧l ⋁ (α ∘ suc) ≡ ⋁ β + αβPath = ∧lComm _ _ ∙ ⋁Meetldist (α zero) (α ∘ suc) + + -- the square we want + theCospan : Cospan C + l theCospan = F .F-ob (⋁ (α ∘ suc)) + m theCospan = F .F-ob (⋁ β) + r theCospan = F .F-ob (α zero) + s₁ theCospan = F .F-hom (≤-⋁Ext _ _ λ _ → hom-∧₁ _ _) + s₂ theCospan = F .F-hom (⋁IsMax _ _ λ _ → hom-∧₂ _ _) + + thePB : Pullback C theCospan + pbOb thePB = F .F-ob (⋁ α) + pbPr₁ thePB = F .F-hom (hom-∨₂ _ _) + pbPr₂ thePB = F .F-hom (hom-∨₁ _ _) + pbCommutes thePB = F-square F (is-prop-valued _ _ _ _) + univProp thePB f g square = presPBSq (α zero) (⋁ (α ∘ suc)) f g squarePath + where + squarePath : f ⋆⟨ C ⟩ F .F-hom (hom-∧₂ _ _) ≡ g ⋆⟨ C ⟩ F .F-hom (hom-∧₁ _ _) + squarePath = transport + (λ i → f ⋆⟨ C ⟩ F≤PathPLemma refl αβPath + (hom-∧₂ _ _) (≤-⋁Ext _ _ λ _ → hom-∧₁ _ _) (~ i) + ≡ g ⋆⟨ C ⟩ F≤PathPLemma refl αβPath + (hom-∧₁ _ _) (⋁IsMax _ _ λ _ → hom-∧₂ _ _) (~ i)) + square + + -- the two induced cones on which we use the ind. hyp. + ccSuc : Cone (funcComp F (FinVec→Diag L (α ∘ suc))) c + coneOut ccSuc (sing i) = coneOut cc (sing (suc i)) + coneOut ccSuc (pair i j i<j) = coneOut cc (pair (suc i) (suc j) (s≤s i<j)) + coneOutCommutes ccSuc {sing _} idAr = coneOutCommutes cc idAr + coneOutCommutes ccSuc {pair _ _ _} idAr = coneOutCommutes cc idAr + coneOutCommutes ccSuc singPairL = coneOutCommutes cc singPairL + coneOutCommutes ccSuc singPairR = coneOutCommutes cc singPairR + + cc∧Suc : Cone (funcComp F (FinVec→Diag L β)) c + coneOut cc∧Suc (sing i) = coneOut cc (pair zero (suc i) (s≤s z≤)) + coneOut cc∧Suc (pair i j i<j) = coneOut cc (pair (suc i) (suc j) (s≤s i<j)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _))) + --(αⱼ ∧ αᵢ) ≥ (αⱼ ∧ α₀) ∧ (αᵢ ∧ α₀) + coneOutCommutes cc∧Suc idAr = + cong (seq' C (coneOut cc∧Suc _)) ((funcComp F (FinVec→Diag L β)) .F-id) ∙ ⋆IdR C _ + coneOutCommutes cc∧Suc (singPairL {i = i} {j = j} {i<j = i<j}) = + coneOut cc (pair zero (suc i) (s≤s z≤)) + ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairL) + ≡⟨ cong (λ x → seq' C x (funcComp F (FinVec→Diag L β) .F-hom singPairL)) + (sym (coneOutCommutes cc singPairR)) ⟩ + (coneOut cc (sing (suc i)) ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L α) .F-hom singPairR)) + ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairL) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + coneOut cc (sing (suc i)) ⋆⟨ C ⟩ ((funcComp F (FinVec→Diag L α) .F-hom singPairR) + ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairL)) + ≡⟨ cong (λ x → coneOut cc (sing (suc i)) ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ + coneOut cc (sing (suc i)) ⋆⟨ C ⟩ F .F-hom + ((FinVec→Diag L α) .F-hom (singPairR {i<j = s≤s z≤}) + ⋆⟨ DLCat ^op ⟩ (FinVec→Diag L β) .F-hom (singPairL {i<j = i<j})) + ≡⟨ cong (λ x → coneOut cc (sing (suc i)) ⋆⟨ C ⟩ F .F-hom x) + (is-prop-valued _ _ _ _) ⟩ + coneOut cc (sing (suc i)) ⋆⟨ C ⟩ F .F-hom + ((FinVec→Diag L α) .F-hom (singPairL {i<j = s≤s i<j}) + ⋆⟨ DLCat ^op ⟩ (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) + ≡⟨ cong (λ x → coneOut cc (sing (suc i)) ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ + coneOut cc (sing (suc i)) ⋆⟨ C ⟩ ((funcComp F (FinVec→Diag L α) .F-hom singPairL) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (coneOut cc (sing (suc i)) ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L α) .F-hom singPairL)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _))) + ≡⟨ cong + (λ x → x ⋆⟨ C ⟩ F .F-hom + (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) + (coneOutCommutes cc singPairL) ⟩ + coneOut cc (pair (suc i) (suc j) (s≤s i<j)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _))) ∎ + + coneOutCommutes cc∧Suc (singPairR {i = i} {j = j} {i<j = i<j}) = + coneOut cc (pair zero (suc j) (s≤s z≤)) + ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairR) + ≡⟨ cong (λ x → seq' C x (funcComp F (FinVec→Diag L β) .F-hom singPairR)) + (sym (coneOutCommutes cc singPairR)) ⟩ + (coneOut cc (sing (suc j)) ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L α) .F-hom singPairR)) + ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairR) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + coneOut cc (sing (suc j)) ⋆⟨ C ⟩ ((funcComp F (FinVec→Diag L α) .F-hom singPairR) + ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L β) .F-hom singPairR)) + ≡⟨ cong (λ x → coneOut cc (sing (suc j)) ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ + coneOut cc (sing (suc j)) ⋆⟨ C ⟩ F .F-hom + ((FinVec→Diag L α) .F-hom (singPairR {i<j = s≤s z≤}) + ⋆⟨ DLCat ^op ⟩ (FinVec→Diag L β) .F-hom (singPairR {i<j = i<j})) + ≡⟨ cong (λ x → coneOut cc (sing (suc j)) ⋆⟨ C ⟩ F .F-hom x) + (is-prop-valued _ _ _ _) ⟩ + coneOut cc (sing (suc j)) ⋆⟨ C ⟩ F .F-hom + ((FinVec→Diag L α) .F-hom (singPairR {i<j = s≤s i<j}) + ⋆⟨ DLCat ^op ⟩ (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) + ≡⟨ cong (λ x → coneOut cc (sing (suc j)) ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ + coneOut cc (sing (suc j)) ⋆⟨ C ⟩ ((funcComp F (FinVec→Diag L α) .F-hom singPairR) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (coneOut cc (sing (suc j)) ⋆⟨ C ⟩ (funcComp F (FinVec→Diag L α) .F-hom singPairR)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _))) + ≡⟨ cong + (λ x → x ⋆⟨ C ⟩ F .F-hom + (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _)))) + (coneOutCommutes cc singPairR) ⟩ + coneOut cc (pair (suc i) (suc j) (s≤s i<j)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤RCancel _ _) (∧≤RCancel _ _))) ∎ + + + -- our morphisms: + f : C [ c , F .F-ob (α zero) ] + f = coneOut cc (sing zero) + + g : C [ c , F .F-ob (⋁ (α ∘ suc)) ] + g = P→L (F0=1 , presPBSq) n (α ∘ suc) c ccSuc .fst .fst + + k = g ⋆⟨ C ⟩ s₁ theCospan + o = f ⋆⟨ C ⟩ s₂ theCospan + + isConeMorK : isConeMor cc∧Suc (F-cone F (⋁Cone L β)) k + isConeMorK = isConeMorSingLemma cc∧Suc (F-cone F (⋁Cone L β)) singCase + where + singCase : ∀ i → k ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L β)) (sing i)) + ≡ coneOut cc∧Suc (sing i) + singCase i = + (g ⋆⟨ C ⟩ s₁ theCospan) ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L β)) (sing i)) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + g ⋆⟨ C ⟩ (s₁ theCospan ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L β)) (sing i))) + ≡⟨ cong (λ x → g ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ + g ⋆⟨ C ⟩ F .F-hom + ((≤-⋁Ext _ _ λ _ → hom-∧₁ _ _) ⋆⟨ DLCat ^op ⟩ coneOut (⋁Cone L β) (sing i)) + ≡⟨ cong (λ x → g ⋆⟨ C ⟩ F .F-hom x) (is-prop-valued _ _ _ _) ⟩ + g ⋆⟨ C ⟩ F .F-hom (coneOut (⋁Cone L (α ∘ suc)) (sing i) + ⋆⟨ DLCat ^op ⟩ (FinVec→Diag L α) .F-hom (singPairR{i<j = s≤s z≤}) ) + ≡⟨ cong (λ x → g ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ + g ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L (α ∘ suc))) (sing i) + ⋆⟨ C ⟩ funcComp F (FinVec→Diag L α) .F-hom singPairR) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (g ⋆⟨ C ⟩ coneOut (F-cone F (⋁Cone L (α ∘ suc))) (sing i)) + ⋆⟨ C ⟩ funcComp F (FinVec→Diag L α) .F-hom singPairR + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ funcComp F (FinVec→Diag L α) .F-hom singPairR) + (P→L (F0=1 , presPBSq) n (α ∘ suc) c ccSuc .fst .snd (sing i)) ⟩ + coneOut cc (sing (suc i)) ⋆⟨ C ⟩ funcComp F (FinVec→Diag L α) .F-hom singPairR + ≡⟨ coneOutCommutes cc singPairR ⟩ + coneOut cc (pair zero (suc i) (s≤s z≤)) ∎ + + + + isConeMorO : isConeMor cc∧Suc (F-cone F (⋁Cone L β)) o + isConeMorO = isConeMorSingLemma cc∧Suc (F-cone F (⋁Cone L β)) singCase + where + singCase : ∀ i → o ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L β)) (sing i)) + ≡ coneOut cc∧Suc (sing i) + singCase i = + o ⋆⟨ C ⟩ (F .F-hom (ind≤⋁ β i)) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + f ⋆⟨ C ⟩ (s₂ theCospan ⋆⟨ C ⟩ (F .F-hom (ind≤⋁ β i))) + ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ + f ⋆⟨ C ⟩ F .F-hom ((⋁IsMax _ _ λ _ → hom-∧₂ _ _) ⋆⟨ DLCat ^op ⟩ ind≤⋁ β i) + ≡⟨ cong (λ x → f ⋆⟨ C ⟩ F .F-hom x) (is-prop-valued _ _ _ _) ⟩ + f ⋆⟨ C ⟩ funcComp F (FinVec→Diag L α) .F-hom singPairL + ≡⟨ coneOutCommutes cc singPairL ⟩ + coneOut cc (pair zero (suc i) (s≤s z≤)) ∎ + + fgSquare : g ⋆⟨ C ⟩ s₁ theCospan ≡ f ⋆⟨ C ⟩ s₂ theCospan + fgSquare = cong fst (isContr→isProp (P→L (F0=1 , presPBSq) n β c cc∧Suc) + (k , isConeMorK) (o , isConeMorO)) + + uniqH : ∃![ h ∈ C [ c , F .F-ob (⋁ α) ] ] + (g ≡ h ⋆⟨ C ⟩ pbPr₁ thePB) × (f ≡ h ⋆⟨ C ⟩ pbPr₂ thePB) + uniqH = univProp thePB _ _ fgSquare + + toIsConeMor : ∀ (h : C [ c , F .F-ob (⋁ α) ]) + → (g ≡ h ⋆⟨ C ⟩ pbPr₁ thePB) × (f ≡ h ⋆⟨ C ⟩ pbPr₂ thePB) + → isConeMor cc (F-cone F (⋁Cone L α)) h + toIsConeMor h (gTriangle , fTriangle) = isConeMorSingLemma cc (F-cone F (⋁Cone L α)) singCase + where + singCase : ∀ i → h ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L α)) (sing i)) + ≡ coneOut cc (sing i) + singCase zero = sym fTriangle + singCase (suc i) = + h ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L α)) (sing (suc i))) + ≡⟨ cong (λ x → seq' C h (F .F-hom x)) (is-prop-valued _ _ _ _) ⟩ + h ⋆⟨ C ⟩ F .F-hom (hom-∨₂ _ _ ⋆⟨ DLCat ^op ⟩ ⋁Cone L (α ∘ suc) .coneOut (sing i)) + ≡⟨ cong (seq' C h) (F .F-seq _ _) ⟩ + h ⋆⟨ C ⟩ (pbPr₁ thePB ⋆⟨ C ⟩ F .F-hom (⋁Cone L (α ∘ suc) .coneOut (sing i))) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (h ⋆⟨ C ⟩ pbPr₁ thePB) ⋆⟨ C ⟩ F .F-hom (⋁Cone L (α ∘ suc) .coneOut (sing i)) + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ (F .F-hom (⋁Cone L (α ∘ suc) .coneOut (sing i)))) + (sym gTriangle) ⟩ + g ⋆⟨ C ⟩ F .F-hom (⋁Cone L (α ∘ suc) .coneOut (sing i)) + ≡⟨ P→L (F0=1 , presPBSq) n (α ∘ suc) c ccSuc .fst .snd (sing i) ⟩ + coneOut cc (sing (suc i)) ∎ + + fromIsConeMor : ∀ (h : C [ c , F .F-ob (⋁ α) ]) + → isConeMor cc (F-cone F (⋁Cone L α)) h + → (g ≡ h ⋆⟨ C ⟩ pbPr₁ thePB) × (f ≡ h ⋆⟨ C ⟩ pbPr₂ thePB) + fst (fromIsConeMor h isConeMorH) = + cong fst (P→L (F0=1 , presPBSq) n (α ∘ suc) c ccSuc .snd (s , isConeMorS)) + where + s = h ⋆⟨ C ⟩ pbPr₁ thePB + isConeMorS : isConeMor ccSuc (F-cone F (⋁Cone L (α ∘ suc))) s + isConeMorS = isConeMorSingLemma ccSuc (F-cone F (⋁Cone L (α ∘ suc))) singCase + where + singCase : ∀ i → s ⋆⟨ C ⟩ (coneOut (F-cone F (⋁Cone L (α ∘ suc))) (sing i)) + ≡ coneOut ccSuc (sing i) + singCase i = + (h ⋆⟨ C ⟩ pbPr₁ thePB) ⋆⟨ C ⟩ (F .F-hom (ind≤⋁ (α ∘ suc) i)) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + h ⋆⟨ C ⟩ (pbPr₁ thePB ⋆⟨ C ⟩ (F .F-hom (ind≤⋁ (α ∘ suc) i))) + ≡⟨ cong (seq' C h) (sym (F .F-seq _ _)) ⟩ + h ⋆⟨ C ⟩ F .F-hom (hom-∨₂ _ _ ⋆⟨ DLCat ^op ⟩ ind≤⋁ (α ∘ suc) i) + ≡⟨ cong (λ x → seq' C h (F .F-hom x)) (is-prop-valued _ _ _ _) ⟩ + h ⋆⟨ C ⟩ coneOut (F-cone F (⋁Cone L α)) (sing (suc i)) + ≡⟨ isConeMorH (sing (suc i)) ⟩ + coneOut cc (sing (suc i)) ∎ + + snd (fromIsConeMor h isConeMorH) = sym (isConeMorH (sing zero)) + + + + + +module SheafOnBasis (L : DistLattice ℓ) (C : Category ℓ' ℓ'') + (L' : ℙ (fst L)) (hB : IsBasis L L') where + + open Category + open Functor + + open DistLatticeStr ⦃...⦄ + open SemilatticeStr ⦃...⦄ + open IsBasis hB + + private + DLCat = DistLatticeCategory L + BasisCat = ΣPropCat DLCat L' + DLBasisPreSheaf = Functor (BasisCat ^op) C + + instance + _ = snd L + _ = snd (Basis→MeetSemilattice L L' hB) + + + module condSquare (x y : ob BasisCat) (x∨y∈L' : fst x ∨l fst y ∈ L') where + + private + x∨y : ob BasisCat -- = Σ[ x ∈ L ] (x ∈ L') + x∨y = fst x ∨l fst y , x∨y∈L' + + {- x ∧ y ----→ x | | | sq | @@ -509,13 +509,13 @@ but as a square in BasisCat -} - Bsq : seq' BasisCat {x = x · y} {y = y} {z = x∨y} (hom-∧₂ L C (fst x) (fst y)) - (hom-∨₂ L C (fst x) (fst y)) - ≡ seq' BasisCat {x = x · y} {y = x} {z = x∨y} (hom-∧₁ L C (fst x) (fst y)) - (hom-∨₁ L C (fst x) (fst y)) - Bsq = sq L C (fst x) (fst y) + Bsq : seq' BasisCat {x = x · y} {y = y} {z = x∨y} (hom-∧₂ L C (fst x) (fst y)) + (hom-∨₂ L C (fst x) (fst y)) + ≡ seq' BasisCat {x = x · y} {y = x} {z = x∨y} (hom-∧₁ L C (fst x) (fst y)) + (hom-∨₁ L C (fst x) (fst y)) + Bsq = sq L C (fst x) (fst y) - {- + {- F(x ∨ y) ----→ F(x) | | | Fsq | @@ -524,102 +524,102 @@ square in C but now F is only presheaf on BasisCat -} - BFsq : (F : DLBasisPreSheaf) - → seq' C {x = F .F-ob x∨y} {y = F .F-ob y} {z = F .F-ob (x · y)} - (F .F-hom (hom-∨₂ L C (fst x) (fst y))) - (F .F-hom (hom-∧₂ L C (fst x) (fst y))) - ≡ seq' C {x = F .F-ob x∨y} {y = F .F-ob x} {z = F .F-ob (x · y)} - (F .F-hom (hom-∨₁ L C (fst x) (fst y))) - (F .F-hom (hom-∧₁ L C (fst x) (fst y))) - BFsq F = F-square F Bsq - - - -- On a basis this is weaker than the definition below! - isDLBasisSheafPullback : DLBasisPreSheaf → Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'') - isDLBasisSheafPullback F = ((0∈L' : 0l ∈ L') → isTerminal C (F .F-ob (0l , 0∈L'))) - × ((x y : ob BasisCat) (x∨y∈L' : fst x ∨l fst y ∈ L') - → isPullback C _ _ _ (BFsq x y x∨y∈L' F)) - where open condSquare - - isPropIsDLBasisSheafPullback : ∀ F → isProp (isDLBasisSheafPullback F) - isPropIsDLBasisSheafPullback F = - isProp× (isPropΠ (λ _ → isPropIsTerminal _ _)) - (isPropΠ3 λ x y x∨y∈L' → isPropIsPullback _ _ _ _ (BFsq x y x∨y∈L' F)) - where open condSquare - - DLBasisSheafPullback : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'') - DLBasisSheafPullback = Σ[ F ∈ DLBasisPreSheaf ] isDLBasisSheafPullback F - - - -- the correct defintion - open Join L - module condCone {n : ℕ} (α : FinVec (ob BasisCat) n) where - open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L)) - open PosetStr (IndPoset .snd) hiding (_≤_) - open MeetSemilattice (Lattice→MeetSemilattice (DistLattice→Lattice L)) - using (∧≤RCancel ; ∧≤LCancel) - open Order (DistLattice→Lattice L) - open Cone - - BDiag : Functor (DLShfDiag n ℓ) (BasisCat ^op) - F-ob BDiag (sing i) = α i - F-ob BDiag (pair i j _) = α i · α j -- α i ∧ α j + basis is closed under ∧ - F-hom BDiag idAr = is-refl _ - F-hom BDiag singPairL = ≤m→≤j _ _ (∧≤RCancel _ _) - F-hom BDiag singPairR = ≤m→≤j _ _ (∧≤LCancel _ _) - F-id BDiag = is-prop-valued _ _ _ _ - F-seq BDiag _ _ = is-prop-valued _ _ _ _ - - module _ (⋁α∈L' : ⋁ (λ i → α i .fst) ∈ L') where - private - α' : FinVec (fst L) n - α' i = α i .fst - ⋁α : ob BasisCat - ⋁α = ⋁ α' , ⋁α∈L' - - B⋁Cone : Cone BDiag ⋁α - coneOut B⋁Cone (sing i) = ind≤⋁ α' i - coneOut B⋁Cone (pair i _ _) = is-trans _ (α' i) _ (≤m→≤j _ _ (∧≤RCancel _ _)) - (ind≤⋁ α' i) - coneOutCommutes B⋁Cone _ = is-prop-valued _ _ _ _ - - - isDLBasisSheaf : DLBasisPreSheaf → Type _ - isDLBasisSheaf F = ∀ {n : ℕ} (α : FinVec (ob BasisCat) n) - (⋁α∈L' : ⋁ (λ i → α i .fst) ∈ L') - → isLimCone _ _ (F-cone F (B⋁Cone α ⋁α∈L')) - where open condCone - - isPropIsDLBasisSheaf : ∀ F → isProp (isDLBasisSheaf F) - isPropIsDLBasisSheaf F = isPropImplicitΠ (λ _ → isPropΠ2 λ _ _ → isPropIsLimCone _ _ _) - - isDLBasisSheafProp : ℙ DLBasisPreSheaf - isDLBasisSheafProp F = isDLBasisSheaf F , isPropIsDLBasisSheaf F - - DLBasisSheaf→Terminal : ∀ (F : DLBasisPreSheaf) - → isDLBasisSheaf F - → ∀ (0∈L' : 0l ∈ L') → isTerminal C (F .F-ob (0l , 0∈L')) - DLBasisSheaf→Terminal F isSheafF 0∈L' = isTerminalF0 - where - open Cone - open condCone {n = 0} (λ ()) - emptyCone = B⋁Cone 0∈L' - - isLimConeF0 : isLimCone _ (F .F-ob (0l , 0∈L')) (F-cone F emptyCone) - isLimConeF0 = isSheafF (λ ()) 0∈L' - - toCone : (y : ob C) → Cone (funcComp F BDiag) y - coneOut (toCone y) (sing ()) - coneOut (toCone y) (pair () _ _) - coneOutCommutes (toCone y) {u = sing ()} idAr - coneOutCommutes (toCone y) {u = pair () _ _} idAr - - toConeMor : ∀ (y : ob C) (f : C [ y , F .F-ob (0l , 0∈L') ]) - → isConeMor (toCone y) (F-cone F emptyCone) f - toConeMor y f (sing ()) - toConeMor y f (pair () _ _) - - isTerminalF0 : isTerminal C (F .F-ob (0l , 0∈L')) - fst (isTerminalF0 y) = isLimConeF0 _ (toCone y) .fst .fst - snd (isTerminalF0 y) f = cong fst (isLimConeF0 _ (toCone y) .snd (_ , toConeMor y f)) + BFsq : (F : DLBasisPreSheaf) + → seq' C {x = F .F-ob x∨y} {y = F .F-ob y} {z = F .F-ob (x · y)} + (F .F-hom (hom-∨₂ L C (fst x) (fst y))) + (F .F-hom (hom-∧₂ L C (fst x) (fst y))) + ≡ seq' C {x = F .F-ob x∨y} {y = F .F-ob x} {z = F .F-ob (x · y)} + (F .F-hom (hom-∨₁ L C (fst x) (fst y))) + (F .F-hom (hom-∧₁ L C (fst x) (fst y))) + BFsq F = F-square F Bsq + + + -- On a basis this is weaker than the definition below! + isDLBasisSheafPullback : DLBasisPreSheaf → Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'') + isDLBasisSheafPullback F = ((0∈L' : 0l ∈ L') → isTerminal C (F .F-ob (0l , 0∈L'))) + × ((x y : ob BasisCat) (x∨y∈L' : fst x ∨l fst y ∈ L') + → isPullback C _ _ _ (BFsq x y x∨y∈L' F)) + where open condSquare + + isPropIsDLBasisSheafPullback : ∀ F → isProp (isDLBasisSheafPullback F) + isPropIsDLBasisSheafPullback F = + isProp× (isPropΠ (λ _ → isPropIsTerminal _ _)) + (isPropΠ3 λ x y x∨y∈L' → isPropIsPullback _ _ _ _ (BFsq x y x∨y∈L' F)) + where open condSquare + + DLBasisSheafPullback : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'') + DLBasisSheafPullback = Σ[ F ∈ DLBasisPreSheaf ] isDLBasisSheafPullback F + + + -- the correct defintion + open Join L + module condCone {n : ℕ} (α : FinVec (ob BasisCat) n) where + open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L)) + open PosetStr (IndPoset .snd) hiding (_≤_) + open MeetSemilattice (Lattice→MeetSemilattice (DistLattice→Lattice L)) + using (∧≤RCancel ; ∧≤LCancel) + open Order (DistLattice→Lattice L) + open Cone + + BDiag : Functor (DLShfDiag n ℓ) (BasisCat ^op) + F-ob BDiag (sing i) = α i + F-ob BDiag (pair i j _) = α i · α j -- α i ∧ α j + basis is closed under ∧ + F-hom BDiag idAr = is-refl _ + F-hom BDiag singPairL = ≤m→≤j _ _ (∧≤RCancel _ _) + F-hom BDiag singPairR = ≤m→≤j _ _ (∧≤LCancel _ _) + F-id BDiag = is-prop-valued _ _ _ _ + F-seq BDiag _ _ = is-prop-valued _ _ _ _ + + module _ (⋁α∈L' : ⋁ (λ i → α i .fst) ∈ L') where + private + α' : FinVec (fst L) n + α' i = α i .fst + ⋁α : ob BasisCat + ⋁α = ⋁ α' , ⋁α∈L' + + B⋁Cone : Cone BDiag ⋁α + coneOut B⋁Cone (sing i) = ind≤⋁ α' i + coneOut B⋁Cone (pair i _ _) = is-trans _ (α' i) _ (≤m→≤j _ _ (∧≤RCancel _ _)) + (ind≤⋁ α' i) + coneOutCommutes B⋁Cone _ = is-prop-valued _ _ _ _ + + + isDLBasisSheaf : DLBasisPreSheaf → Type _ + isDLBasisSheaf F = ∀ {n : ℕ} (α : FinVec (ob BasisCat) n) + (⋁α∈L' : ⋁ (λ i → α i .fst) ∈ L') + → isLimCone _ _ (F-cone F (B⋁Cone α ⋁α∈L')) + where open condCone + + isPropIsDLBasisSheaf : ∀ F → isProp (isDLBasisSheaf F) + isPropIsDLBasisSheaf F = isPropImplicitΠ (λ _ → isPropΠ2 λ _ _ → isPropIsLimCone _ _ _) + + isDLBasisSheafProp : ℙ DLBasisPreSheaf + isDLBasisSheafProp F = isDLBasisSheaf F , isPropIsDLBasisSheaf F + + DLBasisSheaf→Terminal : ∀ (F : DLBasisPreSheaf) + → isDLBasisSheaf F + → ∀ (0∈L' : 0l ∈ L') → isTerminal C (F .F-ob (0l , 0∈L')) + DLBasisSheaf→Terminal F isSheafF 0∈L' = isTerminalF0 + where + open Cone + open condCone {n = 0} (λ ()) + emptyCone = B⋁Cone 0∈L' + + isLimConeF0 : isLimCone _ (F .F-ob (0l , 0∈L')) (F-cone F emptyCone) + isLimConeF0 = isSheafF (λ ()) 0∈L' + + toCone : (y : ob C) → Cone (funcComp F BDiag) y + coneOut (toCone y) (sing ()) + coneOut (toCone y) (pair () _ _) + coneOutCommutes (toCone y) {u = sing ()} idAr + coneOutCommutes (toCone y) {u = pair () _ _} idAr + + toConeMor : ∀ (y : ob C) (f : C [ y , F .F-ob (0l , 0∈L') ]) + → isConeMor (toCone y) (F-cone F emptyCone) f + toConeMor y f (sing ()) + toConeMor y f (pair () _ _) + + isTerminalF0 : isTerminal C (F .F-ob (0l , 0∈L')) + fst (isTerminalF0 y) = isLimConeF0 _ (toCone y) .fst .fst + snd (isTerminalF0 y) f = cong fst (isLimConeF0 _ (toCone y) .snd (_ , toConeMor y f)) \ No newline at end of file diff --git a/Cubical.Categories.DistLatticeSheaf.ComparisonLemma.html b/Cubical.Categories.DistLatticeSheaf.ComparisonLemma.html index 58d08312ad..a7bb9d0fd3 100644 --- a/Cubical.Categories.DistLatticeSheaf.ComparisonLemma.html +++ b/Cubical.Categories.DistLatticeSheaf.ComparisonLemma.html @@ -27,432 +27,432 @@ open import Cubical.Data.FinData.Order open import Cubical.Data.Sum -open import Cubical.Relation.Binary.Poset -open import Cubical.HITs.PropositionalTruncation as PT - -open import Cubical.Algebra.Semilattice -open import Cubical.Algebra.Lattice -open import Cubical.Algebra.DistLattice -open import Cubical.Algebra.DistLattice.Basis -open import Cubical.Algebra.DistLattice.BigOps - -open import Cubical.Categories.Category.Base -open import Cubical.Categories.Morphism -open import Cubical.Categories.Functor -open import Cubical.Categories.NaturalTransformation -open import Cubical.Categories.Adjoint -open import Cubical.Categories.Equivalence -open import Cubical.Categories.Limits.Limits -open import Cubical.Categories.Limits.Pullback -open import Cubical.Categories.Limits.Terminal -open import Cubical.Categories.Limits.RightKan -open import Cubical.Categories.Instances.Poset -open import Cubical.Categories.Instances.Semilattice -open import Cubical.Categories.Instances.Lattice -open import Cubical.Categories.Instances.DistLattice -open import Cubical.Categories.Instances.Functors - -open import Cubical.Categories.DistLatticeSheaf.Diagram -open import Cubical.Categories.DistLatticeSheaf.Base -open import Cubical.Categories.DistLatticeSheaf.Extension - - -private - variable - ℓ ℓ' ℓ'' : Level - -module _ (L : DistLattice ℓ) (C : Category ℓ' ℓ'') (limitC : Limits {ℓ} {ℓ} C) - (B : ℙ (fst L)) (isBasisB : IsBasis L B) where - - - open Category hiding (_∘_) - open Functor - open NatTrans - open Cone - open LimCone - open SheafOnBasis L C B isBasisB - open PreSheafExtension L C limitC B - - open DistLatticeStr ⦃...⦄ - open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L)) - open PosetStr (IndPoset .snd) hiding (_≤_) - open Join L - open Order (DistLattice→Lattice L) - open MeetSemilattice (Lattice→MeetSemilattice (DistLattice→Lattice L)) - using (∧≤RCancel ; ∧≤LCancel) - private - instance - _ = snd L - - Lᵒᵖ = DistLatticeCategory L ^op - Bᵒᵖ = ΣPropCat (DistLatticeCategory L) B ^op - - SheafB = ΣPropCat (FUNCTOR Bᵒᵖ C) isDLBasisSheafProp - SheafL = ΣPropCat (FUNCTOR Lᵒᵖ C) (isDLSheafProp L C) - - i = baseIncl ^opF - - restPresSheafProp : ∀ (F : Functor Lᵒᵖ C) → isDLSheaf L C F → isDLBasisSheaf (F ∘F i) - restPresSheafProp F isSheafF α ⋁α∈B = - transport (λ i → isLimCone (diagPath i) (F .F-ob (⋁ α')) (limConesPathP i)) (isSheafF _ α') - where - open condCone α - - α' : FinVec (fst L) _ - α' i = α i .fst - - diagPath : F ∘F (FinVec→Diag L α') ≡ (F ∘F i) ∘F BDiag - diagPath = Functor≡ diagPathOb diagPathHom - where - diagPathOb : ∀ c → (F ∘F (FinVec→Diag L α')) .F-ob c ≡ ((F ∘F i) ∘F BDiag) .F-ob c - diagPathOb (sing i) = refl - diagPathOb (pair i j i<j) = cong (F .F-ob) (∧lComm _ _) - - diagPathHom : ∀ {c} {d} f → PathP (λ i → C [ diagPathOb c i , diagPathOb d i ]) - ((F ∘F (FinVec→Diag L α')) .F-hom f) - (((F ∘F i) ∘F BDiag) .F-hom f) - diagPathHom {sing i} idAr = refl - diagPathHom {pair i j i<j} idAr = functorCongP {F = F} (toPathP (is-prop-valued _ _ _ _)) - diagPathHom singPairL = functorCongP {F = F} (toPathP (is-prop-valued _ _ _ _)) - diagPathHom singPairR = functorCongP {F = F} (toPathP (is-prop-valued _ _ _ _)) - - limConesPathP : PathP (λ i → Cone (diagPath i) (F .F-ob (⋁ α'))) - (F-cone F (⋁Cone L α')) (F-cone (F ∘F i) (B⋁Cone ⋁α∈B)) - limConesPathP = conePathP limConesPathPOb - where - limConesPathPOb : ∀ c → PathP (λ i → C [ F .F-ob (⋁ α') , diagPath i .F-ob c ]) - (F-cone F (⋁Cone L α') .coneOut c) - (F-cone (F ∘F i) (B⋁Cone ⋁α∈B) .coneOut c) - limConesPathPOb (sing i) = refl - limConesPathPOb (pair i j i<j) = functorCongP {F = F} (toPathP (is-prop-valued _ _ _ _)) - - - --restriction to basis as functor - sheafRestriction : Functor SheafL SheafB - sheafRestriction = ΣPropCatFunc (precomposeF C i) restPresSheafProp - - -- important lemma: a natural transformation between sheaves on L is an - -- iso if the restriction to B is an iso. This will give us that - -- that the unit of the comparison lemma is an iso and thus that - -- restriction of sheaves is fully-faithful - restIsoLemma : (F G : ob SheafL) (α : NatTrans (F .fst) (G .fst)) - → (∀ (u : ob Bᵒᵖ) → isIso C ((α ∘ˡ i) .N-ob u)) - → ∀ (x : ob Lᵒᵖ) → isIso C (α .N-ob x) - restIsoLemma (F , isSheafF) (G , isSheafG) α αiIso x = - PT.rec (isPropIsIso _) basisHyp (isBasisB .⋁Basis x) - where - Fi = F ∘F i - Gi = G ∘F i - open NatIso - αiNatIso : NatIso Fi Gi - trans αiNatIso = α ∘ˡ i - nIso αiNatIso = αiIso - - open IsBasis - basisHyp : Σ[ n ∈ ℕ ] Σ[ u ∈ FinVec (L .fst) n ] (∀ j → u j ∈ B) × (⋁ u ≡ x) - → isIso C (α .N-ob x) - basisHyp (n , u , u∈B , ⋁u≡x) = transport (λ i → isIso C (q i)) (subst (isIso C) p αᵤ'IsIso) - where - open isIso - - FLimCone = isDLSheafLimCone L C F isSheafF n u - GLimCone = isDLSheafLimCone L C G isSheafG n u - - uᴮ : FinVec (Bᵒᵖ .ob) n - uᴮ i = u i , u∈B i - - uᴮDiag = condCone.BDiag uᴮ - - αi⁻¹ : (v : ob Bᵒᵖ) → C [ Gi .F-ob v , Fi .F-ob v ] - αi⁻¹ v = αiIso v .inv - - σ : NatTrans (F ∘F (FinVec→Diag L u)) (G ∘F (FinVec→Diag L u)) - N-ob σ = α .N-ob ∘ FinVec→Diag L u .F-ob - N-hom σ = α .N-hom ∘ FinVec→Diag L u .F-hom - - open SemilatticeStr ⦃...⦄ - instance _ = snd (Basis→MeetSemilattice L B isBasisB) - - σ⁻¹ : NatTrans (G ∘F (FinVec→Diag L u)) (F ∘F (FinVec→Diag L u)) - N-ob σ⁻¹ (sing i) = αi⁻¹ (uᴮDiag .F-ob (sing i)) - N-ob σ⁻¹ (pair i j i<j) = αi⁻¹ ((u j , u∈B j) · (u i , u∈B i)) - -- (uᴮDiag .F-ob (pair i j i<j)) modulo swapping i and j - N-hom σ⁻¹ (idAr {x = v}) = - G .F-hom (id Lᵒᵖ) ⋆⟨ C ⟩ σ⁻¹ .N-ob v ≡⟨ cong (λ f → f ⋆⟨ C ⟩ σ⁻¹ .N-ob v) (G .F-id) ⟩ - id C ⋆⟨ C ⟩ σ⁻¹ .N-ob v ≡⟨ ⋆IdL C _ ⟩ - σ⁻¹ .N-ob v ≡⟨ sym (⋆IdR C _) ⟩ - σ⁻¹ .N-ob v ⋆⟨ C ⟩ id C ≡⟨ cong (λ f → σ⁻¹ .N-ob v ⋆⟨ C ⟩ f) (sym (F .F-id)) ⟩ - σ⁻¹ .N-ob v ⋆⟨ C ⟩ F .F-hom (id Lᵒᵖ) ∎ - N-hom σ⁻¹ (singPairL {i} {j} {i<j}) = transport (λ 𝕚 → p 𝕚 ≡ r 𝕚) q - where - p : PathP (λ 𝕚 → C [ G .F-ob (u i) , F .F-ob (fst (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚)) ]) - (G .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ (uᴮDiag .F-ob (pair i j i<j))) - (G .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ ((u j , u∈B j) · (u i , u∈B i))) - p 𝕚 = G .F-hom (isProp→PathP (λ 𝕚' → is-prop-valued (∧lComm (u i) (u j) 𝕚') (u i)) - (≤m→≤j _ _ (∧≤RCancel _ _)) (≤m→≤j _ _ (∧≤LCancel _ _)) 𝕚) - ⋆⟨ C ⟩ αi⁻¹ (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚) - - q : G .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ (uᴮDiag .F-ob (pair i j i<j)) - ≡ αi⁻¹ (u i , u∈B i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) - q = sqLL αiNatIso - - r : PathP (λ 𝕚 → C [ G .F-ob (u i) , F .F-ob (fst (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚)) ]) - (αi⁻¹ (u i , u∈B i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _))) - (αi⁻¹ (u i , u∈B i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) - r 𝕚 = αi⁻¹ (u i , u∈B i) - ⋆⟨ C ⟩ F .F-hom (isProp→PathP (λ 𝕚' → is-prop-valued (∧lComm (u i) (u j) 𝕚') (u i)) - (≤m→≤j _ _ (∧≤RCancel _ _)) (≤m→≤j _ _ (∧≤LCancel _ _)) 𝕚) - - N-hom σ⁻¹ (singPairR {i} {j} {i<j}) = transport (λ 𝕚 → p 𝕚 ≡ r 𝕚) q - where - p : PathP (λ 𝕚 → C [ G .F-ob (u j) , F .F-ob (fst (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚)) ]) - (G .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ (uᴮDiag .F-ob (pair i j i<j))) - (G .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ ((u j , u∈B j) · (u i , u∈B i))) - p 𝕚 = G .F-hom (isProp→PathP (λ 𝕚' → is-prop-valued (∧lComm (u i) (u j) 𝕚') (u j)) - (≤m→≤j _ _ (∧≤LCancel _ _)) (≤m→≤j _ _ (∧≤RCancel _ _)) 𝕚) - ⋆⟨ C ⟩ αi⁻¹ (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚) - - q : G .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ (uᴮDiag .F-ob (pair i j i<j)) - ≡ αi⁻¹ (u j , u∈B j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - q = sqLL αiNatIso - - r : PathP (λ 𝕚 → C [ G .F-ob (u j) , F .F-ob (fst (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚)) ]) - (αi⁻¹ (u j , u∈B j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) - (αi⁻¹ (u j , u∈B j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _))) - r 𝕚 = αi⁻¹ (u j , u∈B j) - ⋆⟨ C ⟩ F .F-hom (isProp→PathP (λ 𝕚' → is-prop-valued (∧lComm (u i) (u j) 𝕚') (u j)) - (≤m→≤j _ _ (∧≤LCancel _ _)) (≤m→≤j _ _ (∧≤RCancel _ _)) 𝕚) - - -- σ and σ⁻¹ are inverse: - σσ⁻¹≡id : σ ●ᵛ σ⁻¹ ≡ idTrans _ - σσ⁻¹≡id = makeNatTransPath (funExt σσ⁻¹≡idOb) - where - σσ⁻¹≡idOb : ∀ x → σ .N-ob x ⋆⟨ C ⟩ σ⁻¹ .N-ob x ≡ id C - σσ⁻¹≡idOb (sing i) = αiIso (u i , u∈B i) .ret - σσ⁻¹≡idOb (pair i j i<j) = αiIso ((u j , u∈B j) · (u i , u∈B i)) .ret - - σ⁻¹σ≡id : σ⁻¹ ●ᵛ σ ≡ idTrans _ - σ⁻¹σ≡id = makeNatTransPath (funExt σ⁻¹σ≡idOb) - where - σ⁻¹σ≡idOb : ∀ x → σ⁻¹ .N-ob x ⋆⟨ C ⟩ σ .N-ob x ≡ id C - σ⁻¹σ≡idOb (sing i) = αiIso (u i , u∈B i) .sec - σ⁻¹σ≡idOb (pair i j i<j) = αiIso ((u j , u∈B j) · (u i , u∈B i)) .sec - - - αᵤ' = limOfArrows FLimCone GLimCone σ - αᵤ'⁻¹ = limOfArrows GLimCone FLimCone σ⁻¹ - - αᵤ'IsIso : isIso C αᵤ' - inv αᵤ'IsIso = αᵤ'⁻¹ - sec αᵤ'IsIso = sym (limOfArrowsSeq GLimCone FLimCone GLimCone σ⁻¹ σ) - ∙∙ cong (limOfArrows GLimCone GLimCone) σ⁻¹σ≡id - ∙∙ limOfArrowsId GLimCone - ret αᵤ'IsIso = sym (limOfArrowsSeq FLimCone GLimCone FLimCone σ σ⁻¹) - ∙∙ cong (limOfArrows FLimCone FLimCone) σσ⁻¹≡id - ∙∙ limOfArrowsId FLimCone - - - p : αᵤ' ≡ (α .N-ob (⋁ u)) - p = limArrowUnique GLimCone _ _ _ - (isConeMorSingLemma (limOfArrowsCone FLimCone σ) (F-cone G (⋁Cone L u)) - λ i → sym (α .N-hom (ind≤⋁ u i))) - - q : PathP (λ i → C [ F .F-ob (⋁u≡x i) , G .F-ob (⋁u≡x i) ]) (α .N-ob (⋁ u)) (α .N-ob x) - q = cong (α .N-ob) ⋁u≡x - - - -- notation - private module _ {F G : Functor Bᵒᵖ C} (α : NatTrans F G) (x : ob Lᵒᵖ) where - theDiag = (_↓Diag limitC i F x) - -- note that (_↓Diag limitC i F x) = (_↓Diag limitC i G x) definitionally - FLimCone = limitC (_↓Diag limitC i F x) (T* limitC i F x) - GLimCone = limitC (_↓Diag limitC i G x) (T* limitC i G x) - - ↓nt : NatTrans (T* limitC i F x) (T* limitC i G x) - N-ob ↓nt u = α .N-ob (u .fst) - N-hom ↓nt e = α .N-hom (e .fst) - - module _ (y : ob Lᵒᵖ) (x≥y : Lᵒᵖ [ x , y ]) where - GYLimCone = limitC (_↓Diag limitC i G y) (T* limitC i G y) - FYLimCone = limitC (_↓Diag limitC i F y) (T* limitC i F y) - - diagCone : Cone (T* limitC i G y) (RanOb limitC i F x) - coneOut diagCone (u , y≥u) = limOut FLimCone (u , is-trans _ _ _ y≥u x≥y) - ⋆⟨ C ⟩ α .N-ob u - coneOutCommutes diagCone {u = (u , y≥u)} {v = (v , y≥v)} (u≥v , _) = - (limOut FLimCone (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ α .N-ob u) ⋆⟨ C ⟩ G .F-hom u≥v - ≡⟨ ⋆Assoc C _ _ _ ⟩ - limOut FLimCone (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ (α .N-ob u ⋆⟨ C ⟩ G .F-hom u≥v) - ≡⟨ cong (seq' C (limOut FLimCone (u , is-trans _ _ _ y≥u x≥y))) (sym (α .N-hom u≥v)) ⟩ - limOut FLimCone (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ (F .F-hom u≥v ⋆⟨ C ⟩ α .N-ob v) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (limOut FLimCone (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ F .F-hom u≥v) ⋆⟨ C ⟩ α .N-ob v - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ α .N-ob v) (limOutCommutes FLimCone (u≥v , is-prop-valued _ _ _ _)) ⟩ - limOut FLimCone (v , is-trans _ _ _ y≥v x≥y) ⋆⟨ C ⟩ α .N-ob v ∎ - diagArrow : C [ RanOb limitC i F x , RanOb limitC i G y ] - diagArrow = limArrow GYLimCone _ diagCone - - - - DLRanFun : Functor (FUNCTOR Bᵒᵖ C) (FUNCTOR Lᵒᵖ C) - F-ob DLRanFun = DLRan - N-ob (F-hom DLRanFun α) x = limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α x) - N-hom (F-hom DLRanFun {x = F} {y = G} α) {x = x} {y = y} x≥y = - sym (limArrowUnique (GLimCone α y) _ (diagCone α x y x≥y) _ isConeMorL) - ∙ (limArrowUnique (GLimCone α y) _ _ _ isConeMorR) - where - l = limArrow (FLimCone α y) _ (RanCone limitC i F x≥y) - ⋆⟨ C ⟩ limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α y) - - isConeMorL : isConeMor (diagCone α x y x≥y) (limCone (GLimCone α y)) l - isConeMorL (u , y≥u) = - l ⋆⟨ C ⟩ (limOut (GLimCone α y) (u , y≥u)) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - limArrow (FLimCone α y) _ (RanCone limitC i F x≥y) - ⋆⟨ C ⟩ (limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α y) - ⋆⟨ C ⟩ (limOut (GLimCone α y) (u , y≥u))) - ≡⟨ cong (seq' C (limArrow (FLimCone α y) _ (RanCone limitC i F x≥y))) - (limOfArrowsOut (FLimCone α _) (GLimCone α _) _ _) ⟩ - limArrow (FLimCone α y) _ (RanCone limitC i F x≥y) - ⋆⟨ C ⟩ (limOut (FLimCone α _) (u , y≥u) ⋆⟨ C ⟩ α .N-ob u) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (limArrow (FLimCone α y) _ (RanCone limitC i F x≥y) - ⋆⟨ C ⟩ (limOut (FLimCone α _) (u , y≥u))) ⋆⟨ C ⟩ α .N-ob u - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ (α .N-ob u)) (limArrowCommutes (FLimCone α _) _ _ _) ⟩ - limOut (FLimCone α x) (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ α .N-ob u ∎ - - r = limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α x) - ⋆⟨ C ⟩ limArrow (GLimCone α y) _ (RanCone limitC i G x≥y) - - isConeMorR : isConeMor (diagCone α x y x≥y) (limCone (GLimCone α y)) r - isConeMorR (u , y≥u) = - r ⋆⟨ C ⟩ (limOut (GLimCone α y) (u , y≥u)) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α x) - ⋆⟨ C ⟩ (limArrow (GLimCone α y) _ (RanCone limitC i G x≥y) - ⋆⟨ C ⟩ (limOut (GLimCone α y) (u , y≥u))) - ≡⟨ cong (seq' C (limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α x))) - (limArrowCommutes (GLimCone α _) _ _ _) ⟩ - limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α x) - ⋆⟨ C ⟩ limOut (GLimCone α x) (u , is-trans _ _ _ y≥u x≥y) - ≡⟨ limOfArrowsOut (FLimCone α x) (GLimCone α x) _ _ ⟩ - limOut (FLimCone α x) (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ α .N-ob u ∎ - - - F-id DLRanFun {x = F} = makeNatTransPath - (funExt λ x → limOfArrowsId (FLimCone (idTrans F) x)) - F-seq DLRanFun α β = makeNatTransPath - (funExt λ x → limOfArrowsSeq (FLimCone α x) (GLimCone α x) - (GLimCone β x) (↓nt α x) (↓nt β x)) - - - - --extension of sheaves as functor - sheafExtension : Functor SheafB SheafL - sheafExtension = ΣPropCatFunc DLRanFun (isDLSheafDLRan isBasisB) - - - - open WeakInverse - open NatIso - open isIso - - DLComparisonLemma : SheafL ≃ᶜ SheafB - DLComparisonLemma = record { func = sheafRestriction ; isEquiv = ∣ winv ∣₁} - where - winv : WeakInverse sheafRestriction - invFunc winv = sheafExtension - - -- the unit is induced by the universal property - N-ob (trans (η winv)) (F , _ ) = - DLRanUnivProp (F ∘F i) F (idTrans _) .fst .fst - N-hom (trans (η winv)) {x = (F , _)} {y = (G , _)} α = - makeNatTransPath (funExt goal) - where - isConeMorComp : ∀ (x : ob Lᵒᵖ) - → isConeMor - ((NatTransCone _ _ _ F (idTrans _) x) ★ₙₜ (↓nt (α ∘ˡ i) x)) - (GLimCone (α ∘ˡ i) _ .limCone) - (α .N-ob x - ⋆⟨ C ⟩ limArrow (GLimCone (α ∘ˡ i) _) _ - (NatTransCone _ _ _ G (idTrans _) x)) - isConeMorComp x u⇂@((u , u∈B) , u≤x) = - α .N-ob x ⋆⟨ C ⟩ limArrow (GLimCone (α ∘ˡ i) _) _ - (NatTransCone _ _ _ G (idTrans _) x) - ⋆⟨ C ⟩ limOut (GLimCone (α ∘ˡ i) _) u⇂ - ≡⟨ ⋆Assoc C _ _ _ ⟩ - α .N-ob x ⋆⟨ C ⟩ (limArrow (GLimCone (α ∘ˡ i) _) _ - (NatTransCone _ _ _ G (idTrans _) x) - ⋆⟨ C ⟩ limOut (GLimCone (α ∘ˡ i) _) u⇂) - ≡⟨ cong (λ y → α .N-ob x ⋆⟨ C ⟩ y) (limArrowCommutes (GLimCone (α ∘ˡ i) _) _ _ _) ⟩ - α .N-ob x ⋆⟨ C ⟩ (G .F-hom u≤x ⋆⟨ C ⟩ id C) - ≡⟨ cong (λ y → α .N-ob x ⋆⟨ C ⟩ y) (⋆IdR C _) ⟩ - α .N-ob x ⋆⟨ C ⟩ G .F-hom u≤x - ≡⟨ sym (α .N-hom u≤x) ⟩ - F .F-hom u≤x ⋆⟨ C ⟩ α .N-ob u - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ α .N-ob u) (sym (⋆IdR C _)) ⟩ - F .F-hom u≤x ⋆⟨ C ⟩ id C ⋆⟨ C ⟩ α .N-ob u ∎ - - goal : ∀ (x : ob Lᵒᵖ) - → α .N-ob x ⋆⟨ C ⟩ limArrow (GLimCone (α ∘ˡ i) _) _ - (NatTransCone _ _ _ G (idTrans _) x) - ≡ limArrow (FLimCone (α ∘ˡ i) _) _ - (NatTransCone _ _ _ F (idTrans _) x) - ⋆⟨ C ⟩ limOfArrows (FLimCone (α ∘ˡ i) _) (GLimCone (α ∘ˡ i) _) - (↓nt (α ∘ˡ i) x) - goal x = sym (limArrowUnique _ _ _ _ (isConeMorComp x)) - ∙ limArrowCompLimOfArrows _ _ _ _ _ - - nIso (η winv) (F , isSheafF) = isIsoΣPropCat _ _ _ - (NatIso→FUNCTORIso _ _ σNatIso .snd) - where - σ = DLRanUnivProp (F ∘F i) F (idTrans _) .fst .fst - - σRestIso : isIso (FUNCTOR Bᵒᵖ C) (σ ∘ˡ i) - inv σRestIso = DLRanNatTrans (F ∘F i) - sec σRestIso = let ε = DLRanNatTrans (F ∘F i) - ε⁻¹ = NatIso→FUNCTORIso _ _ (DLRanNatIso (F ∘F i)) .snd .inv - in ε ●ᵛ (σ ∘ˡ i) - ≡⟨ cong (λ x → ε ●ᵛ x) (sym (⋆IdR (FUNCTOR Bᵒᵖ C) _)) ⟩ - ε ●ᵛ ((σ ∘ˡ i) ●ᵛ idTrans _) - ≡⟨ cong (λ x → ε ●ᵛ ((σ ∘ˡ i) ●ᵛ x)) - (sym (NatIso→FUNCTORIso _ _ (DLRanNatIso (F ∘F i)) .snd .ret)) ⟩ - ε ●ᵛ ((σ ∘ˡ i) ●ᵛ (ε ●ᵛ ε⁻¹)) - ≡⟨ cong (λ x → ε ●ᵛ x) (sym (⋆Assoc (FUNCTOR Bᵒᵖ C) _ _ _)) ⟩ - ε ●ᵛ ((σ ∘ˡ i) ●ᵛ ε ●ᵛ ε⁻¹) - ≡⟨ cong (λ x → ε ●ᵛ (x ●ᵛ ε⁻¹)) - (sym (DLRanUnivProp (F ∘F i) F (idTrans _) .fst .snd)) ⟩ - ε ●ᵛ (idTrans _ ●ᵛ ε⁻¹) - ≡⟨ cong (λ x → ε ●ᵛ x) (⋆IdL (FUNCTOR Bᵒᵖ C) _) ⟩ - ε ●ᵛ ε⁻¹ - ≡⟨ NatIso→FUNCTORIso _ _ (DLRanNatIso (F ∘F i)) .snd .ret ⟩ - idTrans _ ∎ - ret σRestIso = sym (DLRanUnivProp (F ∘F i) F (idTrans _) .fst .snd) - - σNatIso : NatIso F (DLRan (F ∘F i)) - trans σNatIso = σ - nIso σNatIso = restIsoLemma - (F , isSheafF) - (_ , isDLSheafDLRan isBasisB _ (restPresSheafProp _ isSheafF)) - σ - (FUNCTORIso→NatIso _ _ (_ , σRestIso) .nIso) - - -- the counit is easy - N-ob (trans (ε winv)) (F , _) = DLRanNatTrans F - N-hom (trans (ε winv)) α = -- DLRanNatTrans F is functorial in F - makeNatTransPath (funExt (λ u → limOfArrowsOut (FLimCone α (u .fst)) - (GLimCone α (u .fst)) _ _)) - nIso (ε winv) (F , isSheafF) = isIsoΣPropCat _ _ _ - (NatIso→FUNCTORIso _ _ (DLRanNatIso F) .snd) - - - -- useful corollary: - -- if two natural transformations between sheaves agree on the basis they are identical - makeNatTransPathRest : (F G : ob SheafL) (α β : NatTrans (F .fst) (G .fst)) - → (∀ (u : ob Bᵒᵖ) → (α ∘ˡ i) .N-ob u ≡ (β ∘ˡ i) .N-ob u) - → α ≡ β - makeNatTransPathRest F G _ _ basePaths = isFaithfulSheafRestriction F G _ _ - (makeNatTransPath (funExt basePaths)) - where - isFaithfulSheafRestriction = isEquiv→Faithful (DLComparisonLemma ._≃ᶜ_.isEquiv) +open import Cubical.Relation.Binary.Order.Poset +open import Cubical.HITs.PropositionalTruncation as PT + +open import Cubical.Algebra.Semilattice +open import Cubical.Algebra.Lattice +open import Cubical.Algebra.DistLattice +open import Cubical.Algebra.DistLattice.Basis +open import Cubical.Algebra.DistLattice.BigOps + +open import Cubical.Categories.Category.Base +open import Cubical.Categories.Morphism +open import Cubical.Categories.Functor +open import Cubical.Categories.NaturalTransformation +open import Cubical.Categories.Adjoint +open import Cubical.Categories.Equivalence +open import Cubical.Categories.Limits.Limits +open import Cubical.Categories.Limits.Pullback +open import Cubical.Categories.Limits.Terminal +open import Cubical.Categories.Limits.RightKan +open import Cubical.Categories.Instances.Poset +open import Cubical.Categories.Instances.Semilattice +open import Cubical.Categories.Instances.Lattice +open import Cubical.Categories.Instances.DistLattice +open import Cubical.Categories.Instances.Functors + +open import Cubical.Categories.DistLatticeSheaf.Diagram +open import Cubical.Categories.DistLatticeSheaf.Base +open import Cubical.Categories.DistLatticeSheaf.Extension + + +private + variable + ℓ ℓ' ℓ'' : Level + +module _ (L : DistLattice ℓ) (C : Category ℓ' ℓ'') (limitC : Limits {ℓ} {ℓ} C) + (B : ℙ (fst L)) (isBasisB : IsBasis L B) where + + + open Category hiding (_∘_) + open Functor + open NatTrans + open Cone + open LimCone + open SheafOnBasis L C B isBasisB + open PreSheafExtension L C limitC B + + open DistLatticeStr ⦃...⦄ + open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L)) + open PosetStr (IndPoset .snd) hiding (_≤_) + open Join L + open Order (DistLattice→Lattice L) + open MeetSemilattice (Lattice→MeetSemilattice (DistLattice→Lattice L)) + using (∧≤RCancel ; ∧≤LCancel) + private + instance + _ = snd L + + Lᵒᵖ = DistLatticeCategory L ^op + Bᵒᵖ = ΣPropCat (DistLatticeCategory L) B ^op + + SheafB = ΣPropCat (FUNCTOR Bᵒᵖ C) isDLBasisSheafProp + SheafL = ΣPropCat (FUNCTOR Lᵒᵖ C) (isDLSheafProp L C) + + i = baseIncl ^opF + + restPresSheafProp : ∀ (F : Functor Lᵒᵖ C) → isDLSheaf L C F → isDLBasisSheaf (F ∘F i) + restPresSheafProp F isSheafF α ⋁α∈B = + transport (λ i → isLimCone (diagPath i) (F .F-ob (⋁ α')) (limConesPathP i)) (isSheafF _ α') + where + open condCone α + + α' : FinVec (fst L) _ + α' i = α i .fst + + diagPath : F ∘F (FinVec→Diag L α') ≡ (F ∘F i) ∘F BDiag + diagPath = Functor≡ diagPathOb diagPathHom + where + diagPathOb : ∀ c → (F ∘F (FinVec→Diag L α')) .F-ob c ≡ ((F ∘F i) ∘F BDiag) .F-ob c + diagPathOb (sing i) = refl + diagPathOb (pair i j i<j) = cong (F .F-ob) (∧lComm _ _) + + diagPathHom : ∀ {c} {d} f → PathP (λ i → C [ diagPathOb c i , diagPathOb d i ]) + ((F ∘F (FinVec→Diag L α')) .F-hom f) + (((F ∘F i) ∘F BDiag) .F-hom f) + diagPathHom {sing i} idAr = refl + diagPathHom {pair i j i<j} idAr = functorCongP {F = F} (toPathP (is-prop-valued _ _ _ _)) + diagPathHom singPairL = functorCongP {F = F} (toPathP (is-prop-valued _ _ _ _)) + diagPathHom singPairR = functorCongP {F = F} (toPathP (is-prop-valued _ _ _ _)) + + limConesPathP : PathP (λ i → Cone (diagPath i) (F .F-ob (⋁ α'))) + (F-cone F (⋁Cone L α')) (F-cone (F ∘F i) (B⋁Cone ⋁α∈B)) + limConesPathP = conePathP limConesPathPOb + where + limConesPathPOb : ∀ c → PathP (λ i → C [ F .F-ob (⋁ α') , diagPath i .F-ob c ]) + (F-cone F (⋁Cone L α') .coneOut c) + (F-cone (F ∘F i) (B⋁Cone ⋁α∈B) .coneOut c) + limConesPathPOb (sing i) = refl + limConesPathPOb (pair i j i<j) = functorCongP {F = F} (toPathP (is-prop-valued _ _ _ _)) + + + --restriction to basis as functor + sheafRestriction : Functor SheafL SheafB + sheafRestriction = ΣPropCatFunc (precomposeF C i) restPresSheafProp + + -- important lemma: a natural transformation between sheaves on L is an + -- iso if the restriction to B is an iso. This will give us that + -- that the unit of the comparison lemma is an iso and thus that + -- restriction of sheaves is fully-faithful + restIsoLemma : (F G : ob SheafL) (α : NatTrans (F .fst) (G .fst)) + → (∀ (u : ob Bᵒᵖ) → isIso C ((α ∘ˡ i) .N-ob u)) + → ∀ (x : ob Lᵒᵖ) → isIso C (α .N-ob x) + restIsoLemma (F , isSheafF) (G , isSheafG) α αiIso x = + PT.rec (isPropIsIso _) basisHyp (isBasisB .⋁Basis x) + where + Fi = F ∘F i + Gi = G ∘F i + open NatIso + αiNatIso : NatIso Fi Gi + trans αiNatIso = α ∘ˡ i + nIso αiNatIso = αiIso + + open IsBasis + basisHyp : Σ[ n ∈ ℕ ] Σ[ u ∈ FinVec (L .fst) n ] (∀ j → u j ∈ B) × (⋁ u ≡ x) + → isIso C (α .N-ob x) + basisHyp (n , u , u∈B , ⋁u≡x) = transport (λ i → isIso C (q i)) (subst (isIso C) p αᵤ'IsIso) + where + open isIso + + FLimCone = isDLSheafLimCone L C F isSheafF n u + GLimCone = isDLSheafLimCone L C G isSheafG n u + + uᴮ : FinVec (Bᵒᵖ .ob) n + uᴮ i = u i , u∈B i + + uᴮDiag = condCone.BDiag uᴮ + + αi⁻¹ : (v : ob Bᵒᵖ) → C [ Gi .F-ob v , Fi .F-ob v ] + αi⁻¹ v = αiIso v .inv + + σ : NatTrans (F ∘F (FinVec→Diag L u)) (G ∘F (FinVec→Diag L u)) + N-ob σ = α .N-ob ∘ FinVec→Diag L u .F-ob + N-hom σ = α .N-hom ∘ FinVec→Diag L u .F-hom + + open SemilatticeStr ⦃...⦄ + instance _ = snd (Basis→MeetSemilattice L B isBasisB) + + σ⁻¹ : NatTrans (G ∘F (FinVec→Diag L u)) (F ∘F (FinVec→Diag L u)) + N-ob σ⁻¹ (sing i) = αi⁻¹ (uᴮDiag .F-ob (sing i)) + N-ob σ⁻¹ (pair i j i<j) = αi⁻¹ ((u j , u∈B j) · (u i , u∈B i)) + -- (uᴮDiag .F-ob (pair i j i<j)) modulo swapping i and j + N-hom σ⁻¹ (idAr {x = v}) = + G .F-hom (id Lᵒᵖ) ⋆⟨ C ⟩ σ⁻¹ .N-ob v ≡⟨ cong (λ f → f ⋆⟨ C ⟩ σ⁻¹ .N-ob v) (G .F-id) ⟩ + id C ⋆⟨ C ⟩ σ⁻¹ .N-ob v ≡⟨ ⋆IdL C _ ⟩ + σ⁻¹ .N-ob v ≡⟨ sym (⋆IdR C _) ⟩ + σ⁻¹ .N-ob v ⋆⟨ C ⟩ id C ≡⟨ cong (λ f → σ⁻¹ .N-ob v ⋆⟨ C ⟩ f) (sym (F .F-id)) ⟩ + σ⁻¹ .N-ob v ⋆⟨ C ⟩ F .F-hom (id Lᵒᵖ) ∎ + N-hom σ⁻¹ (singPairL {i} {j} {i<j}) = transport (λ 𝕚 → p 𝕚 ≡ r 𝕚) q + where + p : PathP (λ 𝕚 → C [ G .F-ob (u i) , F .F-ob (fst (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚)) ]) + (G .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ (uᴮDiag .F-ob (pair i j i<j))) + (G .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ ((u j , u∈B j) · (u i , u∈B i))) + p 𝕚 = G .F-hom (isProp→PathP (λ 𝕚' → is-prop-valued (∧lComm (u i) (u j) 𝕚') (u i)) + (≤m→≤j _ _ (∧≤RCancel _ _)) (≤m→≤j _ _ (∧≤LCancel _ _)) 𝕚) + ⋆⟨ C ⟩ αi⁻¹ (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚) + + q : G .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ (uᴮDiag .F-ob (pair i j i<j)) + ≡ αi⁻¹ (u i , u∈B i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) + q = sqLL αiNatIso + + r : PathP (λ 𝕚 → C [ G .F-ob (u i) , F .F-ob (fst (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚)) ]) + (αi⁻¹ (u i , u∈B i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _))) + (αi⁻¹ (u i , u∈B i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) + r 𝕚 = αi⁻¹ (u i , u∈B i) + ⋆⟨ C ⟩ F .F-hom (isProp→PathP (λ 𝕚' → is-prop-valued (∧lComm (u i) (u j) 𝕚') (u i)) + (≤m→≤j _ _ (∧≤RCancel _ _)) (≤m→≤j _ _ (∧≤LCancel _ _)) 𝕚) + + N-hom σ⁻¹ (singPairR {i} {j} {i<j}) = transport (λ 𝕚 → p 𝕚 ≡ r 𝕚) q + where + p : PathP (λ 𝕚 → C [ G .F-ob (u j) , F .F-ob (fst (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚)) ]) + (G .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ (uᴮDiag .F-ob (pair i j i<j))) + (G .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ ((u j , u∈B j) · (u i , u∈B i))) + p 𝕚 = G .F-hom (isProp→PathP (λ 𝕚' → is-prop-valued (∧lComm (u i) (u j) 𝕚') (u j)) + (≤m→≤j _ _ (∧≤LCancel _ _)) (≤m→≤j _ _ (∧≤RCancel _ _)) 𝕚) + ⋆⟨ C ⟩ αi⁻¹ (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚) + + q : G .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ⋆⟨ C ⟩ αi⁻¹ (uᴮDiag .F-ob (pair i j i<j)) + ≡ αi⁻¹ (u j , u∈B j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + q = sqLL αiNatIso + + r : PathP (λ 𝕚 → C [ G .F-ob (u j) , F .F-ob (fst (·Comm (u i , u∈B i) (u j , u∈B j) 𝕚)) ]) + (αi⁻¹ (u j , u∈B j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) + (αi⁻¹ (u j , u∈B j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _))) + r 𝕚 = αi⁻¹ (u j , u∈B j) + ⋆⟨ C ⟩ F .F-hom (isProp→PathP (λ 𝕚' → is-prop-valued (∧lComm (u i) (u j) 𝕚') (u j)) + (≤m→≤j _ _ (∧≤LCancel _ _)) (≤m→≤j _ _ (∧≤RCancel _ _)) 𝕚) + + -- σ and σ⁻¹ are inverse: + σσ⁻¹≡id : σ ●ᵛ σ⁻¹ ≡ idTrans _ + σσ⁻¹≡id = makeNatTransPath (funExt σσ⁻¹≡idOb) + where + σσ⁻¹≡idOb : ∀ x → σ .N-ob x ⋆⟨ C ⟩ σ⁻¹ .N-ob x ≡ id C + σσ⁻¹≡idOb (sing i) = αiIso (u i , u∈B i) .ret + σσ⁻¹≡idOb (pair i j i<j) = αiIso ((u j , u∈B j) · (u i , u∈B i)) .ret + + σ⁻¹σ≡id : σ⁻¹ ●ᵛ σ ≡ idTrans _ + σ⁻¹σ≡id = makeNatTransPath (funExt σ⁻¹σ≡idOb) + where + σ⁻¹σ≡idOb : ∀ x → σ⁻¹ .N-ob x ⋆⟨ C ⟩ σ .N-ob x ≡ id C + σ⁻¹σ≡idOb (sing i) = αiIso (u i , u∈B i) .sec + σ⁻¹σ≡idOb (pair i j i<j) = αiIso ((u j , u∈B j) · (u i , u∈B i)) .sec + + + αᵤ' = limOfArrows FLimCone GLimCone σ + αᵤ'⁻¹ = limOfArrows GLimCone FLimCone σ⁻¹ + + αᵤ'IsIso : isIso C αᵤ' + inv αᵤ'IsIso = αᵤ'⁻¹ + sec αᵤ'IsIso = sym (limOfArrowsSeq GLimCone FLimCone GLimCone σ⁻¹ σ) + ∙∙ cong (limOfArrows GLimCone GLimCone) σ⁻¹σ≡id + ∙∙ limOfArrowsId GLimCone + ret αᵤ'IsIso = sym (limOfArrowsSeq FLimCone GLimCone FLimCone σ σ⁻¹) + ∙∙ cong (limOfArrows FLimCone FLimCone) σσ⁻¹≡id + ∙∙ limOfArrowsId FLimCone + + + p : αᵤ' ≡ (α .N-ob (⋁ u)) + p = limArrowUnique GLimCone _ _ _ + (isConeMorSingLemma (limOfArrowsCone FLimCone σ) (F-cone G (⋁Cone L u)) + λ i → sym (α .N-hom (ind≤⋁ u i))) + + q : PathP (λ i → C [ F .F-ob (⋁u≡x i) , G .F-ob (⋁u≡x i) ]) (α .N-ob (⋁ u)) (α .N-ob x) + q = cong (α .N-ob) ⋁u≡x + + + -- notation + private module _ {F G : Functor Bᵒᵖ C} (α : NatTrans F G) (x : ob Lᵒᵖ) where + theDiag = (_↓Diag limitC i F x) + -- note that (_↓Diag limitC i F x) = (_↓Diag limitC i G x) definitionally + FLimCone = limitC (_↓Diag limitC i F x) (T* limitC i F x) + GLimCone = limitC (_↓Diag limitC i G x) (T* limitC i G x) + + ↓nt : NatTrans (T* limitC i F x) (T* limitC i G x) + N-ob ↓nt u = α .N-ob (u .fst) + N-hom ↓nt e = α .N-hom (e .fst) + + module _ (y : ob Lᵒᵖ) (x≥y : Lᵒᵖ [ x , y ]) where + GYLimCone = limitC (_↓Diag limitC i G y) (T* limitC i G y) + FYLimCone = limitC (_↓Diag limitC i F y) (T* limitC i F y) + + diagCone : Cone (T* limitC i G y) (RanOb limitC i F x) + coneOut diagCone (u , y≥u) = limOut FLimCone (u , is-trans _ _ _ y≥u x≥y) + ⋆⟨ C ⟩ α .N-ob u + coneOutCommutes diagCone {u = (u , y≥u)} {v = (v , y≥v)} (u≥v , _) = + (limOut FLimCone (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ α .N-ob u) ⋆⟨ C ⟩ G .F-hom u≥v + ≡⟨ ⋆Assoc C _ _ _ ⟩ + limOut FLimCone (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ (α .N-ob u ⋆⟨ C ⟩ G .F-hom u≥v) + ≡⟨ cong (seq' C (limOut FLimCone (u , is-trans _ _ _ y≥u x≥y))) (sym (α .N-hom u≥v)) ⟩ + limOut FLimCone (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ (F .F-hom u≥v ⋆⟨ C ⟩ α .N-ob v) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (limOut FLimCone (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ F .F-hom u≥v) ⋆⟨ C ⟩ α .N-ob v + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ α .N-ob v) (limOutCommutes FLimCone (u≥v , is-prop-valued _ _ _ _)) ⟩ + limOut FLimCone (v , is-trans _ _ _ y≥v x≥y) ⋆⟨ C ⟩ α .N-ob v ∎ + diagArrow : C [ RanOb limitC i F x , RanOb limitC i G y ] + diagArrow = limArrow GYLimCone _ diagCone + + + + DLRanFun : Functor (FUNCTOR Bᵒᵖ C) (FUNCTOR Lᵒᵖ C) + F-ob DLRanFun = DLRan + N-ob (F-hom DLRanFun α) x = limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α x) + N-hom (F-hom DLRanFun {x = F} {y = G} α) {x = x} {y = y} x≥y = + sym (limArrowUnique (GLimCone α y) _ (diagCone α x y x≥y) _ isConeMorL) + ∙ (limArrowUnique (GLimCone α y) _ _ _ isConeMorR) + where + l = limArrow (FLimCone α y) _ (RanCone limitC i F x≥y) + ⋆⟨ C ⟩ limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α y) + + isConeMorL : isConeMor (diagCone α x y x≥y) (limCone (GLimCone α y)) l + isConeMorL (u , y≥u) = + l ⋆⟨ C ⟩ (limOut (GLimCone α y) (u , y≥u)) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + limArrow (FLimCone α y) _ (RanCone limitC i F x≥y) + ⋆⟨ C ⟩ (limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α y) + ⋆⟨ C ⟩ (limOut (GLimCone α y) (u , y≥u))) + ≡⟨ cong (seq' C (limArrow (FLimCone α y) _ (RanCone limitC i F x≥y))) + (limOfArrowsOut (FLimCone α _) (GLimCone α _) _ _) ⟩ + limArrow (FLimCone α y) _ (RanCone limitC i F x≥y) + ⋆⟨ C ⟩ (limOut (FLimCone α _) (u , y≥u) ⋆⟨ C ⟩ α .N-ob u) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (limArrow (FLimCone α y) _ (RanCone limitC i F x≥y) + ⋆⟨ C ⟩ (limOut (FLimCone α _) (u , y≥u))) ⋆⟨ C ⟩ α .N-ob u + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ (α .N-ob u)) (limArrowCommutes (FLimCone α _) _ _ _) ⟩ + limOut (FLimCone α x) (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ α .N-ob u ∎ + + r = limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α x) + ⋆⟨ C ⟩ limArrow (GLimCone α y) _ (RanCone limitC i G x≥y) + + isConeMorR : isConeMor (diagCone α x y x≥y) (limCone (GLimCone α y)) r + isConeMorR (u , y≥u) = + r ⋆⟨ C ⟩ (limOut (GLimCone α y) (u , y≥u)) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α x) + ⋆⟨ C ⟩ (limArrow (GLimCone α y) _ (RanCone limitC i G x≥y) + ⋆⟨ C ⟩ (limOut (GLimCone α y) (u , y≥u))) + ≡⟨ cong (seq' C (limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α x))) + (limArrowCommutes (GLimCone α _) _ _ _) ⟩ + limOfArrows (FLimCone α _) (GLimCone α _) (↓nt α x) + ⋆⟨ C ⟩ limOut (GLimCone α x) (u , is-trans _ _ _ y≥u x≥y) + ≡⟨ limOfArrowsOut (FLimCone α x) (GLimCone α x) _ _ ⟩ + limOut (FLimCone α x) (u , is-trans _ _ _ y≥u x≥y) ⋆⟨ C ⟩ α .N-ob u ∎ + + + F-id DLRanFun {x = F} = makeNatTransPath + (funExt λ x → limOfArrowsId (FLimCone (idTrans F) x)) + F-seq DLRanFun α β = makeNatTransPath + (funExt λ x → limOfArrowsSeq (FLimCone α x) (GLimCone α x) + (GLimCone β x) (↓nt α x) (↓nt β x)) + + + + --extension of sheaves as functor + sheafExtension : Functor SheafB SheafL + sheafExtension = ΣPropCatFunc DLRanFun (isDLSheafDLRan isBasisB) + + + + open WeakInverse + open NatIso + open isIso + + DLComparisonLemma : SheafL ≃ᶜ SheafB + DLComparisonLemma = record { func = sheafRestriction ; isEquiv = ∣ winv ∣₁} + where + winv : WeakInverse sheafRestriction + invFunc winv = sheafExtension + + -- the unit is induced by the universal property + N-ob (trans (η winv)) (F , _ ) = + DLRanUnivProp (F ∘F i) F (idTrans _) .fst .fst + N-hom (trans (η winv)) {x = (F , _)} {y = (G , _)} α = + makeNatTransPath (funExt goal) + where + isConeMorComp : ∀ (x : ob Lᵒᵖ) + → isConeMor + ((NatTransCone _ _ _ F (idTrans _) x) ★ₙₜ (↓nt (α ∘ˡ i) x)) + (GLimCone (α ∘ˡ i) _ .limCone) + (α .N-ob x + ⋆⟨ C ⟩ limArrow (GLimCone (α ∘ˡ i) _) _ + (NatTransCone _ _ _ G (idTrans _) x)) + isConeMorComp x u⇂@((u , u∈B) , u≤x) = + α .N-ob x ⋆⟨ C ⟩ limArrow (GLimCone (α ∘ˡ i) _) _ + (NatTransCone _ _ _ G (idTrans _) x) + ⋆⟨ C ⟩ limOut (GLimCone (α ∘ˡ i) _) u⇂ + ≡⟨ ⋆Assoc C _ _ _ ⟩ + α .N-ob x ⋆⟨ C ⟩ (limArrow (GLimCone (α ∘ˡ i) _) _ + (NatTransCone _ _ _ G (idTrans _) x) + ⋆⟨ C ⟩ limOut (GLimCone (α ∘ˡ i) _) u⇂) + ≡⟨ cong (λ y → α .N-ob x ⋆⟨ C ⟩ y) (limArrowCommutes (GLimCone (α ∘ˡ i) _) _ _ _) ⟩ + α .N-ob x ⋆⟨ C ⟩ (G .F-hom u≤x ⋆⟨ C ⟩ id C) + ≡⟨ cong (λ y → α .N-ob x ⋆⟨ C ⟩ y) (⋆IdR C _) ⟩ + α .N-ob x ⋆⟨ C ⟩ G .F-hom u≤x + ≡⟨ sym (α .N-hom u≤x) ⟩ + F .F-hom u≤x ⋆⟨ C ⟩ α .N-ob u + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ α .N-ob u) (sym (⋆IdR C _)) ⟩ + F .F-hom u≤x ⋆⟨ C ⟩ id C ⋆⟨ C ⟩ α .N-ob u ∎ + + goal : ∀ (x : ob Lᵒᵖ) + → α .N-ob x ⋆⟨ C ⟩ limArrow (GLimCone (α ∘ˡ i) _) _ + (NatTransCone _ _ _ G (idTrans _) x) + ≡ limArrow (FLimCone (α ∘ˡ i) _) _ + (NatTransCone _ _ _ F (idTrans _) x) + ⋆⟨ C ⟩ limOfArrows (FLimCone (α ∘ˡ i) _) (GLimCone (α ∘ˡ i) _) + (↓nt (α ∘ˡ i) x) + goal x = sym (limArrowUnique _ _ _ _ (isConeMorComp x)) + ∙ limArrowCompLimOfArrows _ _ _ _ _ + + nIso (η winv) (F , isSheafF) = isIsoΣPropCat _ _ _ + (NatIso→FUNCTORIso _ _ σNatIso .snd) + where + σ = DLRanUnivProp (F ∘F i) F (idTrans _) .fst .fst + + σRestIso : isIso (FUNCTOR Bᵒᵖ C) (σ ∘ˡ i) + inv σRestIso = DLRanNatTrans (F ∘F i) + sec σRestIso = let ε = DLRanNatTrans (F ∘F i) + ε⁻¹ = NatIso→FUNCTORIso _ _ (DLRanNatIso (F ∘F i)) .snd .inv + in ε ●ᵛ (σ ∘ˡ i) + ≡⟨ cong (λ x → ε ●ᵛ x) (sym (⋆IdR (FUNCTOR Bᵒᵖ C) _)) ⟩ + ε ●ᵛ ((σ ∘ˡ i) ●ᵛ idTrans _) + ≡⟨ cong (λ x → ε ●ᵛ ((σ ∘ˡ i) ●ᵛ x)) + (sym (NatIso→FUNCTORIso _ _ (DLRanNatIso (F ∘F i)) .snd .ret)) ⟩ + ε ●ᵛ ((σ ∘ˡ i) ●ᵛ (ε ●ᵛ ε⁻¹)) + ≡⟨ cong (λ x → ε ●ᵛ x) (sym (⋆Assoc (FUNCTOR Bᵒᵖ C) _ _ _)) ⟩ + ε ●ᵛ ((σ ∘ˡ i) ●ᵛ ε ●ᵛ ε⁻¹) + ≡⟨ cong (λ x → ε ●ᵛ (x ●ᵛ ε⁻¹)) + (sym (DLRanUnivProp (F ∘F i) F (idTrans _) .fst .snd)) ⟩ + ε ●ᵛ (idTrans _ ●ᵛ ε⁻¹) + ≡⟨ cong (λ x → ε ●ᵛ x) (⋆IdL (FUNCTOR Bᵒᵖ C) _) ⟩ + ε ●ᵛ ε⁻¹ + ≡⟨ NatIso→FUNCTORIso _ _ (DLRanNatIso (F ∘F i)) .snd .ret ⟩ + idTrans _ ∎ + ret σRestIso = sym (DLRanUnivProp (F ∘F i) F (idTrans _) .fst .snd) + + σNatIso : NatIso F (DLRan (F ∘F i)) + trans σNatIso = σ + nIso σNatIso = restIsoLemma + (F , isSheafF) + (_ , isDLSheafDLRan isBasisB _ (restPresSheafProp _ isSheafF)) + σ + (FUNCTORIso→NatIso _ _ (_ , σRestIso) .nIso) + + -- the counit is easy + N-ob (trans (ε winv)) (F , _) = DLRanNatTrans F + N-hom (trans (ε winv)) α = -- DLRanNatTrans F is functorial in F + makeNatTransPath (funExt (λ u → limOfArrowsOut (FLimCone α (u .fst)) + (GLimCone α (u .fst)) _ _)) + nIso (ε winv) (F , isSheafF) = isIsoΣPropCat _ _ _ + (NatIso→FUNCTORIso _ _ (DLRanNatIso F) .snd) + + + -- useful corollary: + -- if two natural transformations between sheaves agree on the basis they are identical + makeNatTransPathRest : (F G : ob SheafL) (α β : NatTrans (F .fst) (G .fst)) + → (∀ (u : ob Bᵒᵖ) → (α ∘ˡ i) .N-ob u ≡ (β ∘ˡ i) .N-ob u) + → α ≡ β + makeNatTransPathRest F G _ _ basePaths = isFaithfulSheafRestriction F G _ _ + (makeNatTransPath (funExt basePaths)) + where + isFaithfulSheafRestriction = isEquiv→Faithful (DLComparisonLemma ._≃ᶜ_.isEquiv) \ No newline at end of file diff --git a/Cubical.Categories.DistLatticeSheaf.Diagram.html b/Cubical.Categories.DistLatticeSheaf.Diagram.html index 524057dec1..131e5d0a08 100644 --- a/Cubical.Categories.DistLatticeSheaf.Diagram.html +++ b/Cubical.Categories.DistLatticeSheaf.Diagram.html @@ -22,333 +22,333 @@ open import Cubical.Data.Sum open import Cubical.Relation.Nullary -open import Cubical.Relation.Binary.Poset - -open import Cubical.Categories.Category -open import Cubical.Categories.Functor -open import Cubical.Categories.Limits.Limits -open import Cubical.Categories.Limits.Pullback -open import Cubical.Categories.Instances.DistLattice - -open import Cubical.Algebra.DistLattice -open import Cubical.Algebra.Lattice -open import Cubical.Algebra.Semilattice -open import Cubical.Algebra.DistLattice.BigOps - -private - variable - ℓ ℓ' ℓ'' : Level - -module _ {ℓ : Level} where - data DLShfDiagOb (n : ℕ) : Type ℓ where - sing : Fin n → DLShfDiagOb n - pair : (i j : Fin n) → i < j → DLShfDiagOb n - - data DLShfDiagHom (n : ℕ) : DLShfDiagOb n → DLShfDiagOb n → Type ℓ where - idAr : {x : DLShfDiagOb n} → DLShfDiagHom n x x - singPairL : {i j : Fin n} {i<j : i < j} → DLShfDiagHom n (sing i) (pair i j i<j) - singPairR : {i j : Fin n} {i<j : i < j}→ DLShfDiagHom n (sing j) (pair i j i<j) - - - module DLShfDiagHomPath where - variable - n : ℕ - - -- DLShfDiagHom n x y is a retract of Code x y - Code : (x y : DLShfDiagOb n) → Type - Code (sing i) (sing j) = i ≡ j - Code (sing i) (pair j k j<k) = - (Σ[ p ∈ (i ≡ j) ] Σ[ i<k ∈ i < k ] PathP (λ ι → p ι < k) i<k j<k) - ⊎ (Σ[ p ∈ (i ≡ k) ] Σ[ j<i ∈ j < i ] PathP (λ ι → j < p ι) j<i j<k) - Code (pair i j i<j) (sing k) = ⊥ - Code (pair i j i<j) (pair k l k<l) = - Σ[ p ∈ (i ≡ k) × (j ≡ l) ] PathP (λ ι → fst p ι < snd p ι) i<j k<l - - isSetCode : ∀ (x y : DLShfDiagOb n) → isSet (Code x y) - isSetCode (sing _) (sing _) = isProp→isSet (isSetFin _ _) - isSetCode (sing i) (pair j k j<k) = - isSet⊎ - (isSetΣ (isProp→isSet (isSetFin _ _)) - λ _ → isSetΣ (isProp→isSet (≤'FinIsPropValued _ _)) - λ _ → isOfHLevelPathP 2 (isProp→isSet (≤'FinIsPropValued _ _)) _ _) - (isSetΣ (isProp→isSet (isSetFin _ _)) - λ _ → isSetΣ (isProp→isSet (≤'FinIsPropValued _ _)) - λ _ → isOfHLevelPathP 2 (isProp→isSet (≤'FinIsPropValued _ _)) _ _) - isSetCode (pair _ _ _) (sing _) = isProp→isSet isProp⊥ - isSetCode (pair _ _ _) (pair _ _ _) = - isSetΣ - (isSet× (isProp→isSet (isSetFin _ _)) (isProp→isSet (isSetFin _ _))) - λ _ → isOfHLevelPathP 2 (isProp→isSet (≤'FinIsPropValued _ _)) _ _ - - encode : (x y : DLShfDiagOb n) → DLShfDiagHom n x y → Code x y - encode (sing i) (sing .i) idAr = refl - encode (sing i) (pair .i j i<j) singPairL = inl (refl , i<j , refl) - encode (sing j) (pair i .j i<j) singPairR = inr (refl , i<j , refl) - encode (pair i j i<j) (pair .i .j .i<j) idAr = (refl , refl) , refl - - decode : (x y : DLShfDiagOb n) → Code x y → DLShfDiagHom n x y - decode (sing i) (sing j) p = subst (λ k → DLShfDiagHom _ (sing i) (sing k)) p idAr - decode (sing i) (pair j k j<k) (inl (p , i<k , q)) = - transport (λ ι → DLShfDiagHom _ (sing i) (pair (p ι) k (q ι))) singPairL - decode (sing i) (pair k j k<j) (inr (p , k<i , q)) = - transport (λ ι → DLShfDiagHom _ (sing i) (pair k (p ι) (q ι))) singPairR - decode (pair i j i<j) (pair k l k<l) (_ , p) = - transport (λ ι → DLShfDiagHom _ (pair _ _ i<j) (pair _ _ (p ι))) idAr - - codeRetract : ∀ (x y : DLShfDiagOb n) (f : DLShfDiagHom n x y) - → decode x y (encode x y f) ≡ f - codeRetract (sing i) (sing .i) idAr = transportRefl idAr - codeRetract (sing i) (pair .i k i<k) singPairL = transportRefl singPairL - codeRetract (sing i) (pair j .i j<i) singPairR = transportRefl singPairR - codeRetract (pair i j i<j) (pair .i .j .i<j) idAr = transportRefl idAr - - isSetDLShfDiagHom : ∀ (x y : DLShfDiagOb n) → isSet (DLShfDiagHom n x y) - isSetDLShfDiagHom x y = isSetRetract (encode x y) (decode x y) - (codeRetract x y) (isSetCode x y) - - - -open Category -DLShfDiag : ℕ → (ℓ : Level) → Category ℓ ℓ -ob (DLShfDiag n ℓ) = DLShfDiagOb n -Hom[_,_] (DLShfDiag n ℓ) = DLShfDiagHom n -id (DLShfDiag n ℓ) = idAr -_⋆_ (DLShfDiag n ℓ) idAr f = f -_⋆_ (DLShfDiag n ℓ) singPairL idAr = singPairL -_⋆_ (DLShfDiag n ℓ) singPairR idAr = singPairR -⋆IdL (DLShfDiag n ℓ) _ = refl -⋆IdR (DLShfDiag n ℓ) idAr = refl -⋆IdR (DLShfDiag n ℓ) singPairL = refl -⋆IdR (DLShfDiag n ℓ) singPairR = refl -⋆Assoc (DLShfDiag n ℓ) idAr _ _ = refl -⋆Assoc (DLShfDiag n ℓ) singPairL idAr _ = refl -⋆Assoc (DLShfDiag n ℓ) singPairR idAr _ = refl -isSetHom (DLShfDiag n ℓ) = let open DLShfDiagHomPath in (isSetDLShfDiagHom _ _) - - --- a lemma for eliminating pair cases --- when checking that somthing is a cone morphism -module _ {C : Category ℓ ℓ'} {n : ℕ} {F : Functor (DLShfDiag n ℓ'') C} where - open Category - open Functor F - open Cone - - isConeMorSingLemma : {c d : ob C} {f : C [ c , d ]} - (cc : Cone F c) (cd : Cone F d) - → (∀ i → f ⋆⟨ C ⟩ coneOut cd (sing i) ≡ coneOut cc (sing i)) - → isConeMor cc cd f - isConeMorSingLemma cc cd singHyp (sing i) = singHyp i - isConeMorSingLemma {f = f} cc cd singHyp (pair i j i<j) = - f ⋆⟨ C ⟩ coneOut cd (pair i j i<j) - ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) (sym (cd .coneOutCommutes singPairL)) ⟩ - f ⋆⟨ C ⟩ (coneOut cd (sing i) ⋆⟨ C ⟩ F-hom singPairL) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (f ⋆⟨ C ⟩ coneOut cd (sing i)) ⋆⟨ C ⟩ F-hom singPairL - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ F-hom singPairL) (singHyp i) ⟩ - coneOut cc (sing i) ⋆⟨ C ⟩ F-hom singPairL - ≡⟨ cc .coneOutCommutes singPairL ⟩ - coneOut cc (pair i j i<j) ∎ - - -module _ (L' : DistLattice ℓ) where - private - L = fst L' - LCat = (DistLatticeCategory L') ^op - instance - _ = snd L' - - open DistLatticeStr ⦃...⦄ - open Join L' - open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L')) - open PosetStr (IndPoset .snd) hiding (_≤_) - open MeetSemilattice (Lattice→MeetSemilattice (DistLattice→Lattice L')) - using (∧≤RCancel ; ∧≤LCancel) - open Order (DistLattice→Lattice L') - - open Category LCat - open Functor - open Cone - - - FinVec→Diag : {n : ℕ} → FinVec L n → Functor (DLShfDiag n ℓ) LCat - F-ob (FinVec→Diag α) (sing i) = α i - F-ob (FinVec→Diag α) (pair i j _) = α j ∧l α i - F-hom (FinVec→Diag α) idAr = is-refl _ - F-hom (FinVec→Diag α) singPairL = ≤m→≤j _ _ (∧≤LCancel _ _) - F-hom (FinVec→Diag α) singPairR = ≤m→≤j _ _ (∧≤RCancel _ _) - F-id (FinVec→Diag α) = is-prop-valued _ _ _ _ - F-seq (FinVec→Diag α) _ _ = is-prop-valued _ _ _ _ - - ⋁Cone : {n : ℕ} (α : FinVec L n) → Cone (FinVec→Diag α) (⋁ α) - coneOut (⋁Cone α) (sing i) = ind≤⋁ α i - coneOut (⋁Cone α) (pair i _ _) = is-trans _ (α i) _ (≤m→≤j _ _ (∧≤LCancel _ _)) (ind≤⋁ α i) - coneOutCommutes (⋁Cone α) _ = is-prop-valued _ _ _ _ - - isLimCone⋁Cone : {n : ℕ} (α : FinVec L n) → isLimCone (FinVec→Diag α) (⋁ α) (⋁Cone α) - fst (fst (isLimCone⋁Cone α u uCone)) = ⋁IsMax α _ λ i → uCone .coneOut (sing i) - snd (fst (isLimCone⋁Cone α u uCone)) _ = is-prop-valued _ _ _ _ - snd (isLimCone⋁Cone α _ uCone) _ = Σ≡Prop (λ _ → isPropIsConeMor uCone (⋁Cone α) _) - (is-prop-valued _ _ _ _) - - -module PullbacksAsDLShfDiags {ℓ'' : Level} - (C : Category ℓ ℓ') - (cspan : Cospan C) - (pback : Pullback C cspan) where - - open Functor - open Cone - open Cospan ⦃...⦄ - open Pullback ⦃...⦄ - instance - _ = cspan - _ = pback - - cospanAsDiag : Functor (DLShfDiag 2 ℓ'') C - F-ob cospanAsDiag (sing zero) = l - F-ob cospanAsDiag (sing one) = r - F-ob cospanAsDiag (pair _ _ _) = m - F-hom cospanAsDiag idAr = id C - F-hom cospanAsDiag {x = sing zero} singPairL = s₁ - F-hom cospanAsDiag {x = sing one} singPairL = s₂ - F-hom cospanAsDiag {x = sing zero} singPairR = s₁ - F-hom cospanAsDiag {x = sing one} singPairR = s₂ - F-id cospanAsDiag = refl - F-seq cospanAsDiag idAr idAr = sym (⋆IdL C _) - F-seq cospanAsDiag idAr singPairL = sym (⋆IdL C _) - F-seq cospanAsDiag idAr singPairR = sym (⋆IdL C _) - F-seq cospanAsDiag singPairL idAr = sym (⋆IdR C _) - F-seq cospanAsDiag singPairR idAr = sym (⋆IdR C _) - - pbPrAsCone : Cone cospanAsDiag pbOb - coneOut pbPrAsCone (sing zero) = pbPr₁ - coneOut pbPrAsCone (sing one) = pbPr₂ - coneOut pbPrAsCone (pair _ _ _) = pbPr₁ ⋆⟨ C ⟩ s₁ - coneOutCommutes pbPrAsCone idAr = ⋆IdR C _ - coneOutCommutes pbPrAsCone (singPairL {zero}) = refl - coneOutCommutes pbPrAsCone (singPairL {suc zero}) = sym pbCommutes - coneOutCommutes pbPrAsCone (singPairR {zero} {zero}) = refl - coneOutCommutes pbPrAsCone (singPairR {zero} {suc zero}) = sym pbCommutes - coneOutCommutes pbPrAsCone (singPairR {suc zero} {zero}) = refl - coneOutCommutes pbPrAsCone (singPairR {suc zero} {suc zero}) = sym pbCommutes - - pbAsLimit : isLimCone cospanAsDiag pbOb pbPrAsCone - pbAsLimit c cc = uniqueExists (fromPBUnivProp .fst .fst) - toConeMor - (λ _ → isPropIsConeMor cc pbPrAsCone _) - (λ f cf → cong fst (fromPBUnivProp .snd (f , fromConeMor cf))) - where - fromPBUnivProp : ∃![ hk ∈ C [ c , Pullback.pbOb pback ] ] - (coneOut cc (sing zero) ≡ hk ⋆⟨ C ⟩ pbPr₁) × - (coneOut cc (sing one) ≡ hk ⋆⟨ C ⟩ pbPr₂) - fromPBUnivProp = univProp - (cc .coneOut (sing zero)) (cc .coneOut (sing one)) - (cc .coneOutCommutes (singPairL {i<j = s≤s z≤}) ∙ sym (cc .coneOutCommutes singPairR)) - - toConeMor : isConeMor cc pbPrAsCone (fromPBUnivProp .fst .fst) - toConeMor (sing zero) = sym (fromPBUnivProp .fst .snd .fst) - toConeMor (sing one) = sym (fromPBUnivProp .fst .snd .snd) - toConeMor (pair zero j _) = path - where - path : fromPBUnivProp .fst .fst ⋆⟨ C ⟩ (pbPr₁ ⋆⟨ C ⟩ s₁) ≡ cc .coneOut (pair zero j _) - path = fromPBUnivProp .fst .fst ⋆⟨ C ⟩ (pbPr₁ ⋆⟨ C ⟩ s₁) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (fromPBUnivProp .fst .fst ⋆⟨ C ⟩ pbPr₁) ⋆⟨ C ⟩ s₁ - ≡⟨ cong (λ f → f ⋆⟨ C ⟩ s₁) (sym (fromPBUnivProp .fst .snd .fst)) ⟩ - cc .coneOut (sing zero) ⋆⟨ C ⟩ s₁ - ≡⟨ cc .coneOutCommutes singPairL ⟩ - cc .coneOut (pair zero j _) ∎ - toConeMor (pair one j _) = path - where - path : fromPBUnivProp .fst .fst ⋆⟨ C ⟩ (pbPr₁ ⋆⟨ C ⟩ s₁) - ≡ cc .coneOut (pair one j _) - path = fromPBUnivProp .fst .fst ⋆⟨ C ⟩ (pbPr₁ ⋆⟨ C ⟩ s₁) - ≡⟨ cong (λ f → fromPBUnivProp .fst .fst ⋆⟨ C ⟩ f) pbCommutes ⟩ - fromPBUnivProp .fst .fst ⋆⟨ C ⟩ (pbPr₂ ⋆⟨ C ⟩ s₂) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (fromPBUnivProp .fst .fst ⋆⟨ C ⟩ pbPr₂) ⋆⟨ C ⟩ s₂ - ≡⟨ cong (λ f → f ⋆⟨ C ⟩ s₂) (sym (fromPBUnivProp .fst .snd .snd)) ⟩ - cc .coneOut (sing one) ⋆⟨ C ⟩ s₂ - ≡⟨ cc .coneOutCommutes singPairL ⟩ - cc .coneOut (pair one j _) ∎ - - fromConeMor : {f : C [ c , pbOb ]} - → isConeMor cc pbPrAsCone f - → (coneOut cc (sing zero) ≡ f ⋆⟨ C ⟩ pbPr₁) × - (coneOut cc (sing one) ≡ f ⋆⟨ C ⟩ pbPr₂) - fst (fromConeMor cf) = sym (cf (sing zero)) - snd (fromConeMor cf) = sym (cf (sing one)) - - - -module DLShfDiagsAsPullbacks (C : Category ℓ ℓ') - (F : Functor (DLShfDiag 2 ℓ'') C) - (limF : LimCone F) where - - - - open Cospan - open Pullback - open Functor ⦃...⦄ - open Cone ⦃...⦄ - open LimCone ⦃...⦄ - instance - _ = F - _ = limF - _ = limF .limCone - - - DiagAsCospan : Cospan C - l DiagAsCospan = F-ob (sing zero) - m DiagAsCospan = F-ob (pair zero one (s≤s z≤)) - r DiagAsCospan = F-ob (sing one) - s₁ DiagAsCospan = F-hom singPairL - s₂ DiagAsCospan = F-hom singPairR - - LimAsPullback : Pullback C DiagAsCospan - pbOb LimAsPullback = lim - pbPr₁ LimAsPullback = coneOut (sing zero) - pbPr₂ LimAsPullback = coneOut (sing one) - pbCommutes LimAsPullback = coneOutCommutes singPairL ∙ sym (coneOutCommutes singPairR) - univProp LimAsPullback {d = d} f g cSq = - uniqueExists - (fromUnivProp .fst .fst) - (sym (fromUnivProp .fst .snd (sing zero)) , sym (fromUnivProp .fst .snd (sing one))) - (λ _ → isProp× (isSetHom C _ _) (isSetHom C _ _)) - λ h' trs → cong fst (fromUnivProp .snd (h' , toConeMor h' trs)) - where - theCone : Cone F d - Cone.coneOut theCone (sing zero) = f - Cone.coneOut theCone (sing one) = g - Cone.coneOut theCone (pair zero zero ()) - Cone.coneOut theCone (pair zero one (s≤s z≤)) = f ⋆⟨ C ⟩ DiagAsCospan .s₁ - Cone.coneOut theCone (pair one zero ()) - Cone.coneOut theCone (pair one one (s≤s ())) - Cone.coneOutCommutes theCone {u} idAr = cong (seq' C (Cone.coneOut theCone u)) F-id - ∙ ⋆IdR C (Cone.coneOut theCone u) - Cone.coneOutCommutes theCone {sing zero} {pair ._ one (s≤s z≤)} singPairL = refl - Cone.coneOutCommutes theCone {sing one} {pair ._ one (s≤s ())} singPairL - Cone.coneOutCommutes theCone {sing one} {pair zero ._ (s≤s z≤)} singPairR = sym cSq - Cone.coneOutCommutes theCone {sing one} {pair one ._ (s≤s ())} singPairR - - fromUnivProp : ∃![ h ∈ C [ d , lim ] ] isConeMor theCone limCone h - fromUnivProp = LimCone.univProp limF d theCone - - toConeMor : ∀ (h' : C [ d , lim ]) - → (f ≡ h' ⋆⟨ C ⟩ coneOut (sing zero)) × (g ≡ h' ⋆⟨ C ⟩ coneOut (sing one)) - → isConeMor theCone limCone h' - toConeMor h' (tr₁ , tr₂) (sing zero) = sym tr₁ - toConeMor h' (tr₁ , tr₂) (sing one) = sym tr₂ - toConeMor h' (tr₁ , tr₂) (pair zero one (s≤s z≤)) = path - where - path : h' ⋆⟨ C ⟩ coneOut (pair zero one (s≤s z≤)) - ≡ f ⋆⟨ C ⟩ F-hom singPairL - path = h' ⋆⟨ C ⟩ coneOut (pair zero one (s≤s z≤)) - ≡⟨ cong (seq' C h') (sym (coneOutCommutes singPairL)) ⟩ - h' ⋆⟨ C ⟩ (coneOut (sing zero) ⋆⟨ C ⟩ F-hom singPairL) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (h' ⋆⟨ C ⟩ coneOut (sing zero)) ⋆⟨ C ⟩ F-hom singPairL - ≡⟨ cong (λ x → seq' C x (F-hom singPairL)) (sym tr₁) ⟩ - f ⋆⟨ C ⟩ F-hom singPairL ∎ - toConeMor h' (tr₁ , tr₂) (pair one one (s≤s ())) +open import Cubical.Relation.Binary.Order.Poset + +open import Cubical.Categories.Category +open import Cubical.Categories.Functor +open import Cubical.Categories.Limits.Limits +open import Cubical.Categories.Limits.Pullback +open import Cubical.Categories.Instances.DistLattice + +open import Cubical.Algebra.DistLattice +open import Cubical.Algebra.Lattice +open import Cubical.Algebra.Semilattice +open import Cubical.Algebra.DistLattice.BigOps + +private + variable + ℓ ℓ' ℓ'' : Level + +module _ {ℓ : Level} where + data DLShfDiagOb (n : ℕ) : Type ℓ where + sing : Fin n → DLShfDiagOb n + pair : (i j : Fin n) → i < j → DLShfDiagOb n + + data DLShfDiagHom (n : ℕ) : DLShfDiagOb n → DLShfDiagOb n → Type ℓ where + idAr : {x : DLShfDiagOb n} → DLShfDiagHom n x x + singPairL : {i j : Fin n} {i<j : i < j} → DLShfDiagHom n (sing i) (pair i j i<j) + singPairR : {i j : Fin n} {i<j : i < j}→ DLShfDiagHom n (sing j) (pair i j i<j) + + + module DLShfDiagHomPath where + variable + n : ℕ + + -- DLShfDiagHom n x y is a retract of Code x y + Code : (x y : DLShfDiagOb n) → Type + Code (sing i) (sing j) = i ≡ j + Code (sing i) (pair j k j<k) = + (Σ[ p ∈ (i ≡ j) ] Σ[ i<k ∈ i < k ] PathP (λ ι → p ι < k) i<k j<k) + ⊎ (Σ[ p ∈ (i ≡ k) ] Σ[ j<i ∈ j < i ] PathP (λ ι → j < p ι) j<i j<k) + Code (pair i j i<j) (sing k) = ⊥ + Code (pair i j i<j) (pair k l k<l) = + Σ[ p ∈ (i ≡ k) × (j ≡ l) ] PathP (λ ι → fst p ι < snd p ι) i<j k<l + + isSetCode : ∀ (x y : DLShfDiagOb n) → isSet (Code x y) + isSetCode (sing _) (sing _) = isProp→isSet (isSetFin _ _) + isSetCode (sing i) (pair j k j<k) = + isSet⊎ + (isSetΣ (isProp→isSet (isSetFin _ _)) + λ _ → isSetΣ (isProp→isSet (≤'FinIsPropValued _ _)) + λ _ → isOfHLevelPathP 2 (isProp→isSet (≤'FinIsPropValued _ _)) _ _) + (isSetΣ (isProp→isSet (isSetFin _ _)) + λ _ → isSetΣ (isProp→isSet (≤'FinIsPropValued _ _)) + λ _ → isOfHLevelPathP 2 (isProp→isSet (≤'FinIsPropValued _ _)) _ _) + isSetCode (pair _ _ _) (sing _) = isProp→isSet isProp⊥ + isSetCode (pair _ _ _) (pair _ _ _) = + isSetΣ + (isSet× (isProp→isSet (isSetFin _ _)) (isProp→isSet (isSetFin _ _))) + λ _ → isOfHLevelPathP 2 (isProp→isSet (≤'FinIsPropValued _ _)) _ _ + + encode : (x y : DLShfDiagOb n) → DLShfDiagHom n x y → Code x y + encode (sing i) (sing .i) idAr = refl + encode (sing i) (pair .i j i<j) singPairL = inl (refl , i<j , refl) + encode (sing j) (pair i .j i<j) singPairR = inr (refl , i<j , refl) + encode (pair i j i<j) (pair .i .j .i<j) idAr = (refl , refl) , refl + + decode : (x y : DLShfDiagOb n) → Code x y → DLShfDiagHom n x y + decode (sing i) (sing j) p = subst (λ k → DLShfDiagHom _ (sing i) (sing k)) p idAr + decode (sing i) (pair j k j<k) (inl (p , i<k , q)) = + transport (λ ι → DLShfDiagHom _ (sing i) (pair (p ι) k (q ι))) singPairL + decode (sing i) (pair k j k<j) (inr (p , k<i , q)) = + transport (λ ι → DLShfDiagHom _ (sing i) (pair k (p ι) (q ι))) singPairR + decode (pair i j i<j) (pair k l k<l) (_ , p) = + transport (λ ι → DLShfDiagHom _ (pair _ _ i<j) (pair _ _ (p ι))) idAr + + codeRetract : ∀ (x y : DLShfDiagOb n) (f : DLShfDiagHom n x y) + → decode x y (encode x y f) ≡ f + codeRetract (sing i) (sing .i) idAr = transportRefl idAr + codeRetract (sing i) (pair .i k i<k) singPairL = transportRefl singPairL + codeRetract (sing i) (pair j .i j<i) singPairR = transportRefl singPairR + codeRetract (pair i j i<j) (pair .i .j .i<j) idAr = transportRefl idAr + + isSetDLShfDiagHom : ∀ (x y : DLShfDiagOb n) → isSet (DLShfDiagHom n x y) + isSetDLShfDiagHom x y = isSetRetract (encode x y) (decode x y) + (codeRetract x y) (isSetCode x y) + + + +open Category +DLShfDiag : ℕ → (ℓ : Level) → Category ℓ ℓ +ob (DLShfDiag n ℓ) = DLShfDiagOb n +Hom[_,_] (DLShfDiag n ℓ) = DLShfDiagHom n +id (DLShfDiag n ℓ) = idAr +_⋆_ (DLShfDiag n ℓ) idAr f = f +_⋆_ (DLShfDiag n ℓ) singPairL idAr = singPairL +_⋆_ (DLShfDiag n ℓ) singPairR idAr = singPairR +⋆IdL (DLShfDiag n ℓ) _ = refl +⋆IdR (DLShfDiag n ℓ) idAr = refl +⋆IdR (DLShfDiag n ℓ) singPairL = refl +⋆IdR (DLShfDiag n ℓ) singPairR = refl +⋆Assoc (DLShfDiag n ℓ) idAr _ _ = refl +⋆Assoc (DLShfDiag n ℓ) singPairL idAr _ = refl +⋆Assoc (DLShfDiag n ℓ) singPairR idAr _ = refl +isSetHom (DLShfDiag n ℓ) = let open DLShfDiagHomPath in (isSetDLShfDiagHom _ _) + + +-- a lemma for eliminating pair cases +-- when checking that somthing is a cone morphism +module _ {C : Category ℓ ℓ'} {n : ℕ} {F : Functor (DLShfDiag n ℓ'') C} where + open Category + open Functor F + open Cone + + isConeMorSingLemma : {c d : ob C} {f : C [ c , d ]} + (cc : Cone F c) (cd : Cone F d) + → (∀ i → f ⋆⟨ C ⟩ coneOut cd (sing i) ≡ coneOut cc (sing i)) + → isConeMor cc cd f + isConeMorSingLemma cc cd singHyp (sing i) = singHyp i + isConeMorSingLemma {f = f} cc cd singHyp (pair i j i<j) = + f ⋆⟨ C ⟩ coneOut cd (pair i j i<j) + ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) (sym (cd .coneOutCommutes singPairL)) ⟩ + f ⋆⟨ C ⟩ (coneOut cd (sing i) ⋆⟨ C ⟩ F-hom singPairL) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (f ⋆⟨ C ⟩ coneOut cd (sing i)) ⋆⟨ C ⟩ F-hom singPairL + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ F-hom singPairL) (singHyp i) ⟩ + coneOut cc (sing i) ⋆⟨ C ⟩ F-hom singPairL + ≡⟨ cc .coneOutCommutes singPairL ⟩ + coneOut cc (pair i j i<j) ∎ + + +module _ (L' : DistLattice ℓ) where + private + L = fst L' + LCat = (DistLatticeCategory L') ^op + instance + _ = snd L' + + open DistLatticeStr ⦃...⦄ + open Join L' + open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L')) + open PosetStr (IndPoset .snd) hiding (_≤_) + open MeetSemilattice (Lattice→MeetSemilattice (DistLattice→Lattice L')) + using (∧≤RCancel ; ∧≤LCancel) + open Order (DistLattice→Lattice L') + + open Category LCat + open Functor + open Cone + + + FinVec→Diag : {n : ℕ} → FinVec L n → Functor (DLShfDiag n ℓ) LCat + F-ob (FinVec→Diag α) (sing i) = α i + F-ob (FinVec→Diag α) (pair i j _) = α j ∧l α i + F-hom (FinVec→Diag α) idAr = is-refl _ + F-hom (FinVec→Diag α) singPairL = ≤m→≤j _ _ (∧≤LCancel _ _) + F-hom (FinVec→Diag α) singPairR = ≤m→≤j _ _ (∧≤RCancel _ _) + F-id (FinVec→Diag α) = is-prop-valued _ _ _ _ + F-seq (FinVec→Diag α) _ _ = is-prop-valued _ _ _ _ + + ⋁Cone : {n : ℕ} (α : FinVec L n) → Cone (FinVec→Diag α) (⋁ α) + coneOut (⋁Cone α) (sing i) = ind≤⋁ α i + coneOut (⋁Cone α) (pair i _ _) = is-trans _ (α i) _ (≤m→≤j _ _ (∧≤LCancel _ _)) (ind≤⋁ α i) + coneOutCommutes (⋁Cone α) _ = is-prop-valued _ _ _ _ + + isLimCone⋁Cone : {n : ℕ} (α : FinVec L n) → isLimCone (FinVec→Diag α) (⋁ α) (⋁Cone α) + fst (fst (isLimCone⋁Cone α u uCone)) = ⋁IsMax α _ λ i → uCone .coneOut (sing i) + snd (fst (isLimCone⋁Cone α u uCone)) _ = is-prop-valued _ _ _ _ + snd (isLimCone⋁Cone α _ uCone) _ = Σ≡Prop (λ _ → isPropIsConeMor uCone (⋁Cone α) _) + (is-prop-valued _ _ _ _) + + +module PullbacksAsDLShfDiags {ℓ'' : Level} + (C : Category ℓ ℓ') + (cspan : Cospan C) + (pback : Pullback C cspan) where + + open Functor + open Cone + open Cospan ⦃...⦄ + open Pullback ⦃...⦄ + instance + _ = cspan + _ = pback + + cospanAsDiag : Functor (DLShfDiag 2 ℓ'') C + F-ob cospanAsDiag (sing zero) = l + F-ob cospanAsDiag (sing one) = r + F-ob cospanAsDiag (pair _ _ _) = m + F-hom cospanAsDiag idAr = id C + F-hom cospanAsDiag {x = sing zero} singPairL = s₁ + F-hom cospanAsDiag {x = sing one} singPairL = s₂ + F-hom cospanAsDiag {x = sing zero} singPairR = s₁ + F-hom cospanAsDiag {x = sing one} singPairR = s₂ + F-id cospanAsDiag = refl + F-seq cospanAsDiag idAr idAr = sym (⋆IdL C _) + F-seq cospanAsDiag idAr singPairL = sym (⋆IdL C _) + F-seq cospanAsDiag idAr singPairR = sym (⋆IdL C _) + F-seq cospanAsDiag singPairL idAr = sym (⋆IdR C _) + F-seq cospanAsDiag singPairR idAr = sym (⋆IdR C _) + + pbPrAsCone : Cone cospanAsDiag pbOb + coneOut pbPrAsCone (sing zero) = pbPr₁ + coneOut pbPrAsCone (sing one) = pbPr₂ + coneOut pbPrAsCone (pair _ _ _) = pbPr₁ ⋆⟨ C ⟩ s₁ + coneOutCommutes pbPrAsCone idAr = ⋆IdR C _ + coneOutCommutes pbPrAsCone (singPairL {zero}) = refl + coneOutCommutes pbPrAsCone (singPairL {suc zero}) = sym pbCommutes + coneOutCommutes pbPrAsCone (singPairR {zero} {zero}) = refl + coneOutCommutes pbPrAsCone (singPairR {zero} {suc zero}) = sym pbCommutes + coneOutCommutes pbPrAsCone (singPairR {suc zero} {zero}) = refl + coneOutCommutes pbPrAsCone (singPairR {suc zero} {suc zero}) = sym pbCommutes + + pbAsLimit : isLimCone cospanAsDiag pbOb pbPrAsCone + pbAsLimit c cc = uniqueExists (fromPBUnivProp .fst .fst) + toConeMor + (λ _ → isPropIsConeMor cc pbPrAsCone _) + (λ f cf → cong fst (fromPBUnivProp .snd (f , fromConeMor cf))) + where + fromPBUnivProp : ∃![ hk ∈ C [ c , Pullback.pbOb pback ] ] + (coneOut cc (sing zero) ≡ hk ⋆⟨ C ⟩ pbPr₁) × + (coneOut cc (sing one) ≡ hk ⋆⟨ C ⟩ pbPr₂) + fromPBUnivProp = univProp + (cc .coneOut (sing zero)) (cc .coneOut (sing one)) + (cc .coneOutCommutes (singPairL {i<j = s≤s z≤}) ∙ sym (cc .coneOutCommutes singPairR)) + + toConeMor : isConeMor cc pbPrAsCone (fromPBUnivProp .fst .fst) + toConeMor (sing zero) = sym (fromPBUnivProp .fst .snd .fst) + toConeMor (sing one) = sym (fromPBUnivProp .fst .snd .snd) + toConeMor (pair zero j _) = path + where + path : fromPBUnivProp .fst .fst ⋆⟨ C ⟩ (pbPr₁ ⋆⟨ C ⟩ s₁) ≡ cc .coneOut (pair zero j _) + path = fromPBUnivProp .fst .fst ⋆⟨ C ⟩ (pbPr₁ ⋆⟨ C ⟩ s₁) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (fromPBUnivProp .fst .fst ⋆⟨ C ⟩ pbPr₁) ⋆⟨ C ⟩ s₁ + ≡⟨ cong (λ f → f ⋆⟨ C ⟩ s₁) (sym (fromPBUnivProp .fst .snd .fst)) ⟩ + cc .coneOut (sing zero) ⋆⟨ C ⟩ s₁ + ≡⟨ cc .coneOutCommutes singPairL ⟩ + cc .coneOut (pair zero j _) ∎ + toConeMor (pair one j _) = path + where + path : fromPBUnivProp .fst .fst ⋆⟨ C ⟩ (pbPr₁ ⋆⟨ C ⟩ s₁) + ≡ cc .coneOut (pair one j _) + path = fromPBUnivProp .fst .fst ⋆⟨ C ⟩ (pbPr₁ ⋆⟨ C ⟩ s₁) + ≡⟨ cong (λ f → fromPBUnivProp .fst .fst ⋆⟨ C ⟩ f) pbCommutes ⟩ + fromPBUnivProp .fst .fst ⋆⟨ C ⟩ (pbPr₂ ⋆⟨ C ⟩ s₂) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (fromPBUnivProp .fst .fst ⋆⟨ C ⟩ pbPr₂) ⋆⟨ C ⟩ s₂ + ≡⟨ cong (λ f → f ⋆⟨ C ⟩ s₂) (sym (fromPBUnivProp .fst .snd .snd)) ⟩ + cc .coneOut (sing one) ⋆⟨ C ⟩ s₂ + ≡⟨ cc .coneOutCommutes singPairL ⟩ + cc .coneOut (pair one j _) ∎ + + fromConeMor : {f : C [ c , pbOb ]} + → isConeMor cc pbPrAsCone f + → (coneOut cc (sing zero) ≡ f ⋆⟨ C ⟩ pbPr₁) × + (coneOut cc (sing one) ≡ f ⋆⟨ C ⟩ pbPr₂) + fst (fromConeMor cf) = sym (cf (sing zero)) + snd (fromConeMor cf) = sym (cf (sing one)) + + + +module DLShfDiagsAsPullbacks (C : Category ℓ ℓ') + (F : Functor (DLShfDiag 2 ℓ'') C) + (limF : LimCone F) where + + + + open Cospan + open Pullback + open Functor ⦃...⦄ + open Cone ⦃...⦄ + open LimCone ⦃...⦄ + instance + _ = F + _ = limF + _ = limF .limCone + + + DiagAsCospan : Cospan C + l DiagAsCospan = F-ob (sing zero) + m DiagAsCospan = F-ob (pair zero one (s≤s z≤)) + r DiagAsCospan = F-ob (sing one) + s₁ DiagAsCospan = F-hom singPairL + s₂ DiagAsCospan = F-hom singPairR + + LimAsPullback : Pullback C DiagAsCospan + pbOb LimAsPullback = lim + pbPr₁ LimAsPullback = coneOut (sing zero) + pbPr₂ LimAsPullback = coneOut (sing one) + pbCommutes LimAsPullback = coneOutCommutes singPairL ∙ sym (coneOutCommutes singPairR) + univProp LimAsPullback {d = d} f g cSq = + uniqueExists + (fromUnivProp .fst .fst) + (sym (fromUnivProp .fst .snd (sing zero)) , sym (fromUnivProp .fst .snd (sing one))) + (λ _ → isProp× (isSetHom C _ _) (isSetHom C _ _)) + λ h' trs → cong fst (fromUnivProp .snd (h' , toConeMor h' trs)) + where + theCone : Cone F d + Cone.coneOut theCone (sing zero) = f + Cone.coneOut theCone (sing one) = g + Cone.coneOut theCone (pair zero zero ()) + Cone.coneOut theCone (pair zero one (s≤s z≤)) = f ⋆⟨ C ⟩ DiagAsCospan .s₁ + Cone.coneOut theCone (pair one zero ()) + Cone.coneOut theCone (pair one one (s≤s ())) + Cone.coneOutCommutes theCone {u} idAr = cong (seq' C (Cone.coneOut theCone u)) F-id + ∙ ⋆IdR C (Cone.coneOut theCone u) + Cone.coneOutCommutes theCone {sing zero} {pair ._ one (s≤s z≤)} singPairL = refl + Cone.coneOutCommutes theCone {sing one} {pair ._ one (s≤s ())} singPairL + Cone.coneOutCommutes theCone {sing one} {pair zero ._ (s≤s z≤)} singPairR = sym cSq + Cone.coneOutCommutes theCone {sing one} {pair one ._ (s≤s ())} singPairR + + fromUnivProp : ∃![ h ∈ C [ d , lim ] ] isConeMor theCone limCone h + fromUnivProp = LimCone.univProp limF d theCone + + toConeMor : ∀ (h' : C [ d , lim ]) + → (f ≡ h' ⋆⟨ C ⟩ coneOut (sing zero)) × (g ≡ h' ⋆⟨ C ⟩ coneOut (sing one)) + → isConeMor theCone limCone h' + toConeMor h' (tr₁ , tr₂) (sing zero) = sym tr₁ + toConeMor h' (tr₁ , tr₂) (sing one) = sym tr₂ + toConeMor h' (tr₁ , tr₂) (pair zero one (s≤s z≤)) = path + where + path : h' ⋆⟨ C ⟩ coneOut (pair zero one (s≤s z≤)) + ≡ f ⋆⟨ C ⟩ F-hom singPairL + path = h' ⋆⟨ C ⟩ coneOut (pair zero one (s≤s z≤)) + ≡⟨ cong (seq' C h') (sym (coneOutCommutes singPairL)) ⟩ + h' ⋆⟨ C ⟩ (coneOut (sing zero) ⋆⟨ C ⟩ F-hom singPairL) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (h' ⋆⟨ C ⟩ coneOut (sing zero)) ⋆⟨ C ⟩ F-hom singPairL + ≡⟨ cong (λ x → seq' C x (F-hom singPairL)) (sym tr₁) ⟩ + f ⋆⟨ C ⟩ F-hom singPairL ∎ + toConeMor h' (tr₁ , tr₂) (pair one one (s≤s ())) \ No newline at end of file diff --git a/Cubical.Categories.DistLatticeSheaf.Extension.html b/Cubical.Categories.DistLatticeSheaf.Extension.html index 1721fe46b9..27bf25e700 100644 --- a/Cubical.Categories.DistLatticeSheaf.Extension.html +++ b/Cubical.Categories.DistLatticeSheaf.Extension.html @@ -24,1009 +24,1009 @@ open import Cubical.Data.FinData.Order open import Cubical.Data.Sum -open import Cubical.Relation.Binary.Poset -open import Cubical.HITs.PropositionalTruncation - -open import Cubical.Algebra.Semilattice -open import Cubical.Algebra.Lattice -open import Cubical.Algebra.DistLattice -open import Cubical.Algebra.DistLattice.Basis -open import Cubical.Algebra.DistLattice.BigOps - -open import Cubical.Categories.Category.Base -open import Cubical.Categories.Functor -open import Cubical.Categories.NaturalTransformation -open import Cubical.Categories.Limits.Limits -open import Cubical.Categories.Limits.Pullback -open import Cubical.Categories.Limits.Terminal -open import Cubical.Categories.Limits.RightKan -open import Cubical.Categories.Instances.Poset -open import Cubical.Categories.Instances.Semilattice -open import Cubical.Categories.Instances.Lattice -open import Cubical.Categories.Instances.DistLattice - -open import Cubical.Categories.DistLatticeSheaf.Diagram -open import Cubical.Categories.DistLatticeSheaf.Base - -private - variable - ℓ ℓ' ℓ'' : Level - - -module PreSheafExtension (L : DistLattice ℓ) (C : Category ℓ' ℓ'') - (limitC : Limits {ℓ} {ℓ} C) (L' : ℙ (fst L)) where - - open Category hiding (_∘_) - open Functor - open Cone - open LimCone - - private - DLCat = DistLatticeCategory L - DLSubCat = ΣPropCat DLCat L' - DLPreSheaf = Functor (DLCat ^op) C - DLSubPreSheaf = Functor (DLSubCat ^op) C - - baseIncl : Functor DLSubCat DLCat - F-ob baseIncl = fst - F-hom baseIncl f = f - F-id baseIncl = refl - F-seq baseIncl _ _ = refl - - DLRan : DLSubPreSheaf → DLPreSheaf - DLRan = Ran limitC (baseIncl ^opF) - - DLRanNatTrans : (F : DLSubPreSheaf) → NatTrans (funcComp (DLRan F) (baseIncl ^opF)) F - DLRanNatTrans = RanNatTrans _ _ - - DLRanUnivProp : ∀ (F : DLSubPreSheaf) (G : DLPreSheaf) (α : NatTrans (G ∘F (baseIncl ^opF)) F) - → ∃![ σ ∈ NatTrans G (DLRan F) ] α ≡ (σ ∘ˡ (baseIncl ^opF)) ●ᵛ (DLRanNatTrans F) - DLRanUnivProp = RanUnivProp _ _ - - DLRanNatIso : (F : DLSubPreSheaf) → NatIso (funcComp (DLRan F) (baseIncl ^opF)) F - DLRanNatIso F = RanNatIso _ _ _ (λ _ _ → idIsEquiv _) - - module _ (isBasisL' : IsBasis L L') (F : DLSubPreSheaf) - (isSheafF : SheafOnBasis.isDLBasisSheaf L C L' isBasisL' F) where - open SheafOnBasis L C L' isBasisL' - open Order (DistLattice→Lattice L) - open DistLatticeStr (snd L) - open Join L - open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L)) - open MeetSemilattice (Lattice→MeetSemilattice (DistLattice→Lattice L)) - using (∧≤RCancel ; ∧≤LCancel ; ≤-∧Pres ; ≤-∧RPres ; ≤-∧LPres) - open PosetStr (IndPoset .snd) hiding (_≤_; is-set) - open IsBasis ⦃...⦄ - open EquivalenceOfDefs L C (DLRan F) - open condCone - - private - instance - _ = isBasisL' - - F* = T* limitC (baseIncl ^opF) F - - -- a neat lemma - F≤PathPLemmaBase : ∀ {x y z w : ob DLSubCat} (p : x ≡ y) (q : z ≡ w) - (x≥z : (DLSubCat ^op) [ x , z ]) (y≥w : (DLSubCat ^op) [ y , w ]) - → PathP (λ i → C [ F .F-ob (p i) , F .F-ob (q i) ]) (F .F-hom x≥z) (F .F-hom y≥w) - F≤PathPLemmaBase p q x≥z y≥w i = - F .F-hom (isProp→PathP (λ j → is-prop-valued (q j .fst) (p j .fst)) x≥z y≥w i) - - - -- the crucial lemmas that will give us the cones needed to construct the unique - -- arrow in our pullback square below - module _ {n : ℕ} (α : FinVec (fst L) n) (α∈L' : ∀ i → α i ∈ L') where - private -- from the definition of the can extension - ⋁α↓ = _↓Diag limitC (baseIncl ^opF) F (⋁ α) - F[⋁α]Cone = limitC ⋁α↓ (F* (⋁ α)) .limCone - - -- notation that will be used throughout the file. - -- this is the restriction of the limiting cone through which we define - -- the Kan-extension to the αᵢ's - restCone : Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) (DLRan F .F-ob (⋁ α)) - coneOut restCone (sing i) = F[⋁α]Cone .coneOut ((α i , α∈L' i) , ind≤⋁ α i) - coneOut restCone (pair i j i<j) = F[⋁α]Cone .coneOut - ((α i ∧l α j , ∧lClosed _ _ (α∈L' i) (α∈L' j)) - , is-trans _ (α i) _ (≤m→≤j _ _ (∧≤RCancel _ _)) (ind≤⋁ α i)) - coneOutCommutes restCone {u = sing i} idAr = F[⋁α]Cone .coneOutCommutes - (is-refl _ , is-prop-valued _ _ _ _) - coneOutCommutes restCone {u = pair i j i<j} idAr = F[⋁α]Cone .coneOutCommutes - (is-refl _ , is-prop-valued _ _ _ _) - coneOutCommutes restCone singPairL = F[⋁α]Cone .coneOutCommutes - (≤m→≤j _ _ (∧≤RCancel _ _) , is-prop-valued _ _ _ _) - coneOutCommutes restCone singPairR = F[⋁α]Cone .coneOutCommutes - (≤m→≤j _ _ (∧≤LCancel _ _) , is-prop-valued _ _ _ _) - - -- super technical stuff culminating in the last lemma, - -- which will be the only one used. Lemma 1-3 are therefore private - private - -- notation for applying the hypothesis that we have a sheaf on the basis - β : (u : fst L) → FinVec (fst L) n - β u i = u ∧l α i - - β∈L' : ∀ (u : fst L) → u ∈ L' → ∀ i → β u i ∈ L' - β∈L' u u∈L' i = ∧lClosed _ _ u∈L' (α∈L' i) - - β≡ : ∀ (u : fst L) → u ≤ ⋁ α → u ≡ ⋁ (β u) - β≡ u u≤⋁α = sym (≤j→≤m _ _ u≤⋁α) ∙ ⋁Meetrdist _ _ - - ⋁β∈L' : ∀ (u : fst L) → u ∈ L' → u ≤ ⋁ α → ⋁ (β u) ∈ L' - ⋁β∈L' u u∈L' u≤⋁α = subst-∈ L' (β≡ u u≤⋁α) u∈L' - - βCone : (c : ob C) (u : fst L) (u∈L' : u ∈ L') - → Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c - → Cone (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i))) c - coneOut (βCone c u u∈L' cc) (sing i) = coneOut cc (sing i) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - coneOut (βCone c u u∈L' cc) (pair i j i<j) = coneOut cc (pair i j i<j) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _))) - coneOutCommutes (βCone c u u∈L' cc) {u = v} idAr = - cong (λ x → coneOut (βCone c u u∈L' cc) v ⋆⟨ C ⟩ x) - (F-id (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i)))) - ∙ ⋆IdR C _ - coneOutCommutes (βCone c u u∈L' cc) (singPairL {i = i} {j} {i<j}) = - coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i)) .F-hom singPairL) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - coneOut cc (sing i) ⋆⟨ C ⟩ (F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i)) .F-hom singPairL)) - ≡⟨ cong (λ x → coneOut cc (sing i) ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ - coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom - (≤m→≤j _ _ (∧≤LCancel _ _) ⋆⟨ DLCat ^op ⟩ - (BDiag (λ i → β u i , β∈L' u u∈L' i) .F-hom (singPairL {i = i} {j} {i<j}))) - ≡⟨ cong (λ x → coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom - {y = β u i ∧l β u j , ∧lClosed _ _ (β∈L' u u∈L' i) (β∈L' u u∈L' j)} x) - (is-prop-valued _ _ _ _) ⟩ - coneOut cc (sing i) - ⋆⟨ C ⟩ F .F-hom ((BDiag (λ i → α i , α∈L' i)) .F-hom (singPairL {i = i} {j} {i<j}) - ⋆⟨ DLCat ^op ⟩ ≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _))) - ≡⟨ cong (λ x → coneOut cc (sing i) ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ - coneOut cc (sing i) - ⋆⟨ C ⟩ ((funcComp F (BDiag (λ i → α i , α∈L' i)) .F-hom (singPairL {i = i} {j} {i<j})) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (coneOut cc (sing i) - ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → α i , α∈L' i)) .F-hom (singPairL {i = i} {j} {i<j}))) - ⋆⟨ C ⟩ F .F-hom ((≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ F .F-hom - {y = β u i ∧l β u j , ∧lClosed _ _ (β∈L' u u∈L' i) (β∈L' u u∈L' j)} - (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) - (coneOutCommutes cc (singPairL {i = i} {j} {i<j})) ⟩ - coneOut (βCone c u u∈L' cc) (pair i j i<j) ∎ - - coneOutCommutes (βCone c u u∈L' cc) (singPairR {i = i} {j} {i<j}) = - coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i)) .F-hom singPairR) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - coneOut cc (sing j) ⋆⟨ C ⟩ (F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i)) .F-hom singPairR)) - ≡⟨ cong (λ x → coneOut cc (sing j) ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ - coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom - (≤m→≤j _ _ (∧≤LCancel _ _) ⋆⟨ DLCat ^op ⟩ - (BDiag (λ i → β u i , β∈L' u u∈L' i) .F-hom (singPairR {i = i} {j} {i<j}))) - ≡⟨ cong (λ x → coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom - {y = β u i ∧l β u j , ∧lClosed _ _ (β∈L' u u∈L' i) (β∈L' u u∈L' j)} x) - (is-prop-valued _ _ _ _) ⟩ - coneOut cc (sing j) - ⋆⟨ C ⟩ F .F-hom ((BDiag (λ i → α i , α∈L' i)) .F-hom (singPairR {i = i} {j} {i<j}) - ⋆⟨ DLCat ^op ⟩ ≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _))) - ≡⟨ cong (λ x → coneOut cc (sing j) ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ - coneOut cc (sing j) - ⋆⟨ C ⟩ ((funcComp F (BDiag (λ i → α i , α∈L' i)) .F-hom (singPairR {i = i} {j} {i<j})) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (coneOut cc (sing j) - ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → α i , α∈L' i)) .F-hom (singPairR {i = i} {j} {i<j}))) - ⋆⟨ C ⟩ F .F-hom ((≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ F .F-hom - {y = β u i ∧l β u j , ∧lClosed _ _ (β∈L' u u∈L' i) (β∈L' u u∈L' j)} - (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) - (coneOutCommutes cc (singPairR {i = i} {j} {i<j})) ⟩ - coneOut (βCone c u u∈L' cc) (pair i j i<j) ∎ - - - -- this is the crucial application of our assumption that F is a sheaf on L' - uniqβConeMor : (c : ob C) (cc : Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c) - (u : fst L) (u∈L' : u ∈ L') (u≤⋁α : u ≤ ⋁ α) - → ∃![ f ∈ C [ c , F .F-ob (⋁ (β u) , ⋁β∈L' u u∈L' u≤⋁α) ] ] - (isConeMor (βCone c u u∈L' cc) - (F-cone F (B⋁Cone (λ i → β u i , β∈L' u u∈L' i) (⋁β∈L' u u∈L' u≤⋁α))) f) - uniqβConeMor c cc u u∈L' u≤⋁α = - isSheafF (λ i → β u i , β∈L' u u∈L' i) (⋁β∈L' u u∈L' u≤⋁α) c (βCone c u u∈L' cc) - - - -- the lemma giving us the desired cone - lemma1 : (c : ob C) → Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c → Cone (F* (⋁ α)) c - coneOut (lemma1 c cc) ((u , u∈L') , u≤⋁α) = - subst (λ x → C [ c , F .F-ob x ]) - (Σ≡Prop (λ x → L' x .snd) {u = _ , ⋁β∈L' u u∈L' u≤⋁α} (sym (β≡ u u≤⋁α))) - (uniqβConeMor c cc u u∈L' u≤⋁α .fst .fst) - coneOutCommutes (lemma1 c cc) {u = ((u , u∈L') , u≤⋁α)} {v = ((v , v∈L') , v≤⋁α)} (v≤u , p) = - transport (λ i → fᵤPathP i ⋆⟨ C ⟩ ePathP i ≡ fᵥPathP i) triangle - where - e : C [ F .F-ob (⋁ (β u) , ⋁β∈L' u u∈L' u≤⋁α) , F .F-ob (⋁ (β v) , ⋁β∈L' v v∈L' v≤⋁α) ] - e = F .F-hom (subst2 _≤_ (β≡ v v≤⋁α) (β≡ u u≤⋁α) v≤u) -- F(⋁βᵥ≤⋁βᵤ) - - fᵤ : C [ c , F .F-ob (⋁ (β u) , ⋁β∈L' u u∈L' u≤⋁α) ] - fᵤ = uniqβConeMor c cc u u∈L' u≤⋁α .fst .fst - - fᵥ : C [ c , F .F-ob (⋁ (β v) , ⋁β∈L' v v∈L' v≤⋁α) ] - fᵥ = uniqβConeMor c cc v v∈L' v≤⋁α .fst .fst - - -- for convenience - pᵤ = (Σ≡Prop (λ x → L' x .snd) {u = _ , ⋁β∈L' u u∈L' u≤⋁α} (sym (β≡ u u≤⋁α))) - pᵥ = (Σ≡Prop (λ x → L' x .snd) {u = _ , ⋁β∈L' v v∈L' v≤⋁α} (sym (β≡ v v≤⋁α))) - - fᵤPathP : PathP (λ i → C [ c , F .F-ob (pᵤ i) ]) - fᵤ (coneOut (lemma1 c cc) ((u , u∈L') , u≤⋁α)) - fᵤPathP = subst-filler (λ x → C [ c , F .F-ob x ]) pᵤ fᵤ - - fᵥPathP : PathP (λ i → C [ c , F .F-ob (pᵥ i) ]) - fᵥ (coneOut (lemma1 c cc) ((v , v∈L') , v≤⋁α)) - fᵥPathP = subst-filler (λ x → C [ c , F .F-ob x ]) pᵥ fᵥ - - ePathP : PathP (λ i → C [ F .F-ob (pᵤ i) , F .F-ob (pᵥ i) ]) e (F .F-hom v≤u) - ePathP i = F .F-hom (subst2-filler (_≤_) (β≡ v v≤⋁α) (β≡ u u≤⋁α) v≤u (~ i)) - - - -- triangle to be transported by universal property - triangle : fᵤ ⋆⟨ C ⟩ e ≡ fᵥ - triangle = sym (cong fst (uniqβConeMor c cc v v∈L' v≤⋁α .snd (fᵤ ⋆⟨ C ⟩ e , compIsConeMor))) - where - compIsConeMor : isConeMor (βCone c v v∈L' cc) - (F-cone F (B⋁Cone (λ i → β v i , β∈L' v v∈L' i) (⋁β∈L' v v∈L' v≤⋁α))) - (fᵤ ⋆⟨ C ⟩ e) - compIsConeMor = isConeMorSingLemma - (βCone c v v∈L' cc) - (F-cone F (B⋁Cone (λ i → β v i , β∈L' v v∈L' i) (⋁β∈L' v v∈L' v≤⋁α))) - singCase - where - singCase : ∀ i → (fᵤ ⋆⟨ C ⟩ e) ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β v) i) - ≡ coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j (v ∧l α i) (α i) (∧≤LCancel _ _)) - singCase i = - (fᵤ ⋆⟨ C ⟩ e) ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β v) i) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - fᵤ ⋆⟨ C ⟩ (e ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β v) i)) - ≡⟨ cong (λ x → fᵤ ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ - fᵤ ⋆⟨ C ⟩ F .F-hom - (subst2 _≤_ (β≡ v v≤⋁α) (β≡ u u≤⋁α) v≤u ⋆⟨ DLCat ^op ⟩ ind≤⋁ (β v) i) - ≡⟨ cong (λ x → fᵤ ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ v∈L' (α∈L' i)} x) - (is-prop-valued _ _ _ _) ⟩ - fᵤ ⋆⟨ C ⟩ F .F-hom - (ind≤⋁ (β u) i ⋆⟨ DLCat ^op ⟩ ≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u))) - ≡⟨ cong (λ x → fᵤ ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ - fᵤ ⋆⟨ C ⟩ (F .F-hom {y = _ , ∧lClosed _ _ u∈L' (α∈L' i)} (ind≤⋁ (β u) i) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u)))) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (fᵤ ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ u∈L' (α∈L' i)} (ind≤⋁ (β u) i)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u))) - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u)))) - (uniqβConeMor c cc u u∈L' u≤⋁α .fst .snd (sing i)) ⟩ - (coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ u∈L' (α∈L' i)} - (≤m→≤j (u ∧l α i) (α i) (∧≤LCancel _ _))) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u))) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - coneOut cc (sing i) ⋆⟨ C ⟩ (F .F-hom {y = _ , ∧lClosed _ _ u∈L' (α∈L' i)} - (≤m→≤j (u ∧l α i) (α i) (∧≤LCancel _ _)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u)))) - ≡⟨ cong (λ x → coneOut cc (sing i) ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ - coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom - (≤m→≤j (u ∧l α i) (α i) (∧≤LCancel _ _) - ⋆⟨ DLCat ^op ⟩ ≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u))) - ≡⟨ cong (λ x → coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom - {y = _ , ∧lClosed _ _ v∈L' (α∈L' i)} x) - (is-prop-valued _ _ _ _) ⟩ - coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j (v ∧l α i) (α i) (∧≤LCancel _ _)) ∎ - - - -- gives us preservation of cone morphisms that ensure uniqueness - lemma2 : ∀ (c : ob C) (cc : Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c) - (f : C [ c , (DLRan F .F-ob (⋁ α)) ]) - → isConeMor cc restCone f - → isConeMor (lemma1 c cc) F[⋁α]Cone f - lemma2 c cc f isRestConeMorf ((u , u∈L') , u≤⋁α) = - transport (λ i → f ⋆⟨ C ⟩ coneOutPathP i ≡ bᵤPathP i) triangle - where - -- for convenience - pᵤ = Σ≡Prop (λ x → L' x .snd) {u = _ , ⋁β∈L' u u∈L' u≤⋁α} - {v = _ , u∈L'} (sym (β≡ u u≤⋁α)) - - bᵤ : C [ c , F .F-ob (⋁ (β u) , ⋁β∈L' u u∈L' u≤⋁α) ] - bᵤ = uniqβConeMor c cc u u∈L' u≤⋁α .fst .fst - - bᵤPathP : PathP (λ i → C [ c , F .F-ob (pᵤ i) ]) - bᵤ (coneOut (lemma1 c cc) ((u , u∈L') , u≤⋁α)) - bᵤPathP = subst-filler (λ x → C [ c , F .F-ob x ]) pᵤ bᵤ - - - ⋁βᵤ : ob ⋁α↓ - ⋁βᵤ = ((⋁ (β u) , ⋁β∈L' u u∈L' u≤⋁α) , subst (_≤ ⋁ α) (β≡ u u≤⋁α) u≤⋁α) - - coneOutPathP : PathP (λ i → C [ (DLRan F .F-ob (⋁ α)) , F .F-ob (pᵤ i) ]) - (coneOut F[⋁α]Cone ⋁βᵤ) (coneOut F[⋁α]Cone ((u , u∈L') , u≤⋁α)) - coneOutPathP i = coneOut F[⋁α]Cone ((pᵤ i) , subst-filler (_≤ ⋁ α) (β≡ u u≤⋁α) u≤⋁α (~ i)) - - triangle : f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ⋁βᵤ ≡ bᵤ - triangle = sym (cong fst (uniqβConeMor c cc u u∈L' u≤⋁α .snd - (f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ⋁βᵤ , compIsConeMor))) - where - compIsConeMor : isConeMor (βCone c u u∈L' cc) - (F-cone F (B⋁Cone (λ i → β u i , β∈L' u u∈L' i) (⋁β∈L' u u∈L' u≤⋁α))) - (f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ⋁βᵤ) - compIsConeMor = isConeMorSingLemma - (βCone c u u∈L' cc) - (F-cone F (B⋁Cone (λ i → β u i , β∈L' u u∈L' i) (⋁β∈L' u u∈L' u≤⋁α))) - singCase - where - u∧αᵢ≤⋁α : ∀ i → (DLCat ^op) [ ⋁ α , u ∧l α i ] - u∧αᵢ≤⋁α _ = is-trans _ _ _ (≤m→≤j _ _ (∧≤RCancel _ _)) u≤⋁α - - singCase : ∀ i → (f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ⋁βᵤ) ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β u) i) - ≡ coneOut (βCone c u u∈L' cc) (sing i) - singCase i = - (f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ⋁βᵤ) ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β u) i) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - f ⋆⟨ C ⟩ (coneOut F[⋁α]Cone ⋁βᵤ ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β u) i)) - ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) - (coneOutCommutes F[⋁α]Cone (ind≤⋁ (β u) i , is-prop-valued _ _ _ _)) ⟩ - f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ((u ∧l α i , ∧lClosed _ _ u∈L' (α∈L' i)) , u∧αᵢ≤⋁α i) - ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) (sym (coneOutCommutes F[⋁α]Cone - (≤m→≤j _ _ (∧≤LCancel _ _) , is-prop-valued _ _ _ _))) ⟩ - f ⋆⟨ C ⟩ (coneOut F[⋁α]Cone ((α i , α∈L' i) , ind≤⋁ α i) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ((α i , α∈L' i) , ind≤⋁ α i)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) (isRestConeMorf (sing i)) ⟩ - coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ∎ - - -- the other direction, surprisingly hard - lemma3 : ∀ (c : ob C) (cc : Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c) - (f : C [ c , DLRan F .F-ob (⋁ α) ]) - → isConeMor (lemma1 c cc) F[⋁α]Cone f - → isConeMor cc restCone f - lemma3 c cc f isConeMorF = isConeMorSingLemma cc restCone singCase - where - singCase : ∀ i → f ⋆⟨ C ⟩ coneOut restCone (sing i) ≡ coneOut cc (sing i) - singCase i = - subst (λ g → f ⋆⟨ C ⟩ (F[⋁α]Cone .coneOut ((α i , α∈L' i) , ind≤⋁ α i)) ≡ g) - (transport (λ j → helperPathP j ≡ ccᵢSubstFiller (~ j)) ccᵢSubstPath) - assumption - where - assumption : f ⋆⟨ C ⟩ (F[⋁α]Cone .coneOut ((α i , α∈L' i) , ind≤⋁ α i)) - ≡ coneOut (lemma1 c cc) ((α i , α∈L' i) , ind≤⋁ α i) - assumption = isConeMorF ((α i , α∈L' i) , ind≤⋁ α i) - - -- modulo transport - Σpathhelper : (α i , α∈L' i) ≡ (⋁ (β (α i)) , ⋁β∈L' (α i) (α∈L' i) (ind≤⋁ α i)) - Σpathhelper = Σ≡Prop (λ x → L' x .snd) (β≡ (α i) (ind≤⋁ α i)) - - Σpathhelper2 : (⋁ (β (α i)) , ⋁β∈L' (α i) (α∈L' i) (ind≤⋁ α i)) ≡ (α i , α∈L' i) - Σpathhelper2 = Σ≡Prop (λ x → L' x .snd) (sym (β≡ (α i) (ind≤⋁ α i))) - - ccᵢSubst : C [ c , F .F-ob (⋁ (β (α i)) , ⋁β∈L' (α i) (α∈L' i) (ind≤⋁ α i)) ] - ccᵢSubst = subst (λ x → C [ c , F .F-ob x ]) - (Σ≡Prop (λ x → L' x .snd) (β≡ (α i) (ind≤⋁ α i))) - (coneOut cc (sing i)) - - ccᵢSubstFiller : PathP (λ j → C [ c , F .F-ob (Σpathhelper j) ]) - (coneOut cc (sing i)) ccᵢSubst - ccᵢSubstFiller = subst-filler (λ x → C [ c , F .F-ob x ]) Σpathhelper (coneOut cc (sing i)) - - βSubstFiller : PathP (λ j → C [ c , F .F-ob (Σpathhelper2 j) ]) - (uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .fst .fst) - (coneOut (lemma1 c cc) ((α i , α∈L' i) , ind≤⋁ α i)) - βSubstFiller = subst-filler (λ x → C [ c , F .F-ob x ]) Σpathhelper2 - (uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .fst .fst) - - Σpathhelperpath : Σpathhelper2 ≡ sym Σpathhelper - Σpathhelperpath = isSetL' _ _ _ _ - where - isSetL' : isSet (ob DLSubCat) - isSetL' = isSetΣSndProp is-set λ x → L' x .snd - - helperPathP : PathP (λ j → C [ c , F .F-ob (Σpathhelper (~ j)) ]) - (uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .fst .fst) - (coneOut (lemma1 c cc) ((α i , α∈L' i) , ind≤⋁ α i)) - helperPathP = subst (λ p → PathP (λ j → C [ c , F .F-ob (p j) ]) - (uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .fst .fst) - (coneOut (lemma1 c cc) ((α i , α∈L' i) , ind≤⋁ α i))) - Σpathhelperpath βSubstFiller - - ccᵢSubstIsConeMor : isConeMor (βCone c (α i) (α∈L' i) cc) - (F-cone F (B⋁Cone (λ j → (β (α i) j) , β∈L' (α i) (α∈L' i) j) - (⋁β∈L' (α i) (α∈L' i) (ind≤⋁ α i)))) - ccᵢSubst - ccᵢSubstIsConeMor = isConeMorSingLemma (βCone c (α i) (α∈L' i) cc) - (F-cone F (B⋁Cone (λ j → (β (α i) j) , β∈L' (α i) (α∈L' i) j) - (⋁β∈L' (α i) (α∈L' i) (ind≤⋁ α i)))) - singCase2 - where - singCase2 : (j : Fin n) → ccᵢSubst ⋆⟨ C ⟩ F-hom F (ind≤⋁ (β (α i)) j) - ≡ coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - singCase2 j = - (λ 𝕚 → ccᵢSubstFiller (~ 𝕚) - ⋆⟨ C ⟩ F≤PathPLemmaBase - (sym Σpathhelper) refl - (ind≤⋁ (β (α i)) j) (≤m→≤j _ _ (∧≤RCancel _ _)) 𝕚) - ∙ path - where - path : coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) - ≡ coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - path with (i ≟Fin j) - ... | (lt i<j) = coneOutCommutes cc (singPairL {i<j = i<j}) - ∙ sym (coneOutCommutes cc singPairR) - ... | (gt j<i) = transport (λ 𝕚 → B 𝕚) almostPath - where - ∧Path : Path (ob DLSubCat) (α j ∧l α i , β∈L' (α j) (α∈L' j) i) - (α i ∧l α j , β∈L' (α i) (α∈L' i) j) - ∧Path = Σ≡Prop (λ x → L' x .snd) (∧lComm _ _) - - almostPath : coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - ≡ coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) - almostPath = (coneOutCommutes cc (singPairR {i<j = j<i}) - ∙ sym (coneOutCommutes cc singPairL)) - - B : I → Type ℓ'' - B = λ 𝕚 → coneOut cc (sing i) ⋆⟨ C ⟩ F≤PathPLemmaBase refl ∧Path - (≤m→≤j _ _ (∧≤LCancel _ _)) - (≤m→≤j _ _ (∧≤RCancel _ _)) 𝕚 - ≡ coneOut cc (sing j) ⋆⟨ C ⟩ F≤PathPLemmaBase refl ∧Path - (≤m→≤j _ _ (∧≤RCancel _ _)) - (≤m→≤j _ _ (∧≤LCancel _ _)) 𝕚 - - ... | (eq i≡j) = - coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) - ≡⟨ (λ 𝕚 → coneOut cc (sing (i≡j 𝕚)) - ⋆⟨ C ⟩ F≤PathPLemmaBase (λ 𝕛 → α (i≡j 𝕛) , α∈L' (i≡j 𝕛)) - refl - (≤m→≤j _ _ (∧≤RCancel _ _)) - (≤m→≤j _ _ (∧≤LCancel _ _)) 𝕚) ⟩ - coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ∎ - - - ccᵢSubstPath : uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .fst .fst ≡ ccᵢSubst - ccᵢSubstPath = cong fst - (uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .snd (ccᵢSubst , ccᵢSubstIsConeMor)) - - - - -- putting it all together - coverLemma : ∀ (c : ob C) (cc : Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c) - → ∃![ f ∈ C [ c , DLRan F .F-ob (⋁ α) ] ] isConeMor cc restCone f - coverLemma c cc = uniqueExists - (fromUnivProp .fst .fst) - (lemma3 c cc _ (fromUnivProp .fst .snd)) - (λ _ → isPropIsConeMor _ _ _) - λ g isConeMorG → cong fst (fromUnivProp .snd (g , lemma2 c cc g isConeMorG)) - where - fromUnivProp : ∃![ f ∈ C [ c , DLRan F .F-ob (⋁ α) ] ] isConeMor (lemma1 c cc) F[⋁α]Cone f - fromUnivProp = limitC ⋁α↓ (F* (⋁ α)) .univProp c (lemma1 c cc) - - - -- a little notation that is used in the following module but should be outside - open FinSumChar using (++FinInl ; ++FinInr) - renaming (fun to FSCfun ; inv to FSCinv ; sec to FSCsec) - - private - β++γ∈L' : {n : ℕ} {n' : ℕ} {γ : FinVec (fst L) n'} {β : FinVec (fst L) n} - (β∈L' : ∀ i → β i ∈ L') (γ∈L' : ∀ i → γ i ∈ L') - → ∀ i → (β ++Fin γ) i ∈ L' - β++γ∈L' β∈L' γ∈L' = ++FinPres∈ L' β∈L' γ∈L' - - ++FinInlΣ : {n : ℕ} {n' : ℕ} {γ : FinVec (fst L) n'} {β : FinVec (fst L) n} - (β∈L' : ∀ i → β i ∈ L') (γ∈L' : ∀ i → γ i ∈ L') - → ∀ i → Path (ob DLSubCat) (β i , β∈L' i) - ((β ++Fin γ) (FSCfun _ _ (inl i)) , β++γ∈L' β∈L' γ∈L' (FSCfun _ _ (inl i))) - ++FinInlΣ {ℕ.zero} _ _ () - ++FinInlΣ {ℕ.suc n} _ _ zero = refl - ++FinInlΣ {ℕ.suc n} β∈L' γ∈L' (suc i) = ++FinInlΣ (β∈L' ∘ suc) γ∈L' i - - ++FinInrΣ : {n : ℕ} {n' : ℕ} {γ : FinVec (fst L) n'} {β : FinVec (fst L) n} - (β∈L' : ∀ i → β i ∈ L') (γ∈L' : ∀ i → γ i ∈ L') - → ∀ i → Path (ob DLSubCat) (γ i , γ∈L' i) - ((β ++Fin γ) (FSCfun _ _ (inr i)) , β++γ∈L' β∈L' γ∈L' (FSCfun _ _ (inr i))) - ++FinInrΣ {ℕ.zero} _ _ i = refl - ++FinInrΣ {ℕ.suc n} β∈L' γ∈L' i = ++FinInrΣ (β∈L' ∘ suc) γ∈L' i - - module ++Lemmas {c : ob C} {n' : ℕ} {γ : FinVec (fst L) n'} {γ∈L' : ∀ i → γ i ∈ L'} - (ccγ : Cone (funcComp F (BDiag (λ i → γ i , γ∈L' i))) c) where - - private - β∧γ : {n : ℕ} {β : FinVec (fst L) n} (β∈L' : ∀ i → β i ∈ L') - → Fin n → Fin n' → ob DLSubCat - β∧γ {β = β} β∈L' i j = (β i ∧l γ j) , ∧lClosed _ _ (β∈L' i) (γ∈L' j) - - β≥β∧γ : {n : ℕ} {β : FinVec (fst L) n} (β∈L' : ∀ i → β i ∈ L') - → ∀ i j → (DLSubCat ^op) [ (β i , β∈L' i) , β∧γ β∈L' i j ] - β≥β∧γ β∈L' i j = ≤m→≤j _ _ (∧≤RCancel _ _) - - γ≥β∧γ : {n : ℕ} {β : FinVec (fst L) n} (β∈L' : ∀ i → β i ∈ L') - → ∀ i j → (DLSubCat ^op) [ (γ j , γ∈L' j) , β∧γ β∈L' i j ] - γ≥β∧γ β∈L' i j = ≤m→≤j _ _ (∧≤LCancel _ _) - - CommHypType : {n : ℕ} {β : FinVec (fst L) n} (β∈L' : ∀ i → β i ∈ L') - (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) - → Type ℓ'' - CommHypType β∈L' ccβ = ∀ i j → - ccβ .coneOut (sing i) - ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ (β∈L' i) (γ∈L' j)} (β≥β∧γ β∈L' i j) - ≡ ccγ .coneOut (sing j) ⋆⟨ C ⟩ F .F-hom (γ≥β∧γ β∈L' i j) - - coneSuc : {n : ℕ} {β : FinVec (fst L) (ℕ.suc n)} {β∈L' : ∀ i → β i ∈ L'} - → Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c - → Cone (funcComp F (BDiag (λ i → β (suc i) , β∈L' (suc i)))) c - coneOut (coneSuc ccβ) (sing i) = coneOut ccβ (sing (suc i)) - coneOut (coneSuc ccβ) (pair i j i<j) = coneOut ccβ (pair (suc i) (suc j) (s≤s i<j)) - coneOutCommutes (coneSuc ccβ) {u = sing i} idAr = coneOutCommutes ccβ idAr - coneOutCommutes (coneSuc ccβ) {u = pair i j i<j} idAr = coneOutCommutes ccβ idAr - coneOutCommutes (coneSuc ccβ) singPairL = coneOutCommutes ccβ singPairL - coneOutCommutes (coneSuc ccβ) singPairR = coneOutCommutes ccβ singPairR - - --make this explicit to avoid yellow - commHypSuc : {n : ℕ} {β : FinVec (fst L) (ℕ.suc n)} {β∈L' : ∀ i → β i ∈ L'} - {ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c} - → CommHypType β∈L' ccβ - → CommHypType (β∈L' ∘ suc) (coneSuc ccβ) - commHypSuc commHyp i j = commHyp (suc i) j - - toConeOut : (n : ℕ) (β : FinVec (fst L) n) (β∈L' : ∀ i → β i ∈ L') - (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) - (ch : CommHypType β∈L' ccβ) - → ∀ (v : DLShfDiagOb (n + n')) - → C [ c , funcComp F (BDiag (λ i → (β ++Fin γ) i , β++γ∈L' β∈L' γ∈L' i)) .F-ob v ] - toConeOut ℕ.zero β β∈L' ccβ ch (sing i) = ccγ .coneOut (sing i) - toConeOut ℕ.zero β β∈L' ccβ ch (pair i j i<j) = ccγ .coneOut (pair i j i<j) - toConeOut (ℕ.suc n) β β∈L' ccβ ch (sing zero) = ccβ .coneOut (sing zero) - toConeOut (ℕ.suc n) β β∈L' ccβ ch (sing (suc i)) = - toConeOut n (β ∘ suc) (β∈L' ∘ suc) (coneSuc ccβ) (commHypSuc ch) (sing i) - toConeOut (ℕ.suc n) β β∈L' ccβ ch (pair zero j 0<j) = - ccβ .coneOut (sing zero) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) - toConeOut (ℕ.suc n) β β∈L' ccβ ch (pair (suc i) zero ()) - toConeOut (ℕ.suc n) β β∈L' ccβ ch (pair (suc i) (suc j) (s≤s i<j)) = - toConeOut n (β ∘ suc) (β∈L' ∘ suc) (coneSuc ccβ) (commHypSuc ch) (pair i j i<j) - - -- crucial step in proving that this defines a cone is another induction - -- βₛ is supposed to be (β ∘ suc) and β₀ is (β zero) - toConeOutLemma : (n : ℕ) (βₛ : FinVec (fst L) n) (βₛ∈L' : ∀ i → βₛ i ∈ L') - (ccβₛ : Cone (funcComp F (BDiag (λ i → βₛ i , βₛ∈L' i))) c) - (chₛ : CommHypType βₛ∈L' ccβₛ) - (β₀ : fst L) (β₀∈L' : β₀ ∈ L') - -- cone over [β₀]++βₛ - {ccβ₀ : C [ c , F .F-ob (β₀ , β₀∈L') ]} - {ccβ₀ᵢ : (i : Fin n) → C [ c , F .F-ob (β₀ ∧l βₛ i , ∧lClosed _ _ β₀∈L' (βₛ∈L' i)) ]} - (ccβ₀L : ∀ i → ccβ₀ ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) ≡ ccβ₀ᵢ i) - (ccβ₀R : ∀ i → ccβₛ .coneOut (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ≡ ccβ₀ᵢ i) - -- ch at zero - (ch₀ : ∀ j → - ccβ₀ ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ β₀∈L' (γ∈L' j)} (≤m→≤j _ _ (∧≤RCancel _ _)) - ≡ ccγ .coneOut (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) - --------------------------------------------------------------------- - → ∀ j → toConeOut n βₛ βₛ∈L' ccβₛ chₛ (sing j) - ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ β₀∈L' (β++γ∈L' βₛ∈L' γ∈L' j)} - (≤m→≤j _ _ (∧≤LCancel _ _)) - ≡ ccβ₀ ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) - toConeOutLemma ℕ.zero _ _ _ _ _ _ _ _ ch₀ j = sym (ch₀ j) - toConeOutLemma (ℕ.suc n) _ _ _ _ _ _ ccβ₀L ccβ₀R _ zero = ccβ₀R zero ∙ sym (ccβ₀L zero) - toConeOutLemma (ℕ.suc n) βₛ βₛ∈L' ccβₛ chₛ β₀ β₀∈L' ccβ₀L ccβ₀R ch₀ (suc j) = - toConeOutLemma n (βₛ ∘ suc) (βₛ∈L' ∘ suc) (coneSuc ccβₛ) (commHypSuc chₛ) - β₀ β₀∈L' (ccβ₀L ∘ suc) (ccβ₀R ∘ suc) ch₀ j - - - toConeOutCommutes : (n : ℕ) (β : FinVec (fst L) n) (β∈L' : ∀ i → β i ∈ L') - (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) - (ch : CommHypType β∈L' ccβ) - → ∀ {u} {v} e - → toConeOut _ _ _ ccβ ch u - ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → (β ++Fin γ) i , β++γ∈L' β∈L' γ∈L' i)) .F-hom e) - ≡ toConeOut _ _ _ ccβ ch v - toConeOutCommutes ℕ.zero _ _ _ _ {u = sing i} {v = sing .i} idAr = coneOutCommutes ccγ idAr - toConeOutCommutes ℕ.zero _ _ _ _ {u = sing i} {v = pair .i j i<j} singPairL = - coneOutCommutes ccγ singPairL - toConeOutCommutes ℕ.zero _ _ _ _ {u = sing j} {v = pair i .j i<j} singPairR = - coneOutCommutes ccγ singPairR - toConeOutCommutes ℕ.zero _ _ _ _ {u = pair i j i<j} {v = sing k} () - toConeOutCommutes ℕ.zero _ _ _ _ {u = pair i j i<j} {v = pair .i .j .i<j} idAr = - coneOutCommutes ccγ idAr - toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch idAr = - cong (λ x → toConeOut _ _ _ ccβ ch _ ⋆⟨ C ⟩ x) (F .F-id) ∙ ⋆IdR C _ - toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch (singPairL {i = zero} {j = j} {i<j = i<j}) = refl - toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch (singPairL {i = suc i} {j = zero} {i<j = ()}) - toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch (singPairL {i = suc i} {j = suc j} {i<j = s≤s i<j}) = - toConeOutCommutes n (β ∘ suc) (β∈L' ∘ suc) (coneSuc ccβ) (commHypSuc ch) singPairL - toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch (singPairR {i = suc i} {j = suc j} {i<j = s≤s i<j}) = - toConeOutCommutes n (β ∘ suc) (β∈L' ∘ suc) (coneSuc ccβ) (commHypSuc ch) singPairR - toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch (singPairR {i = zero} {j = suc j} {i<j = s≤s z≤}) = - toConeOutLemma n (β ∘ suc) (β∈L' ∘ suc) (coneSuc ccβ) (commHypSuc ch) (β zero) (β∈L' zero) - (λ j → coneOutCommutes ccβ (singPairL {i = zero} {j = suc j} {i<j = s≤s z≤})) - (λ j → coneOutCommutes ccβ (singPairR {i = zero} {j = suc j} {i<j = s≤s z≤})) - (ch zero) j - - toCone : {n : ℕ} {β : FinVec (fst L) n} {β∈L' : ∀ i → β i ∈ L'} - (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) - (ch : CommHypType β∈L' ccβ) - → Cone (funcComp F (BDiag (λ i → (β ++Fin γ) i , β++γ∈L' β∈L' γ∈L' i))) c - coneOut (toCone ccβ ch) = toConeOut _ _ _ ccβ ch - coneOutCommutes (toCone ccβ ch) = toConeOutCommutes _ _ _ ccβ ch - - - -- for checking the universal property - toConeOutPathPL : {n : ℕ} {β : FinVec (fst L) n} {β∈L' : ∀ i → β i ∈ L'} - (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) - (ch : CommHypType β∈L' ccβ) - → ∀ i → PathP (λ 𝕚 → C [ c , F .F-ob (++FinInlΣ β∈L' γ∈L' i 𝕚) ]) - (ccβ .coneOut (sing i)) - (toCone ccβ ch .coneOut (sing (FSCfun _ _ (inl i)))) - toConeOutPathPL {ℕ.zero} ccβ _ () - toConeOutPathPL {ℕ.suc n} ccβ _ zero = refl - toConeOutPathPL {ℕ.suc n} ccβ ch (suc i) = toConeOutPathPL (coneSuc ccβ) (commHypSuc ch) i - - toConeOutPathPR : {n : ℕ} {β : FinVec (fst L) n} {β∈L' : ∀ i → β i ∈ L'} - (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) - (ch : CommHypType β∈L' ccβ) - → ∀ i → PathP (λ 𝕚 → C [ c , F .F-ob (++FinInrΣ β∈L' γ∈L' i 𝕚) ]) - (ccγ .coneOut (sing i)) - (toCone ccβ ch .coneOut (sing (FSCfun _ _ (inr i)))) - toConeOutPathPR {ℕ.zero} ccβ _ i = refl - toConeOutPathPR {ℕ.suc n} ccβ ch i = toConeOutPathPR (coneSuc ccβ) (commHypSuc ch) i - - ----- the main proof -------------------------------------------------------------------------------- - isDLSheafPullbackDLRan : isDLSheafPullback L C (DLRan F) - fst isDLSheafPullbackDLRan x = - limArrow (limitC _ (F* 0l)) x (toCone x) - , λ f → limArrowUnique (limitC _ (F* 0l)) x (toCone x) f (toConeMor x f) - where - 0↓ = _↓Diag limitC (baseIncl ^opF) F 0l - - toTerminal : ∀ (u : ob 0↓) → isTerminal C (F .F-ob (u .fst)) - toTerminal ((u , u∈L') , 0≥u) = subst (λ v → isTerminal C (F .F-ob v)) - (Σ≡Prop (λ y → L' y .snd) 0≡u) - (DLBasisSheaf→Terminal F isSheafF 0∈L') - where - 0≡u : 0l ≡ u - 0≡u = is-antisym _ _ (∨lLid _) 0≥u - 0∈L' : 0l ∈ L' - 0∈L' = subst-∈ L' (sym 0≡u) u∈L' - - toCone : (y : ob C) → Cone (F* 0l) y - coneOut (toCone y) u = toTerminal u y .fst - coneOutCommutes (toCone y) {v = v} e = sym (toTerminal v y .snd _) - - toConeMor : (y : ob C) (f : C [ y , F-ob (DLRan F) 0l ]) - → isConeMor (toCone y) (limCone (limitC 0↓ (F* 0l))) f - toConeMor y f v = sym (toTerminal v y .snd _) - - - snd isDLSheafPullbackDLRan x y = rec2 (isPropIsPullback _ _ _ _ (Fsq L C x y (DLRan F))) - Σhelper (⋁Basis x) (⋁Basis y) - where - Σhelper : Σ[ n ∈ ℕ ] Σ[ β ∈ FinVec (fst L) n ] (∀ i → β i ∈ L') × (⋁ β ≡ x) - → Σ[ m ∈ ℕ ] Σ[ γ ∈ FinVec (fst L) m ] (∀ i → γ i ∈ L') × (⋁ γ ≡ y) - → isPullback C _ _ _ (Fsq L C x y (DLRan F)) - Σhelper (n , β , β∈L' , ⋁β≡x) (n' , γ , γ∈L' , ⋁γ≡y) = - transport (λ i → isPullback C (cospanPath i) (pbPr₁PathP i) (pbPr₂PathP i) (squarePathP i)) - (univProp ⋁Pullback) - where - open Cospan - open Pullback - ⋁β++γ≡x∨y : ⋁ (β ++Fin γ) ≡ x ∨l y - ⋁β++γ≡x∨y = ⋁Split++ β γ ∙ cong₂ (_∨l_) ⋁β≡x ⋁γ≡y - - -- replace x and y by their representations of joins of base elements - -- and transport over - xyCospan : Cospan C - l xyCospan = DLRan F .F-ob y - m xyCospan = DLRan F .F-ob (x ∧l y) - r xyCospan = DLRan F .F-ob x - s₁ xyCospan = DLRan F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - s₂ xyCospan = DLRan F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) - - ⋁Cospan : Cospan C - l ⋁Cospan = DLRan F .F-ob (⋁ γ) - m ⋁Cospan = DLRan F .F-ob (⋁ β ∧l ⋁ γ) - r ⋁Cospan = DLRan F .F-ob (⋁ β) - s₁ ⋁Cospan = DLRan F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - s₂ ⋁Cospan = DLRan F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) - - cospanPath : ⋁Cospan ≡ xyCospan - l (cospanPath i) = DLRan F .F-ob (⋁γ≡y i) - m (cospanPath i) = DLRan F .F-ob (⋁β≡x i ∧l ⋁γ≡y i) - r (cospanPath i) = DLRan F .F-ob (⋁β≡x i) - s₁ (cospanPath i) = DLRan F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - s₂ (cospanPath i) = DLRan F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) - - private - F[⋁β]Cone = limitC _ (F* (⋁ β)) .limCone - F[⋁γ]Cone = limitC _ (F* (⋁ γ)) .limCone - F[⋁β∧⋁γ]Cone = limitC _ (F* (⋁ β ∧l ⋁ γ)) .limCone - F[⋁β++γ]Cone = limitC _ (F* (⋁ (β ++Fin γ))) .limCone - - -- the family of squares we need to construct cones over β++γ - to++ConeSquare : {c : ob C} (f : C [ c , ⋁Cospan .l ]) (g : C [ c , ⋁Cospan .r ]) - → f ⋆⟨ C ⟩ ⋁Cospan .s₁ ≡ g ⋆⟨ C ⟩ ⋁Cospan .s₂ - → ∀ i j → - (g ⋆⟨ C ⟩ restCone β β∈L' .coneOut (sing i)) - ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ (β∈L' i) (γ∈L' j)} - (≤m→≤j _ _ (∧≤RCancel _ _)) - ≡ (f ⋆⟨ C ⟩ restCone γ γ∈L' .coneOut (sing j)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) - to++ConeSquare f g square i j = - (g ⋆⟨ C ⟩ restCone β β∈L' .coneOut (sing i)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - g ⋆⟨ C ⟩ (restCone β β∈L' .coneOut (sing i) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _))) - ≡⟨ cong (λ x → g ⋆⟨ C ⟩ x) (coneOutCommutes F[⋁β]Cone (_ , (is-prop-valued _ _ _ _))) ⟩ - g ⋆⟨ C ⟩ coneOut F[⋁β]Cone ((β i ∧l γ j , _) - , is-trans _ _ _ (≤m→≤j _ _ (≤-∧Pres _ _ _ _ - (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j)))) - (≤m→≤j _ _ (∧≤RCancel _ _))) - ≡⟨ cong (λ x → g ⋆⟨ C ⟩ x) (sym (limArrowCommutes (limitC _ (F* (⋁ β ∧l ⋁ γ))) _ _ _)) ⟩ - g ⋆⟨ C ⟩ (s₂ ⋁Cospan ⋆⟨ C ⟩ coneOut F[⋁β∧⋁γ]Cone ((β i ∧l γ j , _) - , (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j)))))) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (g ⋆⟨ C ⟩ s₂ ⋁Cospan) ⋆⟨ C ⟩ coneOut F[⋁β∧⋁γ]Cone ((β i ∧l γ j , _) - , (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j))))) - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ coneOut F[⋁β∧⋁γ]Cone ( - (β i ∧l γ j , ∧lClosed _ _ (β∈L' i) (γ∈L' j)) - , (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j)))))) - (sym square) ⟩ - (f ⋆⟨ C ⟩ s₁ ⋁Cospan) ⋆⟨ C ⟩ coneOut F[⋁β∧⋁γ]Cone ((β i ∧l γ j , _) - , (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j))))) - ≡⟨ ⋆Assoc C _ _ _ ⟩ - f ⋆⟨ C ⟩ (s₁ ⋁Cospan ⋆⟨ C ⟩ coneOut F[⋁β∧⋁γ]Cone ((β i ∧l γ j , _) - , (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j)))))) - ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) (limArrowCommutes (limitC _ (F* (⋁ β ∧l ⋁ γ))) _ _ _) ⟩ - f ⋆⟨ C ⟩ coneOut F[⋁γ]Cone ((β i ∧l γ j , _) - , is-trans _ _ _ (≤m→≤j _ _ (≤-∧Pres _ _ _ _ - (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j)))) - (≤m→≤j _ _ (∧≤LCancel _ _))) - ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) - (sym (coneOutCommutes F[⋁γ]Cone (_ , (is-prop-valued _ _ _ _)))) ⟩ - f ⋆⟨ C ⟩ (restCone γ γ∈L' .coneOut (sing j) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (f ⋆⟨ C ⟩ restCone γ γ∈L' .coneOut (sing j)) - ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ∎ - - - -- the pullback square we want - ⋁Pullback : Pullback C ⋁Cospan - pbOb ⋁Pullback = DLRan F .F-ob (⋁ (β ++Fin γ)) - pbPr₁ ⋁Pullback = DLRan F .F-hom (subst (⋁ γ ≤_) (sym (⋁Split++ β γ)) (∨≤LCancel _ _)) - pbPr₂ ⋁Pullback = DLRan F .F-hom (subst (⋁ β ≤_) (sym (⋁Split++ β γ)) (∨≤RCancel _ _)) - pbCommutes ⋁Pullback = F-square (DLRan F) (is-prop-valued _ _ _ _) - univProp ⋁Pullback {d = c} f g square = uniqueExists - (applyCoverLemma f g square .fst .fst) - (fromConeMor _ (applyCoverLemma f g square .fst .snd)) - (λ _ → isProp× (isSetHom C _ _) (isSetHom C _ _)) - λ h' trs → cong fst (applyCoverLemma f g square .snd (h' , toConeMor f g square h' trs)) - where -- this is where we apply our lemmas - theLimit = limitC _ (F* (⋁ (β ++Fin γ))) - - toCone : (f : C [ c , ⋁Cospan .l ]) (g : C [ c , ⋁Cospan .r ]) - → f ⋆⟨ C ⟩ ⋁Cospan .s₁ ≡ g ⋆⟨ C ⟩ ⋁Cospan .s₂ - → Cone (funcComp F (BDiag (λ i → (β ++Fin γ) i , β++γ∈L' β∈L' γ∈L' i))) c - toCone f g square = ++Lemmas.toCone (f ★ (restCone γ γ∈L')) (g ★ (restCone β β∈L')) - (to++ConeSquare f g square) - - applyCoverLemma : (f : C [ c , ⋁Cospan .l ]) (g : C [ c , ⋁Cospan .r ]) - (square : f ⋆⟨ C ⟩ ⋁Cospan .s₁ ≡ g ⋆⟨ C ⟩ ⋁Cospan .s₂) - → ∃![ h ∈ C [ c , ⋁Pullback .pbOb ] ] - isConeMor (toCone f g square) (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) h - applyCoverLemma f g square = coverLemma (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') - c (toCone f g square) - - -- Another description of the limiting cone over β++γ that - -- turns out equivalent but behaves better with the ++Lemmas - ++LimCone' : Cone (funcComp F (BDiag (λ i → ((β ++Fin γ) i , β++γ∈L' β∈L' γ∈L' i)))) - (DLRan F .F-ob (⋁ (β ++Fin γ))) - ++LimCone' = ++Lemmas.toCone ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) - ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) - (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) - - ++LimCone≡ : ∀ i → ++LimCone' .coneOut (sing i) - ≡ restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') .coneOut (sing i) - ++LimCone≡ i = subst (λ x → ++LimCone' .coneOut (sing x) - ≡ restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') .coneOut (sing x)) - (FSCsec _ _ i) (++LimCone≡Aux (FSCinv _ _ i)) - where - ++LimCone≡Aux : (x : Fin n ⊎ Fin n') → ++LimCone' .coneOut (sing (FSCfun _ _ x)) - ≡ restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') .coneOut (sing (FSCfun _ _ x)) - ++LimCone≡Aux (inl i) = - sym (fromPathP (++Lemmas.toConeOutPathPL - ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) - ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) - (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i)) - ∙∙ cong (λ x → transport (λ 𝕚 → C [ DLRan F .F-ob (⋁ (β ++Fin γ)) , - F .F-ob (++FinInlΣ β∈L' γ∈L' i 𝕚) ]) x) - (limArrowCommutes (limitC _ (F* (⋁ β))) _ _ _) - ∙∙ fromPathP helperPathP - where - βᵢ≤⋁β++γ = - is-trans _ _ _ (ind≤⋁ β i) (subst (⋁ β ≤_) (sym (⋁Split++ β γ)) (∨≤RCancel _ _)) - - helperPathP : - PathP (λ 𝕚 → C [ DLRan F .F-ob (⋁ (β ++Fin γ)) , F .F-ob (++FinInlΣ β∈L' γ∈L' i 𝕚) ]) - (F[⋁β++γ]Cone .coneOut ((β i , β∈L' i) , βᵢ≤⋁β++γ)) - (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') .coneOut (sing (FSCfun _ _ (inl i)))) - helperPathP 𝕚 = F[⋁β++γ]Cone .coneOut (++FinInlΣ β∈L' γ∈L' i 𝕚 , - ≤PathPLemma refl (λ 𝕛 → ++FinInlΣ β∈L' γ∈L' i 𝕛 .fst) - βᵢ≤⋁β++γ - (ind≤⋁ (β ++Fin γ) (FSCfun _ _ (inl i))) 𝕚) - - ++LimCone≡Aux (inr i) = - sym (fromPathP (++Lemmas.toConeOutPathPR - ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) - ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) - (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i)) - ∙∙ cong (λ x → transport (λ 𝕚 → C [ DLRan F .F-ob (⋁ (β ++Fin γ)) , - F .F-ob (++FinInrΣ β∈L' γ∈L' i 𝕚) ]) x) - (limArrowCommutes (limitC _ (F* (⋁ γ))) _ _ _) - ∙∙ fromPathP helperPathP - where - γᵢ≤⋁β++γ = - is-trans _ _ _ (ind≤⋁ γ i) (subst (⋁ γ ≤_) (sym (⋁Split++ β γ)) (∨≤LCancel _ _)) - - helperPathP : - PathP (λ 𝕚 → C [ DLRan F .F-ob (⋁ (β ++Fin γ)) , F .F-ob (++FinInrΣ β∈L' γ∈L' i 𝕚) ]) - (F[⋁β++γ]Cone .coneOut ((γ i , γ∈L' i) , γᵢ≤⋁β++γ)) - (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') .coneOut (sing (FSCfun _ _ (inr i)))) - helperPathP 𝕚 = F[⋁β++γ]Cone .coneOut (++FinInrΣ β∈L' γ∈L' i 𝕚 , - ≤PathPLemma refl (λ 𝕛 → ++FinInrΣ β∈L' γ∈L' i 𝕛 .fst) - γᵢ≤⋁β++γ - (ind≤⋁ (β ++Fin γ) (FSCfun _ _ (inr i))) 𝕚) - - - - toConeMor : (f : C [ c , ⋁Cospan .l ]) (g : C [ c , ⋁Cospan .r ]) - (square : f ⋆⟨ C ⟩ ⋁Cospan .s₁ ≡ g ⋆⟨ C ⟩ ⋁Cospan .s₂) - (h : C [ c , ⋁Pullback .pbOb ]) - → (f ≡ h ⋆⟨ C ⟩ ⋁Pullback .pbPr₁) × (g ≡ h ⋆⟨ C ⟩ ⋁Pullback .pbPr₂) - → isConeMor (toCone f g square) (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) h - toConeMor f g square h (tr₁ , tr₂) = isConeMorSingLemma - (toCone f g square) - (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) - singCase - where - singCaseAux : ∀ (x : Fin n ⊎ Fin n') - → h ⋆⟨ C ⟩ (coneOut ++LimCone' (sing (FSCfun _ _ x))) - ≡ coneOut (toCone f g square) (sing (FSCfun _ _ x)) - singCaseAux (inl i) = transp (λ 𝕚 → h ⋆⟨ C ⟩ - (++Lemmas.toConeOutPathPL ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) - ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) - (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i 𝕚) - ≡ ++Lemmas.toConeOutPathPL (f ★ (restCone γ γ∈L')) - (g ★ (restCone β β∈L')) - (to++ConeSquare _ _ square) i 𝕚) i0 singCaseAuxL - where - singCaseAuxL : h ⋆⟨ C ⟩ ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) .coneOut (sing i) - ≡ (g ★ (restCone β β∈L')) .coneOut (sing i) - singCaseAuxL = - h ⋆⟨ C ⟩ (pbPr₂ ⋁Pullback ⋆⟨ C ⟩ (restCone β β∈L') .coneOut (sing i)) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (h ⋆⟨ C ⟩ pbPr₂ ⋁Pullback) ⋆⟨ C ⟩ (restCone β β∈L') .coneOut (sing i) - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ (restCone β β∈L') .coneOut (sing i)) (sym tr₂) ⟩ - g ⋆⟨ C ⟩ (restCone β β∈L') .coneOut (sing i) ∎ - - singCaseAux (inr i) = transp (λ 𝕚 → h ⋆⟨ C ⟩ - (++Lemmas.toConeOutPathPR ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) - ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) - (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i 𝕚) - ≡ ++Lemmas.toConeOutPathPR (f ★ (restCone γ γ∈L')) - (g ★ (restCone β β∈L')) - (to++ConeSquare _ _ square) i 𝕚) i0 singCaseAuxR - where - singCaseAuxR : h ⋆⟨ C ⟩ ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) .coneOut (sing i) - ≡ (f ★ (restCone γ γ∈L')) .coneOut (sing i) - singCaseAuxR = - h ⋆⟨ C ⟩ (pbPr₁ ⋁Pullback ⋆⟨ C ⟩ (restCone γ γ∈L') .coneOut (sing i)) - ≡⟨ sym (⋆Assoc C _ _ _) ⟩ - (h ⋆⟨ C ⟩ pbPr₁ ⋁Pullback) ⋆⟨ C ⟩ (restCone γ γ∈L') .coneOut (sing i) - ≡⟨ cong (λ x → x ⋆⟨ C ⟩ (restCone γ γ∈L') .coneOut (sing i)) (sym tr₁) ⟩ - f ⋆⟨ C ⟩ (restCone γ γ∈L') .coneOut (sing i) ∎ - - - singCase' : ∀ i → h ⋆⟨ C ⟩ (coneOut ++LimCone' (sing i)) - ≡ coneOut (toCone f g square) (sing i) - singCase' i = subst (λ x → h ⋆⟨ C ⟩ coneOut ++LimCone' (sing x) - ≡ coneOut (toCone f g square) (sing x)) - (FSCsec _ _ i) (singCaseAux (FSCinv _ _ i)) - - singCase : ∀ i → h ⋆⟨ C ⟩ (coneOut (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) (sing i)) - ≡ coneOut (toCone f g square) (sing i) - singCase i = subst (λ x → h ⋆⟨ C ⟩ x ≡ coneOut (toCone f g square) (sing i)) - (++LimCone≡ i) (singCase' i) - - - fromConeMor : (h : C [ c , ⋁Pullback .pbOb ]) - → isConeMor (toCone f g square) (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) h - → (f ≡ h ⋆⟨ C ⟩ ⋁Pullback .pbPr₁) × (g ≡ h ⋆⟨ C ⟩ ⋁Pullback .pbPr₂) - fst (fromConeMor h hIsConeMor) = sym (preCompUnique f (restCone γ γ∈L') - (coverLemma γ γ∈L') - (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₁) - compIsConeMor) - where - compIsConeMor : isConeMor (f ★ (restCone γ γ∈L')) (restCone γ γ∈L') - (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₁) - compIsConeMor = isConeMorSingLemma (f ★ (restCone γ γ∈L')) (restCone γ γ∈L') singCase - where - singCase : ∀ i → (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₁) ⋆⟨ C ⟩ restCone γ γ∈L' .coneOut (sing i) - ≡ f ⋆⟨ C ⟩ restCone γ γ∈L' .coneOut (sing i) - singCase i = ⋆Assoc C _ _ _ ∙ transp (λ 𝕚 → h ⋆⟨ C ⟩ - (++Lemmas.toConeOutPathPR ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) - ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) - (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i (~ 𝕚)) - ≡ ++Lemmas.toConeOutPathPR (f ★ (restCone γ γ∈L')) - (g ★ (restCone β β∈L')) - (to++ConeSquare _ _ square) i (~ 𝕚)) i0 singCaseHelper - where - fromAssumption : h ⋆⟨ C ⟩ (coneOut (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) - (sing (FSCfun _ _ (inr i)))) - ≡ coneOut (toCone f g square) (sing (FSCfun _ _ (inr i))) - fromAssumption = hIsConeMor (sing (FSCfun _ _ (inr i))) - - singCaseHelper : h ⋆⟨ C ⟩ (coneOut ++LimCone' (sing (FSCfun _ _ (inr i)))) - ≡ coneOut (toCone f g square) (sing (FSCfun _ _ (inr i))) - singCaseHelper = subst (λ x → h ⋆⟨ C ⟩ x ≡ coneOut (toCone f g square) - (sing (FSCfun _ _ (inr i)))) - (sym (++LimCone≡ (FSCfun _ _ (inr i)))) fromAssumption - - snd (fromConeMor h hIsConeMor) = sym (preCompUnique g (restCone β β∈L') - (coverLemma β β∈L') - (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₂) - compIsConeMor) - where - compIsConeMor : isConeMor (g ★ (restCone β β∈L')) (restCone β β∈L') - (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₂) - compIsConeMor = isConeMorSingLemma (g ★ (restCone β β∈L')) (restCone β β∈L') singCase - where - singCase : ∀ i → (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₂) ⋆⟨ C ⟩ restCone β β∈L' .coneOut (sing i) - ≡ g ⋆⟨ C ⟩ restCone β β∈L' .coneOut (sing i) - singCase i = ⋆Assoc C _ _ _ ∙ transp (λ 𝕚 → h ⋆⟨ C ⟩ - (++Lemmas.toConeOutPathPL ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) - ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) - (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i (~ 𝕚)) - ≡ ++Lemmas.toConeOutPathPL (f ★ (restCone γ γ∈L')) - (g ★ (restCone β β∈L')) - (to++ConeSquare _ _ square) i (~ 𝕚)) i0 singCaseHelper - where - fromAssumption : h ⋆⟨ C ⟩ (coneOut (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) - (sing (FSCfun _ _ (inl i)))) - ≡ coneOut (toCone f g square) (sing (FSCfun _ _ (inl i))) - fromAssumption = hIsConeMor (sing (FSCfun _ _ (inl i))) - - singCaseHelper : h ⋆⟨ C ⟩ (coneOut ++LimCone' (sing (FSCfun _ _ (inl i)))) - ≡ coneOut (toCone f g square) (sing (FSCfun _ _ (inl i))) - singCaseHelper = subst (λ x → h ⋆⟨ C ⟩ x ≡ coneOut (toCone f g square) - (sing (FSCfun _ _ (inl i)))) - (sym (++LimCone≡ (FSCfun _ _ (inl i)))) fromAssumption - - - - - -- some more names to make the transport readable - pbPr₁PathP : PathP (λ i → C [ DLRan F .F-ob (⋁β++γ≡x∨y i) , DLRan F .F-ob (⋁γ≡y i) ]) - (pbPr₁ ⋁Pullback) (DLRan F .F-hom (hom-∨₂ L C x y)) - pbPr₁PathP = F≤PathPLemma ⋁β++γ≡x∨y ⋁γ≡y - (subst (⋁ γ ≤_) (sym (⋁Split++ β γ)) (∨≤LCancel _ _)) - (hom-∨₂ L C x y) - - pbPr₂PathP : PathP (λ i → C [ DLRan F .F-ob (⋁β++γ≡x∨y i) , DLRan F .F-ob (⋁β≡x i) ]) - (pbPr₂ ⋁Pullback) (DLRan F .F-hom (hom-∨₁ L C x y)) - pbPr₂PathP = F≤PathPLemma ⋁β++γ≡x∨y ⋁β≡x - (subst (⋁ β ≤_) (sym (⋁Split++ β γ)) (∨≤RCancel _ _)) - (hom-∨₁ L C x y) - - squarePathP : PathP (λ i → pbPr₁PathP i ⋆⟨ C ⟩ cospanPath i .s₁ - ≡ pbPr₂PathP i ⋆⟨ C ⟩ cospanPath i .s₂) - (pbCommutes ⋁Pullback) (Fsq L C x y (DLRan F)) - squarePathP = toPathP (isSetHom C _ _ _ _) - - - -- main result, putting everything together: - isDLSheafDLRan : isDLSheaf L C (DLRan F) - isDLSheafDLRan = P→L isDLSheafPullbackDLRan +open import Cubical.Relation.Binary.Order.Poset +open import Cubical.HITs.PropositionalTruncation + +open import Cubical.Algebra.Semilattice +open import Cubical.Algebra.Lattice +open import Cubical.Algebra.DistLattice +open import Cubical.Algebra.DistLattice.Basis +open import Cubical.Algebra.DistLattice.BigOps + +open import Cubical.Categories.Category.Base +open import Cubical.Categories.Functor +open import Cubical.Categories.NaturalTransformation +open import Cubical.Categories.Limits.Limits +open import Cubical.Categories.Limits.Pullback +open import Cubical.Categories.Limits.Terminal +open import Cubical.Categories.Limits.RightKan +open import Cubical.Categories.Instances.Poset +open import Cubical.Categories.Instances.Semilattice +open import Cubical.Categories.Instances.Lattice +open import Cubical.Categories.Instances.DistLattice + +open import Cubical.Categories.DistLatticeSheaf.Diagram +open import Cubical.Categories.DistLatticeSheaf.Base + +private + variable + ℓ ℓ' ℓ'' : Level + + +module PreSheafExtension (L : DistLattice ℓ) (C : Category ℓ' ℓ'') + (limitC : Limits {ℓ} {ℓ} C) (L' : ℙ (fst L)) where + + open Category hiding (_∘_) + open Functor + open Cone + open LimCone + + private + DLCat = DistLatticeCategory L + DLSubCat = ΣPropCat DLCat L' + DLPreSheaf = Functor (DLCat ^op) C + DLSubPreSheaf = Functor (DLSubCat ^op) C + + baseIncl : Functor DLSubCat DLCat + F-ob baseIncl = fst + F-hom baseIncl f = f + F-id baseIncl = refl + F-seq baseIncl _ _ = refl + + DLRan : DLSubPreSheaf → DLPreSheaf + DLRan = Ran limitC (baseIncl ^opF) + + DLRanNatTrans : (F : DLSubPreSheaf) → NatTrans (funcComp (DLRan F) (baseIncl ^opF)) F + DLRanNatTrans = RanNatTrans _ _ + + DLRanUnivProp : ∀ (F : DLSubPreSheaf) (G : DLPreSheaf) (α : NatTrans (G ∘F (baseIncl ^opF)) F) + → ∃![ σ ∈ NatTrans G (DLRan F) ] α ≡ (σ ∘ˡ (baseIncl ^opF)) ●ᵛ (DLRanNatTrans F) + DLRanUnivProp = RanUnivProp _ _ + + DLRanNatIso : (F : DLSubPreSheaf) → NatIso (funcComp (DLRan F) (baseIncl ^opF)) F + DLRanNatIso F = RanNatIso _ _ _ (λ _ _ → idIsEquiv _) + + module _ (isBasisL' : IsBasis L L') (F : DLSubPreSheaf) + (isSheafF : SheafOnBasis.isDLBasisSheaf L C L' isBasisL' F) where + open SheafOnBasis L C L' isBasisL' + open Order (DistLattice→Lattice L) + open DistLatticeStr (snd L) + open Join L + open JoinSemilattice (Lattice→JoinSemilattice (DistLattice→Lattice L)) + open MeetSemilattice (Lattice→MeetSemilattice (DistLattice→Lattice L)) + using (∧≤RCancel ; ∧≤LCancel ; ≤-∧Pres ; ≤-∧RPres ; ≤-∧LPres) + open PosetStr (IndPoset .snd) hiding (_≤_; is-set) + open IsBasis ⦃...⦄ + open EquivalenceOfDefs L C (DLRan F) + open condCone + + private + instance + _ = isBasisL' + + F* = T* limitC (baseIncl ^opF) F + + -- a neat lemma + F≤PathPLemmaBase : ∀ {x y z w : ob DLSubCat} (p : x ≡ y) (q : z ≡ w) + (x≥z : (DLSubCat ^op) [ x , z ]) (y≥w : (DLSubCat ^op) [ y , w ]) + → PathP (λ i → C [ F .F-ob (p i) , F .F-ob (q i) ]) (F .F-hom x≥z) (F .F-hom y≥w) + F≤PathPLemmaBase p q x≥z y≥w i = + F .F-hom (isProp→PathP (λ j → is-prop-valued (q j .fst) (p j .fst)) x≥z y≥w i) + + + -- the crucial lemmas that will give us the cones needed to construct the unique + -- arrow in our pullback square below + module _ {n : ℕ} (α : FinVec (fst L) n) (α∈L' : ∀ i → α i ∈ L') where + private -- from the definition of the can extension + ⋁α↓ = _↓Diag limitC (baseIncl ^opF) F (⋁ α) + F[⋁α]Cone = limitC ⋁α↓ (F* (⋁ α)) .limCone + + -- notation that will be used throughout the file. + -- this is the restriction of the limiting cone through which we define + -- the Kan-extension to the αᵢ's + restCone : Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) (DLRan F .F-ob (⋁ α)) + coneOut restCone (sing i) = F[⋁α]Cone .coneOut ((α i , α∈L' i) , ind≤⋁ α i) + coneOut restCone (pair i j i<j) = F[⋁α]Cone .coneOut + ((α i ∧l α j , ∧lClosed _ _ (α∈L' i) (α∈L' j)) + , is-trans _ (α i) _ (≤m→≤j _ _ (∧≤RCancel _ _)) (ind≤⋁ α i)) + coneOutCommutes restCone {u = sing i} idAr = F[⋁α]Cone .coneOutCommutes + (is-refl _ , is-prop-valued _ _ _ _) + coneOutCommutes restCone {u = pair i j i<j} idAr = F[⋁α]Cone .coneOutCommutes + (is-refl _ , is-prop-valued _ _ _ _) + coneOutCommutes restCone singPairL = F[⋁α]Cone .coneOutCommutes + (≤m→≤j _ _ (∧≤RCancel _ _) , is-prop-valued _ _ _ _) + coneOutCommutes restCone singPairR = F[⋁α]Cone .coneOutCommutes + (≤m→≤j _ _ (∧≤LCancel _ _) , is-prop-valued _ _ _ _) + + -- super technical stuff culminating in the last lemma, + -- which will be the only one used. Lemma 1-3 are therefore private + private + -- notation for applying the hypothesis that we have a sheaf on the basis + β : (u : fst L) → FinVec (fst L) n + β u i = u ∧l α i + + β∈L' : ∀ (u : fst L) → u ∈ L' → ∀ i → β u i ∈ L' + β∈L' u u∈L' i = ∧lClosed _ _ u∈L' (α∈L' i) + + β≡ : ∀ (u : fst L) → u ≤ ⋁ α → u ≡ ⋁ (β u) + β≡ u u≤⋁α = sym (≤j→≤m _ _ u≤⋁α) ∙ ⋁Meetrdist _ _ + + ⋁β∈L' : ∀ (u : fst L) → u ∈ L' → u ≤ ⋁ α → ⋁ (β u) ∈ L' + ⋁β∈L' u u∈L' u≤⋁α = subst-∈ L' (β≡ u u≤⋁α) u∈L' + + βCone : (c : ob C) (u : fst L) (u∈L' : u ∈ L') + → Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c + → Cone (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i))) c + coneOut (βCone c u u∈L' cc) (sing i) = coneOut cc (sing i) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + coneOut (βCone c u u∈L' cc) (pair i j i<j) = coneOut cc (pair i j i<j) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _))) + coneOutCommutes (βCone c u u∈L' cc) {u = v} idAr = + cong (λ x → coneOut (βCone c u u∈L' cc) v ⋆⟨ C ⟩ x) + (F-id (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i)))) + ∙ ⋆IdR C _ + coneOutCommutes (βCone c u u∈L' cc) (singPairL {i = i} {j} {i<j}) = + coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i)) .F-hom singPairL) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + coneOut cc (sing i) ⋆⟨ C ⟩ (F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i)) .F-hom singPairL)) + ≡⟨ cong (λ x → coneOut cc (sing i) ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ + coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom + (≤m→≤j _ _ (∧≤LCancel _ _) ⋆⟨ DLCat ^op ⟩ + (BDiag (λ i → β u i , β∈L' u u∈L' i) .F-hom (singPairL {i = i} {j} {i<j}))) + ≡⟨ cong (λ x → coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom + {y = β u i ∧l β u j , ∧lClosed _ _ (β∈L' u u∈L' i) (β∈L' u u∈L' j)} x) + (is-prop-valued _ _ _ _) ⟩ + coneOut cc (sing i) + ⋆⟨ C ⟩ F .F-hom ((BDiag (λ i → α i , α∈L' i)) .F-hom (singPairL {i = i} {j} {i<j}) + ⋆⟨ DLCat ^op ⟩ ≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _))) + ≡⟨ cong (λ x → coneOut cc (sing i) ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ + coneOut cc (sing i) + ⋆⟨ C ⟩ ((funcComp F (BDiag (λ i → α i , α∈L' i)) .F-hom (singPairL {i = i} {j} {i<j})) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (coneOut cc (sing i) + ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → α i , α∈L' i)) .F-hom (singPairL {i = i} {j} {i<j}))) + ⋆⟨ C ⟩ F .F-hom ((≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ F .F-hom + {y = β u i ∧l β u j , ∧lClosed _ _ (β∈L' u u∈L' i) (β∈L' u u∈L' j)} + (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) + (coneOutCommutes cc (singPairL {i = i} {j} {i<j})) ⟩ + coneOut (βCone c u u∈L' cc) (pair i j i<j) ∎ + + coneOutCommutes (βCone c u u∈L' cc) (singPairR {i = i} {j} {i<j}) = + coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i)) .F-hom singPairR) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + coneOut cc (sing j) ⋆⟨ C ⟩ (F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → β u i , β∈L' u u∈L' i)) .F-hom singPairR)) + ≡⟨ cong (λ x → coneOut cc (sing j) ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ + coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom + (≤m→≤j _ _ (∧≤LCancel _ _) ⋆⟨ DLCat ^op ⟩ + (BDiag (λ i → β u i , β∈L' u u∈L' i) .F-hom (singPairR {i = i} {j} {i<j}))) + ≡⟨ cong (λ x → coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom + {y = β u i ∧l β u j , ∧lClosed _ _ (β∈L' u u∈L' i) (β∈L' u u∈L' j)} x) + (is-prop-valued _ _ _ _) ⟩ + coneOut cc (sing j) + ⋆⟨ C ⟩ F .F-hom ((BDiag (λ i → α i , α∈L' i)) .F-hom (singPairR {i = i} {j} {i<j}) + ⋆⟨ DLCat ^op ⟩ ≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _))) + ≡⟨ cong (λ x → coneOut cc (sing j) ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ + coneOut cc (sing j) + ⋆⟨ C ⟩ ((funcComp F (BDiag (λ i → α i , α∈L' i)) .F-hom (singPairR {i = i} {j} {i<j})) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (coneOut cc (sing j) + ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → α i , α∈L' i)) .F-hom (singPairR {i = i} {j} {i<j}))) + ⋆⟨ C ⟩ F .F-hom ((≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ F .F-hom + {y = β u i ∧l β u j , ∧lClosed _ _ (β∈L' u u∈L' i) (β∈L' u u∈L' j)} + (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (∧≤LCancel _ _) (∧≤LCancel _ _)))) + (coneOutCommutes cc (singPairR {i = i} {j} {i<j})) ⟩ + coneOut (βCone c u u∈L' cc) (pair i j i<j) ∎ + + + -- this is the crucial application of our assumption that F is a sheaf on L' + uniqβConeMor : (c : ob C) (cc : Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c) + (u : fst L) (u∈L' : u ∈ L') (u≤⋁α : u ≤ ⋁ α) + → ∃![ f ∈ C [ c , F .F-ob (⋁ (β u) , ⋁β∈L' u u∈L' u≤⋁α) ] ] + (isConeMor (βCone c u u∈L' cc) + (F-cone F (B⋁Cone (λ i → β u i , β∈L' u u∈L' i) (⋁β∈L' u u∈L' u≤⋁α))) f) + uniqβConeMor c cc u u∈L' u≤⋁α = + isSheafF (λ i → β u i , β∈L' u u∈L' i) (⋁β∈L' u u∈L' u≤⋁α) c (βCone c u u∈L' cc) + + + -- the lemma giving us the desired cone + lemma1 : (c : ob C) → Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c → Cone (F* (⋁ α)) c + coneOut (lemma1 c cc) ((u , u∈L') , u≤⋁α) = + subst (λ x → C [ c , F .F-ob x ]) + (Σ≡Prop (λ x → L' x .snd) {u = _ , ⋁β∈L' u u∈L' u≤⋁α} (sym (β≡ u u≤⋁α))) + (uniqβConeMor c cc u u∈L' u≤⋁α .fst .fst) + coneOutCommutes (lemma1 c cc) {u = ((u , u∈L') , u≤⋁α)} {v = ((v , v∈L') , v≤⋁α)} (v≤u , p) = + transport (λ i → fᵤPathP i ⋆⟨ C ⟩ ePathP i ≡ fᵥPathP i) triangle + where + e : C [ F .F-ob (⋁ (β u) , ⋁β∈L' u u∈L' u≤⋁α) , F .F-ob (⋁ (β v) , ⋁β∈L' v v∈L' v≤⋁α) ] + e = F .F-hom (subst2 _≤_ (β≡ v v≤⋁α) (β≡ u u≤⋁α) v≤u) -- F(⋁βᵥ≤⋁βᵤ) + + fᵤ : C [ c , F .F-ob (⋁ (β u) , ⋁β∈L' u u∈L' u≤⋁α) ] + fᵤ = uniqβConeMor c cc u u∈L' u≤⋁α .fst .fst + + fᵥ : C [ c , F .F-ob (⋁ (β v) , ⋁β∈L' v v∈L' v≤⋁α) ] + fᵥ = uniqβConeMor c cc v v∈L' v≤⋁α .fst .fst + + -- for convenience + pᵤ = (Σ≡Prop (λ x → L' x .snd) {u = _ , ⋁β∈L' u u∈L' u≤⋁α} (sym (β≡ u u≤⋁α))) + pᵥ = (Σ≡Prop (λ x → L' x .snd) {u = _ , ⋁β∈L' v v∈L' v≤⋁α} (sym (β≡ v v≤⋁α))) + + fᵤPathP : PathP (λ i → C [ c , F .F-ob (pᵤ i) ]) + fᵤ (coneOut (lemma1 c cc) ((u , u∈L') , u≤⋁α)) + fᵤPathP = subst-filler (λ x → C [ c , F .F-ob x ]) pᵤ fᵤ + + fᵥPathP : PathP (λ i → C [ c , F .F-ob (pᵥ i) ]) + fᵥ (coneOut (lemma1 c cc) ((v , v∈L') , v≤⋁α)) + fᵥPathP = subst-filler (λ x → C [ c , F .F-ob x ]) pᵥ fᵥ + + ePathP : PathP (λ i → C [ F .F-ob (pᵤ i) , F .F-ob (pᵥ i) ]) e (F .F-hom v≤u) + ePathP i = F .F-hom (subst2-filler (_≤_) (β≡ v v≤⋁α) (β≡ u u≤⋁α) v≤u (~ i)) + + + -- triangle to be transported by universal property + triangle : fᵤ ⋆⟨ C ⟩ e ≡ fᵥ + triangle = sym (cong fst (uniqβConeMor c cc v v∈L' v≤⋁α .snd (fᵤ ⋆⟨ C ⟩ e , compIsConeMor))) + where + compIsConeMor : isConeMor (βCone c v v∈L' cc) + (F-cone F (B⋁Cone (λ i → β v i , β∈L' v v∈L' i) (⋁β∈L' v v∈L' v≤⋁α))) + (fᵤ ⋆⟨ C ⟩ e) + compIsConeMor = isConeMorSingLemma + (βCone c v v∈L' cc) + (F-cone F (B⋁Cone (λ i → β v i , β∈L' v v∈L' i) (⋁β∈L' v v∈L' v≤⋁α))) + singCase + where + singCase : ∀ i → (fᵤ ⋆⟨ C ⟩ e) ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β v) i) + ≡ coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j (v ∧l α i) (α i) (∧≤LCancel _ _)) + singCase i = + (fᵤ ⋆⟨ C ⟩ e) ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β v) i) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + fᵤ ⋆⟨ C ⟩ (e ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β v) i)) + ≡⟨ cong (λ x → fᵤ ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ + fᵤ ⋆⟨ C ⟩ F .F-hom + (subst2 _≤_ (β≡ v v≤⋁α) (β≡ u u≤⋁α) v≤u ⋆⟨ DLCat ^op ⟩ ind≤⋁ (β v) i) + ≡⟨ cong (λ x → fᵤ ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ v∈L' (α∈L' i)} x) + (is-prop-valued _ _ _ _) ⟩ + fᵤ ⋆⟨ C ⟩ F .F-hom + (ind≤⋁ (β u) i ⋆⟨ DLCat ^op ⟩ ≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u))) + ≡⟨ cong (λ x → fᵤ ⋆⟨ C ⟩ x) (F .F-seq _ _) ⟩ + fᵤ ⋆⟨ C ⟩ (F .F-hom {y = _ , ∧lClosed _ _ u∈L' (α∈L' i)} (ind≤⋁ (β u) i) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u)))) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (fᵤ ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ u∈L' (α∈L' i)} (ind≤⋁ (β u) i)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u))) + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u)))) + (uniqβConeMor c cc u u∈L' u≤⋁α .fst .snd (sing i)) ⟩ + (coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ u∈L' (α∈L' i)} + (≤m→≤j (u ∧l α i) (α i) (∧≤LCancel _ _))) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u))) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + coneOut cc (sing i) ⋆⟨ C ⟩ (F .F-hom {y = _ , ∧lClosed _ _ u∈L' (α∈L' i)} + (≤m→≤j (u ∧l α i) (α i) (∧≤LCancel _ _)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u)))) + ≡⟨ cong (λ x → coneOut cc (sing i) ⋆⟨ C ⟩ x) (sym (F .F-seq _ _)) ⟩ + coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom + (≤m→≤j (u ∧l α i) (α i) (∧≤LCancel _ _) + ⋆⟨ DLCat ^op ⟩ ≤m→≤j _ _ (≤-∧RPres _ _ _ (≤j→≤m _ _ v≤u))) + ≡⟨ cong (λ x → coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom + {y = _ , ∧lClosed _ _ v∈L' (α∈L' i)} x) + (is-prop-valued _ _ _ _) ⟩ + coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j (v ∧l α i) (α i) (∧≤LCancel _ _)) ∎ + + + -- gives us preservation of cone morphisms that ensure uniqueness + lemma2 : ∀ (c : ob C) (cc : Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c) + (f : C [ c , (DLRan F .F-ob (⋁ α)) ]) + → isConeMor cc restCone f + → isConeMor (lemma1 c cc) F[⋁α]Cone f + lemma2 c cc f isRestConeMorf ((u , u∈L') , u≤⋁α) = + transport (λ i → f ⋆⟨ C ⟩ coneOutPathP i ≡ bᵤPathP i) triangle + where + -- for convenience + pᵤ = Σ≡Prop (λ x → L' x .snd) {u = _ , ⋁β∈L' u u∈L' u≤⋁α} + {v = _ , u∈L'} (sym (β≡ u u≤⋁α)) + + bᵤ : C [ c , F .F-ob (⋁ (β u) , ⋁β∈L' u u∈L' u≤⋁α) ] + bᵤ = uniqβConeMor c cc u u∈L' u≤⋁α .fst .fst + + bᵤPathP : PathP (λ i → C [ c , F .F-ob (pᵤ i) ]) + bᵤ (coneOut (lemma1 c cc) ((u , u∈L') , u≤⋁α)) + bᵤPathP = subst-filler (λ x → C [ c , F .F-ob x ]) pᵤ bᵤ + + + ⋁βᵤ : ob ⋁α↓ + ⋁βᵤ = ((⋁ (β u) , ⋁β∈L' u u∈L' u≤⋁α) , subst (_≤ ⋁ α) (β≡ u u≤⋁α) u≤⋁α) + + coneOutPathP : PathP (λ i → C [ (DLRan F .F-ob (⋁ α)) , F .F-ob (pᵤ i) ]) + (coneOut F[⋁α]Cone ⋁βᵤ) (coneOut F[⋁α]Cone ((u , u∈L') , u≤⋁α)) + coneOutPathP i = coneOut F[⋁α]Cone ((pᵤ i) , subst-filler (_≤ ⋁ α) (β≡ u u≤⋁α) u≤⋁α (~ i)) + + triangle : f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ⋁βᵤ ≡ bᵤ + triangle = sym (cong fst (uniqβConeMor c cc u u∈L' u≤⋁α .snd + (f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ⋁βᵤ , compIsConeMor))) + where + compIsConeMor : isConeMor (βCone c u u∈L' cc) + (F-cone F (B⋁Cone (λ i → β u i , β∈L' u u∈L' i) (⋁β∈L' u u∈L' u≤⋁α))) + (f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ⋁βᵤ) + compIsConeMor = isConeMorSingLemma + (βCone c u u∈L' cc) + (F-cone F (B⋁Cone (λ i → β u i , β∈L' u u∈L' i) (⋁β∈L' u u∈L' u≤⋁α))) + singCase + where + u∧αᵢ≤⋁α : ∀ i → (DLCat ^op) [ ⋁ α , u ∧l α i ] + u∧αᵢ≤⋁α _ = is-trans _ _ _ (≤m→≤j _ _ (∧≤RCancel _ _)) u≤⋁α + + singCase : ∀ i → (f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ⋁βᵤ) ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β u) i) + ≡ coneOut (βCone c u u∈L' cc) (sing i) + singCase i = + (f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ⋁βᵤ) ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β u) i) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + f ⋆⟨ C ⟩ (coneOut F[⋁α]Cone ⋁βᵤ ⋆⟨ C ⟩ F .F-hom (ind≤⋁ (β u) i)) + ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) + (coneOutCommutes F[⋁α]Cone (ind≤⋁ (β u) i , is-prop-valued _ _ _ _)) ⟩ + f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ((u ∧l α i , ∧lClosed _ _ u∈L' (α∈L' i)) , u∧αᵢ≤⋁α i) + ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) (sym (coneOutCommutes F[⋁α]Cone + (≤m→≤j _ _ (∧≤LCancel _ _) , is-prop-valued _ _ _ _))) ⟩ + f ⋆⟨ C ⟩ (coneOut F[⋁α]Cone ((α i , α∈L' i) , ind≤⋁ α i) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (f ⋆⟨ C ⟩ coneOut F[⋁α]Cone ((α i , α∈L' i) , ind≤⋁ α i)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) (isRestConeMorf (sing i)) ⟩ + coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ∎ + + -- the other direction, surprisingly hard + lemma3 : ∀ (c : ob C) (cc : Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c) + (f : C [ c , DLRan F .F-ob (⋁ α) ]) + → isConeMor (lemma1 c cc) F[⋁α]Cone f + → isConeMor cc restCone f + lemma3 c cc f isConeMorF = isConeMorSingLemma cc restCone singCase + where + singCase : ∀ i → f ⋆⟨ C ⟩ coneOut restCone (sing i) ≡ coneOut cc (sing i) + singCase i = + subst (λ g → f ⋆⟨ C ⟩ (F[⋁α]Cone .coneOut ((α i , α∈L' i) , ind≤⋁ α i)) ≡ g) + (transport (λ j → helperPathP j ≡ ccᵢSubstFiller (~ j)) ccᵢSubstPath) + assumption + where + assumption : f ⋆⟨ C ⟩ (F[⋁α]Cone .coneOut ((α i , α∈L' i) , ind≤⋁ α i)) + ≡ coneOut (lemma1 c cc) ((α i , α∈L' i) , ind≤⋁ α i) + assumption = isConeMorF ((α i , α∈L' i) , ind≤⋁ α i) + + -- modulo transport + Σpathhelper : (α i , α∈L' i) ≡ (⋁ (β (α i)) , ⋁β∈L' (α i) (α∈L' i) (ind≤⋁ α i)) + Σpathhelper = Σ≡Prop (λ x → L' x .snd) (β≡ (α i) (ind≤⋁ α i)) + + Σpathhelper2 : (⋁ (β (α i)) , ⋁β∈L' (α i) (α∈L' i) (ind≤⋁ α i)) ≡ (α i , α∈L' i) + Σpathhelper2 = Σ≡Prop (λ x → L' x .snd) (sym (β≡ (α i) (ind≤⋁ α i))) + + ccᵢSubst : C [ c , F .F-ob (⋁ (β (α i)) , ⋁β∈L' (α i) (α∈L' i) (ind≤⋁ α i)) ] + ccᵢSubst = subst (λ x → C [ c , F .F-ob x ]) + (Σ≡Prop (λ x → L' x .snd) (β≡ (α i) (ind≤⋁ α i))) + (coneOut cc (sing i)) + + ccᵢSubstFiller : PathP (λ j → C [ c , F .F-ob (Σpathhelper j) ]) + (coneOut cc (sing i)) ccᵢSubst + ccᵢSubstFiller = subst-filler (λ x → C [ c , F .F-ob x ]) Σpathhelper (coneOut cc (sing i)) + + βSubstFiller : PathP (λ j → C [ c , F .F-ob (Σpathhelper2 j) ]) + (uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .fst .fst) + (coneOut (lemma1 c cc) ((α i , α∈L' i) , ind≤⋁ α i)) + βSubstFiller = subst-filler (λ x → C [ c , F .F-ob x ]) Σpathhelper2 + (uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .fst .fst) + + Σpathhelperpath : Σpathhelper2 ≡ sym Σpathhelper + Σpathhelperpath = isSetL' _ _ _ _ + where + isSetL' : isSet (ob DLSubCat) + isSetL' = isSetΣSndProp is-set λ x → L' x .snd + + helperPathP : PathP (λ j → C [ c , F .F-ob (Σpathhelper (~ j)) ]) + (uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .fst .fst) + (coneOut (lemma1 c cc) ((α i , α∈L' i) , ind≤⋁ α i)) + helperPathP = subst (λ p → PathP (λ j → C [ c , F .F-ob (p j) ]) + (uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .fst .fst) + (coneOut (lemma1 c cc) ((α i , α∈L' i) , ind≤⋁ α i))) + Σpathhelperpath βSubstFiller + + ccᵢSubstIsConeMor : isConeMor (βCone c (α i) (α∈L' i) cc) + (F-cone F (B⋁Cone (λ j → (β (α i) j) , β∈L' (α i) (α∈L' i) j) + (⋁β∈L' (α i) (α∈L' i) (ind≤⋁ α i)))) + ccᵢSubst + ccᵢSubstIsConeMor = isConeMorSingLemma (βCone c (α i) (α∈L' i) cc) + (F-cone F (B⋁Cone (λ j → (β (α i) j) , β∈L' (α i) (α∈L' i) j) + (⋁β∈L' (α i) (α∈L' i) (ind≤⋁ α i)))) + singCase2 + where + singCase2 : (j : Fin n) → ccᵢSubst ⋆⟨ C ⟩ F-hom F (ind≤⋁ (β (α i)) j) + ≡ coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + singCase2 j = + (λ 𝕚 → ccᵢSubstFiller (~ 𝕚) + ⋆⟨ C ⟩ F≤PathPLemmaBase + (sym Σpathhelper) refl + (ind≤⋁ (β (α i)) j) (≤m→≤j _ _ (∧≤RCancel _ _)) 𝕚) + ∙ path + where + path : coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) + ≡ coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + path with (i ≟Fin j) + ... | (lt i<j) = coneOutCommutes cc (singPairL {i<j = i<j}) + ∙ sym (coneOutCommutes cc singPairR) + ... | (gt j<i) = transport (λ 𝕚 → B 𝕚) almostPath + where + ∧Path : Path (ob DLSubCat) (α j ∧l α i , β∈L' (α j) (α∈L' j) i) + (α i ∧l α j , β∈L' (α i) (α∈L' i) j) + ∧Path = Σ≡Prop (λ x → L' x .snd) (∧lComm _ _) + + almostPath : coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + ≡ coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) + almostPath = (coneOutCommutes cc (singPairR {i<j = j<i}) + ∙ sym (coneOutCommutes cc singPairL)) + + B : I → Type ℓ'' + B = λ 𝕚 → coneOut cc (sing i) ⋆⟨ C ⟩ F≤PathPLemmaBase refl ∧Path + (≤m→≤j _ _ (∧≤LCancel _ _)) + (≤m→≤j _ _ (∧≤RCancel _ _)) 𝕚 + ≡ coneOut cc (sing j) ⋆⟨ C ⟩ F≤PathPLemmaBase refl ∧Path + (≤m→≤j _ _ (∧≤RCancel _ _)) + (≤m→≤j _ _ (∧≤LCancel _ _)) 𝕚 + + ... | (eq i≡j) = + coneOut cc (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) + ≡⟨ (λ 𝕚 → coneOut cc (sing (i≡j 𝕚)) + ⋆⟨ C ⟩ F≤PathPLemmaBase (λ 𝕛 → α (i≡j 𝕛) , α∈L' (i≡j 𝕛)) + refl + (≤m→≤j _ _ (∧≤RCancel _ _)) + (≤m→≤j _ _ (∧≤LCancel _ _)) 𝕚) ⟩ + coneOut cc (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ∎ + + + ccᵢSubstPath : uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .fst .fst ≡ ccᵢSubst + ccᵢSubstPath = cong fst + (uniqβConeMor c cc (α i) (α∈L' i) (ind≤⋁ α i) .snd (ccᵢSubst , ccᵢSubstIsConeMor)) + + + + -- putting it all together + coverLemma : ∀ (c : ob C) (cc : Cone (funcComp F (BDiag (λ i → α i , α∈L' i))) c) + → ∃![ f ∈ C [ c , DLRan F .F-ob (⋁ α) ] ] isConeMor cc restCone f + coverLemma c cc = uniqueExists + (fromUnivProp .fst .fst) + (lemma3 c cc _ (fromUnivProp .fst .snd)) + (λ _ → isPropIsConeMor _ _ _) + λ g isConeMorG → cong fst (fromUnivProp .snd (g , lemma2 c cc g isConeMorG)) + where + fromUnivProp : ∃![ f ∈ C [ c , DLRan F .F-ob (⋁ α) ] ] isConeMor (lemma1 c cc) F[⋁α]Cone f + fromUnivProp = limitC ⋁α↓ (F* (⋁ α)) .univProp c (lemma1 c cc) + + + -- a little notation that is used in the following module but should be outside + open FinSumChar using (++FinInl ; ++FinInr) + renaming (fun to FSCfun ; inv to FSCinv ; sec to FSCsec) + + private + β++γ∈L' : {n : ℕ} {n' : ℕ} {γ : FinVec (fst L) n'} {β : FinVec (fst L) n} + (β∈L' : ∀ i → β i ∈ L') (γ∈L' : ∀ i → γ i ∈ L') + → ∀ i → (β ++Fin γ) i ∈ L' + β++γ∈L' β∈L' γ∈L' = ++FinPres∈ L' β∈L' γ∈L' + + ++FinInlΣ : {n : ℕ} {n' : ℕ} {γ : FinVec (fst L) n'} {β : FinVec (fst L) n} + (β∈L' : ∀ i → β i ∈ L') (γ∈L' : ∀ i → γ i ∈ L') + → ∀ i → Path (ob DLSubCat) (β i , β∈L' i) + ((β ++Fin γ) (FSCfun _ _ (inl i)) , β++γ∈L' β∈L' γ∈L' (FSCfun _ _ (inl i))) + ++FinInlΣ {ℕ.zero} _ _ () + ++FinInlΣ {ℕ.suc n} _ _ zero = refl + ++FinInlΣ {ℕ.suc n} β∈L' γ∈L' (suc i) = ++FinInlΣ (β∈L' ∘ suc) γ∈L' i + + ++FinInrΣ : {n : ℕ} {n' : ℕ} {γ : FinVec (fst L) n'} {β : FinVec (fst L) n} + (β∈L' : ∀ i → β i ∈ L') (γ∈L' : ∀ i → γ i ∈ L') + → ∀ i → Path (ob DLSubCat) (γ i , γ∈L' i) + ((β ++Fin γ) (FSCfun _ _ (inr i)) , β++γ∈L' β∈L' γ∈L' (FSCfun _ _ (inr i))) + ++FinInrΣ {ℕ.zero} _ _ i = refl + ++FinInrΣ {ℕ.suc n} β∈L' γ∈L' i = ++FinInrΣ (β∈L' ∘ suc) γ∈L' i + + module ++Lemmas {c : ob C} {n' : ℕ} {γ : FinVec (fst L) n'} {γ∈L' : ∀ i → γ i ∈ L'} + (ccγ : Cone (funcComp F (BDiag (λ i → γ i , γ∈L' i))) c) where + + private + β∧γ : {n : ℕ} {β : FinVec (fst L) n} (β∈L' : ∀ i → β i ∈ L') + → Fin n → Fin n' → ob DLSubCat + β∧γ {β = β} β∈L' i j = (β i ∧l γ j) , ∧lClosed _ _ (β∈L' i) (γ∈L' j) + + β≥β∧γ : {n : ℕ} {β : FinVec (fst L) n} (β∈L' : ∀ i → β i ∈ L') + → ∀ i j → (DLSubCat ^op) [ (β i , β∈L' i) , β∧γ β∈L' i j ] + β≥β∧γ β∈L' i j = ≤m→≤j _ _ (∧≤RCancel _ _) + + γ≥β∧γ : {n : ℕ} {β : FinVec (fst L) n} (β∈L' : ∀ i → β i ∈ L') + → ∀ i j → (DLSubCat ^op) [ (γ j , γ∈L' j) , β∧γ β∈L' i j ] + γ≥β∧γ β∈L' i j = ≤m→≤j _ _ (∧≤LCancel _ _) + + CommHypType : {n : ℕ} {β : FinVec (fst L) n} (β∈L' : ∀ i → β i ∈ L') + (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) + → Type ℓ'' + CommHypType β∈L' ccβ = ∀ i j → + ccβ .coneOut (sing i) + ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ (β∈L' i) (γ∈L' j)} (β≥β∧γ β∈L' i j) + ≡ ccγ .coneOut (sing j) ⋆⟨ C ⟩ F .F-hom (γ≥β∧γ β∈L' i j) + + coneSuc : {n : ℕ} {β : FinVec (fst L) (ℕ.suc n)} {β∈L' : ∀ i → β i ∈ L'} + → Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c + → Cone (funcComp F (BDiag (λ i → β (suc i) , β∈L' (suc i)))) c + coneOut (coneSuc ccβ) (sing i) = coneOut ccβ (sing (suc i)) + coneOut (coneSuc ccβ) (pair i j i<j) = coneOut ccβ (pair (suc i) (suc j) (s≤s i<j)) + coneOutCommutes (coneSuc ccβ) {u = sing i} idAr = coneOutCommutes ccβ idAr + coneOutCommutes (coneSuc ccβ) {u = pair i j i<j} idAr = coneOutCommutes ccβ idAr + coneOutCommutes (coneSuc ccβ) singPairL = coneOutCommutes ccβ singPairL + coneOutCommutes (coneSuc ccβ) singPairR = coneOutCommutes ccβ singPairR + + --make this explicit to avoid yellow + commHypSuc : {n : ℕ} {β : FinVec (fst L) (ℕ.suc n)} {β∈L' : ∀ i → β i ∈ L'} + {ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c} + → CommHypType β∈L' ccβ + → CommHypType (β∈L' ∘ suc) (coneSuc ccβ) + commHypSuc commHyp i j = commHyp (suc i) j + + toConeOut : (n : ℕ) (β : FinVec (fst L) n) (β∈L' : ∀ i → β i ∈ L') + (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) + (ch : CommHypType β∈L' ccβ) + → ∀ (v : DLShfDiagOb (n + n')) + → C [ c , funcComp F (BDiag (λ i → (β ++Fin γ) i , β++γ∈L' β∈L' γ∈L' i)) .F-ob v ] + toConeOut ℕ.zero β β∈L' ccβ ch (sing i) = ccγ .coneOut (sing i) + toConeOut ℕ.zero β β∈L' ccβ ch (pair i j i<j) = ccγ .coneOut (pair i j i<j) + toConeOut (ℕ.suc n) β β∈L' ccβ ch (sing zero) = ccβ .coneOut (sing zero) + toConeOut (ℕ.suc n) β β∈L' ccβ ch (sing (suc i)) = + toConeOut n (β ∘ suc) (β∈L' ∘ suc) (coneSuc ccβ) (commHypSuc ch) (sing i) + toConeOut (ℕ.suc n) β β∈L' ccβ ch (pair zero j 0<j) = + ccβ .coneOut (sing zero) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) + toConeOut (ℕ.suc n) β β∈L' ccβ ch (pair (suc i) zero ()) + toConeOut (ℕ.suc n) β β∈L' ccβ ch (pair (suc i) (suc j) (s≤s i<j)) = + toConeOut n (β ∘ suc) (β∈L' ∘ suc) (coneSuc ccβ) (commHypSuc ch) (pair i j i<j) + + -- crucial step in proving that this defines a cone is another induction + -- βₛ is supposed to be (β ∘ suc) and β₀ is (β zero) + toConeOutLemma : (n : ℕ) (βₛ : FinVec (fst L) n) (βₛ∈L' : ∀ i → βₛ i ∈ L') + (ccβₛ : Cone (funcComp F (BDiag (λ i → βₛ i , βₛ∈L' i))) c) + (chₛ : CommHypType βₛ∈L' ccβₛ) + (β₀ : fst L) (β₀∈L' : β₀ ∈ L') + -- cone over [β₀]++βₛ + {ccβ₀ : C [ c , F .F-ob (β₀ , β₀∈L') ]} + {ccβ₀ᵢ : (i : Fin n) → C [ c , F .F-ob (β₀ ∧l βₛ i , ∧lClosed _ _ β₀∈L' (βₛ∈L' i)) ]} + (ccβ₀L : ∀ i → ccβ₀ ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) ≡ ccβ₀ᵢ i) + (ccβ₀R : ∀ i → ccβₛ .coneOut (sing i) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ≡ ccβ₀ᵢ i) + -- ch at zero + (ch₀ : ∀ j → + ccβ₀ ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ β₀∈L' (γ∈L' j)} (≤m→≤j _ _ (∧≤RCancel _ _)) + ≡ ccγ .coneOut (sing j) ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) + --------------------------------------------------------------------- + → ∀ j → toConeOut n βₛ βₛ∈L' ccβₛ chₛ (sing j) + ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ β₀∈L' (β++γ∈L' βₛ∈L' γ∈L' j)} + (≤m→≤j _ _ (∧≤LCancel _ _)) + ≡ ccβ₀ ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) + toConeOutLemma ℕ.zero _ _ _ _ _ _ _ _ ch₀ j = sym (ch₀ j) + toConeOutLemma (ℕ.suc n) _ _ _ _ _ _ ccβ₀L ccβ₀R _ zero = ccβ₀R zero ∙ sym (ccβ₀L zero) + toConeOutLemma (ℕ.suc n) βₛ βₛ∈L' ccβₛ chₛ β₀ β₀∈L' ccβ₀L ccβ₀R ch₀ (suc j) = + toConeOutLemma n (βₛ ∘ suc) (βₛ∈L' ∘ suc) (coneSuc ccβₛ) (commHypSuc chₛ) + β₀ β₀∈L' (ccβ₀L ∘ suc) (ccβ₀R ∘ suc) ch₀ j + + + toConeOutCommutes : (n : ℕ) (β : FinVec (fst L) n) (β∈L' : ∀ i → β i ∈ L') + (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) + (ch : CommHypType β∈L' ccβ) + → ∀ {u} {v} e + → toConeOut _ _ _ ccβ ch u + ⋆⟨ C ⟩ (funcComp F (BDiag (λ i → (β ++Fin γ) i , β++γ∈L' β∈L' γ∈L' i)) .F-hom e) + ≡ toConeOut _ _ _ ccβ ch v + toConeOutCommutes ℕ.zero _ _ _ _ {u = sing i} {v = sing .i} idAr = coneOutCommutes ccγ idAr + toConeOutCommutes ℕ.zero _ _ _ _ {u = sing i} {v = pair .i j i<j} singPairL = + coneOutCommutes ccγ singPairL + toConeOutCommutes ℕ.zero _ _ _ _ {u = sing j} {v = pair i .j i<j} singPairR = + coneOutCommutes ccγ singPairR + toConeOutCommutes ℕ.zero _ _ _ _ {u = pair i j i<j} {v = sing k} () + toConeOutCommutes ℕ.zero _ _ _ _ {u = pair i j i<j} {v = pair .i .j .i<j} idAr = + coneOutCommutes ccγ idAr + toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch idAr = + cong (λ x → toConeOut _ _ _ ccβ ch _ ⋆⟨ C ⟩ x) (F .F-id) ∙ ⋆IdR C _ + toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch (singPairL {i = zero} {j = j} {i<j = i<j}) = refl + toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch (singPairL {i = suc i} {j = zero} {i<j = ()}) + toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch (singPairL {i = suc i} {j = suc j} {i<j = s≤s i<j}) = + toConeOutCommutes n (β ∘ suc) (β∈L' ∘ suc) (coneSuc ccβ) (commHypSuc ch) singPairL + toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch (singPairR {i = suc i} {j = suc j} {i<j = s≤s i<j}) = + toConeOutCommutes n (β ∘ suc) (β∈L' ∘ suc) (coneSuc ccβ) (commHypSuc ch) singPairR + toConeOutCommutes (ℕ.suc n) β β∈L' ccβ ch (singPairR {i = zero} {j = suc j} {i<j = s≤s z≤}) = + toConeOutLemma n (β ∘ suc) (β∈L' ∘ suc) (coneSuc ccβ) (commHypSuc ch) (β zero) (β∈L' zero) + (λ j → coneOutCommutes ccβ (singPairL {i = zero} {j = suc j} {i<j = s≤s z≤})) + (λ j → coneOutCommutes ccβ (singPairR {i = zero} {j = suc j} {i<j = s≤s z≤})) + (ch zero) j + + toCone : {n : ℕ} {β : FinVec (fst L) n} {β∈L' : ∀ i → β i ∈ L'} + (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) + (ch : CommHypType β∈L' ccβ) + → Cone (funcComp F (BDiag (λ i → (β ++Fin γ) i , β++γ∈L' β∈L' γ∈L' i))) c + coneOut (toCone ccβ ch) = toConeOut _ _ _ ccβ ch + coneOutCommutes (toCone ccβ ch) = toConeOutCommutes _ _ _ ccβ ch + + + -- for checking the universal property + toConeOutPathPL : {n : ℕ} {β : FinVec (fst L) n} {β∈L' : ∀ i → β i ∈ L'} + (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) + (ch : CommHypType β∈L' ccβ) + → ∀ i → PathP (λ 𝕚 → C [ c , F .F-ob (++FinInlΣ β∈L' γ∈L' i 𝕚) ]) + (ccβ .coneOut (sing i)) + (toCone ccβ ch .coneOut (sing (FSCfun _ _ (inl i)))) + toConeOutPathPL {ℕ.zero} ccβ _ () + toConeOutPathPL {ℕ.suc n} ccβ _ zero = refl + toConeOutPathPL {ℕ.suc n} ccβ ch (suc i) = toConeOutPathPL (coneSuc ccβ) (commHypSuc ch) i + + toConeOutPathPR : {n : ℕ} {β : FinVec (fst L) n} {β∈L' : ∀ i → β i ∈ L'} + (ccβ : Cone (funcComp F (BDiag (λ i → β i , β∈L' i))) c) + (ch : CommHypType β∈L' ccβ) + → ∀ i → PathP (λ 𝕚 → C [ c , F .F-ob (++FinInrΣ β∈L' γ∈L' i 𝕚) ]) + (ccγ .coneOut (sing i)) + (toCone ccβ ch .coneOut (sing (FSCfun _ _ (inr i)))) + toConeOutPathPR {ℕ.zero} ccβ _ i = refl + toConeOutPathPR {ℕ.suc n} ccβ ch i = toConeOutPathPR (coneSuc ccβ) (commHypSuc ch) i + + +---- the main proof -------------------------------------------------------------------------------- + isDLSheafPullbackDLRan : isDLSheafPullback L C (DLRan F) + fst isDLSheafPullbackDLRan x = + limArrow (limitC _ (F* 0l)) x (toCone x) + , λ f → limArrowUnique (limitC _ (F* 0l)) x (toCone x) f (toConeMor x f) + where + 0↓ = _↓Diag limitC (baseIncl ^opF) F 0l + + toTerminal : ∀ (u : ob 0↓) → isTerminal C (F .F-ob (u .fst)) + toTerminal ((u , u∈L') , 0≥u) = subst (λ v → isTerminal C (F .F-ob v)) + (Σ≡Prop (λ y → L' y .snd) 0≡u) + (DLBasisSheaf→Terminal F isSheafF 0∈L') + where + 0≡u : 0l ≡ u + 0≡u = is-antisym _ _ (∨lLid _) 0≥u + 0∈L' : 0l ∈ L' + 0∈L' = subst-∈ L' (sym 0≡u) u∈L' + + toCone : (y : ob C) → Cone (F* 0l) y + coneOut (toCone y) u = toTerminal u y .fst + coneOutCommutes (toCone y) {v = v} e = sym (toTerminal v y .snd _) + + toConeMor : (y : ob C) (f : C [ y , F-ob (DLRan F) 0l ]) + → isConeMor (toCone y) (limCone (limitC 0↓ (F* 0l))) f + toConeMor y f v = sym (toTerminal v y .snd _) + + + snd isDLSheafPullbackDLRan x y = rec2 (isPropIsPullback _ _ _ _ (Fsq L C x y (DLRan F))) + Σhelper (⋁Basis x) (⋁Basis y) + where + Σhelper : Σ[ n ∈ ℕ ] Σ[ β ∈ FinVec (fst L) n ] (∀ i → β i ∈ L') × (⋁ β ≡ x) + → Σ[ m ∈ ℕ ] Σ[ γ ∈ FinVec (fst L) m ] (∀ i → γ i ∈ L') × (⋁ γ ≡ y) + → isPullback C _ _ _ (Fsq L C x y (DLRan F)) + Σhelper (n , β , β∈L' , ⋁β≡x) (n' , γ , γ∈L' , ⋁γ≡y) = + transport (λ i → isPullback C (cospanPath i) (pbPr₁PathP i) (pbPr₂PathP i) (squarePathP i)) + (univProp ⋁Pullback) + where + open Cospan + open Pullback + ⋁β++γ≡x∨y : ⋁ (β ++Fin γ) ≡ x ∨l y + ⋁β++γ≡x∨y = ⋁Split++ β γ ∙ cong₂ (_∨l_) ⋁β≡x ⋁γ≡y + + -- replace x and y by their representations of joins of base elements + -- and transport over + xyCospan : Cospan C + l xyCospan = DLRan F .F-ob y + m xyCospan = DLRan F .F-ob (x ∧l y) + r xyCospan = DLRan F .F-ob x + s₁ xyCospan = DLRan F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + s₂ xyCospan = DLRan F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) + + ⋁Cospan : Cospan C + l ⋁Cospan = DLRan F .F-ob (⋁ γ) + m ⋁Cospan = DLRan F .F-ob (⋁ β ∧l ⋁ γ) + r ⋁Cospan = DLRan F .F-ob (⋁ β) + s₁ ⋁Cospan = DLRan F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + s₂ ⋁Cospan = DLRan F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) + + cospanPath : ⋁Cospan ≡ xyCospan + l (cospanPath i) = DLRan F .F-ob (⋁γ≡y i) + m (cospanPath i) = DLRan F .F-ob (⋁β≡x i ∧l ⋁γ≡y i) + r (cospanPath i) = DLRan F .F-ob (⋁β≡x i) + s₁ (cospanPath i) = DLRan F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + s₂ (cospanPath i) = DLRan F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) + + private + F[⋁β]Cone = limitC _ (F* (⋁ β)) .limCone + F[⋁γ]Cone = limitC _ (F* (⋁ γ)) .limCone + F[⋁β∧⋁γ]Cone = limitC _ (F* (⋁ β ∧l ⋁ γ)) .limCone + F[⋁β++γ]Cone = limitC _ (F* (⋁ (β ++Fin γ))) .limCone + + -- the family of squares we need to construct cones over β++γ + to++ConeSquare : {c : ob C} (f : C [ c , ⋁Cospan .l ]) (g : C [ c , ⋁Cospan .r ]) + → f ⋆⟨ C ⟩ ⋁Cospan .s₁ ≡ g ⋆⟨ C ⟩ ⋁Cospan .s₂ + → ∀ i j → + (g ⋆⟨ C ⟩ restCone β β∈L' .coneOut (sing i)) + ⋆⟨ C ⟩ F .F-hom {y = _ , ∧lClosed _ _ (β∈L' i) (γ∈L' j)} + (≤m→≤j _ _ (∧≤RCancel _ _)) + ≡ (f ⋆⟨ C ⟩ restCone γ γ∈L' .coneOut (sing j)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) + to++ConeSquare f g square i j = + (g ⋆⟨ C ⟩ restCone β β∈L' .coneOut (sing i)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _)) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + g ⋆⟨ C ⟩ (restCone β β∈L' .coneOut (sing i) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤RCancel _ _))) + ≡⟨ cong (λ x → g ⋆⟨ C ⟩ x) (coneOutCommutes F[⋁β]Cone (_ , (is-prop-valued _ _ _ _))) ⟩ + g ⋆⟨ C ⟩ coneOut F[⋁β]Cone ((β i ∧l γ j , _) + , is-trans _ _ _ (≤m→≤j _ _ (≤-∧Pres _ _ _ _ + (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j)))) + (≤m→≤j _ _ (∧≤RCancel _ _))) + ≡⟨ cong (λ x → g ⋆⟨ C ⟩ x) (sym (limArrowCommutes (limitC _ (F* (⋁ β ∧l ⋁ γ))) _ _ _)) ⟩ + g ⋆⟨ C ⟩ (s₂ ⋁Cospan ⋆⟨ C ⟩ coneOut F[⋁β∧⋁γ]Cone ((β i ∧l γ j , _) + , (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j)))))) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (g ⋆⟨ C ⟩ s₂ ⋁Cospan) ⋆⟨ C ⟩ coneOut F[⋁β∧⋁γ]Cone ((β i ∧l γ j , _) + , (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j))))) + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ coneOut F[⋁β∧⋁γ]Cone ( + (β i ∧l γ j , ∧lClosed _ _ (β∈L' i) (γ∈L' j)) + , (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j)))))) + (sym square) ⟩ + (f ⋆⟨ C ⟩ s₁ ⋁Cospan) ⋆⟨ C ⟩ coneOut F[⋁β∧⋁γ]Cone ((β i ∧l γ j , _) + , (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j))))) + ≡⟨ ⋆Assoc C _ _ _ ⟩ + f ⋆⟨ C ⟩ (s₁ ⋁Cospan ⋆⟨ C ⟩ coneOut F[⋁β∧⋁γ]Cone ((β i ∧l γ j , _) + , (≤m→≤j _ _ (≤-∧Pres _ _ _ _ (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j)))))) + ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) (limArrowCommutes (limitC _ (F* (⋁ β ∧l ⋁ γ))) _ _ _) ⟩ + f ⋆⟨ C ⟩ coneOut F[⋁γ]Cone ((β i ∧l γ j , _) + , is-trans _ _ _ (≤m→≤j _ _ (≤-∧Pres _ _ _ _ + (≤j→≤m _ _ (ind≤⋁ β i)) (≤j→≤m _ _ (ind≤⋁ γ j)))) + (≤m→≤j _ _ (∧≤LCancel _ _))) + ≡⟨ cong (λ x → f ⋆⟨ C ⟩ x) + (sym (coneOutCommutes F[⋁γ]Cone (_ , (is-prop-valued _ _ _ _)))) ⟩ + f ⋆⟨ C ⟩ (restCone γ γ∈L' .coneOut (sing j) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _))) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (f ⋆⟨ C ⟩ restCone γ γ∈L' .coneOut (sing j)) + ⋆⟨ C ⟩ F .F-hom (≤m→≤j _ _ (∧≤LCancel _ _)) ∎ + + + -- the pullback square we want + ⋁Pullback : Pullback C ⋁Cospan + pbOb ⋁Pullback = DLRan F .F-ob (⋁ (β ++Fin γ)) + pbPr₁ ⋁Pullback = DLRan F .F-hom (subst (⋁ γ ≤_) (sym (⋁Split++ β γ)) (∨≤LCancel _ _)) + pbPr₂ ⋁Pullback = DLRan F .F-hom (subst (⋁ β ≤_) (sym (⋁Split++ β γ)) (∨≤RCancel _ _)) + pbCommutes ⋁Pullback = F-square (DLRan F) (is-prop-valued _ _ _ _) + univProp ⋁Pullback {d = c} f g square = uniqueExists + (applyCoverLemma f g square .fst .fst) + (fromConeMor _ (applyCoverLemma f g square .fst .snd)) + (λ _ → isProp× (isSetHom C _ _) (isSetHom C _ _)) + λ h' trs → cong fst (applyCoverLemma f g square .snd (h' , toConeMor f g square h' trs)) + where -- this is where we apply our lemmas + theLimit = limitC _ (F* (⋁ (β ++Fin γ))) + + toCone : (f : C [ c , ⋁Cospan .l ]) (g : C [ c , ⋁Cospan .r ]) + → f ⋆⟨ C ⟩ ⋁Cospan .s₁ ≡ g ⋆⟨ C ⟩ ⋁Cospan .s₂ + → Cone (funcComp F (BDiag (λ i → (β ++Fin γ) i , β++γ∈L' β∈L' γ∈L' i))) c + toCone f g square = ++Lemmas.toCone (f ★ (restCone γ γ∈L')) (g ★ (restCone β β∈L')) + (to++ConeSquare f g square) + + applyCoverLemma : (f : C [ c , ⋁Cospan .l ]) (g : C [ c , ⋁Cospan .r ]) + (square : f ⋆⟨ C ⟩ ⋁Cospan .s₁ ≡ g ⋆⟨ C ⟩ ⋁Cospan .s₂) + → ∃![ h ∈ C [ c , ⋁Pullback .pbOb ] ] + isConeMor (toCone f g square) (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) h + applyCoverLemma f g square = coverLemma (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') + c (toCone f g square) + + -- Another description of the limiting cone over β++γ that + -- turns out equivalent but behaves better with the ++Lemmas + ++LimCone' : Cone (funcComp F (BDiag (λ i → ((β ++Fin γ) i , β++γ∈L' β∈L' γ∈L' i)))) + (DLRan F .F-ob (⋁ (β ++Fin γ))) + ++LimCone' = ++Lemmas.toCone ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) + ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) + (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) + + ++LimCone≡ : ∀ i → ++LimCone' .coneOut (sing i) + ≡ restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') .coneOut (sing i) + ++LimCone≡ i = subst (λ x → ++LimCone' .coneOut (sing x) + ≡ restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') .coneOut (sing x)) + (FSCsec _ _ i) (++LimCone≡Aux (FSCinv _ _ i)) + where + ++LimCone≡Aux : (x : Fin n ⊎ Fin n') → ++LimCone' .coneOut (sing (FSCfun _ _ x)) + ≡ restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') .coneOut (sing (FSCfun _ _ x)) + ++LimCone≡Aux (inl i) = + sym (fromPathP (++Lemmas.toConeOutPathPL + ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) + ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) + (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i)) + ∙∙ cong (λ x → transport (λ 𝕚 → C [ DLRan F .F-ob (⋁ (β ++Fin γ)) , + F .F-ob (++FinInlΣ β∈L' γ∈L' i 𝕚) ]) x) + (limArrowCommutes (limitC _ (F* (⋁ β))) _ _ _) + ∙∙ fromPathP helperPathP + where + βᵢ≤⋁β++γ = + is-trans _ _ _ (ind≤⋁ β i) (subst (⋁ β ≤_) (sym (⋁Split++ β γ)) (∨≤RCancel _ _)) + + helperPathP : + PathP (λ 𝕚 → C [ DLRan F .F-ob (⋁ (β ++Fin γ)) , F .F-ob (++FinInlΣ β∈L' γ∈L' i 𝕚) ]) + (F[⋁β++γ]Cone .coneOut ((β i , β∈L' i) , βᵢ≤⋁β++γ)) + (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') .coneOut (sing (FSCfun _ _ (inl i)))) + helperPathP 𝕚 = F[⋁β++γ]Cone .coneOut (++FinInlΣ β∈L' γ∈L' i 𝕚 , + ≤PathPLemma refl (λ 𝕛 → ++FinInlΣ β∈L' γ∈L' i 𝕛 .fst) + βᵢ≤⋁β++γ + (ind≤⋁ (β ++Fin γ) (FSCfun _ _ (inl i))) 𝕚) + + ++LimCone≡Aux (inr i) = + sym (fromPathP (++Lemmas.toConeOutPathPR + ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) + ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) + (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i)) + ∙∙ cong (λ x → transport (λ 𝕚 → C [ DLRan F .F-ob (⋁ (β ++Fin γ)) , + F .F-ob (++FinInrΣ β∈L' γ∈L' i 𝕚) ]) x) + (limArrowCommutes (limitC _ (F* (⋁ γ))) _ _ _) + ∙∙ fromPathP helperPathP + where + γᵢ≤⋁β++γ = + is-trans _ _ _ (ind≤⋁ γ i) (subst (⋁ γ ≤_) (sym (⋁Split++ β γ)) (∨≤LCancel _ _)) + + helperPathP : + PathP (λ 𝕚 → C [ DLRan F .F-ob (⋁ (β ++Fin γ)) , F .F-ob (++FinInrΣ β∈L' γ∈L' i 𝕚) ]) + (F[⋁β++γ]Cone .coneOut ((γ i , γ∈L' i) , γᵢ≤⋁β++γ)) + (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L') .coneOut (sing (FSCfun _ _ (inr i)))) + helperPathP 𝕚 = F[⋁β++γ]Cone .coneOut (++FinInrΣ β∈L' γ∈L' i 𝕚 , + ≤PathPLemma refl (λ 𝕛 → ++FinInrΣ β∈L' γ∈L' i 𝕛 .fst) + γᵢ≤⋁β++γ + (ind≤⋁ (β ++Fin γ) (FSCfun _ _ (inr i))) 𝕚) + + + + toConeMor : (f : C [ c , ⋁Cospan .l ]) (g : C [ c , ⋁Cospan .r ]) + (square : f ⋆⟨ C ⟩ ⋁Cospan .s₁ ≡ g ⋆⟨ C ⟩ ⋁Cospan .s₂) + (h : C [ c , ⋁Pullback .pbOb ]) + → (f ≡ h ⋆⟨ C ⟩ ⋁Pullback .pbPr₁) × (g ≡ h ⋆⟨ C ⟩ ⋁Pullback .pbPr₂) + → isConeMor (toCone f g square) (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) h + toConeMor f g square h (tr₁ , tr₂) = isConeMorSingLemma + (toCone f g square) + (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) + singCase + where + singCaseAux : ∀ (x : Fin n ⊎ Fin n') + → h ⋆⟨ C ⟩ (coneOut ++LimCone' (sing (FSCfun _ _ x))) + ≡ coneOut (toCone f g square) (sing (FSCfun _ _ x)) + singCaseAux (inl i) = transp (λ 𝕚 → h ⋆⟨ C ⟩ + (++Lemmas.toConeOutPathPL ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) + ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) + (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i 𝕚) + ≡ ++Lemmas.toConeOutPathPL (f ★ (restCone γ γ∈L')) + (g ★ (restCone β β∈L')) + (to++ConeSquare _ _ square) i 𝕚) i0 singCaseAuxL + where + singCaseAuxL : h ⋆⟨ C ⟩ ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) .coneOut (sing i) + ≡ (g ★ (restCone β β∈L')) .coneOut (sing i) + singCaseAuxL = + h ⋆⟨ C ⟩ (pbPr₂ ⋁Pullback ⋆⟨ C ⟩ (restCone β β∈L') .coneOut (sing i)) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (h ⋆⟨ C ⟩ pbPr₂ ⋁Pullback) ⋆⟨ C ⟩ (restCone β β∈L') .coneOut (sing i) + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ (restCone β β∈L') .coneOut (sing i)) (sym tr₂) ⟩ + g ⋆⟨ C ⟩ (restCone β β∈L') .coneOut (sing i) ∎ + + singCaseAux (inr i) = transp (λ 𝕚 → h ⋆⟨ C ⟩ + (++Lemmas.toConeOutPathPR ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) + ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) + (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i 𝕚) + ≡ ++Lemmas.toConeOutPathPR (f ★ (restCone γ γ∈L')) + (g ★ (restCone β β∈L')) + (to++ConeSquare _ _ square) i 𝕚) i0 singCaseAuxR + where + singCaseAuxR : h ⋆⟨ C ⟩ ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) .coneOut (sing i) + ≡ (f ★ (restCone γ γ∈L')) .coneOut (sing i) + singCaseAuxR = + h ⋆⟨ C ⟩ (pbPr₁ ⋁Pullback ⋆⟨ C ⟩ (restCone γ γ∈L') .coneOut (sing i)) + ≡⟨ sym (⋆Assoc C _ _ _) ⟩ + (h ⋆⟨ C ⟩ pbPr₁ ⋁Pullback) ⋆⟨ C ⟩ (restCone γ γ∈L') .coneOut (sing i) + ≡⟨ cong (λ x → x ⋆⟨ C ⟩ (restCone γ γ∈L') .coneOut (sing i)) (sym tr₁) ⟩ + f ⋆⟨ C ⟩ (restCone γ γ∈L') .coneOut (sing i) ∎ + + + singCase' : ∀ i → h ⋆⟨ C ⟩ (coneOut ++LimCone' (sing i)) + ≡ coneOut (toCone f g square) (sing i) + singCase' i = subst (λ x → h ⋆⟨ C ⟩ coneOut ++LimCone' (sing x) + ≡ coneOut (toCone f g square) (sing x)) + (FSCsec _ _ i) (singCaseAux (FSCinv _ _ i)) + + singCase : ∀ i → h ⋆⟨ C ⟩ (coneOut (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) (sing i)) + ≡ coneOut (toCone f g square) (sing i) + singCase i = subst (λ x → h ⋆⟨ C ⟩ x ≡ coneOut (toCone f g square) (sing i)) + (++LimCone≡ i) (singCase' i) + + + fromConeMor : (h : C [ c , ⋁Pullback .pbOb ]) + → isConeMor (toCone f g square) (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) h + → (f ≡ h ⋆⟨ C ⟩ ⋁Pullback .pbPr₁) × (g ≡ h ⋆⟨ C ⟩ ⋁Pullback .pbPr₂) + fst (fromConeMor h hIsConeMor) = sym (preCompUnique f (restCone γ γ∈L') + (coverLemma γ γ∈L') + (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₁) + compIsConeMor) + where + compIsConeMor : isConeMor (f ★ (restCone γ γ∈L')) (restCone γ γ∈L') + (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₁) + compIsConeMor = isConeMorSingLemma (f ★ (restCone γ γ∈L')) (restCone γ γ∈L') singCase + where + singCase : ∀ i → (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₁) ⋆⟨ C ⟩ restCone γ γ∈L' .coneOut (sing i) + ≡ f ⋆⟨ C ⟩ restCone γ γ∈L' .coneOut (sing i) + singCase i = ⋆Assoc C _ _ _ ∙ transp (λ 𝕚 → h ⋆⟨ C ⟩ + (++Lemmas.toConeOutPathPR ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) + ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) + (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i (~ 𝕚)) + ≡ ++Lemmas.toConeOutPathPR (f ★ (restCone γ γ∈L')) + (g ★ (restCone β β∈L')) + (to++ConeSquare _ _ square) i (~ 𝕚)) i0 singCaseHelper + where + fromAssumption : h ⋆⟨ C ⟩ (coneOut (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) + (sing (FSCfun _ _ (inr i)))) + ≡ coneOut (toCone f g square) (sing (FSCfun _ _ (inr i))) + fromAssumption = hIsConeMor (sing (FSCfun _ _ (inr i))) + + singCaseHelper : h ⋆⟨ C ⟩ (coneOut ++LimCone' (sing (FSCfun _ _ (inr i)))) + ≡ coneOut (toCone f g square) (sing (FSCfun _ _ (inr i))) + singCaseHelper = subst (λ x → h ⋆⟨ C ⟩ x ≡ coneOut (toCone f g square) + (sing (FSCfun _ _ (inr i)))) + (sym (++LimCone≡ (FSCfun _ _ (inr i)))) fromAssumption + + snd (fromConeMor h hIsConeMor) = sym (preCompUnique g (restCone β β∈L') + (coverLemma β β∈L') + (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₂) + compIsConeMor) + where + compIsConeMor : isConeMor (g ★ (restCone β β∈L')) (restCone β β∈L') + (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₂) + compIsConeMor = isConeMorSingLemma (g ★ (restCone β β∈L')) (restCone β β∈L') singCase + where + singCase : ∀ i → (h ⋆⟨ C ⟩ ⋁Pullback .pbPr₂) ⋆⟨ C ⟩ restCone β β∈L' .coneOut (sing i) + ≡ g ⋆⟨ C ⟩ restCone β β∈L' .coneOut (sing i) + singCase i = ⋆Assoc C _ _ _ ∙ transp (λ 𝕚 → h ⋆⟨ C ⟩ + (++Lemmas.toConeOutPathPL ((pbPr₁ ⋁Pullback) ★ (restCone γ γ∈L')) + ((pbPr₂ ⋁Pullback) ★ (restCone β β∈L')) + (to++ConeSquare _ _ (pbCommutes ⋁Pullback)) i (~ 𝕚)) + ≡ ++Lemmas.toConeOutPathPL (f ★ (restCone γ γ∈L')) + (g ★ (restCone β β∈L')) + (to++ConeSquare _ _ square) i (~ 𝕚)) i0 singCaseHelper + where + fromAssumption : h ⋆⟨ C ⟩ (coneOut (restCone (β ++Fin γ) (β++γ∈L' β∈L' γ∈L')) + (sing (FSCfun _ _ (inl i)))) + ≡ coneOut (toCone f g square) (sing (FSCfun _ _ (inl i))) + fromAssumption = hIsConeMor (sing (FSCfun _ _ (inl i))) + + singCaseHelper : h ⋆⟨ C ⟩ (coneOut ++LimCone' (sing (FSCfun _ _ (inl i)))) + ≡ coneOut (toCone f g square) (sing (FSCfun _ _ (inl i))) + singCaseHelper = subst (λ x → h ⋆⟨ C ⟩ x ≡ coneOut (toCone f g square) + (sing (FSCfun _ _ (inl i)))) + (sym (++LimCone≡ (FSCfun _ _ (inl i)))) fromAssumption + + + + + -- some more names to make the transport readable + pbPr₁PathP : PathP (λ i → C [ DLRan F .F-ob (⋁β++γ≡x∨y i) , DLRan F .F-ob (⋁γ≡y i) ]) + (pbPr₁ ⋁Pullback) (DLRan F .F-hom (hom-∨₂ L C x y)) + pbPr₁PathP = F≤PathPLemma ⋁β++γ≡x∨y ⋁γ≡y + (subst (⋁ γ ≤_) (sym (⋁Split++ β γ)) (∨≤LCancel _ _)) + (hom-∨₂ L C x y) + + pbPr₂PathP : PathP (λ i → C [ DLRan F .F-ob (⋁β++γ≡x∨y i) , DLRan F .F-ob (⋁β≡x i) ]) + (pbPr₂ ⋁Pullback) (DLRan F .F-hom (hom-∨₁ L C x y)) + pbPr₂PathP = F≤PathPLemma ⋁β++γ≡x∨y ⋁β≡x + (subst (⋁ β ≤_) (sym (⋁Split++ β γ)) (∨≤RCancel _ _)) + (hom-∨₁ L C x y) + + squarePathP : PathP (λ i → pbPr₁PathP i ⋆⟨ C ⟩ cospanPath i .s₁ + ≡ pbPr₂PathP i ⋆⟨ C ⟩ cospanPath i .s₂) + (pbCommutes ⋁Pullback) (Fsq L C x y (DLRan F)) + squarePathP = toPathP (isSetHom C _ _ _ _) + + + -- main result, putting everything together: + isDLSheafDLRan : isDLSheaf L C (DLRan F) + isDLSheafDLRan = P→L isDLSheafPullbackDLRan \ No newline at end of file diff --git a/Cubical.Categories.Equivalence.Properties.html b/Cubical.Categories.Equivalence.Properties.html index e9d665f321..879b855306 100644 --- a/Cubical.Categories.Equivalence.Properties.html +++ b/Cubical.Categories.Equivalence.Properties.html @@ -128,7 +128,7 @@ F-Mor _ = F .F-hom equiv-ob² : C .ob × C .ob ≃ D .ob × D .ob - equiv-ob² = ≃-× (_ , isequiv) (_ , isequiv) + equiv-ob² = ≃-× (_ , isequiv) (_ , isequiv) iso-ob = equivToIso (_ , isequiv) iso-hom = equivOver→IsoOver {P = MorC} {Q = MorD} equiv-ob² F-Mor (λ (x , y) → fullfaith x y) diff --git a/Cubical.Categories.Equivalence.WeakEquivalence.html b/Cubical.Categories.Equivalence.WeakEquivalence.html index 4ce7712cc3..8a22e44a97 100644 --- a/Cubical.Categories.Equivalence.WeakEquivalence.html +++ b/Cubical.Categories.Equivalence.WeakEquivalence.html @@ -65,7 +65,7 @@ open isUnivalent isEquivF-ob : {F : Functor C D} → isWeakEquivalence F → isEquivMap (F .F-ob) - isEquivF-ob {F = F} is-w-equiv = isEmbedding×isSurjection→isEquiv + isEquivF-ob {F = F} is-w-equiv = isEmbedding×isSurjection→isEquiv (isFullyFaithful→isEmbd-ob isUnivC isUnivD {F = F} (is-w-equiv .fullfaith) , isSurj→isSurj-ob isUnivD {F = F} (is-w-equiv .esssurj)) diff --git a/Cubical.Categories.Functor.ComposeProperty.html b/Cubical.Categories.Functor.ComposeProperty.html index 5987e79315..395cebff28 100644 --- a/Cubical.Categories.Functor.ComposeProperty.html +++ b/Cubical.Categories.Functor.ComposeProperty.html @@ -58,7 +58,7 @@ → α .N-ob c ≡ A .F-hom (f .fst) ⋆⟨ E ⟩ g ⋆⟨ E ⟩ B .F-hom (f .snd .inv)) isPropMor : (d : D .ob) → isProp (Mor d) - isPropMor d x y = Σ≡Prop (λ _ → isPropΠ2 (λ _ _ → E .isSetHom _ _)) path + isPropMor d x y = Σ≡Prop (λ _ → isPropΠ2 (λ _ _ → E .isSetHom _ _)) path where path : x .fst ≡ y .fst path = Prop.rec (E .isSetHom _ _) diff --git a/Cubical.Categories.Functor.Properties.html b/Cubical.Categories.Functor.Properties.html index 54713b7cde..a8028e40aa 100644 --- a/Cubical.Categories.Functor.Properties.html +++ b/Cubical.Categories.Functor.Properties.html @@ -138,13 +138,13 @@ module _ {F : Functor C D} where isFullyFaithful→Full : isFullyFaithful F → isFull F - isFullyFaithful→Full fullfaith x y = isEquiv→isSurjection (fullfaith x y) + isFullyFaithful→Full fullfaith x y = isEquiv→isSurjection (fullfaith x y) isFullyFaithful→Faithful : isFullyFaithful F → isFaithful F isFullyFaithful→Faithful fullfaith x y = isEmbedding→Inj (isEquiv→isEmbedding (fullfaith x y)) isFull+Faithful→isFullyFaithful : isFull F → isFaithful F → isFullyFaithful F - isFull+Faithful→isFullyFaithful full faith x y = isEmbedding×isSurjection→isEquiv + isFull+Faithful→isFullyFaithful full faith x y = isEmbedding×isSurjection→isEquiv (injEmbedding (D .isSetHom) (faith x y _ _) , full x y) isFaithful→reflectsMono : isFaithful F → {x y : C .ob} (f : C [ x , y ]) @@ -190,7 +190,7 @@ -- Functors inducing surjection on objects is essentially surjective -isSurj-ob→isSurj : {F : Functor C D} → isSurjection (F .F-ob) → isEssentiallySurj F +isSurj-ob→isSurj : {F : Functor C D} → isSurjection (F .F-ob) → isEssentiallySurj F isSurj-ob→isSurj surj y = Prop.map (λ (x , p) → x , pathToIso p) (surj y) @@ -199,7 +199,7 @@ isFullyFaithful→isEquivF-Iso : {F : Functor C D} → isFullyFaithful F → ∀ x y → isEquiv (F-Iso {F = F} {x = x} {y = y}) isFullyFaithful→isEquivF-Iso {F = F} fullfaith x y = - Σ-cong-equiv-prop (_ , fullfaith x y) isPropIsIso isPropIsIso _ + Σ-cong-equiv-prop (_ , fullfaith x y) isPropIsIso isPropIsIso _ (λ f → isFullyFaithful→Conservative {F = F} fullfaith {f = f}) .snd @@ -213,7 +213,7 @@ -- Essentially surjective functor with univalent target induces surjection on objects - isSurj→isSurj-ob : {F : Functor C D} → isEssentiallySurj F → isSurjection (F .F-ob) + isSurj→isSurj-ob : {F : Functor C D} → isEssentiallySurj F → isSurjection (F .F-ob) isSurj→isSurj-ob surj y = Prop.map (λ (x , f) → x , CatIsoToPath f) (surj y) diff --git a/Cubical.Categories.Instances.CommAlgebras.html b/Cubical.Categories.Instances.CommAlgebras.html index dd9ca8c823..79197225f3 100644 --- a/Cubical.Categories.Instances.CommAlgebras.html +++ b/Cubical.Categories.Instances.CommAlgebras.html @@ -148,7 +148,7 @@ (λ x y → cone≡ (λ v → funExt (λ _ → coneOut cc v .snd .pres⋆ _ _)))) (λ _ → AlgebraHom≡ refl) (isPropIsConeMor cc (limCone (LimitsCommAlgebrasCategory J D))) - (λ a' x → Σ≡Prop (λ _ → isPropIsAlgebraHom _ _ _ _) + (λ a' x → Σ≡Prop (λ _ → isPropIsAlgebraHom _ _ _ _) (funExt (λ y → cone≡ λ v → funExt (λ _ → sym (funExt⁻ (cong fst (x v)) y))))) -- forgetful functor preserves limits @@ -231,8 +231,8 @@ univPropCommRingWithHomHom isRHom₁ isRHom₂ isRHom₃ isRHom₄ (E , f₅) (h₂ , comm₂) (h₁ , comm₁) squareComm = ((h₃ , h₃∘f₅≡f₁) , h₂≡g₂∘h₃ , h₁≡g₁∘h₃) - , λ h₃' → Σ≡Prop (λ _ → isProp× (isSetRingHom _ _ _ _) (isSetRingHom _ _ _ _)) - (Σ≡Prop (λ _ → isSetRingHom _ _ _ _) + , λ h₃' → Σ≡Prop (λ _ → isProp× (isSetRingHom _ _ _ _) (isSetRingHom _ _ _ _)) + (Σ≡Prop (λ _ → isSetRingHom _ _ _ _) (cong fst (commRingPB .univProp h₂ h₁ squareComm .snd (h₃' .fst .fst , h₃' .snd .fst , h₃' .snd .snd)))) where @@ -363,7 +363,7 @@ (h₂' ≡ toCommAlgebraHom _ _ g₂ isRHom₂ ∘a k') × (h₁' ≡ toCommAlgebraHom _ _ g₁ isRHom₁ ∘a k')) → (k , kComm₂ , kComm₁) ≡ y - uniqueness (k' , k'Comm₂ , k'Comm₁) = Σ≡Prop (λ _ → isProp× (isSetAlgebraHom _ _ _ _) + uniqueness (k' , k'Comm₂ , k'Comm₁) = Σ≡Prop (λ _ → isProp× (isSetAlgebraHom _ _ _ _) (isSetAlgebraHom _ _ _ _)) (AlgebraHom≡ (cong (fst ∘ fst ∘ fst) uniqHelper)) where @@ -435,7 +435,7 @@ (χ , triangle) (univProp C cc .fst .snd) (λ _ → isPropIsConeMor _ _ _) - λ _ x → Σ≡Prop (λ _ → isSetRingHom _ _ _ _) + λ _ x → Σ≡Prop (λ _ → isSetRingHom _ _ _ _) (cong fst (univProp C cc .snd (_ , x))) where χ = univProp C cc .fst .fst diff --git a/Cubical.Categories.Instances.CommRings.html b/Cubical.Categories.Instances.CommRings.html index 60ed9569e6..409edb166e 100644 --- a/Cubical.Categories.Instances.CommRings.html +++ b/Cubical.Categories.Instances.CommRings.html @@ -80,7 +80,7 @@ snd (inv CommRingIsoIsoCatIso e) = e .fst .snd rightInv CommRingIsoIsoCatIso x = CatIso≡ _ _ (RingHom≡ refl) leftInv (CommRingIsoIsoCatIso {R = R} {S}) x = - Σ≡Prop (λ x → isPropIsRingHom (CommRingStr→RingStr (R .snd)) + Σ≡Prop (λ x → isPropIsRingHom (CommRingStr→RingStr (R .snd)) (x .fun) (CommRingStr→RingStr (S .snd))) (Iso≡Set (is-set (snd R)) (is-set (snd S)) _ _ (λ _ → refl) (λ _ → refl)) @@ -184,6 +184,6 @@ (λ x y → cone≡ (λ v → funExt (λ _ → coneOut cc v .snd .pres· _ _)))) (λ _ → RingHom≡ refl) (isPropIsConeMor cc (limCone (LimitsCommRingsCategory J D))) - (λ a' x → Σ≡Prop (λ _ → isPropIsRingHom _ _ _) + (λ a' x → Σ≡Prop (λ _ → isPropIsRingHom _ _ _) (funExt (λ y → cone≡ λ v → funExt (λ _ → sym (funExt⁻ (cong fst (x v)) y))))) \ No newline at end of file diff --git a/Cubical.Categories.Instances.Poset.html b/Cubical.Categories.Instances.Poset.html index 6ce3609353..e0e5ead178 100644 --- a/Cubical.Categories.Instances.Poset.html +++ b/Cubical.Categories.Instances.Poset.html @@ -4,27 +4,27 @@ open import Cubical.Foundations.Prelude -open import Cubical.Relation.Binary.Poset +open import Cubical.Relation.Binary.Order.Poset -open import Cubical.Categories.Category +open import Cubical.Categories.Category -open Category +open Category -private - variable - ℓ ℓ' : Level +private + variable + ℓ ℓ' : Level -module _ (P : Poset ℓ ℓ') where +module _ (P : Poset ℓ ℓ') where - open PosetStr (snd P) + open PosetStr (snd P) - PosetCategory : Category ℓ ℓ' - ob PosetCategory = fst P - Hom[_,_] PosetCategory = _≤_ - id PosetCategory = is-refl _ - _⋆_ PosetCategory = is-trans _ _ _ - ⋆IdL PosetCategory _ = is-prop-valued _ _ _ _ - ⋆IdR PosetCategory _ = is-prop-valued _ _ _ _ - ⋆Assoc PosetCategory _ _ _ = is-prop-valued _ _ _ _ - isSetHom PosetCategory = isProp→isSet (is-prop-valued _ _) + PosetCategory : Category ℓ ℓ' + ob PosetCategory = fst P + Hom[_,_] PosetCategory = _≤_ + id PosetCategory = is-refl _ + _⋆_ PosetCategory = is-trans _ _ _ + ⋆IdL PosetCategory _ = is-prop-valued _ _ _ _ + ⋆IdR PosetCategory _ = is-prop-valued _ _ _ _ + ⋆Assoc PosetCategory _ _ _ = is-prop-valued _ _ _ _ + isSetHom PosetCategory = isProp→isSet (is-prop-valued _ _) \ No newline at end of file diff --git a/Cubical.Categories.Instances.Semilattice.html b/Cubical.Categories.Instances.Semilattice.html index d4c8820be7..28073d1697 100644 --- a/Cubical.Categories.Instances.Semilattice.html +++ b/Cubical.Categories.Instances.Semilattice.html @@ -12,16 +12,16 @@ open Category -module _ {ℓ} (L : Semilattice ℓ) where - open JoinSemilattice L +module _ {ℓ} (L : Semilattice ℓ) where + open JoinSemilattice L JoinSemilatticeCategory : Category ℓ ℓ - JoinSemilatticeCategory = PosetCategory IndPoset + JoinSemilatticeCategory = PosetCategory IndPoset -module _ {ℓ} (L : Semilattice ℓ) where - open MeetSemilattice L +module _ {ℓ} (L : Semilattice ℓ) where + open MeetSemilattice L MeetSemilatticeCategory : Category ℓ ℓ - MeetSemilatticeCategory = PosetCategory IndPoset + MeetSemilatticeCategory = PosetCategory IndPoset \ No newline at end of file diff --git a/Cubical.Categories.Limits.Initial.html b/Cubical.Categories.Limits.Initial.html index 5b3e7a2704..6a9053307d 100644 --- a/Cubical.Categories.Limits.Initial.html +++ b/Cubical.Categories.Limits.Initial.html @@ -63,7 +63,7 @@ -- i.e. all initial objects are equal. isPropInitial : (hC : isUnivalent C) → isProp Initial isPropInitial hC x y = - Σ≡Prop isPropIsInitial (CatIsoToPath hC (initialToIso x y)) + Σ≡Prop isPropIsInitial (CatIsoToPath hC (initialToIso x y)) module _ {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (F : Functor C D) where open Category diff --git a/Cubical.Categories.Limits.Limits.html b/Cubical.Categories.Limits.Limits.html index f62459d3fc..a2600bdd99 100644 --- a/Cubical.Categories.Limits.Limits.html +++ b/Cubical.Categories.Limits.Limits.html @@ -290,7 +290,7 @@ coneOut (limCone L₁) v ∎ snd (fst (LimIso D L₁ L₂)) = limArrowCommutes L₂ _ _ - snd (LimIso D L₁ L₂) (e , isConeMorE) = Σ≡Prop + snd (LimIso D L₁ L₂) (e , isConeMorE) = Σ≡Prop (λ _ → isPropIsConeMor (limCone L₁) (limCone L₂) _) (CatIso≡ _ _ (limArrowUnique L₂ _ _ (fst e) isConeMorE)) @@ -307,7 +307,7 @@ cc .coneOutCommutes (isInitJ k .fst) -- is a cone morphism snd (univProp (Initial→LimCone D (j , isInitJ)) c cc) (f , isConeMorF) = -- and indeed unique - Σ≡Prop + Σ≡Prop (λ _ → isPropIsConeMor cc (limCone (Initial→LimCone D (j , isInitJ))) _) (sym (isConeMorF j) ∙∙ cong (λ x → f ⋆⟨ C ⟩ x) (subst (λ x → D .F-hom x ≡ id C) (sym (isInitJ j .snd _)) (D .F-id)) @@ -324,7 +324,7 @@ snd (fst (Iso→LimCone cc₁ e isLimConeCC₁ cc₂ isConeMorE d cd)) = isConeMorSeq cd cc₁ cc₂ (isLimConeCC₁ d cd .fst .snd) isConeMorE snd (Iso→LimCone cc₁ e isLimConeCC₁ cc₂ isConeMorE d cd) (f , isConeMorF) = - Σ≡Prop (isPropIsConeMor cd cc₂) path + Σ≡Prop (isPropIsConeMor cd cc₂) path where isConeMorE⁻¹ : isConeMor cc₂ cc₁ (e .snd .inv) isConeMorE⁻¹ v = diff --git a/Cubical.Categories.Limits.RightKan.html b/Cubical.Categories.Limits.RightKan.html index c0897b65cf..f411509068 100644 --- a/Cubical.Categories.Limits.RightKan.html +++ b/Cubical.Categories.Limits.RightKan.html @@ -47,9 +47,9 @@ ∙ sym (⋆Assoc C _ _ _) ∙ cong (λ l → seq' C l (F-hom K k)) hComm ∙ kComm - ⋆IdL (x ↓Diag) _ = Σ≡Prop (λ _ → isSetHom C _ _) (⋆IdL M _) - ⋆IdR (x ↓Diag) _ = Σ≡Prop (λ _ → isSetHom C _ _) (⋆IdR M _) - ⋆Assoc (x ↓Diag) _ _ _ = Σ≡Prop (λ _ → isSetHom C _ _) (⋆Assoc M _ _ _) + ⋆IdL (x ↓Diag) _ = Σ≡Prop (λ _ → isSetHom C _ _) (⋆IdL M _) + ⋆IdR (x ↓Diag) _ = Σ≡Prop (λ _ → isSetHom C _ _) (⋆IdR M _) + ⋆Assoc (x ↓Diag) _ _ _ = Σ≡Prop (λ _ → isSetHom C _ _) (⋆Assoc M _ _ _) isSetHom (x ↓Diag) = isSetΣSndProp (isSetHom M) λ _ → isSetHom C _ _ private @@ -62,8 +62,8 @@ j : {x y : ob C} (f : C [ x , y ]) → Functor (y ↓Diag) (x ↓Diag) F-ob (j f) (u , g) = u , f ⋆⟨ C ⟩ g F-hom (j f) (h , hComm) = h , ⋆Assoc C _ _ _ ∙ cong (seq' C f) hComm - F-id (j f) = Σ≡Prop (λ _ → isSetHom C _ _) refl - F-seq (j f) _ _ = Σ≡Prop (λ _ → isSetHom C _ _) refl + F-id (j f) = Σ≡Prop (λ _ → isSetHom C _ _) refl + F-seq (j f) _ _ = Σ≡Prop (λ _ → isSetHom C _ _) refl T* : (x : ob C) → Functor (x ↓Diag) A @@ -253,7 +253,7 @@ fst uInitial = u , id C ⋆⟨ C ⟩ id C fst (snd uInitial (v , f)) = invKHom f -- the unique arrow u→v in Ku↓ , cong₂ (seq' C) (⋆IdL C _) (secKHom f) ∙ ⋆IdL C f - snd (snd uInitial (v , f)) (g , tr) = Σ≡Prop (λ _ → isSetHom C _ _) path -- is indeed unique + snd (snd uInitial (v , f)) (g , tr) = Σ≡Prop (λ _ → isSetHom C _ _) path -- is indeed unique where path : invKHom f ≡ g path = isFullyFaithful→Faithful {F = K} isFFK _ _ _ _ diff --git a/Cubical.Categories.Limits.Terminal.html b/Cubical.Categories.Limits.Terminal.html index 827057d002..9bc1811081 100644 --- a/Cubical.Categories.Limits.Terminal.html +++ b/Cubical.Categories.Limits.Terminal.html @@ -67,7 +67,7 @@ -- i.e. all terminal objects are equal. isPropTerminal : (hC : isUnivalent C) → isProp Terminal isPropTerminal hC x y = - Σ≡Prop isPropIsTerminal (CatIsoToPath hC (terminalToIso x y)) + Σ≡Prop isPropIsTerminal (CatIsoToPath hC (terminalToIso x y)) preservesTerminals : ∀ (C : Category ℓc ℓc')(D : Category ℓd ℓd') → Functor C D diff --git a/Cubical.Categories.Presheaf.Morphism.html b/Cubical.Categories.Presheaf.Morphism.html index 7f2c297dfa..084d76cfc5 100644 --- a/Cubical.Categories.Presheaf.Morphism.html +++ b/Cubical.Categories.Presheaf.Morphism.html @@ -71,9 +71,9 @@ pushElt (_ , y .snd ∘ᴾ⟨ C , P ⟩ f) .snd ≡⟨ cong (λ a → pushElt a .snd) (ΣPathP (refl , commutes)) ⟩ pushElt x .snd ∎ - pushEltF .F-id = Σ≡Prop (λ x → (Q ⟅ _ ⟆) .snd _ _) (F .F-id) + pushEltF .F-id = Σ≡Prop (λ x → (Q ⟅ _ ⟆) .snd _ _) (F .F-id) pushEltF .F-seq f g = - Σ≡Prop ((λ x → (Q ⟅ _ ⟆) .snd _ _)) (F .F-seq (f .fst) (g .fst)) + Σ≡Prop ((λ x → (Q ⟅ _ ⟆) .snd _ _)) (F .F-seq (f .fst) (g .fst)) preservesRepresentation : ∀ (η : UniversalElement C P) → Type (ℓ-max (ℓ-max ℓd ℓd') ℓq) diff --git a/Cubical.Categories.Presheaf.Representable.html b/Cubical.Categories.Presheaf.Representable.html index 5540e61566..f4e059ed83 100644 --- a/Cubical.Categories.Presheaf.Representable.html +++ b/Cubical.Categories.Presheaf.Representable.html @@ -139,7 +139,7 @@ Representation≅UniversalElement .Iso.inv = universalElementToRepresentation Representation≅UniversalElement .Iso.rightInv η = isoFunInjective UniversalElementIsoΣ _ _ - (ΣPathP (refl , (Σ≡Prop (λ _ → isPropIsUniversal _ _) + (ΣPathP (refl , (Σ≡Prop (λ _ → isPropIsUniversal _ _) (yonedaᴾ* {C = C} P (η .vertex) .Iso.rightInv (η .element))))) Representation≅UniversalElement .Iso.leftInv repr = ΣPathP (refl , @@ -153,7 +153,7 @@ isTerminalToIsUniversal {η} term A .equiv-proof ϕ .fst .snd = term (_ , ϕ) .fst .snd isTerminalToIsUniversal {η} term A .equiv-proof ϕ .snd (f , commutes) = - Σ≡Prop (λ _ → (P ⟅ A ⟆) .snd _ _) + Σ≡Prop (λ _ → (P ⟅ A ⟆) .snd _ _) (cong fst (term (A , ϕ) .snd (f , commutes))) isUniversalToIsTerminal : @@ -165,7 +165,7 @@ isUniversalToIsTerminal vertex element universal ϕ .fst .snd = universal _ .equiv-proof (ϕ .snd) .fst .snd isUniversalToIsTerminal vertex element universal ϕ .snd (f , commutes) = - Σ≡Prop + Σ≡Prop (λ _ → (P ⟅ _ ⟆) .snd _ _) (cong fst (universal _ .equiv-proof (ϕ .snd) .snd (f , commutes))) @@ -186,9 +186,9 @@ TerminalElement≅UniversalElement .Iso.inv = universalElementToTerminalElement TerminalElement≅UniversalElement .Iso.rightInv η = isoFunInjective UniversalElementIsoΣ _ _ - (ΣPathP (refl , (Σ≡Prop (λ _ → isPropIsUniversal _ _) refl))) + (ΣPathP (refl , (Σ≡Prop (λ _ → isPropIsUniversal _ _) refl))) TerminalElement≅UniversalElement .Iso.leftInv η = - Σ≡Prop (isPropIsTerminal Elements) refl + Σ≡Prop (isPropIsTerminal Elements) refl Representation≅TerminalElement : Iso Representation TerminalElement Representation≅TerminalElement = diff --git a/Cubical.Codata.Conat.Properties.html b/Cubical.Codata.Conat.Properties.html index fea4a68b5e..d70b609d33 100644 --- a/Cubical.Codata.Conat.Properties.html +++ b/Cubical.Codata.Conat.Properties.html @@ -127,14 +127,14 @@ embed (Nat.suc n) .force = suc (embed n) embed-inj : ∀ m n → embed m ≡ embed n → m ≡ n -embed-inj m n p with ⊎Path.encode _ _ (cong force p) +embed-inj m n p with ⊎Path.encode _ _ (cong force p) embed-inj Nat.zero Nat.zero _ | _ = refl embed-inj (Nat.suc m) (Nat.suc n) _ | lift q = cong Nat.suc (embed-inj m n q) embed≢∞ : ∀ n → embed n ≡ ∞ → ⊥ -embed≢∞ Nat.zero = lower ∘ ⊎Path.encode _ _ ∘ cong force -embed≢∞ (Nat.suc n) = embed≢∞ n ∘ lower ∘ ⊎Path.encode _ _ ∘ cong force +embed≢∞ Nat.zero = lower ∘ ⊎Path.encode _ _ ∘ cong force +embed≢∞ (Nat.suc n) = embed≢∞ n ∘ lower ∘ ⊎Path.encode _ _ ∘ cong force cover : Nat.ℕ → Conat cover Nat.zero = ∞ @@ -246,22 +246,22 @@ search-lemma : ∀ α n → search α ≡ ∞ → α n ≡ false search-lemma α Nat.zero p with α 0 | cong force p ... | false | q = refl - ... | true | q = ⊥.rec (⊎Path.encode zero (suc ∞) q .lower) + ... | true | q = ⊥.rec (⊎Path.encode zero (suc ∞) q .lower) search-lemma α (Nat.suc n) p with α 0 | cong force p ... | false | q = search-lemma (α ∘ Nat.suc) n (cong wrap q) - ... | true | q = ⊥.rec (⊎Path.encode zero (suc ∞) q .lower) + ... | true | q = ⊥.rec (⊎Path.encode zero (suc ∞) q .lower) search-n : ∀ α n → search α ≡ embed n → α n ≡ true - search-n α Nat.zero p with α 0 | ⊎Path.encode _ _ (cong force p) + search-n α Nat.zero p with α 0 | ⊎Path.encode _ _ (cong force p) ... | true | _ = refl - search-n α (Nat.suc n) p with α 0 | ⊎Path.encode _ _ (cong force p) + search-n α (Nat.suc n) p with α 0 | ⊎Path.encode _ _ (cong force p) ... | false | q = search-n (α ∘ Nat.suc) n (q .lower) module _ (f : Conat → Nat.ℕ) (emb : isEmbedding f) where discreteConat : Discrete Conat discreteConat - = Embedding-into-Discrete→Discrete (f , emb) Nat.discreteℕ + = Embedding-into-Discrete→Discrete (f , emb) Nat.discreteℕ wlpo' : Omni.WLPO' Nat.ℕ wlpo' α with discreteConat (search α) ∞ diff --git a/Cubical.Codata.M.AsLimit.M.Base.html b/Cubical.Codata.M.AsLimit.M.Base.html index d5ed1682b9..efbcc314f2 100644 --- a/Cubical.Codata.M.AsLimit.M.Base.html +++ b/Cubical.Codata.M.AsLimit.M.Base.html @@ -88,7 +88,7 @@ shift-iso : ∀ {ℓ} (S : Container ℓ) -> Iso (P₀ S (M S)) (M S) shift-iso S@(A , B) = P₀ S (M S) - Iso⟨ Σ-cong-iso-snd + Iso⟨ Σ-cong-iso-snd (λ x → iso (λ f → (λ n z → f z .fst n) , λ n i a → f a .snd n i) (λ (u , q) z → (λ n → u n z) , λ n i → q n i z) (λ _ → refl) @@ -148,8 +148,8 @@ (u n))) (Σ[ a ∈ A ] (Σ[ u ∈ ((n : ℕ) → B a → X (sequence S) n) ] ((n : ℕ) → π (sequence S) ∘ (u (suc n)) ≡ u n))) α-iso-step-5-Iso = - Σ-cong-iso (lemma11-Iso {S = S} (λ _ → A) (λ _ x → x)) (λ a,p → - Σ-cong-iso (pathToIso (cong (λ k → (n : ℕ) → k n) (funExt λ n → cong (λ k → B k → Wₙ S n) (α-iso-step-5-Iso-helper0 (a,p .fst) (a,p .snd) n)))) λ u → + Σ-cong-iso (lemma11-Iso {S = S} (λ _ → A) (λ _ x → x)) (λ a,p → + Σ-cong-iso (pathToIso (cong (λ k → (n : ℕ) → k n) (funExt λ n → cong (λ k → B k → Wₙ S n) (α-iso-step-5-Iso-helper0 (a,p .fst) (a,p .snd) n)))) λ u → pathToIso (cong (λ k → (n : ℕ) → k n) (funExt λ n → α-iso-step-5-Iso-helper1-Iso (a,p .fst) (a,p .snd) u n))) α-iso-step-1-4-Iso-lem-12 : diff --git a/Cubical.Codata.M.AsLimit.helper.html b/Cubical.Codata.M.AsLimit.helper.html index e6fe558866..33c421a245 100644 --- a/Cubical.Codata.M.AsLimit.helper.html +++ b/Cubical.Codata.M.AsLimit.helper.html @@ -32,7 +32,7 @@ → ∀ {f g : C -> A} → (x : C) → (Iso.fun isom (f x) ≡ Iso.fun isom (g x)) ≡ (f x ≡ g x) iso→fun-Injection {A = A} {B} {C} isom {f = f} {g} = - isEmbedding→Injection {A = A} {B} {C} (Iso.fun isom) (iso→isEmbedding {A = A} {B} isom) {f = f} {g = g} + isEmbedding→Injection {A = A} {B} {C} (Iso.fun isom) (iso→isEmbedding {A = A} {B} isom) {f = f} {g = g} abstract iso→Pi-fun-Injection : diff --git a/Cubical.Cohomology.Base.html b/Cubical.Cohomology.Base.html index 7da9a4adf8..734d50d488 100644 --- a/Cubical.Cohomology.Base.html +++ b/Cubical.Cohomology.Base.html @@ -33,7 +33,7 @@ open import Cubical.Data.Nat.Base using (ℕ) open import Cubical.Data.Sigma open import Cubical.Homotopy.Group.Base -open import Cubical.HITs.SetTruncation hiding (map) +open import Cubical.HITs.SetTruncation hiding (map) open import Cubical.Homotopy.Spectrum open import Cubical.Homotopy.Loopspace renaming (EH to isCommΩ) @@ -114,7 +114,7 @@ Cohom = CohomType k , subst AbGroupStr shiftΩTwicePath (snd (abGroupStr.π₂AbGroup k)) CohomPath : Cohom' ≡ Cohom - CohomPath = ΣPathTransport→PathΣ Cohom' Cohom (shiftΩTwicePath , refl) + CohomPath = ΣPathTransport→PathΣ Cohom' Cohom (shiftΩTwicePath , refl) CohomEquiv : AbGroupEquiv Cohom' Cohom CohomEquiv = fst (invEquiv (AbGroupPath Cohom' Cohom)) CohomPath diff --git a/Cubical.Cohomology.EilenbergMacLane.Base.html b/Cubical.Cohomology.EilenbergMacLane.Base.html index f30419cfd4..017871f51c 100644 --- a/Cubical.Cohomology.EilenbergMacLane.Base.html +++ b/Cubical.Cohomology.EilenbergMacLane.Base.html @@ -30,7 +30,7 @@ open import Cubical.Algebra.Group.Instances.IntMod open import Cubical.HITs.SetTruncation as ST - hiding (rec ; map ; elim ; elim2 ; elim3) + hiding (rec ; map ; elim ; elim2 ; elim3) private variable @@ -52,7 +52,7 @@ _+ₕ_ = ST.rec2 squash₂ λ f g → ∣ (λ x → f x +ₖ g x) ∣₂ -ₕ_ : coHom n G A → coHom n G A - -ₕ_ = ST.map λ f x → -ₖ f x + -ₕ_ = ST.map λ f x → -ₖ f x _-ₕ_ : coHom n G A → coHom n G A → coHom n G A _-ₕ_ = ST.rec2 squash₂ λ f g → ∣ (λ x → f x -ₖ g x) ∣₂ @@ -127,7 +127,7 @@ , cong₂ _+ₖ_ (snd f) (snd g) ∙ rUnitₖ n (0ₖ n) ∣₂ -ₕ∙_ : coHomRed n G A → coHomRed n G A - -ₕ∙_ = ST.map λ f → (λ x → -ₖ (fst f x)) + -ₕ∙_ = ST.map λ f → (λ x → -ₖ (fst f x)) , cong -ₖ_ (snd f) ∙ -0ₖ n @@ -251,8 +251,8 @@ ∣ EM-raw'→EM∙ G (suc n) ∣₁) main : GroupIso _ _ - Iso.fun (fst main) = ST.map fst - Iso.inv (fst main) = ST.map λ f → (λ x → f x -ₖ f (pt A)) + Iso.fun (fst main) = ST.map fst + Iso.inv (fst main) = ST.map λ f → (λ x → f x -ₖ f (pt A)) , rCancelₖ (suc n) (f (pt A)) Iso.rightInv (fst main) = ST.elim (λ _ → isSetPathImplicit) @@ -287,7 +287,7 @@ coHomFun : ∀ {ℓ''} {A : Type ℓ} {B : Type ℓ'} {G : AbGroup ℓ''} (n : ℕ) (f : A → B) → coHom n G B → coHom n G A -coHomFun n f = ST.map λ g x → g (f x) +coHomFun n f = ST.map λ g x → g (f x) coHomHom : ∀ {ℓ''} {A : Type ℓ} {B : Type ℓ'} {G : AbGroup ℓ''} (n : ℕ) (f : A → B) @@ -300,7 +300,7 @@ coHomFun∙ : ∀ {ℓ''} {A : Pointed ℓ} {B : Pointed ℓ'} {G : AbGroup ℓ''} (n : ℕ) (f : A →∙ B) → coHomRed n G B → coHomRed n G A -coHomFun∙ n f = ST.map λ g → g ∘∙ f +coHomFun∙ n f = ST.map λ g → g ∘∙ f coHomHom∙ : ∀ {ℓ''} {A : Pointed ℓ} {B : Pointed ℓ'} {G : AbGroup ℓ''} (n : ℕ) (f : A →∙ B) diff --git a/Cubical.Cohomology.EilenbergMacLane.CupProduct.html b/Cubical.Cohomology.EilenbergMacLane.CupProduct.html index 306da6e4f8..d63e3f5619 100644 --- a/Cubical.Cohomology.EilenbergMacLane.CupProduct.html +++ b/Cubical.Cohomology.EilenbergMacLane.CupProduct.html @@ -108,7 +108,7 @@ -- Graded commutativity -ₕ^[_·_] : {G' : AbGroup ℓ} {A : Type ℓ'} (n m : ℕ) {k : ℕ} → coHom k G' A → coHom k G' A --ₕ^[ n · m ] = ST.map λ f x → -ₖ^[ n · m ] (f x) +-ₕ^[ n · m ] = ST.map λ f x → -ₖ^[ n · m ] (f x) -ₕ^[_·_]-even : {G' : AbGroup ℓ} {A : Type ℓ'} (n m : ℕ) {k : ℕ} → isEvenT n ⊎ isEvenT m diff --git a/Cubical.Cohomology.EilenbergMacLane.EilenbergSteenrod.html b/Cubical.Cohomology.EilenbergMacLane.EilenbergSteenrod.html index fc54760b51..712783b0f7 100644 --- a/Cubical.Cohomology.EilenbergMacLane.EilenbergSteenrod.html +++ b/Cubical.Cohomology.EilenbergMacLane.EilenbergSteenrod.html @@ -62,7 +62,7 @@ AbGroupHom (coHomRedℤ G (sucℤ n) (Susp (typ A) , north)) (coHomRedℤ G n A) fst (suspMap (pos n) {A = A}) = - ST.map λ f → (λ x → ΩEM+1→EM n + ST.map λ f → (λ x → ΩEM+1→EM n (sym (snd f) ∙∙ cong (fst f) (merid x ∙ sym (merid (pt A))) ∙∙ snd f)) @@ -123,7 +123,7 @@ AbGroupIso (coHomRedℤ G (sucℤ n) (Susp (typ A) , north)) (coHomRedℤ G n A) fun (fst (suspMapIso n)) = suspMap n .fst - inv (fst (suspMapIso (pos n))) = ST.map (toSusp-coHomRed n) + inv (fst (suspMapIso (pos n))) = ST.map (toSusp-coHomRed n) inv (fst (suspMapIso (negsuc zero))) _ = 0ₕ∙ zero inv (fst (suspMapIso (negsuc (suc n)))) _ = tt* rightInv (fst (suspMapIso (pos n) {A = A})) = @@ -163,7 +163,7 @@ (sym (merid (pt A))) (~ i) j)) leftInv (fst (suspMapIso (negsuc zero) {A = A})) = ST.elim (λ _ → isSetPathImplicit) - λ f → cong ∣_∣₂ (Σ≡Prop (λ _ → hLevelEM G 0 _ _) + λ f → cong ∣_∣₂ (Σ≡Prop (λ _ → hLevelEM G 0 _ _) (funExt (suspToPropElim (pt A) (λ _ → hLevelEM G 0 _ _) (sym (snd f))))) @@ -180,7 +180,7 @@ ; south → refl ; (merid a i) → refl}))) snd (Suspension (satisfies-ES G)) f (negsuc zero) = - funExt λ {tt* → cong ∣_∣₂ (Σ≡Prop (λ _ → hLevelEM G 0 _ _) refl)} + funExt λ {tt* → cong ∣_∣₂ (Σ≡Prop (λ _ → hLevelEM G 0 _ _) refl)} snd (Suspension (satisfies-ES G)) f (negsuc (suc n)) = refl Exactness (satisfies-ES G) {A = A} {B = B} f (pos n) = isoToPath help where @@ -194,7 +194,7 @@ , snd g ∣₂ , cong ∣_∣₂ (→∙Homogeneous≡ (isHomogeneousEM n) refl)) - (Iso.fun ST.PathIdTrunc₀Iso p) + (Iso.fun ST.PathIdTrunc₀Iso p) From : (x : coHomRed n G B) → isInIm (coHomHom∙ n (cfcod (fst f) , refl)) x @@ -210,14 +210,14 @@ ∙ push (pt A) ∙ λ i → inr (snd f i)) ∙ snd h))) - (Iso.fun ST.PathIdTrunc₀Iso p))) + (Iso.fun ST.PathIdTrunc₀Iso p))) help : Iso (Ker (coHomHom∙ n f)) (Im (coHomHom∙ n (cfcod (fst f) , refl))) fun help (x , p) = x , To x p inv help (x , p) = x , From x p - rightInv help (x , p) = Σ≡Prop (λ _ → isPropIsInIm _ _) refl - leftInv help (x , p) = Σ≡Prop (λ _ → isPropIsInKer _ _) refl + rightInv help (x , p) = Σ≡Prop (λ _ → isPropIsInIm _ _) refl + leftInv help (x , p) = Σ≡Prop (λ _ → isPropIsInKer _ _) refl Exactness (satisfies-ES {ℓ} {ℓ'} G) {A = A} {B = B} f (negsuc n) = isoToPath help where @@ -226,8 +226,8 @@ (cfcod (fst f) , refl))) fun help (tt* , p) = tt* , ∣ tt* , refl ∣₁ inv help (tt* , p) = tt* , refl - rightInv help (tt* , p) = Σ≡Prop (λ _ → isPropIsInIm _ _) refl - leftInv help (tt* , p) = Σ≡Prop (λ _ → isPropIsInKer _ _) refl + rightInv help (tt* , p) = Σ≡Prop (λ _ → isPropIsInIm _ _) refl + leftInv help (tt* , p) = Σ≡Prop (λ _ → isPropIsInKer _ _) refl Dimension (satisfies-ES G) (pos zero) p = ⊥.rec (p refl) fst (Dimension (satisfies-ES G) (pos (suc n)) _) = 0ₕ∙ (suc n) snd (Dimension (satisfies-ES G) (pos (suc n)) _) = diff --git a/Cubical.Cohomology.EilenbergMacLane.Groups.Sn.html b/Cubical.Cohomology.EilenbergMacLane.Groups.Sn.html index 31951ac04a..cc175d7483 100644 --- a/Cubical.Cohomology.EilenbergMacLane.Groups.Sn.html +++ b/Cubical.Cohomology.EilenbergMacLane.Groups.Sn.html @@ -113,7 +113,7 @@ HⁿSⁿ↓ : (n : ℕ) → coHom (suc (suc n)) G (S₊ (suc (suc n))) → coHom (suc n) G (S₊ (suc n)) - HⁿSⁿ↓ n = ST.map λ f x → ΩEM+1→EM-gen (suc n) _ (cong f (toSusp (S₊∙ (suc n)) x)) + HⁿSⁿ↓ n = ST.map λ f x → ΩEM+1→EM-gen (suc n) _ (cong f (toSusp (S₊∙ (suc n)) x)) private liftMap : (n : ℕ) (f : S₊ (suc n) → EM G (suc n)) @@ -122,7 +122,7 @@ HⁿSⁿ↑ : (n : ℕ) → coHom (suc n) G (S₊ (suc n)) → coHom (suc (suc n)) G (S₊ (suc (suc n))) - HⁿSⁿ↑ n = ST.map (liftMap n) + HⁿSⁿ↑ n = ST.map (liftMap n) Hⁿ[Sⁿ,G]≅Hⁿ⁺¹[Sⁿ⁺¹,G] : (n : ℕ) → AbGroupEquiv (coHomGr (suc n) G (S₊ (suc n))) @@ -215,7 +215,7 @@ λ p → PT.rec (squash₂ _ _) (λ q → cong ∣_∣₂ (sym (characSⁿFun n (λ _ → 0ₖ _)) ∙ cong (SⁿFun n (0ₖ (suc (m +ℕ suc (suc n))))) q)) - (Iso.fun PathIdTrunc₀Iso + (Iso.fun PathIdTrunc₀Iso (isContr→isProp (subst (λ A → isContr ∥ (S₊ (suc n) → A) ∥₂) (cong (EM G) (sym (+-suc m (suc n))) diff --git a/Cubical.Cohomology.EilenbergMacLane.MayerVietoris.html b/Cubical.Cohomology.EilenbergMacLane.MayerVietoris.html index e50cd4d76e..991db8fe2b 100644 --- a/Cubical.Cohomology.EilenbergMacLane.MayerVietoris.html +++ b/Cubical.Cohomology.EilenbergMacLane.MayerVietoris.html @@ -49,7 +49,7 @@ makeIsGroupHom (ST.elim2 (λ _ _ → isOfHLevelPath 2 - (isSet× isSetSetTrunc isSetSetTrunc) _ _) + (isSet× isSetSetTrunc isSetSetTrunc) _ _) λ _ _ → refl) private @@ -100,7 +100,7 @@ ∙ sym (cong₂+₂ n (EM→ΩEM+1 (suc n) (h a)) (EM→ΩEM+1 (suc n) (l a))) d : (n : ℕ) → AbGroupHom (coHomGr n G C) (coHomGr (suc n) G (Pushout f g)) - fst (d n) = ST.rec isSetSetTrunc λ a → ∣ d-pre n a ∣₂ + fst (d n) = ST.rec isSetSetTrunc λ a → ∣ d-pre n a ∣₂ snd (d n) = makeIsGroupHom (ST.elim2 (λ _ _ → isSetPathImplicit) λ a b → cong ∣_∣₂ (funExt (dHomHelper n a b))) @@ -124,8 +124,8 @@ λ a p → PT.map2 (λ l r → ∣ F a (funExt⁻ l) (funExt⁻ r) ∣₂ , cong ∣_∣₂ (funExt (F-kill a (funExt⁻ l) (funExt⁻ r)))) - (Iso.fun PathIdTrunc₀Iso (cong fst p)) - (Iso.fun PathIdTrunc₀Iso (cong snd p)) + (Iso.fun PathIdTrunc₀Iso (cong fst p)) + (Iso.fun PathIdTrunc₀Iso (cong snd p)) where module _ (a : Pushout f g → EM G (suc n)) (l : (x : A) → a (inl x) ≡ 0ₖ (suc n)) @@ -165,7 +165,7 @@ uncurry (ST.elim2 (λ _ _ → isSetΠ λ _ → isProp→isSet (isPropIsInIm _ _)) λ a b p → PT.map (λ q → ∣ F a b (funExt⁻ q) ∣₂ , refl) - (Iso.fun PathIdTrunc₀Iso p)) + (Iso.fun PathIdTrunc₀Iso p)) where module _ (a : A → EM G n) (b : B → EM G n) @@ -213,7 +213,7 @@ (λ i₁ → p i₁ (inr (g c))) ∙ cong (ΩEM+1→EM n) (help h p c) ∙ Iso.leftInv (Iso-EM-ΩEM+1 n) (h c))) - (Iso.fun (PathIdTrunc₀Iso) p) + (Iso.fun (PathIdTrunc₀Iso) p) where help : (h : _) (p : d-pre n h ≡ (λ _ → 0ₖ (suc n))) (c : C) → funExt⁻ p (inl (f c)) @@ -240,7 +240,7 @@ λ { (inl x) → EM→ΩEM+1 n (F x) ; (inr x) → EM→ΩEM+1 n (G x) ; (push a j) i → help (F (f a)) (G (g a)) i j}))) - (Iso.fun (PathIdTrunc₀Iso) p)))) + (Iso.fun (PathIdTrunc₀Iso) p)))) where help : (x y : EM G n) → Square (EM→ΩEM+1 n (x -ₖ y)) refl (EM→ΩEM+1 n x) (EM→ΩEM+1 n y) diff --git a/Cubical.Cohomology.EilenbergMacLane.RingStructure.html b/Cubical.Cohomology.EilenbergMacLane.RingStructure.html index 89e3a6e7d9..7c532add9f 100644 --- a/Cubical.Cohomology.EilenbergMacLane.RingStructure.html +++ b/Cubical.Cohomology.EilenbergMacLane.RingStructure.html @@ -54,11 +54,11 @@ _⌣_ (λ {k} {l} → 0ₕ-⌣ k l) (λ {k} {l} → ⌣-0ₕ k l) - (λ _ _ _ → sym (ΣPathTransport→PathΣ _ _ (sym (+'-assoc _ _ _) , flipTransport (assoc⌣ _ _ _ _ _ _)))) - (λ {n} a → sym (ΣPathTransport→PathΣ _ _ (sym (+'-rid _) + (λ _ _ _ → sym (ΣPathTransport→PathΣ _ _ (sym (+'-assoc _ _ _) , flipTransport (assoc⌣ _ _ _ _ _ _)))) + (λ {n} a → sym (ΣPathTransport→PathΣ _ _ (sym (+'-rid _) , sym (⌣-1ₕ _ _ ∙ cong (λ p → subst (λ p → coHom p R-ab A) p a) (isSetℕ _ _ _ _))))) - (λ _ → ΣPathTransport→PathΣ _ _ (refl , transportRefl _ ∙ 1ₕ-⌣ _ _)) + (λ _ → ΣPathTransport→PathΣ _ _ (refl , transportRefl _ ∙ 1ₕ-⌣ _ _)) (λ _ _ _ → distrL⌣ _ _ _ _ _) λ _ _ _ → distrR⌣ _ _ _ _ _ diff --git a/Cubical.Data.Cardinality.Base.html b/Cubical.Data.Cardinality.Base.html new file mode 100644 index 0000000000..c77bb89642 --- /dev/null +++ b/Cubical.Data.Cardinality.Base.html @@ -0,0 +1,56 @@ + +Cubical.Data.Cardinality.Base
{-
+
+This file contains:
+
+- Treatment of set truncation as cardinality
+  as per the HoTT book, section 10.2
+
+-}
+{-# OPTIONS --safe #-}
+module Cubical.Data.Cardinality.Base where
+
+open import Cubical.HITs.SetTruncation as ∥₂
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.HLevels
+open import Cubical.Data.Empty
+open import Cubical.Data.Sigma
+open import Cubical.Data.Sum
+open import Cubical.Data.Unit
+
+private
+  variable
+    ℓ : Level
+
+-- First, we define a cardinal as the set truncation of Set
+Card : Type (ℓ-suc ℓ)
+Card {ℓ} = ∥ hSet ℓ ∥₂
+
+-- Verify that it's a set
+isSetCard : isSet (Card {ℓ})
+isSetCard = isSetSetTrunc
+
+-- Set truncation of a set is its cardinality
+card : hSet ℓ → Card {ℓ}
+card = ∣_∣₂
+
+-- Some special cardinalities
+𝟘 : Card {ℓ}
+𝟘 = card (⊥* , isProp→isSet isProp⊥*)
+
+𝟙 : Card {ℓ}
+𝟙 = card (Unit* , isSetUnit*)
+
+-- Now we define some arithmetic
+_+_ : Card {ℓ} → Card {ℓ} → Card {ℓ}
+_+_ = ∥₂.rec2 isSetCard λ (A , isSetA) (B , isSetB)
+                        → card ((A ⊎ B) , isSet⊎ isSetA isSetB)
+
+_·_ : Card {ℓ} → Card {ℓ} → Card {ℓ}
+_·_ = ∥₂.rec2 isSetCard λ (A , isSetA) (B , isSetB)
+                        → card ((A × B) , isSet× isSetA isSetB)
+
+_^_ : Card {ℓ} → Card {ℓ} → Card {ℓ}
+_^_ = ∥₂.rec2 isSetCard λ (A , isSetA) (B , _)
+                        → card ((B → A) , isSet→ isSetA)
+
\ No newline at end of file diff --git a/Cubical.Data.Cardinality.Properties.html b/Cubical.Data.Cardinality.Properties.html new file mode 100644 index 0000000000..311e0cdb5f --- /dev/null +++ b/Cubical.Data.Cardinality.Properties.html @@ -0,0 +1,196 @@ + +Cubical.Data.Cardinality.Properties
{-
+
+This file contains:
+
+- Properties of cardinality
+- Preordering of cardinalities
+
+-}
+{-# OPTIONS --safe #-}
+module Cubical.Data.Cardinality.Properties where
+
+open import Cubical.HITs.SetTruncation as ∥₂
+open import Cubical.Data.Cardinality.Base
+
+open import Cubical.Algebra.CommSemiring
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.Isomorphism
+open import Cubical.Foundations.HLevels
+open import Cubical.Foundations.Structure
+open import Cubical.Functions.Embedding
+open import Cubical.Data.Empty as ⊥
+open import Cubical.Data.Sigma
+open import Cubical.Data.Sum as ⊎
+open import Cubical.Data.Unit
+open import Cubical.HITs.PropositionalTruncation as ∥₁
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Binary.Order.Preorder.Base
+open import Cubical.Relation.Binary.Order.Properties
+
+private
+  variable
+    ℓ : Level
+
+-- Cardinality is a commutative semiring
+module _ where
+  private
+    +Assoc : (A B C : Card {ℓ}) → A + (B + C) ≡ (A + B) + C
+    +Assoc = ∥₂.elim3 (λ _ _ _ → isProp→isSet (isSetCard _ _))
+                      λ _ _ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                                  (sym (isoToPath ⊎-assoc-Iso)))
+
+    ·Assoc : (A B C : Card {ℓ}) → A · (B · C) ≡ (A · B) · C
+    ·Assoc = ∥₂.elim3 (λ _ _ _ → isProp→isSet (isSetCard _ _))
+                      λ _ _ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                                  (sym (isoToPath Σ-assoc-Iso)))
+
+    +IdR𝟘 : (A : Card {ℓ}) → A + 𝟘 ≡ A
+    +IdR𝟘 = ∥₂.elim (λ _ → isProp→isSet (isSetCard _ _))
+                    λ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                            (isoToPath ⊎-IdR-⊥*-Iso))
+
+    +IdL𝟘 : (A : Card {ℓ}) → 𝟘 + A ≡ A
+    +IdL𝟘 = ∥₂.elim (λ _ → isProp→isSet (isSetCard _ _))
+                    λ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                            (isoToPath ⊎-IdL-⊥*-Iso))
+
+    ·IdR𝟙 : (A : Card {ℓ}) → A · 𝟙 ≡ A
+    ·IdR𝟙 = ∥₂.elim (λ _ → isProp→isSet (isSetCard _ _))
+                    λ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                            (isoToPath rUnit*×Iso))
+
+    ·IdL𝟙 : (A : Card {ℓ}) → 𝟙 · A ≡ A
+    ·IdL𝟙 = ∥₂.elim (λ _ → isProp→isSet (isSetCard _ _))
+                    λ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                            (isoToPath lUnit*×Iso))
+
+    +Comm : (A B : Card {ℓ}) → (A + B) ≡ (B + A)
+    +Comm = ∥₂.elim2 (λ _ _ → isProp→isSet (isSetCard _ _))
+                     λ _ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                               (isoToPath ⊎-swap-Iso))
+
+    ·Comm : (A B : Card {ℓ}) → (A · B) ≡ (B · A)
+    ·Comm = ∥₂.elim2 (λ _ _ → isProp→isSet (isSetCard _ _))
+                     λ _ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                               (isoToPath Σ-swap-Iso))
+
+    ·LDist+ : (A B C : Card {ℓ}) → A · (B + C) ≡ (A · B) + (A · C)
+    ·LDist+ = ∥₂.elim3 (λ _ _ _ → isProp→isSet (isSetCard _ _))
+                       λ _ _ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                                   (isoToPath ×DistL⊎Iso))
+
+    AnnihilL : (A : Card {ℓ}) → 𝟘 · A ≡ 𝟘
+    AnnihilL = ∥₂.elim (λ _ → isProp→isSet (isSetCard _ _))
+                       λ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                               (isoToPath (ΣEmpty*Iso λ _ → _)))
+
+  isCardCommSemiring : IsCommSemiring {ℓ-suc ℓ} 𝟘 𝟙 _+_ _·_
+  isCardCommSemiring = makeIsCommSemiring isSetCard +Assoc +IdR𝟘 +Comm ·Assoc ·IdR𝟙 ·LDist+ AnnihilL ·Comm
+
+-- Exponentiation is also well-behaved
+
+^AnnihilR𝟘 : (A : Card {ℓ}) → A ^ 𝟘 ≡ 𝟙
+^AnnihilR𝟘 = ∥₂.elim (λ _ → isProp→isSet (isSetCard _ _))
+             λ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                            (isoToPath (iso⊥ _)))
+           where iso⊥ : ∀ A → Iso (⊥* → A) Unit*
+                 Iso.fun (iso⊥ A) _        = tt*
+                 Iso.inv (iso⊥ A) _        ()
+                 Iso.rightInv (iso⊥ A) _   = refl
+                 Iso.leftInv  (iso⊥ A) _ i ()
+
+^IdR𝟙 : (A : Card {ℓ}) → A ^ 𝟙 ≡ A
+^IdR𝟙 = ∥₂.elim (λ _ → isProp→isSet (isSetCard _ _))
+                λ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                               (isoToPath (iso⊤ _)))
+        where iso⊤ : ∀ A → Iso (Unit* → A) A
+              Iso.fun (iso⊤ _) f      = f tt*
+              Iso.inv (iso⊤ _) a _    = a
+              Iso.rightInv (iso⊤ _) _ = refl
+              Iso.leftInv  (iso⊤ _) _ = refl
+
+^AnnihilL𝟙 : (A : Card {ℓ}) → 𝟙 ^ A ≡ 𝟙
+^AnnihilL𝟙 = ∥₂.elim (λ _ → isProp→isSet (isSetCard _ _))
+                     λ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                             (isoToPath (iso⊤ _)))
+             where iso⊤ : ∀ A → Iso (A → Unit*) Unit*
+                   Iso.fun (iso⊤ _) _      = tt*
+                   Iso.inv (iso⊤ _) _ _    = tt*
+                   Iso.rightInv (iso⊤ _) _ = refl
+                   Iso.leftInv  (iso⊤ _) _ = refl
+
+^LDist+ : (A B C : Card {ℓ}) → A ^ (B + C) ≡ (A ^ B) · (A ^ C)
+^LDist+ = ∥₂.elim3 (λ _ _ _ → isProp→isSet (isSetCard _ _))
+                   λ _ _ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                               (isoToPath Π⊎Iso))
+
+^Assoc· : (A B C : Card {ℓ}) → A ^ (B · C) ≡ (A ^ B) ^ C
+^Assoc· = ∥₂.elim3 (λ _ _ _ → isProp→isSet (isSetCard _ _))
+                   λ _ _ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                               (isoToPath (is _ _ _)))
+          where is : ∀ A B C → Iso (B × C → A) (C → B → A)
+                is A B C = (B × C → A) Iso⟨ domIso Σ-swap-Iso ⟩
+                           (C × B → A) Iso⟨ curryIso ⟩
+                           (C → B → A) ∎Iso
+
+^RDist· : (A B C : Card {ℓ}) → (A · B) ^ C ≡ (A ^ C) · (B ^ C)
+^RDist· = ∥₂.elim3 (λ _ _ _ → isProp→isSet (isSetCard _ _))
+                   λ _ _ _ → cong ∣_∣₂ (Σ≡Prop (λ _ → isPropIsSet)
+                                               (isoToPath Σ-Π-Iso))
+
+
+-- With basic arithmetic done, we can now define an ordering over cardinals
+module _ where
+  private
+    _≲'_ : Card {ℓ} → Card {ℓ} → hProp ℓ
+    _≲'_ = ∥₂.rec2 isSetHProp λ (A , _) (B , _) → ∥ A ↪ B ∥₁ , isPropPropTrunc
+
+  _≲_ : Rel (Card {ℓ}) (Card {ℓ}) ℓ
+  A ≲ B = ⟨ A ≲' B ⟩
+
+  isPreorder≲ : IsPreorder {ℓ-suc ℓ} _≲_
+  isPreorder≲
+    = ispreorder isSetCard prop reflexive transitive
+                 where prop : BinaryRelation.isPropValued _≲_
+                       prop a b = str (a ≲' b)
+
+                       reflexive : BinaryRelation.isRefl _≲_
+                       reflexive = ∥₂.elim (λ A → isProp→isSet (prop A A))
+                                           (λ (A , _) → ∣ id↪ A ∣₁)
+
+                       transitive : BinaryRelation.isTrans _≲_
+                       transitive = ∥₂.elim3 (λ x _ z → isSetΠ2
+                                                      λ _ _ → isProp→isSet
+                                                              (prop x z))
+                                             (λ (A , _) (B , _) (C , _)
+                                              → ∥₁.map2 λ A↪B B↪C
+                                                        → compEmbedding
+                                                          B↪C
+                                                          A↪B)
+
+isLeast𝟘 : ∀{ℓ} → isLeast isPreorder≲ (Card {ℓ} , id↪ (Card {ℓ})) (𝟘 {ℓ})
+isLeast𝟘 = ∥₂.elim (λ x → isProp→isSet (IsPreorder.is-prop-valued
+                                       isPreorder≲ 𝟘 x))
+                   (λ _ → ∣ ⊥.rec* , (λ ()) ∣₁)
+
+-- Our arithmetic behaves as expected over our preordering
++Monotone≲ : (A B C D : Card {ℓ}) → A ≲ C → B ≲ D → (A + B) ≲ (C + D)
++Monotone≲
+  = ∥₂.elim4 (λ w x y z → isSetΠ2 λ _ _ → isProp→isSet (IsPreorder.is-prop-valued
+                                                       isPreorder≲
+                                                       (w + x)
+                                                       (y + z)))
+              λ (A , _) (B , _) (C , _) (D , _)
+              → ∥₁.map2 λ A↪C B↪D → ⊎Monotone↪ A↪C B↪D
+
+·Monotone≲ : (A B C D : Card {ℓ}) → A ≲ C → B ≲ D → (A · B) ≲ (C · D)
+·Monotone≲
+  = ∥₂.elim4 (λ w x y z → isSetΠ2 λ _ _ → isProp→isSet (IsPreorder.is-prop-valued
+                                                       isPreorder≲
+                                                       (w · x)
+                                                       (y · z)))
+              λ (A , _) (B , _) (C , _) (D , _)
+              → ∥₁.map2 λ A↪C B↪D → ×Monotone↪ A↪C B↪D
+
\ No newline at end of file diff --git a/Cubical.Data.Cardinality.html b/Cubical.Data.Cardinality.html new file mode 100644 index 0000000000..fbbaab5a82 --- /dev/null +++ b/Cubical.Data.Cardinality.html @@ -0,0 +1,7 @@ + +Cubical.Data.Cardinality
{-# OPTIONS --safe #-}
+module Cubical.Data.Cardinality where
+
+open import Cubical.Data.Cardinality.Base public
+open import Cubical.Data.Cardinality.Properties public
+
\ No newline at end of file diff --git a/Cubical.Data.Everything.html b/Cubical.Data.Everything.html index 78ab91e0f0..74a1b35360 100644 --- a/Cubical.Data.Everything.html +++ b/Cubical.Data.Everything.html @@ -5,77 +5,78 @@ import Cubical.Data.BinNat import Cubical.Data.Bool import Cubical.Data.Bool.SwitchStatement -import Cubical.Data.DescendingList -import Cubical.Data.Empty -import Cubical.Data.Equality -import Cubical.Data.Fin -import Cubical.Data.Fin.Arithmetic -import Cubical.Data.Fin.LehmerCode -import Cubical.Data.Fin.Recursive -import Cubical.Data.FinData -import Cubical.Data.FinData.DepFinVec -import Cubical.Data.FinData.Order -import Cubical.Data.FinInd -import Cubical.Data.FinSet -import Cubical.Data.FinSet.Binary.Large -import Cubical.Data.FinSet.Binary.Small -import Cubical.Data.FinSet.Cardinality -import Cubical.Data.FinSet.Constructors -import Cubical.Data.FinSet.DecidablePredicate -import Cubical.Data.FinSet.FiniteChoice -import Cubical.Data.FinSet.Induction -import Cubical.Data.FinSet.Quotients -import Cubical.Data.FinType -import Cubical.Data.FinType.FiniteStructure -import Cubical.Data.FinType.Sigma -import Cubical.Data.FinWeak -import Cubical.Data.Graph -import Cubical.Data.InfNat -import Cubical.Data.Int -import Cubical.Data.Int.Divisibility -import Cubical.Data.Int.IsEven -import Cubical.Data.Int.MoreInts.BiInvInt -import Cubical.Data.Int.MoreInts.DeltaInt -import Cubical.Data.Int.MoreInts.DiffInt -import Cubical.Data.Int.MoreInts.QuoInt -import Cubical.Data.Int.Order -import Cubical.Data.List -import Cubical.Data.List.Dependent -import Cubical.Data.List.FinData -import Cubical.Data.Maybe -import Cubical.Data.Nat -import Cubical.Data.Nat.Algebra -import Cubical.Data.Nat.Coprime -import Cubical.Data.Nat.Divisibility -import Cubical.Data.Nat.GCD -import Cubical.Data.Nat.IsEven -import Cubical.Data.Nat.Literals -import Cubical.Data.Nat.Lower -import Cubical.Data.Nat.Mod -import Cubical.Data.Nat.Omniscience -import Cubical.Data.Nat.Order -import Cubical.Data.Nat.Order.Recursive -import Cubical.Data.NatMinusOne -import Cubical.Data.NatPlusOne -import Cubical.Data.NatPlusOne.MoreNats.AssocNat -import Cubical.Data.Prod -import Cubical.Data.Queue -import Cubical.Data.Queue.1List -import Cubical.Data.Queue.Truncated2List -import Cubical.Data.Queue.Untruncated2List -import Cubical.Data.Queue.Untruncated2ListInvariant -import Cubical.Data.Rationals -import Cubical.Data.Rationals.MoreRationals.HITQ -import Cubical.Data.Rationals.MoreRationals.SigmaQ -import Cubical.Data.Sigma -import Cubical.Data.SubFinSet -import Cubical.Data.Sum -import Cubical.Data.SumFin -import Cubical.Data.Unit -import Cubical.Data.Unit.Pointed -import Cubical.Data.Vec -import Cubical.Data.Vec.DepVec -import Cubical.Data.Vec.NAry -import Cubical.Data.Vec.OperationsNat -import Cubical.Data.W.Indexed +import Cubical.Data.Cardinality +import Cubical.Data.DescendingList +import Cubical.Data.Empty +import Cubical.Data.Equality +import Cubical.Data.Fin +import Cubical.Data.Fin.Arithmetic +import Cubical.Data.Fin.LehmerCode +import Cubical.Data.Fin.Recursive +import Cubical.Data.FinData +import Cubical.Data.FinData.DepFinVec +import Cubical.Data.FinData.Order +import Cubical.Data.FinInd +import Cubical.Data.FinSet +import Cubical.Data.FinSet.Binary.Large +import Cubical.Data.FinSet.Binary.Small +import Cubical.Data.FinSet.Cardinality +import Cubical.Data.FinSet.Constructors +import Cubical.Data.FinSet.DecidablePredicate +import Cubical.Data.FinSet.FiniteChoice +import Cubical.Data.FinSet.Induction +import Cubical.Data.FinSet.Quotients +import Cubical.Data.FinType +import Cubical.Data.FinType.FiniteStructure +import Cubical.Data.FinType.Sigma +import Cubical.Data.FinWeak +import Cubical.Data.Graph +import Cubical.Data.InfNat +import Cubical.Data.Int +import Cubical.Data.Int.Divisibility +import Cubical.Data.Int.IsEven +import Cubical.Data.Int.MoreInts.BiInvInt +import Cubical.Data.Int.MoreInts.DeltaInt +import Cubical.Data.Int.MoreInts.DiffInt +import Cubical.Data.Int.MoreInts.QuoInt +import Cubical.Data.Int.Order +import Cubical.Data.List +import Cubical.Data.List.Dependent +import Cubical.Data.List.FinData +import Cubical.Data.Maybe +import Cubical.Data.Nat +import Cubical.Data.Nat.Algebra +import Cubical.Data.Nat.Coprime +import Cubical.Data.Nat.Divisibility +import Cubical.Data.Nat.GCD +import Cubical.Data.Nat.IsEven +import Cubical.Data.Nat.Literals +import Cubical.Data.Nat.Lower +import Cubical.Data.Nat.Mod +import Cubical.Data.Nat.Omniscience +import Cubical.Data.Nat.Order +import Cubical.Data.Nat.Order.Recursive +import Cubical.Data.NatMinusOne +import Cubical.Data.NatPlusOne +import Cubical.Data.NatPlusOne.MoreNats.AssocNat +import Cubical.Data.Prod +import Cubical.Data.Queue +import Cubical.Data.Queue.1List +import Cubical.Data.Queue.Truncated2List +import Cubical.Data.Queue.Untruncated2List +import Cubical.Data.Queue.Untruncated2ListInvariant +import Cubical.Data.Rationals +import Cubical.Data.Rationals.MoreRationals.HITQ +import Cubical.Data.Rationals.MoreRationals.SigmaQ +import Cubical.Data.Sigma +import Cubical.Data.SubFinSet +import Cubical.Data.Sum +import Cubical.Data.SumFin +import Cubical.Data.Unit +import Cubical.Data.Unit.Pointed +import Cubical.Data.Vec +import Cubical.Data.Vec.DepVec +import Cubical.Data.Vec.NAry +import Cubical.Data.Vec.OperationsNat +import Cubical.Data.W.Indexed \ No newline at end of file diff --git a/Cubical.Data.Fin.Arithmetic.html b/Cubical.Data.Fin.Arithmetic.html index c04525ea75..a9db74a0ea 100644 --- a/Cubical.Data.Fin.Arithmetic.html +++ b/Cubical.Data.Fin.Arithmetic.html @@ -45,7 +45,7 @@ +ₘ-assoc : {n : ℕ} (x y z : Fin (suc n)) → (x +ₘ y) +ₘ z ≡ (x +ₘ (y +ₘ z)) +ₘ-assoc {n = n} x y z = - Σ≡Prop (λ _ → isProp≤) + Σ≡Prop (λ _ → isProp≤) ((mod-rCancel (suc n) ((fst x + fst y) mod (suc n)) (fst z)) ∙∙ sym (mod+mod≡mod (suc n) (fst x + fst y) (fst z)) ∙∙ cong (_mod suc n) (sym (+-assoc (fst x) (fst y) (fst z))) @@ -54,12 +54,12 @@ +ₘ-comm : {n : ℕ} (x y : Fin (suc n)) → (x +ₘ y) ≡ (y +ₘ x) +ₘ-comm {n = n} x y = - Σ≡Prop (λ _ → isProp≤) + Σ≡Prop (λ _ → isProp≤) (cong (_mod suc n) (+-comm (fst x) (fst y))) +ₘ-lUnit : {n : ℕ} (x : Fin (suc n)) → 0 +ₘ x ≡ x +ₘ-lUnit {n = n} (x , p) = - Σ≡Prop (λ _ → isProp≤) + Σ≡Prop (λ _ → isProp≤) (+inductionBase n _ _ _ x p) +ₘ-rUnit : {n : ℕ} (x : Fin (suc n)) → x +ₘ 0 ≡ x @@ -67,7 +67,7 @@ +ₘ-rCancel : {n : ℕ} (x : Fin (suc n)) → x -ₘ x ≡ 0 +ₘ-rCancel {n = n} x = - Σ≡Prop (λ _ → isProp≤) + Σ≡Prop (λ _ → isProp≤) (cong (λ z → (fst x + z) mod (suc n)) (+inductionBase n _ _ _ (fst x) (snd x)) ∙∙ sym (mod-rCancel (suc n) (fst x) ((suc n) ∸ (fst x))) diff --git a/Cubical.Data.Fin.Base.html b/Cubical.Data.Fin.Base.html index a6afd3d2c0..52b7609b6f 100644 --- a/Cubical.Data.Fin.Base.html +++ b/Cubical.Data.Fin.Base.html @@ -51,7 +51,7 @@ -- ... and injective. toℕ-injective : ∀{fj fk : Fin k} → toℕ fj ≡ toℕ fk → fj ≡ fk -toℕ-injective {fj = fj} {fk} = Σ≡Prop (λ _ → isProp≤) +toℕ-injective {fj = fj} {fk} = Σ≡Prop (λ _ → isProp≤) -- Conversion from ℕ with a recursive definition of ≤ @@ -109,5 +109,5 @@ FinPathℕ : {n : ℕ} (x : Fin n) (y : ℕ) → fst x ≡ y → Σ[ p ∈ _ ] (x ≡ (y , p)) FinPathℕ {n = n} x y p = ((fst (snd x)) , (cong (λ y → fst (snd x) + y) (cong suc (sym p)) ∙ snd (snd x))) - , (Σ≡Prop (λ _ → isProp≤) p) + , (Σ≡Prop (λ _ → isProp≤) p) \ No newline at end of file diff --git a/Cubical.Data.Fin.LehmerCode.html b/Cubical.Data.Fin.LehmerCode.html index 00b43c6871..e789493379 100644 --- a/Cubical.Data.Fin.LehmerCode.html +++ b/Cubical.Data.Fin.LehmerCode.html @@ -47,7 +47,7 @@ toFinExc = fst toFinExc-injective : {i : Fin n} → {j k : FinExcept i} → toFinExc j ≡ toFinExc k → j ≡ k -toFinExc-injective = Σ≡Prop (λ _ → isPropΠ λ _ → ⊥.isProp⊥) +toFinExc-injective = Σ≡Prop (λ _ → isPropΠ λ _ → ⊥.isProp⊥) toℕExc : {i : Fin n} → FinExcept i → ℕ toℕExc = toℕ ∘ toFinExc @@ -104,10 +104,10 @@ j ∎ isEquivPunchOut : {i : Fin (suc n)} → isEquiv (punchOut i) -isEquivPunchOut {i = i} = isEmbedding×isSurjection→isEquiv (isEmbPunchOut , isSurPunchOut) where +isEquivPunchOut {i = i} = isEmbedding×isSurjection→isEquiv (isEmbPunchOut , isSurPunchOut) where isEmbPunchOut : isEmbedding (punchOut i) isEmbPunchOut = injEmbedding isSetFin λ {_} {_} → punchOut-injective i _ _ - isSurPunchOut : isSurjection (punchOut i) + isSurPunchOut : isSurjection (punchOut i) isSurPunchOut b = ∥_∥₁.∣ _ , (punchOut∘In i b) ∣₁ punchOutEquiv : {i : Fin (suc n)} → FinExcept i ≃ Fin n @@ -134,17 +134,17 @@ lehmerEquiv {suc n} = (Fin (suc n) ≃ Fin (suc n)) ≃⟨ isoToEquiv i ⟩ - (Σ[ k ∈ Fin (suc n) ] (FinExcept fzero ≃ FinExcept k)) ≃⟨ Σ-cong-equiv-snd ii ⟩ - (Fin (suc n) × (Fin n ≃ Fin n)) ≃⟨ Σ-cong-equiv-snd (λ _ → lehmerEquiv) ⟩ + (Σ[ k ∈ Fin (suc n) ] (FinExcept fzero ≃ FinExcept k)) ≃⟨ Σ-cong-equiv-snd ii ⟩ + (Fin (suc n) × (Fin n ≃ Fin n)) ≃⟨ Σ-cong-equiv-snd (λ _ → lehmerEquiv) ⟩ (Fin (suc n) × LehmerCode n) ≃⟨ lehmerSucEquiv ⟩ LehmerCode (suc n) ■ where equivIn : (f : Fin (suc n) ≃ Fin (suc n)) → FinExcept fzero ≃ FinExcept (equivFun f fzero) equivIn f = FinExcept fzero - ≃⟨ Σ-cong-equiv-snd (λ _ → preCompEquiv (invEquiv (congEquiv f))) ⟩ + ≃⟨ Σ-cong-equiv-snd (λ _ → preCompEquiv (invEquiv (congEquiv f))) ⟩ (Σ[ x ∈ Fin (suc n) ] ¬ ffun fzero ≡ ffun x) - ≃⟨ Σ-cong-equiv-fst f ⟩ + ≃⟨ Σ-cong-equiv-fst f ⟩ FinExcept (ffun fzero) ■ where ffun = equivFun f @@ -157,7 +157,7 @@ Fin (suc n) ≃⟨ invEquiv projectionEquiv ⟩ Unit ⊎ FinExcept fzero - ≃⟨ isoToEquiv (Sum.⊎Iso idIso (equivToIso f)) ⟩ + ≃⟨ isoToEquiv (Sum.⊎Iso idIso (equivToIso f)) ⟩ Unit ⊎ FinExcept k ≃⟨ projectionEquiv ⟩ Fin (suc n) @@ -199,7 +199,7 @@ lehmerFinEquiv : LehmerCode n ≃ Fin (factorial n) lehmerFinEquiv {zero} = isContr→Equiv isContrLehmerZero isContrFin1 lehmerFinEquiv {suc n} = _ ≃⟨ invEquiv lehmerSucEquiv ⟩ - _ ≃⟨ ≃-× (idEquiv _) lehmerFinEquiv ⟩ + _ ≃⟨ ≃-× (idEquiv _) lehmerFinEquiv ⟩ _ ≃⟨ factorEquiv ⟩ _ ■ diff --git a/Cubical.Data.Fin.Properties.html b/Cubical.Data.Fin.Properties.html index 1109e52cc8..3bc1626115 100644 --- a/Cubical.Data.Fin.Properties.html +++ b/Cubical.Data.Fin.Properties.html @@ -66,14 +66,14 @@ discreteFin : ∀ {n} → Discrete (Fin n) discreteFin {n} (x , hx) (y , hy) with discreteℕ x y -... | yes prf = yes (Σ≡Prop (λ _ → isProp≤) prf) +... | yes prf = yes (Σ≡Prop (λ _ → isProp≤) prf) ... | no prf = no λ h → prf (cong fst h) inject<-ne : ∀ {n} (i : Fin n) → ¬ inject< ≤-refl i ≡ (n , ≤-refl) inject<-ne {n} (k , k<n) p = <→≢ k<n (cong fst p) Fin-fst-≡ : ∀ {n} {i j : Fin n} → fst i ≡ fst j → i ≡ j -Fin-fst-≡ = Σ≡Prop (λ _ → isProp≤) +Fin-fst-≡ = Σ≡Prop (λ _ → isProp≤) private subst-app : (B : A → Type b) (f : (x : A) → B x) {x y : A} (x≡y : x ≡ y) → @@ -172,14 +172,14 @@ → Residue+k k n (Residue-k k n R) ≡ R Residue+k-k k n (((r , r<k) , zero) , p) = Empty.rec (<-asym r<k (lemma₀ p refl)) Residue+k-k k n ((f , suc o) , p) - = Σ≡Prop (λ tup → isSetℕ (expand× tup) (k + n)) refl + = Σ≡Prop (λ tup → isSetℕ (expand× tup) (k + n)) refl Residue-k+k : (k n : ℕ) → (R : Residue k n) → Residue-k k n (Residue+k k n R) ≡ R Residue-k+k k n ((f , o) , p) - = Σ≡Prop (λ tup → isSetℕ (expand× tup) n) refl + = Σ≡Prop (λ tup → isSetℕ (expand× tup) n) refl private Residue≃ : ∀ k n → Residue k n ≃ Residue k (k + n) @@ -385,7 +385,7 @@ g : Fin (suc n′) → Fin n′ g k = fst (f′ k) , <-trans (snd (f′ k)) m<n′ i , j , ¬q , r = pigeonhole-special g - in transport transport-prf (i , j , ¬q , Σ≡Prop (λ _ → isProp≤) (cong fst r)) + in transport transport-prf (i , j , ¬q , Σ≡Prop (λ _ → isProp≤) (cong fst r)) where n′ : ℕ n′ = k + suc m @@ -474,7 +474,7 @@ factorEquiv : ∀ {n} {m} → Fin n × Fin m ≃ Fin (n · m) factorEquiv {zero} {m} = uninhabEquiv (¬Fin0 ∘ fst) ¬Fin0 -factorEquiv {suc n} {m} = intro , isEmbedding×isSurjection→isEquiv (isEmbeddingIntro , isSurjectionIntro) where +factorEquiv {suc n} {m} = intro , isEmbedding×isSurjection→isEquiv (isEmbeddingIntro , isSurjectionIntro) where intro : Fin (suc n) × Fin m → Fin (suc n · m) intro (nn , mm) = nm , subst (λ nm₁ → nm₁ < suc n · m) (sym (expand≡ _ (toℕ nn) (toℕ mm))) nm<n·m where nm : ℕ @@ -515,7 +515,7 @@ mm<m : mm < m mm<m = <-·sk-cancel mm·sn<m·sn - isSurjectionIntro : isSurjection intro + isSurjectionIntro : isSurjection intro isSurjectionIntro = ∣_∣₁ ∘ elimF -- Fin (m + n) ≡ Fin m ⊎ Fin n @@ -578,11 +578,11 @@ where sec-f-g : _ sec-f-g (inl (k , k<m)) with k ≤? m - sec-f-g (inl (k , k<m)) | inl _ = cong inl (Σ≡Prop (λ _ → isProp≤) refl) + sec-f-g (inl (k , k<m)) | inl _ = cong inl (Σ≡Prop (λ _ → isProp≤) refl) sec-f-g (inl (k , k<m)) | inr m≤k = Empty.rec (¬-<-and-≥ k<m m≤k) sec-f-g (inr (k , k<n)) with (m + k) ≤? m sec-f-g (inr (k , k<n)) | inl p = Empty.rec (¬m+n<m {m} {k} p) - sec-f-g (inr (k , k<n)) | inr k≥m = cong inr (Σ≡Prop (λ _ → isProp≤) rem) + sec-f-g (inr (k , k<n)) | inr k≥m = cong inr (Σ≡Prop (λ _ → isProp≤) rem) where rem : (m + k) ∸ m ≡ k rem = subst (λ - → - ∸ m ≡ k) (+-comm k m) (m+n∸n=m m k) @@ -590,8 +590,8 @@ where ret-f-g : _ ret-f-g (k , k<m+n) with k ≤? m - ret-f-g (k , k<m+n) | inl _ = Σ≡Prop (λ _ → isProp≤) refl - ret-f-g (k , k<m+n) | inr m≥k = Σ≡Prop (λ _ → isProp≤) (∸-lemma m≥k) + ret-f-g (k , k<m+n) | inl _ = Σ≡Prop (λ _ → isProp≤) refl + ret-f-g (k , k<m+n) | inr m≥k = Σ≡Prop (λ _ → isProp≤) (∸-lemma m≥k) Fin+≡Fin⊎Fin : (m n : ℕ) → Fin (m + n) ≡ Fin m ⊎ Fin n Fin+≡Fin⊎Fin m n = isoToPath (Fin+≅Fin⊎Fin m n) diff --git a/Cubical.Data.Fin.Recursive.Properties.html b/Cubical.Data.Fin.Recursive.Properties.html index 60aad55787..ee3ef10bc4 100644 --- a/Cubical.Data.Fin.Recursive.Properties.html +++ b/Cubical.Data.Fin.Recursive.Properties.html @@ -232,22 +232,22 @@ up : Fin m → Fin (m + n) up {m} = inject≤ (k≤k+n m) - resplit-identᵣ₀ : ∀ m (i : Fin n) → Sum.⊎Path.Cover (split m (m ⊕ i)) (inr i) + resplit-identᵣ₀ : ∀ m (i : Fin n) → Sum.⊎Path.Cover (split m (m ⊕ i)) (inr i) resplit-identᵣ₀ zero i = lift refl resplit-identᵣ₀ (suc m) i with split m (m ⊕ i) | resplit-identᵣ₀ m i ... | inr j | p = p resplit-identᵣ : ∀ m (i : Fin n) → split m (m ⊕ i) ≡ inr i - resplit-identᵣ m i = Sum.⊎Path.decode _ _ (resplit-identᵣ₀ m i) + resplit-identᵣ m i = Sum.⊎Path.decode _ _ (resplit-identᵣ₀ m i) - resplit-identₗ₀ : ∀ m (i : Fin m) → Sum.⊎Path.Cover (split {n} m (up i)) (inl i) + resplit-identₗ₀ : ∀ m (i : Fin m) → Sum.⊎Path.Cover (split {n} m (up i)) (inl i) resplit-identₗ₀ (suc m) zero = lift refl resplit-identₗ₀ {n} (suc m) (suc i) with split {n} m (up i) | resplit-identₗ₀ {n} m i ... | inl j | lift p = lift (cong suc p) resplit-identₗ : ∀ m (i : Fin m) → split {n} m (up i) ≡ inl i - resplit-identₗ m i = Sum.⊎Path.decode _ _ (resplit-identₗ₀ m i) + resplit-identₗ m i = Sum.⊎Path.decode _ _ (resplit-identₗ₀ m i) desplit-ident : ∀ m → (i : Fin (m + n)) → Sum.rec up (m ⊕_) (split m i) ≡ i desplit-ident zero i = refl diff --git a/Cubical.Data.FinData.Order.html b/Cubical.Data.FinData.Order.html index b28d9d76ec..6189b56e38 100644 --- a/Cubical.Data.FinData.Order.html +++ b/Cubical.Data.FinData.Order.html @@ -28,8 +28,8 @@ _<Fin_ : {n : ℕ} → Fin n → Fin n → Type i <Fin j = (suc i) ≤Fin (weakenFin j) -open BinaryRelation -≤FinIsPropValued : ∀ {n : ℕ} → isPropValued (_≤Fin_ {n}) +open BinaryRelation +≤FinIsPropValued : ∀ {n : ℕ} → isPropValued (_≤Fin_ {n}) ≤FinIsPropValued _ _ = isProp≤ @@ -40,8 +40,8 @@ _<'Fin_ : {n : ℕ} → Fin n → Fin n → Type i <'Fin j = (suc i) ≤'Fin (weakenFin j) -open BinaryRelation -≤'FinIsPropValued : ∀ {n : ℕ} → isPropValued (_≤'Fin_ {n}) +open BinaryRelation +≤'FinIsPropValued : ∀ {n : ℕ} → isPropValued (_≤'Fin_ {n}) ≤'FinIsPropValued _ _ = ≤'IsPropValued _ _ diff --git a/Cubical.Data.FinData.Properties.html b/Cubical.Data.FinData.Properties.html index 6c0a24e5cc..39c2576ae2 100644 --- a/Cubical.Data.FinData.Properties.html +++ b/Cubical.Data.FinData.Properties.html @@ -337,7 +337,7 @@ Equiv : (n m : ℕ) → (Fin n × Fin m) ≃ Fin (n · m) Equiv ℕzero m = uninhabEquiv (λ x → ¬Fin0 (fst x)) ¬Fin0 Equiv (ℕsuc n) m = Fin (ℕsuc n) × Fin m ≃⟨ isoToEquiv (sucProdToSumIso n m) ⟩ - Fin m ⊎ (Fin n × Fin m) ≃⟨ isoToEquiv (⊎Iso idIso (equivToIso (Equiv n m))) ⟩ + Fin m ⊎ (Fin n × Fin m) ≃⟨ isoToEquiv (⊎Iso idIso (equivToIso (Equiv n m))) ⟩ Fin m ⊎ Fin (n · m) ≃⟨ FinSumChar.Equiv m (n · m) ⟩ Fin (m + n · m) ■ diff --git a/Cubical.Data.FinInd.html b/Cubical.Data.FinInd.html index 25a5a9121c..63ae5c2490 100644 --- a/Cubical.Data.FinInd.html +++ b/Cubical.Data.FinInd.html @@ -32,19 +32,19 @@ A : Type ℓ isFinInd : Type ℓ → Type ℓ -isFinInd A = ∃[ n ∈ ℕ ] Fin n ↠ A +isFinInd A = ∃[ n ∈ ℕ ] Fin n ↠ A isFinSet→isFinInd : isFinSet A → isFinInd A isFinSet→isFinInd h = PT.elim (λ _ → squash₁) (λ equiv → - ∣ _ , invEq equiv , section→isSurjection (retEq equiv) ∣₁) (h .snd) + ∣ _ , invEq equiv , section→isSurjection (retEq equiv) ∣₁) (h .snd) isFinInd-S¹ : isFinInd S¹ isFinInd-S¹ = ∣ 1 , f , isSurjection-f ∣₁ where f : Fin 1 → S¹ f _ = base - isSurjection-f : isSurjection f + isSurjection-f : isSurjection f isSurjection-f b = PT.map (λ base≡b → fzero , base≡b) (isConnectedS¹ b) \ No newline at end of file diff --git a/Cubical.Data.FinSet.Base.html b/Cubical.Data.FinSet.Base.html index e8f6161e3e..a92de72bd2 100644 --- a/Cubical.Data.FinSet.Base.html +++ b/Cubical.Data.FinSet.Base.html @@ -49,10 +49,10 @@ -- isFinSet is proposition isPropIsFinSet : isProp (isFinSet A) -isPropIsFinSet p q = Σ≡PropEquiv (λ _ → isPropPropTrunc) .fst ( +isPropIsFinSet p q = Σ≡PropEquiv (λ _ → isPropPropTrunc) .fst ( Prop.elim2 (λ _ _ → isSetℕ _ _) - (λ p q → Fin-inj _ _ (ua (invEquiv (SumFin≃Fin _) ⋆ (invEquiv p) ⋆ q ⋆ SumFin≃Fin _))) + (λ p q → Fin-inj _ _ (ua (invEquiv (SumFin≃Fin _) ⋆ (invEquiv p) ⋆ q ⋆ SumFin≃Fin _))) (p .snd) (q .snd)) -- isFinOrd is Set @@ -91,10 +91,10 @@ -- equality between finite sets/propositions FinSet≡ : (X Y : FinSet ℓ) → (X .fst ≡ Y .fst) ≃ (X ≡ Y) -FinSet≡ _ _ = Σ≡PropEquiv (λ _ → isPropIsFinSet) +FinSet≡ _ _ = Σ≡PropEquiv (λ _ → isPropIsFinSet) FinProp≡ : (X Y : FinProp ℓ) → (X .fst .fst ≡ Y .fst .fst) ≃ (X ≡ Y) -FinProp≡ X Y = compEquiv (FinSet≡ (X .fst) (Y .fst)) (Σ≡PropEquiv (λ _ → isPropIsProp)) +FinProp≡ X Y = compEquiv (FinSet≡ (X .fst) (Y .fst)) (Σ≡PropEquiv (λ _ → isPropIsProp)) -- hlevels of FinSet and FinProp diff --git a/Cubical.Data.FinSet.Binary.Large.html b/Cubical.Data.FinSet.Binary.Large.html index 44367288d1..624b1e2252 100644 --- a/Cubical.Data.FinSet.Binary.Large.html +++ b/Cubical.Data.FinSet.Binary.Large.html @@ -79,7 +79,7 @@ isGroupoidBinary : isGroupoid (Binary ℓ) isGroupoidBinary - = Embedding-into-hLevel→hLevel 2 + = Embedding-into-hLevel→hLevel 2 (map-snd isBinary→isSet , BinaryEmbedding) (isOfHLevelTypeOfHLevel 2) @@ -109,7 +109,7 @@ first = compEquiv (invEquiv P) Q Loopᴾ² : (P Q R : Bool ≃ B) → Square (Loopᴾ P Q) (Loopᴾ P R) refl (Loopᴾ Q R) - Loopᴾ² P Q R i = Σ≡Prop (λ _ → squash₁) (S i) + Loopᴾ² P Q R i = Σ≡Prop (λ _ → squash₁) (S i) where PQ : B ≃ B PQ = compEquiv (invEquiv P) Q diff --git a/Cubical.Data.FinSet.Cardinality.html b/Cubical.Data.FinSet.Cardinality.html index a105831518..f51b97ab05 100644 --- a/Cubical.Data.FinSet.Cardinality.html +++ b/Cubical.Data.FinSet.Cardinality.html @@ -68,7 +68,7 @@ cardEquiv : (X : FinSet ℓ)(Y : FinSet ℓ') → ∥ X .fst ≃ Y .fst ∥₁ → card X ≡ card Y cardEquiv X Y e = Prop.rec (isSetℕ _ _) (λ p → Fin-inj _ _ (ua p)) - (∣ invEquiv (SumFin≃Fin _) ∣₁ ⋆̂ ∣invEquiv∣ (∣≃card∣ X) ⋆̂ e ⋆̂ ∣≃card∣ Y ⋆̂ ∣ SumFin≃Fin _ ∣₁) + (∣ invEquiv (SumFin≃Fin _) ∣₁ ⋆̂ ∣invEquiv∣ (∣≃card∣ X) ⋆̂ e ⋆̂ ∣≃card∣ Y ⋆̂ ∣ SumFin≃Fin _ ∣₁) cardInj : card X ≡ card Y → ∥ X .fst ≃ Y .fst ∥₁ cardInj {X = X} {Y = Y} p = @@ -92,25 +92,25 @@ card>0→isInhab : card X > 0 → ∥ X .fst ∥₁ card>0→isInhab p = - Prop.map (λ e → invEq e (Fin>0→isInhab _ p)) (∣≃card∣ X) + Prop.map (λ e → invEq e (Fin>0→isInhab _ p)) (∣≃card∣ X) card>1→hasNonEqualTerm : card X > 1 → ∥ Σ[ a ∈ X .fst ] Σ[ b ∈ X .fst ] ¬ a ≡ b ∥₁ card>1→hasNonEqualTerm p = Prop.map (λ e → - e .fst (Fin>1→hasNonEqualTerm _ p .fst) , - e .fst (Fin>1→hasNonEqualTerm _ p .snd .fst) , - Fin>1→hasNonEqualTerm _ p .snd .snd ∘ invEq (congEquiv e)) + e .fst (Fin>1→hasNonEqualTerm _ p .fst) , + e .fst (Fin>1→hasNonEqualTerm _ p .snd .fst) , + Fin>1→hasNonEqualTerm _ p .snd .snd ∘ invEq (congEquiv e)) (∣invEquiv∣ (∣≃card∣ X)) card≡1→isContr : card X ≡ 1 → isContr (X .fst) card≡1→isContr p = Prop.rec isPropIsContr - (λ e → isOfHLevelRespectEquiv 0 (invEquiv (e ⋆ substEquiv Fin p)) isContrSumFin1) (∣≃card∣ X) + (λ e → isOfHLevelRespectEquiv 0 (invEquiv (e ⋆ substEquiv Fin p)) isContrSumFin1) (∣≃card∣ X) card≤1→isProp : card X ≤ 1 → isProp (X .fst) card≤1→isProp p = - Prop.rec isPropIsProp (λ e → isOfHLevelRespectEquiv 1 (invEquiv e) (Fin≤1→isProp (card X) p)) (∣≃card∣ X) + Prop.rec isPropIsProp (λ e → isOfHLevelRespectEquiv 1 (invEquiv e) (Fin≤1→isProp (card X) p)) (∣≃card∣ X) card≡n : card X ≡ n → ∥ X ≡ 𝔽in n ∥₁ card≡n {n = n} p = @@ -138,27 +138,27 @@ 1 (FinSet≡ X 𝟙) (isOfHLevel≡ 1 (card≤1→isProp (subst (λ a → a ≤ 1) (sym p) (≤-solver 1 1))) (isPropUnit*))) .fst - (Prop.map (λ q → q ∙ 𝔽in1≡𝟙) (card≡n p)) + (Prop.map (λ q → q ∙ 𝔽in1≡𝟙) (card≡n p)) module _ (X : FinSet ℓ) where isEmpty→card≡0 : ¬ X .fst → card X ≡ 0 isEmpty→card≡0 p = - Prop.rec (isSetℕ _ _) (λ e → sym (isEmpty→Fin≡0 _ (p ∘ invEq e))) (∣≃card∣ X) + Prop.rec (isSetℕ _ _) (λ e → sym (isEmpty→Fin≡0 _ (p ∘ invEq e))) (∣≃card∣ X) isInhab→card>0 : ∥ X .fst ∥₁ → card X > 0 - isInhab→card>0 = Prop.rec2 isProp≤ (λ p x → isInhab→Fin>0 _ (p .fst x)) (∣≃card∣ X) + isInhab→card>0 = Prop.rec2 isProp≤ (λ p x → isInhab→Fin>0 _ (p .fst x)) (∣≃card∣ X) hasNonEqualTerm→card>1 : {a b : X. fst} → ¬ a ≡ b → card X > 1 hasNonEqualTerm→card>1 {a = a} {b = b} q = - Prop.rec isProp≤ (λ p → hasNonEqualTerm→Fin>1 _ (p .fst a) (p .fst b) (q ∘ invEq (congEquiv p))) (∣≃card∣ X) + Prop.rec isProp≤ (λ p → hasNonEqualTerm→Fin>1 _ (p .fst a) (p .fst b) (q ∘ invEq (congEquiv p))) (∣≃card∣ X) isContr→card≡1 : isContr (X .fst) → card X ≡ 1 isContr→card≡1 p = cardEquiv X (_ , isFinSetUnit) ∣ isContr→≃Unit p ∣₁ isProp→card≤1 : isProp (X .fst) → card X ≤ 1 - isProp→card≤1 p = isProp→Fin≤1 (card X) (Prop.rec isPropIsProp (λ e → isOfHLevelRespectEquiv 1 e p) (∣≃card∣ X)) + isProp→card≤1 p = isProp→Fin≤1 (card X) (Prop.rec isPropIsProp (λ e → isOfHLevelRespectEquiv 1 e p) (∣≃card∣ X)) {- formulae about cardinality -} @@ -203,7 +203,7 @@ sum𝟘 : sum 𝟘 f ≡ 0 sum𝟘 = isEmpty→card≡0 (_ , isFinSetΣ 𝟘 (λ x → Fin (f x) , isFinSetFin)) - ((invEquiv (Σ-cong-equiv-fst (invEquiv 𝟘≃Empty)) ⋆ ΣEmpty _) .fst) + ((invEquiv (Σ-cong-equiv-fst (invEquiv 𝟘≃Empty)) ⋆ ΣEmpty _) .fst) prod𝟘 : prod 𝟘 f ≡ 1 prod𝟘 = @@ -216,7 +216,7 @@ sum𝟙 : sum 𝟙 f ≡ f tt* sum𝟙 = cardEquiv (_ , isFinSetΣ 𝟙 (λ x → Fin (f x) , isFinSetFin)) - (Fin (f tt*) , isFinSetFin) ∣ Σ-contractFst isContrUnit* ∣₁ + (Fin (f tt*) , isFinSetFin) ∣ Σ-contractFst isContrUnit* ∣₁ prod𝟙 : prod 𝟙 f ≡ f tt* prod𝟙 = @@ -232,7 +232,7 @@ sum⊎ = cardEquiv (_ , isFinSetΣ (_ , isFinSet⊎ X Y) (λ x → Fin (f x) , isFinSetFin)) (_ , isFinSet⊎ (_ , isFinSetΣ X (λ x → Fin (f (inl x)) , isFinSetFin)) - (_ , isFinSetΣ Y (λ y → Fin (f (inr y)) , isFinSetFin))) ∣ Σ⊎≃ ∣₁ + (_ , isFinSetΣ Y (λ y → Fin (f (inr y)) , isFinSetFin))) ∣ Σ⊎≃ ∣₁ ∙ card+ (_ , isFinSetΣ X (λ x → Fin (f (inl x)) , isFinSetFin)) (_ , isFinSetΣ Y (λ y → Fin (f (inr y)) , isFinSetFin)) @@ -240,7 +240,7 @@ prod⊎ = cardEquiv (_ , isFinSetΠ (_ , isFinSet⊎ X Y) (λ x → Fin (f x) , isFinSetFin)) (_ , isFinSet× (_ , isFinSetΠ X (λ x → Fin (f (inl x)) , isFinSetFin)) - (_ , isFinSetΠ Y (λ y → Fin (f (inr y)) , isFinSetFin))) ∣ Π⊎≃ ∣₁ + (_ , isFinSetΠ Y (λ y → Fin (f (inr y)) , isFinSetFin))) ∣ Π⊎≃ ∣₁ ∙ card× (_ , isFinSetΠ X (λ x → Fin (f (inl x)) , isFinSetFin)) (_ , isFinSetΠ Y (λ y → Fin (f (inr y)) , isFinSetFin)) @@ -274,14 +274,14 @@ sumConst : sum X f ≡ c · card X sumConst = - elimProp + elimProp (λ X → (f : X .fst → ℕ)(c : ℕ)(h : (x : X .fst) → f x ≡ c) → sum X f ≡ c · (card X)) (λ X → isPropΠ3 (λ _ _ _ → isSetℕ _ _)) (λ n f c h → sumConst𝔽in n f c h ∙ (λ i → c · card𝔽in {ℓ = ℓ} n (~ i))) X f c h prodConst : prod X f ≡ c ^ card X prodConst = - elimProp + elimProp (λ X → (f : X .fst → ℕ)(c : ℕ)(h : (x : X .fst) → f x ≡ c) → prod X f ≡ c ^ (card X)) (λ X → isPropΠ3 (λ _ _ _ → isSetℕ _ _)) (λ n f c h → prodConst𝔽in n f c h ∙ (λ i → c ^ card𝔽in {ℓ = ℓ} n (~ i))) X f c h @@ -322,7 +322,7 @@ sum≤ : sum X f ≤ sum X g sum≤ = - elimProp + elimProp (λ X → (f g : X .fst → ℕ)(h : (x : X .fst) → f x ≤ g x) → sum X f ≤ sum X g) (λ X → isPropΠ3 (λ _ _ _ → isProp≤)) sum≤𝔽in X f g h @@ -332,7 +332,7 @@ sum< : sum X f < sum X g sum< = - elimProp + elimProp (λ X → (f g : X .fst → ℕ)(t : ∥ X .fst ∥₁)(h : (x : X .fst) → f x < g x) → sum X f < sum X g) (λ X → isPropΠ4 (λ _ _ _ _ → isProp≤)) sum<𝔽in X f g t h @@ -361,7 +361,7 @@ cardΣ : card (_ , isFinSetΣ X Y) ≡ sum X (λ x → card (Y x)) cardΣ = cardEquiv (_ , isFinSetΣ X Y) (_ , isFinSetΣ X (λ x → Fin (card (Y x)) , isFinSetFin)) - (Prop.map Σ-cong-equiv-snd + (Prop.map Σ-cong-equiv-snd (choice X (λ x → Y x .fst ≃ Fin (card (Y x))) (λ x → ∣≃card∣ (Y x)))) cardΠ : card (_ , isFinSetΠ X Y) ≡ prod X (λ x → card (Y x)) @@ -472,7 +472,7 @@ (λ y → isProp→card≤1 (_ , isFinSetFiber X Y f y) (isEmbedding→hasPropFibers p y))) - card↠Inequality' : isSurjection f → card X ≥ card Y + card↠Inequality' : isSurjection f → card X ≥ card Y card↠Inequality' p = subst2 (_≥_) (sym (sumCardFiber X Y f)) @@ -483,7 +483,7 @@ card↪Inequality : ∥ X .fst ↪ Y .fst ∥₁ → card X ≤ card Y card↪Inequality = Prop.rec isProp≤ (λ (f , p) → card↪Inequality' f p) - card↠Inequality : ∥ X .fst ↠ Y .fst ∥₁ → card X ≥ card Y + card↠Inequality : ∥ X .fst ↠ Y .fst ∥₁ → card X ≥ card Y card↠Inequality = Prop.rec isProp≤ (λ (f , p) → card↠Inequality' f p) -- maximal value of numerical functions @@ -547,7 +547,7 @@ ∃Max𝔽in : (n : ℕ)(f : 𝔽in {ℓ} n .fst → ℕ)(x : ∥ 𝔽in {ℓ} n .fst ∥₁) → ∃Max _ f ∃Max𝔽in {ℓ = ℓ} 0 _ x = Empty.rec (<→≢ (isInhab→card>0 (𝔽in 0) x) (card𝟘 {ℓ = ℓ})) ∃Max𝔽in 1 f _ = - subst (λ X → (f : X .fst → ℕ) → ∃Max _ f) (sym 𝔽in1≡𝟙) ∃Max𝟙 f + subst (λ X → (f : X .fst → ℕ) → ∃Max _ f) (sym 𝔽in1≡𝟙) ∃Max𝟙 f ∃Max𝔽in (suc (suc n)) f _ = ∃Max⊎ (𝟙 .fst) (𝔽in (suc n) .fst) f (∃Max𝟙 (f ∘ inl)) (∃Max𝔽in (suc n) (f ∘ inr) ∣ * {n = n} ∣₁) @@ -558,7 +558,7 @@ ∃MaxFinSet : ∃Max _ f ∃MaxFinSet = - elimProp + elimProp (λ X → (f : X .fst → ℕ)(x : ∥ X .fst ∥₁) → ∃Max _ f) (λ X → isPropΠ2 (λ _ _ → isPropPropTrunc)) ∃Max𝔽in X f x @@ -578,7 +578,7 @@ Iso-∥FinSet∥₂-ℕ {ℓ = ℓ} .leftInv = Set.elim {B = λ X → ∣ 𝔽in (Set.rec isSetℕ card X) ∣₂ ≡ X} (λ X → isSetPathImplicit) - (elimProp (λ X → ∣ 𝔽in (card X) ∣₂ ≡ ∣ X ∣₂) (λ X → squash₂ _ _) + (elimProp (λ X → ∣ 𝔽in (card X) ∣₂ ≡ ∣ X ∣₂) (λ X → squash₂ _ _) (λ n i → ∣ 𝔽in (card𝔽in {ℓ = ℓ} n i) ∣₂)) -- this is the definition of natural numbers you learned from school @@ -606,13 +606,13 @@ card-case P {n = suc (suc n)} p = Empty.rec (¬-<-zero (pred-≤-pred (subst (λ a → a ≤ 1) p (isProp→card≤1 (P .fst) (P .snd))))) -isSurjectionBool→FinProp : isSurjection (Bool→FinProp {ℓ = ℓ}) +isSurjectionBool→FinProp : isSurjection (Bool→FinProp {ℓ = ℓ}) isSurjectionBool→FinProp P = ∣ card-case P refl ∣₁ FinProp≃Bool : FinProp ℓ ≃ Bool FinProp≃Bool = invEquiv (Bool→FinProp , - isEmbedding×isSurjection→isEquiv (isEmbeddingBool→FinProp , isSurjectionBool→FinProp)) + isEmbedding×isSurjection→isEquiv (isEmbeddingBool→FinProp , isSurjectionBool→FinProp)) isFinSetFinProp : isFinSet (FinProp ℓ) isFinSetFinProp = EquivPresIsFinSet (invEquiv FinProp≃Bool) isFinSetBool @@ -627,9 +627,9 @@ isFinSet≃Eff' (yes p) = factorial (card Y) , Prop.elim2 (λ _ _ → isPropPropTrunc {A = _ ≃ Fin _}) (λ p1 p2 - → ∣ equivComp (p1 ⋆ pathToEquiv (cong Fin p) ⋆ SumFin≃Fin _) (p2 ⋆ SumFin≃Fin _) + → ∣ equivComp (p1 ⋆ pathToEquiv (cong Fin p) ⋆ SumFin≃Fin _) (p2 ⋆ SumFin≃Fin _) ⋆ lehmerEquiv ⋆ lehmerFinEquiv - ⋆ invEquiv (SumFin≃Fin _) ∣₁) + ⋆ invEquiv (SumFin≃Fin _) ∣₁) (∣≃card∣ X) (∣≃card∣ Y) isFinSet≃Eff' (no ¬p) = 0 , ∣ uninhabEquiv (¬p ∘ cardEquiv X Y ∘ ∣_∣₁) (idfun _) ∣₁ diff --git a/Cubical.Data.FinSet.Constructors.html b/Cubical.Data.FinSet.Constructors.html index 85e67174c8..2e73accbc8 100644 --- a/Cubical.Data.FinSet.Constructors.html +++ b/Cubical.Data.FinSet.Constructors.html @@ -42,20 +42,20 @@ (X : Type ℓ)(p : isFinOrd X) where isFinOrd∥∥ : isFinOrd ∥ X ∥₁ - isFinOrd∥∥ = _ , propTrunc≃ (p .snd) ⋆ SumFin∥∥≃ _ + isFinOrd∥∥ = _ , propTrunc≃ (p .snd) ⋆ SumFin∥∥≃ _ isFinOrd≃ : isFinOrd (X ≃ X) - isFinOrd≃ = _ , equivComp (p .snd) (p .snd) ⋆ SumFin≃≃ _ + isFinOrd≃ = _ , equivComp (p .snd) (p .snd) ⋆ SumFin≃≃ _ module _ (X : Type ℓ )(p : isFinOrd X) (Y : Type ℓ')(q : isFinOrd Y) where isFinOrd⊎ : isFinOrd (X ⊎ Y) - isFinOrd⊎ = _ , ⊎-equiv (p .snd) (q .snd) ⋆ SumFin⊎≃ _ _ + isFinOrd⊎ = _ , ⊎-equiv (p .snd) (q .snd) ⋆ SumFin⊎≃ _ _ isFinOrd× : isFinOrd (X × Y) - isFinOrd× = _ , Σ-cong-equiv (p .snd) (λ _ → q .snd) ⋆ SumFin×≃ _ _ + isFinOrd× = _ , Σ-cong-equiv (p .snd) (λ _ → q .snd) ⋆ SumFin×≃ _ _ module _ (X : Type ℓ )(p : isFinOrd X) @@ -69,15 +69,15 @@ isFinOrdΣ : isFinOrd (Σ X Y) isFinOrdΣ = _ , - Σ-cong-equiv {B' = λ x → Y (invEq e x)} e (transpFamily p) - ⋆ Σ-cong-equiv-snd (λ x → q (invEq e x) .snd) - ⋆ SumFinΣ≃ _ _ + Σ-cong-equiv {B' = λ x → Y (invEq e x)} e (transpFamily p) + ⋆ Σ-cong-equiv-snd (λ x → q (invEq e x) .snd) + ⋆ SumFinΣ≃ _ _ isFinOrdΠ : isFinOrd ((x : X) → Y x) isFinOrdΠ = _ , equivΠ {B' = λ x → Y (invEq e x)} e (transpFamily p) ⋆ equivΠCod (λ x → q (invEq e x) .snd) - ⋆ SumFinΠ≃ _ _ + ⋆ SumFinΠ≃ _ _ -- closedness under several type constructors @@ -197,7 +197,7 @@ isFinSetΠ2 X (λ _ → X) (λ a b → _ , isFinSetIsEquiv (_ , isFinSet≡ X a b) (_ , isFinSet≡ Y (f a) (f b)) (cong f)) - isFinSetIsSurjection : isFinSet (isSurjection f) + isFinSetIsSurjection : isFinSet (isSurjection f) isFinSetIsSurjection = isFinSetΠ Y (λ y → _ , isFinSet∥∥ (_ , isFinSetFiber X Y f y)) @@ -208,7 +208,7 @@ isFinSet↪ : isFinSet (X .fst ↪ Y .fst) isFinSet↪ = isFinSetΣ (_ , isFinSet→ X Y) (λ f → _ , isFinSetIsEmbedding X Y f) - isFinSet↠ : isFinSet (X .fst ↠ Y .fst) + isFinSet↠ : isFinSet (X .fst ↠ Y .fst) isFinSet↠ = isFinSetΣ (_ , isFinSet→ X Y) (λ f → _ , isFinSetIsSurjection X Y f) -- a criterion of being finite set diff --git a/Cubical.Data.FinSet.DecidablePredicate.html b/Cubical.Data.FinSet.DecidablePredicate.html index 852f62c293..96886bfb17 100644 --- a/Cubical.Data.FinSet.DecidablePredicate.html +++ b/Cubical.Data.FinSet.DecidablePredicate.html @@ -39,10 +39,10 @@ (X : Type ℓ)(p : isFinOrd X) where isDecProp¬' : isDecProp (¬ X) - isDecProp¬' = _ , invEquiv (preCompEquiv (p .snd)) ⋆ SumFin¬ _ + isDecProp¬' = _ , invEquiv (preCompEquiv (p .snd)) ⋆ SumFin¬ _ isDecProp∥∥' : isDecProp ∥ X ∥₁ - isDecProp∥∥' = _ , propTrunc≃ (p .snd) ⋆ SumFin∥∥DecProp _ + isDecProp∥∥' = _ , propTrunc≃ (p .snd) ⋆ SumFin∥∥DecProp _ module _ (X : Type ℓ )(p : isFinOrd X) @@ -54,22 +54,22 @@ isFinOrdSub : isFinOrd (Σ X P) isFinOrdSub = _ , - Σ-cong-equiv {B' = λ x → P (invEq e x)} e (transpFamily p) - ⋆ Σ-cong-equiv-snd (λ x → dec (invEq e x) .snd) - ⋆ SumFinSub≃ _ (fst ∘ dec ∘ invEq e) + Σ-cong-equiv {B' = λ x → P (invEq e x)} e (transpFamily p) + ⋆ Σ-cong-equiv-snd (λ x → dec (invEq e x) .snd) + ⋆ SumFinSub≃ _ (fst ∘ dec ∘ invEq e) isDecProp∃' : isDecProp ∥ Σ X P ∥₁ isDecProp∃' = _ , Prop.propTrunc≃ ( - Σ-cong-equiv {B' = λ x → P (invEq e x)} e (transpFamily p) - ⋆ Σ-cong-equiv-snd (λ x → dec (invEq e x) .snd)) - ⋆ SumFin∃≃ _ (fst ∘ dec ∘ invEq e) + Σ-cong-equiv {B' = λ x → P (invEq e x)} e (transpFamily p) + ⋆ Σ-cong-equiv-snd (λ x → dec (invEq e x) .snd)) + ⋆ SumFin∃≃ _ (fst ∘ dec ∘ invEq e) isDecProp∀' : isDecProp ((x : X) → P x) isDecProp∀' = _ , equivΠ {B' = λ x → P (invEq e x)} e (transpFamily p) ⋆ equivΠCod (λ x → dec (invEq e x) .snd) - ⋆ SumFin∀≃ _ (fst ∘ dec ∘ invEq e) + ⋆ SumFin∀≃ _ (fst ∘ dec ∘ invEq e) module _ (X : Type ℓ )(p : isFinOrd X) @@ -79,8 +79,8 @@ e = p .snd isDecProp≡' : isDecProp (a ≡ b) - isDecProp≡' .fst = SumFin≡ _ (e .fst a) (e .fst b) - isDecProp≡' .snd = congEquiv e ⋆ SumFin≡≃ _ _ _ + isDecProp≡' .fst = SumFin≡ _ (e .fst a) (e .fst b) + isDecProp≡' .snd = congEquiv e ⋆ SumFin≡≃ _ _ _ module _ (X : FinSet ℓ) @@ -129,7 +129,7 @@ isDecProp× : isDecProp (P .fst × Q .fst) isDecProp× .fst = P .snd .fst and Q .snd .fst - isDecProp× .snd = Σ-cong-equiv (P .snd .snd) (λ _ → Q .snd .snd) ⋆ Bool→Type×≃ _ _ + isDecProp× .snd = Σ-cong-equiv (P .snd .snd) (λ _ → Q .snd .snd) ⋆ Bool→Type×≃ _ _ module _ (X : FinSet ℓ) where diff --git a/Cubical.Data.FinSet.FiniteChoice.html b/Cubical.Data.FinSet.FiniteChoice.html index 4ae7c00504..8942ba0b70 100644 --- a/Cubical.Data.FinSet.FiniteChoice.html +++ b/Cubical.Data.FinSet.FiniteChoice.html @@ -37,12 +37,12 @@ ⋆ invEquiv (propTruncIdempotent≃ isPropUnit*) ⋆ propTrunc≃ (invEquiv (isContr→≃Unit* (isContrΠ⊥ {A = Y}))) choice≃Fin {n = suc n} Y = - Π⊎≃ - ⋆ Σ-cong-equiv-fst (ΠUnit (λ x → ∥ Y (inl x) ∥₁)) - ⋆ Σ-cong-equiv-snd (λ _ → choice≃Fin {n = n} (λ x → Y (inr x))) - ⋆ Σ-cong-equiv-fst (propTrunc≃ (invEquiv (ΠUnit (λ x → Y (inl x))))) + Π⊎≃ + ⋆ Σ-cong-equiv-fst (ΠUnit (λ x → ∥ Y (inl x) ∥₁)) + ⋆ Σ-cong-equiv-snd (λ _ → choice≃Fin {n = n} (λ x → Y (inr x))) + ⋆ Σ-cong-equiv-fst (propTrunc≃ (invEquiv (ΠUnit (λ x → Y (inl x))))) ⋆ ∥∥-×-≃ - ⋆ propTrunc≃ (invEquiv (Π⊎≃ {E = Y})) + ⋆ propTrunc≃ (invEquiv (Π⊎≃ {E = Y})) module _ (X : Type ℓ)(p : isFinOrd X) diff --git a/Cubical.Data.FinSet.Induction.html b/Cubical.Data.FinSet.Induction.html index f15f0fa64e..93158b02ad 100644 --- a/Cubical.Data.FinSet.Induction.html +++ b/Cubical.Data.FinSet.Induction.html @@ -65,70 +65,70 @@ 𝔽in≃Fin : (n : ℕ) → 𝔽in n .fst ≃ Fin n 𝔽in≃Fin 0 = 𝟘≃Empty - 𝔽in≃Fin (suc n) = ⊎-equiv 𝟙≃Unit (𝔽in≃Fin n) + 𝔽in≃Fin (suc n) = ⊎-equiv 𝟙≃Unit (𝔽in≃Fin n) 𝔽in≃Finℕ : (n : ℕ) → 𝔽in n .fst ≃ Finℕ n - 𝔽in≃Finℕ n = 𝔽in≃Fin n ⋆ SumFin≃Fin n + 𝔽in≃Finℕ n = 𝔽in≃Fin n ⋆ SumFin≃Fin n -- 𝔽in preserves addition 𝟘+X≡X : {X : FinSet ℓ} → 𝟘 + X ≡ X - 𝟘+X≡X {X = X} i .fst = ua (⊎-swap-≃ ⋆ ⊎-equiv (idEquiv (X .fst)) 𝟘≃Empty ⋆ ⊎-⊥-≃) i - 𝟘+X≡X {X = X} i .snd = - isProp→PathP {B = λ i → isFinSet (𝟘+X≡X {X = X} i .fst)} - (λ _ → isPropIsFinSet) ((𝟘 + X) .snd) (X .snd) i - - 𝔽in1≡𝟙 : 𝔽in 1 ≡ 𝟙 - 𝔽in1≡𝟙 i .fst = ua (⊎-equiv (idEquiv (𝟙 .fst)) 𝟘≃Empty ⋆ ⊎-⊥-≃) i - 𝔽in1≡𝟙 i .snd = - isProp→PathP {B = λ i → isFinSet (𝔽in1≡𝟙 i .fst)} - (λ _ → isPropIsFinSet) (𝔽in 1 .snd) (𝟙 .snd) i - - 𝔽in+ : (m n : ℕ) → 𝔽in m + 𝔽in n ≡ 𝔽in (m +ℕ n) - 𝔽in+ 0 n = 𝟘+X≡X - 𝔽in+ (suc m) n i .fst = (ua (⊎-assoc-≃) ∙ (λ i → (𝟙 + 𝔽in+ m n i) .fst)) i - 𝔽in+ (suc m) n i .snd = - isProp→PathP {B = λ i → isFinSet (𝔽in+ (suc m) n i .fst)} - (λ _ → isPropIsFinSet) ((𝔽in (suc m) + 𝔽in n) .snd) (𝔽in (suc m +ℕ n) .snd) i - --- every finite sets are merely equal to some 𝔽in - -∣≡𝔽in∣ : (X : FinSet ℓ) → ∥ Σ[ n ∈ ℕ ] X ≡ 𝔽in n ∥₁ -∣≡𝔽in∣ X = Prop.map (λ (n , p) → n , path X (n , p)) (isFinSet→isFinSet' (X .snd)) - where - path : (X : FinSet ℓ) → ((n , _) : isFinOrd (X .fst)) → X ≡ 𝔽in n - path X (n , p) i .fst = ua (p ⋆ invEquiv (𝔽in≃Fin n)) i - path X (n , p) i .snd = - isProp→PathP {B = λ i → isFinSet (path X (n , p) i .fst)} - (λ _ → isPropIsFinSet) (X .snd) (𝔽in n .snd) i - --- the eliminators - -module _ - (P : FinSet ℓ → Type ℓ') - (h : (X : FinSet ℓ) → isProp (P X)) where - - module _ - (p : (n : ℕ) → P (𝔽in n)) where - - elimProp : (X : FinSet ℓ) → P X - elimProp X = Prop.rec (h X) (λ (n , q) → transport (λ i → P (q (~ i))) (p n)) (∣≡𝔽in∣ X) - - module _ - (p0 : P 𝟘) - (p1 : {X : FinSet ℓ} → P X → P (𝟙 + X)) where - - elimProp𝔽in : (n : ℕ) → P (𝔽in n) - elimProp𝔽in 0 = p0 - elimProp𝔽in (suc n) = p1 (elimProp𝔽in n) - - elimProp𝟙+ : (X : FinSet ℓ) → P X - elimProp𝟙+ = elimProp elimProp𝔽in - - module _ - (p0 : P 𝟘)(p1 : P 𝟙) - (p+ : {X Y : FinSet ℓ} → P X → P Y → P (X + Y)) where - - elimProp+ : (X : FinSet ℓ) → P X - elimProp+ = elimProp𝟙+ p0 (λ p → p+ p1 p) + 𝟘+X≡X {X = X} i .fst = ua (⊎-swap-≃ ⋆ ⊎-equiv (idEquiv (X .fst)) 𝟘≃Empty ⋆ ⊎-IdR-⊥-≃) i + 𝟘+X≡X {X = X} i .snd = + isProp→PathP {B = λ i → isFinSet (𝟘+X≡X {X = X} i .fst)} + (λ _ → isPropIsFinSet) ((𝟘 + X) .snd) (X .snd) i + + 𝔽in1≡𝟙 : 𝔽in 1 ≡ 𝟙 + 𝔽in1≡𝟙 i .fst = ua (⊎-equiv (idEquiv (𝟙 .fst)) 𝟘≃Empty ⋆ ⊎-IdR-⊥-≃) i + 𝔽in1≡𝟙 i .snd = + isProp→PathP {B = λ i → isFinSet (𝔽in1≡𝟙 i .fst)} + (λ _ → isPropIsFinSet) (𝔽in 1 .snd) (𝟙 .snd) i + + 𝔽in+ : (m n : ℕ) → 𝔽in m + 𝔽in n ≡ 𝔽in (m +ℕ n) + 𝔽in+ 0 n = 𝟘+X≡X + 𝔽in+ (suc m) n i .fst = (ua (⊎-assoc-≃) ∙ (λ i → (𝟙 + 𝔽in+ m n i) .fst)) i + 𝔽in+ (suc m) n i .snd = + isProp→PathP {B = λ i → isFinSet (𝔽in+ (suc m) n i .fst)} + (λ _ → isPropIsFinSet) ((𝔽in (suc m) + 𝔽in n) .snd) (𝔽in (suc m +ℕ n) .snd) i + +-- every finite sets are merely equal to some 𝔽in + +∣≡𝔽in∣ : (X : FinSet ℓ) → ∥ Σ[ n ∈ ℕ ] X ≡ 𝔽in n ∥₁ +∣≡𝔽in∣ X = Prop.map (λ (n , p) → n , path X (n , p)) (isFinSet→isFinSet' (X .snd)) + where + path : (X : FinSet ℓ) → ((n , _) : isFinOrd (X .fst)) → X ≡ 𝔽in n + path X (n , p) i .fst = ua (p ⋆ invEquiv (𝔽in≃Fin n)) i + path X (n , p) i .snd = + isProp→PathP {B = λ i → isFinSet (path X (n , p) i .fst)} + (λ _ → isPropIsFinSet) (X .snd) (𝔽in n .snd) i + +-- the eliminators + +module _ + (P : FinSet ℓ → Type ℓ') + (h : (X : FinSet ℓ) → isProp (P X)) where + + module _ + (p : (n : ℕ) → P (𝔽in n)) where + + elimProp : (X : FinSet ℓ) → P X + elimProp X = Prop.rec (h X) (λ (n , q) → transport (λ i → P (q (~ i))) (p n)) (∣≡𝔽in∣ X) + + module _ + (p0 : P 𝟘) + (p1 : {X : FinSet ℓ} → P X → P (𝟙 + X)) where + + elimProp𝔽in : (n : ℕ) → P (𝔽in n) + elimProp𝔽in 0 = p0 + elimProp𝔽in (suc n) = p1 (elimProp𝔽in n) + + elimProp𝟙+ : (X : FinSet ℓ) → P X + elimProp𝟙+ = elimProp elimProp𝔽in + + module _ + (p0 : P 𝟘)(p1 : P 𝟙) + (p+ : {X Y : FinSet ℓ} → P X → P Y → P (X + Y)) where + + elimProp+ : (X : FinSet ℓ) → P X + elimProp+ = elimProp𝟙+ p0 (λ p → p+ p1 p) \ No newline at end of file diff --git a/Cubical.Data.FinSet.Properties.html b/Cubical.Data.FinSet.Properties.html index 50f3c41df4..8a7cf072d5 100644 --- a/Cubical.Data.FinSet.Properties.html +++ b/Cubical.Data.FinSet.Properties.html @@ -57,16 +57,16 @@ isFinSetFin = _ , ∣ idEquiv _ ∣₁ isFinSetUnit : isFinSet Unit -isFinSetUnit = 1 , ∣ invEquiv Fin1≃Unit ∣₁ +isFinSetUnit = 1 , ∣ invEquiv Fin1≃Unit ∣₁ isFinSetBool : isFinSet Bool -isFinSetBool = 2 , ∣ invEquiv SumFin2≃Bool ∣₁ +isFinSetBool = 2 , ∣ invEquiv SumFin2≃Bool ∣₁ isFinSet→Discrete : isFinSet A → Discrete A isFinSet→Discrete h = Prop.rec isPropDiscrete (λ p → EquivPresDiscrete (invEquiv p) discreteFin) (h .snd) isContr→isFinSet : isContr A → isFinSet A -isContr→isFinSet h = 1 , ∣ isContr→≃Unit* h ⋆ invEquiv Unit≃Unit* ⋆ invEquiv Fin1≃Unit ∣₁ +isContr→isFinSet h = 1 , ∣ isContr→≃Unit* h ⋆ invEquiv Unit≃Unit* ⋆ invEquiv Fin1≃Unit ∣₁ isDecProp→isFinSet : isProp A → Dec A → isFinSet A isDecProp→isFinSet h (yes p) = isContr→isFinSet (inhProp→isContr p h) @@ -78,7 +78,7 @@ isFinSet→Dec∥∥ : isFinSet A → Dec ∥ A ∥₁ isFinSet→Dec∥∥ h = Prop.rec (isPropDec isPropPropTrunc) - (λ p → EquivPresDec (propTrunc≃ (invEquiv p)) (Dec∥Fin∥ _)) (h .snd) + (λ p → EquivPresDec (propTrunc≃ (invEquiv p)) (Dec∥Fin∥ _)) (h .snd) isFinProp→Dec : isFinSet A → isProp A → Dec A isFinProp→Dec p h = subst Dec (propTruncIdempotent h) (isFinSet→Dec∥∥ p) diff --git a/Cubical.Data.FinSet.Quotients.html b/Cubical.Data.FinSet.Quotients.html index 1285cb26ae..415f42d9cc 100644 --- a/Cubical.Data.FinSet.Quotients.html +++ b/Cubical.Data.FinSet.Quotients.html @@ -81,7 +81,7 @@ e = p .snd isFinOrdℙEff : isFinOrd (ℙEff X) - isFinOrdℙEff = _ , preCompEquiv (invEquiv e) ⋆ SumFinℙ≃ _ + isFinOrdℙEff = _ , preCompEquiv (invEquiv e) ⋆ SumFinℙ≃ _ module _ (X : FinSet ℓ) where @@ -128,17 +128,17 @@ _∥Eff_ = Σ[ f ∈ ℙEff (X .fst) ] isEqClassEff f ∥Eff≃∥Dec : _∥Eff_ ≃ _∥Dec_ (X .fst) R (λ x x' → isDecProp→Dec (dec x x')) - ∥Eff≃∥Dec = Σ-cong-equiv (ℙEff≃ℙDec (X .fst)) isEqClassEff→isEqClass + ∥Eff≃∥Dec = Σ-cong-equiv (ℙEff≃ℙDec (X .fst)) isEqClassEff→isEqClass isFinSet∥Eff : isFinSet _∥Eff_ isFinSet∥Eff = isFinSetSub (_ , isFinSetℙEff X) (λ _ → _ , isDecPropIsEqClassEff) -open BinaryRelation +open BinaryRelation module _ (X : FinSet ℓ) (R : X .fst → X .fst → Type ℓ') - (h : isEquivRel R) + (h : isEquivRel R) (dec : (x x' : X .fst) → isDecProp (R x x')) where isFinSetQuot : isFinSet (X .fst / R) diff --git a/Cubical.Data.FinType.FiniteStructure.html b/Cubical.Data.FinType.FiniteStructure.html index ecdc262cee..4cecf18ed1 100644 --- a/Cubical.Data.FinType.FiniteStructure.html +++ b/Cubical.Data.FinType.FiniteStructure.html @@ -50,13 +50,13 @@ FinSetWithStrOfCard {ℓ = ℓ} S n = Σ[ X ∈ FinSetOfCard ℓ n ] S (X .fst) .fst FinSetOfCard≡ : (X Y : FinSetOfCard ℓ n) → (X .fst ≡ Y .fst) ≃ (X ≡ Y) -FinSetOfCard≡ _ _ = Σ≡PropEquiv (λ _ → isSetℕ _ _) +FinSetOfCard≡ _ _ = Σ≡PropEquiv (λ _ → isSetℕ _ _) open Iso ∥FinSetOfCard∥₂≡ : (X Y : FinSetOfCard ℓ n) → ∥ X .fst ≡ Y .fst ∥₁ → ∣ X ∣₂ ≡ ∣ Y ∣₂ ∥FinSetOfCard∥₂≡ _ _ = - Prop.rec (squash₂ _ _) (λ p → PathIdTrunc₀Iso .inv ∣ FinSetOfCard≡ _ _ .fst p ∣₁) + Prop.rec (squash₂ _ _) (λ p → PathIdTrunc₀Iso .inv ∣ FinSetOfCard≡ _ _ .fst p ∣₁) isPathConnectedFinSetOfCard : isContr ∥ FinSetOfCard ℓ n ∥₂ isPathConnectedFinSetOfCard {n = n} .fst = ∣ 𝔽in n , card𝔽in n ∣₂ diff --git a/Cubical.Data.FinType.Properties.html b/Cubical.Data.FinType.Properties.html index ce8919dd34..ba3c153f73 100644 --- a/Cubical.Data.FinType.Properties.html +++ b/Cubical.Data.FinType.Properties.html @@ -29,13 +29,13 @@ Y : Type ℓ' EquivPresIsFinType : (n : ℕ) → X ≃ Y → isFinType n X → isFinType n Y -EquivPresIsFinType 0 e = EquivPresIsFinSet (isoToEquiv (setTruncIso (equivToIso e))) +EquivPresIsFinType 0 e = EquivPresIsFinSet (isoToEquiv (setTruncIso (equivToIso e))) EquivPresIsFinType (suc n) e (p , q) .fst = EquivPresIsFinType 0 e p EquivPresIsFinType (suc n) e (p , q) .snd a b = EquivPresIsFinType n (invEquiv (congEquiv (invEquiv e))) (q _ _) isFinSet→isFinType : (n : ℕ) → isFinSet X → isFinType n X -isFinSet→isFinType 0 p = EquivPresIsFinSet (invEquiv (setTruncIdempotent≃ (isFinSet→isSet p))) p +isFinSet→isFinType 0 p = EquivPresIsFinSet (invEquiv (setTruncIdempotent≃ (isFinSet→isSet p))) p isFinSet→isFinType (suc n) p .fst = isFinSet→isFinType 0 p isFinSet→isFinType (suc n) p .snd a b = isFinSet→isFinType n (isFinSet≡ (_ , p) _ _) diff --git a/Cubical.Data.FinType.Sigma.html b/Cubical.Data.FinType.Sigma.html index 7af789e23d..a575c9ddd6 100644 --- a/Cubical.Data.FinType.Sigma.html +++ b/Cubical.Data.FinType.Sigma.html @@ -40,7 +40,7 @@ private ∥f∥₂ : ∥ X ∥₂ → ∥ Y ∥₂ - ∥f∥₂ = Set.map f + ∥f∥₂ = Set.map f module _ (y : Y) where @@ -67,7 +67,7 @@ isFinType0Σ : isFinType 0 (Σ (X .fst) (λ x → Y x .fst)) isFinType0Σ = isFinType0Total (Σ (X .fst) (λ x → Y x .fst)) (X .fst) (X .snd) fst - (λ x → EquivPresIsFinType 0 (fiberProjEquiv _ _ x) (Y x .snd)) + (λ x → EquivPresIsFinType 0 (fiberProjEquiv _ _ x) (Y x .snd)) -- the main result @@ -80,6 +80,6 @@ isFinType0Σ (_ , isFinTypeSuc→isFinType1 {n = suc n} (X .snd)) (λ x → _ , isFinType→isFinType0 {n = suc n} (Y x .snd)) isFinTypeΣ {n = suc n} X Y .snd a b = - EquivPresIsFinType n (ΣPathTransport≃PathΣ a b) + EquivPresIsFinType n (ΣPathTransport≃PathΣ a b) (isFinTypeΣ {n = n} (_ , X .snd .snd _ _) (λ _ → _ , Y _ .snd .snd _ _)) \ No newline at end of file diff --git a/Cubical.Data.Int.Divisibility.html b/Cubical.Data.Int.Divisibility.html index 995efddf05..c73bf1883e 100644 --- a/Cubical.Data.Int.Divisibility.html +++ b/Cubical.Data.Int.Divisibility.html @@ -77,9 +77,9 @@ isProp∣' : isProp (m ∣' n) isProp∣' {m = pos 0} {n = n} = isSetℤ 0 n isProp∣' {m = pos (suc m)} {n = n} p q = - Σ≡Prop (λ _ → isSetℤ _ _) (·rCancel (pos (suc m)) _ _ (p .snd ∙ sym (q .snd)) (λ r → snotz (injPos r))) + Σ≡Prop (λ _ → isSetℤ _ _) (·rCancel (pos (suc m)) _ _ (p .snd ∙ sym (q .snd)) (λ r → snotz (injPos r))) isProp∣' {m = negsuc m} {n = n} p q = - Σ≡Prop (λ _ → isSetℤ _ _) (·rCancel (negsuc m) _ _ (p .snd ∙ sym (q .snd)) (negsucNotpos _ 0)) + Σ≡Prop (λ _ → isSetℤ _ _) (·rCancel (negsuc m) _ _ (p .snd ∙ sym (q .snd)) (negsucNotpos _ 0)) ∣→∣' : (m n : ℤ) → m ∣ n → m ∣' n ∣→∣' (pos 0) n ∣ c , p ∣₁ = ·Comm 0 c ∙ p diff --git a/Cubical.Data.Int.MoreInts.DiffInt.Properties.html b/Cubical.Data.Int.MoreInts.DiffInt.Properties.html index 802dfc477a..517a346152 100644 --- a/Cubical.Data.Int.MoreInts.DiffInt.Properties.html +++ b/Cubical.Data.Int.MoreInts.DiffInt.Properties.html @@ -19,18 +19,18 @@ open import Cubical.HITs.PropositionalTruncation as PropositionalTruncation open import Cubical.Foundations.Isomorphism -open BinaryRelation +open BinaryRelation -relIsEquiv : isEquivRel rel -relIsEquiv = equivRel {A = ℕ × ℕ} relIsRefl relIsSym relIsTrans +relIsEquiv : isEquivRel rel +relIsEquiv = equivRel {A = ℕ × ℕ} relIsRefl relIsSym relIsTrans where - relIsRefl : isRefl rel + relIsRefl : isRefl rel relIsRefl (a0 , a1) = refl - relIsSym : isSym rel + relIsSym : isSym rel relIsSym (a0 , a1) (b0 , b1) p = sym p - relIsTrans : isTrans rel + relIsTrans : isTrans rel relIsTrans (a0 , a1) (b0 , b1) (c0 , c1) p0 p1 = inj-m+ {m = (b0 +ℕ b1)} ((b0 +ℕ b1) +ℕ (a0 +ℕ c1) ≡⟨ ℕ.+-assoc (b0 +ℕ b1) a0 c1 ⟩ ((b0 +ℕ b1) +ℕ a0) +ℕ c1 ≡[ i ]⟨ ℕ.+-comm b0 b1 i +ℕ a0 +ℕ c1 ⟩ diff --git a/Cubical.Data.Int.Order.html b/Cubical.Data.Int.Order.html index d38c571ae3..2f24180234 100644 --- a/Cubical.Data.Int.Order.html +++ b/Cubical.Data.Int.Order.html @@ -43,7 +43,7 @@ isProp≤ : isProp (m ≤ n) isProp≤ {m} {n} (k , p) (l , q) - = Σ≡Prop witness-prop lemma + = Σ≡Prop witness-prop lemma where lemma : k ≡ l lemma = injPos (inj-z+ (p ∙ sym q)) diff --git a/Cubical.Data.Nat.Divisibility.html b/Cubical.Data.Nat.Divisibility.html index ac359ccd39..fd0b3f12b8 100644 --- a/Cubical.Data.Nat.Divisibility.html +++ b/Cubical.Data.Nat.Divisibility.html @@ -42,7 +42,7 @@ isProp∣' : isProp (m ∣' n) isProp∣' {zero} {n} = isSetℕ _ _ isProp∣' {suc m} {n} (c₁ , p₁) (c₂ , p₂) = - Σ≡Prop (λ _ → isSetℕ _ _) (inj-·sm {c₁} {m} {c₂} (p₁ ∙ sym p₂)) + Σ≡Prop (λ _ → isSetℕ _ _) (inj-·sm {c₁} {m} {c₂} (p₁ ∙ sym p₂)) ∣≃∣' : (m ∣ n) ≃ (m ∣' n) ∣≃∣' {zero} = propBiimpl→Equiv isProp∣ isProp∣' diff --git a/Cubical.Data.Nat.GCD.html b/Cubical.Data.Nat.GCD.html index 592004cdc0..a105150598 100644 --- a/Cubical.Data.Nat.GCD.html +++ b/Cubical.Data.Nat.GCD.html @@ -51,7 +51,7 @@ isPropGCD : isProp (GCD m n) isPropGCD (d , dCD , gr) (d' , d'CD , gr') = - Σ≡Prop (λ _ → isPropIsGCD) (antisym∣ (gr' d dCD) (gr d' d'CD)) + Σ≡Prop (λ _ → isPropIsGCD) (antisym∣ (gr' d dCD) (gr d' d'CD)) symGCD : isGCD m n d → isGCD n m d diff --git a/Cubical.Data.Nat.Order.html b/Cubical.Data.Nat.Order.html index 0cb3b3891f..387bc1a37d 100644 --- a/Cubical.Data.Nat.Order.html +++ b/Cubical.Data.Nat.Order.html @@ -51,7 +51,7 @@ isProp≤ : isProp (m ≤ n) isProp≤ {m} {n} (k , p) (l , q) - = Σ≡Prop witness-prop lemma + = Σ≡Prop witness-prop lemma where lemma : k ≡ l lemma = inj-+m (p ∙ (sym q)) @@ -373,7 +373,7 @@ = case dichotomy b n return (λ d → d ≡ inr (m , p)) of λ { (inl n<b) → ⊥.rec (<-asym n<b (m , +-comm m b ∙ sym p)) ; (inr (m' , q)) - → cong inr (Σ≡Prop (λ x → isSetℕ n (b + x)) (inj-m+ {m = b} (sym q ∙ p))) + → cong inr (Σ≡Prop (λ x → isSetℕ n (b + x)) (inj-m+ {m = b} (sym q ∙ p))) } b = suc b₀ diff --git a/Cubical.Data.Prod.Properties.html b/Cubical.Data.Prod.Properties.html index 0d4cb6ac5c..2c4df92672 100644 --- a/Cubical.Data.Prod.Properties.html +++ b/Cubical.Data.Prod.Properties.html @@ -5,7 +5,7 @@ open import Cubical.Core.Everything open import Cubical.Data.Prod.Base -open import Cubical.Data.Sigma renaming (_×_ to _×Σ_) hiding (prodIso ; toProdIso ; curryIso) +open import Cubical.Data.Sigma renaming (_×_ to _×Σ_) hiding (prodIso ; toProdIso ; curryIso) open import Cubical.Foundations.Prelude open import Cubical.Foundations.Equiv diff --git a/Cubical.Data.Rationals.Base.html b/Cubical.Data.Rationals.Base.html index e65c6f4576..e979922ae0 100644 --- a/Cubical.Data.Rationals.Base.html +++ b/Cubical.Data.Rationals.Base.html @@ -15,7 +15,7 @@ open import Cubical.Relation.Nullary open import Cubical.Relation.Binary.Base -open BinaryRelation +open BinaryRelation ℕ₊₁→ℤ : ℕ₊₁ → ℤ ℕ₊₁→ℤ n = pos (ℕ₊₁→ℕ n) @@ -41,10 +41,10 @@ [ a / b ] = [ a , b ] -isEquivRel∼ : isEquivRel _∼_ -isEquivRel.reflexive isEquivRel∼ (a , b) = refl -isEquivRel.symmetric isEquivRel∼ (a , b) (c , d) = sym -isEquivRel.transitive isEquivRel∼ (a , b) (c , d) (e , f) p q = ·-injʳ _ _ _ r +isEquivRel∼ : isEquivRel _∼_ +isEquivRel.reflexive isEquivRel∼ (a , b) = refl +isEquivRel.symmetric isEquivRel∼ (a , b) (c , d) = sym +isEquivRel.transitive isEquivRel∼ (a , b) (c , d) (e , f) p q = ·-injʳ _ _ _ r where r = (a · ℕ₊₁→ℤ f) · ℕ₊₁→ℤ d ≡[ i ]⟨ ·-comm a (ℕ₊₁→ℤ f) i · ℕ₊₁→ℤ d ⟩ (ℕ₊₁→ℤ f · a) · ℕ₊₁→ℤ d ≡⟨ sym (·-assoc (ℕ₊₁→ℤ f) a (ℕ₊₁→ℤ d)) ⟩ ℕ₊₁→ℤ f · (a · ℕ₊₁→ℤ d) ≡[ i ]⟨ ℕ₊₁→ℤ f · p i ⟩ diff --git a/Cubical.Data.Rationals.MoreRationals.SigmaQ.Base.html b/Cubical.Data.Rationals.MoreRationals.SigmaQ.Base.html index e42067a40f..7e855d5040 100644 --- a/Cubical.Data.Rationals.MoreRationals.SigmaQ.Base.html +++ b/Cubical.Data.Rationals.MoreRationals.SigmaQ.Base.html @@ -33,9 +33,9 @@ []-cancelʳ : ∀ ((a , b) : ℤ × ℕ₊₁) k → [ a · pos (ℕ₊₁→ℕ k) , b ·₊₁ k ] ≡ [ a , b ] []-cancelʳ (signed s zero , b) k = - Σ≡Prop (λ _ → isPropIsGCD) (λ i → signed-zero spos s i , 1) + Σ≡Prop (λ _ → isPropIsGCD) (λ i → signed-zero spos s i , 1) []-cancelʳ (signed s (suc a) , b) k = - Σ≡Prop (λ _ → isPropIsGCD) (λ i → signedPair (·S-comm s spos i) + Σ≡Prop (λ _ → isPropIsGCD) (λ i → signedPair (·S-comm s spos i) (toCoprime-cancelʳ (suc a , b) k i)) []-cancelʳ (posneg i , b) k j = isSet→isSet' isSetℚ ([]-cancelʳ (pos zero , b) k) ([]-cancelʳ (neg zero , b) k) diff --git a/Cubical.Data.Rationals.MoreRationals.SigmaQ.Properties.html b/Cubical.Data.Rationals.MoreRationals.SigmaQ.Properties.html index 3f423acf7f..24816f38e7 100644 --- a/Cubical.Data.Rationals.MoreRationals.SigmaQ.Properties.html +++ b/Cubical.Data.Rationals.MoreRationals.SigmaQ.Properties.html @@ -58,11 +58,11 @@ reduce-[] : ∀ x → reduce Quo.[ x .fst ] ≡ x -- equivalent to: Sigma.[ s .fst ] ≡ x reduce-[] ((signed s a , b) , cp) = - Σ≡Prop (λ _ → isPropIsGCD) (toCoprime-eq₂ s (a , b) cp) + Σ≡Prop (λ _ → isPropIsGCD) (toCoprime-eq₂ s (a , b) cp) reduce-[] ((posneg i , b) , cp) j = isSet→isSet' Sigma.isSetℚ - (Σ≡Prop (λ _ → isPropIsGCD) (toCoprime-eq₂ spos (0 , b) cp)) - (Σ≡Prop (λ _ → isPropIsGCD) (toCoprime-eq₂ sneg (0 , b) cp)) + (Σ≡Prop (λ _ → isPropIsGCD) (toCoprime-eq₂ spos (0 , b) cp)) + (Σ≡Prop (λ _ → isPropIsGCD) (toCoprime-eq₂ sneg (0 , b) cp)) (λ i → Sigma.[ posneg i , b ]) (λ i → (posneg i , b) , cp) i j diff --git a/Cubical.Data.Sigma.Properties.html b/Cubical.Data.Sigma.Properties.html index 0a36e9516d..307936003f 100644 --- a/Cubical.Data.Sigma.Properties.html +++ b/Cubical.Data.Sigma.Properties.html @@ -137,324 +137,343 @@ rightInv lUnit×Iso _ = refl leftInv lUnit×Iso _ = refl -rUnit×Iso : Iso (A × Unit) A -fun rUnit×Iso = fst -inv rUnit×Iso = _, tt -rightInv rUnit×Iso _ = refl -leftInv rUnit×Iso _ = refl - -module _ {A : Type ℓ} {A' : Type ℓ'} where - Σ-swap-Iso : Iso (A × A') (A' × A) - fun Σ-swap-Iso (x , y) = (y , x) - inv Σ-swap-Iso (x , y) = (y , x) - rightInv Σ-swap-Iso _ = refl - leftInv Σ-swap-Iso _ = refl - - unquoteDecl Σ-swap-≃ = declStrictIsoToEquiv Σ-swap-≃ Σ-swap-Iso - -module _ {A : Type ℓ} {B : A → Type ℓ'} {C : ∀ a → B a → Type ℓ''} where - Σ-assoc-Iso : Iso (Σ[ a ∈ Σ A B ] C (fst a) (snd a)) (Σ[ a ∈ A ] Σ[ b ∈ B a ] C a b) - fun Σ-assoc-Iso ((x , y) , z) = (x , (y , z)) - inv Σ-assoc-Iso (x , (y , z)) = ((x , y) , z) - rightInv Σ-assoc-Iso _ = refl - leftInv Σ-assoc-Iso _ = refl - - unquoteDecl Σ-assoc-≃ = declStrictIsoToEquiv Σ-assoc-≃ Σ-assoc-Iso - - Σ-Π-Iso : Iso ((a : A) → Σ[ b ∈ B a ] C a b) (Σ[ f ∈ ((a : A) → B a) ] ∀ a → C a (f a)) - fun Σ-Π-Iso f = (fst ∘ f , snd ∘ f) - inv Σ-Π-Iso (f , g) x = (f x , g x) - rightInv Σ-Π-Iso _ = refl - leftInv Σ-Π-Iso _ = refl - - unquoteDecl Σ-Π-≃ = declStrictIsoToEquiv Σ-Π-≃ Σ-Π-Iso - -Σ-cong-iso-fst : (isom : Iso A A') → Iso (Σ A (B ∘ fun isom)) (Σ A' B) -fun (Σ-cong-iso-fst isom) x = fun isom (x .fst) , x .snd -inv (Σ-cong-iso-fst {B = B} isom) x = inv isom (x .fst) , subst B (sym (ε (x .fst))) (x .snd) - where - ε = isHAEquiv.rinv (snd (iso→HAEquiv isom)) -rightInv (Σ-cong-iso-fst {B = B} isom) (x , y) = ΣPathP (ε x , toPathP goal) - where - ε = isHAEquiv.rinv (snd (iso→HAEquiv isom)) - goal : subst B (ε x) (subst B (sym (ε x)) y) ≡ y - goal = sym (substComposite B (sym (ε x)) (ε x) y) - ∙∙ cong (λ x → subst B x y) (lCancel (ε x)) - ∙∙ substRefl {B = B} y -leftInv (Σ-cong-iso-fst {A = A} {B = B} isom) (x , y) = ΣPathP (leftInv isom x , toPathP goal) - where - ε = isHAEquiv.rinv (snd (iso→HAEquiv isom)) - γ = isHAEquiv.com (snd (iso→HAEquiv isom)) - - lem : (x : A) → sym (ε (fun isom x)) ∙ cong (fun isom) (leftInv isom x) ≡ refl - lem x = cong (λ a → sym (ε (fun isom x)) ∙ a) (γ x) ∙ lCancel (ε (fun isom x)) - - goal : subst B (cong (fun isom) (leftInv isom x)) (subst B (sym (ε (fun isom x))) y) ≡ y - goal = sym (substComposite B (sym (ε (fun isom x))) (cong (fun isom) (leftInv isom x)) y) - ∙∙ cong (λ a → subst B a y) (lem x) - ∙∙ substRefl {B = B} y - -Σ-cong-equiv-fst : (e : A ≃ A') → Σ A (B ∘ equivFun e) ≃ Σ A' B --- we could just do this: --- Σ-cong-equiv-fst e = isoToEquiv (Σ-cong-iso-fst (equivToIso e)) --- but the following reduces slightly better -Σ-cong-equiv-fst {A = A} {A' = A'} {B = B} e = intro , isEqIntro - where - intro : Σ A (B ∘ equivFun e) → Σ A' B - intro (a , b) = equivFun e a , b - isEqIntro : isEquiv intro - isEqIntro .equiv-proof x = ctr , isCtr where - PB : ∀ {x y} → x ≡ y → B x → B y → Type _ - PB p = PathP (λ i → B (p i)) - - open Σ x renaming (fst to a'; snd to b) - open Σ (equivCtr e a') renaming (fst to ctrA; snd to α) - ctrB : B (equivFun e ctrA) - ctrB = subst B (sym α) b - ctrP : PB α ctrB b - ctrP = symP (transport-filler (λ i → B (sym α i)) b) - ctr : fiber intro x - ctr = (ctrA , ctrB) , ΣPathP (α , ctrP) - - isCtr : ∀ y → ctr ≡ y - isCtr ((r , s) , p) = λ i → (a≡r i , b!≡s i) , ΣPathP (α≡ρ i , coh i) where - open PathPΣ p renaming (fst to ρ; snd to σ) - open PathPΣ (equivCtrPath e a' (r , ρ)) renaming (fst to a≡r; snd to α≡ρ) - - b!≡s : PB (cong (equivFun e) a≡r) ctrB s - b!≡s i = comp (λ k → B (α≡ρ i (~ k))) (λ k → (λ - { (i = i0) → ctrP (~ k) - ; (i = i1) → σ (~ k) - })) b - - coh : PathP (λ i → PB (α≡ρ i) (b!≡s i) b) ctrP σ - coh i j = fill (λ k → B (α≡ρ i (~ k))) (λ k → (λ - { (i = i0) → ctrP (~ k) - ; (i = i1) → σ (~ k) - })) (inS b) (~ j) - -Σ-cong-fst : (p : A ≡ A') → Σ A (B ∘ transport p) ≡ Σ A' B -Σ-cong-fst {B = B} p i = Σ (p i) (B ∘ transp (λ j → p (i ∨ j)) i) - -Σ-cong-iso-snd : ((x : A) → Iso (B x) (B' x)) → Iso (Σ A B) (Σ A B') -fun (Σ-cong-iso-snd isom) (x , y) = x , fun (isom x) y -inv (Σ-cong-iso-snd isom) (x , y') = x , inv (isom x) y' -rightInv (Σ-cong-iso-snd isom) (x , y) = ΣPathP (refl , rightInv (isom x) y) -leftInv (Σ-cong-iso-snd isom) (x , y') = ΣPathP (refl , leftInv (isom x) y') - -Σ-cong-equiv-snd : (∀ a → B a ≃ B' a) → Σ A B ≃ Σ A B' -Σ-cong-equiv-snd h = isoToEquiv (Σ-cong-iso-snd (equivToIso ∘ h)) - -Σ-cong-snd : ((x : A) → B x ≡ B' x) → Σ A B ≡ Σ A B' -Σ-cong-snd {A = A} p i = Σ[ x ∈ A ] (p x i) - -Σ-cong-iso : (isom : Iso A A') - → ((x : A) → Iso (B x) (B' (fun isom x))) - → Iso (Σ A B) (Σ A' B') -Σ-cong-iso isom isom' = compIso (Σ-cong-iso-snd isom') (Σ-cong-iso-fst isom) - -Σ-cong-equiv : (e : A ≃ A') - → ((x : A) → B x ≃ B' (equivFun e x)) - → Σ A B ≃ Σ A' B' -Σ-cong-equiv e e' = isoToEquiv (Σ-cong-iso (equivToIso e) (equivToIso ∘ e')) - -Σ-cong' : (p : A ≡ A') → PathP (λ i → p i → Type ℓ') B B' → Σ A B ≡ Σ A' B' -Σ-cong' p p' = cong₂ (λ (A : Type _) (B : A → Type _) → Σ A B) p p' - -Σ-cong-equiv-prop : - (e : A ≃ A') - → ((x : A ) → isProp (B x)) - → ((x : A') → isProp (B' x)) - → ((x : A) → B x → B' (equivFun e x)) - → ((x : A) → B' (equivFun e x) → B x) - → Σ A B ≃ Σ A' B' -Σ-cong-equiv-prop e prop prop' prop→ prop← = - Σ-cong-equiv e (λ x → propBiimpl→Equiv (prop x) (prop' (equivFun e x)) (prop→ x) (prop← x)) - --- Alternative version for path in Σ-types, as in the HoTT book - -ΣPathTransport : (a b : Σ A B) → Type _ -ΣPathTransport {B = B} a b = Σ[ p ∈ (fst a ≡ fst b) ] transport (λ i → B (p i)) (snd a) ≡ snd b - -IsoΣPathTransportPathΣ : (a b : Σ A B) → Iso (ΣPathTransport a b) (a ≡ b) -IsoΣPathTransportPathΣ {B = B} a b = - compIso (Σ-cong-iso-snd (λ p → invIso (PathPIsoPath (λ i → B (p i)) _ _))) - ΣPathIsoPathΣ - -ΣPathTransport≃PathΣ : (a b : Σ A B) → ΣPathTransport a b ≃ (a ≡ b) -ΣPathTransport≃PathΣ {B = B} a b = isoToEquiv (IsoΣPathTransportPathΣ a b) - -ΣPathTransport→PathΣ : (a b : Σ A B) → ΣPathTransport a b → (a ≡ b) -ΣPathTransport→PathΣ a b = Iso.fun (IsoΣPathTransportPathΣ a b) - -PathΣ→ΣPathTransport : (a b : Σ A B) → (a ≡ b) → ΣPathTransport a b -PathΣ→ΣPathTransport a b = Iso.inv (IsoΣPathTransportPathΣ a b) - -ΣPathTransport≡PathΣ : (a b : Σ A B) → ΣPathTransport a b ≡ (a ≡ b) -ΣPathTransport≡PathΣ a b = ua (ΣPathTransport≃PathΣ a b) - -Σ-contractFstIso : (c : isContr A) → Iso (Σ A B) (B (c .fst)) -fun (Σ-contractFstIso {B = B} c) p = subst B (sym (c .snd (fst p))) (snd p) -inv (Σ-contractFstIso {B = B} c) b = _ , b -rightInv (Σ-contractFstIso {B = B} c) b = - cong (λ p → subst B p b) (isProp→isSet (isContr→isProp c) _ _ _ _) ∙ transportRefl _ -fst (leftInv (Σ-contractFstIso {B = B} c) p j) = c .snd (fst p) j -snd (leftInv (Σ-contractFstIso {B = B} c) p j) = - transp (λ i → B (c .snd (fst p) (~ i ∨ j))) j (snd p) - -Σ-contractFst : (c : isContr A) → Σ A B ≃ B (c .fst) -Σ-contractFst {B = B} c = isoToEquiv (Σ-contractFstIso c) - --- a special case of the above -module _ (A : Unit → Type ℓ) where - ΣUnit : Σ Unit A ≃ A tt - unquoteDef ΣUnit = defStrictEquiv ΣUnit snd (λ { x → (tt , x) }) - -Σ-contractSnd : ((a : A) → isContr (B a)) → Σ A B ≃ A -Σ-contractSnd c = isoToEquiv isom - where - isom : Iso _ _ - isom .fun = fst - isom .inv a = a , c a .fst - isom .rightInv _ = refl - isom .leftInv (a , b) = cong (a ,_) (c a .snd b) - -isEmbeddingFstΣProp : ((x : A) → isProp (B x)) - → {u v : Σ A B} - → isEquiv (λ (p : u ≡ v) → cong fst p) -isEmbeddingFstΣProp {B = B} pB {u = u} {v = v} .equiv-proof x = ctr , isCtr - where - ctrP : u ≡ v - ctrP = ΣPathP (x , isProp→PathP (λ _ → pB _) _ _) - ctr : fiber (λ (p : u ≡ v) → cong fst p) x - ctr = ctrP , refl - - isCtr : ∀ z → ctr ≡ z - isCtr (z , p) = ΣPathP (ctrP≡ , cong (sym ∘ snd) fzsingl) where - fzsingl : Path (singl x) (x , refl) (cong fst z , sym p) - fzsingl = isContrSingl x .snd (cong fst z , sym p) - ctrSnd : SquareP (λ i j → B (fzsingl i .fst j)) (cong snd ctrP) (cong snd z) _ _ - ctrSnd = isProp→SquareP (λ _ _ → pB _) _ _ _ _ - ctrP≡ : ctrP ≡ z - ctrP≡ i = ΣPathP (fzsingl i .fst , ctrSnd i) - -Σ≡PropEquiv : ((x : A) → isProp (B x)) → {u v : Σ A B} - → (u .fst ≡ v .fst) ≃ (u ≡ v) -Σ≡PropEquiv pB = invEquiv (_ , isEmbeddingFstΣProp pB) - -Σ≡Prop : ((x : A) → isProp (B x)) → {u v : Σ A B} - → (p : u .fst ≡ v .fst) → u ≡ v -Σ≡Prop pB p = equivFun (Σ≡PropEquiv pB) p - --- dependent version -ΣPathPProp : ∀ {ℓ ℓ'} {A : I → Type ℓ} {B : (i : I) → A i → Type ℓ'} - → {u : Σ (A i0) (B i0)} {v : Σ (A i1) (B i1)} - → ((a : A (i1)) → isProp (B i1 a)) - → PathP (λ i → A i) (fst u) (fst v) - → PathP (λ i → Σ (A i) (B i)) u v -fst (ΣPathPProp {u = u} {v = v} pB p i) = p i -snd (ΣPathPProp {B = B} {u = u} {v = v} pB p i) = lem i - where - lem : PathP (λ i → B i (p i)) (snd u) (snd v) - lem = toPathP (pB _ _ _) - -≃-× : ∀ {ℓ'' ℓ'''} {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} {D : Type ℓ'''} → A ≃ C → B ≃ D → A × B ≃ C × D -≃-× eq1 eq2 = - map-× (fst eq1) (fst eq2) - , record - { equiv-proof - = λ {(c , d) → ((eq1⁻ c .fst .fst - , eq2⁻ d .fst .fst) - , ≡-× (eq1⁻ c .fst .snd) - (eq2⁻ d .fst .snd)) - , λ {((a , b) , p) → ΣPathP (≡-× (cong fst (eq1⁻ c .snd (a , cong fst p))) - (cong fst (eq2⁻ d .snd (b , cong snd p))) - , λ i → ≡-× (snd ((eq1⁻ c .snd (a , cong fst p)) i)) - (snd ((eq2⁻ d .snd (b , cong snd p)) i)))}}} - where - eq1⁻ = equiv-proof (eq1 .snd) - eq2⁻ = equiv-proof (eq2 .snd) - -{- Some simple ismorphisms -} - -prodIso : ∀ {ℓ ℓ' ℓ'' ℓ'''} {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} {D : Type ℓ'''} - → Iso A C - → Iso B D - → Iso (A × B) (C × D) -Iso.fun (prodIso iAC iBD) (a , b) = (Iso.fun iAC a) , Iso.fun iBD b -Iso.inv (prodIso iAC iBD) (c , d) = (Iso.inv iAC c) , Iso.inv iBD d -Iso.rightInv (prodIso iAC iBD) (c , d) = ΣPathP ((Iso.rightInv iAC c) , (Iso.rightInv iBD d)) -Iso.leftInv (prodIso iAC iBD) (a , b) = ΣPathP ((Iso.leftInv iAC a) , (Iso.leftInv iBD b)) - -prodEquivToIso : ∀ {ℓ'' ℓ'''} {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} {D : Type ℓ'''} - → (e : A ≃ C)(e' : B ≃ D) - → prodIso (equivToIso e) (equivToIso e') ≡ equivToIso (≃-× e e') -Iso.fun (prodEquivToIso e e' i) = Iso.fun (equivToIso (≃-× e e')) -Iso.inv (prodEquivToIso e e' i) = Iso.inv (equivToIso (≃-× e e')) -Iso.rightInv (prodEquivToIso e e' i) = Iso.rightInv (equivToIso (≃-× e e')) -Iso.leftInv (prodEquivToIso e e' i) = Iso.leftInv (equivToIso (≃-× e e')) - -toProdIso : {B C : A → Type ℓ} - → Iso ((a : A) → B a × C a) (((a : A) → B a) × ((a : A) → C a)) -Iso.fun toProdIso = λ f → (λ a → fst (f a)) , (λ a → snd (f a)) -Iso.inv toProdIso (f , g) = λ a → (f a) , (g a) -Iso.rightInv toProdIso (f , g) = refl -Iso.leftInv toProdIso b = refl - -module _ {A : Type ℓ} {B : A → Type ℓ'} {C : ∀ a → B a → Type ℓ''} where - curryIso : Iso (((a , b) : Σ A B) → C a b) ((a : A) → (b : B a) → C a b) - Iso.fun curryIso f a b = f (a , b) - Iso.inv curryIso f a = f (fst a) (snd a) - Iso.rightInv curryIso a = refl - Iso.leftInv curryIso f = refl - - unquoteDecl curryEquiv = declStrictIsoToEquiv curryEquiv curryIso - --- Sigma type with empty base - -module _ (A : ⊥ → Type ℓ) where - - open Iso - - ΣEmptyIso : Iso (Σ ⊥ A) ⊥ - fun ΣEmptyIso (* , _) = * - - ΣEmpty : Σ ⊥ A ≃ ⊥ - ΣEmpty = isoToEquiv ΣEmptyIso - --- fiber of projection map - -module _ - (A : Type ℓ) - (B : A → Type ℓ') where - - private - proj : Σ A B → A - proj (a , b) = a - - module _ - (a : A) where - - open Iso - - fiberProjIso : Iso (B a) (fiber proj a) - fiberProjIso .fun b = (a , b) , refl - fiberProjIso .inv ((a' , b') , p) = subst B p b' - fiberProjIso .leftInv b i = substRefl {B = B} b i - fiberProjIso .rightInv (_ , p) i .fst .fst = p (~ i) - fiberProjIso .rightInv ((_ , b') , p) i .fst .snd = subst-filler B p b' (~ i) - fiberProjIso .rightInv (_ , p) i .snd j = p (~ i ∨ j) - - fiberProjEquiv : B a ≃ fiber proj a - fiberProjEquiv = isoToEquiv fiberProjIso - -separatedΣ : Separated A → ((a : A) → Separated (B a)) → Separated (Σ A B) -separatedΣ {B = B} sepA sepB (a , b) (a' , b') p = ΣPathTransport→PathΣ _ _ (pA , pB) - where - pA : a ≡ a' - pA = sepA a a' (λ q → p (λ r → q (cong fst r))) - - pB : subst B pA b ≡ b' - pB = sepB _ _ _ (λ q → p (λ r → q (cong (λ r' → subst B r' b) - (Separated→isSet sepA _ _ pA (cong fst r)) ∙ snd (PathΣ→ΣPathTransport _ _ r)))) +lUnit*×Iso : ∀{ℓ} → Iso (Unit* {ℓ} × A) A +fun lUnit*×Iso = snd +inv lUnit*×Iso = tt* ,_ +rightInv lUnit*×Iso _ = refl +leftInv lUnit*×Iso _ = refl + +rUnit×Iso : Iso (A × Unit) A +fun rUnit×Iso = fst +inv rUnit×Iso = _, tt +rightInv rUnit×Iso _ = refl +leftInv rUnit×Iso _ = refl + +rUnit*×Iso : ∀{ℓ} → Iso (A × Unit* {ℓ}) A +fun rUnit*×Iso = fst +inv rUnit*×Iso = _, tt* +rightInv rUnit*×Iso _ = refl +leftInv rUnit*×Iso _ = refl + +module _ {A : Type ℓ} {A' : Type ℓ'} where + Σ-swap-Iso : Iso (A × A') (A' × A) + fun Σ-swap-Iso (x , y) = (y , x) + inv Σ-swap-Iso (x , y) = (y , x) + rightInv Σ-swap-Iso _ = refl + leftInv Σ-swap-Iso _ = refl + + unquoteDecl Σ-swap-≃ = declStrictIsoToEquiv Σ-swap-≃ Σ-swap-Iso + +module _ {A : Type ℓ} {B : A → Type ℓ'} {C : ∀ a → B a → Type ℓ''} where + Σ-assoc-Iso : Iso (Σ[ a ∈ Σ A B ] C (fst a) (snd a)) (Σ[ a ∈ A ] Σ[ b ∈ B a ] C a b) + fun Σ-assoc-Iso ((x , y) , z) = (x , (y , z)) + inv Σ-assoc-Iso (x , (y , z)) = ((x , y) , z) + rightInv Σ-assoc-Iso _ = refl + leftInv Σ-assoc-Iso _ = refl + + unquoteDecl Σ-assoc-≃ = declStrictIsoToEquiv Σ-assoc-≃ Σ-assoc-Iso + + Σ-Π-Iso : Iso ((a : A) → Σ[ b ∈ B a ] C a b) (Σ[ f ∈ ((a : A) → B a) ] ∀ a → C a (f a)) + fun Σ-Π-Iso f = (fst ∘ f , snd ∘ f) + inv Σ-Π-Iso (f , g) x = (f x , g x) + rightInv Σ-Π-Iso _ = refl + leftInv Σ-Π-Iso _ = refl + + unquoteDecl Σ-Π-≃ = declStrictIsoToEquiv Σ-Π-≃ Σ-Π-Iso + +Σ-cong-iso-fst : (isom : Iso A A') → Iso (Σ A (B ∘ fun isom)) (Σ A' B) +fun (Σ-cong-iso-fst isom) x = fun isom (x .fst) , x .snd +inv (Σ-cong-iso-fst {B = B} isom) x = inv isom (x .fst) , subst B (sym (ε (x .fst))) (x .snd) + where + ε = isHAEquiv.rinv (snd (iso→HAEquiv isom)) +rightInv (Σ-cong-iso-fst {B = B} isom) (x , y) = ΣPathP (ε x , toPathP goal) + where + ε = isHAEquiv.rinv (snd (iso→HAEquiv isom)) + goal : subst B (ε x) (subst B (sym (ε x)) y) ≡ y + goal = sym (substComposite B (sym (ε x)) (ε x) y) + ∙∙ cong (λ x → subst B x y) (lCancel (ε x)) + ∙∙ substRefl {B = B} y +leftInv (Σ-cong-iso-fst {A = A} {B = B} isom) (x , y) = ΣPathP (leftInv isom x , toPathP goal) + where + ε = isHAEquiv.rinv (snd (iso→HAEquiv isom)) + γ = isHAEquiv.com (snd (iso→HAEquiv isom)) + + lem : (x : A) → sym (ε (fun isom x)) ∙ cong (fun isom) (leftInv isom x) ≡ refl + lem x = cong (λ a → sym (ε (fun isom x)) ∙ a) (γ x) ∙ lCancel (ε (fun isom x)) + + goal : subst B (cong (fun isom) (leftInv isom x)) (subst B (sym (ε (fun isom x))) y) ≡ y + goal = sym (substComposite B (sym (ε (fun isom x))) (cong (fun isom) (leftInv isom x)) y) + ∙∙ cong (λ a → subst B a y) (lem x) + ∙∙ substRefl {B = B} y + +Σ-cong-equiv-fst : (e : A ≃ A') → Σ A (B ∘ equivFun e) ≃ Σ A' B +-- we could just do this: +-- Σ-cong-equiv-fst e = isoToEquiv (Σ-cong-iso-fst (equivToIso e)) +-- but the following reduces slightly better +Σ-cong-equiv-fst {A = A} {A' = A'} {B = B} e = intro , isEqIntro + where + intro : Σ A (B ∘ equivFun e) → Σ A' B + intro (a , b) = equivFun e a , b + isEqIntro : isEquiv intro + isEqIntro .equiv-proof x = ctr , isCtr where + PB : ∀ {x y} → x ≡ y → B x → B y → Type _ + PB p = PathP (λ i → B (p i)) + + open Σ x renaming (fst to a'; snd to b) + open Σ (equivCtr e a') renaming (fst to ctrA; snd to α) + ctrB : B (equivFun e ctrA) + ctrB = subst B (sym α) b + ctrP : PB α ctrB b + ctrP = symP (transport-filler (λ i → B (sym α i)) b) + ctr : fiber intro x + ctr = (ctrA , ctrB) , ΣPathP (α , ctrP) + + isCtr : ∀ y → ctr ≡ y + isCtr ((r , s) , p) = λ i → (a≡r i , b!≡s i) , ΣPathP (α≡ρ i , coh i) where + open PathPΣ p renaming (fst to ρ; snd to σ) + open PathPΣ (equivCtrPath e a' (r , ρ)) renaming (fst to a≡r; snd to α≡ρ) + + b!≡s : PB (cong (equivFun e) a≡r) ctrB s + b!≡s i = comp (λ k → B (α≡ρ i (~ k))) (λ k → (λ + { (i = i0) → ctrP (~ k) + ; (i = i1) → σ (~ k) + })) b + + coh : PathP (λ i → PB (α≡ρ i) (b!≡s i) b) ctrP σ + coh i j = fill (λ k → B (α≡ρ i (~ k))) (λ k → (λ + { (i = i0) → ctrP (~ k) + ; (i = i1) → σ (~ k) + })) (inS b) (~ j) + +Σ-cong-fst : (p : A ≡ A') → Σ A (B ∘ transport p) ≡ Σ A' B +Σ-cong-fst {B = B} p i = Σ (p i) (B ∘ transp (λ j → p (i ∨ j)) i) + +Σ-cong-iso-snd : ((x : A) → Iso (B x) (B' x)) → Iso (Σ A B) (Σ A B') +fun (Σ-cong-iso-snd isom) (x , y) = x , fun (isom x) y +inv (Σ-cong-iso-snd isom) (x , y') = x , inv (isom x) y' +rightInv (Σ-cong-iso-snd isom) (x , y) = ΣPathP (refl , rightInv (isom x) y) +leftInv (Σ-cong-iso-snd isom) (x , y') = ΣPathP (refl , leftInv (isom x) y') + +Σ-cong-equiv-snd : (∀ a → B a ≃ B' a) → Σ A B ≃ Σ A B' +Σ-cong-equiv-snd h = isoToEquiv (Σ-cong-iso-snd (equivToIso ∘ h)) + +Σ-cong-snd : ((x : A) → B x ≡ B' x) → Σ A B ≡ Σ A B' +Σ-cong-snd {A = A} p i = Σ[ x ∈ A ] (p x i) + +Σ-cong-iso : (isom : Iso A A') + → ((x : A) → Iso (B x) (B' (fun isom x))) + → Iso (Σ A B) (Σ A' B') +Σ-cong-iso isom isom' = compIso (Σ-cong-iso-snd isom') (Σ-cong-iso-fst isom) + +Σ-cong-equiv : (e : A ≃ A') + → ((x : A) → B x ≃ B' (equivFun e x)) + → Σ A B ≃ Σ A' B' +Σ-cong-equiv e e' = isoToEquiv (Σ-cong-iso (equivToIso e) (equivToIso ∘ e')) + +Σ-cong' : (p : A ≡ A') → PathP (λ i → p i → Type ℓ') B B' → Σ A B ≡ Σ A' B' +Σ-cong' p p' = cong₂ (λ (A : Type _) (B : A → Type _) → Σ A B) p p' + +Σ-cong-equiv-prop : + (e : A ≃ A') + → ((x : A ) → isProp (B x)) + → ((x : A') → isProp (B' x)) + → ((x : A) → B x → B' (equivFun e x)) + → ((x : A) → B' (equivFun e x) → B x) + → Σ A B ≃ Σ A' B' +Σ-cong-equiv-prop e prop prop' prop→ prop← = + Σ-cong-equiv e (λ x → propBiimpl→Equiv (prop x) (prop' (equivFun e x)) (prop→ x) (prop← x)) + +-- Alternative version for path in Σ-types, as in the HoTT book + +ΣPathTransport : (a b : Σ A B) → Type _ +ΣPathTransport {B = B} a b = Σ[ p ∈ (fst a ≡ fst b) ] transport (λ i → B (p i)) (snd a) ≡ snd b + +IsoΣPathTransportPathΣ : (a b : Σ A B) → Iso (ΣPathTransport a b) (a ≡ b) +IsoΣPathTransportPathΣ {B = B} a b = + compIso (Σ-cong-iso-snd (λ p → invIso (PathPIsoPath (λ i → B (p i)) _ _))) + ΣPathIsoPathΣ + +ΣPathTransport≃PathΣ : (a b : Σ A B) → ΣPathTransport a b ≃ (a ≡ b) +ΣPathTransport≃PathΣ {B = B} a b = isoToEquiv (IsoΣPathTransportPathΣ a b) + +ΣPathTransport→PathΣ : (a b : Σ A B) → ΣPathTransport a b → (a ≡ b) +ΣPathTransport→PathΣ a b = Iso.fun (IsoΣPathTransportPathΣ a b) + +PathΣ→ΣPathTransport : (a b : Σ A B) → (a ≡ b) → ΣPathTransport a b +PathΣ→ΣPathTransport a b = Iso.inv (IsoΣPathTransportPathΣ a b) + +ΣPathTransport≡PathΣ : (a b : Σ A B) → ΣPathTransport a b ≡ (a ≡ b) +ΣPathTransport≡PathΣ a b = ua (ΣPathTransport≃PathΣ a b) + +Σ-contractFstIso : (c : isContr A) → Iso (Σ A B) (B (c .fst)) +fun (Σ-contractFstIso {B = B} c) p = subst B (sym (c .snd (fst p))) (snd p) +inv (Σ-contractFstIso {B = B} c) b = _ , b +rightInv (Σ-contractFstIso {B = B} c) b = + cong (λ p → subst B p b) (isProp→isSet (isContr→isProp c) _ _ _ _) ∙ transportRefl _ +fst (leftInv (Σ-contractFstIso {B = B} c) p j) = c .snd (fst p) j +snd (leftInv (Σ-contractFstIso {B = B} c) p j) = + transp (λ i → B (c .snd (fst p) (~ i ∨ j))) j (snd p) + +Σ-contractFst : (c : isContr A) → Σ A B ≃ B (c .fst) +Σ-contractFst {B = B} c = isoToEquiv (Σ-contractFstIso c) + +-- a special case of the above +module _ (A : Unit → Type ℓ) where + ΣUnit : Σ Unit A ≃ A tt + unquoteDef ΣUnit = defStrictEquiv ΣUnit snd (λ { x → (tt , x) }) + +Σ-contractSnd : ((a : A) → isContr (B a)) → Σ A B ≃ A +Σ-contractSnd c = isoToEquiv isom + where + isom : Iso _ _ + isom .fun = fst + isom .inv a = a , c a .fst + isom .rightInv _ = refl + isom .leftInv (a , b) = cong (a ,_) (c a .snd b) + +isEmbeddingFstΣProp : ((x : A) → isProp (B x)) + → {u v : Σ A B} + → isEquiv (λ (p : u ≡ v) → cong fst p) +isEmbeddingFstΣProp {B = B} pB {u = u} {v = v} .equiv-proof x = ctr , isCtr + where + ctrP : u ≡ v + ctrP = ΣPathP (x , isProp→PathP (λ _ → pB _) _ _) + ctr : fiber (λ (p : u ≡ v) → cong fst p) x + ctr = ctrP , refl + + isCtr : ∀ z → ctr ≡ z + isCtr (z , p) = ΣPathP (ctrP≡ , cong (sym ∘ snd) fzsingl) where + fzsingl : Path (singl x) (x , refl) (cong fst z , sym p) + fzsingl = isContrSingl x .snd (cong fst z , sym p) + ctrSnd : SquareP (λ i j → B (fzsingl i .fst j)) (cong snd ctrP) (cong snd z) _ _ + ctrSnd = isProp→SquareP (λ _ _ → pB _) _ _ _ _ + ctrP≡ : ctrP ≡ z + ctrP≡ i = ΣPathP (fzsingl i .fst , ctrSnd i) + +Σ≡PropEquiv : ((x : A) → isProp (B x)) → {u v : Σ A B} + → (u .fst ≡ v .fst) ≃ (u ≡ v) +Σ≡PropEquiv pB = invEquiv (_ , isEmbeddingFstΣProp pB) + +Σ≡Prop : ((x : A) → isProp (B x)) → {u v : Σ A B} + → (p : u .fst ≡ v .fst) → u ≡ v +Σ≡Prop pB p = equivFun (Σ≡PropEquiv pB) p + +-- dependent version +ΣPathPProp : ∀ {ℓ ℓ'} {A : I → Type ℓ} {B : (i : I) → A i → Type ℓ'} + → {u : Σ (A i0) (B i0)} {v : Σ (A i1) (B i1)} + → ((a : A (i1)) → isProp (B i1 a)) + → PathP (λ i → A i) (fst u) (fst v) + → PathP (λ i → Σ (A i) (B i)) u v +fst (ΣPathPProp {u = u} {v = v} pB p i) = p i +snd (ΣPathPProp {B = B} {u = u} {v = v} pB p i) = lem i + where + lem : PathP (λ i → B i (p i)) (snd u) (snd v) + lem = toPathP (pB _ _ _) + +≃-× : ∀ {ℓ'' ℓ'''} {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} {D : Type ℓ'''} → A ≃ C → B ≃ D → A × B ≃ C × D +≃-× eq1 eq2 = + map-× (fst eq1) (fst eq2) + , record + { equiv-proof + = λ {(c , d) → ((eq1⁻ c .fst .fst + , eq2⁻ d .fst .fst) + , ≡-× (eq1⁻ c .fst .snd) + (eq2⁻ d .fst .snd)) + , λ {((a , b) , p) → ΣPathP (≡-× (cong fst (eq1⁻ c .snd (a , cong fst p))) + (cong fst (eq2⁻ d .snd (b , cong snd p))) + , λ i → ≡-× (snd ((eq1⁻ c .snd (a , cong fst p)) i)) + (snd ((eq2⁻ d .snd (b , cong snd p)) i)))}}} + where + eq1⁻ = equiv-proof (eq1 .snd) + eq2⁻ = equiv-proof (eq2 .snd) + +{- Some simple ismorphisms -} + +prodIso : ∀ {ℓ ℓ' ℓ'' ℓ'''} {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} {D : Type ℓ'''} + → Iso A C + → Iso B D + → Iso (A × B) (C × D) +Iso.fun (prodIso iAC iBD) (a , b) = (Iso.fun iAC a) , Iso.fun iBD b +Iso.inv (prodIso iAC iBD) (c , d) = (Iso.inv iAC c) , Iso.inv iBD d +Iso.rightInv (prodIso iAC iBD) (c , d) = ΣPathP ((Iso.rightInv iAC c) , (Iso.rightInv iBD d)) +Iso.leftInv (prodIso iAC iBD) (a , b) = ΣPathP ((Iso.leftInv iAC a) , (Iso.leftInv iBD b)) + +prodEquivToIso : ∀ {ℓ'' ℓ'''} {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} {D : Type ℓ'''} + → (e : A ≃ C)(e' : B ≃ D) + → prodIso (equivToIso e) (equivToIso e') ≡ equivToIso (≃-× e e') +Iso.fun (prodEquivToIso e e' i) = Iso.fun (equivToIso (≃-× e e')) +Iso.inv (prodEquivToIso e e' i) = Iso.inv (equivToIso (≃-× e e')) +Iso.rightInv (prodEquivToIso e e' i) = Iso.rightInv (equivToIso (≃-× e e')) +Iso.leftInv (prodEquivToIso e e' i) = Iso.leftInv (equivToIso (≃-× e e')) + +toProdIso : {B C : A → Type ℓ} + → Iso ((a : A) → B a × C a) (((a : A) → B a) × ((a : A) → C a)) +Iso.fun toProdIso = λ f → (λ a → fst (f a)) , (λ a → snd (f a)) +Iso.inv toProdIso (f , g) = λ a → (f a) , (g a) +Iso.rightInv toProdIso (f , g) = refl +Iso.leftInv toProdIso b = refl + +module _ {A : Type ℓ} {B : A → Type ℓ'} {C : ∀ a → B a → Type ℓ''} where + curryIso : Iso (((a , b) : Σ A B) → C a b) ((a : A) → (b : B a) → C a b) + Iso.fun curryIso f a b = f (a , b) + Iso.inv curryIso f a = f (fst a) (snd a) + Iso.rightInv curryIso a = refl + Iso.leftInv curryIso f = refl + + unquoteDecl curryEquiv = declStrictIsoToEquiv curryEquiv curryIso + +-- Sigma type with empty base + +module _ (A : ⊥ → Type ℓ) where + + open Iso + + ΣEmptyIso : Iso (Σ ⊥ A) ⊥ + fun ΣEmptyIso (* , _) = * + + ΣEmpty : Σ ⊥ A ≃ ⊥ + ΣEmpty = isoToEquiv ΣEmptyIso + +module _ {ℓ : Level} (A : ⊥* {ℓ} → Type ℓ) where + + open Iso + + ΣEmpty*Iso : Iso (Σ ⊥* A) ⊥* + fun ΣEmpty*Iso (* , _) = * + +-- fiber of projection map + +module _ + (A : Type ℓ) + (B : A → Type ℓ') where + + private + proj : Σ A B → A + proj (a , b) = a + + module _ + (a : A) where + + open Iso + + fiberProjIso : Iso (B a) (fiber proj a) + fiberProjIso .fun b = (a , b) , refl + fiberProjIso .inv ((a' , b') , p) = subst B p b' + fiberProjIso .leftInv b i = substRefl {B = B} b i + fiberProjIso .rightInv (_ , p) i .fst .fst = p (~ i) + fiberProjIso .rightInv ((_ , b') , p) i .fst .snd = subst-filler B p b' (~ i) + fiberProjIso .rightInv (_ , p) i .snd j = p (~ i ∨ j) + + fiberProjEquiv : B a ≃ fiber proj a + fiberProjEquiv = isoToEquiv fiberProjIso + +separatedΣ : Separated A → ((a : A) → Separated (B a)) → Separated (Σ A B) +separatedΣ {B = B} sepA sepB (a , b) (a' , b') p = ΣPathTransport→PathΣ _ _ (pA , pB) + where + pA : a ≡ a' + pA = sepA a a' (λ q → p (λ r → q (cong fst r))) + + pB : subst B pA b ≡ b' + pB = sepB _ _ _ (λ q → p (λ r → q (cong (λ r' → subst B r' b) + (Separated→isSet sepA _ _ pA (cong fst r)) ∙ snd (PathΣ→ΣPathTransport _ _ r)))) \ No newline at end of file diff --git a/Cubical.Data.SubFinSet.html b/Cubical.Data.SubFinSet.html index e429dcbeac..e396d8cae0 100644 --- a/Cubical.Data.SubFinSet.html +++ b/Cubical.Data.SubFinSet.html @@ -42,11 +42,11 @@ isSubFinSet→isSet : isSubFinSet A → isSet A isSubFinSet→isSet = PT.rec isPropIsSet - λ (n , emb) → Embedding-into-isSet→isSet emb isSetFin + λ (n , emb) → Embedding-into-isSet→isSet emb isSetFin isSubFinSet→Discrete : isSubFinSet A → Discrete A isSubFinSet→Discrete isSubFinSet-A x y = PT.rec (isPropDec (isSubFinSet→isSet isSubFinSet-A x y)) - (λ (n , emb) → Embedding-into-Discrete→Discrete emb discreteFin x y) + (λ (n , emb) → Embedding-into-Discrete→Discrete emb discreteFin x y) isSubFinSet-A \ No newline at end of file diff --git a/Cubical.Data.Sum.Properties.html b/Cubical.Data.Sum.Properties.html index 9d4216f3eb..a8cda3eb3c 100644 --- a/Cubical.Data.Sum.Properties.html +++ b/Cubical.Data.Sum.Properties.html @@ -3,199 +3,294 @@ module Cubical.Data.Sum.Properties where open import Cubical.Core.Everything -open import Cubical.Foundations.Prelude -open import Cubical.Foundations.HLevels -open import Cubical.Functions.Embedding -open import Cubical.Foundations.Equiv -open import Cubical.Foundations.Isomorphism -open import Cubical.Data.Empty -open import Cubical.Data.Nat -open import Cubical.Data.Sigma -open import Cubical.Relation.Nullary - -open import Cubical.Data.Sum.Base - -open Iso - - -private - variable - ℓa ℓb ℓc ℓd ℓe : Level - A : Type ℓa - B : Type ℓb - C : Type ℓc - D : Type ℓd - E : A ⊎ B → Type ℓe - - --- Path space of sum type -module ⊎Path {ℓ ℓ'} {A : Type ℓ} {B : Type ℓ'} where - - Cover : A ⊎ B → A ⊎ B → Type (ℓ-max ℓ ℓ') - Cover (inl a) (inl a') = Lift {j = ℓ-max ℓ ℓ'} (a ≡ a') - Cover (inl _) (inr _) = Lift ⊥ - Cover (inr _) (inl _) = Lift ⊥ - Cover (inr b) (inr b') = Lift {j = ℓ-max ℓ ℓ'} (b ≡ b') - - reflCode : (c : A ⊎ B) → Cover c c - reflCode (inl a) = lift refl - reflCode (inr b) = lift refl - - encode : ∀ c c' → c ≡ c' → Cover c c' - encode c _ = J (λ c' _ → Cover c c') (reflCode c) - - encodeRefl : ∀ c → encode c c refl ≡ reflCode c - encodeRefl c = JRefl (λ c' _ → Cover c c') (reflCode c) - - decode : ∀ c c' → Cover c c' → c ≡ c' - decode (inl a) (inl a') (lift p) = cong inl p - decode (inl a) (inr b') () - decode (inr b) (inl a') () - decode (inr b) (inr b') (lift q) = cong inr q - - decodeRefl : ∀ c → decode c c (reflCode c) ≡ refl - decodeRefl (inl a) = refl - decodeRefl (inr b) = refl - - decodeEncode : ∀ c c' → (p : c ≡ c') → decode c c' (encode c c' p) ≡ p - decodeEncode c _ = - J (λ c' p → decode c c' (encode c c' p) ≡ p) - (cong (decode c c) (encodeRefl c) ∙ decodeRefl c) - - encodeDecode : ∀ c c' → (d : Cover c c') → encode c c' (decode c c' d) ≡ d - encodeDecode (inl a) (inl _) (lift d) = - J (λ a' p → encode (inl a) (inl a') (cong inl p) ≡ lift p) (encodeRefl (inl a)) d - encodeDecode (inr a) (inr _) (lift d) = - J (λ a' p → encode (inr a) (inr a') (cong inr p) ≡ lift p) (encodeRefl (inr a)) d - - Cover≃Path : ∀ c c' → Cover c c' ≃ (c ≡ c') - Cover≃Path c c' = - isoToEquiv (iso (decode c c') (encode c c') (decodeEncode c c') (encodeDecode c c')) - - isOfHLevelCover : (n : HLevel) - → isOfHLevel (suc (suc n)) A - → isOfHLevel (suc (suc n)) B - → ∀ c c' → isOfHLevel (suc n) (Cover c c') - isOfHLevelCover n p q (inl a) (inl a') = isOfHLevelLift (suc n) (p a a') - isOfHLevelCover n p q (inl a) (inr b') = - isOfHLevelLift (suc n) (isProp→isOfHLevelSuc n isProp⊥) - isOfHLevelCover n p q (inr b) (inl a') = - isOfHLevelLift (suc n) (isProp→isOfHLevelSuc n isProp⊥) - isOfHLevelCover n p q (inr b) (inr b') = isOfHLevelLift (suc n) (q b b') - -isEmbedding-inl : isEmbedding (inl {A = A} {B = B}) -isEmbedding-inl w z = snd (compEquiv LiftEquiv (⊎Path.Cover≃Path (inl w) (inl z))) - -isEmbedding-inr : isEmbedding (inr {A = A} {B = B}) -isEmbedding-inr w z = snd (compEquiv LiftEquiv (⊎Path.Cover≃Path (inr w) (inr z))) - -isOfHLevel⊎ : (n : HLevel) - → isOfHLevel (suc (suc n)) A - → isOfHLevel (suc (suc n)) B - → isOfHLevel (suc (suc n)) (A ⊎ B) -isOfHLevel⊎ n lA lB c c' = - isOfHLevelRetract (suc n) - (⊎Path.encode c c') - (⊎Path.decode c c') - (⊎Path.decodeEncode c c') - (⊎Path.isOfHLevelCover n lA lB c c') - -isSet⊎ : isSet A → isSet B → isSet (A ⊎ B) -isSet⊎ = isOfHLevel⊎ 0 - -isGroupoid⊎ : isGroupoid A → isGroupoid B → isGroupoid (A ⊎ B) -isGroupoid⊎ = isOfHLevel⊎ 1 - -is2Groupoid⊎ : is2Groupoid A → is2Groupoid B → is2Groupoid (A ⊎ B) -is2Groupoid⊎ = isOfHLevel⊎ 2 - -discrete⊎ : Discrete A → Discrete B → Discrete (A ⊎ B) -discrete⊎ decA decB (inl a) (inl a') = - mapDec (cong inl) (λ p q → p (isEmbedding→Inj isEmbedding-inl _ _ q)) (decA a a') -discrete⊎ decA decB (inl a) (inr b') = no (λ p → lower (⊎Path.encode (inl a) (inr b') p)) -discrete⊎ decA decB (inr b) (inl a') = no ((λ p → lower (⊎Path.encode (inr b) (inl a') p))) -discrete⊎ decA decB (inr b) (inr b') = - mapDec (cong inr) (λ p q → p (isEmbedding→Inj isEmbedding-inr _ _ q)) (decB b b') - -⊎Iso : Iso A C → Iso B D → Iso (A ⊎ B) (C ⊎ D) -fun (⊎Iso iac ibd) (inl x) = inl (iac .fun x) -fun (⊎Iso iac ibd) (inr x) = inr (ibd .fun x) -inv (⊎Iso iac ibd) (inl x) = inl (iac .inv x) -inv (⊎Iso iac ibd) (inr x) = inr (ibd .inv x) -rightInv (⊎Iso iac ibd) (inl x) = cong inl (iac .rightInv x) -rightInv (⊎Iso iac ibd) (inr x) = cong inr (ibd .rightInv x) -leftInv (⊎Iso iac ibd) (inl x) = cong inl (iac .leftInv x) -leftInv (⊎Iso iac ibd) (inr x) = cong inr (ibd .leftInv x) - -⊎-equiv : A ≃ C → B ≃ D → (A ⊎ B) ≃ (C ⊎ D) -⊎-equiv p q = isoToEquiv (⊎Iso (equivToIso p) (equivToIso q)) - -⊎-swap-Iso : Iso (A ⊎ B) (B ⊎ A) -fun ⊎-swap-Iso (inl x) = inr x -fun ⊎-swap-Iso (inr x) = inl x -inv ⊎-swap-Iso (inl x) = inr x -inv ⊎-swap-Iso (inr x) = inl x -rightInv ⊎-swap-Iso (inl _) = refl -rightInv ⊎-swap-Iso (inr _) = refl -leftInv ⊎-swap-Iso (inl _) = refl -leftInv ⊎-swap-Iso (inr _) = refl - -⊎-swap-≃ : A ⊎ B ≃ B ⊎ A -⊎-swap-≃ = isoToEquiv ⊎-swap-Iso - -⊎-assoc-Iso : Iso ((A ⊎ B) ⊎ C) (A ⊎ (B ⊎ C)) -fun ⊎-assoc-Iso (inl (inl x)) = inl x -fun ⊎-assoc-Iso (inl (inr x)) = inr (inl x) -fun ⊎-assoc-Iso (inr x) = inr (inr x) -inv ⊎-assoc-Iso (inl x) = inl (inl x) -inv ⊎-assoc-Iso (inr (inl x)) = inl (inr x) -inv ⊎-assoc-Iso (inr (inr x)) = inr x -rightInv ⊎-assoc-Iso (inl _) = refl -rightInv ⊎-assoc-Iso (inr (inl _)) = refl -rightInv ⊎-assoc-Iso (inr (inr _)) = refl -leftInv ⊎-assoc-Iso (inl (inl _)) = refl -leftInv ⊎-assoc-Iso (inl (inr _)) = refl -leftInv ⊎-assoc-Iso (inr _) = refl - -⊎-assoc-≃ : (A ⊎ B) ⊎ C ≃ A ⊎ (B ⊎ C) -⊎-assoc-≃ = isoToEquiv ⊎-assoc-Iso - -⊎-⊥-Iso : Iso (A ⊎ ⊥) A -fun ⊎-⊥-Iso (inl x) = x -inv ⊎-⊥-Iso x = inl x -rightInv ⊎-⊥-Iso _ = refl -leftInv ⊎-⊥-Iso (inl _) = refl - -⊎-⊥-≃ : A ⊎ ⊥ ≃ A -⊎-⊥-≃ = isoToEquiv ⊎-⊥-Iso - -Π⊎Iso : Iso ((x : A ⊎ B) → E x) (((a : A) → E (inl a)) × ((b : B) → E (inr b))) -fun Π⊎Iso f .fst a = f (inl a) -fun Π⊎Iso f .snd b = f (inr b) -inv Π⊎Iso (g1 , g2) (inl a) = g1 a -inv Π⊎Iso (g1 , g2) (inr b) = g2 b -rightInv Π⊎Iso (g1 , g2) i .fst a = g1 a -rightInv Π⊎Iso (g1 , g2) i .snd b = g2 b -leftInv Π⊎Iso f i (inl a) = f (inl a) -leftInv Π⊎Iso f i (inr b) = f (inr b) - -Σ⊎Iso : Iso (Σ (A ⊎ B) E) ((Σ A (λ a → E (inl a))) ⊎ (Σ B (λ b → E (inr b)))) -fun Σ⊎Iso (inl a , ea) = inl (a , ea) -fun Σ⊎Iso (inr b , eb) = inr (b , eb) -inv Σ⊎Iso (inl (a , ea)) = (inl a , ea) -inv Σ⊎Iso (inr (b , eb)) = (inr b , eb) -rightInv Σ⊎Iso (inl (a , ea)) = refl -rightInv Σ⊎Iso (inr (b , eb)) = refl -leftInv Σ⊎Iso (inl a , ea) = refl -leftInv Σ⊎Iso (inr b , eb) = refl - -Π⊎≃ : ((x : A ⊎ B) → E x) ≃ ((a : A) → E (inl a)) × ((b : B) → E (inr b)) -Π⊎≃ = isoToEquiv Π⊎Iso - -Σ⊎≃ : (Σ (A ⊎ B) E) ≃ ((Σ A (λ a → E (inl a))) ⊎ (Σ B (λ b → E (inr b)))) -Σ⊎≃ = isoToEquiv Σ⊎Iso - -map-⊎ : (A → C) → (B → D) → A ⊎ B → C ⊎ D -map-⊎ f _ (inl a) = inl (f a) -map-⊎ _ g (inr b) = inr (g b) +open import Cubical.Foundations.Function +open import Cubical.Foundations.Prelude +open import Cubical.Foundations.HLevels +open import Cubical.Functions.Embedding +open import Cubical.Foundations.Equiv +open import Cubical.Foundations.Isomorphism +open import Cubical.Data.Empty as ⊥ +open import Cubical.Data.Nat +open import Cubical.Data.Sigma +open import Cubical.Relation.Nullary + +open import Cubical.Data.Sum.Base as ⊎ + +open Iso + + +private + variable + ℓa ℓb ℓc ℓd ℓe : Level + A : Type ℓa + B : Type ℓb + C : Type ℓc + D : Type ℓd + E : A ⊎ B → Type ℓe + + +-- Path space of sum type +module ⊎Path {ℓ ℓ'} {A : Type ℓ} {B : Type ℓ'} where + + Cover : A ⊎ B → A ⊎ B → Type (ℓ-max ℓ ℓ') + Cover (inl a) (inl a') = Lift {j = ℓ-max ℓ ℓ'} (a ≡ a') + Cover (inl _) (inr _) = Lift ⊥ + Cover (inr _) (inl _) = Lift ⊥ + Cover (inr b) (inr b') = Lift {j = ℓ-max ℓ ℓ'} (b ≡ b') + + reflCode : (c : A ⊎ B) → Cover c c + reflCode (inl a) = lift refl + reflCode (inr b) = lift refl + + encode : ∀ c c' → c ≡ c' → Cover c c' + encode c _ = J (λ c' _ → Cover c c') (reflCode c) + + encodeRefl : ∀ c → encode c c refl ≡ reflCode c + encodeRefl c = JRefl (λ c' _ → Cover c c') (reflCode c) + + decode : ∀ c c' → Cover c c' → c ≡ c' + decode (inl a) (inl a') (lift p) = cong inl p + decode (inl a) (inr b') () + decode (inr b) (inl a') () + decode (inr b) (inr b') (lift q) = cong inr q + + decodeRefl : ∀ c → decode c c (reflCode c) ≡ refl + decodeRefl (inl a) = refl + decodeRefl (inr b) = refl + + decodeEncode : ∀ c c' → (p : c ≡ c') → decode c c' (encode c c' p) ≡ p + decodeEncode c _ = + J (λ c' p → decode c c' (encode c c' p) ≡ p) + (cong (decode c c) (encodeRefl c) ∙ decodeRefl c) + + encodeDecode : ∀ c c' → (d : Cover c c') → encode c c' (decode c c' d) ≡ d + encodeDecode (inl a) (inl _) (lift d) = + J (λ a' p → encode (inl a) (inl a') (cong inl p) ≡ lift p) (encodeRefl (inl a)) d + encodeDecode (inr a) (inr _) (lift d) = + J (λ a' p → encode (inr a) (inr a') (cong inr p) ≡ lift p) (encodeRefl (inr a)) d + + Cover≃Path : ∀ c c' → Cover c c' ≃ (c ≡ c') + Cover≃Path c c' = + isoToEquiv (iso (decode c c') (encode c c') (decodeEncode c c') (encodeDecode c c')) + + isOfHLevelCover : (n : HLevel) + → isOfHLevel (suc (suc n)) A + → isOfHLevel (suc (suc n)) B + → ∀ c c' → isOfHLevel (suc n) (Cover c c') + isOfHLevelCover n p q (inl a) (inl a') = isOfHLevelLift (suc n) (p a a') + isOfHLevelCover n p q (inl a) (inr b') = + isOfHLevelLift (suc n) (isProp→isOfHLevelSuc n isProp⊥) + isOfHLevelCover n p q (inr b) (inl a') = + isOfHLevelLift (suc n) (isProp→isOfHLevelSuc n isProp⊥) + isOfHLevelCover n p q (inr b) (inr b') = isOfHLevelLift (suc n) (q b b') + +isEmbedding-inl : isEmbedding (inl {A = A} {B = B}) +isEmbedding-inl w z = snd (compEquiv LiftEquiv (⊎Path.Cover≃Path (inl w) (inl z))) + +isEmbedding-inr : isEmbedding (inr {A = A} {B = B}) +isEmbedding-inr w z = snd (compEquiv LiftEquiv (⊎Path.Cover≃Path (inr w) (inr z))) + +isOfHLevel⊎ : (n : HLevel) + → isOfHLevel (suc (suc n)) A + → isOfHLevel (suc (suc n)) B + → isOfHLevel (suc (suc n)) (A ⊎ B) +isOfHLevel⊎ n lA lB c c' = + isOfHLevelRetract (suc n) + (⊎Path.encode c c') + (⊎Path.decode c c') + (⊎Path.decodeEncode c c') + (⊎Path.isOfHLevelCover n lA lB c c') + +isProp⊎ : isProp A → isProp B → (A → B → ⊥) → isProp (A ⊎ B) +isProp⊎ propA _ _ (inl x) (inl y) i = inl (propA x y i) +isProp⊎ _ _ AB⊥ (inl x) (inr y) = ⊥.rec (AB⊥ x y) +isProp⊎ _ _ AB⊥ (inr x) (inl y) = ⊥.rec (AB⊥ y x) +isProp⊎ _ propB _ (inr x) (inr y) i = inr (propB x y i) + +isSet⊎ : isSet A → isSet B → isSet (A ⊎ B) +isSet⊎ = isOfHLevel⊎ 0 + +isGroupoid⊎ : isGroupoid A → isGroupoid B → isGroupoid (A ⊎ B) +isGroupoid⊎ = isOfHLevel⊎ 1 + +is2Groupoid⊎ : is2Groupoid A → is2Groupoid B → is2Groupoid (A ⊎ B) +is2Groupoid⊎ = isOfHLevel⊎ 2 + +discrete⊎ : Discrete A → Discrete B → Discrete (A ⊎ B) +discrete⊎ decA decB (inl a) (inl a') = + mapDec (cong inl) (λ p q → p (isEmbedding→Inj isEmbedding-inl _ _ q)) (decA a a') +discrete⊎ decA decB (inl a) (inr b') = no (λ p → lower (⊎Path.encode (inl a) (inr b') p)) +discrete⊎ decA decB (inr b) (inl a') = no ((λ p → lower (⊎Path.encode (inr b) (inl a') p))) +discrete⊎ decA decB (inr b) (inr b') = + mapDec (cong inr) (λ p q → p (isEmbedding→Inj isEmbedding-inr _ _ q)) (decB b b') + +⊎Iso : Iso A C → Iso B D → Iso (A ⊎ B) (C ⊎ D) +fun (⊎Iso iac ibd) (inl x) = inl (iac .fun x) +fun (⊎Iso iac ibd) (inr x) = inr (ibd .fun x) +inv (⊎Iso iac ibd) (inl x) = inl (iac .inv x) +inv (⊎Iso iac ibd) (inr x) = inr (ibd .inv x) +rightInv (⊎Iso iac ibd) (inl x) = cong inl (iac .rightInv x) +rightInv (⊎Iso iac ibd) (inr x) = cong inr (ibd .rightInv x) +leftInv (⊎Iso iac ibd) (inl x) = cong inl (iac .leftInv x) +leftInv (⊎Iso iac ibd) (inr x) = cong inr (ibd .leftInv x) + +⊎-equiv : A ≃ C → B ≃ D → (A ⊎ B) ≃ (C ⊎ D) +⊎-equiv p q = isoToEquiv (⊎Iso (equivToIso p) (equivToIso q)) + +⊎-swap-Iso : Iso (A ⊎ B) (B ⊎ A) +fun ⊎-swap-Iso (inl x) = inr x +fun ⊎-swap-Iso (inr x) = inl x +inv ⊎-swap-Iso (inl x) = inr x +inv ⊎-swap-Iso (inr x) = inl x +rightInv ⊎-swap-Iso (inl _) = refl +rightInv ⊎-swap-Iso (inr _) = refl +leftInv ⊎-swap-Iso (inl _) = refl +leftInv ⊎-swap-Iso (inr _) = refl + +⊎-swap-≃ : A ⊎ B ≃ B ⊎ A +⊎-swap-≃ = isoToEquiv ⊎-swap-Iso + +⊎-assoc-Iso : Iso ((A ⊎ B) ⊎ C) (A ⊎ (B ⊎ C)) +fun ⊎-assoc-Iso (inl (inl x)) = inl x +fun ⊎-assoc-Iso (inl (inr x)) = inr (inl x) +fun ⊎-assoc-Iso (inr x) = inr (inr x) +inv ⊎-assoc-Iso (inl x) = inl (inl x) +inv ⊎-assoc-Iso (inr (inl x)) = inl (inr x) +inv ⊎-assoc-Iso (inr (inr x)) = inr x +rightInv ⊎-assoc-Iso (inl _) = refl +rightInv ⊎-assoc-Iso (inr (inl _)) = refl +rightInv ⊎-assoc-Iso (inr (inr _)) = refl +leftInv ⊎-assoc-Iso (inl (inl _)) = refl +leftInv ⊎-assoc-Iso (inl (inr _)) = refl +leftInv ⊎-assoc-Iso (inr _) = refl + +⊎-assoc-≃ : (A ⊎ B) ⊎ C ≃ A ⊎ (B ⊎ C) +⊎-assoc-≃ = isoToEquiv ⊎-assoc-Iso + +⊎-IdR-⊥-Iso : Iso (A ⊎ ⊥) A +fun ⊎-IdR-⊥-Iso (inl x) = x +inv ⊎-IdR-⊥-Iso x = inl x +rightInv ⊎-IdR-⊥-Iso _ = refl +leftInv ⊎-IdR-⊥-Iso (inl _) = refl + +⊎-IdL-⊥-Iso : Iso (⊥ ⊎ A) A +fun ⊎-IdL-⊥-Iso (inr x) = x +inv ⊎-IdL-⊥-Iso x = inr x +rightInv ⊎-IdL-⊥-Iso _ = refl +leftInv ⊎-IdL-⊥-Iso (inr _) = refl + +⊎-IdL-⊥*-Iso : ∀{ℓ} → Iso (⊥* {ℓ} ⊎ A) A +fun ⊎-IdL-⊥*-Iso (inr x) = x +inv ⊎-IdL-⊥*-Iso x = inr x +rightInv ⊎-IdL-⊥*-Iso _ = refl +leftInv ⊎-IdL-⊥*-Iso (inr _) = refl + +⊎-IdR-⊥*-Iso : ∀{ℓ} → Iso (A ⊎ ⊥* {ℓ}) A +fun ⊎-IdR-⊥*-Iso (inl x) = x +inv ⊎-IdR-⊥*-Iso x = inl x +rightInv ⊎-IdR-⊥*-Iso _ = refl +leftInv ⊎-IdR-⊥*-Iso (inl _) = refl + +⊎-IdR-⊥-≃ : A ⊎ ⊥ ≃ A +⊎-IdR-⊥-≃ = isoToEquiv ⊎-IdR-⊥-Iso + +⊎-IdL-⊥-≃ : ⊥ ⊎ A ≃ A +⊎-IdL-⊥-≃ = isoToEquiv ⊎-IdL-⊥-Iso + +⊎-IdR-⊥*-≃ : ∀{ℓ} → A ⊎ ⊥* {ℓ} ≃ A +⊎-IdR-⊥*-≃ = isoToEquiv ⊎-IdR-⊥*-Iso + +⊎-IdL-⊥*-≃ : ∀{ℓ} → ⊥* {ℓ} ⊎ A ≃ A +⊎-IdL-⊥*-≃ = isoToEquiv ⊎-IdL-⊥*-Iso + +Π⊎Iso : Iso ((x : A ⊎ B) → E x) (((a : A) → E (inl a)) × ((b : B) → E (inr b))) +fun Π⊎Iso f .fst a = f (inl a) +fun Π⊎Iso f .snd b = f (inr b) +inv Π⊎Iso (g1 , g2) (inl a) = g1 a +inv Π⊎Iso (g1 , g2) (inr b) = g2 b +rightInv Π⊎Iso (g1 , g2) i .fst a = g1 a +rightInv Π⊎Iso (g1 , g2) i .snd b = g2 b +leftInv Π⊎Iso f i (inl a) = f (inl a) +leftInv Π⊎Iso f i (inr b) = f (inr b) + +Σ⊎Iso : Iso (Σ (A ⊎ B) E) ((Σ A (λ a → E (inl a))) ⊎ (Σ B (λ b → E (inr b)))) +fun Σ⊎Iso (inl a , ea) = inl (a , ea) +fun Σ⊎Iso (inr b , eb) = inr (b , eb) +inv Σ⊎Iso (inl (a , ea)) = (inl a , ea) +inv Σ⊎Iso (inr (b , eb)) = (inr b , eb) +rightInv Σ⊎Iso (inl (a , ea)) = refl +rightInv Σ⊎Iso (inr (b , eb)) = refl +leftInv Σ⊎Iso (inl a , ea) = refl +leftInv Σ⊎Iso (inr b , eb) = refl + +×DistL⊎Iso : Iso (A × (B ⊎ C)) ((A × B) ⊎ (A × C)) +fun ×DistL⊎Iso (a , inl b) = inl (a , b) +fun ×DistL⊎Iso (a , inr c) = inr (a , c) +inv ×DistL⊎Iso (inl (a , b)) = a , inl b +inv ×DistL⊎Iso (inr (a , c)) = a , inr c +rightInv ×DistL⊎Iso (inl (a , b)) = refl +rightInv ×DistL⊎Iso (inr (a , c)) = refl +leftInv ×DistL⊎Iso (a , inl b) = refl +leftInv ×DistL⊎Iso (a , inr c) = refl + +Π⊎≃ : ((x : A ⊎ B) → E x) ≃ ((a : A) → E (inl a)) × ((b : B) → E (inr b)) +Π⊎≃ = isoToEquiv Π⊎Iso + +Σ⊎≃ : (Σ (A ⊎ B) E) ≃ ((Σ A (λ a → E (inl a))) ⊎ (Σ B (λ b → E (inr b)))) +Σ⊎≃ = isoToEquiv Σ⊎Iso + +⊎Monotone↪ : A ↪ C → B ↪ D → (A ⊎ B) ↪ (C ⊎ D) +⊎Monotone↪ (f , embf) (g , embg) = (map f g) , emb + where coverToMap : ∀ x y → ⊎Path.Cover x y + → ⊎Path.Cover (map f g x) (map f g y) + coverToMap (inl _) (inl _) cover = lift (cong f (lower cover)) + coverToMap (inr _) (inr _) cover = lift (cong g (lower cover)) + + equiv : ∀ x y → isEquiv (coverToMap x y) + equiv (inl a₀) (inl a₁) + = ((invEquiv LiftEquiv) + ∙ₑ ((cong f) , (embf a₀ a₁)) + ∙ₑ LiftEquiv) .snd + equiv (inl a₀) (inr b₁) .equiv-proof () + equiv (inr b₀) (inl a₁) .equiv-proof () + equiv (inr b₀) (inr b₁) + = ((invEquiv LiftEquiv) + ∙ₑ ((cong g) , (embg b₀ b₁)) + ∙ₑ LiftEquiv) .snd + + lemma : ∀ x y + → ∀ (p : x ≡ y) + → cong (map f g) p ≡ + ⊎Path.decode + (map f g x) + (map f g y) + (coverToMap x y (⊎Path.encode x y p)) + lemma (inl a₀) _ + = J (λ y p + → cong (map f g) p ≡ + ⊎Path.decode (map f g (inl a₀)) + (map f g y) + (coverToMap (inl a₀) y + (⊎Path.encode (inl a₀) y p))) + (sym $ cong (cong inl) (cong (cong f) (transportRefl _))) + lemma (inr b₀) _ + = J (λ y p + → cong (map f g) p ≡ + ⊎Path.decode + (map f g (inr b₀)) + (map f g y) + (coverToMap (inr b₀) y (⊎Path.encode (inr b₀) y p))) + (sym $ cong (cong inr) (cong (cong g) (transportRefl _))) + + emb : isEmbedding (map f g) + emb x y = subst (λ eq → isEquiv eq) + (sym (funExt (lemma x y))) + ((x ≡ y ≃⟨ invEquiv (⊎Path.Cover≃Path x y) ⟩ + ⊎Path.Cover x y ≃⟨ (coverToMap x y) , (equiv x y) ⟩ + ⊎Path.Cover + (map f g x) + (map f g y) ≃⟨ ⊎Path.Cover≃Path + (map f g x) + (map f g y) ⟩ + map f g x ≡ map f g y ■) .snd) \ No newline at end of file diff --git a/Cubical.Data.SumFin.Properties.html b/Cubical.Data.SumFin.Properties.html index 1835097c7b..76af6e2f76 100644 --- a/Cubical.Data.SumFin.Properties.html +++ b/Cubical.Data.SumFin.Properties.html @@ -18,257 +18,257 @@ import Cubical.Data.Fin as Fin import Cubical.Data.Fin.LehmerCode as LehmerCode open import Cubical.Data.SumFin.Base as SumFin -open import Cubical.Data.Sum -open import Cubical.Data.Sigma +open import Cubical.Data.Sum as ⊎ +open import Cubical.Data.Sigma -open import Cubical.HITs.PropositionalTruncation as Prop +open import Cubical.HITs.PropositionalTruncation as Prop -open import Cubical.Relation.Nullary +open import Cubical.Relation.Nullary -private - variable - ℓ : Level - k : ℕ +private + variable + ℓ : Level + k : ℕ -SumFin→Fin : Fin k → Fin.Fin k -SumFin→Fin = SumFin.elim (λ {k} _ → Fin.Fin k) Fin.fzero Fin.fsuc +SumFin→Fin : Fin k → Fin.Fin k +SumFin→Fin = SumFin.elim (λ {k} _ → Fin.Fin k) Fin.fzero Fin.fsuc -Fin→SumFin : Fin.Fin k → Fin k -Fin→SumFin = Fin.elim (λ {k} _ → Fin k) fzero fsuc +Fin→SumFin : Fin.Fin k → Fin k +Fin→SumFin = Fin.elim (λ {k} _ → Fin k) fzero fsuc -Fin→SumFin-fsuc : (fk : Fin.Fin k) → Fin→SumFin (Fin.fsuc fk) ≡ fsuc (Fin→SumFin fk) -Fin→SumFin-fsuc = Fin.elim-fsuc (λ {k} _ → Fin k) fzero fsuc +Fin→SumFin-fsuc : (fk : Fin.Fin k) → Fin→SumFin (Fin.fsuc fk) ≡ fsuc (Fin→SumFin fk) +Fin→SumFin-fsuc = Fin.elim-fsuc (λ {k} _ → Fin k) fzero fsuc -SumFin→Fin→SumFin : (fk : Fin k) → Fin→SumFin (SumFin→Fin fk) ≡ fk -SumFin→Fin→SumFin = SumFin.elim (λ fk → Fin→SumFin (SumFin→Fin fk) ≡ fk) - refl λ {k} {fk} eq → - Fin→SumFin (Fin.fsuc (SumFin→Fin fk)) ≡⟨ Fin→SumFin-fsuc (SumFin→Fin fk) ⟩ - fsuc (Fin→SumFin (SumFin→Fin fk)) ≡⟨ cong fsuc eq ⟩ - fsuc fk ∎ +SumFin→Fin→SumFin : (fk : Fin k) → Fin→SumFin (SumFin→Fin fk) ≡ fk +SumFin→Fin→SumFin = SumFin.elim (λ fk → Fin→SumFin (SumFin→Fin fk) ≡ fk) + refl λ {k} {fk} eq → + Fin→SumFin (Fin.fsuc (SumFin→Fin fk)) ≡⟨ Fin→SumFin-fsuc (SumFin→Fin fk) ⟩ + fsuc (Fin→SumFin (SumFin→Fin fk)) ≡⟨ cong fsuc eq ⟩ + fsuc fk ∎ -Fin→SumFin→Fin : (fk : Fin.Fin k) → SumFin→Fin (Fin→SumFin fk) ≡ fk -Fin→SumFin→Fin = Fin.elim (λ fk → SumFin→Fin (Fin→SumFin fk) ≡ fk) - refl λ {k} {fk} eq → - SumFin→Fin (Fin→SumFin (Fin.fsuc fk)) ≡⟨ cong SumFin→Fin (Fin→SumFin-fsuc fk) ⟩ - Fin.fsuc (SumFin→Fin (Fin→SumFin fk)) ≡⟨ cong Fin.fsuc eq ⟩ - Fin.fsuc fk ∎ +Fin→SumFin→Fin : (fk : Fin.Fin k) → SumFin→Fin (Fin→SumFin fk) ≡ fk +Fin→SumFin→Fin = Fin.elim (λ fk → SumFin→Fin (Fin→SumFin fk) ≡ fk) + refl λ {k} {fk} eq → + SumFin→Fin (Fin→SumFin (Fin.fsuc fk)) ≡⟨ cong SumFin→Fin (Fin→SumFin-fsuc fk) ⟩ + Fin.fsuc (SumFin→Fin (Fin→SumFin fk)) ≡⟨ cong Fin.fsuc eq ⟩ + Fin.fsuc fk ∎ -SumFin≃Fin : ∀ k → Fin k ≃ Fin.Fin k -SumFin≃Fin _ = - isoToEquiv (iso SumFin→Fin Fin→SumFin Fin→SumFin→Fin SumFin→Fin→SumFin) +SumFin≃Fin : ∀ k → Fin k ≃ Fin.Fin k +SumFin≃Fin _ = + isoToEquiv (iso SumFin→Fin Fin→SumFin Fin→SumFin→Fin SumFin→Fin→SumFin) -SumFin≡Fin : ∀ k → Fin k ≡ Fin.Fin k -SumFin≡Fin k = ua (SumFin≃Fin k) +SumFin≡Fin : ∀ k → Fin k ≡ Fin.Fin k +SumFin≡Fin k = ua (SumFin≃Fin k) -enum : (n : ℕ)(p : n < k) → Fin k -enum n p = Fin→SumFin (n , p) +enum : (n : ℕ)(p : n < k) → Fin k +enum n p = Fin→SumFin (n , p) -enumElim : (P : Fin k → Type ℓ) → ((n : ℕ)(p : n < k) → P (enum _ p)) → (i : Fin k) → P i -enumElim P f i = subst P (SumFin→Fin→SumFin i) (f (SumFin→Fin i .fst) (SumFin→Fin i .snd)) +enumElim : (P : Fin k → Type ℓ) → ((n : ℕ)(p : n < k) → P (enum _ p)) → (i : Fin k) → P i +enumElim P f i = subst P (SumFin→Fin→SumFin i) (f (SumFin→Fin i .fst) (SumFin→Fin i .snd)) --- Closure properties of SumFin under type constructors +-- Closure properties of SumFin under type constructors -SumFin⊎≃ : (m n : ℕ) → (Fin m ⊎ Fin n) ≃ (Fin (m + n)) -SumFin⊎≃ 0 n = ⊎-swap-≃ ⋆ ⊎-⊥-≃ -SumFin⊎≃ (suc m) n = ⊎-assoc-≃ ⋆ ⊎-equiv (idEquiv ⊤) (SumFin⊎≃ m n) +SumFin⊎≃ : (m n : ℕ) → (Fin m ⊎ Fin n) ≃ (Fin (m + n)) +SumFin⊎≃ 0 n = ⊎-swap-≃ ⋆ ⊎-IdR-⊥-≃ +SumFin⊎≃ (suc m) n = ⊎-assoc-≃ ⋆ ⊎-equiv (idEquiv ⊤) (SumFin⊎≃ m n) -SumFinΣ≃ : (n : ℕ)(f : Fin n → ℕ) → (Σ (Fin n) (λ x → Fin (f x))) ≃ (Fin (totalSum f)) -SumFinΣ≃ 0 f = ΣEmpty _ -SumFinΣ≃ (suc n) f = - Σ⊎≃ - ⋆ ⊎-equiv (ΣUnit (λ tt → Fin (f (inl tt)))) (SumFinΣ≃ n (λ x → f (inr x))) - ⋆ SumFin⊎≃ (f (inl tt)) (totalSum (λ x → f (inr x))) +SumFinΣ≃ : (n : ℕ)(f : Fin n → ℕ) → (Σ (Fin n) (λ x → Fin (f x))) ≃ (Fin (totalSum f)) +SumFinΣ≃ 0 f = ΣEmpty _ +SumFinΣ≃ (suc n) f = + Σ⊎≃ + ⋆ ⊎-equiv (ΣUnit (λ tt → Fin (f (inl tt)))) (SumFinΣ≃ n (λ x → f (inr x))) + ⋆ SumFin⊎≃ (f (inl tt)) (totalSum (λ x → f (inr x))) -SumFin×≃ : (m n : ℕ) → (Fin m × Fin n) ≃ (Fin (m · n)) -SumFin×≃ m n = SumFinΣ≃ m (λ _ → n) ⋆ pathToEquiv (λ i → Fin (totalSumConst {m = m} n i)) +SumFin×≃ : (m n : ℕ) → (Fin m × Fin n) ≃ (Fin (m · n)) +SumFin×≃ m n = SumFinΣ≃ m (λ _ → n) ⋆ pathToEquiv (λ i → Fin (totalSumConst {m = m} n i)) -SumFinΠ≃ : (n : ℕ)(f : Fin n → ℕ) → ((x : Fin n) → Fin (f x)) ≃ (Fin (totalProd f)) -SumFinΠ≃ 0 _ = isContr→≃Unit (isContrΠ⊥) ⋆ invEquiv (⊎-⊥-≃) -SumFinΠ≃ (suc n) f = - Π⊎≃ - ⋆ Σ-cong-equiv (ΠUnit (λ tt → Fin (f (inl tt)))) (λ _ → SumFinΠ≃ n (λ x → f (inr x))) - ⋆ SumFin×≃ (f (inl tt)) (totalProd (λ x → f (inr x))) +SumFinΠ≃ : (n : ℕ)(f : Fin n → ℕ) → ((x : Fin n) → Fin (f x)) ≃ (Fin (totalProd f)) +SumFinΠ≃ 0 _ = isContr→≃Unit (isContrΠ⊥) ⋆ invEquiv (⊎-IdR-⊥-≃) +SumFinΠ≃ (suc n) f = + Π⊎≃ + ⋆ Σ-cong-equiv (ΠUnit (λ tt → Fin (f (inl tt)))) (λ _ → SumFinΠ≃ n (λ x → f (inr x))) + ⋆ SumFin×≃ (f (inl tt)) (totalProd (λ x → f (inr x))) -isNotZero : ℕ → ℕ -isNotZero 0 = 0 -isNotZero (suc n) = 1 +isNotZero : ℕ → ℕ +isNotZero 0 = 0 +isNotZero (suc n) = 1 -SumFin∥∥≃ : (n : ℕ) → ∥ Fin n ∥₁ ≃ Fin (isNotZero n) -SumFin∥∥≃ 0 = propTruncIdempotent≃ (isProp⊥) -SumFin∥∥≃ (suc n) = - isContr→≃Unit (inhProp→isContr ∣ inl tt ∣₁ isPropPropTrunc) - ⋆ isContr→≃Unit (isContrUnit) ⋆ invEquiv (⊎-⊥-≃) - -ℕ→Bool : ℕ → Bool -ℕ→Bool 0 = false -ℕ→Bool (suc n) = true - -SumFin∥∥DecProp : (n : ℕ) → ∥ Fin n ∥₁ ≃ Bool→Type (ℕ→Bool n) -SumFin∥∥DecProp 0 = uninhabEquiv (Prop.rec isProp⊥ ⊥.rec) ⊥.rec -SumFin∥∥DecProp (suc n) = isContr→≃Unit (inhProp→isContr ∣ inl tt ∣₁ isPropPropTrunc) - --- negation of SumFin - -SumFin¬ : (n : ℕ) → (¬ Fin n) ≃ Bool→Type (isZero n) -SumFin¬ 0 = isContr→≃Unit isContr⊥→A -SumFin¬ (suc n) = uninhabEquiv (λ f → f fzero) ⊥.rec - --- SumFin 1 is equivalent to unit - -Fin1≃Unit : Fin 1 ≃ Unit -Fin1≃Unit = ⊎-⊥-≃ - -isContrSumFin1 : isContr (Fin 1) -isContrSumFin1 = isOfHLevelRespectEquiv 0 (invEquiv Fin1≃Unit) isContrUnit +SumFin∥∥≃ : (n : ℕ) → ∥ Fin n ∥₁ ≃ Fin (isNotZero n) +SumFin∥∥≃ 0 = propTruncIdempotent≃ (isProp⊥) +SumFin∥∥≃ (suc n) = + isContr→≃Unit (inhProp→isContr ∣ inl tt ∣₁ isPropPropTrunc) + ⋆ isContr→≃Unit (isContrUnit) ⋆ invEquiv (⊎-IdR-⊥-≃) + +ℕ→Bool : ℕ → Bool +ℕ→Bool 0 = false +ℕ→Bool (suc n) = true + +SumFin∥∥DecProp : (n : ℕ) → ∥ Fin n ∥₁ ≃ Bool→Type (ℕ→Bool n) +SumFin∥∥DecProp 0 = uninhabEquiv (Prop.rec isProp⊥ ⊥.rec) ⊥.rec +SumFin∥∥DecProp (suc n) = isContr→≃Unit (inhProp→isContr ∣ inl tt ∣₁ isPropPropTrunc) + +-- negation of SumFin + +SumFin¬ : (n : ℕ) → (¬ Fin n) ≃ Bool→Type (isZero n) +SumFin¬ 0 = isContr→≃Unit isContr⊥→A +SumFin¬ (suc n) = uninhabEquiv (λ f → f fzero) ⊥.rec + +-- SumFin 1 is equivalent to unit + +Fin1≃Unit : Fin 1 ≃ Unit +Fin1≃Unit = ⊎-IdR-⊥-≃ + +isContrSumFin1 : isContr (Fin 1) +isContrSumFin1 = isOfHLevelRespectEquiv 0 (invEquiv Fin1≃Unit) isContrUnit --- SumFin 2 is equivalent to Bool +-- SumFin 2 is equivalent to Bool -SumFin2≃Bool : Fin 2 ≃ Bool -SumFin2≃Bool = ⊎-equiv (idEquiv _) ⊎-⊥-≃ ⋆ isoToEquiv Iso-⊤⊎⊤-Bool - --- decidable predicate over SumFin +SumFin2≃Bool : Fin 2 ≃ Bool +SumFin2≃Bool = ⊎-equiv (idEquiv _) ⊎-IdR-⊥-≃ ⋆ isoToEquiv Iso-⊤⊎⊤-Bool + +-- decidable predicate over SumFin -SumFinℙ≃ : (n : ℕ) → (Fin n → Bool) ≃ Fin (2 ^ n) -SumFinℙ≃ 0 = isContr→≃Unit (isContrΠ⊥) ⋆ invEquiv (⊎-⊥-≃) -SumFinℙ≃ (suc n) = - Π⊎≃ - ⋆ Σ-cong-equiv (UnitToType≃ Bool ⋆ invEquiv SumFin2≃Bool) (λ _ → SumFinℙ≃ n) - ⋆ SumFin×≃ 2 (2 ^ n) +SumFinℙ≃ : (n : ℕ) → (Fin n → Bool) ≃ Fin (2 ^ n) +SumFinℙ≃ 0 = isContr→≃Unit (isContrΠ⊥) ⋆ invEquiv (⊎-IdR-⊥-≃) +SumFinℙ≃ (suc n) = + Π⊎≃ + ⋆ Σ-cong-equiv (UnitToType≃ Bool ⋆ invEquiv SumFin2≃Bool) (λ _ → SumFinℙ≃ n) + ⋆ SumFin×≃ 2 (2 ^ n) --- decidable subsets of SumFin - -Bool→ℕ : Bool → ℕ -Bool→ℕ true = 1 -Bool→ℕ false = 0 - -trueCount : {n : ℕ}(f : Fin n → Bool) → ℕ -trueCount {n = 0} _ = 0 -trueCount {n = suc n} f = Bool→ℕ (f (inl tt)) + (trueCount (f ∘ inr)) +-- decidable subsets of SumFin + +Bool→ℕ : Bool → ℕ +Bool→ℕ true = 1 +Bool→ℕ false = 0 + +trueCount : {n : ℕ}(f : Fin n → Bool) → ℕ +trueCount {n = 0} _ = 0 +trueCount {n = suc n} f = Bool→ℕ (f (inl tt)) + (trueCount (f ∘ inr)) -SumFinDec⊎≃ : (n : ℕ)(t : Bool) → (Bool→Type t ⊎ Fin n) ≃ (Fin (Bool→ℕ t + n)) -SumFinDec⊎≃ _ true = idEquiv _ -SumFinDec⊎≃ _ false = ⊎-swap-≃ ⋆ ⊎-⊥-≃ +SumFinDec⊎≃ : (n : ℕ)(t : Bool) → (Bool→Type t ⊎ Fin n) ≃ (Fin (Bool→ℕ t + n)) +SumFinDec⊎≃ _ true = idEquiv _ +SumFinDec⊎≃ _ false = ⊎-swap-≃ ⋆ ⊎-IdR-⊥-≃ -SumFinSub≃ : (n : ℕ)(f : Fin n → Bool) → Σ _ (Bool→Type ∘ f) ≃ Fin (trueCount f) -SumFinSub≃ 0 _ = ΣEmpty _ -SumFinSub≃ (suc n) f = - Σ⊎≃ - ⋆ ⊎-equiv (ΣUnit (Bool→Type ∘ f ∘ inl)) (SumFinSub≃ n (f ∘ inr)) - ⋆ SumFinDec⊎≃ _ (f (inl tt)) +SumFinSub≃ : (n : ℕ)(f : Fin n → Bool) → Σ _ (Bool→Type ∘ f) ≃ Fin (trueCount f) +SumFinSub≃ 0 _ = ΣEmpty _ +SumFinSub≃ (suc n) f = + Σ⊎≃ + ⋆ ⊎-equiv (ΣUnit (Bool→Type ∘ f ∘ inl)) (SumFinSub≃ n (f ∘ inr)) + ⋆ SumFinDec⊎≃ _ (f (inl tt)) --- decidable quantifier +-- decidable quantifier -trueForSome : (n : ℕ)(f : Fin n → Bool) → Bool -trueForSome 0 _ = false -trueForSome (suc n) f = f (inl tt) or trueForSome n (f ∘ inr) - -trueForAll : (n : ℕ)(f : Fin n → Bool) → Bool -trueForAll 0 _ = true -trueForAll (suc n) f = f (inl tt) and trueForAll n (f ∘ inr) +trueForSome : (n : ℕ)(f : Fin n → Bool) → Bool +trueForSome 0 _ = false +trueForSome (suc n) f = f (inl tt) or trueForSome n (f ∘ inr) + +trueForAll : (n : ℕ)(f : Fin n → Bool) → Bool +trueForAll 0 _ = true +trueForAll (suc n) f = f (inl tt) and trueForAll n (f ∘ inr) -SumFin∃→ : (n : ℕ)(f : Fin n → Bool) → Σ _ (Bool→Type ∘ f) → Bool→Type (trueForSome n f) -SumFin∃→ 0 _ = ΣEmpty _ .fst -SumFin∃→ (suc n) f = - Bool→Type⊎' _ _ - ∘ map-⊎ (ΣUnit (Bool→Type ∘ f ∘ inl) .fst) (SumFin∃→ n (f ∘ inr)) - ∘ Σ⊎≃ .fst - -SumFin∃← : (n : ℕ)(f : Fin n → Bool) → Bool→Type (trueForSome n f) → Σ _ (Bool→Type ∘ f) -SumFin∃← 0 _ = ⊥.rec -SumFin∃← (suc n) f = - invEq Σ⊎≃ - ∘ map-⊎ (invEq (ΣUnit (Bool→Type ∘ f ∘ inl))) (SumFin∃← n (f ∘ inr)) - ∘ Bool→Type⊎ _ _ - -SumFin∃≃ : (n : ℕ)(f : Fin n → Bool) → ∥ Σ (Fin n) (Bool→Type ∘ f) ∥₁ ≃ Bool→Type (trueForSome n f) -SumFin∃≃ n f = - propBiimpl→Equiv isPropPropTrunc isPropBool→Type - (Prop.rec isPropBool→Type (SumFin∃→ n f)) - (∣_∣₁ ∘ SumFin∃← n f) - -SumFin∀≃ : (n : ℕ)(f : Fin n → Bool) → ((x : Fin n) → Bool→Type (f x)) ≃ Bool→Type (trueForAll n f) -SumFin∀≃ 0 _ = isContr→≃Unit (isContrΠ⊥) -SumFin∀≃ (suc n) f = - Π⊎≃ - ⋆ Σ-cong-equiv (ΠUnit (Bool→Type ∘ f ∘ inl)) (λ _ → SumFin∀≃ n (f ∘ inr)) - ⋆ Bool→Type×≃ _ _ +SumFin∃→ : (n : ℕ)(f : Fin n → Bool) → Σ _ (Bool→Type ∘ f) → Bool→Type (trueForSome n f) +SumFin∃→ 0 _ = ΣEmpty _ .fst +SumFin∃→ (suc n) f = + Bool→Type⊎' _ _ + ∘ ⊎.map (ΣUnit (Bool→Type ∘ f ∘ inl) .fst) (SumFin∃→ n (f ∘ inr)) + ∘ Σ⊎≃ .fst + +SumFin∃← : (n : ℕ)(f : Fin n → Bool) → Bool→Type (trueForSome n f) → Σ _ (Bool→Type ∘ f) +SumFin∃← 0 _ = ⊥.rec +SumFin∃← (suc n) f = + invEq Σ⊎≃ + ∘ ⊎.map (invEq (ΣUnit (Bool→Type ∘ f ∘ inl))) (SumFin∃← n (f ∘ inr)) + ∘ Bool→Type⊎ _ _ + +SumFin∃≃ : (n : ℕ)(f : Fin n → Bool) → ∥ Σ (Fin n) (Bool→Type ∘ f) ∥₁ ≃ Bool→Type (trueForSome n f) +SumFin∃≃ n f = + propBiimpl→Equiv isPropPropTrunc isPropBool→Type + (Prop.rec isPropBool→Type (SumFin∃→ n f)) + (∣_∣₁ ∘ SumFin∃← n f) + +SumFin∀≃ : (n : ℕ)(f : Fin n → Bool) → ((x : Fin n) → Bool→Type (f x)) ≃ Bool→Type (trueForAll n f) +SumFin∀≃ 0 _ = isContr→≃Unit (isContrΠ⊥) +SumFin∀≃ (suc n) f = + Π⊎≃ + ⋆ Σ-cong-equiv (ΠUnit (Bool→Type ∘ f ∘ inl)) (λ _ → SumFin∀≃ n (f ∘ inr)) + ⋆ Bool→Type×≃ _ _ --- internal equality - -SumFin≡ : (n : ℕ) → (a b : Fin n) → Bool -SumFin≡ 0 _ _ = true -SumFin≡ (suc n) (inl tt) (inl tt) = true -SumFin≡ (suc n) (inl tt) (inr y) = false -SumFin≡ (suc n) (inr x) (inl tt) = false -SumFin≡ (suc n) (inr x) (inr y) = SumFin≡ n x y +-- internal equality + +SumFin≡ : (n : ℕ) → (a b : Fin n) → Bool +SumFin≡ 0 _ _ = true +SumFin≡ (suc n) (inl tt) (inl tt) = true +SumFin≡ (suc n) (inl tt) (inr y) = false +SumFin≡ (suc n) (inr x) (inl tt) = false +SumFin≡ (suc n) (inr x) (inr y) = SumFin≡ n x y -isSetSumFin : (n : ℕ)→ isSet (Fin n) -isSetSumFin 0 = isProp→isSet isProp⊥ -isSetSumFin (suc n) = isSet⊎ (isProp→isSet isPropUnit) (isSetSumFin n) +isSetSumFin : (n : ℕ)→ isSet (Fin n) +isSetSumFin 0 = isProp→isSet isProp⊥ +isSetSumFin (suc n) = isSet⊎ (isProp→isSet isPropUnit) (isSetSumFin n) -SumFin≡≃ : (n : ℕ) → (a b : Fin n) → (a ≡ b) ≃ Bool→Type (SumFin≡ n a b) -SumFin≡≃ 0 _ _ = isContr→≃Unit (isProp→isContrPath isProp⊥ _ _) -SumFin≡≃ (suc n) (inl tt) (inl tt) = isContr→≃Unit (inhProp→isContr refl (isSetSumFin _ _ _)) -SumFin≡≃ (suc n) (inl tt) (inr y) = invEquiv (⊎Path.Cover≃Path _ _) ⋆ uninhabEquiv ⊥.rec* ⊥.rec -SumFin≡≃ (suc n) (inr x) (inl tt) = invEquiv (⊎Path.Cover≃Path _ _) ⋆ uninhabEquiv ⊥.rec* ⊥.rec -SumFin≡≃ (suc n) (inr x) (inr y) = invEquiv (_ , isEmbedding-inr x y) ⋆ SumFin≡≃ n x y +SumFin≡≃ : (n : ℕ) → (a b : Fin n) → (a ≡ b) ≃ Bool→Type (SumFin≡ n a b) +SumFin≡≃ 0 _ _ = isContr→≃Unit (isProp→isContrPath isProp⊥ _ _) +SumFin≡≃ (suc n) (inl tt) (inl tt) = isContr→≃Unit (inhProp→isContr refl (isSetSumFin _ _ _)) +SumFin≡≃ (suc n) (inl tt) (inr y) = invEquiv (⊎Path.Cover≃Path _ _) ⋆ uninhabEquiv ⊥.rec* ⊥.rec +SumFin≡≃ (suc n) (inr x) (inl tt) = invEquiv (⊎Path.Cover≃Path _ _) ⋆ uninhabEquiv ⊥.rec* ⊥.rec +SumFin≡≃ (suc n) (inr x) (inr y) = invEquiv (_ , isEmbedding-inr x y) ⋆ SumFin≡≃ n x y --- propositional truncation of Fin - --- decidability of Fin - -DecFin : (n : ℕ) → Dec (Fin n) -DecFin 0 = no (idfun _) -DecFin (suc n) = yes fzero - --- propositional truncation of Fin - -Dec∥Fin∥ : (n : ℕ) → Dec ∥ Fin n ∥₁ -Dec∥Fin∥ n = Dec∥∥ (DecFin n) - --- some properties about cardinality - -fzero≠fone : {n : ℕ} → ¬ (fzero ≡ fsuc fzero) -fzero≠fone {n = n} = SumFin≡≃ (suc (suc n)) fzero (fsuc fzero) .fst - -Fin>0→isInhab : (n : ℕ) → 0 < n → Fin n -Fin>0→isInhab 0 p = ⊥.rec (¬-<-zero p) -Fin>0→isInhab (suc n) p = fzero - -Fin>1→hasNonEqualTerm : (n : ℕ) → 1 < n → Σ[ i ∈ Fin n ] Σ[ j ∈ Fin n ] ¬ i ≡ j -Fin>1→hasNonEqualTerm 0 p = ⊥.rec (snotz (≤0→≡0 p)) -Fin>1→hasNonEqualTerm 1 p = ⊥.rec (snotz (≤0→≡0 (pred-≤-pred p))) -Fin>1→hasNonEqualTerm (suc (suc n)) _ = fzero , fsuc fzero , fzero≠fone - -isEmpty→Fin≡0 : (n : ℕ) → ¬ Fin n → 0 ≡ n -isEmpty→Fin≡0 0 _ = refl -isEmpty→Fin≡0 (suc n) p = ⊥.rec (p fzero) - -isInhab→Fin>0 : (n : ℕ) → Fin n → 0 < n -isInhab→Fin>0 0 i = ⊥.rec i -isInhab→Fin>0 (suc n) _ = suc-≤-suc zero-≤ - -hasNonEqualTerm→Fin>1 : (n : ℕ) → (i j : Fin n) → ¬ i ≡ j → 1 < n -hasNonEqualTerm→Fin>1 0 i _ _ = ⊥.rec i -hasNonEqualTerm→Fin>1 1 i j p = ⊥.rec (p (isContr→isProp isContrSumFin1 i j)) -hasNonEqualTerm→Fin>1 (suc (suc n)) _ _ _ = suc-≤-suc (suc-≤-suc zero-≤) - -Fin≤1→isProp : (n : ℕ) → n ≤ 1 → isProp (Fin n) -Fin≤1→isProp 0 _ = isProp⊥ -Fin≤1→isProp 1 _ = isContr→isProp isContrSumFin1 -Fin≤1→isProp (suc (suc n)) p = ⊥.rec (¬-<-zero (pred-≤-pred p)) - -isProp→Fin≤1 : (n : ℕ) → isProp (Fin n) → n ≤ 1 -isProp→Fin≤1 0 _ = ≤-solver 0 1 -isProp→Fin≤1 1 _ = ≤-solver 1 1 -isProp→Fin≤1 (suc (suc n)) p = ⊥.rec (fzero≠fone (p fzero (fsuc fzero))) - --- automorphisms of SumFin - -SumFin≃≃ : (n : ℕ) → (Fin n ≃ Fin n) ≃ Fin (LehmerCode.factorial n) -SumFin≃≃ _ = - equivComp (SumFin≃Fin _) (SumFin≃Fin _) - ⋆ LehmerCode.lehmerEquiv - ⋆ LehmerCode.lehmerFinEquiv - ⋆ invEquiv (SumFin≃Fin _) +-- propositional truncation of Fin + +-- decidability of Fin + +DecFin : (n : ℕ) → Dec (Fin n) +DecFin 0 = no (idfun _) +DecFin (suc n) = yes fzero + +-- propositional truncation of Fin + +Dec∥Fin∥ : (n : ℕ) → Dec ∥ Fin n ∥₁ +Dec∥Fin∥ n = Dec∥∥ (DecFin n) + +-- some properties about cardinality + +fzero≠fone : {n : ℕ} → ¬ (fzero ≡ fsuc fzero) +fzero≠fone {n = n} = SumFin≡≃ (suc (suc n)) fzero (fsuc fzero) .fst + +Fin>0→isInhab : (n : ℕ) → 0 < n → Fin n +Fin>0→isInhab 0 p = ⊥.rec (¬-<-zero p) +Fin>0→isInhab (suc n) p = fzero + +Fin>1→hasNonEqualTerm : (n : ℕ) → 1 < n → Σ[ i ∈ Fin n ] Σ[ j ∈ Fin n ] ¬ i ≡ j +Fin>1→hasNonEqualTerm 0 p = ⊥.rec (snotz (≤0→≡0 p)) +Fin>1→hasNonEqualTerm 1 p = ⊥.rec (snotz (≤0→≡0 (pred-≤-pred p))) +Fin>1→hasNonEqualTerm (suc (suc n)) _ = fzero , fsuc fzero , fzero≠fone + +isEmpty→Fin≡0 : (n : ℕ) → ¬ Fin n → 0 ≡ n +isEmpty→Fin≡0 0 _ = refl +isEmpty→Fin≡0 (suc n) p = ⊥.rec (p fzero) + +isInhab→Fin>0 : (n : ℕ) → Fin n → 0 < n +isInhab→Fin>0 0 i = ⊥.rec i +isInhab→Fin>0 (suc n) _ = suc-≤-suc zero-≤ + +hasNonEqualTerm→Fin>1 : (n : ℕ) → (i j : Fin n) → ¬ i ≡ j → 1 < n +hasNonEqualTerm→Fin>1 0 i _ _ = ⊥.rec i +hasNonEqualTerm→Fin>1 1 i j p = ⊥.rec (p (isContr→isProp isContrSumFin1 i j)) +hasNonEqualTerm→Fin>1 (suc (suc n)) _ _ _ = suc-≤-suc (suc-≤-suc zero-≤) + +Fin≤1→isProp : (n : ℕ) → n ≤ 1 → isProp (Fin n) +Fin≤1→isProp 0 _ = isProp⊥ +Fin≤1→isProp 1 _ = isContr→isProp isContrSumFin1 +Fin≤1→isProp (suc (suc n)) p = ⊥.rec (¬-<-zero (pred-≤-pred p)) + +isProp→Fin≤1 : (n : ℕ) → isProp (Fin n) → n ≤ 1 +isProp→Fin≤1 0 _ = ≤-solver 0 1 +isProp→Fin≤1 1 _ = ≤-solver 1 1 +isProp→Fin≤1 (suc (suc n)) p = ⊥.rec (fzero≠fone (p fzero (fsuc fzero))) + +-- automorphisms of SumFin + +SumFin≃≃ : (n : ℕ) → (Fin n ≃ Fin n) ≃ Fin (LehmerCode.factorial n) +SumFin≃≃ _ = + equivComp (SumFin≃Fin _) (SumFin≃Fin _) + ⋆ LehmerCode.lehmerEquiv + ⋆ LehmerCode.lehmerFinEquiv + ⋆ invEquiv (SumFin≃Fin _) \ No newline at end of file diff --git a/Cubical.Displayed.Base.html b/Cubical.Displayed.Base.html index 097185c4ec..ca30a8cf96 100644 --- a/Cubical.Displayed.Base.html +++ b/Cubical.Displayed.Base.html @@ -38,13 +38,13 @@ ρ : (a : A) → a ≅ a ρ a = ≡→≅ refl -open BinaryRelation +open BinaryRelation -- another constructor for UARel using contractibility of relational singletons make-𝒮 : {A : Type ℓA} {_≅_ : A → A → Type ℓ≅A} - (ρ : isRefl _≅_) (contrTotal : contrRelSingl _≅_) → UARel A ℓ≅A + (ρ : isRefl _≅_) (contrTotal : contrRelSingl _≅_) → UARel A ℓ≅A UARel._≅_ (make-𝒮 {_≅_ = _≅_} _ _) = _≅_ -UARel.ua (make-𝒮 {_≅_ = _≅_} ρ c) = contrRelSingl→isUnivalent _≅_ ρ c +UARel.ua (make-𝒮 {_≅_ = _≅_} ρ c) = contrRelSingl→isUnivalent _≅_ ρ c record DUARel {A : Type ℓA} (𝒮-A : UARel A ℓ≅A) (B : A → Type ℓB) (ℓ≅B : Level) : Type (ℓ-max (ℓ-max ℓA ℓB) (ℓ-max ℓ≅A (ℓ-suc ℓ≅B))) where @@ -56,7 +56,7 @@ _≅ᴰ⟨_⟩_ : {a a' : A} → B a → a ≅ a' → B a' → Type ℓ≅B uaᴰ : {a a' : A} (b : B a) (p : a ≅ a') (b' : B a') → (b ≅ᴰ⟨ p ⟩ b') ≃ PathP (λ i → B (≅→≡ p i)) b b' - fiberRel : (a : A) → Rel (B a) (B a) ℓ≅B + fiberRel : (a : A) → Rel (B a) (B a) ℓ≅B fiberRel a = _≅ᴰ⟨ ρ a ⟩_ uaᴰρ : {a : A} (b b' : B a) → b ≅ᴰ⟨ ρ a ⟩ b' ≃ (b ≡ b') @@ -83,7 +83,7 @@ UARel._≅_ ∫ (a , b) (a' , b') = Σ[ p ∈ a ≅ a' ] (b ≅ᴰ⟨ p ⟩ b') UARel.ua ∫ (a , b) (a' , b') = compEquiv - (Σ-cong-equiv (ua a a') (λ p → uaᴰ b p b')) + (Σ-cong-equiv (ua a a') (λ p → uaᴰ b p b')) ΣPath≃PathΣ \ No newline at end of file diff --git a/Cubical.Displayed.Prop.html b/Cubical.Displayed.Prop.html index 581add6e01..046c15ca98 100644 --- a/Cubical.Displayed.Prop.html +++ b/Cubical.Displayed.Prop.html @@ -37,7 +37,7 @@ → UARel (Σ A P) ℓ≅A 𝒮-subtype 𝒮-A propP .UARel._≅_ (a , _) (a' , _) = 𝒮-A .UARel._≅_ a a' 𝒮-subtype 𝒮-A propP .UARel.ua (a , _) (a' , _) = - compEquiv (𝒮-A .UARel.ua a a') (Σ≡PropEquiv propP) + compEquiv (𝒮-A .UARel.ua a a') (Σ≡PropEquiv propP) 𝒮ᴰ-subtype : {A : Type ℓA} {𝒮-A : UARel A ℓ≅A} {B : A → Type ℓB} (𝒮ᴰ-B : DUARel 𝒮-A B ℓ≅B) @@ -49,6 +49,6 @@ compEquiv (𝒮ᴰ-B .DUARel.uaᴰ b p b') (compEquiv - (invEquiv (Σ-contractSnd λ _ → isOfHLevelPathP' 0 (propP _ b') _ _)) + (invEquiv (Σ-contractSnd λ _ → isOfHLevelPathP' 0 (propP _ b') _ _)) ΣPath≃PathΣ) \ No newline at end of file diff --git a/Cubical.Displayed.Properties.html b/Cubical.Displayed.Properties.html index 2ce8c1c271..5e0907a8d9 100644 --- a/Cubical.Displayed.Properties.html +++ b/Cubical.Displayed.Properties.html @@ -12,7 +12,7 @@ open import Cubical.Data.Sigma open import Cubical.Relation.Binary -open BinaryRelation +open BinaryRelation open import Cubical.Displayed.Base @@ -81,19 +81,19 @@ -- constructor that reduces univalence further to contractibility of relational singletons - 𝒮ᴰ-make-2 : (ρᴰ : {a : A} → isRefl _≅ᴰ⟨ ρ a ⟩_) - (contrTotal : (a : A) → contrRelSingl _≅ᴰ⟨ ρ a ⟩_) + 𝒮ᴰ-make-2 : (ρᴰ : {a : A} → isRefl _≅ᴰ⟨ ρ a ⟩_) + (contrTotal : (a : A) → contrRelSingl _≅ᴰ⟨ ρ a ⟩_) → DUARel 𝒮-A B ℓ≅B - 𝒮ᴰ-make-2 ρᴰ contrTotal = 𝒮ᴰ-make-1 (contrRelSingl→isUnivalent _ ρᴰ (contrTotal _)) + 𝒮ᴰ-make-2 ρᴰ contrTotal = 𝒮ᴰ-make-1 (contrRelSingl→isUnivalent _ ρᴰ (contrTotal _)) -- relational isomorphisms 𝒮-iso→iso : {A : Type ℓA} (𝒮-A : UARel A ℓ≅A) {B : Type ℓB} (𝒮-B : UARel B ℓ≅B) - (F : RelIso (UARel._≅_ 𝒮-A) (UARel._≅_ 𝒮-B)) + (F : RelIso (UARel._≅_ 𝒮-A) (UARel._≅_ 𝒮-B)) → Iso A B 𝒮-iso→iso 𝒮-A 𝒮-B F - = RelIso→Iso (UARel._≅_ 𝒮-A) + = RelIso→Iso (UARel._≅_ 𝒮-A) (UARel._≅_ 𝒮-B) (UARel.≅→≡ 𝒮-A) (UARel.≅→≡ 𝒮-B) @@ -123,14 +123,14 @@ -- the following can of course be done slightly more generally -- for fiberwise binary relations - F*fiberRelB' : (a : A) → Rel (B' (f a)) (B' (f a)) ℓ≅B' + F*fiberRelB' : (a : A) → Rel (B' (f a)) (B' (f a)) ℓ≅B' F*fiberRelB' a = fiberRelB' (f a) - module _ (G : (a : A) → RelIso (fiberRelB a) (F*fiberRelB' a)) where + module _ (G : (a : A) → RelIso (fiberRelB a) (F*fiberRelB' a)) where private fiberIsoOver : (a : A) → Iso (B a) (B' (f a)) fiberIsoOver a - = RelIso→Iso (fiberRelB a) + = RelIso→Iso (fiberRelB a) (F*fiberRelB' a) (equivFun (uaᴰρB _ _)) (equivFun (uaᴰρB' _ _)) @@ -139,5 +139,5 @@ -- DUARelFiberIsoOver→TotalIso produces an isomorphism of total spaces -- from a relational isomorphism between B a and (F * B) a 𝒮ᴰ-fiberIsoOver→totalIso : Iso (Σ A B) (Σ A' B') - 𝒮ᴰ-fiberIsoOver→totalIso = Σ-cong-iso F fiberIsoOver + 𝒮ᴰ-fiberIsoOver→totalIso = Σ-cong-iso F fiberIsoOver \ No newline at end of file diff --git a/Cubical.Displayed.Sigma.html b/Cubical.Displayed.Sigma.html index 9a3683bb4d..44145f44aa 100644 --- a/Cubical.Displayed.Sigma.html +++ b/Cubical.Displayed.Sigma.html @@ -69,7 +69,7 @@ Σ[ q ∈ b B.≅ᴰ⟨ p ⟩ b' ] (c C.≅ᴰ⟨ p , q ⟩ c') DUARel.uaᴰ 𝒮ᴰ-Σ (b , c) p (b' , c') = compEquiv - (Σ-cong-equiv (B.uaᴰ b p b') (λ q → C.uaᴰ c (p , q) c')) + (Σ-cong-equiv (B.uaᴰ b p b') (λ q → C.uaᴰ c (p , q) c')) ΣPath≃PathΣ -- DUARel on a non-dependent Σ-type @@ -96,7 +96,7 @@ module C = SubstRel 𝒮ˢ-C 𝒮ˢ-Σ : SubstRel 𝒮-A (λ a → Σ[ b ∈ B a ] C (a , b)) - 𝒮ˢ-Σ .act p = Σ-cong-equiv (B.act p) (λ b → C.act (p , refl)) + 𝒮ˢ-Σ .act p = Σ-cong-equiv (B.act p) (λ b → C.act (p , refl)) 𝒮ˢ-Σ .uaˢ p _ = fromPathP (DUARel.uaᴰ (𝒮ᴰ-Σ (Subst→DUA 𝒮ˢ-B) (Subst→DUA 𝒮ˢ-C)) _ p _ .fst (refl , refl)) @@ -115,6 +115,6 @@ module C = SubstRel 𝒮ˢ-C _×𝒮ˢ_ : SubstRel 𝒮-A (λ a → B a × C a) - _×𝒮ˢ_ .act p = ≃-× (B.act p) (C.act p) + _×𝒮ˢ_ .act p = ≃-× (B.act p) (C.act p) _×𝒮ˢ_ .uaˢ p (b , c) = ΣPathP (B.uaˢ p b , C.uaˢ p c) \ No newline at end of file diff --git a/Cubical.Experiments.EscardoSIP.html b/Cubical.Experiments.EscardoSIP.html index e98e6ff23c..9fa1d40c8c 100644 --- a/Cubical.Experiments.EscardoSIP.html +++ b/Cubical.Experiments.EscardoSIP.html @@ -32,7 +32,7 @@ Σ-≡-≃ : {X : Type ℓ} {A : X → Type ℓ'} → (σ τ : Σ X A) → ((σ ≡ τ) ≃ (Σ[ p ∈ (σ .fst) ≡ (τ .fst) ] (subst A p (σ .snd) ≡ (τ .snd)))) -Σ-≡-≃ {A = A} σ τ = invEquiv (ΣPathTransport≃PathΣ σ τ) +Σ-≡-≃ {A = A} σ τ = invEquiv (ΣPathTransport≃PathΣ σ τ) @@ -99,11 +99,11 @@ φψ : (z : (Σ Y A)) → φ (ψ z) ≡ z φψ (y , a) = - ΣPathTransport→PathΣ _ _ (η y , transportTransport⁻ (λ i → A (η y i)) a) + ΣPathTransport→PathΣ _ _ (η y , transportTransport⁻ (λ i → A (η y i)) a) -- last term proves transp (λ i → A (η y i)) i0 (transp (λ i → A (η y (~ i))) i0 a) ≡ a ψφ : (z : (Σ X (A ∘ f))) → ψ (φ z) ≡ z - ψφ (x , a) = ΣPathTransport→PathΣ _ _ (ε x , q) + ψφ (x , a) = ΣPathTransport→PathΣ _ _ (ε x , q) where b : A (f (g (f x))) b = (transp (λ i → A (η (f x) (~ i))) i0 a) diff --git a/Cubical.Experiments.Poset.html b/Cubical.Experiments.Poset.html index a4ea1ff81f..d0de852bb1 100644 --- a/Cubical.Experiments.Poset.html +++ b/Cubical.Experiments.Poset.html @@ -94,9 +94,9 @@ NTS : (fib : fiber f p) → ((to , from) , eq) ≡ fib NTS ((φ , ψ) , eq) = - Σ≡Prop + Σ≡Prop (λ i′ → isOfHLevelSuc 2 (isSetOrder ℓ₁ X) _⊑₀_ _⊑₁_ (f i′) p) - (Σ≡Prop + (Σ≡Prop (λ _ → isPropIsOrderPreserving (X , _⊑₁_) (X , _⊑₀_) (idfun _)) (isPropIsOrderPreserving (X , _⊑₀_) (X , _⊑₁_) (idfun _) to φ)) @@ -205,7 +205,7 @@ → f ≡ g → (f , f-mono) ≡ (g , g-mono) forget-mono P Q (f , f-mono) (g , g-mono) = - Σ≡Prop (λ f → isPropΠ3 λ x y x⊑y → snd (f x ⊑[ Q ] f y)) + Σ≡Prop (λ f → isPropΠ3 λ x y x⊑y → snd (f x ⊑[ Q ] f y)) module PosetReasoning (P : Poset ℓ₀ ℓ₁) where @@ -268,7 +268,7 @@ isPosetIso-prop : (P Q : Poset ℓ₀ ℓ₁) (f : P ─m→ Q) → isProp (isPosetIso P Q f) isPosetIso-prop P Q (f , f-mono) (g₀ , sec₀ , ret₀) (g₁ , sec₁ , ret₁) = - Σ≡Prop NTS g₀=g₁ + Σ≡Prop NTS g₀=g₁ where NTS : ((g , _) : Q ─m→ P) → isProp (section f g × retract f g) NTS (g , g-mono) = isPropΣ @@ -314,10 +314,10 @@ is = iso f g sec ret sec : section to from - sec (f , _) = Σ≡Prop (isPosetIso-prop P Q) refl + sec (f , _) = Σ≡Prop (isPosetIso-prop P Q) refl ret : retract to from - ret (e , _) = Σ≡Prop (isPropIsAMonotonicEqv P Q) (Σ≡Prop isPropIsEquiv refl) + ret (e , _) = Σ≡Prop (isPropIsAMonotonicEqv P Q) (Σ≡Prop isPropIsEquiv refl) -- Once we have this equivalence, the main result is then: the type of poset -- isomorphisms between `P` and `Q` is equivalent to the type of identity proofs diff --git a/Cubical.Experiments.ZCohomologyOld.KcompPrelims.html b/Cubical.Experiments.ZCohomologyOld.KcompPrelims.html index 0cf6eb2058..f7f8515b15 100644 --- a/Cubical.Experiments.ZCohomologyOld.KcompPrelims.html +++ b/Cubical.Experiments.ZCohomologyOld.KcompPrelims.html @@ -182,7 +182,7 @@ sphereConnectedSpecCase = sphereConnected 3 d-mapComp : Iso (fiber d-map base) (Path (S₊ 3) north north) -d-mapComp = compIso (IsoΣPathTransportPathΣ {B = HopfSuspS¹} _ _) +d-mapComp = compIso (IsoΣPathTransportPathΣ {B = HopfSuspS¹} _ _) (congIso (invIso IsoS³TotalHopf)) is1Connected-dmap : isConnectedFun 3 d-map diff --git a/Cubical.Experiments.ZCohomologyOld.Properties.html b/Cubical.Experiments.ZCohomologyOld.Properties.html index 06847a3adb..51d754b227 100644 --- a/Cubical.Experiments.ZCohomologyOld.Properties.html +++ b/Cubical.Experiments.ZCohomologyOld.Properties.html @@ -17,7 +17,7 @@ open import Cubical.Data.Sigma hiding (_×_) open import Cubical.HITs.Susp open import Cubical.HITs.Wedge -open import Cubical.HITs.SetTruncation renaming (rec to sRec ; rec2 to sRec2 ; elim to sElim ; elim2 to sElim2 ; isSetSetTrunc to §) +open import Cubical.HITs.SetTruncation renaming (rec to sRec ; rec2 to sRec2 ; elim to sElim ; elim2 to sElim2 ; isSetSetTrunc to §) open import Cubical.Data.Int renaming (_+_ to _ℤ+_) hiding (-_) open import Cubical.Data.Nat open import Cubical.HITs.Truncation renaming (elim to trElim ; map to trMap ; rec to trRec ; elim3 to trElim3) hiding (map2) diff --git a/Cubical.Foundations.Cubes.HLevels.html b/Cubical.Foundations.Cubes.HLevels.html index 2ff3c8c650..dd5a06050d 100644 --- a/Cubical.Foundations.Cubes.HLevels.html +++ b/Cubical.Foundations.Cubes.HLevels.html @@ -50,9 +50,9 @@ isCubeFilledPath≡Suc n A = (λ i → (x y : A)(∂ : ∂CubeConst₀₁≡∂CubePath {n = suc n} {a₀ = x} {y} (~ i)) → CubeRelConst₀₁≡CubeRelPath (~ i) ∂) - ∙ (λ i → (x : A) → isoToPath (curryIso {A = A} + ∙ (λ i → (x : A) → isoToPath (curryIso {A = A} {B = λ y → ∂CubeConst₀₁ (suc n) A x y} {C = λ _ ∂ → CubeRelConst₀₁ (suc n) A ∂}) (~ i)) - ∙ sym (isoToPath curryIso) + ∙ sym (isoToPath curryIso) ∙ (λ i → (∂ : ∂CubeConst₀₁≡∂CubeSuc {A = A} i) → CubeRelConst₀₁≡CubeRelSuc {n = n} i ∂) isCubeFilledPath→Suc : (n : ℕ) (A : Type ℓ) diff --git a/Cubical.Foundations.Cubes.Subtypes.html b/Cubical.Foundations.Cubes.Subtypes.html index 3c9d19c426..e248491050 100644 --- a/Cubical.Foundations.Cubes.Subtypes.html +++ b/Cubical.Foundations.Cubes.Subtypes.html @@ -203,7 +203,7 @@ -- For simplicity, we begin at n=1, and that is all we need. ∂CubeConst₀₁≃∂CubeSuc : {n : ℕ} {A : Type ℓ} → Σ∂CubeConst₀₁ (suc n) A ≃ ∂Cube (suc (suc n)) A -∂CubeConst₀₁≃∂CubeSuc = Σ-cong-equiv (_ , isEquivConst) (λ a → Σ-cong-equiv-fst (_ , isEquivConst)) +∂CubeConst₀₁≃∂CubeSuc = Σ-cong-equiv (_ , isEquivConst) (λ a → Σ-cong-equiv-fst (_ , isEquivConst)) HAEquiv-∂CubeConst₀₁-∂CubeSuc : {n : ℕ}{A : Type ℓ} → HAEquiv (Σ∂CubeConst₀₁ (suc n) A) (∂Cube (suc (suc n)) A) HAEquiv-∂CubeConst₀₁-∂CubeSuc = equiv→HAEquiv ∂CubeConst₀₁≃∂CubeSuc diff --git a/Cubical.Foundations.Equiv.Properties.html b/Cubical.Foundations.Equiv.Properties.html index 215f87c924..c2a4dbd760 100644 --- a/Cubical.Foundations.Equiv.Properties.html +++ b/Cubical.Foundations.Equiv.Properties.html @@ -194,13 +194,13 @@ (λ _ → refl) λ _ → refl) ⟩ Σ _ rCoh1 -- secondly, convert the path into a dependent path for later convenience - ≃⟨ Σ-cong-equiv-snd (λ s → Σ-cong-equiv-snd + ≃⟨ Σ-cong-equiv-snd (λ s → Σ-cong-equiv-snd λ η → equivΠCod λ x → compEquiv (flipSquareEquiv {a₀₀ = f x}) (invEquiv slideSquareEquiv)) ⟩ Σ _ rCoh2 - ≃⟨ Σ-cong-equiv-snd (λ s → invEquiv Σ-Π-≃) ⟩ + ≃⟨ Σ-cong-equiv-snd (λ s → invEquiv Σ-Π-≃) ⟩ Σ _ rCoh3 - ≃⟨ Σ-cong-equiv-snd (λ s → equivΠCod λ x → ΣPath≃PathΣ) ⟩ + ≃⟨ Σ-cong-equiv-snd (λ s → equivΠCod λ x → ΣPath≃PathΣ) ⟩ Σ _ rCoh4 ■ where open isHAEquiv diff --git a/Cubical.Foundations.HLevels.html b/Cubical.Foundations.HLevels.html index 5edb6ab3c9..27e47ffe62 100644 --- a/Cubical.Foundations.HLevels.html +++ b/Cubical.Foundations.HLevels.html @@ -135,7 +135,7 @@ isPropIs2Groupoid = isPropIsOfHLevel 4 TypeOfHLevel≡ : (n : HLevel) {X Y : TypeOfHLevel ℓ n} → ⟨ X ⟩ ≡ ⟨ Y ⟩ → X ≡ Y -TypeOfHLevel≡ n = Σ≡Prop (λ _ → isPropIsOfHLevel n) +TypeOfHLevel≡ n = Σ≡Prop (λ _ → isPropIsOfHLevel n) -- hlevels are preserved by retracts (and consequently equivalences) @@ -314,20 +314,20 @@ section-Σ≡Prop : (pB : (x : A) → isProp (B x)) {u v : Σ A B} - → section (Σ≡Prop pB {u} {v}) (cong fst) + → section (Σ≡Prop pB {u} {v}) (cong fst) section-Σ≡Prop {A = A} pB {u} {v} p j i = (p i .fst) , isProp→PathP (λ i → isOfHLevelPath 1 (pB (fst (p i))) - (Σ≡Prop pB {u} {v} (cong fst p) i .snd) + (Σ≡Prop pB {u} {v} (cong fst p) i .snd) (p i .snd) ) refl refl i j isEquiv-Σ≡Prop : (pB : (x : A) → isProp (B x)) {u v : Σ A B} - → isEquiv (Σ≡Prop pB {u} {v}) -isEquiv-Σ≡Prop {A = A} pB {u} {v} = isoToIsEquiv (iso (Σ≡Prop pB) (cong fst) (section-Σ≡Prop pB) (λ _ → refl)) + → isEquiv (Σ≡Prop pB {u} {v}) +isEquiv-Σ≡Prop {A = A} pB {u} {v} = isoToIsEquiv (iso (Σ≡Prop pB) (cong fst) (section-Σ≡Prop pB) (λ _ → refl)) isPropΣ : isProp A → ((x : A) → isProp (B x)) → isProp (Σ A B) -isPropΣ pA pB t u = Σ≡Prop pB (pA (t .fst) (u .fst)) +isPropΣ pA pB t u = Σ≡Prop pB (pA (t .fst) (u .fst)) isOfHLevelΣ : ∀ n → isOfHLevel n A → ((x : A) → isOfHLevel n (B x)) → isOfHLevel n (Σ A B) @@ -335,7 +335,7 @@ isOfHLevelΣ 1 = isPropΣ isOfHLevelΣ {B = B} (suc (suc n)) h1 h2 x y = isOfHLevelRetractFromIso (suc n) - (invIso (IsoΣPathTransportPathΣ _ _)) + (invIso (IsoΣPathTransportPathΣ _ _)) (isOfHLevelΣ (suc n) (h1 (fst x) (fst y)) λ x → h2 _ _ _) isSetΣ : isSet A → ((x : A) → isSet (B x)) → isSet (Σ A B) @@ -507,7 +507,7 @@ isOfHLevel≃ zero {A = A} {B = B} hA hB = isContr→Equiv hA hB , contr where contr : (y : A ≃ B) → isContr→Equiv hA hB ≡ y - contr y = Σ≡Prop isPropIsEquiv (funExt (λ a → snd hB (fst y a))) + contr y = Σ≡Prop isPropIsEquiv (funExt (λ a → snd hB (fst y a))) isOfHLevel≃ (suc n) {A = A} {B = B} hA hB = isOfHLevelΣ (suc n) (isOfHLevelΠ _ λ _ → hB) @@ -556,12 +556,12 @@ -- h-level of TypeOfHLevel isPropHContr : isProp (TypeOfHLevel ℓ 0) -isPropHContr x y = Σ≡Prop (λ _ → isPropIsContr) (isOfHLevel≡ 0 (x .snd) (y .snd) .fst) +isPropHContr x y = Σ≡Prop (λ _ → isPropIsContr) (isOfHLevel≡ 0 (x .snd) (y .snd) .fst) isOfHLevelTypeOfHLevel : ∀ n → isOfHLevel (suc n) (TypeOfHLevel ℓ n) isOfHLevelTypeOfHLevel zero = isPropHContr isOfHLevelTypeOfHLevel (suc n) (X , a) (Y , b) = - isOfHLevelRetract (suc n) (cong fst) (Σ≡Prop λ _ → isPropIsOfHLevel (suc n)) + isOfHLevelRetract (suc n) (cong fst) (Σ≡Prop λ _ → isPropIsOfHLevel (suc n)) (section-Σ≡Prop λ _ → isPropIsOfHLevel (suc n)) (isOfHLevel≡ (suc n) a b) diff --git a/Cubical.Foundations.Pointed.Homotopy.html b/Cubical.Foundations.Pointed.Homotopy.html index 71e5219fc2..c5702e765f 100644 --- a/Cubical.Foundations.Pointed.Homotopy.html +++ b/Cubical.Foundations.Pointed.Homotopy.html @@ -95,7 +95,7 @@ -- Proof that ∙∼ and ∙∼P are equivalent using the fiberwise equivalence φ ∙∼≃∙∼P : (f g : Π∙ A B ptB) → (f ∙∼ g) ≃ (f ∙∼P g) - ∙∼≃∙∼P f g = Σ-cong-equiv-snd (λ H → pathToEquiv (P≡Q f g H)) + ∙∼≃∙∼P f g = Σ-cong-equiv-snd (λ H → pathToEquiv (P≡Q f g H)) -- inverse of ∙∼→∙∼P extracted from the equivalence ∙∼P→∙∼ : {f g : Π∙ A B ptB} → f ∙∼P g → f ∙∼ g diff --git a/Cubical.Foundations.RelationalStructure.html b/Cubical.Foundations.RelationalStructure.html index f1055a4d02..51f3a37214 100644 --- a/Cubical.Foundations.RelationalStructure.html +++ b/Cubical.Foundations.RelationalStructure.html @@ -20,8 +20,8 @@ open import Cubical.Relation.Binary.Base open import Cubical.Relation.ZigZag.Base -open BinaryRelation -open isEquivRel +open BinaryRelation +open isEquivRel open isQuasiEquivRel private @@ -31,45 +31,45 @@ -- A notion of structured relation for a structure S assigns a relation on S X and S Y to every relation on X -- and Y. We require the output to be proposition-valued when the input is proposition-valued. StrRel : (S : Type ℓ → Type ℓ') (ℓ'' : Level) → Type (ℓ-max (ℓ-suc (ℓ-max ℓ ℓ'')) ℓ') -StrRel {ℓ = ℓ} S ℓ'' = ∀ {A B} (R : Rel A B ℓ) → Rel (S A) (S B) ℓ'' +StrRel {ℓ = ℓ} S ℓ'' = ∀ {A B} (R : Rel A B ℓ) → Rel (S A) (S B) ℓ'' -- Given a type A and relation R, a quotient structure is a structure on the set quotient A/R such that -- the graph of [_] : A → A/R is a structured relation InducedQuotientStr : (S : Type ℓ → Type ℓ') (ρ : StrRel S ℓ'') - (A : TypeWithStr ℓ S) (R : Rel (typ A) (typ A) ℓ) + (A : TypeWithStr ℓ S) (R : Rel (typ A) (typ A) ℓ) → Type (ℓ-max ℓ' ℓ'') InducedQuotientStr S ρ A R = - Σ[ s ∈ S (typ A / R) ] ρ (graphRel [_]) (A .snd) s + Σ[ s ∈ S (typ A / R) ] ρ (graphRel [_]) (A .snd) s -- A structured equivalence relation R on a structured type A should induce a structure on A/R InducesQuotientStr : (S : Type ℓ → Type ℓ') (ρ : StrRel S ℓ'') → Type _ InducesQuotientStr {ℓ = ℓ} S ρ = - (A : TypeWithStr ℓ S) (R : EquivPropRel (typ A) ℓ) + (A : TypeWithStr ℓ S) (R : EquivPropRel (typ A) ℓ) → ρ (R .fst .fst) (A .snd) (A .snd) - → ∃![ s ∈ S (typ A / R .fst .fst) ] ρ (graphRel [_]) (A .snd) s + → ∃![ s ∈ S (typ A / R .fst .fst) ] ρ (graphRel [_]) (A .snd) s -- The identity should be a structured relation isReflexiveStrRel : {S : Type ℓ → Type ℓ'} (ρ : StrRel S ℓ'') → Type _ isReflexiveStrRel {ℓ = ℓ} {S = S} ρ = - {X : Type ℓ} → (s : S X) → ρ (idPropRel X .fst) s s + {X : Type ℓ} → (s : S X) → ρ (idPropRel X .fst) s s -- The inverse of a structured relation should be structured isSymmetricStrRel : {S : Type ℓ → Type ℓ'} (ρ : StrRel S ℓ'') → Type _ isSymmetricStrRel {ℓ = ℓ} {S = S} ρ = - {X Y : Type ℓ} (R : PropRel X Y ℓ) + {X Y : Type ℓ} (R : PropRel X Y ℓ) {sx : S X} {sy : S Y} → ρ (R .fst) sx sy - → ρ (invPropRel R .fst) sy sx + → ρ (invPropRel R .fst) sy sx -- The composite of structured relations should be structured isTransitiveStrRel : {S : Type ℓ → Type ℓ'} (ρ : StrRel S ℓ'') → Type _ isTransitiveStrRel {ℓ = ℓ} {S = S} ρ = {X Y Z : Type ℓ} - (R : PropRel X Y ℓ) (R' : PropRel Y Z ℓ) + (R : PropRel X Y ℓ) (R' : PropRel Y Z ℓ) {sx : S X} {sy : S Y} {sz : S Z} → ρ (R .fst) sx sy → ρ (R' .fst) sy sz - → ρ (compPropRel R R' .fst) sx sz + → ρ (compPropRel R R' .fst) sx sz -- The type of structures on a set should be a set preservesSetsStr : (S : Type ℓ → Type ℓ') → Type (ℓ-max (ℓ-suc ℓ) ℓ') @@ -78,7 +78,7 @@ -- The type of structures on a prop-valued relation should be a prop preservesPropsStrRel : {S : Type ℓ → Type ℓ'} (ρ : StrRel S ℓ'') → Type _ preservesPropsStrRel {ℓ = ℓ} {S = S} ρ = - {X Y : Type ℓ} {R : Rel X Y ℓ} + {X Y : Type ℓ} {R : Rel X Y ℓ} → (∀ x y → isProp (R x y)) → (sx : S X) (sy : S Y) → isProp (ρ R sx sy) @@ -94,7 +94,7 @@ open SuitableStrRel public -quotientPropRel : ∀ {ℓ} {A : Type ℓ} (R : Rel A A ℓ) → PropRel A (A / R) ℓ +quotientPropRel : ∀ {ℓ} {A : Type ℓ} (R : Rel A A ℓ) → PropRel A (A / R) ℓ quotientPropRel R .fst a t = [ a ] ≡ t quotientPropRel R .snd _ _ = squash/ _ _ @@ -104,16 +104,16 @@ → StrRel S ℓ'' → StrEquiv S ℓ''' → Type _ StrRelMatchesEquiv {S = S} ρ ι = (A B : TypeWithStr _ S) (e : typ A ≃ typ B) → - ρ (graphRel (e .fst)) (A .snd) (B .snd) ≃ ι A B e + ρ (graphRel (e .fst)) (A .snd) (B .snd) ≃ ι A B e -- Additional conditions for a "positive" notion of structured relation isDetransitiveStrRel : {S : Type ℓ → Type ℓ'} (ρ : StrRel S ℓ'') → Type _ isDetransitiveStrRel {ℓ = ℓ} {S = S} ρ = {X Y Z : Type ℓ} - (R : PropRel X Y ℓ) (R' : PropRel Y Z ℓ) + (R : PropRel X Y ℓ) (R' : PropRel Y Z ℓ) {sx : S X} {sz : S Z} - → ρ (compPropRel R R' .fst) sx sz + → ρ (compPropRel R R' .fst) sx sz → ∃[ sy ∈ S Y ] ρ (R .fst) sx sy × ρ (R' .fst) sy sz record StrRelAction {S : Type ℓ → Type ℓ'} (ρ : StrRel S ℓ'') @@ -131,7 +131,7 @@ strRelQuotientComparison : {S : Type ℓ → Type ℓ'} {ρ : StrRel S ℓ''} (θ : SuitableStrRel S ρ) (α : StrRelAction ρ) - {X : Type ℓ} (R : EquivPropRel X ℓ) + {X : Type ℓ} (R : EquivPropRel X ℓ) → (S X / ρ (R .fst .fst)) → S (X / R .fst .fst) strRelQuotientComparison θ α R [ s ] = α .actStr [_] s strRelQuotientComparison {ρ = ρ} θ α R (eq/ s t r i) = @@ -143,9 +143,9 @@ (funExt₂ λ x x' → hPropExt squash₁ (R .fst .snd x x') (Trunc.rec (R .fst .snd x x') - (λ {(_ , r , r') → R .snd .transitive _ _ _ r (R .snd .symmetric _ _ r')})) - (λ r → ∣ x' , r , R .snd .reflexive x' ∣₁)) - (θ .transitive (R .fst) (invPropRel (R .fst)) r (θ .symmetric (R .fst) r)) + (λ {(_ , r , r') → R .snd .transitive _ _ _ r (R .snd .symmetric _ _ r')})) + (λ r → ∣ x' , r , R .snd .reflexive x' ∣₁)) + (θ .transitive (R .fst) (invPropRel (R .fst)) r (θ .symmetric (R .fst) r)) leftEq : θ .quo (_ , s) R ρs .fst .fst ≡ α .actStr [_] s leftEq = @@ -153,7 +153,7 @@ (θ .quo (_ , s) R ρs .snd ( α .actStr [_] s , subst - (λ s' → ρ (graphRel [_]) s' (α .actStr [_] s)) + (λ s' → ρ (graphRel [_]) s' (α .actStr [_] s)) (α .actStrId s) (α .actRel eq/ s s ρs) )) @@ -164,7 +164,7 @@ (θ .quo (_ , s) R ρs .snd ( α .actStr [_] t , subst - (λ s' → ρ (graphRel [_]) s' (α .actStr [_] t)) + (λ s' → ρ (graphRel [_]) s' (α .actStr [_] t)) (α .actStrId s) (α .actRel eq/ s t r) )) @@ -181,13 +181,13 @@ act : StrRelAction ρ reflexive : isReflexiveStrRel ρ detransitive : isDetransitiveStrRel ρ - quo : {X : Type ℓ} (R : EquivPropRel X ℓ) → isEquiv (strRelQuotientComparison θ act R) + quo : {X : Type ℓ} (R : EquivPropRel X ℓ) → isEquiv (strRelQuotientComparison θ act R) open PositiveStrRel public posRelReflexive : {S : Type ℓ → Type ℓ'} {ρ : StrRel S ℓ''} {θ : SuitableStrRel S ρ} → PositiveStrRel θ - → {X : Type ℓ} (R : EquivPropRel X ℓ) + → {X : Type ℓ} (R : EquivPropRel X ℓ) → (s : S X) → ρ (R .fst .fst) s s posRelReflexive {ρ = ρ} σ R s = subst @@ -196,7 +196,7 @@ (σ .act .actRel (λ x y → Trunc.rec (R .fst .snd _ _) - (λ p → subst (R .fst .fst x) p (R .snd .reflexive x))) + (λ p → subst (R .fst .fst x) p (R .snd .reflexive x))) s s (σ .reflexive s)) @@ -214,7 +214,7 @@ field quoᴸ : InducedQuotientStr S ρ A E.Rᴸ quoᴿ : InducedQuotientStr S ρ B E.Rᴿ - rel : ρ (graphRel (E.Thm .fst)) (quoᴸ .fst) (quoᴿ .fst) + rel : ρ (graphRel (E.Thm .fst)) (quoᴸ .fst) (quoᴿ .fst) open QERDescends @@ -225,18 +225,18 @@ → QERDescends S ρ A B R structuredQER→structuredEquiv {ρ = ρ} θ (X , s) (Y , t) R r .quoᴸ = θ .quo (X , s) (QER→EquivRel R) - (θ .transitive (R .fst) (invPropRel (R .fst)) r (θ .symmetric (R .fst) r)) + (θ .transitive (R .fst) (invPropRel (R .fst)) r (θ .symmetric (R .fst) r)) .fst structuredQER→structuredEquiv {ρ = ρ} θ (X , s) (Y , t) R r .quoᴿ = θ .quo (Y , t) (QER→EquivRel (invQER R)) - (θ .transitive (invPropRel (R .fst)) (R .fst) (θ .symmetric (R .fst) r) r) + (θ .transitive (invPropRel (R .fst)) (R .fst) (θ .symmetric (R .fst) r) r) .fst structuredQER→structuredEquiv {ρ = ρ} θ (X , s) (Y , t) R r .rel = subst (λ R' → ρ R' (quol .fst) (quor .fst)) correction - (θ .transitive (compPropRel (invPropRel (quotientPropRel E.Rᴸ)) (R .fst)) (quotientPropRel E.Rᴿ) - (θ .transitive (invPropRel (quotientPropRel E.Rᴸ)) (R .fst) + (θ .transitive (compPropRel (invPropRel (quotientPropRel E.Rᴸ)) (R .fst)) (quotientPropRel E.Rᴿ) + (θ .transitive (invPropRel (quotientPropRel E.Rᴸ)) (R .fst) (θ .symmetric (quotientPropRel E.Rᴸ) (quol .snd)) r) (quor .snd)) @@ -244,9 +244,9 @@ module E = QER→Equiv R quol = structuredQER→structuredEquiv {ρ = ρ} θ (X , s) (Y , t) R r .quoᴸ quor = structuredQER→structuredEquiv {ρ = ρ} θ (X , s) (Y , t) R r .quoᴿ - [R] = compPropRel (compPropRel (invPropRel (quotientPropRel E.Rᴸ)) (R .fst)) (quotientPropRel E.Rᴿ) + [R] = compPropRel (compPropRel (invPropRel (quotientPropRel E.Rᴸ)) (R .fst)) (quotientPropRel E.Rᴿ) - correction : [R] .fst ≡ graphRel (E.Thm .fst) + correction : [R] .fst ≡ graphRel (E.Thm .fst) correction = funExt₂ λ qx qy → (hPropExt squash₁ (squash/ _ _) diff --git a/Cubical.Foundations.SIP.html b/Cubical.Foundations.SIP.html index 9d0f81be13..e86f20a50e 100644 --- a/Cubical.Foundations.SIP.html +++ b/Cubical.Foundations.SIP.html @@ -119,7 +119,7 @@ SIP : A ≃[ ι ] B ≃ (A ≡ B) SIP = - sip , isoToIsEquiv (compIso (Σ-cong-iso (invIso univalenceIso) (equivToIso ∘ θ)) ΣPathIsoPathΣ) + sip , isoToIsEquiv (compIso (Σ-cong-iso (invIso univalenceIso) (equivToIso ∘ θ)) ΣPathIsoPathΣ) sip⁻ : A ≡ B → A ≃[ ι ] B sip⁻ = invEq SIP diff --git a/Cubical.Functions.Bundle.html b/Cubical.Functions.Bundle.html index 978ff632b9..8351039b0f 100644 --- a/Cubical.Functions.Bundle.html +++ b/Cubical.Functions.Bundle.html @@ -44,7 +44,7 @@ -} bundleEquiv : (B → TypeEqvTo ℓ' F) ≃ (Σ[ E ∈ Type ℓ' ] Σ[ p ∈ (E → B) ] ∀ x → ∥ fiber p x ≃ F ∥₁) - bundleEquiv = compEquiv (compEquiv Σ-Π-≃ (pathToEquiv p)) Σ-assoc-≃ + bundleEquiv = compEquiv (compEquiv Σ-Π-≃ (pathToEquiv p)) Σ-assoc-≃ where e = fibrationEquiv B ℓ p : (Σ[ p⁻¹ ∈ (B → Type ℓ') ] ∀ x → ∥ p⁻¹ x ≃ F ∥₁) ≡ (Σ[ p ∈ (Σ[ E ∈ Type ℓ' ] (E → B)) ] ∀ x → ∥ fiber (snd p) x ≃ F ∥₁ ) diff --git a/Cubical.Functions.Embedding.html b/Cubical.Functions.Embedding.html index d984081899..096cb28f2e 100644 --- a/Cubical.Functions.Embedding.html +++ b/Cubical.Functions.Embedding.html @@ -160,7 +160,7 @@ injective→hasPropFibers : hasPropFibers f injective→hasPropFibers y (x , fx≡y) (x' , fx'≡y) = - Σ≡Prop + Σ≡Prop (λ _ → isSetB _ _) (inj (fx≡y ∙ sym (fx'≡y))) @@ -182,261 +182,297 @@ Equiv→Embedding : A ≃ B → A ↪ B Equiv→Embedding (f , isEquivF) = (f , isEquiv→isEmbedding isEquivF) -iso→isEmbedding : ∀ {ℓ} {A B : Type ℓ} - → (isom : Iso A B) - ------------------------------- - → isEmbedding (Iso.fun isom) -iso→isEmbedding {A = A} {B} isom = (isEquiv→isEmbedding (equivIsEquiv (isoToEquiv isom))) - -isEmbedding→Injection : - ∀ {ℓ} {A B C : Type ℓ} - → (a : A → B) - → (e : isEmbedding a) - ---------------------- - → ∀ {f g : C → A} → - ∀ x → (a (f x) ≡ a (g x)) ≡ (f x ≡ g x) -isEmbedding→Injection a e {f = f} {g} x = sym (ua (cong a , e (f x) (g x))) - -Embedding-into-Discrete→Discrete : A ↪ B → Discrete B → Discrete A -Embedding-into-Discrete→Discrete (f , isEmbeddingF) _≟_ x y with f x ≟ f y -... | yes p = yes (invIsEq (isEmbeddingF x y) p) -... | no ¬p = no (¬p ∘ cong f) - -Embedding-into-isProp→isProp : A ↪ B → isProp B → isProp A -Embedding-into-isProp→isProp (f , isEmbeddingF) isProp-B x y - = invIsEq (isEmbeddingF x y) (isProp-B (f x) (f y)) - -Embedding-into-isSet→isSet : A ↪ B → isSet B → isSet A -Embedding-into-isSet→isSet (f , isEmbeddingF) isSet-B x y p q = - p ≡⟨ sym (retIsEq isEquiv-cong-f p) ⟩ - cong-f⁻¹ (cong f p) ≡⟨ cong cong-f⁻¹ cong-f-p≡cong-f-q ⟩ - cong-f⁻¹ (cong f q) ≡⟨ retIsEq isEquiv-cong-f q ⟩ - q ∎ - where - cong-f-p≡cong-f-q = isSet-B (f x) (f y) (cong f p) (cong f q) - isEquiv-cong-f = isEmbeddingF x y - cong-f⁻¹ = invIsEq isEquiv-cong-f - -Embedding-into-hLevel→hLevel - : ∀ n → A ↪ B → isOfHLevel (suc n) B → isOfHLevel (suc n) A -Embedding-into-hLevel→hLevel zero = Embedding-into-isProp→isProp -Embedding-into-hLevel→hLevel (suc n) (f , isEmbeddingF) Blvl x y - = isOfHLevelRespectEquiv (suc n) (invEquiv equiv) subLvl - where - equiv : (x ≡ y) ≃ (f x ≡ f y) - equiv .fst = cong f - equiv .snd = isEmbeddingF x y - subLvl : isOfHLevel (suc n) (f x ≡ f y) - subLvl = Blvl (f x) (f y) - --- We now show that the powerset is the subtype classifier --- i.e. ℙ X ≃ Σ[A ∈ Type ℓ] (A ↪ X) -Embedding→Subset : {X : Type ℓ} → Σ[ A ∈ Type ℓ ] (A ↪ X) → ℙ X -Embedding→Subset (_ , f , isEmbeddingF) x = fiber f x , isEmbedding→hasPropFibers isEmbeddingF x - -Subset→Embedding : {X : Type ℓ} → ℙ X → Σ[ A ∈ Type ℓ ] (A ↪ X) -Subset→Embedding {X = X} A = D , fst , Ψ - where - D = Σ[ x ∈ X ] x ∈ A - - Ψ : isEmbedding fst - Ψ w x = isEmbeddingFstΣProp (∈-isProp A) - -Subset→Embedding→Subset : {X : Type ℓ} → section (Embedding→Subset {ℓ} {X}) (Subset→Embedding {ℓ} {X}) -Subset→Embedding→Subset _ = funExt λ x → Σ≡Prop (λ _ → isPropIsProp) (ua (FiberIso.fiberEquiv _ x)) - -Embedding→Subset→Embedding : {X : Type ℓ} → retract (Embedding→Subset {ℓ} {X}) (Subset→Embedding {ℓ} {X}) -Embedding→Subset→Embedding {ℓ = ℓ} {X = X} (A , f , ψ) = - cong (equivFun Σ-assoc-≃) (Σ≡Prop (λ _ → isPropIsEmbedding) (retEq (fibrationEquiv X ℓ) (A , f))) - -Subset≃Embedding : {X : Type ℓ} → ℙ X ≃ (Σ[ A ∈ Type ℓ ] (A ↪ X)) -Subset≃Embedding = isoToEquiv (iso Subset→Embedding Embedding→Subset - Embedding→Subset→Embedding Subset→Embedding→Subset) - -Subset≡Embedding : {X : Type ℓ} → ℙ X ≡ (Σ[ A ∈ Type ℓ ] (A ↪ X)) -Subset≡Embedding = ua Subset≃Embedding - -isEmbedding-∘ : isEmbedding f → isEmbedding h → isEmbedding (f ∘ h) -isEmbedding-∘ {f = f} {h = h} Embf Embh w x - = compEquiv (cong h , Embh w x) (cong f , Embf (h w) (h x)) .snd - -compEmbedding : (B ↪ C) → (A ↪ B) → (A ↪ C) -(compEmbedding (g , _ ) (f , _ )).fst = g ∘ f -(compEmbedding (_ , g↪) (_ , f↪)).snd = isEmbedding-∘ g↪ f↪ - -isEmbedding→embedsFibersIntoSingl - : isEmbedding f - → ∀ z → fiber f z ↪ singl z -isEmbedding→embedsFibersIntoSingl {f = f} isE z = e , isEmbE where - e : fiber f z → singl z - e x = f (fst x) , sym (snd x) - - isEmbE : isEmbedding e - isEmbE u v = goal where - -- "adjust" ΣeqCf by trivial equivalences that hold judgementally, which should save compositions - Dom′ : ∀ u v → Type _ - Dom′ u v = Σ[ p ∈ fst u ≡ fst v ] PathP (λ i → f (p i) ≡ z) (snd u) (snd v) - Cod′ : ∀ u v → Type _ - Cod′ u v = Σ[ p ∈ f (fst u) ≡ f (fst v) ] PathP (λ i → p i ≡ z) (snd u) (snd v) - ΣeqCf : Dom′ u v ≃ Cod′ u v - ΣeqCf = Σ-cong-equiv-fst (_ , isE _ _) - - dom→ : u ≡ v → Dom′ u v - dom→ p = cong fst p , cong snd p - dom← : Dom′ u v → u ≡ v - dom← p i = p .fst i , p .snd i - - cod→ : e u ≡ e v → Cod′ u v - cod→ p = cong fst p , cong (sym ∘ snd) p - cod← : Cod′ u v → e u ≡ e v - cod← p i = p .fst i , sym (p .snd i) - - goal : isEquiv (cong e) - goal .equiv-proof x .fst .fst = - dom← (equivCtr ΣeqCf (cod→ x) .fst) - goal .equiv-proof x .fst .snd j = - cod← (equivCtr ΣeqCf (cod→ x) .snd j) - goal .equiv-proof x .snd (g , p) i .fst = - dom← (equivCtrPath ΣeqCf (cod→ x) (dom→ g , cong cod→ p) i .fst) - goal .equiv-proof x .snd (g , p) i .snd j = - cod← (equivCtrPath ΣeqCf (cod→ x) (dom→ g , cong cod→ p) i .snd j) - -isEmbedding→hasPropFibers′ : isEmbedding f → hasPropFibers f -isEmbedding→hasPropFibers′ {f = f} iE z = - Embedding-into-isProp→isProp (isEmbedding→embedsFibersIntoSingl iE z) isPropSingl - -universeEmbedding : - ∀ {ℓ ℓ' : Level} - → (F : Type ℓ → Type ℓ') - → (∀ X → F X ≃ X) - → isEmbedding F -universeEmbedding F liftingEquiv = hasPropFibersOfImage→isEmbedding propFibersF where - lemma : ∀ A B → (F A ≡ F B) ≃ (B ≡ A) - lemma A B = (F A ≡ F B) ≃⟨ univalence ⟩ - (F A ≃ F B) ≃⟨ equivComp (liftingEquiv A) (liftingEquiv B) ⟩ - (A ≃ B) ≃⟨ invEquivEquiv ⟩ - (B ≃ A) ≃⟨ invEquiv univalence ⟩ - (B ≡ A) ■ - fiberSingl : ∀ X → fiber F (F X) ≃ singl X - fiberSingl X = Σ-cong-equiv-snd (λ _ → lemma _ _) - propFibersF : hasPropFibersOfImage F - propFibersF X = Embedding-into-isProp→isProp (Equiv→Embedding (fiberSingl X)) isPropSingl - -liftEmbedding : (ℓ ℓ' : Level) - → isEmbedding (Lift {i = ℓ} {j = ℓ'}) -liftEmbedding ℓ ℓ' = universeEmbedding (Lift {j = ℓ'}) (λ _ → invEquiv LiftEquiv) - -module FibrationIdentityPrinciple {B : Type ℓ} {ℓ'} where - -- note that fibrationEquiv (for good reason) uses ℓ' = ℓ-max ℓ ℓ', so we have to work - -- some universe magic to achieve good universe polymorphism - - -- First, prove it for the case that's dealt with in fibrationEquiv - Fibration′ = Fibration B (ℓ-max ℓ ℓ') - - module Lifted (f g : Fibration′) where - f≃g′ : Type (ℓ-max ℓ ℓ') - f≃g′ = ∀ b → fiber (f .snd) b ≃ fiber (g .snd) b - - Fibration′IP : f≃g′ ≃ (f ≡ g) - Fibration′IP = - f≃g′ - ≃⟨ equivΠCod (λ _ → invEquiv univalence) ⟩ - (∀ b → fiber (f .snd) b ≡ fiber (g .snd) b) - ≃⟨ funExtEquiv ⟩ - fiber (f .snd) ≡ fiber (g .snd) - ≃⟨ invEquiv (congEquiv (fibrationEquiv B ℓ')) ⟩ - f ≡ g - ■ - - -- Then embed into the above case by lifting the type - L : Type _ → Type _ -- local synonym fixing the levels of Lift - L = Lift {i = ℓ'} {j = ℓ} - - liftFibration : Fibration B ℓ' → Fibration′ - liftFibration (A , f) = L A , f ∘ lower - - hasPropFibersLiftFibration : hasPropFibers liftFibration - hasPropFibersLiftFibration (A , f) = - Embedding-into-isProp→isProp (Equiv→Embedding fiberChar) - (isPropΣ (isEmbedding→hasPropFibers (liftEmbedding _ _) A) - λ _ → isEquiv→hasPropFibers (snd (invEquiv (preCompEquiv LiftEquiv))) _) - where - fiberChar : fiber liftFibration (A , f) - ≃ (Σ[ (E , eq) ∈ fiber L A ] fiber (_∘ lower) (transport⁻ (λ i → eq i → B) f)) - fiberChar = - fiber liftFibration (A , f) - ≃⟨ Σ-cong-equiv-snd (λ _ → invEquiv ΣPath≃PathΣ) ⟩ - (Σ[ (E , g) ∈ Fibration B ℓ' ] Σ[ eq ∈ (L E ≡ A) ] PathP (λ i → eq i → B) (g ∘ lower) f) - ≃⟨ boringSwap ⟩ - (Σ[ (E , eq) ∈ fiber L A ] Σ[ g ∈ (E → B) ] PathP (λ i → eq i → B) (g ∘ lower) f) - ≃⟨ Σ-cong-equiv-snd (λ _ → Σ-cong-equiv-snd λ _ → pathToEquiv (PathP≡Path⁻ _ _ _)) ⟩ - (Σ[ (E , eq) ∈ fiber L A ] fiber (_∘ lower) (transport⁻ (λ i → eq i → B) f)) - ■ where - unquoteDecl boringSwap = - declStrictEquiv boringSwap - (λ ((E , g) , (eq , p)) → ((E , eq) , (g , p))) - (λ ((E , g) , (eq , p)) → ((E , eq) , (g , p))) - - isEmbeddingLiftFibration : isEmbedding liftFibration - isEmbeddingLiftFibration = hasPropFibers→isEmbedding hasPropFibersLiftFibration - - -- and finish off - module _ (f g : Fibration B ℓ') where - open Lifted (liftFibration f) (liftFibration g) - f≃g : Type (ℓ-max ℓ ℓ') - f≃g = ∀ b → fiber (f .snd) b ≃ fiber (g .snd) b - - FibrationIP : f≃g ≃ (f ≡ g) - FibrationIP = - f≃g ≃⟨ equivΠCod (λ b → equivComp (Σ-cong-equiv-fst LiftEquiv) - (Σ-cong-equiv-fst LiftEquiv)) ⟩ - f≃g′ ≃⟨ Fibration′IP ⟩ - (liftFibration f ≡ liftFibration g) ≃⟨ invEquiv (_ , isEmbeddingLiftFibration _ _) ⟩ - (f ≡ g) ■ - -_≃Fib_ : {B : Type ℓ} (f g : Fibration B ℓ') → Type (ℓ-max ℓ ℓ') -_≃Fib_ = FibrationIdentityPrinciple.f≃g - -FibrationIP : {B : Type ℓ} (f g : Fibration B ℓ') → f ≃Fib g ≃ (f ≡ g) -FibrationIP = FibrationIdentityPrinciple.FibrationIP - -Embedding : (B : Type ℓ') → (ℓ : Level) → Type (ℓ-max ℓ' (ℓ-suc ℓ)) -Embedding B ℓ = Σ[ A ∈ Type ℓ ] A ↪ B - -module EmbeddingIdentityPrinciple {B : Type ℓ} {ℓ'} (f g : Embedding B ℓ') where - open Σ f renaming (fst to F) - open Σ g renaming (fst to G) - open Σ (f .snd) renaming (fst to ffun; snd to isEmbF) - open Σ (g .snd) renaming (fst to gfun; snd to isEmbG) - f≃g : Type _ - f≃g = (∀ b → fiber ffun b → fiber gfun b) × - (∀ b → fiber gfun b → fiber ffun b) - toFibr : Embedding B ℓ' → Fibration B ℓ' - toFibr (A , (f , _)) = (A , f) - - isEmbeddingToFibr : isEmbedding toFibr - isEmbeddingToFibr w x = fullEquiv .snd where - -- carefully managed such that (cong toFibr) is the equivalence - fullEquiv : (w ≡ x) ≃ (toFibr w ≡ toFibr x) - fullEquiv = compEquiv (congEquiv (invEquiv Σ-assoc-≃)) (invEquiv (Σ≡PropEquiv (λ _ → isPropIsEmbedding))) - - EmbeddingIP : f≃g ≃ (f ≡ g) - EmbeddingIP = - f≃g - ≃⟨ strictIsoToEquiv (invIso toProdIso) ⟩ - (∀ b → (fiber ffun b → fiber gfun b) × (fiber gfun b → fiber ffun b)) - ≃⟨ equivΠCod (λ _ → isEquivPropBiimpl→Equiv (isEmbedding→hasPropFibers isEmbF _) - (isEmbedding→hasPropFibers isEmbG _)) ⟩ - (∀ b → (fiber (f .snd .fst) b) ≃ (fiber (g .snd .fst) b)) - ≃⟨ FibrationIP (toFibr f) (toFibr g) ⟩ - (toFibr f ≡ toFibr g) - ≃⟨ invEquiv (_ , isEmbeddingToFibr _ _) ⟩ - f ≡ g - ■ - -_≃Emb_ : {B : Type ℓ} (f g : Embedding B ℓ') → Type _ -_≃Emb_ = EmbeddingIdentityPrinciple.f≃g - -EmbeddingIP : {B : Type ℓ} (f g : Embedding B ℓ') → f ≃Emb g ≃ (f ≡ g) -EmbeddingIP = EmbeddingIdentityPrinciple.EmbeddingIP +id↪ : ∀ {ℓ} → (A : Type ℓ) → A ↪ A +id↪ A = Equiv→Embedding (idEquiv A) + +iso→isEmbedding : ∀ {ℓ} {A B : Type ℓ} + → (isom : Iso A B) + ------------------------------- + → isEmbedding (Iso.fun isom) +iso→isEmbedding {A = A} {B} isom = (isEquiv→isEmbedding (equivIsEquiv (isoToEquiv isom))) + +isEmbedding→Injection : + ∀ {ℓ} {A B C : Type ℓ} + → (a : A → B) + → (e : isEmbedding a) + ---------------------- + → ∀ {f g : C → A} → + ∀ x → (a (f x) ≡ a (g x)) ≡ (f x ≡ g x) +isEmbedding→Injection a e {f = f} {g} x = sym (ua (cong a , e (f x) (g x))) + +Embedding-into-Discrete→Discrete : A ↪ B → Discrete B → Discrete A +Embedding-into-Discrete→Discrete (f , isEmbeddingF) _≟_ x y with f x ≟ f y +... | yes p = yes (invIsEq (isEmbeddingF x y) p) +... | no ¬p = no (¬p ∘ cong f) + +Embedding-into-isProp→isProp : A ↪ B → isProp B → isProp A +Embedding-into-isProp→isProp (f , isEmbeddingF) isProp-B x y + = invIsEq (isEmbeddingF x y) (isProp-B (f x) (f y)) + +Embedding-into-isSet→isSet : A ↪ B → isSet B → isSet A +Embedding-into-isSet→isSet (f , isEmbeddingF) isSet-B x y p q = + p ≡⟨ sym (retIsEq isEquiv-cong-f p) ⟩ + cong-f⁻¹ (cong f p) ≡⟨ cong cong-f⁻¹ cong-f-p≡cong-f-q ⟩ + cong-f⁻¹ (cong f q) ≡⟨ retIsEq isEquiv-cong-f q ⟩ + q ∎ + where + cong-f-p≡cong-f-q = isSet-B (f x) (f y) (cong f p) (cong f q) + isEquiv-cong-f = isEmbeddingF x y + cong-f⁻¹ = invIsEq isEquiv-cong-f + +Embedding-into-hLevel→hLevel + : ∀ n → A ↪ B → isOfHLevel (suc n) B → isOfHLevel (suc n) A +Embedding-into-hLevel→hLevel zero = Embedding-into-isProp→isProp +Embedding-into-hLevel→hLevel (suc n) (f , isEmbeddingF) Blvl x y + = isOfHLevelRespectEquiv (suc n) (invEquiv equiv) subLvl + where + equiv : (x ≡ y) ≃ (f x ≡ f y) + equiv .fst = cong f + equiv .snd = isEmbeddingF x y + subLvl : isOfHLevel (suc n) (f x ≡ f y) + subLvl = Blvl (f x) (f y) + +-- We now show that the powerset is the subtype classifier +-- i.e. ℙ X ≃ Σ[A ∈ Type ℓ] (A ↪ X) +Embedding→Subset : {X : Type ℓ} → Σ[ A ∈ Type ℓ ] (A ↪ X) → ℙ X +Embedding→Subset (_ , f , isEmbeddingF) x = fiber f x , isEmbedding→hasPropFibers isEmbeddingF x + +Subset→Embedding : {X : Type ℓ} → ℙ X → Σ[ A ∈ Type ℓ ] (A ↪ X) +Subset→Embedding {X = X} A = D , fst , Ψ + where + D = Σ[ x ∈ X ] x ∈ A + + Ψ : isEmbedding fst + Ψ w x = isEmbeddingFstΣProp (∈-isProp A) + +Subset→Embedding→Subset : {X : Type ℓ} → section (Embedding→Subset {ℓ} {X}) (Subset→Embedding {ℓ} {X}) +Subset→Embedding→Subset _ = funExt λ x → Σ≡Prop (λ _ → isPropIsProp) (ua (FiberIso.fiberEquiv _ x)) + +Embedding→Subset→Embedding : {X : Type ℓ} → retract (Embedding→Subset {ℓ} {X}) (Subset→Embedding {ℓ} {X}) +Embedding→Subset→Embedding {ℓ = ℓ} {X = X} (A , f , ψ) = + cong (equivFun Σ-assoc-≃) (Σ≡Prop (λ _ → isPropIsEmbedding) (retEq (fibrationEquiv X ℓ) (A , f))) + +Subset≃Embedding : {X : Type ℓ} → ℙ X ≃ (Σ[ A ∈ Type ℓ ] (A ↪ X)) +Subset≃Embedding = isoToEquiv (iso Subset→Embedding Embedding→Subset + Embedding→Subset→Embedding Subset→Embedding→Subset) + +Subset≡Embedding : {X : Type ℓ} → ℙ X ≡ (Σ[ A ∈ Type ℓ ] (A ↪ X)) +Subset≡Embedding = ua Subset≃Embedding + +isEmbedding-∘ : isEmbedding f → isEmbedding h → isEmbedding (f ∘ h) +isEmbedding-∘ {f = f} {h = h} Embf Embh w x + = compEquiv (cong h , Embh w x) (cong f , Embf (h w) (h x)) .snd + +compEmbedding : (B ↪ C) → (A ↪ B) → (A ↪ C) +(compEmbedding (g , _ ) (f , _ )).fst = g ∘ f +(compEmbedding (_ , g↪) (_ , f↪)).snd = isEmbedding-∘ g↪ f↪ + +isEmbedding→embedsFibersIntoSingl + : isEmbedding f + → ∀ z → fiber f z ↪ singl z +isEmbedding→embedsFibersIntoSingl {f = f} isE z = e , isEmbE where + e : fiber f z → singl z + e x = f (fst x) , sym (snd x) + + isEmbE : isEmbedding e + isEmbE u v = goal where + -- "adjust" ΣeqCf by trivial equivalences that hold judgementally, which should save compositions + Dom′ : ∀ u v → Type _ + Dom′ u v = Σ[ p ∈ fst u ≡ fst v ] PathP (λ i → f (p i) ≡ z) (snd u) (snd v) + Cod′ : ∀ u v → Type _ + Cod′ u v = Σ[ p ∈ f (fst u) ≡ f (fst v) ] PathP (λ i → p i ≡ z) (snd u) (snd v) + ΣeqCf : Dom′ u v ≃ Cod′ u v + ΣeqCf = Σ-cong-equiv-fst (_ , isE _ _) + + dom→ : u ≡ v → Dom′ u v + dom→ p = cong fst p , cong snd p + dom← : Dom′ u v → u ≡ v + dom← p i = p .fst i , p .snd i + + cod→ : e u ≡ e v → Cod′ u v + cod→ p = cong fst p , cong (sym ∘ snd) p + cod← : Cod′ u v → e u ≡ e v + cod← p i = p .fst i , sym (p .snd i) + + goal : isEquiv (cong e) + goal .equiv-proof x .fst .fst = + dom← (equivCtr ΣeqCf (cod→ x) .fst) + goal .equiv-proof x .fst .snd j = + cod← (equivCtr ΣeqCf (cod→ x) .snd j) + goal .equiv-proof x .snd (g , p) i .fst = + dom← (equivCtrPath ΣeqCf (cod→ x) (dom→ g , cong cod→ p) i .fst) + goal .equiv-proof x .snd (g , p) i .snd j = + cod← (equivCtrPath ΣeqCf (cod→ x) (dom→ g , cong cod→ p) i .snd j) + +isEmbedding→hasPropFibers′ : isEmbedding f → hasPropFibers f +isEmbedding→hasPropFibers′ {f = f} iE z = + Embedding-into-isProp→isProp (isEmbedding→embedsFibersIntoSingl iE z) isPropSingl + +universeEmbedding : + ∀ {ℓ ℓ' : Level} + → (F : Type ℓ → Type ℓ') + → (∀ X → F X ≃ X) + → isEmbedding F +universeEmbedding F liftingEquiv = hasPropFibersOfImage→isEmbedding propFibersF where + lemma : ∀ A B → (F A ≡ F B) ≃ (B ≡ A) + lemma A B = (F A ≡ F B) ≃⟨ univalence ⟩ + (F A ≃ F B) ≃⟨ equivComp (liftingEquiv A) (liftingEquiv B) ⟩ + (A ≃ B) ≃⟨ invEquivEquiv ⟩ + (B ≃ A) ≃⟨ invEquiv univalence ⟩ + (B ≡ A) ■ + fiberSingl : ∀ X → fiber F (F X) ≃ singl X + fiberSingl X = Σ-cong-equiv-snd (λ _ → lemma _ _) + propFibersF : hasPropFibersOfImage F + propFibersF X = Embedding-into-isProp→isProp (Equiv→Embedding (fiberSingl X)) isPropSingl + +liftEmbedding : (ℓ ℓ' : Level) + → isEmbedding (Lift {i = ℓ} {j = ℓ'}) +liftEmbedding ℓ ℓ' = universeEmbedding (Lift {j = ℓ'}) (λ _ → invEquiv LiftEquiv) + +module FibrationIdentityPrinciple {B : Type ℓ} {ℓ'} where + -- note that fibrationEquiv (for good reason) uses ℓ' = ℓ-max ℓ ℓ', so we have to work + -- some universe magic to achieve good universe polymorphism + + -- First, prove it for the case that's dealt with in fibrationEquiv + Fibration′ = Fibration B (ℓ-max ℓ ℓ') + + module Lifted (f g : Fibration′) where + f≃g′ : Type (ℓ-max ℓ ℓ') + f≃g′ = ∀ b → fiber (f .snd) b ≃ fiber (g .snd) b + + Fibration′IP : f≃g′ ≃ (f ≡ g) + Fibration′IP = + f≃g′ + ≃⟨ equivΠCod (λ _ → invEquiv univalence) ⟩ + (∀ b → fiber (f .snd) b ≡ fiber (g .snd) b) + ≃⟨ funExtEquiv ⟩ + fiber (f .snd) ≡ fiber (g .snd) + ≃⟨ invEquiv (congEquiv (fibrationEquiv B ℓ')) ⟩ + f ≡ g + ■ + + -- Then embed into the above case by lifting the type + L : Type _ → Type _ -- local synonym fixing the levels of Lift + L = Lift {i = ℓ'} {j = ℓ} + + liftFibration : Fibration B ℓ' → Fibration′ + liftFibration (A , f) = L A , f ∘ lower + + hasPropFibersLiftFibration : hasPropFibers liftFibration + hasPropFibersLiftFibration (A , f) = + Embedding-into-isProp→isProp (Equiv→Embedding fiberChar) + (isPropΣ (isEmbedding→hasPropFibers (liftEmbedding _ _) A) + λ _ → isEquiv→hasPropFibers (snd (invEquiv (preCompEquiv LiftEquiv))) _) + where + fiberChar : fiber liftFibration (A , f) + ≃ (Σ[ (E , eq) ∈ fiber L A ] fiber (_∘ lower) (transport⁻ (λ i → eq i → B) f)) + fiberChar = + fiber liftFibration (A , f) + ≃⟨ Σ-cong-equiv-snd (λ _ → invEquiv ΣPath≃PathΣ) ⟩ + (Σ[ (E , g) ∈ Fibration B ℓ' ] Σ[ eq ∈ (L E ≡ A) ] PathP (λ i → eq i → B) (g ∘ lower) f) + ≃⟨ boringSwap ⟩ + (Σ[ (E , eq) ∈ fiber L A ] Σ[ g ∈ (E → B) ] PathP (λ i → eq i → B) (g ∘ lower) f) + ≃⟨ Σ-cong-equiv-snd (λ _ → Σ-cong-equiv-snd λ _ → pathToEquiv (PathP≡Path⁻ _ _ _)) ⟩ + (Σ[ (E , eq) ∈ fiber L A ] fiber (_∘ lower) (transport⁻ (λ i → eq i → B) f)) + ■ where + unquoteDecl boringSwap = + declStrictEquiv boringSwap + (λ ((E , g) , (eq , p)) → ((E , eq) , (g , p))) + (λ ((E , g) , (eq , p)) → ((E , eq) , (g , p))) + + isEmbeddingLiftFibration : isEmbedding liftFibration + isEmbeddingLiftFibration = hasPropFibers→isEmbedding hasPropFibersLiftFibration + + -- and finish off + module _ (f g : Fibration B ℓ') where + open Lifted (liftFibration f) (liftFibration g) + f≃g : Type (ℓ-max ℓ ℓ') + f≃g = ∀ b → fiber (f .snd) b ≃ fiber (g .snd) b + + FibrationIP : f≃g ≃ (f ≡ g) + FibrationIP = + f≃g ≃⟨ equivΠCod (λ b → equivComp (Σ-cong-equiv-fst LiftEquiv) + (Σ-cong-equiv-fst LiftEquiv)) ⟩ + f≃g′ ≃⟨ Fibration′IP ⟩ + (liftFibration f ≡ liftFibration g) ≃⟨ invEquiv (_ , isEmbeddingLiftFibration _ _) ⟩ + (f ≡ g) ■ + +_≃Fib_ : {B : Type ℓ} (f g : Fibration B ℓ') → Type (ℓ-max ℓ ℓ') +_≃Fib_ = FibrationIdentityPrinciple.f≃g + +FibrationIP : {B : Type ℓ} (f g : Fibration B ℓ') → f ≃Fib g ≃ (f ≡ g) +FibrationIP = FibrationIdentityPrinciple.FibrationIP + +Embedding : (B : Type ℓ') → (ℓ : Level) → Type (ℓ-max ℓ' (ℓ-suc ℓ)) +Embedding B ℓ = Σ[ A ∈ Type ℓ ] A ↪ B + +module EmbeddingIdentityPrinciple {B : Type ℓ} {ℓ'} (f g : Embedding B ℓ') where + open Σ f renaming (fst to F) + open Σ g renaming (fst to G) + open Σ (f .snd) renaming (fst to ffun; snd to isEmbF) + open Σ (g .snd) renaming (fst to gfun; snd to isEmbG) + f≃g : Type _ + f≃g = (∀ b → fiber ffun b → fiber gfun b) × + (∀ b → fiber gfun b → fiber ffun b) + toFibr : Embedding B ℓ' → Fibration B ℓ' + toFibr (A , (f , _)) = (A , f) + + isEmbeddingToFibr : isEmbedding toFibr + isEmbeddingToFibr w x = fullEquiv .snd where + -- carefully managed such that (cong toFibr) is the equivalence + fullEquiv : (w ≡ x) ≃ (toFibr w ≡ toFibr x) + fullEquiv = compEquiv (congEquiv (invEquiv Σ-assoc-≃)) (invEquiv (Σ≡PropEquiv (λ _ → isPropIsEmbedding))) + + EmbeddingIP : f≃g ≃ (f ≡ g) + EmbeddingIP = + f≃g + ≃⟨ strictIsoToEquiv (invIso toProdIso) ⟩ + (∀ b → (fiber ffun b → fiber gfun b) × (fiber gfun b → fiber ffun b)) + ≃⟨ equivΠCod (λ _ → isEquivPropBiimpl→Equiv (isEmbedding→hasPropFibers isEmbF _) + (isEmbedding→hasPropFibers isEmbG _)) ⟩ + (∀ b → (fiber (f .snd .fst) b) ≃ (fiber (g .snd .fst) b)) + ≃⟨ FibrationIP (toFibr f) (toFibr g) ⟩ + (toFibr f ≡ toFibr g) + ≃⟨ invEquiv (_ , isEmbeddingToFibr _ _) ⟩ + f ≡ g + ■ + +_≃Emb_ : {B : Type ℓ} (f g : Embedding B ℓ') → Type _ +_≃Emb_ = EmbeddingIdentityPrinciple.f≃g + +EmbeddingIP : {B : Type ℓ} (f g : Embedding B ℓ') → f ≃Emb g ≃ (f ≡ g) +EmbeddingIP = EmbeddingIdentityPrinciple.EmbeddingIP + +-- Cantor's theorem for sets +Set-Embedding-into-Powerset : {A : Type ℓ} → isSet A → A ↪ ℙ A +Set-Embedding-into-Powerset {A = A} setA + = fun , (injEmbedding isSetℙ (λ y → sym (H₃ (H₂ y)))) + where fun : A → ℙ A + fun a b = (a ≡ b) , (setA a b) + + H₂ : {a b : A} → fun a ≡ fun b → a ∈ (fun b) + H₂ {a} fa≡fb = transport (cong (fst ∘ (_$ a)) fa≡fb) refl + + H₃ : {a b : A} → b ∈ (fun a) → a ≡ b + H₃ b∈fa = b∈fa + +×Monotone↪ : ∀ {ℓa ℓb ℓc ℓd} + {A : Type ℓa} {B : Type ℓb} {C : Type ℓc} {D : Type ℓd} + → A ↪ C → B ↪ D → (A × B) ↪ (C × D) +×Monotone↪ {A = A} {B = B} {C = C} {D = D} (f , embf) (g , embg) + = (map-× f g) , emb + where apmap : ∀ x y → x ≡ y → map-× f g x ≡ map-× f g y + apmap x y x≡y = ΣPathP (cong (f ∘ fst) x≡y , cong (g ∘ snd) x≡y) + + equiv : ∀ x y → isEquiv (apmap x y) + equiv x y = ((invEquiv ΣPathP≃PathPΣ) + ∙ₑ (≃-× ((cong f) , (embf (fst x) (fst y))) + ((cong g) , (embg (snd x) (snd y)))) + ∙ₑ ΣPathP≃PathPΣ) .snd + + emb : isEmbedding (map-× f g) + emb x y = equiv x y + +EmbeddingΣProp : {A : Type ℓ} → {B : A → Type ℓ'} → (∀ a → isProp (B a)) → Σ A B ↪ A +EmbeddingΣProp f = fst , (λ _ _ → isEmbeddingFstΣProp f) \ No newline at end of file diff --git a/Cubical.Functions.Image.html b/Cubical.Functions.Image.html index 35b86a3ed0..87aa06a8ca 100644 --- a/Cubical.Functions.Image.html +++ b/Cubical.Functions.Image.html @@ -36,16 +36,16 @@ λ y → isOfHLevelRetractFromIso 1 (ϕ y) isPropPropTrunc where ϕ : (y : B) → Iso _ _ - ϕ y = invIso (fiberProjIso B isInImage y) + ϕ y = invIso (fiberProjIso B isInImage y) restrictToImage : A → Image restrictToImage x = (f x) , ∣ x , refl ∣₁ - isSurjectionImageRestriction : isSurjection restrictToImage + isSurjectionImageRestriction : isSurjection restrictToImage isSurjectionImageRestriction (y , y∈im) = PT.rec isPropPropTrunc (λ (x , fx≡y) - → ∣ x , Σ≡Prop isPropIsInImage fx≡y ∣₁) + → ∣ x , Σ≡Prop isPropIsInImage fx≡y ∣₁) y∈im imageFactorization : fst imageInclusion ∘ restrictToImage ≡ f @@ -57,8 +57,8 @@ -} module _ {ℓ₀ ℓ₁} - {Im₀ : Type ℓ₀} (e₀ : A ↠ Im₀) (m₀ : Im₀ ↪ B) - {Im₁ : Type ℓ₁} (e₁ : A ↠ Im₁) (m₁ : Im₁ ↪ B) + {Im₀ : Type ℓ₀} (e₀ : A ↠ Im₀) (m₀ : Im₀ ↪ B) + {Im₁ : Type ℓ₁} (e₁ : A ↠ Im₁) (m₁ : Im₁ ↪ B) (p : m₀ .fst ∘ e₀ .fst ≡ m₁ .fst ∘ e₁ .fst) where @@ -81,8 +81,8 @@ invIsEq (m₁ .snd _ _) (imagesEmbeddingComm _ ∙ funExt⁻ p a) module _ {ℓ₀ ℓ₁} - {Im₀ : Type ℓ₀} (e₀ : A ↠ Im₀) (m₀ : Im₀ ↪ B) - {Im₁ : Type ℓ₁} (e₁ : A ↠ Im₁) (m₁ : Im₁ ↪ B) + {Im₀ : Type ℓ₀} (e₀ : A ↠ Im₀) (m₀ : Im₀ ↪ B) + {Im₁ : Type ℓ₁} (e₁ : A ↠ Im₁) (m₁ : Im₁ ↪ B) (p : m₀ .fst ∘ e₀ .fst ≡ m₁ .fst ∘ e₁ .fst) where @@ -131,7 +131,7 @@ isEquivEmbeddingOntoImage : isEquiv (restrictToImage (fst f)) isEquivEmbeddingOntoImage = - isEmbedding×isSurjection→isEquiv + isEmbedding×isSurjection→isEquiv (hasPropFibers→isEmbedding (λ y → isOfHLevelRetractFromIso 1 (equivToIso (restrictionHasSameFibers y)) @@ -142,5 +142,5 @@ This is the extension to an 'iff', which is also a general modal fact. -} isEmbeddingFromIsEquivToImage : (f : A → B) → isEquiv (restrictToImage f) → isEmbedding f -isEmbeddingFromIsEquivToImage f isEquiv-r = isEmbedding-∘ (snd (imageInclusion f)) (isEquiv→isEmbedding isEquiv-r) +isEmbeddingFromIsEquivToImage f isEquiv-r = isEmbedding-∘ (snd (imageInclusion f)) (isEquiv→isEmbedding isEquiv-r) \ No newline at end of file diff --git a/Cubical.Functions.Surjection.html b/Cubical.Functions.Surjection.html index 8714de8936..57e6c6573f 100644 --- a/Cubical.Functions.Surjection.html +++ b/Cubical.Functions.Surjection.html @@ -3,93 +3,124 @@ module Cubical.Functions.Surjection where open import Cubical.Foundations.Prelude -open import Cubical.Foundations.HLevels -open import Cubical.Foundations.Isomorphism -open import Cubical.Foundations.Equiv -open import Cubical.Foundations.Univalence -open import Cubical.Foundations.Function -open import Cubical.Functions.Embedding - -open import Cubical.Data.Sigma -open import Cubical.Data.Unit -open import Cubical.HITs.PropositionalTruncation as PT - -private variable - ℓ ℓ' : Level - A B C : Type ℓ - f : A → B - -isSurjection : (A → B) → Type _ -isSurjection f = ∀ b → ∥ fiber f b ∥₁ - -_↠_ : Type ℓ → Type ℓ' → Type (ℓ-max ℓ ℓ') -A ↠ B = Σ[ f ∈ (A → B) ] isSurjection f - -section→isSurjection : {g : B → A} → section f g → isSurjection f -section→isSurjection {g = g} s b = ∣ g b , s b ∣₁ - -isPropIsSurjection : isProp (isSurjection f) -isPropIsSurjection = isPropΠ λ _ → squash₁ - -isEquiv→isSurjection : isEquiv f → isSurjection f -isEquiv→isSurjection e b = ∣ fst (equiv-proof e b) ∣₁ - -isEquiv→isEmbedding×isSurjection : isEquiv f → isEmbedding f × isSurjection f -isEquiv→isEmbedding×isSurjection e = isEquiv→isEmbedding e , isEquiv→isSurjection e - -isEmbedding×isSurjection→isEquiv : isEmbedding f × isSurjection f → isEquiv f -equiv-proof (isEmbedding×isSurjection→isEquiv {f = f} (emb , sur)) b = - inhProp→isContr (PT.rec fib' (λ x → x) fib) fib' - where - hpf : hasPropFibers f - hpf = isEmbedding→hasPropFibers emb - - fib : ∥ fiber f b ∥₁ - fib = sur b - - fib' : isProp (fiber f b) - fib' = hpf b - -isEquiv≃isEmbedding×isSurjection : isEquiv f ≃ isEmbedding f × isSurjection f -isEquiv≃isEmbedding×isSurjection = isoToEquiv (iso - isEquiv→isEmbedding×isSurjection - isEmbedding×isSurjection→isEquiv - (λ _ → isOfHLevelΣ 1 isPropIsEmbedding (\ _ → isPropIsSurjection) _ _) - (λ _ → isPropIsEquiv _ _ _)) - --- obs: for epi⇒surjective to go through we require a stronger --- hypothesis that one would expect: --- f must cancel functions from a higher universe. -rightCancellable : (f : A → B) → Type _ -rightCancellable {ℓ} {A} {ℓ'} {B} f = ∀ {C : Type (ℓ-suc (ℓ-max ℓ ℓ'))} - → ∀ (g g' : B → C) → (∀ x → g (f x) ≡ g' (f x)) → ∀ y → g y ≡ g' y - --- This statement is in Mac Lane & Moerdijk (page 143, corollary 5). -epi⇒surjective : (f : A → B) → rightCancellable f → isSurjection f -epi⇒surjective f rc y = transport (fact₂ y) tt* - where hasPreimage : (A → B) → B → _ - hasPreimage f y = ∥ fiber f y ∥₁ - - fact₁ : ∀ x → Unit* ≡ hasPreimage f (f x) - fact₁ x = hPropExt isPropUnit* - isPropPropTrunc - (λ _ → ∣ (x , refl) ∣₁) - (λ _ → tt*) - - fact₂ : ∀ y → Unit* ≡ hasPreimage f y - fact₂ = rc _ _ fact₁ - --- If h ∘ g is surjective, then h is surjective. -leftFactorSurjective : (g : A → B) (h : B → C) - → isSurjection (h ∘ g) - → isSurjection h -leftFactorSurjective g h sur-h∘g c = PT.rec isPropPropTrunc (λ (x , hgx≡c) → ∣ g x , hgx≡c ∣₁) (sur-h∘g c) - -compSurjection : (f : A ↠ B) (g : B ↠ C) - → A ↠ C -compSurjection (f , sur-f) (g , sur-g) = - (λ x → g (f x)) , - λ c → PT.rec isPropPropTrunc - (λ (b , gb≡c) → PT.rec isPropPropTrunc (λ (a , fa≡b) → ∣ a , (cong g fa≡b ∙ gb≡c) ∣₁) (sur-f b)) - (sur-g c) +open import Cubical.Foundations.Powerset +open import Cubical.Foundations.HLevels +open import Cubical.Foundations.Isomorphism +open import Cubical.Foundations.Equiv +open import Cubical.Foundations.Univalence +open import Cubical.Foundations.Function +open import Cubical.Functions.Embedding +open import Cubical.Functions.Fixpoint + +open import Cubical.Relation.Nullary + +open import Cubical.Data.Empty +open import Cubical.Data.Sigma +open import Cubical.Data.Unit +open import Cubical.HITs.PropositionalTruncation as PT + +private variable + ℓ ℓ' : Level + A B C : Type ℓ + f : A → B + +isSurjection : (A → B) → Type _ +isSurjection f = ∀ b → ∥ fiber f b ∥₁ + +_↠_ : Type ℓ → Type ℓ' → Type (ℓ-max ℓ ℓ') +A ↠ B = Σ[ f ∈ (A → B) ] isSurjection f + +section→isSurjection : {g : B → A} → section f g → isSurjection f +section→isSurjection {g = g} s b = ∣ g b , s b ∣₁ + +isPropIsSurjection : isProp (isSurjection f) +isPropIsSurjection = isPropΠ λ _ → squash₁ + +isEquiv→isSurjection : isEquiv f → isSurjection f +isEquiv→isSurjection e b = ∣ fst (equiv-proof e b) ∣₁ + +isEquiv→isEmbedding×isSurjection : isEquiv f → isEmbedding f × isSurjection f +isEquiv→isEmbedding×isSurjection e = isEquiv→isEmbedding e , isEquiv→isSurjection e + +isEmbedding×isSurjection→isEquiv : isEmbedding f × isSurjection f → isEquiv f +equiv-proof (isEmbedding×isSurjection→isEquiv {f = f} (emb , sur)) b = + inhProp→isContr (PT.rec fib' (λ x → x) fib) fib' + where + hpf : hasPropFibers f + hpf = isEmbedding→hasPropFibers emb + + fib : ∥ fiber f b ∥₁ + fib = sur b + + fib' : isProp (fiber f b) + fib' = hpf b + +isEquiv≃isEmbedding×isSurjection : isEquiv f ≃ isEmbedding f × isSurjection f +isEquiv≃isEmbedding×isSurjection = isoToEquiv (iso + isEquiv→isEmbedding×isSurjection + isEmbedding×isSurjection→isEquiv + (λ _ → isOfHLevelΣ 1 isPropIsEmbedding (\ _ → isPropIsSurjection) _ _) + (λ _ → isPropIsEquiv _ _ _)) + +-- obs: for epi⇒surjective to go through we require a stronger +-- hypothesis that one would expect: +-- f must cancel functions from a higher universe. +rightCancellable : (f : A → B) → Type _ +rightCancellable {ℓ} {A} {ℓ'} {B} f = ∀ {C : Type (ℓ-suc (ℓ-max ℓ ℓ'))} + → ∀ (g g' : B → C) → (∀ x → g (f x) ≡ g' (f x)) → ∀ y → g y ≡ g' y + +-- This statement is in Mac Lane & Moerdijk (page 143, corollary 5). +epi⇒surjective : (f : A → B) → rightCancellable f → isSurjection f +epi⇒surjective f rc y = transport (fact₂ y) tt* + where hasPreimage : (A → B) → B → _ + hasPreimage f y = ∥ fiber f y ∥₁ + + fact₁ : ∀ x → Unit* ≡ hasPreimage f (f x) + fact₁ x = hPropExt isPropUnit* + isPropPropTrunc + (λ _ → ∣ (x , refl) ∣₁) + (λ _ → tt*) + + fact₂ : ∀ y → Unit* ≡ hasPreimage f y + fact₂ = rc _ _ fact₁ + +-- If h ∘ g is surjective, then h is surjective. +leftFactorSurjective : (g : A → B) (h : B → C) + → isSurjection (h ∘ g) + → isSurjection h +leftFactorSurjective g h sur-h∘g c = PT.rec isPropPropTrunc (λ (x , hgx≡c) → ∣ g x , hgx≡c ∣₁) (sur-h∘g c) + +compSurjection : (f : A ↠ B) (g : B ↠ C) + → A ↠ C +compSurjection (f , sur-f) (g , sur-g) = + (λ x → g (f x)) , + λ c → PT.rec isPropPropTrunc + (λ (b , gb≡c) → PT.rec isPropPropTrunc (λ (a , fa≡b) → ∣ a , (cong g fa≡b ∙ gb≡c) ∣₁) (sur-f b)) + (sur-g c) + +-- Lawvere's fixed point theorem +↠Fixpoint : ∀ {A : Type ℓ} {B : Type ℓ'} + → (A ↠ (A → B)) + → (n : B → B) + → ∥ Fixpoint n ∥₁ +↠Fixpoint {A = A} {B = B} (f , surf) n + = map (λ (a , fib) → g a , sym (cong n (funExt⁻ fib a))) (surf g) + where g : A → B + g a = n ( f a a ) + +-- Cantor's theorem, that no type surjects into its power set +¬Surjection-into-Powerset : ∀ {A : Type ℓ} → ¬ (A ↠ ℙ A) +¬Surjection-into-Powerset {A = A} (f , surf) + = PT.rec isProp⊥ (λ (_ , fx≡g) → H₁ fx≡g (H₂ fx≡g (H₁ fx≡g))) (surf g) + where _∉_ : ∀ {A} → A → ℙ A → Type ℓ + x ∉ A = ¬ (x ∈ A) + + g : ℙ A + g = λ x → (x ∉ f x , isProp¬ _) + + H₁ : {x : A} → f x ≡ g → x ∉ (f x) + H₁ {x} fx≡g x∈fx = transport (cong (fst ∘ (_$ x)) fx≡g) x∈fx x∈fx + + H₂ : {x : A} → f x ≡ g → x ∉ (f x) → x ∈ (f x) + H₂ {x} fx≡g x∈g = transport (cong (fst ∘ (_$ x)) (sym fx≡g)) x∈g \ No newline at end of file diff --git a/Cubical.HITs.Bouquet.FundamentalGroupProof.html b/Cubical.HITs.Bouquet.FundamentalGroupProof.html index e867103615..606f1b4c52 100644 --- a/Cubical.HITs.Bouquet.FundamentalGroupProof.html +++ b/Cubical.HITs.Bouquet.FundamentalGroupProof.html @@ -78,10 +78,10 @@ π₁Bouquet {A = A} = π 1 (Bouquet∙ A) loopingT : ∥ FreeGroupoid A ∥₂ → π₁Bouquet -loopingT = map looping +loopingT = map looping windingT : π₁Bouquet → ∥ FreeGroupoid A ∥₂ -windingT = map winding +windingT = map winding -- Utility proofs @@ -234,7 +234,7 @@ g ∎ right-homotopyInTruncatedGroupoid : (g : FreeGroupoid A) → ∣ winding (looping g) ∣₂ ≡ ∣ g ∣₂ -right-homotopyInTruncatedGroupoid g = Iso.inv PathIdTrunc₀Iso (truncatedRight-homotopy g) +right-homotopyInTruncatedGroupoid g = Iso.inv PathIdTrunc₀Iso (truncatedRight-homotopy g) -- Truncated encodeDecode over all fibrations @@ -247,15 +247,15 @@ pointwise x = isProp→PathP (λ i → squash₁) (f x) (g x) encodeDecodeInTruncatedGroupoid : (x : Bouquet A) → (g : code x) → ∣ encode x (decode x g) ∣₂ ≡ ∣ g ∣₂ -encodeDecodeInTruncatedGroupoid x g = Iso.inv PathIdTrunc₀Iso (truncatedEncodeDecode x g) +encodeDecodeInTruncatedGroupoid x g = Iso.inv PathIdTrunc₀Iso (truncatedEncodeDecode x g) -- Encode Decode over the truncated versions of the types encodeT : (x : Bouquet A) → ∥ base ≡ x ∥₂ → ∥ code x ∥₂ -encodeT x = map (encode x) +encodeT x = map (encode x) decodeT : (x : Bouquet A) → ∥ code x ∥₂ → ∥ base ≡ x ∥₂ -decodeT x = map (decode x) +decodeT x = map (decode x) decodeEncodeT : (x : Bouquet A) → (p : ∥ base ≡ x ∥₂) → decodeT x (encodeT x p) ≡ p decodeEncodeT x g = elim sethood induction g where diff --git a/Cubical.HITs.Cost.Base.html b/Cubical.HITs.Cost.Base.html index 1e64ca53d7..b9f0e5f4ca 100644 --- a/Cubical.HITs.Cost.Base.html +++ b/Cubical.HITs.Cost.Base.html @@ -18,7 +18,7 @@ -- To compare two elements of Cost A we only need to look at the first parts Cost≡ : (x y : Cost A) → x .fst ≡ y .fst → x ≡ y -Cost≡ _ _ = Σ≡Prop λ _ → squash₁ +Cost≡ _ _ = Σ≡Prop λ _ → squash₁ -- To make it easier to program with Cost A we prove that it forms a -- monad which counts the number of calls to >>=. We could also turn diff --git a/Cubical.HITs.CumulativeHierarchy.Properties.html b/Cubical.HITs.CumulativeHierarchy.Properties.html index 3fb328cfe8..c5a0db00d7 100644 --- a/Cubical.HITs.CumulativeHierarchy.Properties.html +++ b/Cubical.HITs.CumulativeHierarchy.Properties.html @@ -123,15 +123,15 @@ repFiber f b = Σ[ a ∈ _ ] f a ≊ b repFiber≃fiber : (f : X → V ℓ) (b : V ℓ) → repFiber f b ≃ fiber f b -repFiber≃fiber f b = Σ-cong-equiv (idEquiv _) (λ _ → identityPrinciple) +repFiber≃fiber f b = Σ-cong-equiv (idEquiv _) (λ _ → identityPrinciple) -- projecting out a representing type together with the embedding MonicPresentation : (a : V ℓ) → Type (ℓ-suc ℓ) -MonicPresentation {ℓ} a = Σ[ (X , ix , _) ∈ Embedding (V ℓ) ℓ ] (a ≡ sett X ix) +MonicPresentation {ℓ} a = Σ[ (X , ix , _) ∈ Embedding (V ℓ) ℓ ] (a ≡ sett X ix) isPropMonicPresentation : (a : V ℓ) → isProp (MonicPresentation a) isPropMonicPresentation a ((X₁ , ix₁ , isEmb₁) , p) ((X₂ , ix₂ , isEmb₂) , q) = - ΣPathP ( equivFun (EmbeddingIP _ _) (fiberwise1 , fiberwise2) + ΣPathP ( equivFun (EmbeddingIP _ _) (fiberwise1 , fiberwise2) , isProp→PathP (λ i → setIsSet a _) p q) where open PropMonad @@ -194,13 +194,13 @@ private MonicDataF : Type (ℓ-suc ℓ) → Type (ℓ-suc ℓ) - MonicDataF {ℓ} T = Embedding T ℓ + MonicDataF {ℓ} T = Embedding T ℓ V-fixpoint : V ℓ ≃ MonicDataF (V ℓ) V-fixpoint {ℓ} = - V ℓ ≃⟨ invEquiv (Σ-contractSnd λ a → inhProp→isContr (V-repr a) (isPropMonicPresentation a)) ⟩ + V ℓ ≃⟨ invEquiv (Σ-contractSnd λ a → inhProp→isContr (V-repr a) (isPropMonicPresentation a)) ⟩ (Σ[ a ∈ V ℓ ] MonicPresentation a) ≃⟨ boringswap ⟩ - (Σ[ (X , ix , _) ∈ MonicDataF (V ℓ) ] singl (sett X ix)) ≃⟨ Σ-contractSnd (λ _ → isContrSingl _) ⟩ + (Σ[ (X , ix , _) ∈ MonicDataF (V ℓ) ] singl (sett X ix)) ≃⟨ Σ-contractSnd (λ _ → isContrSingl _) ⟩ MonicDataF (V ℓ) ■ where boringswap : (Σ[ a ∈ V ℓ ] MonicPresentation a) ≃ (Σ[ (X , ix , _) ∈ MonicDataF (V ℓ) ] singl (sett X ix)) boringswap = isoToEquiv (iso @@ -233,7 +233,7 @@ isPropRepFiber : (a b : V ℓ) → isProp (repFiber ⟪ a ⟫↪ b) isPropRepFiber a b = - Embedding-into-isProp→isProp + Embedding-into-isProp→isProp (Equiv→Embedding (repFiber≃fiber ⟪ a ⟫↪ b)) (isEmbedding→hasPropFibers isEmb⟪ a ⟫↪ b) @@ -274,7 +274,7 @@ from : ⟪ a ⟫ → Σ[ v ∈ V _ ] ⟨ v ∈ₛ a ⟩ from ⟪a⟫ = ⟪ a ⟫↪ ⟪a⟫ , ∈ₛ⟪ a ⟫↪ ⟪a⟫ retr : retract into from - retr s = Σ≡Prop (λ v → (v ∈ₛ a) .snd) (equivFun identityPrinciple (s .snd .snd)) + retr s = Σ≡Prop (λ v → (v ∈ₛ a) .snd) (equivFun identityPrinciple (s .snd .snd)) -- subset relation, once in level (ℓ-suc ℓ) and once in ℓ _⊆_ : (a b : V ℓ) → hProp (ℓ-suc ℓ) @@ -288,7 +288,7 @@ ⊆⇔⊆ₛ : (a b : V ℓ) → ⟨ a ⊆ b ⇔ a ⊆ₛ b ⟩ ⊆⇔⊆ₛ a b = - (λ s → invEq curryEquiv s ∘ invEq (presentation a)) + (λ s → invEq curryEquiv s ∘ invEq (presentation a)) , (λ s x xa → subst (λ x → ⟨ x ∈ₛ b ⟩) (equivFun identityPrinciple (xa .snd)) (s (xa .fst))) -- the homotopy definition of equality as an hProp, we know this is equivalent to bisimulation @@ -299,8 +299,8 @@ -- extensionality extensionality : ⟨ ∀[ a ∶ V ℓ ] ∀[ b ] (a ⊆ b) ⊓ (b ⊆ a) ⇒ (a ≡ₕ b) ⟩ extensionality {ℓ = ℓ} a b imeq = ⟪ a ⟫-represents ∙∙ settab ∙∙ sym ⟪ b ⟫-represents where - abpth : Path (Embedding _ _) (⟪ a ⟫ , ⟪ a ⟫↪ , isEmb⟪ a ⟫↪) (⟪ b ⟫ , ⟪ b ⟫↪ , isEmb⟪ b ⟫↪) - abpth = equivFun (EmbeddingIP _ _) + abpth : Path (Embedding _ _) (⟪ a ⟫ , ⟪ a ⟫↪ , isEmb⟪ a ⟫↪) (⟪ b ⟫ , ⟪ b ⟫↪ , isEmb⟪ b ⟫↪) + abpth = equivFun (EmbeddingIP _ _) ( (λ p → equivFun (repFiber≃fiber ⟪ b ⟫↪ p) ∘ imeq .fst p ∘ invEq (repFiber≃fiber ⟪ a ⟫↪ p)) , (λ p → equivFun (repFiber≃fiber ⟪ a ⟫↪ p) ∘ imeq .snd p ∘ invEq (repFiber≃fiber ⟪ b ⟫↪ p)) ) diff --git a/Cubical.HITs.FreeGroupoid.Properties.html b/Cubical.HITs.FreeGroupoid.Properties.html index 5d031a5b2b..5d0a00781a 100644 --- a/Cubical.HITs.FreeGroupoid.Properties.html +++ b/Cubical.HITs.FreeGroupoid.Properties.html @@ -118,7 +118,7 @@ (λ x → elim (λ g → isProp→isSet (squash₂ (∣ε∣₂ ∣·∣₂ g) g)) (λ g → cong (λ g' → ∣ g' ∣₂) (sym (idl g))) x) ∣inv∣₂ : ∥ FreeGroupoid A ∥₂ → ∥ FreeGroupoid A ∥₂ -∣inv∣₂ = map inv +∣inv∣₂ = map inv ∥freeGroupoid∥₂IsGroup : IsGroup {G = ∥ FreeGroupoid A ∥₂} ∣ε∣₂ _∣·∣₂_ ∣inv∣₂ ∥freeGroupoid∥₂IsGroup = isgroup ∥freeGroupoid∥₂IsMonoid diff --git a/Cubical.HITs.GroupoidQuotients.Base.html b/Cubical.HITs.GroupoidQuotients.Base.html index 6122f19e66..d11f813fb8 100644 --- a/Cubical.HITs.GroupoidQuotients.Base.html +++ b/Cubical.HITs.GroupoidQuotients.Base.html @@ -15,7 +15,7 @@ -- Groupoid quotients as a higher inductive type: -- For the definition, only transitivity is needed data _//_ {ℓ ℓ'} (A : Type ℓ) {R : A → A → Type ℓ'} - (Rt : BinaryRelation.isTrans R) : Type (ℓ-max ℓ ℓ') where + (Rt : BinaryRelation.isTrans R) : Type (ℓ-max ℓ ℓ') where [_] : (a : A) → A // Rt eq// : {a b : A} → (r : R a b) → [ a ] ≡ [ b ] comp// : {a b c : A} → (r : R a b) → (s : R b c) @@ -36,7 +36,7 @@ -} comp'// : {ℓ ℓ' : Level} (A : Type ℓ) {R : A → A → Type ℓ'} - (Rt : BinaryRelation.isTrans R) + (Rt : BinaryRelation.isTrans R) {a b c : A} → (r : R a b) → (s : R b c) → eq// {Rt = Rt} (Rt a b c r s) ≡ eq// r ∙ eq// s comp'// A Rt r s i = compPath-unique refl (eq// r) (eq// s) diff --git a/Cubical.HITs.GroupoidQuotients.Properties.html b/Cubical.HITs.GroupoidQuotients.Properties.html index 1b886171c2..448767b73f 100644 --- a/Cubical.HITs.GroupoidQuotients.Properties.html +++ b/Cubical.HITs.GroupoidQuotients.Properties.html @@ -35,7 +35,7 @@ A : Type ℓA R : A → A → Type ℓR -elimSet : (Rt : BinaryRelation.isTrans R) +elimSet : (Rt : BinaryRelation.isTrans R) → {B : A // Rt → Type ℓ} → ((x : A // Rt) → isSet (B x)) → (f : (a : A) → B [ a ]) @@ -54,7 +54,7 @@ where g = elimSet Rt Bset f feq -elimProp : (Rt : BinaryRelation.isTrans R) +elimProp : (Rt : BinaryRelation.isTrans R) → {B : A // Rt → Type ℓ} → ((x : A // Rt) → isProp (B x)) → ((a : A) → B [ a ]) @@ -63,7 +63,7 @@ elimProp Rt Brop f x = elimSet Rt (λ x → isProp→isSet (Brop x)) f (λ r → isProp→PathP (λ i → Brop (eq// r i)) (f _) (f _)) x -elimProp2 : (Rt : BinaryRelation.isTrans R) +elimProp2 : (Rt : BinaryRelation.isTrans R) → {C : A // Rt → A // Rt → Type ℓ} → ((x y : A // Rt) → isProp (C x y)) → ((a b : A) → C [ a ] [ b ]) @@ -72,11 +72,11 @@ elimProp2 Rt Cprop f = elimProp Rt (λ x → isPropΠ (λ y → Cprop x y)) (λ x → elimProp Rt (λ y → Cprop [ x ] y) (f x)) -isSurjective[] : (Rt : BinaryRelation.isTrans R) - → isSurjection (λ a → [ a ]) +isSurjective[] : (Rt : BinaryRelation.isTrans R) + → isSurjection (λ a → [ a ]) isSurjective[] Rt = elimProp Rt (λ x → squash₁) (λ a → ∣ a , refl ∣₁) -elim : (Rt : BinaryRelation.isTrans R) +elim : (Rt : BinaryRelation.isTrans R) → {B : A // Rt → Type ℓ} → ((x : A // Rt) → isGroupoid (B x)) → (f : (a : A) → B [ a ]) @@ -95,7 +95,7 @@ where g = elim Rt Bgpd f feq fcomp -rec : (Rt : BinaryRelation.isTrans R) +rec : (Rt : BinaryRelation.isTrans R) → {B : Type ℓ} → isGroupoid B → (f : A → B) diff --git a/Cubical.HITs.James.Inductive.PushoutFormula.html b/Cubical.HITs.James.Inductive.PushoutFormula.html index 1395020bdf..4766922a1c 100644 --- a/Cubical.HITs.James.Inductive.PushoutFormula.html +++ b/Cubical.HITs.James.Inductive.PushoutFormula.html @@ -155,7 +155,7 @@ private left≃ : X × 𝕁ames 1 ≃ X × X - left≃ = ≃-× (idEquiv _) 𝕁ames1≃ + left≃ = ≃-× (idEquiv _) 𝕁ames1≃ lComm : (x : 𝕁amesPush 0) → left≃ .fst (leftMap x) ≡ ⋁↪ (P0→X⋁X x) lComm (inl (x , [])) = refl diff --git a/Cubical.HITs.James.LoopSuspEquiv.html b/Cubical.HITs.James.LoopSuspEquiv.html index d40ed682e9..fb9de5a9cc 100644 --- a/Cubical.HITs.James.LoopSuspEquiv.html +++ b/Cubical.HITs.James.LoopSuspEquiv.html @@ -117,7 +117,7 @@ open FlatteningLemma (λ _ → tt) (λ _ → tt) (λ tt → James) (λ tt → James) (λ x → _ , isEquiv∷ x) Total≃ : Pushout Σf Σg ≃ Total - Total≃ = pushoutEquiv _ _ _ _ (idEquiv _) (ΣUnit _) (ΣUnit _) refl refl + Total≃ = pushoutEquiv _ _ _ _ (idEquiv _) (ΣUnit _) (ΣUnit _) refl refl PushoutSuspCode : (x : PushoutSusp X) → E x ≃ Code (PushoutSusp→Susp x) PushoutSuspCode (inl tt) = idEquiv _ @@ -125,7 +125,7 @@ PushoutSuspCode (push x i) = idEquiv _ ΣCode≃' : _ ≃ Σ _ Code - ΣCode≃' = Σ-cong-equiv PushoutSusp≃Susp PushoutSuspCode + ΣCode≃' = Σ-cong-equiv PushoutSusp≃Susp PushoutSuspCode ΣCode≃ : Total ≃ Σ _ Code ΣCode≃ = compEquiv (invEquiv Total≃) (compEquiv (invEquiv flatten) ΣCode≃') diff --git a/Cubical.HITs.PropositionalTruncation.Properties.html b/Cubical.HITs.PropositionalTruncation.Properties.html index 1b763c6773..a8df38e61e 100644 --- a/Cubical.HITs.PropositionalTruncation.Properties.html +++ b/Cubical.HITs.PropositionalTruncation.Properties.html @@ -216,7 +216,7 @@ eqv : (g : Σ (A → B) 2-Constant) → ∀ fi → fib g ≡ fi eqv g (f , p) = - Σ≡Prop (λ f → isOfHLevelΣ 2 Fset Kset _ _) + Σ≡Prop (λ f → isOfHLevelΣ 2 Fset Kset _ _) (cong (uncurry rec→Set) (sym p) ∙ setRecLemma f) trunc→Set≃ : (∥ A ∥₁ → B) ≃ (Σ (A → B) 2-Constant) diff --git a/Cubical.HITs.Pushout.KrausVonRaumer.html b/Cubical.HITs.Pushout.KrausVonRaumer.html index e4243e7673..db30ea85fe 100644 --- a/Cubical.HITs.Pushout.KrausVonRaumer.html +++ b/Cubical.HITs.Pushout.KrausVonRaumer.html @@ -149,7 +149,7 @@ subst (P (f a) p ≃_) (cong (λ w → fiber (cong ⊔.inr) (p ∙ w)) (lUnit (push a) ⁻¹)) - (Σ-contractFst (inhProp→isContr (a , refl) (isEmbedding→hasPropFibers fEmb (f a))))) + (Σ-contractFst (inhProp→isContr (a , refl) (isEmbedding→hasPropFibers fEmb (f a))))) bwd : ∀ c → (t : ⊔.inr c₀ ≡ ⊔.inr c) → fiber (cong ⊔.inr) t bwd = Bwd.elimR diff --git a/Cubical.HITs.RPn.Base.html b/Cubical.HITs.RPn.Base.html index 94972b0d88..7866709614 100644 --- a/Cubical.HITs.RPn.Base.html +++ b/Cubical.HITs.RPn.Base.html @@ -70,8 +70,8 @@ isContrBoolPointedEquiv : ∀ x → isContr ((Bool , false) ≃[ PointedEquivStr ] (Bool , x)) fst (isContrBoolPointedEquiv x) = ((λ y → x ⊕ y) , isEquiv-⊕ x) , ⊕-comm x false snd (isContrBoolPointedEquiv x) (e , p) - = Σ≡Prop (λ e → isSetBool (equivFun e false) x) - (Σ≡Prop isPropIsEquiv (funExt λ { false → ⊕-comm x false ∙ sym p + = Σ≡Prop (λ e → isSetBool (equivFun e false) x) + (Σ≡Prop isPropIsEquiv (funExt λ { false → ⊕-comm x false ∙ sym p ; true → ⊕-comm x true ∙ sym q })) where q : e .fst true ≡ not x q with dichotomyBool (invEq e (not x)) @@ -235,7 +235,7 @@ where open ⊕* (cov⁻¹ (-1+ n) x) i : Total (cov⁻¹ (ℕ→ℕ₋₁ n)) ≃ Pushout Σf Σg - i = (Σ[ x ∈ RP (ℕ→ℕ₋₁ n) ] typ (cov⁻¹ (ℕ→ℕ₋₁ n) x)) ≃⟨ Σ-cong-equiv-snd cov⁻¹≃E ⟩ + i = (Σ[ x ∈ RP (ℕ→ℕ₋₁ n) ] typ (cov⁻¹ (ℕ→ℕ₋₁ n) x)) ≃⟨ Σ-cong-equiv-snd cov⁻¹≃E ⟩ (Σ[ x ∈ RP (ℕ→ℕ₋₁ n) ] E x) ≃⟨ flatten ⟩ Pushout Σf Σg ■ {- @@ -260,19 +260,19 @@ This was proved above by ⊕*.isEquivˡ. -} u : ∀ {n} → (Σ[ x ∈ Total (cov⁻¹ n) ] typ (cov⁻¹ n (fst x))) ≃ (Total (cov⁻¹ n) × Bool) - u {n} = Σ[ x ∈ Total (cov⁻¹ n) ] typ (cov⁻¹ n (fst x)) ≃⟨ Σ-assoc-≃ ⟩ - Σ[ x ∈ RP n ] (typ (cov⁻¹ n x)) × (typ (cov⁻¹ n x)) ≃⟨ Σ-cong-equiv-snd (λ x → Σ-swap-≃) ⟩ - Σ[ x ∈ RP n ] (typ (cov⁻¹ n x)) × (typ (cov⁻¹ n x)) ≃⟨ Σ-cong-equiv-snd - (λ x → Σ-cong-equiv-snd + u {n} = Σ[ x ∈ Total (cov⁻¹ n) ] typ (cov⁻¹ n (fst x)) ≃⟨ Σ-assoc-≃ ⟩ + Σ[ x ∈ RP n ] (typ (cov⁻¹ n x)) × (typ (cov⁻¹ n x)) ≃⟨ Σ-cong-equiv-snd (λ x → Σ-swap-≃) ⟩ + Σ[ x ∈ RP n ] (typ (cov⁻¹ n x)) × (typ (cov⁻¹ n x)) ≃⟨ Σ-cong-equiv-snd + (λ x → Σ-cong-equiv-snd (λ y → ⊕*.Equivˡ (cov⁻¹ n x) y)) ⟩ - Σ[ x ∈ RP n ] (typ (cov⁻¹ n x)) × Bool ≃⟨ invEquiv Σ-assoc-≃ ⟩ + Σ[ x ∈ RP n ] (typ (cov⁻¹ n x)) × Bool ≃⟨ invEquiv Σ-assoc-≃ ⟩ Total (cov⁻¹ n) × Bool ■ H : ∀ x → u .fst x ≡ (Σf x , snd (Σg x)) H x = refl nat : 3-span-equiv (3span Σf Σg) (3span {A2 = Total (cov⁻¹ (-1+ n)) × Bool} fst snd) - nat = record { e0 = idEquiv _ ; e2 = u ; e4 = ΣUnit _ + nat = record { e0 = idEquiv _ ; e2 = u ; e4 = ΣUnit _ ; H1 = λ x → cong fst (H x) ; H3 = λ x → cong snd (H x) } diff --git a/Cubical.HITs.Replacement.Base.html b/Cubical.HITs.Replacement.Base.html index 7fc84027f6..e3f50f3613 100644 --- a/Cubical.HITs.Replacement.Base.html +++ b/Cubical.HITs.Replacement.Base.html @@ -85,7 +85,7 @@ -- Surjection half of the image factorization - isSurjectiveRep : isSurjection rep + isSurjectiveRep : isSurjection rep isSurjectiveRep = elimProp (λ _ → squash₁) (λ x → ∣ x , refl ∣₁) -- Embedding half of the image factorization diff --git a/Cubical.HITs.SetQuotients.EqClass.html b/Cubical.HITs.SetQuotients.EqClass.html index fc96df447c..c70141e075 100644 --- a/Cubical.HITs.SetQuotients.EqClass.html +++ b/Cubical.HITs.SetQuotients.EqClass.html @@ -24,8 +24,8 @@ -- another definition using equivalence classes -open BinaryRelation -open isEquivRel +open BinaryRelation +open isEquivRel open Iso @@ -88,11 +88,11 @@ {ℓ ℓ' ℓ'' : Level} (X : Type ℓ) (R : X → X → Type ℓ'') - (h : isEquivRel R) where + (h : isEquivRel R) where ∥Rx∥Iso : (x x' : X)(r : R x x') → (a : X) → Iso ∥ R a x ∥₁ ∥ R a x' ∥₁ - ∥Rx∥Iso x x' r a .fun = Prop.rec isPropPropTrunc (λ r' → ∣ h .transitive _ _ _ r' r ∣₁) - ∥Rx∥Iso x x' r a .inv = Prop.rec isPropPropTrunc (λ r' → ∣ h .transitive _ _ _ r' (h .symmetric _ _ r) ∣₁) + ∥Rx∥Iso x x' r a .fun = Prop.rec isPropPropTrunc (λ r' → ∣ h .transitive _ _ _ r' r ∣₁) + ∥Rx∥Iso x x' r a .inv = Prop.rec isPropPropTrunc (λ r' → ∣ h .transitive _ _ _ r' (h .symmetric _ _ r) ∣₁) ∥Rx∥Iso x x' r a .leftInv _ = isPropPropTrunc _ _ ∥Rx∥Iso x x' r a .rightInv _ = isPropPropTrunc _ _ @@ -116,7 +116,7 @@ /→∥ = SetQuot.rec (isSet∥ X R) ∥R∥ (λ x x' r → ∥Rx∥Path x x' r) inj/→∥' : (x x' : X) → ∥R∥ x ≡ ∥R∥ x' → ∥ R x x' ∥₁ - inj/→∥' x x' p = transport (λ i → p i .fst x .fst) ∣ h .reflexive x ∣₁ + inj/→∥' x x' p = transport (λ i → p i .fst x .fst) ∣ h .reflexive x ∣₁ inj/→∥ : (x y : X / R) → /→∥ x ≡ /→∥ y → x ≡ y inj/→∥ = @@ -137,10 +137,10 @@ (λ i → isPropIsEqClass X R (surj/→∥ P (x , p) i .fst)) (isEqClass∥Rx∥ x) (P .snd) i - isSurjection/→∥ : isSurjection /→∥ + isSurjection/→∥ : isSurjection /→∥ isSurjection/→∥ P = Prop.rec isPropPropTrunc (λ p → ∣ [ p .fst ] , surj/→∥ P p ∣₁) (P .snd) -- both definitions are equivalent equivQuot : X / R ≃ X ∥ R - equivQuot = /→∥ , isEmbedding×isSurjection→isEquiv (isEmbedding/→∥ , isSurjection/→∥) + equivQuot = /→∥ , isEmbedding×isSurjection→isEquiv (isEmbedding/→∥ , isSurjection/→∥) \ No newline at end of file diff --git a/Cubical.HITs.SetQuotients.Properties.html b/Cubical.HITs.SetQuotients.Properties.html index f61283b808..c8ad4e99f4 100644 --- a/Cubical.HITs.SetQuotients.Properties.html +++ b/Cubical.HITs.SetQuotients.Properties.html @@ -31,7 +31,7 @@ open import Cubical.HITs.PropositionalTruncation as PropTrunc using (∥_∥₁ ; ∣_∣₁ ; squash₁) renaming (rec to propRec) open import Cubical.HITs.SetTruncation as SetTrunc - using (∥_∥₂ ; ∣_∣₂ ; squash₂ ; isSetSetTrunc) + using (∥_∥₂ ; ∣_∣₂ ; squash₂ ; isSetSetTrunc) private @@ -138,7 +138,7 @@ -- We start by proving that we can recover the set-quotient -- by set-truncating the (non-truncated type quotient) typeQuotSetTruncIso : Iso (A / R) ∥ A /ₜ R ∥₂ -Iso.fun typeQuotSetTruncIso = rec isSetSetTrunc (λ a → ∣ [ a ] ∣₂) +Iso.fun typeQuotSetTruncIso = rec isSetSetTrunc (λ a → ∣ [ a ] ∣₂) λ a b r → cong ∣_∣₂ (eq/ a b r) Iso.inv typeQuotSetTruncIso = SetTrunc.rec squash/ (TypeQuot.rec [_] eq/) Iso.rightInv typeQuotSetTruncIso = SetTrunc.elim (λ _ → isProp→isSet (squash₂ _ _)) @@ -155,7 +155,7 @@ fun = f₁ ∘ f₂ where f₁ : ∥ A /ₜ R ∥₂ → B - f₁ = SetTrunc.rec→Gpd.fun Bgpd f/ congF/Const + f₁ = SetTrunc.rec→Gpd.fun Bgpd f/ congF/Const where f/ : A /ₜ R → B f/ = TypeQuot.rec f feq @@ -189,7 +189,7 @@ → (A / R → B) ≃ (Σ[ f ∈ (A → B) ] ((a b : A) → R a b → f a ≡ f b)) setQuotUniversal Bset = isoToEquiv (setQuotUniversalIso Bset) -open BinaryRelation +open BinaryRelation setQuotUnaryOp : (-_ : A → A) → (∀ a a' → R a a' → R (- a) (- a')) @@ -197,7 +197,7 @@ setQuotUnaryOp -_ h = rec squash/ (λ a → [ - a ]) (λ a b x → eq/ _ _ (h _ _ x)) -- characterisation of binary functions/operations on set-quotients -setQuotUniversal2Iso : isSet C → isRefl R → isRefl S +setQuotUniversal2Iso : isSet C → isRefl R → isRefl S → Iso (A / R → B / S → C) (Σ[ _∗_ ∈ (A → B → C) ] (∀ a a' b b' → R a a' → S b b' → a ∗ b ≡ a' ∗ b')) Iso.fun (setQuotUniversal2Iso {R = R} {S = S} Bset isReflR isReflS) _∗/_ = _∗_ , h @@ -215,11 +215,11 @@ hright : ∀ a b b' → S b b' → (a ∗ b) ≡ (a ∗ b') hright a _ _ r = h _ _ _ _ (isReflR a) r Iso.rightInv (setQuotUniversal2Iso Bset isReflR isReflS) (_∗_ , h) = - Σ≡Prop (λ _ → isPropΠ4 λ _ _ _ _ → isPropΠ2 λ _ _ → Bset _ _) refl + Σ≡Prop (λ _ → isPropΠ4 λ _ _ _ _ → isPropΠ2 λ _ _ → Bset _ _) refl Iso.leftInv (setQuotUniversal2Iso Bset isReflR isReflS) _∗/_ = funExt₂ (elimProp2 (λ _ _ → Bset _ _) λ _ _ → refl) -setQuotUniversal2 : isSet C → isRefl R → isRefl S +setQuotUniversal2 : isSet C → isRefl R → isRefl S → (A / R → B / S → C) ≃ (Σ[ _∗_ ∈ (A → B → C) ] (∀ a a' b b' → R a a' → S b b' → a ∗ b ≡ a' ∗ b')) setQuotUniversal2 Bset isReflR isReflS = @@ -227,7 +227,7 @@ -- corollary for binary operations -- TODO: prove truncated inverse for effective relations -setQuotBinOp : isRefl R → isRefl S +setQuotBinOp : isRefl R → isRefl S → (_∗_ : A → B → C) → (∀ a a' b b' → R a a' → S b b' → T (a ∗ b) (a' ∗ b')) → (A / R → B / S → C / T) @@ -236,7 +236,7 @@ (λ _ _ _ r → eq/ _ _ (h _ _ _ _ r (isReflS _))) (λ _ _ _ s → eq/ _ _ (h _ _ _ _ (isReflR _) s)) -setQuotSymmBinOp : isRefl R → isTrans R +setQuotSymmBinOp : isRefl R → isTrans R → (_∗_ : A → A → A) → (∀ a b → R (a ∗ b) (b ∗ a)) → (∀ a a' b → R a a' → R (a ∗ b) (a' ∗ b)) @@ -250,9 +250,9 @@ (isTransR _ _ _ (∗Rsymm a' b) (isTransR _ _ _ (h b b' a' rb) (∗Rsymm b' a'))) -effective : (Rprop : isPropValued R) (Requiv : isEquivRel R) +effective : (Rprop : isPropValued R) (Requiv : isEquivRel R) → (a b : A) → [ a ] ≡ [ b ] → R a b -effective {A = A} {R = R} Rprop (equivRel R/refl R/sym R/trans) a b p = +effective {A = A} {R = R} Rprop (equivRel R/refl R/sym R/trans) a b p = transport aa≡ab (R/refl _) where helper : A / R → hProp _ @@ -260,7 +260,7 @@ rec isSetHProp (λ c → (R a c , Rprop a c)) (λ c d cd → - Σ≡Prop (λ _ → isPropIsProp) + Σ≡Prop (λ _ → isPropIsProp) (hPropExt (Rprop a c) (Rprop a d) (λ ac → R/trans _ _ _ ac cd) (λ ad → R/trans _ _ _ ad (R/sym _ _ cd)))) @@ -268,14 +268,14 @@ aa≡ab : R a a ≡ R a b aa≡ab i = helper (p i) .fst -isEquivRel→effectiveIso : isPropValued R → isEquivRel R +isEquivRel→effectiveIso : isPropValued R → isEquivRel R → (a b : A) → Iso ([ a ] ≡ [ b ]) (R a b) Iso.fun (isEquivRel→effectiveIso {R = R} Rprop Req a b) = effective Rprop Req a b Iso.inv (isEquivRel→effectiveIso {R = R} Rprop Req a b) = eq/ a b Iso.rightInv (isEquivRel→effectiveIso {R = R} Rprop Req a b) _ = Rprop a b _ _ Iso.leftInv (isEquivRel→effectiveIso {R = R} Rprop Req a b) _ = squash/ _ _ _ _ -isEquivRel→isEffective : isPropValued R → isEquivRel R → isEffective R +isEquivRel→isEffective : isPropValued R → isEquivRel R → isEffective R isEquivRel→isEffective Rprop Req a b = isoToIsEquiv (invIso (isEquivRel→effectiveIso Rprop Req a b)) @@ -293,20 +293,20 @@ -- path-types for equivalence relations (not prop-valued) -- and their quotients -isEquivRel→TruncIso : isEquivRel R → (a b : A) → Iso ([ a ] ≡ [ b ]) ∥ R a b ∥₁ +isEquivRel→TruncIso : isEquivRel R → (a b : A) → Iso ([ a ] ≡ [ b ]) ∥ R a b ∥₁ isEquivRel→TruncIso {A = A} {R = R} Req a b = compIso (isProp→Iso (squash/ _ _) (squash/ _ _) (cong (Iso.fun truncRelIso)) (cong (Iso.inv truncRelIso))) (isEquivRel→effectiveIso (λ _ _ → PropTrunc.isPropPropTrunc) ∥R∥eq a b) where - open isEquivRel - ∥R∥eq : isEquivRel λ a b → ∥ R a b ∥₁ - reflexive ∥R∥eq a = ∣ reflexive Req a ∣₁ - symmetric ∥R∥eq a b = PropTrunc.map (symmetric Req a b) - transitive ∥R∥eq a b c = PropTrunc.map2 (transitive Req a b c) + open isEquivRel + ∥R∥eq : isEquivRel λ a b → ∥ R a b ∥₁ + reflexive ∥R∥eq a = ∣ reflexive Req a ∣₁ + symmetric ∥R∥eq a b = PropTrunc.map (symmetric Req a b) + transitive ∥R∥eq a b c = PropTrunc.map2 (transitive Req a b c) -discreteSetQuotients : isEquivRel R +discreteSetQuotients : isEquivRel R → (∀ a₀ a₁ → Dec (R a₀ a₁)) → Discrete (A / R) discreteSetQuotients {A = A} {R = R} Req Rdec = diff --git a/Cubical.HITs.SetTruncation.Fibers.html b/Cubical.HITs.SetTruncation.Fibers.html index 37b0147b7e..c79dd10b2e 100644 --- a/Cubical.HITs.SetTruncation.Fibers.html +++ b/Cubical.HITs.SetTruncation.Fibers.html @@ -39,7 +39,7 @@ private ∥f∥₂ : ∥ X ∥₂ → ∥ Y ∥₂ - ∥f∥₂ = Set.map f + ∥f∥₂ = Set.map f module _ (y : Y) where @@ -49,11 +49,11 @@ isSetFiber∥∥₂ = isOfHLevelΣ 2 squash₂ (λ _ → isProp→isSet (squash₂ _ _)) fiberRel : ∥ fiber f y ∥₂ → ∥ fiber f y ∥₂ → Type ℓ - fiberRel a b = Set.map fst a ≡ Set.map fst b + fiberRel a b = Set.map fst a ≡ Set.map fst b private proj : ∥ fiber f y ∥₂ / fiberRel → ∥ X ∥₂ - proj = SetQuot.rec squash₂ (Set.map fst) (λ _ _ p → p) + proj = SetQuot.rec squash₂ (Set.map fst) (λ _ _ p → p) ∥fiber∥₂/R→fiber∥∥₂ : ∥ fiber f y ∥₂ / fiberRel → fiber ∥f∥₂ ∣ y ∣₂ ∥fiber∥₂/R→fiber∥∥₂ = SetQuot.rec isSetFiber∥∥₂ ∥fiber∥₂→fiber∥∥₂ feq @@ -76,7 +76,7 @@ fiber∥∥₂→∥fiber∥₂/R = uncurry (Set.elim (λ _ → isSetΠ λ _ → squash/) λ x p → - mereFiber→∥fiber∥₂/R x (PathIdTrunc₀Iso .fun p)) + mereFiber→∥fiber∥₂/R x (PathIdTrunc₀Iso .fun p)) ∥fiber∥₂/R→fiber∥∥₂→fst : (q : ∥ fiber f y ∥₂ / fiberRel) → ∥fiber∥₂/R→fiber∥∥₂ q .fst ≡ proj q ∥fiber∥₂/R→fiber∥∥₂→fst = @@ -90,7 +90,7 @@ Prop.elim {P = λ t → proj (mereFiber→∥fiber∥₂/R x t) ≡ ∣ x ∣₂} (λ _ → squash₂ _ _) (λ _ → refl) - (PathIdTrunc₀Iso .fun p)) + (PathIdTrunc₀Iso .fun p)) ∥fiber∥₂/R→fiber∥∥₂→∥fiber∥₂/R : (x : ∥ fiber f y ∥₂ / fiberRel) → fiber∥∥₂→∥fiber∥₂/R (∥fiber∥₂/R→fiber∥∥₂ x) ≡ x @@ -102,7 +102,7 @@ fiber∥∥₂→∥fiber∥₂/R→fiber∥∥₂ : (x : fiber ∥f∥₂ ∣ y ∣₂) → ∥fiber∥₂/R→fiber∥∥₂ (fiber∥∥₂→∥fiber∥₂/R x) ≡ x fiber∥∥₂→∥fiber∥₂/R→fiber∥∥₂ x = - Σ≡Prop + Σ≡Prop (λ _ → squash₂ _ _) (∥fiber∥₂/R→fiber∥∥₂→fst (fiber∥∥₂→∥fiber∥₂/R x) ∙ fiber∥∥₂→∥fiber∥₂/R→proj x) @@ -119,13 +119,13 @@ -- the relation is an equivalence relation - open BinaryRelation - open isEquivRel + open BinaryRelation + open isEquivRel - isEquivRelFiberRel : isEquivRel fiberRel - isEquivRelFiberRel .reflexive _ = refl - isEquivRelFiberRel .symmetric _ _ = sym - isEquivRelFiberRel .transitive _ _ _ = _∙_ + isEquivRelFiberRel : isEquivRel fiberRel + isEquivRelFiberRel .reflexive _ = refl + isEquivRelFiberRel .symmetric _ _ = sym + isEquivRelFiberRel .transitive _ _ _ = _∙_ -- alternative characterization of the relation in terms of equality in Y and fiber f y @@ -141,7 +141,7 @@ Prop.rec (squash₂ _ _) (uncurry (Set.elim (λ _ → isSetΠ λ _ → isOfHLevelPath 2 squash₂ _ _) λ _ → - cong (Set.map fst))) + cong (Set.map fst))) fiberRel1→2 : ∀ x x' → fiberRel x x' → fiberRel2 x x' fiberRel1→2 = @@ -152,7 +152,7 @@ filler = doubleCompPath-filler (sym (a .snd)) (cong f q) (b .snd) in ∣ ∣ filler i1 ∣₂ , cong ∣_∣₂ (ΣPathP (q , adjustLemma (flipSquare filler))) ∣₁) - (PathIdTrunc₀Iso .Iso.fun p) + (PathIdTrunc₀Iso .Iso.fun p) where adjustLemma : {x y z w : Y} {p : x ≡ y} {q : x ≡ z} {r : z ≡ w} {s : y ≡ w} → PathP (λ i → p i ≡ r i) q s diff --git a/Cubical.HITs.SetTruncation.Properties.html b/Cubical.HITs.SetTruncation.Properties.html index cf2931e379..bea9d9115c 100644 --- a/Cubical.HITs.SetTruncation.Properties.html +++ b/Cubical.HITs.SetTruncation.Properties.html @@ -80,251 +80,258 @@ elim3 Bset g = elim2 (λ _ _ → isSetΠ (λ _ → Bset _ _ _)) (λ a b → elim (λ _ → Bset _ _ _) (g a b)) - --- the recursor for maps into groupoids following the "HIT proof" in: --- https://arxiv.org/abs/1507.01150 --- i.e. for any type A and groupoid B we can construct a map ∥ A ∥₂ → B --- from a map A → B satisfying the condition --- ∀ (a b : A) (p q : a ≡ b) → cong f p ≡ cong f q --- TODO: prove that this is an equivalence -module rec→Gpd {A : Type ℓ} {B : Type ℓ'} (Bgpd : isGroupoid B) (f : A → B) - (congFConst : ∀ (a b : A) (p q : a ≡ b) → cong f p ≡ cong f q) where - - data H : Type ℓ where - η : A → H - ε : ∀ (a b : A) → ∥ a ≡ b ∥₁ → η a ≡ η b -- prop. trunc. of a≡b - δ : ∀ (a b : A) (p : a ≡ b) → ε a b ∣ p ∣₁ ≡ cong η p - gtrunc : isGroupoid H - - -- write elimination principle for H - module Helim {P : H → Type ℓ''} (Pgpd : ∀ h → isGroupoid (P h)) - (η* : (a : A) → P (η a)) - (ε* : ∀ (a b : A) (∣p∣₁ : ∥ a ≡ b ∥₁) - → PathP (λ i → P (ε a b ∣p∣₁ i)) (η* a) (η* b)) - (δ* : ∀ (a b : A) (p : a ≡ b) - → PathP (λ i → PathP (λ j → P (δ a b p i j)) (η* a) (η* b)) - (ε* a b ∣ p ∣₁) (cong η* p)) where - - fun : (h : H) → P h - fun (η a) = η* a - fun (ε a b ∣p∣₁ i) = ε* a b ∣p∣₁ i - fun (δ a b p i j) = δ* a b p i j - fun (gtrunc x y p q α β i j k) = isOfHLevel→isOfHLevelDep 3 Pgpd - (fun x) (fun y) - (cong fun p) (cong fun q) - (cong (cong fun) α) (cong (cong fun) β) - (gtrunc x y p q α β) i j k - - module Hrec {C : Type ℓ''} (Cgpd : isGroupoid C) - (η* : A → C) - (ε* : ∀ (a b : A) → ∥ a ≡ b ∥₁ → η* a ≡ η* b) - (δ* : ∀ (a b : A) (p : a ≡ b) → ε* a b ∣ p ∣₁ ≡ cong η* p) where - - fun : H → C - fun (η a) = η* a - fun (ε a b ∣p∣₁ i) = ε* a b ∣p∣₁ i - fun (δ a b p i j) = δ* a b p i j - fun (gtrunc x y p q α β i j k) = Cgpd (fun x) (fun y) (cong fun p) (cong fun q) - (cong (cong fun) α) (cong (cong fun) β) i j k - - module HelimProp {P : H → Type ℓ''} (Pprop : ∀ h → isProp (P h)) - (η* : (a : A) → P (η a)) where - - fun : ∀ h → P h - fun = Helim.fun (λ _ → isSet→isGroupoid (isProp→isSet (Pprop _))) η* - (λ a b ∣p∣₁ → isOfHLevel→isOfHLevelDep 1 Pprop _ _ (ε a b ∣p∣₁)) - λ a b p → isOfHLevel→isOfHLevelDep 1 - {B = λ p → PathP (λ i → P (p i)) (η* a) (η* b)} - (λ _ → isOfHLevelPathP 1 (Pprop _) _ _) _ _ (δ a b p) - - -- The main trick: eliminating into hsets is easy - -- i.e. H has the universal property of set truncation... - module HelimSet {P : H → Type ℓ''} (Pset : ∀ h → isSet (P h)) - (η* : ∀ a → P (η a)) where - - fun : (h : H) → P h - fun = Helim.fun (λ _ → isSet→isGroupoid (Pset _)) η* ε* - λ a b p → isOfHLevel→isOfHLevelDep 1 - {B = λ p → PathP (λ i → P (p i)) (η* a) (η* b)} - (λ _ → isOfHLevelPathP' 1 (Pset _) _ _) _ _ (δ a b p) - where - ε* : (a b : A) (∣p∣₁ : ∥ a ≡ b ∥₁) → PathP (λ i → P (ε a b ∣p∣₁ i)) (η* a) (η* b) - ε* a b = pElim (λ _ → isOfHLevelPathP' 1 (Pset _) (η* a) (η* b)) - λ p → subst (λ x → PathP (λ i → P (x i)) (η* a) (η* b)) - (sym (δ a b p)) (cong η* p) - - - -- Now we need to prove that H is a set. - -- We start with a little lemma: - localHedbergLemma : {X : Type ℓ''} (P : X → Type ℓ'') - → (∀ x → isProp (P x)) - → ((x : X) → P x → (y : X) → P y → x ≡ y) - -------------------------------------------------- - → (x : X) → P x → (y : X) → isProp (x ≡ y) - localHedbergLemma {X = X} P Pprop P→≡ x px y = isPropRetract - (λ p → subst P p px) (λ py → sym (P→≡ x px x px) ∙ P→≡ x px y py) - isRetract (Pprop y) - where - isRetract : (p : x ≡ y) → (sym (P→≡ x px x px)) ∙ P→≡ x px y (subst P p px) ≡ p - isRetract = J (λ y' p' → (sym (P→≡ x px x px)) ∙ P→≡ x px y' (subst P p' px) ≡ p') - (subst (λ px' → sym (P→≡ x px x px) ∙ P→≡ x px x px' ≡ refl) - (sym (substRefl {B = P} px)) (lCancel (P→≡ x px x px))) - - Hset : isSet H - Hset = HelimProp.fun (λ _ → isPropΠ λ _ → isPropIsProp) baseCaseLeft - where - baseCaseLeft : (a₀ : A) (y : H) → isProp (η a₀ ≡ y) - baseCaseLeft a₀ = localHedbergLemma (λ x → Q x .fst) (λ x → Q x .snd) Q→≡ _ ∣ refl ∣₁ - where - Q : H → hProp ℓ - Q = HelimSet.fun (λ _ → isSetHProp) λ b → ∥ a₀ ≡ b ∥₁ , isPropPropTrunc - -- Q (η b) = ∥ a ≡ b ∥₁ - - Q→≡ : (x : H) → Q x .fst → (y : H) → Q y .fst → x ≡ y - Q→≡ = HelimSet.fun (λ _ → isSetΠ3 λ _ _ _ → gtrunc _ _) - λ a p → HelimSet.fun (λ _ → isSetΠ λ _ → gtrunc _ _) - λ b q → sym (ε a₀ a p) ∙ ε a₀ b q - - -- our desired function will split through H, - -- i.e. we get a function ∥ A ∥₂ → H → B - fun : ∥ A ∥₂ → B - fun = f₁ ∘ f₂ - where - f₁ : H → B - f₁ = Hrec.fun Bgpd f εᶠ λ _ _ _ → refl - where - εᶠ : (a b : A) → ∥ a ≡ b ∥₁ → f a ≡ f b - εᶠ a b = rec→Set (Bgpd _ _) (cong f) λ p q → congFConst a b p q - -- this is the inductive step, - -- we use that maps ∥ A ∥₁ → B for an hset B - -- correspond to 2-Constant maps A → B (which cong f is by assumption) - f₂ : ∥ A ∥₂ → H - f₂ = rec Hset η - - -map : (A → B) → ∥ A ∥₂ → ∥ B ∥₂ -map f = rec squash₂ λ x → ∣ f x ∣₂ - -map∙ : {ℓ ℓ' : Level} {A : Pointed ℓ} {B : Pointed ℓ'} - (f : A →∙ B) → ∥ A ∥₂∙ →∙ ∥ B ∥₂∙ -fst (map∙ f) = map (fst f) -snd (map∙ f) = cong ∣_∣₂ (snd f) - -setTruncUniversal : isSet B → (∥ A ∥₂ → B) ≃ (A → B) -setTruncUniversal {B = B} Bset = - isoToEquiv (iso (λ h x → h ∣ x ∣₂) (rec Bset) (λ _ → refl) rinv) - where - rinv : (f : ∥ A ∥₂ → B) → rec Bset (λ x → f ∣ x ∣₂) ≡ f - rinv f i x = - elim (λ x → isProp→isSet (Bset (rec Bset (λ x → f ∣ x ∣₂) x) (f x))) - (λ _ → refl) x i - -isSetSetTrunc : isSet ∥ A ∥₂ -isSetSetTrunc a b p q = squash₂ a b p q - -setTruncIdempotentIso : isSet A → Iso ∥ A ∥₂ A -Iso.fun (setTruncIdempotentIso hA) = rec hA (idfun _) -Iso.inv (setTruncIdempotentIso hA) x = ∣ x ∣₂ -Iso.rightInv (setTruncIdempotentIso hA) _ = refl -Iso.leftInv (setTruncIdempotentIso hA) = elim (λ _ → isSet→isGroupoid isSetSetTrunc _ _) (λ _ → refl) - -setTruncIdempotent≃ : isSet A → ∥ A ∥₂ ≃ A -setTruncIdempotent≃ {A = A} hA = isoToEquiv (setTruncIdempotentIso hA) - -setTruncIdempotent : isSet A → ∥ A ∥₂ ≡ A -setTruncIdempotent hA = ua (setTruncIdempotent≃ hA) - -isContr→isContrSetTrunc : isContr A → isContr (∥ A ∥₂) -isContr→isContrSetTrunc contr = ∣ fst contr ∣₂ - , elim (λ _ → isOfHLevelPath 2 (isSetSetTrunc) _ _) - λ a → cong ∣_∣₂ (snd contr a) - - -setTruncIso : Iso A B → Iso ∥ A ∥₂ ∥ B ∥₂ -Iso.fun (setTruncIso is) = rec isSetSetTrunc (λ x → ∣ Iso.fun is x ∣₂) -Iso.inv (setTruncIso is) = rec isSetSetTrunc (λ x → ∣ Iso.inv is x ∣₂) -Iso.rightInv (setTruncIso is) = - elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ a → cong ∣_∣₂ (Iso.rightInv is a) -Iso.leftInv (setTruncIso is) = - elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ a → cong ∣_∣₂ (Iso.leftInv is a) - -setSigmaIso : {B : A → Type ℓ} → Iso ∥ Σ A B ∥₂ ∥ Σ A (λ x → ∥ B x ∥₂) ∥₂ -setSigmaIso {A = A} {B = B} = iso fun funinv sect retr - where - {- writing it out explicitly to avoid yellow highlighting -} - fun : ∥ Σ A B ∥₂ → ∥ Σ A (λ x → ∥ B x ∥₂) ∥₂ - fun = rec isSetSetTrunc λ {(a , p) → ∣ a , ∣ p ∣₂ ∣₂} - funinv : ∥ Σ A (λ x → ∥ B x ∥₂) ∥₂ → ∥ Σ A B ∥₂ - funinv = rec isSetSetTrunc (λ {(a , p) → rec isSetSetTrunc (λ p → ∣ a , p ∣₂) p}) - sect : section fun funinv - sect = elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ { (a , p) → elim {B = λ p → fun (funinv ∣ a , p ∣₂) ≡ ∣ a , p ∣₂} - (λ p → isOfHLevelPath 2 isSetSetTrunc _ _) (λ _ → refl) p } - retr : retract fun funinv - retr = elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ { _ → refl } - -sigmaElim : {B : ∥ A ∥₂ → Type ℓ} {C : Σ ∥ A ∥₂ B → Type ℓ'} - (Bset : (x : Σ ∥ A ∥₂ B) → isSet (C x)) - (g : (a : A) (b : B ∣ a ∣₂) → C (∣ a ∣₂ , b)) - (x : Σ ∥ A ∥₂ B) → C x -sigmaElim {B = B} {C = C} set g (x , y) = - elim {B = λ x → (y : B x) → C (x , y)} (λ _ → isSetΠ λ _ → set _) g x y - -sigmaProdElim : {C : ∥ A ∥₂ × ∥ B ∥₂ → Type ℓ} {D : Σ (∥ A ∥₂ × ∥ B ∥₂) C → Type ℓ'} - (Bset : (x : Σ (∥ A ∥₂ × ∥ B ∥₂) C) → isSet (D x)) - (g : (a : A) (b : B) (c : C (∣ a ∣₂ , ∣ b ∣₂)) → D ((∣ a ∣₂ , ∣ b ∣₂) , c)) - (x : Σ (∥ A ∥₂ × ∥ B ∥₂) C) → D x -sigmaProdElim {B = B} {C = C} {D = D} set g ((x , y) , c) = - elim {B = λ x → (y : ∥ B ∥₂) (c : C (x , y)) → D ((x , y) , c)} - (λ _ → isSetΠ λ _ → isSetΠ λ _ → set _) - (λ x → elim (λ _ → isSetΠ λ _ → set _) (g x)) - x y c - -prodElim : {C : ∥ A ∥₂ × ∥ B ∥₂ → Type ℓ} - → ((x : ∥ A ∥₂ × ∥ B ∥₂) → isSet (C x)) - → ((a : A) (b : B) → C (∣ a ∣₂ , ∣ b ∣₂)) - → (x : ∥ A ∥₂ × ∥ B ∥₂) → C x -prodElim setC f (a , b) = elim2 (λ x y → setC (x , y)) f a b - -prodRec : {C : Type ℓ} → isSet C → (A → B → C) → ∥ A ∥₂ × ∥ B ∥₂ → C -prodRec setC f (a , b) = rec2 setC f a b - -prodElim2 : {E : (∥ A ∥₂ × ∥ B ∥₂) → (∥ C ∥₂ × ∥ D ∥₂) → Type ℓ} - → ((x : ∥ A ∥₂ × ∥ B ∥₂) (y : ∥ C ∥₂ × ∥ D ∥₂) → isSet (E x y)) - → ((a : A) (b : B) (c : C) (d : D) → E (∣ a ∣₂ , ∣ b ∣₂) (∣ c ∣₂ , ∣ d ∣₂)) - → ((x : ∥ A ∥₂ × ∥ B ∥₂) (y : ∥ C ∥₂ × ∥ D ∥₂) → (E x y)) -prodElim2 isset f = prodElim (λ _ → isSetΠ λ _ → isset _ _) - λ a b → prodElim (λ _ → isset _ _) - λ c d → f a b c d - -setTruncOfProdIso : Iso ∥ A × B ∥₂ (∥ A ∥₂ × ∥ B ∥₂) -Iso.fun setTruncOfProdIso = rec (isSet× isSetSetTrunc isSetSetTrunc) λ { (a , b) → ∣ a ∣₂ , ∣ b ∣₂ } -Iso.inv setTruncOfProdIso = prodRec isSetSetTrunc λ a b → ∣ a , b ∣₂ -Iso.rightInv setTruncOfProdIso = - prodElim (λ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) λ _ _ → refl -Iso.leftInv setTruncOfProdIso = - elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ {(a , b) → refl} - -IsoSetTruncateSndΣ : {A : Type ℓ} {B : A → Type ℓ'} → Iso ∥ Σ A B ∥₂ ∥ Σ A (λ x → ∥ B x ∥₂) ∥₂ -Iso.fun IsoSetTruncateSndΣ = map λ a → (fst a) , ∣ snd a ∣₂ -Iso.inv IsoSetTruncateSndΣ = rec isSetSetTrunc (uncurry λ x → map λ b → x , b) -Iso.rightInv IsoSetTruncateSndΣ = - elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - (uncurry λ a → elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ _ → refl) -Iso.leftInv IsoSetTruncateSndΣ = - elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ _ → refl - -PathIdTrunc₀Iso : {a b : A} → Iso (∣ a ∣₂ ≡ ∣ b ∣₂) ∥ a ≡ b ∥₁ -Iso.fun (PathIdTrunc₀Iso {b = b}) p = - transport (λ i → rec {B = TypeOfHLevel _ 1} (isOfHLevelTypeOfHLevel 1) - (λ a → ∥ a ≡ b ∥₁ , squash₁) (p (~ i)) .fst) - ∣ refl ∣₁ -Iso.inv PathIdTrunc₀Iso = pRec (squash₂ _ _) (cong ∣_∣₂) -Iso.rightInv PathIdTrunc₀Iso _ = squash₁ _ _ -Iso.leftInv PathIdTrunc₀Iso _ = squash₂ _ _ _ _ +elim4 : {B : (w x y z : ∥ A ∥₂) → Type ℓ} + (Bset : ((w x y z : ∥ A ∥₂) → isSet (B w x y z))) + (g : (a b c d : A) → B ∣ a ∣₂ ∣ b ∣₂ ∣ c ∣₂ ∣ d ∣₂) + (w x y z : ∥ A ∥₂) → B w x y z +elim4 Bset g = elim3 (λ _ _ _ → isSetΠ λ _ → Bset _ _ _ _) + λ a b c → elim (λ _ → Bset _ _ _ _) (g a b c) + + +-- the recursor for maps into groupoids following the "HIT proof" in: +-- https://arxiv.org/abs/1507.01150 +-- i.e. for any type A and groupoid B we can construct a map ∥ A ∥₂ → B +-- from a map A → B satisfying the condition +-- ∀ (a b : A) (p q : a ≡ b) → cong f p ≡ cong f q +-- TODO: prove that this is an equivalence +module rec→Gpd {A : Type ℓ} {B : Type ℓ'} (Bgpd : isGroupoid B) (f : A → B) + (congFConst : ∀ (a b : A) (p q : a ≡ b) → cong f p ≡ cong f q) where + + data H : Type ℓ where + η : A → H + ε : ∀ (a b : A) → ∥ a ≡ b ∥₁ → η a ≡ η b -- prop. trunc. of a≡b + δ : ∀ (a b : A) (p : a ≡ b) → ε a b ∣ p ∣₁ ≡ cong η p + gtrunc : isGroupoid H + + -- write elimination principle for H + module Helim {P : H → Type ℓ''} (Pgpd : ∀ h → isGroupoid (P h)) + (η* : (a : A) → P (η a)) + (ε* : ∀ (a b : A) (∣p∣₁ : ∥ a ≡ b ∥₁) + → PathP (λ i → P (ε a b ∣p∣₁ i)) (η* a) (η* b)) + (δ* : ∀ (a b : A) (p : a ≡ b) + → PathP (λ i → PathP (λ j → P (δ a b p i j)) (η* a) (η* b)) + (ε* a b ∣ p ∣₁) (cong η* p)) where + + fun : (h : H) → P h + fun (η a) = η* a + fun (ε a b ∣p∣₁ i) = ε* a b ∣p∣₁ i + fun (δ a b p i j) = δ* a b p i j + fun (gtrunc x y p q α β i j k) = isOfHLevel→isOfHLevelDep 3 Pgpd + (fun x) (fun y) + (cong fun p) (cong fun q) + (cong (cong fun) α) (cong (cong fun) β) + (gtrunc x y p q α β) i j k + + module Hrec {C : Type ℓ''} (Cgpd : isGroupoid C) + (η* : A → C) + (ε* : ∀ (a b : A) → ∥ a ≡ b ∥₁ → η* a ≡ η* b) + (δ* : ∀ (a b : A) (p : a ≡ b) → ε* a b ∣ p ∣₁ ≡ cong η* p) where + + fun : H → C + fun (η a) = η* a + fun (ε a b ∣p∣₁ i) = ε* a b ∣p∣₁ i + fun (δ a b p i j) = δ* a b p i j + fun (gtrunc x y p q α β i j k) = Cgpd (fun x) (fun y) (cong fun p) (cong fun q) + (cong (cong fun) α) (cong (cong fun) β) i j k + + module HelimProp {P : H → Type ℓ''} (Pprop : ∀ h → isProp (P h)) + (η* : (a : A) → P (η a)) where + + fun : ∀ h → P h + fun = Helim.fun (λ _ → isSet→isGroupoid (isProp→isSet (Pprop _))) η* + (λ a b ∣p∣₁ → isOfHLevel→isOfHLevelDep 1 Pprop _ _ (ε a b ∣p∣₁)) + λ a b p → isOfHLevel→isOfHLevelDep 1 + {B = λ p → PathP (λ i → P (p i)) (η* a) (η* b)} + (λ _ → isOfHLevelPathP 1 (Pprop _) _ _) _ _ (δ a b p) + + -- The main trick: eliminating into hsets is easy + -- i.e. H has the universal property of set truncation... + module HelimSet {P : H → Type ℓ''} (Pset : ∀ h → isSet (P h)) + (η* : ∀ a → P (η a)) where + + fun : (h : H) → P h + fun = Helim.fun (λ _ → isSet→isGroupoid (Pset _)) η* ε* + λ a b p → isOfHLevel→isOfHLevelDep 1 + {B = λ p → PathP (λ i → P (p i)) (η* a) (η* b)} + (λ _ → isOfHLevelPathP' 1 (Pset _) _ _) _ _ (δ a b p) + where + ε* : (a b : A) (∣p∣₁ : ∥ a ≡ b ∥₁) → PathP (λ i → P (ε a b ∣p∣₁ i)) (η* a) (η* b) + ε* a b = pElim (λ _ → isOfHLevelPathP' 1 (Pset _) (η* a) (η* b)) + λ p → subst (λ x → PathP (λ i → P (x i)) (η* a) (η* b)) + (sym (δ a b p)) (cong η* p) + + + -- Now we need to prove that H is a set. + -- We start with a little lemma: + localHedbergLemma : {X : Type ℓ''} (P : X → Type ℓ'') + → (∀ x → isProp (P x)) + → ((x : X) → P x → (y : X) → P y → x ≡ y) + -------------------------------------------------- + → (x : X) → P x → (y : X) → isProp (x ≡ y) + localHedbergLemma {X = X} P Pprop P→≡ x px y = isPropRetract + (λ p → subst P p px) (λ py → sym (P→≡ x px x px) ∙ P→≡ x px y py) + isRetract (Pprop y) + where + isRetract : (p : x ≡ y) → (sym (P→≡ x px x px)) ∙ P→≡ x px y (subst P p px) ≡ p + isRetract = J (λ y' p' → (sym (P→≡ x px x px)) ∙ P→≡ x px y' (subst P p' px) ≡ p') + (subst (λ px' → sym (P→≡ x px x px) ∙ P→≡ x px x px' ≡ refl) + (sym (substRefl {B = P} px)) (lCancel (P→≡ x px x px))) + + Hset : isSet H + Hset = HelimProp.fun (λ _ → isPropΠ λ _ → isPropIsProp) baseCaseLeft + where + baseCaseLeft : (a₀ : A) (y : H) → isProp (η a₀ ≡ y) + baseCaseLeft a₀ = localHedbergLemma (λ x → Q x .fst) (λ x → Q x .snd) Q→≡ _ ∣ refl ∣₁ + where + Q : H → hProp ℓ + Q = HelimSet.fun (λ _ → isSetHProp) λ b → ∥ a₀ ≡ b ∥₁ , isPropPropTrunc + -- Q (η b) = ∥ a ≡ b ∥₁ + + Q→≡ : (x : H) → Q x .fst → (y : H) → Q y .fst → x ≡ y + Q→≡ = HelimSet.fun (λ _ → isSetΠ3 λ _ _ _ → gtrunc _ _) + λ a p → HelimSet.fun (λ _ → isSetΠ λ _ → gtrunc _ _) + λ b q → sym (ε a₀ a p) ∙ ε a₀ b q + + -- our desired function will split through H, + -- i.e. we get a function ∥ A ∥₂ → H → B + fun : ∥ A ∥₂ → B + fun = f₁ ∘ f₂ + where + f₁ : H → B + f₁ = Hrec.fun Bgpd f εᶠ λ _ _ _ → refl + where + εᶠ : (a b : A) → ∥ a ≡ b ∥₁ → f a ≡ f b + εᶠ a b = rec→Set (Bgpd _ _) (cong f) λ p q → congFConst a b p q + -- this is the inductive step, + -- we use that maps ∥ A ∥₁ → B for an hset B + -- correspond to 2-Constant maps A → B (which cong f is by assumption) + f₂ : ∥ A ∥₂ → H + f₂ = rec Hset η + + +map : (A → B) → ∥ A ∥₂ → ∥ B ∥₂ +map f = rec squash₂ λ x → ∣ f x ∣₂ + +map∙ : {ℓ ℓ' : Level} {A : Pointed ℓ} {B : Pointed ℓ'} + (f : A →∙ B) → ∥ A ∥₂∙ →∙ ∥ B ∥₂∙ +fst (map∙ f) = map (fst f) +snd (map∙ f) = cong ∣_∣₂ (snd f) + +setTruncUniversal : isSet B → (∥ A ∥₂ → B) ≃ (A → B) +setTruncUniversal {B = B} Bset = + isoToEquiv (iso (λ h x → h ∣ x ∣₂) (rec Bset) (λ _ → refl) rinv) + where + rinv : (f : ∥ A ∥₂ → B) → rec Bset (λ x → f ∣ x ∣₂) ≡ f + rinv f i x = + elim (λ x → isProp→isSet (Bset (rec Bset (λ x → f ∣ x ∣₂) x) (f x))) + (λ _ → refl) x i + +isSetSetTrunc : isSet ∥ A ∥₂ +isSetSetTrunc a b p q = squash₂ a b p q + +setTruncIdempotentIso : isSet A → Iso ∥ A ∥₂ A +Iso.fun (setTruncIdempotentIso hA) = rec hA (idfun _) +Iso.inv (setTruncIdempotentIso hA) x = ∣ x ∣₂ +Iso.rightInv (setTruncIdempotentIso hA) _ = refl +Iso.leftInv (setTruncIdempotentIso hA) = elim (λ _ → isSet→isGroupoid isSetSetTrunc _ _) (λ _ → refl) + +setTruncIdempotent≃ : isSet A → ∥ A ∥₂ ≃ A +setTruncIdempotent≃ {A = A} hA = isoToEquiv (setTruncIdempotentIso hA) + +setTruncIdempotent : isSet A → ∥ A ∥₂ ≡ A +setTruncIdempotent hA = ua (setTruncIdempotent≃ hA) + +isContr→isContrSetTrunc : isContr A → isContr (∥ A ∥₂) +isContr→isContrSetTrunc contr = ∣ fst contr ∣₂ + , elim (λ _ → isOfHLevelPath 2 (isSetSetTrunc) _ _) + λ a → cong ∣_∣₂ (snd contr a) + + +setTruncIso : Iso A B → Iso ∥ A ∥₂ ∥ B ∥₂ +Iso.fun (setTruncIso is) = rec isSetSetTrunc (λ x → ∣ Iso.fun is x ∣₂) +Iso.inv (setTruncIso is) = rec isSetSetTrunc (λ x → ∣ Iso.inv is x ∣₂) +Iso.rightInv (setTruncIso is) = + elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ a → cong ∣_∣₂ (Iso.rightInv is a) +Iso.leftInv (setTruncIso is) = + elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ a → cong ∣_∣₂ (Iso.leftInv is a) + +setSigmaIso : {B : A → Type ℓ} → Iso ∥ Σ A B ∥₂ ∥ Σ A (λ x → ∥ B x ∥₂) ∥₂ +setSigmaIso {A = A} {B = B} = iso fun funinv sect retr + where + {- writing it out explicitly to avoid yellow highlighting -} + fun : ∥ Σ A B ∥₂ → ∥ Σ A (λ x → ∥ B x ∥₂) ∥₂ + fun = rec isSetSetTrunc λ {(a , p) → ∣ a , ∣ p ∣₂ ∣₂} + funinv : ∥ Σ A (λ x → ∥ B x ∥₂) ∥₂ → ∥ Σ A B ∥₂ + funinv = rec isSetSetTrunc (λ {(a , p) → rec isSetSetTrunc (λ p → ∣ a , p ∣₂) p}) + sect : section fun funinv + sect = elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ { (a , p) → elim {B = λ p → fun (funinv ∣ a , p ∣₂) ≡ ∣ a , p ∣₂} + (λ p → isOfHLevelPath 2 isSetSetTrunc _ _) (λ _ → refl) p } + retr : retract fun funinv + retr = elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ { _ → refl } + +sigmaElim : {B : ∥ A ∥₂ → Type ℓ} {C : Σ ∥ A ∥₂ B → Type ℓ'} + (Bset : (x : Σ ∥ A ∥₂ B) → isSet (C x)) + (g : (a : A) (b : B ∣ a ∣₂) → C (∣ a ∣₂ , b)) + (x : Σ ∥ A ∥₂ B) → C x +sigmaElim {B = B} {C = C} set g (x , y) = + elim {B = λ x → (y : B x) → C (x , y)} (λ _ → isSetΠ λ _ → set _) g x y + +sigmaProdElim : {C : ∥ A ∥₂ × ∥ B ∥₂ → Type ℓ} {D : Σ (∥ A ∥₂ × ∥ B ∥₂) C → Type ℓ'} + (Bset : (x : Σ (∥ A ∥₂ × ∥ B ∥₂) C) → isSet (D x)) + (g : (a : A) (b : B) (c : C (∣ a ∣₂ , ∣ b ∣₂)) → D ((∣ a ∣₂ , ∣ b ∣₂) , c)) + (x : Σ (∥ A ∥₂ × ∥ B ∥₂) C) → D x +sigmaProdElim {B = B} {C = C} {D = D} set g ((x , y) , c) = + elim {B = λ x → (y : ∥ B ∥₂) (c : C (x , y)) → D ((x , y) , c)} + (λ _ → isSetΠ λ _ → isSetΠ λ _ → set _) + (λ x → elim (λ _ → isSetΠ λ _ → set _) (g x)) + x y c + +prodElim : {C : ∥ A ∥₂ × ∥ B ∥₂ → Type ℓ} + → ((x : ∥ A ∥₂ × ∥ B ∥₂) → isSet (C x)) + → ((a : A) (b : B) → C (∣ a ∣₂ , ∣ b ∣₂)) + → (x : ∥ A ∥₂ × ∥ B ∥₂) → C x +prodElim setC f (a , b) = elim2 (λ x y → setC (x , y)) f a b + +prodRec : {C : Type ℓ} → isSet C → (A → B → C) → ∥ A ∥₂ × ∥ B ∥₂ → C +prodRec setC f (a , b) = rec2 setC f a b + +prodElim2 : {E : (∥ A ∥₂ × ∥ B ∥₂) → (∥ C ∥₂ × ∥ D ∥₂) → Type ℓ} + → ((x : ∥ A ∥₂ × ∥ B ∥₂) (y : ∥ C ∥₂ × ∥ D ∥₂) → isSet (E x y)) + → ((a : A) (b : B) (c : C) (d : D) → E (∣ a ∣₂ , ∣ b ∣₂) (∣ c ∣₂ , ∣ d ∣₂)) + → ((x : ∥ A ∥₂ × ∥ B ∥₂) (y : ∥ C ∥₂ × ∥ D ∥₂) → (E x y)) +prodElim2 isset f = prodElim (λ _ → isSetΠ λ _ → isset _ _) + λ a b → prodElim (λ _ → isset _ _) + λ c d → f a b c d + +setTruncOfProdIso : Iso ∥ A × B ∥₂ (∥ A ∥₂ × ∥ B ∥₂) +Iso.fun setTruncOfProdIso = rec (isSet× isSetSetTrunc isSetSetTrunc) λ { (a , b) → ∣ a ∣₂ , ∣ b ∣₂ } +Iso.inv setTruncOfProdIso = prodRec isSetSetTrunc λ a b → ∣ a , b ∣₂ +Iso.rightInv setTruncOfProdIso = + prodElim (λ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) λ _ _ → refl +Iso.leftInv setTruncOfProdIso = + elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ {(a , b) → refl} + +IsoSetTruncateSndΣ : {A : Type ℓ} {B : A → Type ℓ'} → Iso ∥ Σ A B ∥₂ ∥ Σ A (λ x → ∥ B x ∥₂) ∥₂ +Iso.fun IsoSetTruncateSndΣ = map λ a → (fst a) , ∣ snd a ∣₂ +Iso.inv IsoSetTruncateSndΣ = rec isSetSetTrunc (uncurry λ x → map λ b → x , b) +Iso.rightInv IsoSetTruncateSndΣ = + elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (uncurry λ a → elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ _ → refl) +Iso.leftInv IsoSetTruncateSndΣ = + elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ _ → refl + +PathIdTrunc₀Iso : {a b : A} → Iso (∣ a ∣₂ ≡ ∣ b ∣₂) ∥ a ≡ b ∥₁ +Iso.fun (PathIdTrunc₀Iso {b = b}) p = + transport (λ i → rec {B = TypeOfHLevel _ 1} (isOfHLevelTypeOfHLevel 1) + (λ a → ∥ a ≡ b ∥₁ , squash₁) (p (~ i)) .fst) + ∣ refl ∣₁ +Iso.inv PathIdTrunc₀Iso = pRec (squash₂ _ _) (cong ∣_∣₂) +Iso.rightInv PathIdTrunc₀Iso _ = squash₁ _ _ +Iso.leftInv PathIdTrunc₀Iso _ = squash₂ _ _ _ _ \ No newline at end of file diff --git a/Cubical.HITs.SmashProduct.Base.html b/Cubical.HITs.SmashProduct.Base.html index 99cce96dc5..0967438266 100644 --- a/Cubical.HITs.SmashProduct.Base.html +++ b/Cubical.HITs.SmashProduct.Base.html @@ -120,9 +120,9 @@ Σ[ l ∈ ((x : fst A) → f x (pt B) ≡ pt C) ] Σ[ r ∈ ((b : fst B) → f (pt A) b ≡ pt C) ] l (pt A) ≡ r (pt B))) - is₂ = compIso is₁ (Σ-cong-iso-snd - λ f → Σ-cong-iso-snd - λ l → Σ-cong-iso-snd + is₂ = compIso is₁ (Σ-cong-iso-snd + λ f → Σ-cong-iso-snd + λ l → Σ-cong-iso-snd λ r → pathToIso (PathP≡doubleCompPathʳ _ _ _ _ ∙ cong (l (snd A) ≡_) (sym (compPath≡compPath' (r (snd B)) refl) @@ -159,12 +159,12 @@ → Iso (Σ _ B) (B (a , refl)) isContrIso a B = compIso (invIso - (Σ-cong-iso-fst (isContr→Iso isContrUnit (isContrSingl a)))) + (Σ-cong-iso-fst (isContr→Iso isContrUnit (isContrSingl a)))) lUnit×Iso iso₄ : Iso (isoToPath is₃ i1) (isoToPath is₂ i1) - iso₄ = Σ-cong-iso-snd λ f → isContrIso (snd C) _ + iso₄ = Σ-cong-iso-snd λ f → isContrIso (snd C) _ ⋀→∙Homogeneous≡ : isHomogeneous C → {f g : (A ⋀∙ B) →∙ C} diff --git a/Cubical.Homotopy.BlakersMassey.html b/Cubical.Homotopy.BlakersMassey.html index 16b2b0d1d9..1c1a58d78b 100644 --- a/Cubical.Homotopy.BlakersMassey.html +++ b/Cubical.Homotopy.BlakersMassey.html @@ -708,19 +708,19 @@ → Iso (Σ[ c ∈ C ] Σ[ a ∈ A ] (f a ≡ b) × (g a ≡ c)) (Σ[ a ∈ A ] ((Σ[ c ∈ C ] (g a ≡ c)) × (f a ≡ b))) shuffleFibIso₁ f g b = - compIso (invIso Σ-assoc-Iso) - (compIso (Σ-cong-iso-fst Σ-swap-Iso) + compIso (invIso Σ-assoc-Iso) + (compIso (Σ-cong-iso-fst Σ-swap-Iso) (compIso - (Σ-cong-iso-snd (λ y → Σ-swap-Iso)) - (compIso Σ-assoc-Iso - (Σ-cong-iso-snd λ a → invIso Σ-assoc-Iso)))) + (Σ-cong-iso-snd (λ y → Σ-swap-Iso)) + (compIso Σ-assoc-Iso + (Σ-cong-iso-snd λ a → invIso Σ-assoc-Iso)))) shuffleFibIso₂ : {ℓ ℓ' ℓ'' : Level} {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} (f : A → B) (g : A → C) (x : _) → Iso (Σ[ a ∈ A ] ((Σ[ c ∈ C ] (g a ≡ c)) × (f a ≡ x))) (fiber f x) - shuffleFibIso₂ f g x = Σ-cong-iso-snd - λ a → compIso (Σ-cong-iso-fst + shuffleFibIso₂ f g x = Σ-cong-iso-snd + λ a → compIso (Σ-cong-iso-fst (isContr→Iso (isContrSingl (g a)) isContrUnit)) lUnit×Iso @@ -747,8 +747,8 @@ C-con c = isConnectedRetractFromIso (suc m) (compIso - (compIso (Σ-cong-iso-snd - (λ _ → Σ-cong-iso-snd λ _ → Σ-swap-Iso)) + (compIso (Σ-cong-iso-snd + (λ _ → Σ-cong-iso-snd λ _ → Σ-swap-Iso)) (shuffleFibIso₁ g f c)) (shuffleFibIso₂ g f c)) (con-g c) @@ -780,7 +780,7 @@ TotalPathGen×Iso : Iso (Σ (B × C) PushoutGenPath×) (Σ (B × C) PushoutPath×) TotalPathGen×Iso = - Σ-cong-iso-snd λ x + Σ-cong-iso-snd λ x → congIso (invIso (IsoPushoutPushoutGen f g)) Totalfib×Iso : Iso (Σ (B × C) fib×) A diff --git a/Cubical.Homotopy.Connected.html b/Cubical.Homotopy.Connected.html index 818ef51177..9f9804a202 100644 --- a/Cubical.Homotopy.Connected.html +++ b/Cubical.Homotopy.Connected.html @@ -728,13 +728,13 @@ X≃X' a' = (Σ[ x ∈ P (inl a') .fst ] ∀ (b : B) → PathP (λ i → P (push a' b i) .fst) x (k (inr b))) - ≃⟨ invEquiv (Σ-cong-equiv-fst (UnitToType≃ _)) ⟩ + ≃⟨ invEquiv (Σ-cong-equiv-fst (UnitToType≃ _)) ⟩ (Σ[ x' ∈ (Unit → P (inl a') .fst) ] ∀ (b : B) → PathP (λ i → P (push a' b i) .fst) (x' tt) (k (inr b))) - ≃⟨ Σ-cong-equiv-snd (λ x' → equivΠCod (λ b → pathToEquiv (PathP≡Path⁻ _ _ _))) ⟩ + ≃⟨ Σ-cong-equiv-snd (λ x' → equivΠCod (λ b → pathToEquiv (PathP≡Path⁻ _ _ _))) ⟩ (Σ[ x' ∈ (Unit → P (inl a') .fst) ] ∀ (b : B) → x' tt ≡ subst⁻ (λ y → P y .fst) (push a' b) (k (inr b))) - ≃⟨ Σ-cong-equiv-snd (λ x' → funExtEquiv) ⟩ + ≃⟨ Σ-cong-equiv-snd (λ x' → funExtEquiv) ⟩ (Σ[ x' ∈ (Unit → P (inl a') .fst) ] (λ (b : B) → x' tt) ≡ (λ (b : B) → subst⁻ (λ y → P y .fst) (push a' b) (k (inr b)))) diff --git a/Cubical.Homotopy.EilenbergMacLane.CupProduct.html b/Cubical.Homotopy.EilenbergMacLane.CupProduct.html index d9f6f9ee74..db1cce09da 100644 --- a/Cubical.Homotopy.EilenbergMacLane.CupProduct.html +++ b/Cubical.Homotopy.EilenbergMacLane.CupProduct.html @@ -134,7 +134,7 @@ where lem : compGroupHom (GroupEquiv→GroupHom ⨂assoc) TensorMult3Homₗ ≡ compGroupHom (inducedHom⨂ idGroupHom TensorMultHom) TensorMultHom - lem = Σ≡Prop (λ _ → isPropIsGroupHom _ _) + lem = Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt (⊗elimProp (λ _ → is-set (snd G') _ _) (λ a → ⊗elimProp (λ _ → is-set (snd G') _ _) (λ b c → sym (·Assoc (snd G'') a b c)) @@ -170,7 +170,7 @@ (TensorMultHom {G' = CommRing→Ring G''}) ≡ TensorMultHom isTrivComm = - Σ≡Prop (λ _ → isPropIsGroupHom _ _) + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt (⊗elimProp (λ _ → CommRingStr.is-set (snd G'') _ _) (λ a b → CommRingStr.·Comm (snd G'') b a) λ p q r s → cong₂ _+G_ r s)) diff --git a/Cubical.Homotopy.EilenbergMacLane.GradedCommTensor.html b/Cubical.Homotopy.EilenbergMacLane.GradedCommTensor.html index e0f59b6025..8d79af473e 100644 --- a/Cubical.Homotopy.EilenbergMacLane.GradedCommTensor.html +++ b/Cubical.Homotopy.EilenbergMacLane.GradedCommTensor.html @@ -461,7 +461,7 @@ h : Path (AbGroupHom (H' ⨂ G') (G' ⨂ H')) (GroupEquiv→GroupHom ⨂-comm) (GroupEquiv→GroupHom (invGroupEquiv ⨂-comm)) - h = Σ≡Prop (λ _ → isPropIsGroupHom _ _) refl + h = Σ≡Prop (λ _ → isPropIsGroupHom _ _) refl -- cong² comm⨂-EM commutes with wrap cong-cong-comm⨂-EM : (n : ℕ) (p : fst (Ω (EM∙ (H' ⨂ G') (suc (suc n))))) diff --git a/Cubical.Homotopy.EilenbergMacLane.Order2.html b/Cubical.Homotopy.EilenbergMacLane.Order2.html index f295406e92..bbdea3a95b 100644 --- a/Cubical.Homotopy.EilenbergMacLane.Order2.html +++ b/Cubical.Homotopy.EilenbergMacLane.Order2.html @@ -111,7 +111,7 @@ → PathP (λ i → Path (EM G 1) embase (emloop g i) → TypeOfHLevel ℓ 1) (λ p → (p ≡ sym p) , hLevelEM G 1 _ _ _ _) λ p → (p ≡ sym p) , hLevelEM G 1 _ _ _ _ - main g = toPathP (funExt (λ p → Σ≡Prop (λ _ → isPropIsProp) + main g = toPathP (funExt (λ p → Σ≡Prop (λ _ → isPropIsProp) (funExt⁻ (fromPathP (main' g)) p))) symCode (suc n) = TR.elim (λ _ → isOfHLevelΠ (4 +ℕ n) diff --git a/Cubical.Homotopy.EilenbergMacLane.Properties.html b/Cubical.Homotopy.EilenbergMacLane.Properties.html index c5ea0178ec..ffadb619d6 100644 --- a/Cubical.Homotopy.EilenbergMacLane.Properties.html +++ b/Cubical.Homotopy.EilenbergMacLane.Properties.html @@ -133,7 +133,7 @@ CodesSet = EMrec Ĝ (isOfHLevelTypeOfHLevel 2) (G , is-set) RE REComp where RE : (g : G) → Path (hSet ℓ) (G , is-set) (G , is-set) - RE g = Σ≡Prop (λ X → isPropIsOfHLevel {A = X} 2) (ua (rightEquiv g)) + RE g = Σ≡Prop (λ X → isPropIsOfHLevel {A = X} 2) (ua (rightEquiv g)) lemma₁ : (g h : G) → Square (ua (rightEquiv g)) (ua (rightEquiv (g · h))) @@ -197,9 +197,9 @@ → Path (TypeOfHLevel _ (3 + n)) (EM G (suc n) , hLevelEM G (suc n)) (EM G (suc n) , hLevelEM G (suc n)) - fib zero a = Σ≡Prop (λ _ → isPropIsOfHLevel 3) + fib zero a = Σ≡Prop (λ _ → isPropIsOfHLevel 3) (isoToPath (addIso 1 a)) - fib (suc n) a = Σ≡Prop (λ _ → isPropIsOfHLevel (4 + n)) + fib (suc n) a = Σ≡Prop (λ _ → isPropIsOfHLevel (4 + n)) (isoToPath (addIso (suc (suc n)) ∣ a ∣)) decode' : (n : ℕ) (x : EM G (suc (suc n))) → CODE n x .fst → 0ₖ (suc (suc n)) ≡ x @@ -448,7 +448,7 @@ isContr-↓∙ : {G : AbGroup ℓ} {H : AbGroup ℓ'} (n : ℕ) → isContr (EM∙ G (suc n) →∙ EM∙ H n) fst (isContr-↓∙ {G = G} {H = H} zero) = (λ _ → 0g (snd H)) , refl snd (isContr-↓∙{G = G} {H = H} zero) (f , p) = - Σ≡Prop (λ x → is-set (snd H) _ _) + Σ≡Prop (λ x → is-set (snd H) _ _) (funExt (raw-elim G 0 (λ _ → is-set (snd H) _ _) (sym p))) fst (isContr-↓∙ {G = G} {H = H} (suc n)) = (λ _ → 0ₖ (suc n)) , refl fst (snd (isContr-↓∙ {G = G} {H = H} (suc n)) f i) x = diff --git a/Cubical.Homotopy.Group.Base.html b/Cubical.Homotopy.Group.Base.html index 630fd72127..aa9782bd3d 100644 --- a/Cubical.Homotopy.Group.Base.html +++ b/Cubical.Homotopy.Group.Base.html @@ -21,7 +21,7 @@ open import Cubical.HITs.SetTruncation renaming (rec to sRec ; rec2 to sRec2 ; elim to sElim ; elim2 to sElim2 ; elim3 to sElim3 - ; map to sMap) + ; map to sMap) open import Cubical.HITs.Truncation renaming (rec to trRec ; elim to trElim ; elim2 to trElim2) open import Cubical.HITs.Sn @@ -642,7 +642,7 @@ -- and finally, the Iso π'Gr≅πGr : ∀ {ℓ} (n : ℕ) (A : Pointed ℓ) → GroupIso (π'Gr n A) (πGr n A) -fst (π'Gr≅πGr n A) = setTruncIso (IsoSphereMapΩ (suc n)) +fst (π'Gr≅πGr n A) = setTruncIso (IsoSphereMapΩ (suc n)) snd (π'Gr≅πGr n A) = makeIsGroupHom (sElim2 (λ _ _ → isSetPathImplicit) λ p q i → ∣ IsoSphereMapΩ-pres∙Π n p q i ∣₂) @@ -650,7 +650,7 @@ {- Proof of πₙ(ΩA) = πₙ₊₁(A) -} Iso-πΩ-π : ∀ {ℓ} {A : Pointed ℓ} (n : ℕ) → Iso (π n (Ω A)) (π (suc n) A) -Iso-πΩ-π {A = A} n = setTruncIso (invIso (flipΩIso n)) +Iso-πΩ-π {A = A} n = setTruncIso (invIso (flipΩIso n)) GrIso-πΩ-π : ∀ {ℓ} {A : Pointed ℓ} (n : ℕ) → GroupIso (πGr n (Ω A)) (πGr (suc n) A) @@ -791,13 +791,13 @@ πTruncIso : ∀ {ℓ} {A : Pointed ℓ} (n : ℕ) → Iso (π n A) (π n (hLevelTrunc∙ (2 + n) A)) πTruncIso {A = A} zero = - compIso (invIso (setTruncIdempotentIso squash₂)) - (setTruncIso setTruncTrunc2Iso) + compIso (invIso (setTruncIdempotentIso squash₂)) + (setTruncIso setTruncTrunc2Iso) πTruncIso {A = A} (suc n) = compIso setTruncTrunc2Iso (compIso (2TruncΩIso (suc n)) - (invIso (setTruncIdempotentIso (isSetΩTrunc n)))) + (invIso (setTruncIdempotentIso (isSetΩTrunc n)))) πTruncGroupIso : ∀ {ℓ} {A : Pointed ℓ} (n : ℕ) → GroupIso (πGr n A) (πGr n (hLevelTrunc∙ (3 + n) A)) @@ -806,7 +806,7 @@ makeIsGroupHom (sElim2 (λ _ _ → isSetPathImplicit) λ a b - → cong (inv (setTruncIdempotentIso (isSetΩTrunc n))) + → cong (inv (setTruncIdempotentIso (isSetΩTrunc n))) (cong (transport (λ i → typ ((Ω^ suc n) (hLevelTrunc∙ (+-comm (suc n) 2 i) A)))) @@ -1029,7 +1029,7 @@ invEquiv∙idEquiv∙≡idEquiv : ∀ {ℓ} {A : Pointed ℓ} → invEquiv∙ (idEquiv (fst A) , (λ _ → pt A)) ≡ (idEquiv (fst A) , refl) -invEquiv∙idEquiv∙≡idEquiv = ΣPathP ((Σ≡Prop (λ _ → isPropIsEquiv _) refl) , (sym (lUnit refl))) +invEquiv∙idEquiv∙≡idEquiv = ΣPathP ((Σ≡Prop (λ _ → isPropIsEquiv _) refl) , (sym (lUnit refl))) π'eqFunIsEquiv : ∀ {ℓ} {A : Pointed ℓ} {B : Pointed ℓ} (n : ℕ) @@ -1079,7 +1079,7 @@ fst (fst (πIso e n)) = fst (πHom n (≃∙map e)) snd (fst (πIso e n)) = isoToIsEquiv - (setTruncIso + (setTruncIso (equivToIso (_ , isEquivΩ^→ (suc n) (≃∙map e) (snd (fst e))))) snd (πIso e n) = snd (πHom n (≃∙map e)) \ No newline at end of file diff --git a/Cubical.Homotopy.Group.LES.html b/Cubical.Homotopy.Group.LES.html index 98c5fc2310..40bac0ddf2 100644 --- a/Cubical.Homotopy.Group.LES.html +++ b/Cubical.Homotopy.Group.LES.html @@ -26,7 +26,7 @@ open import Cubical.HITs.SetTruncation renaming (rec to sRec ; elim to sElim ; elim2 to sElim2 - ; map to sMap) + ; map to sMap) open import Cubical.HITs.PropositionalTruncation renaming (rec to pRec) @@ -525,7 +525,7 @@ λ p ker → pRec squash₁ (λ ker∙ → ∣ ∣ ind p ker∙ .fst ∣₂ , cong ∣_∣₂ (ind p ker∙ .snd) ∣₁ ) - (fun PathIdTrunc₀Iso ker) + (fun PathIdTrunc₀Iso ker) im⊂ker : ((x : typ (Ω ((Ω^ m) B))) → isInIm∙ f x → isInKer∙ g x) → (x : π (suc m) B) → isInIm (_ , e₁) x → isInKer (_ , e₂) x @@ -536,7 +536,7 @@ (uncurry (sElim (λ _ → isSetΠ λ _ → isSetPathImplicit) λ a q → pRec (squash₂ _ _) (λ q → cong ∣_∣₂ (ind p (a , q))) - (fun PathIdTrunc₀Iso q))) + (fun PathIdTrunc₀Iso q))) {- The long exact sequence of homotopy groups -} module πLES {ℓ ℓ' : Level} {A : Pointed ℓ} {B : Pointed ℓ'} (f : A →∙ B) where @@ -649,14 +649,14 @@ (πLES.A→B f n) (π'∘∙Hom n f) π∘∙A→B-PathP n f = - toPathP (Σ≡Prop (λ _ → isPropIsGroupHom _ _) (π'∘∙Hom'≡π'∘∙fun n f)) + toPathP (Σ≡Prop (λ _ → isPropIsGroupHom _ _) (π'∘∙Hom'≡π'∘∙fun n f)) π∘∙fib→A-PathP : ∀ {ℓ ℓ'} {A : Pointed ℓ} {B : Pointed ℓ'} (n : ℕ) (f : A →∙ B) → PathP (λ i → GroupHomπ≅π'PathP (ΩLES.fibf f) A n i) (πLES.fib→A f n) (π'∘∙Hom n (fst , refl)) π∘∙fib→A-PathP {A = A} {B = B} n f = - toPathP (Σ≡Prop (λ _ → isPropIsGroupHom _ _) + toPathP (Σ≡Prop (λ _ → isPropIsGroupHom _ _) (cong (transport (λ i → (fst (GroupPath _ _) (GroupIso→GroupEquiv (π'Gr≅πGr n (ΩLES.fibf f))) (~ i)) .fst diff --git a/Cubical.Homotopy.Group.Pi4S3.BrunerieNumber.html b/Cubical.Homotopy.Group.Pi4S3.BrunerieNumber.html index 79e449eba8..105627a64b 100644 --- a/Cubical.Homotopy.Group.Pi4S3.BrunerieNumber.html +++ b/Cubical.Homotopy.Group.Pi4S3.BrunerieNumber.html @@ -46,7 +46,7 @@ open import Cubical.HITs.SetTruncation renaming (rec to sRec ; rec2 to sRec2 ; elim to sElim ; elim2 to sElim2 ; elim3 to sElim3 - ; map to sMap) + ; map to sMap) open import Cubical.HITs.Truncation renaming (rec to trRec ; elim to trElim ; elim2 to trElim2 ; map to trMap) @@ -165,8 +165,8 @@ fiberinr'Iso' : Iso (fiber inr' (inl tt)) (Σ (Unit × S₊ 2) PushoutPath×) fiberinr'Iso' = - compIso (Σ-cong-iso-snd (λ x → symIso)) - (Σ-cong-iso-fst (invIso lUnit×Iso)) + compIso (Σ-cong-iso-snd (λ x → symIso)) + (Σ-cong-iso-fst (invIso lUnit×Iso)) fiberinr'Iso : Iso (fiber inr' (inl tt)) (Σ (Unit × S₊ 2) PushoutPath×) @@ -224,7 +224,7 @@ iso₂ : Iso (π 2 (hLevelTrunc∙ 4 (S₊∙ 3))) (π 2 TotalPushoutPath×∙) iso₂ = - (compIso (setTruncIso + (compIso (setTruncIso (equivToIso (_ , (isEquivΩ^→ 2 (fun iso₁ , refl) (isoToIsEquiv iso₁))))) (invIso (πTruncIso 2))) @@ -257,9 +257,9 @@ (sym (GroupPath _ _ .fst π₂P≅0)) _ _ _ _ _ P→S²→Pushout - (ΣPathPProp (λ _ → isPropIsGroupHom _ _) + (ΣPathPProp (λ _ → isPropIsGroupHom _ _) λ i → fst (π∘∙fib→A-PathP 2 inr∙ i)) - (ΣPathPProp (λ _ → isPropIsGroupHom _ _) + (ΣPathPProp (λ _ → isPropIsGroupHom _ _) λ i → fst (π∘∙A→B-PathP 2 inr∙ i)) -- The two surjections in question @@ -291,7 +291,7 @@ transportLem : PathP (λ i → GroupHomπ≅π'PathP (S₊∙ 3) TotalPushoutPath×∙ 2 i) π₃S³→π₃TotalPushoutPath× π₃S³→π₃P transportLem = - toPathP (Σ≡Prop (λ _ → isPropIsGroupHom _ _) + toPathP (Σ≡Prop (λ _ → isPropIsGroupHom _ _) (π'∘∙Hom'≡π'∘∙fun {A = S₊∙ 3} {B = TotalPushoutPath×∙} 2 (S³→TotalPushoutPath× , refl))) @@ -322,7 +322,7 @@ (π'∘∙Hom 2 TotalPushoutPath×∙→P) (π'∘∙Hom 2 (fst , refl)))) ≡ π'∘∙Hom 2 (fold∘W , refl) tripleComp≡ = - Σ≡Prop (λ _ → isPropIsGroupHom _ _) + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt (sElim (λ _ → isSetPathImplicit) λ f → cong ∣_∣₂ (ΣPathP (refl , (cong (_∙ refl) (λ j → cong fst (rUnit (cong (fst TotalPushoutPath×∙→P) diff --git a/Cubical.Homotopy.Group.Pi4S3.DirectProof.html b/Cubical.Homotopy.Group.Pi4S3.DirectProof.html index ddc5884237..5d03cc437e 100644 --- a/Cubical.Homotopy.Group.Pi4S3.DirectProof.html +++ b/Cubical.Homotopy.Group.Pi4S3.DirectProof.html @@ -88,7 +88,7 @@ open import Cubical.HITs.Wedge open import Cubical.HITs.Pushout open import Cubical.HITs.SetTruncation - renaming (rec2 to sRec2 ; elim to sElim ; elim2 to sElim2 ; map to sMap) + renaming (rec2 to sRec2 ; elim to sElim ; elim2 to sElim2 ; map to sMap) open import Cubical.HITs.Truncation as Trunc renaming (rec to trRec) open import Cubical.HITs.PropositionalTruncation as PropTrunc open import Cubical.HITs.GroupoidTruncation as GroupoidTrunc @@ -466,7 +466,7 @@ π₃*joinS¹S¹→π₃*S²' (fst (fst GrEq) , snd GrEq) help = - toPathP (Σ≡Prop (λ _ → isPropIsGroupHom _ _) + toPathP (Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt λ f → (λ i → transportRefl diff --git a/Cubical.Homotopy.Group.Pi4S3.S3PushoutIso.html b/Cubical.Homotopy.Group.Pi4S3.S3PushoutIso.html index a38cc6c866..81eedbd7ad 100644 --- a/Cubical.Homotopy.Group.Pi4S3.S3PushoutIso.html +++ b/Cubical.Homotopy.Group.Pi4S3.S3PushoutIso.html @@ -34,7 +34,7 @@ open import Cubical.HITs.SetTruncation renaming (rec to sRec ; rec2 to sRec2 ; elim to sElim ; elim2 to sElim2 ; elim3 to sElim3 - ; map to sMap) + ; map to sMap) open import Cubical.HITs.Sn open import Cubical.HITs.Susp renaming (toSusp to σ) open import Cubical.HITs.S1 hiding (decode ; encode) diff --git a/Cubical.Homotopy.Group.PinSn.html b/Cubical.Homotopy.Group.PinSn.html index 5a583f8e97..b9324cff96 100644 --- a/Cubical.Homotopy.Group.PinSn.html +++ b/Cubical.Homotopy.Group.PinSn.html @@ -22,7 +22,7 @@ open import Cubical.HITs.SetTruncation renaming (elim to sElim ; elim2 to sElim2 - ; map to sMap) + ; map to sMap) open import Cubical.HITs.Truncation renaming (elim to trElim ; elim2 to trElim2) open import Cubical.HITs.S1 @@ -167,7 +167,7 @@ πₙ'Sⁿ≅ℤ : (n : ℕ) → GroupIso (π'Gr n (S₊∙ (suc n))) ℤGroup πₙ'Sⁿ≅ℤ zero = compGroupIso (π'Gr≅πGr zero (S₊∙ 1)) - ((compIso (setTruncIdempotentIso (isGroupoidS¹ _ _)) ΩS¹Isoℤ) + ((compIso (setTruncIdempotentIso (isGroupoidS¹ _ _)) ΩS¹Isoℤ) , makeIsGroupHom (sElim2 (λ _ _ → isProp→isSet (isSetℤ _ _)) winding-hom)) πₙ'Sⁿ≅ℤ (suc zero) = compGroupIso π₂'S²≅π₁'S¹ (πₙ'Sⁿ≅ℤ zero) @@ -182,7 +182,7 @@ -- The goal now is to show that πₙ'Sⁿ≅ℤ takes idfun∙ : Sⁿ → Sⁿ to 1. -- For this, we need a bunch of identities: private - Isoπ₁S¹ℤ = (compIso (setTruncIdempotentIso (isGroupoidS¹ _ _)) ΩS¹Isoℤ) + Isoπ₁S¹ℤ = (compIso (setTruncIdempotentIso (isGroupoidS¹ _ _)) ΩS¹Isoℤ) π'₂S²≅π₂S²⁻-stLoop' : inv (fst (π'₂S²≅π₂S²)) stLoop₁flip ≡ ∣ idfun∙ _ ∣₂ π'₂S²≅π₂S²⁻-stLoop' = @@ -258,7 +258,7 @@ sym (leftInv Isoπ₁S¹ℤ (fun (fst π₂S²≅π₁S¹) stLoop₁)) ∙∙ cong (inv Isoπ₁S¹ℤ) compute - ∙∙ leftInv (compIso (setTruncIdempotentIso (isGroupoidS¹ _ _)) ΩS¹Isoℤ) + ∙∙ leftInv (compIso (setTruncIdempotentIso (isGroupoidS¹ _ _)) ΩS¹Isoℤ) ∣ loop ∣₂ where compute : fun Isoπ₁S¹ℤ (fun (fst π₂S²≅π₁S¹) stLoop₁) diff --git a/Cubical.Homotopy.Group.SuspensionMap.html b/Cubical.Homotopy.Group.SuspensionMap.html index 0da29f5dbc..8f463b8409 100644 --- a/Cubical.Homotopy.Group.SuspensionMap.html +++ b/Cubical.Homotopy.Group.SuspensionMap.html @@ -40,7 +40,7 @@ renaming (rec to pRec ; rec2 to pRec2 ; elim to pElim) open import Cubical.HITs.SetTruncation renaming (rec to sRec ; rec2 to sRec2 ; elim to sElim - ; elim2 to sElim2 ; elim3 to sElim3 ; map to sMap) + ; elim2 to sElim2 ; elim3 to sElim3 ; map to sMap) open import Cubical.HITs.Truncation renaming (rec to trRec) @@ -572,7 +572,7 @@ πGr≅π'Grᵣ : ∀ {ℓ} (n : ℕ) (A : Pointed ℓ) → GroupIso (πGr (suc n) (Susp∙ (typ A))) (π'Gr (suc n) (Susp∙ (typ A))) -fst (πGr≅π'Grᵣ n A) = setTruncIso (IsoΩSphereMapᵣ (suc n)) +fst (πGr≅π'Grᵣ n A) = setTruncIso (IsoΩSphereMapᵣ (suc n)) snd (πGr≅π'Grᵣ n A) = makeIsGroupHom (sElim2 (λ _ _ → isSetPathImplicit) λ f g → cong ∣_∣₂ (isHom-IsoΩSphereMapᵣ n f g)) diff --git a/Cubical.Homotopy.HopfInvariant.Base.html b/Cubical.Homotopy.HopfInvariant.Base.html index 63e54a6d77..0ba7d5ba65 100644 --- a/Cubical.Homotopy.HopfInvariant.Base.html +++ b/Cubical.Homotopy.HopfInvariant.Base.html @@ -49,7 +49,7 @@ open import Cubical.HITs.Truncation renaming (rec to trRec) open import Cubical.HITs.SetTruncation - renaming (rec to sRec ; elim to sElim ; elim2 to sElim2 ; map to sMap) + renaming (rec to sRec ; elim to sElim ; elim2 to sElim2 ; map to sMap) open import Cubical.HITs.PropositionalTruncation renaming (rec to pRec) diff --git a/Cubical.Homotopy.HopfInvariant.Brunerie.html b/Cubical.Homotopy.HopfInvariant.Brunerie.html index 7547025637..3520faca40 100644 --- a/Cubical.Homotopy.HopfInvariant.Brunerie.html +++ b/Cubical.Homotopy.HopfInvariant.Brunerie.html @@ -47,7 +47,7 @@ open import Cubical.HITs.Wedge open import Cubical.HITs.Truncation open import Cubical.HITs.SetTruncation - renaming (elim to sElim ; elim2 to sElim2 ; map to sMap) + renaming (elim to sElim ; elim2 to sElim2 ; map to sMap) open import Cubical.HITs.PropositionalTruncation renaming (map to pMap ; rec to pRec) @@ -178,18 +178,18 @@ (compIso (fst (Hⁿ-⋁ (S₊∙ 2) (S₊∙ 2) 2)) (compIso - (prodIso (fst (Hⁿ-Sᵐ≅0 2 1 λ p → snotz (cong predℕ p))) + (prodIso (fst (Hⁿ-Sᵐ≅0 2 1 λ p → snotz (cong predℕ p))) (fst (Hⁿ-Sᵐ≅0 2 1 λ p → snotz (cong predℕ p)))) - rUnit×Iso)) + rUnit×Iso)) isContrUnit)) ((isContr→≡UnitGroup (isOfHLevelRetractFromIso 0 (compIso (fst (Hⁿ-⋁ (S₊∙ 2) (S₊∙ 2) 3)) (compIso - (prodIso (fst (Hⁿ-Sᵐ≅0 3 1 λ p → snotz (cong predℕ p))) + (prodIso (fst (Hⁿ-Sᵐ≅0 3 1 λ p → snotz (cong predℕ p))) (fst (Hⁿ-Sᵐ≅0 3 1 λ p → snotz (cong predℕ p)))) - rUnit×Iso)) + rUnit×Iso)) isContrUnit))) (MV-⋁↪-fold⋁.d 3) (MV-⋁↪-fold⋁.i 4) @@ -277,7 +277,7 @@ ((λ x → cong f (push (inl x)) ∙∙ funExt⁻ r x ∙∙ sym (rUnitₖ 2 ∣ x ∣ₕ))) (cong (_∙∙ funExt⁻ r north ∙∙ refl) (cong (cong f) λ j i → push (push tt j) i)))))) - (fun PathIdTrunc₀Iso p) + (fun PathIdTrunc₀Iso p) mainEq : ((fst qHom) (α' ⌣ α') ≡ qHom .fst (β' +ₕ β')) diff --git a/Cubical.Homotopy.HopfInvariant.Homomorphism.html b/Cubical.Homotopy.HopfInvariant.Homomorphism.html index 6463492df8..2e27feab5d 100644 --- a/Cubical.Homotopy.HopfInvariant.Homomorphism.html +++ b/Cubical.Homotopy.HopfInvariant.Homomorphism.html @@ -47,7 +47,7 @@ open import Cubical.HITs.Wedge open import Cubical.HITs.Truncation open import Cubical.HITs.SetTruncation - renaming (elim to sElim ; elim2 to sElim2 ; map to sMap) + renaming (elim to sElim ; elim2 to sElim2 ; map to sMap) open import Cubical.HITs.PropositionalTruncation open PlusBis diff --git a/Cubical.Homotopy.HopfInvariant.HopfMap.html b/Cubical.Homotopy.HopfInvariant.HopfMap.html index fe2d797442..d722bc940c 100644 --- a/Cubical.Homotopy.HopfInvariant.HopfMap.html +++ b/Cubical.Homotopy.HopfInvariant.HopfMap.html @@ -54,7 +54,7 @@ renaming (rec to trRec ; elim to trElim) open import Cubical.HITs.SetTruncation renaming (rec to sRec ; rec2 to sRec2 - ; elim to sElim ; elim2 to sElim2 ; map to sMap) + ; elim to sElim ; elim2 to sElim2 ; map to sMap) open import Cubical.HITs.PropositionalTruncation renaming (rec to pRec) diff --git a/Cubical.Homotopy.Loopspace.html b/Cubical.Homotopy.Loopspace.html index 063031a309..43fed919a8 100644 --- a/Cubical.Homotopy.Loopspace.html +++ b/Cubical.Homotopy.Loopspace.html @@ -442,10 +442,10 @@ {- Homotopy group version -} π-comp : ∀ {ℓ} {A : Pointed ℓ} (n : ℕ) → ∥ typ ((Ω^ (suc n)) A) ∥₂ → ∥ typ ((Ω^ (suc n)) A) ∥₂ → ∥ typ ((Ω^ (suc n)) A) ∥₂ -π-comp n = elim2 (λ _ _ → isSetSetTrunc) λ p q → ∣ p ∙ q ∣₂ +π-comp n = elim2 (λ _ _ → isSetSetTrunc) λ p q → ∣ p ∙ q ∣₂ EH-π : ∀ {ℓ} {A : Pointed ℓ} (n : ℕ) (p q : ∥ typ ((Ω^ (2 + n)) A) ∥₂) → π-comp (1 + n) p q ≡ π-comp (1 + n) q p -EH-π n = elim2 (λ x y → isOfHLevelPath 2 isSetSetTrunc _ _) +EH-π n = elim2 (λ x y → isOfHLevelPath 2 isSetSetTrunc _ _) λ p q → cong ∣_∣₂ (EH n p q) \ No newline at end of file diff --git a/Cubical.Homotopy.Whitehead.html b/Cubical.Homotopy.Whitehead.html index 34187c8259..8d053c93ff 100644 --- a/Cubical.Homotopy.Whitehead.html +++ b/Cubical.Homotopy.Whitehead.html @@ -373,7 +373,7 @@ -- Main iso Iso-Susp×Susp-cofibJoinTo⋁ : Iso (Susp A × Susp B) cofibW Iso-Susp×Susp-cofibJoinTo⋁ = - compIso (Σ-cong-iso-snd (λ _ → invSuspIso)) + compIso (Σ-cong-iso-snd (λ _ → invSuspIso)) Iso₁-Susp×Susp-cofibW -- The induced function A ∨ B → Susp A × Susp B satisfies @@ -391,7 +391,7 @@ f₁ = fun Iso-PushSusp×-Susp×Susp f₂ = fun Iso-A□○-PushSusp× f₃ = backward-l whitehead3x3 - f₄ = fun (Σ-cong-iso-snd (λ _ → invSuspIso)) + f₄ = fun (Σ-cong-iso-snd (λ _ → invSuspIso)) lem : (b : B) → cong (f₁ ∘ f₂ ∘ f₃) (push b) diff --git a/Cubical.Papers.AffineSchemes.html b/Cubical.Papers.AffineSchemes.html index 608d2bd40d..255203c801 100644 --- a/Cubical.Papers.AffineSchemes.html +++ b/Cubical.Papers.AffineSchemes.html @@ -49,10 +49,10 @@ import Cubical.Algebra.CommRing.FGIdeal as FinGenIdeals import Cubical.Algebra.ZariskiLattice.Base as ZLB -module ZariskiLatDef = ZLB.ZarLat +module ZariskiLatDef = ZLB.ZarLat import Cubical.Algebra.ZariskiLattice.UniversalProperty as ZLUP -module ZariskiLatUnivProp = ZLUP.ZarLatUniversalProp +module ZariskiLatUnivProp = ZLUP.ZarLatUniversalProp -- 4: Category Theory @@ -65,7 +65,7 @@ import Cubical.Categories.DistLatticeSheaf.Base as Sheaves import Cubical.Categories.DistLatticeSheaf.Extension as E -module SheafExtension = E.PreSheafExtension +module SheafExtension = E.PreSheafExtension -- 5: The Structure Sheaf @@ -150,8 +150,8 @@ -- Zariski lattice as set-quotient and -- equivalence of quotienting relations -open ZariskiLatDef using (_∼_ ; ZL) renaming (_∼≡_ to _≋_) -open ZariskiLatDef using (≡→∼ ; ∼→≡) +open ZariskiLatDef using (_∼_ ; ZL) renaming (_∼≡_ to _≋_) +open ZariskiLatDef using (≡→∼ ; ∼→≡) -- _++_ and relation to ideal addition open FiniteTypes renaming (_++Fin_ to _++_) @@ -162,21 +162,21 @@ open FinGenIdeals using (FGIdealMultLemma) -- lattice structure and laws -open ZariskiLatDef using (ZariskiLattice) +open ZariskiLatDef using (ZariskiLattice) -- support map D and universal property -open ZariskiLatUnivProp using (D ; isZarMapD) -open ZariskiLatUnivProp using (ZLHasUniversalProp) +open ZariskiLatUnivProp using (D ; isZarMapD) +open ZariskiLatUnivProp using (ZLHasUniversalProp) -- D(g) ≤ D(f) ⇔ isContr (R-Hom R[1/f] R[1/g]) -open StructureSheaf using (contrHoms) +open StructureSheaf using (contrHoms) -- basic opens -open StructureSheaf using (BasicOpens ; BO) +open StructureSheaf using (BasicOpens ; BO) -- basic opens form basis -open ZariskiLatUnivProp using (ZLUniversalPropCorollary ; ⋁D≡) -open StructureSheaf using (basicOpensAreBasis) +open ZariskiLatUnivProp using (ZLUniversalPropCorollary ; ⋁D≡) +open StructureSheaf using (basicOpensAreBasis) @@ -186,32 +186,32 @@ open CatTheory using (ΣPropCat) -- Kan-extension for distributive lattices -open SheafExtension using (DLRan ; DLRanNatIso) +open SheafExtension using (DLRan ; DLRanNatIso) -- Definition 4 -open SheafDiagShapes using (DLShfDiagOb ; DLShfDiagHom ; DLShfDiag) +open SheafDiagShapes using (DLShfDiagOb ; DLShfDiagHom ; DLShfDiag) -- Remark 5 -open SheafDiagShapes.DLShfDiagHomPath using (isSetDLShfDiagHom) +open SheafDiagShapes.DLShfDiagHomPath using (isSetDLShfDiagHom) -- diagram associated to a vector -open SheafDiagShapes using (FinVec→Diag) +open SheafDiagShapes using (FinVec→Diag) -- Definition 6 -open Sheaves using (isDLSheaf) +open Sheaves using (isDLSheaf) -- Definition 7 -open Sheaves.SheafOnBasis using (isDLBasisSheaf) +open Sheaves.SheafOnBasis using (isDLBasisSheaf) -- Lemma 8 -open Sheaves using (isDLSheafPullback) -open Sheaves.EquivalenceOfDefs using (L→P ; P→L) +open Sheaves using (isDLSheafPullback) +open Sheaves.EquivalenceOfDefs using (L→P ; P→L) -- Lemma 9 -open SheafExtension using (coverLemma) +open SheafExtension using (coverLemma) -- Theorem 10 -open SheafExtension using (isDLSheafDLRan) +open SheafExtension using (isDLSheafDLRan) @@ -224,20 +224,20 @@ open R-AlgConstructions.PreSheafFromUniversalProp renaming (universalPShf to 𝓟ᵤ) -- definition of structure sheaf -open StructureSheaf using ( 𝓞ᴮ ; 𝓞 ) +open StructureSheaf using ( 𝓞ᴮ ; 𝓞 ) -- Proposition 13 -open StructureSheaf using (baseSections) +open StructureSheaf using (baseSections) -- Corollary 14 -open StructureSheaf using (globalSection) +open StructureSheaf using (globalSection) -- Lemma 15 open LocalizationLimit using (isLimConeLocCone) -- Theorem 16 -open StructureSheaf using (isSheaf𝓞ᴮ) +open StructureSheaf using (isSheaf𝓞ᴮ) -- Corollary 17 -open StructureSheaf using (isSheaf𝓞) +open StructureSheaf using (isSheaf𝓞) \ No newline at end of file diff --git a/Cubical.Papers.RepresentationIndependence.html b/Cubical.Papers.RepresentationIndependence.html index bf83b40d55..4340ee05b2 100644 --- a/Cubical.Papers.RepresentationIndependence.html +++ b/Cubical.Papers.RepresentationIndependence.html @@ -280,8 +280,8 @@ -- 5.1 Quasi-Equivalence Relations --Lemma (5.1) -open BinRel using (idPropRel ; invPropRel - ; compPropRel ; graphRel) public +open BinRel using (idPropRel ; invPropRel + ; compPropRel ; graphRel) public -- Definitions (5.2) and (5.3) open QER using (isZigZagComplete ; isQuasiEquivRel) public -- Lemma (5.4) diff --git a/Cubical.Relation.Binary.Base.html b/Cubical.Relation.Binary.Base.html index ab297875b8..a7ffc73567 100644 --- a/Cubical.Relation.Binary.Base.html +++ b/Cubical.Relation.Binary.Base.html @@ -9,151 +9,242 @@ open import Cubical.Foundations.Isomorphism open import Cubical.Foundations.Equiv open import Cubical.Foundations.Equiv.Fiberwise -open import Cubical.Data.Sigma -open import Cubical.HITs.SetQuotients.Base -open import Cubical.HITs.PropositionalTruncation.Base - -private - variable - ℓA ℓ≅A ℓA' ℓ≅A' : Level - -Rel : ∀ {ℓ} (A B : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ')) -Rel A B ℓ' = A → B → Type ℓ' - -PropRel : ∀ {ℓ} (A B : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ')) -PropRel A B ℓ' = Σ[ R ∈ Rel A B ℓ' ] ∀ a b → isProp (R a b) - -idPropRel : ∀ {ℓ} (A : Type ℓ) → PropRel A A ℓ -idPropRel A .fst a a' = ∥ a ≡ a' ∥₁ -idPropRel A .snd _ _ = squash₁ - -invPropRel : ∀ {ℓ ℓ'} {A B : Type ℓ} - → PropRel A B ℓ' → PropRel B A ℓ' -invPropRel R .fst b a = R .fst a b -invPropRel R .snd b a = R .snd a b - -compPropRel : ∀ {ℓ ℓ' ℓ''} {A B C : Type ℓ} - → PropRel A B ℓ' → PropRel B C ℓ'' → PropRel A C (ℓ-max ℓ (ℓ-max ℓ' ℓ'')) -compPropRel R S .fst a c = ∥ Σ[ b ∈ _ ] (R .fst a b × S .fst b c) ∥₁ -compPropRel R S .snd _ _ = squash₁ - -graphRel : ∀ {ℓ} {A B : Type ℓ} → (A → B) → Rel A B ℓ -graphRel f a b = f a ≡ b - -module HeterogenousRelation {ℓ ℓ' : Level} {A B : Type ℓ} (R : Rel A B ℓ') where - isUniversalRel : Type (ℓ-max ℓ ℓ') - isUniversalRel = (a : A) (b : B) → R a b - -module BinaryRelation {ℓ ℓ' : Level} {A : Type ℓ} (R : Rel A A ℓ') where - isRefl : Type (ℓ-max ℓ ℓ') - isRefl = (a : A) → R a a - - isSym : Type (ℓ-max ℓ ℓ') - isSym = (a b : A) → R a b → R b a - - isAntisym : Type (ℓ-max ℓ ℓ') - isAntisym = (a b : A) → R a b → R b a → a ≡ b - - isTrans : Type (ℓ-max ℓ ℓ') - isTrans = (a b c : A) → R a b → R b c → R a c - - record isEquivRel : Type (ℓ-max ℓ ℓ') where - constructor equivRel - field - reflexive : isRefl - symmetric : isSym - transitive : isTrans - - isUniversalRel→isEquivRel : HeterogenousRelation.isUniversalRel R → isEquivRel - isUniversalRel→isEquivRel u .isEquivRel.reflexive a = u a a - isUniversalRel→isEquivRel u .isEquivRel.symmetric a b _ = u b a - isUniversalRel→isEquivRel u .isEquivRel.transitive a _ c _ _ = u a c - - isPropValued : Type (ℓ-max ℓ ℓ') - isPropValued = (a b : A) → isProp (R a b) - - isSetValued : Type (ℓ-max ℓ ℓ') - isSetValued = (a b : A) → isSet (R a b) - - isEffective : Type (ℓ-max ℓ ℓ') - isEffective = - (a b : A) → isEquiv (eq/ {R = R} a b) - - - impliesIdentity : Type _ - impliesIdentity = {a a' : A} → (R a a') → (a ≡ a') - - -- the total space corresponding to the binary relation w.r.t. a - relSinglAt : (a : A) → Type (ℓ-max ℓ ℓ') - relSinglAt a = Σ[ a' ∈ A ] (R a a') - - -- the statement that the total space is contractible at any a - contrRelSingl : Type (ℓ-max ℓ ℓ') - contrRelSingl = (a : A) → isContr (relSinglAt a) - - isUnivalent : Type (ℓ-max ℓ ℓ') - isUnivalent = (a a' : A) → (R a a') ≃ (a ≡ a') - - contrRelSingl→isUnivalent : isRefl → contrRelSingl → isUnivalent - contrRelSingl→isUnivalent ρ c a a' = isoToEquiv i - where - h : isProp (relSinglAt a) - h = isContr→isProp (c a) - aρa : relSinglAt a - aρa = a , ρ a - Q : (y : A) → a ≡ y → _ - Q y _ = R a y - i : Iso (R a a') (a ≡ a') - Iso.fun i r = cong fst (h aρa (a' , r)) - Iso.inv i = J Q (ρ a) - Iso.rightInv i = J (λ y p → cong fst (h aρa (y , J Q (ρ a) p)) ≡ p) - (J (λ q _ → cong fst (h aρa (a , q)) ≡ refl) - (J (λ α _ → cong fst α ≡ refl) refl - (isProp→isSet h _ _ refl (h _ _))) - (sym (JRefl Q (ρ a)))) - Iso.leftInv i r = J (λ w β → J Q (ρ a) (cong fst β) ≡ snd w) - (JRefl Q (ρ a)) (h aρa (a' , r)) - - isUnivalent→contrRelSingl : isUnivalent → contrRelSingl - isUnivalent→contrRelSingl u a = q - where - abstract - f : (x : A) → a ≡ x → R a x - f x p = invEq (u a x) p - - t : singl a → relSinglAt a - t (x , p) = x , f x p - - q : isContr (relSinglAt a) - q = isOfHLevelRespectEquiv 0 (t , totalEquiv _ _ f λ x → invEquiv (u a x) .snd) - (isContrSingl a) - -EquivRel : ∀ {ℓ} (A : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ')) -EquivRel A ℓ' = Σ[ R ∈ Rel A A ℓ' ] BinaryRelation.isEquivRel R - -EquivPropRel : ∀ {ℓ} (A : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ')) -EquivPropRel A ℓ' = Σ[ R ∈ PropRel A A ℓ' ] BinaryRelation.isEquivRel (R .fst) - -record RelIso {A : Type ℓA} (_≅_ : Rel A A ℓ≅A) - {A' : Type ℓA'} (_≅'_ : Rel A' A' ℓ≅A') : Type (ℓ-max (ℓ-max ℓA ℓA') (ℓ-max ℓ≅A ℓ≅A')) where - constructor reliso - field - fun : A → A' - inv : A' → A - rightInv : (a' : A') → fun (inv a') ≅' a' - leftInv : (a : A) → inv (fun a) ≅ a - -open BinaryRelation - -RelIso→Iso : {A : Type ℓA} {A' : Type ℓA'} - (_≅_ : Rel A A ℓ≅A) (_≅'_ : Rel A' A' ℓ≅A') - (uni : impliesIdentity _≅_) (uni' : impliesIdentity _≅'_) - (f : RelIso _≅_ _≅'_) - → Iso A A' -Iso.fun (RelIso→Iso _ _ _ _ f) = RelIso.fun f -Iso.inv (RelIso→Iso _ _ _ _ f) = RelIso.inv f -Iso.rightInv (RelIso→Iso _ _ uni uni' f) a' - = uni' (RelIso.rightInv f a') -Iso.leftInv (RelIso→Iso _ _ uni uni' f) a - = uni (RelIso.leftInv f a) +open import Cubical.Functions.Embedding +open import Cubical.Functions.Logic using (_⊔′_) + +open import Cubical.Data.Empty as ⊥ +open import Cubical.Data.Sigma +open import Cubical.Data.Sum.Base as ⊎ +open import Cubical.HITs.SetQuotients.Base +open import Cubical.HITs.PropositionalTruncation as ∥₁ + +open import Cubical.Relation.Nullary.Base + +private + variable + ℓA ℓ≅A ℓA' ℓ≅A' : Level + +Rel : ∀ {ℓ} (A B : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ')) +Rel A B ℓ' = A → B → Type ℓ' + +PropRel : ∀ {ℓ} (A B : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ')) +PropRel A B ℓ' = Σ[ R ∈ Rel A B ℓ' ] ∀ a b → isProp (R a b) + +idPropRel : ∀ {ℓ} (A : Type ℓ) → PropRel A A ℓ +idPropRel A .fst a a' = ∥ a ≡ a' ∥₁ +idPropRel A .snd _ _ = squash₁ + +invPropRel : ∀ {ℓ ℓ'} {A B : Type ℓ} + → PropRel A B ℓ' → PropRel B A ℓ' +invPropRel R .fst b a = R .fst a b +invPropRel R .snd b a = R .snd a b + +compPropRel : ∀ {ℓ ℓ' ℓ''} {A B C : Type ℓ} + → PropRel A B ℓ' → PropRel B C ℓ'' → PropRel A C (ℓ-max ℓ (ℓ-max ℓ' ℓ'')) +compPropRel R S .fst a c = ∥ Σ[ b ∈ _ ] (R .fst a b × S .fst b c) ∥₁ +compPropRel R S .snd _ _ = squash₁ + +graphRel : ∀ {ℓ} {A B : Type ℓ} → (A → B) → Rel A B ℓ +graphRel f a b = f a ≡ b + +module HeterogenousRelation {ℓ ℓ' : Level} {A B : Type ℓ} (R : Rel A B ℓ') where + isUniversalRel : Type (ℓ-max ℓ ℓ') + isUniversalRel = (a : A) (b : B) → R a b + +module BinaryRelation {ℓ ℓ' : Level} {A : Type ℓ} (R : Rel A A ℓ') where + isRefl : Type (ℓ-max ℓ ℓ') + isRefl = (a : A) → R a a + + isIrrefl : Type (ℓ-max ℓ ℓ') + isIrrefl = (a : A) → ¬ R a a + + isSym : Type (ℓ-max ℓ ℓ') + isSym = (a b : A) → R a b → R b a + + isAsym : Type (ℓ-max ℓ ℓ') + isAsym = (a b : A) → R a b → ¬ R b a + + isAntisym : Type (ℓ-max ℓ ℓ') + isAntisym = (a b : A) → R a b → R b a → a ≡ b + + isTrans : Type (ℓ-max ℓ ℓ') + isTrans = (a b c : A) → R a b → R b c → R a c + + -- Sum types don't play nicely with props, so we truncate + isCotrans : Type (ℓ-max ℓ ℓ') + isCotrans = (a b c : A) → R a b → (R a c ⊔′ R b c) + + isWeaklyLinear : Type (ℓ-max ℓ ℓ') + isWeaklyLinear = (a b c : A) → R a b → R a c ⊔′ R c b + + isConnected : Type (ℓ-max ℓ ℓ') + isConnected = (a b : A) → ¬ (a ≡ b) → R a b ⊔′ R b a + + isStronglyConnected : Type (ℓ-max ℓ ℓ') + isStronglyConnected = (a b : A) → R a b ⊔′ R b a + + isStronglyConnected→isConnected : isStronglyConnected → isConnected + isStronglyConnected→isConnected strong a b _ = strong a b + + isIrrefl×isTrans→isAsym : isIrrefl × isTrans → isAsym + isIrrefl×isTrans→isAsym (irrefl , trans) a₀ a₁ Ra₀a₁ Ra₁a₀ + = irrefl a₀ (trans a₀ a₁ a₀ Ra₀a₁ Ra₁a₀) + + IrreflKernel : Rel A A (ℓ-max ℓ ℓ') + IrreflKernel a b = R a b × (¬ a ≡ b) + + ReflClosure : Rel A A (ℓ-max ℓ ℓ') + ReflClosure a b = R a b ⊎ (a ≡ b) + + SymKernel : Rel A A ℓ' + SymKernel a b = R a b × R b a + + SymClosure : Rel A A ℓ' + SymClosure a b = R a b ⊎ R b a + + AsymKernel : Rel A A ℓ' + AsymKernel a b = R a b × (¬ R b a) + + NegationRel : Rel A A ℓ' + NegationRel a b = ¬ (R a b) + + module _ + {ℓ'' : Level} + (P : Embedding A ℓ'') + + where + + private + subtype : Type ℓ'' + subtype = (fst P) + + toA : subtype → A + toA = fst (snd P) + + InducedRelation : Rel subtype subtype ℓ' + InducedRelation a b = R (toA a) (toA b) + + record isEquivRel : Type (ℓ-max ℓ ℓ') where + constructor equivRel + field + reflexive : isRefl + symmetric : isSym + transitive : isTrans + + isUniversalRel→isEquivRel : HeterogenousRelation.isUniversalRel R → isEquivRel + isUniversalRel→isEquivRel u .isEquivRel.reflexive a = u a a + isUniversalRel→isEquivRel u .isEquivRel.symmetric a b _ = u b a + isUniversalRel→isEquivRel u .isEquivRel.transitive a _ c _ _ = u a c + + isPropValued : Type (ℓ-max ℓ ℓ') + isPropValued = (a b : A) → isProp (R a b) + + isSetValued : Type (ℓ-max ℓ ℓ') + isSetValued = (a b : A) → isSet (R a b) + + isEffective : Type (ℓ-max ℓ ℓ') + isEffective = + (a b : A) → isEquiv (eq/ {R = R} a b) + + + impliesIdentity : Type _ + impliesIdentity = {a a' : A} → (R a a') → (a ≡ a') + + -- the total space corresponding to the binary relation w.r.t. a + relSinglAt : (a : A) → Type (ℓ-max ℓ ℓ') + relSinglAt a = Σ[ a' ∈ A ] (R a a') + + -- the statement that the total space is contractible at any a + contrRelSingl : Type (ℓ-max ℓ ℓ') + contrRelSingl = (a : A) → isContr (relSinglAt a) + + isUnivalent : Type (ℓ-max ℓ ℓ') + isUnivalent = (a a' : A) → (R a a') ≃ (a ≡ a') + + contrRelSingl→isUnivalent : isRefl → contrRelSingl → isUnivalent + contrRelSingl→isUnivalent ρ c a a' = isoToEquiv i + where + h : isProp (relSinglAt a) + h = isContr→isProp (c a) + aρa : relSinglAt a + aρa = a , ρ a + Q : (y : A) → a ≡ y → _ + Q y _ = R a y + i : Iso (R a a') (a ≡ a') + Iso.fun i r = cong fst (h aρa (a' , r)) + Iso.inv i = J Q (ρ a) + Iso.rightInv i = J (λ y p → cong fst (h aρa (y , J Q (ρ a) p)) ≡ p) + (J (λ q _ → cong fst (h aρa (a , q)) ≡ refl) + (J (λ α _ → cong fst α ≡ refl) refl + (isProp→isSet h _ _ refl (h _ _))) + (sym (JRefl Q (ρ a)))) + Iso.leftInv i r = J (λ w β → J Q (ρ a) (cong fst β) ≡ snd w) + (JRefl Q (ρ a)) (h aρa (a' , r)) + + isUnivalent→contrRelSingl : isUnivalent → contrRelSingl + isUnivalent→contrRelSingl u a = q + where + abstract + f : (x : A) → a ≡ x → R a x + f x p = invEq (u a x) p + + t : singl a → relSinglAt a + t (x , p) = x , f x p + + q : isContr (relSinglAt a) + q = isOfHLevelRespectEquiv 0 (t , totalEquiv _ _ f λ x → invEquiv (u a x) .snd) + (isContrSingl a) + +EquivRel : ∀ {ℓ} (A : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ')) +EquivRel A ℓ' = Σ[ R ∈ Rel A A ℓ' ] BinaryRelation.isEquivRel R + +EquivPropRel : ∀ {ℓ} (A : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ')) +EquivPropRel A ℓ' = Σ[ R ∈ PropRel A A ℓ' ] BinaryRelation.isEquivRel (R .fst) + +record RelIso {A : Type ℓA} (_≅_ : Rel A A ℓ≅A) + {A' : Type ℓA'} (_≅'_ : Rel A' A' ℓ≅A') : Type (ℓ-max (ℓ-max ℓA ℓA') (ℓ-max ℓ≅A ℓ≅A')) where + constructor reliso + field + fun : A → A' + inv : A' → A + rightInv : (a' : A') → fun (inv a') ≅' a' + leftInv : (a : A) → inv (fun a) ≅ a + +open BinaryRelation + +RelIso→Iso : {A : Type ℓA} {A' : Type ℓA'} + (_≅_ : Rel A A ℓ≅A) (_≅'_ : Rel A' A' ℓ≅A') + (uni : impliesIdentity _≅_) (uni' : impliesIdentity _≅'_) + (f : RelIso _≅_ _≅'_) + → Iso A A' +Iso.fun (RelIso→Iso _ _ _ _ f) = RelIso.fun f +Iso.inv (RelIso→Iso _ _ _ _ f) = RelIso.inv f +Iso.rightInv (RelIso→Iso _ _ uni uni' f) a' + = uni' (RelIso.rightInv f a') +Iso.leftInv (RelIso→Iso _ _ uni uni' f) a + = uni (RelIso.leftInv f a) + +isIrreflIrreflKernel : ∀{ℓ ℓ'} {A : Type ℓ} (R : Rel A A ℓ') → isIrrefl (IrreflKernel R) +isIrreflIrreflKernel _ _ (_ , ¬a≡a) = ¬a≡a refl + +isReflReflClosure : ∀{ℓ ℓ'} {A : Type ℓ} (R : Rel A A ℓ') → isRefl (ReflClosure R) +isReflReflClosure _ _ = inr refl + +isConnectedStronglyConnectedIrreflKernel : ∀{ℓ ℓ'} {A : Type ℓ} (R : Rel A A ℓ') + → isStronglyConnected R + → isConnected (IrreflKernel R) +isConnectedStronglyConnectedIrreflKernel R strong a b ¬a≡b + = ∥₁.map (λ x → ⊎.rec (λ Rab → inl (Rab , ¬a≡b)) + (λ Rba → inr (Rba , (λ b≡a → ¬a≡b (sym b≡a)))) x) + (strong a b) + +isSymSymKernel : ∀{ℓ ℓ'} {A : Type ℓ} (R : Rel A A ℓ') → isSym (SymKernel R) +isSymSymKernel _ _ _ (Rab , Rba) = Rba , Rab + +isSymSymClosure : ∀{ℓ ℓ'} {A : Type ℓ} (R : Rel A A ℓ') → isSym (SymClosure R) +isSymSymClosure _ _ _ (inl Rab) = inr Rab +isSymSymClosure _ _ _ (inr Rba) = inl Rba + +isAsymAsymKernel : ∀ {ℓ ℓ'} {A : Type ℓ} (R : Rel A A ℓ') → isAsym (AsymKernel R) +isAsymAsymKernel _ _ _ (Rab , _) (_ , ¬Rab) = ¬Rab Rab \ No newline at end of file diff --git a/Cubical.Relation.Binary.Extensionality.html b/Cubical.Relation.Binary.Extensionality.html index cbdea8a590..a8b07482e8 100644 --- a/Cubical.Relation.Binary.Extensionality.html +++ b/Cubical.Relation.Binary.Extensionality.html @@ -10,7 +10,7 @@ open import Cubical.Data.Sigma open import Cubical.Relation.Binary.Base -module _ {ℓ ℓ'} {A : Type ℓ} (_≺_ : Rel A A ℓ') where +module _ {ℓ ℓ'} {A : Type ℓ} (_≺_ : Rel A A ℓ') where ≡→≺Equiv : (x y : A) → x ≡ y → ∀ z → (z ≺ x) ≃ (z ≺ y) ≡→≺Equiv _ _ p z = substEquiv (z ≺_) p diff --git a/Cubical.Relation.Binary.Order.Apartness.Base.html b/Cubical.Relation.Binary.Order.Apartness.Base.html new file mode 100644 index 0000000000..d031b689b3 --- /dev/null +++ b/Cubical.Relation.Binary.Order.Apartness.Base.html @@ -0,0 +1,132 @@ + +Cubical.Relation.Binary.Order.Apartness.Base
{-# OPTIONS --safe #-}
+{-
+  An apartness relation is a relation that distinguishes
+  elements which are different from each other
+-}
+module Cubical.Relation.Binary.Order.Apartness.Base where
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.Equiv
+open import Cubical.Foundations.HLevels
+open import Cubical.Foundations.Isomorphism
+open import Cubical.Foundations.Univalence
+open import Cubical.Foundations.Transport
+open import Cubical.Foundations.SIP
+
+open import Cubical.Data.Sigma
+open import Cubical.Data.Sum
+
+open import Cubical.Reflection.RecordEquiv
+open import Cubical.Reflection.StrictEquiv
+
+open import Cubical.Displayed.Base
+open import Cubical.Displayed.Auto
+open import Cubical.Displayed.Record
+open import Cubical.Displayed.Universe
+
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Nullary
+
+open import Cubical.HITs.PropositionalTruncation
+
+open Iso
+open BinaryRelation
+
+
+private
+  variable
+    ℓ ℓ' ℓ'' ℓ₀ ℓ₀' ℓ₁ ℓ₁' : Level
+
+record IsApartness {A : Type ℓ} (_#_ : A → A → Type ℓ') : Type (ℓ-max ℓ ℓ') where
+  no-eta-equality
+  constructor isapartness
+
+  field
+    is-set : isSet A
+    is-prop-valued : isPropValued _#_
+    is-irrefl : isIrrefl _#_
+    is-cotrans : isCotrans _#_
+    is-sym : isSym _#_
+
+unquoteDecl IsApartnessIsoΣ = declareRecordIsoΣ IsApartnessIsoΣ (quote IsApartness)
+
+
+record ApartnessStr (ℓ' : Level) (A : Type ℓ) : Type (ℓ-max ℓ (ℓ-suc ℓ')) where
+
+  constructor apartnessstr
+
+  field
+    _#_     : A → A → Type ℓ'
+    isApartness : IsApartness _#_
+
+  infixl 7 _#_
+
+  open IsApartness isApartness public
+
+Apartness : ∀ ℓ ℓ' → Type (ℓ-max (ℓ-suc ℓ) (ℓ-suc ℓ'))
+Apartness ℓ ℓ' = TypeWithStr ℓ (ApartnessStr ℓ')
+
+apartness : (A : Type ℓ) (_#_ : A → A → Type ℓ') (h : IsApartness _#_) → Apartness ℓ ℓ'
+apartness A _#_ h = A , apartnessstr _#_ h
+
+record IsApartnessEquiv {A : Type ℓ₀} {B : Type ℓ₁}
+  (M : ApartnessStr ℓ₀' A) (e : A ≃ B) (N : ApartnessStr ℓ₁' B)
+  : Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') ℓ₁')
+  where
+  constructor
+   isapartnessequiv
+  -- Shorter qualified names
+  private
+    module M = ApartnessStr M
+    module N = ApartnessStr N
+
+  field
+    pres# : (x y : A) → x M.# y ≃ equivFun e x N.# equivFun e y
+
+
+ApartnessEquiv : (M : Apartness ℓ₀ ℓ₀') (M : Apartness ℓ₁ ℓ₁') → Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') (ℓ-max ℓ₁ ℓ₁'))
+ApartnessEquiv M N = Σ[ e ∈ ⟨ M ⟩ ≃ ⟨ N ⟩ ] IsApartnessEquiv (M .snd) e (N .snd)
+
+isPropIsApartness : {A : Type ℓ} (_#_ : A → A → Type ℓ') → isProp (IsApartness _#_)
+isPropIsApartness _#_ = isOfHLevelRetractFromIso 1 IsApartnessIsoΣ
+  (isPropΣ isPropIsSet
+    λ isSetA → isPropΣ (isPropΠ2 (λ _ _ → isPropIsProp))
+      λ isPropValued# → isProp×2
+                        (isPropΠ λ _ → isProp¬ _)
+                        (isPropΠ4 λ _ _ _ _ → squash₁)
+                        (isPropΠ3 λ _ _ _ → isPropValued# _ _))
+
+𝒮ᴰ-Apartness : DUARel (𝒮-Univ ℓ) (ApartnessStr ℓ') (ℓ-max ℓ ℓ')
+𝒮ᴰ-Apartness =
+  𝒮ᴰ-Record (𝒮-Univ _) IsApartnessEquiv
+    (fields:
+      data[ _#_ ∣ autoDUARel _ _ ∣ pres# ]
+      prop[ isApartness ∣ (λ _ _ → isPropIsApartness _) ])
+    where
+    open ApartnessStr
+    open IsApartness
+    open IsApartnessEquiv
+
+ApartnessPath : (M N : Apartness ℓ ℓ') → ApartnessEquiv M N ≃ (M ≡ N)
+ApartnessPath = ∫ 𝒮ᴰ-Apartness .UARel.ua
+
+-- an easier way of establishing an equivalence of apartness relations
+module _ {P : Apartness ℓ₀ ℓ₀'} {S : Apartness ℓ₁ ℓ₁'} (e : ⟨ P ⟩ ≃ ⟨ S ⟩) where
+  private
+    module P = ApartnessStr (P .snd)
+    module S = ApartnessStr (S .snd)
+
+  module _ (isMon : ∀ x y → x P.# y → equivFun e x S.# equivFun e y)
+           (isMonInv : ∀ x y → x S.# y → invEq e x P.# invEq e y) where
+    open IsApartnessEquiv
+    open IsApartness
+
+    makeIsApartnessEquiv : IsApartnessEquiv (P .snd) e (S .snd)
+    pres# makeIsApartnessEquiv x y = propBiimpl→Equiv (P.isApartness .is-prop-valued _ _)
+                                                      (S.isApartness .is-prop-valued _ _)
+                                                      (isMon _ _) (isMonInv' _ _)
+      where
+      isMonInv' : ∀ x y → equivFun e x S.# equivFun e y → x P.# y
+      isMonInv' x y ex#ey = transport (λ i → retEq e x i P.# retEq e y i) (isMonInv _ _ ex#ey)
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Apartness.Properties.html b/Cubical.Relation.Binary.Order.Apartness.Properties.html new file mode 100644 index 0000000000..01d7ed94c5 --- /dev/null +++ b/Cubical.Relation.Binary.Order.Apartness.Properties.html @@ -0,0 +1,55 @@ + +Cubical.Relation.Binary.Order.Apartness.Properties
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Apartness.Properties where
+
+open import Cubical.Foundations.Prelude
+
+open import Cubical.Functions.Embedding
+
+open import Cubical.Data.Empty as ⊥
+open import Cubical.Data.Sum as ⊎
+
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Binary.Order.Apartness.Base
+
+open import Cubical.HITs.PropositionalTruncation as ∥₁
+
+open import Cubical.Relation.Nullary
+
+private
+  variable
+    ℓ ℓ' ℓ'' : Level
+
+open BinaryRelation
+
+isApartness→ImpliesInequality : {A : Type ℓ} {_#_ : Rel A A ℓ'}
+                              → IsApartness _#_ → ∀ x y → x # y → ¬ (x ≡ y)
+isApartness→ImpliesInequality {_#_ = _#_} apart x y x#y x≡y
+  = IsApartness.is-irrefl apart y (subst (λ a → a # y) x≡y x#y)
+
+isApartness→isEquivRelNegationRel : {A : Type ℓ} {_#_ : Rel A A ℓ'}
+                                  → IsApartness _#_ → isEquivRel (NegationRel _#_)
+isApartness→isEquivRelNegationRel apart
+  = equivRel (λ a a#a → IsApartness.is-irrefl apart a a#a)
+                        (λ a b ¬a#b b#a → ¬a#b (IsApartness.is-sym apart b a b#a))
+                         λ a b c ¬a#b ¬b#c a#c
+                           → ∥₁.rec isProp⊥ (⊎.rec ¬a#b
+                                    (λ c#b → ¬b#c (IsApartness.is-sym apart c b c#b)))
+                                    (IsApartness.is-cotrans apart a c b a#c)
+
+module _
+  {A : Type ℓ}
+  {R : Rel A A ℓ'}
+  where
+
+  open BinaryRelation
+
+  isApartnessInduced : IsApartness R → (B : Type ℓ'') → (f : B ↪ A)
+                     → IsApartness (InducedRelation R (B , f))
+  isApartnessInduced apa B (f , emb)
+    = isapartness (Embedding-into-isSet→isSet (f , emb) (IsApartness.is-set apa))
+                  (λ a b → IsApartness.is-prop-valued apa (f a) (f b))
+                  (λ a → IsApartness.is-irrefl apa (f a))
+                  (λ a b c → IsApartness.is-cotrans apa (f a) (f b) (f c))
+                  λ a b → IsApartness.is-sym apa (f a) (f b)
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Apartness.html b/Cubical.Relation.Binary.Order.Apartness.html new file mode 100644 index 0000000000..6534ae17d9 --- /dev/null +++ b/Cubical.Relation.Binary.Order.Apartness.html @@ -0,0 +1,7 @@ + +Cubical.Relation.Binary.Order.Apartness
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Apartness where
+
+open import Cubical.Relation.Binary.Order.Apartness.Base public
+open import Cubical.Relation.Binary.Order.Apartness.Properties public
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Loset.Base.html b/Cubical.Relation.Binary.Order.Loset.Base.html new file mode 100644 index 0000000000..f7931e6c9a --- /dev/null +++ b/Cubical.Relation.Binary.Order.Loset.Base.html @@ -0,0 +1,136 @@ + +Cubical.Relation.Binary.Order.Loset.Base
{-# OPTIONS --safe #-}
+{-
+  Losets are linearly-ordered sets,
+  i.e. strict posets that are also weakly linear
+  and connected, or more plainly a strict poset
+  where every element can be compared
+-}
+module Cubical.Relation.Binary.Order.Loset.Base where
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.Equiv
+open import Cubical.Foundations.HLevels
+open import Cubical.Foundations.Isomorphism
+open import Cubical.Foundations.Univalence
+open import Cubical.Foundations.Transport
+open import Cubical.Foundations.SIP
+
+open import Cubical.Data.Sigma
+
+open import Cubical.HITs.PropositionalTruncation
+
+open import Cubical.Reflection.RecordEquiv
+open import Cubical.Reflection.StrictEquiv
+
+open import Cubical.Displayed.Base
+open import Cubical.Displayed.Auto
+open import Cubical.Displayed.Record
+open import Cubical.Displayed.Universe
+
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Nullary.Properties
+
+open Iso
+open BinaryRelation
+
+
+private
+  variable
+    ℓ ℓ' ℓ'' ℓ₀ ℓ₀' ℓ₁ ℓ₁' : Level
+
+record IsLoset {A : Type ℓ} (_<_ : A → A → Type ℓ') : Type (ℓ-max ℓ ℓ') where
+  no-eta-equality
+  constructor isloset
+
+  field
+    is-set : isSet A
+    is-prop-valued : isPropValued _<_
+    is-irrefl : isIrrefl _<_
+    is-trans : isTrans _<_
+    is-asym : isAsym _<_
+    is-weakly-linear : isWeaklyLinear _<_
+    is-connected : isConnected _<_
+
+unquoteDecl IsLosetIsoΣ = declareRecordIsoΣ IsLosetIsoΣ (quote IsLoset)
+
+
+record LosetStr (ℓ' : Level) (A : Type ℓ) : Type (ℓ-max ℓ (ℓ-suc ℓ')) where
+
+  constructor losetstr
+
+  field
+    _<_     : A → A → Type ℓ'
+    isLoset : IsLoset _<_
+
+  infixl 7 _<_
+
+  open IsLoset isLoset public
+
+Loset : ∀ ℓ ℓ' → Type (ℓ-max (ℓ-suc ℓ) (ℓ-suc ℓ'))
+Loset ℓ ℓ' = TypeWithStr ℓ (LosetStr ℓ')
+
+loset : (A : Type ℓ) (_<_ : A → A → Type ℓ') (h : IsLoset _<_) → Loset ℓ ℓ'
+loset A _<_ h = A , losetstr _<_ h
+
+record IsLosetEquiv {A : Type ℓ₀} {B : Type ℓ₁}
+  (M : LosetStr ℓ₀' A) (e : A ≃ B) (N : LosetStr ℓ₁' B)
+  : Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') ℓ₁')
+  where
+  constructor
+   islosetequiv
+  -- Shorter qualified names
+  private
+    module M = LosetStr M
+    module N = LosetStr N
+
+  field
+    pres< : (x y : A) → x M.< y ≃ equivFun e x N.< equivFun e y
+
+
+LosetEquiv : (M : Loset ℓ₀ ℓ₀') (M : Loset ℓ₁ ℓ₁') → Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') (ℓ-max ℓ₁ ℓ₁'))
+LosetEquiv M N = Σ[ e ∈ ⟨ M ⟩ ≃ ⟨ N ⟩ ] IsLosetEquiv (M .snd) e (N .snd)
+
+isPropIsLoset : {A : Type ℓ} (_<_ : A → A → Type ℓ') → isProp (IsLoset _<_)
+isPropIsLoset _<_ = isOfHLevelRetractFromIso 1 IsLosetIsoΣ
+  (isPropΣ isPropIsSet
+    λ isSetA → isPropΣ (isPropΠ2 (λ _ _ → isPropIsProp))
+      λ isPropValued< → isProp×4 (isPropΠ (λ x → isProp¬ (x < x)))
+                                 (isPropΠ5 (λ _ _ _ _ _ → isPropValued< _ _))
+                                 (isPropΠ3 (λ x y _ → isProp¬ (y < x)))
+                                 (isPropΠ4 λ _ _ _ _ → squash₁)
+                                 (isPropΠ3 λ _ _ _ → squash₁))
+
+𝒮ᴰ-Loset : DUARel (𝒮-Univ ℓ) (LosetStr ℓ') (ℓ-max ℓ ℓ')
+𝒮ᴰ-Loset =
+  𝒮ᴰ-Record (𝒮-Univ _) IsLosetEquiv
+    (fields:
+      data[ _<_ ∣ autoDUARel _ _ ∣ pres< ]
+      prop[ isLoset ∣ (λ _ _ → isPropIsLoset _) ])
+    where
+    open LosetStr
+    open IsLoset
+    open IsLosetEquiv
+
+LosetPath : (M N : Loset ℓ ℓ') → LosetEquiv M N ≃ (M ≡ N)
+LosetPath = ∫ 𝒮ᴰ-Loset .UARel.ua
+
+-- an easier way of establishing an equivalence of losets
+module _ {P : Loset ℓ₀ ℓ₀'} {S : Loset ℓ₁ ℓ₁'} (e : ⟨ P ⟩ ≃ ⟨ S ⟩) where
+  private
+    module P = LosetStr (P .snd)
+    module S = LosetStr (S .snd)
+
+  module _ (isMon : ∀ x y → x P.< y → equivFun e x S.< equivFun e y)
+           (isMonInv : ∀ x y → x S.< y → invEq e x P.< invEq e y) where
+    open IsLosetEquiv
+    open IsLoset
+
+    makeIsLosetEquiv : IsLosetEquiv (P .snd) e (S .snd)
+    pres< makeIsLosetEquiv x y = propBiimpl→Equiv (P.isLoset .is-prop-valued _ _)
+                                                  (S.isLoset .is-prop-valued _ _)
+                                                  (isMon _ _) (isMonInv' _ _)
+      where
+      isMonInv' : ∀ x y → equivFun e x S.< equivFun e y → x P.< y
+      isMonInv' x y ex<ey = transport (λ i → retEq e x i P.< retEq e y i) (isMonInv _ _ ex<ey)
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Loset.Properties.html b/Cubical.Relation.Binary.Order.Loset.Properties.html new file mode 100644 index 0000000000..43f5db2526 --- /dev/null +++ b/Cubical.Relation.Binary.Order.Loset.Properties.html @@ -0,0 +1,93 @@ + +Cubical.Relation.Binary.Order.Loset.Properties
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Loset.Properties where
+
+open import Cubical.Data.Sum as ⊎
+open import Cubical.Data.Empty as ⊥
+
+open import Cubical.Foundations.Prelude
+
+open import Cubical.Functions.Embedding
+
+open import Cubical.HITs.PropositionalTruncation as ∥₁
+
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Binary.Order.Apartness.Base
+open import Cubical.Relation.Binary.Order.Toset.Base
+open import Cubical.Relation.Binary.Order.StrictPoset.Base
+open import Cubical.Relation.Binary.Order.Loset.Base
+
+open import Cubical.Relation.Nullary
+
+private
+  variable
+    ℓ ℓ' ℓ'' : Level
+
+module _
+  {A : Type ℓ}
+  {R : Rel A A ℓ'}
+  where
+
+  open BinaryRelation
+
+  isLoset→isStrictPoset : IsLoset R → IsStrictPoset R
+  isLoset→isStrictPoset loset = isstrictposet
+                                (IsLoset.is-set loset)
+                                (IsLoset.is-prop-valued loset)
+                                (IsLoset.is-irrefl loset)
+                                (IsLoset.is-trans loset)
+                                (IsLoset.is-asym loset)
+
+  private
+    transrefl : isTrans R → isTrans (ReflClosure R)
+    transrefl trans a b c (inl Rab) (inl Rbc) = inl (trans a b c Rab Rbc)
+    transrefl trans a b c (inl Rab) (inr b≡c) = inl (subst (R a) b≡c Rab)
+    transrefl trans a b c (inr a≡b) (inl Rbc) = inl (subst (λ z → R z c) (sym a≡b) Rbc)
+    transrefl trans a b c (inr a≡b) (inr b≡c) = inr (a≡b ∙ b≡c)
+
+    antisym : isIrrefl R → isTrans R → isAntisym (ReflClosure R)
+    antisym irr trans a b (inl Rab) (inl Rba) = ⊥.rec (irr a (trans a b a Rab Rba))
+    antisym irr trans a b (inl _) (inr b≡a) = sym b≡a
+    antisym irr trans a b (inr a≡b) _ = a≡b
+
+  isLoset→isTosetReflClosure : Discrete A → IsLoset R → IsToset (ReflClosure R)
+  isLoset→isTosetReflClosure disc loset
+    = istoset (IsLoset.is-set loset)
+              (λ a b → isProp⊎ (IsLoset.is-prop-valued loset a b)
+                               (IsLoset.is-set loset a b)
+                               λ Rab a≡b
+                                 → IsLoset.is-irrefl loset a (subst (R a)
+                                                             (sym a≡b) Rab))
+              (isReflReflClosure R)
+              (transrefl (IsLoset.is-trans loset))
+              (antisym (IsLoset.is-irrefl loset)
+                       (IsLoset.is-trans loset))
+              λ a b → decRec (λ a≡b → ∣ inl (inr a≡b) ∣₁)
+                             (λ ¬a≡b → ∥₁.map (⊎.map (λ Rab → inl Rab) λ Rba → inl Rba)
+                             (IsLoset.is-connected loset a b ¬a≡b)) (disc a b)
+
+  isLosetInduced : IsLoset R → (B : Type ℓ'') → (f : B ↪ A)
+                 → IsLoset (InducedRelation R (B , f))
+  isLosetInduced los B (f , emb)
+    = isloset (Embedding-into-isSet→isSet (f , emb) (IsLoset.is-set los))
+              (λ a b → IsLoset.is-prop-valued los (f a) (f b))
+              (λ a → IsLoset.is-irrefl los (f a))
+              (λ a b c → IsLoset.is-trans los (f a) (f b) (f c))
+              (λ a b → IsLoset.is-asym los (f a) (f b))
+              (λ a b c → IsLoset.is-weakly-linear los (f a) (f b) (f c))
+              λ a b ¬a≡b → IsLoset.is-connected los (f a) (f b)
+                λ fa≡fb → ¬a≡b (isEmbedding→Inj emb a b fa≡fb)
+
+Loset→StrictPoset : Loset ℓ ℓ' → StrictPoset ℓ ℓ'
+Loset→StrictPoset (_ , los)
+  = _ , strictposetstr (LosetStr._<_ los)
+                       (isLoset→isStrictPoset (LosetStr.isLoset los))
+
+Loset→Toset : (los : Loset ℓ ℓ')
+            → Discrete (fst los)
+            → Toset ℓ (ℓ-max ℓ ℓ')
+Loset→Toset (_ , los) disc
+  = _ , tosetstr (BinaryRelation.ReflClosure (LosetStr._<_ los))
+                 (isLoset→isTosetReflClosure disc
+                                             (LosetStr.isLoset los))
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Loset.html b/Cubical.Relation.Binary.Order.Loset.html new file mode 100644 index 0000000000..7ed5961abf --- /dev/null +++ b/Cubical.Relation.Binary.Order.Loset.html @@ -0,0 +1,7 @@ + +Cubical.Relation.Binary.Order.Loset
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Loset where
+
+open import Cubical.Relation.Binary.Order.Loset.Base public
+open import Cubical.Relation.Binary.Order.Loset.Properties public
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Poset.Base.html b/Cubical.Relation.Binary.Order.Poset.Base.html new file mode 100644 index 0000000000..2a5ed3e0af --- /dev/null +++ b/Cubical.Relation.Binary.Order.Poset.Base.html @@ -0,0 +1,140 @@ + +Cubical.Relation.Binary.Order.Poset.Base
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Poset.Base where
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.Equiv
+open import Cubical.Foundations.Equiv.HalfAdjoint
+open import Cubical.Foundations.HLevels
+open import Cubical.Foundations.Isomorphism
+open import Cubical.Foundations.Univalence
+open import Cubical.Foundations.Transport
+open import Cubical.Foundations.SIP
+
+open import Cubical.Data.Sigma
+
+open import Cubical.Reflection.RecordEquiv
+open import Cubical.Reflection.StrictEquiv
+
+open import Cubical.Displayed.Base
+open import Cubical.Displayed.Auto
+open import Cubical.Displayed.Record
+open import Cubical.Displayed.Universe
+
+open import Cubical.Relation.Binary.Base
+
+open Iso
+open BinaryRelation
+
+
+private
+  variable
+    ℓ ℓ' ℓ'' ℓ₀ ℓ₀' ℓ₁ ℓ₁' : Level
+
+record IsPoset {A : Type ℓ} (_≤_ : A → A → Type ℓ') : Type (ℓ-max ℓ ℓ') where
+  no-eta-equality
+  constructor isposet
+
+  field
+    is-set : isSet A
+    is-prop-valued : isPropValued _≤_
+    is-refl : isRefl _≤_
+    is-trans : isTrans _≤_
+    is-antisym : isAntisym _≤_
+
+unquoteDecl IsPosetIsoΣ = declareRecordIsoΣ IsPosetIsoΣ (quote IsPoset)
+
+
+record PosetStr (ℓ' : Level) (A : Type ℓ) : Type (ℓ-max ℓ (ℓ-suc ℓ')) where
+
+  constructor posetstr
+
+  field
+    _≤_     : A → A → Type ℓ'
+    isPoset : IsPoset _≤_
+
+  infixl 7 _≤_
+
+  open IsPoset isPoset public
+
+Poset : ∀ ℓ ℓ' → Type (ℓ-max (ℓ-suc ℓ) (ℓ-suc ℓ'))
+Poset ℓ ℓ' = TypeWithStr ℓ (PosetStr ℓ')
+
+poset : (A : Type ℓ) (_≤_ : A → A → Type ℓ') (h : IsPoset _≤_) → Poset ℓ ℓ'
+poset A _≤_ h = A , posetstr _≤_ h
+
+record IsPosetEquiv {A : Type ℓ₀} {B : Type ℓ₁}
+  (M : PosetStr ℓ₀' A) (e : A ≃ B) (N : PosetStr ℓ₁' B)
+  : Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') ℓ₁')
+  where
+  constructor
+   isposetequiv
+  -- Shorter qualified names
+  private
+    module M = PosetStr M
+    module N = PosetStr N
+
+  field
+    pres≤ : (x y : A) → x M.≤ y ≃ equivFun e x N.≤ equivFun e y
+
+
+PosetEquiv : (M : Poset ℓ₀ ℓ₀') (M : Poset ℓ₁ ℓ₁') → Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') (ℓ-max ℓ₁ ℓ₁'))
+PosetEquiv M N = Σ[ e ∈ ⟨ M ⟩ ≃ ⟨ N ⟩ ] IsPosetEquiv (M .snd) e (N .snd)
+
+isPropIsPoset : {A : Type ℓ} (_≤_ : A → A → Type ℓ') → isProp (IsPoset _≤_)
+isPropIsPoset _≤_ = isOfHLevelRetractFromIso 1 IsPosetIsoΣ
+  (isPropΣ isPropIsSet
+    λ isSetA → isPropΣ (isPropΠ2 (λ _ _ → isPropIsProp))
+      λ isPropValued≤ → isProp×2
+                         (isPropΠ (λ _ → isPropValued≤ _ _))
+                           (isPropΠ5 λ _ _ _ _ _ → isPropValued≤ _ _)
+                             (isPropΠ4 λ _ _ _ _ → isSetA _ _))
+
+𝒮ᴰ-Poset : DUARel (𝒮-Univ ℓ) (PosetStr ℓ') (ℓ-max ℓ ℓ')
+𝒮ᴰ-Poset =
+  𝒮ᴰ-Record (𝒮-Univ _) IsPosetEquiv
+    (fields:
+      data[ _≤_ ∣ autoDUARel _ _ ∣ pres≤ ]
+      prop[ isPoset ∣ (λ _ _ → isPropIsPoset _) ])
+    where
+    open PosetStr
+    open IsPoset
+    open IsPosetEquiv
+
+PosetPath : (M N : Poset ℓ ℓ') → PosetEquiv M N ≃ (M ≡ N)
+PosetPath = ∫ 𝒮ᴰ-Poset .UARel.ua
+
+-- an easier way of establishing an equivalence of posets
+module _ {P : Poset ℓ₀ ℓ₀'} {S : Poset ℓ₁ ℓ₁'} (e : ⟨ P ⟩ ≃ ⟨ S ⟩) where
+  private
+    module P = PosetStr (P .snd)
+    module S = PosetStr (S .snd)
+
+  module _ (isMon : ∀ x y → x P.≤ y → equivFun e x S.≤ equivFun e y)
+           (isMonInv : ∀ x y → x S.≤ y → invEq e x P.≤ invEq e y) where
+    open IsPosetEquiv
+    open IsPoset
+
+    makeIsPosetEquiv : IsPosetEquiv (P .snd) e (S .snd)
+    pres≤ makeIsPosetEquiv x y = propBiimpl→Equiv (P.isPoset .is-prop-valued _ _)
+                                                  (S.isPoset .is-prop-valued _ _)
+                                                  (isMon _ _) (isMonInv' _ _)
+      where
+      isMonInv' : ∀ x y → equivFun e x S.≤ equivFun e y → x P.≤ y
+      isMonInv' x y ex≤ey = transport (λ i → retEq e x i P.≤ retEq e y i) (isMonInv _ _ ex≤ey)
+
+
+module PosetReasoning (P' : Poset ℓ ℓ') where
+ private P = fst P'
+ open PosetStr (snd P')
+ open IsPoset
+
+ _≤⟨_⟩_ : (x : P) {y z : P} → x ≤ y → y ≤ z → x ≤ z
+ x ≤⟨ p ⟩ q = isPoset .is-trans x _ _ p q
+
+ _◾ : (x : P) → x ≤ x
+ x ◾ = isPoset .is-refl x
+
+ infixr 0 _≤⟨_⟩_
+ infix  1 _◾
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Poset.Properties.html b/Cubical.Relation.Binary.Order.Poset.Properties.html new file mode 100644 index 0000000000..8cb46b0626 --- /dev/null +++ b/Cubical.Relation.Binary.Order.Poset.Properties.html @@ -0,0 +1,73 @@ + +Cubical.Relation.Binary.Order.Poset.Properties
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Poset.Properties where
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.HLevels
+
+open import Cubical.Functions.Embedding
+
+open import Cubical.HITs.PropositionalTruncation as ∥₁
+
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Binary.Order.Poset.Base
+open import Cubical.Relation.Binary.Order.Preorder.Base
+open import Cubical.Relation.Binary.Order.StrictPoset.Base
+
+open import Cubical.Relation.Nullary
+
+private
+  variable
+    ℓ ℓ' ℓ'' : Level
+
+module _
+  {A : Type ℓ}
+  {R : Rel A A ℓ'}
+  where
+
+  open BinaryRelation
+
+  isPoset→isPreorder : IsPoset R → IsPreorder R
+  isPoset→isPreorder poset = ispreorder
+                             (IsPoset.is-set poset)
+                             (IsPoset.is-prop-valued poset)
+                             (IsPoset.is-refl poset)
+                             (IsPoset.is-trans poset)
+
+  private
+    transirrefl : isTrans R → isAntisym R → isTrans (IrreflKernel R)
+    transirrefl trans anti a b c (Rab , ¬a≡b) (Rbc , ¬b≡c)
+      = trans a b c Rab Rbc
+      , λ a≡c → ¬a≡b (anti a b Rab (subst (R b) (sym a≡c) Rbc))
+
+  isPoset→isStrictPosetIrreflKernel : IsPoset R → IsStrictPoset (IrreflKernel R)
+  isPoset→isStrictPosetIrreflKernel poset
+    = isstrictposet (IsPoset.is-set poset)
+                    (λ a b → isProp× (IsPoset.is-prop-valued poset a b)
+                                     (isProp¬ (a ≡ b)))
+                    (isIrreflIrreflKernel R)
+                    (transirrefl (IsPoset.is-trans poset)
+                                 (IsPoset.is-antisym poset))
+                    (isIrrefl×isTrans→isAsym (IrreflKernel R)
+                                             (isIrreflIrreflKernel R
+                                             , transirrefl (IsPoset.is-trans poset)
+                                                           (IsPoset.is-antisym poset)))
+
+  isPosetInduced : IsPoset R → (B : Type ℓ'') → (f : B ↪ A) → IsPoset (InducedRelation R (B , f))
+  isPosetInduced pos B (f , emb)
+    = isposet (Embedding-into-isSet→isSet (f , emb) (IsPoset.is-set pos))
+              (λ a b → IsPoset.is-prop-valued pos (f a) (f b))
+              (λ a → IsPoset.is-refl pos (f a))
+              (λ a b c → IsPoset.is-trans pos (f a) (f b) (f c))
+              λ a b a≤b b≤a → isEmbedding→Inj emb a b
+                (IsPoset.is-antisym pos (f a) (f b) a≤b b≤a)
+
+Poset→Preorder : Poset ℓ ℓ' → Preorder ℓ ℓ'
+Poset→Preorder (_ , pos) = _ , preorderstr (PosetStr._≤_ pos)
+                                           (isPoset→isPreorder (PosetStr.isPoset pos))
+
+Poset→StrictPoset : Poset ℓ ℓ' → StrictPoset ℓ (ℓ-max ℓ ℓ')
+Poset→StrictPoset (_ , pos)
+  = _ , strictposetstr (BinaryRelation.IrreflKernel (PosetStr._≤_ pos))
+                       (isPoset→isStrictPosetIrreflKernel (PosetStr.isPoset pos))
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Poset.html b/Cubical.Relation.Binary.Order.Poset.html new file mode 100644 index 0000000000..d6a6430fd3 --- /dev/null +++ b/Cubical.Relation.Binary.Order.Poset.html @@ -0,0 +1,7 @@ + +Cubical.Relation.Binary.Order.Poset
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Poset where
+
+open import Cubical.Relation.Binary.Order.Poset.Base public
+open import Cubical.Relation.Binary.Order.Poset.Properties public
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Preorder.Base.html b/Cubical.Relation.Binary.Order.Preorder.Base.html new file mode 100644 index 0000000000..19787a0aea --- /dev/null +++ b/Cubical.Relation.Binary.Order.Preorder.Base.html @@ -0,0 +1,137 @@ + +Cubical.Relation.Binary.Order.Preorder.Base
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Preorder.Base where
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.Equiv
+open import Cubical.Foundations.HLevels
+open import Cubical.Foundations.Isomorphism
+open import Cubical.Foundations.Univalence
+open import Cubical.Foundations.Transport
+open import Cubical.Foundations.SIP
+
+open import Cubical.Data.Sigma
+
+open import Cubical.Reflection.RecordEquiv
+open import Cubical.Reflection.StrictEquiv
+
+open import Cubical.Displayed.Base
+open import Cubical.Displayed.Auto
+open import Cubical.Displayed.Record
+open import Cubical.Displayed.Universe
+
+open import Cubical.Relation.Binary.Base
+
+open Iso
+open BinaryRelation
+
+
+private
+  variable
+    ℓ ℓ' ℓ'' ℓ₀ ℓ₀' ℓ₁ ℓ₁' : Level
+
+record IsPreorder {A : Type ℓ} (_≲_ : A → A → Type ℓ') : Type (ℓ-max ℓ ℓ') where
+  no-eta-equality
+  constructor ispreorder
+
+  field
+    is-set : isSet A
+    is-prop-valued : isPropValued _≲_
+    is-refl : isRefl _≲_
+    is-trans : isTrans _≲_
+
+unquoteDecl IsPreorderIsoΣ = declareRecordIsoΣ IsPreorderIsoΣ (quote IsPreorder)
+
+
+record PreorderStr (ℓ' : Level) (A : Type ℓ) : Type (ℓ-max ℓ (ℓ-suc ℓ')) where
+
+  constructor preorderstr
+
+  field
+    _≲_     : A → A → Type ℓ'
+    isPreorder : IsPreorder _≲_
+
+  infixl 7 _≲_
+
+  open IsPreorder isPreorder public
+
+Preorder : ∀ ℓ ℓ' → Type (ℓ-max (ℓ-suc ℓ) (ℓ-suc ℓ'))
+Preorder ℓ ℓ' = TypeWithStr ℓ (PreorderStr ℓ')
+
+preorder : (A : Type ℓ) (_≲_ : A → A → Type ℓ') (h : IsPreorder _≲_) → Preorder ℓ ℓ'
+preorder A _≲_ h = A , preorderstr _≲_ h
+
+record IsPreorderEquiv {A : Type ℓ₀} {B : Type ℓ₁}
+  (M : PreorderStr ℓ₀' A) (e : A ≃ B) (N : PreorderStr ℓ₁' B)
+  : Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') ℓ₁')
+  where
+  constructor
+   ispreorderequiv
+  -- Shorter qualified names
+  private
+    module M = PreorderStr M
+    module N = PreorderStr N
+
+  field
+    pres≲ : (x y : A) → x M.≲ y ≃ equivFun e x N.≲ equivFun e y
+
+
+PreorderEquiv : (M : Preorder ℓ₀ ℓ₀') (M : Preorder ℓ₁ ℓ₁') → Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') (ℓ-max ℓ₁ ℓ₁'))
+PreorderEquiv M N = Σ[ e ∈ ⟨ M ⟩ ≃ ⟨ N ⟩ ] IsPreorderEquiv (M .snd) e (N .snd)
+
+isPropIsPreorder : {A : Type ℓ} (_≲_ : A → A → Type ℓ') → isProp (IsPreorder _≲_)
+isPropIsPreorder _≲_ = isOfHLevelRetractFromIso 1 IsPreorderIsoΣ
+  (isPropΣ isPropIsSet
+    λ isSetA → isPropΣ (isPropΠ2 (λ _ _ → isPropIsProp))
+      λ isPropValued≲ → isProp×
+                        (isPropΠ (λ _ → isPropValued≲ _ _))
+                        (isPropΠ4 λ _ _ _ _ → isPropΠ λ _ → isPropValued≲ _ _))
+
+𝒮ᴰ-Preorder : DUARel (𝒮-Univ ℓ) (PreorderStr ℓ') (ℓ-max ℓ ℓ')
+𝒮ᴰ-Preorder =
+  𝒮ᴰ-Record (𝒮-Univ _) IsPreorderEquiv
+    (fields:
+      data[ _≲_ ∣ autoDUARel _ _ ∣ pres≲ ]
+      prop[ isPreorder ∣ (λ _ _ → isPropIsPreorder _) ])
+    where
+    open PreorderStr
+    open IsPreorder
+    open IsPreorderEquiv
+
+PreorderPath : (M N : Preorder ℓ ℓ') → PreorderEquiv M N ≃ (M ≡ N)
+PreorderPath = ∫ 𝒮ᴰ-Preorder .UARel.ua
+
+-- an easier way of establishing an equivalence of preorders
+module _ {P : Preorder ℓ₀ ℓ₀'} {S : Preorder ℓ₁ ℓ₁'} (e : ⟨ P ⟩ ≃ ⟨ S ⟩) where
+  private
+    module P = PreorderStr (P .snd)
+    module S = PreorderStr (S .snd)
+
+  module _ (isMon : ∀ x y → x P.≲ y → equivFun e x S.≲ equivFun e y)
+           (isMonInv : ∀ x y → x S.≲ y → invEq e x P.≲ invEq e y) where
+    open IsPreorderEquiv
+    open IsPreorder
+
+    makeIsPreorderEquiv : IsPreorderEquiv (P .snd) e (S .snd)
+    pres≲ makeIsPreorderEquiv x y = propBiimpl→Equiv (P.isPreorder .is-prop-valued _ _)
+                                                  (S.isPreorder .is-prop-valued _ _)
+                                                  (isMon _ _) (isMonInv' _ _)
+      where
+      isMonInv' : ∀ x y → equivFun e x S.≲ equivFun e y → x P.≲ y
+      isMonInv' x y ex≲ey = transport (λ i → retEq e x i P.≲ retEq e y i) (isMonInv _ _ ex≲ey)
+
+
+module PreorderReasoning (P' : Preorder ℓ ℓ') where
+ private P = fst P'
+ open PreorderStr (snd P')
+ open IsPreorder
+
+ _≲⟨_⟩_ : (x : P) {y z : P} → x ≲ y → y ≲ z → x ≲ z
+ x ≲⟨ p ⟩ q = isPreorder .is-trans x _ _ p q
+
+ _◾ : (x : P) → x ≲ x
+ x ◾ = isPreorder .is-refl x
+
+ infixr 0 _≲⟨_⟩_
+ infix  1 _◾
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Preorder.Properties.html b/Cubical.Relation.Binary.Order.Preorder.Properties.html new file mode 100644 index 0000000000..7e2625a35f --- /dev/null +++ b/Cubical.Relation.Binary.Order.Preorder.Properties.html @@ -0,0 +1,59 @@ + +Cubical.Relation.Binary.Order.Preorder.Properties
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Preorder.Properties where
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.HLevels
+
+open import Cubical.Functions.Embedding
+
+open import Cubical.HITs.PropositionalTruncation as ∥₁
+
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Binary.Order.Preorder.Base
+open import Cubical.Relation.Binary.Order.StrictPoset.Base
+
+open import Cubical.Relation.Nullary
+
+private
+  variable
+    ℓ ℓ' ℓ'' : Level
+
+module _
+  {A : Type ℓ}
+  {R : Rel A A ℓ'}
+  where
+
+  open BinaryRelation
+
+  isPreorder→isEquivRelSymKernel : IsPreorder R → isEquivRel (SymKernel R)
+  isPreorder→isEquivRelSymKernel preorder
+    = equivRel (λ a → (IsPreorder.is-refl preorder a)
+                    , (IsPreorder.is-refl preorder a))
+               (isSymSymKernel R)
+               (λ a b c (Rab , Rba) (Rbc , Rcb)
+                 → IsPreorder.is-trans preorder a b c Rab Rbc
+                 , IsPreorder.is-trans preorder c b a Rcb Rba)
+
+  isPreorder→isStrictPosetAsymKernel : IsPreorder R → IsStrictPoset (AsymKernel R)
+  isPreorder→isStrictPosetAsymKernel preorder
+    = isstrictposet (IsPreorder.is-set preorder)
+                    (λ a b → isProp× (IsPreorder.is-prop-valued preorder a b) (isProp¬ (R b a)))
+                    (λ a (Raa , ¬Raa) → ¬Raa (IsPreorder.is-refl preorder a))
+                    (λ a b c (Rab , ¬Rba) (Rbc , ¬Rcb)
+                      → IsPreorder.is-trans preorder a b c Rab Rbc
+                      , λ Rca → ¬Rcb (IsPreorder.is-trans preorder c a b Rca Rab))
+                    (isAsymAsymKernel R)
+
+  isPreorderInduced : IsPreorder R → (B : Type ℓ'') → (f : B ↪ A) → IsPreorder (InducedRelation R (B , f))
+  isPreorderInduced pre B (f , emb)
+    = ispreorder (Embedding-into-isSet→isSet (f , emb) (IsPreorder.is-set pre))
+                 (λ a b → IsPreorder.is-prop-valued pre (f a) (f b))
+                 (λ a → IsPreorder.is-refl pre (f a))
+                 λ a b c → IsPreorder.is-trans pre (f a) (f b) (f c)
+
+Preorder→StrictPoset : Preorder ℓ ℓ' → StrictPoset ℓ ℓ'
+Preorder→StrictPoset (_ , pre)
+  = _ , strictposetstr (BinaryRelation.AsymKernel (PreorderStr._≲_ pre))
+                       (isPreorder→isStrictPosetAsymKernel (PreorderStr.isPreorder pre))
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Preorder.html b/Cubical.Relation.Binary.Order.Preorder.html new file mode 100644 index 0000000000..3f15a32b3f --- /dev/null +++ b/Cubical.Relation.Binary.Order.Preorder.html @@ -0,0 +1,7 @@ + +Cubical.Relation.Binary.Order.Preorder
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Preorder where
+
+open import Cubical.Relation.Binary.Order.Preorder.Base public
+open import Cubical.Relation.Binary.Order.Preorder.Properties public
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Properties.html b/Cubical.Relation.Binary.Order.Properties.html new file mode 100644 index 0000000000..b0f06faf93 --- /dev/null +++ b/Cubical.Relation.Binary.Order.Properties.html @@ -0,0 +1,304 @@ + +Cubical.Relation.Binary.Order.Properties
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Properties where
+
+open import Cubical.Data.Sigma
+open import Cubical.Data.Sum as ⊎
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.HLevels
+
+open import Cubical.Functions.Embedding
+
+open import Cubical.HITs.PropositionalTruncation as ∥₁
+
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Binary.Order.Poset
+open import Cubical.Relation.Binary.Order.Toset
+open import Cubical.Relation.Binary.Order.Preorder.Base
+
+private
+  variable
+    ℓ ℓ' ℓ'' : Level
+
+module _
+  {A : Type ℓ}
+  {_≲_ : Rel A A ℓ'}
+  (pre : IsPreorder _≲_)
+  where
+
+  private
+      prop : ∀ a b → isProp (a ≲ b)
+      prop = IsPreorder.is-prop-valued pre
+
+  module _
+    (P : Embedding A ℓ'')
+    where
+
+    private
+      subtype : Type ℓ''
+      subtype = fst P
+
+      toA : subtype → A
+      toA = fst (snd P)
+
+    isMinimal : (n : subtype) → Type (ℓ-max ℓ' ℓ'')
+    isMinimal n = (x : subtype) → toA x ≲ toA n → toA n ≲ toA x
+
+    isPropIsMinimal : ∀ n → isProp (isMinimal n)
+    isPropIsMinimal n = isPropΠ2 λ x _ → prop (toA n) (toA x)
+
+    Minimal : Type (ℓ-max ℓ' ℓ'')
+    Minimal = Σ[ n ∈ subtype ] isMinimal n
+
+    isMaximal : (n : subtype) → Type (ℓ-max ℓ' ℓ'')
+    isMaximal n = (x : subtype) → toA n ≲ toA x → toA x ≲ toA n
+
+    isPropIsMaximal : ∀ n → isProp (isMaximal n)
+    isPropIsMaximal n = isPropΠ2 λ x _ → prop (toA x) (toA n)
+
+    Maximal : Type (ℓ-max ℓ' ℓ'')
+    Maximal = Σ[ n ∈ subtype ] isMaximal n
+
+    isLeast : (n : subtype) → Type (ℓ-max ℓ' ℓ'')
+    isLeast n = (x : subtype) → toA n ≲ toA x
+
+    isPropIsLeast : ∀ n → isProp (isLeast n)
+    isPropIsLeast n = isPropΠ λ x → prop (toA n) (toA x)
+
+    Least : Type (ℓ-max ℓ' ℓ'')
+    Least = Σ[ n ∈ subtype ] isLeast n
+
+    isGreatest : (n : subtype) → Type (ℓ-max ℓ' ℓ'')
+    isGreatest n = (x : subtype) → toA x ≲ toA n
+
+    isPropIsGreatest : ∀ n → isProp (isGreatest n)
+    isPropIsGreatest n = isPropΠ λ x → prop (toA x) (toA n)
+
+    Greatest : Type (ℓ-max ℓ' ℓ'')
+    Greatest = Σ[ n ∈ subtype ] isGreatest n
+
+  module _
+    {B : Type ℓ''}
+    (P : B → A)
+    where
+
+    isLowerBound : (n : A) → Type (ℓ-max ℓ' ℓ'')
+    isLowerBound n = (x : B) → n ≲ P x
+
+    isPropIsLowerBound : ∀ n → isProp (isLowerBound n)
+    isPropIsLowerBound n = isPropΠ λ x → prop n (P x)
+
+    LowerBound : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'')
+    LowerBound = Σ[ n ∈ A ] isLowerBound n
+
+    isUpperBound : (n : A) → Type (ℓ-max ℓ' ℓ'')
+    isUpperBound n = (x : B) → P x ≲ n
+
+    isPropIsUpperBound : ∀ n → isProp (isUpperBound n)
+    isPropIsUpperBound n = isPropΠ λ x → prop (P x) n
+
+    UpperBound : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'')
+    UpperBound = Σ[ n ∈ A ] isUpperBound n
+
+  module _
+    {B : Type ℓ''}
+    (P : B → A)
+    where
+
+    isMaximalLowerBound : (n : A) → Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'')
+    isMaximalLowerBound n
+      = Σ[ islb ∈ isLowerBound P n ]
+        isMaximal (LowerBound P
+                  , (EmbeddingΣProp (isPropIsLowerBound P))) (n , islb)
+
+    isPropIsMaximalLowerBound : ∀ n → isProp (isMaximalLowerBound n)
+    isPropIsMaximalLowerBound n
+      = isPropΣ (isPropIsLowerBound P n)
+                λ islb → isPropIsMaximal (LowerBound P
+                       , EmbeddingΣProp (isPropIsLowerBound P)) (n , islb)
+
+    MaximalLowerBound : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'')
+    MaximalLowerBound = Σ[ n ∈ A ] isMaximalLowerBound n
+
+    isMinimalUpperBound : (n : A) → Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'')
+    isMinimalUpperBound n
+      = Σ[ isub ∈ isUpperBound P n ]
+        isMinimal (UpperBound P
+                  , EmbeddingΣProp (isPropIsUpperBound P)) (n , isub)
+
+    isPropIsMinimalUpperBound : ∀ n → isProp (isMinimalUpperBound n)
+    isPropIsMinimalUpperBound n
+      = isPropΣ (isPropIsUpperBound P n)
+                λ isub → isPropIsMinimal (UpperBound P
+                       , EmbeddingΣProp (isPropIsUpperBound P)) (n , isub)
+
+    MinimalUpperBound : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'')
+    MinimalUpperBound = Σ[ n ∈ A ] isMinimalUpperBound n
+
+    isInfimum : (n : A) → Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'')
+    isInfimum n
+      = Σ[ islb ∈ isLowerBound P n ]
+        isGreatest (LowerBound P
+                   , EmbeddingΣProp (isPropIsLowerBound P)) (n , islb)
+
+    isPropIsInfimum : ∀ n → isProp (isInfimum n)
+    isPropIsInfimum n
+      = isPropΣ (isPropIsLowerBound P n)
+                λ islb → isPropIsGreatest (LowerBound P
+                       , EmbeddingΣProp (isPropIsLowerBound P)) (n , islb)
+
+    Infimum : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'')
+    Infimum = Σ[ n ∈ A ] isInfimum n
+
+    isSupremum : (n : A) → Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'')
+    isSupremum n
+      = Σ[ isub ∈ isUpperBound P n ]
+        isLeast (UpperBound P
+                , EmbeddingΣProp (isPropIsUpperBound P)) (n , isub)
+
+    isPropIsSupremum : ∀ n → isProp (isSupremum n)
+    isPropIsSupremum n
+      = isPropΣ (isPropIsUpperBound P n)
+                λ isub → isPropIsLeast (UpperBound P
+                       , EmbeddingΣProp (isPropIsUpperBound P)) (n , isub)
+
+    Supremum : Type (ℓ-max (ℓ-max ℓ ℓ') ℓ'')
+    Supremum = Σ[ n ∈ A ] isSupremum n
+
+module _
+  {A : Type ℓ}
+  {_≲_ : Rel A A ℓ'}
+  (pre : IsPreorder _≲_)
+  where
+
+  module _
+    {P : Embedding A ℓ''}
+    where
+
+    private
+      toA : (fst P) → A
+      toA = fst (snd P)
+
+    isLeast→isMinimal : ∀ n → isLeast pre P n → isMinimal pre P n
+    isLeast→isMinimal _ isl x _ = isl x
+
+    isGreatest→isMaximal : ∀ n → isGreatest pre P n → isMaximal pre P n
+    isGreatest→isMaximal _ isg x _ = isg x
+
+    isLeast→isLowerBound : ∀ n → isLeast pre P n → isLowerBound pre toA (toA n)
+    isLeast→isLowerBound _ isl = isl
+
+    isGreatest→isUpperBound : ∀ n → isGreatest pre P n → isUpperBound pre toA (toA n)
+    isGreatest→isUpperBound _ isg = isg
+
+    isLeast→isInfimum : ∀ n → isLeast pre P n → isInfimum pre toA (toA n)
+    isLeast→isInfimum n isl = (isLeast→isLowerBound n isl) , (λ x → snd x n)
+
+    isGreatest→isSupremum : ∀ n → isGreatest pre P n → isSupremum pre toA (toA n)
+    isGreatest→isSupremum n isg = (isGreatest→isUpperBound n isg) , (λ x → snd x n)
+
+  module _
+    {B : Type ℓ''}
+    {P : B → A}
+    where
+
+    isInfimum→isLowerBound : ∀ n → isInfimum pre P n → isLowerBound pre P n
+    isInfimum→isLowerBound _ = fst
+
+    isSupremum→isUpperBound : ∀ n → isSupremum pre P n → isUpperBound pre P n
+    isSupremum→isUpperBound _ = fst
+
+module _
+  {A : Type ℓ}
+  {_≤_ : Rel A A ℓ'}
+  (pos : IsPoset _≤_)
+  where
+
+  private
+    pre : IsPreorder _≤_
+    pre = isPoset→isPreorder pos
+
+    anti : BinaryRelation.isAntisym _≤_
+    anti = IsPoset.is-antisym pos
+
+  module _
+    {P : Embedding A ℓ''}
+    where
+
+    private
+      toA : (fst P) → A
+      toA = fst (snd P)
+
+      emb : isEmbedding toA
+      emb = snd (snd P)
+
+    isLeast→ContrMinimal : ∀ n → isLeast pre P n  → ∀ m → isMinimal pre P m → n ≡ m
+    isLeast→ContrMinimal n isln m ismm
+      = isEmbedding→Inj emb n m (anti (toA n) (toA m) (isln m) (ismm n (isln m)))
+
+    isGreatest→ContrMaximal : ∀ n → isGreatest pre P n → ∀ m → isMaximal pre P m → n ≡ m
+    isGreatest→ContrMaximal n isgn m ismm
+      = isEmbedding→Inj emb n m (anti (toA n) (toA m) (ismm n (isgn m)) (isgn m))
+
+    isLeastUnique : ∀ n m → isLeast pre P n → isLeast pre P m → n ≡ m
+    isLeastUnique n m isln islm
+      = isEmbedding→Inj emb n m (anti (toA n) (toA m) (isln m) (islm n))
+
+    isGreatestUnique : ∀ n m → isGreatest pre P n → isGreatest pre P m → n ≡ m
+    isGreatestUnique n m isgn isgm
+      = isEmbedding→Inj emb n m (anti (toA n) (toA m) (isgm n) (isgn m))
+
+  module _
+    {B : Type ℓ''}
+    {P : B → A}
+    where
+
+    isInfimum→ContrMaximalLowerBound : ∀ n → isInfimum pre P n
+                                     → ∀ m → isMaximalLowerBound pre P m
+                                     → n ≡ m
+    isInfimum→ContrMaximalLowerBound n (isln , isglbn) m (islm , ismlbm)
+      = anti n m (ismlbm (n , isln) (isglbn (m , islm))) (isglbn (m , islm))
+
+    isSupremum→ContrMinimalUpperBound : ∀ n → isSupremum pre P n
+                                      → ∀ m → isMinimalUpperBound pre P m
+                                      → n ≡ m
+    isSupremum→ContrMinimalUpperBound n (isun , islubn) m (isum , ismubm)
+      = anti n m (islubn (m , isum)) (ismubm (n , isun) (islubn (m , isum)))
+
+    isInfimumUnique : ∀ n m → isInfimum pre P n → isInfimum pre P m → n ≡ m
+    isInfimumUnique n m (isln , infn) (islm , infm)
+      = anti n m (infm (n , isln)) (infn (m , islm))
+
+    isSupremumUnique : ∀ n m → isSupremum pre P n → isSupremum pre P m → n ≡ m
+    isSupremumUnique n m (isun , supn) (isum , supm)
+      = anti n m (supn (m , isum)) (supm (n , isun))
+
+module _
+  {A : Type ℓ}
+  {P : Embedding A ℓ''}
+  {_≤_ : Rel A A ℓ'}
+  (tos : IsToset _≤_)
+  where
+
+  private
+    prop : ∀ a b → isProp (a ≤ b)
+    prop = IsToset.is-prop-valued tos
+
+    conn : BinaryRelation.isStronglyConnected _≤_
+    conn = IsToset.is-strongly-connected tos
+
+    pre : IsPreorder _≤_
+    pre = isPoset→isPreorder (isToset→isPoset tos)
+
+    toA : (fst P) → A
+    toA = fst (snd P)
+
+  isMinimal→isLeast : ∀ n → isMinimal pre P n → isLeast pre P n
+  isMinimal→isLeast n ism m
+    = ∥₁.rec (prop _ _) (⊎.rec (λ n≤m → n≤m) (λ m≤n → ism m m≤n)) (conn (toA n) (toA m))
+
+  isMaximal→isGreatest : ∀ n → isMaximal pre P n → isGreatest pre P n
+  isMaximal→isGreatest n ism m
+    = ∥₁.rec (prop _ _) (⊎.rec (λ n≤m → ism m n≤m) (λ m≤n → m≤n)) (conn (toA n) (toA m))
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.StrictPoset.Base.html b/Cubical.Relation.Binary.Order.StrictPoset.Base.html new file mode 100644 index 0000000000..3169d797e3 --- /dev/null +++ b/Cubical.Relation.Binary.Order.StrictPoset.Base.html @@ -0,0 +1,128 @@ + +Cubical.Relation.Binary.Order.StrictPoset.Base
{-# OPTIONS --safe #-}
+{-
+  Strict posets are posets where the relation is strict,
+  i.e. irreflexive rather than reflexive
+-}
+module Cubical.Relation.Binary.Order.StrictPoset.Base where
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.Equiv
+open import Cubical.Foundations.HLevels
+open import Cubical.Foundations.Isomorphism
+open import Cubical.Foundations.Univalence
+open import Cubical.Foundations.Transport
+open import Cubical.Foundations.SIP
+
+open import Cubical.Data.Sigma
+
+open import Cubical.Reflection.RecordEquiv
+open import Cubical.Reflection.StrictEquiv
+
+open import Cubical.Displayed.Base
+open import Cubical.Displayed.Auto
+open import Cubical.Displayed.Record
+open import Cubical.Displayed.Universe
+
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Nullary.Properties
+
+open Iso
+open BinaryRelation
+
+
+private
+  variable
+    ℓ ℓ' ℓ'' ℓ₀ ℓ₀' ℓ₁ ℓ₁' : Level
+
+record IsStrictPoset {A : Type ℓ} (_<_ : A → A → Type ℓ') : Type (ℓ-max ℓ ℓ') where
+  no-eta-equality
+  constructor isstrictposet
+
+  field
+    is-set : isSet A
+    is-prop-valued : isPropValued _<_
+    is-irrefl : isIrrefl _<_
+    is-trans : isTrans _<_
+    is-asym : isAsym _<_
+
+unquoteDecl IsStrictPosetIsoΣ = declareRecordIsoΣ IsStrictPosetIsoΣ (quote IsStrictPoset)
+
+
+record StrictPosetStr (ℓ' : Level) (A : Type ℓ) : Type (ℓ-max ℓ (ℓ-suc ℓ')) where
+
+  constructor strictposetstr
+
+  field
+    _<_     : A → A → Type ℓ'
+    isStrictPoset : IsStrictPoset _<_
+
+  infixl 7 _<_
+
+  open IsStrictPoset isStrictPoset public
+
+StrictPoset : ∀ ℓ ℓ' → Type (ℓ-max (ℓ-suc ℓ) (ℓ-suc ℓ'))
+StrictPoset ℓ ℓ' = TypeWithStr ℓ (StrictPosetStr ℓ')
+
+strictposet : (A : Type ℓ) (_<_ : A → A → Type ℓ') (h : IsStrictPoset _<_) → StrictPoset ℓ ℓ'
+strictposet A _<_ h = A , strictposetstr _<_ h
+
+record IsStrictPosetEquiv {A : Type ℓ₀} {B : Type ℓ₁}
+  (M : StrictPosetStr ℓ₀' A) (e : A ≃ B) (N : StrictPosetStr ℓ₁' B)
+  : Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') ℓ₁')
+  where
+  constructor
+   isstrictposetequiv
+  -- Shorter qualified names
+  private
+    module M = StrictPosetStr M
+    module N = StrictPosetStr N
+
+  field
+    pres< : (x y : A) → x M.< y ≃ equivFun e x N.< equivFun e y
+
+
+StrictPosetEquiv : (M : StrictPoset ℓ₀ ℓ₀') (M : StrictPoset ℓ₁ ℓ₁') → Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') (ℓ-max ℓ₁ ℓ₁'))
+StrictPosetEquiv M N = Σ[ e ∈ ⟨ M ⟩ ≃ ⟨ N ⟩ ] IsStrictPosetEquiv (M .snd) e (N .snd)
+
+isPropIsStrictPoset : {A : Type ℓ} (_<_ : A → A → Type ℓ') → isProp (IsStrictPoset _<_)
+isPropIsStrictPoset _<_ = isOfHLevelRetractFromIso 1 IsStrictPosetIsoΣ
+  (isPropΣ isPropIsSet
+    λ isSetA → isPropΣ (isPropΠ2 (λ _ _ → isPropIsProp))
+      λ isPropValued< → isProp×2 (isPropΠ (λ x → isProp¬ (x < x)))
+                                 (isPropΠ5 (λ _ _ _ _ _ → isPropValued< _ _))
+                                 (isPropΠ3 λ x y _ → isProp¬ (y < x)))
+
+𝒮ᴰ-StrictPoset : DUARel (𝒮-Univ ℓ) (StrictPosetStr ℓ') (ℓ-max ℓ ℓ')
+𝒮ᴰ-StrictPoset =
+  𝒮ᴰ-Record (𝒮-Univ _) IsStrictPosetEquiv
+    (fields:
+      data[ _<_ ∣ autoDUARel _ _ ∣ pres< ]
+      prop[ isStrictPoset ∣ (λ _ _ → isPropIsStrictPoset _) ])
+    where
+    open StrictPosetStr
+    open IsStrictPoset
+    open IsStrictPosetEquiv
+
+StrictPosetPath : (M N : StrictPoset ℓ ℓ') → StrictPosetEquiv M N ≃ (M ≡ N)
+StrictPosetPath = ∫ 𝒮ᴰ-StrictPoset .UARel.ua
+
+-- an easier way of establishing an equivalence of strict posets
+module _ {P : StrictPoset ℓ₀ ℓ₀'} {S : StrictPoset ℓ₁ ℓ₁'} (e : ⟨ P ⟩ ≃ ⟨ S ⟩) where
+  private
+    module P = StrictPosetStr (P .snd)
+    module S = StrictPosetStr (S .snd)
+
+  module _ (isMon : ∀ x y → x P.< y → equivFun e x S.< equivFun e y)
+           (isMonInv : ∀ x y → x S.< y → invEq e x P.< invEq e y) where
+    open IsStrictPosetEquiv
+    open IsStrictPoset
+
+    makeIsStrictPosetEquiv : IsStrictPosetEquiv (P .snd) e (S .snd)
+    pres< makeIsStrictPosetEquiv x y = propBiimpl→Equiv (P.isStrictPoset .is-prop-valued _ _)
+                                                  (S.isStrictPoset .is-prop-valued _ _)
+                                                  (isMon _ _) (isMonInv' _ _)
+      where
+      isMonInv' : ∀ x y → equivFun e x S.< equivFun e y → x P.< y
+      isMonInv' x y ex<ey = transport (λ i → retEq e x i P.< retEq e y i) (isMonInv _ _ ex<ey)
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.StrictPoset.Properties.html b/Cubical.Relation.Binary.Order.StrictPoset.Properties.html new file mode 100644 index 0000000000..1c080137bc --- /dev/null +++ b/Cubical.Relation.Binary.Order.StrictPoset.Properties.html @@ -0,0 +1,96 @@ + +Cubical.Relation.Binary.Order.StrictPoset.Properties
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.StrictPoset.Properties where
+
+open import Cubical.Data.Sum as ⊎
+open import Cubical.Data.Empty as ⊥
+
+open import Cubical.Foundations.Prelude
+
+open import Cubical.Functions.Embedding
+
+open import Cubical.HITs.PropositionalTruncation as ∥₁
+
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Binary.Order.Apartness.Base
+open import Cubical.Relation.Binary.Order.Poset.Base
+open import Cubical.Relation.Binary.Order.StrictPoset.Base
+
+private
+  variable
+    ℓ ℓ' ℓ'' : Level
+
+module _
+  {A : Type ℓ}
+  {R : Rel A A ℓ'}
+  where
+
+  open BinaryRelation
+
+  private
+    transrefl : isTrans R → isTrans (ReflClosure R)
+    transrefl trans a b c (inl Rab) (inl Rbc) = inl (trans a b c Rab Rbc)
+    transrefl trans a b c (inl Rab) (inr b≡c) = inl (subst (R a) b≡c Rab)
+    transrefl trans a b c (inr a≡b) (inl Rbc) = inl (subst (λ z → R z c) (sym a≡b) Rbc)
+    transrefl trans a b c (inr a≡b) (inr b≡c) = inr (a≡b ∙ b≡c)
+
+    antisym : isIrrefl R → isTrans R → isAntisym (ReflClosure R)
+    antisym irr trans a b (inl Rab) (inl Rba) = ⊥.rec (irr a (trans a b a Rab Rba))
+    antisym irr trans a b (inl _) (inr b≡a) = sym b≡a
+    antisym irr trans a b (inr a≡b) _ = a≡b
+
+  isStrictPoset→isPosetReflClosure : IsStrictPoset R → IsPoset (ReflClosure R)
+  isStrictPoset→isPosetReflClosure strictposet
+    = isposet (IsStrictPoset.is-set strictposet)
+              (λ a b → isProp⊎ (IsStrictPoset.is-prop-valued strictposet a b)
+                               (IsStrictPoset.is-set strictposet a b)
+                                 λ Rab a≡b
+                                   → IsStrictPoset.is-irrefl strictposet a (subst (R a)
+                                                                           (sym a≡b) Rab))
+              (isReflReflClosure R)
+              (transrefl (IsStrictPoset.is-trans strictposet))
+              (antisym (IsStrictPoset.is-irrefl strictposet)
+                       (IsStrictPoset.is-trans strictposet))
+
+  isStrictPoset→isApartnessSymClosure : IsStrictPoset R
+                                      → isWeaklyLinear R
+                                      → IsApartness (SymClosure R)
+  isStrictPoset→isApartnessSymClosure strictposet weak
+    = isapartness (IsStrictPoset.is-set strictposet)
+                  (λ a b → isProp⊎ (IsStrictPoset.is-prop-valued strictposet a b)
+                                   (IsStrictPoset.is-prop-valued strictposet b a)
+                                   (IsStrictPoset.is-asym strictposet a b))
+                  (λ a x → ⊎.rec (IsStrictPoset.is-irrefl strictposet a)
+                                 (IsStrictPoset.is-irrefl strictposet a) x)
+                  (λ a b c x → ⊎.rec (λ Rab → ∥₁.map (⊎.map (λ Rac → inl Rac)
+                                                             (λ Rcb → inr Rcb))
+                                                      (weak a b c Rab))
+                                     (λ Rba → ∥₁.rec isPropPropTrunc
+                                                     (λ y → ∣ ⊎.rec (λ Rbc → inr (inl Rbc))
+                                                     (λ Rca → inl (inr Rca)) y ∣₁)
+                                                     (weak b a c Rba)) x)
+                  (isSymSymClosure R)
+
+  isStrictPosetInduced : IsStrictPoset R → (B : Type ℓ'') → (f : B ↪ A)
+                       → IsStrictPoset (InducedRelation R (B , f))
+  isStrictPosetInduced strictpos B (f , emb)
+    = isstrictposet (Embedding-into-isSet→isSet (f , emb)
+                                                (IsStrictPoset.is-set strictpos))
+                    (λ a b → IsStrictPoset.is-prop-valued strictpos (f a) (f b))
+                    (λ a → IsStrictPoset.is-irrefl strictpos (f a))
+                    (λ a b c → IsStrictPoset.is-trans strictpos (f a) (f b) (f c))
+                    λ a b → IsStrictPoset.is-asym strictpos (f a) (f b)
+
+StrictPoset→Poset : StrictPoset ℓ ℓ' → Poset ℓ (ℓ-max ℓ ℓ')
+StrictPoset→Poset (_ , strictpos)
+  = _ , posetstr (BinaryRelation.ReflClosure (StrictPosetStr._<_ strictpos))
+                 (isStrictPoset→isPosetReflClosure (StrictPosetStr.isStrictPoset strictpos))
+
+StrictPoset→Apartness : (R : StrictPoset ℓ ℓ')
+                      → BinaryRelation.isWeaklyLinear (StrictPosetStr._<_ (snd R))
+                      → Apartness ℓ ℓ'
+StrictPoset→Apartness (_ , strictpos) weak
+  = _ , apartnessstr (BinaryRelation.SymClosure (StrictPosetStr._<_ strictpos))
+                     (isStrictPoset→isApartnessSymClosure
+                       (StrictPosetStr.isStrictPoset strictpos) weak)
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.StrictPoset.html b/Cubical.Relation.Binary.Order.StrictPoset.html new file mode 100644 index 0000000000..aaa2f4cc52 --- /dev/null +++ b/Cubical.Relation.Binary.Order.StrictPoset.html @@ -0,0 +1,7 @@ + +Cubical.Relation.Binary.Order.StrictPoset
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.StrictPoset where
+
+open import Cubical.Relation.Binary.Order.StrictPoset.Base public
+open import Cubical.Relation.Binary.Order.StrictPoset.Properties public
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Toset.Base.html b/Cubical.Relation.Binary.Order.Toset.Base.html new file mode 100644 index 0000000000..d9a0c57e87 --- /dev/null +++ b/Cubical.Relation.Binary.Order.Toset.Base.html @@ -0,0 +1,148 @@ + +Cubical.Relation.Binary.Order.Toset.Base
{-# OPTIONS --safe #-}
+{-
+  Tosets are totally-ordered sets,
+  i.e. strongly connected posets,
+  a poset where every element can be compared
+-}
+module Cubical.Relation.Binary.Order.Toset.Base where
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.Equiv
+open import Cubical.Foundations.HLevels
+open import Cubical.Foundations.Isomorphism
+open import Cubical.Foundations.Univalence
+open import Cubical.Foundations.Transport
+open import Cubical.Foundations.SIP
+
+open import Cubical.HITs.PropositionalTruncation
+
+open import Cubical.Data.Sigma
+
+open import Cubical.Reflection.RecordEquiv
+open import Cubical.Reflection.StrictEquiv
+
+open import Cubical.Displayed.Base
+open import Cubical.Displayed.Auto
+open import Cubical.Displayed.Record
+open import Cubical.Displayed.Universe
+
+open import Cubical.Relation.Binary.Base
+
+open Iso
+open BinaryRelation
+
+
+private
+  variable
+    ℓ ℓ' ℓ'' ℓ₀ ℓ₀' ℓ₁ ℓ₁' : Level
+
+record IsToset {A : Type ℓ} (_≤_ : A → A → Type ℓ') : Type (ℓ-max ℓ ℓ') where
+  no-eta-equality
+  constructor istoset
+
+  field
+    is-set : isSet A
+    is-prop-valued : isPropValued _≤_
+    is-refl : isRefl _≤_
+    is-trans : isTrans _≤_
+    is-antisym : isAntisym _≤_
+    is-strongly-connected : isStronglyConnected _≤_
+
+unquoteDecl IsTosetIsoΣ = declareRecordIsoΣ IsTosetIsoΣ (quote IsToset)
+
+
+record TosetStr (ℓ' : Level) (A : Type ℓ) : Type (ℓ-max ℓ (ℓ-suc ℓ')) where
+
+  constructor tosetstr
+
+  field
+    _≤_     : A → A → Type ℓ'
+    isToset : IsToset _≤_
+
+  infixl 7 _≤_
+
+  open IsToset isToset public
+
+Toset : ∀ ℓ ℓ' → Type (ℓ-max (ℓ-suc ℓ) (ℓ-suc ℓ'))
+Toset ℓ ℓ' = TypeWithStr ℓ (TosetStr ℓ')
+
+toset : (A : Type ℓ) (_≤_ : A → A → Type ℓ') (h : IsToset _≤_) → Toset ℓ ℓ'
+toset A _≤_ h = A , tosetstr _≤_ h
+
+record IsTosetEquiv {A : Type ℓ₀} {B : Type ℓ₁}
+  (M : TosetStr ℓ₀' A) (e : A ≃ B) (N : TosetStr ℓ₁' B)
+  : Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') ℓ₁')
+  where
+  constructor
+   istosetequiv
+  -- Shorter qualified names
+  private
+    module M = TosetStr M
+    module N = TosetStr N
+
+  field
+    pres≤ : (x y : A) → x M.≤ y ≃ equivFun e x N.≤ equivFun e y
+
+
+TosetEquiv : (M : Toset ℓ₀ ℓ₀') (M : Toset ℓ₁ ℓ₁') → Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') (ℓ-max ℓ₁ ℓ₁'))
+TosetEquiv M N = Σ[ e ∈ ⟨ M ⟩ ≃ ⟨ N ⟩ ] IsTosetEquiv (M .snd) e (N .snd)
+
+isPropIsToset : {A : Type ℓ} (_≤_ : A → A → Type ℓ') → isProp (IsToset _≤_)
+isPropIsToset _≤_ = isOfHLevelRetractFromIso 1 IsTosetIsoΣ
+  (isPropΣ isPropIsSet
+    λ isSetA → isPropΣ (isPropΠ2 (λ _ _ → isPropIsProp))
+      λ isPropValued≤ → isProp×3
+                         (isPropΠ (λ _ → isPropValued≤ _ _))
+                           (isPropΠ5 λ _ _ _ _ _ → isPropValued≤ _ _)
+                             (isPropΠ4 λ _ _ _ _ → isSetA _ _)
+                               (isPropΠ2 λ _ _ → squash₁))
+
+𝒮ᴰ-Toset : DUARel (𝒮-Univ ℓ) (TosetStr ℓ') (ℓ-max ℓ ℓ')
+𝒮ᴰ-Toset =
+  𝒮ᴰ-Record (𝒮-Univ _) IsTosetEquiv
+    (fields:
+      data[ _≤_ ∣ autoDUARel _ _ ∣ pres≤ ]
+      prop[ isToset ∣ (λ _ _ → isPropIsToset _) ])
+    where
+    open TosetStr
+    open IsToset
+    open IsTosetEquiv
+
+TosetPath : (M N : Toset ℓ ℓ') → TosetEquiv M N ≃ (M ≡ N)
+TosetPath = ∫ 𝒮ᴰ-Toset .UARel.ua
+
+-- an easier way of establishing an equivalence of tosets
+module _ {P : Toset ℓ₀ ℓ₀'} {S : Toset ℓ₁ ℓ₁'} (e : ⟨ P ⟩ ≃ ⟨ S ⟩) where
+  private
+    module P = TosetStr (P .snd)
+    module S = TosetStr (S .snd)
+
+  module _ (isMon : ∀ x y → x P.≤ y → equivFun e x S.≤ equivFun e y)
+           (isMonInv : ∀ x y → x S.≤ y → invEq e x P.≤ invEq e y) where
+    open IsTosetEquiv
+    open IsToset
+
+    makeIsTosetEquiv : IsTosetEquiv (P .snd) e (S .snd)
+    pres≤ makeIsTosetEquiv x y = propBiimpl→Equiv (P.isToset .is-prop-valued _ _)
+                                                  (S.isToset .is-prop-valued _ _)
+                                                  (isMon _ _) (isMonInv' _ _)
+      where
+      isMonInv' : ∀ x y → equivFun e x S.≤ equivFun e y → x P.≤ y
+      isMonInv' x y ex≤ey = transport (λ i → retEq e x i P.≤ retEq e y i) (isMonInv _ _ ex≤ey)
+
+
+module TosetReasoning (P' : Toset ℓ ℓ') where
+ private P = fst P'
+ open TosetStr (snd P')
+ open IsToset
+
+ _≤⟨_⟩_ : (x : P) {y z : P} → x ≤ y → y ≤ z → x ≤ z
+ x ≤⟨ p ⟩ q = isToset .is-trans x _ _ p q
+
+ _◾ : (x : P) → x ≤ x
+ x ◾ = isToset .is-refl x
+
+ infixr 0 _≤⟨_⟩_
+ infix  1 _◾
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Toset.Properties.html b/Cubical.Relation.Binary.Order.Toset.Properties.html new file mode 100644 index 0000000000..f040f5ab49 --- /dev/null +++ b/Cubical.Relation.Binary.Order.Toset.Properties.html @@ -0,0 +1,93 @@ + +Cubical.Relation.Binary.Order.Toset.Properties
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Toset.Properties where
+
+open import Cubical.Data.Sum as ⊎
+open import Cubical.Data.Empty as ⊥
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.HLevels
+
+open import Cubical.Functions.Embedding
+
+open import Cubical.HITs.PropositionalTruncation as ∥₁
+
+open import Cubical.Relation.Binary.Base
+open import Cubical.Relation.Binary.Order.Poset.Base
+open import Cubical.Relation.Binary.Order.Toset.Base
+open import Cubical.Relation.Binary.Order.Loset.Base
+
+open import Cubical.Relation.Nullary
+
+private
+  variable
+    ℓ ℓ' ℓ'' : Level
+
+module _
+  {A : Type ℓ}
+  {R : Rel A A ℓ'}
+  where
+
+  open BinaryRelation
+
+  isToset→isPoset : IsToset R → IsPoset R
+  isToset→isPoset toset = isposet
+                          (IsToset.is-set toset)
+                          (IsToset.is-prop-valued toset)
+                          (IsToset.is-refl toset)
+                          (IsToset.is-trans toset)
+                          (IsToset.is-antisym toset)
+  private
+    transirrefl : isTrans R → isAntisym R → isTrans (IrreflKernel R)
+    transirrefl trans anti a b c (Rab , ¬a≡b) (Rbc , ¬b≡c)
+      = trans a b c Rab Rbc
+      , λ a≡c → ¬a≡b (anti a b Rab (subst (R b) (sym a≡c) Rbc))
+
+  isToset→isLosetIrreflKernel : Discrete A → IsToset R → IsLoset (IrreflKernel R)
+  isToset→isLosetIrreflKernel disc toset
+    = isloset (IsToset.is-set toset)
+              (λ a b → isProp× (IsToset.is-prop-valued toset a b)
+                               (isProp¬ (a ≡ b)))
+              (isIrreflIrreflKernel R)
+              (transirrefl (IsToset.is-trans toset)
+                           (IsToset.is-antisym toset))
+              (isIrrefl×isTrans→isAsym (IrreflKernel R)
+                                       (isIrreflIrreflKernel R
+                                       , transirrefl (IsToset.is-trans toset)
+                                                     (IsToset.is-antisym toset)))
+              (λ a c b (Rac , ¬a≡c)
+                → decRec (λ a≡b → ∥₁.map (⊎.rec
+                         (λ Rbc → inr (Rbc , λ b≡c → ¬a≡c (a≡b ∙ b≡c)))
+                                λ Rcb → ⊥.rec (¬a≡c (IsToset.is-antisym toset a c Rac
+                                              (subst (λ x → R c x) (sym a≡b) Rcb))))
+                                  (IsToset.is-strongly-connected toset b c))
+                         (λ ¬a≡b → ∥₁.map (⊎.map (λ Rab → Rab , ¬a≡b)
+                                   (λ Rba → (IsToset.is-trans toset b a c Rba Rac)
+                                   , λ b≡c → ¬a≡b (IsToset.is-antisym toset a b
+                                       (subst (λ x → R a x) (sym b≡c) Rac) Rba)))
+                                 (IsToset.is-strongly-connected toset a b))
+                         (disc a b))
+              (isConnectedStronglyConnectedIrreflKernel R
+                (IsToset.is-strongly-connected toset))
+
+  isTosetInduced : IsToset R → (B : Type ℓ'') → (f : B ↪ A)
+                 → IsToset (InducedRelation R (B , f))
+  isTosetInduced tos B (f , emb)
+    = istoset (Embedding-into-isSet→isSet (f , emb) (IsToset.is-set tos))
+              (λ a b → IsToset.is-prop-valued tos (f a) (f b))
+              (λ a → IsToset.is-refl tos (f a))
+              (λ a b c → IsToset.is-trans tos (f a) (f b) (f c))
+              (λ a b a≤b b≤a → isEmbedding→Inj emb a b
+                (IsToset.is-antisym tos (f a) (f b) a≤b b≤a))
+              λ a b → IsToset.is-strongly-connected tos (f a) (f b)
+
+Toset→Poset : Toset ℓ ℓ' → Poset ℓ ℓ'
+Toset→Poset (_ , tos) = _ , posetstr (TosetStr._≤_ tos)
+                                     (isToset→isPoset (TosetStr.isToset tos))
+
+Toset→Loset : (tos : Toset ℓ ℓ') → Discrete (fst tos) → Loset ℓ (ℓ-max ℓ ℓ')
+Toset→Loset (_ , tos) disc
+  = _ , losetstr (BinaryRelation.IrreflKernel (TosetStr._≤_ tos))
+                       (isToset→isLosetIrreflKernel disc
+                                                    (TosetStr.isToset tos))
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.Toset.html b/Cubical.Relation.Binary.Order.Toset.html new file mode 100644 index 0000000000..7282101cff --- /dev/null +++ b/Cubical.Relation.Binary.Order.Toset.html @@ -0,0 +1,7 @@ + +Cubical.Relation.Binary.Order.Toset
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order.Toset where
+
+open import Cubical.Relation.Binary.Order.Toset.Base public
+open import Cubical.Relation.Binary.Order.Toset.Properties public
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Order.html b/Cubical.Relation.Binary.Order.html new file mode 100644 index 0000000000..f9ea119db3 --- /dev/null +++ b/Cubical.Relation.Binary.Order.html @@ -0,0 +1,12 @@ + +Cubical.Relation.Binary.Order
{-# OPTIONS --safe #-}
+module Cubical.Relation.Binary.Order where
+
+open import Cubical.Relation.Binary.Order.Apartness public
+open import Cubical.Relation.Binary.Order.Preorder public
+open import Cubical.Relation.Binary.Order.Poset public
+open import Cubical.Relation.Binary.Order.Toset public
+open import Cubical.Relation.Binary.Order.StrictPoset public
+open import Cubical.Relation.Binary.Order.Loset public
+open import Cubical.Relation.Binary.Order.Properties public
+
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Poset.html b/Cubical.Relation.Binary.Poset.html deleted file mode 100644 index ca3b9b549c..0000000000 --- a/Cubical.Relation.Binary.Poset.html +++ /dev/null @@ -1,140 +0,0 @@ - -Cubical.Relation.Binary.Poset
{-# OPTIONS --safe #-}
-module Cubical.Relation.Binary.Poset where
-
-open import Cubical.Foundations.Prelude
-open import Cubical.Foundations.Equiv
-open import Cubical.Foundations.Equiv.HalfAdjoint
-open import Cubical.Foundations.HLevels
-open import Cubical.Foundations.Isomorphism
-open import Cubical.Foundations.Univalence
-open import Cubical.Foundations.Transport
-open import Cubical.Foundations.SIP
-
-open import Cubical.Data.Sigma
-
-open import Cubical.Reflection.RecordEquiv
-open import Cubical.Reflection.StrictEquiv
-
-open import Cubical.Displayed.Base
-open import Cubical.Displayed.Auto
-open import Cubical.Displayed.Record
-open import Cubical.Displayed.Universe
-
-open import Cubical.Relation.Binary.Base
-
-open Iso
-open BinaryRelation
-
-
-private
-  variable
-    ℓ ℓ' ℓ'' ℓ₀ ℓ₀' ℓ₁ ℓ₁' : Level
-
-record IsPoset {A : Type ℓ} (_≤_ : A → A → Type ℓ') : Type (ℓ-max ℓ ℓ') where
-  no-eta-equality
-  constructor isposet
-
-  field
-    is-set : isSet A
-    is-prop-valued : isPropValued _≤_
-    is-refl : isRefl _≤_
-    is-trans : isTrans _≤_
-    is-antisym : isAntisym _≤_
-
-unquoteDecl IsPosetIsoΣ = declareRecordIsoΣ IsPosetIsoΣ (quote IsPoset)
-
-
-record PosetStr (ℓ' : Level) (A : Type ℓ) : Type (ℓ-max ℓ (ℓ-suc ℓ')) where
-
-  constructor posetstr
-
-  field
-    _≤_     : A → A → Type ℓ'
-    isPoset : IsPoset _≤_
-
-  infixl 7 _≤_
-
-  open IsPoset isPoset public
-
-Poset : ∀ ℓ ℓ' → Type (ℓ-max (ℓ-suc ℓ) (ℓ-suc ℓ'))
-Poset ℓ ℓ' = TypeWithStr ℓ (PosetStr ℓ')
-
-poset : (A : Type ℓ) (_≤_ : A → A → Type ℓ') (h : IsPoset _≤_) → Poset ℓ ℓ'
-poset A _≤_ h = A , posetstr _≤_ h
-
-record IsPosetEquiv {A : Type ℓ₀} {B : Type ℓ₁}
-  (M : PosetStr ℓ₀' A) (e : A ≃ B) (N : PosetStr ℓ₁' B)
-  : Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') ℓ₁')
-  where
-  constructor
-   isposetequiv
-  -- Shorter qualified names
-  private
-    module M = PosetStr M
-    module N = PosetStr N
-
-  field
-    pres≤ : (x y : A) → x M.≤ y ≃ equivFun e x N.≤ equivFun e y
-
-
-PosetEquiv : (M : Poset ℓ₀ ℓ₀') (M : Poset ℓ₁ ℓ₁') → Type (ℓ-max (ℓ-max ℓ₀ ℓ₀') (ℓ-max ℓ₁ ℓ₁'))
-PosetEquiv M N = Σ[ e ∈ ⟨ M ⟩ ≃ ⟨ N ⟩ ] IsPosetEquiv (M .snd) e (N .snd)
-
-isPropIsPoset : {A : Type ℓ} (_≤_ : A → A → Type ℓ') → isProp (IsPoset _≤_)
-isPropIsPoset _≤_ = isOfHLevelRetractFromIso 1 IsPosetIsoΣ
-  (isPropΣ isPropIsSet
-    λ isSetA → isPropΣ (isPropΠ2 (λ _ _ → isPropIsProp))
-      λ isPropValued≤ → isProp×2
-                         (isPropΠ (λ _ → isPropValued≤ _ _))
-                           (isPropΠ5 λ _ _ _ _ _ → isPropValued≤ _ _)
-                             (isPropΠ4 λ _ _ _ _ → isSetA _ _))
-
-𝒮ᴰ-Poset : DUARel (𝒮-Univ ℓ) (PosetStr ℓ') (ℓ-max ℓ ℓ')
-𝒮ᴰ-Poset =
-  𝒮ᴰ-Record (𝒮-Univ _) IsPosetEquiv
-    (fields:
-      data[ _≤_ ∣ autoDUARel _ _ ∣ pres≤ ]
-      prop[ isPoset ∣ (λ _ _ → isPropIsPoset _) ])
-    where
-    open PosetStr
-    open IsPoset
-    open IsPosetEquiv
-
-PosetPath : (M N : Poset ℓ ℓ') → PosetEquiv M N ≃ (M ≡ N)
-PosetPath = ∫ 𝒮ᴰ-Poset .UARel.ua
-
--- an easier way of establishing an equivalence of posets
-module _ {P : Poset ℓ₀ ℓ₀'} {S : Poset ℓ₁ ℓ₁'} (e : ⟨ P ⟩ ≃ ⟨ S ⟩) where
-  private
-    module P = PosetStr (P .snd)
-    module S = PosetStr (S .snd)
-
-  module _ (isMon : ∀ x y → x P.≤ y → equivFun e x S.≤ equivFun e y)
-           (isMonInv : ∀ x y → x S.≤ y → invEq e x P.≤ invEq e y) where
-    open IsPosetEquiv
-    open IsPoset
-
-    makeIsPosetEquiv : IsPosetEquiv (P .snd) e (S .snd)
-    pres≤ makeIsPosetEquiv x y = propBiimpl→Equiv (P.isPoset .is-prop-valued _ _)
-                                                  (S.isPoset .is-prop-valued _ _)
-                                                  (isMon _ _) (isMonInv' _ _)
-      where
-      isMonInv' : ∀ x y → equivFun e x S.≤ equivFun e y → x P.≤ y
-      isMonInv' x y ex≤ey = transport (λ i → retEq e x i P.≤ retEq e y i) (isMonInv _ _ ex≤ey)
-
-
-module PosetReasoning (P' : Poset ℓ ℓ') where
- private P = fst P'
- open PosetStr (snd P')
- open IsPoset
-
- _≤⟨_⟩_ : (x : P) {y z : P} → x ≤ y → y ≤ z → x ≤ z
- x ≤⟨ p ⟩ q = isPoset .is-trans x _ _ p q
-
- _◾ : (x : P) → x ≤ x
- x ◾ = isPoset .is-refl x
-
- infixr 0 _≤⟨_⟩_
- infix  1 _◾
-
\ No newline at end of file diff --git a/Cubical.Relation.Binary.Properties.html b/Cubical.Relation.Binary.Properties.html index 05807ee698..0e3bca332d 100644 --- a/Cubical.Relation.Binary.Properties.html +++ b/Cubical.Relation.Binary.Properties.html @@ -17,27 +17,27 @@ module _ (f : A → B) - (R : Rel B B ℓ) + (R : Rel B B ℓ) where - open BinaryRelation + open BinaryRelation - pulledbackRel : Rel A A ℓ + pulledbackRel : Rel A A ℓ pulledbackRel x y = R (f x) (f y) - isReflPulledbackRel : isRefl R → isRefl pulledbackRel + isReflPulledbackRel : isRefl R → isRefl pulledbackRel isReflPulledbackRel isReflR a = isReflR (f a) - isSymPulledbackRel : isSym R → isSym pulledbackRel + isSymPulledbackRel : isSym R → isSym pulledbackRel isSymPulledbackRel isSymR a a' = isSymR (f a) (f a') - isTransPulledbackRel : isTrans R → isTrans pulledbackRel + isTransPulledbackRel : isTrans R → isTrans pulledbackRel isTransPulledbackRel isTransR a a' a'' = isTransR (f a) (f a') (f a'') - open isEquivRel + open isEquivRel - isEquivRelPulledbackRel : isEquivRel R → isEquivRel pulledbackRel - reflexive (isEquivRelPulledbackRel isEquivRelR) = isReflPulledbackRel (reflexive isEquivRelR) - symmetric (isEquivRelPulledbackRel isEquivRelR) = isSymPulledbackRel (symmetric isEquivRelR) - transitive (isEquivRelPulledbackRel isEquivRelR) = isTransPulledbackRel (transitive isEquivRelR) + isEquivRelPulledbackRel : isEquivRel R → isEquivRel pulledbackRel + reflexive (isEquivRelPulledbackRel isEquivRelR) = isReflPulledbackRel (reflexive isEquivRelR) + symmetric (isEquivRelPulledbackRel isEquivRelR) = isSymPulledbackRel (symmetric isEquivRelR) + transitive (isEquivRelPulledbackRel isEquivRelR) = isTransPulledbackRel (transitive isEquivRelR) \ No newline at end of file diff --git a/Cubical.Relation.Everything.html b/Cubical.Relation.Everything.html index d6a278e966..f181f08095 100644 --- a/Cubical.Relation.Everything.html +++ b/Cubical.Relation.Everything.html @@ -4,7 +4,7 @@ import Cubical.Relation.Binary import Cubical.Relation.Binary.Extensionality -import Cubical.Relation.Binary.Poset +import Cubical.Relation.Binary.Order import Cubical.Relation.Nullary import Cubical.Relation.Nullary.DecidablePropositions import Cubical.Relation.Nullary.HLevels diff --git a/Cubical.Relation.Nullary.DecidablePropositions.html b/Cubical.Relation.Nullary.DecidablePropositions.html index e90d07006f..3565ccec9c 100644 --- a/Cubical.Relation.Nullary.DecidablePropositions.html +++ b/Cubical.Relation.Nullary.DecidablePropositions.html @@ -42,7 +42,7 @@ isPropIsDecProp : {P : Type ℓ} → isProp (isDecProp P) isPropIsDecProp p q = - Σ≡PropEquiv (λ _ → isOfHLevel⁺≃ᵣ 0 isPropBool→Type) .fst + Σ≡PropEquiv (λ _ → isOfHLevel⁺≃ᵣ 0 isPropBool→Type) .fst (Bool→TypeInj _ _ (invEquiv (p .snd) ⋆ q .snd)) isDecPropRespectEquiv : {P : Type ℓ} {Q : Type ℓ'} diff --git a/Cubical.Relation.ZigZag.Base.html b/Cubical.Relation.ZigZag.Base.html index a9a58207e1..a2485f58cd 100644 --- a/Cubical.Relation.ZigZag.Base.html +++ b/Cubical.Relation.ZigZag.Base.html @@ -14,8 +14,8 @@ open import Cubical.HITs.PropositionalTruncation as Trunc open import Cubical.Relation.Binary.Base -open BinaryRelation -open isEquivRel +open BinaryRelation +open isEquivRel private variable @@ -37,20 +37,20 @@ QuasiEquivRel : (A B : Type ℓ) (ℓ' : Level) → Type (ℓ-max ℓ (ℓ-suc ℓ')) QuasiEquivRel A B ℓ' = - Σ[ R ∈ PropRel A B ℓ' ] isQuasiEquivRel (R .fst) + Σ[ R ∈ PropRel A B ℓ' ] isQuasiEquivRel (R .fst) invQER : {A B : Type ℓ} {ℓ' : Level} → QuasiEquivRel A B ℓ' → QuasiEquivRel B A ℓ' -invQER (R , qer) .fst = invPropRel R +invQER (R , qer) .fst = invPropRel R invQER (R , qer) .snd .zigzag aRb aRb' a'Rb' = qer .zigzag a'Rb' aRb' aRb invQER (R , qer) .snd .fwd = qer .bwd invQER (R , qer) .snd .bwd = qer .fwd QER→EquivRel : {A B : Type ℓ} - → QuasiEquivRel A B ℓ' → EquivPropRel A (ℓ-max ℓ ℓ') -QER→EquivRel (R , sim) .fst = compPropRel R (invPropRel R) -QER→EquivRel (R , sim) .snd .reflexive a = Trunc.map (λ {(b , r) → b , r , r}) (sim .fwd a) -QER→EquivRel (R , sim) .snd .symmetric _ _ = Trunc.map (λ {(b , r₀ , r₁) → b , r₁ , r₀}) -QER→EquivRel (R , sim) .snd .transitive _ _ _ = + → QuasiEquivRel A B ℓ' → EquivPropRel A (ℓ-max ℓ ℓ') +QER→EquivRel (R , sim) .fst = compPropRel R (invPropRel R) +QER→EquivRel (R , sim) .snd .reflexive a = Trunc.map (λ {(b , r) → b , r , r}) (sim .fwd a) +QER→EquivRel (R , sim) .snd .symmetric _ _ = Trunc.map (λ {(b , r₀ , r₁) → b , r₁ , r₀}) +QER→EquivRel (R , sim) .snd .transitive _ _ _ = Trunc.map2 (λ {(b , r₀ , r₁) (b' , r₀' , r₁') → b , r₀ , sim .zigzag r₁' r₀' r₁}) -- The following result is due to Carlo Angiuli @@ -168,25 +168,25 @@ -- which propagated to "Internalizing representation independence with univalence" -- https://doi.org/10.1145/3434293, just above Definition 5.3 -- -open HeterogenousRelation +open HeterogenousRelation -module Universal→ZigZag {A B : Type ℓ} (R : PropRel A B ℓ') where +module Universal→ZigZag {A B : Type ℓ} (R : PropRel A B ℓ') where - Rᴸ = compPropRel R (invPropRel R) - Rᴿ = compPropRel (invPropRel R) R + Rᴸ = compPropRel R (invPropRel R) + Rᴿ = compPropRel (invPropRel R) R - Claim = isUniversalRel (Rᴸ .fst) → isUniversalRel (Rᴿ .fst) → isZigZagComplete (R .fst) + Claim = isUniversalRel (Rᴸ .fst) → isUniversalRel (Rᴿ .fst) → isZigZagComplete (R .fst) open import Cubical.Data.Empty using (⊥; isProp⊥) -¬Universal→ZigZag : (∀ {ℓ ℓ'} (A B : Type ℓ) (R : PropRel A B ℓ') → Universal→ZigZag.Claim R) → ⊥ +¬Universal→ZigZag : (∀ {ℓ ℓ'} (A B : Type ℓ) (R : PropRel A B ℓ') → Universal→ZigZag.Claim R) → ⊥ ¬Universal→ZigZag p = ¬R-zigzag (λ {a} {b} {a'} {b'} → p Bool Bool R Rᴸ-universal Rᴿ-universal {a} {b} {a'} {b'}) where open import Cubical.Data.Unit open import Cubical.Data.Bool -- zig... - R : PropRel Bool Bool ℓ-zero + R : PropRel Bool Bool ℓ-zero R .fst false false = Unit R .fst false true = ⊥ R .fst true b = Unit @@ -199,16 +199,16 @@ ¬R-zigzag : isZigZagComplete (R .fst) → ⊥ ¬R-zigzag p = p {a = false} {b = false} {a' = true} {b' = true} tt tt tt - Rᴸ = compPropRel R (invPropRel R) - Rᴿ = compPropRel (invPropRel R) R + Rᴸ = compPropRel R (invPropRel R) + Rᴿ = compPropRel (invPropRel R) R - Rᴸ-universal : isUniversalRel (Rᴸ .fst) + Rᴸ-universal : isUniversalRel (Rᴸ .fst) Rᴸ-universal false false = ∣ false , tt , tt ∣₁ Rᴸ-universal false true = ∣ false , tt , tt ∣₁ Rᴸ-universal true false = ∣ false , tt , tt ∣₁ Rᴸ-universal true true = ∣ false , tt , tt ∣₁ - Rᴿ-universal : isUniversalRel (Rᴿ .fst) + Rᴿ-universal : isUniversalRel (Rᴿ .fst) Rᴿ-universal false false = ∣ true , tt , tt ∣₁ Rᴿ-universal false true = ∣ true , tt , tt ∣₁ Rᴿ-universal true false = ∣ true , tt , tt ∣₁ diff --git a/Cubical.Structures.Axioms.html b/Cubical.Structures.Axioms.html index 99af744488..ecf32a621f 100644 --- a/Cubical.Structures.Axioms.html +++ b/Cubical.Structures.Axioms.html @@ -43,7 +43,7 @@ ι (X , s) (Y , t) e ≃⟨ θ e ⟩ PathP (λ i → S (ua e i)) s t - ≃⟨ invEquiv (Σ-contractSnd λ _ → isOfHLevelPathP' 0 (axioms-are-Props _ _) _ _) ⟩ + ≃⟨ invEquiv (Σ-contractSnd λ _ → isOfHLevelPathP' 0 (axioms-are-Props _ _) _ _) ⟩ Σ[ p ∈ PathP (λ i → S (ua e i)) s t ] PathP (λ i → axioms (ua e i) (p i)) a b ≃⟨ ΣPath≃PathΣ ⟩ PathP (λ i → AxiomsStructure S axioms (ua e i)) (s , a) (t , b) diff --git a/Cubical.Structures.Product.html b/Cubical.Structures.Product.html index 84204ac796..897a686e59 100644 --- a/Cubical.Structures.Product.html +++ b/Cubical.Structures.Product.html @@ -36,13 +36,13 @@ {S₂ : Type ℓ → Type ℓ₂} (ι₂ : StrEquiv S₂ ℓ₂') (θ₂ : UnivalentStr S₂ ι₂) → UnivalentStr (ProductStructure S₁ S₂) (ProductEquivStr ι₁ ι₂) productUnivalentStr {S₁ = S₁} ι₁ θ₁ {S₂} ι₂ θ₂ {X , s₁ , s₂} {Y , t₁ , t₂} e = - compEquiv (Σ-cong-equiv (θ₁ e) (λ _ → θ₂ e)) ΣPath≃PathΣ + compEquiv (Σ-cong-equiv (θ₁ e) (λ _ → θ₂ e)) ΣPath≃PathΣ productEquivAction : {S₁ : Type ℓ → Type ℓ₁} (α₁ : EquivAction S₁) {S₂ : Type ℓ → Type ℓ₂} (α₂ : EquivAction S₂) → EquivAction (ProductStructure S₁ S₂) -productEquivAction α₁ α₂ e = Σ-cong-equiv (α₁ e) (λ _ → α₂ e) +productEquivAction α₁ α₂ e = Σ-cong-equiv (α₁ e) (λ _ → α₂ e) productTransportStr : {S₁ : Type ℓ → Type ℓ₁} (α₁ : EquivAction S₁) (τ₁ : TransportStr α₁) diff --git a/Cubical.Structures.Relational.Equalizer.html b/Cubical.Structures.Relational.Equalizer.html index 26cad2a388..f412b40c22 100644 --- a/Cubical.Structures.Relational.Equalizer.html +++ b/Cubical.Structures.Relational.Equalizer.html @@ -40,8 +40,8 @@ equalizerSuitableRel {f = f} {g} {ρ₁} {ρ₂} αf αg θ₁ θ₂ .quo (X , s , p) (R , qer) r = ( ((quo₁ .fst .fst , sym step₀ ∙ step₁) , quo₁ .fst .snd) , λ {((s' , _) , r') → - Σ≡Prop (λ _ → θ₁ .prop (λ _ _ → squash/ _ _) _ _) - (Σ≡Prop (λ _ → θ₂ .set squash/ _ _) + Σ≡Prop (λ _ → θ₁ .prop (λ _ _ → squash/ _ _) _ _) + (Σ≡Prop (λ _ → θ₂ .set squash/ _ _) (cong fst (quo₁ .snd (s' , r'))))} ) where @@ -59,7 +59,7 @@ cong fst (quo₂ .snd ( g _ (quo₁ .fst .fst) - , subst (λ t → ρ₂ (graphRel [_]) t (g _ (quo₁ .fst .fst))) (sym p) (αg (quo₁ .fst .snd)) + , subst (λ t → ρ₂ (graphRel [_]) t (g _ (quo₁ .fst .fst))) (sym p) (αg (quo₁ .fst .snd)) )) equalizerSuitableRel _ _ θ₁ _ .symmetric R = θ₁ .symmetric R equalizerSuitableRel _ _ θ₁ _ .transitive R R' = θ₁ .transitive R R' diff --git a/Cubical.Structures.Relational.Function.html b/Cubical.Structures.Relational.Function.html index f86aab86b8..9f5b40adbe 100644 --- a/Cubical.Structures.Relational.Function.html +++ b/Cubical.Structures.Relational.Function.html @@ -33,20 +33,20 @@ FunctionRelStr ρ₁ ρ₂ R f g = ∀ {x y} → ρ₁ R x y → ρ₂ R (f x) (g y) -open BinaryRelation -open isEquivRel +open BinaryRelation +open isEquivRel private - composeWith[_] : {A : Type ℓ} (R : EquivPropRel A ℓ) - → compPropRel (R .fst) (quotientPropRel (R .fst .fst)) .fst ≡ graphRel [_] + composeWith[_] : {A : Type ℓ} (R : EquivPropRel A ℓ) + → compPropRel (R .fst) (quotientPropRel (R .fst .fst)) .fst ≡ graphRel [_] composeWith[_] R = funExt₂ λ a t → hPropExt squash₁ (squash/ _ _) (Trunc.rec (squash/ _ _) (λ {(b , r , p) → eq/ a b r ∙ p })) - (λ p → ∣ a , R .snd .reflexive a , p ∣₁) + (λ p → ∣ a , R .snd .reflexive a , p ∣₁) - [_]∙[_]⁻¹ : {A : Type ℓ} (R : EquivPropRel A ℓ) - → compPropRel (quotientPropRel (R .fst .fst)) (invPropRel (quotientPropRel (R .fst .fst))) .fst + [_]∙[_]⁻¹ : {A : Type ℓ} (R : EquivPropRel A ℓ) + → compPropRel (quotientPropRel (R .fst .fst)) (invPropRel (quotientPropRel (R .fst .fst))) .fst ≡ R .fst .fst [_]∙[_]⁻¹ R = funExt₂ λ a b → @@ -84,8 +84,8 @@ θ₂ .set squash/ _ _ (cong [f] p) (cong [f] q) j i relLemma : (s : S X) (t : S X) - → ρ₁ (graphRel [_]) s (funIsEq (σ₁ .quo R) [ t ]) - → ρ₂ (graphRel [_]) (f s) ([f] [ t ]) + → ρ₁ (graphRel [_]) s (funIsEq (σ₁ .quo R) [ t ]) + → ρ₂ (graphRel [_]) (f s) ([f] [ t ]) relLemma s t r = subst (λ R' → ρ₂ R' (f s) ([f] [ t ])) (composeWith[_] R) @@ -98,17 +98,17 @@ subst (λ R' → ρ₁ R' s t) ([_]∙[_]⁻¹ R) (θ₁ .transitive (quotientPropRel (R .fst .fst)) - (invPropRel (quotientPropRel (R .fst .fst))) + (invPropRel (quotientPropRel (R .fst .fst))) r (θ₁ .symmetric (quotientPropRel (R .fst .fst)) (subst - (λ t' → ρ₁ (graphRel [_]) t' (funIsEq (σ₁ .quo R) [ t ])) + (λ t' → ρ₁ (graphRel [_]) t' (funIsEq (σ₁ .quo R) [ t ])) (σ₁ .act .actStrId t) (σ₁ .act .actRel eq/ t t (ref t))))) quoRelLemma : (s : S X) (t : S X / ρ₁ (R .fst .fst)) - → ρ₁ (graphRel [_]) s (funIsEq (σ₁ .quo R) t) - → ρ₂ (graphRel [_]) (f s) ([f] t) + → ρ₁ (graphRel [_]) s (funIsEq (σ₁ .quo R) t) + → ρ₂ (graphRel [_]) (f s) ([f] t) quoRelLemma s = elimProp (λ _ → isPropΠ λ _ → θ₂ .prop (λ _ _ → squash/ _ _) _ _) (relLemma s) @@ -118,9 +118,9 @@ final .fst .snd {s} {t} r = quoRelLemma s (invIsEq (σ₁ .quo R) t) - (subst (ρ₁ (graphRel [_]) s) (sym (secIsEq (σ₁ .quo R) t)) r) + (subst (ρ₁ (graphRel [_]) s) (sym (secIsEq (σ₁ .quo R) t)) r) final .snd (f' , c) = - Σ≡Prop + Σ≡Prop (λ _ → isPropImplicitΠ λ s → isPropImplicitΠ λ t → isPropΠ λ _ → θ₂ .prop (λ _ _ → squash/ _ _) _ _) @@ -137,12 +137,12 @@ ( f' (funIsEq (σ₁ .quo R) [ s ]) , c (subst - (λ s' → ρ₁ (graphRel [_]) s' (funIsEq (σ₁ .quo R) [ s ])) + (λ s' → ρ₁ (graphRel [_]) s' (funIsEq (σ₁ .quo R) [ s ])) (σ₁ .act .actStrId s) (σ₁ .act .actRel eq/ s s (ref s))) ))) functionSuitableRel {ρ₁ = ρ₁} {ρ₂} θ₁ σ θ₂ .symmetric R h r = - θ₂ .symmetric R (h (θ₁ .symmetric (invPropRel R) r)) + θ₂ .symmetric R (h (θ₁ .symmetric (invPropRel R) r)) functionSuitableRel {ρ₁ = ρ₁} {ρ₂} θ₁ σ θ₂ .transitive R R' h h' rr' = Trunc.rec (θ₂ .prop (λ _ _ → squash₁) _ _) diff --git a/Cubical.Structures.Relational.Product.html b/Cubical.Structures.Relational.Product.html index 87bec94816..27d9b85849 100644 --- a/Cubical.Structures.Relational.Product.html +++ b/Cubical.Structures.Relational.Product.html @@ -63,7 +63,7 @@ → StrRelMatchesEquiv ρ₁ ι₁ → StrRelMatchesEquiv ρ₂ ι₂ → StrRelMatchesEquiv (ProductRelStr ρ₁ ρ₂) (ProductEquivStr ι₁ ι₂) productRelMatchesEquiv ρ₁ ρ₂ μ₁ μ₂ A B e = - Σ-cong-equiv (μ₁ _ _ e) (λ _ → μ₂ _ _ e) + Σ-cong-equiv (μ₁ _ _ e) (λ _ → μ₂ _ _ e) productRelAction : {S₁ : Type ℓ → Type ℓ₁} {ρ₁ : StrRel S₁ ℓ₁'} (α₁ : StrRelAction ρ₁) @@ -93,7 +93,7 @@ (funExt (elimProp (λ _ → productSuitableRel θ₁ θ₂ .set squash/ _ _) (λ _ → refl))) (compEquiv (isoToEquiv isom) - (Σ-cong-equiv (_ , σ₁ .quo R) (λ _ → _ , σ₂ .quo R)) .snd) + (Σ-cong-equiv (_ , σ₁ .quo R) (λ _ → _ , σ₂ .quo R)) .snd) where fwd : ProductStructure S₁ S₂ X / ProductRelStr ρ₁ ρ₂ (R .fst .fst) @@ -138,5 +138,5 @@ → StrRelMatchesEquiv ρ₂ (EquivAction→StrEquiv α₂) → StrRelMatchesEquiv (ProductRelStr ρ₁ ρ₂) (EquivAction→StrEquiv (productEquivAction α₁ α₂)) productRelMatchesTransp _ _ _ _ μ₁ μ₂ _ _ e = - compEquiv (Σ-cong-equiv (μ₁ _ _ e) (λ _ → μ₂ _ _ e)) ΣPath≃PathΣ + compEquiv (Σ-cong-equiv (μ₁ _ _ e) (λ _ → μ₂ _ _ e)) ΣPath≃PathΣ \ No newline at end of file diff --git a/Cubical.ZCohomology.EilenbergSteenrodZ.html b/Cubical.ZCohomology.EilenbergSteenrodZ.html index 36194e7dc2..68f835c741 100644 --- a/Cubical.ZCohomology.EilenbergSteenrodZ.html +++ b/Cubical.ZCohomology.EilenbergSteenrodZ.html @@ -100,9 +100,9 @@ H0-susp : ∀ {ℓ} {A : Pointed ℓ} → isContr (coHomRed 0 (Susp (typ A) , north)) fst H0-susp = 0ₕ∙ _ snd (H0-susp {A = A}) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ {(f , p) - → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) + → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) (funExt λ {north → sym p ; south → sym p ∙ cong f (merid (pt A)) ; (merid a i) j → isSet→isSet' (isSetℤ) @@ -153,11 +153,11 @@ suspFunCharac : ∀ {ℓ} {A : Pointed ℓ} (n : ℕ) → Iso (coHom (suc (suc n)) (Susp (typ A))) (coHom (suc n) (typ A)) fun (suspFunCharac {A = A} n) = - ST.map λ f → suspFunCharacFun {A = A} (suc n) f -inv (suspFunCharac {A = A} n) = ST.map (suspΩFun (suc n)) + ST.map λ f → suspFunCharacFun {A = A} (suc n) f +inv (suspFunCharac {A = A} n) = ST.map (suspΩFun (suc n)) rightInv (suspFunCharac {A = A} n) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ f → T.rec (isProp→isOfHLevelSuc n (isSetSetTrunc _ _)) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ f → T.rec (isProp→isOfHLevelSuc n (isSetSetTrunc _ _)) (λ fId → cong ∣_∣₂ (funExt (λ x → cong (ΩKn+1→Kn (suc n)) ((λ i → sym (rCancel≡refl n i) ∙∙ cong (λ x → suspΩFun (suc n) f x +ₖ 0ₖ _) @@ -175,31 +175,31 @@ ∙ rUnitₖ _ (f x)))) (fst (isConnectedPathKn n (f (pt A)) (0ₖ _))) leftInv (suspFunCharac {A = A} n) = - SuspCohomElim {A = A} _ (λ _ → isSetSetTrunc _ _) + SuspCohomElim {A = A} _ (λ _ → isSetSetTrunc _ _) λ f fId → cong ∣_∣₂ (funExt (linvLem (suc n) f fId)) -- We also need that H¹(Susp A) ≃ Ĥ⁰(A) suspFunCharac0 : ∀ {ℓ} {A : Pointed ℓ} → Iso (∥ ((Susp (typ A)) → coHomK 1) ∥₂) ∥ A →∙ (ℤ , 0) ∥₂ fun (suspFunCharac0 {A = A}) = - ST.map λ f → suspFunCharacFun {A = A} 0 f + ST.map λ f → suspFunCharacFun {A = A} 0 f , (cong (ΩKn+1→Kn 0) ((λ i → sym (rCancelₖ _ (f north)) ∙∙ cong (λ x → f x -ₖ f north) (rCancel (merid (pt A)) i) ∙∙ rCancelₖ _ (f north)) ∙∙ (doubleCompPath-elim (sym (rCancelₖ _ (f north))) refl (rCancelₖ _ (f north))) ∙∙ (cong (_∙ (rCancelₖ _ (f north))) (sym (rUnit (sym (rCancelₖ _ (f north)))))) ∙ (lCancel (rCancelₖ _ (f north))))) -inv suspFunCharac0 = ST.map λ f → suspΩFun 0 (fst f) +inv suspFunCharac0 = ST.map λ f → suspΩFun 0 (fst f) rightInv (suspFunCharac0 {A = A}) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ {(f , p) - → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) + → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) (funExt (λ x → (λ j → transp (λ i → helix (wedgeMapS¹ (intLoop (p j) (~ i)) base)) j ((transport (λ i → helix (T.rec isGroupoidS¹ (λ x → x) (rUnitₖ 1 ∣ intLoop (f x) i ∣ j))) (pos 0)))) ∙ windingℤLoop (f x))))} leftInv (suspFunCharac0 {A = A}) = - SuspCohomElim {A = A} _ (λ _ → isSetSetTrunc _ _) + SuspCohomElim {A = A} _ (λ _ → isSetSetTrunc _ _) λ f fId → cong ∣_∣₂ (funExt (linvLem 0 f fId)) -- We now prove that the alternative definition of cohomology is a cohomology theory. @@ -207,11 +207,11 @@ -- First, we need to that coHomFunctor' is contravariant theMorph : ∀ {ℓ} (n : ℤ) {A B : Pointed ℓ} (f : A →∙ B) → AbGroupHom (coHomFunctor' n B) (coHomFunctor' n A) - fst (theMorph (pos zero) f) = ST.map λ g → (λ x → fst g (fst f x)) , cong (fst g) (snd f) ∙ snd g + fst (theMorph (pos zero) f) = ST.map λ g → (λ x → fst g (fst f x)) , cong (fst g) (snd f) ∙ snd g snd (theMorph (pos zero) f) = makeIsGroupHom - (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ f g → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl)) + (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ f g → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl)) theMorph (pos (suc n)) f = coHomMorph _ (fst f) fst (theMorph (negsuc n) f) = idfun _ snd (theMorph (negsuc n) f) = makeIsGroupHom λ _ _ → refl @@ -227,7 +227,7 @@ (GroupIso→GroupEquiv ( invIso suspFunCharac0 , makeIsGroupHom - (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ f g → cong ∣_∣₂ (funExt λ { north → refl ; south → refl ; (merid a i) j → helper a (fst f) (fst g) j i})))) @@ -242,7 +242,7 @@ (GroupIso→GroupEquiv ( invIso (suspFunCharac {A = A} n) , makeIsGroupHom - (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ f g → cong ∣_∣₂ (funExt λ { north → refl ; south → refl ; (merid a i) j → helper a f g j i})))) @@ -260,12 +260,12 @@ -- naturality of the suspension isomorphism snd (Suspension (isCohomTheoryZ' {ℓ})) (f , p) (pos zero) = - funExt (ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + funExt (ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ {(f , _) → cong ∣_∣₂ (funExt λ {north → refl ; south → refl ; (merid a i) → refl})}) snd (Suspension (isCohomTheoryZ' {ℓ})) (f , p) (pos (suc n)) = - funExt (ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + funExt (ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ f → cong ∣_∣₂ (funExt λ {north → refl ; south → refl ; (merid a i) → refl})) @@ -278,41 +278,41 @@ exactnessIso : (n : ℤ) (f : A →∙ B) → Iso (Ker (theMorph n f)) (Im (theMorph n (cfcod (fst f) , refl))) fun (exactnessIso (pos zero) (f , p)) = - uncurry (ST.elim (λ _ → isSetΠ λ _ → isSetΣ isSetSetTrunc λ _ → isProp→isSet isPropPropTrunc) + uncurry (ST.elim (λ _ → isSetΠ λ _ → isSetΣ isSetSetTrunc λ _ → isProp→isSet isPropPropTrunc) λ {(g , q) inker → ∣ g , q ∣₂ , PT.rec isPropPropTrunc (λ gId → ∣ ∣ (λ { (inl tt) → 0 ; (inr b) → g b ; (push a i) → funExt⁻ (cong fst gId) a (~ i)}) , q ∣₂ - , cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl) ∣₁) - (Iso.fun PathIdTrunc₀Iso inker)}) + , cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl) ∣₁) + (Iso.fun PathIdTrunc₀Iso inker)}) inv (exactnessIso (pos zero) (f , p)) = - uncurry (ST.elim (λ _ → isSetΠ λ _ → isSetΣ isSetSetTrunc λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + uncurry (ST.elim (λ _ → isSetΠ λ _ → isSetΣ isSetSetTrunc λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ {(g , q) inim' → ∣ g , q ∣₂ - , PT.rec (isSetSetTrunc _ _) + , PT.rec (isSetSetTrunc _ _) (uncurry - (ST.elim (λ _ → isSetΠ (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _)) + (ST.elim (λ _ → isSetΠ (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _)) (λ pushmap pushId' - → PT.rec (isSetSetTrunc _ _) + → PT.rec (isSetSetTrunc _ _) (λ pushId - → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) + → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) (funExt λ x → sym (funExt⁻ (cong fst pushId) (f x)) ∙∙ cong (fst pushmap) (sym (push x) ∙ push (pt A)) ∙∙ (cong (fst pushmap ∘ inr) p ∙ snd pushmap)))) - (Iso.fun PathIdTrunc₀Iso pushId')))) + (Iso.fun PathIdTrunc₀Iso pushId')))) inim'}) rightInv (exactnessIso (pos zero) (f , p)) = uncurry (ST.elim (λ _ → isSetΠ λ _ → isOfHLevelPath 2 - (isSetΣ isSetSetTrunc + (isSetΣ isSetSetTrunc (λ _ → isProp→isSet isPropPropTrunc)) _ _) - λ {(p , q) _ → Σ≡Prop (λ _ → isPropPropTrunc) refl}) + λ {(p , q) _ → Σ≡Prop (λ _ → isPropPropTrunc) refl}) leftInv (exactnessIso (pos zero) (f , p)) = uncurry (ST.elim (λ _ → isSetΠ λ _ → isOfHLevelPath 2 - (isSetΣ isSetSetTrunc - (λ _ → isProp→isSet (isSetSetTrunc _ _))) _ _) - λ {(p , q) _ → Σ≡Prop (λ _ → isSetSetTrunc _ _) refl}) + (isSetΣ isSetSetTrunc + (λ _ → isProp→isSet (isSetSetTrunc _ _))) _ _) + λ {(p , q) _ → Σ≡Prop (λ _ → isSetSetTrunc _ _) refl}) fun (exactnessIso (pos (suc n)) f) ker = (fst ker) , inIm-helper (fst ker) (snd ker) where inIm-helper : (x : coHom (suc n) (typ B)) @@ -325,43 +325,43 @@ ; (inr b) → g b ; (push a i) → funExt⁻ gIdTot a (~ i)}) ∣₂ , cong ∣_∣₂ (funExt λ b → refl) ∣₁) - (Iso.fun PathIdTrunc₀Iso inker) + (Iso.fun PathIdTrunc₀Iso inker) inv (exactnessIso (pos (suc n)) f) im = fst im , inKer-helper (fst im) (snd im) where inKer-helper : (x : coHom (suc n) (typ B)) → isInIm (theMorph (pos (suc n)) {A = B} {B = _ , inr (pt B)} (cfcod (fst f) , refl)) x → isInKer (theMorph (pos (suc n)) {A = A} {B = B} f) x inKer-helper = - coHomPointedElim _ (pt B) (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) - λ g gId → PT.rec (isSetSetTrunc _ _) + coHomPointedElim _ (pt B) (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) + λ g gId → PT.rec (isSetSetTrunc _ _) (uncurry λ cg p → subst (isInKer (coHomMorph (suc n) (fst f))) p (helper cg)) where helper : (cg : _) → coHomFun (suc n) (fst f) (coHomFun (suc n) (cfcod (fst f)) cg) ≡ 0ₕ _ - helper = ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ cg → T.rec (isProp→isOfHLevelSuc n (isSetSetTrunc _ _)) + helper = ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ cg → T.rec (isProp→isOfHLevelSuc n (isSetSetTrunc _ _)) (λ p → (cong ∣_∣₂ (funExt λ x → cong cg (sym (push x)) ∙ p))) (isConnectedPathKn _ (cg (inl tt)) (0ₖ (suc n)) .fst) - rightInv (exactnessIso (pos (suc n)) f) _ = Σ≡Prop (λ _ → isPropPropTrunc) refl - leftInv (exactnessIso (pos (suc n)) f) _ = Σ≡Prop (λ _ → isSetSetTrunc _ _) refl + rightInv (exactnessIso (pos (suc n)) f) _ = Σ≡Prop (λ _ → isPropPropTrunc) refl + leftInv (exactnessIso (pos (suc n)) f) _ = Σ≡Prop (λ _ → isSetSetTrunc _ _) refl exactnessIso (negsuc n) (f , p) = isContr→Iso ((tt* , refl) - , λ {(tt* , p) → Σ≡Prop (λ _ → isOfHLevelPath 1 isPropUnit* _ _) + , λ {(tt* , p) → Σ≡Prop (λ _ → isOfHLevelPath 1 isPropUnit* _ _) refl}) ((tt* , ∣ tt* , refl ∣₁) - , λ {(tt* , p) → Σ≡Prop (λ _ → isPropPropTrunc) + , λ {(tt* , p) → Σ≡Prop (λ _ → isPropPropTrunc) refl}) -------------------------- Dimension --------------------------- Dimension isCohomTheoryZ' (pos zero) p = ⊥.rec (p refl) fst (Dimension isCohomTheoryZ' (pos (suc n)) _) = 0ₕ _ snd (Dimension isCohomTheoryZ' (pos (suc n)) _) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - (λ f → T.rec (isProp→isOfHLevelSuc n (isSetSetTrunc _ _)) - (λ f-true → T.rec (isProp→isOfHLevelSuc n (isSetSetTrunc _ _)) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (λ f → T.rec (isProp→isOfHLevelSuc n (isSetSetTrunc _ _)) + (λ f-true → T.rec (isProp→isOfHLevelSuc n (isSetSetTrunc _ _)) (λ f-false → cong ∣_∣₂ (funExt (λ {(lift true) → f-true ; (lift false) → f-false}))) (isConnectedPathKn n (0ₖ _) (f (lift false)) .fst)) diff --git a/Cubical.ZCohomology.GroupStructure.html b/Cubical.ZCohomology.GroupStructure.html index 5e172ad39d..5a01b49fe8 100644 --- a/Cubical.ZCohomology.GroupStructure.html +++ b/Cubical.ZCohomology.GroupStructure.html @@ -29,7 +29,7 @@ open import Cubical.HITs.S1 open import Cubical.HITs.Sn open import Cubical.HITs.Susp -open import Cubical.HITs.SetTruncation as ST renaming (isSetSetTrunc to §) +open import Cubical.HITs.SetTruncation as ST renaming (isSetSetTrunc to §) open import Cubical.HITs.Truncation as T open import Cubical.Homotopy.Loopspace @@ -526,7 +526,7 @@ commₕ∙ zero = ST.elim2 (λ _ _ → isOfHLevelPath 2 § _ _) λ {(f , p) (g , q) - → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) λ i x → commₖ 0 (f x) (g x) i)} + → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) λ i x → commₖ 0 (f x) (g x) i)} commₕ∙ (suc zero) = ST.elim2 (λ _ _ → isOfHLevelPath 2 § _ _) λ {(f , p) (g , q) @@ -545,7 +545,7 @@ rUnitₕ∙ : {A : Pointed ℓ} (n : ℕ) (x : coHomRed n A) → x +[ n ]ₕ∙ 0ₕ∙ n ≡ x rUnitₕ∙ zero = ST.elim (λ _ → isOfHLevelPath 2 § _ _) - λ {(f , p) → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) λ i x → rUnitₖ zero (f x) i)} + λ {(f , p) → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) λ i x → rUnitₖ zero (f x) i)} rUnitₕ∙ (suc zero) = ST.elim (λ _ → isOfHLevelPath 2 § _ _) λ {(f , p) → cong ∣_∣₂ (ΣPathP ((λ i x → rUnitₖ 1 (f x) i) , λ i j → rUnitₖ 1 (p j) i))} @@ -556,7 +556,7 @@ lUnitₕ∙ : {A : Pointed ℓ} (n : ℕ) (x : coHomRed n A) → 0ₕ∙ n +[ n ]ₕ∙ x ≡ x lUnitₕ∙ zero = ST.elim (λ _ → isOfHLevelPath 2 § _ _) - λ {(f , p) → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) λ i x → lUnitₖ zero (f x) i)} + λ {(f , p) → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) λ i x → lUnitₖ zero (f x) i)} lUnitₕ∙ (suc zero) = ST.elim (λ _ → isOfHLevelPath 2 § _ _) λ {(f , p) → cong ∣_∣₂ (ΣPathP ((λ i x → lUnitₖ 1 (f x) i) , λ i j → lUnitₖ 1 (p j) i))} @@ -580,7 +580,7 @@ rCancelₕ∙ : {A : Pointed ℓ} (n : ℕ) (x : coHomRed n A) → x +[ n ]ₕ∙ (-[ n ]ₕ∙ x) ≡ 0ₕ∙ n rCancelₕ∙ zero = ST.elim (λ _ → isOfHLevelPath 2 § _ _) - λ {(f , p) → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) λ i x → rCancelₖ zero (f x) i)} + λ {(f , p) → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) λ i x → rCancelₖ zero (f x) i)} rCancelₕ∙ {A = A} (suc zero) = ST.elim (λ _ → isOfHLevelPath 2 § _ _) λ {(f , p) → cong ∣_∣₂ (ΣPathP ((λ i x → rCancelₖ 1 (f x) i) , λ i j → rCancelₖ 1 (p j) i))} @@ -593,7 +593,7 @@ lCancelₕ∙ : {A : Pointed ℓ} (n : ℕ) (x : coHomRed n A) → (-[ n ]ₕ∙ x) +[ n ]ₕ∙ x ≡ 0ₕ∙ n lCancelₕ∙ zero = ST.elim (λ _ → isOfHLevelPath 2 § _ _) - λ {(f , p) → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) λ i x → lCancelₖ zero (f x) i)} + λ {(f , p) → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) λ i x → lCancelₖ zero (f x) i)} lCancelₕ∙ {A = A} (suc zero) = ST.elim (λ _ → isOfHLevelPath 2 § _ _) λ {(f , p) @@ -610,7 +610,7 @@ assocₕ∙ zero = ST.elim3 (λ _ _ _ → isOfHLevelPath 2 § _ _) λ {(f , p) (g , q) (h , r) - → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) + → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) (λ i x → assocₖ zero (f x) (g x) (h x) i))} assocₕ∙ (suc zero) = ST.elim3 (λ _ _ _ → isOfHLevelPath 2 § _ _) @@ -705,13 +705,13 @@ coHomGrnA : GroupStr ∥ (A → typ (Ω (coHomK-ptd (suc n)))) ∥₂ 1g coHomGrnA = ∣ (λ _ → refl) ∣₂ GroupStr._·_ coHomGrnA = ST.rec2 § λ p q → ∣ (λ x → p x ∙ q x) ∣₂ - inv coHomGrnA = ST.map λ f x → sym (f x) + inv coHomGrnA = ST.map λ f x → sym (f x) isGroup coHomGrnA = helper where abstract helper : IsGroup {G = ∥ (A → typ (Ω (coHomK-ptd (suc n)))) ∥₂} - (∣ (λ _ → refl) ∣₂) (ST.rec2 § λ p q → ∣ (λ x → p x ∙ q x) ∣₂) (ST.map λ f x → sym (f x)) + (∣ (λ _ → refl) ∣₂) (ST.rec2 § λ p q → ∣ (λ x → p x ∙ q x) ∣₂) (ST.map λ f x → sym (f x)) helper = makeIsGroup § (ST.elim3 (λ _ _ _ → isOfHLevelPath 2 § _ _) (λ p q r → cong ∣_∣₂ (funExt λ x → assoc∙ (p x) (q x) (r x)))) (ST.elim (λ _ → isOfHLevelPath 2 § _ _) λ p → cong ∣_∣₂ (funExt λ x → sym (rUnit (p x)))) diff --git a/Cubical.ZCohomology.Groups.CP2.html b/Cubical.ZCohomology.Groups.CP2.html index a393679534..0b7a663fa0 100644 --- a/Cubical.ZCohomology.Groups.CP2.html +++ b/Cubical.ZCohomology.Groups.CP2.html @@ -86,12 +86,12 @@ where isContrH¹TotalHopf : isContr (coHom 1 TotalHopf) isContrH¹TotalHopf = - isOfHLevelRetractFromIso 0 (setTruncIso (domIso (invIso (IsoS³TotalHopf)))) + isOfHLevelRetractFromIso 0 (setTruncIso (domIso (invIso (IsoS³TotalHopf)))) (isOfHLevelRetractFromIso 0 ((fst (H¹-Sⁿ≅0 1))) isContrUnit) isContrH²TotalHopf : isContr (coHom 2 TotalHopf) isContrH²TotalHopf = - isOfHLevelRetractFromIso 0 (setTruncIso (domIso (invIso (IsoS³TotalHopf)))) + isOfHLevelRetractFromIso 0 (setTruncIso (domIso (invIso (IsoS³TotalHopf)))) ((isOfHLevelRetractFromIso 0 (fst (Hⁿ-Sᵐ≅0 1 2 λ p → snotz (sym (cong predℕ p)))) isContrUnit)) @@ -162,18 +162,18 @@ H¹-CP²≅0 : GroupIso (coHomGr 1 CP²) UnitGroup₀ H¹-CP²≅0 = contrGroupIsoUnit - (isOfHLevelRetractFromIso 0 (setTruncIso characFunSpaceCP²) + (isOfHLevelRetractFromIso 0 (setTruncIso characFunSpaceCP²) (isOfHLevelRetractFromIso 0 lem₂ lem₃)) where lem₁ : (f : (Susp S¹ → coHomK 1)) → ∥ (λ _ → 0ₖ _) ≡ f ∥₁ lem₁ f = PT.map (λ p → p) - (Iso.fun PathIdTrunc₀Iso (isOfHLevelRetractFromIso 1 + (Iso.fun PathIdTrunc₀Iso (isOfHLevelRetractFromIso 1 (fst (Hⁿ-Sᵐ≅0 0 1 (λ p → snotz (sym p)))) isPropUnit (0ₕ _) ∣ f ∣₂)) lem₂ : Iso ∥ (Σ[ x ∈ coHomK 1 ] ( Σ[ f ∈ (Susp S¹ → coHomK 1) ] ((y : TotalHopf) → f (fst y) ≡ x))) ∥₂ ∥ (Σ[ f ∈ (Susp S¹ → coHomK 1) ] ((y : TotalHopf) → f (fst y) ≡ 0ₖ 1)) ∥₂ - fun lem₂ = ST.map (uncurry λ x → uncurry λ f p → (λ y → (-ₖ x) +ₖ f y) , λ y → cong ((-ₖ x) +ₖ_) (p y) ∙ lCancelₖ _ x) - inv lem₂ = ST.map λ p → 0ₖ _ , p + fun lem₂ = ST.map (uncurry λ x → uncurry λ f p → (λ y → (-ₖ x) +ₖ f y) , λ y → cong ((-ₖ x) +ₖ_) (p y) ∙ lCancelₖ _ x) + inv lem₂ = ST.map λ p → 0ₖ _ , p rightInv lem₂ = ST.elim (λ _ → isOfHLevelPath 2 squash₂ _ _) λ {(f , p) → cong ∣_∣₂ (ΣPathP ((funExt (λ x → lUnitₖ _ (f x))) @@ -286,7 +286,7 @@ compEquiv (m.TotalSpaceHopfPush→TotalSpace , m.isEquivTotalSpaceHopfPush→TotalSpace) - (Σ-cong-equiv (idEquiv _) + (Σ-cong-equiv (idEquiv _) λ x → F x , F-eq x) CP²-iso : Iso CP2 (Pushout {A = TotalHopf} (λ _ → tt) fst) diff --git a/Cubical.ZCohomology.Groups.Connected.html b/Cubical.ZCohomology.Groups.Connected.html index 49ca535ce2..bd4ebcc77e 100644 --- a/Cubical.ZCohomology.Groups.Connected.html +++ b/Cubical.ZCohomology.Groups.Connected.html @@ -34,7 +34,7 @@ Iso.inv (H⁰-connected-type a con) b = ∣ (λ x → b) ∣₂ Iso.rightInv (H⁰-connected-type a con) b = refl Iso.leftInv (H⁰-connected-type a con) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ f → cong ∣_∣₂ (funExt λ x → T.rec₊ (isSetℤ _ _) (cong f) (isConnectedPath 1 con a x .fst)) open IsGroupHom @@ -45,7 +45,7 @@ inv (fst (H⁰-connected a con)) b = ∣ (λ _ → b) ∣₂ rightInv (fst (H⁰-connected a con)) _ = refl leftInv (fst (H⁰-connected a con)) = - ST.elim (λ _ → isProp→isSet (isSetSetTrunc _ _)) + ST.elim (λ _ → isProp→isSet (isSetSetTrunc _ _)) (λ f → cong ∣_∣₂ (funExt λ x → PT.rec (isSetℤ _ _) (cong f) (con x))) snd (H⁰-connected a con) = makeIsGroupHom (ST.elim2 (λ _ _ → isProp→isSet (isSetℤ _ _)) λ x y → refl) \ No newline at end of file diff --git a/Cubical.ZCohomology.Groups.KleinBottle.html b/Cubical.ZCohomology.Groups.KleinBottle.html index 9c624c9a89..69fdd5ad07 100644 --- a/Cubical.ZCohomology.Groups.KleinBottle.html +++ b/Cubical.ZCohomology.Groups.KleinBottle.html @@ -104,7 +104,7 @@ inv (fst H⁰-𝕂²≅ℤ) x = ∣ (λ _ → x) ∣₂ rightInv (fst H⁰-𝕂²≅ℤ) _ = refl leftInv (fst H⁰-𝕂²≅ℤ) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ f → cong ∣_∣₂ (funExt (λ {point → refl ; (line1 i) j → isSetℤ (f point) (f point) refl (cong f line1) j i ; (line2 i) j → isSetℤ (f point) (f point) refl (cong f line2) j i @@ -171,7 +171,7 @@ leftInv Iso-H¹-𝕂²₁ (x , (p , (q , P))) = ΣPathP (refl , (ΣPathP (sym (nilpotent→≡refl x p P) - , toPathP (Σ≡Prop (λ _ → isOfHLevelTrunc 3 _ _ _ _) + , toPathP (Σ≡Prop (λ _ → isOfHLevelTrunc 3 _ _ _ _) (transportRefl q))))) {- But this is precisely the type (minus set-truncation) of H¹(S¹) -} @@ -183,11 +183,11 @@ where theIso : Iso (coHom 1 KleinBottle) (coHom 1 S¹) theIso = - setTruncIso ( + setTruncIso ( compIso (characFunSpace𝕂² (coHomK 1)) (compIso - (Σ-cong-iso-snd (λ x → Σ-cong-iso-snd - λ p → Σ-cong-iso-snd + (Σ-cong-iso-snd (λ x → Σ-cong-iso-snd + λ p → Σ-cong-iso-snd λ q → movePathIso p q (isCommΩK-based 1 x))) (compIso Iso-H¹-𝕂²₁ Iso-H¹-𝕂²₂))) @@ -195,7 +195,7 @@ is-hom : IsGroupHom (coHomGr 1 KleinBottle .snd) (fun theIso) (coHomGr 1 S¹ .snd) is-hom = makeIsGroupHom - (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ f g → cong ∣_∣₂ (funExt λ {base → refl ; (loop i) → refl})) theGroupIso : GroupIso (coHomGr 1 KleinBottle) (coHomGr 1 S¹) @@ -216,29 +216,29 @@ Iso-H²-𝕂²₁ : Iso ∥ Σ[ x ∈ coHomK 2 ] Σ[ p ∈ x ≡ x ] Σ[ q ∈ x ≡ x ] p ∙ p ≡ refl ∥₂ ∥ Σ[ p ∈ 0ₖ 2 ≡ 0ₖ 2 ] p ∙ p ≡ refl ∥₂ fun Iso-H²-𝕂²₁ = - ST.rec isSetSetTrunc - (uncurry (T.elim (λ _ → is2GroupoidΠ λ _ → isOfHLevelPlus {n = 2} 2 isSetSetTrunc) - (sphereElim _ (λ _ → isSetΠ λ _ → isSetSetTrunc) + ST.rec isSetSetTrunc + (uncurry (T.elim (λ _ → is2GroupoidΠ λ _ → isOfHLevelPlus {n = 2} 2 isSetSetTrunc) + (sphereElim _ (λ _ → isSetΠ λ _ → isSetSetTrunc) λ y → ∣ fst y , snd (snd y) ∣₂))) inv Iso-H²-𝕂²₁ = - ST.map λ p → (0ₖ 2) , ((fst p) , (refl , (snd p))) + ST.map λ p → (0ₖ 2) , ((fst p) , (refl , (snd p))) rightInv Iso-H²-𝕂²₁ = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ p → refl leftInv Iso-H²-𝕂²₁ = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - (uncurry (T.elim (λ _ → is2GroupoidΠ λ _ → isOfHLevelPlus {n = 1} 3 (isSetSetTrunc _ _)) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (uncurry (T.elim (λ _ → is2GroupoidΠ λ _ → isOfHLevelPlus {n = 1} 3 (isSetSetTrunc _ _)) (sphereToPropElim _ - (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) + (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) λ {(p , (q , sq)) - → T.rec (isSetSetTrunc _ _) + → T.rec (isSetSetTrunc _ _) (λ qid → cong ∣_∣₂ (ΣPathP (refl , (ΣPathP (refl , (ΣPathP (sym qid , refl))))))) (fun (PathIdTruncIso _) (isContr→isProp (isConnectedPathKn 1 (0ₖ 2) (0ₖ 2)) ∣ q ∣ ∣ refl ∣))}))) {- Step two : ∥ Σ[ p ∈ x ≡ x ] p ∙ p ≡ refl ∥₂ ≡ ∥ Σ[ x ∈ K₁ ] x + x ≡ 0 ∥₂ -} Iso-H²-𝕂²₂ : Iso ∥ (Σ[ p ∈ 0ₖ 2 ≡ 0ₖ 2 ] p ∙ p ≡ refl) ∥₂ ∥ Σ[ x ∈ coHomK 1 ] x +ₖ x ≡ 0ₖ 1 ∥₂ -Iso-H²-𝕂²₂ = setTruncIso (Σ-cong-iso {B' = λ x → x +ₖ x ≡ 0ₖ 1} (invIso (Iso-Kn-ΩKn+1 1)) +Iso-H²-𝕂²₂ = setTruncIso (Σ-cong-iso {B' = λ x → x +ₖ x ≡ 0ₖ 1} (invIso (Iso-Kn-ΩKn+1 1)) λ p → compIso (congIso (invIso (Iso-Kn-ΩKn+1 1))) (pathToIso λ i → ΩKn+1→Kn-hom 1 p p i ≡ 0ₖ 1)) @@ -298,13 +298,13 @@ private _*_ : ∥ Σ[ x ∈ coHomK 1 ] x +ₖ x ≡ 0ₖ 1 ∥₂ → ∥ Σ[ x ∈ coHomK 1 ] x +ₖ x ≡ 0ₖ 1 ∥₂ → ∥ Σ[ x ∈ coHomK 1 ] x +ₖ x ≡ 0ₖ 1 ∥₂ - _*_ = ST.rec (isSetΠ (λ _ → isSetSetTrunc)) λ a → ST.rec isSetSetTrunc λ b → *' (fst a) (fst b) (snd a) (snd b) + _*_ = ST.rec (isSetΠ (λ _ → isSetSetTrunc)) λ a → ST.rec isSetSetTrunc λ b → *' (fst a) (fst b) (snd a) (snd b) where *' : (x y : coHomK 1) (p : x +ₖ x ≡ 0ₖ 1) (q : y +ₖ y ≡ 0ₖ 1) → ∥ Σ[ x ∈ coHomK 1 ] x +ₖ x ≡ 0ₖ 1 ∥₂ *' = - T.elim2 (λ _ _ → isGroupoidΠ2 λ _ _ → isOfHLevelSuc 2 isSetSetTrunc) + T.elim2 (λ _ _ → isGroupoidΠ2 λ _ _ → isOfHLevelSuc 2 isSetSetTrunc) (wedgeconFun _ _ - (λ _ _ → isSetΠ2 λ _ _ → isSetSetTrunc) + (λ _ _ → isSetΠ2 λ _ _ → isSetSetTrunc) (λ x p q → ∣ ∣ x ∣ , cong₂ _+ₖ_ p q ∣₂) (λ y p q → ∣ ∣ y ∣ , sym (rUnitₖ 1 (∣ y ∣ +ₖ ∣ y ∣)) ∙ cong₂ _+ₖ_ p q ∣₂) (funExt λ p → funExt λ q → cong ∣_∣₂ (ΣPathP (refl , (sym (lUnit _)))))) @@ -380,10 +380,10 @@ rightInv testIso false = refl rightInv testIso true = refl leftInv testIso = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) (uncurry (T.elim - (λ _ → isGroupoidΠ λ _ → isOfHLevelPlus {n = 1} 2 (isSetSetTrunc _ _)) - (toPropElim (λ _ → isPropΠ (λ _ → isSetSetTrunc _ _)) + (λ _ → isGroupoidΠ λ _ → isOfHLevelPlus {n = 1} 2 (isSetSetTrunc _ _)) + (toPropElim (λ _ → isPropΠ (λ _ → isSetSetTrunc _ _)) (λ p → path p (isEven (ΩKn+1→Kn 0 p)) refl)))) where path : (p : 0ₖ 1 ≡ 0ₖ 1) (b : Bool) → (isEven (ΩKn+1→Kn 0 p) ≡ b) @@ -403,11 +403,11 @@ where theIso : Iso _ _ theIso = - compIso (setTruncIso + compIso (setTruncIso (compIso (characFunSpace𝕂² (coHomK 2)) - (Σ-cong-iso-snd - λ x → Σ-cong-iso-snd - λ p → Σ-cong-iso-snd + (Σ-cong-iso-snd + λ x → Σ-cong-iso-snd + λ p → Σ-cong-iso-snd λ q → (movePathIso p q (isCommΩK-based 2 x))))) (compIso Iso-H²-𝕂²₁ (compIso @@ -418,7 +418,7 @@ isContrHⁿ-𝕂² : (n : ℕ) → isContr (coHom (3 + n) KleinBottle) isContrHⁿ-𝕂² n = isOfHLevelRetractFromIso 0 - (setTruncIso (characFunSpace𝕂² (coHomK _))) + (setTruncIso (characFunSpace𝕂² (coHomK _))) isContrΣ-help where helper : (x : coHomK (3 + n))(p : x ≡ x) → (refl ≡ p) → (q : x ≡ x) → (refl ≡ q) @@ -427,8 +427,8 @@ ∣ x , p , q , P ∣₂ ∣ 0ₖ _ , refl , refl , sym (rUnit refl) ∣₂ helper = - T.elim (λ _ → isProp→isOfHLevelSuc (4 + n) (isPropΠ4 λ _ _ _ _ → isPropΠ λ _ → isSetSetTrunc _ _)) - (sphereToPropElim _ (λ _ → isPropΠ4 λ _ _ _ _ → isPropΠ λ _ → isSetSetTrunc _ _) + T.elim (λ _ → isProp→isOfHLevelSuc (4 + n) (isPropΠ4 λ _ _ _ _ → isPropΠ λ _ → isSetSetTrunc _ _)) + (sphereToPropElim _ (λ _ → isPropΠ4 λ _ _ _ _ → isPropΠ λ _ → isSetSetTrunc _ _) λ p → J (λ p _ → (q : 0ₖ _ ≡ 0ₖ _) → (refl ≡ q) → (P : p ∙∙ q ∙∙ p ≡ q) → Path ∥ (Σ[ x ∈ coHomK (3 + n) ] Σ[ p ∈ x ≡ x ] Σ[ q ∈ x ≡ x ] p ∙∙ q ∙∙ p ≡ q) ∥₂ @@ -438,7 +438,7 @@ → Path ∥ (Σ[ x ∈ coHomK (3 + n) ] Σ[ p ∈ x ≡ x ] Σ[ q ∈ x ≡ x ] p ∙∙ q ∙∙ p ≡ q) ∥₂ ∣ 0ₖ _ , refl , q , P ∣₂ ∣ 0ₖ _ , refl , refl , sym (rUnit refl) ∣₂) - λ P → T.rec (isProp→isOfHLevelSuc n (isSetSetTrunc _ _)) + λ P → T.rec (isProp→isOfHLevelSuc n (isSetSetTrunc _ _)) (λ P≡rUnitrefl i → ∣ 0ₖ (3 + n) , refl , refl , P≡rUnitrefl i ∣₂) (fun (PathIdTruncIso _) (isContr→isProp (isConnectedPath _ (isConnectedPathKn (2 + n) _ _) @@ -448,10 +448,10 @@ isContrΣ-help : isContr ∥ (Σ[ x ∈ coHomK (3 + n) ] Σ[ p ∈ x ≡ x ] Σ[ q ∈ x ≡ x ] p ∙∙ q ∙∙ p ≡ q) ∥₂ fst isContrΣ-help = ∣ 0ₖ _ , refl , refl , sym (rUnit refl) ∣₂ snd isContrΣ-help = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ {(x , p , q , P) - → T.rec (isProp→isOfHLevelSuc (suc n) (isSetSetTrunc _ _)) - (λ pId → T.rec (isProp→isOfHLevelSuc (suc n) (isSetSetTrunc _ _)) + → T.rec (isProp→isOfHLevelSuc (suc n) (isSetSetTrunc _ _)) + (λ pId → T.rec (isProp→isOfHLevelSuc (suc n) (isSetSetTrunc _ _)) (λ qId → sym (helper x p pId q qId P)) (fun (PathIdTruncIso (2 + n)) (isContr→isProp (isConnectedPathKn (2 + n) _ _) ∣ refl ∣ ∣ q ∣))) diff --git a/Cubical.ZCohomology.Groups.Prelims.html b/Cubical.ZCohomology.Groups.Prelims.html index 99e9d86611..cb96868faf 100644 --- a/Cubical.ZCohomology.Groups.Prelims.html +++ b/Cubical.ZCohomology.Groups.Prelims.html @@ -138,7 +138,7 @@ {- Proof that (S¹ → K₁) ≃ K₁ × ℤ. Needed for H¹(T²) -} S1→K₁≡S1×ℤ : Iso ((S₊ 1) → coHomK 1) (coHomK 1 × ℤ) -S1→K₁≡S1×ℤ = S¹→S¹≡S¹×ℤ ⋄ prodIso (invIso (truncIdempotentIso 3 (isGroupoidS¹))) idIso +S1→K₁≡S1×ℤ = S¹→S¹≡S¹×ℤ ⋄ prodIso (invIso (truncIdempotentIso 3 (isGroupoidS¹))) idIso module _ (key : Unit') where module P = lockedCohom key diff --git a/Cubical.ZCohomology.Groups.RP2.html b/Cubical.ZCohomology.Groups.RP2.html index 533daaf7d7..ecdd84a216 100644 --- a/Cubical.ZCohomology.Groups.RP2.html +++ b/Cubical.ZCohomology.Groups.RP2.html @@ -87,12 +87,12 @@ isContr-H¹-RP²-helper : isContr ∥ Σ[ x ∈ coHomK 1 ] Σ[ p ∈ x ≡ x ] p ∙ p ≡ refl ∥₂ fst isContr-H¹-RP²-helper = ∣ 0ₖ 1 , refl , sym (rUnit refl) ∣₂ snd isContr-H¹-RP²-helper = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) (uncurry - (T.elim (λ _ → isGroupoidΠ λ _ → isOfHLevelPlus {n = 1} 2 (isSetSetTrunc _ _)) - (toPropElim (λ _ → isPropΠ (λ _ → isSetSetTrunc _ _)) + (T.elim (λ _ → isGroupoidΠ λ _ → isOfHLevelPlus {n = 1} 2 (isSetSetTrunc _ _)) + (toPropElim (λ _ → isPropΠ (λ _ → isSetSetTrunc _ _)) λ {(p , nilp) - → cong ∣_∣₂ (ΣPathP (refl , Σ≡Prop (λ _ → isOfHLevelTrunc 3 _ _ _ _) + → cong ∣_∣₂ (ΣPathP (refl , Σ≡Prop (λ _ → isOfHLevelTrunc 3 _ _ _ _) (rUnit refl ∙∙ cong (Kn→ΩKn+1 0) (sym (nilpotent→≡0 (ΩKn+1→Kn 0 p) (sym (ΩKn+1→Kn-hom 0 p p) @@ -103,8 +103,8 @@ H¹-RP²≅0 = contrGroupIsoUnit (isOfHLevelRetractFromIso 0 - (setTruncIso (compIso funSpaceIso-RP² - (Σ-cong-iso-snd (λ _ → Σ-cong-iso-snd λ _ → pathIso)))) + (setTruncIso (compIso funSpaceIso-RP² + (Σ-cong-iso-snd (λ _ → Σ-cong-iso-snd λ _ → pathIso)))) isContr-H¹-RP²-helper) --- H²(RP²) ≅ ℤ/2ℤ ---- @@ -112,28 +112,28 @@ Iso-H²-RP²₁ : Iso ∥ Σ[ x ∈ coHomK 2 ] Σ[ p ∈ x ≡ x ] p ≡ sym p ∥₂ ∥ Σ[ p ∈ 0ₖ 2 ≡ 0ₖ 2 ] p ≡ sym p ∥₂ Iso.fun Iso-H²-RP²₁ = - ST.rec isSetSetTrunc + ST.rec isSetSetTrunc (uncurry - (T.elim (λ _ → is2GroupoidΠ λ _ → isOfHLevelPlus {n = 2} 2 isSetSetTrunc) - (sphereElim _ (λ _ → isSetΠ (λ _ → isSetSetTrunc)) + (T.elim (λ _ → is2GroupoidΠ λ _ → isOfHLevelPlus {n = 2} 2 isSetSetTrunc) + (sphereElim _ (λ _ → isSetΠ (λ _ → isSetSetTrunc)) λ p → ∣ fst p , snd p ∣₂))) -Iso.inv Iso-H²-RP²₁ = ST.map λ p → (0ₖ 2) , p -Iso.rightInv Iso-H²-RP²₁ = ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) +Iso.inv Iso-H²-RP²₁ = ST.map λ p → (0ₖ 2) , p +Iso.rightInv Iso-H²-RP²₁ = ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ _ → refl Iso.leftInv Iso-H²-RP²₁ = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - (uncurry (T.elim (λ _ → is2GroupoidΠ λ _ → isOfHLevelPlus {n = 1} 3 (isSetSetTrunc _ _)) - (sphereToPropElim _ (λ _ → isPropΠ (λ _ → isSetSetTrunc _ _)) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (uncurry (T.elim (λ _ → is2GroupoidΠ λ _ → isOfHLevelPlus {n = 1} 3 (isSetSetTrunc _ _)) + (sphereToPropElim _ (λ _ → isPropΠ (λ _ → isSetSetTrunc _ _)) λ p → refl))) Iso-H²-RP²₂ : Iso ∥ Σ[ p ∈ 0ₖ 2 ≡ 0ₖ 2 ] p ≡ sym p ∥₂ Bool -Iso-H²-RP²₂ = compIso (setTruncIso (Σ-cong-iso-snd λ _ → pathIso)) +Iso-H²-RP²₂ = compIso (setTruncIso (Σ-cong-iso-snd λ _ → pathIso)) (compIso Iso-H²-𝕂²₂ testIso) H²-RP²≅Bool : GroupIso (coHomGr 2 RP²) BoolGroup H²-RP²≅Bool = invGroupIso (≅Bool (compIso - (compIso (setTruncIso funSpaceIso-RP²) + (compIso (setTruncIso funSpaceIso-RP²) Iso-H²-RP²₁) Iso-H²-RP²₂)) @@ -141,7 +141,7 @@ Hⁿ-RP²Contr : (n : ℕ) → isContr (coHom (3 + n) RP²) Hⁿ-RP²Contr n = subst isContr - (isoToPath (setTruncIso (invIso (funSpaceIso-RP²)))) + (isoToPath (setTruncIso (invIso (funSpaceIso-RP²)))) (∣ c ∣₂ , c-id) where c : Σ[ x ∈ coHomK (3 + n) ] Σ[ p ∈ x ≡ x ] p ≡ sym p diff --git a/Cubical.ZCohomology.Groups.Sn.html b/Cubical.ZCohomology.Groups.Sn.html index 0d2a087be6..98fb811d5b 100644 --- a/Cubical.ZCohomology.Groups.Sn.html +++ b/Cubical.ZCohomology.Groups.Sn.html @@ -64,7 +64,7 @@ suspensionAx-Sn : (n m : ℕ) → GroupIso (coHomGr (2 + n) (S₊ (2 + m))) (coHomGr (suc n) (S₊ (suc m))) suspensionAx-Sn n m = - compIso (setTruncIso (invIso funSpaceSuspIso)) helperIso , + compIso (setTruncIso (invIso funSpaceSuspIso)) helperIso , makeIsGroupHom funIsHom where helperIso : Iso ∥ (Σ[ x ∈ coHomK (2 + n) ] @@ -72,43 +72,43 @@ (S₊ (suc m) → x ≡ y)) ∥₂ (coHom (suc n) (S₊ (suc m))) Iso.fun helperIso = - ST.rec isSetSetTrunc + ST.rec isSetSetTrunc (uncurry (coHomK-elim _ (λ _ → isOfHLevelΠ (2 + n) - λ _ → isOfHLevelPlus' {n = n} 2 isSetSetTrunc) + λ _ → isOfHLevelPlus' {n = n} 2 isSetSetTrunc) (uncurry (coHomK-elim _ (λ _ → isOfHLevelΠ (2 + n) - λ _ → isOfHLevelPlus' {n = n} 2 isSetSetTrunc) + λ _ → isOfHLevelPlus' {n = n} 2 isSetSetTrunc) λ f → ∣ (λ x → ΩKn+1→Kn (suc n) (f x)) ∣₂)))) Iso.inv helperIso = - ST.map λ f → (0ₖ _) , (0ₖ _ , λ x → Kn→ΩKn+1 (suc n) (f x)) + ST.map λ f → (0ₖ _) , (0ₖ _ , λ x → Kn→ΩKn+1 (suc n) (f x)) Iso.rightInv helperIso = - coHomPointedElim _ (ptSn (suc m)) (λ _ → isSetSetTrunc _ _) + coHomPointedElim _ (ptSn (suc m)) (λ _ → isSetSetTrunc _ _) λ f fId → cong ∣_∣₂ (funExt (λ x → Iso.leftInv (Iso-Kn-ΩKn+1 _) (f x))) Iso.leftInv helperIso = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) (uncurry (coHomK-elim _ - (λ _ → isProp→isOfHLevelSuc (suc n) (isPropΠ λ _ → isSetSetTrunc _ _)) + (λ _ → isProp→isOfHLevelSuc (suc n) (isPropΠ λ _ → isSetSetTrunc _ _)) (uncurry (coHomK-elim _ - (λ _ → isProp→isOfHLevelSuc (suc n) (isPropΠ λ _ → isSetSetTrunc _ _)) + (λ _ → isProp→isOfHLevelSuc (suc n) (isPropΠ λ _ → isSetSetTrunc _ _)) λ f → cong ∣_∣₂ (ΣPathP (refl , ΣPathP (refl , (λ i x → Iso.rightInv (Iso-Kn-ΩKn+1 (suc n)) (f x) i)))))))) theFun : coHom (2 + n) (S₊ (2 + m)) → coHom (suc n) (S₊ (suc m)) - theFun = Iso.fun (compIso (setTruncIso (invIso funSpaceSuspIso)) + theFun = Iso.fun (compIso (setTruncIso (invIso funSpaceSuspIso)) helperIso) funIsHom : (x y : coHom (2 + n) (S₊ (2 + m))) → theFun (x +ₕ y) ≡ theFun x +ₕ theFun y funIsHom = - coHomPointedElimSⁿ _ _ (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) - λ f → coHomPointedElimSⁿ _ _ (λ _ → isSetSetTrunc _ _) + coHomPointedElimSⁿ _ _ (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) + λ f → coHomPointedElimSⁿ _ _ (λ _ → isSetSetTrunc _ _) λ g → cong ∣_∣₂ (funExt λ x → cong (ΩKn+1→Kn (suc n)) (sym (∙≡+₂ n (f x) (g x))) ∙ ΩKn+1→Kn-hom (suc n) (f x) (g x)) @@ -129,11 +129,11 @@ coHomPushout≅coHomSn : (n m : ℕ) → GroupIso (coHomGr m (S₊ (suc n))) (coHomGr m (Pushout {A = S₊ n} (λ _ → tt) λ _ → tt)) coHomPushout≅coHomSn zero m = - setTruncIso (domIso S1Iso) , - makeIsGroupHom (ST.elim2 (λ _ _ → isSet→isGroupoid isSetSetTrunc _ _) (λ _ _ → refl)) + setTruncIso (domIso S1Iso) , + makeIsGroupHom (ST.elim2 (λ _ _ → isSet→isGroupoid isSetSetTrunc _ _) (λ _ _ → refl)) coHomPushout≅coHomSn (suc n) m = - setTruncIso (domIso (invIso PushoutSuspIsoSusp)) , - makeIsGroupHom (ST.elim2 (λ _ _ → isSet→isGroupoid isSetSetTrunc _ _) (λ _ _ → refl)) + setTruncIso (domIso (invIso PushoutSuspIsoSusp)) , + makeIsGroupHom (ST.elim2 (λ _ _ → isSet→isGroupoid isSetSetTrunc _ _) (λ _ _ → refl)) -------------------------- H⁰(S⁰) ----------------------------- S0→ℤ : (a : ℤ × ℤ) → S₊ 0 → ℤ @@ -145,7 +145,7 @@ inv (fst H⁰-S⁰≅ℤ×ℤ) a = ∣ S0→ℤ a ∣₂ rightInv (fst H⁰-S⁰≅ℤ×ℤ) _ = refl leftInv (fst H⁰-S⁰≅ℤ×ℤ) = - ST.elim (λ _ → isSet→isGroupoid isSetSetTrunc _ _) + ST.elim (λ _ → isSet→isGroupoid isSetSetTrunc _ _) (λ f → cong ∣_∣₂ (funExt (λ {true → refl ; false → refl}))) snd H⁰-S⁰≅ℤ×ℤ = makeIsGroupHom @@ -164,27 +164,27 @@ Iso.leftInv (Hⁿ-S0≃Kₙ×Kₙ n) b = funExt λ {true → refl ; false → refl} isContrHⁿ-S0 : (n : ℕ) → isContr (coHom (suc n) (S₊ 0)) - isContrHⁿ-S0 n = isContrRetract (Iso.fun (setTruncIso (Hⁿ-S0≃Kₙ×Kₙ n))) - (Iso.inv (setTruncIso (Hⁿ-S0≃Kₙ×Kₙ n))) - (Iso.leftInv (setTruncIso (Hⁿ-S0≃Kₙ×Kₙ n))) + isContrHⁿ-S0 n = isContrRetract (Iso.fun (setTruncIso (Hⁿ-S0≃Kₙ×Kₙ n))) + (Iso.inv (setTruncIso (Hⁿ-S0≃Kₙ×Kₙ n))) + (Iso.leftInv (setTruncIso (Hⁿ-S0≃Kₙ×Kₙ n))) (isContrHelper n) where isContrHelper : (n : ℕ) → isContr (∥ (coHomK (suc n) × coHomK (suc n)) ∥₂) fst (isContrHelper zero) = ∣ (0₁ , 0₁) ∣₂ - snd (isContrHelper zero) = ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + snd (isContrHelper zero) = ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ y → T.elim2 {B = λ x y → ∣ (0₁ , 0₁) ∣₂ ≡ ∣(x , y) ∣₂ } - (λ _ _ → isOfHLevelPlus {n = 2} 2 isSetSetTrunc _ _) - (toPropElim2 (λ _ _ → isSetSetTrunc _ _) refl) (fst y) (snd y) + (λ _ _ → isOfHLevelPlus {n = 2} 2 isSetSetTrunc _ _) + (toPropElim2 (λ _ _ → isSetSetTrunc _ _) refl) (fst y) (snd y) isContrHelper (suc zero) = ∣ (0₂ , 0₂) ∣₂ - , ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + , ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ y → T.elim2 {B = λ x y → ∣ (0₂ , 0₂) ∣₂ ≡ ∣(x , y) ∣₂ } - (λ _ _ → isOfHLevelPlus {n = 2} 3 isSetSetTrunc _ _) - (suspToPropElim2 base (λ _ _ → isSetSetTrunc _ _) refl) (fst y) (snd y) + (λ _ _ → isOfHLevelPlus {n = 2} 3 isSetSetTrunc _ _) + (suspToPropElim2 base (λ _ _ → isSetSetTrunc _ _) refl) (fst y) (snd y) isContrHelper (suc (suc n)) = ∣ (0ₖ (3 + n) , 0ₖ (3 + n)) ∣₂ - , ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + , ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ y → T.elim2 {B = λ x y → ∣ (0ₖ (3 + n) , 0ₖ (3 + n)) ∣₂ ≡ ∣(x , y) ∣₂ } - (λ _ _ → isProp→isOfHLevelSuc (4 + n) (isSetSetTrunc _ _)) - (suspToPropElim2 north (λ _ _ → isSetSetTrunc _ _) refl) (fst y) (snd y) + (λ _ _ → isProp→isOfHLevelSuc (4 + n) (isSetSetTrunc _ _)) + (suspToPropElim2 north (λ _ _ → isSetSetTrunc _ _) refl) (fst y) (snd y) Hⁿ-S⁰≅0 : (n : ℕ) → GroupIso (coHomGr (suc n) (S₊ 0)) UnitGroup₀ Hⁿ-S⁰≅0 n = contrGroupIsoUnit (isContrHⁿ-S0 n) @@ -197,15 +197,15 @@ (_ , helper2)) where helper : Iso ⟨ coHomGr (2 + n) (S₊ 1)⟩ ∥ Σ (hLevelTrunc (4 + n) (S₊ (2 + n))) (λ x → ∥ x ≡ x ∥₂) ∥₂ - helper = compIso (setTruncIso IsoFunSpaceS¹) IsoSetTruncateSndΣ + helper = compIso (setTruncIso IsoFunSpaceS¹) IsoSetTruncateSndΣ helper2 : (x : ∥ Σ (hLevelTrunc (4 + n) (S₊ (2 + n))) (λ x → ∥ x ≡ x ∥₂) ∥₂) → ∣ ∣ north ∣ , ∣ refl ∣₂ ∣₂ ≡ x helper2 = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) (uncurry - (T.elim (λ _ → isOfHLevelΠ (4 + n) λ _ → isProp→isOfHLevelSuc (3 + n) (isSetSetTrunc _ _)) - (suspToPropElim (ptSn (suc n)) (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) - (ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (T.elim (λ _ → isOfHLevelΠ (4 + n) λ _ → isProp→isOfHLevelSuc (3 + n) (isSetSetTrunc _ _)) + (suspToPropElim (ptSn (suc n)) (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) + (ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ p → cong ∣_∣₂ (ΣPathP (refl , isContr→isProp helper3 _ _)))))) where @@ -224,13 +224,13 @@ where isContrH¹S² : isContr ⟨ coHomGr 1 (S₊ 2) ⟩ isContrH¹S² = ∣ (λ _ → ∣ base ∣) ∣₂ - , coHomPointedElim 0 north (λ _ → isSetSetTrunc _ _) + , coHomPointedElim 0 north (λ _ → isSetSetTrunc _ _) λ f p → cong ∣_∣₂ (funExt λ x → sym p ∙∙ sym (spoke f north) ∙∙ spoke f x) H¹-Sⁿ≅0 (suc n) = contrGroupIsoUnit isContrH¹S³⁺ⁿ where anIso : Iso ⟨ coHomGr 1 (S₊ (3 + n)) ⟩ ∥ (S₊ (3 + n) → hLevelTrunc (4 + n) (coHomK 1)) ∥₂ anIso = - setTruncIso + setTruncIso (codomainIso (invIso (truncIdempotentIso (4 + n) (isOfHLevelPlus' {n = 1 + n} 3 (isOfHLevelTrunc 3))))) @@ -241,16 +241,16 @@ ind-helper : (x : hLevelTrunc (4 + n) (coHomK 1)) → x ≡ f north → ∣ (λ _ → ∣ ∣ base ∣ ∣) ∣₂ ≡ ∣ f ∣₂ - ind-helper = T.elim (λ _ → isOfHLevelΠ (4 + n) λ _ → isOfHLevelPlus' {n = (3 + n)} 1 (isSetSetTrunc _ _)) - (T.elim (λ _ → isOfHLevelΠ 3 λ _ → isOfHLevelPlus {n = 1} 2 (isSetSetTrunc _ _)) - (toPropElim (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) + ind-helper = T.elim (λ _ → isOfHLevelΠ (4 + n) λ _ → isOfHLevelPlus' {n = (3 + n)} 1 (isSetSetTrunc _ _)) + (T.elim (λ _ → isOfHLevelΠ 3 λ _ → isOfHLevelPlus {n = 1} 2 (isSetSetTrunc _ _)) + (toPropElim (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) λ p → cong ∣_∣₂ (funExt λ x → p ∙∙ sym (spoke f north) ∙∙ spoke f x))) isContrH¹S³⁺ⁿ : isContr ⟨ coHomGr 1 (S₊ (3 + n)) ⟩ isContrH¹S³⁺ⁿ = isOfHLevelRetractFromIso 0 anIso (∣ (λ _ → ∣ ∣ base ∣ ∣) ∣₂ - , ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) isContrH¹S³⁺ⁿ-ish) + , ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) isContrH¹S³⁺ⁿ-ish) --------- H¹(S¹) ≅ ℤ ------- {- @@ -272,10 +272,10 @@ inv (fst theIso) a = ∣ (F⁻ (base , a)) ∣₂ rightInv (fst theIso) a = cong snd (Iso.rightInv S¹→S¹≡S¹×ℤ (base , a)) leftInv (fst theIso) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ f → cong ((ST.rec isSetSetTrunc ∣_∣₂) - ∘ ST.rec isSetSetTrunc λ x → ∣ F⁻ (x , (snd (F f))) ∣₂) - (Iso.inv PathIdTrunc₀Iso (isConnectedS¹ (fst (F f)))) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ f → cong ((ST.rec isSetSetTrunc ∣_∣₂) + ∘ ST.rec isSetSetTrunc λ x → ∣ F⁻ (x , (snd (F f))) ∣₂) + (Iso.inv PathIdTrunc₀Iso (isConnectedS¹ (fst (F f)))) ∙ cong ∣_∣₂ (Iso.leftInv S¹→S¹≡S¹×ℤ f) snd theIso = makeIsGroupHom diff --git a/Cubical.ZCohomology.Groups.SphereProduct.html b/Cubical.ZCohomology.Groups.SphereProduct.html index ca5e3670be..28d4cb946d 100644 --- a/Cubical.ZCohomology.Groups.SphereProduct.html +++ b/Cubical.ZCohomology.Groups.SphereProduct.html @@ -84,7 +84,7 @@ → ¬ (n ≡ m) → ∥ f ≡ (λ _ → 0ₖ (suc n)) ∥₁ ∥HⁿSᵐPath∥ n m f p = - fun PathIdTrunc₀Iso + fun PathIdTrunc₀Iso (isContr→isProp (isOfHLevelRetractFromIso 0 (fst (Hⁿ-Sᵐ≅0 n m p)) isContrUnit) ∣ f ∣₂ (0ₕ _)) @@ -96,12 +96,12 @@ (coHomGr (suc (suc ((suc n) + m))) (S₊ (suc (suc n)) × S₊ (suc m))) fun (fst (×leftSuspensionIso n m)) = - ST.map (uncurry ∘ ↑Sⁿ×Sᵐ→Kₙ₊ₘ n m ∘ curry) + ST.map (uncurry ∘ ↑Sⁿ×Sᵐ→Kₙ₊ₘ n m ∘ curry) inv (fst (×leftSuspensionIso n m)) = - ST.map ((uncurry ∘ ↓Sⁿ×Sᵐ→Kₙ₊ₘ n m ∘ curry)) + ST.map ((uncurry ∘ ↓Sⁿ×Sᵐ→Kₙ₊ₘ n m ∘ curry)) rightInv (fst (×leftSuspensionIso n m)) = ST.elim (λ _ → isSetPathImplicit) - λ f → inv PathIdTrunc₀Iso + λ f → inv PathIdTrunc₀Iso (PT.rec squash₁ (uncurry (λ g p → PT.map (λ gid → funExt λ {(x , y) @@ -155,7 +155,7 @@ → typ (Ω (coHomK-ptd (suc (suc (suc n + m)))))) → ∥ (g (ptSn _)) ≡ (λ _ → refl) ∥₁ ∥Path∥ g = - fun PathIdTrunc₀Iso + fun PathIdTrunc₀Iso (isContr→isProp (isOfHLevelRetractFromIso 0 ((invIso (fst (coHom≅coHomΩ _ (S₊ (suc m)))))) @@ -237,11 +237,11 @@ Hⁿ-Sⁿ≅Hⁿ-S¹×Sⁿ : (m : ℕ) → GroupIso (coHomGr (suc m) (S₊ (suc m))) (coHomGr (suc (suc m)) (S₊ (suc zero) × S₊ (suc m))) -fun (fst (Hⁿ-Sⁿ≅Hⁿ-S¹×Sⁿ m)) = ST.map (uncurry ∘ Hⁿ-S¹×Sⁿ→Hⁿ-Sⁿ m) -inv (fst (Hⁿ-Sⁿ≅Hⁿ-S¹×Sⁿ m)) = ST.map (Hⁿ-Sⁿ→Hⁿ-S¹×Sⁿ m ∘ curry) +fun (fst (Hⁿ-Sⁿ≅Hⁿ-S¹×Sⁿ m)) = ST.map (uncurry ∘ Hⁿ-S¹×Sⁿ→Hⁿ-Sⁿ m) +inv (fst (Hⁿ-Sⁿ≅Hⁿ-S¹×Sⁿ m)) = ST.map (Hⁿ-Sⁿ→Hⁿ-S¹×Sⁿ m ∘ curry) rightInv (fst (Hⁿ-Sⁿ≅Hⁿ-S¹×Sⁿ m)) = ST.elim (λ _ → isSetPathImplicit) - λ f → inv PathIdTrunc₀Iso + λ f → inv PathIdTrunc₀Iso (PT.map (uncurry (λ g p → funExt λ {(x , y) → (λ i → uncurry diff --git a/Cubical.ZCohomology.Groups.Torus.html b/Cubical.ZCohomology.Groups.Torus.html index 6fe5c91ef8..170d926ee4 100644 --- a/Cubical.ZCohomology.Groups.Torus.html +++ b/Cubical.ZCohomology.Groups.Torus.html @@ -163,16 +163,16 @@ H¹-T²≅ℤ×ℤ = theIso □ GroupIsoDirProd (Hⁿ-Sⁿ≅ℤ 0) (H⁰-Sⁿ≅ℤ 0) where typIso : Iso _ _ - typIso = setTruncIso (curryIso ⋄ codomainIso S1→K₁≡S1×ℤ ⋄ toProdIso) - ⋄ setTruncOfProdIso + typIso = setTruncIso (curryIso ⋄ codomainIso S1→K₁≡S1×ℤ ⋄ toProdIso) + ⋄ setTruncOfProdIso theIso : GroupIso _ _ fst theIso = typIso snd theIso = makeIsGroupHom - (coHomPointedElimT² _ (λ _ → isPropΠ λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) + (coHomPointedElimT² _ (λ _ → isPropΠ λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) λ pf qf Pf → - coHomPointedElimT² _ (λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) + coHomPointedElimT² _ (λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) λ pg qg Pg i → ∣ funExt (helperFst pf qf pg qg Pg Pf) i ∣₂ , ∣ funExt (helperSnd pf qf pg qg Pg Pf) i ∣₂) where @@ -213,15 +213,15 @@ , refl) rightInv helper _ = refl theIso : Iso (coHom 2 (S¹ × S¹)) (coHom 1 S¹) - theIso = setTruncIso (curryIso ⋄ codomainIso S1→K2≡K2×K1 ⋄ toProdIso) - ⋄ setTruncOfProdIso + theIso = setTruncIso (curryIso ⋄ codomainIso S1→K2≡K2×K1 ⋄ toProdIso) + ⋄ setTruncOfProdIso ⋄ helper helper2 : GroupIso (coHomGr 2 (S¹ × S¹)) (coHomGr 1 S¹) helper2 .fst = theIso helper2 .snd = makeIsGroupHom ( - coHomPointedElimT²'' 0 (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) - λ P → coHomPointedElimT²'' 0 (λ _ → isSetSetTrunc _ _) + coHomPointedElimT²'' 0 (λ _ → isPropΠ λ _ → isSetSetTrunc _ _) + λ P → coHomPointedElimT²'' 0 (λ _ → isSetSetTrunc _ _) λ Q → ((λ i → ∣ (λ a → ΩKn+1→Kn 1 (sym (rCancel≡refl 0 i) ∙∙ cong (λ x → (elimFunT²' 1 P (a , x) +ₖ elimFunT²' 1 Q (a , x)) -ₖ ∣ north ∣) loop ∙∙ rCancel≡refl 0 i)) ∣₂)) diff --git a/Cubical.ZCohomology.Groups.Unit.html b/Cubical.ZCohomology.Groups.Unit.html index 61713e63bd..12153208fb 100644 --- a/Cubical.ZCohomology.Groups.Unit.html +++ b/Cubical.ZCohomology.Groups.Unit.html @@ -37,7 +37,7 @@ fun (fst H⁰-Unit≅ℤ) = ST.rec isSetℤ (λ f → f tt) inv (fst H⁰-Unit≅ℤ) a = ∣ (λ _ → a) ∣₂ rightInv (fst H⁰-Unit≅ℤ) _ = refl -leftInv (fst H⁰-Unit≅ℤ) = ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ a → refl +leftInv (fst H⁰-Unit≅ℤ) = ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ a → refl snd H⁰-Unit≅ℤ = makeIsGroupHom (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetℤ _ _) λ a b → refl) {- Hⁿ(Unit) for n ≥ 1 -} @@ -69,8 +69,8 @@ private Hⁿ-contrTypeIso : ∀ {ℓ} {A : Type ℓ} (n : ℕ) → isContr A → Iso (coHom (suc n) A) (coHom (suc n) Unit) - Hⁿ-contrTypeIso n contr = compIso (setTruncIso (isContr→Iso2 contr)) - (setTruncIso (invIso (isContr→Iso2 isContrUnit))) + Hⁿ-contrTypeIso n contr = compIso (setTruncIso (isContr→Iso2 contr)) + (setTruncIso (invIso (isContr→Iso2 isContrUnit))) Hⁿ-contrType≅0 : ∀ {ℓ} {A : Type ℓ} (n : ℕ) → isContr A → GroupIso (coHomGr (suc n) A) UnitGroup₀ @@ -89,7 +89,7 @@ isContr-HⁿRed-Unit : (n : ℕ) → isContr (coHomRed n (Unit , tt)) fst (isContr-HⁿRed-Unit n) = 0ₕ∙ _ snd (isContr-HⁿRed-Unit n) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ {(f , p) → cong ∣_∣₂ (ΣPathP (funExt (λ _ → sym p) , λ i j → p (~ i ∨ j)))} diff --git a/Cubical.ZCohomology.Groups.Wedge.html b/Cubical.ZCohomology.Groups.Wedge.html index d1c040831d..5b164ffed6 100644 --- a/Cubical.ZCohomology.Groups.Wedge.html +++ b/Cubical.ZCohomology.Groups.Wedge.html @@ -116,20 +116,20 @@ Hⁿ-⋁ : (n : ℕ) → GroupIso (coHomGr (suc n) (A ⋁ B)) (×coHomGr (suc n) (typ A) (typ B)) fun (fst (Hⁿ-⋁ zero)) = - ST.elim (λ _ → isSet× isSetSetTrunc isSetSetTrunc) + ST.elim (λ _ → isSet× isSetSetTrunc isSetSetTrunc) λ f → ∣ (λ x → f (inl x)) ∣₂ , ∣ (λ x → f (inr x)) ∣₂ inv (fst (Hⁿ-⋁ zero)) = - uncurry (ST.elim2 (λ _ _ → isSetSetTrunc) + uncurry (ST.elim2 (λ _ _ → isSetSetTrunc) λ f g → ∣ wedgeFun⁻ 0 f g ∣₂) rightInv (fst (Hⁿ-⋁ zero)) = uncurry - (coHomPointedElim _ (pt A) (λ _ → isPropΠ λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) - λ f fId → coHomPointedElim _ (pt B) (λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) + (coHomPointedElim _ (pt A) (λ _ → isPropΠ λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) + λ f fId → coHomPointedElim _ (pt B) (λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) λ g gId → ΣPathP ((cong ∣_∣₂ (funExt (λ x → cong (f x +ₖ_) gId ∙ rUnitₖ 1 (f x)))) , cong ∣_∣₂ (funExt (λ x → cong (_+ₖ g x) fId ∙ lUnitₖ 1 (g x))))) leftInv (fst (Hⁿ-⋁ zero)) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - (λ f → PT.rec (isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (λ f → PT.rec (isSetSetTrunc _ _) (λ fId → cong ∣_∣₂ (sym fId)) (helper f _ refl)) where @@ -161,23 +161,23 @@ λ i _ → (refl ∙ (λ _ → 0ₖ 1)) i snd (Hⁿ-⋁ zero) = makeIsGroupHom - (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) + (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) λ _ _ → refl) fun (fst (Hⁿ-⋁ (suc n))) = - ST.elim (λ _ → isSet× isSetSetTrunc isSetSetTrunc) + ST.elim (λ _ → isSet× isSetSetTrunc isSetSetTrunc) λ f → ∣ (λ x → f (inl x)) ∣₂ , ∣ (λ x → f (inr x)) ∣₂ inv (fst (Hⁿ-⋁ (suc n))) = - uncurry (ST.elim2 (λ _ _ → isSetSetTrunc) + uncurry (ST.elim2 (λ _ _ → isSetSetTrunc) λ f g → ∣ wedgeFun⁻ (suc n) f g ∣₂) rightInv (fst (Hⁿ-⋁ (suc n))) = uncurry - (coHomPointedElim _ (pt A) (λ _ → isPropΠ λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) - λ f fId → coHomPointedElim _ (pt B) (λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) + (coHomPointedElim _ (pt A) (λ _ → isPropΠ λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) + λ f fId → coHomPointedElim _ (pt B) (λ _ → isSet× isSetSetTrunc isSetSetTrunc _ _) λ g gId → ΣPathP ((cong ∣_∣₂ (funExt (λ x → cong (f x +ₖ_) gId ∙ rUnitₖ (2 + n) (f x)))) , cong ∣_∣₂ (funExt (λ x → cong (_+ₖ g x) fId ∙ lUnitₖ (2 + n) (g x))))) leftInv (fst (Hⁿ-⋁ (suc n))) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - (λ f → PT.rec (isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (λ f → PT.rec (isSetSetTrunc _ _) (λ fId → cong ∣_∣₂ (sym fId)) (helper f _ refl)) where @@ -209,29 +209,29 @@ λ i j → ((λ _ → ∣ north ∣) ∙ refl) i snd (Hⁿ-⋁ (suc n)) = makeIsGroupHom - (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) + (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) λ _ _ → refl) H⁰Red-⋁ : GroupIso (coHomRedGrDir 0 (A ⋁ B , inl (pt A))) (DirProd (coHomRedGrDir 0 A) (coHomRedGrDir 0 B)) fun (fst H⁰Red-⋁) = - ST.rec (isSet× isSetSetTrunc isSetSetTrunc) + ST.rec (isSet× isSetSetTrunc isSetSetTrunc) λ {(f , p) → ∣ (f ∘ inl) , p ∣₂ , ∣ (f ∘ inr) , cong f (sym (push tt)) ∙ p ∣₂} inv (fst H⁰Red-⋁) = - uncurry (ST.rec2 isSetSetTrunc + uncurry (ST.rec2 isSetSetTrunc λ {(f , p) (g , q) → ∣ (λ {(inl a) → f a ; (inr b) → g b ; (push tt i) → (p ∙ sym q) i}) , p ∣₂}) rightInv (fst H⁰Red-⋁) = uncurry - (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) - λ {(_ , _) (_ , _) → ΣPathP (cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl) - , cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl))}) + (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) + λ {(_ , _) (_ , _) → ΣPathP (cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl) + , cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl))}) leftInv (fst H⁰Red-⋁) = - ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ {(f , p) → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) + ST.elim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ {(f , p) → cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) (funExt λ {(inl a) → refl ; (inr b) → refl ; (push tt i) j → (cong (p ∙_) (symDistr (cong f (sym (push tt))) p) @@ -241,9 +241,9 @@ -- Alt. use isOfHLevel→isOfHLevelDep snd H⁰Red-⋁ = makeIsGroupHom - (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) - λ {(f , p) (g , q) → ΣPathP (cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl) - , cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl))}) + (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) + λ {(f , p) (g , q) → ΣPathP (cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl) + , cong ∣_∣₂ (Σ≡Prop (λ _ → isSetℤ _ _) refl))}) wedgeConnected : ((x : typ A) → ∥ pt A ≡ x ∥₁) → ((x : typ B) → ∥ pt B ≡ x ∥₁) → (x : A ⋁ B) → ∥ inl (pt A) ≡ x ∥₁ wedgeConnected conA conB = diff --git a/Cubical.ZCohomology.Gysin.html b/Cubical.ZCohomology.Gysin.html index fe687bfa14..d61509438f 100644 --- a/Cubical.ZCohomology.Gysin.html +++ b/Cubical.ZCohomology.Gysin.html @@ -140,7 +140,7 @@ -- πS is equivalent to (coHomRed n (S₊∙ n)) K : (n : ℕ) → GroupIso (coHomRedGrDir n (S₊∙ n)) (πS n) -fst (K n) = setTruncIdempotentIso (isSetπS n) +fst (K n) = setTruncIdempotentIso (isSetπS n) snd (K zero) = makeIsGroupHom (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSetπS 0) _ _) @@ -174,7 +174,7 @@ (Hⁿ-Sⁿ≅ℤ n)) Iso-πS-ℤ : (n : ℕ) → Iso (S₊∙ (suc n) →∙ coHomK-ptd (suc n)) ℤ -Iso-πS-ℤ n = compIso (invIso (setTruncIdempotentIso (isOfHLevel↑∙' 0 n))) +Iso-πS-ℤ n = compIso (invIso (setTruncIdempotentIso (isOfHLevel↑∙' 0 n))) (compIso (equivToIso (fst (coHomGr≅coHomRedGr n (S₊∙ (suc n))))) (fst (Hⁿ-Sⁿ≅ℤ n))) @@ -794,7 +794,7 @@ (coHomRedGrDir (i +' n) (preThom.Ẽ B P , inl tt)) fst (ϕ i) = isoToEquiv - (setTruncIso + (setTruncIso (compIso (codomainIsoDep λ b → @@ -855,7 +855,7 @@ E-susp : (i : ℕ) → GroupHom (coHomGr i E') (coHomRedGrDir (suc i) (E'̃ , inl tt)) fst (E-susp i) = - ST.map λ f → (λ { (inl x) → 0ₖ _ + ST.map λ f → (λ { (inl x) → 0ₖ _ ; (inr x) → 0ₖ _ ; (push a j) → Kn→ΩKn+1 _ (f a) j}) , refl snd (E-susp zero) = @@ -880,7 +880,7 @@ module cofibSeq where j* : (i : ℕ) → GroupHom (coHomRedGrDir i (E'̃ , (inl tt))) (coHomGr i (typ B)) - fst (j* i) = ST.map λ f → λ x → fst f (inr x) + fst (j* i) = ST.map λ f → λ x → fst f (inr x) snd (j* zero) = makeIsGroupHom (ST.elim2 (λ _ _ → isOfHLevelPath 2 squash₂ _ _) λ _ _ → refl) @@ -908,7 +908,7 @@ ; (inr x) → f x ; (push a i₁) → funExt⁻ id a (~ i₁)}) , refl ∣₂ , refl ∣₁) - (Iso.fun PathIdTrunc₀Iso ker) + (Iso.fun PathIdTrunc₀Iso ker) Im-p⊂Ker-Susp : (i : ℕ) (x : _) → isInIm (p-hom i) x → isInKer (E-susp i) x @@ -941,7 +941,7 @@ ∙∙ cong (Kn→ΩKn+1 i (f (a , b)) ∙_) (rCancel _) ∙∙ sym (rUnit _))) ∙ Iso.leftInv (Iso-Kn-ΩKn+1 _) (f (a , b))})) ∣₁) - (Iso.fun PathIdTrunc₀Iso ker) + (Iso.fun PathIdTrunc₀Iso ker) Im-Susp⊂Ker-j : (i : ℕ) (x : _) → isInIm (E-susp i) x → isInKer (cofibSeq.j* (suc i)) x @@ -952,7 +952,7 @@ λ f id → PT.rec (squash₂ _ _) (λ P → subst (isInKer (cofibSeq.j* (suc i))) (cong ∣_∣₂ P) (cong ∣_∣₂ refl)) - (Iso.fun PathIdTrunc₀Iso id))) + (Iso.fun PathIdTrunc₀Iso id))) Ker-j⊂Im-Susp : (i : ℕ) (x : _) → isInKer (cofibSeq.j* (suc i)) x → isInIm (E-susp i) x @@ -967,7 +967,7 @@ (funExt (λ { (inl x) → sym (snd f) ; (inr x) → sym (funExt⁻ p x) ; (push a j) k → h3 f p a k j}))) ∣₁) - (Iso.fun PathIdTrunc₀Iso ker) + (Iso.fun PathIdTrunc₀Iso ker) where h3 : (f : (E'̃ , inl tt) →∙ coHomK-ptd (suc i)) → (p : (fst f ∘ inr) ≡ (λ _ → 0ₖ (suc i))) @@ -1110,7 +1110,7 @@ -- at an exact sequence involving it. ϕ∘j≡ : (i : ℕ) → ϕ∘j i ≡ ⌣-hom i ϕ∘j≡ i = - Σ≡Prop (λ _ → isPropIsGroupHom _ _) + Σ≡Prop (λ _ → isPropIsGroupHom _ _) (funExt (ST.elim (λ _ → isOfHLevelPath 2 squash₂ _ _) λ _ → refl)) diff --git a/Cubical.ZCohomology.MayerVietorisUnreduced.html b/Cubical.ZCohomology.MayerVietorisUnreduced.html index db63a6100b..240355abdb 100644 --- a/Cubical.ZCohomology.MayerVietorisUnreduced.html +++ b/Cubical.ZCohomology.MayerVietorisUnreduced.html @@ -40,11 +40,11 @@ private i* : (n : ℕ) → coHom n (Pushout f g) → coHom n A × coHom n B - i* n = ST.rec (isSet× isSetSetTrunc isSetSetTrunc) λ δ → ∣ (λ x → δ (inl x)) ∣₂ , ∣ (λ x → δ (inr x)) ∣₂ + i* n = ST.rec (isSet× isSetSetTrunc isSetSetTrunc) λ δ → ∣ (λ x → δ (inl x)) ∣₂ , ∣ (λ x → δ (inr x)) ∣₂ iIsHom : (n : ℕ) → IsGroupHom (coHomGr n (Pushout f g) .snd) (i* n) (×coHomGr n A B .snd) iIsHom n = - makeIsGroupHom (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) λ _ _ → refl) + makeIsGroupHom (ST.elim2 (λ _ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) λ _ _ → refl) i : (n : ℕ) → GroupHom (coHomGr n (Pushout f g)) (×coHomGr n A B) fst (i n) = i* n @@ -64,7 +64,7 @@ Δ'-isMorph : (n : ℕ) → IsGroupHom (×coHomGr n A B .snd) (Δ' n) (coHomGr n C .snd) Δ'-isMorph n = makeIsGroupHom - (prodElim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _ ) + (prodElim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _ ) λ f' x1 g' x2 i → ∣ (λ x → distrLem n (f' (f x)) (g' (f x)) (x1 (g x)) (x2 (g x)) i) ∣₂) Δ : (n : ℕ) → GroupHom (×coHomGr n A B) (coHomGr n C) @@ -93,24 +93,24 @@ ; (j = i1) → (Kn→ΩKn+1 n (h a) i) +[ (suc n) ]ₖ coHom-pt (suc n)}) (rUnitₖ (suc n) (Kn→ΩKn+1 n (h a) i) (~ j)))) - dIsHom : (n : ℕ) → IsGroupHom (coHomGr n C .snd) (ST.rec isSetSetTrunc λ a → ∣ d-pre n a ∣₂) (coHomGr (suc n) (Pushout f g) .snd) + dIsHom : (n : ℕ) → IsGroupHom (coHomGr n C .snd) (ST.rec isSetSetTrunc λ a → ∣ d-pre n a ∣₂) (coHomGr (suc n) (Pushout f g) .snd) dIsHom n = makeIsGroupHom - (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (ST.elim2 (λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) λ f g i → ∣ funExt (λ x → dHomHelper n f g x) i ∣₂) d : (n : ℕ) → GroupHom (coHomGr n C) (coHomGr (suc n) (Pushout f g)) - fst (d n) = ST.rec isSetSetTrunc λ a → ∣ d-pre n a ∣₂ + fst (d n) = ST.rec isSetSetTrunc λ a → ∣ d-pre n a ∣₂ snd (d n) = dIsHom n -- The long exact sequence Im-d⊂Ker-i : (n : ℕ) (x : ⟨ (coHomGr (suc n) (Pushout f g)) ⟩) → isInIm (d n) x → isInKer (i (suc n)) x - Im-d⊂Ker-i n = ST.elim (λ _ → isSetΠ λ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) - λ a → PT.rec (isOfHLevelPath' 1 (isSet× isSetSetTrunc isSetSetTrunc) _ _) - (sigmaElim (λ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) - λ δ b i → ST.rec (isSet× isSetSetTrunc isSetSetTrunc) + Im-d⊂Ker-i n = ST.elim (λ _ → isSetΠ λ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) + λ a → PT.rec (isOfHLevelPath' 1 (isSet× isSetSetTrunc isSetSetTrunc) _ _) + (sigmaElim (λ _ → isOfHLevelPath 2 (isSet× isSetSetTrunc isSetSetTrunc) _ _) + λ δ b i → ST.rec (isSet× isSetSetTrunc isSetSetTrunc) (λ δ → ∣ (λ x → δ (inl x)) ∣₂ , ∣ (λ x → δ (inr x)) ∣₂ ) (b (~ i))) @@ -125,8 +125,8 @@ ∙∙ cong a (push c) ∙∙ cong (λ F → F (g c)) p2)) ∣₂ , cong ∣_∣₂ (funExt (λ δ → helper a p1 p2 δ)) ∣₁) - (Iso.fun PathIdTrunc₀Iso (cong fst p)) - (Iso.fun PathIdTrunc₀Iso (cong snd p)) + (Iso.fun PathIdTrunc₀Iso (cong fst p)) + (Iso.fun PathIdTrunc₀Iso (cong snd p)) where helper : (F : (Pushout f g) → coHomK (suc n)) @@ -154,10 +154,10 @@ Im-i⊂Ker-Δ n (Fa , Fb) = ST.elim {B = λ Fa → (Fb : _) → isInIm (i n) (Fa , Fb) → isInKer (Δ n) (Fa , Fb)} - (λ _ → isSetΠ2 λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - (λ Fa → ST.elim (λ _ → isSetΠ λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ Fb → PT.rec (isSetSetTrunc _ _) - (sigmaElim (λ x → isProp→isSet (isSetSetTrunc _ _)) + (λ _ → isSetΠ2 λ _ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + (λ Fa → ST.elim (λ _ → isSetΠ λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ Fb → PT.rec (isSetSetTrunc _ _) + (sigmaElim (λ x → isProp→isSet (isSetSetTrunc _ _)) λ Fd p → helper n Fa Fb Fd p)) Fa Fb @@ -172,7 +172,7 @@ Ker-Δ⊂Im-i : (n : ℕ) (a : ⟨ ×coHomGr n A B ⟩) → isInKer (Δ n) a → isInIm (i n) a - Ker-Δ⊂Im-i n = prodElim (λ _ → isSetΠ (λ _ → isProp→isSet isPropPropTrunc)) + Ker-Δ⊂Im-i n = prodElim (λ _ → isSetΠ (λ _ → isProp→isSet isPropPropTrunc)) (λ Fa Fb p → PT.rec isPropPropTrunc (λ q → ∣ ∣ helpFun Fa Fb q ∣₂ , refl ∣₁) (helper Fa Fb p)) @@ -180,7 +180,7 @@ helper : (Fa : A → coHomK n) (Fb : B → coHomK n) → fst (Δ n) (∣ Fa ∣₂ , ∣ Fb ∣₂) ≡ 0ₕ n → ∥ Path (_ → _) (λ c → Fa (f c)) (λ c → Fb (g c)) ∥₁ - helper Fa Fb p = Iso.fun PathIdTrunc₀Iso + helper Fa Fb p = Iso.fun PathIdTrunc₀Iso (sym (cong ∣_∣₂ (funExt (λ x → sym (assocₖ n _ _ _) ∙∙ cong (λ y → Fa (f x) +[ n ]ₖ y) (lCancelₖ n (Fb (g x))) ∙∙ rUnitₖ n (Fa (f x))))) @@ -215,8 +215,8 @@ ST.elim (λ _ → isOfHLevelΠ 2 λ _ → isOfHLevelSuc 1 isPropPropTrunc) λ Fc p → PT.rec isPropPropTrunc (λ p → ∣ (∣ (λ a → ΩKn+1→Kn n (cong (λ f → f (inl a)) p)) ∣₂ , ∣ (λ b → ΩKn+1→Kn n (cong (λ f → f (inr b)) p)) ∣₂) , - Iso.inv (PathIdTrunc₀Iso) ∣ funExt (λ c → helper2 Fc p c) ∣₁ ∣₁) - (Iso.fun (PathIdTrunc₀Iso) p) + Iso.inv (PathIdTrunc₀Iso) ∣ funExt (λ c → helper2 Fc p c) ∣₁ ∣₁) + (Iso.fun (PathIdTrunc₀Iso) p) where @@ -232,12 +232,12 @@ → isInIm (Δ n) a → isInKer (d n) a Im-Δ⊂Ker-d n = - ST.elim (λ _ → isOfHLevelΠ 2 λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ Fc → PT.rec (isOfHLevelPath' 1 isSetSetTrunc _ _) - (sigmaProdElim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) - λ Fa Fb p → PT.rec (isOfHLevelPath' 1 isSetSetTrunc _ _) + ST.elim (λ _ → isOfHLevelΠ 2 λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ Fc → PT.rec (isOfHLevelPath' 1 isSetSetTrunc _ _) + (sigmaProdElim (λ _ → isOfHLevelPath 2 isSetSetTrunc _ _) + λ Fa Fb p → PT.rec (isOfHLevelPath' 1 isSetSetTrunc _ _) (λ q → ((λ i → fst (d n) ∣ (q (~ i)) ∣₂) ∙ dΔ-Id n Fa Fb)) - (Iso.fun (PathIdTrunc₀Iso) p)) + (Iso.fun (PathIdTrunc₀Iso) p)) where d-preLeftId : (n : ℕ) (Fa : A → coHomK n)(d : (Pushout f g)) diff --git a/Cubical.ZCohomology.Properties.html b/Cubical.ZCohomology.Properties.html index 0d45cb2f66..560010d611 100644 --- a/Cubical.ZCohomology.Properties.html +++ b/Cubical.ZCohomology.Properties.html @@ -41,7 +41,7 @@ open import Cubical.Algebra.AbGroup open import Cubical.HITs.Truncation as T -open import Cubical.HITs.SetTruncation as ST renaming (isSetSetTrunc to §) +open import Cubical.HITs.SetTruncation as ST renaming (isSetSetTrunc to §) open import Cubical.HITs.S1 hiding (encode ; decode ; _·_) open import Cubical.HITs.Sn open import Cubical.HITs.Susp @@ -195,8 +195,8 @@ coHomRed+1Equiv (suc (suc n)) A i = ∥ coHomRed+1.helpLemma A i {C = (coHomK (2 + n) , ∣ north ∣)} i ∥₂ Iso-coHom-coHomRed : ∀ {ℓ} {A : Pointed ℓ} (n : ℕ) → Iso (coHomRed (suc n) A) (coHom (suc n) (typ A)) -fun (Iso-coHom-coHomRed {A = A , a} n) = ST.map fst -inv' (Iso-coHom-coHomRed {A = A , a} n) = ST.map λ f → (λ x → f x -ₖ f a) , rCancelₖ _ _ +fun (Iso-coHom-coHomRed {A = A , a} n) = ST.map fst +inv' (Iso-coHom-coHomRed {A = A , a} n) = ST.map λ f → (λ x → f x -ₖ f a) , rCancelₖ _ _ rightInv (Iso-coHom-coHomRed {A = A , a} n) = ST.elim (λ _ → isOfHLevelPath 2 § _ _) λ f → T.rec (isProp→isOfHLevelSuc _ (§ _ _)) @@ -502,8 +502,8 @@ open IsGroupHom coHom≅coHomΩ : ∀ {ℓ} (n : ℕ) (A : Type ℓ) → GroupIso (coHomGr n A) (coHomGrΩ n A) -fun (fst (coHom≅coHomΩ n A)) = ST.map λ f a → Kn→ΩKn+1 n (f a) -inv' (fst (coHom≅coHomΩ n A)) = ST.map λ f a → ΩKn+1→Kn n (f a) +fun (fst (coHom≅coHomΩ n A)) = ST.map λ f a → Kn→ΩKn+1 n (f a) +inv' (fst (coHom≅coHomΩ n A)) = ST.map λ f a → ΩKn+1→Kn n (f a) rightInv (fst (coHom≅coHomΩ n A)) = ST.elim (λ _ → isOfHLevelPath 2 § _ _) λ f → cong ∣_∣₂ (funExt λ x → rightInv (Iso-Kn-ΩKn+1 n) (f x)) @@ -547,7 +547,7 @@ isContr-↓∙ : (n : ℕ) → isContr (coHomK-ptd (suc n) →∙ coHomK-ptd n) fst (isContr-↓∙ zero) = (λ _ → 0) , refl snd (isContr-↓∙ zero) (f , p) = - Σ≡Prop (λ f → isSetℤ _ _) + Σ≡Prop (λ f → isSetℤ _ _) (funExt (T.elim (λ _ → isOfHLevelPath 3 (isOfHLevelSuc 2 isSetℤ) _ _) (toPropElim (λ _ → isSetℤ _ _) (sym p)))) fst (isContr-↓∙ (suc n)) = (λ _ → 0ₖ _) , refl @@ -561,7 +561,7 @@ isContr-↓∙' : (n : ℕ) → isContr (S₊∙ (suc n) →∙ coHomK-ptd n) fst (isContr-↓∙' zero) = (λ _ → 0) , refl snd (isContr-↓∙' zero) (f , p) = - Σ≡Prop (λ f → isSetℤ _ _) + Σ≡Prop (λ f → isSetℤ _ _) (funExt (toPropElim (λ _ → isSetℤ _ _) (sym p))) fst (isContr-↓∙' (suc n)) = (λ _ → 0ₖ _) , refl fst (snd (isContr-↓∙' (suc n)) f i) x = @@ -656,7 +656,7 @@ isoType→isoCohom : {A : Type ℓ} {B : Type ℓ'} (n : ℕ) → Iso A B → GroupIso (coHomGr n A) (coHomGr n B) -fst (isoType→isoCohom n is) = setTruncIso (domIso is) +fst (isoType→isoCohom n is) = setTruncIso (domIso is) snd (isoType→isoCohom n is) = makeIsGroupHom (ST.elim2 (λ _ _ → isOfHLevelPath 2 squash₂ _ _) (λ _ _ → refl)) diff --git a/Cubical.ZCohomology.RingStructure.CohomologyRing.html b/Cubical.ZCohomology.RingStructure.CohomologyRing.html index 9276b0a8a8..1258e0f9a6 100644 --- a/Cubical.ZCohomology.RingStructure.CohomologyRing.html +++ b/Cubical.ZCohomology.RingStructure.CohomologyRing.html @@ -54,9 +54,9 @@ _⌣_ (λ {k} {l} → 0ₕ-⌣ k l) (λ {k} {l} → ⌣-0ₕ k l) - (λ _ _ _ → sym (ΣPathTransport→PathΣ _ _ ((sym (+'-assoc _ _ _)) , (sym (assoc-⌣ _ _ _ _ _ _))))) - (λ _ → sym (ΣPathTransport→PathΣ _ _ (sym (+'-rid _) , sym (lUnit⌣ _ _)))) - (λ _ → ΣPathTransport→PathΣ _ _ (refl , transportRefl _ ∙ rUnit⌣ _ _)) + (λ _ _ _ → sym (ΣPathTransport→PathΣ _ _ ((sym (+'-assoc _ _ _)) , (sym (assoc-⌣ _ _ _ _ _ _))))) + (λ _ → sym (ΣPathTransport→PathΣ _ _ (sym (+'-rid _) , sym (lUnit⌣ _ _)))) + (λ _ → ΣPathTransport→PathΣ _ _ (refl , transportRefl _ ∙ rUnit⌣ _ _)) (λ _ _ _ → leftDistr-⌣ _ _ _ _ _) λ _ _ _ → rightDistr-⌣ _ _ _ _ _ diff --git a/Cubical.ZCohomology.RingStructure.CohomologyRingFun.html b/Cubical.ZCohomology.RingStructure.CohomologyRingFun.html index a6e0021ca9..1092c9e39c 100644 --- a/Cubical.ZCohomology.RingStructure.CohomologyRingFun.html +++ b/Cubical.ZCohomology.RingStructure.CohomologyRingFun.html @@ -46,9 +46,9 @@ _⌣_ (λ {k} {l} → 0ₕ-⌣ k l) (λ {k} {l} → ⌣-0ₕ k l) - (λ _ _ _ → sym (ΣPathTransport→PathΣ _ _ ((sym (+'-assoc _ _ _)) , (sym (assoc-⌣ _ _ _ _ _ _))))) - (λ _ → sym (ΣPathTransport→PathΣ _ _ (sym (+'-rid _) , sym (lUnit⌣ _ _)))) - (λ _ → ΣPathTransport→PathΣ _ _ (refl , transportRefl _ ∙ rUnit⌣ _ _)) + (λ _ _ _ → sym (ΣPathTransport→PathΣ _ _ ((sym (+'-assoc _ _ _)) , (sym (assoc-⌣ _ _ _ _ _ _))))) + (λ _ → sym (ΣPathTransport→PathΣ _ _ (sym (+'-rid _) , sym (lUnit⌣ _ _)))) + (λ _ → ΣPathTransport→PathΣ _ _ (refl , transportRefl _ ∙ rUnit⌣ _ _)) (λ _ _ _ → leftDistr-⌣ _ _ _ _ _) λ _ _ _ → rightDistr-⌣ _ _ _ _ _ diff --git a/Cubical.ZCohomology.RingStructure.GradedCommutativity.html b/Cubical.ZCohomology.RingStructure.GradedCommutativity.html index 36df3c8e67..ca862d0d5d 100644 --- a/Cubical.ZCohomology.RingStructure.GradedCommutativity.html +++ b/Cubical.ZCohomology.RingStructure.GradedCommutativity.html @@ -100,7 +100,7 @@ -- cohomology version -ₕ'^_·_ : {k : ℕ} {A : Type ℓ} (n m : ℕ) → coHom k A → coHom k A --ₕ'^_·_ n m = ST.map λ f x → (-ₖ'^ n · m) (f x) +-ₕ'^_·_ n m = ST.map λ f x → (-ₖ'^ n · m) (f x) -- -ₖ'ⁿ̇*ᵐ = -ₖ' for n m odd -ₖ'-gen-inr≡-ₖ' : {k : ℕ} (n m : ℕ) (p : _) (q : _) (x : coHomK k) @@ -1122,7 +1122,7 @@ -ₕ^-gen-eq : ∀ {ℓ} {k : ℕ} {A : Type ℓ} (n m : ℕ) → (p : isEvenT n ⊎ isOddT n) (q : isEvenT m ⊎ isOddT m) → (x : coHom k A) - → -ₕ^-gen n m p q x ≡ (ST.map λ f x → (-ₖ'-gen n m p q) (f x)) x + → -ₕ^-gen n m p q x ≡ (ST.map λ f x → (-ₖ'-gen n m p q) (f x)) x -ₕ^-gen-eq {k = k} n m (inl p) q = ST.elim (λ _ → isSetPathImplicit) λ f → cong ∣_∣₂ (funExt λ x → sym (-ₖ'-gen-inl-left n m p q (f x))) -ₕ^-gen-eq {k = k} n m (inr p) (inl q) = ST.elim (λ _ → isSetPathImplicit) λ f → cong ∣_∣₂ (funExt λ z → sym (-ₖ'-gen-inl-right n m (inr p) q (f z))) -ₕ^-gen-eq {k = k} n m (inr p) (inr q) = ST.elim (λ _ → isSetPathImplicit) λ f → cong ∣_∣₂ (funExt λ z → sym (-ₖ'-gen-inr≡-ₖ' n m p q (f z)))