Mercurial > hg > Members > kono > Proof > category
changeset 398:64aa49a18469
add Maybe Category
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Wed, 16 Mar 2016 17:43:31 +0900 |
parents | dd3fa0680897 |
children | 8304007dc2f8 |
files | limit-to.agda maybeCat.agda |
diffstat | 2 files changed, 69 insertions(+), 4 deletions(-) [+] |
line wrap: on
line diff
--- a/limit-to.agda Wed Mar 16 15:44:46 2016 +0900 +++ b/limit-to.agda Wed Mar 16 17:43:31 2016 +0900 @@ -168,13 +168,13 @@ indexFunctor : {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) - ( a b : Obj A ) ( f g : Hom A a b ) ( f' : Hom A b a ) + ( a b : Obj A ) ( f g h : Hom A a b ) ( h' : Hom A b a ) ( f-iso : A [ A [ f o f' ] ≈ id1 A b ]) ( f'-iso : A [ A [ f' o f ] ≈ id1 A a ]) ( g-iso : A [ A [ g o f' ] ≈ id1 A b ]) ( g'-iso : A [ A [ f' o g ] ≈ id1 A a ]) -> Functor (TwoCat {c₁} {c₂} {ℓ} ) A -indexFunctor {c₁} {c₂} {ℓ} A a b f g f' f-iso f'-iso g-iso g'-iso = record { +indexFunctor {c₁} {c₂} {ℓ} A a b f g h h' f-iso f'-iso g-iso g'-iso = record { FObj = λ a → fobj a ; FMap = λ f → fmap f ; isFunctor = record { @@ -193,9 +193,13 @@ fmap1 {t0} {t0} id-t0 = id1 A a fmap1 {t1} {t1} id-t0 = id1 A b fmap1 {t0} {t0} _ = id1 A a - fmap1 {t0} {t1} _ = f - fmap1 {t1} {t0} _ = f' fmap1 {t1} {t1} _ = id1 A b + fmap1 {t0} {t1} nil = h + fmap1 {t0} {t1} id-t0 = h + fmap1 {t1} {t0} nil = h' + fmap1 {t1} {t0} id-t0 = h' + fmap1 {t1} {t0} arrow-f = h' + fmap1 {t1} {t0} arrow-g = h' fmap : {x y : Obj I } -> Hom I x y -> Hom A (fobj x) (fobj y) fmap {x} {y} f = fmap1 {x} {y} ( Map f) open ≈-Reasoning (A)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/maybeCat.agda Wed Mar 16 17:43:31 2016 +0900 @@ -0,0 +1,61 @@ +open import Category -- https://github.com/konn/category-agda +open import Level + +module maybeCat { c₁ c₂ ℓ : Level} { A : Category c₁ c₂ ℓ } where + +open import cat-utility +open import HomReasoning +open import Relation.Binary +open import Data.Maybe + +open Functor + + +record MaybeHom { c₁ c₂ ℓ : Level} ( A : Category c₁ c₂ ℓ ) (a : Obj A ) (b : Obj A ) : Set (ℓ ⊔ c₂) where + field + hom : Maybe ( Hom A a b ) + +open MaybeHom + +_×_ : {a b c : Obj A } → MaybeHom A b c → MaybeHom A a b → MaybeHom A a c +_×_ {a} {b} {c} f g with hom f | hom g +_×_ {a} {b} {c} f g | nothing | _ = record { hom = nothing } +_×_ {a} {b} {c} f g | _ | nothing = record { hom = nothing } +_×_ {a} {b} {c} _ _ | (just f) | (just g) = record { hom = just ( A [ f o g ] ) } + +MaybeHomId : (a : Obj A ) -> MaybeHom A a a +MaybeHomId a = record { hom = just ( id1 A a) } + +_==_ : {a b : Obj A } -> Rel (Maybe (Hom A a b)) (c₂ ⊔ ℓ) +_==_ {a} {b} = Eq ( Category._≈_ A ) + + +MaybeCat : Category c₁ (ℓ ⊔ c₂) (ℓ ⊔ c₂) +MaybeCat = record { + Obj = Obj A ; + Hom = λ a b → MaybeHom A a b ; + _o_ = _×_ ; + _≈_ = λ a b → _==_ (hom a) (hom b) ; + Id = \{a} -> MaybeHomId a ; + isCategory = record { + isEquivalence = record {refl = *refl ; trans = ? ; sym = ? }; + identityL = \{a b f} -> {!!} {a} {b} {f} ; + identityR = \{a b f} -> {!!} {a} {b} {f} ; + o-resp-≈ = \{a b c f g h i} -> {!!} {a} {b} {c} {f} {g} {h} {i} ; + associative = \{a b c d f g h } -> {!!} {a} {b} {c} {d} {f} {g} {h} + } + } where + open ≈-Reasoning (A) + + *refl : {a b : Obj A } -> {x : Maybe ( Hom A a b ) } → x == x + *refl {_} {_} {just x} = just refl-hom + *refl {_} {_} {nothing} = nothing + + *sym : ∀ {x y} → x == y → y == x + *sym (just x≈y) = just (sym x≈y) + *sym nothing = nothing + + *trans : ∀ {x y z} → x == y → y == z → x == z + *trans (just x≈y) (just y≈z) = just (trans-hom x≈y y≈z) + *trans nothing nothing = nothing +