changeset 371:3a125d05ae0f

limit-to nat will be done
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 06 Mar 2016 01:56:32 +0900
parents 93540deafde7
children b4855a3ebd34
files limit-to.agda
diffstat 1 files changed, 48 insertions(+), 27 deletions(-) [+]
line wrap: on
line diff
--- a/limit-to.agda	Sun Mar 06 01:05:03 2016 +0900
+++ b/limit-to.agda	Sun Mar 06 01:56:32 2016 +0900
@@ -20,9 +20,13 @@
 ---                     f
 ---          e       ------>
 ---     c ------>  a         b
----     ^    . /     ------>
----     |k . h          g
----     d /  
+---     ^      /     ------>
+---     |k   h          g
+---     |   / 
+---     |  / 
+---     | /  
+---     |/  
+---     d  
 
 
 data TwoObject   : Set where
@@ -33,6 +37,9 @@
     field
          obj→ : Obj A  -> TwoObject 
          hom→ : {a b : Obj A} -> Hom A a b -> TwoObject
+         f-rev : Hom A b a
+         feq : A [ A [ f-rev o  f ] ≈  id1 A a ]
+         geq : A [ A [ f-rev o  g ] ≈  id1 A a ]
     fobj : Obj A -> Obj A
     fobj x with  obj→ x
     ... | t0 = a
@@ -44,9 +51,9 @@
 open TwoCat
 
 indexFunctor :  {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) 
-        ( a b : Obj A ) ( f g : Hom A a b ) ( f-rev : Hom A b a ) -> (two : TwoCat A a b f g ) 
+        ( a b : Obj A ) ( f g : Hom A a b )  -> (two : TwoCat A a b f g ) 
             -> Functor A A
-indexFunctor A a b f g f-rev two = record {
+indexFunctor A a b f g two = record {
          FObj = λ a → fobj two a
        ; FMap = λ f → fmap f
        ; isFunctor = record {
@@ -58,7 +65,7 @@
           fmap :  {x y : Obj A } -> Hom A x y -> Hom A (fobj two x) (fobj two y)
           fmap {x} {y} f' with obj→ two x | obj→ two y 
           ... | t0 | t0 = id1 A a
-          ... | t1 | t0 = f-rev
+          ... | t1 | t0 = f-rev two
           ... | t1 | t1 = id1 A b
           ... | t0 | t1  = fmap' two (hom→ two f')
 
@@ -66,48 +73,62 @@
 
 lim-to-equ : {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) 
       (lim : (I : Category c₁ c₂ ℓ) ( Γ : Functor I A ) → { a0 : Obj A } { u : NTrans I A ( K A I a0 ) Γ } → Limit A I Γ a0 u ) -- completeness
-        →  {a b c : Obj A}  (f-rev : Hom A b a ) (f g : Hom A  a b ) (two : TwoCat A a b f g ) 
+        →  {a b c : Obj A}   (f g : Hom A  a b ) (two : TwoCat A a b f g ) 
         → (e : Hom A c a ) → (fe=ge : A [ A [ f o e ] ≈ A [ g o e ] ] ) → Equalizer A e f g
-lim-to-equ A lim {a} {b} {c} f-rev f g two e fe=ge = record {
+lim-to-equ A lim {a} {b} {c}  f g two e fe=ge = record {
         fe=ge =  fe=ge
         ; k = λ {d} h fh=gh → k {d} h fh=gh
         ; ek=h = λ {d} {h} {fh=gh} → {!!}
         ; uniqueness = λ {d} {h} {fh=gh} {k'} → {!!}
      } where
-         Γ = indexFunctor A a b f g f-rev two
+         Γ = indexFunctor A a b f g two
          nmap :  (x : Obj A) ( d : Obj A ) (h : Hom A d a ) -> Hom A (FObj (K A A d) x) (FObj Γ x)
          nmap x d h with (obj→  two x)
          ... | t0 = h
          ... | t1 = A [ fmap' two (obj→  two x) o  h ]
-         commute1 : {x y : Obj A}  {f' : Hom A x y} (d : Obj A) (h : Hom A d a ) ->  A [ A [ f  o  h ] ≈ A [ g  o h ] ] -> TwoObject -> TwoObject 
+         lemma1 :  {x y : Obj A}  {f' : Hom A x y} (d : Obj A) (h : Hom A d a ) ->  A [ A [ f  o  h ] ≈ A [ g  o h ] ]
+                 →  A [ A [ fmap' two (hom→ two f') o h ] ≈ A [ fmap' two (obj→ two y)  o h ] ]
+         lemma1 {x} {y} {f'} d h fh=gh with  (hom→ two f') |  (obj→ two y)
+         ... | t0 | t0 = let open ≈-Reasoning (A) in refl-hom
+         ... | t0 | t1 = fh=gh
+         ... | t1 | t0 = let open ≈-Reasoning (A) in sym fh=gh
+         ... | t1 | t1 =  let open ≈-Reasoning (A) in refl-hom
+         commute1 : {x y : Obj A}  {f' : Hom A x y} (d : Obj A) (h : Hom A d a ) ->  A [ A [ f  o  h ] ≈ A [ g  o h ] ] 
                  → A [ A [ FMap Γ f' o nmap x d h ] ≈ A [ nmap y d h o FMap (K A A d) f' ] ]
-         commute1  {x} {y} {f'} d h fh=gh t0 t0 =   let open ≈-Reasoning (A) in 
+         commute1  {x} {y} {f'} d h fh=gh with (obj→ two x) | (obj→ two y)
+         ... | t0 | t0 = let open ≈-Reasoning (A) in 
               begin
-                  FMap Γ f' o nmap x d h
+                  id1 A a  o h
+              ≈⟨ idL ⟩
+                  h 
+              ≈↑⟨ idR ⟩
+                  h o id1 A d
+              ∎ 
+         ... | t0 | t1 = let open ≈-Reasoning (A) in 
+              begin
+                fmap' two (hom→ two f')  o h
+              ≈⟨ lemma1 {x} {y} {f'} d h fh=gh ⟩
+                fmap' two (obj→  two y) o  h 
+              ≈↑⟨ idR ⟩
+                (fmap' two (obj→  two y) o  h )  o id1 A d
+              ∎ 
+         ... | t1 | t0 =   let open ≈-Reasoning (A) in
+              begin
+                 f-rev two  o ( fmap' two (obj→  two x) o  h )
               ≈⟨ {!!} ⟩
-                  nmap y d h 
-              ≈↑⟨ idR ⟩
-                  nmap y d h o id1 A d
-              ≈⟨⟩
-                  nmap y d h o FMap (K A A d) f' 
+                  h o id1 A d

-         commute1  {x} {y} {f'} d h fh=gh t0 t1 =   let open ≈-Reasoning (A) in 
+         ... | t1 | t1 =   let open ≈-Reasoning (A) in
               begin
-                  FMap Γ f' o nmap x d h
+                 id1 A b  o ( fmap' two (obj→  two x) o  h )
               ≈⟨ {!!} ⟩
-                  nmap y d h 
-              ≈↑⟨ idR ⟩
-                  nmap y d h o id1 A d
-              ≈⟨⟩
-                  nmap y d h o FMap (K A A d) f'
+                 (fmap' two (obj→  two y) o  h ) o id1 A d

-         commute1  {x} {y} {f'} d h fh=gh t1 t0 =  {!!}
-         commute1  {x} {y} {f'} d h fh=gh t1 t1 =  {!!}
          nat : (d : Obj A) → (h : Hom A d a ) →  A [ A [ f  o  h ] ≈ A [ g  o h ] ]   → NTrans A A (K A A d) Γ
          nat d h fh=gh = record {
             TMap = λ x → nmap x d h ; 
             isNTrans = record {
-                commute = λ {x} {y} {f'} -> commute1 {x} {y} {f'} d h fh=gh (obj→ two x) (obj→ two y)
+                commute = λ {x} {y} {f'} -> commute1 {x} {y} {f'} d h fh=gh 
             }
           }
          k : {d : Obj A}  (h : Hom A d a) → A [ A [ f  o  h ] ≈ A [ g  o h ] ] → Hom A d c