Mercurial > hg > Members > kono > Proof > category
changeset 864:84acbaa068d3
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 06 Apr 2020 17:48:24 +0900 |
parents | 8407fe9eaac9 |
children | bcd91387cef3 |
files | CCCGraph1.agda |
diffstat | 1 files changed, 40 insertions(+), 7 deletions(-) [+] |
line wrap: on
line diff
--- a/CCCGraph1.agda Sun Apr 05 17:57:55 2020 +0900 +++ b/CCCGraph1.agda Mon Apr 06 17:48:24 2020 +0900 @@ -109,6 +109,40 @@ std-iv ε y (iv z f) ne | iv z1 t = refl std-iv (x *) y (iv z f) ne | iv z1 t = refl + idem-eval : {a b : Objs } (f : Arrows a b ) → eval (eval f) ≡ eval f + idem-eval (id a) = refl + idem-eval (○ a) = refl + idem-eval < f , f₁ > = cong₂ ( λ j k → < j , k > ) (idem-eval f) (idem-eval f₁) + idem-eval (iv f (id a)) = refl + idem-eval (iv f (○ a)) = refl + idem-eval (iv π < g , g₁ >) = idem-eval g + idem-eval (iv π' < g , g₁ >) = idem-eval g₁ + idem-eval (iv ε < f , f₁ >) = cong₂ ( λ j k → iv ε < j , k > ) (idem-eval f) (idem-eval f₁) + idem-eval (iv (x *) < f , f₁ >) = cong₂ ( λ j k → iv (x *) < j , k > ) (idem-eval f) (idem-eval f₁) + idem-eval (iv f (iv {b} {c} {d} g h)) with eval (iv g h) | idem-eval (iv g h) + idem-eval (iv f (iv {_} {_} {d} g h)) | id a | m = refl + idem-eval (iv f (iv {_} {_} {d} g h)) | ○ a | m = refl + idem-eval (iv π (iv {_} {_} {d} g h)) | < t , t₁ > | m = refl-<l> m + 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 } = {!!} + 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 assoc-iv x (○ a) g = refl @@ -116,7 +150,12 @@ assoc-iv π' < f , f₁ > g = refl assoc-iv ε < f , f₁ > g = refl assoc-iv (x *) < f , f₁ > g = refl - assoc-iv x (iv f g) h = {!!} + assoc-iv x (iv f g) h = begin + eval (iv x (iv f g ・ h)) + ≡⟨ {!!} ⟩ + eval (iv x (iv f g) ・ h) + ∎ where open ≡-Reasoning + ==←≡ : {A B : Objs} {f g : Arrows A B} → f ≡ g → f == g ==←≡ eq = cong (λ k → eval k ) eq @@ -165,12 +204,6 @@ ≡⟨ sym (assoc-iv x (iv y f) ( g ・ h)) ⟩ eval (iv x ((iv y f) ・ (g ・ h))) ≡⟨ {!!} ⟩ - iv x (eval ((iv y f) ・ (g ・ h))) - ≡⟨ {!!} ⟩ - iv x (eval ((iv y f ・ g ) ・ h)) - ≡⟨ {!!} ⟩ - eval (iv x ((iv y f ・ g ) ・ h)) - ≡⟨ {!!} ⟩ eval ((iv x (iv y f) ・ g) ・ h) ∎ where open ≡-Reasoning -- cong ( λ k → iv x k ) (associative f g h)