Mercurial > hg > Members > kono > Proof > category

changeset 113:239fa20251ec

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
field version
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 01 Aug 2013 01:45:17 +0900
parents 5f8d6d1aece4
children 2032c438b6a6
files em-category.agda
diffstat 1 files changed, 41 insertions(+), 66 deletions(-) [+]
line wrap: on
line diff
--- a/em-category.agda	Wed Jul 31 23:53:36 2013 +0900
+++ b/em-category.agda	Thu Aug 01 01:45:17 2013 +0900
@@ -37,40 +37,33 @@
        eval     : A [ A [ φ  o TMap μ a ] ≈ A [ φ o FMap T φ ] ]
 open IsEMObj
 
-record EMObj {a : Obj A}  {φ : Hom A (FObj T a) a } : Set (c₁ ⊔ c₂ ⊔ ℓ)  where
+record EMObj : Set (c₁ ⊔ c₂ ⊔ ℓ)  where
+   field
+       a : Obj A
+       phi : Hom A (FObj T a) a
+       isEMObj : IsEMObj a phi 
    obj : Obj A
    obj = a
-   phi : Hom A (FObj T a) a
-   phi = φ
-   field
-     isEMObj : IsEMObj a φ 
+   φ : Hom A (FObj T a) a
+   φ = phi
 open EMObj
 
 record IsEMHom {x y : Obj A} {φ  : Hom A (FObj T x) x } {φ'  : Hom A (FObj T y) y }
-              (α : Hom A x y) 
-              (a : EMObj {x} {φ}) 
-              (b : EMObj {y} {φ'}) : Set ℓ where
+              (α : Hom A x y) : Set ℓ where
    field
        homomorphism : A [ A [ φ'  o FMap T α ]  ≈ A [ α  o φ ] ]
 open IsEMHom
 
-record Eilenberg-Moore-Hom {x y : Obj A }
-              {φ  : Hom A (FObj T x) x } 
-              {φ' : Hom A (FObj T y) y } 
-              {α : Hom A x y} 
-              (a : EMObj {x} {φ}) 
-              (b : EMObj {y} {φ'}) : Set (c₁ ⊔ c₂ ⊔ ℓ) where
-   EMap    : Hom A x y
-   EMap    = α
+record Eilenberg-Moore-Hom (a : EMObj ) (b : EMObj ) : Set (c₁ ⊔ c₂ ⊔ ℓ) where
    field
-       isEMHom : IsEMHom {x} {y} {φ} {φ'} α a b 
+       EMap    : Hom A (obj a) (obj b)
+       isEMHom : IsEMHom {obj a} {obj b} {φ a} {φ b} EMap 
 open Eilenberg-Moore-Hom
 
-EMHom : {x y : Obj A} {φ : Hom A (FObj T x) x } {φ' : Hom A (FObj T y) y } {α : Hom A x y }
-          (a : EMObj {x} {φ} ) (b : EMObj {y} {φ'} ) -> Set (c₁ ⊔ c₂ ⊔ ℓ)
-EMHom {x} {y} {φ} {φ'} {α} = \a b -> Eilenberg-Moore-Hom {x} {y} {φ} {φ'} {α} a b
+EMHom : (a : EMObj ) (b : EMObj ) -> Set (c₁ ⊔ c₂ ⊔ ℓ)
+EMHom = \a b -> Eilenberg-Moore-Hom a b
 
-Lemma-EM1 : {x : Obj A} {φ : Hom A (FObj T x) x} (a : EMObj {x} {φ})
+Lemma-EM1 : {x : Obj A} {φ : Hom A (FObj T x) x} (a : EMObj )
                -> A [ A [ φ  o FMap T (id1 A x) ]  ≈ A [ (id1 A x) o φ ] ]
 Lemma-EM1 {x} {φ} a = let open ≈-Reasoning (A) in
    begin
@@ -83,66 +76,49 @@
        (id1 A x)  o φ
    ∎
 
-EM-id : { a : EMObj } -> EMHom {obj a} {obj a} {phi a} {phi a} {id1 A (obj a)} a a 
-EM-id {a} = record { 
+EM-id : { a : EMObj } -> EMHom a a
+EM-id {a} = record { EMap = id1 A (obj a);
      isEMHom = record { homomorphism = Lemma-EM1 {obj a} {phi a} a } } 
 
 open import Relation.Binary.Core
 
-Lemma-EM2 : {x y z : Obj A}
-            {φ   : Hom A  (FObj T x) x}
-            {φ'  : Hom A  (FObj T y) y}
-            {φ'' : Hom A  (FObj T z) z}
-            {α  : Hom A x y}
-            {α' : Hom A y z}
-            (a : EMObj {x} {φ}   ) 
-            (b : EMObj {y} {φ'}  ) 
-            (c : EMObj {z} {φ''} ) 
-            (g : EMHom {y} {z} {φ'} {φ''} {α'} b c )
-            (f : EMHom {x} {y} {φ} {φ'} {α} a b)
-                 -> A [ A [ φ''  o FMap T (A [ (EMap g)  o  (EMap f) ] ) ]  
-                      ≈ A [ (A [ (EMap g)  o  (EMap f) ])  o φ ] ]
-Lemma-EM2 {_} {_} {_} {φ} {φ'} {φ''} _ _ _ g f = let 
+Lemma-EM2 : (a : EMObj ) 
+            (b : EMObj ) 
+            (c : EMObj ) 
+            (g : EMHom b c)
+            (f : EMHom a b)
+                 -> A [ A [ φ c  o FMap T (A [ (EMap g)  o  (EMap f) ] ) ]  
+                      ≈ A [ (A [ (EMap g)  o  (EMap f) ])  o φ a ] ]
+Lemma-EM2 a b c g f = let 
       open ≈-Reasoning (A) in
    begin
-        φ''  o FMap T ((EMap g)  o  (EMap f))
+        φ c  o FMap T ((EMap g)  o  (EMap f))
    ≈⟨ cdr (distr T) ⟩
-        φ''  o ( FMap T (EMap g)  o  FMap T (EMap f) )
+        φ c o ( FMap T (EMap g)  o  FMap T (EMap f) )
    ≈⟨ assoc ⟩
-        ( φ''  o FMap T (EMap g))  o  FMap T (EMap f) 
+        ( φ c o FMap T (EMap g))  o  FMap T (EMap f) 
    ≈⟨ car (IsEMHom.homomorphism (isEMHom g)) ⟩
-        ( EMap g o φ') o  FMap T (EMap f) 
+        ( EMap g o φ b) o  FMap T (EMap f) 
    ≈⟨ sym assoc ⟩
-        EMap g  o (φ' o  FMap T (EMap f) )
+        EMap g  o (φ b o  FMap T (EMap f) )
    ≈⟨ cdr (IsEMHom.homomorphism (isEMHom f)) ⟩
-        EMap g  o (EMap f  o  φ)
+        EMap g  o (EMap f  o  φ a)
    ≈⟨ assoc ⟩
-        ( (EMap g)  o  (EMap f) )  o φ
+        ( (EMap g)  o  (EMap f) )  o φ a
    ∎
 
-_*_ : {x y z : Obj A}
-            {φ   : Hom A  (FObj T x) x}
-            {φ'  : Hom A  (FObj T y) y}
-            {φ'' : Hom A  (FObj T z) z}
-            {α  : Hom A x y}
-            {α' : Hom A y z}
-            {a : EMObj {x} {φ}   } 
-            {b : EMObj {y} {φ'}  } 
-            {c : EMObj {z} {φ''} } 
-            (g : EMHom {y} {z} {φ'} {φ''} {α'} b c ) 
-            (f : EMHom {x} {y} {φ} {φ'} {α} a b) ->
-                (EMHom {x} {z} {φ} {φ''} {A [ α' o  α ] } a c)
-_*_ {x} {y} {z} {φ} {φ'} {φ''} {α} {α'} {a} {b} {c} g f = record { isEMHom = record { homomorphism = 
-     Lemma-EM2 {x} {y} {z} {φ} {φ'} {φ''} {α} {α'} a b c g f } }
+_*_ : {a : EMObj } {b : EMObj } {c : EMObj }
+            (g : EMHom b c ) (f : EMHom a b) -> (EMHom a c)
+_*_ {a} {b} {c} g f = record { EMap = A [ EMap g  o EMap f ] ; isEMHom = record { homomorphism = 
+     Lemma-EM2 a b c g f } }
 
 _∙_ :  {a b c : EMObj } -> EMHom b c -> EMHom a b -> EMHom a c
 _∙_ {a} {b} {c} g f = record { isEMHom = record { homomorphism = Lemma-EM2 a b c g f } }
 
-_≗_ :  {x y : Obj A} {φ   : Hom A  (FObj T x) x} {φ'  : Hom A  (FObj T y) y} {α α' : Hom A x y} 
-            {a : EMObj {x} {φ} } {b : EMObj {y} {φ'}}
-            (f : EMHom {x} {y} {φ} {φ'} {α}  a b )
-            (g : EMHom {x} {y} {φ} {φ'} {α'} a b ) -> Set ℓ 
-_≗_ {_} {_} {_} {_} {α} {α'} f g = A [ α ≈ α' ]
+_≗_ : {a : EMObj } {b : EMObj }
+            (f : EMHom a b )
+            (g : EMHom a b ) -> Set ℓ 
+_≗_ f g = A [ EMap f ≈ EMap g ]
 
 
 isEilenberg-MooreCategory : IsCategory EMObj EMHom _≗_ _∙_  EM-id 
@@ -154,9 +130,8 @@
                     }
      where
          open ≈-Reasoning (A) 
-         isEquivalence : {x y : Obj A} {φ   : Hom A  (FObj T x) x} {φ'  : Hom A  (FObj T y) y} {α α' : Hom A x y} 
-            {a : EMObj {x} {φ} } {b : EMObj {y} {φ'}} ->
-               IsEquivalence {_} {_} {EMHom {x} {y} {φ} {φ'} {α}  a b } _≗_
+         isEquivalence : {a : EMObj } {b : EMObj } ->
+               IsEquivalence {_} {_} {EMHom a b } _≗_
          isEquivalence {C} {D} =      -- this is the same function as A's equivalence but has different types
            record { refl  = refl-hom
              ; sym   = sym