changeset 930:327abed926d6

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 11 May 2020 16:47:58 +0900
parents 1e8ed7dedc03
children 98b5fafb1efb
files CCCGraph.agda
diffstat 1 files changed, 21 insertions(+), 18 deletions(-) [+]
line wrap: on
line diff
--- a/CCCGraph.agda	Mon May 11 16:26:35 2020 +0900
+++ b/CCCGraph.agda	Mon May 11 16:47:58 2020 +0900
@@ -21,10 +21,10 @@
 
 postulate extensionality : { c₁ c₂ ℓ : Level} ( A : Category c₁ c₂ ℓ ) → Relation.Binary.PropositionalEquality.Extensionality c₂ c₂
 
-data One  : Set (suc c₁) where
+data One  : Set c₁ where
   OneObj : One   -- () in Haskell ( or any one object set )
 
-sets : CCC (Sets {suc c₁})
+sets : CCC (Sets {c₁})
 sets  = record {
          1  = One
        ; ○ = λ _ → λ _ → OneObj
@@ -95,19 +95,19 @@
                 *-cong refl = refl
 
 open import graph
-module ccc-from-graph  (G : Graph {suc c₁} {suc c₁} )  where
+module ccc-from-graph  (G : Graph {c₁} {c₁} )  where
 
    open import Relation.Binary.PropositionalEquality renaming ( cong to ≡-cong ) hiding ( [_] )
    open Graph
 
-   data Objs : Set (suc c₁) where
+   data Objs : Set c₁ where
       atom : (vertex G) → Objs 
       ⊤ : Objs 
       _∧_ : Objs  → Objs  → Objs 
       _<=_ : Objs → Objs → Objs 
 
-   data  Arrows  : (b c : Objs ) → Set (suc c₁  )
-   data Arrow :  Objs → Objs → Set (suc c₁)  where                       --- case i
+   data  Arrows  : (b c : Objs ) → Set c₁ 
+   data Arrow :  Objs → Objs → Set c₁  where                       --- case i
       arrow : {a b : vertex G} →  (edge G) a b → Arrow (atom a) (atom b)
       π : {a b : Objs } → Arrow ( a ∧ b ) a
       π' : {a b : Objs } → Arrow ( a ∧ b ) b
@@ -143,7 +143,7 @@
    assoc≡ (iv f f1) g h = cong (λ k → iv f k ) ( assoc≡ f1 g h )
 
    -- positive intutionistic calculus
-   PL :  Category  (suc c₁) (suc c₁)  (suc c₁ )
+   PL :  Category  c₁ c₁ c₁ 
    PL = record {
             Obj  = Objs;
             Hom = λ a b →  Arrows  a b ;
@@ -175,7 +175,7 @@
    tr : {a b : vertex G} → edge G a b → ((y : vertex G) → C y a) → (y : vertex G) → C y b
    tr f x y  = graphtocat.next f (x y) 
    
-   fobj :  ( a  : Objs  ) → Set (suc c₁ )
+   fobj :  ( a  : Objs  ) → Set c₁
    fobj  (atom x) = ( y : vertex G ) → C y x
    fobj ⊤ = One
    fobj  (a ∧ b) = ( fobj  a /\ fobj  b)
@@ -197,7 +197,7 @@
 --    Sets is CCC, so we have a cartesian closed category generated by a graph
 --       as a sub category of Sets
 
-   CS :  Functor PL (Sets {suc c₁})
+   CS :  Functor PL (Sets {c₁})
    FObj CS a  = fobj  a
    FMap CS {a} {b} f = fmap  {a} {b} f
    isFunctor CS = isf where
@@ -234,7 +234,7 @@
  
 open CCCObj 
  
-record CCCMap  (A B : CCCObj ) : Set (suc c₁ ) where
+record CCCMap  (A B : CCCObj ) : Set (suc c₁) where
    field
      cmap : Functor (cat A ) (cat B )
      ccf :  CCC (cat A) → CCC (cat B)
@@ -244,7 +244,7 @@
 open  CCCMap
 open import Relation.Binary.Core
 
-Cart :  Category (suc c₁) (suc c₁) (suc c₁)
+Cart :  Category (suc c₁) (suc c₁) (suc c₁) 
 Cart = record {
     Obj = CCCObj 
   ; Hom = CCCMap
@@ -279,13 +279,13 @@
   mrefl : {g : edge C A B} → (eqv : f ≡ g ) → [ C ] f == g
 
 _=m=_ : {C D : Graph {c₁} {c₁} } 
-    → (F G : GMap C D) → Set (suc  c₁)
+    → (F G : GMap C D) → Set (suc c₁)
 _=m=_ {C = C} {D = D} F G = ∀{A B : vertex C} → (f : edge C A B) → [ D ] emap F f == emap G f
 
 _&_ :  {x y 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 :  Category (suc c₁)  (suc c₁) (suc c₁)
+Grph :  Category (suc c₁) (suc c₁)  (suc c₁) 
 Grph  = record {
     Obj = Graph {c₁} {c₁}
   ; Hom = GMap 
@@ -365,10 +365,13 @@
 open ccc-from-graph.Arrows
 open graphtocat.Chain
 
+Sets0 : Category (suc c₁) c₁ c₁
+Sets0 = Sets {c₁}
+
 ccc-graph-univ :  UniversalMapping Grph Cart forgetful.UX 
 ccc-graph-univ = record {
-     F = λ g → csc {!!} ; -- g
-     η = λ a → record { vmap = λ y → {!!} ; emap = λ f x y →  next f (x y) } ; -- graphtocat.Chain a ? ?  
+     F = λ g → csc g ; 
+     η = λ a → record { vmap = λ y → graphtocat.Chain {!!} {!!} {!!} ; emap = λ f x y →  next f (x y) } ; -- graphtocat.Chain a ? ?  
      _* = solution ;
      isUniversalMapping = record {
          universalMapping = {!!} ;
@@ -377,11 +380,11 @@
   } where
        open forgetful  
        open ccc-from-graph
-       csc : Graph {suc c₁} {suc c₁} → Obj Cart  
+       csc : Graph {c₁} {c₁} → Obj Cart  
        csc  g = record { cat = {!!} ; ccc = {!!} ; ≡←≈ = λ eq → eq } 
-       cs :  (g : Graph {suc c₁}{suc c₁} ) → Functor  (ccc-from-graph.PL g) (Sets {suc c₁})
+       cs :  (g : Graph {c₁}{c₁} ) → Functor  (ccc-from-graph.PL g) (Sets {suc c₁})
        cs g = {!!}
-       pl :  (g : Graph {suc c₁} {suc c₁ } ) → Category _ _ _
+       pl :  (g : Graph {c₁} {c₁ } ) → Category _ _ _
        pl g = PL g
        cobj  :   {g : Obj (Grph    )} {c : Obj (Cart)} → Hom Grph g (FObj UX c)  → Objs {!!} → Obj (cat c)
        cobj {g} {c} f (atom x) = vmap f {!!}