changeset 810:084dc5e170f8

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Fri, 26 Apr 2019 22:53:57 +0900
parents 0976d576f5f6
children 2de0358ea10a
files CCChom.agda
diffstat 1 files changed, 45 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/CCChom.agda	Fri Apr 26 21:24:12 2019 +0900
+++ b/CCChom.agda	Fri Apr 26 22:53:57 2019 +0900
@@ -635,11 +635,11 @@
        k : fobj a → fobj {G} c 
        k z = fmap f z
    fmap {G} {a} {⊤} (next (○ b) f) = λ _ → OneObj'
-   fmap {G} {a} {b} (next {a} {x ∧ y} {b} π f) = λ z → proj₁ ( k z ) where
-       k : fobj a → fobj x /\ fobj y  
+   fmap {G} {a} {b} (next {a} {b ∧ y} {b} π f) = λ z → proj₁ ( k z ) where
+       k : fobj a → fobj b /\ fobj y  
        k z = fmap f z
-   fmap {G} {a} {b} (next {.a} {x ∧ y} π' f) =  λ z → proj₂ ( k z ) where
-       k : fobj a → fobj x /\ fobj y  
+   fmap {G} {a} {b} (next {.a} {x ∧ b} π' f) =  λ z → proj₂ ( k z ) where
+       k : fobj a → fobj x /\ fobj b  
        k z = fmap f z
    fmap {G} {a} {b} (next {.a} {(x <= y) ∧ y} {.b} ε f) =  λ z → (  proj₁ (k z))(  proj₂ (k z)) where
        k :  fobj a →  (fobj y → fobj x) /\ fobj y
@@ -662,15 +662,51 @@
              Sets [ fmap (next x g) o fmap (Chain.id a) ]
           ∎  where open ≈-Reasoning Sets
        distrCS {a} {b} {b} {f} {id b} =  refl
-       distrCS {a} {b} {atom z} {f} {next {.b} {atom y} {atom z} (arrow x) g} = {!!}
+       distrCS {a} {b} {atom z} {f} {next {.b} {atom y} {atom z} (arrow x) g} = begin
+             fmap (DX G [ next (arrow x) g o f ])
+          ≈⟨⟩
+             fmap ( next (arrow x) (g ++ f ) )
+          ≈⟨⟩
+             ( λ y → smap G x ( fmap (g ++ f) y )  )
+          ≈⟨ extensionality Sets ( λ y → ( cong ( λ k → smap G x (k y) ) distrCS )) ⟩
+             (λ z → fmap (next (arrow x) g) ( fmap f z ))
+          ≈⟨⟩
+             (Sets [ fmap (next (arrow x) g) o fmap f ])
+          ∎  where open ≈-Reasoning Sets
        distrCS {a} {b} {.⊤} {f} {next (○ a₁) g} = begin
              fmap (DX G [ next (○ a₁) g o f ])
-          ≈⟨ {!!} ⟩
+          ≈⟨⟩
              Sets [ fmap (next (○ a₁) g) o fmap f ]
           ∎  where open ≈-Reasoning Sets
-       distrCS {a} {b} {c} {f} {next {.b} {c ∧ x} {c} π g} = {!!}
-       distrCS {a} {b} {c} {f} {next π' g} = {!!}
-       distrCS {a} {b} {c} {f} {next ε g} = {!!}
+       distrCS {a} {b} {c} {f} {next {.b} {.c ∧ x} {.c} π g} =  begin
+             fmap (DX G [ next π g o f ])
+          ≈⟨⟩
+             fmap (next π (g ++ f))
+          ≈⟨  extensionality Sets ( λ z → (cong ( λ k → k z) refl ))  ⟩
+             ( λ z → proj₁ (fmap (g ++ f) z))
+          ≈⟨ extensionality Sets ( λ z → cong ( λ k → proj₁ (k z)  ) distrCS )  ⟩
+             Sets [ fmap (next π g) o fmap f ]
+          ∎  where open ≈-Reasoning Sets
+       distrCS {a} {b} {c} {f} {next π' g} =   begin
+             fmap (DX G [ next π' g o f ])
+          ≈⟨⟩
+             fmap (next π' (g ++ f))
+          ≈⟨  extensionality Sets ( λ z → (cong ( λ k → k z) refl ))  ⟩
+             ( λ z → proj₂ (fmap (g ++ f) z))
+          ≈⟨ extensionality Sets ( λ z → cong ( λ k → proj₂ (k z)  ) distrCS )  ⟩
+             Sets [ fmap (next π' g) o fmap f ]
+          ∎  where open ≈-Reasoning Sets
+       distrCS {a} {b} {c} {f} {next ε g} =  begin
+             fmap (DX G [ next ε g o f ] )
+          ≈⟨⟩
+              fmap (next ε (g ++ f))
+          ≈⟨  extensionality Sets ( λ z → (cong ( λ k → k z) refl )) ⟩
+             ( λ z →  proj₁ (fmap (g ++ f)  z) (  proj₂ (fmap (g ++ f) z) ))
+          ≈⟨  extensionality Sets ( λ z → cong ( λ k → proj₁ (k z) (  proj₂ (k z))  ) distrCS )    ⟩
+             ( λ x → fmap (next ε g) (fmap f x) )
+          ≈⟨⟩
+             Sets [ fmap (next ε g) o fmap f ]
+          ∎  where open ≈-Reasoning Sets
        isf : IsFunctor (DX G) Sets fobj fmap 
        IsFunctor.identity isf = extensionality Sets ( λ x → refl )
        IsFunctor.≈-cong isf refl = refl