changeset 404:07bea66e5ceb

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 20 Mar 2016 12:32:13 +0900
parents 375edfefbf6a
children 4c34c0e3c4bb
files limit-to.agda maybeCat.agda
diffstat 2 files changed, 41 insertions(+), 32 deletions(-) [+]
line wrap: on
line diff
--- a/limit-to.agda	Sun Mar 20 11:36:44 2016 +0900
+++ b/limit-to.agda	Sun Mar 20 12:32:13 2016 +0900
@@ -33,36 +33,46 @@
    arrow-g :  Arrow
    nil :  Arrow
 
-record RawHom { c₁ c₂ : Level}  (a : TwoObject {c₁}  ) (b : TwoObject {c₁}  ) : Set   c₂ where
-   field
-       RawMap    : Arrow  { c₂ }
-
-open RawHom
-
 record Two-Hom { c₁  c₂ : Level }   (a : TwoObject { c₁}  ) (b : TwoObject  { c₁} ) : Set    c₂  where
    field
-      hom : Maybe ( RawHom  {c₁} { c₂ } a b )
+      hom  : Maybe ( Arrow  { c₂ } )
 
 open  Two-Hom 
 
 Two-id :  { c₁ c₂ : Level } -> (a : TwoObject {c₁} ) ->   Two-Hom {c₁} { c₂}  a a 
-Two-id _  = record { hom = just ( record { RawMap = id-t0 } ) }
+Two-id _  = record { hom = just  id-t0  }
 
 -- arrow composition
 
-twocomp : {c₁  c₂ : Level } ->  { a b : TwoObject {c₁} } -> Arrow  { c₂ } -> Arrow  { c₂ } -> Maybe  ( RawHom a b )
-twocomp id-t0 f = just ( record { RawMap = f } )
-twocomp f id-t0 = just ( record { RawMap = f } )
+twocomp : {c₁  c₂ : Level } ->  { a b : TwoObject {c₁} } -> Arrow  { c₂ } -> Arrow  { c₂ } -> Maybe  ( Arrow  { c₂ } )
+twocomp id-t0 f = just f
+twocomp f id-t0 = just f
 twocomp _ _ = nothing
 
 _×_ :  { c₁  c₂ : Level }  -> {A B C : TwoObject { c₁} } →  Two-Hom { c₁}  {c₂}  B C →  Two-Hom { c₁}  {c₂}  A B  →  Two-Hom { c₁}  {c₂}  A C 
 _×_   { c₁} {ℓ} {a} {b} {c} f g with  hom f |  hom g 
 _×_   { c₁} {ℓ} {a} {b} {c} f g | nothing   | _ = record { hom = nothing }
 _×_   { c₁} {ℓ} {a} {b} {c} f g | _   | nothing  = record { hom = nothing }
-_×_   { c₁} {ℓ} {a} {b} {c} _ _ | just f  | just g   = record { hom = twocomp  { c₁} {ℓ} {a} {c} (RawMap f) (RawMap g ) }
+_×_   { c₁} {ℓ} {a} {b} {c} _ _ | just f  | just g   = record { hom = twocomp  { c₁} {ℓ} {a} {c} f g }
+
+_==_ :  {c₁ c₂ : Level } ->  {a b : TwoObject  {c₁} } -> Rel (Maybe (Arrow  { c₂ })) c₂ 
+_==_    =   Eq ( _≡_  ) 
+
+open  import  Relation.Binary.PropositionalEquality
 
-_==_ :  {c₁ c₂ : Level } ->  {a b : TwoObject  {c₁} } -> Rel (Maybe (RawHom  {c₁} {c₂} a b  )) c₂
-_==_    =   Eq ( _≡_  ) 
+==-refl :    {   c₂ : Level }  {x : Maybe ( Arrow  { c₂ } ) } → x == x 
+==-refl  {_} {just x}  = just refl
+==-refl  {_} {nothing} = nothing
+
+==-sym :  {   c₂ : Level }  {x y : Maybe ( Arrow  { c₂ } ) }  → x == y  →  y == x 
+==-sym  (just x≈y) = just (sym x≈y)  
+==-sym   nothing    = nothing
+
+==-trans :   {   c₂ : Level }  -> {x y z : Maybe ( Arrow  { c₂ } ) }  → x == y  → y == z  → x == z 
+==-trans (just x≈y) (just y≈z) = just (trans x≈y y≈z)  
+==-trans nothing    nothing    = nothing
+
+
 
 open import maybeCat  
 
@@ -75,14 +85,13 @@
     _≈_ = λ a b →   hom a == hom b  ;
     Id  =  \{a} -> Two-id a ;
     isCategory  = record {
-            isEquivalence =  record {refl = *refl  {_} {_} {_} {{!!}}; trans = *trans  {_} {_} {_} {{!!}}; sym = *sym  {_} {_} {_} {{!!}}};
+            isEquivalence =  record {refl = ==-refl  ; trans = ==-trans  ; sym = ==-sym   } ;
             identityL  = \{a b f} -> identityL {a} {b} {f} ;
             identityR  = \{a b f} -> identityR {a} {b} {f} ;
             o-resp-≈  = \{a b c f g h i} -> o-resp-≈  {a} {b} {c} {f} {g} {h} {i} ;
             associative  = \{a b c d f g h } -> associative  {a} {b} {c} {d} {f} {g} {h}
        } 
    } where
-        open  import  Relation.Binary.PropositionalEquality
         ≡-cong = Relation.Binary.PropositionalEquality.cong 
         identityL : {A B : TwoObject} {f : Two-Hom A B} →  hom ( Two-id B × f ) == hom f
         identityL {a} {b} {f}  = {!!}
@@ -106,27 +115,27 @@
       } where
           I = TwoCat  {c₁} {c₂} {ℓ}
           MA = MaybeCat A
+          open ≈-Reasoning (MA)
           fobj :  Obj I -> Obj A
           fobj t0 = a
           fobj t1 = b
           fmap1 :  {x y : Obj I } ->  (Arrow  {c₂} ) -> Hom MA (fobj x) (fobj y)
           fmap1 {t0} {t1} arrow-f = record { hom = just f }
-          fmap1 {t0} {t1}  arrow-g = record { hom = just g }
+          fmap1 {t0} {t1} arrow-g = record { hom = just g }
           fmap1 {t0} {t0} id-t0  = record { hom = just ( id1 A a )}
           fmap1 {t1} {t1} id-t0  = record { hom = just ( id1 A b )}
           fmap1 {_} {_}   _ = record { hom = nothing }
           fmap :  {x y : Obj I } -> Hom I x y -> Hom MA (fobj x) (fobj y)
           fmap {x} {y} f  with ( hom f )
           fmap {x} {y} f  | nothing = record { hom = nothing }
-          fmap {x} {y} _  | just f = fmap1 {x} {y} ( RawMap f )
+          fmap {x} {y} _  | just f = fmap1 {x} {y}  f 
           open ≈-Reasoning (A) 
-          identity :  {x : Obj I} → MA [ fmap (id1 I  x) ≈ id1 MA  (fobj x) ]
+          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} → 
-               MA [ fmap (I [ g₁ o f₁ ]) ≈ MA [ fmap g₁ o fmap f₁ ] ]
+          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 ] → MA [ fmap f ≈ fmap g ]
+          ≈-cong :   {a : Obj I} {b : Obj I} {f g : Hom I a b}  → _[_≈_] I f g → {!!}
           ≈-cong   {_} {_} {f1} {g1} f≈g = {!!}
 
 
--- a/maybeCat.agda	Sun Mar 20 11:36:44 2016 +0900
+++ b/maybeCat.agda	Sun Mar 20 12:32:13 2016 +0900
@@ -30,17 +30,17 @@
 _[_≡≡_]  A =  Eq ( Category._≈_ A ) 
 
 
-*refl :   { c₁ c₂ ℓ : Level} -> { A : Category c₁ c₂ ℓ } ->  {a b : Obj A } -> {x : Maybe ( Hom A a b ) } → A [ x ≡≡ x ]
-*refl  {_} {_} {_} {A} {_} {_} {just x}  = just refl-hom where  open ≈-Reasoning (A)
-*refl  {_} {_} {_} {A} {_} {_} {nothing} = nothing
+≡≡-refl :   { c₁ c₂ ℓ : Level} -> { A : Category c₁ c₂ ℓ } ->  {a b : Obj A } -> {x : Maybe ( Hom A a b ) } → A [ x ≡≡ x ]
+≡≡-refl  {_} {_} {_} {A} {_} {_} {just x}  = just refl-hom where  open ≈-Reasoning (A)
+≡≡-refl  {_} {_} {_} {A} {_} {_} {nothing} = nothing
 
-*sym :  { c₁ c₂ ℓ : Level} -> { A : Category c₁ c₂ ℓ } -> {a b : Obj A } -> {x y : Maybe ( Hom A a b ) }  → A [ x ≡≡ y ] → A [ y ≡≡ x ]
-*sym {_} {_} {_} {A} (just x≈y) = just (sym x≈y)  where  open ≈-Reasoning (A)
-*sym {_} {_} {_} {A} nothing    = nothing
+≡≡-sym :  { c₁ c₂ ℓ : Level} -> { A : Category c₁ c₂ ℓ } -> {a b : Obj A } -> {x y : Maybe ( Hom A a b ) }  → A [ x ≡≡ y ] → A [ y ≡≡ x ]
+≡≡-sym {_} {_} {_} {A} (just x≈y) = just (sym x≈y)  where  open ≈-Reasoning (A)
+≡≡-sym {_} {_} {_} {A} nothing    = nothing
 
-*trans :  { c₁ c₂ ℓ : Level} -> { A : Category c₁ c₂ ℓ } -> {a b : Obj A } -> {x y z : Maybe ( Hom A a b ) }  → A [ x ≡≡ y ] → A [ y ≡≡ z ] → A [ x ≡≡ z ]
-*trans {_} {_} {_} {A} (just x≈y) (just y≈z) = just (trans-hom x≈y y≈z)  where  open ≈-Reasoning (A)
-*trans {_} {_} {_} {A} nothing    nothing    = nothing
+≡≡-trans :  { c₁ c₂ ℓ : Level} -> { A : Category c₁ c₂ ℓ } -> {a b : Obj A } -> {x y z : Maybe ( Hom A a b ) }  → A [ x ≡≡ y ] → A [ y ≡≡ z ] → A [ x ≡≡ z ]
+≡≡-trans {_} {_} {_} {A} (just x≈y) (just y≈z) = just (trans-hom x≈y y≈z)  where  open ≈-Reasoning (A)
+≡≡-trans {_} {_} {_} {A} nothing    nothing    = nothing
 
 
 
@@ -52,7 +52,7 @@
     _≈_ = λ a b →    _[_≡≡_] { c₁} {c₂} {ℓ} A  (hom a) (hom b)  ;
     Id  =  \{a} -> MaybeHomId a ;
     isCategory  = record {
-            isEquivalence = record {refl = *refl  {_} {_} {_} {A}; trans = *trans  {_} {_} {_} {A}; sym = *sym  {_} {_} {_} {A}};
+            isEquivalence = record {refl = ≡≡-refl  {_} {_} {_} {A}; trans = ≡≡-trans  {_} {_} {_} {A}; sym = ≡≡-sym  {_} {_} {_} {A}};
             identityL  = \{a b f} -> identityL {a} {b} {f} ;
             identityR  = \{a b f} -> identityR {a} {b} {f};
             o-resp-≈  = \{a b c f g h i} ->  o-resp-≈ {a} {b} {c} {f} {g} {h} {i} ;