fredefox/cat
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Expose naturalIsProp

Browse source
This commit is contained in:
Frederik Hanghøj Iversen 2018-02-23 11:12:27 +01:00
parent bc2129b8fc
commit 954a89f8d1
1 changed files with 44 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

94
src/Cat/Categories/Fun.agda
View file

@ -38,9 +38,6 @@ module _ {ℓc ℓc' ℓd ℓd' : Level} {ℂ : Category ℓc ℓc'} {𝔻 : Cat
→ (f : ℂ [ A , B ]) → (f : ℂ [ A , B ])
→ 𝔻 [ θ B ∘ F.func→ f ] ≡ 𝔻 [ G.func→ f ∘ θ A ] → 𝔻 [ θ B ∘ F.func→ f ] ≡ 𝔻 [ G.func→ f ∘ θ A ]
-- naturalIsProp : ∀ θ → isProp (Natural θ)
-- naturalIsProp θ x y = {!funExt!}
NaturalTransformation : Set (ℓc ⊔ ℓc' ⊔ ℓd') NaturalTransformation : Set (ℓc ⊔ ℓc' ⊔ ℓd')
NaturalTransformation = Σ Transformation Natural NaturalTransformation = Σ Transformation Natural
@ -100,59 +97,56 @@ module _ {ℓc ℓc' ℓd ℓd' : Level} {ℂ : Category ℓc ℓc'} {𝔻 : Cat
NatComp = _:⊕:_ NatComp = _:⊕:_
private private
module _ {F G : Functor ℂ 𝔻} where module 𝔻 = Category 𝔻
module 𝔻 = Category 𝔻
transformationIsSet : isSet (Transformation F G) module _ {F G : Functor ℂ 𝔻} where
transformationIsSet _ _ p q i j C = 𝔻.arrowIsSet _ _ (λ l → p l C) (λ l → q l C) i j transformationIsSet : isSet (Transformation F G)
IsSet' : {ℓ : Level} (A : Set ℓ) → Set ℓ transformationIsSet _ _ p q i j C = 𝔻.arrowIsSet _ _ (λ l → p l C) (λ l → q l C) i j
IsSet' A = {x y : A} → (p q : (λ _ → A) [ x ≡ y ]) → p ≡ q
naturalIsProp : (θ : Transformation F G) → isProp (Natural F G θ) naturalIsProp : (θ : Transformation F G) → isProp (Natural F G θ)
naturalIsProp θ θNat θNat' = lem naturalIsProp θ θNat θNat' = lem
where where
lem : (λ _ → Natural F G θ) [ (λ f → θNat f) ≡ (λ f → θNat' f) ] lem : (λ _ → Natural F G θ) [ (λ f → θNat f) ≡ (λ f → θNat' f) ]
lem = λ i f → 𝔻.arrowIsSet _ _ (θNat f) (θNat' f) i lem = λ i f → 𝔻.arrowIsSet _ _ (θNat f) (θNat' f) i
naturalTransformationIsSets : isSet (NaturalTransformation F G) naturalTransformationIsSets : isSet (NaturalTransformation F G)
naturalTransformationIsSets = sigPresSet transformationIsSet naturalTransformationIsSets = sigPresSet transformationIsSet
λ θ → ntypeCommulative λ θ → ntypeCommulative
(s≤s {n = Nat.suc Nat.zero} z≤n) (s≤s {n = Nat.suc Nat.zero} z≤n)
(naturalIsProp θ) (naturalIsProp θ)
module _ {A B C D : Functor ℂ 𝔻} {θ' : NaturalTransformation A B} module _ {A B C D : Functor ℂ 𝔻} {θ' : NaturalTransformation A B}
{η' : NaturalTransformation B C} {ζ' : NaturalTransformation C D} where {η' : NaturalTransformation B C} {ζ' : NaturalTransformation C D} where
private private
θ = proj₁ θ' θ = proj₁ θ'
η = proj₁ η' η = proj₁ η'
ζ = proj₁ ζ' ζ = proj₁ ζ'
θNat = proj₂ θ' θNat = proj₂ θ'
ηNat = proj₂ η' ηNat = proj₂ η'
ζNat = proj₂ ζ' ζNat = proj₂ ζ'
L : NaturalTransformation A D L : NaturalTransformation A D
L = (_:⊕:_ {A} {C} {D} ζ' (_:⊕:_ {A} {B} {C} η' θ')) L = (_:⊕:_ {A} {C} {D} ζ' (_:⊕:_ {A} {B} {C} η' θ'))
R : NaturalTransformation A D R : NaturalTransformation A D
R = (_:⊕:_ {A} {B} {D} (_:⊕:_ {B} {C} {D} ζ' η') θ') R = (_:⊕:_ {A} {B} {D} (_:⊕:_ {B} {C} {D} ζ' η') θ')
_g⊕f_ = _:⊕:_ {A} {B} {C} _g⊕f_ = _:⊕:_ {A} {B} {C}
_h⊕g_ = _:⊕:_ {B} {C} {D} _h⊕g_ = _:⊕:_ {B} {C} {D}
:assoc: : L ≡ R :assoc: : L ≡ R
:assoc: = lemSig (naturalIsProp {F = A} {D}) :assoc: = lemSig (naturalIsProp {F = A} {D})
L R (funExt (λ x → assoc)) L R (funExt (λ x → assoc))
where where
open Category 𝔻 open Category 𝔻
private
module _ {A B : Functor ℂ 𝔻} {f : NaturalTransformation A B} where module _ {A B : Functor ℂ 𝔻} {f : NaturalTransformation A B} where
private allNatural = naturalIsProp {F = A} {B}
allNatural = naturalIsProp {F = A} {B} f' = proj₁ f
f' = proj₁ f eq-r : ∀ C → (𝔻 [ f' C ∘ identityTrans A C ]) ≡ f' C
module 𝔻Data = Category 𝔻 eq-r C = begin
eq-r : ∀ C → (𝔻 [ f' C ∘ identityTrans A C ]) ≡ f' C 𝔻 [ f' C ∘ identityTrans A C ] ≡⟨⟩
eq-r C = begin 𝔻 [ f' C ∘ 𝔻.𝟙 ] ≡⟨ proj₁ 𝔻.ident ⟩
𝔻 [ f' C ∘ identityTrans A C ] ≡⟨⟩ f' C ∎
𝔻 [ f' C ∘ 𝔻Data.𝟙 ] ≡⟨ proj₁ (𝔻.ident {A} {B}) ⟩ eq-l : ∀ C → (𝔻 [ identityTrans B C ∘ f' C ]) ≡ f' C
f' C ∎ eq-l C = proj₂ 𝔻.ident
eq-l : ∀ C → (𝔻 [ identityTrans B C ∘ f' C ]) ≡ f' C
eq-l C = proj₂ (𝔻.ident {A} {B})
ident-r : (_:⊕:_ {A} {A} {B} f (identityNat A)) ≡ f ident-r : (_:⊕:_ {A} {A} {B} f (identityNat A)) ≡ f
ident-r = lemSig allNatural _ _ (funExt eq-r) ident-r = lemSig allNatural _ _ (funExt eq-r)
ident-l : (_:⊕:_ {A} {B} {B} (identityNat B) f) ≡ f ident-l : (_:⊕:_ {A} {B} {B} (identityNat B) f) ≡ f