Mercurial > hg > Members > kono > Proof > category
changeset 360:29e0f0bd4d2c
arrow
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Fri, 26 Jun 2015 19:03:54 +0900 |
parents | 6d803a4708bf |
children | e9d4e6ab6cd1 |
files | limit-to.agda |
diffstat | 1 files changed, 55 insertions(+), 17 deletions(-) [+] |
line wrap: on
line diff
--- a/limit-to.agda Fri Jun 26 17:56:22 2015 +0900 +++ b/limit-to.agda Fri Jun 26 19:03:54 2015 +0900 @@ -23,7 +23,6 @@ --- ------> --- g -postulate φ id-0 id-1 f g : Set c₂ infixr 40 _::_ data List {a} (A : Set a) : Set a where @@ -50,34 +49,73 @@ memberp1 .(succ (x + y)) ( x :: T) | greater .x y = memberp1 x T - +-- Category object configuration -data Two {c₁} : Set c₁ where +data Two : Set c₁ where t0 : Two t1 : Two -record Two-Hom {c₁} (a : Two {c₁}) (b : Two {c₁}) : Set (c₁ ⊔ suc c₂ ⊔ ℓ) where - field - Map : Set c₂ +two-equality : Two -> Two -> Bool +two-equality t0 t0 = true +two-equality t0 t1 = false +two-equality t1 t0 = true +two-equality t1 t1 = false + +data Arrow : Set c₂ where + id-0 : Arrow + id-1 : Arrow + af : Arrow + ag : Arrow -hom : Two {c₁} → Two {c₁} → List (Set c₂) +arrow-equality : Arrow -> Arrow -> Bool +arrow-equality id-0 id-0 = true +arrow-equality id-0 id-1 = false +arrow-equality id-0 af = false +arrow-equality id-0 ag = false +arrow-equality id-1 id-0 = false +arrow-equality id-1 id-1 = true +arrow-equality id-1 af = false +arrow-equality id-1 ag = false +arrow-equality af id-0 = false +arrow-equality af id-1 = false +arrow-equality af af = true +arrow-equality af ag = false +arrow-equality ag id-0 = false +arrow-equality ag id-1 = false +arrow-equality ag af = false +arrow-equality ag ag = true + +-- Category arrow configuration + +hom : Two → Two → List (Arrow ) hom t0 t0 = id-0 :: [] -hom t0 t1 = f :: g :: [] +hom t0 t1 = af :: ag :: [] hom t1 t0 = [] hom t1 t1 = id-1 :: [] -Two-id : {c₁ : Level} -> (a : Two {c₁}) -> Two-Hom {c₁} a a -Two-id {c₁} t0 = record { Map = id-0 } -Two-id {c₁} t1 = record { Map = id-1 } +in-hom : Arrow -> List Arrow -> Bool +in-hom _ [] = false +in-hom x (y :: T) with arrow-equality x y +in-hom _ (y :: T) | true = true +in-hom x (y :: T) | false = in-hom x T + +record Two-Hom (a : Two ) (b : Two ) : Set (c₁ ⊔ suc c₂ ⊔ ℓ) where + field + Map : Arrow + isMap : in-hom Map ( hom a b ) ≡ true + +Two-id : (a : Two ) -> Two-Hom a a +Two-id t0 = record { Map = id-0 ; isMap = refl } +Two-id t1 = record { Map = id-1 ; isMap = refl } open Two-Hom -twocat : {c₁ ℓ : Level} → Category c₁ _ ℓ -twocat {c₁} {ℓ} = record { - Obj = Two {c₁} ; +twocat : Category c₁ _ (ℓ ⊔ (suc c₂ ⊔ c₁)) +twocat = record { + Obj = Two ; Hom = λ a b → Two-Hom a b ; _o_ = {!!} ; - _≈_ = {!!} ; + _≈_ = _≡_; Id = \{a} -> Two-id a ; isCategory = record { isEquivalence = {!!} ; @@ -100,10 +138,10 @@ ; ek=h = λ {d} {h} {fh=gh} → {!!} ; uniqueness = λ {d} {h} {fh=gh} {k'} → {!!} } where - Γobj : Two {c₁} → Obj A + Γobj : Two → Obj A Γobj t0 = a Γobj t1 = b - Γmap : Two {c₁} → Hom A a b + Γmap : Two → Hom A a b Γmap t0 = f Γmap t1 = g Γ : Functor I A