Mercurial > hg > Members > kono > Proof > category
view limit-to.agda @ 407:7bdc93de2d6e
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 21 Mar 2016 21:08:46 +0900 |
parents | 2fbd92ddecb5 |
children | b265e02b0e0b |
line wrap: on
line source
open import Category -- https://github.com/konn/category-agda open import Level module limit-to where open import cat-utility open import HomReasoning open import Relation.Binary.Core open import Data.Maybe open Functor -- If we have limit then we have equalizer --- two objects category --- --- f --- ------> --- 0 1 --- ------> --- g data TwoObject {c₁ : Level} : Set c₁ where t0 : TwoObject t1 : TwoObject data Arrow {ℓ : Level } : Set ℓ where id-t0 : Arrow id-t1 : Arrow arrow-f : Arrow arrow-g : Arrow -- arrow composition twocomp : {c₁ c₂ : Level } -> { a b c : TwoObject {c₁} } -> Arrow { c₂ } -> Arrow { c₂ } -> Maybe ( Arrow { c₂ } ) twocomp {_} {_} {t0} {t1} {t1} id-t1 arrow-f = just arrow-f twocomp {_} {_} {t0} {t1} {t1} id-t1 arrow-g = just arrow-g twocomp {_} {_} {t1} {t1} {t1} id-t1 id-t1 = just id-t1 twocomp {_} {_} {t0} {t0} {t1} arrow-f id-t0 = just arrow-f twocomp {_} {_} {t0} {t0} {t1} arrow-g id-t0 = just arrow-g twocomp {_} {_} {t0} {t0} {t0} id-t0 id-t0 = just id-t0 twocomp _ _ = nothing _×_ : { c₁ c₂ : Level } -> {A B C : TwoObject { c₁} } → Maybe ( Arrow { c₂ }) → Maybe ( Arrow { c₂ }) → Maybe ( Arrow { c₂ }) _×_ nothing _ = nothing _×_ _ nothing = nothing _×_ { c₁} { c₂} {a} {b} {c} (just f) (just g) = twocomp { c₁} { c₂} {a} {b} {c} f g [_==_] : { c₁ c₂ : Level} {a b : TwoObject {c₁} } -> Rel (Maybe (Arrow { c₂ })) (c₂) [_==_] = Eq _≡_ -- f g h -- d <- c <- b <- a assoc-× : { c₁ c₂ : Level } {a b c d : TwoObject { c₁} } {f g h : Maybe (Arrow { c₂ })} → [ f × (g × h) == (f × g) × h ] assoc-× {_} {_} {_} {_} {_} {_} {nothing} {_} {_} = nothing assoc-× {_} {_} {_} {_} {_} {_} {just _} {nothing} {_} = nothing assoc-× {_} {_} {_} {_} {_} {_} {just _} {just _} {nothing} = nothing assoc-× {_} {_} {_} {_} {_} {_} {just f} {just g} {just h} with ((just g ) × (just h)) | ((just f ) × (just g) ) ... | nothing | _ = nothing ... | just _ | nothing = nothing ... | just id-t0 | just id-t0 = just refl ... | just id-t1 | just id-t1 = just refl ... | just id-t1 | just arrow-f = just refl ... | just id-t1 | just arrow-g = just refl ... | just arrow-f | just id-t0 = just refl ... | just arrow-g | just id-t0 = just refl ... | just id-t0 | just id-t1 = nothing ... | just id-t0 | (just arrow-f) = nothing ... | just id-t0 | (just arrow-g) = nothing ... | just id-t1 | (just id-t0) = nothing ... | just arrow-f | (just id-t1) = nothing ... | just arrow-f | (just arrow-f) = nothing ... | just arrow-f | (just arrow-g) = nothing ... | just arrow-g | (just id-t1) = nothing ... | just arrow-g | (just arrow-f) = nothing ... | just arrow-g | (just arrow-g) = nothing TwoId : { c₁ c₂ : Level } {a : TwoObject { c₁} } -> Maybe (Arrow { c₂ }) TwoId {_} {_} {t0} = just id-t0 TwoId {_} {_} {t1} = just id-t1 open import maybeCat open import Relation.Binary TwoCat : { c₁ c₂ ℓ : Level } -> Category c₁ c₂ c₂ TwoCat {c₁} {c₂} {ℓ} = record { Obj = TwoObject {c₁} ; Hom = λ a b → Maybe ( Arrow { c₂ } ) ; _o_ = \{a} {b} {c} x y -> _×_ { c₁ } { c₂} {a} {b} {c} x y ; _≈_ = Eq _≡_ ; Id = \{a} -> TwoId { c₁ } { c₂} {a} ; isCategory = record { isEquivalence = record {refl = {!!} ; trans = {!!} ; sym = {!!} } ; identityL = {!!} ; identityR = {!!} ; o-resp-≈ = {!!} ; associative = {!!} } } indexFunctor : {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) ( a b : Obj (MaybeCat A )) ( f g : Hom A a b ) -> Functor (TwoCat {c₁} {c₂} {c₂} ) (MaybeCat A ) indexFunctor {c₁} {c₂} {ℓ} A a b f g = record { FObj = λ a → fobj a ; FMap = λ {a} {b} f → fmap {a} {b} f ; isFunctor = record { identity = \{x} -> identity {x} ; distr = \ {a} {b} {c} {f} {g} -> distr1 {a} {b} {c} {f} {g} ; ≈-cong = \ {a} {b} {c} {f} -> ≈-cong {a} {b} {c} {f} } } where I = TwoCat {c₁} {c₂} {ℓ} MA = MaybeCat A open ≈-Reasoning (MA) fobj : Obj I -> Obj A fobj t0 = a fobj t1 = b fmap : {x y : Obj I } -> Maybe (Arrow {c₂} ) -> Hom MA (fobj x) (fobj y) fmap {t0} {t1} (just arrow-f) = record { hom = just f } fmap {t0} {t1} (just arrow-g) = record { hom = just g } fmap {t0} {t0} (just id-t0) = record { hom = just ( id1 A a )} fmap {t1} {t1} (just id-t1) = record { hom = just ( id1 A b )} fmap {_} {_} _ = record { hom = nothing } open ≈-Reasoning (A) identity : {x : Obj I} → {!!} identity {t0} = {!!} identity {t1} = {!!} distr1 : {a₁ : Obj I} {b₁ : Obj I} {c : Obj I} {f₁ : Hom I a₁ b₁} {g₁ : Hom I b₁ c} → {!!} distr1 {a1} {b1} {c} {f1} {g1} = {!!} ≈-cong : {a : Obj I} {b : Obj I} {f g : Hom I a b} → _[_≈_] I f g → {!!} ≈-cong {_} {_} {f1} {g1} f≈g = {!!} --- Equalizer --- f --- e ------> --- c ------> a b --- ^ / ------> --- |k h g --- | / --- | / --- | / --- |/ --- d open Limit lim-to-equ : {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) -> (lim : (I : Category c₁ c₂ ℓ) ( Γ : Functor I A ) → { a0 : Obj A } { u : NTrans I A ( K A I a0 ) Γ } → Limit A I Γ a0 u ) -- completeness → {a b c : Obj A} (f g : Hom A a b ) → (e : Hom A c a ) → (fe=ge : A [ A [ f o e ] ≈ A [ g o e ] ] ) → Equalizer A e f g lim-to-equ {c₁} {c₂} {ℓ } A lim {a} {b} {c} f g e fe=ge = record { fe=ge = fe=ge ; k = λ {d} h fh=gh → k {d} h fh=gh ; ek=h = λ {d} {h} {fh=gh} → ek=h d h fh=gh ; uniqueness = λ {d} {h} {fh=gh} {k'} → uniquness d h fh=gh k' } where I = TwoCat {c₁} {c₂} {ℓ } Γ = {!!} nmap : (x : Obj I) ( d : Obj A ) (h : Hom A d a ) -> Hom A (FObj (K A I d) x) (FObj Γ x) nmap x d h = {!!} commute1 : {x y : Obj I} {f' : Hom I x y} (d : Obj A) (h : Hom A d a ) -> A [ A [ f o h ] ≈ A [ g o h ] ] → A [ A [ FMap Γ f' o nmap x d h ] ≈ A [ nmap y d h o FMap (K A I d) f' ] ] commute1 {x} {y} {f'} d h fh=gh = {!!} nat : (d : Obj A) → (h : Hom A d a ) → A [ A [ f o h ] ≈ A [ g o h ] ] → NTrans I A (K A I d) Γ nat d h fh=gh = record { TMap = λ x → nmap x d h ; isNTrans = record { commute = λ {x} {y} {f'} -> commute1 {x} {y} {f'} d h fh=gh } } k : {d : Obj A} (h : Hom A d a) → A [ A [ f o h ] ≈ A [ g o h ] ] → Hom A d c k {d} h fh=gh = {!!} -- limit (lim I Γ {c} {nat c e fe=ge }) d (nat d h fh=gh ) ek=h : (d : Obj A ) (h : Hom A d a ) -> ( fh=gh : A [ A [ f o h ] ≈ A [ g o h ] ] ) -> A [ A [ e o k h fh=gh ] ≈ h ] ek=h d h fh=gh = {!!} uniquness : (d : Obj A ) (h : Hom A d a ) -> ( fh=gh : A [ A [ f o h ] ≈ A [ g o h ] ] ) -> ( k' : Hom A d c ) -> A [ A [ e o k' ] ≈ h ] → A [ k h fh=gh ≈ k' ] uniquness d h fh=gh = {!!}