changeset 837:d809e2502be4

concat defined
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 02 Apr 2020 08:16:17 +0900
parents 861cae4707bd
children be4b8e70fa8e
files CCCGraph1.agda
diffstat 1 files changed, 14 insertions(+), 41 deletions(-) [+]
line wrap: on
line diff
--- a/CCCGraph1.agda	Thu Mar 26 17:58:51 2020 +0900
+++ b/CCCGraph1.agda	Thu Apr 02 08:16:17 2020 +0900
@@ -17,54 +17,27 @@
       _∧_ : Objs  → Objs  → Objs 
       _<=_ : Objs → Objs → Objs 
 
-   data Arrow :  Objs → Objs → Set (c₁ ⊔ c₂)  where
+   data Arrow :  Objs → Objs → Set (c₁ ⊔ c₂)  where                       --- case i
       arrow : {a b : vertex G} →  (edge G) a b → Arrow (atom a) (atom b)
       ○ : (a : Objs ) → Arrow a ⊤
       π : {a b : Objs } → Arrow ( a ∧ b ) a
       π' : {a b : Objs } → Arrow ( a ∧ b ) b
       ε : {a b : Objs } → Arrow ((a <= b) ∧ b ) a
-      <_,_> : {a b c : Objs } → Arrow c a → Arrow c b → Arrow c (a ∧ b)
-      _* : {a b c : Objs } → Arrow (c ∧ b ) a → Arrow c ( a <= b )
-      id : ( a : Objs ) → Arrow a a
+      _* : {a b c : Objs } → Arrow (c ∧ b ) a → Arrow c ( a <= b )        --- case v
 
    data  Arrows  : (b c : Objs ) → Set ( c₁  ⊔  c₂ ) where
-      i   : {b c : Objs} (k : Arrow b c ) → Arrows b c
-      iii : {b c' c'' : Objs } ( f : Arrows b c' ) ( g : Arrows b c'' ) → Arrows b (c'  ∧ c'')  
-      iv  : {b c d : Objs } ( f : Arrows d c ) ( g : Arrow b d ) → Arrows b c
-      v   : {b c' c'' : Objs } ( f : Arrows (b ∧ c') c'' ) → Arrows b (c'' <= c') 
-
-   eval1 :  {a b c : Objs } (f : Arrow b c ) → (g : Arrow a b) → Arrows a c
-   eval1 {a} {_} {⊤} _ _ = i ( ○ a )
-   eval1 f (id a)  = i f
-   eval1 (arrow x) g = iv (i (arrow x)) g
-   eval1 π < f , g > = i f
-   eval1 π g = iv (i π) g
-   eval1 π' < f , g > = i g
-   eval1 π' g = iv (i π') g
-   eval1 ε g = iv (i ε) g
-   eval1 < f , g > h = iv (i < f , g >) h
-   eval1 (f *) g = iv (i (f *)) g
-   eval1 (id a) g = i g
-
-   eval :  {a b c : Objs } (f : Arrow b c ) → (g : Arrows a b) → Arrows a c
-   eval {a} {_} {⊤} _ _ = i ( ○ a )
-   eval f (i k) = eval1 f k
-   eval (id _) f = f
-   eval π (iii g h) = g
-   eval π' (iii g h) = h
-   eval ε (iii (i f) (i g )) = iv (i ε) < f , g >
-   eval ε (iii f g ) = {!!}
-   eval < f , g > h = iii (eval f h) (eval g h)
-   eval (f *) g = v (eval f (iii (iv g π ) (i π') )) 
-   eval f (iv g h) = iv (eval f g) h
+      id : ( a : Objs ) → Arrows a a                                      --- case i
+      <_,_> : {a b c : Objs } → Arrows c a → Arrows c b → Arrows c (a ∧ b)   --- case iii
+      iv  : {b c d : Objs } ( f : Arrow d c ) ( g : Arrows b d ) → Arrows b c   -- cas iv
 
    _・_ :  {a b c : Objs } (f : Arrows b c ) → (g : Arrows a b) → Arrows a c
-   _・_ {a} {_} {⊤} _ _ = i ( ○ a )
-   i (id _)  ・ f = f
-   f ・ i (id _)  = f
-   (iv f g) ・ h  = f ・ eval g h 
-   f ・ (iv g h)  = iv ( f ・ g ) h
-   i f ・ g = eval f g 
-   iii f g ・  h = iii (f ・ h) ( g ・ h )
-   v f ・ g = v ( f ・ iii (iv g π ) (i π') )  
+   _・_ {a} {b} {⊤} _ _ = iv (○ a) (id a)
+   id a ・ g = g
+   < f , g > ・  h = < ( f ・ h ) , ( g ・ h ) >
+   iv f (id _) ・ h = iv f h
+   iv π < g , g₁ > ・  h = g ・ h
+   iv π' < g , g₁ > ・  h = g₁ ・ h
+   iv ε < g , g₁ > ・  h = iv ε < g ・ h , g₁ ・ h >
+   iv (f *) < g , g₁ > ・ h = iv (f *) < g ・ h , g₁ ・ h > -- Arrows b a Arrows a b
+   iv f (iv f₁ g) ・ h = iv f (  (iv f₁ g) ・ h )