changeset 82:bb95e780c68f

fix
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sat, 27 Jul 2013 14:34:21 +0900
parents 0404b2ba7db6
children c3846bf83717
files nat.agda
diffstat 1 files changed, 51 insertions(+), 28 deletions(-) [+]
line wrap: on
line diff
--- a/nat.agda	Sat Jul 27 13:03:02 2013 +0900
+++ b/nat.agda	Sat Jul 27 14:34:21 2013 +0900
@@ -1,4 +1,10 @@
-
+-- -- -- -- -- -- -- -- 
+--  Monad to Kelisli Category
+--  defines U_T and F_T as a resolution of Monad
+--  checks Adjointness
+-- 
+--   Shinji KONO <kono@ie.u-ryukyu.ac.jp>
+-- -- -- -- -- -- -- -- 
 
 -- Monad
 -- Category A
@@ -36,11 +42,13 @@
       → A [ A [  FMap G f o TMap μ a ]  ≈ A [ TMap μ b o  FMap F f ] ]
 Lemma2 = \n → IsNTrans.naturality ( isNTrans  n  )
 
+-- Laws of Monad
+--
 -- η :   1_A → T
 -- μ :   TT → T
--- μ(a)η(T(a)) = a
--- μ(a)T(η(a)) = a
--- μ(a)(μ(T(a))) = μ(a)T(μ(a))
+-- μ(a)η(T(a)) = a                 -- unity law 1
+-- μ(a)T(η(a)) = a                 -- unity law 2
+-- μ(a)(μ(T(a))) = μ(a)T(μ(a))     -- association law
 
 
 open Monad
@@ -76,19 +84,13 @@
     →  A [ A [ TMap μ a o (FMap T (TMap η a )) ] ≈ Id {_} {_} {_} {A} (FObj T a) ]
 Lemma6 = \m → IsMonad.unity2 ( isMonad m )
 
--- T = M x A
+-- Laws of Kleisli Category
+--
 -- nat of η
--- g ○ f = μ(c) T(g) f
--- η(b) ○ f = f
--- f ○ η(a) = f
--- h ○ (g ○ f) = (h ○ g) ○ f
-
-
-lemma12 :  {c₁ c₂ ℓ : Level} (L : Category c₁ c₂ ℓ) { a b c : Obj L } → 
-       ( x : Hom L c a ) → ( y : Hom L b c ) → L [ L [ x o y ] ≈ L [ x o y ] ]
-lemma12 L x y =  
-   let open ≈-Reasoning ( L )  in 
-      begin  L [ x o y ]  ∎
+-- g ○ f = μ(c) T(g) f        -- join definition
+-- η(b) ○ f = f               -- left id  (Lemma7)
+-- f ○ η(a) = f               -- right id  (Lemma8)
+-- h ○ (g ○ f) = (h ○ g) ○ f  -- assocation law (Lemma9)
 
 open Kleisli
 -- η(b) ○ f = f
@@ -188,6 +190,9 @@
      join K ( join K h g) f 
   ∎ where open ≈-Reasoning (A) 
 
+--
+--  o-resp in Kleisli Category ( for Functor definitions )
+--
 Lemma10 :  {a b c : Obj A} -> (f g : Hom A a (FObj T b) ) → (h i : Hom A b (FObj T c) ) → 
                           A [ f ≈ g ] → A [ h ≈ i ] → A [ (join K h f) ≈ (join K i g) ]
 Lemma10 {a} {b} {c} f g h i eq-fg eq-hi = let open ≈-Reasoning (A) in
@@ -201,6 +206,9 @@
        join K i g

 
+--
+--  Hom in Kleisli Category
+--
 
 record KHom (a : Obj A)  (b : Obj A)
      : Set c₂ where
@@ -231,17 +239,11 @@
          open ≈-Reasoning (A) 
          isEquivalence :  { a b : Obj A } ->
                IsEquivalence {_} {_} {KHom a b} _⋍_
-         isEquivalence {C} {D} =
-           record { refl  = λ {F} → ⋍-refl {F}
-             ; sym   = λ {F} {G} → ⋍-sym {F} {G}
-             ; trans = λ {F} {G} {H} → ⋍-trans {F} {G} {H}
-             } where
-                  ⋍-refl : {F : KHom C D} → F ⋍ F
-                  ⋍-refl = refl-hom
-                  ⋍-sym : {F G : KHom C D} → F ⋍ G → G ⋍ F
-                  ⋍-sym = sym
-                  ⋍-trans : {F G H : KHom C D} → F ⋍ G → G ⋍ H → F ⋍ H
-                  ⋍-trans = trans-hom
+         isEquivalence {C} {D} =      -- this is the same function as A's equivalence but has different types
+           record { refl  = refl-hom
+             ; sym   = sym
+             ; trans = trans-hom
+             } 
          KidL : {C D : Obj A} -> {f : KHom C D} → (K-id * f) ⋍ f
          KidL {_} {_} {f} =  Lemma7 (KMap f) 
          KidR : {C D : Obj A} -> {f : KHom C D} → (f * K-id) ⋍ f
@@ -263,6 +265,13 @@
          ; isCategory = isKleisliCategory
          }
 
+--
+-- Resolution
+--    T = U_T U_F
+--      nat-ε
+--      nat-η
+--
+
 ufmap : {a b : Obj A} (f : KHom a b ) -> Hom A (FObj T a) (FObj T b)
 ufmap {a} {b} f =  A [ TMap μ (b)  o FMap T (KMap f) ]
 
@@ -336,6 +345,7 @@
      } where
         identity : {a : Obj A} →  A [ A [ TMap η a o id1 A a ] ≈ TMap η a  ]
         identity {a} = IsCategory.identityR ( Category.isCategory A)
+        --  Category.cod A f and Category.cod A g are actualy the same b, so we don't need cong-≈, just refl
         lemma1 : {a b : Obj A} {f g : Hom A a b} → A [ f ≈ g ] → A [ TMap η b  ≈  TMap η b ]
         lemma1 f≈g = IsEquivalence.refl (IsCategory.isEquivalence  ( Category.isCategory A ))
         ≈-cong : {a b : Obj A} {f g : Hom A a b} → A [ f ≈ g ] → A [ A [ TMap η (Category.cod A f) o f ] ≈ A [ TMap η (Category.cod A g) o g ] ]
@@ -377,6 +387,10 @@
              KMap  ( ffmap g * ffmap f )

 
+--
+-- T = (U_T ○ F_T) 
+--
+
 Lemma11-1 :  ∀{a b : Obj A} -> (f : Hom A a b ) -> A [ FMap T f  ≈ FMap (U_T ○ F_T) f ]
 Lemma11-1 {a} {b} f = let open ≈-Reasoning (A) in
      sym ( begin
@@ -397,9 +411,15 @@
            FMap T f 
      ∎ )
 
+-- construct ≃
+
 Lemma11 :  T ≃  (U_T ○ F_T)
 Lemma11 f = Category.Cat.refl (Lemma11-1 f)
 
+--
+-- natural transformations
+--
+
 nat-η : NTrans A A identityFunctor ( U_T ○ F_T ) 
 nat-η = record { TMap = \x -> TMap η x ; isNTrans = isNTrans1 } where
        naturality1 :  {a b : Obj A} {f : Hom A a b}
@@ -465,6 +485,9 @@
        isNTrans1 : IsNTrans  KleisliCategory KleisliCategory ( F_T ○ U_T ) identityFunctor (\a -> tmap-ε a )
        isNTrans1 = record { naturality = naturality1 } 
 
+--
+-- μ = U_T ε U_F
+--
 Lemma12 : {x : Obj A } -> A [ TMap μ x ≈ FMap U_T ( TMap nat-ε ( FObj F_T x ) ) ]
 Lemma12 {x} = let open ≈-Reasoning (A) in
           sym ( begin
@@ -521,7 +544,7 @@
                   TMap η (FObj F_T a)
                ≈⟨⟩
                   KMap (id1 KleisliCategory (FObj F_T a))
-              ∎
+               ∎