Mercurial > hg > Members > kono > Proof > category
changeset 865:bcd91387cef3
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 07 Apr 2020 14:33:54 +0900 |
parents | 84acbaa068d3 |
children | 2ff6242aed06 |
files | CCCGraph1.agda |
diffstat | 1 files changed, 19 insertions(+), 16 deletions(-) [+] |
line wrap: on
line diff
--- a/CCCGraph1.agda Mon Apr 06 17:48:24 2020 +0900 +++ b/CCCGraph1.agda Tue Apr 07 14:33:54 2020 +0900 @@ -51,6 +51,11 @@ eval (iv (f *) (iv g h)) | < t , t₁ > = iv (f *) < t , t₁ > eval (iv f (iv g h)) | iv f1 t = iv f (iv f1 t) + pi : {a b c : Objs} → { f : Arrows a b } { g : Arrows a c } → Arrows a ( b ∧ c) → Arrows a b + pi (id .(_ ∧ _)) = iv π (id _) + pi < x , x₁ > = x + pi (iv f x) = iv π (iv f x) + refl-<l> : {a b c : Objs} → { f f1 : Arrows a b } { g g1 : Arrows a c } → < f , g > ≡ < f1 , g1 > → f ≡ f1 refl-<l> refl = refl @@ -109,6 +114,15 @@ std-iv ε y (iv z f) ne | iv z1 t = refl std-iv (x *) y (iv z f) ne | iv z1 t = refl + std-∧ : { a b c : Objs } ( f : Arrows a b ) ( g : Arrows a b ) ( h : Arrows a c ) → ¬ ( eval f ≡ iv π < g , h > ) + std-∧ f g h t with eval f | inspect eval f + std-∧ {a} {b} {_} (iv π < f1 , f2 >) g h refl | iv π < g , h > | record { eq = ee } = std-∧ f1 g h ee + std-∧ {a} {b} {_} (iv π' < f1 , f2 >) g h refl | iv π < g , h > | record { eq = ee } = std-∧ f2 g h ee + std-∧ {a} {b} {_} (iv f (iv f₁ f1)) g h refl | iv π < g , h > | record { eq = ee } = {!!} + + std-∧' : { a b c : Objs } ( f : Arrows a c ) ( g : Arrows a b ) ( h : Arrows a c ) → ¬ ( eval f ≡ iv π' < g , h > ) + std-∧' = {!!} + idem-eval : {a b : Objs } (f : Arrows a b ) → eval (eval f) ≡ eval f idem-eval (id a) = refl idem-eval (○ a) = refl @@ -126,22 +140,11 @@ idem-eval (iv π' (iv {_} {_} {d} g h)) | < t , t₁ > | m = refl-<r> m idem-eval (iv ε (iv {_} {_} {d} g h)) | < t , t₁ > | m = cong ( λ k → iv ε k ) m idem-eval (iv (f *) (iv {_} {_} {d} g h)) | < t , t₁ > | m = cong ( λ k → iv (f *) k ) m - idem-eval (iv f (iv {a} {c} {d} g h)) | iv {a} {c} {d1} f1 t | m with isnot-∧ d1 | inspect eval (iv g h) - idem-eval (iv f (iv {_} {_} {d} g h)) | iv f1 t | m | yes p | record { eq = ee } = lemma where - lemma1 : eval (iv f ( iv f1 t)) ≡ iv f (eval ( iv f1 t)) - lemma1 = std-iv f f1 t p - lemma : eval (iv f ( iv f1 t)) ≡ iv f ( iv f1 t) - lemma = begin - eval (iv f ( iv f1 t)) - ≡⟨ lemma1 ⟩ - iv f (eval ( iv f1 t)) - ≡⟨ cong (λ k → iv f k ) m ⟩ - iv f ( iv f1 t) - ∎ where open ≡-Reasoning - idem-eval (iv f (iv {_} {_} {d} g h)) | iv {_} {_} {atom x} f₁ t | m | no ¬p | record { eq = ee } = ⊥-elim ( ¬p (λ ()) ) - idem-eval (iv f (iv {_} {_} {d} g h)) | iv {_} {_} {⊤} f₁ t | m | no ¬p | record { eq = ee } = ⊥-elim ( ¬p (λ ()) ) - idem-eval (iv f (iv {_} {_} {d} g h)) | iv {_} {_} {d1 <= d2} f₁ t | m | no ¬p | record { eq = ee } = ⊥-elim ( ¬p (λ ()) ) - idem-eval (iv f (iv {_} {_} {d} g h)) | iv {_} {_} {d1 ∧ d2} f₁ t | m | no ¬p | record { eq = ee } = {!!} + idem-eval (iv f (iv {_} {_} {d} g h)) | iv {a} {_} {atom _} f1 t | m = trans (std-iv f f1 t (λ ()) ) (cong (λ k → iv f k ) m ) + idem-eval (iv f (iv {_} {_} {d} g h)) | iv {a} {_} {⊤} f1 t | m = trans (std-iv f f1 t (λ ()) ) (cong (λ k → iv f k ) m ) + idem-eval (iv f (iv {_} {_} {d} g h)) | iv {a} {_} {d1 <= d2} f1 t | m = trans (std-iv f f1 t (λ ()) ) (cong (λ k → iv f k ) m ) + idem-eval (iv f (iv {_} {_} {d} g h)) | iv {a} {_} {d1 ∧ d2} f1 t | m = {!!} + -- lemma : eval (iv f ( iv f1 t)) ≡ iv f ( iv f1 t) assoc-iv : {a b c d : Objs} (x : Arrow c d) (f : Arrows b c) (g : Arrows a b ) → eval (iv x (f ・ g)) ≡ eval (iv x f ・ g) assoc-iv x (id a) g = refl