Mercurial > hg > Members > kono > Proof > category

changeset 688:a5f2ca67e7c5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix monad/adjunction definition couniversal to limit does not work
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sat, 11 Nov 2017 21:34:58 +0900
parents d0bc017c6b61
children fb9fc9652c04
files adj-monad.agda cat-utility.agda comparison-em.agda comparison-functor.agda em-category.agda free-monoid.agda kleisli.agda pullback.agda universal-mapping.agda
diffstat 9 files changed, 260 insertions(+), 166 deletions(-) [+]
line wrap: on
line diff
--- a/adj-monad.agda	Wed Nov 08 19:57:43 2017 +0900
+++ b/adj-monad.agda	Sat Nov 11 21:34:58 2017 +0900
@@ -20,7 +20,6 @@
 --
 ----
 
-open Adjunction
 open NTrans
 open Functor
 
@@ -35,18 +34,25 @@
          lemma11  n = record { TMap = \a → TMap n a; isNTrans = record { commute = IsNTrans.commute ( isNTrans n ) }}
 
 Adj2Monad : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
-                 { U : Functor B A }
-                 { F : Functor A B }
-                 { η : NTrans A A identityFunctor ( U ○  F ) }
-                 { ε : NTrans B B  ( F ○  U ) identityFunctor } →
-      Adjunction A B U F η ε  → Monad A (U ○  F) η (UεF A B U F ε)
-Adj2Monad A B {U} {F} {η} {ε} adj = record {
+       → Adjunction A B → Monad A 
+Adj2Monad A B adj = record {
+         T = T ;
+         η = η ;
+         μ = μ ;
          isMonad = record {
                     assoc = assoc1;
                     unity1 = unity1;
                     unity2 = unity2
               }
       }  where
+           U : Functor B A 
+           U = Adjunction.U adj
+           F : Functor A B 
+           F = Adjunction.F adj
+           η : NTrans A A identityFunctor ( U ○  F ) 
+           η = Adjunction.η adj
+           ε : NTrans B B  ( F ○  U ) identityFunctor 
+           ε = Adjunction.ε adj
            T : Functor A A
            T = U  ○ F
            μ : NTrans A A ( T ○ T ) T
@@ -75,7 +81,7 @@
                TMap μ a o TMap η ( FObj T a )
              ≈⟨⟩
                (FMap U (TMap ε ( FObj F a ))) o TMap η ( FObj U ( FObj F  a ))
-             ≈⟨ IsAdjunction.adjoint1 ( isAdjunction adj ) ⟩
+             ≈⟨ IsAdjunction.adjoint1 ( Adjunction.isAdjunction adj ) ⟩
                id (FObj U ( FObj F a ))
              ≈⟨⟩
                id (FObj T a)
@@ -88,7 +94,7 @@
                 (FMap U (TMap ε ( FObj F a ))) o (FMap U ( FMap F (TMap η a )))
              ≈⟨ sym (distr U ) ⟩
                 FMap U ( B [  (TMap ε ( FObj F a )) o ( FMap F (TMap η a )) ])
-             ≈⟨ (IsFunctor.≈-cong (isFunctor U)) (IsAdjunction.adjoint2 ( isAdjunction adj )) ⟩
+             ≈⟨ (IsFunctor.≈-cong (isFunctor U)) (IsAdjunction.adjoint2 ( Adjunction.isAdjunction adj )) ⟩
                 FMap U ( id1 B (FObj F a) )
              ≈⟨ IsFunctor.identity ( isFunctor U ) ⟩
                 id (FObj T a)
--- a/cat-utility.agda	Wed Nov 08 19:57:43 2017 +0900
+++ b/cat-utility.agda	Sat Nov 11 21:34:58 2017 +0900
@@ -26,12 +26,12 @@
                              A [ A [ FMap U g o  η a ]  ≈ f ] → B [ f * ≈ g ]
 
         record UniversalMapping  {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
-                         ( U : Functor B A )
-                         ( F : Obj A → Obj B )
-                         ( η : (a : Obj A) → Hom A a ( FObj U (F a) ) )
                          : Set (suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁' ⊔ c₂' ⊔ ℓ' )) where
             infixr 11 _*
             field
+               U : Functor B A 
+               F : Obj A → Obj B 
+               η : (a : Obj A) → Hom A a ( FObj U (F a) ) 
                _* :  { a : Obj A}{ b : Obj B} → ( Hom A a (FObj U b) ) →  Hom B (F a ) b
                isUniversalMapping : IsUniversalMapping A B U F η _*
 
@@ -48,12 +48,12 @@
                              B [ B [ ε b o FMap F g ]  ≈ f ] → A [ f *' ≈ g ]
 
         record coUniversalMapping  {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
-                         ( F : Functor A B )
-                         ( U : Obj B → Obj A )
-                         ( ε : (b : Obj B) → Hom B ( FObj F (U b) ) b )
                          : Set (suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁' ⊔ c₂' ⊔ ℓ' )) where
             infixr 11 _*'
             field
+               F : Functor A B 
+               U : Obj B → Obj A 
+               ε : (b : Obj B) → Hom B ( FObj F (U b) ) b 
                _*' :  { b : Obj B}{ a : Obj A} → ( Hom B (FObj F a) b ) →  Hom A a (U b )
                iscoUniversalMapping : coIsUniversalMapping A B F U ε _*'
 
@@ -72,12 +72,12 @@
                              B [ B [ ( TMap ε ( FObj F a ))  o ( FMap F ( TMap η a )) ]  ≈ id1 B (FObj F a) ]
 
         record Adjunction {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
-                         ( U : Functor B A )
-                         ( F : Functor A B )
-                         ( η : NTrans A A identityFunctor ( U ○  F ) )
-                         ( ε : NTrans B B  ( F ○  U ) identityFunctor )
                          : Set (suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁' ⊔ c₂' ⊔ ℓ' )) where
             field
+               U : Functor B A 
+               F : Functor A B 
+               η : NTrans A A identityFunctor ( U ○  F ) 
+               ε : NTrans B B  ( F ○  U ) identityFunctor 
                isAdjunction : IsAdjunction A B U F η ε
             U-functor =  U
             F-functor =  F
@@ -95,9 +95,12 @@
               unity1 : {a : Obj A} → A [ A [ TMap μ a o TMap η ( FObj T a ) ] ≈ Id {_} {_} {_} {A} (FObj T a) ]
               unity2 : {a : Obj A} → A [ A [ TMap μ a o (FMap T (TMap η a ))] ≈ Id {_} {_} {_} {A} (FObj T a) ]
 
-        record Monad {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) (T : Functor A A) (η : NTrans A A identityFunctor T) (μ : NTrans A A (T ○ T) T)
+        record Monad {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) 
                : Set (suc (c₁ ⊔ c₂ ⊔ ℓ )) where
           field
+            T : Functor A A
+            η : NTrans A A identityFunctor T
+            μ : NTrans A A (T ○ T) T
             isMonad : IsMonad A T η μ
              -- g ○ f = μ(c) T(g) f
           join : { a b : Obj A } → { c : Obj A } →
@@ -143,20 +146,17 @@
         --      nat-ε
         --      nat-η     -- same as η but has different types
 
-        record MResolution {c₁ c₂ ℓ  c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) ( B : Category c₁' c₂' ℓ' )
-              ( T : Functor A A )
-              -- { η : NTrans A A identityFunctor T }
-              -- { μ : NTrans A A (T ○ T) T }
-              -- { M : Monad A T  η μ }
-              ( UR : Functor B A ) ( FR : Functor A B )
-              { ηR : NTrans A A identityFunctor  ( UR ○ FR ) }
-              { εR : NTrans B B ( FR ○ UR ) identityFunctor }
-              { μR : NTrans A A ( (UR ○ FR)  ○ ( UR ○ FR )) ( UR ○ FR  ) }
-              ( Adj : Adjunction A B UR FR ηR εR  )
-                        : Set (suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁' ⊔ c₂' ⊔ ℓ' )) where
-                   field
-                      T=UF  :  T ≃  (UR ○ FR)
-                      μ=UεF : {x : Obj A } → A [ TMap μR x ≈ FMap UR ( TMap εR ( FObj FR x ) ) ]
+        record MResolution {c₁ c₂ ℓ  c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) ( B : Category c₁' c₂' ℓ' ) ( M : Monad A )
+           : Set (suc (c₁ ⊔ c₂ ⊔ ℓ ⊔ c₁' ⊔ c₂' ⊔ ℓ' )) where
+             field
+              UR : Functor B A
+              FR : Functor A B 
+              ηR : NTrans A A identityFunctor  ( UR ○ FR ) 
+              εR : NTrans B B ( FR ○ UR ) identityFunctor 
+              μR : NTrans A A ( (UR ○ FR)  ○ ( UR ○ FR )) ( UR ○ FR  ) 
+              Adj : IsAdjunction A B UR FR ηR εR  
+              T=UF  :  Monad.T M ≃  (UR ○ FR)
+              μ=UεF : {x : Obj A } → A [ TMap μR x ≈ FMap UR ( TMap εR ( FObj FR x ) ) ]
                       -- ηR=η  : {x : Obj A } → A [ TMap ηR x  ≈  TMap η x ] -- We need T → UR FR conversion
                       -- μR=μ  : {x : Obj A } → A [ TMap μR x  ≈  TMap μ x ]
 
@@ -381,8 +381,13 @@
 
 -- initial object
 
-        record HasInitialObject {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) (i : Obj A) : Set  (suc ℓ ⊔ (suc c₁ ⊔ suc c₂)) where
+        record IsInitialObject {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) (i : Obj A) : Set  (suc ℓ ⊔ (suc c₁ ⊔ suc c₂)) where
           field
              initial :  ∀( a : Obj A ) →  Hom A i a
              uniqueness  : { a : Obj A } →  ( f : Hom A i a ) → A [ f ≈  initial a ]
 
+        record InitialObject {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) : Set  (suc ℓ ⊔ (suc c₁ ⊔ suc c₂)) where
+          field
+             initialObject :  Obj A 
+             isInitialObject :  IsInitialObject A initialObject
+
--- a/comparison-em.agda	Wed Nov 08 19:57:43 2017 +0900
+++ b/comparison-em.agda	Sat Nov 11 21:34:58 2017 +0900
@@ -19,14 +19,13 @@
                  { T : Functor A A }
                  { η : NTrans A A identityFunctor T }
                  { μ : NTrans A A (T ○ T) T }
-                 { M' : Monad A T η μ }
+                 { M' : IsMonad A T η μ }
       {c₁' c₂' ℓ' : Level} ( B : Category c₁' c₂' ℓ' ) 
       { U^K : Functor B A } { F^K : Functor A B }
       { η^K : NTrans A A identityFunctor ( U^K ○ F^K ) }
       { ε^K : NTrans B B ( F^K ○ U^K ) identityFunctor } 
       { μ^K : NTrans A A (( U^K ○ F^K ) ○ ( U^K ○ F^K )) ( U^K ○ F^K ) }
-      ( Adj^K : Adjunction A B U^K F^K η^K ε^K )
-      ( RK : MResolution A B T U^K F^K {η^K} {ε^K} {μ^K} Adj^K )
+      ( Adj^K : IsAdjunction A B U^K F^K η^K ε^K )
   where
 
 open import adj-monad
@@ -36,8 +35,8 @@
 μ^K' : NTrans A A (( U^K ○ F^K ) ○ ( U^K ○ F^K )) ( U^K ○ F^K ) 
 μ^K'  = UεF A B U^K F^K ε^K 
 
-M : Monad A (U^K ○ F^K ) η^K μ^K' 
-M =  Adj2Monad A B {U^K} {F^K} {η^K} {ε^K} Adj^K
+M : IsMonad A (U^K ○ F^K ) η^K μ^K' 
+M = Monad.isMonad ( Adj2Monad A B ( record { U = U^K; F = F^K ; η = η^K ; ε = ε^K ; isAdjunction =  Adj^K } ) )
 
 open import em-category {c₁} {c₂} {ℓ} {A} { U^K ○ F^K } { η^K } { μ^K' } { M } 
 
@@ -55,7 +54,7 @@
       identity1 b =  let open ≈-Reasoning (A) in
            begin
                 (FMap U^K (TMap ε^K b))  o TMap η^K (FObj U^K b)
-           ≈⟨ IsAdjunction.adjoint1 (isAdjunction Adj^K) ⟩
+           ≈⟨ IsAdjunction.adjoint1 Adj^K ⟩
                 id1 A (FObj U^K b)
            ∎
 
--- a/comparison-functor.agda	Wed Nov 08 19:57:43 2017 +0900
+++ b/comparison-functor.agda	Sat Nov 11 21:34:58 2017 +0900
@@ -19,14 +19,13 @@
                  { T : Functor A A }
                  { η : NTrans A A identityFunctor T }
                  { μ : NTrans A A (T ○ T) T }
-                 { M' : Monad A T η μ }
+                 { M' : IsMonad A T η μ }
       {c₁' c₂' ℓ' : Level} ( B : Category c₁' c₂' ℓ' ) 
       { U_K : Functor B A } { F_K : Functor A B }
       { η_K : NTrans A A identityFunctor ( U_K ○ F_K ) }
       { ε_K : NTrans B B ( F_K ○ U_K ) identityFunctor } 
       { μ_K' : NTrans A A (( U_K ○ F_K ) ○ ( U_K ○ F_K )) ( U_K ○ F_K ) }
-      ( AdjK : Adjunction A B U_K F_K η_K ε_K )
-      ( RK : MResolution A B T U_K F_K {η_K} {ε_K} {μ_K'} AdjK )
+      ( AdjK : IsAdjunction A B U_K F_K η_K ε_K )
    where
 
 open import adj-monad
@@ -36,8 +35,8 @@
 μ_K : NTrans A A (( U_K ○ F_K ) ○ ( U_K ○ F_K )) ( U_K ○ F_K ) 
 μ_K  = UεF A B U_K F_K ε_K 
 
-M : Monad A (U_K ○ F_K ) η_K μ_K 
-M =  Adj2Monad A B {U_K} {F_K} {η_K} {ε_K} AdjK
+M : IsMonad A (U_K ○ F_K ) η_K μ_K 
+M = Monad.isMonad ( Adj2Monad A B ( record { U = U_K; F = F_K ; η = η_K ; ε = ε_K ; isAdjunction =  AdjK } ) )
 
 open import kleisli {c₁} {c₂} {ℓ} {A} { U_K ○ F_K } { η_K } { μ_K } { M } 
 
@@ -68,7 +67,7 @@
                TMap ε_K (FObj F_K a) o FMap F_K (KMap (K-id {a}))
            ≈⟨⟩
               TMap ε_K (FObj F_K a) o FMap F_K (TMap η_K a)
-           ≈⟨ IsAdjunction.adjoint2 (isAdjunction AdjK) ⟩
+           ≈⟨ IsAdjunction.adjoint2 AdjK ⟩
               id1 B (FObj F_K a)
            ∎
          ≈-cong : {a b : Obj A} → {f g : KHom a b} → A [ KMap f ≈ KMap g ] → B [ kfmap f ≈ kfmap g ]
@@ -144,7 +143,7 @@
              TMap ε_K (FObj F_K b) o (FMap F_K (TMap η_K b)  o FMap F_K f )
            ≈⟨ assoc  ⟩
              (TMap ε_K (FObj F_K b) o FMap F_K (TMap η_K b))  o FMap F_K f 
-           ≈⟨ car ( IsAdjunction.adjoint2 (isAdjunction AdjK)) ⟩
+           ≈⟨ car ( IsAdjunction.adjoint2 AdjK) ⟩
              id1 B (FObj F_K b)  o FMap F_K f 
            ≈⟨ idL  ⟩
              FMap F_K f 
@@ -170,7 +169,7 @@
                  FMap K_T  (record { KMap = (TMap η_K b) })
            ≈⟨⟩  
                  TMap ε_K (FObj F_K b) o FMap F_K (TMap η_K b)
-           ≈⟨  IsAdjunction.adjoint2 (isAdjunction AdjK) ⟩  
+           ≈⟨  IsAdjunction.adjoint2 AdjK ⟩  
                  id1 B (FObj F_K b)
            ∎
 
@@ -185,7 +184,7 @@
                 TMap ε_K (FObj F_K (FObj T_K c)) o ( FMap F_K (TMap η_K (FObj T_K c)) o FMap F_K g )
            ≈⟨ assoc ⟩
                 (TMap ε_K (FObj F_K (FObj T_K c)) o ( FMap F_K (TMap η_K (FObj T_K c)))) o FMap F_K g 
-           ≈⟨ car ( IsAdjunction.adjoint2 (isAdjunction AdjK)) ⟩  
+           ≈⟨ car ( IsAdjunction.adjoint2 AdjK) ⟩  
                  id1 B (FObj F_K (FObj T_K c)) o FMap F_K g 
            ≈⟨ idL ⟩
                 FMap F_K g 
--- a/em-category.agda	Wed Nov 08 19:57:43 2017 +0900
+++ b/em-category.agda	Sat Nov 11 21:34:58 2017 +0900
@@ -24,7 +24,7 @@
                  { T : Functor A A }
                  { η : NTrans A A identityFunctor T }
                  { μ : NTrans A A (T ○ T) T }
-                 { M : Monad A T η μ } where
+                 { M : IsMonad A T η μ } where
 
 --
 --  Hom in Eilenberg-Moore Category
@@ -104,7 +104,7 @@
 -- cannot use as identityL = EMidL
 --
 EMidL : {C D : EMObj} → {f : EMHom C D} → (EM-id  ∙ f) ≗ f
-EMidL {C} {D} {f} = let open ≈-Reasoning (A) in idL {obj D} 
+EMidL {C} {D} {f} = let open ≈-Reasoning (A) in idL {obj C} 
 EMidR : {C D : EMObj} → {f : EMHom C D} → (f ∙ EM-id)  ≗ f
 EMidR {C} {_} {_} = let open ≈-Reasoning (A) in  idR {obj C}
 EMo-resp :  {a b c : EMObj} → {f g : EMHom a b } → {h i : EMHom  b c } → 
@@ -157,12 +157,11 @@
         }
      } where open ≈-Reasoning (A) 
 
-open Monad
 Lemma-EM4 : (x : Obj A ) → A [ A [ TMap μ x  o TMap η (FObj T x) ] ≈ id1 A (FObj T x) ]
 Lemma-EM4 x = let  open ≈-Reasoning (A) in
     begin
        TMap μ x  o TMap η (FObj T x) 
-    ≈⟨ IsMonad.unity1 (isMonad M) ⟩
+    ≈⟨ IsMonad.unity1 M ⟩
        id1 A (FObj T x)
     ∎
 
@@ -170,7 +169,7 @@
 Lemma-EM5 x =  let  open ≈-Reasoning (A) in
     begin
        ( TMap μ x)  o TMap μ (FObj T x) 
-    ≈⟨ IsMonad.assoc (isMonad M) ⟩
+    ≈⟨ IsMonad.assoc M ⟩
        ( TMap μ x) o FMap T ( TMap μ x)
     ∎
 
@@ -312,8 +311,12 @@
               TMap μ x
           ∎ )
 
-Adj^T : Adjunction A Eilenberg-MooreCategory U^T F^T η^T ε^T
+Adj^T : Adjunction A Eilenberg-MooreCategory 
 Adj^T = record {
+           U =  U^T ;
+           F =  F^T ;
+           η = η^T  ;
+           ε = ε^T ;
            isAdjunction = record {
                adjoint1 = λ {b} → IsAlgebra.identity (isAlgebra b) ; -- adjoint1
                adjoint2 = adjoint2
@@ -339,14 +342,20 @@
                   EMap (( TMap ε^T ( FObj F^T a )) ∙ ( FMap F^T ( TMap η^T a )) )
                ≈⟨⟩
                   TMap μ a  o FMap T ( TMap η a )
-               ≈⟨ IsMonad.unity2 (isMonad M) ⟩
+               ≈⟨ IsMonad.unity2 M ⟩
                   EMap (id1 Eilenberg-MooreCategory (FObj F^T a))
                ∎
 
 open MResolution
 
-Resolution^T : MResolution A Eilenberg-MooreCategory T U^T F^T {η^T} {ε^T} {μ^T} Adj^T 
+Resolution^T : MResolution A Eilenberg-MooreCategory  ( record { T = T ; η = η ; μ = μ; isMonad = M } )
 Resolution^T = record {
+     UR =  U^T ;
+     FR =  F^T ;
+     ηR =  η^T ;
+     εR =  ε^T ;
+     μR =  μ^T  ;
+     Adj = Adjunction.isAdjunction Adj^T ;
      T=UF = Lemma-EM8;
      μ=UεF  = Lemma-EM11
  }
--- a/free-monoid.agda	Wed Nov 08 19:57:43 2017 +0900
+++ b/free-monoid.agda	Sat Nov 11 21:34:58 2017 +0900
@@ -199,8 +199,6 @@
 
 -- solution
 
-open UniversalMapping
-
 --   [a,b,c] → f(a) ∙ f(b) ∙ f(c)
 Φ :  {a : Obj A } {b : Obj B} ( f : Hom A a (FObj U b) ) →  List a → Carrier b
 Φ {a} {b} f [] = ε b
@@ -236,9 +234,12 @@
 eta :  (a : Obj A) → Hom A a ( FObj U (Generator a) )
 eta  a = λ ( x : a ) →  x :: []
 
-FreeMonoidUniveralMapping : UniversalMapping A B U Generator eta  
+FreeMonoidUniveralMapping : UniversalMapping A B 
 FreeMonoidUniveralMapping = 
     record {
+       U = U ;
+       F = Generator ;
+       η =  eta ;
        _* = λ {a b} → λ f → solution a b f ; 
        isUniversalMapping = record {
              universalMapping = λ {a b f} → universalMapping {a} {b} {f} ; 
@@ -308,8 +309,9 @@
 
 open NTrans
 --   fm-ε b = Φ
+
 fm-ε :  NTrans B B ( ( FunctorF A B FreeMonoidUniveralMapping) ○ U) identityFunctor
-fm-ε =  nat-ε A B {U} {Generator} {eta} FreeMonoidUniveralMapping 
+fm-ε =  nat-ε A B FreeMonoidUniveralMapping 
 --   TMap = λ a  →  solution (FObj U a) a (λ x → x ) ;
 --   isNTrans = record {
 --        commute =  commute1 
@@ -337,8 +339,6 @@
      commute1 {a} {b} {f} =  refl   --    λ (x : a ) → f x :: []
         
 
-open Adjunction
-
 -- A = Sets {c}
 -- B = Monoids  
 -- U   underline funcotr
@@ -346,7 +346,7 @@
 -- Eta          x :: []
 -- Epsiron      morph = Φ
 
-adj = UMAdjunction  A B  U Generator eta FreeMonoidUniveralMapping 
+adj = UMAdjunction A B FreeMonoidUniveralMapping 
 
  
 
--- a/kleisli.agda	Wed Nov 08 19:57:43 2017 +0900
+++ b/kleisli.agda	Sat Nov 11 21:34:58 2017 +0900
@@ -24,7 +24,7 @@
                  { T : Functor A A }
                  { η : NTrans A A identityFunctor T }
                  { μ : NTrans A A (T ○ T) T }
-                 { M : Monad A T η μ }  where
+                 { M : IsMonad A T η μ }  where
 
 --T(g f) = T(g) T(f)
 
@@ -49,15 +49,14 @@
 -- μ(a)(μ(T(a))) = μ(a)T(μ(a))     -- association law
 
 
-open Monad
 Lemma3 : {c₁ c₂ ℓ : Level} {A : Category c₁ c₂ ℓ}
                  { T : Functor A A }
                  { η : NTrans A A identityFunctor T }
                  { μ : NTrans A A (T ○ T) T }
                  { a : Obj A } →
-                 ( M : Monad A T η μ )
+                 ( M : IsMonad A T η μ )
     → A [ A [  TMap μ a o TMap μ ( FObj T a ) ] ≈  A [  TMap μ a o FMap T (TMap μ a) ] ]
-Lemma3 = λ m → IsMonad.assoc ( isMonad m )
+Lemma3 = λ m → IsMonad.assoc m
 
 
 Lemma4 : {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) {a b : Obj A } { f : Hom A a b}
@@ -69,18 +68,18 @@
                  { η : NTrans A A identityFunctor T }
                  { μ : NTrans A A (T ○ T) T }
                  { a : Obj A } →
-                 ( M : Monad A T η μ )
+                 ( M : IsMonad A T η μ )
     →  A [ A [ TMap μ a o TMap η ( FObj T a )  ] ≈ Id {_} {_} {_} {A} (FObj T a) ]
-Lemma5 = λ m → IsMonad.unity1 ( isMonad m )
+Lemma5 = λ m → IsMonad.unity1 m
 
 Lemma6 : {c₁ c₂ ℓ : Level} {A : Category c₁ c₂ ℓ}
                  { T : Functor A A }
                  { η : NTrans A A identityFunctor T }
                  { μ : NTrans A A (T ○ T) T }
                  { a : Obj A } →
-                 ( M : Monad A T η μ )
+                 ( M : IsMonad A T η μ )
     →  A [ A [ TMap μ a o (FMap T (TMap η a )) ] ≈ Id {_} {_} {_} {A} (FObj T a) ]
-Lemma6 = λ m → IsMonad.unity2 ( isMonad m )
+Lemma6 = λ m → IsMonad.unity2 m
 
 -- Laws of Kleisli Category
 --
@@ -91,6 +90,11 @@
 -- h ○ (g ○ f) = (h ○ g) ○ f  -- assocation law (Lemma9)
 
 -- η(b) ○ f = f
+
+join : (m : IsMonad A T η μ ) → { a b : Obj A } → { c : Obj A } →
+                              ( Hom A b ( FObj T c )) → (  Hom A a ( FObj T b)) → Hom A a ( FObj T c )
+join _ {_} {_} {c} g f = A [ TMap μ c  o A [ FMap T g o f ] ]
+
 Lemma7 : { a : Obj A } { b : Obj A } ( f : Hom A a ( FObj T b) )
                       → A  [ join M (TMap η b) f  ≈ f ]
 Lemma7 {_} {b} f = 
@@ -101,7 +105,7 @@
          A [ TMap μ b  o A [ FMap T ((TMap η b)) o f ] ]  
      ≈⟨ IsCategory.associative (Category.isCategory A) ⟩
         A [ A [ TMap μ b  o  FMap T ((TMap η b)) ] o f ]
-     ≈⟨ car ( IsMonad.unity2 ( isMonad M) )  ⟩
+     ≈⟨ car ( IsMonad.unity2 M )  ⟩
         A [  id (FObj T b)   o f ]
      ≈⟨ IsCategory.identityL (Category.isCategory A) ⟩
         f
@@ -120,7 +124,7 @@
      A [ TMap μ b  o A [ (TMap η ( FObj T b)) o f ] ] 
   ≈⟨ IsCategory.associative (Category.isCategory A) ⟩
      A [ A [ TMap μ b  o (TMap η ( FObj T b)) ] o f ] 
-  ≈⟨ car ( IsMonad.unity1 ( isMonad M) ) ⟩
+  ≈⟨ car ( IsMonad.unity1 M ) ⟩
      A [ id (FObj T b)  o f ]
   ≈⟨  IsCategory.identityL (Category.isCategory A)  ⟩
      f
@@ -170,7 +174,7 @@
    ≈⟨ car ( car (
       begin
          ( TMap μ d o TMap μ (FObj T d) )
-      ≈⟨ IsMonad.assoc ( isMonad M) ⟩
+      ≈⟨ IsMonad.assoc M ⟩
          ( TMap μ d o FMap T (TMap μ d) )
       ∎
    )) ⟩
@@ -292,7 +296,7 @@
         identity {a} = let open ≈-Reasoning (A) in
           begin
               TMap μ (a)  o FMap T (TMap η a)
-          ≈⟨ IsMonad.unity2 (isMonad M) ⟩
+          ≈⟨ IsMonad.unity2 M ⟩
              id (FObj T a)
           ∎
         ≈-cong : {a b : Obj A} {f g : KHom a b} → A [ KMap f ≈ KMap g ] → A [ ufmap f ≈ ufmap g ]
@@ -314,7 +318,7 @@
              TMap μ (c)  o (( FMap T ( TMap μ (c)) o FMap T  (FMap T (KMap g)  o (KMap f))))
           ≈⟨ assoc ⟩
              (TMap μ (c)  o ( FMap T ( TMap μ (c)))) o FMap T  (FMap T (KMap g)  o (KMap f))
-          ≈⟨ car (sym (IsMonad.assoc (isMonad M))) ⟩
+          ≈⟨ car (sym (IsMonad.assoc M)) ⟩
              (TMap μ (c)  o ( TMap μ (FObj T c))) o FMap T  (FMap T (KMap g)  o (KMap f))
           ≈⟨ sym assoc ⟩
              TMap μ (c)  o (( TMap μ (FObj T c)) o FMap T  (FMap T (KMap g)  o (KMap f)))
@@ -366,7 +370,7 @@
              (FMap T g  o TMap η (b)) o f
           ≈⟨ sym idL ⟩
              id (FObj T c)  o ((FMap T g  o TMap η (b)) o f)
-          ≈⟨ sym (car (IsMonad.unity2 (isMonad M)))  ⟩
+          ≈⟨ sym (car (IsMonad.unity2 M))  ⟩
              (TMap μ c  o FMap T (TMap η c)) o ((FMap T g  o TMap η (b)) o f)
           ≈⟨ sym assoc  ⟩
              TMap μ c  o  ( FMap T (TMap η c) o ((FMap T g  o TMap η (b)) o f) )
@@ -408,7 +412,7 @@
            TMap μ (b)  o ( FMap T (TMap η (b)) o FMap T f)
      ≈⟨ assoc  ⟩
            (TMap μ (b)  o  FMap T (TMap η (b))) o FMap T f
-     ≈⟨ car (IsMonad.unity2 (isMonad M)) ⟩
+     ≈⟨ car (IsMonad.unity2 M) ⟩
            id (FObj T b) o FMap T f
      ≈⟨ idL ⟩
            FMap T f 
@@ -464,7 +468,7 @@
               TMap μ b  o  (TMap η (FObj T b) o (TMap μ (b)  o FMap T (KMap f)))
           ≈⟨ assoc ⟩
               (TMap μ b  o  (TMap η (FObj T b))) o (TMap μ (b)  o FMap T (KMap f))
-          ≈⟨ (car (IsMonad.unity1 (isMonad M))) ⟩
+          ≈⟨ (car (IsMonad.unity1 M)) ⟩
               id (FObj T b) o (TMap μ (b)  o FMap T (KMap f))
           ≈⟨ idL ⟩
               TMap μ b  o FMap T (KMap f) 
@@ -525,8 +529,12 @@
               TMap μ x
           ∎ )
 
-Adj_T : Adjunction A KleisliCategory U_T F_T nat-η nat-ε 
+Adj_T : Adjunction A KleisliCategory 
 Adj_T = record {
+           U = U_T ;
+           F = F_T ;
+           η = nat-η ;
+           ε = nat-ε  ;
            isAdjunction = record {
                adjoint1 = adjoint1 ; 
                adjoint2 = adjoint2
@@ -543,7 +551,7 @@
                   (TMap μ (b)  o (id (FObj T (FObj T b ))))  o ( TMap η ( FObj T b ))
                ≈⟨ car idR ⟩
                   TMap μ (b) o ( TMap η ( FObj T b ))
-               ≈⟨ IsMonad.unity1 (isMonad M) ⟩
+               ≈⟨ IsMonad.unity1 M ⟩
                   id (FObj U_T b)
                ∎ 
            adjoint2 :   {a : Obj A} →
@@ -560,7 +568,7 @@
                   TMap μ a o ((TMap η (FObj T a)) o (TMap η a))
                ≈⟨ assoc  ⟩
                   (TMap μ a o (TMap η (FObj T a))) o (TMap η a)
-               ≈⟨ car (IsMonad.unity1 (isMonad M)) ⟩
+               ≈⟨ car (IsMonad.unity1 M) ⟩
                   id (FObj T a) o (TMap η a)
                ≈⟨ idL ⟩
                   TMap η a
@@ -572,8 +580,14 @@
 
 open MResolution
 
-Resolution_T : MResolution A KleisliCategory T U_T F_T {nat-η} {nat-ε} {nat-μ} Adj_T 
+Resolution_T : MResolution A KleisliCategory ( record { T = T ; η = η ; μ = μ; isMonad = M } )
 Resolution_T = record {
+      UR = U_T ;
+      FR = F_T ;
+      ηR = nat-η ;
+      εR = nat-ε ;
+      μR = nat-μ ;
+      Adj = Adjunction.isAdjunction Adj_T  ;
       T=UF   = Lemma11;
       μ=UεF  = Lemma12 
   }
--- a/pullback.agda	Wed Nov 08 19:57:43 2017 +0900
+++ b/pullback.agda	Sat Nov 11 21:34:58 2017 +0900
@@ -235,9 +235,12 @@
 
 limit2couniv :
      ( lim : ( Γ : Functor I A ) → Limit A I Γ )
-     →  coUniversalMapping A ( A ^ I ) (KI I) (λ b → a0 ( lim b) )  ( λ b → t0 (lim b)  )
-limit2couniv lim  = record {  -- F             U                            ε
-       _*' = λ {b} {a} k → limit (isLimit (lim b )) a k ; -- η
+     →  coUniversalMapping A ( A ^ I ) 
+limit2couniv lim  = record {  
+       F =  KI I ;
+       U =  λ b → a0 ( lim b) ;
+       ε = λ b → t0 (lim b) ;
+       _*' = λ {b} {a} k → limit (isLimit (lim b )) a k ; 
        iscoUniversalMapping = record {
            couniversalMapping = λ{ b a f} → couniversalMapping1 {b} {a} {f} ;
            couniquness = couniquness2
@@ -263,43 +266,59 @@
 
 open import Category.Cat
 
-
-open coUniversalMapping
-
 univ2limit :
-     ( U : Obj (A ^ I ) → Obj A )
-     ( ε : ( b : Obj (A ^ I ) ) → NTrans I A (K A I (U b)) b )
-     ( univ :  coUniversalMapping A (A ^ I) (KI I) U ε ) →
+     ( univ :  coUniversalMapping A (A ^ I) ) →
      ( Γ : Functor I A ) →   Limit A I Γ 
-univ2limit U ε univ Γ = record {
+univ2limit univ Γ = record {
      a0 = U Γ ;
-     t0 = ε Γ ;
+     t0 = ε ;
      isLimit = record {
              limit = λ a t → limit1 a t ;
              t0f=t = λ {a t i } → t0f=t1 {a} {t} {i}  ;
              limit-uniqueness =  λ {a} {t} {f} t=f → limit-uniqueness1 {a} {t} {f} t=f
      }
  } where
+     F : Functor A  (A ^ I)
+     F = coUniversalMapping.F univ
+     U : Obj (A ^ I ) → Obj A 
+     U = coUniversalMapping.U univ
+     η : (i : Obj I) → Hom A (U Γ) (FObj (FObj F (U Γ)) i)
+     η i = {!!}
+     ε :  NTrans I A (K A I (U Γ)) Γ 
+     ε  = record {
+         TMap = λ (i : Obj I) → A [ TMap ( coUniversalMapping.ε univ Γ ) i o η i ] ;
+         isNTrans = record { commute = {!!} }
+       }
+     ε' : ( b : Obj (A ^ I ) ) → NTrans I A (FObj F (U b)) b
+     ε' b = coUniversalMapping.ε univ b
+     limit1' :  (a : Obj A) → NTrans I A (FObj F a) Γ → Hom A a (U Γ)
+     limit1' a t = coUniversalMapping._*' univ {_} {a} t
      limit1 :  (a : Obj A) → NTrans I A (K A I a) Γ → Hom A a (U Γ)
-     limit1 a t = _*' univ {_} {a} t
+     limit1 a t = coUniversalMapping._*' univ {_} {a} (record {
+          TMap = λ (i : Obj I) → A [ TMap t i o {!!} ] ;
+          isNTrans = record { commute = {!!}
+        } } )
      t0f=t1 :   {a : Obj A} {t : NTrans I A (K A I a) Γ}  {i : Obj I} →
-                A [ A [ TMap (ε Γ) i o limit1 a t ] ≈ TMap t i ]
+                A [ A [ TMap ε i o limit1 a t ] ≈ TMap t i ]
      t0f=t1 {a} {t} {i} =  let  open ≈-Reasoning (A) in begin
-            TMap (ε Γ) i o limit1 a t
+            TMap ε i o limit1 a t
         ≈⟨⟩
-            TMap (ε Γ) i o _*' univ {Γ} {a} t
-        ≈⟨ coIsUniversalMapping.couniversalMapping ( iscoUniversalMapping univ) {Γ} {a} {t} ⟩
+            TMap ε i o coUniversalMapping._*' univ {Γ} {a} {!!}
+        -- ≈⟨ coIsUniversalMapping.couniversalMapping ( coUniversalMapping.iscoUniversalMapping univ) {Γ} {?} {?} ⟩
+        ≈⟨ {!!} ⟩
             TMap t i
         ∎
      limit-uniqueness1 : { a : Obj A } →  { t : NTrans I A ( K A I a ) Γ } → { f : Hom A a (U Γ)}
-         → ( ∀ { i : Obj I } → A [ A [ TMap  (ε Γ) i o  f ]  ≈ TMap t i ] ) → A [ limit1 a t ≈ f ]
+         → ( ∀ { i : Obj I } → A [ A [ TMap  ε i o  f ]  ≈ TMap t i ] ) → A [ limit1 a t ≈ f ]
      limit-uniqueness1 {a} {t} {f} εf=t = let  open ≈-Reasoning (A) in begin
-            _*' univ t
-        ≈⟨  ( coIsUniversalMapping.couniquness ( iscoUniversalMapping univ) ) εf=t  ⟩
+            coUniversalMapping._*' univ {!!}
+        ≈⟨ {!!} ⟩
+        -- ≈⟨  ( coIsUniversalMapping.couniquness ( coUniversalMapping.iscoUniversalMapping univ) ) εf=t  ⟩
             f
         ∎
 
 
+
 -- another form of uniqueness of a product
 lemma-p0 :   (a b ab : Obj A) ( π1 : Hom A ab a ) ( π2 : Hom A ab b ) ( prod : IsProduct A a b ab π1 π2 ) →
       A [ _×_ prod π1 π2 ≈  id1 A ab  ]
@@ -517,11 +536,8 @@
  
 adjoint-preseve-limit :
      { c₁' c₂' ℓ' : Level}  (B : Category c₁' c₂' ℓ') ( Γ : Functor I B ) ( limitb : Limit B I Γ ) →
-         { U : Functor B A } { F : Functor A B }
-         { η : NTrans A A identityFunctor ( U ○ F ) }
-         { ε : NTrans B B  ( F ○  U ) identityFunctor } →
-       ( adj : Adjunction A B U F η ε  ) →  Limit A I (U ○ Γ) 
-adjoint-preseve-limit B Γ limitb {U} {F} {η} {ε} adj = record {
+       ( adj : Adjunction A B ) →  Limit A I (Adjunction.U adj ○ Γ) 
+adjoint-preseve-limit B Γ limitb adj = record {
      a0 = FObj U lim ;
      t0 = ta1 B Γ lim tb U ;
      isLimit = record {
@@ -530,6 +546,14 @@
              limit-uniqueness =  λ {a} {t} {f} t=f → limit-uniqueness1 {a} {t} {f} t=f
      }
     } where
+         U : Functor B A
+         U = Adjunction.U adj
+         F : Functor A B 
+         F = Adjunction.F adj
+         η : NTrans A A identityFunctor ( U ○ F ) 
+         η = Adjunction.η adj
+         ε : NTrans B B  ( F ○  U ) identityFunctor  
+         ε = Adjunction.ε adj
          ta = ta1 B Γ (a0 limitb) (t0 limitb) U
          tb = t0 limitb
          lim = a0 limitb
--- a/universal-mapping.agda	Wed Nov 08 19:57:43 2017 +0900
+++ b/universal-mapping.agda	Sat Nov 11 21:34:58 2017 +0900
@@ -16,22 +16,26 @@
 --
 --
 
-open Adjunction
-open UniversalMapping
-
 Adj2UM : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
-                 { U : Functor B A }
-                 { F : Functor A B }
-                 { η : NTrans A A identityFunctor ( U ○  F ) }
-                 { ε : NTrans B B  ( F ○  U ) identityFunctor } →
-      Adjunction A B U F η ε  → UniversalMapping A B U (FObj F) (TMap η)
-Adj2UM A B {U} {F} {η} {ε} adj = record {
+      → Adjunction A B → UniversalMapping A B 
+Adj2UM A B adj = record {
+         U = U ;
+         F = FObj F ;
+         η = TMap η ;
          _* = solution  ;
          isUniversalMapping = record {
                     universalMapping  = universalMapping;
                     uniquness = uniqueness
               }
       } where
+         U : Functor B A 
+         U = Adjunction.U adj
+         F : Functor A B 
+         F = Adjunction.F adj
+         η : NTrans A A identityFunctor ( U ○  F ) 
+         η = Adjunction.η adj
+         ε : NTrans B B  ( F ○  U ) identityFunctor 
+         ε = Adjunction.ε adj
          solution :  { a : Obj A} { b : Obj B} → ( f : Hom A a (FObj U b) ) →  Hom B (FObj F a ) b
          solution  {_} {b} f = B [ TMap ε b o FMap F f ]
          universalMapping :   {a' : Obj A} { b' : Obj B } → { f : Hom A a' (FObj U b') } →
@@ -50,7 +54,7 @@
                   (FMap U (TMap ε b))  o ((TMap η (FObj U b )) o f )
               ≈⟨ assoc ⟩
                   ((FMap U (TMap ε b))  o (TMap η (FObj U b)))  o f
-              ≈⟨ car ( IsAdjunction.adjoint1 ( isAdjunction adj))  ⟩
+              ≈⟨ car ( IsAdjunction.adjoint1 ( Adjunction.isAdjunction adj))  ⟩
                   id (FObj U b) o f
               ≈⟨  idL  ⟩
                   f
@@ -76,7 +80,7 @@
                   ( g o TMap ε ( FObj F a) )  o FMap F ( TMap η a )
               ≈⟨ sym assoc ⟩
                   g o ( TMap ε ( FObj F a)   o FMap F ( TMap η a ) )
-              ≈⟨ cdr ( IsAdjunction.adjoint2 ( isAdjunction adj )) ⟩
+              ≈⟨ cdr ( IsAdjunction.adjoint2 ( Adjunction.isAdjunction adj )) ⟩
                   g o id (FObj F a)
               ≈⟨ idR ⟩
                   g
@@ -94,15 +98,20 @@
 --
 
 FunctorF : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
-                 { U : Functor B A }
-                 { F : Obj A → Obj B }
-                 { η : (a : Obj A) → Hom A a ( FObj U (F a) ) } →
-       UniversalMapping A B U F η   → Functor A B
-FunctorF A B {U} {F} {η} um = record {
+       → UniversalMapping A B → Functor A B
+FunctorF A B um = record {
               FObj = F;
               FMap = myFMap ;
               isFunctor = myIsFunctor
        } where
+    U : Functor B A 
+    U = UniversalMapping.U um
+    F : Obj A → Obj B 
+    F = UniversalMapping.F um
+    η : (a : Obj A) → Hom A a ( FObj U (F a) ) 
+    η = UniversalMapping.η um
+    _* : (UniversalMapping A B) →  { a : Obj A} { b : Obj B} → ( Hom A a (FObj U b) ) →  Hom B (F a ) b
+    _* _ = UniversalMapping._* um 
     myFMap : {a b : Obj A} → Hom A a b → Hom B (F a) (F b)
     myFMap f = (_* um)  (A [  η (Category.cod A f )   o f ])
     lemma-id1 :  {a : Obj A} →  A [ A [ FMap U (id1 B (F a))  o  η a ]  ≈ (A [ (η a) o (id1 A a) ]) ]
@@ -117,19 +126,19 @@
            η a o id a
        ∎
     lemma-id :  {a : Obj A} →  B [ ( (_* um) (A [ (η a) o (id1 A a)] )) ≈ (id1 B (F a)) ]
-    lemma-id {a} =   ( IsUniversalMapping.uniquness ( isUniversalMapping um ) ) lemma-id1
+    lemma-id {a} =   ( IsUniversalMapping.uniquness ( UniversalMapping.isUniversalMapping um ) ) lemma-id1
     lemma-cong2 : (a b : Obj A) (f g : Hom A a b) → A [ f ≈ g ] →
                 A [ A [ FMap U ((_* um) (A [ η b  o  g ]) ) o  η a ] ≈  A [ η b  o  f ] ]
     lemma-cong2 a b f g eq =  let open ≈-Reasoning (A) in
        begin
           ( FMap U ((_* um) (A [ η b  o  g ]) )) o  η a
-       ≈⟨  ( IsUniversalMapping.universalMapping ( isUniversalMapping um ))  ⟩
+       ≈⟨  ( IsUniversalMapping.universalMapping ( UniversalMapping.isUniversalMapping um ))  ⟩
           η b  o  g
        ≈⟨ ( IsCategory.o-resp-≈ ( Category.isCategory A ) (sym eq) (refl-hom)  ) ⟩
           η b  o  f
        ∎
     lemma-cong1 : (a b : Obj A) (f g : Hom A a b) → A [ f ≈ g ] → B [ (_* um) (A [ η b  o  f ] ) ≈  (_* um) (A [ η b  o  g ]) ]
-    lemma-cong1 a b f g eq = ( IsUniversalMapping.uniquness ( isUniversalMapping um ) ) ( lemma-cong2 a b f g eq )
+    lemma-cong1 a b f g eq = ( IsUniversalMapping.uniquness ( UniversalMapping.isUniversalMapping um ) ) ( lemma-cong2 a b f g eq )
     lemma-cong :  {a b : Obj A} {f g : Hom A a b} → A [ f ≈ g ] → B [ myFMap f ≈ myFMap g ]
     lemma-cong {a} {b} {f} {g} eq = lemma-cong1 a b f g eq
     lemma-distr2 :  (a b c : Obj A) (f : Hom A a b) (g : Hom A b c) →
@@ -141,18 +150,18 @@
            (( FMap U ((_* um) (A [ η c o g ])) o ( FMap U ((_* um)( A [ η b  o f ])))) )   o  η a
        ≈⟨ sym assoc ⟩
            ( FMap U ((_* um) (A [ η c o g ])) o (( FMap U ((_* um)( A [ η b  o f ]))))   o  η a )
-       ≈⟨ cdr ( IsUniversalMapping.universalMapping ( isUniversalMapping um ))  ⟩
+       ≈⟨ cdr ( IsUniversalMapping.universalMapping ( UniversalMapping.isUniversalMapping um ))  ⟩
            ( FMap U ((_* um) (A [ η c o g ])) o ( η b  o f) )
        ≈⟨ assoc ⟩
            ( FMap U ((_* um) (A [ η c o g ])) o  η b)  o f
-       ≈⟨ car ( IsUniversalMapping.universalMapping ( isUniversalMapping um ))  ⟩
+       ≈⟨ car ( IsUniversalMapping.universalMapping ( UniversalMapping.isUniversalMapping um ))  ⟩
            (  η c o g )  o f
        ≈⟨ sym assoc  ⟩
             η c o ( g o f )
        ∎
     lemma-distr1 :  (a b c : Obj A) (f : Hom A a b) (g : Hom A b c) →
             B [ (_* um) (A [ η c o A [ g o f ] ]) ≈ (B [(_* um) (A [ η c o g ]) o (_* um)( A [ η b  o f ]) ] )]
-    lemma-distr1 a b c f g =  ( IsUniversalMapping.uniquness ( isUniversalMapping um )) (lemma-distr2 a b c f g )
+    lemma-distr1 a b c f g =  ( IsUniversalMapping.uniquness ( UniversalMapping.isUniversalMapping um )) (lemma-distr2 a b c f g )
     lemma-distr :  {a b c : Obj A} {f : Hom A a b} {g : Hom A b c} → B [ myFMap (A [ g o f ]) ≈ (B [ myFMap g o myFMap f ] )]
     lemma-distr {a} {b} {c} {f} {g} = lemma-distr1 a b c f g
     myIsFunctor : IsFunctor A B F myFMap
@@ -166,16 +175,21 @@
 -- naturality of η
 --
 nat-η : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
-                 { U : Functor B A }
-                 { F : Obj A → Obj B }
-                 { η : (a : Obj A) → Hom A a ( FObj U (F a) ) } →
-       (um : UniversalMapping A B U F η )  →
-           NTrans  A A identityFunctor ( U ○ FunctorF A B um )
-nat-η A B {U} {F} {η} um = record {
+                 → (um : UniversalMapping A B )  →
+           NTrans  A A identityFunctor ( UniversalMapping.U um ○ FunctorF A B um )
+nat-η A B um = record {
              TMap = η ; isNTrans = myIsNTrans
        } where
+    U : Functor B A 
+    U = UniversalMapping.U um
+    F : Obj A → Obj B 
+    F = UniversalMapping.F um
+    η : (a : Obj A) → Hom A a ( FObj U (F a) ) 
+    η = UniversalMapping.η um
     F' : Functor A B
     F' = FunctorF A B um
+    _* : (UniversalMapping A B) →  { a : Obj A} { b : Obj B} → ( Hom A a (FObj U b) ) →  Hom B (F a ) b
+    _* _ = UniversalMapping._* um 
     commute :  {a b : Obj A} {f : Hom A a b}
       → A [ A [ (FMap U (FMap F' f))  o  ( η a ) ]  ≈ A [ (η b ) o f ] ]
     commute {a} {b} {f} =   let open ≈-Reasoning (A) in
@@ -183,23 +197,28 @@
             (FMap U (FMap F' f))  o  ( η a )
        ≈⟨⟩
             (FMap U ((_* um)  (A [  η b  o f ])))   o  ( η a )
-       ≈⟨ (IsUniversalMapping.universalMapping ( isUniversalMapping um ))  ⟩
+       ≈⟨ (IsUniversalMapping.universalMapping ( UniversalMapping.isUniversalMapping um ))  ⟩
             (η b ) o f
        ∎
     myIsNTrans : IsNTrans A A identityFunctor ( U ○  F' ) η
     myIsNTrans = record { commute = commute }
 
 nat-ε : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
-                 { U : Functor B A }
-                 { F : Obj A → Obj B }
-                 { η : (a : Obj A) → Hom A a ( FObj U (F a) ) } →
-       (um : UniversalMapping A B U F η )  →
-           NTrans B B ( FunctorF A B um ○ U) identityFunctor
-nat-ε A B {U} {F} {η} um = record {
+       → (um : UniversalMapping A B  )  →
+           NTrans B B ( FunctorF A B um ○ UniversalMapping.U um ) identityFunctor
+nat-ε A B um = record {
              TMap = ε ; isNTrans = myIsNTrans
        } where
+    U : Functor B A 
+    U = UniversalMapping.U um
+    F : Obj A → Obj B 
+    F = UniversalMapping.F um
+    η : (a : Obj A) → Hom A a ( FObj U (F a) ) 
+    η = UniversalMapping.η um
     F' : Functor A B
     F' = FunctorF A B um
+    _* : (UniversalMapping A B) →  { a : Obj A} { b : Obj B} → ( Hom A a (FObj U b) ) →  Hom B (F a ) b
+    _* _ = UniversalMapping._* um 
     ε : ( b : Obj B ) → Hom B ( FObj F' ( FObj U b) ) b
     ε b = (_* um) ( id1 A (FObj U b))
     lemma-nat1 :  (a b : Obj B) (f : Hom B a b ) →
@@ -212,11 +231,11 @@
           ( FMap U  ((um *) (id1 A (FObj U b))) o FMap U ((um *) ( η (FObj U b) o FMap U f )) )  o η (FObj U a)
        ≈⟨ sym assoc  ⟩
            FMap U  ((um *) (id1 A (FObj U b))) o ( FMap U ((um *) ( η (FObj U b) o FMap U f )))  o η (FObj U a)
-       ≈⟨ cdr ((IsUniversalMapping.universalMapping ( isUniversalMapping um )) )  ⟩
+       ≈⟨ cdr ((IsUniversalMapping.universalMapping ( UniversalMapping.isUniversalMapping um )) )  ⟩
            FMap U  ((um *) (id1 A (FObj U b))) o ( η (FObj U b) o FMap U f )
        ≈⟨ assoc  ⟩
            (FMap U  ((um *) (id1 A (FObj U b))) o  η (FObj U b)) o FMap U f
-       ≈⟨ car ((IsUniversalMapping.universalMapping ( isUniversalMapping um )) ) ⟩
+       ≈⟨ car ((IsUniversalMapping.universalMapping ( UniversalMapping.isUniversalMapping um )) ) ⟩
            id1 A (FObj U b) o FMap U f
        ≈⟨ idL ⟩
             FMap U f
@@ -232,7 +251,7 @@
           (FMap U f o FMap U ((um *) (id1 A (FObj U a ))))  o η (FObj U a)
        ≈⟨ sym assoc  ⟩
           FMap U f o ( FMap U ((um *) (id1 A (FObj U a )))  o η (FObj U a)  )
-       ≈⟨ cdr ( IsUniversalMapping.universalMapping ( isUniversalMapping um)) ⟩
+       ≈⟨ cdr ( IsUniversalMapping.universalMapping ( UniversalMapping.isUniversalMapping um)) ⟩
           FMap U f o id (FObj U a )
        ∎
     commute : {a b : Obj B} {f : Hom B a b }
@@ -244,9 +263,9 @@
           ε b o ((_* um) (A [ η (FObj U b) o (FMap U f) ]))
        ≈⟨⟩
           ((_* um) ( id1 A (FObj U b))) o ((_* um) (A [ η (FObj U b) o (FMap U f) ]))
-       ≈⟨ sym ( ( IsUniversalMapping.uniquness ( isUniversalMapping um )  (lemma-nat1 a b f))) ⟩
+       ≈⟨ sym ( ( IsUniversalMapping.uniquness ( UniversalMapping.isUniversalMapping um )  (lemma-nat1 a b f))) ⟩
           (_* um) ( A [ FMap U f o id1 A (FObj U a) ] )
-       ≈⟨ (IsUniversalMapping.uniquness ( isUniversalMapping um )  (lemma-nat2 a b f)) ⟩
+       ≈⟨ (IsUniversalMapping.uniquness ( UniversalMapping.isUniversalMapping um )  (lemma-nat2 a b f)) ⟩
           f o  ((_* um) ( id1 A (FObj U a)))
        ≈⟨⟩
           f o  (ε a)
@@ -260,24 +279,32 @@
 --
 -----
 
-UMAdjunction : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
-                 ( U : Functor B A )
-                 ( F' : Obj A → Obj B )
-                 ( η' : (a : Obj A) → Hom A a ( FObj U (F' a) ) ) →
-       (um : UniversalMapping A B U F' η' )  →
-              Adjunction A B U (FunctorF A B um) (nat-η A B um) (nat-ε A B  um)
-UMAdjunction A B U F' η' um = record {
+UMAdjunction : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ') →
+       (um : UniversalMapping A B )  →
+              Adjunction A B 
+UMAdjunction A B um = record {
+           U = UniversalMapping.U um ;
+           F = FunctorF A B um ;
+           η = nat-η A B um ;
+           ε = nat-ε A B um ;
            isAdjunction = record {
                adjoint1 = adjoint1 ;
                adjoint2 = adjoint2
            }
        } where
+          U : Functor B A 
+          U = UniversalMapping.U um
           F : Functor A B
           F = FunctorF A B um
           η : NTrans A A identityFunctor ( U ○  F )
           η = nat-η A B um
+          η' : (a : Obj A) → Hom A a ( FObj U (FObj F a) )
+          η' = TMap (nat-η A B um)
           ε : NTrans B B  ( F ○  U ) identityFunctor
           ε = nat-ε A B um
+          _* : UniversalMapping A B →  { a : Obj A}{ b : Obj B} → ( Hom A a (FObj U b) ) →  Hom B (FObj F a ) b
+          _* _ = UniversalMapping._* um
+          isUniversalMapping = UniversalMapping.isUniversalMapping
           adjoint1 :   { b : Obj B } →
                      A [ A [ ( FMap U ( TMap ε b ))  o ( TMap η ( FObj U b )) ]  ≈ id1 A (FObj U b) ]
           adjoint1 {b} = let open ≈-Reasoning (A) in
@@ -409,12 +436,8 @@
                            lemma-2 g h  = let open ≈-Reasoning (A) in car ( right-injective  )
 
 Adj2UO : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
-                 { U : Functor B A }
-                 { F : Functor A B }
-                 { η : NTrans A A identityFunctor ( U ○  F ) }
-                 { ε : NTrans B B  ( F ○  U ) identityFunctor } →
-                 ( adj : Adjunction A B U F η ε )  → UnityOfOppsite A B U F
-Adj2UO A B {U} {F} {η} {ε} adj = record {
+                 ( adj : Adjunction A B )  → UnityOfOppsite A B (Adjunction.U adj) (Adjunction.F adj)
+Adj2UO A B adj = record {
             right =  right ;
             left  =  left ;
             right-injective =  right-injective  ;
@@ -424,6 +447,14 @@
             r-cong = r-cong ;
             l-cong = l-cong
       } where
+            U : Functor B A 
+            U = Adjunction.U adj
+            F : Functor A B 
+            F = Adjunction.F adj
+            η : NTrans A A identityFunctor ( U ○  F ) 
+            η = Adjunction.η adj
+            ε : NTrans B B  ( F ○  U ) identityFunctor 
+            ε = Adjunction.ε adj
             right  : {a : Obj A} { b : Obj B } → Hom A a ( FObj U b ) → Hom B (FObj F a) b
             right {a} {b} f = B [ TMap ε b o FMap F f ]
             left   : {a : Obj A} { b : Obj B } → Hom B (FObj F a) b   → Hom A a ( FObj U b )
@@ -440,7 +471,7 @@
                          FMap U (TMap ε b) o ((TMap η (FObj U b))  o f )
                      ≈⟨ assoc  ⟩
                          (FMap U (TMap ε b) o (TMap η (FObj U b)))  o f
-                     ≈⟨  car  ( IsAdjunction.adjoint1 ( isAdjunction adj )) ⟩
+                     ≈⟨  car  ( IsAdjunction.adjoint1 ( Adjunction.isAdjunction adj )) ⟩
                         id1 A (FObj U b) o f
                      ≈⟨ idL  ⟩
                         f
@@ -457,7 +488,7 @@
                          ( f  o TMap ε ( FObj F a )) o ( FMap F ( TMap η a ))
                      ≈↑⟨ assoc  ⟩
                           f  o ( TMap ε ( FObj F a ) o ( FMap F ( TMap η a )))
-                     ≈⟨  cdr  ( IsAdjunction.adjoint2 ( isAdjunction adj )) ⟩
+                     ≈⟨  cdr  ( IsAdjunction.adjoint2 ( Adjunction.isAdjunction adj )) ⟩
                         f o id1 B (FObj F a)
                      ≈⟨ idR  ⟩
                         f
@@ -537,9 +568,12 @@
 UO2UM  : {c₁ c₂ ℓ c₁' c₂' ℓ' : Level} (A : Category c₁ c₂ ℓ) (B : Category c₁' c₂' ℓ')
                  ( U : Functor B A )
                  ( F : Functor A B ) →
-                 ( uo : UnityOfOppsite A B U F)  → UniversalMapping A B U (FObj F) ( uo-η-map A B U F uo  )
+                 ( uo : UnityOfOppsite A B U F)  → UniversalMapping A B 
 UO2UM  A B U F uo = record {
          _* = uo-solution A B U F uo  ;
+         U = U ;
+         F = FObj F ;
+         η = uo-η-map A B U F uo  ; 
          isUniversalMapping = record {
                     universalMapping  = universalMapping;
                     uniquness = uniqueness
@@ -641,8 +675,12 @@
                  { U : Functor B A }
                  { F : Functor A B }
                  ( uo : UnityOfOppsite A B U F)
-                    → Adjunction A B U F ( uo-η A B U F uo ) (uo-ε A B U F uo )
+                    → Adjunction A B 
 UO2Adj A B {U} {F} uo = record {
+           U =  U ;
+           F =  F ;
+           η =  uo-η A B U F uo  ;
+           ε =  uo-ε A B U F uo ;
            isAdjunction = record {
                adjoint1 = adjoint1 ;
                adjoint2 = adjoint2