diff --git a/docs/Cubical.Categories.Adjoint.html b/docs/Cubical.Categories.Adjoint.html index fd4d26a..b4abb0b 100644 --- a/docs/Cubical.Categories.Adjoint.html +++ b/docs/Cubical.Categories.Adjoint.html @@ -11,7 +11,7 @@ open import Cubical.Foundations.Isomorphism open import Cubical.Foundations.Univalence -open Functor +open Functor open Iso open Category @@ -42,70 +42,76 @@ definition. -} -module UnitCounit where - - -- Adjoint def 1: unit-counit - record _⊣_ {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (F : Functor C D) (G : Functor D C) - : Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) where - field - -- unit - η : 𝟙⟨ C ⟩ ⇒ (funcComp G F) - -- counit - ε : (funcComp F G) ⇒ 𝟙⟨ D ⟩ - -- triangle identities - Δ₁ : ∀ c → F ⟪ η ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ ε ⟦ F ⟅ c ⟆ ⟧ ≡ D .id - Δ₂ : ∀ d → η ⟦ G ⟅ d ⟆ ⟧ ⋆⟨ C ⟩ G ⟪ ε ⟦ d ⟧ ⟫ ≡ C .id - -module NaturalBijection where - -- Adjoint def 2: natural bijection - record _⊣_ {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (F : Functor C D) (G : Functor D C) : Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) where - field - adjIso : ∀ {c d} → Iso (D [ F ⟅ c ⟆ , d ]) (C [ c , G ⟅ d ⟆ ]) - - infix 40 _♭ - infix 40 _♯ - _♭ : ∀ {c d} → (D [ F ⟅ c ⟆ , d ]) → (C [ c , G ⟅ d ⟆ ]) - (_♭) {_} {_} = adjIso .fun - - _♯ : ∀ {c d} → (C [ c , G ⟅ d ⟆ ]) → (D [ F ⟅ c ⟆ , d ]) - (_♯) {_} {_} = adjIso .inv - - field - adjNatInD : ∀ {c : C .ob} {d d'} (f : D [ F ⟅ c ⟆ , d ]) (k : D [ d , d' ]) - → (f ⋆⟨ D ⟩ k) ♭ ≡ f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ - - adjNatInC : ∀ {c' c d} (g : C [ c , G ⟅ d ⟆ ]) (h : C [ c' , c ]) - → (h ⋆⟨ C ⟩ g) ♯ ≡ F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯ - - adjNatInD' : ∀ {c : C .ob} {d d'} (g : C [ c , G ⟅ d ⟆ ]) (k : D [ d , d' ]) - → g ♯ ⋆⟨ D ⟩ k ≡ (g ⋆⟨ C ⟩ G ⟪ k ⟫) ♯ - adjNatInD' {c} {d} {d'} g k = - g ♯ ⋆⟨ D ⟩ k - ≡⟨ sym (adjIso .leftInv (g ♯ ⋆⟨ D ⟩ k)) ⟩ - ((g ♯ ⋆⟨ D ⟩ k) ♭) ♯ - ≡⟨ cong _♯ (adjNatInD (g ♯) k) ⟩ - ((g ♯) ♭ ⋆⟨ C ⟩ G ⟪ k ⟫) ♯ - ≡⟨ cong _♯ (cong (λ g' → seq' C g' (G ⟪ k ⟫)) (adjIso .rightInv g)) ⟩ - (g ⋆⟨ C ⟩ G ⟪ k ⟫) ♯ ∎ - - adjNatInC' : ∀ {c' c d} (f : D [ F ⟅ c ⟆ , d ]) (h : C [ c' , c ]) - → h ⋆⟨ C ⟩ (f ♭) ≡ (F ⟪ h ⟫ ⋆⟨ D ⟩ f) ♭ - adjNatInC' {c'} {c} {d} f h = - h ⋆⟨ C ⟩ (f ♭) - ≡⟨ sym (adjIso .rightInv (h ⋆⟨ C ⟩ (f ♭))) ⟩ - ((h ⋆⟨ C ⟩ (f ♭)) ♯) ♭ - ≡⟨ cong _♭ (adjNatInC (f ♭) h) ⟩ - ((F ⟪ h ⟫ ⋆⟨ D ⟩ (f ♭) ♯) ♭) - ≡⟨ cong _♭ (cong (λ f' → seq' D (F ⟪ h ⟫) f') (adjIso .leftInv f)) ⟩ - (F ⟪ h ⟫ ⋆⟨ D ⟩ f) ♭ ∎ - - isLeftAdjoint : {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (F : Functor C D) → Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) - isLeftAdjoint {C = C}{D} F = Σ[ G ∈ Functor D C ] F ⊣ G - - isRightAdjoint : {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (G : Functor D C) → Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) - isRightAdjoint {C = C}{D} G = Σ[ F ∈ Functor C D ] F ⊣ G - -{- +module UnitCounit {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (F : Functor C D) (G : Functor D C) where + record TriangleIdentities + (η : 𝟙⟨ C ⟩ ⇒ (funcComp G F)) + (ε : (funcComp F G) ⇒ 𝟙⟨ D ⟩) + : Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) + where + field + Δ₁ : ∀ c → F ⟪ η ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ ε ⟦ F ⟅ c ⟆ ⟧ ≡ D .id + Δ₂ : ∀ d → η ⟦ G ⟅ d ⟆ ⟧ ⋆⟨ C ⟩ G ⟪ ε ⟦ d ⟧ ⟫ ≡ C .id + + -- Adjoint def 1: unit-counit + record _⊣_ : Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) where + field + -- unit + η : 𝟙⟨ C ⟩ ⇒ (funcComp G F) + -- counit + ε : (funcComp F G) ⇒ 𝟙⟨ D ⟩ + triangleIdentities : TriangleIdentities η ε + open TriangleIdentities triangleIdentities public + +module NaturalBijection where + -- Adjoint def 2: natural bijection + record _⊣_ {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (F : Functor C D) (G : Functor D C) : Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) where + field + adjIso : ∀ {c d} → Iso (D [ F ⟅ c ⟆ , d ]) (C [ c , G ⟅ d ⟆ ]) + + infix 40 _♭ + infix 40 _♯ + _♭ : ∀ {c d} → (D [ F ⟅ c ⟆ , d ]) → (C [ c , G ⟅ d ⟆ ]) + (_♭) {_} {_} = adjIso .fun + + _♯ : ∀ {c d} → (C [ c , G ⟅ d ⟆ ]) → (D [ F ⟅ c ⟆ , d ]) + (_♯) {_} {_} = adjIso .inv + + field + adjNatInD : ∀ {c : C .ob} {d d'} (f : D [ F ⟅ c ⟆ , d ]) (k : D [ d , d' ]) + → (f ⋆⟨ D ⟩ k) ♭ ≡ f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ + + adjNatInC : ∀ {c' c d} (g : C [ c , G ⟅ d ⟆ ]) (h : C [ c' , c ]) + → (h ⋆⟨ C ⟩ g) ♯ ≡ F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯ + + adjNatInD' : ∀ {c : C .ob} {d d'} (g : C [ c , G ⟅ d ⟆ ]) (k : D [ d , d' ]) + → g ♯ ⋆⟨ D ⟩ k ≡ (g ⋆⟨ C ⟩ G ⟪ k ⟫) ♯ + adjNatInD' {c} {d} {d'} g k = + g ♯ ⋆⟨ D ⟩ k + ≡⟨ sym (adjIso .leftInv (g ♯ ⋆⟨ D ⟩ k)) ⟩ + ((g ♯ ⋆⟨ D ⟩ k) ♭) ♯ + ≡⟨ cong _♯ (adjNatInD (g ♯) k) ⟩ + ((g ♯) ♭ ⋆⟨ C ⟩ G ⟪ k ⟫) ♯ + ≡⟨ cong _♯ (cong (λ g' → seq' C g' (G ⟪ k ⟫)) (adjIso .rightInv g)) ⟩ + (g ⋆⟨ C ⟩ G ⟪ k ⟫) ♯ ∎ + + adjNatInC' : ∀ {c' c d} (f : D [ F ⟅ c ⟆ , d ]) (h : C [ c' , c ]) + → h ⋆⟨ C ⟩ (f ♭) ≡ (F ⟪ h ⟫ ⋆⟨ D ⟩ f) ♭ + adjNatInC' {c'} {c} {d} f h = + h ⋆⟨ C ⟩ (f ♭) + ≡⟨ sym (adjIso .rightInv (h ⋆⟨ C ⟩ (f ♭))) ⟩ + ((h ⋆⟨ C ⟩ (f ♭)) ♯) ♭ + ≡⟨ cong _♭ (adjNatInC (f ♭) h) ⟩ + ((F ⟪ h ⟫ ⋆⟨ D ⟩ (f ♭) ♯) ♭) + ≡⟨ cong _♭ (cong (λ f' → seq' D (F ⟪ h ⟫) f') (adjIso .leftInv f)) ⟩ + (F ⟪ h ⟫ ⋆⟨ D ⟩ f) ♭ ∎ + + isLeftAdjoint : {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (F : Functor C D) → Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) + isLeftAdjoint {C = C}{D} F = Σ[ G ∈ Functor D C ] F ⊣ G + + isRightAdjoint : {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (G : Functor D C) → Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) + isRightAdjoint {C = C}{D} G = Σ[ F ∈ Functor C D ] F ⊣ G + +{- ============================================== Proofs of equivalence ============================================== @@ -117,159 +123,160 @@ The second unnamed module does the reverse. -} -module _ {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (F : Functor C D) (G : Functor D C) where - open UnitCounit - open NaturalBijection renaming (_⊣_ to _⊣²_) - module _ (adj : F ⊣² G) where - open _⊣²_ adj - open _⊣_ - - -- Naturality condition implies that a commutative square in C - -- appears iff the transpose in D is commutative as well - -- Used in adj'→adj - adjNat' : ∀ {c c' d d'} {f : D [ F ⟅ c ⟆ , d ]} {k : D [ d , d' ]} - → {h : C [ c , c' ]} {g : C [ c' , G ⟅ d' ⟆ ]} - -- commutativity of squares is iff - → ((f ⋆⟨ D ⟩ k ≡ F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯) → (f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ ≡ h ⋆⟨ C ⟩ g)) - × ((f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ ≡ h ⋆⟨ C ⟩ g) → (f ⋆⟨ D ⟩ k ≡ F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯)) - adjNat' {c} {c'} {d} {d'} {f} {k} {h} {g} = D→C , C→D - where - D→C : (f ⋆⟨ D ⟩ k ≡ F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯) → (f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ ≡ h ⋆⟨ C ⟩ g) - D→C eq = f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ - ≡⟨ sym (adjNatInD _ _) ⟩ - ((f ⋆⟨ D ⟩ k) ♭) - ≡⟨ cong _♭ eq ⟩ - (F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯) ♭ - ≡⟨ sym (cong _♭ (adjNatInC _ _)) ⟩ - (h ⋆⟨ C ⟩ g) ♯ ♭ - ≡⟨ adjIso .rightInv _ ⟩ - h ⋆⟨ C ⟩ g - ∎ - C→D : (f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ ≡ h ⋆⟨ C ⟩ g) → (f ⋆⟨ D ⟩ k ≡ F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯) - C→D eq = f ⋆⟨ D ⟩ k - ≡⟨ sym (adjIso .leftInv _) ⟩ - (f ⋆⟨ D ⟩ k) ♭ ♯ - ≡⟨ cong _♯ (adjNatInD _ _) ⟩ - (f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫) ♯ - ≡⟨ cong _♯ eq ⟩ - (h ⋆⟨ C ⟩ g) ♯ - ≡⟨ adjNatInC _ _ ⟩ - F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯ - ∎ - - open NatTrans - - -- note : had to make this record syntax because termination checker was complaining - -- due to referencing η and ε from the definitions of Δs - adj'→adj : F ⊣ G - adj'→adj = record - { η = η' - ; ε = ε' - ; Δ₁ = Δ₁' - ; Δ₂ = Δ₂' } - - where - -- ETA - - -- trivial commutative diagram between identities in D - commInD : ∀ {x y} (f : C [ x , y ]) → D .id ⋆⟨ D ⟩ F ⟪ f ⟫ ≡ F ⟪ f ⟫ ⋆⟨ D ⟩ D .id - commInD f = (D .⋆IdL _) ∙ sym (D .⋆IdR _) - - sharpen1 : ∀ {x y} (f : C [ x , y ]) → F ⟪ f ⟫ ⋆⟨ D ⟩ D .id ≡ F ⟪ f ⟫ ⋆⟨ D ⟩ D .id ♭ ♯ - sharpen1 f = cong (λ v → F ⟪ f ⟫ ⋆⟨ D ⟩ v) (sym (adjIso .leftInv _)) - - η' : 𝟙⟨ C ⟩ ⇒ G ∘F F - η' .N-ob x = D .id ♭ - η' .N-hom f = sym (fst (adjNat') (commInD f ∙ sharpen1 f)) - - -- EPSILON - - -- trivial commutative diagram between identities in C - commInC : ∀ {x y} (g : D [ x , y ]) → C .id ⋆⟨ C ⟩ G ⟪ g ⟫ ≡ G ⟪ g ⟫ ⋆⟨ C ⟩ C .id - commInC g = (C .⋆IdL _) ∙ sym (C .⋆IdR _) - - sharpen2 : ∀ {x y} (g : D [ x , y ]) → C .id ♯ ♭ ⋆⟨ C ⟩ G ⟪ g ⟫ ≡ C .id ⋆⟨ C ⟩ G ⟪ g ⟫ - sharpen2 g = cong (λ v → v ⋆⟨ C ⟩ G ⟪ g ⟫) (adjIso .rightInv _) - - ε' : F ∘F G ⇒ 𝟙⟨ D ⟩ - ε' .N-ob x = C .id ♯ - ε' .N-hom g = sym (snd adjNat' (sharpen2 g ∙ commInC g)) - - -- DELTA 1 - - Δ₁' : ∀ c → F ⟪ η' ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ ε' ⟦ F ⟅ c ⟆ ⟧ ≡ D .id - Δ₁' c = - F ⟪ η' ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ ε' ⟦ F ⟅ c ⟆ ⟧ - ≡⟨ sym (snd adjNat' (cong (λ v → (η' ⟦ c ⟧) ⋆⟨ C ⟩ v) (G .F-id))) ⟩ - D .id ⋆⟨ D ⟩ D .id - ≡⟨ D .⋆IdL _ ⟩ - D .id - ∎ - - -- DELTA 2 - - Δ₂' : ∀ d → η' ⟦ G ⟅ d ⟆ ⟧ ⋆⟨ C ⟩ G ⟪ ε' ⟦ d ⟧ ⟫ ≡ C .id - Δ₂' d = - (η' ⟦ G ⟅ d ⟆ ⟧) ⋆⟨ C ⟩ (G ⟪ ε' ⟦ d ⟧ ⟫) - ≡⟨ fst adjNat' (cong (λ v → v ⋆⟨ D ⟩ (ε' ⟦ d ⟧)) (sym (F .F-id))) ⟩ - C .id ⋆⟨ C ⟩ C .id - ≡⟨ C .⋆IdL _ ⟩ - C .id - ∎ - - - module _ (adj : F ⊣ G) where - open _⊣_ adj - open _⊣²_ - open NatTrans - - adj→adj' : F ⊣² G - -- ∀ {c d} → Iso (D [ F ⟅ c ⟆ , d ]) (C [ c , G ⟅ d ⟆ ]) - -- takes f to Gf precomposed with the unit - adj→adj' .adjIso {c = c} .fun f = η ⟦ c ⟧ ⋆⟨ C ⟩ G ⟪ f ⟫ - -- takes g to Fg postcomposed with the counit - adj→adj' .adjIso {d = d} .inv g = F ⟪ g ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧ - -- invertibility follows from the triangle identities - adj→adj' .adjIso {c = c} {d} .rightInv g - = η ⟦ c ⟧ ⋆⟨ C ⟩ G ⟪ F ⟪ g ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧ ⟫ - ≡⟨ cong (λ v → η ⟦ c ⟧ ⋆⟨ C ⟩ v) (G .F-seq _ _) ⟩ - η ⟦ c ⟧ ⋆⟨ C ⟩ (G ⟪ F ⟪ g ⟫ ⟫ ⋆⟨ C ⟩ G ⟪ ε ⟦ d ⟧ ⟫) - ≡⟨ sym (C .⋆Assoc _ _ _) ⟩ - η ⟦ c ⟧ ⋆⟨ C ⟩ G ⟪ F ⟪ g ⟫ ⟫ ⋆⟨ C ⟩ G ⟪ ε ⟦ d ⟧ ⟫ - -- apply naturality - ≡⟨ rCatWhisker {C = C} _ _ _ natu ⟩ - (g ⋆⟨ C ⟩ η ⟦ G ⟅ d ⟆ ⟧) ⋆⟨ C ⟩ G ⟪ ε ⟦ d ⟧ ⟫ - ≡⟨ C .⋆Assoc _ _ _ ⟩ - g ⋆⟨ C ⟩ (η ⟦ G ⟅ d ⟆ ⟧ ⋆⟨ C ⟩ G ⟪ ε ⟦ d ⟧ ⟫) - ≡⟨ lCatWhisker {C = C} _ _ _ (Δ₂ d) ⟩ - g ⋆⟨ C ⟩ C .id - ≡⟨ C .⋆IdR _ ⟩ - g - ∎ - where - natu : η ⟦ c ⟧ ⋆⟨ C ⟩ G ⟪ F ⟪ g ⟫ ⟫ ≡ g ⋆⟨ C ⟩ η ⟦ G ⟅ d ⟆ ⟧ - natu = sym (η .N-hom _) - adj→adj' .adjIso {c = c} {d} .leftInv f - = F ⟪ η ⟦ c ⟧ ⋆⟨ C ⟩ G ⟪ f ⟫ ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧ - ≡⟨ cong (λ v → v ⋆⟨ D ⟩ ε ⟦ d ⟧) (F .F-seq _ _) ⟩ - F ⟪ η ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ F ⟪ G ⟪ f ⟫ ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧ - ≡⟨ D .⋆Assoc _ _ _ ⟩ - F ⟪ η ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ (F ⟪ G ⟪ f ⟫ ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧) - -- apply naturality - ≡⟨ lCatWhisker {C = D} _ _ _ natu ⟩ - F ⟪ η ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ (ε ⟦ F ⟅ c ⟆ ⟧ ⋆⟨ D ⟩ f) - ≡⟨ sym (D .⋆Assoc _ _ _) ⟩ - F ⟪ η ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ ε ⟦ F ⟅ c ⟆ ⟧ ⋆⟨ D ⟩ f - -- apply triangle identity - ≡⟨ rCatWhisker {C = D} _ _ _ (Δ₁ c) ⟩ - D .id ⋆⟨ D ⟩ f - ≡⟨ D .⋆IdL _ ⟩ - f - ∎ - where - natu : F ⟪ G ⟪ f ⟫ ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧ ≡ ε ⟦ F ⟅ c ⟆ ⟧ ⋆⟨ D ⟩ f - natu = ε .N-hom _ - -- follows directly from functoriality - adj→adj' .adjNatInD {c = c} f k = cong (λ v → η ⟦ c ⟧ ⋆⟨ C ⟩ v) (G .F-seq _ _) ∙ (sym (C .⋆Assoc _ _ _)) - adj→adj' .adjNatInC {d = d} g h = cong (λ v → v ⋆⟨ D ⟩ ε ⟦ d ⟧) (F .F-seq _ _) ∙ D .⋆Assoc _ _ _ +module _ {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (F : Functor C D) (G : Functor D C) where + open UnitCounit + open NaturalBijection renaming (_⊣_ to _⊣²_) + module _ (adj : F ⊣² G) where + open _⊣²_ adj + open _⊣_ + + -- Naturality condition implies that a commutative square in C + -- appears iff the transpose in D is commutative as well + -- Used in adj'→adj + adjNat' : ∀ {c c' d d'} {f : D [ F ⟅ c ⟆ , d ]} {k : D [ d , d' ]} + → {h : C [ c , c' ]} {g : C [ c' , G ⟅ d' ⟆ ]} + -- commutativity of squares is iff + → ((f ⋆⟨ D ⟩ k ≡ F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯) → (f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ ≡ h ⋆⟨ C ⟩ g)) + × ((f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ ≡ h ⋆⟨ C ⟩ g) → (f ⋆⟨ D ⟩ k ≡ F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯)) + adjNat' {c} {c'} {d} {d'} {f} {k} {h} {g} = D→C , C→D + where + D→C : (f ⋆⟨ D ⟩ k ≡ F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯) → (f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ ≡ h ⋆⟨ C ⟩ g) + D→C eq = f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ + ≡⟨ sym (adjNatInD _ _) ⟩ + ((f ⋆⟨ D ⟩ k) ♭) + ≡⟨ cong _♭ eq ⟩ + (F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯) ♭ + ≡⟨ sym (cong _♭ (adjNatInC _ _)) ⟩ + (h ⋆⟨ C ⟩ g) ♯ ♭ + ≡⟨ adjIso .rightInv _ ⟩ + h ⋆⟨ C ⟩ g + ∎ + C→D : (f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫ ≡ h ⋆⟨ C ⟩ g) → (f ⋆⟨ D ⟩ k ≡ F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯) + C→D eq = f ⋆⟨ D ⟩ k + ≡⟨ sym (adjIso .leftInv _) ⟩ + (f ⋆⟨ D ⟩ k) ♭ ♯ + ≡⟨ cong _♯ (adjNatInD _ _) ⟩ + (f ♭ ⋆⟨ C ⟩ G ⟪ k ⟫) ♯ + ≡⟨ cong _♯ eq ⟩ + (h ⋆⟨ C ⟩ g) ♯ + ≡⟨ adjNatInC _ _ ⟩ + F ⟪ h ⟫ ⋆⟨ D ⟩ g ♯ + ∎ + + open NatTrans + + -- note : had to make this record syntax because termination checker was complaining + -- due to referencing η and ε from the definitions of Δs + adj'→adj : F ⊣ G + adj'→adj = record + { η = η' + ; ε = ε' + ; triangleIdentities = record + {Δ₁ = Δ₁' + ; Δ₂ = Δ₂' }} + + where + -- ETA + + -- trivial commutative diagram between identities in D + commInD : ∀ {x y} (f : C [ x , y ]) → D .id ⋆⟨ D ⟩ F ⟪ f ⟫ ≡ F ⟪ f ⟫ ⋆⟨ D ⟩ D .id + commInD f = (D .⋆IdL _) ∙ sym (D .⋆IdR _) + + sharpen1 : ∀ {x y} (f : C [ x , y ]) → F ⟪ f ⟫ ⋆⟨ D ⟩ D .id ≡ F ⟪ f ⟫ ⋆⟨ D ⟩ D .id ♭ ♯ + sharpen1 f = cong (λ v → F ⟪ f ⟫ ⋆⟨ D ⟩ v) (sym (adjIso .leftInv _)) + + η' : 𝟙⟨ C ⟩ ⇒ G ∘F F + η' .N-ob x = D .id ♭ + η' .N-hom f = sym (fst (adjNat') (commInD f ∙ sharpen1 f)) + + -- EPSILON + + -- trivial commutative diagram between identities in C + commInC : ∀ {x y} (g : D [ x , y ]) → C .id ⋆⟨ C ⟩ G ⟪ g ⟫ ≡ G ⟪ g ⟫ ⋆⟨ C ⟩ C .id + commInC g = (C .⋆IdL _) ∙ sym (C .⋆IdR _) + + sharpen2 : ∀ {x y} (g : D [ x , y ]) → C .id ♯ ♭ ⋆⟨ C ⟩ G ⟪ g ⟫ ≡ C .id ⋆⟨ C ⟩ G ⟪ g ⟫ + sharpen2 g = cong (λ v → v ⋆⟨ C ⟩ G ⟪ g ⟫) (adjIso .rightInv _) + + ε' : F ∘F G ⇒ 𝟙⟨ D ⟩ + ε' .N-ob x = C .id ♯ + ε' .N-hom g = sym (snd adjNat' (sharpen2 g ∙ commInC g)) + + -- DELTA 1 + + Δ₁' : ∀ c → F ⟪ η' ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ ε' ⟦ F ⟅ c ⟆ ⟧ ≡ D .id + Δ₁' c = + F ⟪ η' ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ ε' ⟦ F ⟅ c ⟆ ⟧ + ≡⟨ sym (snd adjNat' (cong (λ v → (η' ⟦ c ⟧) ⋆⟨ C ⟩ v) (G .F-id))) ⟩ + D .id ⋆⟨ D ⟩ D .id + ≡⟨ D .⋆IdL _ ⟩ + D .id + ∎ + + -- DELTA 2 + + Δ₂' : ∀ d → η' ⟦ G ⟅ d ⟆ ⟧ ⋆⟨ C ⟩ G ⟪ ε' ⟦ d ⟧ ⟫ ≡ C .id + Δ₂' d = + (η' ⟦ G ⟅ d ⟆ ⟧) ⋆⟨ C ⟩ (G ⟪ ε' ⟦ d ⟧ ⟫) + ≡⟨ fst adjNat' (cong (λ v → v ⋆⟨ D ⟩ (ε' ⟦ d ⟧)) (sym (F .F-id))) ⟩ + C .id ⋆⟨ C ⟩ C .id + ≡⟨ C .⋆IdL _ ⟩ + C .id + ∎ + + + module _ (adj : F ⊣ G) where + open _⊣_ adj + open _⊣²_ + open NatTrans + + adj→adj' : F ⊣² G + -- ∀ {c d} → Iso (D [ F ⟅ c ⟆ , d ]) (C [ c , G ⟅ d ⟆ ]) + -- takes f to Gf precomposed with the unit + adj→adj' .adjIso {c = c} .fun f = η ⟦ c ⟧ ⋆⟨ C ⟩ G ⟪ f ⟫ + -- takes g to Fg postcomposed with the counit + adj→adj' .adjIso {d = d} .inv g = F ⟪ g ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧ + -- invertibility follows from the triangle identities + adj→adj' .adjIso {c = c} {d} .rightInv g + = η ⟦ c ⟧ ⋆⟨ C ⟩ G ⟪ F ⟪ g ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧ ⟫ + ≡⟨ cong (λ v → η ⟦ c ⟧ ⋆⟨ C ⟩ v) (G .F-seq _ _) ⟩ + η ⟦ c ⟧ ⋆⟨ C ⟩ (G ⟪ F ⟪ g ⟫ ⟫ ⋆⟨ C ⟩ G ⟪ ε ⟦ d ⟧ ⟫) + ≡⟨ sym (C .⋆Assoc _ _ _) ⟩ + η ⟦ c ⟧ ⋆⟨ C ⟩ G ⟪ F ⟪ g ⟫ ⟫ ⋆⟨ C ⟩ G ⟪ ε ⟦ d ⟧ ⟫ + -- apply naturality + ≡⟨ rCatWhisker {C = C} _ _ _ natu ⟩ + (g ⋆⟨ C ⟩ η ⟦ G ⟅ d ⟆ ⟧) ⋆⟨ C ⟩ G ⟪ ε ⟦ d ⟧ ⟫ + ≡⟨ C .⋆Assoc _ _ _ ⟩ + g ⋆⟨ C ⟩ (η ⟦ G ⟅ d ⟆ ⟧ ⋆⟨ C ⟩ G ⟪ ε ⟦ d ⟧ ⟫) + ≡⟨ lCatWhisker {C = C} _ _ _ (Δ₂ d) ⟩ + g ⋆⟨ C ⟩ C .id + ≡⟨ C .⋆IdR _ ⟩ + g + ∎ + where + natu : η ⟦ c ⟧ ⋆⟨ C ⟩ G ⟪ F ⟪ g ⟫ ⟫ ≡ g ⋆⟨ C ⟩ η ⟦ G ⟅ d ⟆ ⟧ + natu = sym (η .N-hom _) + adj→adj' .adjIso {c = c} {d} .leftInv f + = F ⟪ η ⟦ c ⟧ ⋆⟨ C ⟩ G ⟪ f ⟫ ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧ + ≡⟨ cong (λ v → v ⋆⟨ D ⟩ ε ⟦ d ⟧) (F .F-seq _ _) ⟩ + F ⟪ η ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ F ⟪ G ⟪ f ⟫ ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧ + ≡⟨ D .⋆Assoc _ _ _ ⟩ + F ⟪ η ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ (F ⟪ G ⟪ f ⟫ ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧) + -- apply naturality + ≡⟨ lCatWhisker {C = D} _ _ _ natu ⟩ + F ⟪ η ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ (ε ⟦ F ⟅ c ⟆ ⟧ ⋆⟨ D ⟩ f) + ≡⟨ sym (D .⋆Assoc _ _ _) ⟩ + F ⟪ η ⟦ c ⟧ ⟫ ⋆⟨ D ⟩ ε ⟦ F ⟅ c ⟆ ⟧ ⋆⟨ D ⟩ f + -- apply triangle identity + ≡⟨ rCatWhisker {C = D} _ _ _ (Δ₁ c) ⟩ + D .id ⋆⟨ D ⟩ f + ≡⟨ D .⋆IdL _ ⟩ + f + ∎ + where + natu : F ⟪ G ⟪ f ⟫ ⟫ ⋆⟨ D ⟩ ε ⟦ d ⟧ ≡ ε ⟦ F ⟅ c ⟆ ⟧ ⋆⟨ D ⟩ f + natu = ε .N-hom _ + -- follows directly from functoriality + adj→adj' .adjNatInD {c = c} f k = cong (λ v → η ⟦ c ⟧ ⋆⟨ C ⟩ v) (G .F-seq _ _) ∙ (sym (C .⋆Assoc _ _ _)) + adj→adj' .adjNatInC {d = d} g h = cong (λ v → v ⋆⟨ D ⟩ ε ⟦ d ⟧) (F .F-seq _ _) ∙ D .⋆Assoc _ _ _ \ No newline at end of file diff --git a/docs/Cubical.Categories.Category.Base.html b/docs/Cubical.Categories.Category.Base.html index 6fb78a8..b094022 100644 --- a/docs/Cubical.Categories.Category.Base.html +++ b/docs/Cubical.Categories.Category.Base.html @@ -24,7 +24,7 @@ ⋆IdR : ∀ {x y} (f : Hom[ x , y ]) → f ⋆ id ≡ f ⋆Assoc : ∀ {x y z w} (f : Hom[ x , y ]) (g : Hom[ y , z ]) (h : Hom[ z , w ]) → (f ⋆ g) ⋆ h ≡ f ⋆ (g ⋆ h) - isSetHom : ∀ {x y} → isSet Hom[ x , y ] + isSetHom : ∀ {x y} → isSet Hom[ x , y ] -- composition: alternative to diagramatic order _∘_ : ∀ {x y z} (g : Hom[ y , z ]) (f : Hom[ x , y ]) → Hom[ x , z ] @@ -65,13 +65,13 @@ open isIso -isPropIsIso : {C : Category ℓ ℓ'}{x y : C .ob}(f : C [ x , y ]) → isProp (isIso C f) +isPropIsIso : {C : Category ℓ ℓ'}{x y : C .ob}(f : C [ x , y ]) → isProp (isIso C f) isPropIsIso {C = C} f p q i .inv = (sym (C .⋆IdL _) - ∙ (λ i → q .sec (~ i) ⋆⟨ C ⟩ p .inv) - ∙ C .⋆Assoc _ _ _ - ∙ (λ i → q .inv ⋆⟨ C ⟩ p .ret i) - ∙ C .⋆IdR _) i + ∙ (λ i → q .sec (~ i) ⋆⟨ C ⟩ p .inv) + ∙ C .⋆Assoc _ _ _ + ∙ (λ i → q .inv ⋆⟨ C ⟩ p .ret i) + ∙ C .⋆IdR _) i isPropIsIso {C = C} f p q i .sec j = isSet→SquareP (λ i j → C .isSetHom) (p .sec) (q .sec) (λ i → isPropIsIso {C = C} f p q i .inv ⋆⟨ C ⟩ f) refl i j @@ -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} @@ -98,15 +98,15 @@ idCatIso : {C : Category ℓ ℓ'} {x : C .ob} → CatIso C x x idCatIso {C = C} = C .id , isiso (C .id) (C .⋆IdL (C .id)) (C .⋆IdL (C .id)) -isSet-CatIso : {C : Category ℓ ℓ'} → ∀ x y → isSet (CatIso C x y) -isSet-CatIso {C = C} x y = isOfHLevelΣ 2 (C .isSetHom) (λ f → isProp→isSet (isPropIsIso f)) +isSet-CatIso : {C : Category ℓ ℓ'} → ∀ x y → isSet (CatIso C x y) +isSet-CatIso {C = C} x y = isOfHLevelΣ 2 (C .isSetHom) (λ f → isProp→isSet (isPropIsIso f)) pathToIso : {C : Category ℓ ℓ'} {x y : C .ob} (p : x ≡ y) → CatIso C x y -pathToIso {C = C} p = J (λ z _ → CatIso C _ z) idCatIso p +pathToIso {C = C} p = J (λ z _ → CatIso C _ z) idCatIso p pathToIso-refl : {C : Category ℓ ℓ'} {x : C .ob} → pathToIso {C = C} {x} refl ≡ idCatIso -pathToIso-refl {C = C} {x} = JRefl (λ z _ → CatIso C x z) (idCatIso) +pathToIso-refl {C = C} {x} = JRefl (λ z _ → CatIso C x z) (idCatIso) -- Univalent Categories @@ -122,7 +122,7 @@ CatIsoToPath : {x y : C .ob} (p : CatIso _ x y) → x ≡ y CatIsoToPath = invEq (univEquiv _ _) - isGroupoid-ob : isGroupoid (C .ob) + isGroupoid-ob : isGroupoid (C .ob) isGroupoid-ob = isOfHLevelPath'⁻ 2 (λ _ _ → isOfHLevelRespectEquiv 2 (invEquiv (univEquiv _ _)) (isSet-CatIso _ _)) diff --git a/docs/Cubical.Categories.Category.Properties.html b/docs/Cubical.Categories.Category.Properties.html index ec074b7..e76903a 100644 --- a/docs/Cubical.Categories.Category.Properties.html +++ b/docs/Cubical.Categories.Category.Properties.html @@ -49,34 +49,34 @@ -- working with equal objects idP : ∀ {x x'} {p : x ≡ x'} → C [ x , x' ] - idP {x} {x'} {p} = subst (λ v → C [ x , v ]) p (C .id) + idP {x} {x'} {p} = subst (λ v → C [ x , v ]) p (C .id) -- heterogeneous seq seqP : ∀ {x y y' z} {p : y ≡ y'} → (f : C [ x , y ]) (g : C [ y' , z ]) → C [ x , z ] - seqP {x} {_} {_} {z} {p} f g = f ⋆⟨ C ⟩ (subst (λ a → C [ a , z ]) (sym p) g) + seqP {x} {_} {_} {z} {p} f g = f ⋆⟨ C ⟩ (subst (λ a → C [ a , z ]) (sym p) g) -- also heterogeneous seq, but substituting on the left seqP' : ∀ {x y y' z} {p : y ≡ y'} → (f : C [ x , y ]) (g : C [ y' , z ]) → C [ x , z ] - seqP' {x} {_} {_} {z} {p} f g = subst (λ a → C [ x , a ]) p f ⋆⟨ C ⟩ g + seqP' {x} {_} {_} {z} {p} f g = subst (λ a → C [ x , a ]) p f ⋆⟨ C ⟩ g -- show that they're equal seqP≡seqP' : ∀ {x y y' z} {p : y ≡ y'} → (f : C [ x , y ]) (g : C [ y' , z ]) → seqP {p = p} f g ≡ seqP' {p = p} f g seqP≡seqP' {x = x} {z = z} {p = p} f g i = - (toPathP {A = λ i' → C [ x , p i' ]} {f} refl i) + (toPathP {A = λ i' → C [ x , p i' ]} {f} refl i) ⋆⟨ C ⟩ - (toPathP {A = λ i' → C [ p (~ i') , z ]} {x = g} (sym refl) (~ i)) + (toPathP {A = λ i' → C [ p (~ i') , z ]} {x = g} (sym refl) (~ i)) -- seqP is equal to normal seq when y ≡ y' seqP≡seq : ∀ {x y z} → (f : C [ x , y ]) (g : C [ y , z ]) → seqP {p = refl} f g ≡ f ⋆⟨ C ⟩ g - seqP≡seq {y = y} {z} f g i = f ⋆⟨ C ⟩ toPathP {A = λ _ → C [ y , z ]} {x = g} refl (~ i) + seqP≡seq {y = y} {z} f g i = f ⋆⟨ C ⟩ toPathP {A = λ _ → C [ y , z ]} {x = g} refl (~ i) -- whiskering with heterogenous seq -- (maybe should let z be heterogeneous too) @@ -85,11 +85,11 @@ → (r : PathP (λ i → C [ p i , z ]) g g') → f ⋆⟨ C ⟩ g ≡ seqP {p = p} f g' lCatWhiskerP {z = z} {p = p} f g g' r = - cong (λ v → f ⋆⟨ C ⟩ v) (sym (fromPathP (symP {A = λ i → C [ p (~ i) , z ]} r))) + cong (λ v → f ⋆⟨ C ⟩ v) (sym (fromPathP (symP {A = λ i → C [ p (~ i) , z ]} r))) rCatWhiskerP : {x y' y z : C .ob} {p : y' ≡ y} → (f' : C [ x , y' ]) (f : C [ x , y ]) (g : C [ y , z ]) → (r : PathP (λ i → C [ x , p i ]) f' f) → f ⋆⟨ C ⟩ g ≡ seqP' {p = p} f' g - rCatWhiskerP f' f g r = cong (λ v → v ⋆⟨ C ⟩ g) (sym (fromPathP r)) + rCatWhiskerP f' f g r = cong (λ v → v ⋆⟨ C ⟩ g) (sym (fromPathP r)) \ No newline at end of file diff --git a/docs/Cubical.Categories.Commutativity.html b/docs/Cubical.Categories.Commutativity.html index 03d5f7b..0f3e6ba 100644 --- a/docs/Cubical.Categories.Commutativity.html +++ b/docs/Cubical.Categories.Commutativity.html @@ -21,15 +21,15 @@ → f ⋆ (g ⋆ l) ≡ (h ⋆ m) ⋆ n compSq {f = f} {g} {h} {k} {l} {m} {n} p q = f ⋆ (g ⋆ l) - ≡⟨ sym (⋆Assoc _ _ _) ⟩ + ≡⟨ sym (⋆Assoc _ _ _) ⟩ (f ⋆ g) ⋆ l - ≡⟨ cong (_⋆ l) p ⟩ + ≡⟨ cong (_⋆ l) p ⟩ (h ⋆ k) ⋆ l - ≡⟨ ⋆Assoc _ _ _ ⟩ + ≡⟨ ⋆Assoc _ _ _ ⟩ h ⋆ (k ⋆ l) - ≡⟨ cong (h ⋆_) q ⟩ + ≡⟨ cong (h ⋆_) q ⟩ h ⋆ (m ⋆ n) - ≡⟨ sym (⋆Assoc _ _ _) ⟩ + ≡⟨ sym (⋆Assoc _ _ _) ⟩ (h ⋆ m) ⋆ n - ∎ + ∎ \ No newline at end of file diff --git a/docs/Cubical.Categories.Constructions.BinProduct.html b/docs/Cubical.Categories.Constructions.BinProduct.html index 248ceef..dd57ce8 100644 --- a/docs/Cubical.Categories.Constructions.BinProduct.html +++ b/docs/Cubical.Categories.Constructions.BinProduct.html @@ -32,19 +32,19 @@ infixr 5 _×C_ -open Functor +open Functor -Fst : (C : Category ℓC ℓC') → (D : Category ℓD ℓD') → Functor (C ×C D) C -F-ob (Fst C D) = fst -F-hom (Fst C D) = fst -F-id (Fst C D) = refl -F-seq (Fst C D) _ _ = refl +Fst : (C : Category ℓC ℓC') → (D : Category ℓD ℓD') → Functor (C ×C D) C +F-ob (Fst C D) = fst +F-hom (Fst C D) = fst +F-id (Fst C D) = refl +F-seq (Fst C D) _ _ = refl -Snd : (C : Category ℓC ℓC') → (D : Category ℓD ℓD') → Functor (C ×C D) D -F-ob (Snd C D) = snd -F-hom (Snd C D) = snd -F-id (Snd C D) = refl -F-seq (Snd C D) _ _ = refl +Snd : (C : Category ℓC ℓC') → (D : Category ℓD ℓD') → Functor (C ×C D) D +F-ob (Snd C D) = snd +F-hom (Snd C D) = snd +F-id (Snd C D) = refl +F-seq (Snd C D) _ _ = refl module _ where private @@ -55,36 +55,36 @@ D : Category ℓD ℓD' E : Category ℓE ℓE' - open Functor + open Functor - _,F_ : Functor C D → Functor C E → Functor C (D ×C E) - (G ,F H) .F-ob a = (G ⟅ a ⟆ , H ⟅ a ⟆) - (G ,F H) .F-hom g = (G ⟪ g ⟫ , H ⟪ g ⟫) - (G ,F H) .F-id = ≡-× (G .F-id) (H .F-id) - (G ,F H) .F-seq _ _ = ≡-× (G .F-seq _ _) (H .F-seq _ _) + _,F_ : Functor C D → Functor C E → Functor C (D ×C E) + (G ,F H) .F-ob a = (G ⟅ a ⟆ , H ⟅ a ⟆) + (G ,F H) .F-hom g = (G ⟪ g ⟫ , H ⟪ g ⟫) + (G ,F H) .F-id = ≡-× (G .F-id) (H .F-id) + (G ,F H) .F-seq _ _ = ≡-× (G .F-seq _ _) (H .F-seq _ _) - _×F_ : Functor A C → Functor B D → Functor (A ×C B) (C ×C D) - _×F_ {A = A} {B = B} G H = G ∘F Fst A B ,F H ∘F Snd A B + _×F_ : Functor A C → Functor B D → Functor (A ×C B) (C ×C D) + _×F_ {A = A} {B = B} G H = G ∘F Fst A B ,F H ∘F Snd A B -- Some useful functors module _ (C : Category ℓC ℓC') (D : Category ℓD ℓD') where - open Functor + open Functor module _ (E : Category ℓE ℓE') where -- Associativity of product - ×C-assoc : Functor (C ×C (D ×C E)) ((C ×C D) ×C E) - ×C-assoc .F-ob (c , (d , e)) = ((c , d), e) - ×C-assoc .F-hom (f , (g , h)) = ((f , g), h) - ×C-assoc .F-id = refl - ×C-assoc .F-seq _ _ = refl + ×C-assoc : Functor (C ×C (D ×C E)) ((C ×C D) ×C E) + ×C-assoc .F-ob (c , (d , e)) = ((c , d), e) + ×C-assoc .F-hom (f , (g , h)) = ((f , g), h) + ×C-assoc .F-id = refl + ×C-assoc .F-seq _ _ = refl -- Left/right injections into product - linj : (d : ob D) → Functor C (C ×C D) - linj d = Id ,F Constant C D d + linj : (d : ob D) → Functor C (C ×C D) + linj d = Id ,F Constant C D d - rinj : (c : ob C) → Functor D (C ×C D) - rinj c = Constant D C c ,F Id + rinj : (c : ob C) → Functor D (C ×C D) + rinj c = Constant D C c ,F Id {- TODO: diff --git a/docs/Cubical.Categories.Functor.Base.html b/docs/Cubical.Categories.Functor.Base.html index 14988dc..915f951 100644 --- a/docs/Cubical.Categories.Functor.Base.html +++ b/docs/Cubical.Categories.Functor.Base.html @@ -2,153 +2,160 @@ Cubical.Categories.Functor.Base
{-# OPTIONS --safe #-}
 module Cubical.Categories.Functor.Base where
 
-open import Cubical.Foundations.Prelude
-open import Cubical.Foundations.Equiv
-open import Cubical.Foundations.HLevels
-open import Cubical.Foundations.Powerset
-
-open import Cubical.Data.Sigma
-
-open import Cubical.Categories.Category
-
-private
-  variable
-    ℓC ℓC' ℓD ℓD' : Level
-
-record Functor (C : Category ℓC ℓC') (D : Category ℓD ℓD') :
-         Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) where
-  no-eta-equality
-
-  open Category
-
-  field
-    F-ob  : C .ob → D .ob
-    F-hom : {x y : C .ob} → C [ x , y ] → D [ F-ob x , F-ob y ]
-    F-id  : {x : C .ob} → F-hom (C .id) ≡ D .id {x = F-ob x}
-    F-seq : {x y z : C .ob} (f : C [ x , y ]) (g : C [ y , z ])
-          → F-hom (f ⋆⟨ C ⟩ g) ≡ (F-hom f) ⋆⟨ D ⟩ (F-hom g)
-
-  isFull = (x y : _) (F[f] : D [ F-ob x , F-ob y ]) → ∃[ f ∈ C [ x , y ] ] F-hom f ≡ F[f]
-  isFaithful = (x y : _) (f g : C [ x , y ]) → F-hom f ≡ F-hom g → f ≡ g
-  isFullyFaithful = (x y : _) → isEquiv (F-hom {x = x} {y = y})
-  isEssentiallySurj = (d : D .ob) → ∃[ c ∈ C .ob ] CatIso D (F-ob c) d
-
-  -- preservation of commuting squares and triangles
-  F-square : {x y u v : C .ob}
-             {f : C [ x , y ]} {g : C [ x , u ]}
-             {h : C [ u , v ]} {k : C [ y , v ]}
-           → f ⋆⟨ C ⟩ k ≡ g ⋆⟨ C ⟩ h
-           → (F-hom f) ⋆⟨ D ⟩ (F-hom k) ≡ (F-hom g) ⋆⟨ D ⟩ (F-hom h)
-  F-square Csquare = sym (F-seq _ _) ∙∙ cong F-hom Csquare ∙∙ F-seq _ _
-
-  F-triangle : {x y z : C .ob}
-               {f : C [ x , y ]} {g : C [ y , z ]} {h : C [ x , z ]}
-             → f ⋆⟨ C ⟩ g ≡ h
-             → (F-hom f) ⋆⟨ D ⟩ (F-hom g) ≡ (F-hom h)
-  F-triangle Ctriangle = sym (F-seq _ _) ∙ cong F-hom Ctriangle
-
-private
-  variable
-    ℓ ℓ' : Level
-    B C D E : Category ℓ ℓ'
-
-open Category
-open Functor
-
-Functor≡ : {F G : Functor C D}
-         → (h : ∀ (c : ob C) → F-ob F c ≡ F-ob G c)
-         → (∀ {c c' : ob C} (f : C [ c , c' ]) → PathP (λ i → D [ h c i , h c' i ]) (F-hom F f) (F-hom G f))
-         → F ≡ G
-F-ob (Functor≡ hOb hHom i) c = hOb c i
-F-hom (Functor≡ hOb hHom i) f = hHom f i
-F-id (Functor≡ {C = C} {D = D} {F = F} {G = G} hOb hHom i) =
-  isProp→PathP (λ j → isSetHom D (hHom (C .id) j) (D .id)) (F-id F) (F-id G) i
-F-seq (Functor≡ {C = C} {D = D} {F = F} {G = G} hOb hHom i) f g =
-  isProp→PathP (λ j → isSetHom D (hHom (f ⋆⟨ C ⟩ g) j) ((hHom f j) ⋆⟨ D ⟩ (hHom g j))) (F-seq F f g) (F-seq G f g) i
-
-FunctorSquare :
-  {F₀₀ F₀₁ F₁₀ F₁₁ : Functor C D}
-  (F₀₋ : F₀₀ ≡ F₀₁) (F₁₋ : F₁₀ ≡ F₁₁)
-  (F₋₀ : F₀₀ ≡ F₁₀) (F₋₁ : F₀₁ ≡ F₁₁)
-  → Square (cong F-ob F₀₋) (cong F-ob F₁₋) (cong F-ob F₋₀) (cong F-ob F₋₁)
-  → Square F₀₋ F₁₋ F₋₀ F₋₁
-FunctorSquare {C = C} {D = D} F₀₋ F₁₋ F₋₀ F₋₁ r = sqr
-  where
-  sqr : _
-  sqr i j .F-ob = r i j
-  sqr i j .F-hom {x = x} {y = y} f =
-    isSet→SquareP (λ i j → D .isSetHom {x = sqr i j .F-ob x} {y = sqr i j .F-ob y})
-    (λ i → F₀₋ i .F-hom f) (λ i → F₁₋ i .F-hom f) (λ i → F₋₀ i .F-hom f) (λ i → F₋₁ i .F-hom f) i j
-  sqr i j .F-id {x = x} =
-    isSet→SquareP (λ i j → isProp→isSet (D .isSetHom (sqr i j .F-hom (C .id)) (D .id)))
-    (λ i → F₀₋ i .F-id) (λ i → F₁₋ i .F-id) (λ i → F₋₀ i .F-id) (λ i → F₋₁ i .F-id) i j
-  sqr i j .F-seq f g =
-    isSet→SquareP (λ i j →
-      isProp→isSet (D .isSetHom (sqr i j .F-hom (f ⋆⟨ C ⟩ g)) ((sqr i j .F-hom f) ⋆⟨ D ⟩ (sqr i j .F-hom g))))
-    (λ i → F₀₋ i .F-seq f g) (λ i → F₁₋ i .F-seq f g) (λ i → F₋₀ i .F-seq f g) (λ i → F₋₁ i .F-seq f g) i j
-
-FunctorPath≡ : {F G : Functor C D}{p q : F ≡ G} → cong F-ob p ≡ cong F-ob q → p ≡ q
-FunctorPath≡ {p = p} {q = q} = FunctorSquare p q refl refl
-
-
--- Helpful notation
-
--- action on objects
-infix 30 _⟅_⟆
-_⟅_⟆ : (F : Functor C D)
-     → C .ob
-     → D .ob
-_⟅_⟆ = F-ob
-
--- action on morphisms
-infix 30 _⟪_⟫ -- same infix level as on objects since these will never be used in the same context
-_⟪_⟫ : (F : Functor C D)
-     → ∀ {x y}
-     → C [ x , y ]
-     → D [(F ⟅ x ⟆) , (F ⟅ y ⟆)]
-_⟪_⟫ = F-hom
-
-
--- Functor constructions
-
-𝟙⟨_⟩ : ∀ (C : Category ℓ ℓ') → Functor C C
-𝟙⟨ C ⟩ .F-ob x    = x
-𝟙⟨ C ⟩ .F-hom f   = f
-𝟙⟨ C ⟩ .F-id      = refl
-𝟙⟨ C ⟩ .F-seq _ _ = refl
-
-Id : {C : Category ℓ ℓ'} → Functor C C
-Id = 𝟙⟨ _ ⟩
-
-
--- functor composition
-funcComp : ∀ (G : Functor D E) (F : Functor C D) → Functor C E
-(funcComp G F) .F-ob c    = G ⟅ F ⟅ c ⟆ ⟆
-(funcComp G F) .F-hom f   = G ⟪ F ⟪ f ⟫ ⟫
-(funcComp G F) .F-id      = cong (G ⟪_⟫) (F .F-id) ∙ G .F-id
-(funcComp G F) .F-seq f g = cong (G ⟪_⟫) (F .F-seq _ _) ∙ G .F-seq _ _
-
-infixr 30 funcComp
-syntax funcComp G F = G ∘F F
-
--- hacky lemma to stop Agda from computing too much
-funcCompOb≡ : ∀ (G : Functor D E) (F : Functor C D) (c : ob C)
-            → funcComp G F .F-ob c ≡ G .F-ob (F .F-ob c)
-funcCompOb≡ G F c = refl
-
-_^opF : Functor C D → Functor (C ^op) (D ^op)
-(F ^opF) .F-ob      = F .F-ob
-(F ^opF) .F-hom     = F .F-hom
-(F ^opF) .F-id      = F .F-id
-(F ^opF) .F-seq f g = F .F-seq g f
-
-
--- Functoriality on full subcategories defined by propositions
-ΣPropCatFunc : {P : ℙ (ob C)} {Q : ℙ (ob D)} (F : Functor C D)
-             → (∀ c → c ∈ P → F .F-ob c ∈ Q)
-             → Functor (ΣPropCat C P) (ΣPropCat D Q)
-F-ob (ΣPropCatFunc F FPres) (c , c∈P) = F .F-ob c , FPres c c∈P
-F-hom (ΣPropCatFunc F FPres) = F .F-hom
-F-id (ΣPropCatFunc F FPres) = F .F-id
-F-seq (ΣPropCatFunc F FPres) = F .F-seq
+open import Cubical.Foundations.Powerset
+open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.Equiv
+open import Cubical.Foundations.HLevels
+open import Cubical.Foundations.Powerset
+
+open import Cubical.Data.Sigma
+
+open import Cubical.Categories.Category
+
+private
+  variable
+    ℓC ℓC' ℓD ℓD' : Level
+
+record Functor (C : Category ℓC ℓC') (D : Category ℓD ℓD') :
+         Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) where
+  no-eta-equality
+
+  open Category
+
+  field
+    F-ob  : C .ob → D .ob
+    F-hom : {x y : C .ob} → C [ x , y ] → D [ F-ob x , F-ob y ]
+    F-id  : {x : C .ob} → F-hom (C .id) ≡ D .id {x = F-ob x}
+    F-seq : {x y z : C .ob} (f : C [ x , y ]) (g : C [ y , z ])
+          → F-hom (f ⋆⟨ C ⟩ g) ≡ (F-hom f) ⋆⟨ D ⟩ (F-hom g)
+
+  isFull = (x y : _) (F[f] : D [ F-ob x , F-ob y ]) → ∃[ f ∈ C [ x , y ] ] F-hom f ≡ F[f]
+  isFaithful = (x y : _) (f g : C [ x , y ]) → F-hom f ≡ F-hom g → f ≡ g
+  isFullyFaithful = (x y : _) → isEquiv (F-hom {x = x} {y = y})
+  isEssentiallySurj = (d : D .ob) → ∃[ c ∈ C .ob ] CatIso D (F-ob c) d
+
+  -- preservation of commuting squares and triangles
+  F-square : {x y u v : C .ob}
+             {f : C [ x , y ]} {g : C [ x , u ]}
+             {h : C [ u , v ]} {k : C [ y , v ]}
+           → f ⋆⟨ C ⟩ k ≡ g ⋆⟨ C ⟩ h
+           → (F-hom f) ⋆⟨ D ⟩ (F-hom k) ≡ (F-hom g) ⋆⟨ D ⟩ (F-hom h)
+  F-square Csquare = sym (F-seq _ _) ∙∙ cong F-hom Csquare ∙∙ F-seq _ _
+
+  F-triangle : {x y z : C .ob}
+               {f : C [ x , y ]} {g : C [ y , z ]} {h : C [ x , z ]}
+             → f ⋆⟨ C ⟩ g ≡ h
+             → (F-hom f) ⋆⟨ D ⟩ (F-hom g) ≡ (F-hom h)
+  F-triangle Ctriangle = sym (F-seq _ _) ∙ cong F-hom Ctriangle
+
+private
+  variable
+    ℓ ℓ' : Level
+    B C D E : Category ℓ ℓ'
+
+open Category
+open Functor
+
+Functor≡ : {F G : Functor C D}
+         → (h : ∀ (c : ob C) → F-ob F c ≡ F-ob G c)
+         → (∀ {c c' : ob C} (f : C [ c , c' ]) → PathP (λ i → D [ h c i , h c' i ]) (F-hom F f) (F-hom G f))
+         → F ≡ G
+F-ob (Functor≡ hOb hHom i) c = hOb c i
+F-hom (Functor≡ hOb hHom i) f = hHom f i
+F-id (Functor≡ {C = C} {D = D} {F = F} {G = G} hOb hHom i) =
+  isProp→PathP (λ j → isSetHom D (hHom (C .id) j) (D .id)) (F-id F) (F-id G) i
+F-seq (Functor≡ {C = C} {D = D} {F = F} {G = G} hOb hHom i) f g =
+  isProp→PathP (λ j → isSetHom D (hHom (f ⋆⟨ C ⟩ g) j) ((hHom f j) ⋆⟨ D ⟩ (hHom g j))) (F-seq F f g) (F-seq G f g) i
+
+FunctorSquare :
+  {F₀₀ F₀₁ F₁₀ F₁₁ : Functor C D}
+  (F₀₋ : F₀₀ ≡ F₀₁) (F₁₋ : F₁₀ ≡ F₁₁)
+  (F₋₀ : F₀₀ ≡ F₁₀) (F₋₁ : F₀₁ ≡ F₁₁)
+  → Square (cong F-ob F₀₋) (cong F-ob F₁₋) (cong F-ob F₋₀) (cong F-ob F₋₁)
+  → Square F₀₋ F₁₋ F₋₀ F₋₁
+FunctorSquare {C = C} {D = D} F₀₋ F₁₋ F₋₀ F₋₁ r = sqr
+  where
+  sqr : _
+  sqr i j .F-ob = r i j
+  sqr i j .F-hom {x = x} {y = y} f =
+    isSet→SquareP (λ i j → D .isSetHom {x = sqr i j .F-ob x} {y = sqr i j .F-ob y})
+    (λ i → F₀₋ i .F-hom f) (λ i → F₁₋ i .F-hom f) (λ i → F₋₀ i .F-hom f) (λ i → F₋₁ i .F-hom f) i j
+  sqr i j .F-id {x = x} =
+    isSet→SquareP (λ i j → isProp→isSet (D .isSetHom (sqr i j .F-hom (C .id)) (D .id)))
+    (λ i → F₀₋ i .F-id) (λ i → F₁₋ i .F-id) (λ i → F₋₀ i .F-id) (λ i → F₋₁ i .F-id) i j
+  sqr i j .F-seq f g =
+    isSet→SquareP (λ i j →
+      isProp→isSet (D .isSetHom (sqr i j .F-hom (f ⋆⟨ C ⟩ g)) ((sqr i j .F-hom f) ⋆⟨ D ⟩ (sqr i j .F-hom g))))
+    (λ i → F₀₋ i .F-seq f g) (λ i → F₁₋ i .F-seq f g) (λ i → F₋₀ i .F-seq f g) (λ i → F₋₁ i .F-seq f g) i j
+
+FunctorPath≡ : {F G : Functor C D}{p q : F ≡ G} → cong F-ob p ≡ cong F-ob q → p ≡ q
+FunctorPath≡ {p = p} {q = q} = FunctorSquare p q refl refl
+
+
+-- Helpful notation
+
+-- action on objects
+infix 30 _⟅_⟆
+_⟅_⟆ : (F : Functor C D)
+     → C .ob
+     → D .ob
+_⟅_⟆ = F-ob
+
+-- action on morphisms
+infix 30 _⟪_⟫ -- same infix level as on objects since these will never be used in the same context
+_⟪_⟫ : (F : Functor C D)
+     → ∀ {x y}
+     → C [ x , y ]
+     → D [(F ⟅ x ⟆) , (F ⟅ y ⟆)]
+_⟪_⟫ = F-hom
+
+
+-- Functor constructions
+
+𝟙⟨_⟩ : ∀ (C : Category ℓ ℓ') → Functor C C
+𝟙⟨ C ⟩ .F-ob x    = x
+𝟙⟨ C ⟩ .F-hom f   = f
+𝟙⟨ C ⟩ .F-id      = refl
+𝟙⟨ C ⟩ .F-seq _ _ = refl
+
+Id : {C : Category ℓ ℓ'} → Functor C C
+Id = 𝟙⟨ _ ⟩
+
+forgetΣPropCat : (C : Category ℓ ℓ') (prop : ℙ (C .ob)) → Functor (ΣPropCat C prop) C
+forgetΣPropCat _ _ .F-ob x    = x .fst
+forgetΣPropCat _ _ .F-hom f   = f
+forgetΣPropCat _ _ .F-id      = refl
+forgetΣPropCat _ _ .F-seq _ _ = refl
+
+-- functor composition
+funcComp : ∀ (G : Functor D E) (F : Functor C D) → Functor C E
+(funcComp G F) .F-ob c    = G ⟅ F ⟅ c ⟆ ⟆
+(funcComp G F) .F-hom f   = G ⟪ F ⟪ f ⟫ ⟫
+(funcComp G F) .F-id      = cong (G ⟪_⟫) (F .F-id) ∙ G .F-id
+(funcComp G F) .F-seq f g = cong (G ⟪_⟫) (F .F-seq _ _) ∙ G .F-seq _ _
+
+infixr 30 _∘F_
+_∘F_ : Functor D E → Functor C D → Functor C E
+_∘F_ = funcComp
+
+-- hacky lemma to stop Agda from computing too much
+funcCompOb≡ : ∀ (G : Functor D E) (F : Functor C D) (c : ob C)
+            → funcComp G F .F-ob c ≡ G .F-ob (F .F-ob c)
+funcCompOb≡ G F c = refl
+
+_^opF : Functor C D → Functor (C ^op) (D ^op)
+(F ^opF) .F-ob      = F .F-ob
+(F ^opF) .F-hom     = F .F-hom
+(F ^opF) .F-id      = F .F-id
+(F ^opF) .F-seq f g = F .F-seq g f
+
+
+-- Functoriality on full subcategories defined by propositions
+ΣPropCatFunc : {P : ℙ (ob C)} {Q : ℙ (ob D)} (F : Functor C D)
+             → (∀ c → c ∈ P → F .F-ob c ∈ Q)
+             → Functor (ΣPropCat C P) (ΣPropCat D Q)
+F-ob (ΣPropCatFunc F FPres) (c , c∈P) = F .F-ob c , FPres c c∈P
+F-hom (ΣPropCatFunc F FPres) = F .F-hom
+F-id (ΣPropCatFunc F FPres) = F .F-id
+F-seq (ΣPropCatFunc F FPres) = F .F-seq
\ No newline at end of file diff --git a/docs/Cubical.Categories.Functor.Compose.html b/docs/Cubical.Categories.Functor.Compose.html index ce37f7b..0ed1143 100644 --- a/docs/Cubical.Categories.Functor.Compose.html +++ b/docs/Cubical.Categories.Functor.Compose.html @@ -13,34 +13,34 @@ module _ {ℓC ℓC' ℓD ℓD' ℓE ℓE'} {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (E : Category ℓE ℓE') - (F : Functor C D) + (F : Functor C D) where - open Functor + open Functor open NatTrans - precomposeF : Functor (FUNCTOR D E) (FUNCTOR C E) - precomposeF .F-ob G = funcComp G F - precomposeF .F-hom α .N-ob c = α .N-ob (F .F-ob c) - precomposeF .F-hom α .N-hom f = α .N-hom (F .F-hom f) - precomposeF .F-id = refl - precomposeF .F-seq f g = refl + precomposeF : Functor (FUNCTOR D E) (FUNCTOR C E) + precomposeF .F-ob G = funcComp G F + precomposeF .F-hom α .N-ob c = α .N-ob (F .F-ob c) + precomposeF .F-hom α .N-hom f = α .N-hom (F .F-hom f) + precomposeF .F-id = refl + precomposeF .F-seq f g = refl module _ {ℓC ℓC' ℓD ℓD' ℓE ℓE'} (C : Category ℓC ℓC') {D : Category ℓD ℓD'} {E : Category ℓE ℓE'} - (G : Functor D E) + (G : Functor D E) where - open Functor + open Functor open NatTrans - postcomposeF : Functor (FUNCTOR C D) (FUNCTOR C E) - postcomposeF .F-ob F = funcComp G F - postcomposeF .F-hom α .N-ob c = G. F-hom (α .N-ob c) - postcomposeF .F-hom {F₀} {F₁} α .N-hom {x} {y} f = - sym (G .F-seq (F₀ ⟪ f ⟫) (α ⟦ y ⟧)) - ∙∙ cong (G ⟪_⟫) (α .N-hom f) - ∙∙ G .F-seq (α ⟦ x ⟧) (F₁ ⟪ f ⟫) - postcomposeF .F-id = makeNatTransPath (funExt λ _ → G .F-id) - postcomposeF .F-seq f g = makeNatTransPath (funExt λ _ → G .F-seq _ _) + postcomposeF : Functor (FUNCTOR C D) (FUNCTOR C E) + postcomposeF .F-ob F = funcComp G F + postcomposeF .F-hom α .N-ob c = G. F-hom (α .N-ob c) + postcomposeF .F-hom {F₀} {F₁} α .N-hom {x} {y} f = + sym (G .F-seq (F₀ ⟪ f ⟫) (α ⟦ y ⟧)) + ∙∙ cong (G ⟪_⟫) (α .N-hom f) + ∙∙ G .F-seq (α ⟦ x ⟧) (F₁ ⟪ f ⟫) + postcomposeF .F-id = makeNatTransPath (funExt λ _ → G .F-id) + postcomposeF .F-seq f g = makeNatTransPath (funExt λ _ → G .F-seq _ _) \ No newline at end of file diff --git a/docs/Cubical.Categories.Functor.Properties.html b/docs/Cubical.Categories.Functor.Properties.html index e6b660a..a8028e4 100644 --- a/docs/Cubical.Categories.Functor.Properties.html +++ b/docs/Cubical.Categories.Functor.Properties.html @@ -15,213 +15,222 @@ open import Cubical.Data.Sigma open import Cubical.Categories.Category open import Cubical.Categories.Isomorphism -open import Cubical.Categories.Functor.Base - - -private - variable - ℓ ℓ' ℓ'' : Level - B C D E : Category ℓ ℓ' - -open Category -open Functor - -F-assoc : {F : Functor B C} {G : Functor C D} {H : Functor D E} - → H ∘F (G ∘F F) ≡ (H ∘F G) ∘F F -F-assoc = Functor≡ (λ _ → refl) (λ _ → refl) - - --- Results about functors - -module _ {F : Functor C D} where - - -- the identity is the identity - F-lUnit : F ∘F 𝟙⟨ C ⟩ ≡ F - F-lUnit i .F-ob x = F ⟅ x ⟆ - F-lUnit i .F-hom f = F ⟪ f ⟫ - F-lUnit i .F-id {x} = lUnit (F .F-id) (~ i) - F-lUnit i .F-seq f g = lUnit (F .F-seq f g) (~ i) - - F-rUnit : 𝟙⟨ D ⟩ ∘F F ≡ F - F-rUnit i .F-ob x = F ⟅ x ⟆ - F-rUnit i .F-hom f = F ⟪ f ⟫ - F-rUnit i .F-id {x} = rUnit (F .F-id) (~ i) - F-rUnit i .F-seq f g = rUnit (F .F-seq f g) (~ i) - - -- functors preserve commutative diagrams (specificallysqures here) - preserveCommF : ∀ {x y z w} {f : C [ x , y ]} {g : C [ y , w ]} {h : C [ x , z ]} {k : C [ z , w ]} - → f ⋆⟨ C ⟩ g ≡ h ⋆⟨ C ⟩ k - → (F ⟪ f ⟫) ⋆⟨ D ⟩ (F ⟪ g ⟫) ≡ (F ⟪ h ⟫) ⋆⟨ D ⟩ (F ⟪ k ⟫) - preserveCommF {f = f} {g = g} {h = h} {k = k} eq - = (F ⟪ f ⟫) ⋆⟨ D ⟩ (F ⟪ g ⟫) - ≡⟨ sym (F .F-seq _ _) ⟩ - F ⟪ f ⋆⟨ C ⟩ g ⟫ - ≡⟨ cong (F ⟪_⟫) eq ⟩ - F ⟪ h ⋆⟨ C ⟩ k ⟫ - ≡⟨ F .F-seq _ _ ⟩ - (F ⟪ h ⟫) ⋆⟨ D ⟩ (F ⟪ k ⟫) - ∎ - - -- functors preserve isomorphisms - preserveIsosF : ∀ {x y} → CatIso C x y → CatIso D (F ⟅ x ⟆) (F ⟅ y ⟆) - preserveIsosF {x} {y} (f , isiso f⁻¹ sec' ret') = - catiso - g g⁻¹ - -- sec - ( (g⁻¹ ⋆⟨ D ⟩ g) - ≡⟨ sym (F .F-seq f⁻¹ f) ⟩ - F ⟪ f⁻¹ ⋆⟨ C ⟩ f ⟫ - ≡⟨ cong (F .F-hom) sec' ⟩ - F ⟪ C .id ⟫ - ≡⟨ F .F-id ⟩ - D .id - ∎ ) - -- ret - ( (g ⋆⟨ D ⟩ g⁻¹) - ≡⟨ sym (F .F-seq f f⁻¹) ⟩ - F ⟪ f ⋆⟨ C ⟩ f⁻¹ ⟫ - ≡⟨ cong (F .F-hom) ret' ⟩ - F ⟪ C .id ⟫ - ≡⟨ F .F-id ⟩ - D .id - ∎ ) - - where - x' : D .ob - x' = F ⟅ x ⟆ - y' : D .ob - y' = F ⟅ y ⟆ - - g : D [ x' , y' ] - g = F ⟪ f ⟫ - g⁻¹ : D [ y' , x' ] - g⁻¹ = F ⟪ f⁻¹ ⟫ - - -- hacky lemma helping with type inferences - functorCongP : {x y v w : ob C} {p : x ≡ y} {q : v ≡ w} {f : C [ x , v ]} {g : C [ y , w ]} - → PathP (λ i → C [ p i , q i ]) f g - → PathP (λ i → D [ F .F-ob (p i) , F. F-ob (q i) ]) (F .F-hom f) (F .F-hom g) - functorCongP r i = F .F-hom (r i) - -isSetFunctor : isSet (D .ob) → isSet (Functor C D) -isSetFunctor {D = D} {C = C} isSet-D-ob F G p q = w - where - w : _ - F-ob (w i i₁) = isSetΠ (λ _ → isSet-D-ob) _ _ (cong F-ob p) (cong F-ob q) i i₁ - F-hom (w i i₁) z = - isSet→SquareP - (λ i i₁ → D .isSetHom {(F-ob (w i i₁) _)} {(F-ob (w i i₁) _)}) - (λ i₁ → F-hom (p i₁) z) (λ i₁ → F-hom (q i₁) z) refl refl i i₁ - - F-id (w i i₁) = - isSet→SquareP - (λ i i₁ → isProp→isSet (D .isSetHom (F-hom (w i i₁) _) (D .id))) - (λ i₁ → F-id (p i₁)) (λ i₁ → F-id (q i₁)) refl refl i i₁ +open import Cubical.Categories.Morphism +open import Cubical.Categories.Functor.Base + + +private + variable + ℓ ℓ' ℓ'' : Level + B C D E : Category ℓ ℓ' + +open Category +open Functor + +F-assoc : {F : Functor B C} {G : Functor C D} {H : Functor D E} + → H ∘F (G ∘F F) ≡ (H ∘F G) ∘F F +F-assoc = Functor≡ (λ _ → refl) (λ _ → refl) + + +-- Results about functors + +module _ {F : Functor C D} where + + -- the identity is the identity + F-lUnit : F ∘F 𝟙⟨ C ⟩ ≡ F + F-lUnit i .F-ob x = F ⟅ x ⟆ + F-lUnit i .F-hom f = F ⟪ f ⟫ + F-lUnit i .F-id {x} = lUnit (F .F-id) (~ i) + F-lUnit i .F-seq f g = lUnit (F .F-seq f g) (~ i) + + F-rUnit : 𝟙⟨ D ⟩ ∘F F ≡ F + F-rUnit i .F-ob x = F ⟅ x ⟆ + F-rUnit i .F-hom f = F ⟪ f ⟫ + F-rUnit i .F-id {x} = rUnit (F .F-id) (~ i) + F-rUnit i .F-seq f g = rUnit (F .F-seq f g) (~ i) + + -- functors preserve commutative diagrams (specificallysqures here) + preserveCommF : ∀ {x y z w} {f : C [ x , y ]} {g : C [ y , w ]} {h : C [ x , z ]} {k : C [ z , w ]} + → f ⋆⟨ C ⟩ g ≡ h ⋆⟨ C ⟩ k + → (F ⟪ f ⟫) ⋆⟨ D ⟩ (F ⟪ g ⟫) ≡ (F ⟪ h ⟫) ⋆⟨ D ⟩ (F ⟪ k ⟫) + preserveCommF {f = f} {g = g} {h = h} {k = k} eq + = (F ⟪ f ⟫) ⋆⟨ D ⟩ (F ⟪ g ⟫) + ≡⟨ sym (F .F-seq _ _) ⟩ + F ⟪ f ⋆⟨ C ⟩ g ⟫ + ≡⟨ cong (F ⟪_⟫) eq ⟩ + F ⟪ h ⋆⟨ C ⟩ k ⟫ + ≡⟨ F .F-seq _ _ ⟩ + (F ⟪ h ⟫) ⋆⟨ D ⟩ (F ⟪ k ⟫) + ∎ + + -- functors preserve isomorphisms + preserveIsosF : ∀ {x y} → CatIso C x y → CatIso D (F ⟅ x ⟆) (F ⟅ y ⟆) + preserveIsosF {x} {y} (f , isiso f⁻¹ sec' ret') = + catiso + g g⁻¹ + -- sec + ( (g⁻¹ ⋆⟨ D ⟩ g) + ≡⟨ sym (F .F-seq f⁻¹ f) ⟩ + F ⟪ f⁻¹ ⋆⟨ C ⟩ f ⟫ + ≡⟨ cong (F .F-hom) sec' ⟩ + F ⟪ C .id ⟫ + ≡⟨ F .F-id ⟩ + D .id + ∎ ) + -- ret + ( (g ⋆⟨ D ⟩ g⁻¹) + ≡⟨ sym (F .F-seq f f⁻¹) ⟩ + F ⟪ f ⋆⟨ C ⟩ f⁻¹ ⟫ + ≡⟨ cong (F .F-hom) ret' ⟩ + F ⟪ C .id ⟫ + ≡⟨ F .F-id ⟩ + D .id + ∎ ) + + where + x' : D .ob + x' = F ⟅ x ⟆ + y' : D .ob + y' = F ⟅ y ⟆ + + g : D [ x' , y' ] + g = F ⟪ f ⟫ + g⁻¹ : D [ y' , x' ] + g⁻¹ = F ⟪ f⁻¹ ⟫ + + -- hacky lemma helping with type inferences + functorCongP : {x y v w : ob C} {p : x ≡ y} {q : v ≡ w} {f : C [ x , v ]} {g : C [ y , w ]} + → PathP (λ i → C [ p i , q i ]) f g + → PathP (λ i → D [ F .F-ob (p i) , F. F-ob (q i) ]) (F .F-hom f) (F .F-hom g) + functorCongP r i = F .F-hom (r i) + +isSetFunctor : isSet (D .ob) → isSet (Functor C D) +isSetFunctor {D = D} {C = C} isSet-D-ob F G p q = w + where + w : _ + F-ob (w i i₁) = isSetΠ (λ _ → isSet-D-ob) _ _ (cong F-ob p) (cong F-ob q) i i₁ + F-hom (w i i₁) z = + isSet→SquareP + (λ i i₁ → D .isSetHom {(F-ob (w i i₁) _)} {(F-ob (w i i₁) _)}) + (λ i₁ → F-hom (p i₁) z) (λ i₁ → F-hom (q i₁) z) refl refl i i₁ + + F-id (w i i₁) = + isSet→SquareP + (λ i i₁ → isProp→isSet (D .isSetHom (F-hom (w i i₁) _) (D .id))) + (λ i₁ → F-id (p i₁)) (λ i₁ → F-id (q i₁)) refl refl i i₁ + + F-seq (w i i₁) _ _ = + isSet→SquareP + (λ i i₁ → isProp→isSet (D .isSetHom (F-hom (w i i₁) _) ((F-hom (w i i₁) _) ⋆⟨ D ⟩ (F-hom (w i i₁) _)))) + (λ i₁ → F-seq (p i₁) _ _) (λ i₁ → F-seq (q i₁) _ _) refl refl i i₁ + + +-- Conservative Functor, +-- namely if a morphism f is mapped to an isomorphism, +-- the morphism f is itself isomorphism. + +isConservative : (F : Functor C D) → Type _ +isConservative {C = C} {D = D} F = {x y : C .ob}{f : C [ x , y ]} → isIso D (F .F-hom f) → isIso C f + + +-- Fully-faithfulness of functors + +module _ {F : Functor C D} where + + isFullyFaithful→Full : isFullyFaithful F → isFull F + 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 + (injEmbedding (D .isSetHom) (faith x y _ _) , full x y) + + isFaithful→reflectsMono : isFaithful F → {x y : C .ob} (f : C [ x , y ]) + → isMonic D (F ⟪ f ⟫) → isMonic C f + isFaithful→reflectsMono F-faithful f Ff-mon {a = a} {a' = a'} a⋆f≡a'⋆f = + let Fa⋆Ff≡Fa'⋆Ff = sym (F .F-seq a f) + ∙ cong (F ⟪_⟫) a⋆f≡a'⋆f + ∙ F .F-seq a' f + in F-faithful _ _ _ _ (Ff-mon Fa⋆Ff≡Fa'⋆Ff) + + + -- Fully-faithful functor is conservative + + open isIso + + isFullyFaithful→Conservative : isFullyFaithful F → isConservative F + isFullyFaithful→Conservative fullfaith {x = x} {y = y} {f = f} isoFf = w + where + w : isIso C f + w .inv = invIsEq (fullfaith _ _) (isoFf .inv) + w .sec = isFullyFaithful→Faithful fullfaith _ _ _ _ + (F .F-seq _ _ + ∙ (λ i → secIsEq (fullfaith _ _) (isoFf .inv) i ⋆⟨ D ⟩ F .F-hom f) + ∙ isoFf .sec + ∙ sym (F .F-id)) + w .ret = isFullyFaithful→Faithful fullfaith _ _ _ _ + (F .F-seq _ _ + ∙ (λ i → F .F-hom f ⋆⟨ D ⟩ secIsEq (fullfaith _ _) (isoFf .inv) i) + ∙ isoFf .ret + ∙ sym (F .F-id)) - F-seq (w i i₁) _ _ = - isSet→SquareP - (λ i i₁ → isProp→isSet (D .isSetHom (F-hom (w i i₁) _) ((F-hom (w i i₁) _) ⋆⟨ D ⟩ (F-hom (w i i₁) _)))) - (λ i₁ → F-seq (p i₁) _ _) (λ i₁ → F-seq (q i₁) _ _) refl refl i i₁ - - --- Conservative Functor, --- namely if a morphism f is mapped to an isomorphism, --- the morphism f is itself isomorphism. - -isConservative : (F : Functor C D) → Type _ -isConservative {C = C} {D = D} F = {x y : C .ob}{f : C [ x , y ]} → isIso D (F .F-hom f) → isIso C f - - --- Fully-faithfulness of functors - -module _ {F : Functor C D} where - - isFullyFaithful→Full : isFullyFaithful F → isFull F - 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 - (injEmbedding (D .isSetHom) (faith x y _ _) , full x y) - - - -- Fully-faithful functor is conservative - - open isIso - - isFullyFaithful→Conservative : isFullyFaithful F → isConservative F - isFullyFaithful→Conservative fullfaith {x = x} {y = y} {f = f} isoFf = w - where - w : isIso C f - w .inv = invIsEq (fullfaith _ _) (isoFf .inv) - w .sec = isFullyFaithful→Faithful fullfaith _ _ _ _ - (F .F-seq _ _ - ∙ (λ i → secIsEq (fullfaith _ _) (isoFf .inv) i ⋆⟨ D ⟩ F .F-hom f) - ∙ isoFf .sec - ∙ sym (F .F-id)) - w .ret = isFullyFaithful→Faithful fullfaith _ _ _ _ - (F .F-seq _ _ - ∙ (λ i → F .F-hom f ⋆⟨ D ⟩ secIsEq (fullfaith _ _) (isoFf .inv) i) - ∙ isoFf .ret - ∙ sym (F .F-id)) + -- Lifting isomorphism upwards a fully faithful functor - -- Lifting isomorphism upwards a fully faithful functor + module _ (fullfaith : isFullyFaithful F) where - module _ (fullfaith : isFullyFaithful F) where + liftIso : {x y : C .ob} → CatIso D (F .F-ob x) (F .F-ob y) → CatIso C x y + liftIso f .fst = invEq (_ , fullfaith _ _) (f .fst) + liftIso f .snd = isFullyFaithful→Conservative fullfaith (subst (isIso D) (sym (secEq (_ , fullfaith _ _) (f .fst))) (f .snd)) - liftIso : {x y : C .ob} → CatIso D (F .F-ob x) (F .F-ob y) → CatIso C x y - liftIso f .fst = invEq (_ , fullfaith _ _) (f .fst) - liftIso f .snd = isFullyFaithful→Conservative fullfaith (subst (isIso D) (sym (secEq (_ , fullfaith _ _) (f .fst))) (f .snd)) + liftIso≡ : {x y : C .ob} → (f : CatIso D (F .F-ob x) (F .F-ob y)) → F-Iso {F = F} (liftIso f) ≡ f + liftIso≡ f = CatIso≡ _ _ (secEq (_ , fullfaith _ _) (f .fst)) - liftIso≡ : {x y : C .ob} → (f : CatIso D (F .F-ob x) (F .F-ob y)) → F-Iso {F = F} (liftIso f) ≡ f - liftIso≡ f = CatIso≡ _ _ (secEq (_ , fullfaith _ _) (f .fst)) +-- Functors inducing surjection on objects is essentially surjective --- Functors inducing surjection on objects is essentially surjective +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) -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) +-- Fully-faithful functors induce equivalence on isomorphisms --- Fully-faithful functors induce equivalence on isomorphisms +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 _ + (λ f → isFullyFaithful→Conservative {F = F} fullfaith {f = f}) .snd -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 _ - (λ f → isFullyFaithful→Conservative {F = F} fullfaith {f = f}) .snd +-- Functors involving univalent categories --- Functors involving univalent categories +module _ + (isUnivD : isUnivalent D) + where -module _ - (isUnivD : isUnivalent D) - where + open isUnivalent isUnivD - open isUnivalent isUnivD + -- Essentially surjective functor with univalent target induces surjection on objects - -- 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 surj y = Prop.map (λ (x , f) → x , CatIsoToPath f) (surj y) - 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) +module _ + (isUnivC : isUnivalent C) + (isUnivD : isUnivalent D) + {F : Functor C D} + where -module _ - (isUnivC : isUnivalent C) - (isUnivD : isUnivalent D) - {F : Functor C D} - where + open isUnivalent - open isUnivalent + -- Fully-faithful functor between univalent target induces embedding on objects - -- Fully-faithful functor between univalent target induces embedding on objects - - isFullyFaithful→isEmbd-ob : isFullyFaithful F → isEmbedding (F .F-ob) - isFullyFaithful→isEmbd-ob fullfaith x y = - isEquiv[equivFunA≃B∘f]→isEquiv[f] _ (_ , isUnivD .univ _ _) - (subst isEquiv (F-pathToIso-∘ {F = F}) - (compEquiv (_ , isUnivC .univ _ _) - (_ , isFullyFaithful→isEquivF-Iso {F = F} fullfaith x y) .snd)) + isFullyFaithful→isEmbd-ob : isFullyFaithful F → isEmbedding (F .F-ob) + isFullyFaithful→isEmbd-ob fullfaith x y = + isEquiv[equivFunA≃B∘f]→isEquiv[f] _ (_ , isUnivD .univ _ _) + (subst isEquiv (F-pathToIso-∘ {F = F}) + (compEquiv (_ , isUnivC .univ _ _) + (_ , isFullyFaithful→isEquivF-Iso {F = F} fullfaith x y) .snd)) \ No newline at end of file diff --git a/docs/Cubical.Categories.Functors.Constant.html b/docs/Cubical.Categories.Functors.Constant.html index a278069..28c23e7 100644 --- a/docs/Cubical.Categories.Functors.Constant.html +++ b/docs/Cubical.Categories.Functors.Constant.html @@ -12,11 +12,11 @@ ℓC ℓC' ℓD ℓD' : Level open Category -open Functor +open Functor -Constant : (C : Category ℓC ℓC') (D : Category ℓD ℓD') (d : ob D) → Functor C D -F-ob (Constant C D d) c = d -F-hom (Constant C D d) φ = id D -F-id (Constant C D d) = refl -F-seq (Constant C D d) φ χ = sym (⋆IdR D _) +Constant : (C : Category ℓC ℓC') (D : Category ℓD ℓD') (d : ob D) → Functor C D +F-ob (Constant C D d) c = d +F-hom (Constant C D d) φ = id D +F-id (Constant C D d) = refl +F-seq (Constant C D d) φ χ = sym (⋆IdR D _) \ No newline at end of file diff --git a/docs/Cubical.Categories.Instances.Functors.html b/docs/Cubical.Categories.Instances.Functors.html index 5197de8..9cdfe2f 100644 --- a/docs/Cubical.Categories.Instances.Functors.html +++ b/docs/Cubical.Categories.Instances.Functors.html @@ -34,45 +34,45 @@ module _ (C : Category ℓC ℓC') (D : Category ℓD ℓD') where open Category open NatTrans - open Functor + open Functor FUNCTOR : Category (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) (ℓ-max (ℓ-max ℓC ℓC') ℓD') - ob FUNCTOR = Functor C D + ob FUNCTOR = Functor C D Hom[_,_] FUNCTOR = NatTrans - id FUNCTOR {F} = idTrans F - _⋆_ FUNCTOR = seqTrans - ⋆IdL FUNCTOR α = makeNatTransPath λ i x → D .⋆IdL (α .N-ob x) i - ⋆IdR FUNCTOR α = makeNatTransPath λ i x → D .⋆IdR (α .N-ob x) i - ⋆Assoc FUNCTOR α β γ = makeNatTransPath λ i x → D .⋆Assoc (α .N-ob x) (β .N-ob x) (γ .N-ob x) i + id FUNCTOR {F} = idTrans F + _⋆_ FUNCTOR = seqTrans + ⋆IdL FUNCTOR α = makeNatTransPath λ i x → D .⋆IdL (α .N-ob x) i + ⋆IdR FUNCTOR α = makeNatTransPath λ i x → D .⋆IdR (α .N-ob x) i + ⋆Assoc FUNCTOR α β γ = makeNatTransPath λ i x → D .⋆Assoc (α .N-ob x) (β .N-ob x) (γ .N-ob x) i isSetHom FUNCTOR = isSetNatTrans open isIsoC renaming (inv to invC) -- componentwise iso is an iso in Functor - FUNCTORIso : ∀ {F G : Functor C D} (α : F ⇒ G) - → (∀ (c : C .ob) → isIsoC D (α ⟦ c ⟧)) + FUNCTORIso : ∀ {F G : Functor C D} (α : F ⇒ G) + → (∀ (c : C .ob) → isIsoC D (α ⟦ c ⟧)) → isIsoC FUNCTOR α FUNCTORIso α is .invC .N-ob c = (is c) .invC FUNCTORIso {F} {G} α is .invC .N-hom {c} {d} f - = invMoveL areInv-αc - ( α ⟦ c ⟧ ⋆⟨ D ⟩ (G ⟪ f ⟫ ⋆⟨ D ⟩ is d .invC) - ≡⟨ sym (D .⋆Assoc _ _ _) ⟩ - (α ⟦ c ⟧ ⋆⟨ D ⟩ G ⟪ f ⟫) ⋆⟨ D ⟩ is d .invC - ≡⟨ sym (invMoveR areInv-αd (α .N-hom f)) ⟩ - F ⟪ f ⟫ - ∎ ) + = invMoveL areInv-αc + ( α ⟦ c ⟧ ⋆⟨ D ⟩ (G ⟪ f ⟫ ⋆⟨ D ⟩ is d .invC) + ≡⟨ sym (D .⋆Assoc _ _ _) ⟩ + (α ⟦ c ⟧ ⋆⟨ D ⟩ G ⟪ f ⟫) ⋆⟨ D ⟩ is d .invC + ≡⟨ sym (invMoveR areInv-αd (α .N-hom f)) ⟩ + F ⟪ f ⟫ + ∎ ) where - areInv-αc : areInv _ (α ⟦ c ⟧) ((is c) .invC) - areInv-αc = isIso→areInv (is c) + areInv-αc : areInv _ (α ⟦ c ⟧) ((is c) .invC) + areInv-αc = isIso→areInv (is c) - areInv-αd : areInv _ (α ⟦ d ⟧) ((is d) .invC) - areInv-αd = isIso→areInv (is d) - FUNCTORIso α is .sec = makeNatTransPath (funExt (λ c → (is c) .sec)) - FUNCTORIso α is .ret = makeNatTransPath (funExt (λ c → (is c) .ret)) + areInv-αd : areInv _ (α ⟦ d ⟧) ((is d) .invC) + areInv-αd = isIso→areInv (is d) + FUNCTORIso α is .sec = makeNatTransPath (funExt (λ c → (is c) .sec)) + FUNCTORIso α is .ret = makeNatTransPath (funExt (λ c → (is c) .ret)) -- iso is componentwise iso in Functor - FUNCTORIso' : ∀ {F G : Functor C D} (α : F ⇒ G) + FUNCTORIso' : ∀ {F G : Functor C D} (α : F ⇒ G) → isIsoC FUNCTOR α - → ((c : C .ob) → isIsoC D (α ⟦ c ⟧)) + → ((c : C .ob) → isIsoC D (α ⟦ c ⟧)) FUNCTORIso' α isom c .invC = isom .invC .N-ob c FUNCTORIso' α isom c .sec i = isom .sec i .N-ob c FUNCTORIso' α isom c .ret i = isom .ret i .N-ob c @@ -80,31 +80,31 @@ open Iso open NatIso - FUNCTORIso→NatIso : {F G : Functor C D} → CatIso FUNCTOR F G → NatIso F G + FUNCTORIso→NatIso : {F G : Functor C D} → CatIso FUNCTOR F G → NatIso F G FUNCTORIso→NatIso α .trans = α .fst FUNCTORIso→NatIso α .nIso = FUNCTORIso' _ (α .snd) - NatIso→FUNCTORIso : {F G : Functor C D} → NatIso F G → CatIso FUNCTOR F G + NatIso→FUNCTORIso : {F G : Functor C D} → NatIso F G → CatIso FUNCTOR F G NatIso→FUNCTORIso α = α .trans , FUNCTORIso _ (α .nIso) - Path→FUNCTORIso→NatIso : {F G : Functor C D} → (p : F ≡ G) → pathToNatIso p ≡ FUNCTORIso→NatIso (pathToIso p) - Path→FUNCTORIso→NatIso {F = F} p = J (λ _ p → pathToNatIso p ≡ FUNCTORIso→NatIso (pathToIso p)) (NatIso≡ refl-helper) p + Path→FUNCTORIso→NatIso : {F G : Functor C D} → (p : F ≡ G) → pathToNatIso p ≡ FUNCTORIso→NatIso (pathToIso p) + Path→FUNCTORIso→NatIso {F = F} p = J (λ _ p → pathToNatIso p ≡ FUNCTORIso→NatIso (pathToIso p)) (NatIso≡ refl-helper) p where refl-helper : _ - refl-helper i x = ((λ i → pathToIso-refl {C = D} {x = F .F-ob x} i .fst) - ∙ (λ i → pathToIso-refl {C = FUNCTOR} {x = F} (~ i) .fst .N-ob x)) i + refl-helper i x = ((λ i → pathToIso-refl {C = D} {x = F .F-ob x} i .fst) + ∙ (λ i → pathToIso-refl {C = FUNCTOR} {x = F} (~ i) .fst .N-ob x)) i - Iso-FUNCTORIso-NatIso : {F G : Functor C D} → Iso (CatIso FUNCTOR F G) (NatIso F G) + Iso-FUNCTORIso-NatIso : {F G : Functor C D} → Iso (CatIso FUNCTOR F G) (NatIso F G) Iso-FUNCTORIso-NatIso .fun = FUNCTORIso→NatIso Iso-FUNCTORIso-NatIso .inv = NatIso→FUNCTORIso Iso-FUNCTORIso-NatIso .rightInv α i .trans = α .trans Iso-FUNCTORIso-NatIso .rightInv α i .nIso = - isProp→PathP (λ i → isPropΠ (λ _ → isPropIsIso _)) (FUNCTORIso' (α .trans) (FUNCTORIso _ (α .nIso))) (α .nIso) i + isProp→PathP (λ i → isPropΠ (λ _ → isPropIsIso _)) (FUNCTORIso' (α .trans) (FUNCTORIso _ (α .nIso))) (α .nIso) i Iso-FUNCTORIso-NatIso .leftInv α i .fst = α .fst Iso-FUNCTORIso-NatIso .leftInv α i .snd = - isProp→PathP (λ i → isPropIsIso _) (FUNCTORIso _ (FUNCTORIso' _ (α .snd))) (α .snd) i + isProp→PathP (λ i → isPropIsIso _) (FUNCTORIso _ (FUNCTORIso' _ (α .snd))) (α .snd) i - FUNCTORIso≃NatIso : {F G : Functor C D} → CatIso FUNCTOR F G ≃ NatIso F G + FUNCTORIso≃NatIso : {F G : Functor C D} → CatIso FUNCTOR F G ≃ NatIso F G FUNCTORIso≃NatIso = isoToEquiv Iso-FUNCTORIso-NatIso @@ -115,59 +115,59 @@ isUnivalentFUNCTOR : isUnivalent D → isUnivalent FUNCTOR isUnivalentFUNCTOR isUnivD .univ _ _ = isEquiv[equivFunA≃B∘f]→isEquiv[f] _ FUNCTORIso≃NatIso - (subst isEquiv (λ i p → Path→FUNCTORIso→NatIso p i) (Path≃NatIso isUnivD .snd)) - - appF : Functor (FUNCTOR ×C C) D - appF .F-ob (F , c) = F ⟅ c ⟆ - appF .F-hom {F , c} {G , d} (α , f) = α .N-ob d ∘⟨ D ⟩ F .F-hom f - appF .F-id {F , c} = - D .id ∘⟨ D ⟩ F .F-hom (C .id) ≡⟨ D .⋆IdR (F .F-hom (C .id)) ⟩ - F .F-hom (C .id) ≡⟨ F .F-id ⟩ - D .id ∎ - appF .F-seq {F , c}{G , d}{H , e} (α , f) (β , g ) = - (β .N-ob e ∘⟨ D ⟩ α .N-ob e) ∘⟨ D ⟩ F .F-hom (g ∘⟨ C ⟩ f) - ≡⟨ (λ i → (β .N-ob e ∘⟨ D ⟩ α .N-ob e) ∘⟨ D ⟩ F .F-seq f g i) ⟩ - (β .N-ob e ∘⟨ D ⟩ α .N-ob e) ∘⟨ D ⟩ (F .F-hom g ∘⟨ D ⟩ F .F-hom f) - ≡⟨ sym (D .⋆Assoc _ _ _) ⟩ - β .N-ob e ∘⟨ D ⟩ (α .N-ob e ∘⟨ D ⟩ (F .F-hom g ∘⟨ D ⟩ F .F-hom f)) - ≡⟨ (λ i → β .N-ob e - ∘⟨ D ⟩ D .⋆Assoc (F .F-hom f) (F .F-hom g) (α .N-ob e) i) ⟩ - β .N-ob e ∘⟨ D ⟩ ((α .N-ob e ∘⟨ D ⟩ F .F-hom g) ∘⟨ D ⟩ F .F-hom f) - ≡⟨ (λ i → β .N-ob e ∘⟨ D ⟩ α .N-hom g i ∘⟨ D ⟩ F .F-hom f) ⟩ - β .N-ob e ∘⟨ D ⟩ ((G .F-hom g ∘⟨ D ⟩ α .N-ob d) ∘⟨ D ⟩ F .F-hom f) - ≡⟨ (λ i → β .N-ob e - ∘⟨ D ⟩ D .⋆Assoc (F .F-hom f) (α .N-ob d) (G .F-hom g) (~ i) ) ⟩ - β .N-ob e ∘⟨ D ⟩ (G .F-hom g ∘⟨ D ⟩ (α .N-ob d ∘⟨ D ⟩ F .F-hom f)) - ≡⟨ D .⋆Assoc _ _ _ ⟩ - (β .N-ob e ∘⟨ D ⟩ G .F-hom g) ∘⟨ D ⟩ (α .N-ob d ∘⟨ D ⟩ F .F-hom f) ∎ + (subst isEquiv (λ i p → Path→FUNCTORIso→NatIso p i) (Path≃NatIso isUnivD .snd)) + + appF : Functor (FUNCTOR ×C C) D + appF .F-ob (F , c) = F ⟅ c ⟆ + appF .F-hom {F , c} {G , d} (α , f) = α .N-ob d ∘⟨ D ⟩ F .F-hom f + appF .F-id {F , c} = + D .id ∘⟨ D ⟩ F .F-hom (C .id) ≡⟨ D .⋆IdR (F .F-hom (C .id)) ⟩ + F .F-hom (C .id) ≡⟨ F .F-id ⟩ + D .id ∎ + appF .F-seq {F , c}{G , d}{H , e} (α , f) (β , g ) = + (β .N-ob e ∘⟨ D ⟩ α .N-ob e) ∘⟨ D ⟩ F .F-hom (g ∘⟨ C ⟩ f) + ≡⟨ (λ i → (β .N-ob e ∘⟨ D ⟩ α .N-ob e) ∘⟨ D ⟩ F .F-seq f g i) ⟩ + (β .N-ob e ∘⟨ D ⟩ α .N-ob e) ∘⟨ D ⟩ (F .F-hom g ∘⟨ D ⟩ F .F-hom f) + ≡⟨ sym (D .⋆Assoc _ _ _) ⟩ + β .N-ob e ∘⟨ D ⟩ (α .N-ob e ∘⟨ D ⟩ (F .F-hom g ∘⟨ D ⟩ F .F-hom f)) + ≡⟨ (λ i → β .N-ob e + ∘⟨ D ⟩ D .⋆Assoc (F .F-hom f) (F .F-hom g) (α .N-ob e) i) ⟩ + β .N-ob e ∘⟨ D ⟩ ((α .N-ob e ∘⟨ D ⟩ F .F-hom g) ∘⟨ D ⟩ F .F-hom f) + ≡⟨ (λ i → β .N-ob e ∘⟨ D ⟩ α .N-hom g i ∘⟨ D ⟩ F .F-hom f) ⟩ + β .N-ob e ∘⟨ D ⟩ ((G .F-hom g ∘⟨ D ⟩ α .N-ob d) ∘⟨ D ⟩ F .F-hom f) + ≡⟨ (λ i → β .N-ob e + ∘⟨ D ⟩ D .⋆Assoc (F .F-hom f) (α .N-ob d) (G .F-hom g) (~ i) ) ⟩ + β .N-ob e ∘⟨ D ⟩ (G .F-hom g ∘⟨ D ⟩ (α .N-ob d ∘⟨ D ⟩ F .F-hom f)) + ≡⟨ D .⋆Assoc _ _ _ ⟩ + (β .N-ob e ∘⟨ D ⟩ G .F-hom g) ∘⟨ D ⟩ (α .N-ob d ∘⟨ D ⟩ F .F-hom f) ∎ module _ (E : Category ℓE ℓE') where - λF : Functor (E ×C C) D → Functor E FUNCTOR - λF F .F-ob e .F-ob c = F ⟅ e , c ⟆ - λF F .F-ob e .F-hom f = F ⟪ (E .id) , f ⟫ - λF F .F-ob e .F-id = F .F-id - λF F .F-ob e .F-seq f g = - F ⟪ E .id , g ∘⟨ C ⟩ f ⟫ - ≡⟨ (λ i → F ⟪ (E .⋆IdL (E .id) (~ i)) , (g ∘⟨ C ⟩ f) ⟫) ⟩ - (F ⟪ (E .id ∘⟨ E ⟩ E .id) , g ∘⟨ C ⟩ f ⟫) - ≡⟨ F .F-seq (E .id , f) (E .id , g) ⟩ - (F ⟪ E .id , g ⟫ ∘⟨ D ⟩ F ⟪ E .id , f ⟫) ∎ - λF F .F-hom h .N-ob c = F ⟪ h , (C .id) ⟫ - λF F .F-hom h .N-hom f = - F ⟪ h , C .id ⟫ ∘⟨ D ⟩ F ⟪ E .id , f ⟫ ≡⟨ sym (F .F-seq _ _) ⟩ - F ⟪ h ∘⟨ E ⟩ E .id , C .id ∘⟨ C ⟩ f ⟫ - ≡⟨ (λ i → F ⟪ E .⋆IdL h i , C .⋆IdR f i ⟫) ⟩ - F ⟪ h , f ⟫ ≡⟨ (λ i → F ⟪ (E .⋆IdR h (~ i)) , (C .⋆IdL f (~ i)) ⟫) ⟩ - F ⟪ E .id ∘⟨ E ⟩ h , f ∘⟨ C ⟩ C .id ⟫ ≡⟨ F .F-seq _ _ ⟩ - F ⟪ E .id , f ⟫ ∘⟨ D ⟩ F ⟪ h , C .id ⟫ ∎ - λF F .F-id = makeNatTransPath (funExt λ c → F .F-id) - λF F .F-seq f g = makeNatTransPath (funExt lem) where + λF : Functor (E ×C C) D → Functor E FUNCTOR + λF F .F-ob e .F-ob c = F ⟅ e , c ⟆ + λF F .F-ob e .F-hom f = F ⟪ (E .id) , f ⟫ + λF F .F-ob e .F-id = F .F-id + λF F .F-ob e .F-seq f g = + F ⟪ E .id , g ∘⟨ C ⟩ f ⟫ + ≡⟨ (λ i → F ⟪ (E .⋆IdL (E .id) (~ i)) , (g ∘⟨ C ⟩ f) ⟫) ⟩ + (F ⟪ (E .id ∘⟨ E ⟩ E .id) , g ∘⟨ C ⟩ f ⟫) + ≡⟨ F .F-seq (E .id , f) (E .id , g) ⟩ + (F ⟪ E .id , g ⟫ ∘⟨ D ⟩ F ⟪ E .id , f ⟫) ∎ + λF F .F-hom h .N-ob c = F ⟪ h , (C .id) ⟫ + λF F .F-hom h .N-hom f = + F ⟪ h , C .id ⟫ ∘⟨ D ⟩ F ⟪ E .id , f ⟫ ≡⟨ sym (F .F-seq _ _) ⟩ + F ⟪ h ∘⟨ E ⟩ E .id , C .id ∘⟨ C ⟩ f ⟫ + ≡⟨ (λ i → F ⟪ E .⋆IdL h i , C .⋆IdR f i ⟫) ⟩ + F ⟪ h , f ⟫ ≡⟨ (λ i → F ⟪ (E .⋆IdR h (~ i)) , (C .⋆IdL f (~ i)) ⟫) ⟩ + F ⟪ E .id ∘⟨ E ⟩ h , f ∘⟨ C ⟩ C .id ⟫ ≡⟨ F .F-seq _ _ ⟩ + F ⟪ E .id , f ⟫ ∘⟨ D ⟩ F ⟪ h , C .id ⟫ ∎ + λF F .F-id = makeNatTransPath (funExt λ c → F .F-id) + λF F .F-seq f g = makeNatTransPath (funExt lem) where lem : (c : C .ob) → - F ⟪ g ∘⟨ E ⟩ f , C .id ⟫ ≡ - F ⟪ g , C .id ⟫ ∘⟨ D ⟩ F ⟪ f , C .id ⟫ + F ⟪ g ∘⟨ E ⟩ f , C .id ⟫ ≡ + F ⟪ g , C .id ⟫ ∘⟨ D ⟩ F ⟪ f , C .id ⟫ lem c = - F ⟪ g ∘⟨ E ⟩ f , C .id ⟫ - ≡⟨ (λ i → F ⟪ (g ∘⟨ E ⟩ f) , (C .⋆IdR (C .id) (~ i)) ⟫) ⟩ - F ⟪ g ∘⟨ E ⟩ f , C .id ∘⟨ C ⟩ C .id ⟫ - ≡⟨ F .F-seq (f , C .id) (g , C .id) ⟩ - (F ⟪ g , C .id ⟫) ∘⟨ D ⟩ (F ⟪ f , C .id ⟫) ∎ + F ⟪ g ∘⟨ E ⟩ f , C .id ⟫ + ≡⟨ (λ i → F ⟪ (g ∘⟨ E ⟩ f) , (C .⋆IdR (C .id) (~ i)) ⟫) ⟩ + F ⟪ g ∘⟨ E ⟩ f , C .id ∘⟨ C ⟩ C .id ⟫ + ≡⟨ F .F-seq (f , C .id) (g , C .id) ⟩ + (F ⟪ g , C .id ⟫) ∘⟨ D ⟩ (F ⟪ f , C .id ⟫) ∎ \ No newline at end of file diff --git a/docs/Cubical.Categories.Isomorphism.html b/docs/Cubical.Categories.Isomorphism.html index c4950a3..fc05c4e 100644 --- a/docs/Cubical.Categories.Isomorphism.html +++ b/docs/Cubical.Categories.Isomorphism.html @@ -34,15 +34,15 @@ ⋆Iso f g .fst = f .fst ⋆ g .fst ⋆Iso f g .snd .inv = g .snd .inv ⋆ f .snd .inv ⋆Iso f g .snd .sec = sym (⋆Assoc _ _ _) - ∙ (λ i → ⋆Assoc (g .snd .inv) (f .snd .inv) (f .fst) i ⋆ g .fst) - ∙ (λ i → (g .snd .inv ⋆ f .snd .sec i) ⋆ g .fst) - ∙ (λ i → ⋆IdR (g .snd .inv) i ⋆ g .fst) - ∙ g .snd .sec + ∙ (λ i → ⋆Assoc (g .snd .inv) (f .snd .inv) (f .fst) i ⋆ g .fst) + ∙ (λ i → (g .snd .inv ⋆ f .snd .sec i) ⋆ g .fst) + ∙ (λ i → ⋆IdR (g .snd .inv) i ⋆ g .fst) + ∙ g .snd .sec ⋆Iso f g .snd .ret = sym (⋆Assoc _ _ _) - ∙ (λ i → ⋆Assoc (f .fst) (g .fst) (g .snd .inv) i ⋆ f .snd .inv) - ∙ (λ i → (f .fst ⋆ g .snd .ret i) ⋆ f .snd .inv) - ∙ (λ i → ⋆IdR (f .fst) i ⋆ f .snd .inv) - ∙ f .snd .ret + ∙ (λ i → ⋆Assoc (f .fst) (g .fst) (g .snd .inv) i ⋆ f .snd .inv) + ∙ (λ i → (f .fst ⋆ g .snd .ret i) ⋆ f .snd .inv) + ∙ (λ i → ⋆IdR (f .fst) i ⋆ f .snd .inv) + ∙ f .snd .ret compIso : {x y z : ob} → (g : CatIso C y z)(f : CatIso C x y) → CatIso C x z compIso g f = ⋆Iso f g @@ -58,18 +58,18 @@ ⋆IsoInvRev _ _ = refl - pathToIso-∙ : {x y z : ob}(p : x ≡ y)(q : y ≡ z) → pathToIso (p ∙ q) ≡ ⋆Iso (pathToIso p) (pathToIso q) - pathToIso-∙ p q = J2 (λ y p z q → pathToIso (p ∙ q) ≡ ⋆Iso (pathToIso p) (pathToIso q)) pathToIso-∙-refl p q + pathToIso-∙ : {x y z : ob}(p : x ≡ y)(q : y ≡ z) → pathToIso (p ∙ q) ≡ ⋆Iso (pathToIso p) (pathToIso q) + pathToIso-∙ p q = J2 (λ y p z q → pathToIso (p ∙ q) ≡ ⋆Iso (pathToIso p) (pathToIso q)) pathToIso-∙-refl p q where - pathToIso-∙-refl : {x : ob} → pathToIso {x = x} (refl ∙ refl) ≡ ⋆Iso (pathToIso refl) (pathToIso refl) + pathToIso-∙-refl : {x : ob} → pathToIso {x = x} (refl ∙ refl) ≡ ⋆Iso (pathToIso refl) (pathToIso refl) pathToIso-∙-refl = cong pathToIso (sym compPathRefl) - ∙ sym (⋆IsoIdL _) - ∙ (λ i → ⋆Iso (pathToIso-refl (~ i)) (pathToIso refl)) + ∙ sym (⋆IsoIdL _) + ∙ (λ i → ⋆Iso (pathToIso-refl (~ i)) (pathToIso refl)) transportPathToIso : {x y z : ob}(f : C [ x , y ])(p : y ≡ z) → PathP (λ i → C [ x , p i ]) f (f ⋆ pathToIso {C = C} p .fst) - transportPathToIso {x = x} f = J (λ _ p → PathP (λ i → C [ x , p i ]) f (f ⋆ pathToIso {C = C} p .fst)) - (sym (⋆IdR _) ∙ cong (λ x → f ⋆ x) (sym (cong fst (pathToIso-refl {C = C})))) + transportPathToIso {x = x} f = J (λ _ p → PathP (λ i → C [ x , p i ]) f (f ⋆ pathToIso {C = C} p .fst)) + (sym (⋆IdR _) ∙ cong (λ x → f ⋆ x) (sym (cong fst (pathToIso-refl {C = C})))) pathToIso-Comm : {x y z w : ob} @@ -78,7 +78,7 @@ → PathP (λ i → Hom[ p i , q i ]) f g → f ⋆ pathToIso {C = C} q .fst ≡ pathToIso {C = C} p .fst ⋆ g pathToIso-Comm {x = x} {z = z} p q = - J2 (λ y p w q → + J2 (λ y p w q → (f : Hom[ x , z ])(g : Hom[ y , w ]) → PathP (λ i → Hom[ p i , q i ]) f g → f ⋆ pathToIso {C = C} q .fst ≡ pathToIso {C = C} p .fst ⋆ g) @@ -87,8 +87,8 @@ sqr-refl : (f g : Hom[ x , z ]) → f ≡ g → f ⋆ pathToIso {C = C} refl .fst ≡ pathToIso {C = C} refl .fst ⋆ g sqr-refl f g p = (λ i → f ⋆ pathToIso-refl {C = C} i .fst) - ∙ ⋆IdR _ ∙ p ∙ sym (⋆IdL _) - ∙ (λ i → pathToIso-refl {C = C} (~ i) .fst ⋆ g) + ∙ ⋆IdR _ ∙ p ∙ sym (⋆IdL _) + ∙ (λ i → pathToIso-refl {C = C} (~ i) .fst ⋆ g) pathToIso-Square : {x y z w : ob} → (p : x ≡ y)(q : z ≡ w) @@ -96,7 +96,7 @@ → f ⋆ pathToIso {C = C} q .fst ≡ pathToIso {C = C} p .fst ⋆ g → PathP (λ i → Hom[ p i , q i ]) f g pathToIso-Square {x = x} {z = z} p q = - J2 (λ y p w q → + J2 (λ y p w q → (f : Hom[ x , z ])(g : Hom[ y , w ]) → f ⋆ pathToIso {C = C} q .fst ≡ pathToIso {C = C} p .fst ⋆ g → PathP (λ i → Hom[ p i , q i ]) f g) @@ -106,10 +106,10 @@ → f ⋆ pathToIso {C = C} refl .fst ≡ pathToIso {C = C} refl .fst ⋆ g → f ≡ g sqr-refl f g p = sym (⋆IdR _) - ∙ (λ i → f ⋆ pathToIso-refl {C = C} (~ i) .fst) - ∙ p - ∙ (λ i → pathToIso-refl {C = C} i .fst ⋆ g) - ∙ ⋆IdL _ + ∙ (λ i → f ⋆ pathToIso-refl {C = C} (~ i) .fst) + ∙ p + ∙ (λ i → pathToIso-refl {C = C} i .fst ⋆ g) + ∙ ⋆IdL _ module _ (isUnivC : isUnivalent C) where @@ -128,7 +128,7 @@ → PathP (λ i → CatIso C x (CatIsoToPath p i)) f (⋆Iso f p) transportIsoToPathIso f p i .fst = transportIsoToPath (f .fst) p i transportIsoToPathIso f p i .snd = - isProp→PathP (λ i → isPropIsIso (transportIsoToPath (f .fst) p i)) (f .snd) (⋆Iso f p .snd) i + isProp→PathP (λ i → isPropIsIso (transportIsoToPath (f .fst) p i)) (f .snd) (⋆Iso f p .snd) i isoToPath-Square : {x y z w : ob} @@ -138,7 +138,7 @@ → PathP (λ i → Hom[ CatIsoToPath p i , CatIsoToPath q i ]) f g isoToPath-Square p q f g comm = pathToIso-Square (CatIsoToPath p) (CatIsoToPath q) _ _ - ((λ i → f ⋆ secEq (univEquiv _ _) q i .fst) ∙ comm ∙ (λ i → secEq (univEquiv _ _) p (~ i) .fst ⋆ g)) + ((λ i → f ⋆ secEq (univEquiv _ _) q i .fst) ∙ comm ∙ (λ i → secEq (univEquiv _ _) p (~ i) .fst ⋆ g)) module _ {C : Category ℓC ℓC'} where @@ -153,9 +153,9 @@ → g ≡ f .snd .inv ⋆ h ⋆InvLMove f {g = g} p = sym (⋆IdL _) - ∙ (λ i → f .snd .sec (~ i) ⋆ g) - ∙ ⋆Assoc _ _ _ - ∙ (λ i → f .snd .inv ⋆ p i) + ∙ (λ i → f .snd .sec (~ i) ⋆ g) + ∙ ⋆Assoc _ _ _ + ∙ (λ i → f .snd .inv ⋆ p i) ⋆InvRMove : {x y z : ob} (f : CatIso C y z) @@ -164,9 +164,9 @@ → g ≡ h ⋆ f .snd .inv ⋆InvRMove f {g = g} p = sym (⋆IdR _) - ∙ (λ i → g ⋆ f .snd .ret (~ i)) - ∙ sym (⋆Assoc _ _ _) - ∙ (λ i → p i ⋆ f .snd .inv) + ∙ (λ i → g ⋆ f .snd .ret (~ i)) + ∙ sym (⋆Assoc _ _ _) + ∙ (λ i → p i ⋆ f .snd .inv) ⋆CancelL : {x y z : ob} (f : CatIso C x y){g h : Hom[ y , z ]} @@ -174,12 +174,12 @@ → g ≡ h ⋆CancelL f {g = g} {h = h} p = sym (⋆IdL _) - ∙ (λ i → f .snd .sec (~ i) ⋆ g) - ∙ ⋆Assoc _ _ _ - ∙ (λ i → f .snd .inv ⋆ p i) - ∙ sym (⋆Assoc _ _ _) - ∙ (λ i → f .snd .sec i ⋆ h) - ∙ ⋆IdL _ + ∙ (λ i → f .snd .sec (~ i) ⋆ g) + ∙ ⋆Assoc _ _ _ + ∙ (λ i → f .snd .inv ⋆ p i) + ∙ sym (⋆Assoc _ _ _) + ∙ (λ i → f .snd .sec i ⋆ h) + ∙ ⋆IdL _ ⋆CancelR : {x y z : ob} (f : CatIso C y z){g h : Hom[ x , y ]} @@ -187,12 +187,12 @@ → g ≡ h ⋆CancelR f {g = g} {h = h} p = sym (⋆IdR _) - ∙ (λ i → g ⋆ f .snd .ret (~ i)) - ∙ sym (⋆Assoc _ _ _) - ∙ (λ i → p i ⋆ f .snd .inv) - ∙ ⋆Assoc _ _ _ - ∙ (λ i → h ⋆ f .snd .ret i) - ∙ ⋆IdR _ + ∙ (λ i → g ⋆ f .snd .ret (~ i)) + ∙ sym (⋆Assoc _ _ _) + ∙ (λ i → p i ⋆ f .snd .inv) + ∙ ⋆Assoc _ _ _ + ∙ (λ i → h ⋆ f .snd .ret i) + ∙ ⋆IdR _ module _ {C : Category ℓC ℓC'} where @@ -207,38 +207,38 @@ op-Iso f .snd .ret = f .snd .ret -module _ {C : Category ℓC ℓC'}{D : Category ℓD ℓD'}{F : Functor C D} where +module _ {C : Category ℓC ℓC'}{D : Category ℓD ℓD'}{F : Functor C D} where open Category hiding (_∘_) open isIso - open Functor + open Functor - F-PresIsIso : {x y : C .ob}{f : C [ x , y ]} → isIso C f → isIso D (F .F-hom f) - F-PresIsIso f .inv = F . F-hom (f .inv) - F-PresIsIso f .sec = sym (F .F-seq (f .inv) _) ∙ cong (F .F-hom) (f .sec) ∙ F .F-id - F-PresIsIso f .ret = sym (F .F-seq _ (f .inv)) ∙ cong (F .F-hom) (f .ret) ∙ F .F-id + F-PresIsIso : {x y : C .ob}{f : C [ x , y ]} → isIso C f → isIso D (F .F-hom f) + F-PresIsIso f .inv = F . F-hom (f .inv) + F-PresIsIso f .sec = sym (F .F-seq (f .inv) _) ∙ cong (F .F-hom) (f .sec) ∙ F .F-id + F-PresIsIso f .ret = sym (F .F-seq _ (f .inv)) ∙ cong (F .F-hom) (f .ret) ∙ F .F-id - F-Iso : {x y : C .ob} → CatIso C x y → CatIso D (F .F-ob x) (F .F-ob y) - F-Iso f .fst = F . F-hom (f .fst) + F-Iso : {x y : C .ob} → CatIso C x y → CatIso D (F .F-ob x) (F .F-ob y) + F-Iso f .fst = F . F-hom (f .fst) F-Iso f .snd = F-PresIsIso (f .snd) F-Iso-PresId : {x : C .ob} → F-Iso (idCatIso {x = x}) ≡ idCatIso - F-Iso-PresId = CatIso≡ _ _ (F .F-id) + F-Iso-PresId = CatIso≡ _ _ (F .F-id) F-Iso-Pres⋆ : {x y z : C .ob} → (f : CatIso C x y)(g : CatIso C y z) → F-Iso (⋆Iso f g) ≡ ⋆Iso (F-Iso f) (F-Iso g) - F-Iso-Pres⋆ _ _ = CatIso≡ _ _ (F .F-seq _ _) + F-Iso-Pres⋆ _ _ = CatIso≡ _ _ (F .F-seq _ _) - F-pathToIso : {x y : C .ob} → (p : x ≡ y) → F-Iso (pathToIso p) ≡ pathToIso (cong (F .F-ob) p) - F-pathToIso p = J (λ y p → F-Iso (pathToIso p) ≡ pathToIso (cong (F .F-ob) p)) F-pathToIso-refl p + F-pathToIso : {x y : C .ob} → (p : x ≡ y) → F-Iso (pathToIso p) ≡ pathToIso (cong (F .F-ob) p) + F-pathToIso p = J (λ y p → F-Iso (pathToIso p) ≡ pathToIso (cong (F .F-ob) p)) F-pathToIso-refl p where - F-pathToIso-refl : {x : C .ob} → F-Iso (pathToIso {x = x} refl) ≡ pathToIso (cong (F .F-ob) refl) + F-pathToIso-refl : {x : C .ob} → F-Iso (pathToIso {x = x} refl) ≡ pathToIso (cong (F .F-ob) refl) F-pathToIso-refl = cong F-Iso pathToIso-refl - ∙ F-Iso-PresId - ∙ sym pathToIso-refl + ∙ F-Iso-PresId + ∙ sym pathToIso-refl - F-pathToIso-∘ : {x y : C .ob} → F-Iso ∘ pathToIso {x = x} {y = y} ≡ pathToIso ∘ cong (F .F-ob) + F-pathToIso-∘ : {x y : C .ob} → F-Iso ∘ pathToIso {x = x} {y = y} ≡ pathToIso ∘ cong (F .F-ob) F-pathToIso-∘ i p = F-pathToIso p i \ No newline at end of file diff --git a/docs/Cubical.Categories.Limits.BinProduct.html b/docs/Cubical.Categories.Limits.BinProduct.html index 3b3414e..789bc4c 100644 --- a/docs/Cubical.Categories.Limits.BinProduct.html +++ b/docs/Cubical.Categories.Limits.BinProduct.html @@ -1,45 +1,90 @@ Cubical.Categories.Limits.BinProduct
-- Binary products
-{-# OPTIONS --safe #-}
+{-# OPTIONS --allow-unsolved-metas #-}
 
-module Cubical.Categories.Limits.BinProduct where
+module Cubical.Categories.Limits.BinProduct where
 
-open import Cubical.Categories.Category.Base
-open import Cubical.Data.Sigma.Base
-open import Cubical.Foundations.HLevels
-open import Cubical.Foundations.Prelude
-open import Cubical.HITs.PropositionalTruncation.Base
+open import Cubical.Categories.Category.Base
+open import Cubical.Categories.Constructions.BinProduct
+open import Cubical.Categories.Functor.Base
+open import Cubical.Data.Sigma.Base
+open import Cubical.Foundations.HLevels
+open import Cubical.Foundations.Prelude
+open import Cubical.HITs.PropositionalTruncation.Base
 
-private
-  variable
-    ℓ ℓ' : Level
+private
+  variable
+    ℓ ℓ' : Level
 
-module _ (C : Category ℓ ℓ') where
-  open Category C
+module _ (C : Category ℓ ℓ') where
+  open Category C
 
-  module _ {x y x×y : ob}
-           (π₁ : Hom[ x×y , x ])
-           (π₂ : Hom[ x×y , y ]) where
+  module _ {x y x×y : ob}
+           (π₁ : Hom[ x×y , x ])
+           (π₂ : Hom[ x×y , y ]) where
 
-    isBinProduct : Type (ℓ-max ℓ ℓ')
-    isBinProduct = ∀ {z : ob} (f₁ : Hom[ z , x ]) (f₂ : Hom[ z , y ]) →
-        ∃![ f ∈ Hom[ z , x×y ] ] (f ⋆ π₁ ≡ f₁) × (f ⋆ π₂ ≡ f₂)
+    isBinProduct : Type (ℓ-max ℓ ℓ')
+    isBinProduct = ∀ {z : ob} (f₁ : Hom[ z , x ]) (f₂ : Hom[ z , y ]) →
+        ∃![ f ∈ Hom[ z , x×y ] ] (f ⋆ π₁ ≡ f₁) × (f ⋆ π₂ ≡ f₂)
 
-    isPropIsBinProduct : isProp (isBinProduct)
-    isPropIsBinProduct = isPropImplicitΠ (λ _ → isPropΠ2 (λ _ _ → isPropIsContr))
+    isPropIsBinProduct : isProp (isBinProduct)
+    isPropIsBinProduct = isPropImplicitΠ (λ _ → isPropΠ2 (λ _ _ → isPropIsContr))
 
 
-  record BinProduct (x y : ob) : Type (ℓ-max ℓ ℓ') where
-    field
-      binProdOb : ob
-      binProdPr₁ : Hom[ binProdOb , x ]
-      binProdPr₂ : Hom[ binProdOb , y ]
-      univProp : isBinProduct binProdPr₁ binProdPr₂
+  record BinProduct (x y : ob) : Type (ℓ-max ℓ ℓ') where
+    field
+      binProdOb : ob
+      binProdPr₁ : Hom[ binProdOb , x ]
+      binProdPr₂ : Hom[ binProdOb , y ]
+      univProp : isBinProduct binProdPr₁ binProdPr₂
 
 
-  BinProducts : Type (ℓ-max ℓ ℓ')
-  BinProducts = (x y : ob) → BinProduct x y
+  BinProducts : Type (ℓ-max ℓ ℓ')
+  BinProducts = (x y : ob) → BinProduct x y
 
-  hasBinProducts : Type (ℓ-max ℓ ℓ')
-  hasBinProducts = ∥ BinProducts ∥₁
+  hasBinProducts : Type (ℓ-max ℓ ℓ')
+  hasBinProducts = ∥ BinProducts ∥₁
+
+  module _ (binProducts : BinProducts) where
+    {-
+      Given morphisms f : Hom[ a , b ] and g : Hom[ c , d ]
+      we can construct a morphism f×g : Hom[ a × c , b × d ].
+      This is given by f , g ⟨ a , c ⟩ ⊢ ⟨ f a , g c ⟩
+      Here the ⊢ and ⟨⟩ notation have their obvious meanings
+    -}
+    open BinProduct
+    private variable
+      a b c d : ob
+    infix 20 _⊗₀_
+    _⊗₀_ : ob → ob → ob
+    x ⊗₀ y = binProducts x y .binProdOb
+    
+    _⊗₁_ : (f : Hom[ a , b ]) (g : Hom[ c , d ]) → Hom[ a ⊗₀ c , b ⊗₀ d ]
+    _⊗₁_ {a} {b} {c} {d} f g = b⊗d .univProp (a⊗c .binProdPr₁ ⋆ f) (a⊗c .binProdPr₂ ⋆ g) .fst .fst where
+         b⊗d = binProducts b d
+         a⊗c = binProducts a c
+
+    open Functor
+    prodFunctor : Functor (C ×C C) C
+    prodFunctor .F-ob (x , y) = x ⊗₀ y
+    prodFunctor .F-hom {x , y} {x' , y'} (f , g) = f ⊗₁ g
+    prodFunctor .F-id {x , y} i =
+      (isContr→isProp
+        (x×y .univProp
+          (x×y .binProdPr₁ ⋆ id)
+          (x×y .binProdPr₂ ⋆ id))
+        ( id {x} ⊗₁ id {y}
+        , x×y .univProp (x×y .binProdPr₁ ⋆ id) (x×y .binProdPr₂ ⋆ id) .fst .snd .fst
+        , x×y .univProp (x×y .binProdPr₁ ⋆ id) (x×y .binProdPr₂ ⋆ id) .fst .snd .snd)
+        ( id {x ⊗₀ y}
+        , (id ⋆ (x×y .binProdPr₁) ≡⟨ ⋆IdL _ ⟩
+          x×y .binProdPr₁ ≡⟨ sym (⋆IdR _) ⟩
+          x×y .binProdPr₁ ⋆ id ∎)
+        , (id ⋆ (x×y .binProdPr₂) ≡⟨ ⋆IdL _ ⟩
+          x×y .binProdPr₂ ≡⟨ sym (⋆IdR _) ⟩
+          x×y .binProdPr₂ ⋆ id ∎)))
+        i .fst where
+          x×y = binProducts x y
+    prodFunctor .F-seq {a , b} {c , d} {e , f} (α , β) (δ , γ) =
+      {!!}
\ No newline at end of file diff --git a/docs/Cubical.Categories.Limits.Initial.html b/docs/Cubical.Categories.Limits.Initial.html index d3619c8..6a90533 100644 --- a/docs/Cubical.Categories.Limits.Initial.html +++ b/docs/Cubical.Categories.Limits.Initial.html @@ -22,7 +22,7 @@ open Category C isInitial : (x : ob) → Type (ℓ-max ℓ ℓ') - isInitial x = ∀ (y : ob) → isContr (C [ x , y ]) + isInitial x = ∀ (y : ob) → isContr (C [ x , y ]) Initial : Type (ℓ-max ℓ ℓ') Initial = Σ[ x ∈ ob ] isInitial x @@ -39,14 +39,14 @@ initialEndoIsId : (T : Initial) (f : C [ initialOb T , initialOb T ]) → f ≡ id - initialEndoIsId T f = isContr→isProp (T .snd (initialOb T)) f id + initialEndoIsId T f = isContr→isProp (T .snd (initialOb T)) f id hasInitial : Type (ℓ-max ℓ ℓ') hasInitial = ∥ Initial ∥₁ -- Initiality of an object is a proposition. - isPropIsInitial : (x : ob) → isProp (isInitial x) - isPropIsInitial _ = isPropΠ λ _ → isPropIsContr + isPropIsInitial : (x : ob) → isProp (isInitial x) + isPropIsInitial _ = isPropΠ λ _ → isPropIsContr open isIso @@ -61,26 +61,26 @@ -- The type of initial objects of a univalent category is a proposition, -- i.e. all initial objects are equal. - isPropInitial : (hC : isUnivalent C) → isProp Initial + 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 +module _ {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} (F : Functor C D) where open Category - open Functor - open NaturalBijection - open _⊣_ + open Functor + open NaturalBijection + open _⊣_ open _≅_ preservesInitial : Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) - preservesInitial = ∀ (x : ob C) → isInitial C x → isInitial D (F-ob F x) + preservesInitial = ∀ (x : ob C) → isInitial C x → isInitial D (F-ob F x) - isLeftAdjoint→preservesInitial : isLeftAdjoint F → preservesInitial - fst (isLeftAdjoint→preservesInitial (G , F⊣G) x initX y) = _♯ F⊣G (fst (initX (F-ob G y))) + isLeftAdjoint→preservesInitial : isLeftAdjoint F → preservesInitial + fst (isLeftAdjoint→preservesInitial (G , F⊣G) x initX y) = _♯ F⊣G (fst (initX (F-ob G y))) snd (isLeftAdjoint→preservesInitial (G , F⊣G) x initX y) ψ = - _♯ F⊣G (fst (initX (F-ob G y))) - ≡⟨ cong (F⊣G ♯) (snd (initX (F-ob G y)) (_♭ F⊣G ψ)) ⟩ - _♯ F⊣G (_♭ F⊣G ψ) - ≡⟨ leftInv (adjIso F⊣G) ψ ⟩ - ψ ∎ + _♯ F⊣G (fst (initX (F-ob G y))) + ≡⟨ cong (F⊣G ♯) (snd (initX (F-ob G y)) (_♭ F⊣G ψ)) ⟩ + _♯ F⊣G (_♭ F⊣G ψ) + ≡⟨ leftInv (adjIso F⊣G) ψ ⟩ + ψ ∎ \ No newline at end of file diff --git a/docs/Cubical.Categories.Limits.Terminal.html b/docs/Cubical.Categories.Limits.Terminal.html index 0b4ec79..9bc1811 100644 --- a/docs/Cubical.Categories.Limits.Terminal.html +++ b/docs/Cubical.Categories.Limits.Terminal.html @@ -19,7 +19,7 @@ open Category C isTerminal : (x : ob) → Type (ℓ-max ℓ ℓ') - isTerminal x = ∀ (y : ob) → isContr (C [ y , x ]) + isTerminal x = ∀ (y : ob) → isContr (C [ y , x ]) Terminal : Type (ℓ-max ℓ ℓ') Terminal = Σ[ x ∈ ob ] isTerminal x @@ -36,14 +36,14 @@ terminalEndoIsId : (T : Terminal) (f : C [ terminalOb T , terminalOb T ]) → f ≡ id - terminalEndoIsId T f = isContr→isProp (T .snd (terminalOb T)) f id + terminalEndoIsId T f = isContr→isProp (T .snd (terminalOb T)) f id hasTerminal : Type (ℓ-max ℓ ℓ') hasTerminal = ∥ Terminal ∥₁ -- Terminality of an object is a proposition. - isPropIsTerminal : (x : ob) → isProp (isTerminal x) - isPropIsTerminal _ = isPropΠ λ _ → isPropIsContr + isPropIsTerminal : (x : ob) → isProp (isTerminal x) + isPropIsTerminal _ = isPropΠ λ _ → isPropIsContr open isIso @@ -65,21 +65,21 @@ -- The type of terminal objects of a univalent category is a proposition, -- i.e. all terminal objects are equal. - isPropTerminal : (hC : isUnivalent C) → isProp Terminal + 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 + → Functor C D → Type (ℓ-max (ℓ-max (ℓ-max ℓc ℓc') ℓd) ℓd') -preservesTerminals C D F = ∀ (term : Terminal C) → isTerminal D (F ⟅ term .fst ⟆) +preservesTerminals C D F = ∀ (term : Terminal C) → isTerminal D (F ⟅ term .fst ⟆) preserveAnyTerminal→PreservesTerminals : ∀ (C : Category ℓc ℓc')(D : Category ℓd ℓd') - → (F : Functor C D) - → (term : Terminal C) → isTerminal D (F ⟅ term .fst ⟆) + → (F : Functor C D) + → (term : Terminal C) → isTerminal D (F ⟅ term .fst ⟆) → preservesTerminals C D F preserveAnyTerminal→PreservesTerminals C D F term D-preserves-term term' = isoToTerminal D - ((F ⟅ term .fst ⟆) , D-preserves-term) (F ⟅ term' .fst ⟆) + ((F ⟅ term .fst ⟆) , D-preserves-term) (F ⟅ term' .fst ⟆) (F-Iso {F = F} (terminalToIso C term term')) \ No newline at end of file diff --git a/docs/Cubical.Categories.Morphism.html b/docs/Cubical.Categories.Morphism.html index 24ddfdd..e945480 100644 --- a/docs/Cubical.Categories.Morphism.html +++ b/docs/Cubical.Categories.Morphism.html @@ -2,136 +2,168 @@ Cubical.Categories.Morphism
{-# OPTIONS --safe #-}
 module Cubical.Categories.Morphism where
 
-open import Cubical.Foundations.Prelude
-open import Cubical.Data.Sigma
-open import Cubical.Categories.Category
-
-
-private
-  variable
-    ℓ ℓ' : Level
-
--- C needs to be explicit for these definitions as Agda can't infer it
-module _ (C : Category ℓ ℓ') where
-  open Category C
-
-  private
-    variable
-      x y z v w : ob
-
-  isMonic : Hom[ x , y ] → Type (ℓ-max ℓ ℓ')
-  isMonic {x} {y} f =
-    ∀ {z} {a a' : Hom[ z , x ]} → f ∘ a ≡ f ∘ a' → a ≡ a'
-
-  isEpic : (Hom[ x , y ]) → Type (ℓ-max ℓ ℓ')
-  isEpic {x} {y} g =
-    ∀ {z} {b b' : Hom[ y , z ]} → b ∘ g ≡ b' ∘ g → b ≡ b'
-
-  -- A morphism is split monic if it has a *retraction*
-  isSplitMon : (Hom[ x , y ]) → Type ℓ'
-  isSplitMon {x} {y} f = ∃[ r ∈ Hom[ y , x ] ] r ∘ f ≡ id
-
-  -- A morphism is split epic if it has a *section*
-  isSplitEpi : (Hom[ x , y ]) → Type ℓ'
-  isSplitEpi {x} {y} g = ∃[ s ∈ Hom[ y , x ] ] g ∘ s ≡ id
-
-  record areInv (f : Hom[ x , y ]) (g : Hom[ y , x ]) : Type ℓ' where
-    field
-      sec : g ⋆ f ≡ id
-      ret : f ⋆ g ≡ id
-
-
--- C can be implicit here
-module _ {C : Category ℓ ℓ'} where
-  open Category C
-
-  private
-    variable
-      x y z v w : ob
-
-  open areInv
-
-  symAreInv : {f : Hom[ x , y ]} {g : Hom[ y , x ]} → areInv C f g → areInv C g f
-  sec (symAreInv x) = ret x
-  ret (symAreInv x) = sec x
-
-  -- equational reasoning with inverses
-  invMoveR : ∀ {f : Hom[ x , y ]} {g : Hom[ y , x ]} {h : Hom[ z , x ]} {k : Hom[ z , y ]}
-           → areInv C f g
-           → h ⋆ f ≡ k
-           → h ≡ k ⋆ g
-  invMoveR {f = f} {g} {h} {k} ai p
-    = h
-    ≡⟨ sym (⋆IdR _) ⟩
-      (h ⋆ id)
-    ≡⟨ cong (h ⋆_) (sym (ai .ret)) ⟩
-      (h ⋆ (f ⋆ g))
-    ≡⟨ sym (⋆Assoc _ _ _) ⟩
-      ((h ⋆ f) ⋆ g)
-    ≡⟨ cong (_⋆ g) p ⟩
-      k ⋆ g
-    ∎
-
-  invMoveL : ∀ {f : Hom[ x , y ]} {g : Hom[ y , x ]} {h : Hom[ y , z ]} {k : Hom[ x , z ]}
-          → areInv C f g
-          → f ⋆ h ≡ k
-          → h ≡ g ⋆ k
-  invMoveL {f = f} {g} {h} {k} ai p
-    = h
-    ≡⟨ sym (⋆IdL _) ⟩
-      id ⋆ h
-    ≡⟨ cong (_⋆ h) (sym (ai .sec)) ⟩
-      (g ⋆ f) ⋆ h
-    ≡⟨ ⋆Assoc _ _ _ ⟩
-      g ⋆ (f ⋆ h)
-    ≡⟨ cong (g ⋆_) p ⟩
-      (g ⋆ k)
-    ∎
-
-  invFlipSq : {f₁⁻¹ : Hom[ x , y ]} {f₁ : Hom[ y , x ]}
-              {f₂⁻¹ : Hom[ v , w ]} {f₂ : Hom[ w , v ]}
-              {g : Hom[ x , v ]} {h : Hom[ y , w ]}
-            → areInv C f₁ f₁⁻¹ → areInv C f₂ f₂⁻¹
-            → h ⋆ f₂ ≡ f₁ ⋆ g
-            → g ⋆ f₂⁻¹ ≡ f₁⁻¹ ⋆ h
-  invFlipSq {f₁⁻¹ = f₁⁻¹} {f₁} {f₂⁻¹} {f₂} {g} {h} inv₁ inv₂ sq =
-    g ⋆ f₂⁻¹                ≡⟨ cong (_⋆ f₂⁻¹) (sym (⋆IdL _)) ⟩
-    (id ⋆ g) ⋆ f₂⁻¹         ≡⟨ cong (λ m → (m ⋆ g) ⋆ f₂⁻¹) (sym (inv₁ .sec)) ⟩
-    ((f₁⁻¹ ⋆ f₁) ⋆ g) ⋆ f₂⁻¹ ≡⟨ cong (_⋆ f₂⁻¹) (⋆Assoc _ _ _) ⟩
-    (f₁⁻¹ ⋆ (f₁ ⋆ g)) ⋆ f₂⁻¹ ≡⟨ ⋆Assoc _ _ _ ⟩
-    f₁⁻¹ ⋆ ((f₁ ⋆ g) ⋆ f₂⁻¹) ≡⟨ cong (λ m → f₁⁻¹ ⋆ (m ⋆ f₂⁻¹)) (sym sq) ⟩
-    f₁⁻¹ ⋆ ((h ⋆ f₂) ⋆ f₂⁻¹) ≡⟨ cong (f₁⁻¹ ⋆_) (⋆Assoc _ _ _) ⟩
-    f₁⁻¹ ⋆ (h ⋆ (f₂ ⋆ f₂⁻¹)) ≡⟨ cong (λ m → f₁⁻¹ ⋆ (h ⋆ m)) (inv₂ .ret) ⟩
-    f₁⁻¹ ⋆ (h ⋆ id)         ≡⟨ cong (f₁⁻¹ ⋆_) (⋆IdR _) ⟩
-    f₁⁻¹ ⋆ h ∎
-
-  open isIso
-
-  isIso→areInv : ∀ {f : Hom[ x , y ]}
-               → (isI : isIso C f)
-               → areInv C f (isI .inv)
-  sec (isIso→areInv isI) = sec isI
-  ret (isIso→areInv isI) = ret isI
-
-
-  -- Back and forth between isIso and CatIso
-
-  isIso→CatIso : ∀ {f : C [ x , y ]}
-               → isIso C f
-               → CatIso C x y
-  isIso→CatIso x = _ , x
-
-  CatIso→isIso : (cIso : CatIso C x y)
-               → isIso C (cIso .fst)
-  CatIso→isIso = snd
-
-  CatIso→areInv : (cIso : CatIso C x y)
-                → areInv C (cIso .fst) (cIso .snd .inv)
-  CatIso→areInv cIso = isIso→areInv (CatIso→isIso cIso)
-
-  -- reverse of an iso is also an iso
-  symCatIso : ∀ {x y}
-             → CatIso C x y
-             → CatIso C y x
-  symCatIso (mor , isiso inv sec ret) = inv , isiso mor ret sec
+open import Cubical.Foundations.HLevels
+open import Cubical.Foundations.Prelude
+open import Cubical.Data.Sigma
+open import Cubical.Categories.Category
+
+
+private
+  variable
+    ℓ ℓ' : Level
+
+-- C needs to be explicit for these definitions as Agda can't infer it
+module _ (C : Category ℓ ℓ') where
+  open Category C
+
+  private
+    variable
+      x y z v w : ob
+
+  isMonic : Hom[ x , y ] → Type (ℓ-max ℓ ℓ')
+  isMonic {x} {y} f =
+    ∀ {z} {a a' : Hom[ z , x ]} → f ∘ a ≡ f ∘ a' → a ≡ a'
+
+  isPropIsMonic : (f : Hom[ x , y ]) → isProp (isMonic f)
+  isPropIsMonic _ = isPropImplicitΠ (λ _ → (isPropImplicitΠ2
+    (λ a a' → (isProp→ (isOfHLevelPath' 1 isSetHom a a')))))
+
+  postcompCreatesMonic : (f : Hom[ x , y ]) (g : Hom[ y , z ])
+    → isMonic (f ⋆ g) → isMonic f
+  postcompCreatesMonic f g monic {a = a} {a' = a'} fa≡fa' =
+    monic (sym (⋆Assoc a f g) ∙ cong (_⋆ g) fa≡fa' ∙ ⋆Assoc a' f g)
+
+  monicComp : (f : Hom[ x , y ]) (g : Hom[ y , z ])
+    → isMonic f → isMonic g → isMonic (f ⋆ g)
+  monicComp f g mon-f mon-g {a = a} {a' = a'} eq =
+    mon-f (mon-g (⋆Assoc a f g ∙ eq ∙ sym (⋆Assoc a' f g)))
+
+  monicId : {x : ob} → isMonic (id {x})
+  monicId {a = a} {a' = a'} eq = sym (⋆IdR a) ∙ eq ∙ ⋆IdR a'
+
+  retraction⇒monic : (f : Hom[ x , y ]) (lInv : Hom[ y , x ])
+    → (lInv ∘ f ≡ id) → isMonic f
+  retraction⇒monic f lInv eq =
+    postcompCreatesMonic f lInv (subst isMonic (sym eq) monicId)
+
+  isEpic : (Hom[ x , y ]) → Type (ℓ-max ℓ ℓ')
+  isEpic {x} {y} g =
+    ∀ {z} {b b' : Hom[ y , z ]} → b ∘ g ≡ b' ∘ g → b ≡ b'
+
+  isPropIsEpic : (f : Hom[ x , y ]) → isProp (isEpic f)
+  isPropIsEpic _ = isPropImplicitΠ (λ _ → (isPropImplicitΠ2
+    (λ a a' → (isProp→ (isOfHLevelPath' 1 isSetHom a a')))))
+
+  precompCreatesEpic : (f : Hom[ x , y ]) (g : Hom[ z , x ])
+    → isEpic (g ⋆ f) → isEpic f
+  precompCreatesEpic f g epic {b = b} {b' = b'} bf≡b'f =
+    epic (⋆Assoc g f b ∙ cong (g ⋆_) bf≡b'f ∙ sym (⋆Assoc g f b'))
+
+  -- A morphism is split monic if it has a *retraction*
+  isSplitMon : (Hom[ x , y ]) → Type ℓ'
+  isSplitMon {x} {y} f = ∃[ r ∈ Hom[ y , x ] ] r ∘ f ≡ id
+
+  -- A morphism is split epic if it has a *section*
+  isSplitEpi : (Hom[ x , y ]) → Type ℓ'
+  isSplitEpi {x} {y} g = ∃[ s ∈ Hom[ y , x ] ] g ∘ s ≡ id
+
+  record areInv (f : Hom[ x , y ]) (g : Hom[ y , x ]) : Type ℓ' where
+    field
+      sec : g ⋆ f ≡ id
+      ret : f ⋆ g ≡ id
+
+
+-- C can be implicit here
+module _ {C : Category ℓ ℓ'} where
+  open Category C
+
+  private
+    variable
+      x y z v w : ob
+
+  open areInv
+
+  symAreInv : {f : Hom[ x , y ]} {g : Hom[ y , x ]} → areInv C f g → areInv C g f
+  sec (symAreInv x) = ret x
+  ret (symAreInv x) = sec x
+
+  -- equational reasoning with inverses
+  invMoveR : ∀ {f : Hom[ x , y ]} {g : Hom[ y , x ]} {h : Hom[ z , x ]} {k : Hom[ z , y ]}
+           → areInv C f g
+           → h ⋆ f ≡ k
+           → h ≡ k ⋆ g
+  invMoveR {f = f} {g} {h} {k} ai p
+    = h
+    ≡⟨ sym (⋆IdR _) ⟩
+      (h ⋆ id)
+    ≡⟨ cong (h ⋆_) (sym (ai .ret)) ⟩
+      (h ⋆ (f ⋆ g))
+    ≡⟨ sym (⋆Assoc _ _ _) ⟩
+      ((h ⋆ f) ⋆ g)
+    ≡⟨ cong (_⋆ g) p ⟩
+      k ⋆ g
+    ∎
+
+  invMoveL : ∀ {f : Hom[ x , y ]} {g : Hom[ y , x ]} {h : Hom[ y , z ]} {k : Hom[ x , z ]}
+          → areInv C f g
+          → f ⋆ h ≡ k
+          → h ≡ g ⋆ k
+  invMoveL {f = f} {g} {h} {k} ai p
+    = h
+    ≡⟨ sym (⋆IdL _) ⟩
+      id ⋆ h
+    ≡⟨ cong (_⋆ h) (sym (ai .sec)) ⟩
+      (g ⋆ f) ⋆ h
+    ≡⟨ ⋆Assoc _ _ _ ⟩
+      g ⋆ (f ⋆ h)
+    ≡⟨ cong (g ⋆_) p ⟩
+      (g ⋆ k)
+    ∎
+
+  invFlipSq : {f₁⁻¹ : Hom[ x , y ]} {f₁ : Hom[ y , x ]}
+              {f₂⁻¹ : Hom[ v , w ]} {f₂ : Hom[ w , v ]}
+              {g : Hom[ x , v ]} {h : Hom[ y , w ]}
+            → areInv C f₁ f₁⁻¹ → areInv C f₂ f₂⁻¹
+            → h ⋆ f₂ ≡ f₁ ⋆ g
+            → g ⋆ f₂⁻¹ ≡ f₁⁻¹ ⋆ h
+  invFlipSq {f₁⁻¹ = f₁⁻¹} {f₁} {f₂⁻¹} {f₂} {g} {h} inv₁ inv₂ sq =
+    g ⋆ f₂⁻¹                ≡⟨ cong (_⋆ f₂⁻¹) (sym (⋆IdL _)) ⟩
+    (id ⋆ g) ⋆ f₂⁻¹         ≡⟨ cong (λ m → (m ⋆ g) ⋆ f₂⁻¹) (sym (inv₁ .sec)) ⟩
+    ((f₁⁻¹ ⋆ f₁) ⋆ g) ⋆ f₂⁻¹ ≡⟨ cong (_⋆ f₂⁻¹) (⋆Assoc _ _ _) ⟩
+    (f₁⁻¹ ⋆ (f₁ ⋆ g)) ⋆ f₂⁻¹ ≡⟨ ⋆Assoc _ _ _ ⟩
+    f₁⁻¹ ⋆ ((f₁ ⋆ g) ⋆ f₂⁻¹) ≡⟨ cong (λ m → f₁⁻¹ ⋆ (m ⋆ f₂⁻¹)) (sym sq) ⟩
+    f₁⁻¹ ⋆ ((h ⋆ f₂) ⋆ f₂⁻¹) ≡⟨ cong (f₁⁻¹ ⋆_) (⋆Assoc _ _ _) ⟩
+    f₁⁻¹ ⋆ (h ⋆ (f₂ ⋆ f₂⁻¹)) ≡⟨ cong (λ m → f₁⁻¹ ⋆ (h ⋆ m)) (inv₂ .ret) ⟩
+    f₁⁻¹ ⋆ (h ⋆ id)         ≡⟨ cong (f₁⁻¹ ⋆_) (⋆IdR _) ⟩
+    f₁⁻¹ ⋆ h ∎
+
+  open isIso
+
+  isIso→areInv : ∀ {f : Hom[ x , y ]}
+               → (isI : isIso C f)
+               → areInv C f (isI .inv)
+  sec (isIso→areInv isI) = sec isI
+  ret (isIso→areInv isI) = ret isI
+
+
+  -- Back and forth between isIso and CatIso
+
+  isIso→CatIso : ∀ {f : C [ x , y ]}
+               → isIso C f
+               → CatIso C x y
+  isIso→CatIso x = _ , x
+
+  CatIso→isIso : (cIso : CatIso C x y)
+               → isIso C (cIso .fst)
+  CatIso→isIso = snd
+
+  CatIso→areInv : (cIso : CatIso C x y)
+                → areInv C (cIso .fst) (cIso .snd .inv)
+  CatIso→areInv cIso = isIso→areInv (CatIso→isIso cIso)
+
+  -- reverse of an iso is also an iso
+  symCatIso : ∀ {x y}
+             → CatIso C x y
+             → CatIso C y x
+  symCatIso (mor , isiso inv sec ret) = inv , isiso mor ret sec
\ No newline at end of file diff --git a/docs/Cubical.Categories.NaturalTransformation.Base.html b/docs/Cubical.Categories.NaturalTransformation.Base.html index ef0ea14..34d641f 100644 --- a/docs/Cubical.Categories.NaturalTransformation.Base.html +++ b/docs/Cubical.Categories.NaturalTransformation.Base.html @@ -26,16 +26,16 @@ f ⋆ᴰ g = f ⋆⟨ D ⟩ g open Category - open Functor + open Functor -- type aliases because it gets tedious typing it out all the time - N-ob-Type : (F G : Functor C D) → Type _ - N-ob-Type F G = (x : C .ob) → D [(F .F-ob x) , (G .F-ob x)] + N-ob-Type : (F G : Functor C D) → Type _ + N-ob-Type F G = (x : C .ob) → D [(F .F-ob x) , (G .F-ob x)] - N-hom-Type : (F G : Functor C D) → N-ob-Type F G → Type _ - N-hom-Type F G ϕ = {x y : C .ob} (f : C [ x , y ]) → (F .F-hom f) ⋆ᴰ (ϕ y) ≡ (ϕ x) ⋆ᴰ (G .F-hom f) + N-hom-Type : (F G : Functor C D) → N-ob-Type F G → Type _ + N-hom-Type F G ϕ = {x y : C .ob} (f : C [ x , y ]) → (F .F-hom f) ⋆ᴰ (ϕ y) ≡ (ϕ x) ⋆ᴰ (G .F-hom f) - record NatTrans (F G : Functor C D) : Type (ℓ-max (ℓ-max ℓC ℓC') ℓD') where + record NatTrans (F G : Functor C D) : Type (ℓ-max (ℓ-max ℓC ℓC') ℓD') where constructor natTrans field -- components of the natural transformation @@ -43,7 +43,7 @@ -- naturality condition N-hom : N-hom-Type F G N-ob - record NatIso (F G : Functor C D): Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) where + record NatIso (F G : Functor C D): Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) where field trans : NatTrans F G open NatTrans trans @@ -55,192 +55,197 @@ -- the three other commuting squares sqRL : ∀ {x y : C .ob} {f : C [ x , y ]} - → F ⟪ f ⟫ ≡ (N-ob x) ⋆ᴰ G ⟪ f ⟫ ⋆ᴰ (nIso y) .inv - sqRL {x} {y} {f} = invMoveR (isIso→areInv (nIso y)) (N-hom f) + → F ⟪ f ⟫ ≡ (N-ob x) ⋆ᴰ G ⟪ f ⟫ ⋆ᴰ (nIso y) .inv + sqRL {x} {y} {f} = invMoveR (isIso→areInv (nIso y)) (N-hom f) sqLL : ∀ {x y : C .ob} {f : C [ x , y ]} - → G ⟪ f ⟫ ⋆ᴰ (nIso y) .inv ≡ (nIso x) .inv ⋆ᴰ F ⟪ f ⟫ - sqLL {x} {y} {f} = invMoveL (isIso→areInv (nIso x)) (sym sqRL') + → G ⟪ f ⟫ ⋆ᴰ (nIso y) .inv ≡ (nIso x) .inv ⋆ᴰ F ⟪ f ⟫ + sqLL {x} {y} {f} = invMoveL (isIso→areInv (nIso x)) (sym sqRL') where - sqRL' : F ⟪ f ⟫ ≡ (N-ob x) ⋆ᴰ ( G ⟪ f ⟫ ⋆ᴰ (nIso y) .inv ) - sqRL' = sqRL ∙ (D .⋆Assoc _ _ _) + sqRL' : F ⟪ f ⟫ ≡ (N-ob x) ⋆ᴰ ( G ⟪ f ⟫ ⋆ᴰ (nIso y) .inv ) + sqRL' = sqRL ∙ (D .⋆Assoc _ _ _) sqLR : ∀ {x y : C .ob} {f : C [ x , y ]} - → G ⟪ f ⟫ ≡ (nIso x) .inv ⋆ᴰ F ⟪ f ⟫ ⋆ᴰ (N-ob y) - sqLR {x} {y} {f} = invMoveR (symAreInv (isIso→areInv (nIso y))) sqLL + → G ⟪ f ⟫ ≡ (nIso x) .inv ⋆ᴰ F ⟪ f ⟫ ⋆ᴰ (N-ob y) + sqLR {x} {y} {f} = invMoveR (symAreInv (isIso→areInv (nIso y))) sqLL open NatTrans open NatIso - infix 10 NatTrans - syntax NatTrans F G = F ⇒ G - - infix 9 NatIso - syntax NatIso F G = F ≅ᶜ G -- c superscript to indicate that this is in the context of categories - - -- component of a natural transformation - infix 30 _⟦_⟧ - _⟦_⟧ : ∀ {F G : Functor C D} → F ⇒ G → (x : C .ob) → D [ F .F-ob x , G .F-ob x ] - _⟦_⟧ = N-ob - - idTrans : (F : Functor C D) → NatTrans F F - idTrans F .N-ob x = D .id - idTrans F .N-hom f = - (F .F-hom f) ⋆ᴰ (idTrans F .N-ob _) - ≡⟨ D .⋆IdR _ ⟩ - F .F-hom f - ≡⟨ sym (D .⋆IdL _) ⟩ - (D .id) ⋆ᴰ (F .F-hom f) - ∎ - - syntax idTrans F = 1[ F ] - - idNatIso : (F : Functor C D) → NatIso F F - idNatIso F .trans = idTrans F - idNatIso F .nIso _ = idCatIso .snd - - - -- Natural isomorphism induced by path of functors - - pathToNatTrans : {F G : Functor C D} → F ≡ G → NatTrans F G - pathToNatTrans p .N-ob x = pathToIso {C = D} (λ i → p i .F-ob x) .fst - pathToNatTrans {F = F} {G = G} p .N-hom {x = x} {y = y} f = - pathToIso-Comm {C = D} _ _ _ _ (λ i → p i .F-hom f) - - pathToNatIso : {F G : Functor C D} → F ≡ G → NatIso F G - pathToNatIso p .trans = pathToNatTrans p - pathToNatIso p .nIso x = pathToIso {C = D} _ .snd - - - -- vertical sequencing - seqTrans : {F G H : Functor C D} (α : NatTrans F G) (β : NatTrans G H) → NatTrans F H - seqTrans α β .N-ob x = (α .N-ob x) ⋆ᴰ (β .N-ob x) - seqTrans {F} {G} {H} α β .N-hom f = - (F .F-hom f) ⋆ᴰ ((α .N-ob _) ⋆ᴰ (β .N-ob _)) - ≡⟨ sym (D .⋆Assoc _ _ _) ⟩ - ((F .F-hom f) ⋆ᴰ (α .N-ob _)) ⋆ᴰ (β .N-ob _) - ≡[ i ]⟨ (α .N-hom f i) ⋆ᴰ (β .N-ob _) ⟩ - ((α .N-ob _) ⋆ᴰ (G .F-hom f)) ⋆ᴰ (β .N-ob _) - ≡⟨ D .⋆Assoc _ _ _ ⟩ - (α .N-ob _) ⋆ᴰ ((G .F-hom f) ⋆ᴰ (β .N-ob _)) - ≡[ i ]⟨ (α .N-ob _) ⋆ᴰ (β .N-hom f i) ⟩ - (α .N-ob _) ⋆ᴰ ((β .N-ob _) ⋆ᴰ (H .F-hom f)) - ≡⟨ sym (D .⋆Assoc _ _ _) ⟩ - ((α .N-ob _) ⋆ᴰ (β .N-ob _)) ⋆ᴰ (H .F-hom f) - ∎ - - compTrans : {F G H : Functor C D} (β : NatTrans G H) (α : NatTrans F G) → NatTrans F H - compTrans β α = seqTrans α β - - infixl 8 seqTrans - syntax seqTrans α β = α ●ᵛ β - - - -- vertically sequence natural transformations whose - -- common functor is not definitional equal - seqTransP : {F G G' H : Functor C D} (p : G ≡ G') - → (α : NatTrans F G) (β : NatTrans G' H) - → NatTrans F H - seqTransP {F} {G} {G'} {H} p α β .N-ob x - -- sequence morphisms with non-judgementally equal (co)domain - = seqP {C = D} {p = Gx≡G'x} (α ⟦ x ⟧) (β ⟦ x ⟧) - where - Gx≡G'x : ∀ {x} → G ⟅ x ⟆ ≡ G' ⟅ x ⟆ - Gx≡G'x {x} i = F-ob (p i) x - seqTransP {F} {G} {G'} {H} p α β .N-hom {x = x} {y} f - -- compose the two commuting squares - -- 1. α's commuting square - -- 2. β's commuting square, but extended to G since β is only G' ≡> H - = compSq {C = D} (α .N-hom f) βSq - where - -- functor equality implies equality of actions on objects and morphisms - Gx≡G'x : G ⟅ x ⟆ ≡ G' ⟅ x ⟆ - Gx≡G'x i = F-ob (p i) x - - Gy≡G'y : G ⟅ y ⟆ ≡ G' ⟅ y ⟆ - Gy≡G'y i = F-ob (p i) y - - Gf≡G'f : PathP (λ i → D [ Gx≡G'x i , Gy≡G'y i ]) (G ⟪ f ⟫) (G' ⟪ f ⟫) - Gf≡G'f i = p i ⟪ f ⟫ - - -- components of β extended out to Gx and Gy respectively - βx' = subst (λ a → D [ a , H ⟅ x ⟆ ]) (sym Gx≡G'x) (β ⟦ x ⟧) - βy' = subst (λ a → D [ a , H ⟅ y ⟆ ]) (sym Gy≡G'y) (β ⟦ y ⟧) - - -- extensions are equal to originals - βy'≡βy : PathP (λ i → D [ Gy≡G'y i , H ⟅ y ⟆ ]) βy' (β ⟦ y ⟧) - βy'≡βy = symP (toPathP {A = λ i → D [ Gy≡G'y (~ i) , H ⟅ y ⟆ ]} refl) - - βx≡βx' : PathP (λ i → D [ Gx≡G'x (~ i) , H ⟅ x ⟆ ]) (β ⟦ x ⟧) βx' - βx≡βx' = toPathP refl - - -- left wall of square - left : PathP (λ i → D [ Gx≡G'x i , H ⟅ y ⟆ ]) (G ⟪ f ⟫ ⋆⟨ D ⟩ βy') (G' ⟪ f ⟫ ⋆⟨ D ⟩ β ⟦ y ⟧) - left i = Gf≡G'f i ⋆⟨ D ⟩ βy'≡βy i - - -- right wall of square - right : PathP (λ i → D [ Gx≡G'x (~ i) , H ⟅ y ⟆ ]) (β ⟦ x ⟧ ⋆⟨ D ⟩ H ⟪ f ⟫) (βx' ⋆⟨ D ⟩ H ⟪ f ⟫) - right i = βx≡βx' i ⋆⟨ D ⟩ refl {x = H ⟪ f ⟫} i - - -- putting it all together - βSq : G ⟪ f ⟫ ⋆⟨ D ⟩ βy' ≡ βx' ⋆⟨ D ⟩ H ⟪ f ⟫ - βSq i = comp (λ k → D [ Gx≡G'x (~ k) , H ⟅ y ⟆ ]) - (λ j → λ { (i = i0) → left (~ j) - ; (i = i1) → right j }) - (β .N-hom f i) - - module _ {F G : Functor C D} {α β : NatTrans F G} where - open Category - open Functor - open NatTrans - - makeNatTransPath : α .N-ob ≡ β .N-ob → α ≡ β - makeNatTransPath p i .N-ob = p i - makeNatTransPath p i .N-hom f = rem i - where - rem : PathP (λ i → (F .F-hom f) ⋆ᴰ (p i _) ≡ (p i _) ⋆ᴰ (G .F-hom f)) - (α .N-hom f) (β .N-hom f) - rem = toPathP (D .isSetHom _ _ _ _) - - - -- `constructor` for path of natural isomorphisms - NatIso≡ : {F G : Functor C D}{f g : NatIso F G} → f .trans .N-ob ≡ g .trans .N-ob → f ≡ g - NatIso≡ {f = f} {g} p i .trans = makeNatTransPath {α = f .trans} {β = g .trans} p i - NatIso≡ {f = f} {g} p i .nIso x = - isProp→PathP (λ i → isPropIsIso (NatIso≡ {f = f} {g} p i .trans .N-ob x)) (f .nIso _) (g .nIso _) i - - - module _ {F F' G G' : Functor C D} {α : NatTrans F G} {β : NatTrans F' G'} where - open Category - open Functor - open NatTrans - makeNatTransPathP : ∀ (p : F ≡ F') (q : G ≡ G') - → PathP (λ i → (x : C .ob) → D [ (p i) .F-ob x , (q i) .F-ob x ]) - (α .N-ob) (β .N-ob) - → PathP (λ i → NatTrans (p i) (q i)) α β - makeNatTransPathP p q P i .N-ob = P i - makeNatTransPathP p q P i .N-hom f = rem i - where - rem : PathP (λ i → ((p i) .F-hom f) ⋆ᴰ (P i _) ≡ (P i _) ⋆ᴰ ((q i) .F-hom f)) - (α .N-hom f) (β .N-hom f) - rem = toPathP (D .isSetHom _ _ _ _) - -module _ {B : Category ℓB ℓB'} {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} where - open NatTrans - -- whiskering - -- αF - _∘ˡ_ : ∀ {G H : Functor C D} (α : NatTrans G H) → (F : Functor B C) - → NatTrans (G ∘F F) (H ∘F F) - (_∘ˡ_ {G} {H} α F) .N-ob x = α ⟦ F ⟅ x ⟆ ⟧ - (_∘ˡ_ {G} {H} α F) .N-hom f = (α .N-hom) _ - - -- Kβ - _∘ʳ_ : ∀ (K : Functor C D) → {G H : Functor B C} (β : NatTrans G H) - → NatTrans (K ∘F G) (K ∘F H) - (_∘ʳ_ K {G} {H} β) .N-ob x = K ⟪ β ⟦ x ⟧ ⟫ - (_∘ʳ_ K {G} {H} β) .N-hom f = preserveCommF {C = C} {D = D} {K} (β .N-hom f) - - whiskerTrans : {F F' : Functor B C} {G G' : Functor C D} (β : NatTrans G G') (α : NatTrans F F') - → NatTrans (G ∘F F) (G' ∘F F') - whiskerTrans {F}{F'}{G}{G'} β α = compTrans (β ∘ˡ F') (G ∘ʳ α) + infix 10 _⇒_ + _⇒_ : Functor C D → Functor C D → Type (ℓ-max (ℓ-max ℓC ℓC') ℓD') + _⇒_ = NatTrans + + infix 9 _≅ᶜ_ + -- c superscript to indicate that this is in the context of categories + _≅ᶜ_ : Functor C D → Functor C D → Type (ℓ-max (ℓ-max ℓC ℓC') (ℓ-max ℓD ℓD')) + _≅ᶜ_ = NatIso + + -- component of a natural transformation + infix 30 _⟦_⟧ + _⟦_⟧ : ∀ {F G : Functor C D} → F ⇒ G → (x : C .ob) → D [ F .F-ob x , G .F-ob x ] + _⟦_⟧ = N-ob + + idTrans : (F : Functor C D) → NatTrans F F + idTrans F .N-ob x = D .id + idTrans F .N-hom f = + (F .F-hom f) ⋆ᴰ (idTrans F .N-ob _) + ≡⟨ D .⋆IdR _ ⟩ + F .F-hom f + ≡⟨ sym (D .⋆IdL _) ⟩ + (D .id) ⋆ᴰ (F .F-hom f) + ∎ + + 1[_] : (F : Functor C D) → NatTrans F F + 1[_] = idTrans + + idNatIso : (F : Functor C D) → NatIso F F + idNatIso F .trans = idTrans F + idNatIso F .nIso _ = idCatIso .snd + + + -- Natural isomorphism induced by path of functors + + pathToNatTrans : {F G : Functor C D} → F ≡ G → NatTrans F G + pathToNatTrans p .N-ob x = pathToIso {C = D} (λ i → p i .F-ob x) .fst + pathToNatTrans {F = F} {G = G} p .N-hom {x = x} {y = y} f = + pathToIso-Comm {C = D} _ _ _ _ (λ i → p i .F-hom f) + + pathToNatIso : {F G : Functor C D} → F ≡ G → NatIso F G + pathToNatIso p .trans = pathToNatTrans p + pathToNatIso p .nIso x = pathToIso {C = D} _ .snd + + + -- vertical sequencing + seqTrans : {F G H : Functor C D} (α : NatTrans F G) (β : NatTrans G H) → NatTrans F H + seqTrans α β .N-ob x = (α .N-ob x) ⋆ᴰ (β .N-ob x) + seqTrans {F} {G} {H} α β .N-hom f = + (F .F-hom f) ⋆ᴰ ((α .N-ob _) ⋆ᴰ (β .N-ob _)) + ≡⟨ sym (D .⋆Assoc _ _ _) ⟩ + ((F .F-hom f) ⋆ᴰ (α .N-ob _)) ⋆ᴰ (β .N-ob _) + ≡[ i ]⟨ (α .N-hom f i) ⋆ᴰ (β .N-ob _) ⟩ + ((α .N-ob _) ⋆ᴰ (G .F-hom f)) ⋆ᴰ (β .N-ob _) + ≡⟨ D .⋆Assoc _ _ _ ⟩ + (α .N-ob _) ⋆ᴰ ((G .F-hom f) ⋆ᴰ (β .N-ob _)) + ≡[ i ]⟨ (α .N-ob _) ⋆ᴰ (β .N-hom f i) ⟩ + (α .N-ob _) ⋆ᴰ ((β .N-ob _) ⋆ᴰ (H .F-hom f)) + ≡⟨ sym (D .⋆Assoc _ _ _) ⟩ + ((α .N-ob _) ⋆ᴰ (β .N-ob _)) ⋆ᴰ (H .F-hom f) + ∎ + + compTrans : {F G H : Functor C D} (β : NatTrans G H) (α : NatTrans F G) → NatTrans F H + compTrans β α = seqTrans α β + + infixl 8 _●ᵛ_ + _●ᵛ_ : {F G H : Functor C D} → NatTrans F G → NatTrans G H → NatTrans F H + _●ᵛ_ = seqTrans + + + -- vertically sequence natural transformations whose + -- common functor is not definitional equal + seqTransP : {F G G' H : Functor C D} (p : G ≡ G') + → (α : NatTrans F G) (β : NatTrans G' H) + → NatTrans F H + seqTransP {F} {G} {G'} {H} p α β .N-ob x + -- sequence morphisms with non-judgementally equal (co)domain + = seqP {C = D} {p = Gx≡G'x} (α ⟦ x ⟧) (β ⟦ x ⟧) + where + Gx≡G'x : ∀ {x} → G ⟅ x ⟆ ≡ G' ⟅ x ⟆ + Gx≡G'x {x} i = F-ob (p i) x + seqTransP {F} {G} {G'} {H} p α β .N-hom {x = x} {y} f + -- compose the two commuting squares + -- 1. α's commuting square + -- 2. β's commuting square, but extended to G since β is only G' ≡> H + = compSq {C = D} (α .N-hom f) βSq + where + -- functor equality implies equality of actions on objects and morphisms + Gx≡G'x : G ⟅ x ⟆ ≡ G' ⟅ x ⟆ + Gx≡G'x i = F-ob (p i) x + + Gy≡G'y : G ⟅ y ⟆ ≡ G' ⟅ y ⟆ + Gy≡G'y i = F-ob (p i) y + + Gf≡G'f : PathP (λ i → D [ Gx≡G'x i , Gy≡G'y i ]) (G ⟪ f ⟫) (G' ⟪ f ⟫) + Gf≡G'f i = p i ⟪ f ⟫ + + -- components of β extended out to Gx and Gy respectively + βx' = subst (λ a → D [ a , H ⟅ x ⟆ ]) (sym Gx≡G'x) (β ⟦ x ⟧) + βy' = subst (λ a → D [ a , H ⟅ y ⟆ ]) (sym Gy≡G'y) (β ⟦ y ⟧) + + -- extensions are equal to originals + βy'≡βy : PathP (λ i → D [ Gy≡G'y i , H ⟅ y ⟆ ]) βy' (β ⟦ y ⟧) + βy'≡βy = symP (toPathP {A = λ i → D [ Gy≡G'y (~ i) , H ⟅ y ⟆ ]} refl) + + βx≡βx' : PathP (λ i → D [ Gx≡G'x (~ i) , H ⟅ x ⟆ ]) (β ⟦ x ⟧) βx' + βx≡βx' = toPathP refl + + -- left wall of square + left : PathP (λ i → D [ Gx≡G'x i , H ⟅ y ⟆ ]) (G ⟪ f ⟫ ⋆⟨ D ⟩ βy') (G' ⟪ f ⟫ ⋆⟨ D ⟩ β ⟦ y ⟧) + left i = Gf≡G'f i ⋆⟨ D ⟩ βy'≡βy i + + -- right wall of square + right : PathP (λ i → D [ Gx≡G'x (~ i) , H ⟅ y ⟆ ]) (β ⟦ x ⟧ ⋆⟨ D ⟩ H ⟪ f ⟫) (βx' ⋆⟨ D ⟩ H ⟪ f ⟫) + right i = βx≡βx' i ⋆⟨ D ⟩ refl {x = H ⟪ f ⟫} i + + -- putting it all together + βSq : G ⟪ f ⟫ ⋆⟨ D ⟩ βy' ≡ βx' ⋆⟨ D ⟩ H ⟪ f ⟫ + βSq i = comp (λ k → D [ Gx≡G'x (~ k) , H ⟅ y ⟆ ]) + (λ j → λ { (i = i0) → left (~ j) + ; (i = i1) → right j }) + (β .N-hom f i) + + module _ {F G : Functor C D} {α β : NatTrans F G} where + open Category + open Functor + open NatTrans + + makeNatTransPath : α .N-ob ≡ β .N-ob → α ≡ β + makeNatTransPath p i .N-ob = p i + makeNatTransPath p i .N-hom f = rem i + where + rem : PathP (λ i → (F .F-hom f) ⋆ᴰ (p i _) ≡ (p i _) ⋆ᴰ (G .F-hom f)) + (α .N-hom f) (β .N-hom f) + rem = toPathP (D .isSetHom _ _ _ _) + + + -- `constructor` for path of natural isomorphisms + NatIso≡ : {F G : Functor C D}{f g : NatIso F G} → f .trans .N-ob ≡ g .trans .N-ob → f ≡ g + NatIso≡ {f = f} {g} p i .trans = makeNatTransPath {α = f .trans} {β = g .trans} p i + NatIso≡ {f = f} {g} p i .nIso x = + isProp→PathP (λ i → isPropIsIso (NatIso≡ {f = f} {g} p i .trans .N-ob x)) (f .nIso _) (g .nIso _) i + + + module _ {F F' G G' : Functor C D} {α : NatTrans F G} {β : NatTrans F' G'} where + open Category + open Functor + open NatTrans + makeNatTransPathP : ∀ (p : F ≡ F') (q : G ≡ G') + → PathP (λ i → (x : C .ob) → D [ (p i) .F-ob x , (q i) .F-ob x ]) + (α .N-ob) (β .N-ob) + → PathP (λ i → NatTrans (p i) (q i)) α β + makeNatTransPathP p q P i .N-ob = P i + makeNatTransPathP p q P i .N-hom f = rem i + where + rem : PathP (λ i → ((p i) .F-hom f) ⋆ᴰ (P i _) ≡ (P i _) ⋆ᴰ ((q i) .F-hom f)) + (α .N-hom f) (β .N-hom f) + rem = toPathP (D .isSetHom _ _ _ _) + +module _ {B : Category ℓB ℓB'} {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} where + open NatTrans + -- whiskering + -- αF + _∘ˡ_ : ∀ {G H : Functor C D} (α : NatTrans G H) → (F : Functor B C) + → NatTrans (G ∘F F) (H ∘F F) + (_∘ˡ_ {G} {H} α F) .N-ob x = α ⟦ F ⟅ x ⟆ ⟧ + (_∘ˡ_ {G} {H} α F) .N-hom f = (α .N-hom) _ + + -- Kβ + _∘ʳ_ : ∀ (K : Functor C D) → {G H : Functor B C} (β : NatTrans G H) + → NatTrans (K ∘F G) (K ∘F H) + (_∘ʳ_ K {G} {H} β) .N-ob x = K ⟪ β ⟦ x ⟧ ⟫ + (_∘ʳ_ K {G} {H} β) .N-hom f = preserveCommF {C = C} {D = D} {K} (β .N-hom f) + + whiskerTrans : {F F' : Functor B C} {G G' : Functor C D} (β : NatTrans G G') (α : NatTrans F F') + → NatTrans (G ∘F F) (G' ∘F F') + whiskerTrans {F}{F'}{G}{G'} β α = compTrans (β ∘ˡ F') (G ∘ʳ α) \ No newline at end of file diff --git a/docs/Cubical.Categories.NaturalTransformation.Properties.html b/docs/Cubical.Categories.NaturalTransformation.Properties.html index 5188e64..8ca9c22 100644 --- a/docs/Cubical.Categories.NaturalTransformation.Properties.html +++ b/docs/Cubical.Categories.NaturalTransformation.Properties.html @@ -26,7 +26,7 @@ open NatIso open NatTrans open Category -open Functor +open Functor open Iso module _ {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} where @@ -35,9 +35,9 @@ f ⋆ᴰ g = f ⋆⟨ D ⟩ g -- natural isomorphism is symmetric - symNatIso : ∀ {F G : Functor C D} - → F ≅ᶜ G - → G ≅ᶜ F + symNatIso : ∀ {F G : Functor C D} + → F ≅ᶜ G + → G ≅ᶜ F symNatIso η .trans .N-ob x = η .nIso x .inv symNatIso η .trans .N-hom _ = sqLL η symNatIso η .nIso x .inv = η .trans .N-ob x @@ -49,12 +49,12 @@ -- path helpers module NatTransP where - module _ {F G : Functor C D} where + module _ {F G : Functor C D} where -- same as Sigma version NatTransΣ : Type (ℓ-max (ℓ-max ℓC ℓC') ℓD') - NatTransΣ = Σ[ ob ∈ ((x : C .ob) → D [(F .F-ob x) , (G .F-ob x)]) ] - ({x y : _ } (f : C [ x , y ]) → (F .F-hom f) ⋆ᴰ (ob y) ≡ (ob x) ⋆ᴰ (G .F-hom f)) + NatTransΣ = Σ[ ob ∈ ((x : C .ob) → D [(F .F-ob x) , (G .F-ob x)]) ] + ({x y : _ } (f : C [ x , y ]) → (F .F-hom f) ⋆ᴰ (ob y) ≡ (ob x) ⋆ᴰ (G .F-hom f)) NatTransIsoΣ : Iso (NatTrans F G) NatTransΣ NatTransIsoΣ .fun (natTrans N-ob N-hom) = N-ob , N-hom @@ -70,11 +70,11 @@ {αh : N-hom-Type F G αo} {βh : N-hom-Type F G βo} → (p : αo ≡ βo) - → PathP (λ i → ({x y : C .ob} (f : C [ x , y ]) → (F .F-hom f) ⋆ᴰ (p i y) ≡ (p i x) ⋆ᴰ (G .F-hom f))) αh βh + → PathP (λ i → ({x y : C .ob} (f : C [ x , y ]) → (F .F-hom f) ⋆ᴰ (p i y) ≡ (p i x) ⋆ᴰ (G .F-hom f))) αh βh → natTrans {F = F} {G} αo αh ≡ natTrans βo βh NatTrans-≡-intro p q i = natTrans (p i) (q i) - module _ {F G : Functor C D} {α β : NatTrans F G} where + module _ {F G : Functor C D} {α β : NatTrans F G} where open Iso private αOb = α .N-ob @@ -84,7 +84,7 @@ -- path between natural transformations is the same as a pair of paths (between ob and hom) NTPathIsoPathΣ : Iso (α ≡ β) (Σ[ p ∈ (αOb ≡ βOb) ] - (PathP (λ i → ({x y : _} (f : _) → F ⟪ f ⟫ ⋆ᴰ (p i y) ≡ (p i x) ⋆ᴰ G ⟪ f ⟫)) + (PathP (λ i → ({x y : _} (f : _) → F ⟪ f ⟫ ⋆ᴰ (p i y) ≡ (p i x) ⋆ᴰ G ⟪ f ⟫)) αHom βHom)) NTPathIsoPathΣ .fun p = (λ i → p i .N-ob) , (λ i → p i .N-hom) @@ -99,7 +99,7 @@ module _ where open NatTransP - isSetNatTrans : {F G : Functor C D} → isSet (NatTrans F G) + isSetNatTrans : {F G : Functor C D} → isSet (NatTrans F G) isSetNatTrans = isSetRetract (fun NatTransIsoΣ) (inv NatTransIsoΣ) (leftInv NatTransIsoΣ) (isSetΣSndProp (isSetΠ (λ _ → isSetHom D)) @@ -111,66 +111,66 @@ module _ {C : Category ℓC ℓC'} {D : Category ℓD ℓD'}(isUnivD : isUnivalent D) - {F G : Functor C D} where + {F G : Functor C D} where open isUnivalent isUnivD NatIsoToPath : NatIso F G → F ≡ G NatIsoToPath niso = - Functor≡ (λ x → CatIsoToPath (_ , niso .nIso x)) + Functor≡ (λ x → CatIsoToPath (_ , niso .nIso x)) (λ f → isoToPath-Square isUnivD _ _ _ _ (niso .trans .N-hom f)) - NatIso→Path→NatIso : (niso : NatIso F G) → pathToNatIso (NatIsoToPath niso) ≡ niso - NatIso→Path→NatIso niso = NatIso≡ (λ i x → secEq (univEquiv _ _) (_ , niso .nIso x) i .fst) + NatIso→Path→NatIso : (niso : NatIso F G) → pathToNatIso (NatIsoToPath niso) ≡ niso + NatIso→Path→NatIso niso = NatIso≡ (λ i x → secEq (univEquiv _ _) (_ , niso .nIso x) i .fst) - Path→NatIso→Path : (p : F ≡ G) → NatIsoToPath (pathToNatIso p) ≡ p - Path→NatIso→Path p = FunctorPath≡ (λ i j x → retEq (univEquiv _ _) (λ i → p i .F-ob x) i j) + Path→NatIso→Path : (p : F ≡ G) → NatIsoToPath (pathToNatIso p) ≡ p + Path→NatIso→Path p = FunctorPath≡ (λ i j x → retEq (univEquiv _ _) (λ i → p i .F-ob x) i j) Iso-Path-NatIso : Iso (F ≡ G) (NatIso F G) - Iso-Path-NatIso = iso pathToNatIso NatIsoToPath NatIso→Path→NatIso Path→NatIso→Path + Iso-Path-NatIso = iso pathToNatIso NatIsoToPath NatIso→Path→NatIso Path→NatIso→Path Path≃NatIso : (F ≡ G) ≃ NatIso F G Path≃NatIso = isoToEquiv Iso-Path-NatIso module _ {C : Category ℓC ℓC'} {D : Category ℓD ℓD'} where - seqNatIso : {F G H : Functor C D} → NatIso F G → NatIso G H → NatIso F H - seqNatIso ı ı' .trans = seqTrans (ı .trans) (ı' .trans) + seqNatIso : {F G H : Functor C D} → NatIso F G → NatIso G H → NatIso F H + seqNatIso ı ı' .trans = seqTrans (ı .trans) (ı' .trans) seqNatIso ı ı' .nIso x .inv = ı' .nIso x .inv ⋆⟨ D ⟩ ı .nIso x .inv seqNatIso ı ı' .nIso x .sec = D .⋆Assoc _ _ _ - ∙ cong (_⋆_ D (ı' .nIso x .inv)) + ∙ cong (_⋆_ D (ı' .nIso x .inv)) (sym (D .⋆Assoc _ _ _) - ∙ cong (D ∘ ı' .trans .N-ob x) (ı .nIso x .sec) - ∙ D .⋆IdL (ı' .trans .N-ob x)) - ∙ ı' .nIso x .sec + ∙ cong (D ∘ ı' .trans .N-ob x) (ı .nIso x .sec) + ∙ D .⋆IdL (ı' .trans .N-ob x)) + ∙ ı' .nIso x .sec seqNatIso ı ı' .nIso x .ret = (sym (D .⋆Assoc _ _ _)) - ∙ cong (_∘_ D (ı .nIso x .inv)) + ∙ cong (_∘_ D (ı .nIso x .inv)) (D .⋆Assoc _ _ _ - ∙ cong (D ⋆ ı .trans .N-ob x) (ı' .nIso x .ret) - ∙ D .⋆IdR (ı .trans .N-ob x)) - ∙ ı .nIso x .ret + ∙ cong (D ⋆ ı .trans .N-ob x) (ı' .nIso x .ret) + ∙ D .⋆IdR (ı .trans .N-ob x)) + ∙ ı .nIso x .ret - CAT⋆IdR : {F : Functor C D} → NatIso (Id ∘F F) F - CAT⋆IdR {F} .trans .N-ob = idTrans F .N-ob - CAT⋆IdR {F} .trans .N-hom = idTrans F .N-hom - CAT⋆IdR {F} .nIso = idNatIso F .nIso + CAT⋆IdR : {F : Functor C D} → NatIso (Id ∘F F) F + CAT⋆IdR {F} .trans .N-ob = idTrans F .N-ob + CAT⋆IdR {F} .trans .N-hom = idTrans F .N-hom + CAT⋆IdR {F} .nIso = idNatIso F .nIso module _ {B : Category ℓB ℓB'}{C : Category ℓC ℓC'}{D : Category ℓD ℓD'} where - _∘ʳi_ : ∀ (K : Functor C D) → {G H : Functor B C} (β : NatIso G H) - → NatIso (K ∘F G) (K ∘F H) - _∘ʳi_ K β .trans = K ∘ʳ β .trans - _∘ʳi_ K β .nIso x = preserveIsosF {F = K} (β .trans .N-ob _ , β .nIso x) .snd + _∘ʳi_ : ∀ (K : Functor C D) → {G H : Functor B C} (β : NatIso G H) + → NatIso (K ∘F G) (K ∘F H) + _∘ʳi_ K β .trans = K ∘ʳ β .trans + _∘ʳi_ K β .nIso x = preserveIsosF {F = K} (β .trans .N-ob _ , β .nIso x) .snd - open Functor - _∘ˡi_ : ∀ (K : Functor B C) → {G H : Functor C D} (β : NatIso G H) - → NatIso (G ∘F K) (H ∘F K) - _∘ˡi_ K β .trans = β .trans ∘ˡ K - _∘ˡi_ K β .nIso b = β .nIso (K ⟅ b ⟆) + open Functor + _∘ˡi_ : ∀ (K : Functor B C) → {G H : Functor C D} (β : NatIso G H) + → NatIso (G ∘F K) (H ∘F K) + _∘ˡi_ K β .trans = β .trans ∘ˡ K + _∘ˡi_ K β .nIso b = β .nIso (K ⟅ b ⟆) CAT⋆Assoc : {E : Category ℓE ℓE'} - (F : Functor B C)(G : Functor C D)(H : Functor D E) - → NatIso (H ∘F (G ∘F F)) ((H ∘F G) ∘F F) - CAT⋆Assoc F G H .trans .N-ob = idTrans ((H ∘F G) ∘F F) .N-ob - CAT⋆Assoc F G H .trans .N-hom = idTrans ((H ∘F G) ∘F F) .N-hom - CAT⋆Assoc F G H .nIso = idNatIso ((H ∘F G) ∘F F) .nIso + (F : Functor B C)(G : Functor C D)(H : Functor D E) + → NatIso (H ∘F (G ∘F F)) ((H ∘F G) ∘F F) + CAT⋆Assoc F G H .trans .N-ob = idTrans ((H ∘F G) ∘F F) .N-ob + CAT⋆Assoc F G H .trans .N-hom = idTrans ((H ∘F G) ∘F F) .N-hom + CAT⋆Assoc F G H .nIso = idNatIso ((H ∘F G) ∘F F) .nIso \ No newline at end of file diff --git a/docs/Cubical.Categories.Regular.Base.html b/docs/Cubical.Categories.Regular.Base.html new file mode 100644 index 0000000..880246a --- /dev/null +++ b/docs/Cubical.Categories.Regular.Base.html @@ -0,0 +1,42 @@ + +Cubical.Categories.Regular.Base
{-# OPTIONS --safe #-}
+
+open import Cubical.Foundations.Prelude
+open import Cubical.Categories.Category.Base
+open import Cubical.Categories.Morphism
+open import Cubical.Data.Sigma
+open import Cubical.HITs.PropositionalTruncation
+
+module Cubical.Categories.Regular.Base where
+
+private
+  variable
+    ℓ ℓ' : Level
+
+module _ (C : Category ℓ ℓ') where
+  open Category C
+  private
+    variable
+      x y z w : ob
+
+  isRegularEpic : Hom[ y , z ] → Type (ℓ-max ℓ ℓ')
+  isRegularEpic {y} {z} p =
+    ∃[ x ∈ ob ]
+    ∃[ f ∈ Hom[ x , y ] ]
+    ∃[ g ∈ Hom[ x , y ] ]
+    isCoequalizer x f g where
+      module _ (x : ob) (f g : Hom[ x , y ]) where
+        glues : (z' : ob) → Hom[ y , z' ] → Type ℓ'
+        glues z' p = f ⋆ p ≡ g ⋆ p
+
+        factorizes : Type (ℓ-max ℓ ℓ')
+        factorizes = ∀ {w} (q : Hom[ y , w ]) → (glues w q) → ∃![ ! ∈ Hom[ w , z ] ] (q ⋆ ! ≡ p)
+        
+        isCoequalizer : Type (ℓ-max ℓ ℓ')
+        isCoequalizer = glues z p × factorizes
+
+  isPropIsRegularEpic : ∀ {y} {z} p → isProp (isRegularEpic {y} {z} p)
+  isPropIsRegularEpic p = isPropPropTrunc
+
+      
+
\ No newline at end of file diff --git a/docs/Cubical.Core.Everything.html b/docs/Cubical.Core.Everything.html index a15c917..de4a227 100644 --- a/docs/Cubical.Core.Everything.html +++ b/docs/Cubical.Core.Everything.html @@ -7,7 +7,4 @@ -- Definition of equivalences and Glue types open import Cubical.Core.Glue public - --- Definition of cubical Identity types -open import Cubical.Core.Id \ No newline at end of file diff --git a/docs/Cubical.Core.Glue.html b/docs/Cubical.Core.Glue.html index a0caf2f..3818780 100644 --- a/docs/Cubical.Core.Glue.html +++ b/docs/Cubical.Core.Glue.html @@ -126,9 +126,9 @@ e1 : T1 ≃ A1 e1 = e i1 1=1 - open import Cubical.Foundations.Prelude using (transport) + open import Cubical.Foundations.Prelude using (transport) transportA : A0 → A1 - transportA = transport (λ i → A i) + transportA = transport (λ i → A i) -- copied over from Foundations/Equiv for readability, can't directly import due to cyclic dependency invEq : ∀ {X : Type ℓ'} {ℓ''} {Y : Type ℓ''} (w : X ≃ Y) → Y → X @@ -137,5 +137,5 @@ -- transport in Glue reduces to transport in A + the application of the equivalences in forward and backward -- direction. transp-S : (t0 : T0) → T1 [ i1 ↦ (λ _ → invEq e1 (transportA (equivFun e0 t0))) ] - transp-S t0 = inS (transport (λ i → Glue (A i) (Te i)) t0) + transp-S t0 = inS (transport (λ i → Glue (A i) (Te i)) t0) \ No newline at end of file diff --git a/docs/Cubical.Data.Bool.Base.html b/docs/Cubical.Data.Bool.Base.html index 22af562..bf7effb 100644 --- a/docs/Cubical.Data.Bool.Base.html +++ b/docs/Cubical.Data.Bool.Base.html @@ -45,8 +45,8 @@ _≟_ : Discrete Bool false ≟ false = yes refl -false ≟ true = no λ p → subst (λ b → if b then ⊥ else Bool) p true -true ≟ false = no λ p → subst (λ b → if b then Bool else ⊥) p true +false ≟ true = no λ p → subst (λ b → if b then ⊥ else Bool) p true +true ≟ false = no λ p → subst (λ b → if b then Bool else ⊥) p true true ≟ true = yes refl Dec→Bool : Dec A → Bool @@ -88,13 +88,13 @@ -- Universe lifted booleans Bool* : ∀ {ℓ} → Type ℓ -Bool* = Lift Bool +Bool* = Lift Bool true* : ∀ {ℓ} → Bool* {ℓ} -true* = lift true +true* = lift true false* : ∀ {ℓ} → Bool* {ℓ} -false* = lift false +false* = lift false -- Pointed version Bool*∙ : ∀ {ℓ} → Σ[ X ∈ Type ℓ ] X diff --git a/docs/Cubical.Data.Empty.Base.html b/docs/Cubical.Data.Empty.Base.html index d53e9f3..c75497d 100644 --- a/docs/Cubical.Data.Empty.Base.html +++ b/docs/Cubical.Data.Empty.Base.html @@ -11,7 +11,7 @@ data ⊥ : Type₀ where ⊥* : Type ℓ -⊥* = Lift ⊥ +⊥* = Lift ⊥ rec : {A : Type ℓ} → ⊥ → A rec () diff --git a/docs/Cubical.Data.Empty.Properties.html b/docs/Cubical.Data.Empty.Properties.html index ae0cead..16f50bc 100644 --- a/docs/Cubical.Data.Empty.Properties.html +++ b/docs/Cubical.Data.Empty.Properties.html @@ -8,21 +8,21 @@ open import Cubical.Data.Empty.Base -isProp⊥ : isProp ⊥ +isProp⊥ : isProp ⊥ isProp⊥ () -isProp⊥* : ∀ {ℓ} → isProp {ℓ} ⊥* +isProp⊥* : ∀ {ℓ} → isProp {ℓ} ⊥* isProp⊥* _ () -isContr⊥→A : ∀ {ℓ} {A : Type ℓ} → isContr (⊥ → A) +isContr⊥→A : ∀ {ℓ} {A : Type ℓ} → isContr (⊥ → A) fst isContr⊥→A () snd isContr⊥→A f i () -isContrΠ⊥ : ∀ {ℓ} {A : ⊥ → Type ℓ} → isContr ((x : ⊥) → A x) +isContrΠ⊥ : ∀ {ℓ} {A : ⊥ → Type ℓ} → isContr ((x : ⊥) → A x) fst isContrΠ⊥ () snd isContrΠ⊥ f i () -isContrΠ⊥* : ∀ {ℓ ℓ'} {A : ⊥* {ℓ} → Type ℓ'} → isContr ((x : ⊥*) → A x) +isContrΠ⊥* : ∀ {ℓ ℓ'} {A : ⊥* {ℓ} → Type ℓ'} → isContr ((x : ⊥*) → A x) fst isContrΠ⊥* () snd isContrΠ⊥* f i () diff --git a/docs/Cubical.Data.Fin.Base.html b/docs/Cubical.Data.Fin.Base.html index f65df59..52b7609 100644 --- a/docs/Cubical.Data.Fin.Base.html +++ b/docs/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 ≤ @@ -85,14 +85,14 @@ elim P fz fs {zero} = ⊥.rec ∘ ¬Fin0 elim P fz fs {suc k} fj = case fsplit fj return (λ _ → P fj) of λ - { (inl p) → subst P p fz - ; (inr (fk , p)) → subst P p (fs (elim P fz fs fk)) + { (inl p) → subst P p fz + ; (inr (fk , p)) → subst P p (fs (elim P fz fs fk)) } any? : ∀ {n} {P : Fin n → Type ℓ} → (∀ i → Dec (P i)) → Dec (Σ (Fin n) P) any? {n = zero} {P = _} P? = no (λ (x , _) → ¬Fin0 x) any? {n = suc n} {P = P} P? = - mapDec + mapDec (λ { (inl P0) → fzero , P0 ; (inr (x , Px)) → fsuc x , Px @@ -103,11 +103,11 @@ where helper : Σ (Fin (suc n)) P → P fzero ⊎ Σ (Fin n) λ z → P (fsuc z) helper (x , Px) with fsplit x - ... | inl x≡0 = inl (subst P (sym x≡0) Px) - ... | inr (k , x≡sk) = inr (k , subst P (sym x≡sk) Px) + ... | inl x≡0 = inl (subst P (sym x≡0) Px) + ... | inr (k , x≡sk) = inr (k , subst P (sym x≡sk) Px) 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) + ((fst (snd x)) , (cong (λ y → fst (snd x) + y) (cong suc (sym p)) ∙ snd (snd x))) + , (Σ≡Prop (λ _ → isProp≤) p) \ No newline at end of file diff --git a/docs/Cubical.Data.Fin.Properties.html b/docs/Cubical.Data.Fin.Properties.html index 54d3716..3bc1626 100644 --- a/docs/Cubical.Data.Fin.Properties.html +++ b/docs/Cubical.Data.Fin.Properties.html @@ -39,11 +39,11 @@ A : Type a -- Fin 0 is empty, and thus a proposition. -isPropFin0 : isProp (Fin 0) +isPropFin0 : isProp (Fin 0) isPropFin0 = Empty.rec ∘ ¬Fin0 -- Fin 1 has only one value. -isContrFin1 : isContr (Fin 1) +isContrFin1 : isContr (Fin 1) isContrFin1 = fzero , λ { (zero , _) → toℕ-injective refl @@ -61,25 +61,25 @@ ) -- Regardless of k, Fin k is a set. -isSetFin : ∀{k} → isSet (Fin k) -isSetFin {k} = isSetΣ isSetℕ (λ _ → isProp→isSet isProp≤) +isSetFin : ∀{k} → isSet (Fin k) +isSetFin {k} = isSetΣ isSetℕ (λ _ → isProp→isSet isProp≤) 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) → - subst B x≡y (f x) ≡ f y + subst B x≡y (f x) ≡ f y subst-app B f {x = x} = - J (λ y e → subst B e (f x) ≡ f y) (substRefl {B = B} (f x)) + J (λ y e → subst B e (f x) ≡ f y) (substRefl {B = B} (f x)) -- Computation rules for the eliminator. module _ (P : ∀ {k} → Fin k → Type ℓ) @@ -88,18 +88,18 @@ {k : ℕ} where elim-fzero : Fin.elim P fz fs {k = suc k} fzero ≡ fz elim-fzero = - subst P (toℕ-injective _) fz ≡⟨ cong (λ p → subst P p fz) (isSetFin _ _ _ _) ⟩ - subst P refl fz ≡⟨ substRefl {B = P} fz ⟩ - fz ∎ + subst P (toℕ-injective _) fz ≡⟨ cong (λ p → subst P p fz) (isSetFin _ _ _ _) ⟩ + subst P refl fz ≡⟨ substRefl {B = P} fz ⟩ + fz ∎ elim-fsuc : (fk : Fin k) → Fin.elim P fz fs (fsuc fk) ≡ fs (Fin.elim P fz fs fk) elim-fsuc fk = - subst P (toℕ-injective (λ _ → toℕ (fsuc fk′))) (fs (Fin.elim P fz fs fk′)) - ≡⟨ cong (λ p → subst P p (fs (Fin.elim P fz fs fk′)) ) (isSetFin _ _ _ _) ⟩ - subst P (cong fsuc fk′≡fk) (fs (Fin.elim P fz fs fk′)) - ≡⟨ subst-app _ (λ fj → fs (Fin.elim P fz fs fj)) fk′≡fk ⟩ + subst P (toℕ-injective (λ _ → toℕ (fsuc fk′))) (fs (Fin.elim P fz fs fk′)) + ≡⟨ cong (λ p → subst P p (fs (Fin.elim P fz fs fk′)) ) (isSetFin _ _ _ _) ⟩ + subst P (cong fsuc fk′≡fk) (fs (Fin.elim P fz fs fk′)) + ≡⟨ subst-app _ (λ fj → fs (Fin.elim P fz fs fj)) fk′≡fk ⟩ fs (Fin.elim P fz fs fk) - ∎ + ∎ where fk′ = fst fk , pred-≤-pred (snd (fsuc fk)) fk′≡fk : fk′ ≡ fk @@ -115,7 +115,7 @@ expand≡ : ∀ k m o → expand o k m ≡ o · k + m expand≡ k m zero = refl expand≡ k m (suc o) - = cong (k +_) (expand≡ k m o) ∙ +-assoc k (o · k) m + = cong (k +_) (expand≡ k m o) ∙ +-assoc k (o · k) m -- Expand a pair. This is useful because the whole function is -- injective. @@ -124,7 +124,7 @@ private lemma₀ : ∀{k m n r} → r ≡ n → k + m ≡ n → k ≤ r - lemma₀ {k = k} {m} p q = m , +-comm m k ∙ q ∙ sym p + lemma₀ {k = k} {m} p q = m , +-comm m k ∙ q ∙ sym p expand×Inj : ∀ k → {t1 t2 : Fin (suc k) × ℕ} → expand× t1 ≡ expand× t2 → t1 ≡ t2 expand×Inj k {f1 , zero} {f2 , zero} p i @@ -150,7 +150,7 @@ -- There is at most one canonical finite value congruent to each -- natural. -isPropResidue : ∀ k n → isProp (Residue k n) +isPropResidue : ∀ k n → isProp (Residue k n) isPropResidue k = isEmbedding→hasPropFibers (expand×Emb k) -- A value of a finite type is its own residue. @@ -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) @@ -200,19 +200,19 @@ base n n<k = Fin→Residue (n , n<k) step : ∀ n → Residue k n → Residue k (k + n) - step n = transport (Residue≡ k n) + step n = transport (Residue≡ k n) reduce : ∀ n → Residue k n reduce = +induction k₀ (Residue k) base step reduce≡ - : ∀ n → transport (Residue≡ k n) (reduce n) ≡ reduce (k + n) + : ∀ n → transport (Residue≡ k n) (reduce n) ≡ reduce (k + n) reduce≡ n = sym (+inductionStep k₀ _ base step n) reduceP : ∀ n → PathP (λ i → Residue≡ k n i) (reduce n) (reduce (k + n)) - reduceP n = toPathP (reduce≡ n) + reduceP n = toPathP (reduce≡ n) open Reduce using (reduce; reduce≡) public @@ -222,15 +222,15 @@ private lemma₅ : ∀ k n (R : Residue k n) - → extract R ≡ extract (transport (Residue≡ k n) R) + → extract R ≡ extract (transport (Residue≡ k n) R) lemma₅ k n = sym ∘ cong extract ∘ uaβ (Residue≃ k n) -- The residue of n modulo k is the same as the residue of k + n. extract≡ : ∀ k n → extract (reduce k n) ≡ extract (reduce k (suc k + n)) extract≡ k n - = lemma₅ (suc k) n (reduce k n) ∙ cong extract (Reduce.reduce≡ k n) + = lemma₅ (suc k) n (reduce k n) ∙ cong extract (Reduce.reduce≡ k n) -isContrResidue : ∀{k n} → isContr (Residue (suc k) n) +isContrResidue : ∀{k n} → isContr (Residue (suc k) n) isContrResidue {k} {n} = inhProp→isContr (reduce k n) (isPropResidue (suc k) n) -- the modulo operator on ℕ @@ -245,7 +245,7 @@ moddiv : ∀ n k → (n / k) · k + n % k ≡ n moddiv n zero = refl -moddiv n (suc k) = sym (expand≡ _ _ (n / suc k)) ∙ reduce k n .snd +moddiv n (suc k) = sym (expand≡ _ _ (n / suc k)) ∙ reduce k n .snd n%k≡n[modk] : ∀ n k → Σ[ o ∈ ℕ ] o · k + n % k ≡ n n%k≡n[modk] n k = (n / k) , moddiv n k @@ -254,7 +254,7 @@ n%sk<sk n k = extract (reduce k n) .snd fznotfs : ∀ {m : ℕ} {k : Fin m} → ¬ fzero ≡ fsuc k -fznotfs {m} p = subst F p tt +fznotfs {m} p = subst F p tt where F : Fin (suc m) → Type₀ F (zero , _) = Unit @@ -266,28 +266,28 @@ punchOut : ∀ {m} {i j : Fin (suc m)} → (¬ i ≡ j) → Fin m punchOut {_} {i} {j} p with fsplit i | fsplit j punchOut {_} {i} {j} p | inl prfi | inl prfj = - Empty.elim (p (i ≡⟨ sym prfi ⟩ fzero ≡⟨ prfj ⟩ j ∎)) + Empty.elim (p (i ≡⟨ sym prfi ⟩ fzero ≡⟨ prfj ⟩ j ∎)) punchOut {_} {i} {j} p | inl prfi | inr (kj , prfj) = kj punchOut {zero} {i} {j} p | inr (ki , prfi) | inl prfj = Empty.elim (p ( - i ≡⟨ sym (isContrFin1 .snd i) ⟩ - c ≡⟨ isContrFin1 .snd j ⟩ - j ∎ + i ≡⟨ sym (isContrFin1 .snd i) ⟩ + c ≡⟨ isContrFin1 .snd j ⟩ + j ∎ )) where c = isContrFin1 .fst punchOut {suc _} {i} {j} p | inr (ki , prfi) | inl prfj = fzero punchOut {zero} {i} {j} p | inr (ki , prfi) | inr (kj , prfj) = Empty.elim ((p ( - i ≡⟨ sym (isContrFin1 .snd i) ⟩ - c ≡⟨ isContrFin1 .snd j ⟩ - j ∎) + i ≡⟨ sym (isContrFin1 .snd i) ⟩ + c ≡⟨ isContrFin1 .snd j ⟩ + j ∎) )) where c = isContrFin1 .fst punchOut {suc _} {i} {j} p | inr (ki , prfi) | inr (kj , prfj) = fsuc (punchOut {i = ki} {j = kj} - (λ q → p (i ≡⟨ sym prfi ⟩ fsuc ki ≡⟨ cong fsuc q ⟩ fsuc kj ≡⟨ prfj ⟩ j ∎)) + (λ q → p (i ≡⟨ sym prfi ⟩ fsuc ki ≡⟨ cong fsuc q ⟩ fsuc kj ≡⟨ prfj ⟩ j ∎)) ) punchOut-inj @@ -295,29 +295,29 @@ → punchOut i≢j ≡ punchOut i≢k → j ≡ k punchOut-inj {_} {i} {j} {k} i≢j i≢k p with fsplit i | fsplit j | fsplit k punchOut-inj {zero} {i} {j} {k} i≢j i≢k p | _ | _ | _ = - Empty.elim (i≢j (i ≡⟨ sym (isContrFin1 .snd i) ⟩ c ≡⟨ isContrFin1 .snd j ⟩ j ∎)) + Empty.elim (i≢j (i ≡⟨ sym (isContrFin1 .snd i) ⟩ c ≡⟨ isContrFin1 .snd j ⟩ j ∎)) where c = isContrFin1 .fst punchOut-inj {suc _} {i} {j} {k} i≢j i≢k p | inl prfi | inl prfj | _ = - Empty.elim (i≢j (i ≡⟨ sym prfi ⟩ fzero ≡⟨ prfj ⟩ j ∎)) + Empty.elim (i≢j (i ≡⟨ sym prfi ⟩ fzero ≡⟨ prfj ⟩ j ∎)) punchOut-inj {suc _} {i} {j} {k} i≢j i≢k p | inl prfi | _ | inl prfk = - Empty.elim (i≢k (i ≡⟨ sym prfi ⟩ fzero ≡⟨ prfk ⟩ k ∎)) + Empty.elim (i≢k (i ≡⟨ sym prfi ⟩ fzero ≡⟨ prfk ⟩ k ∎)) punchOut-inj {suc _} {i} {j} {k} i≢j i≢k p | inl prfi | inr (kj , prfj) | inr (kk , prfk) = - j ≡⟨ sym prfj ⟩ - fsuc kj ≡⟨ cong fsuc p ⟩ - fsuc kk ≡⟨ prfk ⟩ - k ∎ + j ≡⟨ sym prfj ⟩ + fsuc kj ≡⟨ cong fsuc p ⟩ + fsuc kk ≡⟨ prfk ⟩ + k ∎ punchOut-inj {suc _} {i} {j} {k} i≢j i≢k p | inr (ki , prfi) | inl prfj | inl prfk = - j ≡⟨ sym prfj ⟩ - fzero ≡⟨ prfk ⟩ - k ∎ + j ≡⟨ sym prfj ⟩ + fzero ≡⟨ prfk ⟩ + k ∎ punchOut-inj {suc _} {i} {j} {k} i≢j i≢k p | inr (ki , prfi) | inr (kj , prfj) | inr (kk , prfk) = - j ≡⟨ sym prfj ⟩ - fsuc kj ≡⟨ cong fsuc lemma4 ⟩ - fsuc kk ≡⟨ prfk ⟩ - k ∎ + j ≡⟨ sym prfj ⟩ + fsuc kj ≡⟨ cong fsuc lemma4 ⟩ + fsuc kk ≡⟨ prfk ⟩ + k ∎ where - lemma1 = λ q → i≢j (i ≡⟨ sym prfi ⟩ fsuc ki ≡⟨ cong fsuc q ⟩ fsuc kj ≡⟨ prfj ⟩ j ∎) - lemma2 = λ q → i≢k (i ≡⟨ sym prfi ⟩ fsuc ki ≡⟨ cong fsuc q ⟩ fsuc kk ≡⟨ prfk ⟩ k ∎) + lemma1 = λ q → i≢j (i ≡⟨ sym prfi ⟩ fsuc ki ≡⟨ cong fsuc q ⟩ fsuc kj ≡⟨ prfj ⟩ j ∎) + lemma2 = λ q → i≢k (i ≡⟨ sym prfi ⟩ fsuc ki ≡⟨ cong fsuc q ⟩ fsuc kk ≡⟨ prfk ⟩ k ∎) lemma3 = fsuc-inj p lemma4 = punchOut-inj lemma1 lemma2 lemma3 punchOut-inj {suc m} {i} {j} {k} i≢j i≢k p | inr (ki , prfi) | inl prfj | inr (kk , prfk) = @@ -366,10 +366,10 @@ → (f : Fin n → Fin m) → Σ[ i ∈ Fin n ] Σ[ j ∈ Fin n ] (¬ i ≡ j) × (f i ≡ f j) pigeonhole {m} {n} (zero , sm≡n) f = - transport transport-prf (pigeonhole-special f′) + transport transport-prf (pigeonhole-special f′) where f′ : Fin (suc m) → Fin m - f′ = subst (λ h → Fin h → Fin m) (sym sm≡n) f + f′ = subst (λ h → Fin h → Fin m) (sym sm≡n) f f′≡f : PathP (λ i → Fin (sm≡n i) → Fin m) f′ f f′≡f i = transport-fillerExt (cong (λ h → Fin h → Fin m) (sym sm≡n)) (~ i) f @@ -385,22 +385,22 @@ 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 n≡sn′ : n ≡ suc n′ n≡sn′ = - n ≡⟨ sym prf ⟩ - suc (k + suc m) ≡⟨ refl ⟩ - suc n′ ∎ + n ≡⟨ sym prf ⟩ + suc (k + suc m) ≡⟨ refl ⟩ + suc n′ ∎ m<n′ : m < n′ - m<n′ = k , injSuc (suc (k + suc m) ≡⟨ prf ⟩ n ≡⟨ n≡sn′ ⟩ suc n′ ∎) + m<n′ = k , injSuc (suc (k + suc m) ≡⟨ prf ⟩ n ≡⟨ n≡sn′ ⟩ suc n′ ∎) f′ : Fin (suc n′) → Fin m - f′ = subst (λ h → Fin h → Fin m) n≡sn′ f + f′ = subst (λ h → Fin h → Fin m) n≡sn′ f f′≡f : PathP (λ i → Fin (n≡sn′ (~ i)) → Fin m) f′ f f′≡f i = transport-fillerExt (cong (λ h → Fin h → Fin m) n≡sn′) (~ i) f @@ -415,23 +415,23 @@ Fin-inj′ : {n m : ℕ} → n < m → ¬ Fin m ≡ Fin n Fin-inj′ n<m p = let - i , j , i≢j , q = pigeonhole n<m (transport p) + i , j , i≢j , q = pigeonhole n<m (transport p) in i≢j ( - i ≡⟨ refl ⟩ - fst (pigeonhole n<m (transport p)) ≡⟨ transport-p-inj {p = p} q ⟩ - fst (snd (pigeonhole n<m (transport p))) ≡⟨ refl ⟩ - j ∎ + i ≡⟨ refl ⟩ + fst (pigeonhole n<m (transport p)) ≡⟨ transport-p-inj {p = p} q ⟩ + fst (snd (pigeonhole n<m (transport p))) ≡⟨ refl ⟩ + j ∎ ) where transport-p-inj : ∀ {A B : Type ℓ} {x y : A} {p : A ≡ B} - → transport p x ≡ transport p y + → transport p x ≡ transport p y → x ≡ y transport-p-inj {x = x} {y = y} {p = p} q = - x ≡⟨ sym (transport⁻Transport p x) ⟩ - transport (sym p) (transport p x) ≡⟨ cong (transport (sym p)) q ⟩ - transport (sym p) (transport p y) ≡⟨ transport⁻Transport p y ⟩ - y ∎ + x ≡⟨ sym (transport⁻Transport p x) ⟩ + transport (sym p) (transport p x) ≡⟨ cong (transport (sym p)) q ⟩ + transport (sym p) (transport p y) ≡⟨ transport⁻Transport p y ⟩ + y ∎ Fin-inj : (n m : ℕ) → Fin n ≡ Fin m → n ≡ m Fin-inj n m p with n ≟ m @@ -445,22 +445,22 @@ o = d / suc k resn·k : Residue (suc k) (n · suc k) resn·k = ((r , n%sk<sk d k) , (o + m)) , reason where - reason = expand× ((r , n%sk<sk d k) , o + m) ≡⟨ expand≡ (suc k) r (o + m) ⟩ - (o + m) · suc k + r ≡[ i ]⟨ +-comm (·-distribʳ o m (suc k) (~ i)) r i ⟩ - r + (o · suc k + m · suc k) ≡⟨ +-assoc r (o · suc k) (m · suc k) ⟩ - (r + o · suc k) + m · suc k ≡⟨ cong (_+ m · suc k) (+-comm r (o · suc k) ∙ moddiv d (suc k)) ⟩ - d + m · suc k ≡⟨ p ⟩ - n · suc k ∎ + reason = expand× ((r , n%sk<sk d k) , o + m) ≡⟨ expand≡ (suc k) r (o + m) ⟩ + (o + m) · suc k + r ≡[ i ]⟨ +-comm (·-distribʳ o m (suc k) (~ i)) r i ⟩ + r + (o · suc k + m · suc k) ≡⟨ +-assoc r (o · suc k) (m · suc k) ⟩ + (r + o · suc k) + m · suc k ≡⟨ cong (_+ m · suc k) (+-comm r (o · suc k) ∙ moddiv d (suc k)) ⟩ + d + m · suc k ≡⟨ p ⟩ + n · suc k ∎ - residuek·n : ∀ k n → (r : Residue (suc k) (n · suc k)) → ((fzero , n) , expand≡ (suc k) 0 n ∙ +-zero _) ≡ r - residuek·n _ _ = isContr→isProp isContrResidue _ + residuek·n : ∀ k n → (r : Residue (suc k) (n · suc k)) → ((fzero , n) , expand≡ (suc k) 0 n ∙ +-zero _) ≡ r + residuek·n _ _ = isContr→isProp isContrResidue _ r≡0 : r ≡ 0 r≡0 = cong (toℕ ∘ extract) (sym (residuek·n k n resn·k)) d≡o·sk : d ≡ o · suc k - d≡o·sk = sym (moddiv d (suc k)) ∙∙ cong (o · suc k +_) r≡0 ∙∙ +-zero _ + d≡o·sk = sym (moddiv d (suc k)) ∙∙ cong (o · suc k +_) r≡0 ∙∙ +-zero _ goal : (o + m) · suc k ≡ n · suc k - goal = sym (·-distribʳ o m (suc k)) ∙∙ cong (_+ m · suc k) (sym d≡o·sk) ∙∙ p + goal = sym (·-distribʳ o m (suc k)) ∙∙ cong (_+ m · suc k) (sym d≡o·sk) ∙∙ p <-·sk-cancel : ∀ {m} {k} {n} → m · suc k < n · suc k → m < n <-·sk-cancel {m} {k} {n} p = goal where @@ -469,14 +469,14 @@ goal : m < n goal = case <-split (suc-≤-suc ≤-helper) of λ { (inl g) → g - ; (inr e) → Empty.rec (¬m<m (subst (λ m → m · suc k < n · suc k) e p)) + ; (inr e) → Empty.rec (¬m<m (subst (λ m → m · suc k < n · suc k) e p)) } 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 + intro (nn , mm) = nm , subst (λ nm₁ → nm₁ < suc n · m) (sym (expand≡ _ (toℕ nn) (toℕ mm))) nm<n·m where nm : ℕ nm = expand× (nn , toℕ mm) nm<n·m : toℕ mm · suc n + toℕ nn < suc n · m @@ -484,8 +484,8 @@ toℕ mm · suc n + toℕ nn <≤⟨ <-k+ (snd nn) ⟩ toℕ mm · suc n + suc n ≡≤⟨ +-comm _ (suc n) ⟩ suc (toℕ mm) · suc n ≤≡⟨ ≤-·k (snd mm) ⟩ - m · suc n ≡⟨ ·-comm _ (suc n) ⟩ - suc n · m ∎ where open <-Reasoning + m · suc n ≡⟨ ·-comm _ (suc n) ⟩ + suc n · m ∎ where open <-Reasoning intro-injective : ∀ {o} {p} → intro o ≡ intro p → o ≡ p intro-injective {o} {p} io≡ip = λ i → io′≡ip′ i .fst , toℕ-injective {fj = snd o} {fk = snd p} (cong snd io′≡ip′) i where @@ -505,27 +505,27 @@ nn<n = n%sk<sk (toℕ nm) _ nmsnd : mm · suc n + nn < suc n · m - nmsnd = subst (λ l → l < suc n · m) (sym nmmoddiv) (snd nm) + nmsnd = subst (λ l → l < suc n · m) (sym nmmoddiv) (snd nm) mm·sn<m·sn : mm · suc n < m · suc n mm·sn<m·sn = mm · suc n ≤<⟨ nn , +-comm nn (mm · suc n) ⟩ mm · suc n + nn <≡⟨ nmsnd ⟩ - suc n · m ≡⟨ ·-comm (suc n) m ⟩ - m · suc n ∎ where open <-Reasoning + suc n · m ≡⟨ ·-comm (suc n) m ⟩ + m · suc n ∎ where open <-Reasoning 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 -- =========================== o<m→o<m+n : (m n o : ℕ) → o < m → o < (m + n) -o<m→o<m+n m n o (k , p) = (n + k) , (n + k + suc o ≡⟨ sym (+-assoc n k _) ⟩ - n + (k + suc o) ≡⟨ cong (λ - → n + -) p ⟩ - n + m ≡⟨ +-comm n m ⟩ - m + n ∎) +o<m→o<m+n m n o (k , p) = (n + k) , (n + k + suc o ≡⟨ sym (+-assoc n k _) ⟩ + n + (k + suc o) ≡⟨ cong (λ - → n + -) p ⟩ + n + m ≡⟨ +-comm n m ⟩ + m + n ∎) ∸-<-lemma : (m n o : ℕ) → o < m + n → m ≤ o → o ∸ m < n ∸-<-lemma zero n o o<m+n m<o = o<m+n @@ -538,7 +538,7 @@ _≤?_ : (m n : ℕ) → (m < n) ⊎ (n ≤ m) _≤?_ m n with m ≟ n _≤?_ m n | lt m<n = inl m<n -_≤?_ m n | eq m=n = inr (subst (λ - → - ≤ m) m=n ≤-refl) +_≤?_ m n | eq m=n = inr (subst (λ - → - ≤ m) m=n ≤-refl) _≤?_ m n | gt n<m = inr (<-weaken n<m) ¬-<-and-≥ : {m n : ℕ} → m < n → ¬ n ≤ m @@ -548,19 +548,19 @@ m+n∸n=m : (n m : ℕ) → (m + n) ∸ n ≡ m m+n∸n=m zero k = +-zero k -m+n∸n=m (suc m) k = (k + suc m) ∸ suc m ≡⟨ cong (λ - → - ∸ suc m) (+-suc k m) ⟩ - suc (k + m) ∸ (suc m) ≡⟨ refl ⟩ - (k + m) ∸ m ≡⟨ m+n∸n=m m k ⟩ - k ∎ +m+n∸n=m (suc m) k = (k + suc m) ∸ suc m ≡⟨ cong (λ - → - ∸ suc m) (+-suc k m) ⟩ + suc (k + m) ∸ (suc m) ≡⟨ refl ⟩ + (k + m) ∸ m ≡⟨ m+n∸n=m m k ⟩ + k ∎ ∸-lemma : {m n : ℕ} → m ≤ n → m + (n ∸ m) ≡ n ∸-lemma {zero} {k} _ = refl {x = k} ∸-lemma {suc m} {zero} m≤k = Empty.rec (¬-<-and-≥ (suc-≤-suc zero-≤) m≤k) ∸-lemma {suc m} {suc k} m≤k = - suc m + (suc k ∸ suc m) ≡⟨ refl ⟩ - suc (m + (suc k ∸ suc m)) ≡⟨ refl ⟩ - suc (m + (k ∸ m)) ≡⟨ cong suc (∸-lemma (pred-≤-pred m≤k)) ⟩ - suc k ∎ + suc m + (suc k ∸ suc m) ≡⟨ refl ⟩ + suc (m + (suc k ∸ suc m)) ≡⟨ refl ⟩ + suc (m + (k ∸ m)) ≡⟨ cong suc (∸-lemma (pred-≤-pred m≤k)) ⟩ + suc k ∎ Fin+≅Fin⊎Fin : (m n : ℕ) → Iso (Fin (m + n)) (Fin m ⊎ Fin n) Iso.fun (Fin+≅Fin⊎Fin m n) = f @@ -578,20 +578,20 @@ 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) + rem = subst (λ - → - ∸ m ≡ k) (+-comm k m) (m+n∸n=m m k) Iso.leftInv (Fin+≅Fin⊎Fin m n) = ret-f-g 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) @@ -599,7 +599,7 @@ -- Equivalence between FinData and Fin sucFin : {N : ℕ} → Fin N → Fin (suc N) -sucFin (k , n , p) = suc k , n , (+-suc _ _ ∙ cong suc p) +sucFin (k , n , p) = suc k , n , (+-suc _ _ ∙ cong suc p) FinData→Fin : (N : ℕ) → FinData N → Fin N FinData→Fin zero () @@ -607,23 +607,23 @@ FinData→Fin (suc N) (suc k) = sucFin (FinData→Fin N k) Fin→FinData : (N : ℕ) → Fin N → FinData N -Fin→FinData zero (k , n , p) = Empty.rec (snotz (sym (+-suc n k) ∙ p)) +Fin→FinData zero (k , n , p) = Empty.rec (snotz (sym (+-suc n k) ∙ p)) Fin→FinData (suc N) (0 , n , p) = zero Fin→FinData (suc N) ((suc k) , n , p) = suc (Fin→FinData N (k , n , p')) where p' : n + suc k ≡ N - p' = injSuc (sym (+-suc n (suc k)) ∙ p) + p' = injSuc (sym (+-suc n (suc k)) ∙ p) secFin : (n : ℕ) → section (FinData→Fin n) (Fin→FinData n) -secFin 0 (k , n , p) = Empty.rec (snotz (sym (+-suc n k) ∙ p)) +secFin 0 (k , n , p) = Empty.rec (snotz (sym (+-suc n k) ∙ p)) secFin (suc N) (0 , n , p) = Fin-fst-≡ refl secFin (suc N) (suc k , n , p) = Fin-fst-≡ (cong suc (cong fst (secFin N (k , n , p')))) where p' : n + suc k ≡ N - p' = injSuc (sym (+-suc n (suc k)) ∙ p) + p' = injSuc (sym (+-suc n (suc k)) ∙ p) retFin : (n : ℕ) → retract (FinData→Fin n) (Fin→FinData n) retFin 0 () retFin (suc N) zero = refl -retFin (suc N) (suc k) = cong FinData.suc (cong (Fin→FinData N) (Fin-fst-≡ refl) ∙ retFin N k) +retFin (suc N) (suc k) = cong FinData.suc (cong (Fin→FinData N) (Fin-fst-≡ refl) ∙ retFin N k) FinDataIsoFin : (N : ℕ) → Iso (FinData N) (Fin N) Iso.fun (FinDataIsoFin N) = FinData→Fin N @@ -646,7 +646,7 @@ -- propositional truncation of Fin Dec∥Fin∥ : (n : ℕ) → Dec ∥ Fin n ∥₁ -Dec∥Fin∥ n = Dec∥∥ (DecFin n) +Dec∥Fin∥ n = Dec∥∥ (DecFin n) -- some properties about cardinality @@ -669,15 +669,15 @@ hasNonEqualTerm→Fin>1 : (n : ℕ) → (i j : Fin n) → ¬ i ≡ j → 1 < n hasNonEqualTerm→Fin>1 0 i _ _ = Empty.rec (¬Fin0 i) -hasNonEqualTerm→Fin>1 1 i j p = Empty.rec (p (isContr→isProp isContrFin1 i j)) +hasNonEqualTerm→Fin>1 1 i j p = Empty.rec (p (isContr→isProp isContrFin1 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 : (n : ℕ) → n ≤ 1 → isProp (Fin n) Fin≤1→isProp 0 _ = isPropFin0 -Fin≤1→isProp 1 _ = isContr→isProp isContrFin1 +Fin≤1→isProp 1 _ = isContr→isProp isContrFin1 Fin≤1→isProp (suc (suc n)) p = Empty.rec (¬-<-zero (pred-≤-pred p)) -isProp→Fin≤1 : (n : ℕ) → isProp (Fin n) → n ≤ 1 +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 = Empty.rec (fzero≠fone (p fzero fone)) diff --git a/docs/Cubical.Data.FinData.Properties.html b/docs/Cubical.Data.FinData.Properties.html index 7bea95e..39c2576 100644 --- a/docs/Cubical.Data.FinData.Properties.html +++ b/docs/Cubical.Data.FinData.Properties.html @@ -35,17 +35,17 @@ toℕ<n : ∀ {n} (i : Fin n) → toℕ i < n toℕ<n {n = ℕsuc n} zero = n , +-comm n 1 -toℕ<n {n = ℕsuc n} (suc i) = toℕ<n i .fst , +-suc _ _ ∙ cong ℕsuc (toℕ<n i .snd) +toℕ<n {n = ℕsuc n} (suc i) = toℕ<n i .fst , +-suc _ _ ∙ cong ℕsuc (toℕ<n i .snd) znots : ∀{k} {m : Fin k} → ¬ (zero ≡ (suc m)) -znots {k} {m} x = subst (Fin.rec (Fin k) ⊥) x m +znots {k} {m} x = subst (Fin.rec (Fin k) ⊥) x m znotsP : ∀ {k0 k1 : ℕ} {k : k0 ≡ k1} {m1 : Fin k1} → ¬ PathP (λ i → Fin (ℕsuc (k i))) zero (suc m1) znotsP p = ℕznots (congP (λ i → toℕ) p) snotz : ∀{k} {m : Fin k} → ¬ ((suc m) ≡ zero) -snotz {k} {m} x = subst (Fin.rec ⊥ (Fin k)) x m +snotz {k} {m} x = subst (Fin.rec ⊥ (Fin k)) x m snotzP : ∀ {k0 k1 : ℕ} {k : k0 ≡ k1} {m0 : Fin k0} → ¬ PathP (λ i → Fin (ℕsuc (k i))) (suc m0) zero @@ -75,10 +75,10 @@ inj-cong : {n : ℕ} → {k l : Fin n} → (p : toℕ k ≡ toℕ l) → cong toℕ (inj-toℕ p) ≡ p inj-cong p = isSetℕ _ _ _ _ -isPropFin0 : isProp (Fin 0) +isPropFin0 : isProp (Fin 0) isPropFin0 = ⊥.rec ∘ ¬Fin0 -isContrFin1 : isContr (Fin 1) +isContrFin1 : isContr (Fin 1) isContrFin1 .fst = zero isContrFin1 .snd zero = refl @@ -90,15 +90,15 @@ → PathP (λ i → Fin (ℕsuc (pn i))) (suc p0) (suc p1) → PathP (λ i → Fin (pn i)) p0 p1 injSucFinP {one} {one} {pn} {zero} {zero} sucp = - transport (λ j → PathP (λ i → Fin (eqn j i)) zero zero) refl + transport (λ j → PathP (λ i → Fin (eqn j i)) zero zero) refl where eqn : refl ≡ pn eqn = isSetℕ one one refl pn injSucFinP {one} {ℕsuc (ℕsuc n1)} {pn} {p0} {p1} sucp = ⊥.rec (ℕznots (injSuc pn)) injSucFinP {ℕsuc (ℕsuc n0)} {one} {pn} {p0} {p1} sucp = ⊥.rec (ℕsnotz (injSuc pn)) injSucFinP {ℕsuc (ℕsuc n0)} {ℕsuc (ℕsuc n1)} {pn} {p0} {p1} sucp = - transport (λ j → PathP (λ i → Fin (eqn j i)) p0 p1) ( + transport (λ j → PathP (λ i → Fin (eqn j i)) p0 p1) ( congP (λ i → predFin) ( - transport (λ j → PathP (λ i → Fin (ℕsuc (eqn (~ j) i))) (suc p0) (suc p1)) sucp + transport (λ j → PathP (λ i → Fin (ℕsuc (eqn (~ j) i))) (suc p0) (suc p1)) sucp ) ) where pn' : 2 + n0 ≡ 2 + n1 @@ -114,8 +114,8 @@ ... | yes p = yes (cong suc p) ... | no ¬p = no (λ q → ¬p (injSucFin q)) -isSetFin : ∀{k} → isSet (Fin k) -isSetFin = Discrete→isSet discreteFin +isSetFin : ∀{k} → isSet (Fin k) +isSetFin = Discrete→isSet discreteFin isWeaken? : ∀ {n} (p : Fin (ℕsuc n)) → Dec (Σ[ q ∈ Fin n ] p ≡ weakenFin q) isWeaken? {ℕzero} zero = no λ (q , eqn) → case q of λ () @@ -160,10 +160,10 @@ toFin {n = ℕsuc n} m (ℕsuc k , p) = weakenFin (toFin m (k , cong predℕ p)) toFin0≡0 : {n : ℕ} (p : 0 < ℕsuc n) → toFin 0 p ≡ zero -toFin0≡0 (ℕzero , p) = subst (λ x → fromℕ x ≡ zero) (cong predℕ p) refl -toFin0≡0 {ℕzero} (ℕsuc k , p) = ⊥.rec (ℕsnotz (+-comm 1 k ∙ (cong predℕ p))) +toFin0≡0 (ℕzero , p) = subst (λ x → fromℕ x ≡ zero) (cong predℕ p) refl +toFin0≡0 {ℕzero} (ℕsuc k , p) = ⊥.rec (ℕsnotz (+-comm 1 k ∙ (cong predℕ p))) toFin0≡0 {ℕsuc n} (ℕsuc k , p) = - subst (λ x → weakenFin x ≡ zero) (sym (toFin0≡0 (k , cong predℕ p))) refl + subst (λ x → weakenFin x ≡ zero) (sym (toFin0≡0 (k , cong predℕ p))) refl genδ-FinVec : (n k : ℕ) → (a b : A) → FinVec A n genδ-FinVec (ℕsuc n) ℕzero a b zero = a @@ -196,10 +196,10 @@ toℕ∘enum {n = ℕsuc n} (ℕsuc m) p i = ℕsuc (toℕ∘enum m (pred-≤-pred p) i) enumExt : {m m' : ℕ}(p : m < n)(p' : m' < n) → m ≡ m' → enum m p ≡ enum m' p' -enumExt p p' q i = enum (q i) (isProp→PathP (λ i → isProp≤ {m = ℕsuc (q i)}) p p' i) +enumExt p p' q i = enum (q i) (isProp→PathP (λ i → isProp≤ {m = ℕsuc (q i)}) p p' i) enumInj : (p : m < k) (q : n < k) → enum m p ≡ enum n q → m ≡ n -enumInj p q path = sym (toℕ∘enum _ p) ∙ cong toℕ path ∙ toℕ∘enum _ q +enumInj p q path = sym (toℕ∘enum _ p) ∙ cong toℕ path ∙ toℕ∘enum _ q enumIndStep : (P : Fin n → Type ℓ) @@ -210,7 +210,7 @@ enumIndStep P k p f x m q q' = case (≤-split q') return (λ _ → P (enum m q)) of λ { (inl r') → f m q (pred-≤-pred r') - ; (inr r') → subst P (enumExt p q (sym r')) x } + ; (inr r') → subst P (enumExt p q (sym r')) x } enumElim : (P : Fin n → Type ℓ) @@ -218,8 +218,8 @@ → ((m : ℕ)(q : m < n)(q' : m ≤ k) → P (enum m q)) → (i : Fin n) → P i enumElim P k p h f i = - subst P (enum∘toℕ i (toℕ<n i)) (f (toℕ i) (toℕ<n i) - (pred-≤-pred (subst (λ a → toℕ i < a) (sym h) (toℕ<n i)))) + subst P (enum∘toℕ i (toℕ<n i)) (f (toℕ i) (toℕ<n i) + (pred-≤-pred (subst (λ a → toℕ i < a) (sym h) (toℕ<n i)))) ++FinAssoc : {n m k : ℕ} (U : FinVec A n) (V : FinVec A m) (W : FinVec A k) @@ -230,7 +230,7 @@ ++FinRid : {n : ℕ} (U : FinVec A n) (V : FinVec A 0) → PathP (λ i → FinVec A (+-zero n i)) (U ++Fin V) U -++FinRid {n = ℕzero} U V = funExt λ i → ⊥.rec (¬Fin0 i) +++FinRid {n = ℕzero} U V = funExt λ i → ⊥.rec (¬Fin0 i) ++FinRid {n = ℕsuc n} U V i zero = U zero ++FinRid {n = ℕsuc n} U V i (suc ind) = ++FinRid (U ∘ suc) V i ind @@ -254,7 +254,7 @@ +Shuffle m n i with <Dec (toℕ i) m ... | yes i<m = toFin (n + (toℕ i)) (<-k+ i<m) ... | no ¬i<m = toFin (toℕ i ∸ m) - (subst (λ x → toℕ i ∸ m < x) (+-comm m n) (≤<-trans (∸-≤ (toℕ i) m) (toℕ<n i))) + (subst (λ x → toℕ i ∸ m < x) (+-comm m n) (≤<-trans (∸-≤ (toℕ i) m) (toℕ<n i))) finSucMaybeIso : Iso (Fin (ℕ.suc n)) (Maybe (Fin n)) @@ -294,14 +294,14 @@ ret : (n m : ℕ) (i : Fin n ⊎ Fin m) → inv n m (fun n m i) ≡ i ret ℕzero m (inr i) = refl ret (ℕsuc n) m (inl zero) = refl - ret (ℕsuc n) m (inl (suc i)) = subst (λ x → invSucAux n m x ≡ inl (suc i)) + ret (ℕsuc n) m (inl (suc i)) = subst (λ x → invSucAux n m x ≡ inl (suc i)) (sym (ret n m (inl i))) refl - ret (ℕsuc n) m (inr i) = subst (λ x → invSucAux n m x ≡ inr i) (sym (ret n m (inr i))) refl + ret (ℕsuc n) m (inr i) = subst (λ x → invSucAux n m x ≡ inr i) (sym (ret n m (inr i))) refl sec : (n m : ℕ) (i : Fin (n + m)) → fun n m (inv n m i) ≡ i sec ℕzero m i = refl sec (ℕsuc n) m zero = refl - sec (ℕsuc n) m (suc i) = helperPath (inv n m i) ∙ cong suc (sec n m i) + sec (ℕsuc n) m (suc i) = helperPath (inv n m i) ∙ cong suc (sec n m i) where helperPath : ∀ x → fun (ℕsuc n) m (invSucAux n m x) ≡ suc (fun n m x) helperPath (inl _) = refl @@ -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/docs/Cubical.Data.List.Properties.html b/docs/Cubical.Data.List.Properties.html index 5d2f50f..00323e6 100644 --- a/docs/Cubical.Data.List.Properties.html +++ b/docs/Cubical.Data.List.Properties.html @@ -33,19 +33,19 @@ rev-++ [] ys = sym (++-unit-r (rev ys)) rev-++ (x ∷ xs) ys = cong (λ zs → zs ++ [ x ]) (rev-++ xs ys) - ∙ ++-assoc (rev ys) (rev xs) [ x ] + ∙ ++-assoc (rev ys) (rev xs) [ x ] rev-rev : (xs : List A) → rev (rev xs) ≡ xs rev-rev [] = refl - rev-rev (x ∷ xs) = rev-snoc (rev xs) x ∙ cong (_∷_ x) (rev-rev xs) + rev-rev (x ∷ xs) = rev-snoc (rev xs) x ∙ cong (_∷_ x) (rev-rev xs) rev-rev-snoc : (xs : List A) (y : A) → - Square (rev-rev (xs ++ [ y ])) (cong (_++ [ y ]) (rev-rev xs)) (cong rev (rev-snoc xs y)) refl + Square (rev-rev (xs ++ [ y ])) (cong (_++ [ y ]) (rev-rev xs)) (cong rev (rev-snoc xs y)) refl rev-rev-snoc [] y = sym (lUnit refl) rev-rev-snoc (x ∷ xs) y i j = hcomp (λ k → λ - { (i = i1) → compPath-filler (rev-snoc (rev xs) x) (cong (x ∷_) (rev-rev xs)) k j ++ [ y ] + { (i = i1) → compPath-filler (rev-snoc (rev xs) x) (cong (x ∷_) (rev-rev xs)) k j ++ [ y ] ; (j = i0) → rev (rev-snoc xs y i ++ [ x ]) ; (j = i1) → x ∷ rev-rev-snoc xs y i k }) @@ -59,32 +59,32 @@ snocView xs = helper nil xs where helper : {l : List A} -> SnocView l -> (r : List A) -> SnocView (l ++ r) - helper {l} sl [] = subst SnocView (sym (++-unit-r l)) sl - helper {l} sl (x ∷ r) = subst SnocView (++-assoc l (x ∷ []) r) (helper (snoc x l sl) r) + helper {l} sl [] = subst SnocView (sym (++-unit-r l)) sl + helper {l} sl (x ∷ r) = subst SnocView (++-assoc l (x ∷ []) r) (helper (snoc x l sl) r) -- Path space of list type module ListPath {ℓ} {A : Type ℓ} where Cover : List A → List A → Type ℓ - Cover [] [] = Lift Unit - Cover [] (_ ∷ _) = Lift ⊥ - Cover (_ ∷ _) [] = Lift ⊥ + Cover [] [] = Lift Unit + Cover [] (_ ∷ _) = Lift ⊥ + Cover (_ ∷ _) [] = Lift ⊥ Cover (x ∷ xs) (y ∷ ys) = (x ≡ y) × Cover xs ys reflCode : ∀ xs → Cover xs xs - reflCode [] = lift tt + reflCode [] = lift tt reflCode (_ ∷ xs) = refl , reflCode xs encode : ∀ xs ys → (p : xs ≡ ys) → Cover xs ys - encode xs _ = J (λ ys _ → Cover xs ys) (reflCode xs) + encode xs _ = J (λ ys _ → Cover xs ys) (reflCode xs) encodeRefl : ∀ xs → encode xs xs refl ≡ reflCode xs - encodeRefl xs = JRefl (λ ys _ → Cover xs ys) (reflCode xs) + encodeRefl xs = JRefl (λ ys _ → Cover xs ys) (reflCode xs) decode : ∀ xs ys → Cover xs ys → xs ≡ ys decode [] [] _ = refl - decode [] (_ ∷ _) (lift ()) - decode (x ∷ xs) [] (lift ()) + decode [] (_ ∷ _) (lift ()) + decode (x ∷ xs) [] (lift ()) decode (x ∷ xs) (y ∷ ys) (p , c) = cong₂ _∷_ p (decode xs ys c) decodeRefl : ∀ xs → decode xs xs (reflCode xs) ≡ refl @@ -93,8 +93,8 @@ decodeEncode : ∀ xs ys → (p : xs ≡ ys) → decode xs ys (encode xs ys p) ≡ p decodeEncode xs _ = - J (λ ys p → decode xs ys (encode xs ys p) ≡ p) - (cong (decode xs xs) (encodeRefl xs) ∙ decodeRefl xs) + J (λ ys p → decode xs ys (encode xs ys p) ≡ p) + (cong (decode xs xs) (encodeRefl xs) ∙ decodeRefl xs) isOfHLevelCover : (n : HLevel) (p : isOfHLevel (suc (suc n)) A) (xs ys : List A) → isOfHLevel (suc n) (Cover xs ys) @@ -140,10 +140,10 @@ cons-inj₂ = cong safe-tail ¬cons≡nil : ∀ {x : A} {xs} → ¬ (x ∷ xs ≡ []) -¬cons≡nil {A = A} p = lower (subst (caseList (Lift ⊥) (List A)) p []) +¬cons≡nil {A = A} p = lower (subst (caseList (Lift ⊥) (List A)) p []) ¬nil≡cons : ∀ {x : A} {xs} → ¬ ([] ≡ x ∷ xs) -¬nil≡cons {A = A} p = lower (subst (caseList (List A) (Lift ⊥)) p []) +¬nil≡cons {A = A} p = lower (subst (caseList (List A) (Lift ⊥)) p []) ¬snoc≡nil : ∀ {x : A} {xs} → ¬ (xs ∷ʳ x ≡ []) ¬snoc≡nil {xs = []} contra = ¬cons≡nil contra @@ -156,10 +156,10 @@ cons≡rev-snoc _ [] = refl cons≡rev-snoc x (y ∷ ys) = λ i → cons≡rev-snoc x ys i ++ y ∷ [] -isContr[]≡[] : isContr (Path (List A) [] []) +isContr[]≡[] : isContr (Path (List A) [] []) isContr[]≡[] = refl , ListPath.decodeEncode [] [] -isPropXs≡[] : {xs : List A} → isProp (xs ≡ []) +isPropXs≡[] : {xs : List A} → isProp (xs ≡ []) isPropXs≡[] {xs = []} = isOfHLevelSuc 0 isContr[]≡[] isPropXs≡[] {xs = x ∷ xs} = λ p _ → ⊥.rec (¬cons≡nil p) diff --git a/docs/Cubical.Data.Maybe.Properties.html b/docs/Cubical.Data.Maybe.Properties.html index 99eee15..9b7b0ad 100644 --- a/docs/Cubical.Data.Maybe.Properties.html +++ b/docs/Cubical.Data.Maybe.Properties.html @@ -8,7 +8,7 @@ open import Cubical.Foundations.Function using (_∘_; idfun) open import Cubical.Foundations.Isomorphism open import Cubical.Foundations.Pointed.Base using (Pointed; _→∙_; pt) -open import Cubical.Foundations.Structure using (⟨_⟩) +open import Cubical.Foundations.Structure using (⟨_⟩) open import Cubical.Functions.Embedding using (isEmbedding) @@ -30,13 +30,13 @@ -- forgetful functor forgetting the base point. module _ {ℓ} (A : Type ℓ) {ℓ'} (B : Pointed ℓ') where - freelyPointedIso : Iso (Maybe∙ A →∙ B) (A → ⟨ B ⟩) + freelyPointedIso : Iso (Maybe∙ A →∙ B) (A → ⟨ B ⟩) Iso.fun freelyPointedIso f∙ = fst f∙ ∘ just Iso.inv freelyPointedIso f = Maybe.rec (pt B) f , refl Iso.rightInv freelyPointedIso f = refl Iso.leftInv freelyPointedIso f∙ = ΣPathP - ( funExt (Maybe.elim _ (sym (snd f∙)) (λ a → refl)) + ( funExt (Maybe.elim _ (sym (snd f∙)) (λ a → refl)) , λ i j → snd f∙ (~ i ∨ j)) map-Maybe-id : ∀ {ℓ} {A : Type ℓ} → ∀ m → map-Maybe (idfun A) m ≡ m @@ -46,20 +46,20 @@ -- Path space of Maybe type module MaybePath {ℓ} {A : Type ℓ} where Cover : Maybe A → Maybe A → Type ℓ - Cover nothing nothing = Lift Unit - Cover nothing (just _) = Lift ⊥ - Cover (just _) nothing = Lift ⊥ + Cover nothing nothing = Lift Unit + Cover nothing (just _) = Lift ⊥ + Cover (just _) nothing = Lift ⊥ Cover (just a) (just a') = a ≡ a' reflCode : (c : Maybe A) → Cover c c - reflCode nothing = lift tt + reflCode nothing = lift tt reflCode (just b) = refl encode : ∀ c c' → c ≡ c' → Cover c c' - encode c _ = J (λ c' _ → Cover c c') (reflCode 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) + encodeRefl c = JRefl (λ c' _ → Cover c c') (reflCode c) decode : ∀ c c' → Cover c c' → c ≡ c' decode nothing nothing _ = refl @@ -71,13 +71,13 @@ 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) + 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 nothing nothing _ = refl encodeDecode (just a) (just a') = - J (λ a' p → encode (just a) (just a') (cong just p) ≡ p) (encodeRefl (just a)) + J (λ a' p → encode (just a) (just a') (cong just p) ≡ p) (encodeRefl (just a)) Cover≃Path : ∀ c c' → Cover c c' ≃ (c ≡ c') Cover≃Path c c' = isoToEquiv @@ -121,22 +121,22 @@ isEmbedding-just w z = MaybePath.Cover≃Path (just w) (just z) .snd ¬nothing≡just : ∀ {x : A} → ¬ (nothing ≡ just x) -¬nothing≡just {A = A} {x = x} p = lower (subst (caseMaybe (Maybe A) (Lift ⊥)) p (just x)) +¬nothing≡just {A = A} {x = x} p = lower (subst (caseMaybe (Maybe A) (Lift ⊥)) p (just x)) ¬just≡nothing : ∀ {x : A} → ¬ (just x ≡ nothing) -¬just≡nothing {A = A} {x = x} p = lower (subst (caseMaybe (Lift ⊥) (Maybe A)) p (just x)) +¬just≡nothing {A = A} {x = x} p = lower (subst (caseMaybe (Lift ⊥) (Maybe A)) p (just x)) -isProp-x≡nothing : (x : Maybe A) → isProp (x ≡ nothing) +isProp-x≡nothing : (x : Maybe A) → isProp (x ≡ nothing) isProp-x≡nothing nothing x w = - subst isProp (MaybePath.Cover≡Path nothing nothing) (isOfHLevelLift 1 isPropUnit) x w + subst isProp (MaybePath.Cover≡Path nothing nothing) (isOfHLevelLift 1 isPropUnit) x w isProp-x≡nothing (just _) p _ = ⊥.rec (¬just≡nothing p) -isProp-nothing≡x : (x : Maybe A) → isProp (nothing ≡ x) +isProp-nothing≡x : (x : Maybe A) → isProp (nothing ≡ x) isProp-nothing≡x nothing x w = - subst isProp (MaybePath.Cover≡Path nothing nothing) (isOfHLevelLift 1 isPropUnit) x w + subst isProp (MaybePath.Cover≡Path nothing nothing) (isOfHLevelLift 1 isPropUnit) x w isProp-nothing≡x (just _) p _ = ⊥.rec (¬nothing≡just p) -isContr-nothing≡nothing : isContr (nothing {A = A} ≡ nothing) +isContr-nothing≡nothing : isContr (nothing {A = A} ≡ nothing) isContr-nothing≡nothing = inhProp→isContr refl (isProp-x≡nothing _) discreteMaybe : Discrete A → Discrete (Maybe A) diff --git a/docs/Cubical.Data.Nat.Order.Recursive.html b/docs/Cubical.Data.Nat.Order.Recursive.html index 47e386b..1924996 100644 --- a/docs/Cubical.Data.Nat.Order.Recursive.html +++ b/docs/Cubical.Data.Nat.Order.Recursive.html @@ -46,7 +46,7 @@ P : ℕ → Type ℓ k l m n : ℕ -isProp≤ : isProp (m ≤ n) +isProp≤ : isProp (m ≤ n) isProp≤ {zero} = isPropUnit isProp≤ {suc m} {zero} = isProp⊥ isProp≤ {suc m} {suc n} = isProp≤ {m} {n} @@ -57,7 +57,7 @@ ≤-+k : m ≤ n → m + k ≤ n + k ≤-+k {m} {n} {k} m≤n - = transport (λ i → +-comm k m i ≤ +-comm k n i) (≤-k+ {m} {n} {k} m≤n) + = transport (λ i → +-comm k m i ≤ +-comm k n i) (≤-k+ {m} {n} {k} m≤n) ≤-refl : ∀ m → m ≤ m ≤-refl zero = _ @@ -77,7 +77,7 @@ ≤-+k-cancel : m + k ≤ n + k → m ≤ n ≤-+k-cancel {m} {k} {n} - = ≤-k+-cancel {k} {m} {n} ∘ transport λ i → +-comm m k i ≤ +-comm n k i + = ≤-k+-cancel {k} {m} {n} ∘ transport λ i → +-comm m k i ≤ +-comm n k i ¬m<m : ¬ m < m ¬m<m {suc m} = ¬m<m {m} @@ -100,7 +100,7 @@ <-asym {m} m<n n<m = ¬m<m {m} (<-trans {m} {_} {m} m<n n<m) <→≢ : n < m → ¬ n ≡ m -<→≢ {n} {m} p q = ¬m<m {m = m} (subst {x = n} (_< m) q p) +<→≢ {n} {m} p q = ¬m<m {m = m} (subst {x = n} (_< m) q p) Trichotomy-suc : Trichotomy m n → Trichotomy (suc m) (suc n) Trichotomy-suc (lt m<n) = lt m<n @@ -118,7 +118,7 @@ k≤k+n (suc k) = k≤k+n k n≤k+n : ∀ n → n ≤ k + n -n≤k+n {k} n = transport (λ i → n ≤ +-comm n k i) (k≤k+n n) +n≤k+n {k} n = transport (λ i → n ≤ +-comm n k i) (k≤k+n n) ≤-split : m ≤ n → (m < n) ⊎ (m ≡ n) ≤-split {zero} {zero} m≤n = inr refl @@ -146,7 +146,7 @@ Least : ∀{ℓ} → (ℕ → Type ℓ) → (ℕ → Type ℓ) Least P m = P m × (∀ n → n < m → ¬ P n) - isPropLeast : (∀ m → isProp (P m)) → ∀ m → isProp (Least P m) + isPropLeast : (∀ m → isProp (P m)) → ∀ m → isProp (Least P m) isPropLeast pP m = isPropΣ (pP m) (λ _ → isPropΠ3 λ _ _ _ → isProp⊥) @@ -177,7 +177,7 @@ ... | eq m≡n = m≡n ... | gt n<m = Empty.rec (¬P<m n n<m Pn) - isPropΣLeast : (∀ m → isProp (P m)) → isProp (Σ _ (Least P)) + isPropΣLeast : (∀ m → isProp (P m)) → isProp (Σ _ (Least P)) isPropΣLeast pP (m , LPm) (n , LPn) = ΣPathP λ where .fst → Least-unique m n LPm LPn @@ -185,7 +185,7 @@ LPm LPn (Least-unique m n LPm LPn) Decidable→Collapsible - : (∀ m → isProp (P m)) → (∀ m → Dec (P m)) → Collapsible (Σ ℕ P) + : (∀ m → isProp (P m)) → (∀ m → Dec (P m)) → Collapsible (Σ ℕ P) Decidable→Collapsible pP dP = λ where .fst → Least→ ∘ →Least dP .snd x y → cong Least→ (isPropΣLeast pP (→Least dP x) (→Least dP y)) diff --git a/docs/Cubical.Data.Nat.Order.html b/docs/Cubical.Data.Nat.Order.html index 251b64d..387bc1a 100644 --- a/docs/Cubical.Data.Nat.Order.html +++ b/docs/Cubical.Data.Nat.Order.html @@ -46,40 +46,40 @@ k l m n : ℕ private - witness-prop : ∀ j → isProp (j + m ≡ n) + witness-prop : ∀ j → isProp (j + m ≡ n) witness-prop {m} {n} j = isSetℕ (j + m) n -isProp≤ : isProp (m ≤ n) +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)) + lemma = inj-+m (p ∙ (sym q)) zero-≤ : 0 ≤ n zero-≤ {n} = n , +-zero n suc-≤-suc : m ≤ n → suc m ≤ suc n -suc-≤-suc (k , p) = k , (+-suc k _) ∙ (cong suc p) +suc-≤-suc (k , p) = k , (+-suc k _) ∙ (cong suc p) ≤-+k : m ≤ n → m + k ≤ n + k ≤-+k {m} {k = k} (i , p) - = i , +-assoc i m k ∙ cong (_+ k) p + = i , +-assoc i m k ∙ cong (_+ k) p ≤SumRight : n ≤ k + n ≤SumRight {n} {k} = ≤-+k zero-≤ ≤-k+ : m ≤ n → k + m ≤ k + n ≤-k+ {m} {n} {k} - = subst (_≤ k + n) (+-comm m k) - ∘ subst (m + k ≤_) (+-comm n k) + = subst (_≤ k + n) (+-comm m k) + ∘ subst (m + k ≤_) (+-comm n k) ∘ ≤-+k ≤SumLeft : n ≤ n + k -≤SumLeft {n} {k} = subst (n ≤_) (+-comm k n) (≤-+k zero-≤) +≤SumLeft {n} {k} = subst (n ≤_) (+-comm k n) (≤-+k zero-≤) pred-≤-pred : suc m ≤ suc n → m ≤ n -pred-≤-pred (k , p) = k , injSuc ((sym (+-suc k _)) ∙ p) +pred-≤-pred (k , p) = k , injSuc ((sym (+-suc k _)) ∙ p) ≤-refl : m ≤ m ≤-refl = 0 , refl @@ -98,18 +98,18 @@ ≤-predℕ {suc n} = ≤-suc ≤-refl ≤-trans : k ≤ m → m ≤ n → k ≤ n -≤-trans {k} {m} {n} (i , p) (j , q) = i + j , l2 ∙ (l1 ∙ q) +≤-trans {k} {m} {n} (i , p) (j , q) = i + j , l2 ∙ (l1 ∙ q) where l1 : j + i + k ≡ j + m - l1 = (sym (+-assoc j i k)) ∙ (cong (j +_) p) + l1 = (sym (+-assoc j i k)) ∙ (cong (j +_) p) l2 : i + j + k ≡ j + i + k l2 = cong (_+ k) (+-comm i j) ≤-antisym : m ≤ n → n ≤ m → m ≡ n -≤-antisym {m} (i , p) (j , q) = (cong (_+ m) l3) ∙ p +≤-antisym {m} (i , p) (j , q) = (cong (_+ m) l3) ∙ p where l1 : j + i + m ≡ m - l1 = (sym (+-assoc j i m)) ∙ ((cong (j +_) p) ∙ q) + l1 = (sym (+-assoc j i m)) ∙ ((cong (j +_) p) ∙ q) l2 : j + i ≡ 0 l2 = m+n≡n→m≡0 l1 l3 : 0 ≡ i @@ -119,16 +119,16 @@ ≤-+-≤ p q = ≤-trans (≤-+k p) (≤-k+ q) ≤-k+-cancel : k + m ≤ k + n → m ≤ n -≤-k+-cancel {k} {m} (l , p) = l , inj-m+ (sub k m ∙ p) +≤-k+-cancel {k} {m} (l , p) = l , inj-m+ (sub k m ∙ p) where sub : ∀ k m → k + (l + m) ≡ l + (k + m) - sub k m = +-assoc k l m ∙ cong (_+ m) (+-comm k l) ∙ sym (+-assoc l k m) + sub k m = +-assoc k l m ∙ cong (_+ m) (+-comm k l) ∙ sym (+-assoc l k m) ≤-+k-cancel : m + k ≤ n + k → m ≤ n ≤-+k-cancel {m} {k} {n} (l , p) = l , cancelled where cancelled : l + m ≡ n - cancelled = inj-+m (sym (+-assoc l m k) ∙ p) + cancelled = inj-+m (sym (+-assoc l m k) ∙ p) ≤-+k-trans : (m + k ≤ n) → m ≤ n ≤-+k-trans {m} {k} {n} p = ≤-trans (k , +-comm k m) p @@ -139,15 +139,15 @@ ≤-·k : m ≤ n → m · k ≤ n · k ≤-·k {m} {n} {k} (d , r) = d · k , reason where reason : d · k + m · k ≡ n · k - reason = d · k + m · k ≡⟨ ·-distribʳ d m k ⟩ - (d + m) · k ≡⟨ cong (_· k) r ⟩ - n · k ∎ + reason = d · k + m · k ≡⟨ ·-distribʳ d m k ⟩ + (d + m) · k ≡⟨ cong (_· k) r ⟩ + n · k ∎ <-k+-cancel : k + m < k + n → m < n -<-k+-cancel {k} {m} {n} = ≤-k+-cancel ∘ subst (_≤ k + n) (sym (+-suc k m)) +<-k+-cancel {k} {m} {n} = ≤-k+-cancel ∘ subst (_≤ k + n) (sym (+-suc k m)) ¬-<-zero : ¬ m < 0 -¬-<-zero (k , p) = snotz ((sym (+-suc k _)) ∙ p) +¬-<-zero (k , p) = snotz ((sym (+-suc k _)) ∙ p) ¬m<m : ¬ m < m ¬m<m {m} = ¬-<-zero ∘ ≤-+k-cancel {k = m} @@ -163,10 +163,10 @@ predℕ-≤-predℕ {suc m} {suc n} ineq = pred-≤-pred ineq ¬m+n<m : ¬ m + n < m -¬m+n<m {m} {n} = ¬-<-zero ∘ <-k+-cancel ∘ subst (m + n <_) (sym (+-zero m)) +¬m+n<m {m} {n} = ¬-<-zero ∘ <-k+-cancel ∘ subst (m + n <_) (sym (+-zero m)) <-weaken : m < n → m ≤ n -<-weaken (k , p) = suc k , sym (+-suc k _) ∙ p +<-weaken (k , p) = suc k , sym (+-suc k _) ∙ p ≤<-trans : l ≤ m → m < n → l < n ≤<-trans p = ≤-trans (suc-≤-suc p) @@ -184,7 +184,7 @@ <-+k p = ≤-+k p <-k+ : m < n → k + m < k + n -<-k+ {m} {n} {k} p = subst (λ km → km ≤ k + n) (+-suc k m) (≤-k+ p) +<-k+ {m} {n} {k} p = subst (λ km → km ≤ k + n) (+-suc k m) (≤-k+ p) <-+k-trans : (m + k < n) → m < n <-+k-trans {m} {k} {n} p = ≤<-trans (k , +-comm k m) p @@ -201,11 +201,11 @@ <-·sk : m < n → m · suc k < n · suc k <-·sk {m} {n} {k} (d , r) = (d · suc k + k) , reason where reason : (d · suc k + k) + suc (m · suc k) ≡ n · suc k - reason = (d · suc k + k) + suc (m · suc k) ≡⟨ sym (+-assoc (d · suc k) k _) ⟩ - d · suc k + (k + suc (m · suc k)) ≡[ i ]⟨ d · suc k + +-suc k (m · suc k) i ⟩ - d · suc k + suc m · suc k ≡⟨ ·-distribʳ d (suc m) (suc k) ⟩ - (d + suc m) · suc k ≡⟨ cong (_· suc k) r ⟩ - n · suc k ∎ + reason = (d · suc k + k) + suc (m · suc k) ≡⟨ sym (+-assoc (d · suc k) k _) ⟩ + d · suc k + (k + suc (m · suc k)) ≡[ i ]⟨ d · suc k + +-suc k (m · suc k) i ⟩ + d · suc k + suc m · suc k ≡⟨ ·-distribʳ d (suc m) (suc k) ⟩ + (d + suc m) · suc k ≡⟨ cong (_· suc k) r ⟩ + n · suc k ∎ ∸-≤ : ∀ m n → m ∸ n ≤ m ∸-≤ m zero = ≤-refl @@ -215,7 +215,7 @@ ≤-∸-+-cancel : m ≤ n → (n ∸ m) + m ≡ n ≤-∸-+-cancel {zero} {n} _ = +-zero _ ≤-∸-+-cancel {suc m} {zero} m≤n = ⊥.rec (¬-<-zero m≤n) -≤-∸-+-cancel {suc m} {suc n} m+1≤n+1 = +-suc _ _ ∙ cong suc (≤-∸-+-cancel (pred-≤-pred m+1≤n+1)) +≤-∸-+-cancel {suc m} {suc n} m+1≤n+1 = +-suc _ _ ∙ cong suc (≤-∸-+-cancel (pred-≤-pred m+1≤n+1)) ≤-∸-suc : m ≤ n → suc (n ∸ m) ≡ suc n ∸ m ≤-∸-suc {zero} {n} m≤n = refl @@ -224,7 +224,7 @@ ≤-∸-k : m ≤ n → k + (n ∸ m) ≡ (k + n) ∸ m ≤-∸-k {m} {n} {zero} r = refl -≤-∸-k {m} {n} {suc k} r = cong suc (≤-∸-k r) ∙ ≤-∸-suc (≤-trans r (k , refl)) +≤-∸-k {m} {n} {suc k} r = cong suc (≤-∸-k r) ∙ ≤-∸-suc (≤-trans r (k , refl)) left-≤-max : m ≤ max m n left-≤-max {zero} {n} = zero-≤ @@ -254,13 +254,13 @@ ... | no m≰n = no λ m+1≤n+1 → m≰n (pred-≤-pred m+1≤n+1 ) ≤Stable : ∀ m n → Stable (m ≤ n) -≤Stable m n = Dec→Stable (≤Dec m n) +≤Stable m n = Dec→Stable (≤Dec m n) <Dec : ∀ m n → Dec (m < n) <Dec m n = ≤Dec (suc m) n <Stable : ∀ m n → Stable (m < n) -<Stable m n = Dec→Stable (<Dec m n) +<Stable m n = Dec→Stable (<Dec m n) Trichotomy-suc : Trichotomy m n → Trichotomy (suc m) (suc n) Trichotomy-suc (lt m<n) = lt (suc-≤-suc m<n) @@ -290,7 +290,7 @@ → P n m ≤CaseInduction {n = n} {m = m} p q with n ≟ m ... | lt x = p (<-weaken x) -... | eq x = p (subst (n ≤_) x ≤-refl) +... | eq x = p (subst (n ≤_) x ≤-refl) ... | gt x = q (<-weaken x) <-split : m < suc n → (m < n) ⊎ (m ≡ n) @@ -318,7 +318,7 @@ ... | eq p = inr (0 , p) ... | lt m<n+m∸k = inr (<-weaken m<n+m∸k) ... | gt n+m∸k<m = - ⊥.rec (¬m<m (transport (λ i → ≤-∸-+-cancel k≤n+m i < +-comm m n i) (<-+-< n+m∸k<m k<n))) + ⊥.rec (¬m<m (transport (λ i → ≤-∸-+-cancel k≤n+m i < +-comm m n i) (<-+-< n+m∸k<m k<n))) <-asym'-case : Trichotomy m n → ¬ m < n → n ≤ m <-asym'-case (lt p) q = ⊥.rec (q p) @@ -334,7 +334,7 @@ = acc λ y y<sn → case <-split y<sn of λ { (inl y<n) → access a y y<n - ; (inr y≡n) → subst _ (sym y≡n) a + ; (inr y≡n) → subst _ (sym y≡n) a } <-wellfounded : WellFounded _<_ @@ -342,7 +342,7 @@ <-wellfounded (suc n) = acc-suc (<-wellfounded n) <→≢ : n < m → ¬ n ≡ m -<→≢ {n} {m} p q = ¬m<m (subst (_< m) q p) +<→≢ {n} {m} p q = ¬m<m (subst (_< m) q p) module _ (b₀ : ℕ) @@ -357,34 +357,34 @@ dichotomy b n = case n ≟ b return (λ _ → (n < b) ⊎ (Σ[ m ∈ ℕ ] n ≡ b + m)) of λ { (lt o) → inl o - ; (eq p) → inr (0 , p ∙ sym (+-zero b)) - ; (gt (m , p)) → inr (suc m , sym p ∙ +-suc m b ∙ +-comm (suc m) b) + ; (eq p) → inr (0 , p ∙ sym (+-zero b)) + ; (gt (m , p)) → inr (suc m , sym p ∙ +-suc m b ∙ +-comm (suc m) b) } dichotomy<≡ : ∀ b n → (n<b : n < b) → dichotomy b n ≡ inl n<b dichotomy<≡ b n n<b = case dichotomy b n return (λ d → d ≡ inl n<b) of λ { (inl x) → cong inl (isProp≤ x n<b) - ; (inr (m , p)) → ⊥.rec (<-asym n<b (m , sym (p ∙ +-comm b m))) + ; (inr (m , p)) → ⊥.rec (<-asym n<b (m , sym (p ∙ +-comm b m))) } dichotomy+≡ : ∀ b m n → (p : n ≡ b + m) → dichotomy b n ≡ inr (m , p) dichotomy+≡ b m n p = case dichotomy b n return (λ d → d ≡ inr (m , p)) of λ - { (inl n<b) → ⊥.rec (<-asym n<b (m , +-comm m b ∙ sym p)) + { (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₀ lemma₁ : ∀{x y z} → x ≡ suc z + y → y < x - lemma₁ {y = y} {z} p = z , +-suc z y ∙ sym p + lemma₁ {y = y} {z} p = z , +-suc z y ∙ sym p subStep : (n : ℕ) → (∀ m → m < n → P m) → (n < b) ⊎ (Σ[ m ∈ ℕ ] n ≡ b + m) → P n subStep n _ (inl l) = base n l subStep n rec (inr (m , p)) - = transport (cong P (sym p)) (step m (rec m (lemma₁ p))) + = transport (cong P (sym p)) (step m (rec m (lemma₁ p))) wfStep : (n : ℕ) → (∀ m → m < n → P m) → P n wfStep n rec = subStep n rec (dichotomy b n) @@ -395,16 +395,16 @@ wfStepLemma₁ : ∀ n rec → wfStep (b + n) rec ≡ step n (rec n (lemma₁ refl)) wfStepLemma₁ n rec = cong (subStep (b + n) rec) (dichotomy+≡ b n (b + n) refl) - ∙ transportRefl _ + ∙ transportRefl _ +induction : ∀ n → P n +induction = induction wfStep +inductionBase : ∀ n → (l : n < b) → +induction n ≡ base n l - +inductionBase n l = induction-compute wfStep n ∙ wfStepLemma₀ n l _ + +inductionBase n l = induction-compute wfStep n ∙ wfStepLemma₀ n l _ +inductionStep : ∀ n → +induction (b + n) ≡ step n (+induction n) - +inductionStep n = induction-compute wfStep (b + n) ∙ wfStepLemma₁ n _ + +inductionStep n = induction-compute wfStep (b + n) ∙ wfStepLemma₁ n _ module <-Reasoning where -- TODO: would it be better to mirror the way it is done in the agda-stdlib? @@ -422,13 +422,13 @@ _ <≤⟨ p ⟩ q = <≤-trans p q _≡≤⟨_⟩_ : ∀ k → k ≡ l → l ≤ m → k ≤ m - _ ≡≤⟨ p ⟩ q = subst (λ k → k ≤ _) (sym p) q + _ ≡≤⟨ p ⟩ q = subst (λ k → k ≤ _) (sym p) q _≡<⟨_⟩_ : ∀ k → k ≡ l → l < m → k < m _ ≡<⟨ p ⟩ q = _ ≡≤⟨ cong suc p ⟩ q _≤≡⟨_⟩_ : ∀ k → k ≤ l → l ≡ m → k ≤ m - _ ≤≡⟨ p ⟩ q = subst (λ l → _ ≤ l) q p + _ ≤≡⟨ p ⟩ q = subst (λ l → _ ≤ l) q p _<≡⟨_⟩_ : ∀ k → k < l → l ≡ m → k < m _ <≡⟨ p ⟩ q = _ ≤≡⟨ p ⟩ q @@ -497,7 +497,7 @@ ... | yes m≤'n = yes (s≤s m≤'n) ... | no m≰'n = no λ { (s≤s m≤'n) → m≰'n m≤'n } -≤'IsPropValued : ∀ m n → isProp (m ≤' n) +≤'IsPropValued : ∀ m n → isProp (m ≤' n) ≤'IsPropValued zero n z≤ z≤ = refl ≤'IsPropValued (suc m) zero () ≤'IsPropValued (suc m) (suc n) (s≤s x) (s≤s y) = cong s≤s (≤'IsPropValued m n x y) diff --git a/docs/Cubical.Data.Nat.Properties.html b/docs/Cubical.Data.Nat.Properties.html index 0a36869..8399e5b 100644 --- a/docs/Cubical.Data.Nat.Properties.html +++ b/docs/Cubical.Data.Nat.Properties.html @@ -42,10 +42,10 @@ maxComm (suc n) (suc m) = cong suc (maxComm n m) znots : ¬ (0 ≡ suc n) -znots eq = subst (caseNat ℕ ⊥) eq 0 +znots eq = subst (caseNat ℕ ⊥) eq 0 snotz : ¬ (suc n ≡ 0) -snotz eq = subst (caseNat ⊥ ℕ) eq 0 +snotz eq = subst (caseNat ⊥ ℕ) eq 0 injSuc : suc m ≡ suc n → m ≡ n injSuc p = cong predℕ p @@ -58,7 +58,7 @@ codeℕ (suc n) (suc m) = codeℕ n m encodeℕ : (n m : ℕ) → (n ≡ m) → codeℕ n m -encodeℕ n m p = subst (λ m → codeℕ n m) p (reflCode n) +encodeℕ n m p = subst (λ m → codeℕ n m) p (reflCode n) where reflCode : (n : ℕ) → codeℕ n n reflCode zero = tt @@ -96,7 +96,7 @@ reflRetr (suc n) i = cong suc (reflRetr n i) retr : (n m : ℕ) → (p : n ≡ m) → (decodeℕ n m (encodeℕ n m p) ≡ p) - retr n m p = J (λ m p → decodeℕ n m (encodeℕ n m p) ≡ p) (reflRetr n) p + retr n m p = J (λ m p → decodeℕ n m (encodeℕ n m p) ≡ p) (reflRetr n) p ≡ℕ≃Codeℕ' : (n m : ℕ) → (n ≡ m) ≃ codeℕ n m @@ -117,7 +117,7 @@ reflRetr (suc n) i = cong suc (reflRetr n i) retr : (n m : ℕ) → (p : n ≡ m) → decodeℕ n m (compute-eqℕ n m p) ≡ p - retr n m p = J (λ m p → decodeℕ n m (compute-eqℕ n m p) ≡ p) (reflRetr n) p + retr n m p = J (λ m p → decodeℕ n m (compute-eqℕ n m p) ≡ p) (reflRetr n) p discreteℕ : Discrete ℕ @@ -129,10 +129,10 @@ ... | no p = no (λ x → p (injSuc x)) separatedℕ : Separated ℕ -separatedℕ = Discrete→Separated discreteℕ +separatedℕ = Discrete→Separated discreteℕ -isSetℕ : isSet ℕ -isSetℕ = Discrete→isSet discreteℕ +isSetℕ : isSet ℕ +isSetℕ = Discrete→isSet discreteℕ -- Arithmetic facts about predℕ @@ -152,7 +152,7 @@ +-comm : ∀ m n → m + n ≡ n + m +-comm m zero = +-zero m -+-comm m (suc n) = (+-suc m n) ∙ (cong suc (+-comm m n)) ++-comm m (suc n) = (+-suc m n) ∙ (cong suc (+-comm m n)) -- Addition is associative +-assoc : ∀ m n o → m + (n + o) ≡ (m + n) + o @@ -164,11 +164,11 @@ inj-m+ {suc m} p = inj-m+ (injSuc p) inj-+m : l + m ≡ n + m → l ≡ n -inj-+m {l} {m} {n} p = inj-m+ ((+-comm m l) ∙ (p ∙ (+-comm n m))) +inj-+m {l} {m} {n} p = inj-m+ ((+-comm m l) ∙ (p ∙ (+-comm n m))) m+n≡n→m≡0 : m + n ≡ n → m ≡ 0 -m+n≡n→m≡0 {n = zero} = λ p → (sym (+-zero _)) ∙ p -m+n≡n→m≡0 {n = suc n} p = m+n≡n→m≡0 (injSuc ((sym (+-suc _ n)) ∙ p)) +m+n≡n→m≡0 {n = zero} = λ p → (sym (+-zero _)) ∙ p +m+n≡n→m≡0 {n = suc n} p = m+n≡n→m≡0 (injSuc ((sym (+-suc _ n)) ∙ p)) m+n≡0→m≡0×n≡0 : m + n ≡ 0 → (m ≡ 0) × (n ≡ 0) m+n≡0→m≡0×n≡0 {zero} = refl ,_ @@ -184,27 +184,27 @@ ·-suc zero n = refl ·-suc (suc m) n = cong suc - ( n + m · suc n ≡⟨ cong (n +_) (·-suc m n) ⟩ - n + (m + m · n) ≡⟨ +-assoc n m (m · n) ⟩ - (n + m) + m · n ≡⟨ cong (_+ m · n) (+-comm n m) ⟩ - (m + n) + m · n ≡⟨ sym (+-assoc m n (m · n)) ⟩ - m + (n + m · n) ∎ + ( n + m · suc n ≡⟨ cong (n +_) (·-suc m n) ⟩ + n + (m + m · n) ≡⟨ +-assoc n m (m · n) ⟩ + (n + m) + m · n ≡⟨ cong (_+ m · n) (+-comm n m) ⟩ + (m + n) + m · n ≡⟨ sym (+-assoc m n (m · n)) ⟩ + m + (n + m · n) ∎ ) ·-comm : ∀ m n → m · n ≡ n · m ·-comm zero n = 0≡m·0 n -·-comm (suc m) n = cong (n +_) (·-comm m n) ∙ sym (·-suc n m) +·-comm (suc m) n = cong (n +_) (·-comm m n) ∙ sym (·-suc n m) ·-distribʳ : ∀ m n o → (m · o) + (n · o) ≡ (m + n) · o ·-distribʳ zero _ _ = refl -·-distribʳ (suc m) n o = sym (+-assoc o (m · o) (n · o)) ∙ cong (o +_) (·-distribʳ m n o) +·-distribʳ (suc m) n o = sym (+-assoc o (m · o) (n · o)) ∙ cong (o +_) (·-distribʳ m n o) ·-distribˡ : ∀ o m n → (o · m) + (o · n) ≡ o · (m + n) -·-distribˡ o m n = (λ i → ·-comm o m i + ·-comm o n i) ∙ ·-distribʳ m n o ∙ ·-comm (m + n) o +·-distribˡ o m n = (λ i → ·-comm o m i + ·-comm o n i) ∙ ·-distribʳ m n o ∙ ·-comm (m + n) o ·-assoc : ∀ m n o → m · (n · o) ≡ (m · n) · o ·-assoc zero _ _ = refl -·-assoc (suc m) n o = cong (n · o +_) (·-assoc m n o) ∙ ·-distribʳ n (m · n) o +·-assoc (suc m) n o = cong (n · o +_) (·-assoc m n o) ∙ ·-distribʳ n (m · n) o ·-identityˡ : ∀ m → 1 · m ≡ m ·-identityˡ m = +-zero m @@ -223,7 +223,7 @@ inj-·sm {suc l} {m} {suc n} p = cong suc (inj-·sm (inj-m+ {m = suc m} p)) inj-sm· : suc m · l ≡ suc m · n → l ≡ n -inj-sm· {m} {l} {n} p = inj-·sm (·-comm l (suc m) ∙ p ∙ ·-comm (suc m) n) +inj-sm· {m} {l} {n} p = inj-·sm (·-comm l (suc m) ∙ p ∙ ·-comm (suc m) n) integral-domain-· : {k l : ℕ} → (k ≡ 0 → ⊥) → (l ≡ 0 → ⊥) → (k · l ≡ 0 → ⊥) integral-domain-· {zero} {l} ¬p ¬q r = ¬p refl @@ -248,18 +248,18 @@ +∸ : ∀ k n → (k + n) ∸ n ≡ k +∸ zero n = n∸n n +∸ (suc k) zero = cong suc (+-comm k zero) -+∸ (suc k) (suc n) = cong (_∸ n) (+-suc k n) ∙ +∸ (suc k) n ++∸ (suc k) (suc n) = cong (_∸ n) (+-suc k n) ∙ +∸ (suc k) n ∸+ : ∀ k n → (n + k) ∸ n ≡ k -∸+ k n = cong (λ X → X ∸ n) (+-comm n k) ∙ +∸ k n +∸+ k n = cong (λ X → X ∸ n) (+-comm n k) ∙ +∸ k n ∸-cancelʳ : ∀ m n k → (m + k) ∸ (n + k) ≡ m ∸ n -∸-cancelʳ m n k = (λ i → +-comm m k i ∸ +-comm n k i) ∙ ∸-cancelˡ k m n +∸-cancelʳ m n k = (λ i → +-comm m k i ∸ +-comm n k i) ∙ ∸-cancelˡ k m n ∸-distribʳ : ∀ m n k → (m ∸ n) · k ≡ m · k ∸ n · k ∸-distribʳ m zero k = refl ∸-distribʳ zero (suc n) k = sym (zero∸ (k + n · k)) -∸-distribʳ (suc m) (suc n) k = ∸-distribʳ m n k ∙ sym (∸-cancelˡ k (m · k) (n · k)) +∸-distribʳ (suc m) (suc n) k = ∸-distribʳ m n k ∙ sym (∸-cancelˡ k (m · k) (n · k)) @@ -284,15 +284,15 @@ ¬evenAndOdd (suc zero) () ¬evenAndOdd (suc (suc n)) = ¬evenAndOdd n -isPropIsEvenT : (n : ℕ) → isProp (isEvenT n) +isPropIsEvenT : (n : ℕ) → isProp (isEvenT n) isPropIsEvenT zero x y = refl isPropIsEvenT (suc zero) = isProp⊥ isPropIsEvenT (suc (suc n)) = isPropIsEvenT n -isPropIsOddT : (n : ℕ) → isProp (isOddT n) +isPropIsOddT : (n : ℕ) → isProp (isOddT n) isPropIsOddT n = isPropIsEvenT (suc n) -isPropEvenOrOdd : (n : ℕ) → isProp (isEvenT n ⊎ isOddT n) +isPropEvenOrOdd : (n : ℕ) → isProp (isEvenT n ⊎ isOddT n) isPropEvenOrOdd n (inl x) (inl x₁) = cong inl (isPropIsEvenT n x x₁) isPropEvenOrOdd n (inl x) (inr x₁) = ⊥.rec (¬evenAndOdd n (x , x₁)) isPropEvenOrOdd n (inr x) (inl x₁) = ⊥.rec (¬evenAndOdd (suc n) (x , x₁)) @@ -311,13 +311,13 @@ +'≡+ (suc n) (suc m) = cong suc (sym (+-suc n m)) +'-comm : (n m : ℕ) → n +' m ≡ m +' n - +'-comm n m = +'≡+ n m ∙∙ +-comm n m ∙∙ sym (+'≡+ m n) + +'-comm n m = +'≡+ n m ∙∙ +-comm n m ∙∙ sym (+'≡+ m n) +'-assoc : (n m l : ℕ) → (n +' (m +' l)) ≡ ((n +' m) +' l) +'-assoc n m l = (λ i → +'≡+ n (+'≡+ m l i) i) - ∙∙ +-assoc n m l - ∙∙ (λ i → +'≡+ (+'≡+ n m (~ i)) l (~ i)) + ∙∙ +-assoc n m l + ∙∙ (λ i → +'≡+ (+'≡+ n m (~ i)) l (~ i)) +'-rid : (n : ℕ) → n +' 0 ≡ n +'-rid zero = refl @@ -336,9 +336,9 @@ compSubstℕ : ∀ {ℓ} {A : ℕ → Type ℓ} {n m l : ℕ} (p : n ≡ m) (q : m ≡ l) (r : n ≡ l) → {x : _} - → subst A q (subst A p x) - ≡ subst A r x + → subst A q (subst A p x) + ≡ subst A r x compSubstℕ {A = A} p q r {x = x} = - sym (substComposite A p q x) - ∙ λ i → subst A (isSetℕ _ _ (p ∙ q) r i) x + sym (substComposite A p q x) + ∙ λ i → subst A (isSetℕ _ _ (p ∙ q) r i) x \ No newline at end of file diff --git a/docs/Cubical.Data.Sigma.Base.html b/docs/Cubical.Data.Sigma.Base.html index eef3dcf..d1fe022 100644 --- a/docs/Cubical.Data.Sigma.Base.html +++ b/docs/Cubical.Data.Sigma.Base.html @@ -43,7 +43,7 @@ -- Unique existence ∃! : ∀ {ℓ ℓ'} (A : Type ℓ) (B : A → Type ℓ') → Type (ℓ-max ℓ ℓ') -∃! A B = isContr (Σ A B) +∃! A B = isContr (Σ A B) infix 2 ∃!-syntax diff --git a/docs/Cubical.Data.Sigma.Properties.html b/docs/Cubical.Data.Sigma.Properties.html index cb5c171..5d84ac7 100644 --- a/docs/Cubical.Data.Sigma.Properties.html +++ b/docs/Cubical.Data.Sigma.Properties.html @@ -89,13 +89,13 @@ ≡ (PathP (λ i → Σ (A i) (B i)) x y) ΣPath≡PathΣ = ua ΣPath≃PathΣ -×≡Prop : isProp A' → {u v : A × A'} → u .fst ≡ v .fst → u ≡ v +×≡Prop : isProp A' → {u v : A × A'} → u .fst ≡ v .fst → u ≡ v ×≡Prop pB {u} {v} p i = (p i) , (pB (u .snd) (v .snd) i) -- Useful lemma to prove unique existence -uniqueExists : (a : A) (b : B a) (h : (a' : A) → isProp (B a')) (H : (a' : A) → B a' → a ≡ a') → ∃![ a ∈ A ] B a +uniqueExists : (a : A) (b : B a) (h : (a' : A) → isProp (B a')) (H : (a' : A) → B a' → a ≡ a') → ∃![ a ∈ A ] B a fst (uniqueExists a b h H) = (a , b) -snd (uniqueExists a b h H) (a' , b') = ΣPathP (H a' b' , isProp→PathP (λ i → h (H a' b' i)) b b') +snd (uniqueExists a b h H) (a' , b') = ΣPathP (H a' b' , isProp→PathP (λ i → h (H a' b' i)) b b') -- Characterization of dependent paths in Σ @@ -123,12 +123,12 @@ discreteΣ {B = B} Adis Bdis (a0 , b0) (a1 , b1) = discreteΣ' (Adis a0 a1) where discreteΣ' : Dec (a0 ≡ a1) → Dec ((a0 , b0) ≡ (a1 , b1)) - discreteΣ' (yes p) = J (λ a1 p → ∀ b1 → Dec ((a0 , b0) ≡ (a1 , b1))) (discreteΣ'') p b1 + discreteΣ' (yes p) = J (λ a1 p → ∀ b1 → Dec ((a0 , b0) ≡ (a1 , b1))) (discreteΣ'') p b1 where discreteΣ'' : (b1 : B a0) → Dec ((a0 , b0) ≡ (a0 , b1)) discreteΣ'' b1 with Bdis a0 b0 b1 - ... | (yes q) = yes (transport ΣPath≡PathΣ (refl , q)) - ... | (no ¬q) = no (λ r → ¬q (subst (λ X → PathP (λ i → B (X i)) b0 b1) (Discrete→isSet Adis a0 a0 (cong fst r) refl) (cong snd r))) + ... | (yes q) = yes (transport ΣPath≡PathΣ (refl , q)) + ... | (no ¬q) = no (λ r → ¬q (subst (λ X → PathP (λ i → B (X i)) b0 b1) (Discrete→isSet Adis a0 a0 (cong fst r) refl) (cong snd r))) discreteΣ' (no ¬p) = no (λ r → ¬p (cong fst r)) lUnit×Iso : Iso (Unit × A) A @@ -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/docs/Cubical.Data.Sum.Properties.html b/docs/Cubical.Data.Sum.Properties.html index 82eab06..a8cda3e 100644 --- a/docs/Cubical.Data.Sum.Properties.html +++ b/docs/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/docs/Cubical.Data.Unit.Base.html b/docs/Cubical.Data.Unit.Base.html index a8b9377..dcff31b 100644 --- a/docs/Cubical.Data.Unit.Base.html +++ b/docs/Cubical.Data.Unit.Base.html @@ -10,9 +10,9 @@ -- Universe polymorphic version Unit* : {ℓ : Level} → Type ℓ -Unit* = Lift Unit +Unit* = Lift Unit -pattern tt* = lift tt +pattern tt* = lift tt -- Pointed version Unit*∙ : ∀ {ℓ} → Σ[ X ∈ Type ℓ ] X diff --git a/docs/Cubical.Data.Unit.Properties.html b/docs/Cubical.Data.Unit.Properties.html index b29dc9f..cdec8f9 100644 --- a/docs/Cubical.Data.Unit.Properties.html +++ b/docs/Cubical.Data.Unit.Properties.html @@ -26,14 +26,14 @@ variable ℓ ℓ' : Level -isContrUnit : isContr Unit +isContrUnit : isContr Unit isContrUnit = tt , λ {tt → refl} -isPropUnit : isProp Unit +isPropUnit : isProp Unit isPropUnit _ _ i = tt -- definitionally equal to: isContr→isProp isContrUnit -isSetUnit : isSet Unit -isSetUnit = isProp→isSet isPropUnit +isSetUnit : isSet Unit +isSetUnit = isProp→isSet isPropUnit isOfHLevelUnit : (n : HLevel) → isOfHLevel n Unit isOfHLevelUnit n = isContr→isOfHLevel n isContrUnit @@ -77,11 +77,11 @@ rightInv fiberUnitIso _ = refl leftInv fiberUnitIso _ = refl -isContr→Iso2 : {A : Type ℓ} {B : Type ℓ'} → isContr A → Iso (A → B) B +isContr→Iso2 : {A : Type ℓ} {B : Type ℓ'} → isContr A → Iso (A → B) B fun (isContr→Iso2 iscontr) f = f (fst iscontr) inv (isContr→Iso2 iscontr) b _ = b rightInv (isContr→Iso2 iscontr) _ = refl -leftInv (isContr→Iso2 iscontr) f = funExt λ x → cong f (snd iscontr x) +leftInv (isContr→Iso2 iscontr) f = funExt λ x → cong f (snd iscontr x) diagonal-unit : Unit ≡ Unit × Unit diagonal-unit = isoToPath (iso (λ x → tt , tt) (λ x → tt) (λ {(tt , tt) i → tt , tt}) λ {tt i → tt}) @@ -91,19 +91,19 @@ where unquoteDecl e = declStrictEquiv e fst (λ a → a , refl) -isContr→≃Unit : {A : Type ℓ} → isContr A → A ≃ Unit +isContr→≃Unit : {A : Type ℓ} → isContr A → A ≃ Unit isContr→≃Unit contr = isoToEquiv (iso (λ _ → tt) (λ _ → fst contr) (λ _ → refl) λ _ → snd contr _) -isContr→≡Unit : {A : Type₀} → isContr A → A ≡ Unit +isContr→≡Unit : {A : Type₀} → isContr A → A ≡ Unit isContr→≡Unit contr = ua (isContr→≃Unit contr) -isContrUnit* : ∀ {ℓ} → isContr (Unit* {ℓ}) +isContrUnit* : ∀ {ℓ} → isContr (Unit* {ℓ}) isContrUnit* = tt* , λ _ → refl -isPropUnit* : ∀ {ℓ} → isProp (Unit* {ℓ}) +isPropUnit* : ∀ {ℓ} → isProp (Unit* {ℓ}) isPropUnit* _ _ = refl -isSetUnit* : ∀ {ℓ} → isSet (Unit* {ℓ}) +isSetUnit* : ∀ {ℓ} → isSet (Unit* {ℓ}) isSetUnit* _ _ _ _ = refl isOfHLevelUnit* : ∀ {ℓ} (n : HLevel) → isOfHLevel n (Unit* {ℓ}) @@ -115,9 +115,9 @@ Unit≃Unit* : ∀ {ℓ} → Unit ≃ Unit* {ℓ} Unit≃Unit* = invEquiv (isContr→≃Unit isContrUnit*) -isContr→≃Unit* : {A : Type ℓ} → isContr A → A ≃ Unit* {ℓ} +isContr→≃Unit* : {A : Type ℓ} → isContr A → A ≃ Unit* {ℓ} isContr→≃Unit* contr = compEquiv (isContr→≃Unit contr) Unit≃Unit* -isContr→≡Unit* : {A : Type ℓ} → isContr A → A ≡ Unit* +isContr→≡Unit* : {A : Type ℓ} → isContr A → A ≡ Unit* isContr→≡Unit* contr = ua (isContr→≃Unit* contr) \ No newline at end of file diff --git a/docs/Cubical.Data.Vec.NAry.html b/docs/Cubical.Data.Vec.NAry.html index fe84afd..4555fdc 100644 --- a/docs/Cubical.Data.Vec.NAry.html +++ b/docs/Cubical.Data.Vec.NAry.html @@ -34,12 +34,12 @@ curryⁿ {n = suc n} f x = curryⁿ (λ xs → f (x ∷ xs)) $ⁿ-curryⁿ : ∀ {n} (f : Vec A n → B) → _$ⁿ_ (curryⁿ f) ≡ f -$ⁿ-curryⁿ {n = zero} f = funExt λ { [] → refl } -$ⁿ-curryⁿ {n = suc n} f = funExt λ { (x ∷ xs) i → $ⁿ-curryⁿ {n = n} (λ ys → f (x ∷ ys)) i xs} +$ⁿ-curryⁿ {n = zero} f = funExt λ { [] → refl } +$ⁿ-curryⁿ {n = suc n} f = funExt λ { (x ∷ xs) i → $ⁿ-curryⁿ {n = n} (λ ys → f (x ∷ ys)) i xs} curryⁿ-$ⁿ : ∀ {n} (f : nAryOp {ℓ = ℓ} {ℓ' = ℓ'} n A B) → curryⁿ {A = A} {B = B} (_$ⁿ_ f) ≡ f curryⁿ-$ⁿ {n = zero} f = refl -curryⁿ-$ⁿ {n = suc n} f = funExt λ x → curryⁿ-$ⁿ {n = n} (f x) +curryⁿ-$ⁿ {n = suc n} f = funExt λ x → curryⁿ-$ⁿ {n = n} (f x) nAryOp≃VecFun : ∀ {n} → nAryOp n A B ≃ (Vec A n → B) nAryOp≃VecFun {n = n} = isoToEquiv f diff --git a/docs/Cubical.Data.Vec.Properties.html b/docs/Cubical.Data.Vec.Properties.html index d86d1ed..cc676e0 100644 --- a/docs/Cubical.Data.Vec.Properties.html +++ b/docs/Cubical.Data.Vec.Properties.html @@ -42,8 +42,8 @@ Vec→FinVec xs f = lookup f xs FinVec→Vec→FinVec : {n : ℕ} (xs : FinVec A n) → Vec→FinVec (FinVec→Vec xs) ≡ xs -FinVec→Vec→FinVec {n = zero} xs = funExt λ f → ⊥.rec (¬Fin0 f) -FinVec→Vec→FinVec {n = suc n} xs = funExt goal +FinVec→Vec→FinVec {n = zero} xs = funExt λ f → ⊥.rec (¬Fin0 f) +FinVec→Vec→FinVec {n = suc n} xs = funExt goal where goal : (f : Fin (suc n)) → Vec→FinVec (xs zero ∷ FinVec→Vec (λ x → xs (suc x))) f ≡ xs f @@ -63,7 +63,7 @@ FinVec≡Vec : (n : ℕ) → FinVec A n ≡ Vec A n FinVec≡Vec n = ua (FinVec≃Vec n) -isContrVec0 : isContr (Vec A 0) +isContrVec0 : isContr (Vec A 0) isContrVec0 = [] , λ { [] → refl } -- encode - decode Vec @@ -80,10 +80,10 @@ reflEncode (a ∷ v) = refl , refl encode : {n : ℕ} → (v v' : Vec A n) → (v ≡ v') → code v v' - encode v v' p = J (λ v' _ → code v v') (reflEncode v) p + encode v v' p = J (λ v' _ → code v v') (reflEncode v) p encodeRefl : {n : ℕ} → (v : Vec A n) → encode v v refl ≡ reflEncode v - encodeRefl v = JRefl (λ v' _ → code v v') (reflEncode v) + encodeRefl v = JRefl (λ v' _ → code v v') (reflEncode v) -- decode decode : {n : ℕ} → (v v' : Vec A n) → (r : code v v') → (v ≡ v') @@ -106,15 +106,15 @@ sect : {n : ℕ} → (v v' : Vec A n) → (r : code v v') → encode v v' (decode v v' r) ≡ r sect [] [] tt* = encodeRefl [] - sect (a ∷ v) (a' ∷ v') (p , q) = J (λ a' p → encode (a ∷ v) (a' ∷ v') (decode (a ∷ v) (a' ∷ v') (p , q)) ≡ (p , q)) - (J (λ v' q → encode (a ∷ v) (a ∷ v') (decode (a ∷ v) (a ∷ v') (refl , q)) ≡ (refl , q)) + sect (a ∷ v) (a' ∷ v') (p , q) = J (λ a' p → encode (a ∷ v) (a' ∷ v') (decode (a ∷ v) (a' ∷ v') (p , q)) ≡ (p , q)) + (J (λ v' q → encode (a ∷ v) (a ∷ v') (decode (a ∷ v) (a ∷ v') (refl , q)) ≡ (refl , q)) (encodeRefl (a ∷ v)) q) p leftInv is = retr v v' where retr : {n : ℕ} → (v v' : Vec A n) → (p : v ≡ v') → decode v v' (encode v v' p) ≡ p - retr v v' p = J (λ v' p → decode v v' (encode v v' p) ≡ p) - (cong (decode v v) (encodeRefl v) ∙ decodeRefl v) p + retr v v' p = J (λ v' p → decode v v' (encode v v' p) ≡ p) + (cong (decode v v) (encodeRefl v) ∙ decodeRefl v) p isOfHLevelVec : (h : HLevel) (n : ℕ) diff --git a/docs/Cubical.Foundations.CartesianKanOps.html b/docs/Cubical.Foundations.CartesianKanOps.html index 4962e5d..cc54051 100644 --- a/docs/Cubical.Foundations.CartesianKanOps.html +++ b/docs/Cubical.Foundations.CartesianKanOps.html @@ -104,7 +104,7 @@ hcomp (λ k → λ { (i = i0)(j = i0) → rUnit refl (~ k) ; (i = i1)(j = i1) → rUnit refl (~ k) }) - (diag ∙ coei→i A j (p j)) + (diag ∙ coei→i A j (p j)) where diag : coei→j A i j (p i) ≡ coei→j A j j (p j) diag k = coei→j A _ j (p ((j ∨ (i ∧ ~ k)) ∧ (i ∨ (j ∧ k)))) diff --git a/docs/Cubical.Foundations.Equiv.Base.html b/docs/Cubical.Foundations.Equiv.Base.html index 1b3fb95..3aa75b7 100644 --- a/docs/Cubical.Foundations.Equiv.Base.html +++ b/docs/Cubical.Foundations.Equiv.Base.html @@ -29,5 +29,5 @@ -- the definition using Π-type isEquiv' : ∀ {ℓ}{ℓ'}{A : Type ℓ}{B : Type ℓ'} → (A → B) → Type (ℓ-max ℓ ℓ') -isEquiv' {B = B} f = (y : B) → isContr (fiber f y) +isEquiv' {B = B} f = (y : B) → isContr (fiber f y) \ No newline at end of file diff --git a/docs/Cubical.Foundations.Equiv.Fiberwise.html b/docs/Cubical.Foundations.Equiv.Fiberwise.html index 7926967..af5301b 100644 --- a/docs/Cubical.Foundations.Equiv.Fiberwise.html +++ b/docs/Cubical.Foundations.Equiv.Fiberwise.html @@ -27,14 +27,14 @@ fibers-total {xv} = iso h g h-g g-h where h : ∀ {xv} → fiber total xv → fiber (f (xv .fst)) (xv .snd) - h {xv} (p , eq) = J (\ xv eq → fiber (f (xv .fst)) (xv .snd)) ((p .snd) , refl) eq + h {xv} (p , eq) = J (\ xv eq → fiber (f (xv .fst)) (xv .snd)) ((p .snd) , refl) eq g : ∀ {xv} → fiber (f (xv .fst)) (xv .snd) → fiber total xv g {xv} (p , eq) = (xv .fst , p) , (\ i → _ , eq i) h-g : ∀ {xv} y → h {xv} (g {xv} y) ≡ y - h-g {x , v} (p , eq) = J (λ _ eq₁ → h (g (p , eq₁)) ≡ (p , eq₁)) (JRefl (λ xv₁ eq₁ → fiber (f (xv₁ .fst)) (xv₁ .snd)) ((p , refl))) (eq) + h-g {x , v} (p , eq) = J (λ _ eq₁ → h (g (p , eq₁)) ≡ (p , eq₁)) (JRefl (λ xv₁ eq₁ → fiber (f (xv₁ .fst)) (xv₁ .snd)) ((p , refl))) (eq) g-h : ∀ {xv} y → g {xv} (h {xv} y) ≡ y - g-h {xv} ((a , p) , eq) = J (λ _ eq₁ → g (h ((a , p) , eq₁)) ≡ ((a , p) , eq₁)) - (cong g (JRefl (λ xv₁ eq₁ → fiber (f (xv₁ .fst)) (xv₁ .snd)) (p , refl))) + g-h {xv} ((a , p) , eq) = J (λ _ eq₁ → g (h ((a , p) , eq₁)) ≡ ((a , p) , eq₁)) + (cong g (JRefl (λ xv₁ eq₁ → fiber (f (xv₁ .fst)) (xv₁ .snd)) (p , refl))) eq -- Thm 4.7.7 (fiberwise equivalences) fiberEquiv : ([tf] : isEquiv total) @@ -57,7 +57,7 @@ isContrToUniv {A} {B} = fiberEquiv (λ z → A ≡ z) (λ z → A ~ z) (\ B → idTo~ {A} {B}) (λ { .equiv-proof y - → isContrΣ (isContrSingl _) + → isContrΣ (isContrSingl _) \ a → isContr→isContrPath (c A) _ _ }) B @@ -69,33 +69,33 @@ -} recognizeId : {A : Type ℓ} {a : A} (Eq : A → Type ℓ') → Eq a - → isContr (Σ _ Eq) + → isContr (Σ _ Eq) → (x : A) → (a ≡ x) ≃ (Eq x) recognizeId {A = A} {a = a} Eq eqRefl eqContr x = (fiberMap x) , (isEquivFiberMap x) where fiberMap : (x : A) → a ≡ x → Eq x - fiberMap x = J (λ x p → Eq x) eqRefl + fiberMap x = J (λ x p → Eq x) eqRefl mapOnSigma : Σ[ x ∈ A ] a ≡ x → Σ _ Eq mapOnSigma pair = fst pair , fiberMap (fst pair) (snd pair) equivOnSigma : (x : A) → isEquiv mapOnSigma - equivOnSigma x = isEquivFromIsContr mapOnSigma (isContrSingl a) eqContr + equivOnSigma x = isEquivFromIsContr mapOnSigma (isContrSingl a) eqContr isEquivFiberMap : (x : A) → isEquiv (fiberMap x) isEquivFiberMap = fiberEquiv (λ x → a ≡ x) Eq fiberMap (equivOnSigma x) fundamentalTheoremOfId : {A : Type ℓ} (Eq : A → A → Type ℓ') → ((x : A) → Eq x x) - → ((x : A) → isContr (Σ[ y ∈ A ] Eq x y)) + → ((x : A) → isContr (Σ[ y ∈ A ] Eq x y)) → (x y : A) → (x ≡ y) ≃ (Eq x y) fundamentalTheoremOfId Eq eqRefl eqContr x = recognizeId (Eq x) (eqRefl x) (eqContr x) fundamentalTheoremOfIdβ : {A : Type ℓ} (Eq : A → A → Type ℓ') → (eqRefl : (x : A) → Eq x x) - → (eqContr : (x : A) → isContr (Σ[ y ∈ A ] Eq x y)) + → (eqContr : (x : A) → isContr (Σ[ y ∈ A ] Eq x y)) → (x : A) → fst (fundamentalTheoremOfId Eq eqRefl eqContr x x) refl ≡ eqRefl x -fundamentalTheoremOfIdβ Eq eqRefl eqContr x = JRefl (λ y p → Eq x y) (eqRefl x) +fundamentalTheoremOfIdβ Eq eqRefl eqContr x = JRefl (λ y p → Eq x y) (eqRefl x) \ No newline at end of file diff --git a/docs/Cubical.Foundations.Equiv.HalfAdjoint.html b/docs/Cubical.Foundations.Equiv.HalfAdjoint.html index faee942..5367ff2 100644 --- a/docs/Cubical.Foundations.Equiv.HalfAdjoint.html +++ b/docs/Cubical.Foundations.Equiv.HalfAdjoint.html @@ -30,7 +30,7 @@ com : ∀ a → cong f (linv a) ≡ rinv (f a) com-op : ∀ b → cong g (rinv b) ≡ linv (g b) - com-op b = subst (λ b → cong g (rinv b) ≡ linv (g b)) (rinv b) (helper (g b)) + com-op b = subst (λ b → cong g (rinv b) ≡ linv (g b)) (rinv b) (helper (g b)) where helper : ∀ a → cong g (rinv (f a)) ≡ linv (g (f a)) helper a i j = hcomp (λ k → λ { (i = i0) → g (rinv (f a) (j ∨ ~ k)) @@ -50,15 +50,15 @@ isCenter : ∀ xp → (g y , rinv y) ≡ xp isCenter (x , p) i = gy≡x i , ry≡p i where gy≡x : g y ≡ x - gy≡x = sym (cong g p) ∙∙ refl ∙∙ linv x + gy≡x = sym (cong g p) ∙∙ refl ∙∙ linv x - lem0 : Square (cong f (linv x)) p (cong f (linv x)) p + lem0 : Square (cong f (linv x)) p (cong f (linv x)) p lem0 i j = invSides-filler p (sym (cong f (linv x))) (~ i) j - ry≡p : Square (rinv y) p (cong f gy≡x) refl + ry≡p : Square (rinv y) p (cong f gy≡x) refl ry≡p i j = hcomp (λ k → λ { (i = i0) → cong rinv p k j ; (i = i1) → lem0 k j - ; (j = i0) → f (doubleCompPath-filler (sym (cong g p)) refl (linv x) k i) + ; (j = i0) → f (doubleCompPath-filler (sym (cong g p)) refl (linv x) k i) ; (j = i1) → p k }) (com x (~ i) j) @@ -77,9 +77,9 @@ η = Iso.leftInv e Hfa≡fHa : (f : A → A) → (H : ∀ a → f a ≡ a) → ∀ a → H (f a) ≡ cong f (H a) - Hfa≡fHa f H = J (λ f p → ∀ a → funExt⁻ (sym p) (f a) ≡ cong f (funExt⁻ (sym p) a)) + Hfa≡fHa f H = J (λ f p → ∀ a → funExt⁻ (sym p) (f a) ≡ cong f (funExt⁻ (sym p) a)) (λ a → refl) - (sym (funExt H)) + (sym (funExt H)) isHAEquivf : isHAEquiv f isHAEquiv.g isHAEquivf = g @@ -109,10 +109,10 @@ goal : Iso (x ≡ y) (Iso.fun e x ≡ Iso.fun e y) fun goal = cong (iso→HAEquiv e .fst) - inv goal p = sym (linv x) ∙∙ cong g p ∙∙ linv y + inv goal p = sym (linv x) ∙∙ cong g p ∙∙ linv y rightInv goal p i j = hcomp (λ k → λ { (i = i0) → iso→HAEquiv e .fst - (doubleCompPath-filler (sym (linv x)) (cong g p) (linv y) k j) + (doubleCompPath-filler (sym (linv x)) (cong g p) (linv y) k j) ; (i = i1) → rinv (p j) k ; (j = i0) → com x i k ; (j = i1) → com y i k }) @@ -124,17 +124,17 @@ (Iso.leftInv e (p j) i) invCongFunct : {x : A} (e : Iso A B) (p : Iso.fun e x ≡ Iso.fun e x) (q : Iso.fun e x ≡ Iso.fun e x) - → Iso.inv (congIso e) (p ∙ q) ≡ Iso.inv (congIso e) p ∙ Iso.inv (congIso e) q + → Iso.inv (congIso e) (p ∙ q) ≡ Iso.inv (congIso e) p ∙ Iso.inv (congIso e) q invCongFunct {x = x} e p q = helper (Iso.inv e) _ _ _ where helper : {x : A} {y : B} (f : A → B) (r : f x ≡ y) (p q : x ≡ x) - → (sym r ∙∙ cong f (p ∙ q) ∙∙ r) ≡ (sym r ∙∙ cong f p ∙∙ r) ∙ (sym r ∙∙ cong f q ∙∙ r) + → (sym r ∙∙ cong f (p ∙ q) ∙∙ r) ≡ (sym r ∙∙ cong f p ∙∙ r) ∙ (sym r ∙∙ cong f q ∙∙ r) helper {x = x} f = - J (λ y r → (p q : x ≡ x) - → (sym r ∙∙ cong f (p ∙ q) ∙∙ r) ≡ (sym r ∙∙ cong f p ∙∙ r) ∙ (sym r ∙∙ cong f q ∙∙ r)) + J (λ y r → (p q : x ≡ x) + → (sym r ∙∙ cong f (p ∙ q) ∙∙ r) ≡ (sym r ∙∙ cong f p ∙∙ r) ∙ (sym r ∙∙ cong f q ∙∙ r)) λ p q → (λ i → rUnit (congFunct f p q i) (~ i)) - ∙ λ i → rUnit (cong f p) i ∙ rUnit (cong f q) i + ∙ λ i → rUnit (cong f p) i ∙ rUnit (cong f q) i invCongRefl : {x : A} (e : Iso A B) → Iso.inv (congIso {x = x} {y = x} e) refl ≡ refl -invCongRefl {x = x} e = (λ i → (λ j → Iso.leftInv e x (i ∨ ~ j)) ∙∙ refl ∙∙ (λ j → Iso.leftInv e x (i ∨ j))) ∙ sym (rUnit refl) +invCongRefl {x = x} e = (λ i → (λ j → Iso.leftInv e x (i ∨ ~ j)) ∙∙ refl ∙∙ (λ j → Iso.leftInv e x (i ∨ j))) ∙ sym (rUnit refl) \ No newline at end of file diff --git a/docs/Cubical.Foundations.Equiv.Properties.html b/docs/Cubical.Foundations.Equiv.Properties.html index af3ef7d..85bae4a 100644 --- a/docs/Cubical.Foundations.Equiv.Properties.html +++ b/docs/Cubical.Foundations.Equiv.Properties.html @@ -77,7 +77,7 @@ hasRetract : (A → B) → Type _ hasRetract {A = A} {B = B} f = Σ[ g ∈ (B → A) ] retract f g -isEquiv→isContrHasSection : {f : A → B} → isEquiv f → isContr (hasSection f) +isEquiv→isContrHasSection : {f : A → B} → isEquiv f → isContr (hasSection f) fst (isEquiv→isContrHasSection isEq) = invIsEq isEq , secIsEq isEq snd (isEquiv→isContrHasSection isEq) (f , ε) i = (λ b → fst (p b i)) , (λ b → snd (p b i)) where p : ∀ b → (invIsEq isEq b , secIsEq isEq b) ≡ (f b , ε b) @@ -86,34 +86,34 @@ isEquiv→hasSection : {f : A → B} → isEquiv f → hasSection f isEquiv→hasSection = fst ∘ isEquiv→isContrHasSection -isContr-hasSection : (e : A ≃ B) → isContr (hasSection (fst e)) +isContr-hasSection : (e : A ≃ B) → isContr (hasSection (fst e)) isContr-hasSection e = isEquiv→isContrHasSection (snd e) -isEquiv→isContrHasRetract : {f : A → B} → isEquiv f → isContr (hasRetract f) +isEquiv→isContrHasRetract : {f : A → B} → isEquiv f → isContr (hasRetract f) fst (isEquiv→isContrHasRetract isEq) = invIsEq isEq , retIsEq isEq snd (isEquiv→isContrHasRetract {f = f} isEq) (g , η) = λ i → (λ b → p b i) , (λ a → q a i) where p : ∀ b → invIsEq isEq b ≡ g b - p b = sym (η (invIsEq isEq b)) ∙' cong g (secIsEq isEq b) + p b = sym (η (invIsEq isEq b)) ∙' cong g (secIsEq isEq b) -- one square from the definition of invIsEq - ieSq : ∀ a → Square (cong g (secIsEq isEq (f a))) + ieSq : ∀ a → Square (cong g (secIsEq isEq (f a))) refl (cong (g ∘ f) (retIsEq isEq a)) refl ieSq a k j = g (commSqIsEq isEq a k j) -- one square from η - ηSq : ∀ a → Square (η (invIsEq isEq (f a))) + ηSq : ∀ a → Square (η (invIsEq isEq (f a))) (η a) (cong (g ∘ f) (retIsEq isEq a)) (retIsEq isEq a) ηSq a i j = η (retIsEq isEq a i) j -- and one last square from the definition of p - pSq : ∀ b → Square (η (invIsEq isEq b)) + pSq : ∀ b → Square (η (invIsEq isEq b)) refl (cong g (secIsEq isEq b)) (p b) - pSq b i j = compPath'-filler (sym (η (invIsEq isEq b))) (cong g (secIsEq isEq b)) j i - q : ∀ a → Square (retIsEq isEq a) (η a) (p (f a)) refl + pSq b i j = compPath'-filler (sym (η (invIsEq isEq b))) (cong g (secIsEq isEq b)) j i + q : ∀ a → Square (retIsEq isEq a) (η a) (p (f a)) refl q a i j = hcomp (λ k → λ { (i = i0) → ηSq a j k ; (i = i1) → η a (j ∧ k) ; (j = i0) → pSq (f a) i k @@ -124,11 +124,11 @@ isEquiv→hasRetract : {f : A → B} → isEquiv f → hasRetract f isEquiv→hasRetract = fst ∘ isEquiv→isContrHasRetract -isContr-hasRetract : (e : A ≃ B) → isContr (hasRetract (fst e)) +isContr-hasRetract : (e : A ≃ B) → isContr (hasRetract (fst e)) isContr-hasRetract e = isEquiv→isContrHasRetract (snd e) isEquiv→retractIsEquiv : {f : A → B} {g : B → A} → isEquiv f → retract f g → isEquiv g -isEquiv→retractIsEquiv {f = f} {g = g} isEquiv-f retract-g = subst isEquiv f⁻¹≡g (snd f⁻¹) +isEquiv→retractIsEquiv {f = f} {g = g} isEquiv-f retract-g = subst isEquiv f⁻¹≡g (snd f⁻¹) where f⁻¹ = invEquiv (f , isEquiv-f) retract-f⁻¹ : retract f (fst f⁻¹) @@ -137,13 +137,13 @@ f⁻¹≡g : fst f⁻¹ ≡ g f⁻¹≡g = cong fst - (isContr→isProp (isEquiv→isContrHasRetract isEquiv-f) + (isContr→isProp (isEquiv→isContrHasRetract isEquiv-f) (fst f⁻¹ , retract-f⁻¹) (g , retract-g)) isEquiv→sectionIsEquiv : {f : A → B} {g : B → A} → isEquiv f → section f g → isEquiv g -isEquiv→sectionIsEquiv {f = f} {g = g} isEquiv-f section-g = subst isEquiv f⁻¹≡g (snd f⁻¹) +isEquiv→sectionIsEquiv {f = f} {g = g} isEquiv-f section-g = subst isEquiv f⁻¹≡g (snd f⁻¹) where f⁻¹ = invEquiv (f , isEquiv-f) section-f⁻¹ : section f (fst f⁻¹) @@ -152,7 +152,7 @@ f⁻¹≡g : fst f⁻¹ ≡ g f⁻¹≡g = cong fst - (isContr→isProp (isEquiv→isContrHasSection isEquiv-f) + (isContr→isProp (isEquiv→isContrHasSection isEquiv-f) (fst f⁻¹ , section-f⁻¹) (g , section-g)) @@ -163,11 +163,11 @@ cong≃-char F e = ua-pathToEquiv (cong F (ua e)) cong≃-idEquiv : (F : Type ℓ → Type ℓ') (A : Type ℓ) → cong≃ F (idEquiv A) ≡ idEquiv (F A) -cong≃-idEquiv F A = cong≃ F (idEquiv A) ≡⟨ cong (λ p → pathToEquiv (cong F p)) uaIdEquiv ⟩ - pathToEquiv refl ≡⟨ pathToEquivRefl ⟩ - idEquiv (F A) ∎ +cong≃-idEquiv F A = cong≃ F (idEquiv A) ≡⟨ cong (λ p → pathToEquiv (cong F p)) uaIdEquiv ⟩ + pathToEquiv refl ≡⟨ pathToEquivRefl ⟩ + idEquiv (F A) ∎ -isPropIsHAEquiv : {f : A → B} → isProp (isHAEquiv f) +isPropIsHAEquiv : {f : A → B} → isProp (isHAEquiv f) isPropIsHAEquiv {f = f} ishaef = goal ishaef where equivF : isEquiv f equivF = isHAEquiv→isEquiv ishaef @@ -176,10 +176,10 @@ rCoh1 (g , ε) = Σ[ η ∈ retract f g ] ∀ x → cong f (η x) ≡ ε (f x) rCoh2 : (sec : hasSection f) → Type _ - rCoh2 (g , ε) = Σ[ η ∈ retract f g ] ∀ x → Square (ε (f x)) refl (cong f (η x)) refl + rCoh2 (g , ε) = Σ[ η ∈ retract f g ] ∀ x → Square (ε (f x)) refl (cong f (η x)) refl rCoh3 : (sec : hasSection f) → Type _ - rCoh3 (g , ε) = ∀ x → Σ[ ηx ∈ g (f x) ≡ x ] Square (ε (f x)) refl (cong f ηx) refl + rCoh3 (g , ε) = ∀ x → Σ[ ηx ∈ g (f x) ≡ x ] Square (ε (f x)) refl (cong f ηx) refl rCoh4 : (sec : hasSection f) → Type _ rCoh4 (g , ε) = ∀ x → Path (fiber f (f x)) (g (f x) , ε (f x)) (x , refl) @@ -194,39 +194,39 @@ (λ _ → 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 - goal : isProp (isHAEquiv f) - goal = subst isProp (sym (ua characterization)) - (isPropΣ (isContr→isProp (isEquiv→isContrHasSection equivF)) - λ s → isPropΠ λ x → isProp→isSet (isContr→isProp (equivF .equiv-proof (f x))) _ _) + goal : isProp (isHAEquiv f) + goal = subst isProp (sym (ua characterization)) + (isPropΣ (isContr→isProp (isEquiv→isContrHasSection equivF)) + λ s → isPropΠ λ x → isProp→isSet (isContr→isProp (equivF .equiv-proof (f x))) _ _) -- loop spaces connected by a path are equivalent conjugatePathEquiv : {A : Type ℓ} {a b : A} (p : a ≡ b) → (a ≡ a) ≃ (b ≡ b) conjugatePathEquiv p = compEquiv (compPathrEquiv p) (compPathlEquiv (sym p)) -- composition on the right induces an equivalence of path types -compr≡Equiv : {A : Type ℓ} {a b c : A} (p q : a ≡ b) (r : b ≡ c) → (p ≡ q) ≃ (p ∙ r ≡ q ∙ r) -compr≡Equiv p q r = congEquiv ((λ s → s ∙ r) , compPathr-isEquiv r) +compr≡Equiv : {A : Type ℓ} {a b c : A} (p q : a ≡ b) (r : b ≡ c) → (p ≡ q) ≃ (p ∙ r ≡ q ∙ r) +compr≡Equiv p q r = congEquiv ((λ s → s ∙ r) , compPathr-isEquiv r) -- composition on the left induces an equivalence of path types -compl≡Equiv : {A : Type ℓ} {a b c : A} (p : a ≡ b) (q r : b ≡ c) → (q ≡ r) ≃ (p ∙ q ≡ p ∙ r) -compl≡Equiv p q r = congEquiv ((λ s → p ∙ s) , (compPathl-isEquiv p)) +compl≡Equiv : {A : Type ℓ} {a b c : A} (p : a ≡ b) (q r : b ≡ c) → (q ≡ r) ≃ (p ∙ q ≡ p ∙ r) +compl≡Equiv p q r = congEquiv ((λ s → p ∙ s) , (compPathl-isEquiv p)) isEquivFromIsContr : {A : Type ℓ} {B : Type ℓ'} - → (f : A → B) → isContr A → isContr B + → (f : A → B) → isContr A → isContr B → isEquiv f isEquivFromIsContr f isContrA isContrB = - subst isEquiv (λ i x → isContr→isProp isContrB (fst B≃A x) (f x) i) (snd B≃A) + subst isEquiv (λ i x → isContr→isProp isContrB (fst B≃A x) (f x) i) (snd B≃A) where B≃A = isContr→Equiv isContrA isContrB isEquiv[f∘equivFunA≃B]→isEquiv[f] : {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} @@ -254,4 +254,9 @@ w' : isEquiv (equivFun (invEquiv (_ , g∘fIsEquiv)) ∘ g) w' = snd (compEquiv (_ , gIsEquiv) (invEquiv (_ , g∘fIsEquiv))) + +isPointedTarget→isEquiv→isEquiv : {A B : Type ℓ} (f : A → B) + → (B → isEquiv f) → isEquiv f +equiv-proof (isPointedTarget→isEquiv→isEquiv f hf) = + λ y → equiv-proof (hf y) y \ No newline at end of file diff --git a/docs/Cubical.Foundations.Equiv.html b/docs/Cubical.Foundations.Equiv.html index 48bf693..493955b 100644 --- a/docs/Cubical.Foundations.Equiv.html +++ b/docs/Cubical.Foundations.Equiv.html @@ -45,15 +45,15 @@ -- Proof using isPropIsContr. This is slow and the direct proof below is better -isPropIsEquiv' : (f : A → B) → isProp (isEquiv f) +isPropIsEquiv' : (f : A → B) → isProp (isEquiv f) equiv-proof (isPropIsEquiv' f u0 u1 i) y = - isPropIsContr (u0 .equiv-proof y) (u1 .equiv-proof y) i + isPropIsContr (u0 .equiv-proof y) (u1 .equiv-proof y) i -- Direct proof that computes quite ok (can be optimized further if -- necessary, see: -- https://github.com/mortberg/cubicaltt/blob/pi4s3_dimclosures/examples/brunerie2.ctt#L562 -isPropIsEquiv : (f : A → B) → isProp (isEquiv f) +isPropIsEquiv : (f : A → B) → isProp (isEquiv f) equiv-proof (isPropIsEquiv f p q i) y = let p2 = p .equiv-proof y .snd q2 = q .equiv-proof y .snd @@ -65,7 +65,7 @@ (p2 w (i ∨ j)) equivEq : {e f : A ≃ B} → (h : e .fst ≡ f .fst) → e ≡ f -equivEq {e = e} {f = f} h = λ i → (h i) , isProp→PathP (λ i → isPropIsEquiv (h i)) (e .snd) (f .snd) i +equivEq {e = e} {f = f} h = λ i → (h i) , isProp→PathP (λ i → isPropIsEquiv (h i)) (e .snd) (f .snd) i module _ {f : A → B} (equivF : isEquiv f) where funIsEq : A → B @@ -80,7 +80,7 @@ retIsEq : retract f invIsEq retIsEq a i = equivF .equiv-proof (f a) .snd (a , refl) i .fst - commSqIsEq : ∀ a → Square (secIsEq (f a)) refl (cong f (retIsEq a)) refl + commSqIsEq : ∀ a → Square (secIsEq (f a)) refl (cong f (retIsEq a)) refl commSqIsEq a i = equivF .equiv-proof (f a) .snd (a , refl) i .snd commPathIsEq : ∀ a → secIsEq (f a) ≡ cong f (retIsEq a) @@ -126,11 +126,11 @@ contractG = g .snd .equiv-proof c .snd secFiller : (a : A) (p : g .fst (f .fst a) ≡ c) → _ {- square in A -} - secFiller a p = compPath-filler (cong (invEq f ∘ fst) (contractG (_ , p))) (retEq f a) + secFiller a p = compPath-filler (cong (invEq f ∘ fst) (contractG (_ , p))) (retEq f a) - contr : isContr (fiber (g .fst ∘ f .fst) c) + contr : isContr (fiber (g .fst ∘ f .fst) c) contr .fst .fst = invEq f (invEq g c) - contr .fst .snd = cong (g .fst) (secEq f (invEq g c)) ∙ secEq g c + contr .fst .snd = cong (g .fst) (secEq f (invEq g c)) ∙ secEq g c contr .snd (a , p) i .fst = secFiller a p i1 i contr .snd (a , p) i .snd j = hcomp @@ -161,42 +161,42 @@ compEquivEquivId e = equivEq refl invEquiv-is-rinv : (e : A ≃ B) → compEquiv e (invEquiv e) ≡ idEquiv A -invEquiv-is-rinv e = equivEq (funExt (retEq e)) +invEquiv-is-rinv e = equivEq (funExt (retEq e)) invEquiv-is-linv : (e : A ≃ B) → compEquiv (invEquiv e) e ≡ idEquiv B -invEquiv-is-linv e = equivEq (funExt (secEq e)) +invEquiv-is-linv e = equivEq (funExt (secEq e)) compEquiv-assoc : (f : A ≃ B) (g : B ≃ C) (h : C ≃ D) → compEquiv f (compEquiv g h) ≡ compEquiv (compEquiv f g) h compEquiv-assoc f g h = equivEq refl -LiftEquiv : A ≃ Lift {i = ℓ} {j = ℓ'} A -LiftEquiv .fst a .lower = a -LiftEquiv .snd .equiv-proof = strictContrFibers lower - -Lift≃Lift : (e : A ≃ B) → Lift {j = ℓ'} A ≃ Lift {j = ℓ''} B -Lift≃Lift e .fst a .lower = e .fst (a .lower) -Lift≃Lift e .snd .equiv-proof b .fst .fst .lower = invEq e (b .lower) -Lift≃Lift e .snd .equiv-proof b .fst .snd i .lower = - e .snd .equiv-proof (b .lower) .fst .snd i -Lift≃Lift e .snd .equiv-proof b .snd (a , p) i .fst .lower = - e .snd .equiv-proof (b .lower) .snd (a .lower , cong lower p) i .fst -Lift≃Lift e .snd .equiv-proof b .snd (a , p) i .snd j .lower = - e .snd .equiv-proof (b .lower) .snd (a .lower , cong lower p) i .snd j - -isContr→Equiv : isContr A → isContr B → A ≃ B +LiftEquiv : A ≃ Lift {i = ℓ} {j = ℓ'} A +LiftEquiv .fst a .lower = a +LiftEquiv .snd .equiv-proof = strictContrFibers lower + +Lift≃Lift : (e : A ≃ B) → Lift {j = ℓ'} A ≃ Lift {j = ℓ''} B +Lift≃Lift e .fst a .lower = e .fst (a .lower) +Lift≃Lift e .snd .equiv-proof b .fst .fst .lower = invEq e (b .lower) +Lift≃Lift e .snd .equiv-proof b .fst .snd i .lower = + e .snd .equiv-proof (b .lower) .fst .snd i +Lift≃Lift e .snd .equiv-proof b .snd (a , p) i .fst .lower = + e .snd .equiv-proof (b .lower) .snd (a .lower , cong lower p) i .fst +Lift≃Lift e .snd .equiv-proof b .snd (a , p) i .snd j .lower = + e .snd .equiv-proof (b .lower) .snd (a .lower , cong lower p) i .snd j + +isContr→Equiv : isContr A → isContr B → A ≃ B isContr→Equiv Actr Bctr = isoToEquiv (isContr→Iso Actr Bctr) -propBiimpl→Equiv : (Aprop : isProp A) (Bprop : isProp B) (f : A → B) (g : B → A) → A ≃ B +propBiimpl→Equiv : (Aprop : isProp A) (Bprop : isProp B) (f : A → B) (g : B → A) → A ≃ B propBiimpl→Equiv Aprop Bprop f g = f , hf where hf : isEquiv f hf .equiv-proof y .fst = (g y , Bprop (f (g y)) y) hf .equiv-proof y .snd h i .fst = Aprop (g y) (h .fst) i - hf .equiv-proof y .snd h i .snd = isProp→isSet' Bprop (Bprop (f (g y)) y) (h .snd) + hf .equiv-proof y .snd h i .snd = isProp→isSet' Bprop (Bprop (f (g y)) y) (h .snd) (cong f (Aprop (g y) (h .fst))) refl i -isEquivPropBiimpl→Equiv : isProp A → isProp B +isEquivPropBiimpl→Equiv : isProp A → isProp B → ((A → B) × (B → A)) ≃ (A ≃ B) isEquivPropBiimpl→Equiv {A = A} {B = B} Aprop Bprop = isoToEquiv isom where isom : Iso (Σ (A → B) (λ _ → B → A)) (A ≃ B) @@ -228,8 +228,8 @@ equiv→Iso : (A ≃ B) → (C ≃ D) → Iso (A → C) (B → D) equiv→Iso h k .Iso.fun f b = equivFun k (f (invEq h b)) equiv→Iso h k .Iso.inv g a = invEq k (g (equivFun h a)) -equiv→Iso h k .Iso.rightInv g = funExt λ b → secEq k _ ∙ cong g (secEq h b) -equiv→Iso h k .Iso.leftInv f = funExt λ a → retEq k _ ∙ cong f (retEq h a) +equiv→Iso h k .Iso.rightInv g = funExt λ b → secEq k _ ∙ cong g (secEq h b) +equiv→Iso h k .Iso.leftInv f = funExt λ a → retEq k _ ∙ cong f (retEq h a) equiv→ : (A ≃ B) → (C ≃ D) → (A → C) ≃ (B → D) equiv→ h k = isoToEquiv (equiv→Iso h k) @@ -250,16 +250,16 @@ isom .inv f' a = invEq (eB refl) (f' (eA .fst a)) isom .rightInv f' = - funExt λ a' → - J (λ a'' p → eB p .fst (invEq (eB refl) (f' (p i0))) ≡ f' a'') + funExt λ a' → + J (λ a'' p → eB p .fst (invEq (eB refl) (f' (p i0))) ≡ f' a'') (secEq (eB refl) (f' (eA .fst (invEq eA a')))) (secEq eA a') isom .leftInv f = - funExt λ a → - subst + funExt λ a → + subst (λ p → invEq (eB refl) (eB p .fst (f (invEq eA (eA .fst a)))) ≡ f a) (sym (commPathIsEq (eA .snd) a)) - (J (λ a'' p → invEq (eB refl) (eB (cong (eA .fst) p) .fst (f (invEq eA (eA .fst a)))) ≡ f a'') + (J (λ a'' p → invEq (eB refl) (eB (cong (eA .fst) p) .fst (f (invEq eA (eA .fst a)))) ≡ f a'') (retEq (eB refl) (f (invEq eA (eA .fst a)))) (retEq eA a)) @@ -268,7 +268,7 @@ (eA : A ≃ A') (eB : (a : A) → B a ≃ B' (eA .fst a)) → ((a : A) → B a) ≃ ((a' : A') → B' a') -equivΠ {B = B} {B' = B'} eA eB = equivΠ' eA (λ {a = a} p → J (λ a' p → B a ≃ B' a') (eB a) p) +equivΠ {B = B} {B' = B'} eA eB = equivΠ' eA (λ {a = a} p → J (λ a' p → B a ≃ B' a') (eB a) p) equivCompIso : (A ≃ B) → (C ≃ D) → Iso (A ≃ C) (B ≃ D) @@ -295,17 +295,17 @@ isoToIsEquiv (iso g f (λ b → (λ i → equiv-proof iseqf (f b) .snd (g (f b) , cong (λ h → h (f b)) id) (~ i) .fst) - ∙∙ cong (λ x → equiv-proof iseqf (f b) .fst .fst) id - ∙∙ λ i → equiv-proof iseqf (f b) .snd (b , refl) i .fst) + ∙∙ cong (λ x → equiv-proof iseqf (f b) .fst .fst) id + ∙∙ λ i → equiv-proof iseqf (f b) .snd (b , refl) i .fst) λ a i → id i a) precomposesToId→Equiv : (f : A → B) (g : B → A) → f ∘ g ≡ idfun B → isEquiv g → isEquiv f -precomposesToId→Equiv f g id iseqg = subst isEquiv (sym f-≡-g⁻) (snd (invEquiv (_ , iseqg))) +precomposesToId→Equiv f g id iseqg = subst isEquiv (sym f-≡-g⁻) (snd (invEquiv (_ , iseqg))) where g⁻ = invEq (g , iseqg) f-≡-g⁻ : _ - f-≡-g⁻ = cong (f ∘_ ) (cong fst (sym (invEquiv-is-linv (g , iseqg)))) ∙ cong (_∘ g⁻) id + f-≡-g⁻ = cong (f ∘_ ) (cong fst (sym (invEquiv-is-linv (g , iseqg)))) ∙ cong (_∘ g⁻) id -- equivalence between isEquiv and isEquiv' diff --git a/docs/Cubical.Foundations.Function.html b/docs/Cubical.Foundations.Function.html index 1292bd3..8818ac2 100644 --- a/docs/Cubical.Foundations.Function.html +++ b/docs/Cubical.Foundations.Function.html @@ -92,7 +92,7 @@ 2-Constant : (A → B) → Type _ 2-Constant f = ∀ x y → f x ≡ f y - 2-Constant-isProp : isSet B → (f : A → B) → isProp (2-Constant f) + 2-Constant-isProp : isSet B → (f : A → B) → isProp (2-Constant f) 2-Constant-isProp Bset f link1 link2 i x y j = Bset (f x) (f y) (link1 x y) (link2 x y) i j @@ -100,9 +100,9 @@ record 3-Constant (f : A → B) : Type (ℓ-max ℓ ℓ') where field link : 2-Constant f - coh₁ : ∀ x y z → Square (link x y) (link x z) refl (link y z) + coh₁ : ∀ x y z → Square (link x y) (link x z) refl (link y z) - coh₂ : ∀ x y z → Square (link x z) (link y z) (link x y) refl + coh₂ : ∀ x y z → Square (link x z) (link y z) (link x y) refl coh₂ x y z i j = hcomp (λ k → λ { (j = i0) → link x y i @@ -122,7 +122,7 @@ }) (coh₁ x x x (~ i) j) - downleft : ∀ x y → Square (link x y) refl refl (link y x) + downleft : ∀ x y → Square (link x y) refl refl (link y x) downleft x y i j = hcomp (λ k → λ { (i = i0) → link x y j @@ -143,10 +143,10 @@ (downleft x y i j) homotopyNatural : {B : Type ℓ'} {f g : A → B} (H : ∀ a → f a ≡ g a) {x y : A} (p : x ≡ y) → - H x ∙ cong g p ≡ cong f p ∙ H y + H x ∙ cong g p ≡ cong f p ∙ H y homotopyNatural {f = f} {g = g} H {x} {y} p i j = - hcomp (λ k → λ { (i = i0) → compPath-filler (H x) (cong g p) k j - ; (i = i1) → compPath-filler' (cong f p) (H y) k j + hcomp (λ k → λ { (i = i0) → compPath-filler (H x) (cong g p) k j + ; (i = i1) → compPath-filler' (cong f p) (H y) k j ; (j = i0) → cong f p (i ∧ ~ k) ; (j = i1) → cong g p (i ∨ k) }) (H (p i) j) diff --git a/docs/Cubical.Foundations.GroupoidLaws.html b/docs/Cubical.Foundations.GroupoidLaws.html index b092b07..07e065b 100644 --- a/docs/Cubical.Foundations.GroupoidLaws.html +++ b/docs/Cubical.Foundations.GroupoidLaws.html @@ -26,8 +26,8 @@ symInvo : (p : x ≡ y) → p ≡ p ⁻¹ ⁻¹ symInvo p = refl -rUnit : (p : x ≡ y) → p ≡ p ∙ refl -rUnit p j i = compPath-filler p refl j i +rUnit : (p : x ≡ y) → p ≡ p ∙ refl +rUnit p j i = compPath-filler p refl j i -- The filler of left unit: lUnit-filler p = -- PathP (λ i → PathP (λ j → PathP (λ k → A) x (p (~ j ∨ i))) @@ -41,13 +41,13 @@ -- ; (k = i1) → compPath-filler refl p j i }) (inS (p (~ k ∧ i ))) j -lUnit : (p : x ≡ y) → p ≡ refl ∙ p +lUnit : (p : x ≡ y) → p ≡ refl ∙ p lUnit p j i = lUnit-filler p i1 j i symRefl : refl {x = x} ≡ refl ⁻¹ symRefl i = refl -compPathRefl : refl {x = x} ≡ refl ∙ refl +compPathRefl : refl {x = x} ≡ refl ∙ refl compPathRefl = rUnit refl -- The filler of right cancellation: rCancel-filler p = @@ -62,7 +62,7 @@ ; (j = i1) → x }) (inS (p (i ∧ ~ j))) k -rCancel : (p : x ≡ y) → p ∙ p ⁻¹ ≡ refl +rCancel : (p : x ≡ y) → p ∙ p ⁻¹ ≡ refl rCancel {x = x} p j i = rCancel-filler p i1 j i rCancel-filler' : ∀ {ℓ} {A : Type ℓ} {x y : A} (p : x ≡ y) → (i j k : I) → A @@ -76,15 +76,15 @@ (inS (p k)) (~ i) -rCancel' : ∀ {ℓ} {A : Type ℓ} {x y : A} (p : x ≡ y) → p ∙ p ⁻¹ ≡ refl +rCancel' : ∀ {ℓ} {A : Type ℓ} {x y : A} (p : x ≡ y) → p ∙ p ⁻¹ ≡ refl rCancel' p j k = rCancel-filler' p i0 j k -lCancel : (p : x ≡ y) → p ⁻¹ ∙ p ≡ refl +lCancel : (p : x ≡ y) → p ⁻¹ ∙ p ≡ refl lCancel p = rCancel (p ⁻¹) assoc : (p : x ≡ y) (q : y ≡ z) (r : z ≡ w) → - p ∙ q ∙ r ≡ (p ∙ q) ∙ r -assoc p q r k = (compPath-filler p q k) ∙ compPath-filler' q r (~ k) + p ∙ q ∙ r ≡ (p ∙ q) ∙ r +assoc p q r k = (compPath-filler p q k) ∙ compPath-filler' q r (~ k) -- heterogeneous groupoid laws @@ -94,17 +94,17 @@ symInvoP p = refl rUnitP : {A : I → Type ℓ} → {x : A i0} → {y : A i1} → (p : PathP A x y) → - PathP (λ j → PathP (λ i → rUnit (λ i → A i) j i) x y) p (compPathP p refl) -rUnitP p j i = compPathP-filler p refl j i + PathP (λ j → PathP (λ i → rUnit (λ i → A i) j i) x y) p (compPathP p refl) +rUnitP p j i = compPathP-filler p refl j i rUnitP' : ∀ {ℓ'} {A : Type ℓ} (B : A → Type ℓ') {x y : A} {p : x ≡ y} {z : B x} {w : B y} (q : PathP (λ i → B (p i)) z w) - → PathP (λ j → PathP (λ i → B (rUnit p j i)) z w) q (compPathP' {B = B} q refl) -rUnitP' B {w = w} q j i = compPathP'-filler {B = B} q (refl {x = w}) j i + → PathP (λ j → PathP (λ i → B (rUnit p j i)) z w) q (compPathP' {B = B} q refl) +rUnitP' B {w = w} q j i = compPathP'-filler {B = B} q (refl {x = w}) j i lUnitP : {A : I → Type ℓ} → {x : A i0} → {y : A i1} → (p : PathP A x y) → - PathP (λ j → PathP (λ i → lUnit (λ i → A i) j i) x y) p (compPathP refl p) + PathP (λ j → PathP (λ i → lUnit (λ i → A i) j i) x y) p (compPathP refl p) lUnitP {A = A} {x = x} p k i = comp (λ j → lUnit-filler (λ i → A i) j k i) (λ j → λ { (i = i0) → x @@ -115,7 +115,7 @@ lUnitP' : ∀ {ℓ'} {A : Type ℓ} (B : A → Type ℓ') {x y : A} {p : x ≡ y} {z : B x} {w : B y} (q : PathP (λ i → B (p i)) z w) - → PathP (λ j → PathP (λ i → B (lUnit p j i)) z w) q (compPathP' {B = B} refl q) + → PathP (λ j → PathP (λ i → B (lUnit p j i)) z w) q (compPathP' {B = B} refl q) lUnitP' B {p = p} {z = z} q k i = comp (λ j → B (lUnit-filler p j k i)) (λ j → λ { (i = i0) → z @@ -124,7 +124,7 @@ }) (q (~ k ∧ i )) rCancelP : {A : I → Type ℓ} → {x : A i0} → {y : A i1} → (p : PathP A x y) → - PathP (λ j → PathP (λ i → rCancel (λ i → A i) j i) x x) (compPathP p (symP p)) refl + PathP (λ j → PathP (λ i → rCancel (λ i → A i) j i) x x) (compPathP p (symP p)) refl rCancelP {A = A} {x = x} p j i = comp (λ k → rCancel-filler (λ i → A i) k j i) (λ k → λ { (i = i0) → x @@ -133,19 +133,19 @@ }) (p (i ∧ ~ j)) lCancelP : {A : I → Type ℓ} → {x : A i0} → {y : A i1} → (p : PathP A x y) → - PathP (λ j → PathP (λ i → lCancel (λ i → A i) j i) y y) (compPathP (symP p) p) refl + PathP (λ j → PathP (λ i → lCancel (λ i → A i) j i) y y) (compPathP (symP p) p) refl lCancelP p = rCancelP (symP p) assocP : {A : I → Type ℓ} {x : A i0} {y : A i1} {B_i1 : Type ℓ} {B : (A i1) ≡ B_i1} {z : B i1} {C_i1 : Type ℓ} {C : (B i1) ≡ C_i1} {w : C i1} (p : PathP A x y) (q : PathP (λ i → B i) y z) (r : PathP (λ i → C i) z w) → - PathP (λ j → PathP (λ i → assoc (λ i → A i) B C j i) x w) (compPathP p (compPathP q r)) (compPathP (compPathP p q) r) + PathP (λ j → PathP (λ i → assoc (λ i → A i) B C j i) x w) (compPathP p (compPathP q r)) (compPathP (compPathP p q) r) assocP {A = A} {B = B} {C = C} p q r k i = comp (\ j' → hfill (λ j → λ { (i = i0) → A i0 - ; (i = i1) → compPath-filler' (λ i₁ → B i₁) (λ i₁ → C i₁) (~ k) j }) - (inS (compPath-filler (λ i₁ → A i₁) (λ i₁ → B i₁) k i)) j') + ; (i = i1) → compPath-filler' (λ i₁ → B i₁) (λ i₁ → C i₁) (~ k) j }) + (inS (compPath-filler (λ i₁ → A i₁) (λ i₁ → B i₁) k i)) j') (λ j → λ { (i = i0) → p i0 ; (i = i1) → @@ -161,7 +161,7 @@ }) (q (j ∨ k)) }) - (compPathP-filler p q k i) + (compPathP-filler p q k i) @@ -169,7 +169,7 @@ -- some exchange law for doubleCompPath and refl -invSides-filler : {x y z : A} (p : x ≡ y) (q : x ≡ z) → Square p (sym q) q (sym p) +invSides-filler : {x y z : A} (p : x ≡ y) (q : x ≡ z) → Square p (sym q) q (sym p) invSides-filler {x = x} p q i j = hcomp (λ k → λ { (i = i0) → p (k ∧ j) ; (i = i1) → q (~ j ∧ k) @@ -178,7 +178,7 @@ x leftright : {ℓ : Level} {A : Type ℓ} {x y z : A} (p : x ≡ y) (q : y ≡ z) → - (refl ∙∙ p ∙∙ q) ≡ (p ∙∙ q ∙∙ refl) + (refl ∙∙ p ∙∙ q) ≡ (p ∙∙ q ∙∙ refl) leftright p q i j = hcomp (λ t → λ { (j = i0) → p (i ∧ (~ t)) ; (j = i1) → q (t ∨ i) }) @@ -187,44 +187,44 @@ -- equating doubleCompPath and a succession of two compPath split-leftright : {ℓ : Level} {A : Type ℓ} {w x y z : A} (p : w ≡ x) (q : x ≡ y) (r : y ≡ z) → - (p ∙∙ q ∙∙ r) ≡ (refl ∙∙ (p ∙∙ q ∙∙ refl) ∙∙ r) + (p ∙∙ q ∙∙ r) ≡ (refl ∙∙ (p ∙∙ q ∙∙ refl) ∙∙ r) split-leftright p q r j i = hcomp (λ t → λ { (i = i0) → p (~ j ∧ ~ t) ; (i = i1) → r t }) - (doubleCompPath-filler p q refl j i) + (doubleCompPath-filler p q refl j i) split-leftright' : {ℓ : Level} {A : Type ℓ} {w x y z : A} (p : w ≡ x) (q : x ≡ y) (r : y ≡ z) → - (p ∙∙ q ∙∙ r) ≡ (p ∙∙ (refl ∙∙ q ∙∙ r) ∙∙ refl) + (p ∙∙ q ∙∙ r) ≡ (p ∙∙ (refl ∙∙ q ∙∙ r) ∙∙ refl) split-leftright' p q r j i = hcomp (λ t → λ { (i = i0) → p (~ t) ; (i = i1) → r (j ∨ t) }) - (doubleCompPath-filler refl q r j i) + (doubleCompPath-filler refl q r j i) doubleCompPath-elim : {ℓ : Level} {A : Type ℓ} {w x y z : A} (p : w ≡ x) (q : x ≡ y) - (r : y ≡ z) → (p ∙∙ q ∙∙ r) ≡ (p ∙ q) ∙ r -doubleCompPath-elim p q r = (split-leftright p q r) ∙ (λ i → (leftright p q (~ i)) ∙ r) + (r : y ≡ z) → (p ∙∙ q ∙∙ r) ≡ (p ∙ q) ∙ r +doubleCompPath-elim p q r = (split-leftright p q r) ∙ (λ i → (leftright p q (~ i)) ∙ r) doubleCompPath-elim' : {ℓ : Level} {A : Type ℓ} {w x y z : A} (p : w ≡ x) (q : x ≡ y) - (r : y ≡ z) → (p ∙∙ q ∙∙ r) ≡ p ∙ (q ∙ r) -doubleCompPath-elim' p q r = (split-leftright' p q r) ∙ (sym (leftright p (q ∙ r))) + (r : y ≡ z) → (p ∙∙ q ∙∙ r) ≡ p ∙ (q ∙ r) +doubleCompPath-elim' p q r = (split-leftright' p q r) ∙ (sym (leftright p (q ∙ r))) cong-∙∙-filler : ∀ {ℓ ℓ'} {A : Type ℓ} {B : Type ℓ'} {x y z w : A} (f : A → B) (p : w ≡ x) (q : x ≡ y) (r : y ≡ z) → I → I → I → B cong-∙∙-filler {A = A} f p q r k j i = - hfill ((λ k → λ { (j = i1) → doubleCompPath-filler (cong f p) (cong f q) (cong f r) k i - ; (j = i0) → f (doubleCompPath-filler p q r k i) + hfill ((λ k → λ { (j = i1) → doubleCompPath-filler (cong f p) (cong f q) (cong f r) k i + ; (j = i0) → f (doubleCompPath-filler p q r k i) ; (i = i0) → f (p (~ k)) ; (i = i1) → f (r k) })) (inS (f (q i))) k cong-∙∙ : ∀ {B : Type ℓ} (f : A → B) (p : w ≡ x) (q : x ≡ y) (r : y ≡ z) - → cong f (p ∙∙ q ∙∙ r) ≡ (cong f p) ∙∙ (cong f q) ∙∙ (cong f r) + → cong f (p ∙∙ q ∙∙ r) ≡ (cong f p) ∙∙ (cong f q) ∙∙ (cong f r) cong-∙∙ f p q r j i = cong-∙∙-filler f p q r i1 j i cong-∙ : ∀ {B : Type ℓ} (f : A → B) (p : x ≡ y) (q : y ≡ z) - → cong f (p ∙ q) ≡ (cong f p) ∙ (cong f q) + → cong f (p ∙ q) ≡ (cong f p) ∙ (cong f q) cong-∙ f p q = cong-∙∙ f refl p q hcomp-unique : ∀ {ℓ} {A : Type ℓ} {φ} @@ -286,23 +286,23 @@ congFunct-filler {x = x} f p q i j z = hfill (λ k → λ { (i = i0) → f x ; (i = i1) → f (q k) - ; (j = i0) → f (compPath-filler p q k i)}) + ; (j = i0) → f (compPath-filler p q k i)}) (inS (f (p i))) z -congFunct : ∀ {ℓ} {B : Type ℓ} (f : A → B) (p : x ≡ y) (q : y ≡ z) → cong f (p ∙ q) ≡ cong f p ∙ cong f q +congFunct : ∀ {ℓ} {B : Type ℓ} (f : A → B) (p : x ≡ y) (q : y ≡ z) → cong f (p ∙ q) ≡ cong f p ∙ cong f q congFunct f p q j i = congFunct-filler f p q i j i1 -- congFunct for dependent types congFunct-dep : ∀ {ℓ ℓ'} {A : Type ℓ} {B : A → Type ℓ'} {x y z : A} (f : (a : A) → B a) (p : x ≡ y) (q : y ≡ z) - → PathP (λ i → PathP (λ j → B (compPath-filler p q i j)) (f x) (f (q i))) (cong f p) (cong f (p ∙ q)) -congFunct-dep {B = B} {x = x} f p q i j = f (compPath-filler p q i j) + → PathP (λ i → PathP (λ j → B (compPath-filler p q i j)) (f x) (f (q i))) (cong f p) (cong f (p ∙ q)) +congFunct-dep {B = B} {x = x} f p q i j = f (compPath-filler p q i j) cong₂Funct : ∀ {ℓ ℓ'} {A : Type ℓ} {x y : A} {B : Type ℓ'} (f : A → A → B) → (p : x ≡ y) → {u v : A} (q : u ≡ v) → - cong₂ f p q ≡ cong (λ x → f x u) p ∙ cong (f y) q + cong₂ f p q ≡ cong (λ x → f x u) p ∙ cong (f y) q cong₂Funct {x = x} {y = y} f p {u = u} {v = v} q j i = hcomp (λ k → λ { (i = i0) → f x u ; (i = i1) → f y (q k) @@ -316,7 +316,7 @@ (inS (invSides-filler q (sym p) i j)) k -symDistr : ∀ {ℓ} {A : Type ℓ} {x y z : A} (p : x ≡ y) (q : y ≡ z) → sym (p ∙ q) ≡ sym q ∙ sym p +symDistr : ∀ {ℓ} {A : Type ℓ} {x y z : A} (p : x ≡ y) (q : y ≡ z) → sym (p ∙ q) ≡ sym q ∙ sym p symDistr p q i j = symDistr-filler p q j i i1 -- we can not write hcomp-isEquiv : {ϕ : I} → (p : I → Partial ϕ A) → isEquiv (λ (a : A [ ϕ ↦ p i0 ]) → hcomp p a) @@ -339,15 +339,15 @@ pentagonIdentity : (p : x ≡ y) → (q : y ≡ z) → (r : z ≡ w) → (s : w ≡ v) → - (assoc p q (r ∙ s) ∙ assoc (p ∙ q) r s) + (assoc p q (r ∙ s) ∙ assoc (p ∙ q) r s) ≡ - cong (p ∙_) (assoc q r s) ∙∙ assoc p (q ∙ r) s ∙∙ cong (_∙ s) (assoc p q r) + cong (p ∙_) (assoc q r s) ∙∙ assoc p (q ∙ r) s ∙∙ cong (_∙ s) (assoc p q r) pentagonIdentity {x = x} {y} p q r s = (λ i → - (λ j → cong (p ∙_) (assoc q r s) (i ∧ j)) - ∙∙ (λ j → lemma₀₀ i j ∙ lemma₀₁ i j) - ∙∙ (λ j → lemma₁₀ i j ∙ lemma₁₁ i j) + (λ j → cong (p ∙_) (assoc q r s) (i ∧ j)) + ∙∙ (λ j → lemma₀₀ i j ∙ lemma₀₁ i j) + ∙∙ (λ j → lemma₁₀ i j ∙ lemma₁₁ i j) ) where @@ -378,7 +378,7 @@ ; (i = i1) → s (k₁ ∧ k ∧ i₁) ; (i₁ = i1)(k = i1) → s k₁ }) (r ((i₁ ∧ k) ∨ i)) - ; (i₁ = i0) → compPath-filler q r i j + ; (i₁ = i0) → compPath-filler q r i j ; (i₁ = i1) → hcomp (λ k₁ → λ { (k = i0) → r i ; (k = i1) → s k₁ @@ -413,7 +413,7 @@ ; (i = i0) → r (k ∧ j ∧ k₁) }) (q (k ∨ j ∨ ~ i)) - ; (i = i0)(j = i0) → (p ∙ q) i₁ + ; (i = i0)(j = i0) → (p ∙ q) i₁ }) (hcomp (λ k → λ { (i₁ = i0) → x @@ -425,7 +425,7 @@ lemma₁₀-front : I → I → I → _ lemma₁₀-front i j i₁ = - (((λ _ → x) ∙∙ compPath-filler p q j ∙∙ + (((λ _ → x) ∙∙ compPath-filler p q j ∙∙ (λ i₁ → hcomp (λ k → λ { (i₁ = i0) → q j @@ -438,15 +438,15 @@ compPath-filler-in-filler : (p : _ ≡ y) → (q : _ ≡ _ ) - → _≡_ {A = Square (p ∙ q) (p ∙ q) (λ _ → x) (λ _ → z)} + → _≡_ {A = Square (p ∙ q) (p ∙ q) (λ _ → x) (λ _ → z)} (λ i j → hcomp (λ i₂ → λ { (j = i0) → x ; (j = i1) → q (i₂ ∨ ~ i) - ; (i = i0) → (p ∙ q) j + ; (i = i0) → (p ∙ q) j }) - (compPath-filler p q (~ i) j)) - (λ _ → p ∙ q) + (compPath-filler p q (~ i) j)) + (λ _ → p ∙ q) compPath-filler-in-filler p q z i j = hcomp (λ k → λ { @@ -459,21 +459,21 @@ ;(z = i1) (k = i0) → p j }) (p j) - ; (i = i1) → compPath-filler p (λ i₁ → q (k ∧ i₁)) k j + ; (i = i1) → compPath-filler p (λ i₁ → q (k ∧ i₁)) k j ; (z = i0) → hfill ((λ i₂ → λ { (j = i0) → p i0 ; (j = i1) → q (i₂ ∨ ~ i) - ; (i = i0) → (p ∙ q) j + ; (i = i0) → (p ∙ q) j })) - (inS ((compPath-filler p q (~ i) j))) k - ; (z = i1) → compPath-filler p q k j + (inS ((compPath-filler p q (~ i) j))) k + ; (z = i1) → compPath-filler p q k j }) - (compPath-filler p q (~ i ∧ ~ z) j) + (compPath-filler p q (~ i ∧ ~ z) j) cube-comp₋₀₋ : (c : I → I → I → A) - → {a' : Square _ _ _ _} + → {a' : Square _ _ _ _} → (λ i i₁ → c i i0 i₁) ≡ a' → (I → I → I → A) cube-comp₋₀₋ c p i j k = @@ -490,7 +490,7 @@ cube-comp₀₋₋ : (c : I → I → I → A) - → {a' : Square _ _ _ _} + → {a' : Square _ _ _ _} → (λ i i₁ → c i0 i i₁) ≡ a' → (I → I → I → A) cube-comp₀₋₋ c p i j k = @@ -529,6 +529,6 @@ ∙∙lCancel : ∀ {ℓ} {A : Type ℓ} {x y : A} → (p : x ≡ y) - → sym p ∙∙ refl ∙∙ p ≡ refl + → sym p ∙∙ refl ∙∙ p ≡ refl ∙∙lCancel p i j = ∙∙lCancel-fill p i j i1 \ No newline at end of file diff --git a/docs/Cubical.Foundations.HLevels.html b/docs/Cubical.Foundations.HLevels.html index 5620431..79051dd 100644 --- a/docs/Cubical.Foundations.HLevels.html +++ b/docs/Cubical.Foundations.HLevels.html @@ -43,8 +43,8 @@ n : HLevel isOfHLevel : HLevel → Type ℓ → Type ℓ -isOfHLevel 0 A = isContr A -isOfHLevel 1 A = isProp A +isOfHLevel 0 A = isContr A +isOfHLevel 1 A = isProp A isOfHLevel (suc (suc n)) A = (x y : A) → isOfHLevel (suc n) (x ≡ y) isOfHLevelFun : (n : HLevel) {A : Type ℓ} {B : Type ℓ'} (f : A → B) → Type (ℓ-max ℓ ℓ') @@ -54,12 +54,12 @@ ∀ {ℓ} {A : Type ℓ} (n : ℕ) → ((x : A) → isOfHLevel (suc n) (x ≡ x)) → isOfHLevel (2 + n) A isOfHLevelΩ→isOfHLevel zero hΩ x y = - J (λ y p → (q : x ≡ y) → p ≡ q) (hΩ x refl) + J (λ y p → (q : x ≡ y) → p ≡ q) (hΩ x refl) isOfHLevelΩ→isOfHLevel (suc n) hΩ x y = - J (λ y p → (q : x ≡ y) → isOfHLevel (suc n) (p ≡ q)) (hΩ x refl) + J (λ y p → (q : x ≡ y) → isOfHLevel (suc n) (p ≡ q)) (hΩ x refl) TypeOfHLevel : ∀ ℓ → HLevel → Type (ℓ-suc ℓ) -TypeOfHLevel ℓ n = TypeWithStr ℓ (isOfHLevel n) +TypeOfHLevel ℓ n = TypeWithStr ℓ (isOfHLevel n) hProp hSet hGroupoid h2Groupoid : ∀ ℓ → Type (ℓ-suc ℓ) hProp ℓ = TypeOfHLevel ℓ 1 @@ -70,25 +70,25 @@ -- lower h-levels imply higher h-levels isOfHLevelSuc : (n : HLevel) → isOfHLevel n A → isOfHLevel (suc n) A -isOfHLevelSuc 0 = isContr→isProp -isOfHLevelSuc 1 = isProp→isSet +isOfHLevelSuc 0 = isContr→isProp +isOfHLevelSuc 1 = isProp→isSet isOfHLevelSuc (suc (suc n)) h a b = isOfHLevelSuc (suc n) (h a b) -isSet→isGroupoid : isSet A → isGroupoid A +isSet→isGroupoid : isSet A → isGroupoid A isSet→isGroupoid = isOfHLevelSuc 2 -isGroupoid→is2Groupoid : isGroupoid A → is2Groupoid A +isGroupoid→is2Groupoid : isGroupoid A → is2Groupoid A isGroupoid→is2Groupoid = isOfHLevelSuc 3 isOfHLevelPlus : (m : HLevel) → isOfHLevel n A → isOfHLevel (m + n) A isOfHLevelPlus zero hA = hA isOfHLevelPlus (suc m) hA = isOfHLevelSuc _ (isOfHLevelPlus m hA) -isContr→isOfHLevel : (n : HLevel) → isContr A → isOfHLevel n A +isContr→isOfHLevel : (n : HLevel) → isContr A → isOfHLevel n A isContr→isOfHLevel zero cA = cA isContr→isOfHLevel (suc n) cA = isOfHLevelSuc _ (isContr→isOfHLevel n cA) -isProp→isOfHLevelSuc : (n : HLevel) → isProp A → isOfHLevel (suc n) A +isProp→isOfHLevelSuc : (n : HLevel) → isProp A → isOfHLevel (suc n) A isProp→isOfHLevelSuc zero pA = pA isProp→isOfHLevelSuc (suc n) pA = isOfHLevelSuc _ (isProp→isOfHLevelSuc n pA) @@ -99,11 +99,11 @@ -- hlevel of path types -isProp→isContrPath : isProp A → (x y : A) → isContr (x ≡ y) -isProp→isContrPath h x y = h x y , isProp→isSet h x y _ +isProp→isContrPath : isProp A → (x y : A) → isContr (x ≡ y) +isProp→isContrPath h x y = h x y , isProp→isSet h x y _ -isContr→isContrPath : isContr A → (x y : A) → isContr (x ≡ y) -isContr→isContrPath cA = isProp→isContrPath (isContr→isProp cA) +isContr→isContrPath : isContr A → (x y : A) → isContr (x ≡ y) +isContr→isContrPath cA = isProp→isContrPath (isContr→isProp cA) isOfHLevelPath' : (n : HLevel) → isOfHLevel (suc n) A → (x y : A) → isOfHLevel n (x ≡ y) isOfHLevelPath' 0 = isProp→isContrPath @@ -119,23 +119,23 @@ -- h-level of isOfHLevel -isPropIsOfHLevel : (n : HLevel) → isProp (isOfHLevel n A) -isPropIsOfHLevel 0 = isPropIsContr -isPropIsOfHLevel 1 = isPropIsProp +isPropIsOfHLevel : (n : HLevel) → isProp (isOfHLevel n A) +isPropIsOfHLevel 0 = isPropIsContr +isPropIsOfHLevel 1 = isPropIsProp isPropIsOfHLevel (suc (suc n)) f g i a b = isPropIsOfHLevel (suc n) (f a b) (g a b) i -isPropIsSet : isProp (isSet A) +isPropIsSet : isProp (isSet A) isPropIsSet = isPropIsOfHLevel 2 -isPropIsGroupoid : isProp (isGroupoid A) +isPropIsGroupoid : isProp (isGroupoid A) isPropIsGroupoid = isPropIsOfHLevel 3 -isPropIs2Groupoid : isProp (is2Groupoid A) +isPropIs2Groupoid : isProp (is2Groupoid A) isPropIs2Groupoid = isPropIsOfHLevel 4 -TypeOfHLevel≡ : (n : HLevel) {X Y : TypeOfHLevel ℓ n} → ⟨ X ⟩ ≡ ⟨ Y ⟩ → X ≡ Y -TypeOfHLevel≡ n = Σ≡Prop (λ _ → isPropIsOfHLevel n) +TypeOfHLevel≡ : (n : HLevel) {X Y : TypeOfHLevel ℓ n} → ⟨ X ⟩ ≡ ⟨ Y ⟩ → X ≡ Y +TypeOfHLevel≡ n = Σ≡Prop (λ _ → isPropIsOfHLevel n) -- hlevels are preserved by retracts (and consequently equivalences) @@ -143,15 +143,15 @@ : ∀ {B : Type ℓ} → (f : A → B) (g : B → A) → (h : retract f g) - → (v : isContr B) → isContr A + → (v : isContr B) → isContr A fst (isContrRetract f g h (b , p)) = g b -snd (isContrRetract f g h (b , p)) x = (cong g (p (f x))) ∙ (h x) +snd (isContrRetract f g h (b , p)) x = (cong g (p (f x))) ∙ (h x) isPropRetract : {B : Type ℓ} (f : A → B) (g : B → A) (h : (x : A) → g (f x) ≡ x) - → isProp B → isProp A + → isProp B → isProp A isPropRetract f g h p x y i = hcomp (λ j → λ @@ -163,7 +163,7 @@ : {B : Type ℓ} (f : A → B) (g : B → A) (h : (x : A) → g (f x) ≡ x) - → isSet B → isSet A + → isSet B → isSet A isSetRetract f g h set x y p q i j = hcomp (λ k → λ { (i = i0) → h (p j) k ; (i = i1) → h (q j) k @@ -176,7 +176,7 @@ : {B : Type ℓ} (f : A → B) (g : B → A) (h : (x : A) → g (f x) ≡ x) - → isGroupoid B → isGroupoid A + → isGroupoid B → isGroupoid A isGroupoidRetract f g h grp x y p q P Q i j k = hcomp ((λ l → λ { (i = i0) → h (P j k) l ; (i = i1) → h (Q j k) l @@ -191,7 +191,7 @@ : {B : Type ℓ} (f : A → B) (g : B → A) (h : (x : A) → g (f x) ≡ x) - → is2Groupoid B → is2Groupoid A + → is2Groupoid B → is2Groupoid A is2GroupoidRetract f g h grp x y p q P Q R S i j k l = hcomp (λ r → λ { (i = i0) → h (R j k l) r ; (i = i1) → h (S j k l) r @@ -251,7 +251,7 @@ isContrRetractOfConstFun : {A : Type ℓ} {B : Type ℓ'} (b₀ : B) → Σ[ f ∈ (B → A) ] ((x : A) → (f ∘ (λ _ → b₀)) x ≡ x) - → isContr A + → isContr A fst (isContrRetractOfConstFun b₀ ret) = ret .fst b₀ snd (isContrRetractOfConstFun b₀ ret) y = ret .snd y @@ -273,35 +273,35 @@ isSet→SquareP : {A : I → I → Type ℓ} - (isSet : (i j : I) → isSet (A i j)) + (isSet : (i j : I) → isSet (A i j)) {a₀₀ : A i0 i0} {a₀₁ : A i0 i1} (a₀₋ : PathP (λ j → A i0 j) a₀₀ a₀₁) {a₁₀ : A i1 i0} {a₁₁ : A i1 i1} (a₁₋ : PathP (λ j → A i1 j) a₁₀ a₁₁) (a₋₀ : PathP (λ i → A i i0) a₀₀ a₁₀) (a₋₁ : PathP (λ i → A i i1) a₀₁ a₁₁) - → SquareP A a₀₋ a₁₋ a₋₀ a₋₁ + → SquareP A a₀₋ a₁₋ a₋₀ a₋₁ isSet→SquareP isset a₀₋ a₁₋ a₋₀ a₋₁ = PathPIsoPath _ _ _ .Iso.inv (isOfHLevelPathP' 1 (isset _ _) _ _ _ _ ) -isGroupoid→isGroupoid' : isGroupoid A → isGroupoid' A +isGroupoid→isGroupoid' : isGroupoid A → isGroupoid' A isGroupoid→isGroupoid' {A = A} Agpd a₀₋₋ a₁₋₋ a₋₀₋ a₋₁₋ a₋₋₀ a₋₋₁ = - PathPIsoPath (λ i → Square (a₋₀₋ i) (a₋₁₋ i) (a₋₋₀ i) (a₋₋₁ i)) a₀₋₋ a₁₋₋ .Iso.inv + PathPIsoPath (λ i → Square (a₋₀₋ i) (a₋₁₋ i) (a₋₋₀ i) (a₋₋₁ i)) a₀₋₋ a₁₋₋ .Iso.inv (isGroupoid→isPropSquare _ _ _ _ _ _) where isGroupoid→isPropSquare : {a₀₀ a₀₁ : A} (a₀₋ : a₀₀ ≡ a₀₁) {a₁₀ a₁₁ : A} (a₁₋ : a₁₀ ≡ a₁₁) (a₋₀ : a₀₀ ≡ a₁₀) (a₋₁ : a₀₁ ≡ a₁₁) - → isProp (Square a₀₋ a₁₋ a₋₀ a₋₁) + → isProp (Square a₀₋ a₁₋ a₋₀ a₋₁) isGroupoid→isPropSquare a₀₋ a₁₋ a₋₀ a₋₁ = isOfHLevelRetractFromIso 1 (PathPIsoPath (λ i → a₋₀ i ≡ a₋₁ i) a₀₋ a₁₋) (Agpd _ _ _ _) -isGroupoid'→isGroupoid : isGroupoid' A → isGroupoid A +isGroupoid'→isGroupoid : isGroupoid' A → isGroupoid A isGroupoid'→isGroupoid Agpd' x y p q r s = Agpd' r s refl refl refl refl -- h-level of Σ-types -isProp∃! : isProp (∃! A B) -isProp∃! = isPropIsContr +isProp∃! : isProp (∃! A B) +isProp∃! = isPropIsContr -isContrΣ : isContr A → ((x : A) → isContr (B x)) → isContr (Σ A B) +isContrΣ : isContr A → ((x : A) → isContr (B x)) → isContr (Σ A B) isContrΣ {A = A} {B = B} (a , p) q = let h : (x : A) (y : B x) → (q x) .fst ≡ y h x y = (q x) .snd y @@ -309,25 +309,25 @@ , ( λ x i → p (x .fst) i , h (p (x .fst) i) (transp (λ j → B (p (x .fst) (i ∨ ~ j))) i (x .snd)) i)) -isContrΣ' : (ca : isContr A) → isContr (B (fst ca)) → isContr (Σ A B) -isContrΣ' ca cb = isContrΣ ca (λ x → subst _ (snd ca x) cb) +isContrΣ' : (ca : isContr A) → isContr (B (fst ca)) → isContr (Σ A B) +isContrΣ' ca cb = isContrΣ ca (λ x → subst _ (snd ca x) cb) section-Σ≡Prop - : (pB : (x : A) → isProp (B x)) {u v : Σ A B} - → section (Σ≡Prop pB {u} {v}) (cong fst) + : (pB : (x : A) → isProp (B x)) {u v : Σ A B} + → 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) + (p i .fst) , isProp→PathP (λ i → isOfHLevelPath 1 (pB (fst (p i))) + (Σ≡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)) + : (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)) -isPropΣ : isProp A → ((x : A) → isProp (B x)) → isProp (Σ A B) -isPropΣ pA pB t u = Σ≡Prop pB (pA (t .fst) (u .fst)) +isPropΣ : isProp A → ((x : A) → isProp (B x)) → isProp (Σ A B) +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,42 +335,42 @@ 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) +isSetΣ : isSet A → ((x : A) → isSet (B x)) → isSet (Σ A B) isSetΣ = isOfHLevelΣ 2 -- Useful consequence -isSetΣSndProp : isSet A → ((x : A) → isProp (B x)) → isSet (Σ A B) -isSetΣSndProp h p = isSetΣ h (λ x → isProp→isSet (p x)) +isSetΣSndProp : isSet A → ((x : A) → isProp (B x)) → isSet (Σ A B) +isSetΣSndProp h p = isSetΣ h (λ x → isProp→isSet (p x)) -isGroupoidΣ : isGroupoid A → ((x : A) → isGroupoid (B x)) → isGroupoid (Σ A B) +isGroupoidΣ : isGroupoid A → ((x : A) → isGroupoid (B x)) → isGroupoid (Σ A B) isGroupoidΣ = isOfHLevelΣ 3 -is2GroupoidΣ : is2Groupoid A → ((x : A) → is2Groupoid (B x)) → is2Groupoid (Σ A B) +is2GroupoidΣ : is2Groupoid A → ((x : A) → is2Groupoid (B x)) → is2Groupoid (Σ A B) is2GroupoidΣ = isOfHLevelΣ 4 -- h-level of × -isProp× : {A : Type ℓ} {B : Type ℓ'} → isProp A → isProp B → isProp (A × B) +isProp× : {A : Type ℓ} {B : Type ℓ'} → isProp A → isProp B → isProp (A × B) isProp× pA pB = isPropΣ pA (λ _ → pB) isProp×2 : {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} - → isProp A → isProp B → isProp C → isProp (A × B × C) + → isProp A → isProp B → isProp C → isProp (A × B × C) isProp×2 pA pB pC = isProp× pA (isProp× pB pC) isProp×3 : {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} {D : Type ℓ'''} - → isProp A → isProp B → isProp C → isProp D → isProp (A × B × C × D) + → isProp A → isProp B → isProp C → isProp D → isProp (A × B × C × D) isProp×3 pA pB pC pD = isProp×2 pA pB (isProp× pC pD) isProp×4 : {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} {D : Type ℓ'''} {E : Type ℓ''''} - → isProp A → isProp B → isProp C → isProp D → isProp E → isProp (A × B × C × D × E) + → isProp A → isProp B → isProp C → isProp D → isProp E → isProp (A × B × C × D × E) isProp×4 pA pB pC pD pE = isProp×3 pA pB pC (isProp× pD pE) isProp×5 : {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} {D : Type ℓ'''} {E : Type ℓ''''} {F : Type ℓ'''''} - → isProp A → isProp B → isProp C → isProp D → isProp E → isProp F - → isProp (A × B × C × D × E × F) + → isProp A → isProp B → isProp C → isProp D → isProp E → isProp F + → isProp (A × B × C × D × E × F) isProp×5 pA pB pC pD pE pF = isProp×4 pA pB pC pD (isProp× pE pF) @@ -378,15 +378,15 @@ → isOfHLevel n (A × B) isOfHLevel× n hA hB = isOfHLevelΣ n hA (λ _ → hB) -isSet× : ∀ {A : Type ℓ} {B : Type ℓ'} → isSet A → isSet B → isSet (A × B) +isSet× : ∀ {A : Type ℓ} {B : Type ℓ'} → isSet A → isSet B → isSet (A × B) isSet× = isOfHLevel× 2 -isGroupoid× : ∀ {A : Type ℓ} {B : Type ℓ'} → isGroupoid A → isGroupoid B - → isGroupoid (A × B) +isGroupoid× : ∀ {A : Type ℓ} {B : Type ℓ'} → isGroupoid A → isGroupoid B + → isGroupoid (A × B) isGroupoid× = isOfHLevel× 3 -is2Groupoid× : ∀ {A : Type ℓ} {B : Type ℓ'} → is2Groupoid A → is2Groupoid B - → is2Groupoid (A × B) +is2Groupoid× : ∀ {A : Type ℓ} {B : Type ℓ'} → is2Groupoid A → is2Groupoid B + → is2Groupoid (A × B) is2Groupoid× = isOfHLevel× 4 -- h-level of Π-types @@ -395,101 +395,101 @@ → isOfHLevel n ((x : A) → B x) isOfHLevelΠ 0 h = (λ x → fst (h x)) , λ f i y → snd (h y) (f y) i isOfHLevelΠ 1 h f g i x = (h x) (f x) (g x) i -isOfHLevelΠ 2 h f g F G i j z = h z (f z) (g z) (funExt⁻ F z) (funExt⁻ G z) i j +isOfHLevelΠ 2 h f g F G i j z = h z (f z) (g z) (funExt⁻ F z) (funExt⁻ G z) i j isOfHLevelΠ 3 h f g p q P Q i j k z = h z (f z) (g z) - (funExt⁻ p z) (funExt⁻ q z) - (cong (λ f → funExt⁻ f z) P) (cong (λ f → funExt⁻ f z) Q) i j k + (funExt⁻ p z) (funExt⁻ q z) + (cong (λ f → funExt⁻ f z) P) (cong (λ f → funExt⁻ f z) Q) i j k isOfHLevelΠ 4 h f g p q P Q R S i j k l z = h z (f z) (g z) - (funExt⁻ p z) (funExt⁻ q z) - (cong (λ f → funExt⁻ f z) P) (cong (λ f → funExt⁻ f z) Q) - (cong (cong (λ f → funExt⁻ f z)) R) (cong (cong (λ f → funExt⁻ f z)) S) i j k l + (funExt⁻ p z) (funExt⁻ q z) + (cong (λ f → funExt⁻ f z) P) (cong (λ f → funExt⁻ f z) Q) + (cong (cong (λ f → funExt⁻ f z)) R) (cong (cong (λ f → funExt⁻ f z)) S) i j k l isOfHLevelΠ (suc (suc (suc (suc (suc n))))) h f g p q P Q R S = isOfHLevelRetract (suc n) - (cong (cong (cong funExt⁻))) (cong (cong (cong funExt))) (λ _ → refl) + (cong (cong (cong funExt⁻))) (cong (cong (cong funExt))) (λ _ → refl) (isOfHLevelΠ (suc (suc (suc (suc n)))) (λ x → h x (f x) (g x)) - (funExt⁻ p) (funExt⁻ q) - (cong funExt⁻ P) (cong funExt⁻ Q) - (cong (cong funExt⁻) R) (cong (cong funExt⁻) S)) + (funExt⁻ p) (funExt⁻ q) + (cong funExt⁻ P) (cong funExt⁻ Q) + (cong (cong funExt⁻) R) (cong (cong funExt⁻) S)) isOfHLevelΠ2 : (n : HLevel) → ((x : A) → (y : B x) → isOfHLevel n (C x y)) → isOfHLevel n ((x : A) → (y : B x) → C x y) isOfHLevelΠ2 n f = isOfHLevelΠ n (λ x → isOfHLevelΠ n (f x)) -isContrΠ : (h : (x : A) → isContr (B x)) → isContr ((x : A) → B x) +isContrΠ : (h : (x : A) → isContr (B x)) → isContr ((x : A) → B x) isContrΠ = isOfHLevelΠ 0 -isPropΠ : (h : (x : A) → isProp (B x)) → isProp ((x : A) → B x) +isPropΠ : (h : (x : A) → isProp (B x)) → isProp ((x : A) → B x) isPropΠ = isOfHLevelΠ 1 -isPropΠ2 : (h : (x : A) (y : B x) → isProp (C x y)) - → isProp ((x : A) (y : B x) → C x y) +isPropΠ2 : (h : (x : A) (y : B x) → isProp (C x y)) + → isProp ((x : A) (y : B x) → C x y) isPropΠ2 h = isPropΠ λ x → isPropΠ λ y → h x y -isPropΠ3 : (h : (x : A) (y : B x) (z : C x y) → isProp (D x y z)) - → isProp ((x : A) (y : B x) (z : C x y) → D x y z) +isPropΠ3 : (h : (x : A) (y : B x) (z : C x y) → isProp (D x y z)) + → isProp ((x : A) (y : B x) (z : C x y) → D x y z) isPropΠ3 h = isPropΠ λ x → isPropΠ λ y → isPropΠ λ z → h x y z -isPropΠ4 : (h : (x : A) (y : B x) (z : C x y) (w : D x y z) → isProp (E x y z w)) - → isProp ((x : A) (y : B x) (z : C x y) (w : D x y z) → E x y z w) +isPropΠ4 : (h : (x : A) (y : B x) (z : C x y) (w : D x y z) → isProp (E x y z w)) + → isProp ((x : A) (y : B x) (z : C x y) (w : D x y z) → E x y z w) isPropΠ4 h = isPropΠ λ _ → isPropΠ3 (h _) -isPropΠ5 : (h : (x : A) (y : B x) (z : C x y) (w : D x y z) (v : E x y z w) → isProp (F x y z w v)) - → isProp ((x : A) (y : B x) (z : C x y) (w : D x y z) (v : E x y z w) → F x y z w v) +isPropΠ5 : (h : (x : A) (y : B x) (z : C x y) (w : D x y z) (v : E x y z w) → isProp (F x y z w v)) + → isProp ((x : A) (y : B x) (z : C x y) (w : D x y z) (v : E x y z w) → F x y z w v) isPropΠ5 h = isPropΠ λ _ → isPropΠ4 (h _) -isPropΠ6 : (h : (x : A) (y : B x) (z : C x y) (w : D x y z) (v : E x y z w) (u : F x y z w v) → isProp (G x y z w v u)) - → isProp ((x : A) (y : B x) (z : C x y) (w : D x y z) (v : E x y z w) (u : F x y z w v) → G x y z w v u) +isPropΠ6 : (h : (x : A) (y : B x) (z : C x y) (w : D x y z) (v : E x y z w) (u : F x y z w v) → isProp (G x y z w v u)) + → isProp ((x : A) (y : B x) (z : C x y) (w : D x y z) (v : E x y z w) (u : F x y z w v) → G x y z w v u) isPropΠ6 h = isPropΠ λ _ → isPropΠ5 (h _) -isPropImplicitΠ : (h : (x : A) → isProp (B x)) → isProp ({x : A} → B x) +isPropImplicitΠ : (h : (x : A) → isProp (B x)) → isProp ({x : A} → B x) isPropImplicitΠ h f g i {x} = h x (f {x}) (g {x}) i -isPropImplicitΠ2 : (h : (x : A) (y : B x) → isProp (C x y)) → isProp ({x : A} {y : B x} → C x y) +isPropImplicitΠ2 : (h : (x : A) (y : B x) → isProp (C x y)) → isProp ({x : A} {y : B x} → C x y) isPropImplicitΠ2 h = isPropImplicitΠ (λ x → isPropImplicitΠ (λ y → h x y)) -isProp→ : {A : Type ℓ} {B : Type ℓ'} → isProp B → isProp (A → B) +isProp→ : {A : Type ℓ} {B : Type ℓ'} → isProp B → isProp (A → B) isProp→ pB = isPropΠ λ _ → pB -isSetΠ : ((x : A) → isSet (B x)) → isSet ((x : A) → B x) +isSetΠ : ((x : A) → isSet (B x)) → isSet ((x : A) → B x) isSetΠ = isOfHLevelΠ 2 -isSetImplicitΠ : (h : (x : A) → isSet (B x)) → isSet ({x : A} → B x) +isSetImplicitΠ : (h : (x : A) → isSet (B x)) → isSet ({x : A} → B x) isSetImplicitΠ h f g F G i j {x} = h x (f {x}) (g {x}) (λ i → F i {x}) (λ i → G i {x}) i j -isSet→ : isSet A' → isSet (A → A') +isSet→ : isSet A' → isSet (A → A') isSet→ isSet-A' = isOfHLevelΠ 2 (λ _ → isSet-A') -isSetΠ2 : (h : (x : A) (y : B x) → isSet (C x y)) - → isSet ((x : A) (y : B x) → C x y) +isSetΠ2 : (h : (x : A) (y : B x) → isSet (C x y)) + → isSet ((x : A) (y : B x) → C x y) isSetΠ2 h = isSetΠ λ x → isSetΠ λ y → h x y -isSetΠ3 : (h : (x : A) (y : B x) (z : C x y) → isSet (D x y z)) - → isSet ((x : A) (y : B x) (z : C x y) → D x y z) +isSetΠ3 : (h : (x : A) (y : B x) (z : C x y) → isSet (D x y z)) + → isSet ((x : A) (y : B x) (z : C x y) → D x y z) isSetΠ3 h = isSetΠ λ x → isSetΠ λ y → isSetΠ λ z → h x y z -isGroupoidΠ : ((x : A) → isGroupoid (B x)) → isGroupoid ((x : A) → B x) +isGroupoidΠ : ((x : A) → isGroupoid (B x)) → isGroupoid ((x : A) → B x) isGroupoidΠ = isOfHLevelΠ 3 -isGroupoidΠ2 : (h : (x : A) (y : B x) → isGroupoid (C x y)) → isGroupoid ((x : A) (y : B x) → C x y) +isGroupoidΠ2 : (h : (x : A) (y : B x) → isGroupoid (C x y)) → isGroupoid ((x : A) (y : B x) → C x y) isGroupoidΠ2 h = isGroupoidΠ λ _ → isGroupoidΠ λ _ → h _ _ -isGroupoidΠ3 : (h : (x : A) (y : B x) (z : C x y) → isGroupoid (D x y z)) - → isGroupoid ((x : A) (y : B x) (z : C x y) → D x y z) +isGroupoidΠ3 : (h : (x : A) (y : B x) (z : C x y) → isGroupoid (D x y z)) + → isGroupoid ((x : A) (y : B x) (z : C x y) → D x y z) isGroupoidΠ3 h = isGroupoidΠ λ _ → isGroupoidΠ2 λ _ → h _ _ -isGroupoidΠ4 : (h : (x : A) (y : B x) (z : C x y) (w : D x y z) → isGroupoid (E x y z w)) - → isGroupoid ((x : A) (y : B x) (z : C x y) (w : D x y z) → E x y z w) +isGroupoidΠ4 : (h : (x : A) (y : B x) (z : C x y) (w : D x y z) → isGroupoid (E x y z w)) + → isGroupoid ((x : A) (y : B x) (z : C x y) (w : D x y z) → E x y z w) isGroupoidΠ4 h = isGroupoidΠ λ _ → isGroupoidΠ3 λ _ → h _ _ -is2GroupoidΠ : ((x : A) → is2Groupoid (B x)) → is2Groupoid ((x : A) → B x) +is2GroupoidΠ : ((x : A) → is2Groupoid (B x)) → is2Groupoid ((x : A) → B x) is2GroupoidΠ = isOfHLevelΠ 4 isOfHLevelΠ⁻ : ∀ {A : Type ℓ} {B : Type ℓ'} n → isOfHLevel n (A → B) → (A → isOfHLevel n B) -isOfHLevelΠ⁻ 0 h x = fst h x , λ y → funExt⁻ (snd h (const y)) x -isOfHLevelΠ⁻ 1 h x y z = funExt⁻ (h (const y) (const z)) x +isOfHLevelΠ⁻ 0 h x = fst h x , λ y → funExt⁻ (snd h (const y)) x +isOfHLevelΠ⁻ 1 h x y z = funExt⁻ (h (const y) (const z)) x isOfHLevelΠ⁻ (suc (suc n)) h x y z = isOfHLevelΠ⁻ (suc n) (isOfHLevelRetractFromIso (suc n) funExtIso (h _ _)) x @@ -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) @@ -538,16 +538,16 @@ isOfHLevel⁺≡ₗ : ∀ n → {A B : Type ℓ} → isOfHLevel (suc n) A → isOfHLevel (suc n) (A ≡ B) -isOfHLevel⁺≡ₗ zero pA P = isOfHLevel≡ 1 pA (subst isProp P pA) P +isOfHLevel⁺≡ₗ zero pA P = isOfHLevel≡ 1 pA (subst isProp P pA) P isOfHLevel⁺≡ₗ (suc n) hA P - = isOfHLevel≡ m hA (subst (isOfHLevel m) P hA) P + = isOfHLevel≡ m hA (subst (isOfHLevel m) P hA) P where m = suc (suc n) isOfHLevel⁺≡ᵣ : ∀ n → {A B : Type ℓ} → isOfHLevel (suc n) B → isOfHLevel (suc n) (A ≡ B) -isOfHLevel⁺≡ᵣ zero pB P = isOfHLevel≡ 1 (subst⁻ isProp P pB) pB P +isOfHLevel⁺≡ᵣ zero pB P = isOfHLevel≡ 1 (subst⁻ isProp P pB) pB P isOfHLevel⁺≡ᵣ (suc n) hB P = isOfHLevel≡ m (subst⁻ (isOfHLevel m) P hB) hB P where @@ -555,47 +555,47 @@ -- h-level of TypeOfHLevel -isPropHContr : isProp (TypeOfHLevel ℓ 0) -isPropHContr x y = Σ≡Prop (λ _ → isPropIsContr) (isOfHLevel≡ 0 (x .snd) (y .snd) .fst) +isPropHContr : isProp (TypeOfHLevel ℓ 0) +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) -isSetHProp : isSet (hProp ℓ) +isSetHProp : isSet (hProp ℓ) isSetHProp = isOfHLevelTypeOfHLevel 1 -isGroupoidHSet : isGroupoid (hSet ℓ) +isGroupoidHSet : isGroupoid (hSet ℓ) isGroupoidHSet = isOfHLevelTypeOfHLevel 2 -- h-level of lifted type -isOfHLevelLift : ∀ {ℓ ℓ'} (n : HLevel) {A : Type ℓ} → isOfHLevel n A → isOfHLevel n (Lift {j = ℓ'} A) -isOfHLevelLift n = isOfHLevelRetract n lower lift λ _ → refl +isOfHLevelLift : ∀ {ℓ ℓ'} (n : HLevel) {A : Type ℓ} → isOfHLevel n A → isOfHLevel n (Lift {j = ℓ'} A) +isOfHLevelLift n = isOfHLevelRetract n lower lift λ _ → refl -isOfHLevelLower : ∀ {ℓ ℓ'} (n : HLevel) {A : Type ℓ} → isOfHLevel n (Lift {j = ℓ'} A) → isOfHLevel n A -isOfHLevelLower n = isOfHLevelRetract n lift lower λ _ → refl +isOfHLevelLower : ∀ {ℓ ℓ'} (n : HLevel) {A : Type ℓ} → isOfHLevel n (Lift {j = ℓ'} A) → isOfHLevel n A +isOfHLevelLower n = isOfHLevelRetract n lift lower λ _ → refl ---------------------------- -- More consequences of isProp and isContr -inhProp→isContr : A → isProp A → isContr A +inhProp→isContr : A → isProp A → isContr A inhProp→isContr x h = x , h x -extend : isContr A → (∀ φ → (u : Partial φ A) → Sub A φ u) +extend : isContr A → (∀ φ → (u : Partial φ A) → Sub A φ u) extend (x , p) φ u = inS (hcomp (λ { j (φ = i1) → p (u 1=1) j }) x) isContrPartial→isContr : ∀ {ℓ} {A : Type ℓ} → (extend : ∀ φ → Partial φ A → A) → (∀ u → u ≡ (extend i1 λ { _ → u})) - → isContr A + → isContr A isContrPartial→isContr {A = A} extend law - = ex , λ y → law ex ∙ (λ i → Aux.v y i) ∙ sym (law y) + = ex , λ y → law ex ∙ (λ i → Aux.v y i) ∙ sym (law y) where ex = extend i0 empty module Aux (y : A) (i : I) where φ = ~ i ∨ i @@ -634,14 +634,14 @@ isOfHLevel→isOfHLevelDep : (n : HLevel) → {A : Type ℓ} {B : A → Type ℓ'} (h : (a : A) → isOfHLevel n (B a)) → isOfHLevelDep n {A = A} B isOfHLevel→isOfHLevelDep 0 h {a} = - (h a .fst , λ b' p → isProp→PathP (λ i → isContr→isProp (h (p i))) (h a .fst) b') -isOfHLevel→isOfHLevelDep 1 h = λ b0 b1 p → isProp→PathP (λ i → h (p i)) b0 b1 + (h a .fst , λ b' p → isProp→PathP (λ i → isContr→isProp (h (p i))) (h a .fst) b') +isOfHLevel→isOfHLevelDep 1 h = λ b0 b1 p → isProp→PathP (λ i → h (p i)) b0 b1 isOfHLevel→isOfHLevelDep (suc (suc n)) {A = A} {B} h {a0} {a1} b0 b1 = isOfHLevel→isOfHLevelDep (suc n) (λ p → helper p) where helper : (p : a0 ≡ a1) → isOfHLevel (suc n) (PathP (λ i → B (p i)) b0 b1) - helper p = J (λ a1 p → ∀ b1 → isOfHLevel (suc n) (PathP (λ i → B (p i)) b0 b1)) + helper p = J (λ a1 p → ∀ b1 → isOfHLevel (suc n) (PathP (λ i → B (p i)) b0 b1)) (λ _ → h _ _ _) p b1 isContrDep→isPropDep : isOfHLevelDep 0 B → isOfHLevelDep 1 B @@ -671,12 +671,12 @@ : isOfHLevelDep 1 B → {p : w ≡ x} {q : y ≡ z} {r : w ≡ y} {s : x ≡ z} → {tw : B w} {tx : B x} {ty : B y} {tz : B z} - → (sq : Square p q r s) + → (sq : Square p q r s) → (tp : PathP (λ i → B (p i)) tw tx) → (tq : PathP (λ i → B (q i)) ty tz) → (tr : PathP (λ i → B (r i)) tw ty) → (ts : PathP (λ i → B (s i)) tx tz) - → SquareP (λ i j → B (sq i j)) tp tq tr ts + → SquareP (λ i j → B (sq i j)) tp tq tr ts isPropDep→isSetDep' {B = B} Bprp {p} {q} {r} {s} {tw} sq tp tq tr ts i j = comp (λ k → B (sq (i ∧ k) (j ∧ k))) (λ k → λ where (i = i0) → Bprp tw (tp j) (λ k → p (k ∧ j)) k @@ -698,22 +698,22 @@ (λ x → refl) (isOfHLevelΣ' (suc n) (Alvl w x) (Blvl y z)) -ΣSquareSet : ((x : A) → isSet (B x)) → {u v w x : Σ A B} +ΣSquareSet : ((x : A) → isSet (B x)) → {u v w x : Σ A B} → {p : u ≡ v} {q : v ≡ w} {r : x ≡ w} {s : u ≡ x} - → Square (cong fst p) (cong fst r) + → Square (cong fst p) (cong fst r) (cong fst s) (cong fst q) - → Square p r s q + → Square p r s q fst (ΣSquareSet pB sq i j) = sq i j snd (ΣSquareSet {B = B} pB {p = p} {q = q} {r = r} {s = s} sq i j) = lem i j where - lem : SquareP (λ i j → B (sq i j)) + lem : SquareP (λ i j → B (sq i j)) (cong snd p) (cong snd r) (cong snd s) (cong snd q) - lem = toPathP (isOfHLevelPathP' 1 (pB _) _ _ _ _) + lem = toPathP (isOfHLevelPathP' 1 (pB _) _ _ _ _) -module _ (isSet-A : isSet A) (isSet-A' : isSet A') where +module _ (isSet-A : isSet A) (isSet-A' : isSet A') where - isSet-SetsIso : isSet (Iso A A') + isSet-SetsIso : isSet (Iso A A') isSet-SetsIso x y p₀ p₁ = h where @@ -727,12 +727,12 @@ s-p : ∀ b → _ s-p b = - isSet→SquareP (λ i j → isProp→isSet (isSet-A' _ _)) + isSet→SquareP (λ i j → isProp→isSet (isSet-A' _ _)) refl refl (λ i₁ → (Iso.rightInv (p₀ i₁) b)) (λ i₁ → (Iso.rightInv (p₁ i₁) b)) r-p : ∀ a → _ r-p a = - isSet→SquareP (λ i j → isProp→isSet (isSet-A _ _)) + isSet→SquareP (λ i j → isProp→isSet (isSet-A _ _)) refl refl (λ i₁ → (Iso.leftInv (p₀ i₁) a)) (λ i₁ → (Iso.leftInv (p₁ i₁) a)) @@ -767,7 +767,7 @@ → (Iso.inv a ≡ Iso.inv b) → a ≡ b SetsIso≡ p q = - SetsIso≡-ext (funExt⁻ p) (funExt⁻ q) + SetsIso≡-ext (funExt⁻ p) (funExt⁻ q) isSet→Iso-Iso-≃ : Iso (Iso A A') (A ≃ A') isSet→Iso-Iso-≃ = ww @@ -786,7 +786,7 @@ -isSet→Iso-Iso-≡ : (isSet-A : isSet A) → (isSet-A' : isSet A') → Iso (Iso A A') (A ≡ A') +isSet→Iso-Iso-≡ : (isSet-A : isSet A) → (isSet-A' : isSet A') → Iso (Iso A A') (A ≡ A') isSet→Iso-Iso-≡ isSet-A isSet-A' = ww where open Iso @@ -794,8 +794,8 @@ ww : Iso _ _ fun ww = isoToPath inv ww = pathToIso - rightInv ww b = isInjectiveTransport (funExt λ _ → transportRefl _) - leftInv ww a = SetsIso≡-ext isSet-A isSet-A' (λ _ → transportRefl (fun a _)) λ _ → cong (inv a) (transportRefl _) + rightInv ww b = isInjectiveTransport (funExt λ _ → transportRefl _) + leftInv ww a = SetsIso≡-ext isSet-A isSet-A' (λ _ → transportRefl (fun a _)) λ _ → cong (inv a) (transportRefl _) hSet-Iso-Iso-≡ : (A : hSet ℓ) → (A' : hSet ℓ) → Iso (Iso (fst A) (fst A')) (A ≡ A') hSet-Iso-Iso-≡ A A' = compIso (isSet→Iso-Iso-≡ (snd A) (snd A')) (equivToIso (_ , isEquiv-Σ≡Prop λ _ → isPropIsSet)) diff --git a/docs/Cubical.Foundations.Isomorphism.html b/docs/Cubical.Foundations.Isomorphism.html index dedda62..a33be00 100644 --- a/docs/Cubical.Foundations.Isomorphism.html +++ b/docs/Cubical.Foundations.Isomorphism.html @@ -45,10 +45,10 @@ isIso {A = A} {B = B} f = Σ[ g ∈ (B → A) ] Σ[ _ ∈ section f g ] retract f g isoFunInjective : (f : Iso A B) → (x y : A) → Iso.fun f x ≡ Iso.fun f y → x ≡ y -isoFunInjective f x y h = sym (Iso.leftInv f x) ∙∙ cong (Iso.inv f) h ∙∙ Iso.leftInv f y +isoFunInjective f x y h = sym (Iso.leftInv f x) ∙∙ cong (Iso.inv f) h ∙∙ Iso.leftInv f y isoInvInjective : (f : Iso A B) → (x y : B) → Iso.inv f x ≡ Iso.inv f y → x ≡ y -isoInvInjective f x y h = sym (Iso.rightInv f x) ∙∙ cong (Iso.fun f) h ∙∙ Iso.rightInv f y +isoInvInjective f x y h = sym (Iso.rightInv f x) ∙∙ cong (Iso.fun f) h ∙∙ Iso.rightInv f y -- Any iso is an equivalence module _ (i : Iso A B) where @@ -121,14 +121,14 @@ compIso : Iso A B → Iso B C → Iso A C fun (compIso i j) = fun j ∘ fun i inv (compIso i j) = inv i ∘ inv j -rightInv (compIso i j) b = cong (fun j) (rightInv i (inv j b)) ∙ rightInv j b -leftInv (compIso i j) a = cong (inv i) (leftInv j (fun i a)) ∙ leftInv i a +rightInv (compIso i j) b = cong (fun j) (rightInv i (inv j b)) ∙ rightInv j b +leftInv (compIso i j) a = cong (inv i) (leftInv j (fun i a)) ∙ leftInv i a composesToId→Iso : (G : Iso A B) (g : B → A) → G .fun ∘ g ≡ idfun B → Iso B A fun (composesToId→Iso _ g _) = g inv (composesToId→Iso j _ _) = fun j rightInv (composesToId→Iso i g path) b = - sym (leftInv i (g (fun i b))) ∙∙ cong (λ g → inv i (g (fun i b))) path ∙∙ leftInv i b + sym (leftInv i (g (fun i b))) ∙∙ cong (λ g → inv i (g (fun i b))) path ∙∙ leftInv i b leftInv (composesToId→Iso _ _ path) b i = path i b idIso : Iso A A @@ -149,25 +149,25 @@ rightInv (compIsoIdR isom i) b = rUnit (isom .rightInv b) (~ i) leftInv (compIsoIdR isom i) a = lUnit (isom .leftInv a) (~ i) -LiftIso : Iso A (Lift {i = ℓ} {j = ℓ'} A) -fun LiftIso = lift -inv LiftIso = lower +LiftIso : Iso A (Lift {i = ℓ} {j = ℓ'} A) +fun LiftIso = lift +inv LiftIso = lower rightInv LiftIso _ = refl leftInv LiftIso _ = refl -isContr→Iso : isContr A → isContr B → Iso A B +isContr→Iso : isContr A → isContr B → Iso A B fun (isContr→Iso _ Bctr) _ = Bctr .fst inv (isContr→Iso Actr _) _ = Actr .fst rightInv (isContr→Iso _ Bctr) = Bctr .snd leftInv (isContr→Iso Actr _) = Actr .snd -isContr→Iso' : isContr A → isContr B → (A → B) → Iso A B +isContr→Iso' : isContr A → isContr B → (A → B) → Iso A B fun (isContr→Iso' _ Bctr f) = f inv (isContr→Iso' Actr _ _) _ = Actr .fst -rightInv (isContr→Iso' _ Bctr f) = isContr→isProp Bctr _ +rightInv (isContr→Iso' _ Bctr f) = isContr→isProp Bctr _ leftInv (isContr→Iso' Actr _ _) = Actr .snd -isProp→Iso : (Aprop : isProp A) (Bprop : isProp B) (f : A → B) (g : B → A) → Iso A B +isProp→Iso : (Aprop : isProp A) (Bprop : isProp B) (f : A → B) (g : B → A) → Iso A B fun (isProp→Iso _ _ f _) = f inv (isProp→Iso _ _ _ g) = g rightInv (isProp→Iso _ Bprop f g) b = Bprop (f (g b)) b @@ -194,23 +194,28 @@ → Iso ((a : A) → B a) ((a : A) → C a) fun (codomainIsoDep is) f a = fun (is a) (f a) inv (codomainIsoDep is) f a = inv (is a) (f a) -rightInv (codomainIsoDep is) f = funExt λ a → rightInv (is a) (f a) -leftInv (codomainIsoDep is) f = funExt λ a → leftInv (is a) (f a) +rightInv (codomainIsoDep is) f = funExt λ a → rightInv (is a) (f a) +leftInv (codomainIsoDep is) f = funExt λ a → leftInv (is a) (f a) codomainIso : ∀ {ℓ ℓ' ℓ''} {A : Type ℓ} {B : Type ℓ'} {C : Type ℓ''} → Iso B C → Iso (A → B) (A → C) codomainIso z = codomainIsoDep λ _ → z - -Iso≡Set : isSet A → isSet B → (f g : Iso A B) - → ((x : A) → f .fun x ≡ g .fun x) - → ((x : B) → f .inv x ≡ g .inv x) - → f ≡ g -fun (Iso≡Set hA hB f g hfun hinv i) x = hfun x i -inv (Iso≡Set hA hB f g hfun hinv i) x = hinv x i -rightInv (Iso≡Set hA hB f g hfun hinv i) x j = - isSet→isSet' hB (rightInv f x) (rightInv g x) (λ i → hfun (hinv x i) i) refl i j -leftInv (Iso≡Set hA hB f g hfun hinv i) x j = - isSet→isSet' hA (leftInv f x) (leftInv g x) (λ i → hinv (hfun x i) i) refl i j +endoIso : Iso A B → Iso (A → A) (B → B) +endoIso is = compIso (domIso is) (codomainIso is) + +binaryOpIso : Iso A B → Iso (A → A → A) (B → B → B) +binaryOpIso is = compIso (domIso is) (codomainIso (endoIso is)) + +Iso≡Set : isSet A → isSet B → (f g : Iso A B) + → ((x : A) → f .fun x ≡ g .fun x) + → ((x : B) → f .inv x ≡ g .inv x) + → f ≡ g +fun (Iso≡Set hA hB f g hfun hinv i) x = hfun x i +inv (Iso≡Set hA hB f g hfun hinv i) x = hinv x i +rightInv (Iso≡Set hA hB f g hfun hinv i) x j = + isSet→isSet' hB (rightInv f x) (rightInv g x) (λ i → hfun (hinv x i) i) refl i j +leftInv (Iso≡Set hA hB f g hfun hinv i) x j = + isSet→isSet' hA (leftInv f x) (leftInv g x) (λ i → hinv (hfun x i) i) refl i j \ No newline at end of file diff --git a/docs/Cubical.Foundations.Path.html b/docs/Cubical.Foundations.Path.html index b85eefe..b57dab0 100644 --- a/docs/Cubical.Foundations.Path.html +++ b/docs/Cubical.Foundations.Path.html @@ -19,22 +19,22 @@ module _ {A : I → Type ℓ} {x : A i0} {y : A i1} where toPathP⁻ : x ≡ transport⁻ (λ i → A i) y → PathP A x y - toPathP⁻ p = symP (toPathP (sym p)) + toPathP⁻ p = symP (toPathP (sym p)) fromPathP⁻ : PathP A x y → x ≡ transport⁻ (λ i → A i) y - fromPathP⁻ p = sym (fromPathP {A = λ i → A (~ i)} (symP p)) + fromPathP⁻ p = sym (fromPathP {A = λ i → A (~ i)} (symP p)) PathP≡Path : ∀ (P : I → Type ℓ) (p : P i0) (q : P i1) → - PathP P p q ≡ Path (P i1) (transport (λ i → P i) p) q -PathP≡Path P p q i = PathP (λ j → P (i ∨ j)) (transport-filler (λ j → P j) p i) q + PathP P p q ≡ Path (P i1) (transport (λ i → P i) p) q +PathP≡Path P p q i = PathP (λ j → P (i ∨ j)) (transport-filler (λ j → P j) p i) q PathP≡Path⁻ : ∀ (P : I → Type ℓ) (p : P i0) (q : P i1) → PathP P p q ≡ Path (P i0) p (transport⁻ (λ i → P i) q) PathP≡Path⁻ P p q i = PathP (λ j → P (~ i ∧ j)) p (transport⁻-filler (λ j → P j) q i) -PathPIsoPath : ∀ (A : I → Type ℓ) (x : A i0) (y : A i1) → Iso (PathP A x y) (transport (λ i → A i) x ≡ y) -PathPIsoPath A x y .Iso.fun = fromPathP -PathPIsoPath A x y .Iso.inv = toPathP +PathPIsoPath : ∀ (A : I → Type ℓ) (x : A i0) (y : A i1) → Iso (PathP A x y) (transport (λ i → A i) x ≡ y) +PathPIsoPath A x y .Iso.fun = fromPathP +PathPIsoPath A x y .Iso.inv = toPathP PathPIsoPath A x y .Iso.rightInv q k i = hcomp (λ j → λ @@ -81,59 +81,59 @@ k PathP≃Path : (A : I → Type ℓ) (x : A i0) (y : A i1) → - PathP A x y ≃ (transport (λ i → A i) x ≡ y) + PathP A x y ≃ (transport (λ i → A i) x ≡ y) PathP≃Path A x y = isoToEquiv (PathPIsoPath A x y) PathP≡compPath : ∀ {A : Type ℓ} {x y z : A} (p : x ≡ y) (q : y ≡ z) (r : x ≡ z) - → (PathP (λ i → x ≡ q i) p r) ≡ (p ∙ q ≡ r) -PathP≡compPath p q r k = PathP (λ i → p i0 ≡ q (i ∨ k)) (λ j → compPath-filler p q k j) r + → (PathP (λ i → x ≡ q i) p r) ≡ (p ∙ q ≡ r) +PathP≡compPath p q r k = PathP (λ i → p i0 ≡ q (i ∨ k)) (λ j → compPath-filler p q k j) r -- a quick corollary for 3-constant functions 3-ConstantCompChar : {A : Type ℓ} {B : Type ℓ'} (f : A → B) (link : 2-Constant f) - → (∀ x y z → link x y ∙ link y z ≡ link x z) + → (∀ x y z → link x y ∙ link y z ≡ link x z) → 3-Constant f 3-Constant.link (3-ConstantCompChar f link coh₂) = link 3-Constant.coh₁ (3-ConstantCompChar f link coh₂) _ _ _ = transport⁻ (PathP≡compPath _ _ _) (coh₂ _ _ _) PathP≡doubleCompPathˡ : ∀ {A : Type ℓ} {w x y z : A} (p : w ≡ y) (q : w ≡ x) (r : y ≡ z) (s : x ≡ z) - → (PathP (λ i → p i ≡ s i) q r) ≡ (p ⁻¹ ∙∙ q ∙∙ s ≡ r) + → (PathP (λ i → p i ≡ s i) q r) ≡ (p ⁻¹ ∙∙ q ∙∙ s ≡ r) PathP≡doubleCompPathˡ p q r s k = PathP (λ i → p (i ∨ k) ≡ s (i ∨ k)) - (λ j → doubleCompPath-filler (p ⁻¹) q s k j) r + (λ j → doubleCompPath-filler (p ⁻¹) q s k j) r PathP≡doubleCompPathʳ : ∀ {A : Type ℓ} {w x y z : A} (p : w ≡ y) (q : w ≡ x) (r : y ≡ z) (s : x ≡ z) - → (PathP (λ i → p i ≡ s i) q r) ≡ (q ≡ p ∙∙ r ∙∙ s ⁻¹) + → (PathP (λ i → p i ≡ s i) q r) ≡ (q ≡ p ∙∙ r ∙∙ s ⁻¹) PathP≡doubleCompPathʳ p q r s k = PathP (λ i → p (i ∧ (~ k)) ≡ s (i ∧ (~ k))) - q (λ j → doubleCompPath-filler p r (s ⁻¹) k j) + q (λ j → doubleCompPath-filler p r (s ⁻¹) k j) -compPathl-cancel : ∀ {ℓ} {A : Type ℓ} {x y z : A} (p : x ≡ y) (q : x ≡ z) → p ∙ (sym p ∙ q) ≡ q -compPathl-cancel p q = p ∙ (sym p ∙ q) ≡⟨ assoc p (sym p) q ⟩ - (p ∙ sym p) ∙ q ≡⟨ cong (_∙ q) (rCancel p) ⟩ - refl ∙ q ≡⟨ sym (lUnit q) ⟩ - q ∎ +compPathl-cancel : ∀ {ℓ} {A : Type ℓ} {x y z : A} (p : x ≡ y) (q : x ≡ z) → p ∙ (sym p ∙ q) ≡ q +compPathl-cancel p q = p ∙ (sym p ∙ q) ≡⟨ assoc p (sym p) q ⟩ + (p ∙ sym p) ∙ q ≡⟨ cong (_∙ q) (rCancel p) ⟩ + refl ∙ q ≡⟨ sym (lUnit q) ⟩ + q ∎ -compPathr-cancel : ∀ {ℓ} {A : Type ℓ} {x y z : A} (p : z ≡ y) (q : x ≡ y) → (q ∙ sym p) ∙ p ≡ q +compPathr-cancel : ∀ {ℓ} {A : Type ℓ} {x y z : A} (p : z ≡ y) (q : x ≡ y) → (q ∙ sym p) ∙ p ≡ q compPathr-cancel {x = x} p q i j = hcomp-equivFiller (doubleComp-faces (λ _ → x) (sym p) j) (inS (q j)) (~ i) -compPathl-isEquiv : {x y z : A} (p : x ≡ y) → isEquiv (λ (q : y ≡ z) → p ∙ q) -compPathl-isEquiv p = isoToIsEquiv (iso (p ∙_) (sym p ∙_) (compPathl-cancel p) (compPathl-cancel (sym p))) +compPathl-isEquiv : {x y z : A} (p : x ≡ y) → isEquiv (λ (q : y ≡ z) → p ∙ q) +compPathl-isEquiv p = isoToIsEquiv (iso (p ∙_) (sym p ∙_) (compPathl-cancel p) (compPathl-cancel (sym p))) compPathlEquiv : {x y z : A} (p : x ≡ y) → (y ≡ z) ≃ (x ≡ z) -compPathlEquiv p = (p ∙_) , compPathl-isEquiv p +compPathlEquiv p = (p ∙_) , compPathl-isEquiv p -compPathr-isEquiv : {x y z : A} (p : y ≡ z) → isEquiv (λ (q : x ≡ y) → q ∙ p) -compPathr-isEquiv p = isoToIsEquiv (iso (_∙ p) (_∙ sym p) (compPathr-cancel p) (compPathr-cancel (sym p))) +compPathr-isEquiv : {x y z : A} (p : y ≡ z) → isEquiv (λ (q : x ≡ y) → q ∙ p) +compPathr-isEquiv p = isoToIsEquiv (iso (_∙ p) (_∙ sym p) (compPathr-cancel p) (compPathr-cancel (sym p))) compPathrEquiv : {x y z : A} (p : y ≡ z) → (x ≡ y) ≃ (x ≡ z) -compPathrEquiv p = (_∙ p) , compPathr-isEquiv p +compPathrEquiv p = (_∙ p) , compPathr-isEquiv p -- Variations of isProp→isSet for PathP -isProp→SquareP : ∀ {B : I → I → Type ℓ} → ((i j : I) → isProp (B i j)) +isProp→SquareP : ∀ {B : I → I → Type ℓ} → ((i j : I) → isProp (B i j)) → {a : B i0 i0} {b : B i0 i1} {c : B i1 i0} {d : B i1 i1} → (r : PathP (λ j → B j i0) a c) (s : PathP (λ j → B j i1) b d) → (t : PathP (λ j → B i0 j) a b) (u : PathP (λ j → B i1 j) c d) - → SquareP B t u r s + → SquareP B t u r s isProp→SquareP {B = B} isPropB {a = a} r s t u i j = hcomp (λ { k (i = i0) → isPropB i0 j (base i0 j) (t j) k ; k (i = i1) → isPropB i1 j (base i1 j) (u j) k @@ -141,34 +141,34 @@ ; k (j = i1) → isPropB i i1 (base i i1) (s i) k }) (base i j) where base : (i j : I) → B i j - base i j = transport (λ k → B (i ∧ k) (j ∧ k)) a + base i j = transport (λ k → B (i ∧ k) (j ∧ k)) a -isProp→isPropPathP : ∀ {ℓ} {B : I → Type ℓ} → ((i : I) → isProp (B i)) +isProp→isPropPathP : ∀ {ℓ} {B : I → Type ℓ} → ((i : I) → isProp (B i)) → (b0 : B i0) (b1 : B i1) - → isProp (PathP (λ i → B i) b0 b1) + → isProp (PathP (λ i → B i) b0 b1) isProp→isPropPathP {B = B} hB b0 b1 = isProp→SquareP (λ _ → hB) refl refl -isProp→isContrPathP : {A : I → Type ℓ} → (∀ i → isProp (A i)) +isProp→isContrPathP : {A : I → Type ℓ} → (∀ i → isProp (A i)) → (x : A i0) (y : A i1) - → isContr (PathP A x y) -isProp→isContrPathP h x y = isProp→PathP h x y , isProp→isPropPathP h x y _ + → isContr (PathP A x y) +isProp→isContrPathP h x y = isProp→PathP h x y , isProp→isPropPathP h x y _ -- Flipping a square along its diagonal flipSquare : {a₀₀ a₀₁ : A} {a₀₋ : a₀₀ ≡ a₀₁} {a₁₀ a₁₁ : A} {a₁₋ : a₁₀ ≡ a₁₁} {a₋₀ : a₀₀ ≡ a₁₀} {a₋₁ : a₀₁ ≡ a₁₁} - → Square a₀₋ a₁₋ a₋₀ a₋₁ → Square a₋₀ a₋₁ a₀₋ a₁₋ + → Square a₀₋ a₁₋ a₋₀ a₋₁ → Square a₋₀ a₋₁ a₀₋ a₁₋ flipSquare sq i j = sq j i module _ {a₀₀ a₀₁ : A} {a₀₋ : a₀₀ ≡ a₀₁} {a₁₀ a₁₁ : A} {a₁₋ : a₁₀ ≡ a₁₁} {a₋₀ : a₀₀ ≡ a₁₀} {a₋₁ : a₀₁ ≡ a₁₁} where - flipSquareEquiv : Square a₀₋ a₁₋ a₋₀ a₋₁ ≃ Square a₋₀ a₋₁ a₀₋ a₁₋ + flipSquareEquiv : Square a₀₋ a₁₋ a₋₀ a₋₁ ≃ Square a₋₀ a₋₁ a₀₋ a₁₋ unquoteDef flipSquareEquiv = defStrictEquiv flipSquareEquiv flipSquare flipSquare - flipSquarePath : Square a₀₋ a₁₋ a₋₀ a₋₁ ≡ Square a₋₀ a₋₁ a₀₋ a₁₋ + flipSquarePath : Square a₀₋ a₁₋ a₋₀ a₋₁ ≡ Square a₋₀ a₋₁ a₀₋ a₁₋ flipSquarePath = ua flipSquareEquiv module _ {a₀₀ a₁₁ : A} {a₋ : a₀₀ ≡ a₁₁} @@ -180,12 +180,12 @@ slideSquareFaces i j k (j = i0) = a₋₀ i slideSquareFaces i j k (j = i1) = a₋ (i ∨ ~ k) - slideSquare : Square a₋ a₁₋ a₋₀ refl → Square refl a₁₋ a₋₀ a₋ + slideSquare : Square a₋ a₁₋ a₋₀ refl → Square refl a₁₋ a₋₀ a₋ slideSquare sq i j = hcomp (slideSquareFaces i j) (sq i j) - slideSquareEquiv : (Square a₋ a₁₋ a₋₀ refl) ≃ (Square refl a₁₋ a₋₀ a₋) + slideSquareEquiv : (Square a₋ a₁₋ a₋₀ refl) ≃ (Square refl a₁₋ a₋₀ a₋) slideSquareEquiv = isoToEquiv (iso slideSquare slideSquareInv fillerTo fillerFrom) where - slideSquareInv : Square refl a₁₋ a₋₀ a₋ → Square a₋ a₁₋ a₋₀ refl + slideSquareInv : Square refl a₁₋ a₋₀ a₋ → Square a₋ a₁₋ a₋₀ refl slideSquareInv sq i j = hcomp (λ k → slideSquareFaces i j (~ k)) (sq i j) fillerTo : ∀ p → slideSquare (slideSquareInv p) ≡ p fillerTo p k i j = hcomp-equivFiller (λ k → slideSquareFaces i j (~ k)) (inS (p i j)) (~ k) @@ -196,11 +196,11 @@ Square≃doubleComp : {a₀₀ a₀₁ a₁₀ a₁₁ : A} (a₀₋ : a₀₀ ≡ a₀₁) (a₁₋ : a₁₀ ≡ a₁₁) (a₋₀ : a₀₀ ≡ a₁₀) (a₋₁ : a₀₁ ≡ a₁₁) - → Square a₀₋ a₁₋ a₋₀ a₋₁ ≃ (a₋₀ ⁻¹ ∙∙ a₀₋ ∙∙ a₋₁ ≡ a₁₋) + → Square a₀₋ a₁₋ a₋₀ a₋₁ ≃ (a₋₀ ⁻¹ ∙∙ a₀₋ ∙∙ a₋₁ ≡ a₁₋) Square≃doubleComp a₀₋ a₁₋ a₋₀ a₋₁ = pathToEquiv (PathP≡doubleCompPathˡ a₋₀ a₀₋ a₁₋ a₋₁) -- Flipping a square in Ω²A is the same as inverting it -sym≡flipSquare : {x : A} (P : Square (refl {x = x}) refl refl refl) +sym≡flipSquare : {x : A} (P : Square (refl {x = x}) refl refl refl) → sym P ≡ flipSquare P sym≡flipSquare {x = x} P = sym (main refl P) where @@ -208,10 +208,10 @@ B q i = PathP (λ j → x ≡ q (i ∨ j)) (λ k → q (i ∧ k)) refl main : (q : x ≡ x) (p : refl ≡ q) → PathP (λ i → B q i) (λ i j → p j i) (sym p) - main q = J (λ q p → PathP (λ i → B q i) (λ i j → p j i) (sym p)) refl + main q = J (λ q p → PathP (λ i → B q i) (λ i j → p j i) (sym p)) refl -- Inverting both interval arguments of a square in Ω²A is the same as doing nothing -sym-cong-sym≡id : {x : A} (P : Square (refl {x = x}) refl refl refl) +sym-cong-sym≡id : {x : A} (P : Square (refl {x = x}) refl refl refl) → P ≡ λ i j → P (~ i) (~ j) sym-cong-sym≡id {x = x} P = sym (main refl P) where @@ -219,15 +219,15 @@ B q i = Path (x ≡ q i) (λ j → q (i ∨ ~ j)) λ j → q (i ∧ j) main : (q : x ≡ x) (p : refl ≡ q) → PathP (λ i → B q i) (λ i j → p (~ i) (~ j)) p - main q = J (λ q p → PathP (λ i → B q i) (λ i j → p (~ i) (~ j)) p) refl + main q = J (λ q p → PathP (λ i → B q i) (λ i j → p (~ i) (~ j)) p) refl -- Applying cong sym is the same as flipping a square in Ω²A -flipSquare≡cong-sym : ∀ {ℓ} {A : Type ℓ} {x : A} (P : Square (refl {x = x}) refl refl refl) +flipSquare≡cong-sym : ∀ {ℓ} {A : Type ℓ} {x : A} (P : Square (refl {x = x}) refl refl refl) → flipSquare P ≡ λ i j → P i (~ j) -flipSquare≡cong-sym P = sym (sym≡flipSquare P) ∙ sym (sym-cong-sym≡id (cong sym P)) +flipSquare≡cong-sym P = sym (sym≡flipSquare P) ∙ sym (sym-cong-sym≡id (cong sym P)) -- Applying cong sym is the same as inverting a square in Ω²A -sym≡cong-sym : ∀ {ℓ} {A : Type ℓ} {x : A} (P : Square (refl {x = x}) refl refl refl) +sym≡cong-sym : ∀ {ℓ} {A : Type ℓ} {x : A} (P : Square (refl {x = x}) refl refl refl) → sym P ≡ cong sym P sym≡cong-sym P = sym-cong-sym≡id (sym P) @@ -247,195 +247,195 @@ where -- "Pointwise" composition - _∙v_ : (p : Square a₀₋ a₁₋ a₋₀ a₋₁) (q : Square a₁₋ a₂₋ b₋₀ b₋₁) - → Square a₀₋ a₂₋ (a₋₀ ∙ b₋₀) (a₋₁ ∙ b₋₁) - (p ∙v q) i j = ((λ i → p i j) ∙ (λ i → q i j)) i + _∙v_ : (p : Square a₀₋ a₁₋ a₋₀ a₋₁) (q : Square a₁₋ a₂₋ b₋₀ b₋₁) + → Square a₀₋ a₂₋ (a₋₀ ∙ b₋₀) (a₋₁ ∙ b₋₁) + (p ∙v q) i j = ((λ i → p i j) ∙ (λ i → q i j)) i -- "Direct" composition - _∙v'_ : (p : Square a₀₋ a₁₋ a₋₀ a₋₁) (q : Square a₁₋ a₂₋ b₋₀ b₋₁) - → Square a₀₋ a₂₋ (a₋₀ ∙ b₋₀) (a₋₁ ∙ b₋₁) + _∙v'_ : (p : Square a₀₋ a₁₋ a₋₀ a₋₁) (q : Square a₁₋ a₂₋ b₋₀ b₋₁) + → Square a₀₋ a₂₋ (a₋₀ ∙ b₋₀) (a₋₁ ∙ b₋₁) (p ∙v' q) i = - comp (λ k → compPath-filler a₋₀ b₋₀ k i ≡ compPath-filler a₋₁ b₋₁ k i) + comp (λ k → compPath-filler a₋₀ b₋₀ k i ≡ compPath-filler a₋₁ b₋₁ k i) (λ where k (i = i0) → a₀₋ k (i = i1) → q k) (p i) -- The two ways of composing squares are equal, because they are -- correct "lids" for the same box - ∙v≡∙v' : (p : Square a₀₋ a₁₋ a₋₀ a₋₁) (q : Square a₁₋ a₂₋ b₋₀ b₋₁) + ∙v≡∙v' : (p : Square a₀₋ a₁₋ a₋₀ a₋₁) (q : Square a₁₋ a₂₋ b₋₀ b₋₁) → p ∙v q ≡ p ∙v' q ∙v≡∙v' p q l i = outS - (comp-unique {A = λ k → compPath-filler a₋₀ b₋₀ k i ≡ compPath-filler a₋₁ b₋₁ k i} + (comp-unique {A = λ k → compPath-filler a₋₀ b₋₀ k i ≡ compPath-filler a₋₁ b₋₁ k i} (λ where k (i = i0) → a₀₋ k (i = i1) → q k) (inS (p i)) - (λ k → inS λ j → compPath-filler (λ i → p i j) (λ i → q i j) k i)) + (λ k → inS λ j → compPath-filler (λ i → p i j) (λ i → q i j) k i)) (~ l) -- Inspect -module _ {A : Type ℓ} {B : Type ℓ'} where - - record Reveal_·_is_ (f : A → B) (x : A) (y : B) : Type (ℓ-max ℓ ℓ') where - constructor [_]ᵢ - field path : f x ≡ y - - inspect : (f : A → B) (x : A) → Reveal f · x is f x - inspect f x .Reveal_·_is_.path = refl - --- J is an equivalence -Jequiv : {x : A} (P : ∀ y → x ≡ y → Type ℓ') → P x refl ≃ (∀ {y} (p : x ≡ y) → P y p) -Jequiv P = isoToEquiv isom - where - isom : Iso _ _ - Iso.fun isom = J P - Iso.inv isom f = f refl - Iso.rightInv isom f = - implicitFunExt λ {_} → - funExt λ t → - J (λ _ t → J P (f refl) t ≡ f t) (JRefl P (f refl)) t - Iso.leftInv isom = JRefl P - --- Action of PathP on equivalences (without relying on univalence) - -congPathIso : ∀ {ℓ ℓ'} {A : I → Type ℓ} {B : I → Type ℓ'} - (e : ∀ i → A i ≃ B i) {a₀ : A i0} {a₁ : A i1} - → Iso (PathP A a₀ a₁) (PathP B (e i0 .fst a₀) (e i1 .fst a₁)) -congPathIso {A = A} {B} e {a₀} {a₁} .Iso.fun p i = e i .fst (p i) -congPathIso {A = A} {B} e {a₀} {a₁} .Iso.inv q i = - hcomp - (λ j → λ - { (i = i0) → retEq (e i0) a₀ j - ; (i = i1) → retEq (e i1) a₁ j - }) - (invEq (e i) (q i)) -congPathIso {A = A} {B} e {a₀} {a₁} .Iso.rightInv q k i = - hcomp - (λ j → λ - { (i = i0) → commSqIsEq (e i0 .snd) a₀ j k - ; (i = i1) → commSqIsEq (e i1 .snd) a₁ j k - ; (k = i0) → - e i .fst - (hfill - (λ j → λ - { (i = i0) → retEq (e i0) a₀ j - ; (i = i1) → retEq (e i1) a₁ j - }) - (inS (invEq (e i) (q i))) - j) - ; (k = i1) → q i - }) - (secEq (e i) (q i) k) - where b = commSqIsEq -congPathIso {A = A} {B} e {a₀} {a₁} .Iso.leftInv p k i = - hcomp - (λ j → λ - { (i = i0) → retEq (e i0) a₀ (j ∨ k) - ; (i = i1) → retEq (e i1) a₁ (j ∨ k) - ; (k = i1) → p i - }) - (retEq (e i) (p i) k) - -congPathEquiv : ∀ {ℓ ℓ'} {A : I → Type ℓ} {B : I → Type ℓ'} - (e : ∀ i → A i ≃ B i) {a₀ : A i0} {a₁ : A i1} - → PathP A a₀ a₁ ≃ PathP B (e i0 .fst a₀) (e i1 .fst a₁) -congPathEquiv e = isoToEquiv (congPathIso e) - --- Characterizations of dependent paths in path types - -doubleCompPath-filler∙ : {a b c d : A} (p : a ≡ b) (q : b ≡ c) (r : c ≡ d) - → PathP (λ i → p i ≡ r (~ i)) (p ∙ q ∙ r) q -doubleCompPath-filler∙ {A = A} {b = b} p q r j i = - hcomp (λ k → λ { (i = i0) → p j - ; (i = i1) → side j k - ; (j = i1) → q (i ∧ k)}) - (p (j ∨ i)) - where - side : I → I → A - side i j = - hcomp (λ k → λ { (i = i1) → q j - ; (j = i0) → b - ; (j = i1) → r (~ i ∧ k)}) - (q j) - -PathP→compPathL : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} - → PathP (λ i → p i ≡ q i) r s - → sym p ∙ r ∙ q ≡ s -PathP→compPathL {p = p} {q = q} {r = r} {s = s} P j i = - hcomp (λ k → λ { (i = i0) → p (j ∨ k) - ; (i = i1) → q (j ∨ k) - ; (j = i0) → doubleCompPath-filler∙ (sym p) r q (~ k) i - ; (j = i1) → s i }) - (P j i) - -PathP→compPathR : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} - → PathP (λ i → p i ≡ q i) r s - → r ≡ p ∙ s ∙ sym q -PathP→compPathR {p = p} {q = q} {r = r} {s = s} P j i = - hcomp (λ k → λ { (i = i0) → p (j ∧ (~ k)) - ; (i = i1) → q (j ∧ (~ k)) - ; (j = i0) → r i - ; (j = i1) → doubleCompPath-filler∙ p s (sym q) (~ k) i}) - (P j i) - - --- Other direction - -compPathL→PathP : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} - → sym p ∙ r ∙ q ≡ s - → PathP (λ i → p i ≡ q i) r s -compPathL→PathP {p = p} {q = q} {r = r} {s = s} P j i = - hcomp (λ k → λ { (i = i0) → p (~ k ∨ j) - ; (i = i1) → q (~ k ∨ j) - ; (j = i0) → doubleCompPath-filler∙ (sym p) r q k i - ; (j = i1) → s i}) - (P j i) - -compPathR→PathP : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} - → r ≡ p ∙ s ∙ sym q - → PathP (λ i → p i ≡ q i) r s -compPathR→PathP {p = p} {q = q} {r = r} {s = s} P j i = - hcomp (λ k → λ { (i = i0) → p (k ∧ j) - ; (i = i1) → q (k ∧ j) - ; (j = i0) → r i - ; (j = i1) → doubleCompPath-filler∙ p s (sym q) k i}) - (P j i) - -compPathR→PathP∙∙ : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} - → r ≡ p ∙∙ s ∙∙ sym q - → PathP (λ i → p i ≡ q i) r s -compPathR→PathP∙∙ {p = p} {q = q} {r = r} {s = s} P j i = - hcomp (λ k → λ { (i = i0) → p (k ∧ j) - ; (i = i1) → q (k ∧ j) - ; (j = i0) → r i - ; (j = i1) → doubleCompPath-filler p s (sym q) (~ k) i}) - (P j i) - -compPath→Square-faces : {a b c d : A} (p : a ≡ c) (q : b ≡ d) (r : a ≡ b) (s : c ≡ d) - → (i j k : I) → Partial (i ∨ ~ i ∨ j ∨ ~ j) A -compPath→Square-faces p q r s i j k = λ where - (i = i0) → r (j ∧ k) - (i = i1) → s (j ∨ ~ k) - (j = i0) → compPath-filler p s (~ k) i - (j = i1) → compPath-filler' r q (~ k) i - -compPath→Square : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} - → p ∙ s ≡ r ∙ q → Square r s p q -compPath→Square {p = p} {q = q} {r = r} {s = s} P i j = - hcomp (compPath→Square-faces p q r s i j) (P j i) - -Square→compPath : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} - → Square r s p q → p ∙ s ≡ r ∙ q -Square→compPath {p = p} {q = q} {r = r} {s = s} sq i j = - hcomp (λ k → compPath→Square-faces p q r s j i (~ k)) (sq j i) - -Square→compPathΩ² : {a : A} (sq : Square (λ _ → a) refl refl refl) - → Square→compPath sq ≡ cong (_∙ refl) (flipSquare sq) -Square→compPathΩ² {a = a} sq k i j = - hcomp (λ r → λ {(i = i0) → rUnit (λ _ → a) r j - ; (i = i1) → rUnit (λ _ → a) r j - ; (j = i0) → a - ; (j = i1) → a - ; (k = i1) → cong (λ x → rUnit x r) (flipSquare sq) i j}) - (sq j i) +module _ {A : Type ℓ} {B : A -> Type ℓ'} where + + record Reveal_·_is_ (f : (x : A) → B x) (x : A) (y : B x) : Type (ℓ-max ℓ ℓ') where + constructor [_]ᵢ + field path : f x ≡ y + + inspect : (f : (x : A) → B x) (x : A) → Reveal f · x is f x + inspect f x .Reveal_·_is_.path = refl + +-- J is an equivalence +Jequiv : {x : A} (P : ∀ y → x ≡ y → Type ℓ') → P x refl ≃ (∀ {y} (p : x ≡ y) → P y p) +Jequiv P = isoToEquiv isom + where + isom : Iso _ _ + Iso.fun isom = J P + Iso.inv isom f = f refl + Iso.rightInv isom f = + implicitFunExt λ {_} → + funExt λ t → + J (λ _ t → J P (f refl) t ≡ f t) (JRefl P (f refl)) t + Iso.leftInv isom = JRefl P + +-- Action of PathP on equivalences (without relying on univalence) + +congPathIso : ∀ {ℓ ℓ'} {A : I → Type ℓ} {B : I → Type ℓ'} + (e : ∀ i → A i ≃ B i) {a₀ : A i0} {a₁ : A i1} + → Iso (PathP A a₀ a₁) (PathP B (e i0 .fst a₀) (e i1 .fst a₁)) +congPathIso {A = A} {B} e {a₀} {a₁} .Iso.fun p i = e i .fst (p i) +congPathIso {A = A} {B} e {a₀} {a₁} .Iso.inv q i = + hcomp + (λ j → λ + { (i = i0) → retEq (e i0) a₀ j + ; (i = i1) → retEq (e i1) a₁ j + }) + (invEq (e i) (q i)) +congPathIso {A = A} {B} e {a₀} {a₁} .Iso.rightInv q k i = + hcomp + (λ j → λ + { (i = i0) → commSqIsEq (e i0 .snd) a₀ j k + ; (i = i1) → commSqIsEq (e i1 .snd) a₁ j k + ; (k = i0) → + e i .fst + (hfill + (λ j → λ + { (i = i0) → retEq (e i0) a₀ j + ; (i = i1) → retEq (e i1) a₁ j + }) + (inS (invEq (e i) (q i))) + j) + ; (k = i1) → q i + }) + (secEq (e i) (q i) k) + where b = commSqIsEq +congPathIso {A = A} {B} e {a₀} {a₁} .Iso.leftInv p k i = + hcomp + (λ j → λ + { (i = i0) → retEq (e i0) a₀ (j ∨ k) + ; (i = i1) → retEq (e i1) a₁ (j ∨ k) + ; (k = i1) → p i + }) + (retEq (e i) (p i) k) + +congPathEquiv : ∀ {ℓ ℓ'} {A : I → Type ℓ} {B : I → Type ℓ'} + (e : ∀ i → A i ≃ B i) {a₀ : A i0} {a₁ : A i1} + → PathP A a₀ a₁ ≃ PathP B (e i0 .fst a₀) (e i1 .fst a₁) +congPathEquiv e = isoToEquiv (congPathIso e) + +-- Characterizations of dependent paths in path types + +doubleCompPath-filler∙ : {a b c d : A} (p : a ≡ b) (q : b ≡ c) (r : c ≡ d) + → PathP (λ i → p i ≡ r (~ i)) (p ∙ q ∙ r) q +doubleCompPath-filler∙ {A = A} {b = b} p q r j i = + hcomp (λ k → λ { (i = i0) → p j + ; (i = i1) → side j k + ; (j = i1) → q (i ∧ k)}) + (p (j ∨ i)) + where + side : I → I → A + side i j = + hcomp (λ k → λ { (i = i1) → q j + ; (j = i0) → b + ; (j = i1) → r (~ i ∧ k)}) + (q j) + +PathP→compPathL : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} + → PathP (λ i → p i ≡ q i) r s + → sym p ∙ r ∙ q ≡ s +PathP→compPathL {p = p} {q = q} {r = r} {s = s} P j i = + hcomp (λ k → λ { (i = i0) → p (j ∨ k) + ; (i = i1) → q (j ∨ k) + ; (j = i0) → doubleCompPath-filler∙ (sym p) r q (~ k) i + ; (j = i1) → s i }) + (P j i) + +PathP→compPathR : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} + → PathP (λ i → p i ≡ q i) r s + → r ≡ p ∙ s ∙ sym q +PathP→compPathR {p = p} {q = q} {r = r} {s = s} P j i = + hcomp (λ k → λ { (i = i0) → p (j ∧ (~ k)) + ; (i = i1) → q (j ∧ (~ k)) + ; (j = i0) → r i + ; (j = i1) → doubleCompPath-filler∙ p s (sym q) (~ k) i}) + (P j i) + + +-- Other direction + +compPathL→PathP : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} + → sym p ∙ r ∙ q ≡ s + → PathP (λ i → p i ≡ q i) r s +compPathL→PathP {p = p} {q = q} {r = r} {s = s} P j i = + hcomp (λ k → λ { (i = i0) → p (~ k ∨ j) + ; (i = i1) → q (~ k ∨ j) + ; (j = i0) → doubleCompPath-filler∙ (sym p) r q k i + ; (j = i1) → s i}) + (P j i) + +compPathR→PathP : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} + → r ≡ p ∙ s ∙ sym q + → PathP (λ i → p i ≡ q i) r s +compPathR→PathP {p = p} {q = q} {r = r} {s = s} P j i = + hcomp (λ k → λ { (i = i0) → p (k ∧ j) + ; (i = i1) → q (k ∧ j) + ; (j = i0) → r i + ; (j = i1) → doubleCompPath-filler∙ p s (sym q) k i}) + (P j i) + +compPathR→PathP∙∙ : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} + → r ≡ p ∙∙ s ∙∙ sym q + → PathP (λ i → p i ≡ q i) r s +compPathR→PathP∙∙ {p = p} {q = q} {r = r} {s = s} P j i = + hcomp (λ k → λ { (i = i0) → p (k ∧ j) + ; (i = i1) → q (k ∧ j) + ; (j = i0) → r i + ; (j = i1) → doubleCompPath-filler p s (sym q) (~ k) i}) + (P j i) + +compPath→Square-faces : {a b c d : A} (p : a ≡ c) (q : b ≡ d) (r : a ≡ b) (s : c ≡ d) + → (i j k : I) → Partial (i ∨ ~ i ∨ j ∨ ~ j) A +compPath→Square-faces p q r s i j k = λ where + (i = i0) → r (j ∧ k) + (i = i1) → s (j ∨ ~ k) + (j = i0) → compPath-filler p s (~ k) i + (j = i1) → compPath-filler' r q (~ k) i + +compPath→Square : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} + → p ∙ s ≡ r ∙ q → Square r s p q +compPath→Square {p = p} {q = q} {r = r} {s = s} P i j = + hcomp (compPath→Square-faces p q r s i j) (P j i) + +Square→compPath : {a b c d : A} {p : a ≡ c} {q : b ≡ d} {r : a ≡ b} {s : c ≡ d} + → Square r s p q → p ∙ s ≡ r ∙ q +Square→compPath {p = p} {q = q} {r = r} {s = s} sq i j = + hcomp (λ k → compPath→Square-faces p q r s j i (~ k)) (sq j i) + +Square→compPathΩ² : {a : A} (sq : Square (λ _ → a) refl refl refl) + → Square→compPath sq ≡ cong (_∙ refl) (flipSquare sq) +Square→compPathΩ² {a = a} sq k i j = + hcomp (λ r → λ {(i = i0) → rUnit (λ _ → a) r j + ; (i = i1) → rUnit (λ _ → a) r j + ; (j = i0) → a + ; (j = i1) → a + ; (k = i1) → cong (λ x → rUnit x r) (flipSquare sq) i j}) + (sq j i) \ No newline at end of file diff --git a/docs/Cubical.Foundations.Pointed.Base.html b/docs/Cubical.Foundations.Pointed.Base.html index f346054..3ee105b 100644 --- a/docs/Cubical.Foundations.Pointed.Base.html +++ b/docs/Cubical.Foundations.Pointed.Base.html @@ -6,7 +6,7 @@ open import Cubical.Foundations.Equiv open import Cubical.Foundations.Structure -open import Cubical.Foundations.Structure using (typ) public +open import Cubical.Foundations.Structure using (typ) public open import Cubical.Foundations.GroupoidLaws open import Cubical.Foundations.Isomorphism open import Cubical.Foundations.Univalence @@ -17,10 +17,10 @@ ℓ ℓ' : Level Pointed : (ℓ : Level) → Type (ℓ-suc ℓ) -Pointed ℓ = TypeWithStr ℓ (λ x → x) +Pointed ℓ = TypeWithStr ℓ (λ x → x) -pt : ∀ {ℓ} (A∙ : Pointed ℓ) → typ A∙ -pt = str +pt : ∀ {ℓ} (A∙ : Pointed ℓ) → typ A∙ +pt = str Pointed₀ = Pointed ℓ-zero @@ -50,12 +50,12 @@ invEquiv∙ : {A : Pointed ℓ} {B : Pointed ℓ'} → A ≃∙ B → B ≃∙ A fst (invEquiv∙ x) = invEquiv (fst x) snd (invEquiv∙ {A = A} x) = - sym (cong (fst (invEquiv (fst x))) (snd x)) ∙ retEq (fst x) (pt A) + sym (cong (fst (invEquiv (fst x))) (snd x)) ∙ retEq (fst x) (pt A) compEquiv∙ : ∀ {ℓ ℓ' ℓ''} {A : Pointed ℓ} {B : Pointed ℓ'} {C : Pointed ℓ''} → A ≃∙ B → B ≃∙ C → A ≃∙ C fst (compEquiv∙ e1 e2) = compEquiv (fst e1) (fst e2) -snd (compEquiv∙ e1 e2) = cong (fst (fst e2)) (snd e1) ∙ snd e2 +snd (compEquiv∙ e1 e2) = cong (fst (fst e2)) (snd e1) ∙ snd e2 Equiv∙J : {B : Pointed ℓ} (C : (A : Pointed ℓ) → A ≃∙ B → Type ℓ') → C B (idEquiv (fst B) , refl) @@ -63,21 +63,21 @@ Equiv∙J {ℓ} {ℓ'} {B = B} C ind {A = A} = uncurry λ e p → help e (pt A) (pt B) p C ind where - help : ∀ {A : Type ℓ} (e : A ≃ typ B) (a : A) (b : typ B) + help : ∀ {A : Type ℓ} (e : A ≃ typ B) (a : A) (b : typ B) → (p : fst e a ≡ b) → (C : (A : Pointed ℓ) → A ≃∙ (fst B , b) → Type ℓ') → C (fst B , b) (idEquiv (fst B) , refl) → C (A , a) (e , p) - help = EquivJ (λ A e → (a : A) (b : typ B) + help = EquivJ (λ A e → (a : A) (b : typ B) → (p : fst e a ≡ b) → (C : (A : Pointed ℓ) → A ≃∙ (fst B , b) → Type ℓ') → C (fst B , b) (idEquiv (fst B) , refl) → C (A , a) (e , p)) - λ a b → J (λ b p + λ a b → J (λ b p → (C : (A : Pointed ℓ) → A ≃∙ (fst B , b) → Type ℓ') → C (fst B , b) (idEquiv (fst B) , refl) → - C (typ B , a) (idEquiv (typ B) , p)) + C (typ B , a) (idEquiv (typ B) , p)) λ _ p → p ua∙ : {A B : Pointed ℓ} (e : fst A ≃ fst B) @@ -91,15 +91,15 @@ → ((f : fst A → B) → P (f (pt A)) (f , refl)) → {b₀ : B} (f : A →∙ (B , b₀)) → P b₀ f →∙J {A = A} P ind = - uncurry λ f → J (λ b₀ y → P b₀ (f , y)) (ind f) + uncurry λ f → J (λ b₀ y → P b₀ (f , y)) (ind f) {- HIT allowing for pattern matching on pointed types -} data Pointer {ℓ} (A : Pointed ℓ) : Type ℓ where pt₀ : Pointer A - ⌊_⌋ : typ A → Pointer A + ⌊_⌋ : typ A → Pointer A id : ⌊ pt A ⌋ ≡ pt₀ -IsoPointedPointer : {A : Pointed ℓ} → Iso (typ A) (Pointer A) +IsoPointedPointer : {A : Pointed ℓ} → Iso (typ A) (Pointer A) Iso.fun IsoPointedPointer = ⌊_⌋ Iso.inv (IsoPointedPointer {A = A}) pt₀ = pt A Iso.inv IsoPointedPointer ⌊ x ⌋ = x @@ -109,7 +109,7 @@ Iso.rightInv IsoPointedPointer (id i) j = id (i ∧ j) Iso.leftInv IsoPointedPointer x = refl -Pointed≡Pointer : {A : Pointed ℓ} → typ A ≡ Pointer A +Pointed≡Pointer : {A : Pointed ℓ} → typ A ≡ Pointer A Pointed≡Pointer = isoToPath IsoPointedPointer Pointer∙ : (A : Pointed ℓ) → Pointed ℓ @@ -126,7 +126,7 @@ → Pointer A → Pointer B pointerFun f pt₀ = pt₀ pointerFun f ⌊ x ⌋ = ⌊ fst f x ⌋ -pointerFun f (id i) = (cong ⌊_⌋ (snd f) ∙ id) i +pointerFun f (id i) = (cong ⌊_⌋ (snd f) ∙ id) i pointerFun∙ : ∀ {ℓ'} {A : Pointed ℓ} {B : Pointed ℓ'} (f : A →∙ B) → Pointer∙ A →∙ Pointer∙ B @@ -136,7 +136,7 @@ -- pointed identity equivalence idEquiv∙ : (A : Pointed ℓ) → (A ≃∙ A) -idEquiv∙ A = idEquiv (typ A) , refl +idEquiv∙ A = idEquiv (typ A) , refl {- Equational reasoning for pointed equivalences diff --git a/docs/Cubical.Foundations.Pointed.FunExt.html b/docs/Cubical.Foundations.Pointed.FunExt.html index af0e758..d06dceb 100644 --- a/docs/Cubical.Foundations.Pointed.FunExt.html +++ b/docs/Cubical.Foundations.Pointed.FunExt.html @@ -14,37 +14,37 @@ variable ℓ ℓ' : Level -module _ {A : Pointed ℓ} {B : typ A → Type ℓ'} {ptB : B (pt A)} where +module _ {A : Pointed ℓ} {B : typ A → Type ℓ'} {ptB : B (pt A)} where -- pointed function extensionality - funExt∙P : {f g : Π∙ A B ptB} → f ∙∼P g → f ≡ g + funExt∙P : {f g : Π∙ A B ptB} → f ∙∼P g → f ≡ g funExt∙P (h , h∙) i .fst x = h x i funExt∙P (h , h∙) i .snd = h∙ i -- inverse of pointed function extensionality - funExt∙P⁻ : {f g : Π∙ A B ptB} → f ≡ g → f ∙∼P g + funExt∙P⁻ : {f g : Π∙ A B ptB} → f ≡ g → f ∙∼P g funExt∙P⁻ p .fst a i = p i .fst a funExt∙P⁻ p .snd i = p i .snd -- function extensionality is an isomorphism, PathP version - funExt∙PIso : (f g : Π∙ A B ptB) → Iso (f ∙∼P g) (f ≡ g) + funExt∙PIso : (f g : Π∙ A B ptB) → Iso (f ∙∼P g) (f ≡ g) Iso.fun (funExt∙PIso f g) = funExt∙P {f = f} {g = g} Iso.inv (funExt∙PIso f g) = funExt∙P⁻ {f = f} {g = g} Iso.rightInv (funExt∙PIso f g) p i j = p j Iso.leftInv (funExt∙PIso f g) h _ = h -- transformed to equivalence - funExt∙P≃ : (f g : Π∙ A B ptB) → (f ∙∼P g) ≃ (f ≡ g) + funExt∙P≃ : (f g : Π∙ A B ptB) → (f ∙∼P g) ≃ (f ≡ g) funExt∙P≃ f g = isoToEquiv (funExt∙PIso f g) -- funExt∙≃ using the other kind of pointed homotopy - funExt∙≃ : (f g : Π∙ A B ptB) → (f ∙∼ g) ≃ (f ≡ g) + funExt∙≃ : (f g : Π∙ A B ptB) → (f ∙∼ g) ≃ (f ≡ g) funExt∙≃ f g = compEquiv (∙∼≃∙∼P f g) (funExt∙P≃ f g) -- standard pointed function extensionality and its inverse - funExt∙ : {f g : Π∙ A B ptB} → f ∙∼ g → f ≡ g + funExt∙ : {f g : Π∙ A B ptB} → f ∙∼ g → f ≡ g funExt∙ {f = f} {g = g} = equivFun (funExt∙≃ f g) - funExt∙⁻ : {f g : Π∙ A B ptB} → f ≡ g → f ∙∼ g + funExt∙⁻ : {f g : Π∙ A B ptB} → f ≡ g → f ∙∼ g funExt∙⁻ {f = f} {g = g} = equivFun (invEquiv (funExt∙≃ f g)) \ No newline at end of file diff --git a/docs/Cubical.Foundations.Pointed.Homogeneous.html b/docs/Cubical.Foundations.Pointed.Homogeneous.html index 867c636..742d17b 100644 --- a/docs/Cubical.Foundations.Pointed.Homogeneous.html +++ b/docs/Cubical.Foundations.Pointed.Homogeneous.html @@ -43,32 +43,32 @@ →∙Homogeneous≡ : ∀ {ℓ ℓ'} {A∙ : Pointed ℓ} {B∙ : Pointed ℓ'} {f∙ g∙ : A∙ →∙ B∙} (h : isHomogeneous B∙) → f∙ .fst ≡ g∙ .fst → f∙ ≡ g∙ →∙Homogeneous≡ {A∙ = A∙@(_ , a₀)} {B∙@(B , _)} {f∙@(_ , f₀)} {g∙@(_ , g₀)} h p = - subst (λ Q∙ → PathP (λ i → A∙ →∙ Q∙ i) f∙ g∙) (sym (flipSquare fix)) badPath + subst (λ Q∙ → PathP (λ i → A∙ →∙ Q∙ i) f∙ g∙) (sym (flipSquare fix)) badPath where - badPath : PathP (λ i → A∙ →∙ (B , (sym f₀ ∙∙ funExt⁻ p a₀ ∙∙ g₀) i)) f∙ g∙ + badPath : PathP (λ i → A∙ →∙ (B , (sym f₀ ∙∙ funExt⁻ p a₀ ∙∙ g₀) i)) f∙ g∙ badPath i .fst = p i - badPath i .snd j = doubleCompPath-filler (sym f₀) (funExt⁻ p a₀) g₀ j i + badPath i .snd j = doubleCompPath-filler (sym f₀) (funExt⁻ p a₀) g₀ j i - fix : PathP (λ i → B∙ ≡ (B , (sym f₀ ∙∙ funExt⁻ p a₀ ∙∙ g₀) i)) refl refl + fix : PathP (λ i → B∙ ≡ (B , (sym f₀ ∙∙ funExt⁻ p a₀ ∙∙ g₀) i)) refl refl fix i = hcomp (λ j → λ { (i = i0) → lCancel (h (pt B∙)) j ; (i = i1) → lCancel (h (pt B∙)) j }) - (sym (h (pt B∙)) ∙ h ((sym f₀ ∙∙ funExt⁻ p a₀ ∙∙ g₀) i)) + (sym (h (pt B∙)) ∙ h ((sym f₀ ∙∙ funExt⁻ p a₀ ∙∙ g₀) i)) →∙Homogeneous≡Path : ∀ {ℓ ℓ'} {A∙ : Pointed ℓ} {B∙ : Pointed ℓ'} {f∙ g∙ : A∙ →∙ B∙} (h : isHomogeneous B∙) → (p q : f∙ ≡ g∙) → cong fst p ≡ cong fst q → p ≡ q →∙Homogeneous≡Path {A∙ = A∙@(A , a₀)} {B∙@(B , b)} {f∙@(f , f₀)} {g∙@(g , g₀)} h p q r = - transport (λ k + transport (λ k → PathP (λ i → PathP (λ j → (A , a₀) →∙ newPath-refl p q r i j (~ k)) (f , f₀) (g , g₀)) p q) (badPath p q r) where newPath : (p q : f∙ ≡ g∙) (r : cong fst p ≡ cong fst q) - → Square (refl {x = b}) refl refl refl + → Square (refl {x = b}) refl refl refl newPath p q r i j = hcomp (λ k → λ {(i = i0) → cong snd p j k ; (i = i1) → cong snd q j k @@ -85,7 +85,7 @@ ; (j = i1) → lCancel (h b) w k ; (k = i0) → lCancel (h b) w k ; (k = i1) → B , newPath p q r i j}) - ((sym (h b) ∙ h (newPath p q r i j)) k) + ((sym (h b) ∙ h (newPath p q r i j)) k) badPath : (p q : f∙ ≡ g∙) (r : cong fst p ≡ cong fst q) → PathP (λ i → @@ -103,29 +103,29 @@ →∙HomogeneousSquare : ∀ {ℓ ℓ'} {A∙ : Pointed ℓ} {B∙ : Pointed ℓ'} {f∙ g∙ h∙ l∙ : A∙ →∙ B∙} (h : isHomogeneous B∙) → (s : f∙ ≡ h∙) (t : g∙ ≡ l∙) (p : f∙ ≡ g∙) (q : h∙ ≡ l∙) - → Square (cong fst p) (cong fst q) (cong fst s) (cong fst t) - → Square p q s t + → Square (cong fst p) (cong fst q) (cong fst s) (cong fst t) + → Square p q s t →∙HomogeneousSquare {f∙ = f∙} {g∙ = g∙} {h∙ = h∙} {l∙ = l∙} h = - J (λ h∙ s → (t : g∙ ≡ l∙) (p : f∙ ≡ g∙) (q : h∙ ≡ l∙) → - Square (cong fst p) (cong fst q) (cong fst s) (cong fst t) → - Square p q s t) - (J (λ l∙ t → (p : f∙ ≡ g∙) (q : f∙ ≡ l∙) - → Square (cong fst p) (cong fst q) refl (cong fst t) - → Square p q refl t) + J (λ h∙ s → (t : g∙ ≡ l∙) (p : f∙ ≡ g∙) (q : h∙ ≡ l∙) → + Square (cong fst p) (cong fst q) (cong fst s) (cong fst t) → + Square p q s t) + (J (λ l∙ t → (p : f∙ ≡ g∙) (q : f∙ ≡ l∙) + → Square (cong fst p) (cong fst q) refl (cong fst t) + → Square p q refl t) (→∙Homogeneous≡Path {f∙ = f∙} {g∙ = g∙} h)) isHomogeneousPi : ∀ {ℓ ℓ'} {A : Type ℓ} {B∙ : A → Pointed ℓ'} - → (∀ a → isHomogeneous (B∙ a)) → isHomogeneous (Πᵘ∙ A B∙) -isHomogeneousPi h f i .fst = ∀ a → typ (h a (f a) i) + → (∀ a → isHomogeneous (B∙ a)) → isHomogeneous (Πᵘ∙ A B∙) +isHomogeneousPi h f i .fst = ∀ a → typ (h a (f a) i) isHomogeneousPi h f i .snd a = pt (h a (f a) i) -isHomogeneousΠ∙ : ∀ {ℓ ℓ'} (A : Pointed ℓ) (B : typ A → Type ℓ') +isHomogeneousΠ∙ : ∀ {ℓ ℓ'} (A : Pointed ℓ) (B : typ A → Type ℓ') → (b₀ : B (pt A)) - → ((a : typ A) (x : B a) → isHomogeneous (B a , x)) - → (f : Π∙ A B b₀) - → isHomogeneous (Π∙ A B b₀ , f) + → ((a : typ A) (x : B a) → isHomogeneous (B a , x)) + → (f : Π∙ A B b₀) + → isHomogeneous (Π∙ A B b₀ , f) fst (isHomogeneousΠ∙ A B b₀ h f g i) = - Σ[ r ∈ ((a : typ A) → fst ((h a (fst f a) (fst g a)) i)) ] + Σ[ r ∈ ((a : typ A) → fst ((h a (fst f a) (fst g a)) i)) ] r (pt A) ≡ hcomp (λ k → λ {(i = i0) → snd f k ; (i = i1) → snd g k}) (snd (h (pt A) (fst f (pt A)) (fst g (pt A)) i)) @@ -141,22 +141,22 @@ → isHomogeneous B∙ → isHomogeneous (A∙ →∙ B∙ ∙) isHomogeneous→∙ {A∙ = A∙} {B∙} h f∙ = ΣPathP - ( (λ i → Π∙ A∙ (λ a → T a i) (t₀ i)) + ( (λ i → Π∙ A∙ (λ a → T a i) (t₀ i)) , PathPIsoPath _ _ _ .Iso.inv (→∙Homogeneous≡ h - (PathPIsoPath (λ i → (a : typ A∙) → T a i) (λ _ → pt B∙) _ .Iso.fun + (PathPIsoPath (λ i → (a : typ A∙) → T a i) (λ _ → pt B∙) _ .Iso.fun (λ i a → pt (h (f∙ .fst a) i)))) ) where - T : ∀ a → typ B∙ ≡ typ B∙ - T a i = typ (h (f∙ .fst a) i) + T : ∀ a → typ B∙ ≡ typ B∙ + T a i = typ (h (f∙ .fst a) i) t₀ : PathP (λ i → T (pt A∙) i) (pt B∙) (pt B∙) - t₀ = cong pt (h (f∙ .fst (pt A∙))) ▷ f∙ .snd + t₀ = cong pt (h (f∙ .fst (pt A∙))) ▷ f∙ .snd isHomogeneousProd : ∀ {ℓ ℓ'} {A∙ : Pointed ℓ} {B∙ : Pointed ℓ'} - → isHomogeneous A∙ → isHomogeneous B∙ → isHomogeneous (A∙ ×∙ B∙) -isHomogeneousProd hA hB (a , b) i .fst = typ (hA a i) × typ (hB b i) + → isHomogeneous A∙ → isHomogeneous B∙ → isHomogeneous (A∙ ×∙ B∙) +isHomogeneousProd hA hB (a , b) i .fst = typ (hA a i) × typ (hB b i) isHomogeneousProd hA hB (a , b) i .snd .fst = pt (hA a i) isHomogeneousProd hA hB (a , b) i .snd .snd = pt (hB b i) @@ -164,12 +164,12 @@ isHomogeneousPath A {x} {y} p q = pointed-sip ((x ≡ y) , p) ((x ≡ y) , q) (eqv , compPathr-cancel p q) where eqv : (x ≡ y) ≃ (x ≡ y) - eqv = compPathlEquiv (q ∙ sym p) + eqv = compPathlEquiv (q ∙ sym p) -module HomogeneousDiscrete {ℓ} {A∙ : Pointed ℓ} (dA : Discrete (typ A∙)) (y : typ A∙) where +module HomogeneousDiscrete {ℓ} {A∙ : Pointed ℓ} (dA : Discrete (typ A∙)) (y : typ A∙) where -- switches pt A∙ with y - switch : typ A∙ → typ A∙ + switch : typ A∙ → typ A∙ switch x with dA x (pt A∙) ... | yes _ = y ... | no _ with dA x y @@ -184,13 +184,13 @@ switch-idp : ∀ x → switch (switch x) ≡ x switch-idp x with dA x (pt A∙) switch-idp x | yes p with dA y (pt A∙) - switch-idp x | yes p | yes q = q ∙ sym p + switch-idp x | yes p | yes q = q ∙ sym p switch-idp x | yes p | no _ with dA y y switch-idp x | yes p | no _ | yes _ = sym p switch-idp x | yes p | no _ | no ¬p = ⊥.rec (¬p refl) switch-idp x | no ¬p with dA x y switch-idp x | no ¬p | yes p with dA y (pt A∙) - switch-idp x | no ¬p | yes p | yes q = ⊥.rec (¬p (p ∙ q)) + switch-idp x | no ¬p | yes p | yes q = ⊥.rec (¬p (p ∙ q)) switch-idp x | no ¬p | yes p | no _ with dA (pt A∙) (pt A∙) switch-idp x | no ¬p | yes p | no _ | yes _ = sym p switch-idp x | no ¬p | yes p | no _ | no ¬q = ⊥.rec (¬q refl) @@ -200,11 +200,11 @@ switch-idp x | no ¬p | no ¬q | no _ | yes q = ⊥.rec (¬q q) switch-idp x | no ¬p | no ¬q | no _ | no _ = refl - switch-eqv : typ A∙ ≃ typ A∙ + switch-eqv : typ A∙ ≃ typ A∙ switch-eqv = isoToEquiv (iso switch switch switch-idp switch-idp) -isHomogeneousDiscrete : ∀ {ℓ} {A∙ : Pointed ℓ} (dA : Discrete (typ A∙)) → isHomogeneous A∙ +isHomogeneousDiscrete : ∀ {ℓ} {A∙ : Pointed ℓ} (dA : Discrete (typ A∙)) → isHomogeneous A∙ isHomogeneousDiscrete {ℓ} {A∙} dA y - = pointed-sip (typ A∙ , pt A∙) (typ A∙ , y) (switch-eqv , switch-ptA∙) + = pointed-sip (typ A∙ , pt A∙) (typ A∙ , y) (switch-eqv , switch-ptA∙) where open HomogeneousDiscrete {ℓ} {A∙} dA y \ No newline at end of file diff --git a/docs/Cubical.Foundations.Pointed.Homotopy.html b/docs/Cubical.Foundations.Pointed.Homotopy.html index ee5bf81..ad8887b 100644 --- a/docs/Cubical.Foundations.Pointed.Homotopy.html +++ b/docs/Cubical.Foundations.Pointed.Homotopy.html @@ -25,22 +25,22 @@ variable ℓ ℓ' : Level -module _ {A : Pointed ℓ} {B : typ A → Type ℓ'} {ptB : B (pt A)} where +module _ {A : Pointed ℓ} {B : typ A → Type ℓ'} {ptB : B (pt A)} where ⋆ = pt A -- pointed homotopy as pointed Π. This is just a Σ-type, see ∙∼Σ - _∙∼_ : (f g : Π∙ A B ptB) → Type (ℓ-max ℓ ℓ') - (f₁ , f₂) ∙∼ (g₁ , g₂) = Π∙ A (λ x → f₁ x ≡ g₁ x) (f₂ ∙ g₂ ⁻¹) + _∙∼_ : (f g : Π∙ A B ptB) → Type (ℓ-max ℓ ℓ') + (f₁ , f₂) ∙∼ (g₁ , g₂) = Π∙ A (λ x → f₁ x ≡ g₁ x) (f₂ ∙ g₂ ⁻¹) -- pointed homotopy with PathP. Also a Σ-type, see ∙∼PΣ - _∙∼P_ : (f g : Π∙ A B ptB) → Type (ℓ-max ℓ ℓ') + _∙∼P_ : (f g : Π∙ A B ptB) → Type (ℓ-max ℓ ℓ') (f₁ , f₂) ∙∼P (g₁ , g₂) = Σ[ h ∈ f₁ ∼ g₁ ] PathP (λ i → h ⋆ i ≡ ptB) f₂ g₂ -- Proof that f ∙∼ g ≃ f ∙∼P g -- using equivalence of the total map of φ private - module _ (f g : Π∙ A B ptB) (H : f .fst ∼ g .fst) where + module _ (f g : Π∙ A B ptB) (H : f .fst ∼ g .fst) where -- convenient notation f₁ = fst f f₂ = snd f @@ -49,7 +49,7 @@ -- P is the predicate on a homotopy H to be pointed of the ∙∼ kind P : Type ℓ' - P = H ⋆ ≡ f₂ ∙ g₂ ⁻¹ + P = H ⋆ ≡ f₂ ∙ g₂ ⁻¹ -- Q is the predicate on a homotopy H to be pointed of the ∙∼P kind Q : Type ℓ' @@ -61,61 +61,61 @@ r = f₂ s = g₂ P≡Q : P ≡ Q - P≡Q = p ≡ r ∙ s ⁻¹ - ≡⟨ isoToPath symIso ⟩ - r ∙ s ⁻¹ ≡ p - ≡⟨ cong (r ∙ s ⁻¹ ≡_) (rUnit p ∙∙ cong (p ∙_) (sym (rCancel s)) ∙∙ assoc p s (s ⁻¹)) ⟩ - r ∙ s ⁻¹ ≡ (p ∙ s) ∙ s ⁻¹ - ≡⟨ sym (ua (compr≡Equiv r (p ∙ s) (s ⁻¹))) ⟩ - r ≡ p ∙ s - ≡⟨ ua (compl≡Equiv (p ⁻¹) r (p ∙ s)) ⟩ - p ⁻¹ ∙ r ≡ p ⁻¹ ∙ (p ∙ s) - ≡⟨ cong (p ⁻¹ ∙ r ≡_ ) (assoc (p ⁻¹) p s ∙∙ (cong (_∙ s) (lCancel p)) ∙∙ sym (lUnit s)) ⟩ - p ⁻¹ ∙ r ≡ s - ≡⟨ cong (λ z → p ⁻¹ ∙ z ≡ s) (rUnit r) ⟩ - p ⁻¹ ∙ (r ∙ refl) ≡ s - ≡⟨ cong (_≡ s) (sym (doubleCompPath-elim' (p ⁻¹) r refl)) ⟩ - p ⁻¹ ∙∙ r ∙∙ refl ≡ s - ≡⟨ sym (ua (Square≃doubleComp r s p refl)) ⟩ - PathP (λ i → p i ≡ ptB) r s ∎ + P≡Q = p ≡ r ∙ s ⁻¹ + ≡⟨ isoToPath symIso ⟩ + r ∙ s ⁻¹ ≡ p + ≡⟨ cong (r ∙ s ⁻¹ ≡_) (rUnit p ∙∙ cong (p ∙_) (sym (rCancel s)) ∙∙ assoc p s (s ⁻¹)) ⟩ + r ∙ s ⁻¹ ≡ (p ∙ s) ∙ s ⁻¹ + ≡⟨ sym (ua (compr≡Equiv r (p ∙ s) (s ⁻¹))) ⟩ + r ≡ p ∙ s + ≡⟨ ua (compl≡Equiv (p ⁻¹) r (p ∙ s)) ⟩ + p ⁻¹ ∙ r ≡ p ⁻¹ ∙ (p ∙ s) + ≡⟨ cong (p ⁻¹ ∙ r ≡_ ) (assoc (p ⁻¹) p s ∙∙ (cong (_∙ s) (lCancel p)) ∙∙ sym (lUnit s)) ⟩ + p ⁻¹ ∙ r ≡ s + ≡⟨ cong (λ z → p ⁻¹ ∙ z ≡ s) (rUnit r) ⟩ + p ⁻¹ ∙ (r ∙ refl) ≡ s + ≡⟨ cong (_≡ s) (sym (doubleCompPath-elim' (p ⁻¹) r refl)) ⟩ + p ⁻¹ ∙∙ r ∙∙ refl ≡ s + ≡⟨ sym (ua (Square≃doubleComp r s p refl)) ⟩ + PathP (λ i → p i ≡ ptB) r s ∎ -- φ is a fiberwise transformation (H : f ∼ g) → P H → Q H -- φ is even a fiberwise equivalence by P≡Q φ : P → Q - φ = transport P≡Q + φ = transport P≡Q -- The total map corresponding to φ - totφ : (f g : Π∙ A B ptB) → f ∙∼ g → f ∙∼P g + totφ : (f g : Π∙ A B ptB) → f ∙∼ g → f ∙∼P g totφ f g p .fst = p .fst totφ f g p .snd = φ f g (p .fst) (p .snd) -- transformation of the homotopies using totφ - ∙∼→∙∼P : (f g : Π∙ A B ptB) → (f ∙∼ g) → (f ∙∼P g) + ∙∼→∙∼P : (f g : Π∙ A B ptB) → (f ∙∼ g) → (f ∙∼P g) ∙∼→∙∼P f g = totφ f g -- 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 : Π∙ A B ptB) → (f ∙∼ g) ≃ (f ∙∼P g) + ∙∼≃∙∼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 + ∙∼P→∙∼ : {f g : Π∙ A B ptB} → f ∙∼P g → f ∙∼ g ∙∼P→∙∼ {f = f} {g = g} = invEq (∙∼≃∙∼P f g) -- ∙∼≃∙∼P transformed to a path - ∙∼≡∙∼P : (f g : Π∙ A B ptB) → (f ∙∼ g) ≡ (f ∙∼P g) + ∙∼≡∙∼P : (f g : Π∙ A B ptB) → (f ∙∼ g) ≡ (f ∙∼P g) ∙∼≡∙∼P f g = ua (∙∼≃∙∼P f g) -- Verifies that the pointed homotopies actually correspond -- to their Σ-type versions - _∙∼Σ_ : (f g : Π∙ A B ptB) → Type (ℓ-max ℓ ℓ') + _∙∼Σ_ : (f g : Π∙ A B ptB) → Type (ℓ-max ℓ ℓ') f ∙∼Σ g = Σ[ H ∈ f .fst ∼ g .fst ] (P f g H) - _∙∼PΣ_ : (f g : Π∙ A B ptB) → Type (ℓ-max ℓ ℓ') + _∙∼PΣ_ : (f g : Π∙ A B ptB) → Type (ℓ-max ℓ ℓ') f ∙∼PΣ g = Σ[ H ∈ f .fst ∼ g .fst ] (Q f g H) - ∙∼≡∙∼Σ : (f g : Π∙ A B ptB) → f ∙∼ g ≡ f ∙∼Σ g + ∙∼≡∙∼Σ : (f g : Π∙ A B ptB) → f ∙∼ g ≡ f ∙∼Σ g ∙∼≡∙∼Σ f g = refl - ∙∼P≡∙∼PΣ : (f g : Π∙ A B ptB) → f ∙∼P g ≡ f ∙∼PΣ g + ∙∼P≡∙∼PΣ : (f g : Π∙ A B ptB) → f ∙∼P g ≡ f ∙∼PΣ g ∙∼P≡∙∼PΣ f g = refl \ No newline at end of file diff --git a/docs/Cubical.Foundations.Pointed.Properties.html b/docs/Cubical.Foundations.Pointed.Properties.html index 80367d6..a66ee0a 100644 --- a/docs/Cubical.Foundations.Pointed.Properties.html +++ b/docs/Cubical.Foundations.Pointed.Properties.html @@ -8,187 +8,241 @@ open import Cubical.Foundations.GroupoidLaws open import Cubical.Foundations.Isomorphism open import Cubical.Foundations.Equiv -open import Cubical.Foundations.Isomorphism - -open import Cubical.Data.Sigma - -private - variable - ℓ ℓ' ℓA ℓB ℓC ℓD : Level - --- the default pointed Π-type: A is pointed, and B has a base point in the chosen fiber -Π∙ : (A : Pointed ℓ) (B : typ A → Type ℓ') (ptB : B (pt A)) → Type (ℓ-max ℓ ℓ') -Π∙ A B ptB = Σ[ f ∈ ((a : typ A) → B a) ] f (pt A) ≡ ptB - --- the unpointed Π-type becomes a pointed type if the fibers are all pointed -Πᵘ∙ : (A : Type ℓ) (B : A → Pointed ℓ') → Pointed (ℓ-max ℓ ℓ') -Πᵘ∙ A B .fst = ∀ a → typ (B a) -Πᵘ∙ A B .snd a = pt (B a) - --- if the base and all fibers are pointed, we have the pointed pointed Π-type -Πᵖ∙ : (A : Pointed ℓ) (B : typ A → Pointed ℓ') → Pointed (ℓ-max ℓ ℓ') -Πᵖ∙ A B .fst = Π∙ A (typ ∘ B) (pt (B (pt A))) -Πᵖ∙ A B .snd .fst a = pt (B a) -Πᵖ∙ A B .snd .snd = refl - --- the default pointed Σ-type is just the Σ-type, but as a pointed type -Σ∙ : (A : Pointed ℓ) (B : typ A → Type ℓ') (ptB : B (pt A)) → Pointed (ℓ-max ℓ ℓ') -Σ∙ A B ptB .fst = Σ[ a ∈ typ A ] B a -Σ∙ A B ptB .snd .fst = pt A -Σ∙ A B ptB .snd .snd = ptB - --- version if B is a family of pointed types -Σᵖ∙ : (A : Pointed ℓ) (B : typ A → Pointed ℓ') → Pointed (ℓ-max ℓ ℓ') -Σᵖ∙ A B = Σ∙ A (typ ∘ B) (pt (B (pt A))) - -_×∙_ : (A∙ : Pointed ℓ) (B∙ : Pointed ℓ') → Pointed (ℓ-max ℓ ℓ') -(A∙ ×∙ B∙) .fst = (typ A∙) × (typ B∙) -(A∙ ×∙ B∙) .snd .fst = pt A∙ -(A∙ ×∙ B∙) .snd .snd = pt B∙ - --- composition of pointed maps -_∘∙_ : {A : Pointed ℓA} {B : Pointed ℓB} {C : Pointed ℓC} - (g : B →∙ C) (f : A →∙ B) → (A →∙ C) -((g , g∙) ∘∙ (f , f∙)) .fst x = g (f x) -((g , g∙) ∘∙ (f , f∙)) .snd = (cong g f∙) ∙ g∙ - --- post composition -post∘∙ : ∀ {ℓX ℓ ℓ'} (X : Pointed ℓX) {A : Pointed ℓ} {B : Pointed ℓ'} - → (A →∙ B) → ((X →∙ A ∙) →∙ (X →∙ B ∙)) -post∘∙ X f .fst g = f ∘∙ g -post∘∙ X f .snd = - ΣPathP - ( (funExt λ _ → f .snd) - , (sym (lUnit (f .snd)) ◁ λ i j → f .snd (i ∨ j))) - --- pointed identity -id∙ : (A : Pointed ℓA) → (A →∙ A) -id∙ A .fst x = x -id∙ A .snd = refl - --- constant pointed map -const∙ : (A : Pointed ℓA) (B : Pointed ℓB) → (A →∙ B) -const∙ _ B .fst _ = B .snd -const∙ _ B .snd = refl - --- left identity law for pointed maps -∘∙-idˡ : {A : Pointed ℓA} {B : Pointed ℓB} (f : A →∙ B) → f ∘∙ id∙ A ≡ f -∘∙-idˡ f = ΣPathP ( refl , (lUnit (f .snd)) ⁻¹ ) - --- right identity law for pointed maps -∘∙-idʳ : {A : Pointed ℓA} {B : Pointed ℓB} (f : A →∙ B) → id∙ B ∘∙ f ≡ f -∘∙-idʳ f = ΣPathP ( refl , (rUnit (f .snd)) ⁻¹ ) - --- associativity for composition of pointed maps -∘∙-assoc : {A : Pointed ℓA} {B : Pointed ℓB} {C : Pointed ℓC} {D : Pointed ℓD} - (h : C →∙ D) (g : B →∙ C) (f : A →∙ B) - → (h ∘∙ g) ∘∙ f ≡ h ∘∙ (g ∘∙ f) -∘∙-assoc (h , h∙) (g , g∙) (f , f∙) = ΣPathP (refl , q) - where - q : (cong (h ∘ g) f∙) ∙ (cong h g∙ ∙ h∙) ≡ cong h (cong g f∙ ∙ g∙) ∙ h∙ - q = ( (cong (h ∘ g) f∙) ∙ (cong h g∙ ∙ h∙) - ≡⟨ refl ⟩ - (cong h (cong g f∙)) ∙ (cong h g∙ ∙ h∙) - ≡⟨ assoc (cong h (cong g f∙)) (cong h g∙) h∙ ⟩ - (cong h (cong g f∙) ∙ cong h g∙) ∙ h∙ - ≡⟨ cong (λ p → p ∙ h∙) ((cong-∙ h (cong g f∙) g∙) ⁻¹) ⟩ - (cong h (cong g f∙ ∙ g∙) ∙ h∙) ∎ ) - -module _ {ℓ ℓ' : Level} {A : Pointed ℓ} {B : Pointed ℓ'} (f : A →∙ B) where - isInIm∙ : (x : typ B) → Type (ℓ-max ℓ ℓ') - isInIm∙ x = Σ[ z ∈ typ A ] fst f z ≡ x - - isInKer∙ : (x : fst A) → Type ℓ' - isInKer∙ x = fst f x ≡ snd B - -pre∘∙equiv : ∀ {ℓ ℓ'} {A : Pointed ℓ} {B C : Pointed ℓ'} - → (B ≃∙ C) → Iso (A →∙ B) (A →∙ C) -pre∘∙equiv {A = A} {B = B} {C = C} eq = main - where - module _ {ℓ ℓ' : Level} (A : Pointed ℓ) (B C : Pointed ℓ') - (eq : (B ≃∙ C)) where - to : (A →∙ B) → (A →∙ C) - to = ≃∙map eq ∘∙_ - - from : (A →∙ C) → (A →∙ B) - from = ≃∙map (invEquiv∙ eq) ∘∙_ - - lem : {ℓ : Level} {B : Pointed ℓ} - → ≃∙map (invEquiv∙ {A = B} ((idEquiv (fst B)) , refl)) ≡ id∙ B - lem = ΣPathP (refl , (sym (lUnit _))) - - J-lem : {ℓ ℓ' : Level} {A : Pointed ℓ} {B C : Pointed ℓ'} - → (eq : (B ≃∙ C)) - → retract (to A B C eq) (from _ _ _ eq) - × section (to A B C eq) (from _ _ _ eq) - J-lem {A = A} {B = B} {C = C} = - Equiv∙J (λ B eq → retract (to A B C eq) (from _ _ _ eq) - × section (to A B C eq) (from _ _ _ eq)) - ((λ f → ((λ i → (lem i ∘∙ (id∙ C ∘∙ f))) - ∙ λ i → ∘∙-idʳ (∘∙-idʳ f i) i)) - , λ f → ((λ i → (id∙ C ∘∙ (lem i ∘∙ f))) - ∙ λ i → ∘∙-idʳ (∘∙-idʳ f i) i)) - - main : Iso (A →∙ B) (A →∙ C) - Iso.fun main = to A B C eq - Iso.inv main = from A B C eq - Iso.rightInv main = J-lem eq .snd - Iso.leftInv main = J-lem eq .fst - -post∘∙equiv : ∀ {ℓ ℓC} {A B : Pointed ℓ} {C : Pointed ℓC} - → (A ≃∙ B) → Iso (A →∙ C) (B →∙ C) -post∘∙equiv {A = A} {B = B} {C = C} eq = main - where - module _ {ℓ ℓC : Level} (A B : Pointed ℓ) (C : Pointed ℓC) - (eq : (A ≃∙ B)) where - to : (A →∙ C) → (B →∙ C) - to = _∘∙ ≃∙map (invEquiv∙ eq) - - from : (B →∙ C) → (A →∙ C) - from = _∘∙ ≃∙map eq - - lem : {ℓ : Level} {B : Pointed ℓ} - → ≃∙map (invEquiv∙ {A = B} ((idEquiv (fst B)) , refl)) ≡ id∙ B - lem = ΣPathP (refl , (sym (lUnit _))) - - J-lem : {ℓ ℓC : Level} {A B : Pointed ℓ} {C : Pointed ℓC} - → (eq : (A ≃∙ B)) - → retract (to A B C eq) (from _ _ _ eq) - × section (to A B C eq) (from _ _ _ eq) - J-lem {B = B} {C = C} = - Equiv∙J (λ A eq → retract (to A B C eq) (from _ _ _ eq) - × section (to A B C eq) (from _ _ _ eq)) - ((λ f → ((λ i → (f ∘∙ lem i) ∘∙ id∙ B) - ∙ λ i → ∘∙-idˡ (∘∙-idˡ f i) i)) - , λ f → (λ i → (f ∘∙ id∙ B) ∘∙ lem i) - ∙ λ i → ∘∙-idˡ (∘∙-idˡ f i) i) - - main : Iso (A →∙ C) (B →∙ C) - Iso.fun main = to A B C eq - Iso.inv main = from A B C eq - Iso.rightInv main = J-lem eq .snd - Iso.leftInv main = J-lem eq .fst - -flip→∙∙ : {A : Pointed ℓ} {B : Pointed ℓ'} {C : Pointed ℓA} - → (A →∙ (B →∙ C ∙)) → B →∙ (A →∙ C ∙) -fst (fst (flip→∙∙ f) x) a = fst f a .fst x -snd (fst (flip→∙∙ f) x) i = snd f i .fst x -fst (snd (flip→∙∙ f) i) a = fst f a .snd i -snd (snd (flip→∙∙ f) i) j = snd f j .snd i - -flip→∙∙Iso : {A : Pointed ℓ} {B : Pointed ℓ'} {C : Pointed ℓA} - → Iso (A →∙ (B →∙ C ∙)) (B →∙ (A →∙ C ∙)) -Iso.fun flip→∙∙Iso = flip→∙∙ -Iso.inv flip→∙∙Iso = flip→∙∙ -Iso.rightInv flip→∙∙Iso _ = refl -Iso.leftInv flip→∙∙Iso _ = refl - -≃∙→ret/sec∙ : ∀ {ℓ} {A B : Pointed ℓ} - (f : A ≃∙ B) → ((≃∙map (invEquiv∙ f) ∘∙ ≃∙map f) ≡ idfun∙ A) - × (≃∙map f ∘∙ ≃∙map (invEquiv∙ f) ≡ idfun∙ B) -≃∙→ret/sec∙ {A = A} {B = B} = - Equiv∙J (λ A f → ((≃∙map (invEquiv∙ f) ∘∙ ≃∙map f) ≡ idfun∙ A) - × (≃∙map f ∘∙ ≃∙map (invEquiv∙ f) ≡ idfun∙ B)) - ((ΣPathP (refl , sym (lUnit _) ∙ sym (rUnit refl))) - , (ΣPathP (refl , sym (rUnit _) ∙ sym (rUnit refl)))) +open import Cubical.Foundations.Equiv.HalfAdjoint +open import Cubical.Foundations.Isomorphism +open import Cubical.Foundations.Path + +open import Cubical.Data.Sigma + +private + variable + ℓ ℓ' ℓA ℓB ℓC ℓD : Level + +-- the default pointed Π-type: A is pointed, and B has a base point in the chosen fiber +Π∙ : (A : Pointed ℓ) (B : typ A → Type ℓ') (ptB : B (pt A)) → Type (ℓ-max ℓ ℓ') +Π∙ A B ptB = Σ[ f ∈ ((a : typ A) → B a) ] f (pt A) ≡ ptB + +-- the unpointed Π-type becomes a pointed type if the fibers are all pointed +Πᵘ∙ : (A : Type ℓ) (B : A → Pointed ℓ') → Pointed (ℓ-max ℓ ℓ') +Πᵘ∙ A B .fst = ∀ a → typ (B a) +Πᵘ∙ A B .snd a = pt (B a) + +-- if the base and all fibers are pointed, we have the pointed pointed Π-type +Πᵖ∙ : (A : Pointed ℓ) (B : typ A → Pointed ℓ') → Pointed (ℓ-max ℓ ℓ') +Πᵖ∙ A B .fst = Π∙ A (typ ∘ B) (pt (B (pt A))) +Πᵖ∙ A B .snd .fst a = pt (B a) +Πᵖ∙ A B .snd .snd = refl + +-- the default pointed Σ-type is just the Σ-type, but as a pointed type +Σ∙ : (A : Pointed ℓ) (B : typ A → Type ℓ') (ptB : B (pt A)) → Pointed (ℓ-max ℓ ℓ') +Σ∙ A B ptB .fst = Σ[ a ∈ typ A ] B a +Σ∙ A B ptB .snd .fst = pt A +Σ∙ A B ptB .snd .snd = ptB + +-- version if B is a family of pointed types +Σᵖ∙ : (A : Pointed ℓ) (B : typ A → Pointed ℓ') → Pointed (ℓ-max ℓ ℓ') +Σᵖ∙ A B = Σ∙ A (typ ∘ B) (pt (B (pt A))) + +_×∙_ : (A∙ : Pointed ℓ) (B∙ : Pointed ℓ') → Pointed (ℓ-max ℓ ℓ') +(A∙ ×∙ B∙) .fst = (typ A∙) × (typ B∙) +(A∙ ×∙ B∙) .snd .fst = pt A∙ +(A∙ ×∙ B∙) .snd .snd = pt B∙ + +-- composition of pointed maps +_∘∙_ : {A : Pointed ℓA} {B : Pointed ℓB} {C : Pointed ℓC} + (g : B →∙ C) (f : A →∙ B) → (A →∙ C) +((g , g∙) ∘∙ (f , f∙)) .fst x = g (f x) +((g , g∙) ∘∙ (f , f∙)) .snd = (cong g f∙) ∙ g∙ + +-- post composition +post∘∙ : ∀ {ℓX ℓ ℓ'} (X : Pointed ℓX) {A : Pointed ℓ} {B : Pointed ℓ'} + → (A →∙ B) → ((X →∙ A ∙) →∙ (X →∙ B ∙)) +post∘∙ X f .fst g = f ∘∙ g +post∘∙ X f .snd = + ΣPathP + ( (funExt λ _ → f .snd) + , (sym (lUnit (f .snd)) ◁ λ i j → f .snd (i ∨ j))) + +-- pointed identity +id∙ : (A : Pointed ℓA) → (A →∙ A) +id∙ A .fst x = x +id∙ A .snd = refl + +-- constant pointed map +const∙ : (A : Pointed ℓA) (B : Pointed ℓB) → (A →∙ B) +const∙ _ B .fst _ = B .snd +const∙ _ B .snd = refl + +-- left identity law for pointed maps +∘∙-idˡ : {A : Pointed ℓA} {B : Pointed ℓB} (f : A →∙ B) → f ∘∙ id∙ A ≡ f +∘∙-idˡ f = ΣPathP ( refl , (lUnit (f .snd)) ⁻¹ ) + +-- right identity law for pointed maps +∘∙-idʳ : {A : Pointed ℓA} {B : Pointed ℓB} (f : A →∙ B) → id∙ B ∘∙ f ≡ f +∘∙-idʳ f = ΣPathP ( refl , (rUnit (f .snd)) ⁻¹ ) + +-- associativity for composition of pointed maps +∘∙-assoc : {A : Pointed ℓA} {B : Pointed ℓB} {C : Pointed ℓC} {D : Pointed ℓD} + (h : C →∙ D) (g : B →∙ C) (f : A →∙ B) + → (h ∘∙ g) ∘∙ f ≡ h ∘∙ (g ∘∙ f) +∘∙-assoc (h , h∙) (g , g∙) (f , f∙) = ΣPathP (refl , q) + where + q : (cong (h ∘ g) f∙) ∙ (cong h g∙ ∙ h∙) ≡ cong h (cong g f∙ ∙ g∙) ∙ h∙ + q = ( (cong (h ∘ g) f∙) ∙ (cong h g∙ ∙ h∙) + ≡⟨ refl ⟩ + (cong h (cong g f∙)) ∙ (cong h g∙ ∙ h∙) + ≡⟨ assoc (cong h (cong g f∙)) (cong h g∙) h∙ ⟩ + (cong h (cong g f∙) ∙ cong h g∙) ∙ h∙ + ≡⟨ cong (λ p → p ∙ h∙) ((cong-∙ h (cong g f∙) g∙) ⁻¹) ⟩ + (cong h (cong g f∙ ∙ g∙) ∙ h∙) ∎ ) + +module _ {ℓ ℓ' : Level} {A : Pointed ℓ} {B : Pointed ℓ'} (f : A →∙ B) where + isInIm∙ : (x : typ B) → Type (ℓ-max ℓ ℓ') + isInIm∙ x = Σ[ z ∈ typ A ] fst f z ≡ x + + isInKer∙ : (x : fst A) → Type ℓ' + isInKer∙ x = fst f x ≡ snd B + +private module _ {ℓA ℓB ℓC : Level} (A : Pointed ℓA) (B : Pointed ℓB) (C : Pointed ℓC) (e : A ≃∙ B) where + toEq : (A →∙ C) → (B →∙ C) + toEq = _∘∙ ≃∙map (invEquiv∙ e) + + fromEq : B →∙ C → (A →∙ C) + fromEq = _∘∙ ≃∙map e + + toEq' : (C →∙ A) → C →∙ B + toEq' = ≃∙map e ∘∙_ + + fromEq' : C →∙ B → (C →∙ A) + fromEq' = ≃∙map (invEquiv∙ e) ∘∙_ + +pre∘∙equiv : ∀ {ℓA ℓB ℓC} {A : Pointed ℓA} {B : Pointed ℓB} {C : Pointed ℓC} + → (B ≃∙ C) → Iso (A →∙ B) (A →∙ C) +Iso.fun (pre∘∙equiv {A = A} {B = B} {C = C} e) = toEq' B C A e +Iso.inv (pre∘∙equiv {A = A} {B = B} {C = C} e) = fromEq' B C A e +Iso.rightInv (pre∘∙equiv {A = A} {B = B} {C = C} e) = + J (λ ptC p → section (toEq' B (fst C , ptC) A (fst e , p)) + (fromEq' B (fst C , ptC) A (fst e , p))) + (uncurry (λ f p → ΣPathP (funExt (λ x → isHAEquiv.rinv (HAe .snd) (f x)) + , ((sym (rUnit _) + ∙ cong (cong (fst (fst e))) + λ i → cong (invEq (fst e)) p + ∙ (lUnit (retEq (fst e) (pt B)) (~ i))) + ∙ cong-∙ (fst (fst e)) + (cong (invEq (fst e)) p) + (retEq (fst e) (pt B)) + ∙ refl + ◁ flipSquare (((λ _ → isHAEquiv.rinv (HAe .snd) (f (pt A))) + ∙ refl) + ◁ lem _ _ _ _ (cong (isHAEquiv.rinv (HAe .snd)) p + ▷ sym (isHAEquiv.com (HAe .snd) (pt B)))))))) + (snd e) + where + HAe = equiv→HAEquiv (fst e) + lem : ∀ {ℓ} {A : Type ℓ} {x y z w : A} + (p : x ≡ y) (q : y ≡ z) (r : x ≡ w) (l : w ≡ z) + → PathP (λ i → p i ≡ l i) r q + → PathP (λ i → (p ∙ q) i ≡ l i) r refl + lem p q r l P i j = + hcomp (λ k → λ{ (i = i0) → r j + ; (i = i1) → q (j ∨ k) + ; (j = i1) → l i}) + (P i j) +Iso.leftInv (pre∘∙equiv {A = A} {B = B} {C = C} e) = + J (λ pt p → retract (toEq' B (fst C , pt) A (fst e , p)) + (fromEq' B (fst C , pt) A (fst e , p))) + (uncurry (λ f → + J (λ ptB p + → fromEq' (fst B , ptB) + (fst C , fst (fst e) ptB) A (fst e , refl) + (toEq' (fst B , ptB) + (fst C , fst (fst e) ptB) A (fst e , refl) (f , p)) + ≡ (f , p)) + (ΣPathP + (funExt (λ x → retEq (fst e) (f x)) + , ((cong₂ _∙_ ((λ i → cong (invEq (fst e)) (lUnit refl (~ i)))) + (sym (lUnit _) ∙ λ _ → retEq (fst e) (f (pt A))) + ∙ sym (lUnit _)) + ◁ λ i j → retEq (fst e) (f (pt A)) (i ∨ j)))))) + (snd e) + +post∘∙equiv : ∀ {ℓA ℓB ℓC} {A : Pointed ℓA} {B : Pointed ℓB} {C : Pointed ℓC} + → (A ≃∙ B) → Iso (A →∙ C) (B →∙ C) +Iso.fun (post∘∙equiv {A = A} {B = B} {C = C} e) = toEq A B C e +Iso.inv (post∘∙equiv {A = A} {B = B} {C = C} e) = fromEq A B C e +Iso.rightInv (post∘∙equiv {A = A}{B = B , ptB} {C = C} e) = + J (λ pt p → section (toEq A (B , pt) C (fst e , p)) + (fromEq A (B , pt) C (fst e , p))) + (uncurry (λ f → + J (λ ptC p → toEq A (B , fst (fst e) (pt A)) (fst C , ptC) (fst e , refl) + (fromEq A (B , fst (fst e) (pt A)) (fst C , ptC) (fst e , refl) + (f , p)) + ≡ (f , p)) + (ΣPathP (funExt (λ x → cong f (isHAEquiv.rinv (snd HAe) x)) + , (cong₂ _∙_ + (λ i → cong f (cong (fst (fst e)) (lUnit (retEq (fst e) (pt A)) (~ i)))) + (sym (rUnit refl)) + ∙ sym (rUnit _) + ∙ cong (cong f) (isHAEquiv.com (snd HAe) (pt A))) + ◁ λ i j → f (isHAEquiv.rinv (snd HAe) (fst HAe (pt A)) (i ∨ j)))))) + (snd e) + where + HAe = equiv→HAEquiv (fst e) +Iso.leftInv (post∘∙equiv {A = A} {B = B , ptB} {C = C} e) = + J (λ pt p → retract (toEq A (B , pt) C (fst e , p)) + (fromEq A (B , pt) C (fst e , p))) + (uncurry (λ f → J (λ ptC y → + fromEq A (B , fst (fst e) (pt A)) (fst C , ptC) (fst e , refl) + (toEq A (B , fst (fst e) (pt A)) (fst C , ptC) (fst e , refl) + (f , y)) + ≡ (f , y)) + (ΣPathP (funExt (λ x → cong f (retEq (fst e) x)) + , (sym (lUnit _) + ∙ sym (rUnit _) + ∙ cong (cong f) (sym (lUnit _)) + ∙ (λ _ → cong f (retEq (fst e) (pt A))) + ◁ λ i j → f (retEq (fst e) (pt A) (i ∨ j))))))) + (snd e) + +flip→∙∙ : {A : Pointed ℓ} {B : Pointed ℓ'} {C : Pointed ℓA} + → (A →∙ (B →∙ C ∙)) → B →∙ (A →∙ C ∙) +fst (fst (flip→∙∙ f) x) a = fst f a .fst x +snd (fst (flip→∙∙ f) x) i = snd f i .fst x +fst (snd (flip→∙∙ f) i) a = fst f a .snd i +snd (snd (flip→∙∙ f) i) j = snd f j .snd i + +flip→∙∙Iso : {A : Pointed ℓ} {B : Pointed ℓ'} {C : Pointed ℓA} + → Iso (A →∙ (B →∙ C ∙)) (B →∙ (A →∙ C ∙)) +Iso.fun flip→∙∙Iso = flip→∙∙ +Iso.inv flip→∙∙Iso = flip→∙∙ +Iso.rightInv flip→∙∙Iso _ = refl +Iso.leftInv flip→∙∙Iso _ = refl + +≃∙→ret/sec∙ : ∀ {ℓ} {A B : Pointed ℓ} + (f : A ≃∙ B) → ((≃∙map (invEquiv∙ f) ∘∙ ≃∙map f) ≡ idfun∙ A) + × (≃∙map f ∘∙ ≃∙map (invEquiv∙ f) ≡ idfun∙ B) +≃∙→ret/sec∙ {A = A} {B = B} = + Equiv∙J (λ A f → ((≃∙map (invEquiv∙ f) ∘∙ ≃∙map f) ≡ idfun∙ A) + × (≃∙map f ∘∙ ≃∙map (invEquiv∙ f) ≡ idfun∙ B)) + ((ΣPathP (refl , sym (lUnit _) ∙ sym (rUnit refl))) + , (ΣPathP (refl , sym (rUnit _) ∙ sym (rUnit refl)))) + +pointedSecIso : ∀ {ℓ''} {A : Pointed ℓ} {B : Pointed ℓ'} (Q : fst A → Pointed ℓ'') + → Iso ((a : fst A) → Q a →∙ B) + (Σ[ F ∈ (Σ (fst A) (fst ∘ Q) → fst B) ] + ((a : fst A) → F (a , pt (Q a)) ≡ pt B)) +Iso.fun (pointedSecIso Q) F = (λ x → F (fst x) .fst (snd x)) , (λ x → F x .snd) +Iso.inv (pointedSecIso Q) F a = (fst F ∘ (a ,_)) , snd F a +Iso.rightInv (pointedSecIso Q) F = refl +Iso.leftInv (pointedSecIso Q) F = refl + +compPathrEquiv∙ : {A : Type ℓ} {a b c : A} {q : a ≡ b} (p : b ≡ c) + → ((a ≡ b) , q) ≃∙ ((a ≡ c) , q ∙ p) +fst (compPathrEquiv∙ p) = compPathrEquiv p +snd (compPathrEquiv∙ p) = refl + +compPathlEquiv∙ : {A : Type ℓ} {a b c : A} {q : b ≡ c} (p : a ≡ b) + → ((b ≡ c) , q) ≃∙ ((a ≡ c) , p ∙ q) +fst (compPathlEquiv∙ p) = compPathlEquiv p +snd (compPathlEquiv∙ p) = refl \ No newline at end of file diff --git a/docs/Cubical.Foundations.Powerset.html b/docs/Cubical.Foundations.Powerset.html index 99ce1b3..26adf84 100644 --- a/docs/Cubical.Foundations.Powerset.html +++ b/docs/Cubical.Foundations.Powerset.html @@ -28,36 +28,36 @@ ℙ : Type ℓ → Type (ℓ-suc ℓ) ℙ X = X → hProp _ -isSetℙ : isSet (ℙ X) +isSetℙ : isSet (ℙ X) isSetℙ = isSetΠ λ x → isSetHProp infix 5 _∈_ _∈_ : {X : Type ℓ} → X → ℙ X → Type ℓ -x ∈ A = ⟨ A x ⟩ +x ∈ A = ⟨ A x ⟩ _⊆_ : {X : Type ℓ} → ℙ X → ℙ X → Type ℓ A ⊆ B = ∀ x → x ∈ A → x ∈ B -∈-isProp : (A : ℙ X) (x : X) → isProp (x ∈ A) +∈-isProp : (A : ℙ X) (x : X) → isProp (x ∈ A) ∈-isProp A = snd ∘ A -⊆-isProp : (A B : ℙ X) → isProp (A ⊆ B) +⊆-isProp : (A B : ℙ X) → isProp (A ⊆ B) ⊆-isProp A B = isPropΠ2 (λ x _ → ∈-isProp B x) ⊆-refl : (A : ℙ X) → A ⊆ A ⊆-refl A x = idfun (x ∈ A) subst-∈ : (A : ℙ X) {x y : X} → x ≡ y → x ∈ A → y ∈ A -subst-∈ A = subst (_∈ A) +subst-∈ A = subst (_∈ A) ⊆-refl-consequence : (A B : ℙ X) → A ≡ B → (A ⊆ B) × (B ⊆ A) -⊆-refl-consequence A B p = subst (A ⊆_) p (⊆-refl A) - , subst (B ⊆_) (sym p) (⊆-refl B) +⊆-refl-consequence A B p = subst (A ⊆_) p (⊆-refl A) + , subst (B ⊆_) (sym p) (⊆-refl B) ⊆-extensionality : (A B : ℙ X) → (A ⊆ B) × (B ⊆ A) → A ≡ B ⊆-extensionality A B (φ , ψ) = - funExt (λ x → TypeOfHLevel≡ 1 (hPropExt (A x .snd) (B x .snd) (φ x) (ψ x))) + funExt (λ x → TypeOfHLevel≡ 1 (hPropExt (A x .snd) (B x .snd) (φ x) (ψ x))) ⊆-extensionalityEquiv : (A B : ℙ X) → (A ⊆ B) × (B ⊆ A) ≃ (A ≡ B) ⊆-extensionalityEquiv A B = isoToEquiv (iso (⊆-extensionality A B) diff --git a/docs/Cubical.Foundations.Prelude.html b/docs/Cubical.Foundations.Prelude.html index adceb21..5b30c0f 100644 --- a/docs/Cubical.Foundations.Prelude.html +++ b/docs/Cubical.Foundations.Prelude.html @@ -26,12 +26,12 @@ open import Cubical.Core.Primitives public -infixr 30 _∙_ -infixr 30 _∙₂_ -infix 3 _∎ -infixr 2 step-≡ _≡⟨⟩_ -infixr 2.5 _≡⟨_⟩≡⟨_⟩_ -infixl 4 _≡$_ _≡$S_ +infixr 30 _∙_ +infixr 30 _∙₂_ +infix 3 _∎ +infixr 2 step-≡ _≡⟨⟩_ +infixr 2.5 _≡⟨_⟩≡⟨_⟩_ +infixl 4 _≡$_ _≡$S_ -- Basic theory about paths. These proofs should typically be -- inlined. This module also makes equational reasoning work with @@ -111,34 +111,34 @@ `doubleCompPath-filler p q r` gives the whole square -} -doubleComp-faces : {x y z w : A } (p : x ≡ y) (r : z ≡ w) - → (i : I) (j : I) → Partial (i ∨ ~ i) A -doubleComp-faces p r i j (i = i0) = p (~ j) -doubleComp-faces p r i j (i = i1) = r j - -_∙∙_∙∙_ : w ≡ x → x ≡ y → y ≡ z → w ≡ z -(p ∙∙ q ∙∙ r) i = - hcomp (doubleComp-faces p r i) (q i) - -doubleCompPath-filler : (p : x ≡ y) (q : y ≡ z) (r : z ≡ w) - → PathP (λ j → p (~ j) ≡ r j) q (p ∙∙ q ∙∙ r) -doubleCompPath-filler p q r j i = - hfill (doubleComp-faces p r i) (inS (q i)) j - --- any two definitions of double composition are equal -compPath-unique : (p : x ≡ y) (q : y ≡ z) (r : z ≡ w) - → (α β : Σ[ s ∈ x ≡ w ] PathP (λ j → p (~ j) ≡ r j) q s) - → α ≡ β -compPath-unique p q r (α , α-filler) (β , β-filler) t - = (λ i → cb i1 i) , (λ j i → cb j i) - where cb : I → I → _ - cb j i = hfill (λ j → λ { (t = i0) → α-filler j i - ; (t = i1) → β-filler j i - ; (i = i0) → p (~ j) - ; (i = i1) → r j }) - (inS (q i)) j - -{- For single homogenous path composition, we take `p = refl`: +doubleComp-faces : {x y z w : A} (p : x ≡ y) (r : z ≡ w) + → (i : I) (j : I) → Partial (i ∨ ~ i) A +doubleComp-faces p r i j (i = i0) = p (~ j) +doubleComp-faces p r i j (i = i1) = r j + +_∙∙_∙∙_ : x ≡ y → y ≡ z → z ≡ w → x ≡ w +(p ∙∙ q ∙∙ r) i = + hcomp (doubleComp-faces p r i) (q i) + +doubleCompPath-filler : (p : x ≡ y) (q : y ≡ z) (r : z ≡ w) + → PathP (λ j → p (~ j) ≡ r j) q (p ∙∙ q ∙∙ r) +doubleCompPath-filler p q r j i = + hfill (doubleComp-faces p r i) (inS (q i)) j + +-- any two definitions of double composition are equal +compPath-unique : (p : x ≡ y) (q : y ≡ z) (r : z ≡ w) + → (α β : Σ[ s ∈ x ≡ w ] PathP (λ j → p (~ j) ≡ r j) q s) + → α ≡ β +compPath-unique p q r (α , α-filler) (β , β-filler) t + = (λ i → cb i1 i) , (λ j i → cb j i) + where cb : I → I → _ + cb j i = hfill (λ j → λ { (t = i0) → α-filler j i + ; (t = i1) → β-filler j i + ; (i = i0) → p (~ j) + ; (i = i1) → r j }) + (inS (q i)) j + +{- For single homogenous path composition, we take `p = refl`: x ∙ ∙ ∙ > z ‖ ^ @@ -151,450 +151,450 @@ `compPath-filler q r` gives the whole square -} -_∙_ : x ≡ y → y ≡ z → x ≡ z -p ∙ q = refl ∙∙ p ∙∙ q - -compPath-filler : (p : x ≡ y) (q : y ≡ z) → PathP (λ j → x ≡ q j) p (p ∙ q) -compPath-filler p q = doubleCompPath-filler refl p q - --- We could have also defined single composition by taking `r = refl`: - -_∙'_ : x ≡ y → y ≡ z → x ≡ z -p ∙' q = p ∙∙ q ∙∙ refl - -compPath'-filler : (p : x ≡ y) (q : y ≡ z) → PathP (λ j → p (~ j) ≡ z) q (p ∙' q) -compPath'-filler p q = doubleCompPath-filler p q refl - --- It's easy to show that `p ∙ q` also has such a filler: -compPath-filler' : (p : x ≡ y) (q : y ≡ z) → PathP (λ j → p (~ j) ≡ z) q (p ∙ q) -compPath-filler' {z = z} p q j i = - hcomp (λ k → λ { (i = i0) → p (~ j) - ; (i = i1) → q k - ; (j = i0) → q (i ∧ k) }) - (p (i ∨ ~ j)) --- Note: We can omit a (j = i1) case here since when (j = i1), the whole expression is --- definitionally equal to `p ∙ q`. (Notice that `p ∙ q` is also an hcomp.) Nevertheless, --- we could have given `compPath-filler p q k i` as the (j = i1) case. - --- From this, we can show that these two notions of composition are the same -compPath≡compPath' : (p : x ≡ y) (q : y ≡ z) → p ∙ q ≡ p ∙' q -compPath≡compPath' p q j = - compPath-unique p q refl (p ∙ q , compPath-filler' p q) - (p ∙' q , compPath'-filler p q) j .fst - --- Double composition agrees with iterated single composition -doubleCompPath≡compPath : {x y z w : A} - (p : x ≡ y) (q : y ≡ z) (r : z ≡ w) - → p ∙∙ q ∙∙ r ≡ p ∙ q ∙ r -doubleCompPath≡compPath p q r i j = - hcomp (λ k → λ { (i = i1) → compPath-filler' p (q ∙ r) k j - ; (j = i0) → p (~ k) - ; (j = i1) → r (i ∨ k)}) - (compPath-filler q r i j) - --- Heterogeneous path composition and its filler: - --- Composition in a family indexed by the interval -compPathP : {A : I → Type ℓ} {x : A i0} {y : A i1} {B_i1 : Type ℓ} {B : (A i1) ≡ B_i1} {z : B i1} - → PathP A x y → PathP (λ i → B i) y z → PathP (λ j → ((λ i → A i) ∙ B) j) x z -compPathP {A = A} {x = x} {B = B} p q i = - comp (λ j → compPath-filler (λ i → A i) B j i) - (λ j → λ { (i = i0) → x ; - (i = i1) → q j }) - (p i) - --- Composition in a family indexed by a type -compPathP' : {B : A → Type ℓ'} {x' : B x} {y' : B y} {z' : B z} {p : x ≡ y} {q : y ≡ z} - (P : PathP (λ i → B (p i)) x' y') (Q : PathP (λ i → B (q i)) y' z') - → PathP (λ i → B ((p ∙ q) i)) x' z' -compPathP' {B = B} {x' = x'} {p = p} {q = q} P Q i = - comp (λ j → B (compPath-filler p q j i)) - (λ j → λ { (i = i0) → x' ; - (i = i1) → Q j }) - (P i) - -compPathP-filler : {A : I → Type ℓ} {x : A i0} {y : A i1} {B_i1 : Type ℓ} {B : A i1 ≡ B_i1} {z : B i1} - (p : PathP A x y) (q : PathP (λ i → B i) y z) - → PathP (λ j → PathP (λ k → (compPath-filler (λ i → A i) B j k)) x (q j)) p (compPathP p q) -compPathP-filler {A = A} {x = x} {B = B} p q j i = - fill (λ j → compPath-filler (λ i → A i) B j i) - (λ j → λ { (i = i0) → x ; - (i = i1) → q j }) - (inS (p i)) j - -compPathP'-filler : {B : A → Type ℓ'} {x' : B x} {y' : B y} {z' : B z} {p : x ≡ y} {q : y ≡ z} - (P : PathP (λ i → B (p i)) x' y') (Q : PathP (λ i → B (q i)) y' z') - → PathP (λ j → PathP (λ i → B (compPath-filler p q j i)) x' (Q j)) P (compPathP' {B = B} P Q) -compPathP'-filler {B = B} {x' = x'} {p = p} {q = q} P Q j i = - fill (λ j → B (compPath-filler p q j i)) - (λ j → λ { (i = i0) → x' ; - (i = i1) → Q j }) - (inS (P i)) - j - --- Syntax for chains of equational reasoning - -step-≡ : (x : A) → y ≡ z → x ≡ y → x ≡ z -step-≡ _ p q = q ∙ p - -syntax step-≡ x y p = x ≡⟨ p ⟩ y - -≡⟨⟩-syntax : (x : A) → y ≡ z → x ≡ y → x ≡ z -≡⟨⟩-syntax = step-≡ - -infixr 2 ≡⟨⟩-syntax -syntax ≡⟨⟩-syntax x y (λ i → B) = x ≡[ i ]⟨ B ⟩ y - -_≡⟨⟩_ : (x : A) → x ≡ y → x ≡ y -_ ≡⟨⟩ x≡y = x≡y - -≡⟨⟩⟨⟩-syntax : (x y : A) → x ≡ y → y ≡ z → z ≡ w → x ≡ w -≡⟨⟩⟨⟩-syntax x y p q r = p ∙∙ q ∙∙ r -infixr 3 ≡⟨⟩⟨⟩-syntax -syntax ≡⟨⟩⟨⟩-syntax x y B C = x ≡⟨ B ⟩≡ y ≡⟨ C ⟩≡ - -_≡⟨_⟩≡⟨_⟩_ : (x : A) → x ≡ y → y ≡ z → z ≡ w → x ≡ w -_ ≡⟨ x≡y ⟩≡⟨ y≡z ⟩ z≡w = x≡y ∙∙ y≡z ∙∙ z≡w - -_∎ : (x : A) → x ≡ x -_ ∎ = refl - --- Transport and subst - --- transport is a special case of transp -transport : {A B : Type ℓ} → A ≡ B → A → B -transport p a = transp (λ i → p i) i0 a - --- Transporting in a constant family is the identity function (up to a --- path). If we would have regularity this would be definitional. -transportRefl : (x : A) → transport refl x ≡ x -transportRefl {A = A} x i = transp (λ _ → A) i x - -transport-filler : ∀ {ℓ} {A B : Type ℓ} (p : A ≡ B) (x : A) - → PathP (λ i → p i) x (transport p x) -transport-filler p x i = transp (λ j → p (i ∧ j)) (~ i) x - --- We want B to be explicit in subst -subst : (B : A → Type ℓ') (p : x ≡ y) → B x → B y -subst B p pa = transport (λ i → B (p i)) pa - -subst2 : ∀ {ℓ' ℓ''} {B : Type ℓ'} {z w : B} (C : A → B → Type ℓ'') - (p : x ≡ y) (q : z ≡ w) → C x z → C y w -subst2 B p q b = transport (λ i → B (p i) (q i)) b - -substRefl : ∀ {B : A → Type ℓ} {x} → (px : B x) → subst B refl px ≡ px -substRefl px = transportRefl px - -subst-filler : (B : A → Type ℓ') (p : x ≡ y) (b : B x) - → PathP (λ i → B (p i)) b (subst B p b) -subst-filler B p = transport-filler (cong B p) - -subst2-filler : {B : Type ℓ'} {z w : B} (C : A → B → Type ℓ'') - (p : x ≡ y) (q : z ≡ w) (c : C x z) - → PathP (λ i → C (p i) (q i)) c (subst2 C p q c) -subst2-filler C p q = transport-filler (cong₂ C p q) - --- Function extensionality - -funExt : {B : A → I → Type ℓ'} - {f : (x : A) → B x i0} {g : (x : A) → B x i1} - → ((x : A) → PathP (B x) (f x) (g x)) - → PathP (λ i → (x : A) → B x i) f g -funExt p i x = p x i - -implicitFunExt : {B : A → I → Type ℓ'} - {f : {x : A} → B x i0} {g : {x : A} → B x i1} - → ({x : A} → PathP (B x) (f {x}) (g {x})) - → PathP (λ i → {x : A} → B x i) f g -implicitFunExt p i {x} = p {x} i - --- the inverse to funExt (see Functions.FunExtEquiv), converting paths --- between functions to homotopies; `funExt⁻` is called `happly` and --- defined by path induction in the HoTT book (see function 2.9.2 in --- section 2.9) -funExt⁻ : {B : A → I → Type ℓ'} - {f : (x : A) → B x i0} {g : (x : A) → B x i1} - → PathP (λ i → (x : A) → B x i) f g - → ((x : A) → PathP (B x) (f x) (g x)) -funExt⁻ eq x i = eq i x - -implicitFunExt⁻ : {B : A → I → Type ℓ'} - {f : {x : A} → B x i0} {g : {x : A} → B x i1} - → PathP (λ i → {x : A} → B x i) f g - → ({x : A} → PathP (B x) (f {x}) (g {x})) -implicitFunExt⁻ eq {x} i = eq i {x} - -_≡$_ = funExt⁻ +_∙_ : x ≡ y → y ≡ z → x ≡ z +p ∙ q = refl ∙∙ p ∙∙ q + +compPath-filler : (p : x ≡ y) (q : y ≡ z) → PathP (λ j → x ≡ q j) p (p ∙ q) +compPath-filler p q = doubleCompPath-filler refl p q + +-- We could have also defined single composition by taking `r = refl`: + +_∙'_ : x ≡ y → y ≡ z → x ≡ z +p ∙' q = p ∙∙ q ∙∙ refl + +compPath'-filler : (p : x ≡ y) (q : y ≡ z) → PathP (λ j → p (~ j) ≡ z) q (p ∙' q) +compPath'-filler p q = doubleCompPath-filler p q refl + +-- It's easy to show that `p ∙ q` also has such a filler: +compPath-filler' : (p : x ≡ y) (q : y ≡ z) → PathP (λ j → p (~ j) ≡ z) q (p ∙ q) +compPath-filler' {z = z} p q j i = + hcomp (λ k → λ { (i = i0) → p (~ j) + ; (i = i1) → q k + ; (j = i0) → q (i ∧ k) }) + (p (i ∨ ~ j)) +-- Note: We can omit a (j = i1) case here since when (j = i1), the whole expression is +-- definitionally equal to `p ∙ q`. (Notice that `p ∙ q` is also an hcomp.) Nevertheless, +-- we could have given `compPath-filler p q k i` as the (j = i1) case. + +-- From this, we can show that these two notions of composition are the same +compPath≡compPath' : (p : x ≡ y) (q : y ≡ z) → p ∙ q ≡ p ∙' q +compPath≡compPath' p q j = + compPath-unique p q refl (p ∙ q , compPath-filler' p q) + (p ∙' q , compPath'-filler p q) j .fst + +-- Double composition agrees with iterated single composition +doubleCompPath≡compPath : {x y z w : A} + (p : x ≡ y) (q : y ≡ z) (r : z ≡ w) + → p ∙∙ q ∙∙ r ≡ p ∙ q ∙ r +doubleCompPath≡compPath p q r i j = + hcomp (λ k → λ { (i = i1) → compPath-filler' p (q ∙ r) k j + ; (j = i0) → p (~ k) + ; (j = i1) → r (i ∨ k)}) + (compPath-filler q r i j) + +-- Heterogeneous path composition and its filler: + +-- Composition in a family indexed by the interval +compPathP : {A : I → Type ℓ} {x : A i0} {y : A i1} {B_i1 : Type ℓ} {B : (A i1) ≡ B_i1} {z : B i1} + → PathP A x y → PathP (λ i → B i) y z → PathP (λ j → ((λ i → A i) ∙ B) j) x z +compPathP {A = A} {x = x} {B = B} p q i = + comp (λ j → compPath-filler (λ i → A i) B j i) + (λ j → λ { (i = i0) → x ; + (i = i1) → q j }) + (p i) + +-- Composition in a family indexed by a type +compPathP' : {B : A → Type ℓ'} {x' : B x} {y' : B y} {z' : B z} {p : x ≡ y} {q : y ≡ z} + (P : PathP (λ i → B (p i)) x' y') (Q : PathP (λ i → B (q i)) y' z') + → PathP (λ i → B ((p ∙ q) i)) x' z' +compPathP' {B = B} {x' = x'} {p = p} {q = q} P Q i = + comp (λ j → B (compPath-filler p q j i)) + (λ j → λ { (i = i0) → x' ; + (i = i1) → Q j }) + (P i) + +compPathP-filler : {A : I → Type ℓ} {x : A i0} {y : A i1} {B_i1 : Type ℓ} {B : A i1 ≡ B_i1} {z : B i1} + (p : PathP A x y) (q : PathP (λ i → B i) y z) + → PathP (λ j → PathP (λ k → (compPath-filler (λ i → A i) B j k)) x (q j)) p (compPathP p q) +compPathP-filler {A = A} {x = x} {B = B} p q j i = + fill (λ j → compPath-filler (λ i → A i) B j i) + (λ j → λ { (i = i0) → x ; + (i = i1) → q j }) + (inS (p i)) j + +compPathP'-filler : {B : A → Type ℓ'} {x' : B x} {y' : B y} {z' : B z} {p : x ≡ y} {q : y ≡ z} + (P : PathP (λ i → B (p i)) x' y') (Q : PathP (λ i → B (q i)) y' z') + → PathP (λ j → PathP (λ i → B (compPath-filler p q j i)) x' (Q j)) P (compPathP' {B = B} P Q) +compPathP'-filler {B = B} {x' = x'} {p = p} {q = q} P Q j i = + fill (λ j → B (compPath-filler p q j i)) + (λ j → λ { (i = i0) → x' ; + (i = i1) → Q j }) + (inS (P i)) + j + +-- Syntax for chains of equational reasoning + +step-≡ : (x : A) → y ≡ z → x ≡ y → x ≡ z +step-≡ _ p q = q ∙ p + +syntax step-≡ x y p = x ≡⟨ p ⟩ y + +≡⟨⟩-syntax : (x : A) → y ≡ z → x ≡ y → x ≡ z +≡⟨⟩-syntax = step-≡ + +infixr 2 ≡⟨⟩-syntax +syntax ≡⟨⟩-syntax x y (λ i → B) = x ≡[ i ]⟨ B ⟩ y + +_≡⟨⟩_ : (x : A) → x ≡ y → x ≡ y +_ ≡⟨⟩ x≡y = x≡y + +≡⟨⟩⟨⟩-syntax : (x y : A) → x ≡ y → y ≡ z → z ≡ w → x ≡ w +≡⟨⟩⟨⟩-syntax x y p q r = p ∙∙ q ∙∙ r +infixr 3 ≡⟨⟩⟨⟩-syntax +syntax ≡⟨⟩⟨⟩-syntax x y B C = x ≡⟨ B ⟩≡ y ≡⟨ C ⟩≡ + +_≡⟨_⟩≡⟨_⟩_ : (x : A) → x ≡ y → y ≡ z → z ≡ w → x ≡ w +_ ≡⟨ x≡y ⟩≡⟨ y≡z ⟩ z≡w = x≡y ∙∙ y≡z ∙∙ z≡w + +_∎ : (x : A) → x ≡ x +_ ∎ = refl + +-- Transport and subst + +-- transport is a special case of transp +transport : {A B : Type ℓ} → A ≡ B → A → B +transport p a = transp (λ i → p i) i0 a + +-- Transporting in a constant family is the identity function (up to a +-- path). If we would have regularity this would be definitional. +transportRefl : (x : A) → transport refl x ≡ x +transportRefl {A = A} x i = transp (λ _ → A) i x + +transport-filler : ∀ {ℓ} {A B : Type ℓ} (p : A ≡ B) (x : A) + → PathP (λ i → p i) x (transport p x) +transport-filler p x i = transp (λ j → p (i ∧ j)) (~ i) x + +-- We want B to be explicit in subst +subst : (B : A → Type ℓ') (p : x ≡ y) → B x → B y +subst B p pa = transport (λ i → B (p i)) pa + +subst2 : ∀ {ℓ' ℓ''} {B : Type ℓ'} {z w : B} (C : A → B → Type ℓ'') + (p : x ≡ y) (q : z ≡ w) → C x z → C y w +subst2 B p q b = transport (λ i → B (p i) (q i)) b + +substRefl : ∀ {B : A → Type ℓ} {x} → (px : B x) → subst B refl px ≡ px +substRefl px = transportRefl px + +subst-filler : (B : A → Type ℓ') (p : x ≡ y) (b : B x) + → PathP (λ i → B (p i)) b (subst B p b) +subst-filler B p = transport-filler (cong B p) + +subst2-filler : {B : Type ℓ'} {z w : B} (C : A → B → Type ℓ'') + (p : x ≡ y) (q : z ≡ w) (c : C x z) + → PathP (λ i → C (p i) (q i)) c (subst2 C p q c) +subst2-filler C p q = transport-filler (cong₂ C p q) + +-- Function extensionality + +funExt : {B : A → I → Type ℓ'} + {f : (x : A) → B x i0} {g : (x : A) → B x i1} + → ((x : A) → PathP (B x) (f x) (g x)) + → PathP (λ i → (x : A) → B x i) f g +funExt p i x = p x i + +implicitFunExt : {B : A → I → Type ℓ'} + {f : {x : A} → B x i0} {g : {x : A} → B x i1} + → ({x : A} → PathP (B x) (f {x}) (g {x})) + → PathP (λ i → {x : A} → B x i) f g +implicitFunExt p i {x} = p {x} i + +-- the inverse to funExt (see Functions.FunExtEquiv), converting paths +-- between functions to homotopies; `funExt⁻` is called `happly` and +-- defined by path induction in the HoTT book (see function 2.9.2 in +-- section 2.9) +funExt⁻ : {B : A → I → Type ℓ'} + {f : (x : A) → B x i0} {g : (x : A) → B x i1} + → PathP (λ i → (x : A) → B x i) f g + → ((x : A) → PathP (B x) (f x) (g x)) +funExt⁻ eq x i = eq i x + +implicitFunExt⁻ : {B : A → I → Type ℓ'} + {f : {x : A} → B x i0} {g : {x : A} → B x i1} + → PathP (λ i → {x : A} → B x i) f g + → ({x : A} → PathP (B x) (f {x}) (g {x})) +implicitFunExt⁻ eq {x} i = eq i {x} + +_≡$_ = funExt⁻ -{- `S` stands for simply typed. Using `funExtS⁻` instead of `funExt⁻` +{- `S` stands for simply typed. Using `funExtS⁻` instead of `funExt⁻` can help Agda to solve metavariables that may otherwise remain unsolved. -} -funExtS⁻ : {B : I → Type ℓ'} - {f : (x : A) → B i0} {g : (x : A) → B i1} - → PathP (λ i → (x : A) → B i) f g - → ((x : A) → PathP (λ i → B i) (f x) (g x)) -funExtS⁻ eq x i = eq i x +funExtS⁻ : {B : I → Type ℓ'} + {f : (x : A) → B i0} {g : (x : A) → B i1} + → PathP (λ i → (x : A) → B i) f g + → ((x : A) → PathP (λ i → B i) (f x) (g x)) +funExtS⁻ eq x i = eq i x -_≡$S_ = funExtS⁻ +_≡$S_ = funExtS⁻ --- J for paths and its computation rule +-- J for paths and its computation rule -module _ (P : ∀ y → x ≡ y → Type ℓ') (d : P x refl) where +module _ (P : ∀ y → x ≡ y → Type ℓ') (d : P x refl) where - J : (p : x ≡ y) → P y p - J p = transport (λ i → P (p i) (λ j → p (i ∧ j))) d + J : (p : x ≡ y) → P y p + J p = transport (λ i → P (p i) (λ j → p (i ∧ j))) d - JRefl : J refl ≡ d - JRefl = transportRefl d + JRefl : J refl ≡ d + JRefl = transportRefl d - J-∙ : (p : x ≡ y) (q : y ≡ z) - → J (p ∙ q) ≡ transport (λ i → P (q i) (λ j → compPath-filler p q i j)) (J p) - J-∙ p q k = - transp - (λ i → P (q (i ∨ ~ k)) - (λ j → compPath-filler p q (i ∨ ~ k) j)) (~ k) - (J (λ j → compPath-filler p q (~ k) j)) + J-∙ : (p : x ≡ y) (q : y ≡ z) + → J (p ∙ q) ≡ transport (λ i → P (q i) (λ j → compPath-filler p q i j)) (J p) + J-∙ p q k = + transp + (λ i → P (q (i ∨ ~ k)) + (λ j → compPath-filler p q (i ∨ ~ k) j)) (~ k) + (J (λ j → compPath-filler p q (~ k) j)) --- Multi-variable versions of J +-- Multi-variable versions of J -module _ {b : B x} - (P : (y : A) (p : x ≡ y) (z : B y) (q : PathP (λ i → B (p i)) b z) → Type ℓ'') - (d : P _ refl _ refl) where +module _ {b : B x} + (P : (y : A) (p : x ≡ y) (z : B y) (q : PathP (λ i → B (p i)) b z) → Type ℓ'') + (d : P _ refl _ refl) where - JDep : {y : A} (p : x ≡ y) {z : B y} (q : PathP (λ i → B (p i)) b z) → P _ p _ q - JDep _ q = transport (λ i → P _ _ _ (λ j → q (i ∧ j))) d + JDep : {y : A} (p : x ≡ y) {z : B y} (q : PathP (λ i → B (p i)) b z) → P _ p _ q + JDep _ q = transport (λ i → P _ _ _ (λ j → q (i ∧ j))) d - JDepRefl : JDep refl refl ≡ d - JDepRefl = transportRefl d + JDepRefl : JDep refl refl ≡ d + JDepRefl = transportRefl d -module _ {x : A} - {P : (y : A) → x ≡ y → Type ℓ'} {d : (y : A) (p : x ≡ y) → P y p} - (Q : (y : A) (p : x ≡ y) (z : P y p) → d y p ≡ z → Type ℓ'') - (r : Q _ refl _ refl) where +module _ {x : A} + {P : (y : A) → x ≡ y → Type ℓ'} {d : (y : A) (p : x ≡ y) → P y p} + (Q : (y : A) (p : x ≡ y) (z : P y p) → d y p ≡ z → Type ℓ'') + (r : Q _ refl _ refl) where - private - ΠQ : (y : A) → x ≡ y → _ - ΠQ y p = ∀ z q → Q y p z q + private + ΠQ : (y : A) → x ≡ y → _ + ΠQ y p = ∀ z q → Q y p z q - J2 : {y : A} (p : x ≡ y) {z : P y p} (q : d y p ≡ z) → Q _ p _ q - J2 p = J ΠQ (λ _ → J (Q x refl) r) p _ + J2 : {y : A} (p : x ≡ y) {z : P y p} (q : d y p ≡ z) → Q _ p _ q + J2 p = J ΠQ (λ _ → J (Q x refl) r) p _ - J2Refl : J2 refl refl ≡ r - J2Refl = (λ i → JRefl ΠQ (λ _ → J (Q x refl) r) i _ refl) ∙ JRefl (Q x refl) _ + J2Refl : J2 refl refl ≡ r + J2Refl = (λ i → JRefl ΠQ (λ _ → J (Q x refl) r) i _ refl) ∙ JRefl (Q x refl) _ --- A prefix operator version of J that is more suitable to be nested +-- A prefix operator version of J that is more suitable to be nested -module _ {P : ∀ y → x ≡ y → Type ℓ'} (d : P x refl) where +module _ {P : ∀ y → x ≡ y → Type ℓ'} (d : P x refl) where - J>_ : ∀ y → (p : x ≡ y) → P y p - J>_ _ p = transport (λ i → P (p i) (λ j → p (i ∧ j))) d + J>_ : ∀ y → (p : x ≡ y) → P y p + J>_ _ p = transport (λ i → P (p i) (λ j → p (i ∧ j))) d - infix 10 J>_ + infix 10 J>_ --- Converting to and from a PathP - -module _ {A : I → Type ℓ} {x : A i0} {y : A i1} where - toPathP : transport (λ i → A i) x ≡ y → PathP A x y - toPathP p i = hcomp (λ j → λ { (i = i0) → x - ; (i = i1) → p j }) - (transp (λ j → A (i ∧ j)) (~ i) x) - - fromPathP : PathP A x y → transport (λ i → A i) x ≡ y - fromPathP p i = transp (λ j → A (i ∨ j)) i (p i) - --- Whiskering a dependent path by a path --- Double whiskering -_◁_▷_ : ∀ {ℓ} {A : I → Type ℓ} {a₀ a₀' : A i0} {a₁ a₁' : A i1} - → a₀ ≡ a₀' → PathP A a₀' a₁ → a₁ ≡ a₁' - → PathP A a₀ a₁' -(p ◁ P ▷ q) i = - hcomp (λ j → λ {(i = i0) → p (~ j) ; (i = i1) → q j}) (P i) - -doubleWhiskFiller : - ∀ {ℓ} {A : I → Type ℓ} {a₀ a₀' : A i0} {a₁ a₁' : A i1} - → (p : a₀ ≡ a₀') (pq : PathP A a₀' a₁) (q : a₁ ≡ a₁') - → PathP (λ i → PathP A (p (~ i)) (q i)) - pq - (p ◁ pq ▷ q) -doubleWhiskFiller p pq q k i = - hfill (λ j → λ {(i = i0) → p (~ j) ; (i = i1) → q j}) - (inS (pq i)) - k - -_◁_ : ∀ {ℓ} {A : I → Type ℓ} {a₀ a₀' : A i0} {a₁ : A i1} - → a₀ ≡ a₀' → PathP A a₀' a₁ → PathP A a₀ a₁ -(p ◁ q) = p ◁ q ▷ refl - -_▷_ : ∀ {ℓ} {A : I → Type ℓ} {a₀ : A i0} {a₁ a₁' : A i1} - → PathP A a₀ a₁ → a₁ ≡ a₁' → PathP A a₀ a₁' -p ▷ q = refl ◁ p ▷ q - --- Direct definitions of lower h-levels - -isContr : Type ℓ → Type ℓ -isContr A = Σ[ x ∈ A ] (∀ y → x ≡ y) - -isProp : Type ℓ → Type ℓ -isProp A = (x y : A) → x ≡ y - -isSet : Type ℓ → Type ℓ -isSet A = (x y : A) → isProp (x ≡ y) - -isGroupoid : Type ℓ → Type ℓ -isGroupoid A = ∀ a b → isSet (Path A a b) - -is2Groupoid : Type ℓ → Type ℓ -is2Groupoid A = ∀ a b → isGroupoid (Path A a b) - --- Contractibility of singletons - -singlP : (A : I → Type ℓ) (a : A i0) → Type _ -singlP A a = Σ[ x ∈ A i1 ] PathP A a x - -singl : (a : A) → Type _ -singl {A = A} a = singlP (λ _ → A) a - -isContrSingl : (a : A) → isContr (singl a) -isContrSingl a .fst = (a , refl) -isContrSingl a .snd p i .fst = p .snd i -isContrSingl a .snd p i .snd j = p .snd (i ∧ j) - -isContrSinglP : (A : I → Type ℓ) (a : A i0) → isContr (singlP A a) -isContrSinglP A a .fst = _ , transport-filler (λ i → A i) a -isContrSinglP A a .snd (x , p) i = - _ , λ j → fill A (λ j → λ {(i = i0) → transport-filler (λ i → A i) a j; (i = i1) → p j}) (inS a) j - --- Higher cube types - -SquareP : - (A : I → I → Type ℓ) - {a₀₀ : A i0 i0} {a₀₁ : A i0 i1} (a₀₋ : PathP (λ j → A i0 j) a₀₀ a₀₁) - {a₁₀ : A i1 i0} {a₁₁ : A i1 i1} (a₁₋ : PathP (λ j → A i1 j) a₁₀ a₁₁) - (a₋₀ : PathP (λ i → A i i0) a₀₀ a₁₀) (a₋₁ : PathP (λ i → A i i1) a₀₁ a₁₁) - → Type ℓ -SquareP A a₀₋ a₁₋ a₋₀ a₋₁ = PathP (λ i → PathP (λ j → A i j) (a₋₀ i) (a₋₁ i)) a₀₋ a₁₋ - -Square : - {a₀₀ a₀₁ : A} (a₀₋ : a₀₀ ≡ a₀₁) - {a₁₀ a₁₁ : A} (a₁₋ : a₁₀ ≡ a₁₁) - (a₋₀ : a₀₀ ≡ a₁₀) (a₋₁ : a₀₁ ≡ a₁₁) - → Type _ -Square a₀₋ a₁₋ a₋₀ a₋₁ = PathP (λ i → a₋₀ i ≡ a₋₁ i) a₀₋ a₁₋ - -Cube : - {a₀₀₀ a₀₀₁ : A} {a₀₀₋ : a₀₀₀ ≡ a₀₀₁} - {a₀₁₀ a₀₁₁ : A} {a₀₁₋ : a₀₁₀ ≡ a₀₁₁} - {a₀₋₀ : a₀₀₀ ≡ a₀₁₀} {a₀₋₁ : a₀₀₁ ≡ a₀₁₁} - (a₀₋₋ : Square a₀₀₋ a₀₁₋ a₀₋₀ a₀₋₁) - {a₁₀₀ a₁₀₁ : A} {a₁₀₋ : a₁₀₀ ≡ a₁₀₁} - {a₁₁₀ a₁₁₁ : A} {a₁₁₋ : a₁₁₀ ≡ a₁₁₁} - {a₁₋₀ : a₁₀₀ ≡ a₁₁₀} {a₁₋₁ : a₁₀₁ ≡ a₁₁₁} - (a₁₋₋ : Square a₁₀₋ a₁₁₋ a₁₋₀ a₁₋₁) - {a₋₀₀ : a₀₀₀ ≡ a₁₀₀} {a₋₀₁ : a₀₀₁ ≡ a₁₀₁} - (a₋₀₋ : Square a₀₀₋ a₁₀₋ a₋₀₀ a₋₀₁) - {a₋₁₀ : a₀₁₀ ≡ a₁₁₀} {a₋₁₁ : a₀₁₁ ≡ a₁₁₁} - (a₋₁₋ : Square a₀₁₋ a₁₁₋ a₋₁₀ a₋₁₁) - (a₋₋₀ : Square a₀₋₀ a₁₋₀ a₋₀₀ a₋₁₀) - (a₋₋₁ : Square a₀₋₁ a₁₋₁ a₋₀₁ a₋₁₁) - → Type _ -Cube a₀₋₋ a₁₋₋ a₋₀₋ a₋₁₋ a₋₋₀ a₋₋₁ = - PathP (λ i → Square (a₋₀₋ i) (a₋₁₋ i) (a₋₋₀ i) (a₋₋₁ i)) a₀₋₋ a₁₋₋ - --- Horizontal composition of squares (along their second dimension) --- See Cubical.Foundations.Path for vertical composition - -_∙₂_ : - {a₀₀ a₀₁ a₀₂ : A} {a₀₋ : a₀₀ ≡ a₀₁} {b₀₋ : a₀₁ ≡ a₀₂} - {a₁₀ a₁₁ a₁₂ : A} {a₁₋ : a₁₀ ≡ a₁₁} {b₁₋ : a₁₁ ≡ a₁₂} - {a₋₀ : a₀₀ ≡ a₁₀} {a₋₁ : a₀₁ ≡ a₁₁} {a₋₂ : a₀₂ ≡ a₁₂} - (p : Square a₀₋ a₁₋ a₋₀ a₋₁) (q : Square b₀₋ b₁₋ a₋₁ a₋₂) - → Square (a₀₋ ∙ b₀₋) (a₁₋ ∙ b₁₋) a₋₀ a₋₂ -_∙₂_ = congP₂ (λ _ → _∙_) - --- Alternative (equivalent) definitions of hlevel n that give fillers for n-cubes instead of n-globes - -isSet' : Type ℓ → Type ℓ -isSet' A = - {a₀₀ a₀₁ : A} (a₀₋ : a₀₀ ≡ a₀₁) - {a₁₀ a₁₁ : A} (a₁₋ : a₁₀ ≡ a₁₁) - (a₋₀ : a₀₀ ≡ a₁₀) (a₋₁ : a₀₁ ≡ a₁₁) - → Square a₀₋ a₁₋ a₋₀ a₋₁ - -isSet→isSet' : isSet A → isSet' A -isSet→isSet' Aset _ _ _ _ = toPathP (Aset _ _ _ _) - -isSet'→isSet : isSet' A → isSet A -isSet'→isSet Aset' x y p q = Aset' p q refl refl - -isGroupoid' : Type ℓ → Type ℓ -isGroupoid' A = - {a₀₀₀ a₀₀₁ : A} {a₀₀₋ : a₀₀₀ ≡ a₀₀₁} - {a₀₁₀ a₀₁₁ : A} {a₀₁₋ : a₀₁₀ ≡ a₀₁₁} - {a₀₋₀ : a₀₀₀ ≡ a₀₁₀} {a₀₋₁ : a₀₀₁ ≡ a₀₁₁} - (a₀₋₋ : Square a₀₀₋ a₀₁₋ a₀₋₀ a₀₋₁) - {a₁₀₀ a₁₀₁ : A} {a₁₀₋ : a₁₀₀ ≡ a₁₀₁} - {a₁₁₀ a₁₁₁ : A} {a₁₁₋ : a₁₁₀ ≡ a₁₁₁} - {a₁₋₀ : a₁₀₀ ≡ a₁₁₀} {a₁₋₁ : a₁₀₁ ≡ a₁₁₁} - (a₁₋₋ : Square a₁₀₋ a₁₁₋ a₁₋₀ a₁₋₁) - {a₋₀₀ : a₀₀₀ ≡ a₁₀₀} {a₋₀₁ : a₀₀₁ ≡ a₁₀₁} - (a₋₀₋ : Square a₀₀₋ a₁₀₋ a₋₀₀ a₋₀₁) - {a₋₁₀ : a₀₁₀ ≡ a₁₁₀} {a₋₁₁ : a₀₁₁ ≡ a₁₁₁} - (a₋₁₋ : Square a₀₁₋ a₁₁₋ a₋₁₀ a₋₁₁) - (a₋₋₀ : Square a₀₋₀ a₁₋₀ a₋₀₀ a₋₁₀) - (a₋₋₁ : Square a₀₋₁ a₁₋₁ a₋₀₁ a₋₁₁) - → Cube a₀₋₋ a₁₋₋ a₋₀₋ a₋₁₋ a₋₋₀ a₋₋₁ - --- Essential properties of isProp and isContr - -isProp→PathP : ∀ {B : I → Type ℓ} → ((i : I) → isProp (B i)) - → (b0 : B i0) (b1 : B i1) - → PathP B b0 b1 -isProp→PathP hB b0 b1 = toPathP (hB _ _ _) - -isPropIsContr : isProp (isContr A) -isPropIsContr (c0 , h0) (c1 , h1) j .fst = h0 c1 j -isPropIsContr (c0 , h0) (c1 , h1) j .snd y i = - hcomp (λ k → λ { (i = i0) → h0 (h0 c1 j) k; - (i = i1) → h0 y k; - (j = i0) → h0 (h0 y i) k; - (j = i1) → h0 (h1 y i) k}) - c0 - -isContr→isProp : isContr A → isProp A -isContr→isProp (x , p) a b = sym (p a) ∙ p b - -isProp→isSet : isProp A → isSet A -isProp→isSet h a b p q j i = - hcomp (λ k → λ { (i = i0) → h a a k - ; (i = i1) → h a b k - ; (j = i0) → h a (p i) k - ; (j = i1) → h a (q i) k }) a - -isProp→isSet' : isProp A → isSet' A -isProp→isSet' h {a} p q r s i j = - hcomp (λ k → λ { (i = i0) → h a (p j) k - ; (i = i1) → h a (q j) k - ; (j = i0) → h a (r i) k - ; (j = i1) → h a (s i) k}) a - -isPropIsProp : isProp (isProp A) -isPropIsProp f g i a b = isProp→isSet f a b (f a b) (g a b) i - -isPropSingl : {a : A} → isProp (singl a) -isPropSingl = isContr→isProp (isContrSingl _) - -isPropSinglP : {A : I → Type ℓ} {a : A i0} → isProp (singlP A a) -isPropSinglP = isContr→isProp (isContrSinglP _ _) - --- Universe lifting - -record Lift {i j} (A : Type i) : Type (ℓ-max i j) where - constructor lift - field - lower : A - -open Lift public - -liftExt : ∀ {A : Type ℓ} {a b : Lift {ℓ} {ℓ'} A} → (lower a ≡ lower b) → a ≡ b -liftExt x i = lift (x i) +-- Converting to and from a PathP + +module _ {A : I → Type ℓ} {x : A i0} {y : A i1} where + toPathP : transport (λ i → A i) x ≡ y → PathP A x y + toPathP p i = hcomp (λ j → λ { (i = i0) → x + ; (i = i1) → p j }) + (transp (λ j → A (i ∧ j)) (~ i) x) + + fromPathP : PathP A x y → transport (λ i → A i) x ≡ y + fromPathP p i = transp (λ j → A (i ∨ j)) i (p i) + +-- Whiskering a dependent path by a path +-- Double whiskering +_◁_▷_ : ∀ {ℓ} {A : I → Type ℓ} {a₀ a₀' : A i0} {a₁ a₁' : A i1} + → a₀ ≡ a₀' → PathP A a₀' a₁ → a₁ ≡ a₁' + → PathP A a₀ a₁' +(p ◁ P ▷ q) i = + hcomp (λ j → λ {(i = i0) → p (~ j) ; (i = i1) → q j}) (P i) + +doubleWhiskFiller : + ∀ {ℓ} {A : I → Type ℓ} {a₀ a₀' : A i0} {a₁ a₁' : A i1} + → (p : a₀ ≡ a₀') (pq : PathP A a₀' a₁) (q : a₁ ≡ a₁') + → PathP (λ i → PathP A (p (~ i)) (q i)) + pq + (p ◁ pq ▷ q) +doubleWhiskFiller p pq q k i = + hfill (λ j → λ {(i = i0) → p (~ j) ; (i = i1) → q j}) + (inS (pq i)) + k + +_◁_ : ∀ {ℓ} {A : I → Type ℓ} {a₀ a₀' : A i0} {a₁ : A i1} + → a₀ ≡ a₀' → PathP A a₀' a₁ → PathP A a₀ a₁ +(p ◁ q) = p ◁ q ▷ refl + +_▷_ : ∀ {ℓ} {A : I → Type ℓ} {a₀ : A i0} {a₁ a₁' : A i1} + → PathP A a₀ a₁ → a₁ ≡ a₁' → PathP A a₀ a₁' +p ▷ q = refl ◁ p ▷ q + +-- Direct definitions of lower h-levels + +isContr : Type ℓ → Type ℓ +isContr A = Σ[ x ∈ A ] (∀ y → x ≡ y) + +isProp : Type ℓ → Type ℓ +isProp A = (x y : A) → x ≡ y + +isSet : Type ℓ → Type ℓ +isSet A = (x y : A) → isProp (x ≡ y) + +isGroupoid : Type ℓ → Type ℓ +isGroupoid A = ∀ a b → isSet (Path A a b) + +is2Groupoid : Type ℓ → Type ℓ +is2Groupoid A = ∀ a b → isGroupoid (Path A a b) + +-- Contractibility of singletons + +singlP : (A : I → Type ℓ) (a : A i0) → Type _ +singlP A a = Σ[ x ∈ A i1 ] PathP A a x + +singl : (a : A) → Type _ +singl {A = A} a = singlP (λ _ → A) a + +isContrSingl : (a : A) → isContr (singl a) +isContrSingl a .fst = (a , refl) +isContrSingl a .snd p i .fst = p .snd i +isContrSingl a .snd p i .snd j = p .snd (i ∧ j) + +isContrSinglP : (A : I → Type ℓ) (a : A i0) → isContr (singlP A a) +isContrSinglP A a .fst = _ , transport-filler (λ i → A i) a +isContrSinglP A a .snd (x , p) i = + _ , λ j → fill A (λ j → λ {(i = i0) → transport-filler (λ i → A i) a j; (i = i1) → p j}) (inS a) j + +-- Higher cube types + +SquareP : + (A : I → I → Type ℓ) + {a₀₀ : A i0 i0} {a₀₁ : A i0 i1} (a₀₋ : PathP (λ j → A i0 j) a₀₀ a₀₁) + {a₁₀ : A i1 i0} {a₁₁ : A i1 i1} (a₁₋ : PathP (λ j → A i1 j) a₁₀ a₁₁) + (a₋₀ : PathP (λ i → A i i0) a₀₀ a₁₀) (a₋₁ : PathP (λ i → A i i1) a₀₁ a₁₁) + → Type ℓ +SquareP A a₀₋ a₁₋ a₋₀ a₋₁ = PathP (λ i → PathP (λ j → A i j) (a₋₀ i) (a₋₁ i)) a₀₋ a₁₋ + +Square : + {a₀₀ a₀₁ : A} (a₀₋ : a₀₀ ≡ a₀₁) + {a₁₀ a₁₁ : A} (a₁₋ : a₁₀ ≡ a₁₁) + (a₋₀ : a₀₀ ≡ a₁₀) (a₋₁ : a₀₁ ≡ a₁₁) + → Type _ +Square a₀₋ a₁₋ a₋₀ a₋₁ = PathP (λ i → a₋₀ i ≡ a₋₁ i) a₀₋ a₁₋ + +Cube : + {a₀₀₀ a₀₀₁ : A} {a₀₀₋ : a₀₀₀ ≡ a₀₀₁} + {a₀₁₀ a₀₁₁ : A} {a₀₁₋ : a₀₁₀ ≡ a₀₁₁} + {a₀₋₀ : a₀₀₀ ≡ a₀₁₀} {a₀₋₁ : a₀₀₁ ≡ a₀₁₁} + (a₀₋₋ : Square a₀₀₋ a₀₁₋ a₀₋₀ a₀₋₁) + {a₁₀₀ a₁₀₁ : A} {a₁₀₋ : a₁₀₀ ≡ a₁₀₁} + {a₁₁₀ a₁₁₁ : A} {a₁₁₋ : a₁₁₀ ≡ a₁₁₁} + {a₁₋₀ : a₁₀₀ ≡ a₁₁₀} {a₁₋₁ : a₁₀₁ ≡ a₁₁₁} + (a₁₋₋ : Square a₁₀₋ a₁₁₋ a₁₋₀ a₁₋₁) + {a₋₀₀ : a₀₀₀ ≡ a₁₀₀} {a₋₀₁ : a₀₀₁ ≡ a₁₀₁} + (a₋₀₋ : Square a₀₀₋ a₁₀₋ a₋₀₀ a₋₀₁) + {a₋₁₀ : a₀₁₀ ≡ a₁₁₀} {a₋₁₁ : a₀₁₁ ≡ a₁₁₁} + (a₋₁₋ : Square a₀₁₋ a₁₁₋ a₋₁₀ a₋₁₁) + (a₋₋₀ : Square a₀₋₀ a₁₋₀ a₋₀₀ a₋₁₀) + (a₋₋₁ : Square a₀₋₁ a₁₋₁ a₋₀₁ a₋₁₁) + → Type _ +Cube a₀₋₋ a₁₋₋ a₋₀₋ a₋₁₋ a₋₋₀ a₋₋₁ = + PathP (λ i → Square (a₋₀₋ i) (a₋₁₋ i) (a₋₋₀ i) (a₋₋₁ i)) a₀₋₋ a₁₋₋ + +-- Horizontal composition of squares (along their second dimension) +-- See Cubical.Foundations.Path for vertical composition + +_∙₂_ : + {a₀₀ a₀₁ a₀₂ : A} {a₀₋ : a₀₀ ≡ a₀₁} {b₀₋ : a₀₁ ≡ a₀₂} + {a₁₀ a₁₁ a₁₂ : A} {a₁₋ : a₁₀ ≡ a₁₁} {b₁₋ : a₁₁ ≡ a₁₂} + {a₋₀ : a₀₀ ≡ a₁₀} {a₋₁ : a₀₁ ≡ a₁₁} {a₋₂ : a₀₂ ≡ a₁₂} + (p : Square a₀₋ a₁₋ a₋₀ a₋₁) (q : Square b₀₋ b₁₋ a₋₁ a₋₂) + → Square (a₀₋ ∙ b₀₋) (a₁₋ ∙ b₁₋) a₋₀ a₋₂ +_∙₂_ = congP₂ (λ _ → _∙_) + +-- Alternative (equivalent) definitions of hlevel n that give fillers for n-cubes instead of n-globes + +isSet' : Type ℓ → Type ℓ +isSet' A = + {a₀₀ a₀₁ : A} (a₀₋ : a₀₀ ≡ a₀₁) + {a₁₀ a₁₁ : A} (a₁₋ : a₁₀ ≡ a₁₁) + (a₋₀ : a₀₀ ≡ a₁₀) (a₋₁ : a₀₁ ≡ a₁₁) + → Square a₀₋ a₁₋ a₋₀ a₋₁ + +isSet→isSet' : isSet A → isSet' A +isSet→isSet' Aset _ _ _ _ = toPathP (Aset _ _ _ _) + +isSet'→isSet : isSet' A → isSet A +isSet'→isSet Aset' x y p q = Aset' p q refl refl + +isGroupoid' : Type ℓ → Type ℓ +isGroupoid' A = + {a₀₀₀ a₀₀₁ : A} {a₀₀₋ : a₀₀₀ ≡ a₀₀₁} + {a₀₁₀ a₀₁₁ : A} {a₀₁₋ : a₀₁₀ ≡ a₀₁₁} + {a₀₋₀ : a₀₀₀ ≡ a₀₁₀} {a₀₋₁ : a₀₀₁ ≡ a₀₁₁} + (a₀₋₋ : Square a₀₀₋ a₀₁₋ a₀₋₀ a₀₋₁) + {a₁₀₀ a₁₀₁ : A} {a₁₀₋ : a₁₀₀ ≡ a₁₀₁} + {a₁₁₀ a₁₁₁ : A} {a₁₁₋ : a₁₁₀ ≡ a₁₁₁} + {a₁₋₀ : a₁₀₀ ≡ a₁₁₀} {a₁₋₁ : a₁₀₁ ≡ a₁₁₁} + (a₁₋₋ : Square a₁₀₋ a₁₁₋ a₁₋₀ a₁₋₁) + {a₋₀₀ : a₀₀₀ ≡ a₁₀₀} {a₋₀₁ : a₀₀₁ ≡ a₁₀₁} + (a₋₀₋ : Square a₀₀₋ a₁₀₋ a₋₀₀ a₋₀₁) + {a₋₁₀ : a₀₁₀ ≡ a₁₁₀} {a₋₁₁ : a₀₁₁ ≡ a₁₁₁} + (a₋₁₋ : Square a₀₁₋ a₁₁₋ a₋₁₀ a₋₁₁) + (a₋₋₀ : Square a₀₋₀ a₁₋₀ a₋₀₀ a₋₁₀) + (a₋₋₁ : Square a₀₋₁ a₁₋₁ a₋₀₁ a₋₁₁) + → Cube a₀₋₋ a₁₋₋ a₋₀₋ a₋₁₋ a₋₋₀ a₋₋₁ + +-- Essential properties of isProp and isContr + +isProp→PathP : ∀ {B : I → Type ℓ} → ((i : I) → isProp (B i)) + → (b0 : B i0) (b1 : B i1) + → PathP B b0 b1 +isProp→PathP hB b0 b1 = toPathP (hB _ _ _) + +isPropIsContr : isProp (isContr A) +isPropIsContr (c0 , h0) (c1 , h1) j .fst = h0 c1 j +isPropIsContr (c0 , h0) (c1 , h1) j .snd y i = + hcomp (λ k → λ { (i = i0) → h0 (h0 c1 j) k; + (i = i1) → h0 y k; + (j = i0) → h0 (h0 y i) k; + (j = i1) → h0 (h1 y i) k}) + c0 + +isContr→isProp : isContr A → isProp A +isContr→isProp (x , p) a b = sym (p a) ∙ p b + +isProp→isSet : isProp A → isSet A +isProp→isSet h a b p q j i = + hcomp (λ k → λ { (i = i0) → h a a k + ; (i = i1) → h a b k + ; (j = i0) → h a (p i) k + ; (j = i1) → h a (q i) k }) a + +isProp→isSet' : isProp A → isSet' A +isProp→isSet' h {a} p q r s i j = + hcomp (λ k → λ { (i = i0) → h a (p j) k + ; (i = i1) → h a (q j) k + ; (j = i0) → h a (r i) k + ; (j = i1) → h a (s i) k}) a + +isPropIsProp : isProp (isProp A) +isPropIsProp f g i a b = isProp→isSet f a b (f a b) (g a b) i + +isPropSingl : {a : A} → isProp (singl a) +isPropSingl = isContr→isProp (isContrSingl _) + +isPropSinglP : {A : I → Type ℓ} {a : A i0} → isProp (singlP A a) +isPropSinglP = isContr→isProp (isContrSinglP _ _) + +-- Universe lifting + +record Lift {i j} (A : Type i) : Type (ℓ-max i j) where + constructor lift + field + lower : A + +open Lift public + +liftExt : ∀ {A : Type ℓ} {a b : Lift {ℓ} {ℓ'} A} → (lower a ≡ lower b) → a ≡ b +liftExt x i = lift (x i) \ No newline at end of file diff --git a/docs/Cubical.Foundations.SIP.html b/docs/Cubical.Foundations.SIP.html index c3b5bb8..cd97f9e 100644 --- a/docs/Cubical.Foundations.SIP.html +++ b/docs/Cubical.Foundations.SIP.html @@ -30,28 +30,28 @@ -- a proposition. Indeed this type should correspond to the ways s and t can be identified -- as S-structures. This we call a standard notion of structure or SNS. -- We will use a different definition, but the two definitions are interchangeable. -SNS : (S : Type ℓ₁ → Type ℓ₂) (ι : StrEquiv S ℓ₃) → Type (ℓ-max (ℓ-max (ℓ-suc ℓ₁) ℓ₂) ℓ₃) +SNS : (S : Type ℓ₁ → Type ℓ₂) (ι : StrEquiv S ℓ₃) → Type (ℓ-max (ℓ-max (ℓ-suc ℓ₁) ℓ₂) ℓ₃) SNS {ℓ₁} S ι = ∀ {X : Type ℓ₁} (s t : S X) → ι (X , s) (X , t) (idEquiv X) ≃ (s ≡ t) -- We introduce the notation for structure preserving equivalences a -- bit differently, but this definition doesn't actually change from -- Escardó's notes. -_≃[_]_ : (A : TypeWithStr ℓ₁ S) (ι : StrEquiv S ℓ₂) (B : TypeWithStr ℓ₁ S) → Type (ℓ-max ℓ₁ ℓ₂) -A ≃[ ι ] B = Σ[ e ∈ typ A ≃ typ B ] (ι A B e) +_≃[_]_ : (A : TypeWithStr ℓ₁ S) (ι : StrEquiv S ℓ₂) (B : TypeWithStr ℓ₁ S) → Type (ℓ-max ℓ₁ ℓ₂) +A ≃[ ι ] B = Σ[ e ∈ typ A ≃ typ B ] (ι A B e) -- The following PathP version of SNS is a bit easier to work with -- for the proof of the SIP -UnivalentStr : (S : Type ℓ₁ → Type ℓ₂) (ι : StrEquiv S ℓ₃) → Type (ℓ-max (ℓ-max (ℓ-suc ℓ₁) ℓ₂) ℓ₃) +UnivalentStr : (S : Type ℓ₁ → Type ℓ₂) (ι : StrEquiv S ℓ₃) → Type (ℓ-max (ℓ-max (ℓ-suc ℓ₁) ℓ₂) ℓ₃) UnivalentStr {ℓ₁} S ι = - {A B : TypeWithStr ℓ₁ S} (e : typ A ≃ typ B) - → ι A B e ≃ PathP (λ i → S (ua e i)) (str A) (str B) + {A B : TypeWithStr ℓ₁ S} (e : typ A ≃ typ B) + → ι A B e ≃ PathP (λ i → S (ua e i)) (str A) (str B) -- A quick sanity-check that our definition is interchangeable with -- Escardó's. The direction SNS→UnivalentStr corresponds more or less -- to a dependent EquivJ formulation of Escardó's homomorphism-lemma. -UnivalentStr→SNS : (S : Type ℓ₁ → Type ℓ₂) (ι : StrEquiv S ℓ₃) +UnivalentStr→SNS : (S : Type ℓ₁ → Type ℓ₂) (ι : StrEquiv S ℓ₃) → UnivalentStr S ι → SNS S ι UnivalentStr→SNS S ι θ {X = X} s t = ι (X , s) (X , t) (idEquiv X) @@ -62,10 +62,10 @@ ■ -SNS→UnivalentStr : (ι : StrEquiv S ℓ₃) → SNS S ι → UnivalentStr S ι -SNS→UnivalentStr {S = S} ι θ {A = A} {B = B} e = EquivJ P C e (str A) (str B) +SNS→UnivalentStr : (ι : StrEquiv S ℓ₃) → SNS S ι → UnivalentStr S ι +SNS→UnivalentStr {S = S} ι θ {A = A} {B = B} e = EquivJ P C e (str A) (str B) where - Y = typ B + Y = typ B P : (X : Type _) → X ≃ Y → Type _ P X e' = (s : S X) (t : S Y) → ι (X , s) (Y , t) e' ≃ PathP (λ i → S (ua e' i)) s t @@ -79,39 +79,39 @@ PathP (λ i → S (ua (idEquiv Y) i)) s t ■ -TransportStr : {S : Type ℓ → Type ℓ₁} (α : EquivAction S) → Type (ℓ-max (ℓ-suc ℓ) ℓ₁) +TransportStr : {S : Type ℓ → Type ℓ₁} (α : EquivAction S) → Type (ℓ-max (ℓ-suc ℓ) ℓ₁) TransportStr {ℓ} {S = S} α = - {X Y : Type ℓ} (e : X ≃ Y) (s : S X) → equivFun (α e) s ≡ subst S (ua e) s + {X Y : Type ℓ} (e : X ≃ Y) (s : S X) → equivFun (α e) s ≡ subst S (ua e) s -TransportStr→UnivalentStr : {S : Type ℓ → Type ℓ₁} (α : EquivAction S) - → TransportStr α → UnivalentStr S (EquivAction→StrEquiv α) +TransportStr→UnivalentStr : {S : Type ℓ → Type ℓ₁} (α : EquivAction S) + → TransportStr α → UnivalentStr S (EquivAction→StrEquiv α) TransportStr→UnivalentStr {S = S} α τ {X , s} {Y , t} e = equivFun (α e) s ≡ t ≃⟨ pathToEquiv (cong (_≡ t) (τ e s)) ⟩ - subst S (ua e) s ≡ t + subst S (ua e) s ≡ t ≃⟨ invEquiv (PathP≃Path _ _ _) ⟩ PathP (λ i → S (ua e i)) s t ■ -UnivalentStr→TransportStr : {S : Type ℓ → Type ℓ₁} (α : EquivAction S) - → UnivalentStr S (EquivAction→StrEquiv α) → TransportStr α +UnivalentStr→TransportStr : {S : Type ℓ → Type ℓ₁} (α : EquivAction S) + → UnivalentStr S (EquivAction→StrEquiv α) → TransportStr α UnivalentStr→TransportStr {S = S} α θ e s = - invEq (θ e) (transport-filler (cong S (ua e)) s) + invEq (θ e) (transport-filler (cong S (ua e)) s) -invTransportStr : {S : Type ℓ → Type ℓ₂} (α : EquivAction S) (τ : TransportStr α) +invTransportStr : {S : Type ℓ → Type ℓ₂} (α : EquivAction S) (τ : TransportStr α) {X Y : Type ℓ} (e : X ≃ Y) (t : S Y) → invEq (α e) t ≡ subst⁻ S (ua e) t invTransportStr {S = S} α τ e t = sym (transport⁻Transport (cong S (ua e)) (invEq (α e) t)) - ∙∙ sym (cong (subst⁻ S (ua e)) (τ e (invEq (α e) t))) - ∙∙ cong (subst⁻ S (ua e)) (secEq (α e) t) + ∙∙ sym (cong (subst⁻ S (ua e)) (τ e (invEq (α e) t))) + ∙∙ cong (subst⁻ S (ua e)) (secEq (α e) t) --- We can now define an invertible function --- --- sip : A ≃[ ι ] B → A ≡ B -module _ {S : Type ℓ₁ → Type ℓ₂} {ι : StrEquiv S ℓ₃} - (θ : UnivalentStr S ι) (A B : TypeWithStr ℓ₁ S) +module _ {S : Type ℓ₁ → Type ℓ₂} {ι : StrEquiv S ℓ₃} + (θ : UnivalentStr S ι) (A B : TypeWithStr ℓ₁ S) where sip : A ≃[ ι ] B → A ≡ B @@ -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/docs/Cubical.Foundations.Structure.html b/docs/Cubical.Foundations.Structure.html index 3c43500..acb8ee9 100644 --- a/docs/Cubical.Foundations.Structure.html +++ b/docs/Cubical.Foundations.Structure.html @@ -11,39 +11,39 @@ S : Type ℓ → Type ℓ' -- A structure is a type-family S : Type ℓ → Type ℓ', i.e. for X : Type ℓ and s : S X, --- the pair (X , s) : TypeWithStr ℓ S means that X is equipped with a S-structure, witnessed by s. +-- the pair (X , s) : TypeWithStr ℓ S means that X is equipped with an S-structure, witnessed by s. -TypeWithStr : (ℓ : Level) (S : Type ℓ → Type ℓ') → Type (ℓ-max (ℓ-suc ℓ) ℓ') -TypeWithStr ℓ S = Σ[ X ∈ Type ℓ ] S X +TypeWithStr : (ℓ : Level) (S : Type ℓ → Type ℓ') → Type (ℓ-max (ℓ-suc ℓ) ℓ') +TypeWithStr ℓ S = Σ[ X ∈ Type ℓ ] S X -typ : TypeWithStr ℓ S → Type ℓ -typ = fst +typ : TypeWithStr ℓ S → Type ℓ +typ = fst -str : (A : TypeWithStr ℓ S) → S (typ A) -str = snd +str : (A : TypeWithStr ℓ S) → S (typ A) +str = snd --- Alternative notation for typ -⟨_⟩ : TypeWithStr ℓ S → Type ℓ -⟨_⟩ = typ +-- Alternative notation for typ +⟨_⟩ : TypeWithStr ℓ S → Type ℓ +⟨_⟩ = typ -instance - mkTypeWithStr : ∀ {ℓ} {S : Type ℓ → Type ℓ'} {X} → {{S X}} → TypeWithStr ℓ S - mkTypeWithStr {{i}} = _ , i +instance + mkTypeWithStr : ∀ {ℓ} {S : Type ℓ → Type ℓ'} {X} → {{S X}} → TypeWithStr ℓ S + mkTypeWithStr {{i}} = _ , i --- An S-structure should have a notion of S-homomorphism, or rather S-isomorphism. --- This will be implemented by a function ι : StrEquiv S ℓ' --- that gives us for any two types with S-structure (X , s) and (Y , t) a family: --- ι (X , s) (Y , t) : (X ≃ Y) → Type ℓ'' -StrEquiv : (S : Type ℓ → Type ℓ'') (ℓ' : Level) → Type (ℓ-max (ℓ-suc (ℓ-max ℓ ℓ')) ℓ'') -StrEquiv {ℓ} S ℓ' = (A B : TypeWithStr ℓ S) → typ A ≃ typ B → Type ℓ' +-- An S-structure should have a notion of S-homomorphism, or rather S-isomorphism. +-- This will be implemented by a function ι : StrEquiv S ℓ' +-- that gives us for any two types with S-structure (X , s) and (Y , t) a family: +-- ι (X , s) (Y , t) : (X ≃ Y) → Type ℓ'' +StrEquiv : (S : Type ℓ → Type ℓ'') (ℓ' : Level) → Type (ℓ-max (ℓ-suc (ℓ-max ℓ ℓ')) ℓ'') +StrEquiv {ℓ} S ℓ' = (A B : TypeWithStr ℓ S) → typ A ≃ typ B → Type ℓ' --- An S-structure may instead be equipped with an action on equivalences, which will --- induce a notion of S-homomorphism +-- An S-structure may instead be equipped with an action on equivalences, which will +-- induce a notion of S-homomorphism -EquivAction : (S : Type ℓ → Type ℓ'') → Type (ℓ-max (ℓ-suc ℓ) ℓ'') -EquivAction {ℓ} S = {X Y : Type ℓ} → X ≃ Y → S X ≃ S Y +EquivAction : (S : Type ℓ → Type ℓ'') → Type (ℓ-max (ℓ-suc ℓ) ℓ'') +EquivAction {ℓ} S = {X Y : Type ℓ} → X ≃ Y → S X ≃ S Y -EquivAction→StrEquiv : {S : Type ℓ → Type ℓ''} - → EquivAction S → StrEquiv S ℓ'' -EquivAction→StrEquiv α (X , s) (Y , t) e = equivFun (α e) s ≡ t +EquivAction→StrEquiv : {S : Type ℓ → Type ℓ''} + → EquivAction S → StrEquiv S ℓ'' +EquivAction→StrEquiv α (X , s) (Y , t) e = equivFun (α e) s ≡ t \ No newline at end of file diff --git a/docs/Cubical.Foundations.Transport.html b/docs/Cubical.Foundations.Transport.html index e752f93..18968fe 100644 --- a/docs/Cubical.Foundations.Transport.html +++ b/docs/Cubical.Foundations.Transport.html @@ -26,25 +26,25 @@ transpFill φ A u0 i = transp (λ j → outS (A (i ∧ j))) (~ i ∨ φ) u0 transport⁻ : ∀ {ℓ} {A B : Type ℓ} → A ≡ B → B → A -transport⁻ p = transport (λ i → p (~ i)) +transport⁻ p = transport (λ i → p (~ i)) subst⁻ : ∀ {ℓ ℓ'} {A : Type ℓ} {x y : A} (B : A → Type ℓ') (p : x ≡ y) → B y → B x subst⁻ B p pa = transport⁻ (λ i → B (p i)) pa subst⁻-filler : ∀ {ℓ ℓ'} {A : Type ℓ} {x y : A} (B : A → Type ℓ') (p : x ≡ y) (b : B y) → PathP (λ i → B (p (~ i))) b (subst⁻ B p b) -subst⁻-filler B p = subst-filler B (sym p) +subst⁻-filler B p = subst-filler B (sym p) transport-fillerExt : ∀ {ℓ} {A B : Type ℓ} (p : A ≡ B) - → PathP (λ i → A → p i) (λ x → x) (transport p) -transport-fillerExt p i x = transport-filler p x i + → PathP (λ i → A → p i) (λ x → x) (transport p) +transport-fillerExt p i x = transport-filler p x i transport⁻-fillerExt : ∀ {ℓ} {A B : Type ℓ} (p : A ≡ B) → PathP (λ i → p i → A) (λ x → x) (transport⁻ p) transport⁻-fillerExt p i x = transp (λ j → p (i ∧ ~ j)) (~ i) x transport-fillerExt⁻ : ∀ {ℓ} {A B : Type ℓ} (p : A ≡ B) - → PathP (λ i → p i → B) (transport p) (λ x → x) + → PathP (λ i → p i → B) (transport p) (λ x → x) transport-fillerExt⁻ p = symP (transport⁻-fillerExt (sym p)) transport⁻-fillerExt⁻ : ∀ {ℓ} {A B : Type ℓ} (p : A ≡ B) @@ -54,26 +54,26 @@ transport⁻-filler : ∀ {ℓ} {A B : Type ℓ} (p : A ≡ B) (x : B) → PathP (λ i → p (~ i)) x (transport⁻ p x) -transport⁻-filler p x = transport-filler (λ i → p (~ i)) x +transport⁻-filler p x = transport-filler (λ i → p (~ i)) x transport⁻Transport : ∀ {ℓ} {A B : Type ℓ} → (p : A ≡ B) → (a : A) → - transport⁻ p (transport p a) ≡ a + transport⁻ p (transport p a) ≡ a transport⁻Transport p a j = transport⁻-fillerExt p (~ j) (transport-fillerExt p (~ j) a) transportTransport⁻ : ∀ {ℓ} {A B : Type ℓ} → (p : A ≡ B) → (b : B) → - transport p (transport⁻ p b) ≡ b + transport p (transport⁻ p b) ≡ b transportTransport⁻ p b j = transport-fillerExt⁻ p j (transport⁻-fillerExt⁻ p j b) subst⁻Subst : ∀ {ℓ ℓ'} {A : Type ℓ} {x y : A} (B : A → Type ℓ') (p : x ≡ y) - → (u : B x) → subst⁻ B p (subst B p u) ≡ u + → (u : B x) → subst⁻ B p (subst B p u) ≡ u subst⁻Subst {x = x} {y = y} B p u = transport⁻Transport {A = B x} {B = B y} (cong B p) u substSubst⁻ : ∀ {ℓ ℓ'} {A : Type ℓ} {x y : A} (B : A → Type ℓ') (p : x ≡ y) - → (v : B y) → subst B p (subst⁻ B p v) ≡ v + → (v : B y) → subst B p (subst⁻ B p v) ≡ v substSubst⁻ {x = x} {y = y} B p v = transportTransport⁻ {A = B x} {B = B y} (cong B p) v substEquiv : ∀ {ℓ ℓ'} {A : Type ℓ} {a a' : A} (P : A → Type ℓ') (p : a ≡ a') → P a ≃ P a' -substEquiv P p = (subst P p , isEquivTransport (λ i → P (p i))) +substEquiv P p = (subst P p , isEquivTransport (λ i → P (p i))) liftEquiv : ∀ {ℓ ℓ'} {A B : Type ℓ} (P : Type ℓ → Type ℓ') (e : A ≃ B) → P A ≃ P B liftEquiv P e = substEquiv P (ua e) @@ -92,116 +92,123 @@ (j = i1) → P i1 , idEquiv (P i1) pathToIso : ∀ {ℓ} {A B : Type ℓ} → A ≡ B → Iso A B -Iso.fun (pathToIso x) = transport x +Iso.fun (pathToIso x) = transport x Iso.inv (pathToIso x) = transport⁻ x Iso.rightInv (pathToIso x) = transportTransport⁻ x Iso.leftInv (pathToIso x) = transport⁻Transport x -isInjectiveTransport : ∀ {ℓ : Level} {A B : Type ℓ} {p q : A ≡ B} - → transport p ≡ transport q → p ≡ q -isInjectiveTransport {p = p} {q} α i = - hcomp - (λ j → λ - { (i = i0) → retEq univalence p j - ; (i = i1) → retEq univalence q j - }) - (invEq univalence ((λ a → α i a) , t i)) - where - t : PathP (λ i → isEquiv (λ a → α i a)) (pathToEquiv p .snd) (pathToEquiv q .snd) - t = isProp→PathP (λ i → isPropIsEquiv (λ a → α i a)) _ _ - -transportUaInv : ∀ {ℓ} {A B : Type ℓ} (e : A ≃ B) → transport (ua (invEquiv e)) ≡ transport (sym (ua e)) -transportUaInv e = cong transport (uaInvEquiv e) --- notice that transport (ua e) would reduce, thus an alternative definition using EquivJ can give --- refl for the case of idEquiv: --- transportUaInv e = EquivJ (λ _ e → transport (ua (invEquiv e)) ≡ transport (sym (ua e))) refl e - -isSet-subst : ∀ {ℓ ℓ'} {A : Type ℓ} {B : A → Type ℓ'} - → (isSet-A : isSet A) - → ∀ {a : A} - → (p : a ≡ a) → (x : B a) → subst B p x ≡ x -isSet-subst {B = B} isSet-A p x = subst (λ p′ → subst B p′ x ≡ x) (isSet-A _ _ refl p) (substRefl {B = B} x) - --- substituting along a composite path is equivalent to substituting twice -substComposite : ∀ {ℓ ℓ'} {A : Type ℓ} → (B : A → Type ℓ') - → {x y z : A} (p : x ≡ y) (q : y ≡ z) (u : B x) - → subst B (p ∙ q) u ≡ subst B q (subst B p u) -substComposite B p q Bx i = - transport (cong B (compPath-filler' p q (~ i))) (transport-fillerExt (cong B p) i Bx) - --- transporting along a composite path is equivalent to transporting twice -transportComposite : ∀ {ℓ} {A B C : Type ℓ} (p : A ≡ B) (q : B ≡ C) (x : A) - → transport (p ∙ q) x ≡ transport q (transport p x) -transportComposite = substComposite (λ D → D) - --- substitution commutes with morphisms in slices -substCommSlice : ∀ {ℓ ℓ' ℓ''} {A : Type ℓ} - → (B : A → Type ℓ') (C : A → Type ℓ'') - → (F : ∀ a → B a → C a) - → {x y : A} (p : x ≡ y) (u : B x) - → subst C p (F x u) ≡ F y (subst B p u) -substCommSlice B C F p Bx a = - transport-fillerExt⁻ (cong C p) a (F _ (transport-fillerExt (cong B p) a Bx)) - -constSubstCommSlice : ∀ {ℓ ℓ' ℓ''} {A : Type ℓ} - → (B : A → Type ℓ') - → (C : Type ℓ'') - → (F : ∀ a → B a → C) - → {x y : A} (p : x ≡ y) (u : B x) - → (F x u) ≡ F y (subst B p u) -constSubstCommSlice B C F p Bx = (sym (transportRefl (F _ Bx)) ∙ substCommSlice B (λ _ → C) F p Bx) - --- transporting over (λ i → B (p i) → C (p i)) divides the transport into --- transports over (λ i → C (p i)) and (λ i → B (p (~ i))) -funTypeTransp : ∀ {ℓ ℓ' ℓ''} {A : Type ℓ} (B : A → Type ℓ') (C : A → Type ℓ'') {x y : A} (p : x ≡ y) (f : B x → C x) - → PathP (λ i → B (p i) → C (p i)) f (subst C p ∘ f ∘ subst B (sym p)) -funTypeTransp B C {x = x} p f i b = - transp (λ j → C (p (j ∧ i))) (~ i) (f (transp (λ j → B (p (i ∧ ~ j))) (~ i) b)) - --- transports between loop spaces preserve path composition -overPathFunct : ∀ {ℓ} {A : Type ℓ} {x y : A} (p q : x ≡ x) (P : x ≡ y) - → transport (λ i → P i ≡ P i) (p ∙ q) - ≡ transport (λ i → P i ≡ P i) p ∙ transport (λ i → P i ≡ P i) q -overPathFunct p q = - J (λ y P → transport (λ i → P i ≡ P i) (p ∙ q) ≡ transport (λ i → P i ≡ P i) p ∙ transport (λ i → P i ≡ P i) q) - (transportRefl (p ∙ q) ∙ cong₂ _∙_ (sym (transportRefl p)) (sym (transportRefl q))) - --- substition over families of paths --- theorem 2.11.3 in The Book -substInPaths : ∀ {ℓ} {A B : Type ℓ} {a a' : A} - → (f g : A → B) → (p : a ≡ a') (q : f a ≡ g a) - → subst (λ x → f x ≡ g x) p q ≡ sym (cong f p) ∙ q ∙ cong g p -substInPaths {a = a} f g p q = - J (λ x p' → (subst (λ y → f y ≡ g y) p' q) ≡ (sym (cong f p') ∙ q ∙ cong g p')) - p=refl p - where - p=refl : subst (λ y → f y ≡ g y) refl q - ≡ refl ∙ q ∙ refl - p=refl = subst (λ y → f y ≡ g y) refl q - ≡⟨ substRefl {B = (λ y → f y ≡ g y)} q ⟩ q - ≡⟨ (rUnit q) ∙ lUnit (q ∙ refl) ⟩ refl ∙ q ∙ refl ∎ - -flipTransport : ∀ {ℓ} {A : I → Type ℓ} {x : A i0} {y : A i1} - → x ≡ transport⁻ (λ i → A i) y - → transport (λ i → A i) x ≡ y -flipTransport {A = A} {y = y} p = - cong (transport (λ i → A i)) p ∙ transportTransport⁻ (λ i → A i) y - --- special cases of substInPaths from lemma 2.11.2 in The Book -module _ {ℓ : Level} {A : Type ℓ} {a x1 x2 : A} (p : x1 ≡ x2) where - substInPathsL : (q : a ≡ x1) → subst (λ x → a ≡ x) p q ≡ q ∙ p - substInPathsL q = subst (λ x → a ≡ x) p q - ≡⟨ substInPaths (λ _ → a) (λ x → x) p q ⟩ - sym (cong (λ _ → a) p) ∙ q ∙ cong (λ x → x) p - ≡⟨ assoc (λ _ → a) q p ⟩ - (refl ∙ q) ∙ p - ≡⟨ cong (_∙ p) (sym (lUnit q)) ⟩ q ∙ p ∎ - - substInPathsR : (q : x1 ≡ a) → subst (λ x → x ≡ a) p q ≡ sym p ∙ q - substInPathsR q = subst (λ x → x ≡ a) p q - ≡⟨ substInPaths (λ x → x) (λ _ → a) p q ⟩ - sym (cong (λ x → x) p) ∙ q ∙ cong (λ _ → a) p - ≡⟨ assoc (sym p) q refl ⟩ - (sym p ∙ q) ∙ refl - ≡⟨ sym (rUnit (sym p ∙ q))⟩ sym p ∙ q ∎ +substIso : ∀ {ℓ ℓ'} {A : Type ℓ} (B : A → Type ℓ') {x y : A} (p : x ≡ y) → Iso (B x) (B y) +substIso B p = pathToIso (cong B p) + +-- Redefining substEquiv in terms of substIso gives an explicit inverse +substEquiv' : ∀ {ℓ ℓ'} {A : Type ℓ} (B : A → Type ℓ') {x y : A} (p : x ≡ y) → B x ≃ B y +substEquiv' B p = isoToEquiv (substIso B p) + +isInjectiveTransport : ∀ {ℓ : Level} {A B : Type ℓ} {p q : A ≡ B} + → transport p ≡ transport q → p ≡ q +isInjectiveTransport {p = p} {q} α i = + hcomp + (λ j → λ + { (i = i0) → retEq univalence p j + ; (i = i1) → retEq univalence q j + }) + (invEq univalence ((λ a → α i a) , t i)) + where + t : PathP (λ i → isEquiv (λ a → α i a)) (pathToEquiv p .snd) (pathToEquiv q .snd) + t = isProp→PathP (λ i → isPropIsEquiv (λ a → α i a)) _ _ + +transportUaInv : ∀ {ℓ} {A B : Type ℓ} (e : A ≃ B) → transport (ua (invEquiv e)) ≡ transport (sym (ua e)) +transportUaInv e = cong transport (uaInvEquiv e) +-- notice that transport (ua e) would reduce, thus an alternative definition using EquivJ can give +-- refl for the case of idEquiv: +-- transportUaInv e = EquivJ (λ _ e → transport (ua (invEquiv e)) ≡ transport (sym (ua e))) refl e + +isSet-subst : ∀ {ℓ ℓ'} {A : Type ℓ} {B : A → Type ℓ'} + → (isSet-A : isSet A) + → ∀ {a : A} + → (p : a ≡ a) → (x : B a) → subst B p x ≡ x +isSet-subst {B = B} isSet-A p x = subst (λ p′ → subst B p′ x ≡ x) (isSet-A _ _ refl p) (substRefl {B = B} x) + +-- substituting along a composite path is equivalent to substituting twice +substComposite : ∀ {ℓ ℓ'} {A : Type ℓ} → (B : A → Type ℓ') + → {x y z : A} (p : x ≡ y) (q : y ≡ z) (u : B x) + → subst B (p ∙ q) u ≡ subst B q (subst B p u) +substComposite B p q Bx i = + transport (cong B (compPath-filler' p q (~ i))) (transport-fillerExt (cong B p) i Bx) + +-- transporting along a composite path is equivalent to transporting twice +transportComposite : ∀ {ℓ} {A B C : Type ℓ} (p : A ≡ B) (q : B ≡ C) (x : A) + → transport (p ∙ q) x ≡ transport q (transport p x) +transportComposite = substComposite (λ D → D) + +-- substitution commutes with morphisms in slices +substCommSlice : ∀ {ℓ ℓ' ℓ''} {A : Type ℓ} + → (B : A → Type ℓ') (C : A → Type ℓ'') + → (F : ∀ a → B a → C a) + → {x y : A} (p : x ≡ y) (u : B x) + → subst C p (F x u) ≡ F y (subst B p u) +substCommSlice B C F p Bx a = + transport-fillerExt⁻ (cong C p) a (F _ (transport-fillerExt (cong B p) a Bx)) + +constSubstCommSlice : ∀ {ℓ ℓ' ℓ''} {A : Type ℓ} + → (B : A → Type ℓ') + → (C : Type ℓ'') + → (F : ∀ a → B a → C) + → {x y : A} (p : x ≡ y) (u : B x) + → (F x u) ≡ F y (subst B p u) +constSubstCommSlice B C F p Bx = (sym (transportRefl (F _ Bx)) ∙ substCommSlice B (λ _ → C) F p Bx) + +-- transporting over (λ i → B (p i) → C (p i)) divides the transport into +-- transports over (λ i → C (p i)) and (λ i → B (p (~ i))) +funTypeTransp : ∀ {ℓ ℓ' ℓ''} {A : Type ℓ} (B : A → Type ℓ') (C : A → Type ℓ'') {x y : A} (p : x ≡ y) (f : B x → C x) + → PathP (λ i → B (p i) → C (p i)) f (subst C p ∘ f ∘ subst B (sym p)) +funTypeTransp B C {x = x} p f i b = + transp (λ j → C (p (j ∧ i))) (~ i) (f (transp (λ j → B (p (i ∧ ~ j))) (~ i) b)) + +-- transports between loop spaces preserve path composition +overPathFunct : ∀ {ℓ} {A : Type ℓ} {x y : A} (p q : x ≡ x) (P : x ≡ y) + → transport (λ i → P i ≡ P i) (p ∙ q) + ≡ transport (λ i → P i ≡ P i) p ∙ transport (λ i → P i ≡ P i) q +overPathFunct p q = + J (λ y P → transport (λ i → P i ≡ P i) (p ∙ q) ≡ transport (λ i → P i ≡ P i) p ∙ transport (λ i → P i ≡ P i) q) + (transportRefl (p ∙ q) ∙ cong₂ _∙_ (sym (transportRefl p)) (sym (transportRefl q))) + +-- substition over families of paths +-- theorem 2.11.3 in The Book +substInPaths : ∀ {ℓ ℓ'} {A : Type ℓ} {B : Type ℓ'} {a a' : A} + → (f g : A → B) → (p : a ≡ a') (q : f a ≡ g a) + → subst (λ x → f x ≡ g x) p q ≡ sym (cong f p) ∙ q ∙ cong g p +substInPaths {a = a} f g p q = + J (λ x p' → (subst (λ y → f y ≡ g y) p' q) ≡ (sym (cong f p') ∙ q ∙ cong g p')) + p=refl p + where + p=refl : subst (λ y → f y ≡ g y) refl q + ≡ refl ∙ q ∙ refl + p=refl = subst (λ y → f y ≡ g y) refl q + ≡⟨ substRefl {B = (λ y → f y ≡ g y)} q ⟩ q + ≡⟨ (rUnit q) ∙ lUnit (q ∙ refl) ⟩ refl ∙ q ∙ refl ∎ + +flipTransport : ∀ {ℓ} {A : I → Type ℓ} {x : A i0} {y : A i1} + → x ≡ transport⁻ (λ i → A i) y + → transport (λ i → A i) x ≡ y +flipTransport {A = A} {y = y} p = + cong (transport (λ i → A i)) p ∙ transportTransport⁻ (λ i → A i) y + +-- special cases of substInPaths from lemma 2.11.2 in The Book +module _ {ℓ : Level} {A : Type ℓ} {a x1 x2 : A} (p : x1 ≡ x2) where + substInPathsL : (q : a ≡ x1) → subst (λ x → a ≡ x) p q ≡ q ∙ p + substInPathsL q = subst (λ x → a ≡ x) p q + ≡⟨ substInPaths (λ _ → a) (λ x → x) p q ⟩ + sym (cong (λ _ → a) p) ∙ q ∙ cong (λ x → x) p + ≡⟨ assoc (λ _ → a) q p ⟩ + (refl ∙ q) ∙ p + ≡⟨ cong (_∙ p) (sym (lUnit q)) ⟩ q ∙ p ∎ + + substInPathsR : (q : x1 ≡ a) → subst (λ x → x ≡ a) p q ≡ sym p ∙ q + substInPathsR q = subst (λ x → x ≡ a) p q + ≡⟨ substInPaths (λ x → x) (λ _ → a) p q ⟩ + sym (cong (λ x → x) p) ∙ q ∙ cong (λ _ → a) p + ≡⟨ assoc (sym p) q refl ⟩ + (sym p ∙ q) ∙ refl + ≡⟨ sym (rUnit (sym p ∙ q))⟩ sym p ∙ q ∎ \ No newline at end of file diff --git a/docs/Cubical.Foundations.Univalence.html b/docs/Cubical.Foundations.Univalence.html index d1165e2..f250af6 100644 --- a/docs/Cubical.Foundations.Univalence.html +++ b/docs/Cubical.Foundations.Univalence.html @@ -42,7 +42,7 @@ uaIdEquiv {A = A} i j = Glue A {φ = i ∨ ~ j ∨ j} (λ _ → A , idEquiv A) -- Propositional extensionality -hPropExt : {A B : Type ℓ} → isProp A → isProp B → (A → B) → (B → A) → A ≡ B +hPropExt : {A B : Type ℓ} → isProp A → isProp B → (A → B) → (B → A) → A ≡ B hPropExt Aprop Bprop f g = ua (propBiimpl→Equiv Aprop Bprop f g) -- the unglue and glue primitives specialized to the case of ua @@ -164,24 +164,24 @@ contrSinglEquiv : {A B : Type ℓ} (e : A ≃ B) → (B , idEquiv B) ≡ (A , e) contrSinglEquiv {A = A} {B = B} e = - isContr→isProp (EquivContr B) (B , idEquiv B) (A , e) + isContr→isProp (EquivContr B) (B , idEquiv B) (A , e) -- Equivalence induction EquivJ : {A B : Type ℓ} (P : (A : Type ℓ) → (e : A ≃ B) → Type ℓ') → (r : P B (idEquiv B)) → (e : A ≃ B) → P A e -EquivJ P r e = subst (λ x → P (x .fst) (x .snd)) (contrSinglEquiv e) r +EquivJ P r e = subst (λ x → P (x .fst) (x .snd)) (contrSinglEquiv e) r -- Assuming that we have an inverse to ua we can easily prove univalence module Univalence (au : ∀ {ℓ} {A B : Type ℓ} → A ≡ B → A ≃ B) (aurefl : ∀ {ℓ} {A : Type ℓ} → au refl ≡ idEquiv A) where ua-au : {A B : Type ℓ} (p : A ≡ B) → ua (au p) ≡ p - ua-au {B = B} = J (λ _ p → ua (au p) ≡ p) - (cong ua aurefl ∙ uaIdEquiv) + ua-au {B = B} = J (λ _ p → ua (au p) ≡ p) + (cong ua aurefl ∙ uaIdEquiv) au-ua : {A B : Type ℓ} (e : A ≃ B) → au (ua e) ≡ e au-ua {B = B} = EquivJ (λ _ f → au (ua f) ≡ f) - (subst (λ r → au r ≡ idEquiv _) (sym uaIdEquiv) aurefl) + (subst (λ r → au r ≡ idEquiv _) (sym uaIdEquiv) aurefl) isoThm : ∀ {ℓ} {A B : Type ℓ} → Iso (A ≡ B) (A ≃ B) isoThm .Iso.fun = au @@ -192,12 +192,12 @@ thm : ∀ {ℓ} {A B : Type ℓ} → isEquiv au thm {A = A} {B = B} = isoToIsEquiv {B = A ≃ B} isoThm -isEquivTransport : {A B : Type ℓ} (p : A ≡ B) → isEquiv (transport p) +isEquivTransport : {A B : Type ℓ} (p : A ≡ B) → isEquiv (transport p) isEquivTransport p = - transport (λ i → isEquiv (transp (λ j → p (i ∧ j)) (~ i))) (idIsEquiv _) + transport (λ i → isEquiv (transp (λ j → p (i ∧ j)) (~ i))) (idIsEquiv _) pathToEquiv : {A B : Type ℓ} → A ≡ B → A ≃ B -pathToEquiv p .fst = transport p +pathToEquiv p .fst = transport p pathToEquiv p .snd = isEquivTransport p pathToEquivRefl : {A : Type ℓ} → pathToEquiv refl ≡ idEquiv A @@ -218,10 +218,10 @@ -- The original map from UniMath/Foundations eqweqmap : {A B : Type ℓ} → A ≡ B → A ≃ B -eqweqmap {A = A} e = J (λ X _ → A ≃ X) (idEquiv A) e +eqweqmap {A = A} e = J (λ X _ → A ≃ X) (idEquiv A) e eqweqmapid : {A : Type ℓ} → eqweqmap refl ≡ idEquiv A -eqweqmapid {A = A} = JRefl (λ X _ → A ≃ X) (idEquiv A) +eqweqmapid {A = A} = JRefl (λ X _ → A ≃ X) (idEquiv A) univalenceStatement : {A B : Type ℓ} → isEquiv (eqweqmap {ℓ} {A} {B}) univalenceStatement = Univalence.thm eqweqmap eqweqmapid @@ -229,17 +229,17 @@ univalenceUAH : {A B : Type ℓ} → (A ≡ B) ≃ (A ≃ B) univalenceUAH = ( _ , univalenceStatement ) -univalencePath : {A B : Type ℓ} → (A ≡ B) ≡ Lift (A ≃ B) +univalencePath : {A B : Type ℓ} → (A ≡ B) ≡ Lift (A ≃ B) univalencePath = ua (compEquiv univalence LiftEquiv) -- The computation rule for ua. Because of "ghcomp" it is now very -- simple compared to cubicaltt: -- https://github.com/mortberg/cubicaltt/blob/master/examples/univalence.ctt#L202 -uaβ : {A B : Type ℓ} (e : A ≃ B) (x : A) → transport (ua e) x ≡ equivFun e x -uaβ e x = transportRefl (equivFun e x) +uaβ : {A B : Type ℓ} (e : A ≃ B) (x : A) → transport (ua e) x ≡ equivFun e x +uaβ e x = transportRefl (equivFun e x) uaη : ∀ {A B : Type ℓ} → (P : A ≡ B) → ua (pathToEquiv P) ≡ P -uaη = J (λ _ q → ua (pathToEquiv q) ≡ q) (cong ua pathToEquivRefl ∙ uaIdEquiv) +uaη = J (λ _ q → ua (pathToEquiv q) ≡ q) (cong ua pathToEquivRefl ∙ uaIdEquiv) -- Lemmas for constructing and destructing dependent paths in a function type where the domain is ua. ua→ : ∀ {ℓ ℓ'} {A₀ A₁ : Type ℓ} {e : A₀ ≃ A₁} {B : (i : I) → Type ℓ'} @@ -254,8 +254,8 @@ }) (h (transp (λ j → ua e (~ j ∧ i)) (~ i) a) i) where - lem : ∀ a₁ → e .fst (transport (sym (ua e)) a₁) ≡ a₁ - lem a₁ = secEq e _ ∙ transportRefl _ + lem : ∀ a₁ → e .fst (transport (sym (ua e)) a₁) ≡ a₁ + lem a₁ = secEq e _ ∙ transportRefl _ ua→⁻ : ∀ {ℓ ℓ'} {A₀ A₁ : Type ℓ} {e : A₀ ≃ A₁} {B : (i : I) → Type ℓ'} {f₀ : A₀ → B i0} {f₁ : A₁ → B i1} @@ -280,21 +280,21 @@ -- Useful lemma for unfolding a transported function over ua -- If we would have regularity this would be refl transportUAop₁ : ∀ {A B : Type ℓ} → (e : A ≃ B) (f : A → A) (x : B) - → transport (λ i → ua e i → ua e i) f x ≡ equivFun e (f (invEq e x)) -transportUAop₁ e f x i = transportRefl (equivFun e (f (invEq e (transportRefl x i)))) i + → transport (λ i → ua e i → ua e i) f x ≡ equivFun e (f (invEq e x)) +transportUAop₁ e f x i = transportRefl (equivFun e (f (invEq e (transportRefl x i)))) i -- Binary version transportUAop₂ : ∀ {ℓ} {A B : Type ℓ} → (e : A ≃ B) (f : A → A → A) (x y : B) - → transport (λ i → ua e i → ua e i → ua e i) f x y ≡ + → transport (λ i → ua e i → ua e i → ua e i) f x y ≡ equivFun e (f (invEq e x) (invEq e y)) transportUAop₂ e f x y i = - transportRefl (equivFun e (f (invEq e (transportRefl x i)) - (invEq e (transportRefl y i)))) i + transportRefl (equivFun e (f (invEq e (transportRefl x i)) + (invEq e (transportRefl y i)))) i -- Alternative version of EquivJ that only requires a predicate on functions elimEquivFun : {A B : Type ℓ} (P : (A : Type ℓ) → (A → B) → Type ℓ') → (r : P B (idfun B)) → (e : A ≃ B) → P A (e .fst) -elimEquivFun P r e = subst (λ x → P (x .fst) (x .snd .fst)) (contrSinglEquiv e) r +elimEquivFun P r e = subst (λ x → P (x .fst) (x .snd .fst)) (contrSinglEquiv e) r -- Isomorphism induction elimIso : {B : Type ℓ} → (Q : {A : Type ℓ} → (A → B) → (B → A) → Type ℓ') → @@ -306,7 +306,7 @@ P A f = (g : B → A) → section f g → retract f g → Q f g rem : P B (idfun B) - rem g sfg rfg = subst (Q (idfun B)) (λ i b → (sfg b) (~ i)) h + rem g sfg rfg = subst (Q (idfun B)) (λ i b → (sfg b) (~ i)) h rem1 : {A : Type ℓ} → (f : A → B) → P A f rem1 f g sfg rfg = elimEquivFun P rem (f , isoToIsEquiv (iso f g sfg rfg)) g sfg rfg @@ -316,9 +316,9 @@ uaInvEquiv {B = B} = EquivJ (λ _ e → ua (invEquiv e) ≡ sym (ua e)) (cong ua (invEquivIdEquiv B)) -uaCompEquiv : ∀ {A B C : Type ℓ} → (e : A ≃ B) (f : B ≃ C) → ua (compEquiv e f) ≡ ua e ∙ ua f -uaCompEquiv {B = B} {C} = EquivJ (λ _ e → (f : B ≃ C) → ua (compEquiv e f) ≡ ua e ∙ ua f) +uaCompEquiv : ∀ {A B C : Type ℓ} → (e : A ≃ B) (f : B ≃ C) → ua (compEquiv e f) ≡ ua e ∙ ua f +uaCompEquiv {B = B} {C} = EquivJ (λ _ e → (f : B ≃ C) → ua (compEquiv e f) ≡ ua e ∙ ua f) (λ f → cong ua (compEquivIdEquiv f) - ∙ sym (cong (λ x → x ∙ ua f) uaIdEquiv - ∙ sym (lUnit (ua f)))) + ∙ sym (cong (λ x → x ∙ ua f) uaIdEquiv + ∙ sym (lUnit (ua f)))) \ No newline at end of file diff --git a/docs/Cubical.Functions.Embedding.html b/docs/Cubical.Functions.Embedding.html index a30b362..096cb28 100644 --- a/docs/Cubical.Functions.Embedding.html +++ b/docs/Cubical.Functions.Embedding.html @@ -45,7 +45,7 @@ isEmbedding : (A → B) → Type _ isEmbedding f = ∀ w x → isEquiv {A = w ≡ x} (cong f) -isPropIsEmbedding : isProp (isEmbedding f) +isPropIsEmbedding : isProp (isEmbedding f) isPropIsEmbedding {f = f} = isPropΠ2 λ _ _ → isPropIsEquiv (cong f) -- Embedding is injection in the aforementioned sense: @@ -62,24 +62,24 @@ -- If `f` is an embedding, we'd expect the fibers of `f` to be -- propositions, like an injective function. hasPropFibers : (A → B) → Type _ -hasPropFibers f = ∀ y → isProp (fiber f y) +hasPropFibers f = ∀ y → isProp (fiber f y) -- This can be relaxed to having all prop fibers over the image, see [hasPropFibersOfImage→isEmbedding] hasPropFibersOfImage : (A → B) → Type _ -hasPropFibersOfImage f = ∀ x → isProp (fiber f (f x)) +hasPropFibersOfImage f = ∀ x → isProp (fiber f (f x)) -- some notation _↪_ : Type ℓ' → Type ℓ'' → Type (ℓ-max ℓ' ℓ'') A ↪ B = Σ[ f ∈ (A → B) ] isEmbedding f -hasPropFibersIsProp : isProp (hasPropFibers f) -hasPropFibersIsProp = isPropΠ (λ _ → isPropIsProp) +hasPropFibersIsProp : isProp (hasPropFibers f) +hasPropFibersIsProp = isPropΠ (λ _ → isPropIsProp) private lemma₀ : (p : y ≡ z) → fiber f y ≡ fiber f z lemma₀ {f = f} p = λ i → fiber f (p i) - lemma₁ : isEmbedding f → ∀ x → isContr (fiber f (f x)) + lemma₁ : isEmbedding f → ∀ x → isContr (fiber f (f x)) lemma₁ {f = f} iE x = value , path where value : fiber f (f x) @@ -98,7 +98,7 @@ isEmbedding→hasPropFibers : isEmbedding f → hasPropFibers f isEmbedding→hasPropFibers iE y (x , p) - = subst (λ f → isProp f) (lemma₀ p) (isContr→isProp (lemma₁ iE x)) (x , p) + = subst (λ f → isProp f) (lemma₀ p) (isContr→isProp (lemma₁ iE x)) (x , p) private fibCong→PathP @@ -124,7 +124,7 @@ hasPropFibers→isEmbedding : hasPropFibers f → isEmbedding f hasPropFibers→isEmbedding {f = f} iP w x .equiv-proof p - = subst isContr (PathP≡fibCong p) (isProp→isContrPathP (λ i → iP (p i)) fw fx) + = subst isContr (PathP≡fibCong p) (isProp→isContrPathP (λ i → iP (p i)) fw fx) where fw : fiber f (f w) fw = (w , refl) @@ -134,7 +134,7 @@ hasPropFibersOfImage→hasPropFibers : hasPropFibersOfImage f → hasPropFibers f hasPropFibersOfImage→hasPropFibers {f = f} fibImg y a b = - subst (λ y → isProp (fiber f y)) (snd a) (fibImg (fst a)) a b + subst (λ y → isProp (fiber f y)) (snd a) (fibImg (fst a)) a b hasPropFibersOfImage→isEmbedding : hasPropFibersOfImage f → isEmbedding f hasPropFibersOfImage→isEmbedding = hasPropFibers→isEmbedding ∘ hasPropFibersOfImage→hasPropFibers @@ -151,7 +151,7 @@ -- implies isEmbedding as long as B is an h-set. module _ {f : A → B} - (isSetB : isSet B) + (isSetB : isSet B) where module _ @@ -160,9 +160,9 @@ injective→hasPropFibers : hasPropFibers f injective→hasPropFibers y (x , fx≡y) (x' , fx'≡y) = - Σ≡Prop + Σ≡Prop (λ _ → isSetB _ _) - (inj (fx≡y ∙ sym (fx'≡y))) + (inj (fx≡y ∙ sym (fx'≡y))) injEmbedding : isEmbedding f injEmbedding = hasPropFibers→isEmbedding injective→hasPropFibers @@ -171,10 +171,10 @@ retractableIntoSet→isEmbedding (g , ret) = injEmbedding inj where inj : f w ≡ f x → w ≡ x - inj {w = w} {x = x} p = sym (ret w) ∙∙ cong g p ∙∙ ret x + inj {w = w} {x = x} p = sym (ret w) ∙∙ cong g p ∙∙ ret x isEquiv→hasPropFibers : isEquiv f → hasPropFibers f -isEquiv→hasPropFibers e b = isContr→isProp (equiv-proof e b) +isEquiv→hasPropFibers e b = isContr→isProp (equiv-proof e b) isEquiv→isEmbedding : isEquiv f → isEmbedding f isEquiv→isEmbedding e = λ _ _ → congEquiv (_ , e) .snd @@ -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/docs/Cubical.Functions.Fibration.html b/docs/Cubical.Functions.Fibration.html index 2222516..513e5d4 100644 --- a/docs/Cubical.Functions.Fibration.html +++ b/docs/Cubical.Functions.Fibration.html @@ -25,23 +25,23 @@ p = fst fwd : fiber p x → p⁻¹ x - fwd ((x' , y) , q) = subst (λ z → p⁻¹ z) q y + fwd ((x' , y) , q) = subst (λ z → p⁻¹ z) q y bwd : p⁻¹ x → fiber p x bwd y = (x , y) , refl fwd-bwd : ∀ x → fwd (bwd x) ≡ x - fwd-bwd y = transportRefl y + fwd-bwd y = transportRefl y bwd-fwd : ∀ x → bwd (fwd x) ≡ x bwd-fwd ((x' , y) , q) i = h (r i) - where h : Σ[ s ∈ singl x ] p⁻¹ (s .fst) → fiber p x + where h : Σ[ s ∈ singl x ] p⁻¹ (s .fst) → fiber p x h ((x , p) , y) = (x , y) , sym p - r : Path (Σ[ s ∈ singl x ] p⁻¹ (s .fst)) - ((x , refl ) , subst p⁻¹ q y) + r : Path (Σ[ s ∈ singl x ] p⁻¹ (s .fst)) + ((x , refl ) , subst p⁻¹ q y) ((x' , sym q) , y ) - r = ΣPathP (isContrSingl x .snd (x' , sym q) - , toPathP (transport⁻Transport (λ i → p⁻¹ (q i)) y)) + r = ΣPathP (isContrSingl x .snd (x' , sym q) + , toPathP (transport⁻Transport (λ i → p⁻¹ (q i)) y)) -- HoTT Lemma 4.8.1 fiberEquiv : fiber p x ≃ p⁻¹ x @@ -75,7 +75,7 @@ where e = totalEquiv p -module ForSets {E : Type ℓ} {isSetB : isSet B} (f : E → B) where +module ForSets {E : Type ℓ} {isSetB : isSet B} (f : E → B) where module _ {x x'} {px : x ≡ x'} {a' : fiber f x} {b' : fiber f x'} where -- fibers are equal when their representatives are equal fibersEqIfRepsEq : fst a' ≡ fst b' @@ -90,20 +90,20 @@ fiberPath : ∀ {ℓ ℓ'} {A : Type ℓ} {B : Type ℓ'} {f : A → B} {b : B} (h h' : fiber f b) → (Σ[ p ∈ (fst h ≡ fst h') ] (PathP (λ i → f (p i) ≡ b) (snd h) (snd h'))) - ≡ fiber (cong f) (h .snd ∙∙ refl ∙∙ sym (h' .snd)) -fiberPath h h' = cong (Σ (h .fst ≡ h' .fst)) (funExt λ p → flipSquarePath ∙ PathP≡doubleCompPathʳ _ _ _ _) + ≡ fiber (cong f) (h .snd ∙∙ refl ∙∙ sym (h' .snd)) +fiberPath h h' = cong (Σ (h .fst ≡ h' .fst)) (funExt λ p → flipSquarePath ∙ PathP≡doubleCompPathʳ _ _ _ _) fiber≡ : ∀ {ℓ ℓ'} {A : Type ℓ} {B : Type ℓ'} {f : A → B} {b : B} (h h' : fiber f b) - → (h ≡ h') ≡ fiber (cong f) (h .snd ∙∙ refl ∙∙ sym (h' .snd)) + → (h ≡ h') ≡ fiber (cong f) (h .snd ∙∙ refl ∙∙ sym (h' .snd)) fiber≡ {f = f} {b = b} h h' = - ΣPath≡PathΣ ⁻¹ ∙ + ΣPath≡PathΣ ⁻¹ ∙ fiberPath h h' fiberCong : ∀ {ℓ ℓ'} {A : Type ℓ} {B : Type ℓ'} (f : A → B) {a₀ a₁ : A} (q : f a₀ ≡ f a₁) → fiber (cong f) q ≡ Path (fiber f (f a₁)) (a₀ , q) (a₁ , refl) fiberCong f q = cong (fiber (cong f)) (cong sym (lUnit (sym q))) - ∙ sym (fiber≡ (_ , q) (_ , refl)) + ∙ sym (fiber≡ (_ , q) (_ , refl)) FibrationStr : (B : Type ℓb) → Type ℓ → Type (ℓ-max ℓ ℓb) FibrationStr B A = A → B diff --git a/docs/Cubical.Functions.Fixpoint.html b/docs/Cubical.Functions.Fixpoint.html index a6e74b2..2547317 100644 --- a/docs/Cubical.Functions.Fixpoint.html +++ b/docs/Cubical.Functions.Fixpoint.html @@ -26,20 +26,20 @@ -- Kraus' lemma -- a version not using cubical features can be found at -- https://www.cs.bham.ac.uk/~mhe/GeneralizedHedberg/html/GeneralizedHedberg.html#21576 -2-Constant→isPropFixpoint : (f : A → A) → 2-Constant f → isProp (Fixpoint f) +2-Constant→isPropFixpoint : (f : A → A) → 2-Constant f → isProp (Fixpoint f) 2-Constant→isPropFixpoint f fconst (x , p) (y , q) i = s i , t i where noose : ∀ x y → f x ≡ f y - noose x y = sym (fconst x x) ∙ fconst x y + noose x y = sym (fconst x x) ∙ fconst x y -- the main idea is that for any path p, cong f p does not depend on p -- but only on its endpoints and the structure of 2-Constant f KrausInsight : ∀ {x y} → (p : x ≡ y) → noose x y ≡ cong f p - KrausInsight {x} = J (λ y p → noose x y ≡ cong f p) (lCancel (fconst x x)) + KrausInsight {x} = J (λ y p → noose x y ≡ cong f p) (lCancel (fconst x x)) -- Need to solve for a path s : x ≡ y, such that: -- transport (λ i → cong f s i ≡ s i) p ≡ q s : x ≡ y - s = sym p ∙∙ noose x y ∙∙ q + s = sym p ∙∙ noose x y ∙∙ q t' : PathP (λ i → noose x y i ≡ s i) p q - t' i j = doubleCompPath-filler (sym p) (noose x y) q j i + t' i j = doubleCompPath-filler (sym p) (noose x y) q j i t : PathP (λ i → cong f s i ≡ s i) p q - t = subst (λ kraus → PathP (λ i → kraus i ≡ s i) p q) (KrausInsight s) t' + t = subst (λ kraus → PathP (λ i → kraus i ≡ s i) p q) (KrausInsight s) t' \ No newline at end of file diff --git a/docs/Cubical.Functions.FunExtEquiv.html b/docs/Cubical.Functions.FunExtEquiv.html index 327a0c6..6a35705 100644 --- a/docs/Cubical.Functions.FunExtEquiv.html +++ b/docs/Cubical.Functions.FunExtEquiv.html @@ -24,13 +24,13 @@ {f : (x : A) → B x i0} {g : (x : A) → B x i1} where funExtEquiv : (∀ x → PathP (B x) (f x) (g x)) ≃ PathP (λ i → ∀ x → B x i) f g - unquoteDef funExtEquiv = defStrictEquiv funExtEquiv funExt funExt⁻ + unquoteDef funExtEquiv = defStrictEquiv funExtEquiv funExt funExt⁻ funExtPath : (∀ x → PathP (B x) (f x) (g x)) ≡ PathP (λ i → ∀ x → B x i) f g funExtPath = ua funExtEquiv funExtIso : Iso (∀ x → PathP (B x) (f x) (g x)) (PathP (λ i → ∀ x → B x i) f g) - funExtIso = iso funExt funExt⁻ (λ x → refl {x = x}) (λ x → refl {x = x}) + funExtIso = iso funExt funExt⁻ (λ x → refl {x = x}) (λ x → refl {x = x}) -- Function extensionality for binary functions funExt₂ : {A : Type ℓ} {B : A → Type ℓ₁} {C : (x : A) → B x → I → Type ℓ₂} @@ -168,28 +168,28 @@ lemi→i : PathP (λ m → lemi→j i m ≡ p i) (coei→i A i (p i)) refl lemi→i = sym (coei→i (λ k → coei→j A i k (p i) ≡ p k) i (coei→i A i (p i))) - ◁ λ m k → lemi→j i (m ∨ k) + ◁ λ m k → lemi→j i (m ∨ k) heteroHomotopy≃Homotopy : {A : I → Type ℓ} {B : (i : I) → Type ℓ₁} {f : A i0 → B i0} {g : A i1 → B i1} → ({x₀ : A i0} {x₁ : A i1} → PathP A x₀ x₁ → PathP B (f x₀) (g x₁)) - ≃ ((x₀ : A i0) → PathP B (f x₀) (g (transport (λ i → A i) x₀))) + ≃ ((x₀ : A i0) → PathP B (f x₀) (g (transport (λ i → A i) x₀))) heteroHomotopy≃Homotopy {A = A} {B} {f} {g} = isoToEquiv isom where open Iso isom : Iso _ _ - isom .fun h x₀ = h (isContrSinglP A x₀ .fst .snd) + isom .fun h x₀ = h (isContrSinglP A x₀ .fst .snd) isom .inv k {x₀} {x₁} p = - subst (λ fib → PathP B (f x₀) (g (fib .fst))) (isContrSinglP A x₀ .snd (x₁ , p)) (k x₀) - isom .rightInv k = funExt λ x₀ → - cong (λ α → subst (λ fib → PathP B (f x₀) (g (fib .fst))) α (k x₀)) - (isProp→isSet isPropSinglP (isContrSinglP A x₀ .fst) _ - (isContrSinglP A x₀ .snd (isContrSinglP A x₀ .fst)) + subst (λ fib → PathP B (f x₀) (g (fib .fst))) (isContrSinglP A x₀ .snd (x₁ , p)) (k x₀) + isom .rightInv k = funExt λ x₀ → + cong (λ α → subst (λ fib → PathP B (f x₀) (g (fib .fst))) α (k x₀)) + (isProp→isSet isPropSinglP (isContrSinglP A x₀ .fst) _ + (isContrSinglP A x₀ .snd (isContrSinglP A x₀ .fst)) refl) - ∙ transportRefl (k x₀) + ∙ transportRefl (k x₀) isom .leftInv h j {x₀} {x₁} p = transp - (λ i → PathP B (f x₀) (g (isContrSinglP A x₀ .snd (x₁ , p) (i ∨ j) .fst))) + (λ i → PathP B (f x₀) (g (isContrSinglP A x₀ .snd (x₁ , p) (i ∨ j) .fst))) j - (h (isContrSinglP A x₀ .snd (x₁ , p) j .snd)) + (h (isContrSinglP A x₀ .snd (x₁ , p) j .snd)) \ No newline at end of file diff --git a/docs/Cubical.Functions.Logic.html b/docs/Cubical.Functions.Logic.html index cc02d7f..72bb66a 100644 --- a/docs/Cubical.Functions.Logic.html +++ b/docs/Cubical.Functions.Logic.html @@ -66,38 +66,38 @@ _≡ₚ_ : (x y : A) → hProp _ x ≡ₚ y = ∥ x ≡ y ∥ₚ -hProp≡ : ⟨ P ⟩ ≡ ⟨ Q ⟩ → P ≡ Q +hProp≡ : ⟨ P ⟩ ≡ ⟨ Q ⟩ → P ≡ Q hProp≡ = TypeOfHLevel≡ 1 -isProp⟨⟩ : (A : hProp ℓ) → isProp ⟨ A ⟩ +isProp⟨⟩ : (A : hProp ℓ) → isProp ⟨ A ⟩ isProp⟨⟩ = snd -------------------------------------------------------------------------------- -- Logical implication of mere propositions _⇒_ : (A : hProp ℓ) → (B : hProp ℓ') → hProp _ -A ⇒ B = (⟨ A ⟩ → ⟨ B ⟩) , isPropΠ λ _ → isProp⟨⟩ B +A ⇒ B = (⟨ A ⟩ → ⟨ B ⟩) , isPropΠ λ _ → isProp⟨⟩ B -⇔toPath : ⟨ P ⇒ Q ⟩ → ⟨ Q ⇒ P ⟩ → P ≡ Q +⇔toPath : ⟨ P ⇒ Q ⟩ → ⟨ Q ⇒ P ⟩ → P ≡ Q ⇔toPath {P = P} {Q = Q} P⇒Q Q⇒P = hProp≡ (hPropExt (isProp⟨⟩ P) (isProp⟨⟩ Q) P⇒Q Q⇒P) -pathTo⇒ : P ≡ Q → ⟨ P ⇒ Q ⟩ -pathTo⇒ p x = subst fst p x +pathTo⇒ : P ≡ Q → ⟨ P ⇒ Q ⟩ +pathTo⇒ p x = subst fst p x -pathTo⇐ : P ≡ Q → ⟨ Q ⇒ P ⟩ -pathTo⇐ p x = subst fst (sym p) x +pathTo⇐ : P ≡ Q → ⟨ Q ⇒ P ⟩ +pathTo⇐ p x = subst fst (sym p) x -substₚ : {x y : A} (B : A → hProp ℓ) → ⟨ x ≡ₚ y ⇒ B x ⇒ B y ⟩ -substₚ {x = x} {y = y} B = PropTrunc.elim (λ _ → isPropΠ λ _ → isProp⟨⟩ (B y)) (subst (fst ∘ B)) +substₚ : {x y : A} (B : A → hProp ℓ) → ⟨ x ≡ₚ y ⇒ B x ⇒ B y ⟩ +substₚ {x = x} {y = y} B = PropTrunc.elim (λ _ → isPropΠ λ _ → isProp⟨⟩ (B y)) (subst (fst ∘ B)) -------------------------------------------------------------------------------- -- Mixfix notations for ⇔-toPath -- see ⊔-identityˡ and ⊔-identityʳ for the difference -⇒∶_⇐∶_ : ⟨ P ⇒ Q ⟩ → ⟨ Q ⇒ P ⟩ → P ≡ Q +⇒∶_⇐∶_ : ⟨ P ⇒ Q ⟩ → ⟨ Q ⇒ P ⟩ → P ≡ Q ⇒∶_⇐∶_ = ⇔toPath -⇐∶_⇒∶_ : ⟨ Q ⇒ P ⟩ → ⟨ P ⇒ Q ⟩ → P ≡ Q +⇐∶_⇒∶_ : ⟨ Q ⇒ P ⟩ → ⟨ P ⇒ Q ⟩ → P ≡ Q ⇐∶ g ⇒∶ f = ⇔toPath f g -------------------------------------------------------------------------------- -- False and True @@ -112,7 +112,7 @@ -- Pseudo-complement of mere propositions ¬_ : hProp ℓ → hProp _ -¬ A = (⟨ A ⟩ → ⊥.⊥) , isPropΠ λ _ → ⊥.isProp⊥ +¬ A = (⟨ A ⟩ → ⊥.⊥) , isPropΠ λ _ → ⊥.isProp⊥ _≢ₚ_ : (x y : A) → hProp _ x ≢ₚ y = ¬ x ≡ₚ y @@ -124,7 +124,7 @@ A ⊔′ B = ∥ A ⊎ B ∥₁ _⊔_ : hProp ℓ → hProp ℓ' → hProp _ -P ⊔ Q = ∥ ⟨ P ⟩ ⊎ ⟨ Q ⟩ ∥ₚ +P ⊔ Q = ∥ ⟨ P ⟩ ⊎ ⟨ Q ⟩ ∥ₚ inl : A → A ⊔′ B inl x = ∣ ⊎.inl x ∣₁ @@ -132,8 +132,8 @@ inr : B → A ⊔′ B inr x = ∣ ⊎.inr x ∣₁ -⊔-elim : (P : hProp ℓ) (Q : hProp ℓ') (R : ⟨ P ⊔ Q ⟩ → hProp ℓ'') - → (∀ x → ⟨ R (inl x) ⟩) → (∀ y → ⟨ R (inr y) ⟩) → (∀ z → ⟨ R z ⟩) +⊔-elim : (P : hProp ℓ) (Q : hProp ℓ') (R : ⟨ P ⊔ Q ⟩ → hProp ℓ'') + → (∀ x → ⟨ R (inl x) ⟩) → (∀ y → ⟨ R (inr y) ⟩) → (∀ z → ⟨ R z ⟩) ⊔-elim _ _ R P⇒R Q⇒R = PropTrunc.elim (snd ∘ R) (⊎.elim P⇒R Q⇒R) -------------------------------------------------------------------------------- @@ -142,10 +142,10 @@ A ⊓′ B = A × B _⊓_ : hProp ℓ → hProp ℓ' → hProp _ -A ⊓ B = ⟨ A ⟩ ⊓′ ⟨ B ⟩ , isOfHLevelΣ 1 (isProp⟨⟩ A) (\ _ → isProp⟨⟩ B) +A ⊓ B = ⟨ A ⟩ ⊓′ ⟨ B ⟩ , isOfHLevelΣ 1 (isProp⟨⟩ A) (\ _ → isProp⟨⟩ B) -⊓-intro : (P : hProp ℓ) (Q : ⟨ P ⟩ → hProp ℓ') (R : ⟨ P ⟩ → hProp ℓ'') - → (∀ a → ⟨ Q a ⟩) → (∀ a → ⟨ R a ⟩) → (∀ (a : ⟨ P ⟩) → ⟨ Q a ⊓ R a ⟩ ) +⊓-intro : (P : hProp ℓ) (Q : ⟨ P ⟩ → hProp ℓ') (R : ⟨ P ⟩ → hProp ℓ'') + → (∀ a → ⟨ Q a ⟩) → (∀ a → ⟨ R a ⟩) → (∀ (a : ⟨ P ⟩) → ⟨ Q a ⊓ R a ⟩ ) ⊓-intro _ _ _ = \ f g a → f a , g a -------------------------------------------------------------------------------- @@ -154,18 +154,18 @@ _⇔_ : hProp ℓ → hProp ℓ' → hProp _ A ⇔ B = (A ⇒ B) ⊓ (B ⇒ A) -⇔-id : (P : hProp ℓ) → ⟨ P ⇔ P ⟩ -⇔-id P = (idfun ⟨ P ⟩) , (idfun ⟨ P ⟩) +⇔-id : (P : hProp ℓ) → ⟨ P ⇔ P ⟩ +⇔-id P = (idfun ⟨ P ⟩) , (idfun ⟨ P ⟩) -------------------------------------------------------------------------------- -- Universal Quantifier ∀[∶]-syntax : (A → hProp ℓ) → hProp _ -∀[∶]-syntax {A = A} P = (∀ x → ⟨ P x ⟩) , isPropΠ (isProp⟨⟩ ∘ P) +∀[∶]-syntax {A = A} P = (∀ x → ⟨ P x ⟩) , isPropΠ (isProp⟨⟩ ∘ P) ∀[]-syntax : (A → hProp ℓ) → hProp _ -∀[]-syntax {A = A} P = (∀ x → ⟨ P x ⟩) , isPropΠ (isProp⟨⟩ ∘ P) +∀[]-syntax {A = A} P = (∀ x → ⟨ P x ⟩) , isPropΠ (isProp⟨⟩ ∘ P) syntax ∀[∶]-syntax {A = A} (λ a → P) = ∀[ a ∶ A ] P syntax ∀[]-syntax (λ a → P) = ∀[ a ] P @@ -174,10 +174,10 @@ -- Existential Quantifier ∃[]-syntax : (A → hProp ℓ) → hProp _ -∃[]-syntax {A = A} P = ∥ Σ A (⟨_⟩ ∘ P) ∥ₚ +∃[]-syntax {A = A} P = ∥ Σ A (⟨_⟩ ∘ P) ∥ₚ ∃[∶]-syntax : (A → hProp ℓ) → hProp _ -∃[∶]-syntax {A = A} P = ∥ Σ A (⟨_⟩ ∘ P) ∥ₚ +∃[∶]-syntax {A = A} P = ∥ Σ A (⟨_⟩ ∘ P) ∥ₚ syntax ∃[∶]-syntax {A = A} (λ x → P) = ∃[ x ∶ A ] P syntax ∃[]-syntax (λ x → P) = ∃[ x ] P @@ -186,7 +186,7 @@ -- Decidable mere proposition Decₚ : (P : hProp ℓ) → hProp ℓ -Decₚ P = Dec ⟨ P ⟩ , isPropDec (isProp⟨⟩ P) +Decₚ P = Dec ⟨ P ⟩ , isPropDec (isProp⟨⟩ P) -------------------------------------------------------------------------------- -- Negation commutes with truncation diff --git a/docs/Cubical.Functions.Surjection.html b/docs/Cubical.Functions.Surjection.html index caff5e9..57e6c65 100644 --- a/docs/Cubical.Functions.Surjection.html +++ b/docs/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/docs/Cubical.HITs.PropositionalTruncation.MagicTrick.html b/docs/Cubical.HITs.PropositionalTruncation.MagicTrick.html index 78d8144..8463f4c 100644 --- a/docs/Cubical.HITs.PropositionalTruncation.MagicTrick.html +++ b/docs/Cubical.HITs.PropositionalTruncation.MagicTrick.html @@ -27,11 +27,11 @@ module Recover {ℓ} (A∙ : Pointed ℓ) (h : isHomogeneous A∙) where private - A = typ A∙ + A = typ A∙ a = pt A∙ toEquivPtd : ∥ A ∥₁ → Σ[ B∙ ∈ Pointed ℓ ] (A , a) ≡ B∙ - toEquivPtd = rec isPropSingl (λ x → (A , x) , h x) + toEquivPtd = rec isPropSingl (λ x → (A , x) , h x) private B∙ : ∥ A ∥₁ → Pointed ℓ B∙ tx = fst (toEquivPtd tx) @@ -43,7 +43,7 @@ -- thus any truncated element (of a homogeneous type) can be recovered by agda's normalizer! - recover : ∀ (tx : ∥ A ∥₁) → typ (B∙ tx) + recover : ∀ (tx : ∥ A ∥₁) → typ (B∙ tx) recover tx = pt (B∙ tx) recover∣∣ : ∀ (x : A) → recover ∣ x ∣₁ ≡ x @@ -59,7 +59,7 @@ -- one might wonder if (cong recover (squash₁ ∣ x ∣₁ ∣ y ∣₁)) therefore has type x ≡ y, but thankfully -- typ (B∙ (squash₁ ∣ x ∣₁ ∣ y ∣₁ i)) is *not* A (it's a messy hcomp involving h x and h y) recover-squash₁ : ∀ x y → -- x ≡ y -- this raises an error - PathP (λ i → typ (B∙ (squash₁ ∣ x ∣₁ ∣ y ∣₁ i))) x y + PathP (λ i → typ (B∙ (squash₁ ∣ x ∣₁ ∣ y ∣₁ i))) x y recover-squash₁ x y = cong recover (squash₁ ∣ x ∣₁ ∣ y ∣₁) diff --git a/docs/Cubical.HITs.PropositionalTruncation.Monad.html b/docs/Cubical.HITs.PropositionalTruncation.Monad.html index 3211a8b..aa8b455 100644 --- a/docs/Cubical.HITs.PropositionalTruncation.Monad.html +++ b/docs/Cubical.HITs.PropositionalTruncation.Monad.html @@ -18,7 +18,7 @@ P Q : Type ℓ infix 1 proof_by_ -proof_by_ : (P : hProp ℓ) → ∥ ⟨ P ⟩ ∥₁ → ⟨ P ⟩ +proof_by_ : (P : hProp ℓ) → ∥ ⟨ P ⟩ ∥₁ → ⟨ P ⟩ proof P by p = rec (isProp⟨⟩ P) (λ p → p) p return : P → ∥ P ∥₁ diff --git a/docs/Cubical.HITs.PropositionalTruncation.Properties.html b/docs/Cubical.HITs.PropositionalTruncation.Properties.html index bac77cf..a8df38e 100644 --- a/docs/Cubical.HITs.PropositionalTruncation.Properties.html +++ b/docs/Cubical.HITs.PropositionalTruncation.Properties.html @@ -34,16 +34,16 @@ ∥∥-isPropDep : (P : A → Type ℓ) → isOfHLevelDep 1 (λ x → ∥ P x ∥₁) ∥∥-isPropDep P = isOfHLevel→isOfHLevelDep 1 (λ _ → squash₁) -rec : {P : Type ℓ} → isProp P → (A → P) → ∥ A ∥₁ → P +rec : {P : Type ℓ} → isProp P → (A → P) → ∥ A ∥₁ → P rec Pprop f ∣ x ∣₁ = f x rec Pprop f (squash₁ x y i) = Pprop (rec Pprop f x) (rec Pprop f y) i -rec2 : {P : Type ℓ} → isProp P → (A → B → P) → ∥ A ∥₁ → ∥ B ∥₁ → P +rec2 : {P : Type ℓ} → isProp P → (A → B → P) → ∥ A ∥₁ → ∥ B ∥₁ → P rec2 Pprop f ∣ x ∣₁ ∣ y ∣₁ = f x y rec2 Pprop f ∣ x ∣₁ (squash₁ y z i) = Pprop (rec2 Pprop f ∣ x ∣₁ y) (rec2 Pprop f ∣ x ∣₁ z) i rec2 Pprop f (squash₁ x y i) z = Pprop (rec2 Pprop f x z) (rec2 Pprop f y z) i -rec3 : {P : Type ℓ} → isProp P → (A → B → C → P) → ∥ A ∥₁ → ∥ B ∥₁ → ∥ C ∥₁ → P +rec3 : {P : Type ℓ} → isProp P → (A → B → C → P) → ∥ A ∥₁ → ∥ B ∥₁ → ∥ C ∥₁ → P rec3 Pprop f ∣ x ∣₁ ∣ y ∣₁ ∣ z ∣₁ = f x y z rec3 Pprop f ∣ x ∣₁ ∣ y ∣₁ (squash₁ z w i) = Pprop (rec3 Pprop f ∣ x ∣₁ ∣ y ∣₁ z) (rec3 Pprop f ∣ x ∣₁ ∣ y ∣₁ w) i rec3 Pprop f ∣ x ∣₁ (squash₁ y z i) w = Pprop (rec3 Pprop f ∣ x ∣₁ y w) (rec3 Pprop f ∣ x ∣₁ z w) i @@ -55,7 +55,7 @@ -- n-ary recursor, stated using a dependent FinVec recFin : {m : ℕ} {P : Fin m → Type ℓ} - {B : Type ℓ'} (isPropB : isProp B) + {B : Type ℓ'} (isPropB : isProp B) → ((∀ i → P i) → B) --------------------- → ((∀ i → ∥ P i ∥₁) → B) @@ -71,7 +71,7 @@ curriedishTrunc = rec (isProp→ isPropB) curriedish recFin2 : {m1 m2 : ℕ} {P : Fin m1 → Fin m2 → Type ℓ} - {B : Type ℓ'} (isPropB : isProp B) + {B : Type ℓ'} (isPropB : isProp B) → ((∀ i j → P i j) → B) -------------------------- → (∀ i j → ∥ P i j ∥₁) @@ -89,7 +89,7 @@ curriedishTrunc = recFin (isProp→ isPropB) curriedish -elim : {P : ∥ A ∥₁ → Type ℓ} → ((a : ∥ A ∥₁) → isProp (P a)) +elim : {P : ∥ A ∥₁ → Type ℓ} → ((a : ∥ A ∥₁) → isProp (P a)) → ((x : A) → P ∣ x ∣₁) → (a : ∥ A ∥₁) → P a elim Pprop f ∣ x ∣₁ = f x elim Pprop f (squash₁ x y i) = @@ -97,7 +97,7 @@ (elim Pprop f x) (elim Pprop f y) (squash₁ x y) i elim2 : {P : ∥ A ∥₁ → ∥ B ∥₁ → Type ℓ} - (Pprop : (x : ∥ A ∥₁) (y : ∥ B ∥₁) → isProp (P x y)) + (Pprop : (x : ∥ A ∥₁) (y : ∥ B ∥₁) → isProp (P x y)) (f : (a : A) (b : B) → P ∣ a ∣₁ ∣ b ∣₁) (x : ∥ A ∥₁) (y : ∥ B ∥₁) → P x y elim2 Pprop f = @@ -105,7 +105,7 @@ (λ a → elim (λ _ → Pprop _ _) (f a)) elim3 : {P : ∥ A ∥₁ → ∥ B ∥₁ → ∥ C ∥₁ → Type ℓ} - (Pprop : ((x : ∥ A ∥₁) (y : ∥ B ∥₁) (z : ∥ C ∥₁) → isProp (P x y z))) + (Pprop : ((x : ∥ A ∥₁) (y : ∥ B ∥₁) (z : ∥ C ∥₁) → isProp (P x y z))) (g : (a : A) (b : B) (c : C) → P (∣ a ∣₁) ∣ b ∣₁ ∣ c ∣₁) (x : ∥ A ∥₁) (y : ∥ B ∥₁) (z : ∥ C ∥₁) → P x y z elim3 Pprop g = elim2 (λ _ _ → isPropΠ (λ _ → Pprop _ _ _)) @@ -114,29 +114,29 @@ -- n-ary eliminator, stated using a dependent FinVec elimFin : {m : ℕ} {P : Fin m → Type ℓ} {B : (∀ i → ∥ P i ∥₁) → Type ℓ'} - (isPropB : ∀ x → isProp (B x)) + (isPropB : ∀ x → isProp (B x)) → ((x : ∀ i → P i) → B (λ i → ∣ x i ∣₁)) ---------------------------------------- → ((x : ∀ i → ∥ P i ∥₁) → B x) -elimFin {m = zero} {B = B} _ untruncHyp _ = subst B (funExt (λ ())) (untruncHyp (λ ())) +elimFin {m = zero} {B = B} _ untruncHyp _ = subst B (funExt (λ ())) (untruncHyp (λ ())) elimFin {m = suc m} {P = P} {B = B} isPropB untruncHyp x = - subst B (funExt (λ { zero → refl ; (suc i) → refl})) + subst B (funExt (λ { zero → refl ; (suc i) → refl})) (curriedishTrunc (x zero) (x ∘ suc)) where curriedish : (x₀ : P zero) (xₛ : ∀ i → ∥ P (suc i) ∥₁) → B (λ { zero → ∣ x₀ ∣₁ ; (suc i) → xₛ i}) - curriedish x₀ xₛ = subst B (funExt (λ { zero → refl ; (suc i) → refl})) + curriedish x₀ xₛ = subst B (funExt (λ { zero → refl ; (suc i) → refl})) (elimFin (λ xₛ → isPropB (λ { zero → ∣ x₀ ∣₁ ; (suc i) → xₛ i})) - (λ y → subst B (funExt (λ { zero → refl ; (suc i) → refl})) + (λ y → subst B (funExt (λ { zero → refl ; (suc i) → refl})) (untruncHyp (λ { zero → x₀ ; (suc i) → y i }))) xₛ) curriedishTrunc : (x₀ : ∥ P zero ∥₁) (xₛ : ∀ i → ∥ P (suc i) ∥₁) → B (λ { zero → x₀ ; (suc i) → xₛ i}) curriedishTrunc = elim (λ _ → isPropΠ λ _ → isPropB _) - λ x₀ xₛ → subst B (funExt (λ { zero → refl ; (suc i) → refl})) + λ x₀ xₛ → subst B (funExt (λ { zero → refl ; (suc i) → refl})) (curriedish x₀ xₛ) -isPropPropTrunc : isProp ∥ A ∥₁ +isPropPropTrunc : isProp ∥ A ∥₁ isPropPropTrunc x y = squash₁ x y propTrunc≃ : A ≃ B → ∥ A ∥₁ ≃ ∥ B ∥₁ @@ -146,20 +146,20 @@ (rec isPropPropTrunc (λ a → ∣ e .fst a ∣₁)) (rec isPropPropTrunc (λ b → ∣ invEq e b ∣₁)) -propTruncIdempotent≃ : isProp A → ∥ A ∥₁ ≃ A +propTruncIdempotent≃ : isProp A → ∥ A ∥₁ ≃ A propTruncIdempotent≃ {A = A} hA = isoToEquiv f where f : Iso ∥ A ∥₁ A Iso.fun f = rec hA (idfun A) Iso.inv f x = ∣ x ∣₁ Iso.rightInv f _ = refl - Iso.leftInv f = elim (λ _ → isProp→isSet isPropPropTrunc _ _) (λ _ → refl) + Iso.leftInv f = elim (λ _ → isProp→isSet isPropPropTrunc _ _) (λ _ → refl) -propTruncIdempotent : isProp A → ∥ A ∥₁ ≡ A +propTruncIdempotent : isProp A → ∥ A ∥₁ ≡ A propTruncIdempotent hA = ua (propTruncIdempotent≃ hA) -- We could also define the eliminator using the recursor -elim' : {P : ∥ A ∥₁ → Type ℓ} → ((a : ∥ A ∥₁) → isProp (P a)) → +elim' : {P : ∥ A ∥₁ → Type ℓ} → ((a : ∥ A ∥₁) → isProp (P a)) → ((x : A) → P ∣ x ∣₁) → (a : ∥ A ∥₁) → P a elim' {P = P} Pprop f a = rec (Pprop a) (λ x → transp (λ i → P (squash₁ ∣ x ∣₁ a i)) i0 (f x)) a @@ -175,9 +175,9 @@ -- constant.' The details of this can be found in the following paper: -- -- https://arxiv.org/pdf/1411.2682.pdf -module SetElim (Bset : isSet B) where - Bset' : isSet' B - Bset' = isSet→isSet' Bset +module SetElim (Bset : isSet B) where + Bset' : isSet' B + Bset' = isSet→isSet' Bset rec→Set : (f : A → B) (kf : 2-Constant f) → ∥ A ∥₁ → B helper : (f : A → B) (kf : 2-Constant f) → (t u : ∥ A ∥₁) @@ -195,11 +195,11 @@ kcomp : (f : ∥ A ∥₁ → B) → 2-Constant (f ∘ ∣_∣₁) kcomp f x y = cong f (squash₁ ∣ x ∣₁ ∣ y ∣₁) - Fset : isSet (A → B) + Fset : isSet (A → B) Fset = isSetΠ (const Bset) - Kset : (f : A → B) → isSet (2-Constant f) - Kset f = isSetΠ (λ _ → isSetΠ (λ _ → isProp→isSet (Bset _ _))) + Kset : (f : A → B) → isSet (2-Constant f) + Kset f = isSetΠ (λ _ → isSetΠ (λ _ → isProp→isSet (Bset _ _))) setRecLemma : (f : ∥ A ∥₁ → B) @@ -216,8 +216,8 @@ eqv : (g : Σ (A → B) 2-Constant) → ∀ fi → fib g ≡ fi eqv g (f , p) = - Σ≡Prop (λ f → isOfHLevelΣ 2 Fset Kset _ _) - (cong (uncurry rec→Set) (sym p) ∙ setRecLemma f) + Σ≡Prop (λ f → isOfHLevelΣ 2 Fset Kset _ _) + (cong (uncurry rec→Set) (sym p) ∙ setRecLemma f) trunc→Set≃ : (∥ A ∥₁ → B) ≃ (Σ (A → B) 2-Constant) trunc→Set≃ .fst = mkKmap @@ -266,7 +266,7 @@ elim→Set : {P : ∥ A ∥₁ → Type ℓ} - → (∀ t → isSet (P t)) + → (∀ t → isSet (P t)) → (f : (x : A) → P ∣ x ∣₁) → (kf : ∀ x y → PathP (λ i → P (squash₁ ∣ x ∣₁ ∣ y ∣₁ i)) (f x) (f y)) → (t : ∥ A ∥₁) → P t @@ -281,11 +281,11 @@ elim2→Set : {P : ∥ A ∥₁ → ∥ B ∥₁ → Type ℓ} - → (∀ t u → isSet (P t u)) + → (∀ t u → isSet (P t u)) → (f : (x : A) (y : B) → P ∣ x ∣₁ ∣ y ∣₁) → (kf₁ : ∀ x y v → PathP (λ i → P (squash₁ ∣ x ∣₁ ∣ y ∣₁ i) ∣ v ∣₁) (f x v) (f y v)) → (kf₂ : ∀ x v w → PathP (λ i → P ∣ x ∣₁ (squash₁ ∣ v ∣₁ ∣ w ∣₁ i)) (f x v) (f x w)) - → (sf : ∀ x y v w → SquareP (λ i j → P (squash₁ ∣ x ∣₁ ∣ y ∣₁ i) (squash₁ ∣ v ∣₁ ∣ w ∣₁ j)) + → (sf : ∀ x y v w → SquareP (λ i j → P (squash₁ ∣ x ∣₁ ∣ y ∣₁ i) (squash₁ ∣ v ∣₁ ∣ w ∣₁ j)) (kf₂ x v w) (kf₂ y v w) (kf₁ x y v) (kf₁ x y w)) → (t : ∥ A ∥₁) → (u : ∥ B ∥₁) → P t u elim2→Set {A = A} {B = B} {P = P} Pset f kf₁ kf₂ sf = @@ -301,8 +301,8 @@ RecHProp : (P : A → hProp ℓ) (kP : ∀ x y → P x ≡ P y) → ∥ A ∥₁ → hProp ℓ RecHProp P kP = rec→Set isSetHProp P kP -module GpdElim (Bgpd : isGroupoid B) where - Bgpd' : isGroupoid' B +module GpdElim (Bgpd : isGroupoid B) where + Bgpd' : isGroupoid' B Bgpd' = isGroupoid→isGroupoid' Bgpd module _ (f : A → B) (3kf : 3-Constant f) where @@ -312,10 +312,10 @@ pathHelper : (t u : ∥ A ∥₁) → rec→Gpd t ≡ rec→Gpd u triHelper₁ : (t u v : ∥ A ∥₁) - → Square (pathHelper t u) (pathHelper t v) refl (pathHelper u v) + → Square (pathHelper t u) (pathHelper t v) refl (pathHelper u v) triHelper₂ : (t u v : ∥ A ∥₁) - → Square (pathHelper t v) (pathHelper u v) (pathHelper t u) refl + → Square (pathHelper t v) (pathHelper u v) (pathHelper t u) refl rec→Gpd ∣ x ∣₁ = f x rec→Gpd (squash₁ t u i) = pathHelper t u i @@ -448,16 +448,16 @@ squash₁ᵗ : ∀(x y z : A) - → Square (squash₁ ∣ x ∣₁ ∣ y ∣₁) (squash₁ ∣ x ∣₁ ∣ z ∣₁) refl (squash₁ ∣ y ∣₁ ∣ z ∣₁) + → Square (squash₁ ∣ x ∣₁ ∣ y ∣₁) (squash₁ ∣ x ∣₁ ∣ z ∣₁) refl (squash₁ ∣ y ∣₁ ∣ z ∣₁) squash₁ᵗ x y z i = squash₁ ∣ x ∣₁ (squash₁ ∣ y ∣₁ ∣ z ∣₁ i) elim→Gpd : (P : ∥ A ∥₁ → Type ℓ) - → (∀ t → isGroupoid (P t)) + → (∀ t → isGroupoid (P t)) → (f : (x : A) → P ∣ x ∣₁) → (kf : ∀ x y → PathP (λ i → P (squash₁ ∣ x ∣₁ ∣ y ∣₁ i)) (f x) (f y)) → (3kf : ∀ x y z - → SquareP (λ i j → P (squash₁ᵗ x y z i j)) (kf x y) (kf x z) refl (kf y z)) + → SquareP (λ i j → P (squash₁ᵗ x y z i j)) (kf x y) (kf x z) refl (kf y z)) → (t : ∥ A ∥₁) → P t elim→Gpd {A = A} P Pgpd f kf 3kf t = rec→Gpd (Pgpd t) g 3kg t where @@ -510,9 +510,9 @@ ∥∥-IdempotentR-⊎ = ua ∥∥-IdempotentR-⊎-≃ ∥∥-Idempotent-⊎ : {A : Type ℓ} {A′ : Type ℓ'} → ∥ ∥ A ∥₁ ⊎ ∥ A′ ∥₁ ∥₁ ≡ ∥ A ⊎ A′ ∥₁ -∥∥-Idempotent-⊎ {A = A} {A′} = ∥ ∥ A ∥₁ ⊎ ∥ A′ ∥₁ ∥₁ ≡⟨ ∥∥-IdempotentR-⊎ ⟩ - ∥ ∥ A ∥₁ ⊎ A′ ∥₁ ≡⟨ ∥∥-IdempotentL-⊎ ⟩ - ∥ A ⊎ A′ ∥₁ ∎ +∥∥-Idempotent-⊎ {A = A} {A′} = ∥ ∥ A ∥₁ ⊎ ∥ A′ ∥₁ ∥₁ ≡⟨ ∥∥-IdempotentR-⊎ ⟩ + ∥ ∥ A ∥₁ ⊎ A′ ∥₁ ≡⟨ ∥∥-IdempotentL-⊎ ⟩ + ∥ A ⊎ A′ ∥₁ ∎ ∥∥-IdempotentL-×-≃ : ∥ ∥ A ∥₁ × A′ ∥₁ ≃ ∥ A × A′ ∥₁ ∥∥-IdempotentL-×-≃ = isoToEquiv ∥∥-IdempotentL-×-Iso @@ -545,9 +545,9 @@ ∥∥-IdempotentR-× = ua ∥∥-IdempotentR-×-≃ ∥∥-Idempotent-× : {A : Type ℓ} {A′ : Type ℓ'} → ∥ ∥ A ∥₁ × ∥ A′ ∥₁ ∥₁ ≡ ∥ A × A′ ∥₁ -∥∥-Idempotent-× {A = A} {A′} = ∥ ∥ A ∥₁ × ∥ A′ ∥₁ ∥₁ ≡⟨ ∥∥-IdempotentR-× ⟩ - ∥ ∥ A ∥₁ × A′ ∥₁ ≡⟨ ∥∥-IdempotentL-× ⟩ - ∥ A × A′ ∥₁ ∎ +∥∥-Idempotent-× {A = A} {A′} = ∥ ∥ A ∥₁ × ∥ A′ ∥₁ ∥₁ ≡⟨ ∥∥-IdempotentR-× ⟩ + ∥ ∥ A ∥₁ × A′ ∥₁ ≡⟨ ∥∥-IdempotentL-× ⟩ + ∥ A × A′ ∥₁ ∎ ∥∥-Idempotent-×-≃ : {A : Type ℓ} {A′ : Type ℓ'} → ∥ ∥ A ∥₁ × ∥ A′ ∥₁ ∥₁ ≃ ∥ A × A′ ∥₁ ∥∥-Idempotent-×-≃ {A = A} {A′} = compEquiv ∥∥-IdempotentR-×-≃ ∥∥-IdempotentL-×-≃ @@ -559,7 +559,7 @@ ∥∥-× = ua ∥∥-×-≃ -- using this we get a convenient recursor/eliminator for binary functions into sets -rec2→Set : {A B C : Type ℓ} (Cset : isSet C) +rec2→Set : {A B C : Type ℓ} (Cset : isSet C) → (f : A → B → C) → (∀ (a a' : A) (b b' : B) → f a b ≡ f a' b') → ∥ A ∥₁ → ∥ B ∥₁ → C diff --git a/docs/Cubical.HITs.SetCoequalizer.Properties.html b/docs/Cubical.HITs.SetCoequalizer.Properties.html index edf9bb1..59efbd6 100644 --- a/docs/Cubical.HITs.SetCoequalizer.Properties.html +++ b/docs/Cubical.HITs.SetCoequalizer.Properties.html @@ -24,21 +24,21 @@ -- Some helpful lemmas, similar to those in Cubical/HITs/SetQuotients/Properties.agda elimProp : {f g : A → B} {C : SetCoequalizer f g → Type ℓ} - → (Cprop : (x : SetCoequalizer f g) → isProp (C x)) + → (Cprop : (x : SetCoequalizer f g) → isProp (C x)) → (Cinc : (b : B) → C (inc b)) → (x : SetCoequalizer f g) → C x elimProp Cprop Cinc (inc x) = Cinc x elimProp {f = f} {g = g} Cprop Cinc (coeq a i) = - isProp→PathP (λ i → Cprop (coeq a i)) (Cinc (f a)) (Cinc (g a)) i + isProp→PathP (λ i → Cprop (coeq a i)) (Cinc (f a)) (Cinc (g a)) i elimProp Cprop Cinc (squash x y p q i j) = isOfHLevel→isOfHLevelDep - 2 (λ x → isProp→isSet (Cprop x)) (g x) (g y) (cong g p) (cong g q) (squash x y p q) i j + 2 (λ x → isProp→isSet (Cprop x)) (g x) (g y) (cong g p) (cong g q) (squash x y p q) i j where g = elimProp Cprop Cinc elimProp2 : {A' : Type ℓ} {B' : Type ℓ'} {f g : A → B} {f' g' : A' → B'} {C : SetCoequalizer f g → SetCoequalizer f' g' → Type (ℓ-max ℓ ℓ')} - → (Cprop : (x : SetCoequalizer f g) → (y : SetCoequalizer f' g') → isProp (C x y)) + → (Cprop : (x : SetCoequalizer f g) → (y : SetCoequalizer f' g') → isProp (C x y)) → (Cinc : (b : B) → (b' : B') → C (inc b) (inc b')) → (x : SetCoequalizer f g) → (y : SetCoequalizer f' g') → C x y elimProp2 Cprop Cinc = elimProp (λ x → isPropΠ (λ y → Cprop x y)) @@ -51,7 +51,7 @@ → (Cprop : (x : SetCoequalizer f g) → (y : SetCoequalizer f' g') → (z : SetCoequalizer f'' g'') - → isProp (C x y z)) + → isProp (C x y z)) → (Cinc : (b : B) → (b' : B') → (b'' : B'') → C (inc b) (inc b') (inc b'')) → (x : SetCoequalizer f g) → (y : SetCoequalizer f' g') → (z : SetCoequalizer f'' g'') → C x y z @@ -79,7 +79,7 @@ rec (isSetΠ (λ _ → Cset)) (λ b → rec Cset (λ b' → h b b') (λ a' → hcoeqsr a' b)) - (λ a → funExt (elimProp (λ _ → Cset _ _) (λ b' → hcoeqsl a b'))) + (λ a → funExt (elimProp (λ _ → Cset _ _) (λ b' → hcoeqsl a b'))) module UniversalProperty where {- The proof of the universal property of the coequalizer of sets. @@ -119,7 +119,7 @@ where q : (x : SetCoequalizer f g) → i x ≡ inducedHom Cset h hcoeq x q = elimProp (λ _ → Cset _ _) - (λ b → i (inc b) ≡⟨ sym (icommutativity b) ⟩ - h b ≡⟨ refl ⟩ - inducedHom Cset h hcoeq (inc b) ∎) + (λ b → i (inc b) ≡⟨ sym (icommutativity b) ⟩ + h b ≡⟨ refl ⟩ + inducedHom Cset h hcoeq (inc b) ∎) \ No newline at end of file diff --git a/docs/Cubical.Homotopy.Base.html b/docs/Cubical.Homotopy.Base.html index cf1cbc7..4a4d4a4 100644 --- a/docs/Cubical.Homotopy.Base.html +++ b/docs/Cubical.Homotopy.Base.html @@ -14,7 +14,7 @@ _∼_ {X = X} f g = (x : X) → f x ≡ g x funExt∼ : {X : Type ℓ} {Y : X → Type ℓ'} {f g : (x : X) → Y x} (H : f ∼ g) → f ≡ g -funExt∼ = funExt +funExt∼ = funExt ∼-refl : {X : Type ℓ} {Y : X → Type ℓ'} {f : (x : X) → Y x} → f ∼ f ∼-refl {f = f} = λ x → refl {x = f x} diff --git a/docs/Cubical.Induction.WellFounded.html b/docs/Cubical.Induction.WellFounded.html index 98f35e4..e1736d8 100644 --- a/docs/Cubical.Induction.WellFounded.html +++ b/docs/Cubical.Induction.WellFounded.html @@ -20,7 +20,7 @@ module _ {ℓ ℓ'} {A : Type ℓ} {_<_ : A → A → Type ℓ'} where - isPropAcc : ∀ x → isProp (Acc _<_ x) + isPropAcc : ∀ x → isProp (Acc _<_ x) isPropAcc x (acc p) (acc q) = λ i → acc (λ y y<x → isPropAcc y (p y y<x) (q y y<x) i) diff --git a/docs/Cubical.Relation.Binary.Base.html b/docs/Cubical.Relation.Binary.Base.html index 8245d73..a7ffc73 100644 --- a/docs/Cubical.Relation.Binary.Base.html +++ b/docs/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/docs/Cubical.Relation.Binary.Properties.html b/docs/Cubical.Relation.Binary.Properties.html index 05807ee..0e3bca3 100644 --- a/docs/Cubical.Relation.Binary.Properties.html +++ b/docs/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/docs/Cubical.Relation.Nullary.Properties.html b/docs/Cubical.Relation.Nullary.Properties.html index 5faa773..2479982 100644 --- a/docs/Cubical.Relation.Nullary.Properties.html +++ b/docs/Cubical.Relation.Nullary.Properties.html @@ -17,165 +17,189 @@ open import Cubical.Functions.Fixpoint open import Cubical.Data.Empty as ⊥ - -open import Cubical.Relation.Nullary.Base -open import Cubical.HITs.PropositionalTruncation.Base - -private - variable - ℓ : Level - A B : Type ℓ - --- Functions with a section preserve discreteness. -sectionDiscrete - : (f : A → B) (g : B → A) → section f g → Discrete A → Discrete B -sectionDiscrete f g sect dA x y with dA (g x) (g y) -... | yes p = yes (sym (sect x) ∙∙ cong f p ∙∙ sect y) -... | no ¬p = no (λ p → ¬p (cong g p)) - -isoPresDiscrete : Iso A B → Discrete A → Discrete B -isoPresDiscrete e = sectionDiscrete fun inv rightInv - where open Iso e - -EquivPresDiscrete : ∀ {ℓ ℓ'}{A : Type ℓ} {B : Type ℓ'} → A ≃ B - → Discrete A → Discrete B -EquivPresDiscrete e = isoPresDiscrete (equivToIso e) - -isProp¬ : (A : Type ℓ) → isProp (¬ A) -isProp¬ A p q i x = isProp⊥ (p x) (q x) i - -Stable¬ : Stable (¬ A) -Stable¬ ¬¬¬a a = ¬¬¬a ¬¬a - where - ¬¬a = λ ¬a → ¬a a - -fromYes : A → Dec A → A -fromYes _ (yes a) = a -fromYes a (no _) = a - -discreteDec : (Adis : Discrete A) → Discrete (Dec A) -discreteDec Adis (yes p) (yes p') = decideYes (Adis p p') -- TODO: monad would simply stuff - where - decideYes : Dec (p ≡ p') → Dec (yes p ≡ yes p') - decideYes (yes eq) = yes (cong yes eq) - decideYes (no ¬eq) = no λ eq → ¬eq (cong (fromYes p) eq) -discreteDec Adis (yes p) (no ¬p) = ⊥.rec (¬p p) -discreteDec Adis (no ¬p) (yes p) = ⊥.rec (¬p p) -discreteDec {A = A} Adis (no ¬p) (no ¬p') = yes (cong no (isProp¬ A ¬p ¬p')) - -isPropDec : (Aprop : isProp A) → isProp (Dec A) -isPropDec Aprop (yes a) (yes a') = cong yes (Aprop a a') -isPropDec Aprop (yes a) (no ¬a) = ⊥.rec (¬a a) -isPropDec Aprop (no ¬a) (yes a) = ⊥.rec (¬a a) -isPropDec {A = A} Aprop (no ¬a) (no ¬a') = cong no (isProp¬ A ¬a ¬a') - -mapDec : ∀ {B : Type ℓ} → (A → B) → (¬ A → ¬ B) → Dec A → Dec B -mapDec f _ (yes p) = yes (f p) -mapDec _ f (no ¬p) = no (f ¬p) - -EquivPresDec : ∀ {ℓ ℓ'}{A : Type ℓ} {B : Type ℓ'} → A ≃ B - → Dec A → Dec B -EquivPresDec p = mapDec (p .fst) (λ f → f ∘ invEq p) - -¬→¬∥∥ : ¬ A → ¬ ∥ A ∥₁ -¬→¬∥∥ ¬p ∣ a ∣₁ = ¬p a -¬→¬∥∥ ¬p (squash₁ x y i) = isProp⊥ (¬→¬∥∥ ¬p x) (¬→¬∥∥ ¬p y) i - -Dec∥∥ : Dec A → Dec ∥ A ∥₁ -Dec∥∥ = mapDec ∣_∣₁ ¬→¬∥∥ - --- we have the following implications --- X ── ∣_∣ ─→ ∥ X ∥ --- ∥ X ∥ ── populatedBy ─→ ⟪ X ⟫ --- ⟪ X ⟫ ── notEmptyPopulated ─→ NonEmpty X - --- reexport propositional truncation for uniformity -open Cubical.HITs.PropositionalTruncation.Base - -populatedBy : ∥ A ∥₁ → ⟪ A ⟫ -populatedBy {A = A} a (f , fIsConst) = h a where - h : ∥ A ∥₁ → Fixpoint f - h ∣ a ∣₁ = f a , fIsConst (f a) a - h (squash₁ a b i) = 2-Constant→isPropFixpoint f fIsConst (h a) (h b) i - -notEmptyPopulated : ⟪ A ⟫ → NonEmpty A -notEmptyPopulated {A = A} pop u = u (fixpoint (pop (h , hIsConst))) where - h : A → A - h a = ⊥.elim (u a) - hIsConst : ∀ x y → h x ≡ h y - hIsConst x y i = ⊥.elim (isProp⊥ (u x) (u y) i) - --- these implications induce the following for different kinds of stability, gradually weakening the assumption -Dec→Stable : Dec A → Stable A -Dec→Stable (yes x) = λ _ → x -Dec→Stable (no x) = λ f → ⊥.elim (f x) - -Stable→PStable : Stable A → PStable A -Stable→PStable st = st ∘ notEmptyPopulated - -PStable→SplitSupport : PStable A → SplitSupport A -PStable→SplitSupport pst = pst ∘ populatedBy - --- Although SplitSupport and Collapsible are not properties, their path versions, HSeparated and Collapsible≡, are. --- Nevertheless they are logically equivalent -SplitSupport→Collapsible : SplitSupport A → Collapsible A -SplitSupport→Collapsible {A = A} hst = h , hIsConst where - h : A → A - h p = hst ∣ p ∣₁ - hIsConst : 2-Constant h - hIsConst p q i = hst (squash₁ ∣ p ∣₁ ∣ q ∣₁ i) - -Collapsible→SplitSupport : Collapsible A → SplitSupport A -Collapsible→SplitSupport f x = fixpoint (populatedBy x f) - -HSeparated→Collapsible≡ : HSeparated A → Collapsible≡ A -HSeparated→Collapsible≡ hst x y = SplitSupport→Collapsible (hst x y) - -Collapsible≡→HSeparated : Collapsible≡ A → HSeparated A -Collapsible≡→HSeparated col x y = Collapsible→SplitSupport (col x y) - --- stability of path space under truncation or path collapsability are necessary and sufficient properties --- for a a type to be a set. -Collapsible≡→isSet : Collapsible≡ A → isSet A -Collapsible≡→isSet {A = A} col a b p q = p≡q where - f : (x : A) → a ≡ x → a ≡ x - f x = col a x .fst - fIsConst : (x : A) → (p q : a ≡ x) → f x p ≡ f x q - fIsConst x = col a x .snd - rem : (p : a ≡ b) → PathP (λ i → a ≡ p i) (f a refl) (f b p) - rem p j = f (p j) (λ i → p (i ∧ j)) - p≡q : p ≡ q - p≡q j i = hcomp (λ k → λ { (i = i0) → f a refl k - ; (i = i1) → fIsConst b p q j k - ; (j = i0) → rem p i k - ; (j = i1) → rem q i k }) a - -HSeparated→isSet : HSeparated A → isSet A -HSeparated→isSet = Collapsible≡→isSet ∘ HSeparated→Collapsible≡ - -isSet→HSeparated : isSet A → HSeparated A -isSet→HSeparated setA x y = extract where - extract : ∥ x ≡ y ∥₁ → x ≡ y - extract ∣ p ∣₁ = p - extract (squash₁ p q i) = setA x y (extract p) (extract q) i - --- by the above more sufficient conditions to inhibit isSet A are given -PStable≡→HSeparated : PStable≡ A → HSeparated A -PStable≡→HSeparated pst x y = PStable→SplitSupport (pst x y) - -PStable≡→isSet : PStable≡ A → isSet A -PStable≡→isSet = HSeparated→isSet ∘ PStable≡→HSeparated - -Separated→PStable≡ : Separated A → PStable≡ A -Separated→PStable≡ st x y = Stable→PStable (st x y) - -Separated→isSet : Separated A → isSet A -Separated→isSet = PStable≡→isSet ∘ Separated→PStable≡ - --- Proof of Hedberg's theorem: a type with decidable equality is an h-set -Discrete→Separated : Discrete A → Separated A -Discrete→Separated d x y = Dec→Stable (d x y) - -Discrete→isSet : Discrete A → isSet A -Discrete→isSet = Separated→isSet ∘ Discrete→Separated +open import Cubical.Data.Sigma.Base using (_×_) + +open import Cubical.Relation.Nullary.Base +open import Cubical.HITs.PropositionalTruncation.Base + +private + variable + ℓ : Level + A B : Type ℓ + P : A -> Type ℓ + +-- Functions with a section preserve discreteness. +sectionDiscrete + : (f : A → B) (g : B → A) → section f g → Discrete A → Discrete B +sectionDiscrete f g sect dA x y with dA (g x) (g y) +... | yes p = yes (sym (sect x) ∙∙ cong f p ∙∙ sect y) +... | no ¬p = no (λ p → ¬p (cong g p)) + +isoPresDiscrete : Iso A B → Discrete A → Discrete B +isoPresDiscrete e = sectionDiscrete fun inv rightInv + where open Iso e + +EquivPresDiscrete : ∀ {ℓ ℓ'}{A : Type ℓ} {B : Type ℓ'} → A ≃ B + → Discrete A → Discrete B +EquivPresDiscrete e = isoPresDiscrete (equivToIso e) + +isProp¬ : (A : Type ℓ) → isProp (¬ A) +isProp¬ A p q i x = isProp⊥ (p x) (q x) i + +Stable¬ : Stable (¬ A) +Stable¬ ¬¬¬a a = ¬¬¬a ¬¬a + where + ¬¬a = λ ¬a → ¬a a + +StableΠ : (∀ x → Stable (P x)) -> Stable (∀ x → P x) +StableΠ Ps e x = Ps x λ k → e λ f → k (f x) + +Stable→ : Stable B → Stable (A → B) +Stable→ Bs = StableΠ (λ _ → Bs) + +Stable× : Stable A -> Stable B -> Stable (A × B) +Stable× As Bs e = λ where + .fst → As λ k → e (k ∘ fst) + .snd → Bs λ k → e (k ∘ snd) + +fromYes : A → Dec A → A +fromYes _ (yes a) = a +fromYes a (no _) = a + +discreteDec : (Adis : Discrete A) → Discrete (Dec A) +discreteDec Adis (yes p) (yes p') = decideYes (Adis p p') -- TODO: monad would simply stuff + where + decideYes : Dec (p ≡ p') → Dec (yes p ≡ yes p') + decideYes (yes eq) = yes (cong yes eq) + decideYes (no ¬eq) = no λ eq → ¬eq (cong (fromYes p) eq) +discreteDec Adis (yes p) (no ¬p) = ⊥.rec (¬p p) +discreteDec Adis (no ¬p) (yes p) = ⊥.rec (¬p p) +discreteDec {A = A} Adis (no ¬p) (no ¬p') = yes (cong no (isProp¬ A ¬p ¬p')) + +isPropDec : (Aprop : isProp A) → isProp (Dec A) +isPropDec Aprop (yes a) (yes a') = cong yes (Aprop a a') +isPropDec Aprop (yes a) (no ¬a) = ⊥.rec (¬a a) +isPropDec Aprop (no ¬a) (yes a) = ⊥.rec (¬a a) +isPropDec {A = A} Aprop (no ¬a) (no ¬a') = cong no (isProp¬ A ¬a ¬a') + +mapDec : ∀ {B : Type ℓ} → (A → B) → (¬ A → ¬ B) → Dec A → Dec B +mapDec f _ (yes p) = yes (f p) +mapDec _ f (no ¬p) = no (f ¬p) + +EquivPresDec : ∀ {ℓ ℓ'}{A : Type ℓ} {B : Type ℓ'} → A ≃ B + → Dec A → Dec B +EquivPresDec p = mapDec (p .fst) (λ f → f ∘ invEq p) + +¬→¬∥∥ : ¬ A → ¬ ∥ A ∥₁ +¬→¬∥∥ ¬p ∣ a ∣₁ = ¬p a +¬→¬∥∥ ¬p (squash₁ x y i) = isProp⊥ (¬→¬∥∥ ¬p x) (¬→¬∥∥ ¬p y) i + +Dec∥∥ : Dec A → Dec ∥ A ∥₁ +Dec∥∥ = mapDec ∣_∣₁ ¬→¬∥∥ + +-- we have the following implications +-- X ── ∣_∣ ─→ ∥ X ∥ +-- ∥ X ∥ ── populatedBy ─→ ⟪ X ⟫ +-- ⟪ X ⟫ ── notEmptyPopulated ─→ NonEmpty X + +-- reexport propositional truncation for uniformity +open Cubical.HITs.PropositionalTruncation.Base + +populatedBy : ∥ A ∥₁ → ⟪ A ⟫ +populatedBy {A = A} a (f , fIsConst) = h a where + h : ∥ A ∥₁ → Fixpoint f + h ∣ a ∣₁ = f a , fIsConst (f a) a + h (squash₁ a b i) = 2-Constant→isPropFixpoint f fIsConst (h a) (h b) i + +notEmptyPopulated : ⟪ A ⟫ → NonEmpty A +notEmptyPopulated {A = A} pop u = u (fixpoint (pop (h , hIsConst))) where + h : A → A + h a = ⊥.elim (u a) + hIsConst : ∀ x y → h x ≡ h y + hIsConst x y i = ⊥.elim (isProp⊥ (u x) (u y) i) + +-- these implications induce the following for different kinds of stability, gradually weakening the assumption +Dec→Stable : Dec A → Stable A +Dec→Stable (yes x) = λ _ → x +Dec→Stable (no x) = λ f → ⊥.elim (f x) + +Stable→PStable : Stable A → PStable A +Stable→PStable st = st ∘ notEmptyPopulated + +PStable→SplitSupport : PStable A → SplitSupport A +PStable→SplitSupport pst = pst ∘ populatedBy + +-- Although SplitSupport and Collapsible are not properties, their path versions, HSeparated and Collapsible≡, are. +-- Nevertheless they are logically equivalent +SplitSupport→Collapsible : SplitSupport A → Collapsible A +SplitSupport→Collapsible {A = A} hst = h , hIsConst where + h : A → A + h p = hst ∣ p ∣₁ + hIsConst : 2-Constant h + hIsConst p q i = hst (squash₁ ∣ p ∣₁ ∣ q ∣₁ i) + +Collapsible→SplitSupport : Collapsible A → SplitSupport A +Collapsible→SplitSupport f x = fixpoint (populatedBy x f) + +HSeparated→Collapsible≡ : HSeparated A → Collapsible≡ A +HSeparated→Collapsible≡ hst x y = SplitSupport→Collapsible (hst x y) + +Collapsible≡→HSeparated : Collapsible≡ A → HSeparated A +Collapsible≡→HSeparated col x y = Collapsible→SplitSupport (col x y) + +-- stability of path space under truncation or path collapsability are necessary and sufficient properties +-- for a a type to be a set. +Collapsible≡→isSet : Collapsible≡ A → isSet A +Collapsible≡→isSet {A = A} col a b p q = p≡q where + f : (x : A) → a ≡ x → a ≡ x + f x = col a x .fst + fIsConst : (x : A) → (p q : a ≡ x) → f x p ≡ f x q + fIsConst x = col a x .snd + rem : (p : a ≡ b) → PathP (λ i → a ≡ p i) (f a refl) (f b p) + rem p j = f (p j) (λ i → p (i ∧ j)) + p≡q : p ≡ q + p≡q j i = hcomp (λ k → λ { (i = i0) → f a refl k + ; (i = i1) → fIsConst b p q j k + ; (j = i0) → rem p i k + ; (j = i1) → rem q i k }) a + +HSeparated→isSet : HSeparated A → isSet A +HSeparated→isSet = Collapsible≡→isSet ∘ HSeparated→Collapsible≡ + +isSet→HSeparated : isSet A → HSeparated A +isSet→HSeparated setA x y = extract where + extract : ∥ x ≡ y ∥₁ → x ≡ y + extract ∣ p ∣₁ = p + extract (squash₁ p q i) = setA x y (extract p) (extract q) i + +-- by the above more sufficient conditions to inhibit isSet A are given +PStable≡→HSeparated : PStable≡ A → HSeparated A +PStable≡→HSeparated pst x y = PStable→SplitSupport (pst x y) + +PStable≡→isSet : PStable≡ A → isSet A +PStable≡→isSet = HSeparated→isSet ∘ PStable≡→HSeparated + +Separated→PStable≡ : Separated A → PStable≡ A +Separated→PStable≡ st x y = Stable→PStable (st x y) + +Separated→isSet : Separated A → isSet A +Separated→isSet = PStable≡→isSet ∘ Separated→PStable≡ + +SeparatedΠ : (∀ x → Separated (P x)) -> Separated ((x : A) -> P x) +SeparatedΠ Ps f g e i x = Ps x (f x) (g x) (λ k → e (k ∘ cong (λ f → f x))) i + +Separated→ : Separated B -> Separated (A → B) +Separated→ Bs = SeparatedΠ (λ _ → Bs) + +Separated× : Separated A -> Separated B -> Separated (A × B) +Separated× As Bs p q e i = λ where + .fst → As (fst p) (fst q) (λ k → e λ r → k (cong fst r)) i + .snd → Bs (snd p) (snd q) (λ k → e λ r → k (cong snd r)) i + +-- Proof of Hedberg's theorem: a type with decidable equality is an h-set +Discrete→Separated : Discrete A → Separated A +Discrete→Separated d x y = Dec→Stable (d x y) + +Discrete→isSet : Discrete A → isSet A +Discrete→isSet = Separated→isSet ∘ Discrete→Separated \ No newline at end of file diff --git a/docs/Cubical.Structures.Axioms.html b/docs/Cubical.Structures.Axioms.html index 09f7156..c3bbfea 100644 --- a/docs/Cubical.Structures.Axioms.html +++ b/docs/Cubical.Structures.Axioms.html @@ -28,44 +28,44 @@ → Type ℓ → Type (ℓ-max ℓ₁ ℓ₂) AxiomsStructure S axioms X = Σ[ s ∈ S X ] (axioms X s) -AxiomsEquivStr : {S : Type ℓ → Type ℓ₁} (ι : StrEquiv S ℓ₁') +AxiomsEquivStr : {S : Type ℓ → Type ℓ₁} (ι : StrEquiv S ℓ₁') (axioms : (X : Type ℓ) → S X → Type ℓ₂) - → StrEquiv (AxiomsStructure S axioms) ℓ₁' + → StrEquiv (AxiomsStructure S axioms) ℓ₁' AxiomsEquivStr ι axioms (X , (s , a)) (Y , (t , b)) e = ι (X , s) (Y , t) e axiomsUnivalentStr : {S : Type ℓ → Type ℓ₁} - (ι : (A B : TypeWithStr ℓ S) → A .fst ≃ B .fst → Type ℓ₁') + (ι : (A B : TypeWithStr ℓ S) → A .fst ≃ B .fst → Type ℓ₁') {axioms : (X : Type ℓ) → S X → Type ℓ₂} - (axioms-are-Props : (X : Type ℓ) (s : S X) → isProp (axioms X s)) + (axioms-are-Props : (X : Type ℓ) (s : S X) → isProp (axioms X s)) (θ : UnivalentStr S ι) → UnivalentStr (AxiomsStructure S axioms) (AxiomsEquivStr ι axioms) axiomsUnivalentStr {S = S} ι {axioms = axioms} axioms-are-Props θ {X , s , a} {Y , t , b} e = ι (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) ■ inducedStructure : {S : Type ℓ → Type ℓ₁} - {ι : (A B : TypeWithStr ℓ S) → A .fst ≃ B .fst → Type ℓ₁'} + {ι : (A B : TypeWithStr ℓ S) → A .fst ≃ B .fst → Type ℓ₁'} (θ : UnivalentStr S ι) {axioms : (X : Type ℓ) → S X → Type ℓ₂} - (A : TypeWithStr ℓ (AxiomsStructure S axioms)) (B : TypeWithStr ℓ S) - → (typ A , str A .fst) ≃[ ι ] B - → TypeWithStr ℓ (AxiomsStructure S axioms) + (A : TypeWithStr ℓ (AxiomsStructure S axioms)) (B : TypeWithStr ℓ S) + → (typ A , str A .fst) ≃[ ι ] B + → TypeWithStr ℓ (AxiomsStructure S axioms) inducedStructure θ {axioms} A B eqv = - B .fst , B .snd , subst (uncurry axioms) (sip θ _ _ eqv) (A .snd .snd) + B .fst , B .snd , subst (uncurry axioms) (sip θ _ _ eqv) (A .snd .snd) transferAxioms : {S : Type ℓ → Type ℓ₁} - {ι : (A B : TypeWithStr ℓ S) → A .fst ≃ B .fst → Type ℓ₁'} + {ι : (A B : TypeWithStr ℓ S) → A .fst ≃ B .fst → Type ℓ₁'} (θ : UnivalentStr S ι) {axioms : (X : Type ℓ) → S X → Type ℓ₂} - (A : TypeWithStr ℓ (AxiomsStructure S axioms)) (B : TypeWithStr ℓ S) - → (typ A , str A .fst) ≃[ ι ] B + (A : TypeWithStr ℓ (AxiomsStructure S axioms)) (B : TypeWithStr ℓ S) + → (typ A , str A .fst) ≃[ ι ] B → axioms (fst B) (snd B) transferAxioms θ {axioms} A B eqv = - subst (uncurry axioms) (sip θ _ _ eqv) (A .snd .snd) + subst (uncurry axioms) (sip θ _ _ eqv) (A .snd .snd) \ No newline at end of file diff --git a/docs/Cubical.Structures.Pointed.html b/docs/Cubical.Structures.Pointed.html index c22c1bb..1261ca3 100644 --- a/docs/Cubical.Structures.Pointed.html +++ b/docs/Cubical.Structures.Pointed.html @@ -24,7 +24,7 @@ PointedStructure : Type ℓ → Type ℓ PointedStructure X = X -PointedEquivStr : StrEquiv PointedStructure ℓ +PointedEquivStr : StrEquiv PointedStructure ℓ PointedEquivStr A B f = equivFun f (pt A) ≡ pt B pointedUnivalentStr : UnivalentStr {ℓ} PointedStructure PointedEquivStr @@ -53,9 +53,9 @@ pointed-sip⁻-refl : (A : Pointed ℓ) → pointed-sip⁻ A A refl ≡ idEquiv∙ A pointed-sip⁻-refl A = sym (invEq (equivAdjointEquiv (pointedSIP A A)) (pointed-sip-idEquiv∙ A)) -pointedEquivAction : EquivAction {ℓ} PointedStructure +pointedEquivAction : EquivAction {ℓ} PointedStructure pointedEquivAction e = e pointedTransportStr : TransportStr {ℓ} pointedEquivAction -pointedTransportStr e s = sym (transportRefl _) +pointedTransportStr e s = sym (transportRefl _) \ No newline at end of file diff --git a/docs/Realizability.ApplicativeStructure.html b/docs/Realizability.ApplicativeStructure.html index 3d140ad..e3f5c1c 100644 --- a/docs/Realizability.ApplicativeStructure.html +++ b/docs/Realizability.ApplicativeStructure.html @@ -14,7 +14,7 @@ record ApplicativeStructure {ℓ} (A : Type ℓ) : Type ℓ where infixl 20 _⨾_ field - isSetA : isSet A + isSetA : isSet A _⨾_ : A → A → A module _ {ℓ} {A : Type ℓ} (as : ApplicativeStructure A) where diff --git a/docs/Realizability.Assembly.html b/docs/Realizability.Assembly.html index 3044c0c..dc2f500 100644 --- a/docs/Realizability.Assembly.html +++ b/docs/Realizability.Assembly.html @@ -11,546 +11,607 @@ open import Cubical.Data.Sum hiding (map) open import Cubical.HITs.PropositionalTruncation renaming (map to ∥∥map ; map2 to ∥∥map2) open import Cubical.HITs.PropositionalTruncation.Monad -open import Cubical.Relation.Binary -open import Cubical.Categories.Category -open import Cubical.Categories.Limits.Terminal -open import Cubical.Categories.Limits.Initial -open import Cubical.Categories.Limits.BinProduct -open import Cubical.Reflection.RecordEquiv - -open import Realizability.CombinatoryAlgebra - -module Realizability.Assembly {ℓ} {A : Type ℓ} (ca : CombinatoryAlgebra A) where - open CombinatoryAlgebra ca - open Realizability.CombinatoryAlgebra.Combinators ca renaming (i to Id; ia≡a to Ida≡a) - - record Assembly (X : Type ℓ) : Type (ℓ-suc ℓ) where - infix 25 _⊩_ - field - isSetX : isSet X - _⊩_ : A → X → Type ℓ - ⊩isPropValued : ∀ a x → isProp (a ⊩ x) - ⊩surjective : ∀ x → ∃[ a ∈ A ] a ⊩ x - - open Assembly - unitAssembly : Assembly Unit* - unitAssembly .isSetX = isSetUnit* - unitAssembly ._⊩_ a x = Unit* - unitAssembly .⊩isPropValued a x = isPropUnit* - unitAssembly .⊩surjective x = ∣ s ⨾ k ⨾ k , tt* ∣₁ - - emptyAssembly : Assembly ⊥* - emptyAssembly .isSetX = isProp→isSet isProp⊥* - emptyAssembly ._⊩_ a x = ⊥* - emptyAssembly .⊩isPropValued a x = isProp⊥* - emptyAssembly .⊩surjective x = ∣ s ⨾ k ⨾ k , x ∣₁ - - module _ {X Y : Type ℓ} {xs : Assembly X} {ys : Assembly Y} (t : A) (f : X → Y) where +open import Cubical.HITs.SetCoequalizer renaming (rec to setCoequalizerRec ; elimProp to setCoequalizerElimProp) +open import Cubical.Relation.Binary +open import Cubical.Categories.Category +open import Cubical.Categories.Limits.Terminal +open import Cubical.Categories.Limits.Initial +open import Cubical.Categories.Limits.BinProduct +open import Cubical.Categories.Regular.Base +open import Cubical.Reflection.RecordEquiv +open import Cubical.Functions.Surjection + +open import Realizability.CombinatoryAlgebra + +module Realizability.Assembly {ℓ} {A : Type ℓ} (ca : CombinatoryAlgebra A) where + open CombinatoryAlgebra ca + open Realizability.CombinatoryAlgebra.Combinators ca renaming (i to Id; ia≡a to Ida≡a) + + record Assembly (X : Type ℓ) : Type (ℓ-suc ℓ) where + infix 25 _⊩_ + field + isSetX : isSet X + _⊩_ : A → X → Type ℓ + ⊩isPropValued : ∀ a x → isProp (a ⊩ x) + ⊩surjective : ∀ x → ∃[ a ∈ A ] a ⊩ x + + open Assembly + unitAssembly : Assembly Unit* + unitAssembly .isSetX = isSetUnit* + unitAssembly ._⊩_ a x = Unit* + unitAssembly .⊩isPropValued a x = isPropUnit* + unitAssembly .⊩surjective x = ∣ s ⨾ k ⨾ k , tt* ∣₁ + + emptyAssembly : Assembly ⊥* + emptyAssembly .isSetX = isProp→isSet isProp⊥* + emptyAssembly ._⊩_ a x = ⊥* + emptyAssembly .⊩isPropValued a x = isProp⊥* + emptyAssembly .⊩surjective x = ∣ s ⨾ k ⨾ k , x ∣₁ + + module _ {X Y : Type ℓ} {xs : Assembly X} {ys : Assembly Y} (t : A) (f : X → Y) where - tracks : Type ℓ - tracks = ∀ (x : X) (aₓ : A) → (aₓ ⊩X x) → (t ⨾ aₓ) ⊩Y (f x) where - _⊩X_ = xs ._⊩_ - _⊩Y_ = ys ._⊩_ + tracks : Type ℓ + tracks = ∀ (x : X) (aₓ : A) → (aₓ ⊩X x) → (t ⨾ aₓ) ⊩Y (f x) where + _⊩X_ = xs ._⊩_ + _⊩Y_ = ys ._⊩_ - isPropTracks : isProp tracks - isPropTracks = isPropΠ λ x → - isPropΠ λ aₓ → - isPropΠ λ aₓ⊩x → - ys .⊩isPropValued (t ⨾ aₓ) (f x) + isPropTracks : isProp tracks + isPropTracks = isPropΠ λ x → + isPropΠ λ aₓ → + isPropΠ λ aₓ⊩x → + ys .⊩isPropValued (t ⨾ aₓ) (f x) - record AssemblyMorphism {X Y : Type ℓ} (as : Assembly X) (bs : Assembly Y) : Type ℓ where - open Assembly as renaming (_⊩_ to _⊩X_) - open Assembly bs renaming (_⊩_ to _⊩Y_) - field - map : X → Y - tracker : ∃[ t ∈ A ] ((x : X) (aₓ : A) → (aₓ ⊩X x) → (t ⨾ aₓ) ⊩Y (map x)) - open AssemblyMorphism + record AssemblyMorphism {X Y : Type ℓ} (as : Assembly X) (bs : Assembly Y) : Type ℓ where + open Assembly as renaming (_⊩_ to _⊩X_) + open Assembly bs renaming (_⊩_ to _⊩Y_) + field + map : X → Y + tracker : ∃[ t ∈ A ] ((x : X) (aₓ : A) → (aₓ ⊩X x) → (t ⨾ aₓ) ⊩Y (map x)) + open AssemblyMorphism - unquoteDecl AssemblyMorphismIsoΣ = declareRecordIsoΣ AssemblyMorphismIsoΣ (quote AssemblyMorphism) + unquoteDecl AssemblyMorphismIsoΣ = declareRecordIsoΣ AssemblyMorphismIsoΣ (quote AssemblyMorphism) - module _ {X Y : Type ℓ} (xs : Assembly X) (ys : Assembly Y) where + module _ {X Y : Type ℓ} (xs : Assembly X) (ys : Assembly Y) where - AssemblyMorphismΣ : Type ℓ - AssemblyMorphismΣ = Σ[ map ∈ (X → Y) ] ∃[ t ∈ A ] ((x : X) (aₓ : A) → (aₓ ⊩X x) → (t ⨾ aₓ) ⊩Y (map x)) where - _⊩X_ = xs ._⊩_ - _⊩Y_ = ys ._⊩_ - - isSetAssemblyMorphismΣ : isSet AssemblyMorphismΣ - isSetAssemblyMorphismΣ = isSetΣ (isSet→ (ys .isSetX)) (λ map → isProp→isSet squash₁) - - AssemblyMorphism≡Σ = isoToPath (AssemblyMorphismIsoΣ {as = xs} {bs = ys}) - - isSetAssemblyMorphism : isSet (AssemblyMorphism xs ys) - isSetAssemblyMorphism = subst (λ t → isSet t) (sym AssemblyMorphism≡Σ) isSetAssemblyMorphismΣ - - AssemblyMorphismΣ≡ : {X Y : Type ℓ} - {xs : Assembly X} - {ys : Assembly Y} - (f g : AssemblyMorphismΣ xs ys) - → f .fst ≡ g .fst - → f ≡ g - AssemblyMorphismΣ≡ f g = Σ≡Prop λ _ → squash₁ - - module _ {X Y : Type ℓ} - {xs : Assembly X} - {ys : Assembly Y} - (f g : AssemblyMorphism xs ys) where - -- Necessary to please the constraint solver - theIso = AssemblyMorphismIsoΣ {X} {Y} {as = xs} {bs = ys} - thePath = AssemblyMorphismΣ≡ {X = X} {Y = Y} {xs = xs} {ys = ys} - open Iso - AssemblyMorphism≡ : (f .map ≡ g .map) → f ≡ g - AssemblyMorphism≡ fmap≡gmap i = theIso .inv (thePath (theIso .fun f) (theIso .fun g) (fmap≡gmap) i) - - identityMorphism : {X : Type ℓ} (as : Assembly X) → AssemblyMorphism as as - identityMorphism as .map x = x - identityMorphism as .tracker = ∣ Id , (λ x aₓ aₓ⊩x → subst (λ y → (as ⊩ y) x) (sym (Ida≡a aₓ)) aₓ⊩x) ∣₁ - - compositeMorphism : {X Y Z : Type ℓ} {xs : Assembly X} {ys : Assembly Y} {zs : Assembly Z} - → (f : AssemblyMorphism xs ys) - → (g : AssemblyMorphism ys zs) - → AssemblyMorphism xs zs - compositeMorphism f g .map x = g .map (f .map x) - compositeMorphism {X} {Y} {Z} {xs} {ys} {zs} f g .tracker = ∥∥map2 untruncated (f .tracker) (g .tracker) where - open Assembly xs renaming (_⊩_ to _⊩X_) - open Assembly ys renaming (_⊩_ to _⊩Y_) - open Assembly zs renaming (_⊩_ to _⊩Z_) - module _ (fTracker : Σ[ f~ ∈ A ] tracks {xs = xs} {ys = ys} f~ (f .map)) - (gTracker : Σ[ g~ ∈ A ] tracks {xs = ys} {ys = zs} g~ (g .map)) where + AssemblyMorphismΣ : Type ℓ + AssemblyMorphismΣ = Σ[ map ∈ (X → Y) ] ∃[ t ∈ A ] ((x : X) (aₓ : A) → (aₓ ⊩X x) → (t ⨾ aₓ) ⊩Y (map x)) where + _⊩X_ = xs ._⊩_ + _⊩Y_ = ys ._⊩_ + + isSetAssemblyMorphismΣ : isSet AssemblyMorphismΣ + isSetAssemblyMorphismΣ = isSetΣ (isSet→ (ys .isSetX)) (λ map → isProp→isSet squash₁) + + AssemblyMorphism≡Σ = isoToPath (AssemblyMorphismIsoΣ {as = xs} {bs = ys}) + + isSetAssemblyMorphism : isSet (AssemblyMorphism xs ys) + isSetAssemblyMorphism = subst (λ t → isSet t) (sym AssemblyMorphism≡Σ) isSetAssemblyMorphismΣ + + AssemblyMorphismΣ≡ : {X Y : Type ℓ} + {xs : Assembly X} + {ys : Assembly Y} + (f g : AssemblyMorphismΣ xs ys) + → f .fst ≡ g .fst + → f ≡ g + AssemblyMorphismΣ≡ f g = Σ≡Prop λ _ → squash₁ + + module _ {X Y : Type ℓ} + {xs : Assembly X} + {ys : Assembly Y} + (f g : AssemblyMorphism xs ys) where + -- Necessary to please the constraint solver + theIso = AssemblyMorphismIsoΣ {X} {Y} {as = xs} {bs = ys} + thePath = AssemblyMorphismΣ≡ {X = X} {Y = Y} {xs = xs} {ys = ys} + open Iso + AssemblyMorphism≡ : (f .map ≡ g .map) → f ≡ g + AssemblyMorphism≡ fmap≡gmap i = theIso .inv (thePath (theIso .fun f) (theIso .fun g) (fmap≡gmap) i) + + identityMorphism : {X : Type ℓ} (as : Assembly X) → AssemblyMorphism as as + identityMorphism as .map x = x + identityMorphism as .tracker = ∣ Id , (λ x aₓ aₓ⊩x → subst (λ y → (as ⊩ y) x) (sym (Ida≡a aₓ)) aₓ⊩x) ∣₁ + + compositeMorphism : {X Y Z : Type ℓ} {xs : Assembly X} {ys : Assembly Y} {zs : Assembly Z} + → (f : AssemblyMorphism xs ys) + → (g : AssemblyMorphism ys zs) + → AssemblyMorphism xs zs + compositeMorphism f g .map x = g .map (f .map x) + compositeMorphism {X} {Y} {Z} {xs} {ys} {zs} f g .tracker = ∥∥map2 untruncated (f .tracker) (g .tracker) where + open Assembly xs renaming (_⊩_ to _⊩X_) + open Assembly ys renaming (_⊩_ to _⊩Y_) + open Assembly zs renaming (_⊩_ to _⊩Z_) + module _ (fTracker : Σ[ f~ ∈ A ] tracks {xs = xs} {ys = ys} f~ (f .map)) + (gTracker : Σ[ g~ ∈ A ] tracks {xs = ys} {ys = zs} g~ (g .map)) where - f~ = fTracker .fst - f~tracks = fTracker .snd + f~ = fTracker .fst + f~tracks = fTracker .snd - g~ = gTracker .fst - g~tracks = gTracker .snd + g~ = gTracker .fst + g~tracks = gTracker .snd - easierVariant : ∀ x aₓ aₓ⊩x → (g~ ⨾ (f~ ⨾ aₓ)) ⊩Z g .map (f .map x) - easierVariant x aₓ aₓ⊩x = g~tracks (f .map x) (f~ ⨾ aₓ) (f~tracks x aₓ aₓ⊩x) + easierVariant : ∀ x aₓ aₓ⊩x → (g~ ⨾ (f~ ⨾ aₓ)) ⊩Z g .map (f .map x) + easierVariant x aₓ aₓ⊩x = g~tracks (f .map x) (f~ ⨾ aₓ) (f~tracks x aₓ aₓ⊩x) - goal : ∀ (x : X) (aₓ : A) (aₓ⊩x : aₓ ⊩X x) - → (B g~ f~ ⨾ aₓ) ⊩Z (compositeMorphism f g .map x) - goal x aₓ aₓ⊩x = subst (λ y → y ⊩Z g .map (f .map x)) - (sym (Ba≡gfa g~ f~ aₓ)) - (easierVariant x aₓ aₓ⊩x) - - untruncated : Σ[ t ∈ A ] - ((x : X) (aₓ : A) - → aₓ ⊩X x - → (t ⨾ aₓ) ⊩Z (compositeMorphism f g) .map x) - untruncated = B g~ f~ , goal + goal : ∀ (x : X) (aₓ : A) (aₓ⊩x : aₓ ⊩X x) + → (B g~ f~ ⨾ aₓ) ⊩Z (compositeMorphism f g .map x) + goal x aₓ aₓ⊩x = subst (λ y → y ⊩Z g .map (f .map x)) + (sym (Ba≡gfa g~ f~ aₓ)) + (easierVariant x aₓ aₓ⊩x) + + untruncated : Σ[ t ∈ A ] + ((x : X) (aₓ : A) + → aₓ ⊩X x + → (t ⨾ aₓ) ⊩Z (compositeMorphism f g) .map x) + untruncated = B g~ f~ , goal - infixl 23 _⊚_ - _⊚_ : {X Y Z : Type ℓ} → {xs : Assembly X} {ys : Assembly Y} {zs : Assembly Z} - → AssemblyMorphism xs ys - → AssemblyMorphism ys zs - → AssemblyMorphism xs zs - f ⊚ g = compositeMorphism f g - - module _ {X Y : Type ℓ} (xs : Assembly X) (ys : Assembly Y) where - ⊚idL : ∀ (f : AssemblyMorphism xs ys) → identityMorphism xs ⊚ f ≡ f - ⊚idL f = AssemblyMorphism≡ (identityMorphism xs ⊚ f) f (funExt λ x → refl) - - ⊚idR : ∀ (f : AssemblyMorphism ys xs) → f ⊚ identityMorphism xs ≡ f - ⊚idR f = AssemblyMorphism≡ (f ⊚ identityMorphism xs) f (funExt λ x → refl) - - module _ {X Y Z W : Type ℓ} - (xs : Assembly X) - (ys : Assembly Y) - (zs : Assembly Z) - (ws : Assembly W) - (f : AssemblyMorphism xs ys) - (g : AssemblyMorphism ys zs) - (h : AssemblyMorphism zs ws) where - - ⊚assoc : (f ⊚ g) ⊚ h ≡ f ⊚ (g ⊚ h) - ⊚assoc = AssemblyMorphism≡ ((f ⊚ g) ⊚ h) (f ⊚ (g ⊚ h)) (∘-assoc (h .map) (g .map) (f .map)) - open Category + infixl 23 _⊚_ + _⊚_ : {X Y Z : Type ℓ} → {xs : Assembly X} {ys : Assembly Y} {zs : Assembly Z} + → AssemblyMorphism xs ys + → AssemblyMorphism ys zs + → AssemblyMorphism xs zs + f ⊚ g = compositeMorphism f g + + module _ {X Y : Type ℓ} (xs : Assembly X) (ys : Assembly Y) where + ⊚idL : ∀ (f : AssemblyMorphism xs ys) → identityMorphism xs ⊚ f ≡ f + ⊚idL f = AssemblyMorphism≡ (identityMorphism xs ⊚ f) f (funExt λ x → refl) + + ⊚idR : ∀ (f : AssemblyMorphism ys xs) → f ⊚ identityMorphism xs ≡ f + ⊚idR f = AssemblyMorphism≡ (f ⊚ identityMorphism xs) f (funExt λ x → refl) + + module _ {X Y Z W : Type ℓ} + (xs : Assembly X) + (ys : Assembly Y) + (zs : Assembly Z) + (ws : Assembly W) + (f : AssemblyMorphism xs ys) + (g : AssemblyMorphism ys zs) + (h : AssemblyMorphism zs ws) where + + ⊚assoc : (f ⊚ g) ⊚ h ≡ f ⊚ (g ⊚ h) + ⊚assoc = AssemblyMorphism≡ ((f ⊚ g) ⊚ h) (f ⊚ (g ⊚ h)) (∘-assoc (h .map) (g .map) (f .map)) + open Category - ASM : Category (ℓ-suc ℓ) ℓ - ASM .ob = Σ[ X ∈ Type ℓ ] Assembly X - ASM .Hom[_,_] x y = AssemblyMorphism (x .snd) (y .snd) - ASM .id {x} = identityMorphism (x .snd) - ASM ._⋆_ f g = f ⊚ g - ASM .⋆IdL {x} {y} f = ⊚idL (x .snd) (y .snd) f - ASM .⋆IdR {x} {y} f = ⊚idR (y .snd) (x .snd) f - ASM .⋆Assoc {x} {y} {z} {w} f g h = ⊚assoc (x .snd) (y .snd) (z .snd) (w .snd) f g h - ASM .isSetHom {x} {y} f g = isSetAssemblyMorphism (x .snd) (y .snd) f g + ASM : Category (ℓ-suc ℓ) ℓ + ASM .ob = Σ[ X ∈ Type ℓ ] Assembly X + ASM .Hom[_,_] x y = AssemblyMorphism (x .snd) (y .snd) + ASM .id {x} = identityMorphism (x .snd) + ASM ._⋆_ f g = f ⊚ g + ASM .⋆IdL {x} {y} f = ⊚idL (x .snd) (y .snd) f + ASM .⋆IdR {x} {y} f = ⊚idR (y .snd) (x .snd) f + ASM .⋆Assoc {x} {y} {z} {w} f g h = ⊚assoc (x .snd) (y .snd) (z .snd) (w .snd) f g h + ASM .isSetHom {x} {y} f g = isSetAssemblyMorphism (x .snd) (y .snd) f g - -- Some constructions on assemblies - infixl 23 _⊗_ - _⊗_ : {A B : Type ℓ} → Assembly A → Assembly B → Assembly (A × B) - (as ⊗ bs) .isSetX = isSetΣ (as .isSetX) (λ _ → bs .isSetX) - (as ⊗ bs) ._⊩_ r (a , b) = (as ._⊩_ (pr₁ ⨾ r) a) × (bs ._⊩_ (pr₂ ⨾ r) b) - (as ⊗ bs) .⊩isPropValued r (a , b) = isPropΣ (as .⊩isPropValued (pr₁ ⨾ r) a) - (λ _ → bs .⊩isPropValued (pr₂ ⨾ r) b) - (as ⊗ bs) .⊩surjective (a , b) = do - (b~ , b~realizes) ← bs .⊩surjective b - (a~ , a~realizes) ← as .⊩surjective a - return - ( pair ⨾ a~ ⨾ b~ - , subst (λ x → as ._⊩_ x a) (sym (pr₁pxy≡x a~ b~)) a~realizes - , subst (λ x → bs ._⊩_ x b) (sym (pr₂pxy≡y a~ b~)) b~realizes - ) - - ⟪_,_⟫ : {X Y Z W : Type ℓ} - {xs : Assembly X} - {ys : Assembly Y} - {zs : Assembly Z} - {ws : Assembly W} - (f : AssemblyMorphism xs ys) - (g : AssemblyMorphism zs ws) - → AssemblyMorphism (xs ⊗ zs) (ys ⊗ ws) - ⟪ f , g ⟫ .map (x , z) = f .map x , g .map z - ⟪_,_⟫ {ys = ys} {ws = ws} f g .tracker = (do - (f~ , f~tracks) ← f .tracker - (g~ , g~tracks) ← g .tracker - return (s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id))) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id)) - , λ xz r r⊩xz → - ( subst (λ y → ys ._⊩_ y (f .map (xz .fst))) - (sym (subst _ - (sym (t⨾r≡pair_fg f~ g~ r)) - (pr₁pxy≡x (f~ ⨾ (pr₁ ⨾ r)) (g~ ⨾ (pr₂ ⨾ r))))) - (f~tracks (xz .fst) (pr₁ ⨾ r) (r⊩xz .fst))) - , subst (λ y → ws ._⊩_ y (g .map (xz .snd))) - (sym (subst _ - (sym (t⨾r≡pair_fg f~ g~ r)) - (pr₂pxy≡y (f~ ⨾ (pr₁ ⨾ r)) (g~ ⨾ (pr₂ ⨾ r))))) - (g~tracks (xz .snd) (pr₂ ⨾ r) (r⊩xz .snd)))) - where - module _ (f~ g~ r : A) where - subf≡fprr : ∀ f pr → (s ⨾ (k ⨾ f) ⨾ (s ⨾ (k ⨾ pr) ⨾ Id) ⨾ r) ≡ (f ⨾ (pr ⨾ r)) - subf≡fprr f pr = - s ⨾ (k ⨾ f) ⨾ (s ⨾ (k ⨾ pr) ⨾ Id) ⨾ r - ≡⟨ sabc≡ac_bc _ _ _ ⟩ - (k ⨾ f ⨾ r) ⨾ (s ⨾ (k ⨾ pr) ⨾ Id ⨾ r) - ≡⟨ cong (λ x → x ⨾ _) (kab≡a f r) ⟩ - f ⨾ (s ⨾ (k ⨾ pr) ⨾ Id ⨾ r) - ≡⟨ cong (λ x → f ⨾ x) (sabc≡ac_bc _ _ _) ⟩ - f ⨾ (k ⨾ pr ⨾ r ⨾ (Id ⨾ r)) - ≡⟨ cong (λ x → f ⨾ (x ⨾ (Id ⨾ r))) (kab≡a _ _ ) ⟩ - f ⨾ (pr ⨾ (Id ⨾ r)) - ≡⟨ cong (λ x → f ⨾ (pr ⨾ x)) (Ida≡a r) ⟩ - f ⨾ (pr ⨾ r) - ∎ - t⨾r≡pair_fg : - s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id))) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id)) ⨾ r - ≡ pair ⨾ (f~ ⨾ (pr₁ ⨾ r)) ⨾ (g~ ⨾ (pr₂ ⨾ r)) - t⨾r≡pair_fg = - s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id))) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id)) ⨾ r - ≡⟨ sabc≡ac_bc _ _ _ ⟩ - s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id)) ⨾ r ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r) - ≡⟨ cong (λ x → x ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r)) (sabc≡ac_bc _ _ _) ⟩ - k ⨾ pair ⨾ r ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ r) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r) - ≡⟨ cong (λ x → x ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ r) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r)) - (kab≡a pair r) ⟩ - pair ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ r) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r) - ≡⟨ cong₂ (λ x y → pair ⨾ x ⨾ y) (subf≡fprr f~ pr₁) (subf≡fprr g~ pr₂) ⟩ - pair ⨾ (f~ ⨾ (pr₁ ⨾ r)) ⨾ (g~ ⨾ (pr₂ ⨾ r)) - ∎ + -- Some constructions on assemblies + infixl 23 _⊗_ + _⊗_ : {A B : Type ℓ} → Assembly A → Assembly B → Assembly (A × B) + (as ⊗ bs) .isSetX = isSetΣ (as .isSetX) (λ _ → bs .isSetX) + (as ⊗ bs) ._⊩_ r (a , b) = (as ._⊩_ (pr₁ ⨾ r) a) × (bs ._⊩_ (pr₂ ⨾ r) b) + (as ⊗ bs) .⊩isPropValued r (a , b) = isPropΣ (as .⊩isPropValued (pr₁ ⨾ r) a) + (λ _ → bs .⊩isPropValued (pr₂ ⨾ r) b) + (as ⊗ bs) .⊩surjective (a , b) = do + (b~ , b~realizes) ← bs .⊩surjective b + (a~ , a~realizes) ← as .⊩surjective a + return + ( pair ⨾ a~ ⨾ b~ + , subst (λ x → as ._⊩_ x a) (sym (pr₁pxy≡x a~ b~)) a~realizes + , subst (λ x → bs ._⊩_ x b) (sym (pr₂pxy≡y a~ b~)) b~realizes + ) + + ⟪_,_⟫ : {X Y Z W : Type ℓ} + {xs : Assembly X} + {ys : Assembly Y} + {zs : Assembly Z} + {ws : Assembly W} + (f : AssemblyMorphism xs ys) + (g : AssemblyMorphism zs ws) + → AssemblyMorphism (xs ⊗ zs) (ys ⊗ ws) + ⟪ f , g ⟫ .map (x , z) = f .map x , g .map z + ⟪_,_⟫ {ys = ys} {ws = ws} f g .tracker = (do + (f~ , f~tracks) ← f .tracker + (g~ , g~tracks) ← g .tracker + return (s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id))) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id)) + , λ xz r r⊩xz → + ( subst (λ y → ys ._⊩_ y (f .map (xz .fst))) + (sym (subst _ + (sym (t⨾r≡pair_fg f~ g~ r)) + (pr₁pxy≡x (f~ ⨾ (pr₁ ⨾ r)) (g~ ⨾ (pr₂ ⨾ r))))) + (f~tracks (xz .fst) (pr₁ ⨾ r) (r⊩xz .fst))) + , subst (λ y → ws ._⊩_ y (g .map (xz .snd))) + (sym (subst _ + (sym (t⨾r≡pair_fg f~ g~ r)) + (pr₂pxy≡y (f~ ⨾ (pr₁ ⨾ r)) (g~ ⨾ (pr₂ ⨾ r))))) + (g~tracks (xz .snd) (pr₂ ⨾ r) (r⊩xz .snd)))) + where + module _ (f~ g~ r : A) where + subf≡fprr : ∀ f pr → (s ⨾ (k ⨾ f) ⨾ (s ⨾ (k ⨾ pr) ⨾ Id) ⨾ r) ≡ (f ⨾ (pr ⨾ r)) + subf≡fprr f pr = + s ⨾ (k ⨾ f) ⨾ (s ⨾ (k ⨾ pr) ⨾ Id) ⨾ r + ≡⟨ sabc≡ac_bc _ _ _ ⟩ + (k ⨾ f ⨾ r) ⨾ (s ⨾ (k ⨾ pr) ⨾ Id ⨾ r) + ≡⟨ cong (λ x → x ⨾ _) (kab≡a f r) ⟩ + f ⨾ (s ⨾ (k ⨾ pr) ⨾ Id ⨾ r) + ≡⟨ cong (λ x → f ⨾ x) (sabc≡ac_bc _ _ _) ⟩ + f ⨾ (k ⨾ pr ⨾ r ⨾ (Id ⨾ r)) + ≡⟨ cong (λ x → f ⨾ (x ⨾ (Id ⨾ r))) (kab≡a _ _ ) ⟩ + f ⨾ (pr ⨾ (Id ⨾ r)) + ≡⟨ cong (λ x → f ⨾ (pr ⨾ x)) (Ida≡a r) ⟩ + f ⨾ (pr ⨾ r) + ∎ + t⨾r≡pair_fg : + s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id))) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id)) ⨾ r + ≡ pair ⨾ (f~ ⨾ (pr₁ ⨾ r)) ⨾ (g~ ⨾ (pr₂ ⨾ r)) + t⨾r≡pair_fg = + s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id))) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id)) ⨾ r + ≡⟨ sabc≡ac_bc _ _ _ ⟩ + s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id)) ⨾ r ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r) + ≡⟨ cong (λ x → x ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r)) (sabc≡ac_bc _ _ _) ⟩ + k ⨾ pair ⨾ r ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ r) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r) + ≡⟨ cong (λ x → x ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ r) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r)) + (kab≡a pair r) ⟩ + pair ⨾ (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ r) ⨾ (s ⨾ (k ⨾ g~) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r) + ≡⟨ cong₂ (λ x y → pair ⨾ x ⨾ y) (subf≡fprr f~ pr₁) (subf≡fprr g~ pr₂) ⟩ + pair ⨾ (f~ ⨾ (pr₁ ⨾ r)) ⨾ (g~ ⨾ (pr₂ ⨾ r)) + ∎ - π₁ : {A B : Type ℓ} {as : Assembly A} {bs : Assembly B} → AssemblyMorphism (as ⊗ bs) as - π₁ .map (a , b) = a - π₁ .tracker = ∣ pr₁ , (λ (a , b) p (goal , _) → goal) ∣₁ - - π₂ : {A B : Type ℓ} {as : Assembly A} {bs : Assembly B} → AssemblyMorphism (as ⊗ bs) bs - π₂ .map (a , b) = b - π₂ .tracker = ∣ pr₂ , (λ (a , b) p (_ , goal) → goal) ∣₁ - - ⟨_,_⟩ : {X Y Z : Type ℓ} - → {xs : Assembly X} {ys : Assembly Y} {zs : Assembly Z} - → AssemblyMorphism zs xs - → AssemblyMorphism zs ys - → AssemblyMorphism zs (xs ⊗ ys) - ⟨ f , g ⟩ .map z = f .map z , g .map z - ⟨_,_⟩ {X} {Y} {Z} {xs} {ys} {zs} f g .tracker = ∥∥map2 untruncated (f .tracker) (g .tracker) where - module _ - ((f~ , f~tracks) : Σ[ f~ ∈ A ] tracks {xs = zs} {ys = xs} f~ (f .map)) - ((g~ , g~tracks) : Σ[ g~ ∈ A ] tracks {xs = zs} {ys = ys} g~ (g .map)) where + π₁ : {A B : Type ℓ} {as : Assembly A} {bs : Assembly B} → AssemblyMorphism (as ⊗ bs) as + π₁ .map (a , b) = a + π₁ .tracker = ∣ pr₁ , (λ (a , b) p (goal , _) → goal) ∣₁ + + π₂ : {A B : Type ℓ} {as : Assembly A} {bs : Assembly B} → AssemblyMorphism (as ⊗ bs) bs + π₂ .map (a , b) = b + π₂ .tracker = ∣ pr₂ , (λ (a , b) p (_ , goal) → goal) ∣₁ + + ⟨_,_⟩ : {X Y Z : Type ℓ} + → {xs : Assembly X} {ys : Assembly Y} {zs : Assembly Z} + → AssemblyMorphism zs xs + → AssemblyMorphism zs ys + → AssemblyMorphism zs (xs ⊗ ys) + ⟨ f , g ⟩ .map z = f .map z , g .map z + ⟨_,_⟩ {X} {Y} {Z} {xs} {ys} {zs} f g .tracker = ∥∥map2 untruncated (f .tracker) (g .tracker) where + module _ + ((f~ , f~tracks) : Σ[ f~ ∈ A ] tracks {xs = zs} {ys = xs} f~ (f .map)) + ((g~ , g~tracks) : Σ[ g~ ∈ A ] tracks {xs = zs} {ys = ys} g~ (g .map)) where - _⊩X_ = xs ._⊩_ - _⊩Y_ = ys ._⊩_ - _⊩Z_ = zs ._⊩_ + _⊩X_ = xs ._⊩_ + _⊩Y_ = ys ._⊩_ + _⊩Z_ = zs ._⊩_ - t = s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ Id)) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id) - untruncated : Σ[ t ∈ A ] (∀ z zᵣ zᵣ⊩z → ((pr₁ ⨾ (t ⨾ zᵣ)) ⊩X (f .map z)) × ((pr₂ ⨾ (t ⨾ zᵣ)) ⊩Y (g .map z))) - untruncated = t , λ z zᵣ zᵣ⊩z → goal₁ z zᵣ zᵣ⊩z , goal₂ z zᵣ zᵣ⊩z where - module _ (z : Z) (zᵣ : A) (zᵣ⊩z : zᵣ ⊩Z z) where - - pr₁⨾tracker⨾zᵣ≡f~⨾zᵣ : pr₁ ⨾ (t ⨾ zᵣ) ≡ f~ ⨾ zᵣ - pr₁⨾tracker⨾zᵣ≡f~⨾zᵣ = - pr₁ ⨾ (s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ Id)) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id) ⨾ zᵣ) - ≡⟨ cong (λ x → pr₁ ⨾ x) (sabc≡ac_bc _ _ _) ⟩ - pr₁ ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ Id) ⨾ zᵣ ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) - ≡⟨ cong (λ x → pr₁ ⨾ (x ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ))) (sabc≡ac_bc _ _ _) ⟩ - pr₁ ⨾ (k ⨾ pair ⨾ zᵣ ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) - ≡⟨ cong (λ x → pr₁ ⨾ (x ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ))) (kab≡a _ _) ⟩ - pr₁ ⨾ (pair ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) - ≡⟨ pr₁pxy≡x _ _ ⟩ - s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ - ≡⟨ sabc≡ac_bc _ _ _ ⟩ - k ⨾ f~ ⨾ zᵣ ⨾ (Id ⨾ zᵣ) - ≡⟨ cong (λ x → x ⨾ (Id ⨾ zᵣ)) (kab≡a _ _) ⟩ - f~ ⨾ (Id ⨾ zᵣ) - ≡⟨ cong (λ x → f~ ⨾ x) (Ida≡a _) ⟩ - f~ ⨾ zᵣ - ∎ - - pr₂⨾tracker⨾zᵣ≡g~⨾zᵣ : pr₂ ⨾ (t ⨾ zᵣ) ≡ g~ ⨾ zᵣ - pr₂⨾tracker⨾zᵣ≡g~⨾zᵣ = - pr₂ ⨾ (s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ Id)) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id) ⨾ zᵣ) - ≡⟨ cong (λ x → pr₂ ⨾ x) (sabc≡ac_bc _ _ _) ⟩ - pr₂ ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ Id) ⨾ zᵣ ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) - ≡⟨ cong (λ x → pr₂ ⨾ (x ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ))) (sabc≡ac_bc _ _ _) ⟩ - pr₂ ⨾ (k ⨾ pair ⨾ zᵣ ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) - ≡⟨ cong (λ x → pr₂ ⨾ (x ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ))) (kab≡a _ _) ⟩ - pr₂ ⨾ (pair ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) - ≡⟨ pr₂pxy≡y _ _ ⟩ - s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ - ≡⟨ sabc≡ac_bc _ _ _ ⟩ - k ⨾ g~ ⨾ zᵣ ⨾ (Id ⨾ zᵣ) - ≡⟨ cong (λ x → x ⨾ (Id ⨾ zᵣ)) (kab≡a _ _) ⟩ - g~ ⨾ (Id ⨾ zᵣ) - ≡⟨ cong (λ x → g~ ⨾ x) (Ida≡a _) ⟩ - g~ ⨾ zᵣ - ∎ - goal₁ : (pr₁ ⨾ (t ⨾ zᵣ)) ⊩X (f .map z) - goal₁ = subst (λ y → y ⊩X (f .map z)) (sym pr₁⨾tracker⨾zᵣ≡f~⨾zᵣ) (f~tracks z zᵣ zᵣ⊩z) + t = s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ Id)) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id) + untruncated : Σ[ t ∈ A ] (∀ z zᵣ zᵣ⊩z → ((pr₁ ⨾ (t ⨾ zᵣ)) ⊩X (f .map z)) × ((pr₂ ⨾ (t ⨾ zᵣ)) ⊩Y (g .map z))) + untruncated = t , λ z zᵣ zᵣ⊩z → goal₁ z zᵣ zᵣ⊩z , goal₂ z zᵣ zᵣ⊩z where + module _ (z : Z) (zᵣ : A) (zᵣ⊩z : zᵣ ⊩Z z) where + + pr₁⨾tracker⨾zᵣ≡f~⨾zᵣ : pr₁ ⨾ (t ⨾ zᵣ) ≡ f~ ⨾ zᵣ + pr₁⨾tracker⨾zᵣ≡f~⨾zᵣ = + pr₁ ⨾ (s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ Id)) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id) ⨾ zᵣ) + ≡⟨ cong (λ x → pr₁ ⨾ x) (sabc≡ac_bc _ _ _) ⟩ + pr₁ ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ Id) ⨾ zᵣ ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) + ≡⟨ cong (λ x → pr₁ ⨾ (x ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ))) (sabc≡ac_bc _ _ _) ⟩ + pr₁ ⨾ (k ⨾ pair ⨾ zᵣ ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) + ≡⟨ cong (λ x → pr₁ ⨾ (x ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ))) (kab≡a _ _) ⟩ + pr₁ ⨾ (pair ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) + ≡⟨ pr₁pxy≡x _ _ ⟩ + s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ + ≡⟨ sabc≡ac_bc _ _ _ ⟩ + k ⨾ f~ ⨾ zᵣ ⨾ (Id ⨾ zᵣ) + ≡⟨ cong (λ x → x ⨾ (Id ⨾ zᵣ)) (kab≡a _ _) ⟩ + f~ ⨾ (Id ⨾ zᵣ) + ≡⟨ cong (λ x → f~ ⨾ x) (Ida≡a _) ⟩ + f~ ⨾ zᵣ + ∎ + + pr₂⨾tracker⨾zᵣ≡g~⨾zᵣ : pr₂ ⨾ (t ⨾ zᵣ) ≡ g~ ⨾ zᵣ + pr₂⨾tracker⨾zᵣ≡g~⨾zᵣ = + pr₂ ⨾ (s ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ Id)) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id) ⨾ zᵣ) + ≡⟨ cong (λ x → pr₂ ⨾ x) (sabc≡ac_bc _ _ _) ⟩ + pr₂ ⨾ (s ⨾ (k ⨾ pair) ⨾ (s ⨾ (k ⨾ f~) ⨾ Id) ⨾ zᵣ ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) + ≡⟨ cong (λ x → pr₂ ⨾ (x ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ))) (sabc≡ac_bc _ _ _) ⟩ + pr₂ ⨾ (k ⨾ pair ⨾ zᵣ ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) + ≡⟨ cong (λ x → pr₂ ⨾ (x ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ))) (kab≡a _ _) ⟩ + pr₂ ⨾ (pair ⨾ (s ⨾ (k ⨾ f~) ⨾ Id ⨾ zᵣ) ⨾ (s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ)) + ≡⟨ pr₂pxy≡y _ _ ⟩ + s ⨾ (k ⨾ g~) ⨾ Id ⨾ zᵣ + ≡⟨ sabc≡ac_bc _ _ _ ⟩ + k ⨾ g~ ⨾ zᵣ ⨾ (Id ⨾ zᵣ) + ≡⟨ cong (λ x → x ⨾ (Id ⨾ zᵣ)) (kab≡a _ _) ⟩ + g~ ⨾ (Id ⨾ zᵣ) + ≡⟨ cong (λ x → g~ ⨾ x) (Ida≡a _) ⟩ + g~ ⨾ zᵣ + ∎ + goal₁ : (pr₁ ⨾ (t ⨾ zᵣ)) ⊩X (f .map z) + goal₁ = subst (λ y → y ⊩X (f .map z)) (sym pr₁⨾tracker⨾zᵣ≡f~⨾zᵣ) (f~tracks z zᵣ zᵣ⊩z) - goal₂ : (pr₂ ⨾ (t ⨾ zᵣ)) ⊩Y (g .map z) - goal₂ = subst (λ y → y ⊩Y (g .map z)) (sym pr₂⨾tracker⨾zᵣ≡g~⨾zᵣ) (g~tracks z zᵣ zᵣ⊩z) - -- Not sure if this is correct but okay let us see - infixl 23 _⊕_ - _⊕_ : {A B : Type ℓ} → Assembly A → Assembly B → Assembly (A ⊎ B) - (as ⊕ bs) .isSetX = isSet⊎ (as .isSetX) (bs .isSetX) - (as ⊕ bs) ._⊩_ r (inl a) = ∃[ aᵣ ∈ A ] (as ._⊩_ aᵣ a) × (r ≡ pair ⨾ true ⨾ aᵣ) - (as ⊕ bs) ._⊩_ r (inr b) = ∃[ bᵣ ∈ A ] (bs ._⊩_ bᵣ b) × (r ≡ pair ⨾ false ⨾ bᵣ) - (as ⊕ bs) .⊩isPropValued r (inl a) = squash₁ - (as ⊕ bs) .⊩isPropValued r (inr b) = squash₁ - (as ⊕ bs) .⊩surjective (inl a) = - do - (a~ , a~realizes) ← as .⊩surjective a - return ( pair ⨾ true ⨾ a~ - , ∣ a~ - , a~realizes - , refl ∣₁ - ) - (as ⊕ bs) .⊩surjective (inr b) = - do - (b~ , b~realizes) ← bs .⊩surjective b - return ( pair ⨾ false ⨾ b~ - , ∣ b~ - , b~realizes - , refl ∣₁ - ) + goal₂ : (pr₂ ⨾ (t ⨾ zᵣ)) ⊩Y (g .map z) + goal₂ = subst (λ y → y ⊩Y (g .map z)) (sym pr₂⨾tracker⨾zᵣ≡g~⨾zᵣ) (g~tracks z zᵣ zᵣ⊩z) + -- Not sure if this is correct but okay let us see + infixl 23 _⊕_ + _⊕_ : {A B : Type ℓ} → Assembly A → Assembly B → Assembly (A ⊎ B) + (as ⊕ bs) .isSetX = isSet⊎ (as .isSetX) (bs .isSetX) + (as ⊕ bs) ._⊩_ r (inl a) = ∃[ aᵣ ∈ A ] (as ._⊩_ aᵣ a) × (r ≡ pair ⨾ true ⨾ aᵣ) + (as ⊕ bs) ._⊩_ r (inr b) = ∃[ bᵣ ∈ A ] (bs ._⊩_ bᵣ b) × (r ≡ pair ⨾ false ⨾ bᵣ) + (as ⊕ bs) .⊩isPropValued r (inl a) = squash₁ + (as ⊕ bs) .⊩isPropValued r (inr b) = squash₁ + (as ⊕ bs) .⊩surjective (inl a) = + do + (a~ , a~realizes) ← as .⊩surjective a + return ( pair ⨾ true ⨾ a~ + , ∣ a~ + , a~realizes + , refl ∣₁ + ) + (as ⊕ bs) .⊩surjective (inr b) = + do + (b~ , b~realizes) ← bs .⊩surjective b + return ( pair ⨾ false ⨾ b~ + , ∣ b~ + , b~realizes + , refl ∣₁ + ) - κ₁ : {A B : Type ℓ} {as : Assembly A} {bs : Assembly B} → AssemblyMorphism as (as ⊕ bs) - κ₁ .map = inl - κ₁ .tracker = ∣ pair ⨾ true , (λ x aₓ aₓ⊩x → ∣ aₓ , aₓ⊩x , refl ∣₁) ∣₁ - - κ₂ : {A B : Type ℓ} {as : Assembly A} {bs : Assembly B} → AssemblyMorphism bs (as ⊕ bs) - κ₂ .map b = inr b - κ₂ .tracker = ∣ pair ⨾ false , (λ x bₓ bₓ⊩x → ∣ bₓ , bₓ⊩x , refl ∣₁) ∣₁ - module _ {A B : Type ℓ} {as : Assembly A} {bs : Assembly B} (f g : AssemblyMorphism as bs) where - _⊩A_ = as ._⊩_ - equalizer : Assembly (Σ[ a ∈ A ] f .map a ≡ g .map a) - equalizer .isSetX = isSetΣ (as .isSetX) λ x → isProp→isSet (bs .isSetX (f .map x) (g .map x)) - equalizer ._⊩_ r (a , fa≡ga) = as ._⊩_ r a - equalizer .⊩isPropValued r (a , fa≡ga) = as .⊩isPropValued r a - equalizer .⊩surjective (a , fa≡ga) = as .⊩surjective a - - ιequalizer : AssemblyMorphism equalizer as - ιequalizer .map (a , fa≡ga) = a - ιequalizer .tracker = ∣ Id , (λ x aₓ aₓ⊩x → subst (λ y → y ⊩A (x .fst)) (sym (Ida≡a aₓ)) aₓ⊩x) ∣₁ - - equalizerFactors : ((Z , zs) : Σ[ Z ∈ Type ℓ ] (Assembly Z)) - → (ι' : AssemblyMorphism zs as) - → (ι' ⊚ f ≡ ι' ⊚ g) - → ∃![ ! ∈ AssemblyMorphism zs equalizer ] (! ⊚ ιequalizer ≡ ι') - equalizerFactors (Z , zs) ι' ι'f≡ι'g = - uniqueExists (λ where - .map z → ι' .map z , λ i → ι'f≡ι'g i .map z - .tracker → ι' .tracker) - (AssemblyMorphism≡ _ _ refl) - (λ ! → isSetAssemblyMorphism _ _ (! ⊚ ιequalizer) ι') - λ !' !'⊚ι≡ι' → AssemblyMorphism≡ _ _ - (funExt λ z → Σ≡Prop (λ x → bs .isSetX (f .map x) (g .map x)) - (λ i → !'⊚ι≡ι' (~ i) .map z)) - - -- Exponential objects - _⇒_ : {A B : Type ℓ} → (as : Assembly A) → (bs : Assembly B) → Assembly (AssemblyMorphism as bs) - (as ⇒ bs) .isSetX = isSetAssemblyMorphism as bs - (as ⇒ bs) ._⊩_ r f = tracks {xs = as} {ys = bs} r (f .map) - _⇒_ {A} {B} as bs .⊩isPropValued r f = isPropTracks {X = A} {Y = B} {xs = as} {ys = bs} r (f .map) - (as ⇒ bs) .⊩surjective f = f .tracker - - -- What a distinguished gentleman - eval : {X Y : Type ℓ} → (xs : Assembly X) → (ys : Assembly Y) → AssemblyMorphism ((xs ⇒ ys) ⊗ xs) ys - eval xs ys .map (f , x) = f .map x - eval {X} {Y} xs ys .tracker = - ∣(s ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id)) - , (λ (f , x) r r⊩fx → subst - (λ y → y ⊩Y (f .map x)) - (sym (tracker⨾r≡pr₁r⨾pr₂r (f , x) r r⊩fx)) - (pr₁r⨾pr₂rTracks (f , x) r r⊩fx)) - ∣₁ where - _⊩Y_ = ys ._⊩_ - module _ (fx : (AssemblyMorphism xs ys) × X) - (r : A) - (r⊩fx : ((xs ⇒ ys) ⊗ xs) ._⊩_ r (fx .fst , fx .snd)) where - f = fx .fst - x = fx .snd + κ₁ : {A B : Type ℓ} {as : Assembly A} {bs : Assembly B} → AssemblyMorphism as (as ⊕ bs) + κ₁ .map = inl + κ₁ .tracker = ∣ pair ⨾ true , (λ x aₓ aₓ⊩x → ∣ aₓ , aₓ⊩x , refl ∣₁) ∣₁ + + κ₂ : {A B : Type ℓ} {as : Assembly A} {bs : Assembly B} → AssemblyMorphism bs (as ⊕ bs) + κ₂ .map b = inr b + κ₂ .tracker = ∣ pair ⨾ false , (λ x bₓ bₓ⊩x → ∣ bₓ , bₓ⊩x , refl ∣₁) ∣₁ + module _ {A B : Type ℓ} {as : Assembly A} {bs : Assembly B} (f g : AssemblyMorphism as bs) where + _⊩A_ = as ._⊩_ + equalizer : Assembly (Σ[ a ∈ A ] f .map a ≡ g .map a) + equalizer .isSetX = isSetΣ (as .isSetX) λ x → isProp→isSet (bs .isSetX (f .map x) (g .map x)) + equalizer ._⊩_ r (a , fa≡ga) = as ._⊩_ r a + equalizer .⊩isPropValued r (a , fa≡ga) = as .⊩isPropValued r a + equalizer .⊩surjective (a , fa≡ga) = as .⊩surjective a + + ιequalizer : AssemblyMorphism equalizer as + ιequalizer .map (a , fa≡ga) = a + ιequalizer .tracker = ∣ Id , (λ x aₓ aₓ⊩x → subst (λ y → y ⊩A (x .fst)) (sym (Ida≡a aₓ)) aₓ⊩x) ∣₁ + + equalizerFactors : ((Z , zs) : Σ[ Z ∈ Type ℓ ] (Assembly Z)) + → (ι' : AssemblyMorphism zs as) + → (ι' ⊚ f ≡ ι' ⊚ g) + → ∃![ ! ∈ AssemblyMorphism zs equalizer ] (! ⊚ ιequalizer ≡ ι') + equalizerFactors (Z , zs) ι' ι'f≡ι'g = + uniqueExists (λ where + .map z → ι' .map z , λ i → ι'f≡ι'g i .map z + .tracker → ι' .tracker) + (AssemblyMorphism≡ _ _ refl) + (λ ! → isSetAssemblyMorphism _ _ (! ⊚ ιequalizer) ι') + λ !' !'⊚ι≡ι' → AssemblyMorphism≡ _ _ + (funExt λ z → Σ≡Prop (λ x → bs .isSetX (f .map x) (g .map x)) + (λ i → !'⊚ι≡ι' (~ i) .map z)) + + -- Exponential objects + _⇒_ : {A B : Type ℓ} → (as : Assembly A) → (bs : Assembly B) → Assembly (AssemblyMorphism as bs) + (as ⇒ bs) .isSetX = isSetAssemblyMorphism as bs + (as ⇒ bs) ._⊩_ r f = tracks {xs = as} {ys = bs} r (f .map) + _⇒_ {A} {B} as bs .⊩isPropValued r f = isPropTracks {X = A} {Y = B} {xs = as} {ys = bs} r (f .map) + (as ⇒ bs) .⊩surjective f = f .tracker + + -- What a distinguished gentleman + eval : {X Y : Type ℓ} → (xs : Assembly X) → (ys : Assembly Y) → AssemblyMorphism ((xs ⇒ ys) ⊗ xs) ys + eval xs ys .map (f , x) = f .map x + eval {X} {Y} xs ys .tracker = + ∣(s ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id)) + , (λ (f , x) r r⊩fx → subst + (λ y → y ⊩Y (f .map x)) + (sym (tracker⨾r≡pr₁r⨾pr₂r (f , x) r r⊩fx)) + (pr₁r⨾pr₂rTracks (f , x) r r⊩fx)) + ∣₁ where + _⊩Y_ = ys ._⊩_ + module _ (fx : (AssemblyMorphism xs ys) × X) + (r : A) + (r⊩fx : ((xs ⇒ ys) ⊗ xs) ._⊩_ r (fx .fst , fx .snd)) where + f = fx .fst + x = fx .snd - pr₁r⨾pr₂rTracks : (pr₁ ⨾ r ⨾ (pr₂ ⨾ r)) ⊩Y (f .map x) - pr₁r⨾pr₂rTracks = r⊩fx .fst x (pr₂ ⨾ r) (r⊩fx .snd) + pr₁r⨾pr₂rTracks : (pr₁ ⨾ r ⨾ (pr₂ ⨾ r)) ⊩Y (f .map x) + pr₁r⨾pr₂rTracks = r⊩fx .fst x (pr₂ ⨾ r) (r⊩fx .snd) - tracker⨾r≡pr₁r⨾pr₂r : s ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r ≡ (pr₁ ⨾ r) ⨾ (pr₂ ⨾ r) - tracker⨾r≡pr₁r⨾pr₂r = - s ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r - ≡⟨ sabc≡ac_bc _ _ _ ⟩ - (s ⨾ (k ⨾ pr₁) ⨾ Id ⨾ r) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id ⨾ r) - ≡⟨ cong (λ x → x ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id ⨾ r)) (sabc≡ac_bc _ _ _) ⟩ - (k ⨾ pr₁ ⨾ r ⨾ (Id ⨾ r)) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id ⨾ r) - ≡⟨ cong (λ x → (k ⨾ pr₁ ⨾ r ⨾ (Id ⨾ r)) ⨾ x) (sabc≡ac_bc _ _ _) ⟩ - (k ⨾ pr₁ ⨾ r ⨾ (Id ⨾ r)) ⨾ (k ⨾ pr₂ ⨾ r ⨾ (Id ⨾ r)) - ≡⟨ cong (λ x → (x ⨾ (Id ⨾ r)) ⨾ (k ⨾ pr₂ ⨾ r ⨾ (Id ⨾ r))) (kab≡a _ _) ⟩ - (pr₁ ⨾ (Id ⨾ r)) ⨾ (k ⨾ pr₂ ⨾ r ⨾ (Id ⨾ r)) - ≡⟨ cong (λ x → (pr₁ ⨾ x) ⨾ (k ⨾ pr₂ ⨾ r ⨾ (Id ⨾ r))) (Ida≡a r) ⟩ - (pr₁ ⨾ r) ⨾ (k ⨾ pr₂ ⨾ r ⨾ (Id ⨾ r)) - ≡⟨ cong (λ x → (pr₁ ⨾ r) ⨾ (x ⨾ (Id ⨾ r))) (kab≡a _ _) ⟩ - (pr₁ ⨾ r) ⨾ (pr₂ ⨾ (Id ⨾ r)) - ≡⟨ cong (λ x → (pr₁ ⨾ r) ⨾ (pr₂ ⨾ x)) (Ida≡a r) ⟩ - (pr₁ ⨾ r) ⨾ (pr₂ ⨾ r) - ∎ - -- With major constructions done we start the universal properties - module _ {X Y : Type ℓ} (xs : Assembly X) (ys : Assembly Y) where - theπ₁ = π₁ {A = X} {B = Y} {as = xs} {bs = ys} - theπ₂ = π₂ {A = X} {B = Y} {as = xs} {bs = ys} - isBinProduct⊗ : ((Z , zs) : Σ[ Z ∈ Type ℓ ] Assembly Z) - → (f : AssemblyMorphism zs xs) - → (g : AssemblyMorphism zs ys) - → ∃![ fg ∈ AssemblyMorphism zs (xs ⊗ ys) ] (fg ⊚ theπ₁ ≡ f) × (fg ⊚ theπ₂ ≡ g) - isBinProduct⊗ (Z , zs) f g = - uniqueExists - {B = λ fg → (fg ⊚ theπ₁ ≡ f) × (fg ⊚ theπ₂ ≡ g)} - ⟨ f , g ⟩ - ( AssemblyMorphism≡ (⟨ f , g ⟩ ⊚ theπ₁) f (funExt (λ x → refl)) - , AssemblyMorphism≡ (⟨ f , g ⟩ ⊚ theπ₂) g (funExt (λ x → refl))) - (λ fg → isProp× - (isSetAssemblyMorphism zs xs (fg ⊚ theπ₁) f) - (isSetAssemblyMorphism zs ys (fg ⊚ theπ₂) g)) - -- TODO : Come up with a prettier proof - λ fg (fgπ₁≡f , fgπ₂≡g) → sym ((lemma₂ fg fgπ₁≡f fgπ₂≡g) ∙ (lemma₁ fg fgπ₁≡f fgπ₂≡g)) where - module _ (fg : AssemblyMorphism zs (xs ⊗ ys)) - (fgπ₁≡f : fg ⊚ theπ₁ ≡ f) - (fgπ₂≡g : fg ⊚ theπ₂ ≡ g) where - lemma₁ : ⟨ fg ⊚ theπ₁ , fg ⊚ theπ₂ ⟩ ≡ ⟨ f , g ⟩ - lemma₁ = AssemblyMorphism≡ - ⟨ fg ⊚ theπ₁ , fg ⊚ theπ₂ ⟩ - ⟨ f , g ⟩ - (λ i z → (fgπ₁≡f i .map z) , (fgπ₂≡g i .map z)) - - lemma₂ : fg ≡ ⟨ fg ⊚ theπ₁ , fg ⊚ theπ₂ ⟩ - lemma₂ = AssemblyMorphism≡ - fg - ⟨ fg ⊚ theπ₁ , fg ⊚ theπ₂ ⟩ - (funExt λ x → ΣPathP (refl , refl)) - - module _ where - open BinProduct - ASMBinProducts : BinProducts ASM - ASMBinProducts (X , xs) (Y , ys) .binProdOb = (X × Y) , (xs ⊗ ys) - ASMBinProducts (X , xs) (Y , ys) .binProdPr₁ = π₁ {as = xs} {bs = ys} - ASMBinProducts (X , xs) (Y , ys) .binProdPr₂ = π₂ {as = xs} {bs = ys} - ASMBinProducts (X , xs) (Y , ys) .univProp {z} f g = isBinProduct⊗ xs ys z f g - - isTerminalUnitAssembly : ((Z , zs) : Σ[ Z ∈ Type ℓ ] (Assembly Z)) → isContr (AssemblyMorphism zs unitAssembly) - isTerminalUnitAssembly (Z , zs) = - inhProp→isContr (λ where - .map → (λ _ → tt*) - .tracker → ∣ k ⨾ Id , (λ _ _ _ → tt*) ∣₁) - λ f g → AssemblyMorphism≡ f g refl - - ASMTerminal : Terminal ASM - ASMTerminal = (Unit* , unitAssembly) , isTerminalUnitAssembly - - isInitialUnitAssembly : ((Z , zs) : Σ[ Z ∈ Type ℓ ] (Assembly Z)) → isContr (AssemblyMorphism emptyAssembly zs) - isInitialUnitAssembly (Z , zs) = - inhProp→isContr (λ where - .map → λ () - .tracker → ∣ Id , (λ x aₓ aₓ⊩x → rec* x) ∣₁) - λ f g → AssemblyMorphism≡ _ _ (funExt λ x → rec* x) - - ASMInitial : Initial ASM - ASMInitial = (⊥* , emptyAssembly) , isInitialUnitAssembly - - module _ {X Y Z : Type ℓ} - {xs : Assembly X} - {ys : Assembly Y} - {zs : Assembly Z} - (f : AssemblyMorphism (zs ⊗ xs) ys) where - theEval = eval {X} {Y} xs ys - ⇒isExponential : ∃![ g ∈ AssemblyMorphism zs (xs ⇒ ys) ] - ⟪ g , identityMorphism xs ⟫ ⊚ theEval ≡ f - ⇒isExponential = uniqueExists (λ where - .map z → λ where - .map x → f .map (z , x) - .tracker → do - (f~ , f~tracks) ← f .tracker - (z~ , z~realizes) ← zs .⊩surjective z - return ( (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id) - , λ x aₓ aₓ⊩x - → subst (λ k → k ⊩Y (f .map (z , x))) - (sym (eq f~ f~tracks z (z~ , z~realizes) x aₓ aₓ⊩x)) - (pair⨾z~⨾aₓtracks f~ f~tracks z (z~ , z~realizes) x aₓ aₓ⊩x))) - .tracker → do - (f~ , f~tracker) ← f .tracker - return {!!}) - (AssemblyMorphism≡ _ _ (funExt (λ (z , x) → refl))) - (λ g → isSetAssemblyMorphism _ _ (⟪ g , identityMorphism xs ⟫ ⊚ theEval) f) - λ g g×id⊚eval≡f → AssemblyMorphism≡ _ _ - (funExt (λ z → AssemblyMorphism≡ _ _ - (funExt (λ x → λ i → g×id⊚eval≡f (~ i) .map (z , x))))) where - _⊩X_ = xs ._⊩_ - _⊩Y_ = ys ._⊩_ - _⊩Z_ = zs ._⊩_ - _⊩Z×X_ = (zs ⊗ xs) ._⊩_ - Z×X = Z × X - module _ (f~ : A) - (f~tracks : (∀ (zx : Z×X) (r : A) (rRealizes : (r ⊩Z×X zx)) → ((f~ ⨾ r) ⊩Y (f .map zx)))) - (z : Z) - (zRealizer : Σ[ z~ ∈ A ] (z~ ⊩Z z)) - (x : X) - (aₓ : A) - (aₓ⊩x : aₓ ⊩X x) where - z~ : A - z~ = zRealizer .fst - z~realizes = zRealizer .snd - - eq : s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id) ⨾ aₓ ≡ f~ ⨾ (pair ⨾ z~ ⨾ aₓ) - eq = - s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id) ⨾ aₓ - ≡⟨ sabc≡ac_bc _ _ _ ⟩ - (k ⨾ f~ ⨾ aₓ) ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id ⨾ aₓ) - ≡⟨ cong (λ x → x ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id ⨾ aₓ)) (kab≡a f~ aₓ) ⟩ - f~ ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id ⨾ aₓ) - ≡⟨ cong (λ x → f~ ⨾ x) (sabc≡ac_bc _ _ _) ⟩ - f~ ⨾ ((k ⨾ (pair ⨾ z~) ⨾ aₓ) ⨾ (Id ⨾ aₓ)) - ≡⟨ cong (λ x → f~ ⨾ (x ⨾ (Id ⨾ aₓ))) (kab≡a (pair ⨾ z~) aₓ) ⟩ - f~ ⨾ (pair ⨾ z~ ⨾ (Id ⨾ aₓ)) - ≡⟨ cong (λ x → f~ ⨾ (pair ⨾ z~ ⨾ x)) (Ida≡a aₓ) ⟩ - f~ ⨾ (pair ⨾ z~ ⨾ aₓ) - ∎ - - pair⨾z~⨾aₓtracks : (f~ ⨾ (pair ⨾ z~ ⨾ aₓ)) ⊩Y (f .map (z , x)) - pair⨾z~⨾aₓtracks = - f~tracks - (z , x) - (pair ⨾ z~ ⨾ aₓ) - ( (subst (λ y → y ⊩Z z) (sym (pr₁pxy≡x z~ aₓ)) z~realizes) - , (subst (λ y → y ⊩X x) (sym (pr₂pxy≡y z~ aₓ)) aₓ⊩x)) - - + tracker⨾r≡pr₁r⨾pr₂r : s ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r ≡ (pr₁ ⨾ r) ⨾ (pr₂ ⨾ r) + tracker⨾r≡pr₁r⨾pr₂r = + s ⨾ (s ⨾ (k ⨾ pr₁) ⨾ Id) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id) ⨾ r + ≡⟨ sabc≡ac_bc _ _ _ ⟩ + (s ⨾ (k ⨾ pr₁) ⨾ Id ⨾ r) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id ⨾ r) + ≡⟨ cong (λ x → x ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id ⨾ r)) (sabc≡ac_bc _ _ _) ⟩ + (k ⨾ pr₁ ⨾ r ⨾ (Id ⨾ r)) ⨾ (s ⨾ (k ⨾ pr₂) ⨾ Id ⨾ r) + ≡⟨ cong (λ x → (k ⨾ pr₁ ⨾ r ⨾ (Id ⨾ r)) ⨾ x) (sabc≡ac_bc _ _ _) ⟩ + (k ⨾ pr₁ ⨾ r ⨾ (Id ⨾ r)) ⨾ (k ⨾ pr₂ ⨾ r ⨾ (Id ⨾ r)) + ≡⟨ cong (λ x → (x ⨾ (Id ⨾ r)) ⨾ (k ⨾ pr₂ ⨾ r ⨾ (Id ⨾ r))) (kab≡a _ _) ⟩ + (pr₁ ⨾ (Id ⨾ r)) ⨾ (k ⨾ pr₂ ⨾ r ⨾ (Id ⨾ r)) + ≡⟨ cong (λ x → (pr₁ ⨾ x) ⨾ (k ⨾ pr₂ ⨾ r ⨾ (Id ⨾ r))) (Ida≡a r) ⟩ + (pr₁ ⨾ r) ⨾ (k ⨾ pr₂ ⨾ r ⨾ (Id ⨾ r)) + ≡⟨ cong (λ x → (pr₁ ⨾ r) ⨾ (x ⨾ (Id ⨾ r))) (kab≡a _ _) ⟩ + (pr₁ ⨾ r) ⨾ (pr₂ ⨾ (Id ⨾ r)) + ≡⟨ cong (λ x → (pr₁ ⨾ r) ⨾ (pr₂ ⨾ x)) (Ida≡a r) ⟩ + (pr₁ ⨾ r) ⨾ (pr₂ ⨾ r) + ∎ + -- With major constructions done we start the universal properties + module _ {X Y : Type ℓ} (xs : Assembly X) (ys : Assembly Y) where + theπ₁ = π₁ {A = X} {B = Y} {as = xs} {bs = ys} + theπ₂ = π₂ {A = X} {B = Y} {as = xs} {bs = ys} + isBinProduct⊗ : ((Z , zs) : Σ[ Z ∈ Type ℓ ] Assembly Z) + → (f : AssemblyMorphism zs xs) + → (g : AssemblyMorphism zs ys) + → ∃![ fg ∈ AssemblyMorphism zs (xs ⊗ ys) ] (fg ⊚ theπ₁ ≡ f) × (fg ⊚ theπ₂ ≡ g) + isBinProduct⊗ (Z , zs) f g = + uniqueExists + {B = λ fg → (fg ⊚ theπ₁ ≡ f) × (fg ⊚ theπ₂ ≡ g)} + ⟨ f , g ⟩ + ( AssemblyMorphism≡ (⟨ f , g ⟩ ⊚ theπ₁) f (funExt (λ x → refl)) + , AssemblyMorphism≡ (⟨ f , g ⟩ ⊚ theπ₂) g (funExt (λ x → refl))) + (λ fg → isProp× + (isSetAssemblyMorphism zs xs (fg ⊚ theπ₁) f) + (isSetAssemblyMorphism zs ys (fg ⊚ theπ₂) g)) + -- TODO : Come up with a prettier proof + λ fg (fgπ₁≡f , fgπ₂≡g) → sym ((lemma₂ fg fgπ₁≡f fgπ₂≡g) ∙ (lemma₁ fg fgπ₁≡f fgπ₂≡g)) where + module _ (fg : AssemblyMorphism zs (xs ⊗ ys)) + (fgπ₁≡f : fg ⊚ theπ₁ ≡ f) + (fgπ₂≡g : fg ⊚ theπ₂ ≡ g) where + lemma₁ : ⟨ fg ⊚ theπ₁ , fg ⊚ theπ₂ ⟩ ≡ ⟨ f , g ⟩ + lemma₁ = AssemblyMorphism≡ + ⟨ fg ⊚ theπ₁ , fg ⊚ theπ₂ ⟩ + ⟨ f , g ⟩ + (λ i z → (fgπ₁≡f i .map z) , (fgπ₂≡g i .map z)) + + lemma₂ : fg ≡ ⟨ fg ⊚ theπ₁ , fg ⊚ theπ₂ ⟩ + lemma₂ = AssemblyMorphism≡ + fg + ⟨ fg ⊚ theπ₁ , fg ⊚ theπ₂ ⟩ + (funExt λ x → ΣPathP (refl , refl)) + + module _ where + open BinProduct + ASMBinProducts : BinProducts ASM + ASMBinProducts (X , xs) (Y , ys) .binProdOb = (X × Y) , (xs ⊗ ys) + ASMBinProducts (X , xs) (Y , ys) .binProdPr₁ = π₁ {as = xs} {bs = ys} + ASMBinProducts (X , xs) (Y , ys) .binProdPr₂ = π₂ {as = xs} {bs = ys} + ASMBinProducts (X , xs) (Y , ys) .univProp {z} f g = isBinProduct⊗ xs ys z f g + + isTerminalUnitAssembly : ((Z , zs) : Σ[ Z ∈ Type ℓ ] (Assembly Z)) → isContr (AssemblyMorphism zs unitAssembly) + isTerminalUnitAssembly (Z , zs) = + inhProp→isContr (λ where + .map → (λ _ → tt*) + .tracker → ∣ k ⨾ Id , (λ _ _ _ → tt*) ∣₁) + λ f g → AssemblyMorphism≡ f g refl + + ASMTerminal : Terminal ASM + ASMTerminal = (Unit* , unitAssembly) , isTerminalUnitAssembly + + isInitialUnitAssembly : ((Z , zs) : Σ[ Z ∈ Type ℓ ] (Assembly Z)) → isContr (AssemblyMorphism emptyAssembly zs) + isInitialUnitAssembly (Z , zs) = + inhProp→isContr (λ where + .map → λ () + .tracker → ∣ Id , (λ x aₓ aₓ⊩x → rec* x) ∣₁) + λ f g → AssemblyMorphism≡ _ _ (funExt λ x → rec* x) + + ASMInitial : Initial ASM + ASMInitial = (⊥* , emptyAssembly) , isInitialUnitAssembly + + module _ {X Y Z : Type ℓ} + {xs : Assembly X} + {ys : Assembly Y} + {zs : Assembly Z} + (f : AssemblyMorphism (zs ⊗ xs) ys) where + theEval = eval {X} {Y} xs ys + ⇒isExponential : ∃![ g ∈ AssemblyMorphism zs (xs ⇒ ys) ] + ⟪ g , identityMorphism xs ⟫ ⊚ theEval ≡ f + ⇒isExponential = uniqueExists (λ where + .map z → λ where + .map x → f .map (z , x) + .tracker → do + (f~ , f~tracks) ← f .tracker + (z~ , z~realizes) ← zs .⊩surjective z + return ( (s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id) + , λ x aₓ aₓ⊩x + → subst (λ k → k ⊩Y (f .map (z , x))) + (sym (eq f~ f~tracks z (z~ , z~realizes) x aₓ aₓ⊩x)) + (pair⨾z~⨾aₓtracks f~ f~tracks z (z~ , z~realizes) x aₓ aₓ⊩x))) + .tracker → do + (f~ , f~tracker) ← f .tracker + -- λ* x. λ* y. f~ ⨾ (pair ⨾ x ⨾ y) + return ({!!} , (λ z zᵣ zᵣ⊩z x xᵣ xᵣ⊩x → {!!}))) + (AssemblyMorphism≡ _ _ (funExt (λ (z , x) → refl))) + (λ g → isSetAssemblyMorphism _ _ (⟪ g , identityMorphism xs ⟫ ⊚ theEval) f) + λ g g×id⊚eval≡f → AssemblyMorphism≡ _ _ + (funExt (λ z → AssemblyMorphism≡ _ _ + (funExt (λ x → λ i → g×id⊚eval≡f (~ i) .map (z , x))))) where + _⊩X_ = xs ._⊩_ + _⊩Y_ = ys ._⊩_ + _⊩Z_ = zs ._⊩_ + _⊩Z×X_ = (zs ⊗ xs) ._⊩_ + Z×X = Z × X + module _ (f~ : A) + (f~tracks : (∀ (zx : Z×X) (r : A) (rRealizes : (r ⊩Z×X zx)) → ((f~ ⨾ r) ⊩Y (f .map zx)))) + (z : Z) + (zRealizer : Σ[ z~ ∈ A ] (z~ ⊩Z z)) + (x : X) + (aₓ : A) + (aₓ⊩x : aₓ ⊩X x) where + z~ : A + z~ = zRealizer .fst + z~realizes = zRealizer .snd + + eq : s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id) ⨾ aₓ ≡ f~ ⨾ (pair ⨾ z~ ⨾ aₓ) + eq = + s ⨾ (k ⨾ f~) ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id) ⨾ aₓ + ≡⟨ sabc≡ac_bc _ _ _ ⟩ + (k ⨾ f~ ⨾ aₓ) ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id ⨾ aₓ) + ≡⟨ cong (λ x → x ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id ⨾ aₓ)) (kab≡a f~ aₓ) ⟩ + f~ ⨾ (s ⨾ (k ⨾ (pair ⨾ z~)) ⨾ Id ⨾ aₓ) + ≡⟨ cong (λ x → f~ ⨾ x) (sabc≡ac_bc _ _ _) ⟩ + f~ ⨾ ((k ⨾ (pair ⨾ z~) ⨾ aₓ) ⨾ (Id ⨾ aₓ)) + ≡⟨ cong (λ x → f~ ⨾ (x ⨾ (Id ⨾ aₓ))) (kab≡a (pair ⨾ z~) aₓ) ⟩ + f~ ⨾ (pair ⨾ z~ ⨾ (Id ⨾ aₓ)) + ≡⟨ cong (λ x → f~ ⨾ (pair ⨾ z~ ⨾ x)) (Ida≡a aₓ) ⟩ + f~ ⨾ (pair ⨾ z~ ⨾ aₓ) + ∎ + + pair⨾z~⨾aₓtracks : (f~ ⨾ (pair ⨾ z~ ⨾ aₓ)) ⊩Y (f .map (z , x)) + pair⨾z~⨾aₓtracks = + f~tracks + (z , x) + (pair ⨾ z~ ⨾ aₓ) + ( (subst (λ y → y ⊩Z z) (sym (pr₁pxy≡x z~ aₓ)) z~realizes) + , (subst (λ y → y ⊩X x) (sym (pr₂pxy≡y z~ aₓ)) aₓ⊩x)) + -- ASM has coequalizers + module _ + {X Y : Type ℓ} + (xs : Assembly X) + (ys : Assembly Y) + (f g : AssemblyMorphism xs ys) + where + private + _⊩X_ = xs ._⊩_ + _⊩Y_ = ys ._⊩_ + + _⊩coeq_ : (a : A) (x : SetCoequalizer (f .map) (g .map)) → hProp ℓ + a ⊩coeq x = + setCoequalizerRec + isSetHProp + (λ y → (∃[ y' ∈ Y ] (inc {f = f .map} {g = g .map} y ≡ inc y') × (a ⊩Y y')) , squash₁) + (λ x i → (∃[ y' ∈ Y ] (coeq {f = f .map} {g = g .map} x i ≡ inc y') × (a ⊩Y y')) , squash₁) + x + + coequalizer : Assembly (SetCoequalizer (f .map) (g .map)) + ⊩coeqSurjective : (x : SetCoequalizer (f .map) (g .map)) → ∃[ a ∈ A ] ((a ⊩coeq x) .fst) + + coequalizer .isSetX = squash + coequalizer ._⊩_ a x = (a ⊩coeq x) .fst + coequalizer .⊩isPropValued a x = (a ⊩coeq x) .snd + coequalizer .⊩surjective x = {!!} + + ⊩coeqSurjective x = + setCoequalizerElimProp + {C = λ b → ∃[ a ∈ A ] ((a ⊩coeq b) .fst)} + (λ x → squash₁) + (λ b → do + (b~ , b~realizes) ← ys .⊩surjective b + return (b~ , b~⊩coeq_inc_b b b~ b~realizes)) + x where + b~⊩coeq_inc_b : (b : Y) (b~ : A) (b~realizes : b~ ⊩Y b) → (b~ ⊩coeq inc b) .fst + b~⊩coeq_inc_b b b~ b~realizes = {!!} + + -- ASM is regular + module _ + {X Y : Type ℓ} + (xs : Assembly X) + (ys : Assembly Y) + (e : AssemblyMorphism xs ys) + where + _⊩X_ = xs ._⊩_ + _⊩Y_ = ys ._⊩_ + -- First, isSurjection(e .map) and surjective tracking + -- together create a regular epi in ASM + + tracksSurjection : (a : A) → Type ℓ + tracksSurjection a = ∀ y b → (b ⊩Y y) → ∃[ x ∈ X ] (e .map x ≡ y) × ((a ⨾ b) ⊩X x) + module _ + (surjection : isSurjection (e .map)) + (surjectionIsTracked : ∃[ a ∈ A ] tracksSurjection a) + where + + + \ No newline at end of file diff --git a/docs/Realizability.CombinatoryAlgebra.html b/docs/Realizability.CombinatoryAlgebra.html index 399e083..c2ea59d 100644 --- a/docs/Realizability.CombinatoryAlgebra.html +++ b/docs/Realizability.CombinatoryAlgebra.html @@ -27,17 +27,17 @@ k' = k ⨾ i ia≡a : ∀ a → i ⨾ a ≡ a - ia≡a a = (cong (λ x → x ⨾ a) refl) ∙ (sabc≡ac_bc k k a) ∙ (kab≡a a (k ⨾ a)) + ia≡a a = (cong (λ x → x ⨾ a) refl) ∙ (sabc≡ac_bc k k a) ∙ (kab≡a a (k ⨾ a)) k'ab≡b : ∀ a b → k' ⨾ a ⨾ b ≡ b k'ab≡b a b = k' ⨾ a ⨾ b - ≡⟨ refl ⟩ + ≡⟨ refl ⟩ (k ⨾ i ⨾ a ⨾ b) - ≡⟨ cong (λ x → x ⨾ b) (kab≡a i a) ⟩ + ≡⟨ cong (λ x → x ⨾ b) (kab≡a i a) ⟩ (i ⨾ b) - ≡⟨ ia≡a b ⟩ + ≡⟨ ia≡a b ⟩ b - ∎ + ∎ true : A true = k @@ -50,27 +50,27 @@ ifTrueThen : ∀ t e → if true then t else e ≡ t ifTrueThen t e = if true then t else e - ≡⟨ refl ⟩ + ≡⟨ refl ⟩ i ⨾ true ⨾ t ⨾ e - ≡⟨ cong (λ x → i ⨾ x ⨾ t ⨾ e) refl ⟩ + ≡⟨ cong (λ x → i ⨾ x ⨾ t ⨾ e) refl ⟩ i ⨾ k ⨾ t ⨾ e - ≡⟨ cong (λ x → x ⨾ t ⨾ e) (ia≡a k) ⟩ + ≡⟨ cong (λ x → x ⨾ t ⨾ e) (ia≡a k) ⟩ k ⨾ t ⨾ e - ≡⟨ kab≡a t e ⟩ + ≡⟨ kab≡a t e ⟩ t - ∎ + ∎ ifFalseElse : ∀ t e → if false then t else e ≡ e ifFalseElse t e = if false then t else e - ≡⟨ refl ⟩ + ≡⟨ refl ⟩ i ⨾ false ⨾ t ⨾ e - ≡⟨ cong (λ x → i ⨾ x ⨾ t ⨾ e) refl ⟩ + ≡⟨ cong (λ x → i ⨾ x ⨾ t ⨾ e) refl ⟩ i ⨾ k' ⨾ t ⨾ e - ≡⟨ cong (λ x → x ⨾ t ⨾ e) (ia≡a k') ⟩ + ≡⟨ cong (λ x → x ⨾ t ⨾ e) (ia≡a k') ⟩ k' ⨾ t ⨾ e - ≡⟨ k'ab≡b t e ⟩ + ≡⟨ k'ab≡b t e ⟩ e - ∎ + ∎ -- I used a Scheme script to generate this pair : A @@ -101,40 +101,40 @@ Zzero≡true : Z ⨾ (ℕ→curry zero) ≡ true Zzero≡true = Z ⨾ (ℕ→curry zero) - ≡⟨ cong (λ x → Z ⨾ x) refl ⟩ + ≡⟨ cong (λ x → Z ⨾ x) refl ⟩ Z ⨾ i - ≡⟨ cong (λ x → x ⨾ i) refl ⟩ + ≡⟨ cong (λ x → x ⨾ i) refl ⟩ s ⨾ (s ⨾ k ⨾ k) ⨾ (k ⨾ k) ⨾ i - ≡⟨ sabc≡ac_bc (s ⨾ k ⨾ k) (k ⨾ k) i ⟩ + ≡⟨ sabc≡ac_bc (s ⨾ k ⨾ k) (k ⨾ k) i ⟩ ((s ⨾ k ⨾ k) ⨾ i) ⨾ (k ⨾ k ⨾ i) - ≡⟨ cong (λ x → (x ⨾ i) ⨾ (k ⨾ k ⨾ i)) refl ⟩ + ≡⟨ cong (λ x → (x ⨾ i) ⨾ (k ⨾ k ⨾ i)) refl ⟩ (i ⨾ i) ⨾ (k ⨾ k ⨾ i) - ≡⟨ cong (λ x → x ⨾ (k ⨾ k ⨾ i)) (ia≡a i) ⟩ + ≡⟨ cong (λ x → x ⨾ (k ⨾ k ⨾ i)) (ia≡a i) ⟩ i ⨾ (k ⨾ k ⨾ i) - ≡⟨ cong (λ x → i ⨾ x) (kab≡a k i) ⟩ + ≡⟨ cong (λ x → i ⨾ x) (kab≡a k i) ⟩ i ⨾ k - ≡⟨ ia≡a k ⟩ + ≡⟨ ia≡a k ⟩ k - ∎ + ∎ Zsuc≡false : ∀ n → Z ⨾ (ℕ→curry (suc n)) ≡ false Zsuc≡false n = Z ⨾ (ℕ→curry (suc n)) - ≡⟨ cong (λ x → Z ⨾ x) refl ⟩ + ≡⟨ cong (λ x → Z ⨾ x) refl ⟩ Z ⨾ (pair ⨾ k' ⨾ (ℕ→curry n)) - ≡⟨ cong (λ x → x ⨾ (pair ⨾ k' ⨾ (ℕ→curry n))) refl ⟩ + ≡⟨ cong (λ x → x ⨾ (pair ⨾ k' ⨾ (ℕ→curry n))) refl ⟩ pr₁ ⨾ (pair ⨾ k' ⨾ (ℕ→curry n)) - ≡⟨ pr₁pxy≡x k' (ℕ→curry n) ⟩ + ≡⟨ pr₁pxy≡x k' (ℕ→curry n) ⟩ false - ∎ + ∎ S : A S = pair ⨾ k' Sn≡sucn : ∀ n → S ⨾ (ℕ→curry n) ≡ ℕ→curry (suc n) Sn≡sucn n = S ⨾ (ℕ→curry n) - ≡⟨ cong (λ x → x ⨾ (ℕ→curry n)) refl ⟩ + ≡⟨ cong (λ x → x ⨾ (ℕ→curry n)) refl ⟩ pair ⨾ k' ⨾ (ℕ→curry n) - ∎ + ∎ P : A P = s ⨾ (s ⨾ (s ⨾ (k ⨾ pr₁) ⨾ i) ⨾ (k ⨾ (ℕ→curry zero))) ⨾ (s ⨾ (k ⨾ (pr₂)) ⨾ i) @@ -148,17 +148,17 @@ Ba≡gfa : ∀ g f a → B g f ⨾ a ≡ g ⨾ (f ⨾ a) Ba≡gfa g f a = s ⨾ (k ⨾ g) ⨾ (s ⨾ (k ⨾ f) ⨾ i) ⨾ a - ≡⟨ sabc≡ac_bc (k ⨾ g) (s ⨾ (k ⨾ f) ⨾ i) a ⟩ + ≡⟨ sabc≡ac_bc (k ⨾ g) (s ⨾ (k ⨾ f) ⨾ i) a ⟩ (k ⨾ g ⨾ a) ⨾ (s ⨾ (k ⨾ f) ⨾ i ⨾ a) - ≡⟨ cong (λ x → x ⨾ (s ⨾ (k ⨾ f) ⨾ i ⨾ a)) (kab≡a g a) ⟩ + ≡⟨ cong (λ x → x ⨾ (s ⨾ (k ⨾ f) ⨾ i ⨾ a)) (kab≡a g a) ⟩ g ⨾ (s ⨾ (k ⨾ f) ⨾ i ⨾ a) - ≡⟨ cong (λ x → g ⨾ x) (sabc≡ac_bc (k ⨾ f) i a) ⟩ + ≡⟨ cong (λ x → g ⨾ x) (sabc≡ac_bc (k ⨾ f) i a) ⟩ g ⨾ ((k ⨾ f ⨾ a) ⨾ (i ⨾ a)) - ≡⟨ cong (λ x → g ⨾ (x ⨾ (i ⨾ a))) (kab≡a f a) ⟩ + ≡⟨ cong (λ x → g ⨾ (x ⨾ (i ⨾ a))) (kab≡a f a) ⟩ g ⨾ (f ⨾ (i ⨾ a)) - ≡⟨ cong (λ x → g ⨾ (f ⨾ x)) (ia≡a a) ⟩ + ≡⟨ cong (λ x → g ⨾ (f ⨾ x)) (ia≡a a) ⟩ g ⨾ (f ⨾ a) - ∎ + ∎ diff --git a/docs/Realizability.PartialApplicativeStructure.html b/docs/Realizability.PartialApplicativeStructure.html index 76fc36a..65dd9f8 100644 --- a/docs/Realizability.PartialApplicativeStructure.html +++ b/docs/Realizability.PartialApplicativeStructure.html @@ -17,7 +17,7 @@ record PartialApplicativeStructure {ℓ} (A : Type ℓ) : Type (ℓ-max ℓ (ℓ-suc 𝓢)) where infixl 20 _⨾_ field - isSetA : isSet A + isSetA : isSet A _⨾_ : A → A → ♯ A module _ {ℓ} {A : Type ℓ} (pas : PartialApplicativeStructure A) where diff --git a/docs/Realizability.PartialCombinatoryAlgebra.html b/docs/Realizability.PartialCombinatoryAlgebra.html index 1bab3aa..558a664 100644 --- a/docs/Realizability.PartialCombinatoryAlgebra.html +++ b/docs/Realizability.PartialCombinatoryAlgebra.html @@ -29,7 +29,7 @@ record Assembly : Type (ℓ-suc ℓ) where field X : Type ℓ - isSetX : isSet X + isSetX : isSet X _⊩_ : A → X → Type ℓ ⊩-covers : ∀ x → Σ[ a ∈ A ] (a ⊩ x) diff --git a/docs/Realizability.Partiality.html b/docs/Realizability.Partiality.html index feca9ed..ce3e9f2 100644 --- a/docs/Realizability.Partiality.html +++ b/docs/Realizability.Partiality.html @@ -19,7 +19,7 @@ record ♯_ {ℓ} (A : Type ℓ) : Type (ℓ-max ℓ (ℓ-suc 𝓢)) where field support : Type 𝓢 - isProp-support : isProp support + isProp-support : isProp support force : support → A open ♯_ diff --git a/docs/index.html b/docs/index.html index 2dd1f02..70cd214 100644 --- a/docs/index.html +++ b/docs/index.html @@ -8,5 +8,4 @@ open import Realizability.CombinatoryAlgebra open import Realizability.ApplicativeStructure open import Realizability.Assembly -open import Realizability.DirectedCompletePartialOrder \ No newline at end of file diff --git a/src/index.agda b/src/index.agda index b61307b..37a4eab 100644 --- a/src/index.agda +++ b/src/index.agda @@ -7,4 +7,3 @@ open import Realizability.PartialCombinatoryAlgebra open import Realizability.CombinatoryAlgebra open import Realizability.ApplicativeStructure open import Realizability.Assembly -open import Realizability.DirectedCompletePartialOrder