Mercurial > hg > Members > kono > Proof > category
diff HomReasoning.agda @ 948:dca4b29553cb
mp-flatten
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Sat, 22 Aug 2020 10:45:40 +0900 |
parents | ca5eba647990 |
children |
line wrap: on
line diff
--- a/HomReasoning.agda Mon May 18 23:13:14 2020 +0900 +++ b/HomReasoning.agda Sat Aug 22 10:45:40 2020 +0900 @@ -170,6 +170,100 @@ _∎ : { a b : Obj A } ( x : Hom A a b ) → x IsRelatedTo x _∎ _ = relTo refl-hom + + --- + -- to avoid assoc storm, flatten composition according to the template + -- + + data MP : { a b : Obj A } ( x : Hom A a b ) → Set (c₁ ⊔ c₂ ⊔ ℓ ) where + am : { a b : Obj A } → (x : Hom A a b ) → MP x + _repl_by_ : { a b : Obj A } → (x y : Hom A a b ) → x ≈ y → MP y + _∙_ : { a b c : Obj A } {x : Hom A b c } { y : Hom A a b } → MP x → MP y → MP ( x o y ) + + open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) + + mp-before : { a b : Obj A } { f : Hom A a b } → MP f → Hom A a b + mp-before (am x) = x + mp-before (x repl y by x₁) = x + mp-before (m ∙ m₁) = mp-before m o mp-before m₁ + + mp-after : { a b : Obj A } { f : Hom A a b } → MP f → Hom A a b + mp-after (am x) = x + mp-after (x repl y by x₁) = y + mp-after (m ∙ m₁) = mp-before m o mp-before m₁ + + mp≈ : { a b : Obj A } { f g : Hom A a b } → (m : MP f ) → mp-before m ≈ mp-after m + mp≈ {a} {b} {f} {g} (am x) = refl-hom + mp≈ {a} {b} {f} {g} (x repl y by x=y ) = x=y + mp≈ {a} {b} {f} {g} (m ∙ m₁) = resp refl-hom refl-hom + + mpf : {a b c : Obj A } {y : Hom A b c } → (m : MP y ) → Hom A a b → Hom A a c + mpf (am x) y = x o y + mpf (x repl y by eq ) z = y o z + mpf (m ∙ m₁) y = mpf m ( mpf m₁ y ) + + mp-flatten : {a b : Obj A } {x : Hom A a b } → (m : MP x ) → Hom A a b + mp-flatten m = mpf m (id _) + + mpl1 : {a b c : Obj A } → Hom A b c → {y : Hom A a b } → MP y → Hom A a c + mpl1 x (am y) = x o y + mpl1 x (z repl y by eq ) = x o y + mpl1 x (y ∙ y1) = mpl1 ( mpl1 x y ) y1 + + mpl : {a b c : Obj A } {x : Hom A b c } {z : Hom A a b } → MP x → MP z → Hom A a c + mpl (am x) m = mpl1 x m + mpl (y repl x by eq ) m = mpl1 x m + mpl (m ∙ m1) m2 = mpl m (m1 ∙ m2) + + mp-flattenl : {a b : Obj A } {x : Hom A a b } → (m : MP x ) → Hom A a b + mp-flattenl m = mpl m (am (id _)) + + _⁻¹ : {a b : Obj A } ( f : Hom A a b ) → Set c₂ + _⁻¹ {a} {b} f = Hom A b a + + test1 : {a b c : Obj A } ( f : Hom A b c ) ( g : Hom A a b ) → ( _⁻¹ : {a b : Obj A } ( f : Hom A a b ) → Hom A b a ) → Hom A c a + test1 f g _⁻¹ = mp-flattenl ((am (g ⁻¹) ∙ am (f ⁻¹) ) ∙ ( (am f ∙ am g) ∙ am ((f o g) ⁻¹ ))) + + test2 : {a b c : Obj A } ( f : Hom A b c ) ( g : Hom A a b ) → ( _⁻¹ : {a b : Obj A } ( f : Hom A a b ) → Hom A b a ) → test1 f g _⁻¹ ≈ ((((g ⁻¹ o f ⁻¹ )o f ) o g ) o (f o g) ⁻¹ ) o id _ + test2 f g _⁻¹ = refl-hom + + test3 : {a b c : Obj A } ( f : Hom A b c ) ( g : Hom A a b ) → ( _⁻¹ : {a b : Obj A } ( f : Hom A a b ) → Hom A b a ) → Hom A c a + test3 f g _⁻¹ = mp-flatten ((am (g ⁻¹) ∙ am (f ⁻¹) ) ∙ ( (am f ∙ am g) ∙ am ((f o g) ⁻¹ ))) + + test4 : {a b c : Obj A } ( f : Hom A b c ) ( g : Hom A a b ) → ( _⁻¹ : {a b : Obj A } ( f : Hom A a b ) → Hom A b a ) → test3 f g _⁻¹ ≈ g ⁻¹ o (f ⁻¹ o (f o (g o ((f o g) ⁻¹ o id _)))) + test4 f g _⁻¹ = refl-hom + + o-flatten : {a b : Obj A } {x : Hom A a b } → (m : MP x ) → x ≈ mp-flatten m + o-flatten (am y) = sym-hom (idR ) + o-flatten (y repl x by eq) = sym-hom (idR ) + o-flatten (am x ∙ q) = resp ( o-flatten q ) refl-hom + o-flatten ((y repl x by eq) ∙ q) = resp ( o-flatten q ) refl-hom + -- d <- c <- b <- a ( p ∙ q ) ∙ r , ( x o y ) o z + o-flatten {a} {d} (_∙_ {a} {b} {d} {xy} {z} (_∙_ {b} {c} {d} {x} {y} p q) r) = + lemma9 _ _ _ ( o-flatten {b} {d} {x o y } (p ∙ q )) ( o-flatten {a} {b} {z} r ) where + mp-cong : { a b c : Obj A } → {p : Hom A b c} {q r : Hom A a b} → (P : MP p) → q ≈ r → mpf P q ≈ mpf P r + mp-cong (am x) q=r = resp q=r refl-hom + mp-cong (y repl x by eq) q=r = resp q=r refl-hom + mp-cong (P ∙ P₁) q=r = mp-cong P ( mp-cong P₁ q=r ) + mp-assoc : {a b c d : Obj A } {p : Hom A c d} {q : Hom A b c} {r : Hom A a b} → (P : MP p) → mpf P q o r ≈ mpf P (q o r ) + mp-assoc (am x) = sym-hom assoc + mp-assoc (y repl x by eq ) = sym-hom assoc + mp-assoc {_} {_} {_} {_} {p} {q} {r} (P ∙ P₁) = begin + mpf P (mpf P₁ q) o r ≈⟨ mp-assoc P ⟩ + mpf P (mpf P₁ q o r) ≈⟨ mp-cong P (mp-assoc P₁) ⟩ mpf P ((mpf P₁) (q o r)) + ∎ + lemma9 : (x : Hom A c d) (y : Hom A b c) (z : Hom A a b) → x o y ≈ mpf p (mpf q (id _)) + → z ≈ mpf r (id _) + → (x o y) o z ≈ mp-flatten ((p ∙ q) ∙ r) + lemma9 x y z t s = begin + (x o y) o z ≈⟨ resp refl-hom t ⟩ + mpf p (mpf q (id _)) o z ≈⟨ mp-assoc p ⟩ + mpf p (mpf q (id _) o z) ≈⟨ mp-cong p (mp-assoc q ) ⟩ + mpf p (mpf q ((id _) o z)) ≈⟨ mp-cong p (mp-cong q idL) ⟩ + mpf p (mpf q z) ≈⟨ mp-cong p (mp-cong q s) ⟩ + mpf p (mpf q (mpf r (id _))) + ∎ + -- an example Lemma61 : {c₁ c₂ ℓ : Level} (A : Category c₁ c₂ ℓ) →