changeset 934:cce9e539486e

workaround on forget functor level
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 14 May 2020 18:28:08 +0900
parents e702aa8be9dd
children 92f8f57467e3
files CCCGraph.agda
diffstat 1 files changed, 34 insertions(+), 46 deletions(-) [+]
line wrap: on
line diff
--- a/CCCGraph.agda	Thu May 14 10:48:52 2020 +0900
+++ b/CCCGraph.agda	Thu May 14 18:28:08 2020 +0900
@@ -222,32 +222,6 @@
         IsFunctor.≈-cong isf refl = refl 
         IsFunctor.distr isf {a} {b} {c} {g} {f} = extensionality Sets ( λ z → distr {a} {b} {c} {g} {f} z ) 
 
-   pccc : CCC PL  -- this does not work because of ≡ , if we define another equality, o-resp-≈ may trouble
-   pccc = record {
-         1  = ⊤
-       ; ○ = λ _ → ○ _
-       ; _∧_ = _∧_ 
-       ; <_,_> = λ f g → < f , g >
-       ; π = iv π (id  _)
-       ; π' = iv π' (id _)
-       ; _<=_ = _<=_
-       ; _* = λ f → iv (f *) (id _)
-       ; ε = iv ε (id _)
-       ; isCCC = isCCC
-     } where
-         open graphtocat.Chain 
-         isCCC : CCC.IsCCC PL ⊤ ○ _∧_ <_,_> (iv π (id  _)) (iv π' (id _)) _<=_ (λ f → iv (f *) (id _)) (iv ε (id _))
-         isCCC = record {
-               e2  = {!!} --e2
-             ; e3a = {!!} --λ {a} {b} {c} {f} {g} → e3a {a} {b} {c} {f} {g}
-             ; e3b = {!!} --λ {a} {b} {c} {f} {g} → e3b {a} {b} {c} {f} {g}
-             ; e3c = {!!} --e3c
-             ; π-cong = {!!} --π-cong
-             ; e4a = {!!} --e4a
-             ; e4b = {!!} --e4b
-             ; *-cong = {!!} --*-cong
-           } 
-
 ---
 ---  SubCategoy SC F A is a category with Obj = FObj F, Hom = FMap 
 ---
@@ -313,7 +287,7 @@
     → (F G : GMap C D) → Set (c₁ ⊔ c₂ ⊔ c₁' ⊔ c₂')
 _=m=_ {C = C} {D = D} F G = ∀{A B : vertex C} → (f : edge C A B) → [ D ] emap F f == emap G f
 
-_&_ :  {c₁ c₂ : Level} {x y z : Graph {c₁} {c₂} } ( f : GMap y z ) ( g : GMap x y ) → GMap x z
+_&_ :  {c₁ c₂ c₁' c₂'  c₁'' c₂'' : Level} {x : Graph {c₁} {c₂}} {y : Graph {c₁'} {c₂'}} {z : Graph {c₁''} {c₂''} } ( f : GMap y z ) ( g : GMap x y ) → GMap x z
 f & g = record { vmap = λ x →  vmap f ( vmap g x ) ; emap = λ x → emap f ( emap g x ) }
 
 Grph : {c₁ c₂ : Level} →  Category (suc (c₁ ⊔ c₂)) (c₁ ⊔ c₂) (c₁ ⊔ c₂)
@@ -354,7 +328,7 @@
 
 --- Forgetful functor
 
-module forgetful  where
+module forgetful {c₁ c₂ : Level} where
 
   ≃-cong : {c₁ c₂ ℓ : Level}  (B : Category c₁ c₂ ℓ ) → {a b a' b' : Obj B }
       → { f f'   : Hom B a b }
@@ -369,26 +343,40 @@
           ≈⟨ g=g' ⟩
              g'
           ∎  )
-  
-  fobj : {c₁ c₂ ℓ : Level} → Obj (Cart {c₁} {c₂} {ℓ}) → Obj Grph
-  fobj a = record { vertex = Obj (cat a) ; edge = Hom (cat a) }
-  fmap :  {c₁ c₂ ℓ : Level}  {a b : Obj (Cart {c₁} {c₂} {ℓ}  ) } → Hom (Cart ) a b → Hom (Grph  ) ( fobj a ) ( fobj b )
-  fmap f =  record { vmap = FObj (cmap f) ; emap = FMap (cmap f) }
 
-  UX :  {c₁ c₂ : Level} → Functor (Cart  {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} {c₁ ⊔ c₂}) (Grph {c₁} {c₂})
-  FObj UX a = {!!} -- fobj a
-  FMap UX f =  {!!} -- fmap f
-  isFunctor UX  = {!!} where -- isf where
-    isf : IsFunctor Cart Grph fobj fmap
-    IsFunctor.identity isf {a} {b} {f} e = mrefl refl
-    IsFunctor.distr isf {a} {b} {c} f = mrefl refl
-    IsFunctor.≈-cong isf {a} {b} {f} {g} f=g e = lemma ( (extensionality Sets ( λ z → lemma4 (
-                 ≃-cong (cat b) (f=g (id1 (cat a) z)) (IsFunctor.identity (Functor.isFunctor (cmap f))) (IsFunctor.identity (Functor.isFunctor (cmap g)))
-            )))) (f=g e) where
+  -- Grph does not allow morph on different level graphs
+  -- simply assumes we have iso to the another level. This may means same axiom on CCCs results the same CCCs.
+  postulate
+     g21 : Graph {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} → Graph {c₁} {c₂} 
+     m21 : (g : Graph {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} )  → GMap  {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} {c₁} {c₂} g (g21 g)
+     m12 : (g : Graph {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} )  → GMap  {c₁} {c₂}  {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} (g21 g) g
+     giso→  : { g : Graph {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} }
+          → {a b : vertex g } → {e : edge g a b } →  (m12 g & m21 g) =m= id1 Grph g
+     giso←  : { g : Graph {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} }
+          → {a b : vertex (g21 g) } → {e : edge (g21 g) a b } →  (m21 g & m12 g ) =m= id1 Grph (g21 g)
+                -- Grph [ Grph [ m21 g o m12 g ] ≈ id1 Grph (g21 g) ]
+  
+  fobj : Obj (Cart {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} {c₁ ⊔ c₂}) → Obj Grph
+  fobj a = record { vertex = Obj (cat a) ; edge = Hom (cat a) }
+  fmap :  {a b : Obj (Cart {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} {c₁ ⊔ c₂} ) } → Hom (Cart ) a b → Hom (Grph {c₁} {c₂}) (g21 ( fobj a )) (g21 ( fobj b ))
+  fmap {a} {b} f =  record {
+           vmap = λ e → vmap (m21 (fobj b)) (FObj (cmap f) (vmap (m12 (fobj a)) e ))
+         ; emap = λ e → emap (m21 (fobj b)) (FMap (cmap f) (emap (m12 (fobj a)) e )) } 
+
+  UX :  Functor (Cart  {suc (c₁ ⊔ c₂)} {c₁ ⊔ c₂} {c₁ ⊔ c₂}) (Grph {c₁} {c₂})
+  FObj UX a = g21 (fobj a)
+  FMap UX f =  fmap f
+  isFunctor UX  = isf where
+    isf : IsFunctor Cart Grph (λ z → g21 (fobj z)) fmap
+    IsFunctor.identity isf {a} {b} {f} e = {!!}
+    IsFunctor.distr isf {a} {b} {c} f = {!!}
+    IsFunctor.≈-cong isf {a} {b} {f} {g} f=g e = {!!} where -- lemma ( (extensionality Sets ( λ z → lemma4 (
+          --       ≃-cong (cat b) (f=g (id1 (cat a) z)) (IsFunctor.identity (Functor.isFunctor (cmap f))) (IsFunctor.identity (Functor.isFunctor (cmap g)))
+          --  )))) (f=g e) where
       lemma4 : {x y : vertex (fobj b)} →  [_]_~_ (cat b)  (id1 (cat b) x) (id1 (cat b) y) → x ≡ y
       lemma4 (refl eqv) = refl 
-      lemma : vmap (fmap f) ≡ vmap (fmap g) → [ cat b ] FMap (cmap f) e ~ FMap (cmap g) e → [ fobj b ] emap (fmap f) e == emap (fmap g) e
-      lemma refl (refl eqv) = mrefl (≡←≈ b eqv)
+      -- lemma : vmap (fmap f) ≡ vmap (fmap g) → [ cat b ] FMap (cmap f) e ~ FMap (cmap g) e → [ g21 (fobj b)] emap (fmap f) {!!} == emap (fmap g) {!!}
+      -- lemma = {!!} -- refl (refl eqv) = mrefl (≡←≈ b eqv)
 
 
 open ccc-from-graph.Objs
@@ -416,7 +404,7 @@
        FO : (a : Obj (Grph {c₁} {c₂}) ) → Graph {(c₁ ⊔ c₂)} {(c₁ ⊔ c₂)}
        FO a = FObj UX (F a)
        η : (a : Obj (Grph {c₁} {c₂}) ) → Hom Grph a (FObj UX (F a))
-       η a =  record { vmap = λ y →  {!!} ;  emap = λ f x → {!!} }
+       η a =  record { vmap = λ y →  {!!} ;  emap = λ f → {!!} }
        csc : Graph  → Obj Cart  
        csc g = record { cat = Sets {c₁ ⊔ c₂} ; ccc = sets ; ≡←≈ = λ eq → eq } 
        cs : {c₁ c₂ : Level}  → (g : Graph  {c₁} {c₂} ) → Functor  (ccc-from-graph.PL g) (Sets {_})