diff --git a/src/Cat/Categories/Cat.agda b/src/Cat/Categories/Cat.agda index da421e9..55d717c 100644 --- a/src/Cat/Categories/Cat.agda +++ b/src/Cat/Categories/Cat.agda @@ -72,16 +72,20 @@ module CatProduct {โ„“ โ„“' : Level} (โ„‚ ๐”ป : Category โ„“ โ„“') where = ฮฃโ‰ก (fst โ„‚.isIdentity) (fst ๐”ป.isIdentity) , ฮฃโ‰ก (snd โ„‚.isIdentity) (snd ๐”ป.isIdentity) + isPreCategory : IsPreCategory rawProduct + IsPreCategory.isAssociative isPreCategory = ฮฃโ‰ก โ„‚.isAssociative ๐”ป.isAssociative + IsPreCategory.isIdentity isPreCategory = isIdentity + IsPreCategory.arrowsAreSets isPreCategory = arrowsAreSets + postulate univalent : Univalence.Univalent isIdentity - instance - isCategory : IsCategory rawProduct - IsCategory.isAssociative isCategory = ฮฃโ‰ก โ„‚.isAssociative ๐”ป.isAssociative - IsCategory.isIdentity isCategory = isIdentity - IsCategory.arrowsAreSets isCategory = arrowsAreSets - IsCategory.univalent isCategory = univalent + + isCategory : IsCategory rawProduct + IsCategory.isPreCategory isCategory = isPreCategory + IsCategory.univalent isCategory = univalent object : Category โ„“ โ„“' Category.raw object = rawProduct + Category.isCategory object = isCategory fstF : Functor object โ„‚ fstF = record diff --git a/src/Cat/Categories/Fam.agda b/src/Cat/Categories/Fam.agda index 897d6e0..e90838c 100644 --- a/src/Cat/Categories/Fam.agda +++ b/src/Cat/Categories/Fam.agda @@ -35,29 +35,31 @@ module _ (โ„“a โ„“b : Level) where open import Cubical.NType.Properties open import Cubical.Sigma - instance - isCategory : IsCategory RawFam - isCategory = record - { isAssociative = ฮป {A} {B} {C} {D} {f} {g} {h} โ†’ isAssociative {A} {B} {C} {D} {f} {g} {h} - ; isIdentity = ฮป {A} {B} {f} โ†’ isIdentity {A} {B} {f = f} - ; arrowsAreSets = ฮป { - {((A , hA) , famA)} - {((B , hB) , famB)} - โ†’ setSig - {sA = setPi ฮป _ โ†’ hB} - {sB = ฮป f โ†’ - let - helpr : isSet ((a : A) โ†’ fst (famA a) โ†’ fst (famB (f a))) - helpr = setPi ฮป a โ†’ setPi ฮป _ โ†’ snd (famB (f a)) - -- It's almost like above, but where the first argument is - -- implicit. - res : isSet ({a : A} โ†’ fst (famA a) โ†’ fst (famB (f a))) - res = {!!} - in res - } - } - ; univalent = {!!} + + isPreCategory : IsPreCategory RawFam + IsPreCategory.isAssociative isPreCategory + {A} {B} {C} {D} {f} {g} {h} = isAssociative {A} {B} {C} {D} {f} {g} {h} + IsPreCategory.isIdentity isPreCategory + {A} {B} {f} = isIdentity {A} {B} {f = f} + IsPreCategory.arrowsAreSets isPreCategory + {(A , hA) , famA} {(B , hB) , famB} + = setSig + {sA = setPi ฮป _ โ†’ hB} + {sB = ฮป f โ†’ + let + helpr : isSet ((a : A) โ†’ fst (famA a) โ†’ fst (famB (f a))) + helpr = setPi ฮป a โ†’ setPi ฮป _ โ†’ snd (famB (f a)) + -- It's almost like above, but where the first argument is + -- implicit. + res : isSet ({a : A} โ†’ fst (famA a) โ†’ fst (famB (f a))) + res = {!!} + in res } + isCategory : IsCategory RawFam + IsCategory.isPreCategory isCategory = isPreCategory + IsCategory.univalent isCategory = {!!} + Fam : Category (lsuc (โ„“a โŠ” โ„“b)) (โ„“a โŠ” โ„“b) Category.raw Fam = RawFam + Category.isCategory Fam = isCategory diff --git a/src/Cat/Categories/Free.agda b/src/Cat/Categories/Free.agda index 29d6bbe..d004467 100644 --- a/src/Cat/Categories/Free.agda +++ b/src/Cat/Categories/Free.agda @@ -61,6 +61,12 @@ module _ {โ„“a โ„“b : Level} (โ„‚ : Category โ„“a โ„“b) where arrowsAreSets : isSet (Path โ„‚.Arrow A B) arrowsAreSets a b p q = {!!} + isPreCategory : IsPreCategory RawFree + IsPreCategory.isAssociative isPreCategory {f = f} {g} {h} = isAssociative {r = f} {g} {h} + IsPreCategory.isIdentity isPreCategory = isIdentity + IsPreCategory.arrowsAreSets isPreCategory = arrowsAreSets + + module _ {A B : โ„‚.Object} where eqv : isEquiv (A โ‰ก B) (A โ‰… B) (Univalence.id-to-iso isIdentity A B) eqv = {!!} @@ -68,9 +74,7 @@ module _ {โ„“a โ„“b : Level} (โ„‚ : Category โ„“a โ„“b) where univalent = eqv isCategory : IsCategory RawFree - IsCategory.isAssociative isCategory {f = f} {g} {h} = isAssociative {r = f} {g} {h} - IsCategory.isIdentity isCategory = isIdentity - IsCategory.arrowsAreSets isCategory = arrowsAreSets + IsCategory.isPreCategory isCategory = isPreCategory IsCategory.univalent isCategory = univalent Free : Category _ _ diff --git a/src/Cat/Categories/Fun.agda b/src/Cat/Categories/Fun.agda index 63e6f1b..60ee5e7 100644 --- a/src/Cat/Categories/Fun.agda +++ b/src/Cat/Categories/Fun.agda @@ -10,20 +10,28 @@ import Cat.Category.NaturalTransformation module Fun {โ„“c โ„“c' โ„“d โ„“d' : Level} (โ„‚ : Category โ„“c โ„“c') (๐”ป : Category โ„“d โ„“d') where open NaturalTransformation โ„‚ ๐”ป public hiding (module Properties) - open NaturalTransformation.Properties โ„‚ ๐”ป private module โ„‚ = Category โ„‚ module ๐”ป = Category ๐”ป - -- Functor categories. Objects are functors, arrows are natural transformations. - raw : RawCategory (โ„“c โŠ” โ„“c' โŠ” โ„“d โŠ” โ„“d') (โ„“c โŠ” โ„“c' โŠ” โ„“d') - RawCategory.Object raw = Functor โ„‚ ๐”ป - RawCategory.Arrow raw = NaturalTransformation - RawCategory.identity raw {F} = identity F - RawCategory._โˆ˜_ raw {F} {G} {H} = NT[_โˆ˜_] {F} {G} {H} + module _ where + -- Functor categories. Objects are functors, arrows are natural transformations. + raw : RawCategory (โ„“c โŠ” โ„“c' โŠ” โ„“d โŠ” โ„“d') (โ„“c โŠ” โ„“c' โŠ” โ„“d') + RawCategory.Object raw = Functor โ„‚ ๐”ป + RawCategory.Arrow raw = NaturalTransformation + RawCategory.identity raw {F} = identity F + RawCategory._โˆ˜_ raw {F} {G} {H} = NT[_โˆ˜_] {F} {G} {H} - open RawCategory raw hiding (identity) - open Univalence (ฮป {A} {B} {f} โ†’ isIdentity {F = A} {B} {f}) + module _ where + open RawCategory raw hiding (identity) + open NaturalTransformation.Properties โ„‚ ๐”ป + + isPreCategory : IsPreCategory raw + IsPreCategory.isAssociative isPreCategory {A} {B} {C} {D} = isAssociative {A} {B} {C} {D} + IsPreCategory.isIdentity isPreCategory {A} {B} = isIdentity {A} {B} + IsPreCategory.arrowsAreSets isPreCategory {F} {G} = naturalTransformationIsSet {F} {G} + + open IsPreCategory isPreCategory hiding (identity) module _ (F : Functor โ„‚ ๐”ป) where center : ฮฃ[ G โˆˆ Object ] (F โ‰… G) @@ -167,17 +175,15 @@ module Fun {โ„“c โ„“c' โ„“d โ„“d' : Level} (โ„‚ : Category โ„“c โ„“c') (๐”ป : C re-ve : (x : A โ‰ก B) โ†’ reverse (obverse x) โ‰ก x re-ve = {!!} - done : isEquiv (A โ‰ก B) (A โ‰… B) (Univalence.id-to-iso (ฮป { {A} {B} โ†’ isIdentity {F = A} {B}}) A B) + done : isEquiv (A โ‰ก B) (A โ‰… B) (id-to-iso A B) done = {!gradLemma obverse reverse ve-re re-ve!} - -- univalent : Univalent - -- univalent = done + univalent : Univalent + univalent = {!done!} isCategory : IsCategory raw - IsCategory.isAssociative isCategory {A} {B} {C} {D} = isAssociative {A} {B} {C} {D} - IsCategory.isIdentity isCategory {A} {B} = isIdentity {A} {B} - IsCategory.arrowsAreSets isCategory {F} {G} = naturalTransformationIsSet {F} {G} - IsCategory.univalent isCategory = {!!} + IsCategory.isPreCategory isCategory = isPreCategory + IsCategory.univalent isCategory = univalent Fun : Category (โ„“c โŠ” โ„“c' โŠ” โ„“d โŠ” โ„“d') (โ„“c โŠ” โ„“c' โŠ” โ„“d') Category.raw Fun = raw @@ -199,26 +205,26 @@ module _ {โ„“ โ„“' : Level} (โ„‚ : Category โ„“ โ„“') where ; _โˆ˜_ = ฮป {F G H} โ†’ NT[_โˆ˜_] {F = F} {G = G} {H = H} } - isCategory : IsCategory raw - isCategory = record - { isAssociative = - ฮป{ {A} {B} {C} {D} {f} {g} {h} - โ†’ F.isAssociative {A} {B} {C} {D} {f} {g} {h} - } - ; isIdentity = - ฮป{ {A} {B} {f} - โ†’ F.isIdentity {A} {B} {f} - } - ; arrowsAreSets = - ฮป{ {A} {B} - โ†’ F.arrowsAreSets {A} {B} - } - ; univalent = - ฮป{ {A} {B} - โ†’ F.univalent {A} {B} - } - } + -- isCategory : IsCategory raw + -- isCategory = record + -- { isAssociative = + -- ฮป{ {A} {B} {C} {D} {f} {g} {h} + -- โ†’ F.isAssociative {A} {B} {C} {D} {f} {g} {h} + -- } + -- ; isIdentity = + -- ฮป{ {A} {B} {f} + -- โ†’ F.isIdentity {A} {B} {f} + -- } + -- ; arrowsAreSets = + -- ฮป{ {A} {B} + -- โ†’ F.arrowsAreSets {A} {B} + -- } + -- ; univalent = + -- ฮป{ {A} {B} + -- โ†’ F.univalent {A} {B} + -- } + -- } - Presh : Category (โ„“ โŠ” lsuc โ„“') (โ„“ โŠ” โ„“') - Category.raw Presh = raw - Category.isCategory Presh = isCategory + -- Presh : Category (โ„“ โŠ” lsuc โ„“') (โ„“ โŠ” โ„“') + -- Category.raw Presh = raw + -- Category.isCategory Presh = isCategory diff --git a/src/Cat/Categories/Rel.agda b/src/Cat/Categories/Rel.agda index e4e9edc..6b08717 100644 --- a/src/Cat/Categories/Rel.agda +++ b/src/Cat/Categories/Rel.agda @@ -157,10 +157,12 @@ RawRel = record ; _โˆ˜_ = ฮป {A B C} S R โ†’ ฮป {( a , c ) โ†’ ฮฃ[ b โˆˆ B ] ( (a , b) โˆˆ R ร— (b , c) โˆˆ S )} } -RawIsCategoryRel : IsCategory RawRel -RawIsCategoryRel = record - { isAssociative = funExt is-isAssociative - ; isIdentity = funExt ident-l , funExt ident-r - ; arrowsAreSets = {!!} - ; univalent = {!!} - } +isPreCategory : IsPreCategory RawRel + +IsPreCategory.isAssociative isPreCategory = funExt is-isAssociative +IsPreCategory.isIdentity isPreCategory = funExt ident-l , funExt ident-r +IsPreCategory.arrowsAreSets isPreCategory = {!!} + +Rel : PreCategory _ _ +PreCategory.raw Rel = RawRel +PreCategory.isPreCategory Rel = isPreCategory diff --git a/src/Cat/Categories/Sets.agda b/src/Cat/Categories/Sets.agda index 683192b..a323481 100644 --- a/src/Cat/Categories/Sets.agda +++ b/src/Cat/Categories/Sets.agda @@ -34,16 +34,23 @@ module _ (โ„“ : Level) where RawCategory.identity SetsRaw = Function.id RawCategory._โˆ˜_ SetsRaw = Function._โˆ˜โ€ฒ_ - open RawCategory SetsRaw hiding (_โˆ˜_) + module _ where + private + open RawCategory SetsRaw hiding (_โˆ˜_) - isIdentity : IsIdentity Function.id - fst isIdentity = funExt ฮป _ โ†’ refl - snd isIdentity = funExt ฮป _ โ†’ refl + isIdentity : IsIdentity Function.id + fst isIdentity = funExt ฮป _ โ†’ refl + snd isIdentity = funExt ฮป _ โ†’ refl - open Univalence (ฮป {A} {B} {f} โ†’ isIdentity {A} {B} {f}) + arrowsAreSets : ArrowsAreSets + arrowsAreSets {B = (_ , s)} = setPi ฮป _ โ†’ s - arrowsAreSets : ArrowsAreSets - arrowsAreSets {B = (_ , s)} = setPi ฮป _ โ†’ s + isPreCat : IsPreCategory SetsRaw + IsPreCategory.isAssociative isPreCat = refl + IsPreCategory.isIdentity isPreCat {A} {B} = isIdentity {A} {B} + IsPreCategory.arrowsAreSets isPreCat {A} {B} = arrowsAreSets {A} {B} + + open IsPreCategory isPreCat hiding (_โˆ˜_) isIso = Eqv.Isomorphism module _ {hA hB : hSet โ„“} where @@ -255,9 +262,7 @@ module _ (โ„“ : Level) where univalent = from[Contr] univalent[Contr] SetsIsCategory : IsCategory SetsRaw - IsCategory.isAssociative SetsIsCategory = refl - IsCategory.isIdentity SetsIsCategory {A} {B} = isIdentity {A} {B} - IsCategory.arrowsAreSets SetsIsCategory {A} {B} = arrowsAreSets {A} {B} + IsCategory.isPreCategory SetsIsCategory = isPreCat IsCategory.univalent SetsIsCategory = univalent ๐“ข๐“ฎ๐“ฝ Sets : Category (lsuc โ„“) โ„“ diff --git a/src/Cat/Category.agda b/src/Cat/Category.agda index a847eb9..b182e02 100644 --- a/src/Cat/Category.agda +++ b/src/Cat/Category.agda @@ -203,15 +203,13 @@ record RawCategory (โ„“a โ„“b : Level) : Set (lsuc (โ„“a โŠ” โ„“b)) where -- -- Sans `univalent` this would be what is referred to as a pre-category in -- [HoTT]. -record IsCategory {โ„“a โ„“b : Level} (โ„‚ : RawCategory โ„“a โ„“b) : Set (lsuc (โ„“a โŠ” โ„“b)) where +record IsPreCategory {โ„“a โ„“b : Level} (โ„‚ : RawCategory โ„“a โ„“b) : Set (lsuc (โ„“a โŠ” โ„“b)) where open RawCategory โ„‚ public field isAssociative : IsAssociative isIdentity : IsIdentity identity arrowsAreSets : ArrowsAreSets open Univalence isIdentity public - field - univalent : Univalent leftIdentity : {A B : Object} {f : Arrow A B} โ†’ identity โˆ˜ f โ‰ก f leftIdentity {A} {B} {f} = fst (isIdentity {A = A} {B} {f}) @@ -251,6 +249,83 @@ record IsCategory {โ„“a โ„“b : Level} (โ„‚ : RawCategory โ„“a โ„“b) : Set (lsuc isoโ†’epiร—mono : Isomorphism f โ†’ Epimorphism {X = X} f ร— Monomorphism {X = X} f isoโ†’epiร—mono iso = isoโ†’epi iso , isoโ†’mono iso + propIsAssociative : isProp IsAssociative + propIsAssociative x y i = arrowsAreSets _ _ x y i + + propIsIdentity : โˆ€ {f : โˆ€ {A} โ†’ Arrow A A} โ†’ isProp (IsIdentity f) + propIsIdentity a b i + = arrowsAreSets _ _ (fst a) (fst b) i + , arrowsAreSets _ _ (snd a) (snd b) i + + propArrowIsSet : isProp (โˆ€ {A B} โ†’ isSet (Arrow A B)) + propArrowIsSet a b i = isSetIsProp a b i + + propIsInverseOf : โˆ€ {A B f g} โ†’ isProp (IsInverseOf {A} {B} f g) + propIsInverseOf x y = ฮป i โ†’ + let + h : fst x โ‰ก fst y + h = arrowsAreSets _ _ (fst x) (fst y) + hh : snd x โ‰ก snd y + hh = arrowsAreSets _ _ (snd x) (snd y) + in h i , hh i + + module _ {A B : Object} {f : Arrow A B} where + isoIsProp : isProp (Isomorphism f) + isoIsProp a@(g , ฮท , ฮต) a'@(g' , ฮท' , ฮต') = + lemSig (ฮป g โ†’ propIsInverseOf) a a' geq + where + geq : g โ‰ก g' + geq = begin + g โ‰กโŸจ sym rightIdentity โŸฉ + g โˆ˜ identity โ‰กโŸจ cong (ฮป ฯ† โ†’ g โˆ˜ ฯ†) (sym ฮต') โŸฉ + g โˆ˜ (f โˆ˜ g') โ‰กโŸจ isAssociative โŸฉ + (g โˆ˜ f) โˆ˜ g' โ‰กโŸจ cong (ฮป ฯ† โ†’ ฯ† โˆ˜ g') ฮท โŸฉ + identity โˆ˜ g' โ‰กโŸจ leftIdentity โŸฉ + g' โˆŽ + + propIsInitial : โˆ€ I โ†’ isProp (IsInitial I) + propIsInitial I x y i {X} = res X i + where + module _ (X : Object) where + open ฮฃ (x {X}) renaming (fst to fx ; snd to cx) + open ฮฃ (y {X}) renaming (fst to fy ; snd to cy) + fp : fx โ‰ก fy + fp = cx fy + prop : (x : Arrow I X) โ†’ isProp (โˆ€ f โ†’ x โ‰ก f) + prop x = propPi (ฮป y โ†’ arrowsAreSets x y) + cp : (ฮป i โ†’ โˆ€ f โ†’ fp i โ‰ก f) [ cx โ‰ก cy ] + cp = lemPropF prop fp + res : (fx , cx) โ‰ก (fy , cy) + res i = fp i , cp i + + propIsTerminal : โˆ€ T โ†’ isProp (IsTerminal T) + propIsTerminal T x y i {X} = res X i + where + module _ (X : Object) where + open ฮฃ (x {X}) renaming (fst to fx ; snd to cx) + open ฮฃ (y {X}) renaming (fst to fy ; snd to cy) + fp : fx โ‰ก fy + fp = cx fy + prop : (x : Arrow X T) โ†’ isProp (โˆ€ f โ†’ x โ‰ก f) + prop x = propPi (ฮป y โ†’ arrowsAreSets x y) + cp : (ฮป i โ†’ โˆ€ f โ†’ fp i โ‰ก f) [ cx โ‰ก cy ] + cp = lemPropF prop fp + res : (fx , cx) โ‰ก (fy , cy) + res i = fp i , cp i + +record PreCategory (โ„“a โ„“b : Level) : Set (lsuc (โ„“a โŠ” โ„“b)) where + field + raw : RawCategory โ„“a โ„“b + isPreCategory : IsPreCategory raw + open IsPreCategory isPreCategory public + +record IsCategory {โ„“a โ„“b : Level} (โ„‚ : RawCategory โ„“a โ„“b) : Set (lsuc (โ„“a โŠ” โ„“b)) where + field + isPreCategory : IsPreCategory โ„‚ + open IsPreCategory isPreCategory public + field + univalent : Univalent + -- | The formulation of univalence expressed with _โ‰ƒ_ is trivially admissable - -- just "forget" the equivalence. univalentโ‰ƒ : Univalentโ‰ƒ @@ -264,58 +339,9 @@ record IsCategory {โ„“a โ„“b : Level} (โ„‚ : RawCategory โ„“a โ„“b) : Set (lsuc -- | All projections are propositions. module Propositionality where - propIsAssociative : isProp IsAssociative - propIsAssociative x y i = arrowsAreSets _ _ x y i - - propIsIdentity : โˆ€ {f : โˆ€ {A} โ†’ Arrow A A} โ†’ isProp (IsIdentity f) - propIsIdentity a b i - = arrowsAreSets _ _ (fst a) (fst b) i - , arrowsAreSets _ _ (snd a) (snd b) i - - propArrowIsSet : isProp (โˆ€ {A B} โ†’ isSet (Arrow A B)) - propArrowIsSet a b i = isSetIsProp a b i - - propIsInverseOf : โˆ€ {A B f g} โ†’ isProp (IsInverseOf {A} {B} f g) - propIsInverseOf x y = ฮป i โ†’ - let - h : fst x โ‰ก fst y - h = arrowsAreSets _ _ (fst x) (fst y) - hh : snd x โ‰ก snd y - hh = arrowsAreSets _ _ (snd x) (snd y) - in h i , hh i - - module _ {A B : Object} {f : Arrow A B} where - isoIsProp : isProp (Isomorphism f) - isoIsProp a@(g , ฮท , ฮต) a'@(g' , ฮท' , ฮต') = - lemSig (ฮป g โ†’ propIsInverseOf) a a' geq - where - geq : g โ‰ก g' - geq = begin - g โ‰กโŸจ sym rightIdentity โŸฉ - g โˆ˜ identity โ‰กโŸจ cong (ฮป ฯ† โ†’ g โˆ˜ ฯ†) (sym ฮต') โŸฉ - g โˆ˜ (f โˆ˜ g') โ‰กโŸจ isAssociative โŸฉ - (g โˆ˜ f) โˆ˜ g' โ‰กโŸจ cong (ฮป ฯ† โ†’ ฯ† โˆ˜ g') ฮท โŸฉ - identity โˆ˜ g' โ‰กโŸจ leftIdentity โŸฉ - g' โˆŽ - propUnivalent : isProp Univalent propUnivalent a b i = propPi (ฮป iso โ†’ propIsContr) a b i - propIsTerminal : โˆ€ T โ†’ isProp (IsTerminal T) - propIsTerminal T x y i {X} = res X i - where - module _ (X : Object) where - open ฮฃ (x {X}) renaming (fst to fx ; snd to cx) - open ฮฃ (y {X}) renaming (fst to fy ; snd to cy) - fp : fx โ‰ก fy - fp = cx fy - prop : (x : Arrow X T) โ†’ isProp (โˆ€ f โ†’ x โ‰ก f) - prop x = propPi (ฮป y โ†’ arrowsAreSets x y) - cp : (ฮป i โ†’ โˆ€ f โ†’ fp i โ‰ก f) [ cx โ‰ก cy ] - cp = lemPropF prop fp - res : (fx , cx) โ‰ก (fy , cy) - res i = fp i , cp i - -- | Terminal objects are propositional - a.k.a uniqueness of terminal -- | objects. -- @@ -353,20 +379,6 @@ record IsCategory {โ„“a โ„“b : Level} (โ„‚ : RawCategory โ„“a โ„“b) : Set (lsuc res i = p0 i , p1 i -- Merely the dual of the above statement. - propIsInitial : โˆ€ I โ†’ isProp (IsInitial I) - propIsInitial I x y i {X} = res X i - where - module _ (X : Object) where - open ฮฃ (x {X}) renaming (fst to fx ; snd to cx) - open ฮฃ (y {X}) renaming (fst to fy ; snd to cy) - fp : fx โ‰ก fy - fp = cx fy - prop : (x : Arrow I X) โ†’ isProp (โˆ€ f โ†’ x โ‰ก f) - prop x = propPi (ฮป y โ†’ arrowsAreSets x y) - cp : (ฮป i โ†’ โˆ€ f โ†’ fp i โ‰ก f) [ cx โ‰ก cy ] - cp = lemPropF prop fp - res : (fx , cx) โ‰ก (fy , cy) - res i = fp i , cp i propInitial : isProp Initial propInitial Xi Yi = res @@ -404,6 +416,23 @@ module _ {โ„“a โ„“b : Level} (โ„‚ : RawCategory โ„“a โ„“b) where open RawCategory โ„‚ open Univalence private + module _ (x y : IsPreCategory โ„‚) where + module x = IsPreCategory x + module y = IsPreCategory y + -- In a few places I use the result of propositionality of the various + -- projections of `IsCategory` - Here I arbitrarily chose to use this + -- result from `x : IsCategory C`. I don't know which (if any) possibly + -- adverse effects this may have. + -- module Prop = X.Propositionality + + propIsPreCategory : x โ‰ก y + IsPreCategory.isAssociative (propIsPreCategory i) + = x.propIsAssociative x.isAssociative y.isAssociative i + IsPreCategory.isIdentity (propIsPreCategory i) + = x.propIsIdentity x.isIdentity y.isIdentity i + IsPreCategory.arrowsAreSets (propIsPreCategory i) + = x.propArrowIsSet x.arrowsAreSets y.arrowsAreSets i + module _ (x y : IsCategory โ„‚) where module X = IsCategory x module Y = IsCategory y @@ -414,7 +443,7 @@ module _ {โ„“a โ„“b : Level} (โ„‚ : RawCategory โ„“a โ„“b) where module Prop = X.Propositionality isIdentity : (ฮป _ โ†’ IsIdentity identity) [ X.isIdentity โ‰ก Y.isIdentity ] - isIdentity = Prop.propIsIdentity X.isIdentity Y.isIdentity + isIdentity = X.propIsIdentity X.isIdentity Y.isIdentity U : โˆ€ {a : IsIdentity identity} โ†’ (ฮป _ โ†’ IsIdentity identity) [ X.isIdentity โ‰ก a ] @@ -434,10 +463,13 @@ module _ {โ„“a โ„“b : Level} (โ„‚ : RawCategory โ„“a โ„“b) where eqUni : U isIdentity Y.univalent eqUni = helper Y.univalent done : x โ‰ก y - IsCategory.isAssociative (done i) = Prop.propIsAssociative X.isAssociative Y.isAssociative i - IsCategory.isIdentity (done i) = isIdentity i - IsCategory.arrowsAreSets (done i) = Prop.propArrowIsSet X.arrowsAreSets Y.arrowsAreSets i + IsCategory.isPreCategory (done i) + = propIsPreCategory X.isPreCategory Y.isPreCategory i IsCategory.univalent (done i) = eqUni i + -- IsCategory.isAssociative (done i) = Prop.propIsAssociative X.isAssociative Y.isAssociative i + -- IsCategory.isIdentity (done i) = isIdentity i + -- IsCategory.arrowsAreSets (done i) = Prop.propArrowIsSet X.arrowsAreSets Y.arrowsAreSets i + -- IsCategory.univalent (done i) = eqUni i propIsCategory : isProp (IsCategory โ„‚) propIsCategory = done @@ -486,19 +518,25 @@ module _ {โ„“a โ„“b : Level} (โ„‚ : Category โ„“a โ„“b) where module Opposite {โ„“a โ„“b : Level} where module _ (โ„‚ : Category โ„“a โ„“b) where private - module โ„‚ = Category โ„‚ - opRaw : RawCategory โ„“a โ„“b - RawCategory.Object opRaw = โ„‚.Object - RawCategory.Arrow opRaw = Function.flip โ„‚.Arrow - RawCategory.identity opRaw = โ„‚.identity - RawCategory._โˆ˜_ opRaw = Function.flip โ„‚._โˆ˜_ + module _ where + module โ„‚ = Category โ„‚ + opRaw : RawCategory โ„“a โ„“b + RawCategory.Object opRaw = โ„‚.Object + RawCategory.Arrow opRaw = Function.flip โ„‚.Arrow + RawCategory.identity opRaw = โ„‚.identity + RawCategory._โˆ˜_ opRaw = Function.flip โ„‚._โˆ˜_ - open RawCategory opRaw + open RawCategory opRaw - isIdentity : IsIdentity identity - isIdentity = swap โ„‚.isIdentity + isIdentity : IsIdentity identity + isIdentity = swap โ„‚.isIdentity - open Univalence isIdentity + isPreCategory : IsPreCategory opRaw + IsPreCategory.isAssociative isPreCategory = sym โ„‚.isAssociative + IsPreCategory.isIdentity isPreCategory = isIdentity + IsPreCategory.arrowsAreSets isPreCategory = โ„‚.arrowsAreSets + + open IsPreCategory isPreCategory module _ {A B : โ„‚.Object} where open import Cat.Equivalence as Equivalence hiding (_โ‰…_) @@ -571,9 +609,7 @@ module Opposite {โ„“a โ„“b : Level} where univalent = Equivโ‰ƒ.fromIso _ _ h isCategory : IsCategory opRaw - IsCategory.isAssociative isCategory = sym โ„‚.isAssociative - IsCategory.isIdentity isCategory = isIdentity - IsCategory.arrowsAreSets isCategory = โ„‚.arrowsAreSets + IsCategory.isPreCategory isCategory = isPreCategory IsCategory.univalent isCategory = univalent opposite : Category โ„“a โ„“b diff --git a/src/Cat/Category/Product.agda b/src/Cat/Category/Product.agda index ac5ac14..9a77477 100644 --- a/src/Cat/Category/Product.agda +++ b/src/Cat/Category/Product.agda @@ -122,48 +122,54 @@ module Try0 {โ„“a โ„“b : Level} {โ„‚ : Category โ„“a โ„“b} } } - open RawCategory raw + module _ where + open RawCategory raw - propEqs : โˆ€ {X' : Object}{Y' : Object} (let X , xa , xb = X') (let Y , ya , yb = Y') - โ†’ (xy : โ„‚.Arrow X Y) โ†’ isProp (โ„‚ [ ya โˆ˜ xy ] โ‰ก xa ร— โ„‚ [ yb โˆ˜ xy ] โ‰ก xb) - propEqs xs = propSig (โ„‚.arrowsAreSets _ _) (\ _ โ†’ โ„‚.arrowsAreSets _ _) + propEqs : โˆ€ {X' : Object}{Y' : Object} (let X , xa , xb = X') (let Y , ya , yb = Y') + โ†’ (xy : โ„‚.Arrow X Y) โ†’ isProp (โ„‚ [ ya โˆ˜ xy ] โ‰ก xa ร— โ„‚ [ yb โˆ˜ xy ] โ‰ก xb) + propEqs xs = propSig (โ„‚.arrowsAreSets _ _) (\ _ โ†’ โ„‚.arrowsAreSets _ _) - isAssocitaive : IsAssociative - isAssocitaive {A'@(A , a0 , a1)} {B , _} {C , c0 , c1} {D'@(D , d0 , d1)} {ff@(f , f0 , f1)} {gg@(g , g0 , g1)} {hh@(h , h0 , h1)} i - = s0 i , lemPropF propEqs s0 {P.snd l} {P.snd r} i - where - l = hh โˆ˜ (gg โˆ˜ ff) - r = hh โˆ˜ gg โˆ˜ ff - -- s0 : h โ„‚.โˆ˜ (g โ„‚.โˆ˜ f) โ‰ก h โ„‚.โˆ˜ g โ„‚.โˆ˜ f - s0 : fst l โ‰ก fst r - s0 = โ„‚.isAssociative {f = f} {g} {h} - - - isIdentity : IsIdentity identity - isIdentity {AA@(A , a0 , a1)} {BB@(B , b0 , b1)} {f , f0 , f1} = leftIdentity , rightIdentity - where - leftIdentity : identity โˆ˜ (f , f0 , f1) โ‰ก (f , f0 , f1) - leftIdentity i = l i , lemPropF propEqs l {snd L} {snd R} i + isAssociative : IsAssociative + isAssociative {A'@(A , a0 , a1)} {B , _} {C , c0 , c1} {D'@(D , d0 , d1)} {ff@(f , f0 , f1)} {gg@(g , g0 , g1)} {hh@(h , h0 , h1)} i + = s0 i , lemPropF propEqs s0 {P.snd l} {P.snd r} i where - L = identity โˆ˜ (f , f0 , f1) - R : Arrow AA BB - R = f , f0 , f1 - l : fst L โ‰ก fst R - l = โ„‚.leftIdentity - rightIdentity : (f , f0 , f1) โˆ˜ identity โ‰ก (f , f0 , f1) - rightIdentity i = l i , lemPropF propEqs l {snd L} {snd R} i + l = hh โˆ˜ (gg โˆ˜ ff) + r = hh โˆ˜ gg โˆ˜ ff + -- s0 : h โ„‚.โˆ˜ (g โ„‚.โˆ˜ f) โ‰ก h โ„‚.โˆ˜ g โ„‚.โˆ˜ f + s0 : fst l โ‰ก fst r + s0 = โ„‚.isAssociative {f = f} {g} {h} + + + isIdentity : IsIdentity identity + isIdentity {AA@(A , a0 , a1)} {BB@(B , b0 , b1)} {f , f0 , f1} = leftIdentity , rightIdentity where - L = (f , f0 , f1) โˆ˜ identity - R : Arrow AA BB - R = (f , f0 , f1) - l : โ„‚ [ f โˆ˜ โ„‚.identity ] โ‰ก f - l = โ„‚.rightIdentity + leftIdentity : identity โˆ˜ (f , f0 , f1) โ‰ก (f , f0 , f1) + leftIdentity i = l i , lemPropF propEqs l {snd L} {snd R} i + where + L = identity โˆ˜ (f , f0 , f1) + R : Arrow AA BB + R = f , f0 , f1 + l : fst L โ‰ก fst R + l = โ„‚.leftIdentity + rightIdentity : (f , f0 , f1) โˆ˜ identity โ‰ก (f , f0 , f1) + rightIdentity i = l i , lemPropF propEqs l {snd L} {snd R} i + where + L = (f , f0 , f1) โˆ˜ identity + R : Arrow AA BB + R = (f , f0 , f1) + l : โ„‚ [ f โˆ˜ โ„‚.identity ] โ‰ก f + l = โ„‚.rightIdentity - arrowsAreSets : ArrowsAreSets - arrowsAreSets {X , x0 , x1} {Y , y0 , y1} - = sigPresNType {n = โŸจ0โŸฉ} โ„‚.arrowsAreSets ฮป a โ†’ propSet (propEqs _) + arrowsAreSets : ArrowsAreSets + arrowsAreSets {X , x0 , x1} {Y , y0 , y1} + = sigPresNType {n = โŸจ0โŸฉ} โ„‚.arrowsAreSets ฮป a โ†’ propSet (propEqs _) - open Univalence isIdentity + isPreCat : IsPreCategory raw + IsPreCategory.isAssociative isPreCat = isAssociative + IsPreCategory.isIdentity isPreCat = isIdentity + IsPreCategory.arrowsAreSets isPreCat = arrowsAreSets + + open IsPreCategory isPreCat -- module _ (X : Object) where -- center : ฮฃ Object (X โ‰…_) @@ -327,12 +333,8 @@ module Try0 {โ„“a โ„“b : Level} {โ„‚ : Category โ„“a โ„“b} res = Equivโ‰ƒ.fromIso _ _ iso isCat : IsCategory raw - isCat = record - { isAssociative = isAssocitaive - ; isIdentity = isIdentity - ; arrowsAreSets = arrowsAreSets - ; univalent = univalent - } + IsCategory.isPreCategory isCat = isPreCat + IsCategory.univalent isCat = univalent cat : Category _ _ cat = record