diff cat-utility.agda @ 176:ae1a4f7e5203

hom set adjunction done.
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 25 Aug 2013 09:44:00 +0900
parents 795be747d7a9
children 58ee98bbb333
line wrap: on
line diff
--- a/cat-utility.agda	Sat Aug 24 22:14:29 2013 +0900
+++ b/cat-utility.agda	Sun Aug 25 09:44:00 2013 +0900
@@ -34,72 +34,6 @@
                _* :  { a : Obj A}{ b : Obj B} → ( Hom A a (FObj U b) ) →  Hom B (F a ) b 
                isUniversalMapping : IsUniversalMapping A B U F η _*
 
---     naturality of left
---     f' = k* f   k*: Hom A F(a) k,                                                                                                                        
---                        left                                               left                                                                           
---    f : Hom A F(a)   b --------> f* : Hom B a U(b)      f : Hom A F(a')b --------> f* : Hom B a' U(b)                                                     
---       |                               |                     |                               |                                                            
---       |k*                             |U(k*)                |F(h*)                          |h*                                                          
---       v                               v                     v                               v                                                            
---    f': Hom A F(a)   b'--------> f* : Hom B a U(b')     f': Hom A F(a)  b --------> f* : Hom B a U(b)                                                     
---                        left                                                                                                                              
-
-        record UnityOfOppsite  {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ') 
-                         ( U : Functor B A )
-                         ( F : Functor A B )
-                         : Set (suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁' ⊔ c₂' ⊔ ℓ' )) where
-           field
-               right  : {a : Obj A} { b : Obj B } → Hom A a ( FObj U b ) → Hom B (FObj F a) b
-               left   : {a : Obj A} { b : Obj B } → Hom B (FObj F a) b   → Hom A a ( FObj U b ) 
-               right-injective : {a : Obj A} { b : Obj B } → {f : Hom A a (FObj U b) }  → A [ left ( right f ) ≈ f ]
-               left-injective  : {a : Obj A} { b : Obj B } → {f : Hom B (FObj F a) b }  → B [ right ( left f ) ≈ f ]
-               left-commute1 : {a : Obj A} {b b' : Obj B } ->
-                       ( f : Hom B (FObj F a) b )  -> ( k : Hom B b b' ) ->
-                        A [  left ( B [ k o  f ] )  ≈ A [ FMap U k o left f  ] ]
-               left-commute2 : {a a' : Obj A} {b : Obj B } ->
-                       ( f : Hom B (FObj F a) b )  -> ( h : Hom A a' a ) ->
-                        A [ left ( B [ f  o  FMap F h ] )  ≈  A [ left f o h ] ]
-               r-cong : {a : Obj A} { b : Obj B } → { f g : Hom A a ( FObj U b ) } →  A [ f  ≈ g ] → B [ right f ≈ right g ]
-               l-cong : {a : Obj A} { b : Obj B } → { f g : Hom B (FObj F a) b }   →  B [ f  ≈ g ] → A [ left f ≈ left g   ]
-           right-commute1 : {a : Obj A} {b b' : Obj B } ->
-                       ( g : Hom A a (FObj U b))  -> ( k : Hom B b b' ) ->
-                        B [ B [ k o  right g ]   ≈ right ( A [ FMap U k o g  ] ) ]
-           right-commute1 g k =  let open ≈-Reasoning (B) in
-                     begin
-                          k o  right g
-                     ≈⟨ sym left-injective ⟩
-                          right ( left ( k o  right g ) )
-                     ≈⟨ r-cong ( left-commute1 (right g) k ) ⟩
-                          right ( A [ FMap U k o left ( right g ) ] )
-                     ≈⟨ r-cong (lemma-1 g k) ⟩
-                         right ( A [ FMap U k o g  ] ) 
-                     ∎ where
-                             lemma-1 : {a : Obj A} {b b' : Obj B } ->
-                               ( g : Hom A a (FObj U b))  -> ( k : Hom B b b' ) ->
-                                A [ A [ FMap U k o left ( right g ) ]   ≈  A [ FMap U k o g  ] ]
-                             lemma-1 g k = let open ≈-Reasoning (A) in
-                                   begin
-                                        FMap U k o left ( right g ) 
-                                   ≈⟨ cdr ( right-injective) ⟩
-                                        FMap U k o g  
-                                   ∎ 
-           right-commute2 : {a a' : Obj A} {b : Obj B } ->
-                       ( g : Hom A a (FObj U b) )  -> ( h : Hom A a' a ) ->
-                        B [ B [ right g  o  FMap F h ]   ≈  right ( A [ g o h ] ) ]
-           right-commute2 g h =  let open ≈-Reasoning (B) in
-                     begin
-                          right g  o  FMap F h 
-                     ≈⟨  sym left-injective ⟩
-                          right ( left ( right g  o  FMap F h  ))
-                     ≈⟨ r-cong ( left-commute2 (right g) h ) ⟩
-                          right ( A [ left ( right g ) o h ] )
-                     ≈⟨ r-cong ( lemma-2 g h  ) ⟩
-                          right ( A [ g o h ] )
-                     ∎  where
-                           lemma-2 :  {a a' : Obj A} {b : Obj B } ->
-                               ( g : Hom A a (FObj U b))  -> ( h : Hom A a' a ) ->
-                                A [ A [  left ( right g ) o h ]   ≈  A [ g o h  ] ]
-                           lemma-2 g h  = let open ≈-Reasoning (A) in car ( right-injective  )
         open NTrans
         open import Category.Cat
         record IsAdjunction  {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')