refactor(hott,library): use/test the rewrite tactic in more places
The performance also improved.
This commit is contained in:
Leonardo de Moura
parent
55586dcb2d
commit
d7c6028a3e
3 changed files with 51 additions and 51 deletions
|
|
@ -48,12 +48,12 @@ namespace category
|
|||
definition id_comp (a : ob) : ID a ∘ ID a = ID a := !id_left
|
||||
|
||||
definition left_id_unique (H : Π{b} {f : hom b a}, i ∘ f = f) : i = id :=
|
||||
calc i = i ∘ id : id_right
|
||||
... = id : H
|
||||
calc i = i ∘ id : by rewrite id_right
|
||||
... = id : by rewrite H
|
||||
|
||||
definition right_id_unique (H : Π{b} {f : hom a b}, f ∘ i = f) : i = id :=
|
||||
calc i = id ∘ i : id_left
|
||||
... = id : H
|
||||
calc i = id ∘ i : by rewrite id_left
|
||||
... = id : by rewrite H
|
||||
|
||||
definition homset [reducible] (x y : ob) : hset :=
|
||||
hset.mk (hom x y) _
|
||||
|
|
@ -73,11 +73,11 @@ namespace category
|
|||
(xyab : wb ∘ xf = yf ∘ wa) (xybc : wc ∘ xg = yg ∘ wb)
|
||||
: wc ∘ (xg ∘ xf) = (yg ∘ yf) ∘ wa :=
|
||||
calc
|
||||
wc ∘ (xg ∘ xf) = (wc ∘ xg) ∘ xf : assoc
|
||||
... = (yg ∘ wb) ∘ xf : xybc
|
||||
... = yg ∘ (wb ∘ xf) : assoc
|
||||
... = yg ∘ (yf ∘ wa) : xyab
|
||||
... = (yg ∘ yf) ∘ wa : assoc
|
||||
wc ∘ (xg ∘ xf) = (wc ∘ xg) ∘ xf : by rewrite assoc
|
||||
... = (yg ∘ wb) ∘ xf : by rewrite xybc
|
||||
... = yg ∘ (wb ∘ xf) : by rewrite assoc
|
||||
... = yg ∘ (yf ∘ wa) : by rewrite xyab
|
||||
... = (yg ∘ yf) ∘ wa : by rewrite assoc
|
||||
|
||||
set_option unifier.max_steps 30000
|
||||
definition compose_squares_2x2 {xa xb xc ya yb yc za zb zc : ob}
|
||||
|
|
@ -87,28 +87,28 @@ namespace category
|
|||
(yzab : vb ∘ yf = zf ∘ va) (yzbc : vc ∘ yg = zg ∘ vb)
|
||||
: (vc ∘ wc) ∘ (xg ∘ xf) = (zg ∘ zf) ∘ (va ∘ wa) :=
|
||||
calc
|
||||
(vc ∘ wc) ∘ (xg ∘ xf) = vc ∘ (wc ∘ (xg ∘ xf)) : (assoc vc wc (xg ∘ xf))⁻¹ᵖ
|
||||
... = vc ∘ ((yg ∘ yf) ∘ wa) : {compose_squares xyab xybc}
|
||||
... = (vc ∘ (yg ∘ yf)) ∘ wa : assoc vc (yg ∘ yf) wa
|
||||
... = ((zg ∘ zf) ∘ va) ∘ wa : {compose_squares yzab yzbc}
|
||||
... = (zg ∘ zf) ∘ (va ∘ wa) : (assoc (zg ∘ zf) va wa)⁻¹ᵖ
|
||||
(vc ∘ wc) ∘ (xg ∘ xf) = vc ∘ (wc ∘ (xg ∘ xf)) : by rewrite (assoc vc wc _)
|
||||
... = vc ∘ ((yg ∘ yf) ∘ wa) : by rewrite (compose_squares xyab xybc)
|
||||
... = (vc ∘ (yg ∘ yf)) ∘ wa : by rewrite assoc
|
||||
... = ((zg ∘ zf) ∘ va) ∘ wa : by rewrite (compose_squares yzab yzbc)
|
||||
... = (zg ∘ zf) ∘ (va ∘ wa) : by rewrite assoc
|
||||
set_option unifier.max_steps 20000
|
||||
|
||||
definition square_precompose {xa xb xc yb yc : ob}
|
||||
{xg : xb ⟶ xc} {yg : yb ⟶ yc} {wb : xb ⟶ yb} {wc : xc ⟶ yc}
|
||||
(H : wc ∘ xg = yg ∘ wb) (xf : xa ⟶ xb) : wc ∘ xg ∘ xf = yg ∘ wb ∘ xf :=
|
||||
calc
|
||||
wc ∘ xg ∘ xf = (wc ∘ xg) ∘ xf : assoc
|
||||
... = (yg ∘ wb) ∘ xf : H
|
||||
... = yg ∘ wb ∘ xf : assoc
|
||||
wc ∘ xg ∘ xf = (wc ∘ xg) ∘ xf : by rewrite assoc
|
||||
... = (yg ∘ wb) ∘ xf : by rewrite H
|
||||
... = yg ∘ wb ∘ xf : by rewrite assoc
|
||||
|
||||
definition square_postcompose {xb xc yb yc yd : ob}
|
||||
{xg : xb ⟶ xc} {yg : yb ⟶ yc} {wb : xb ⟶ yb} {wc : xc ⟶ yc}
|
||||
(H : wc ∘ xg = yg ∘ wb) (yh : yc ⟶ yd) : (yh ∘ wc) ∘ xg = (yh ∘ yg) ∘ wb :=
|
||||
calc
|
||||
(yh ∘ wc) ∘ xg = yh ∘ wc ∘ xg : assoc
|
||||
... = yh ∘ yg ∘ wb : H
|
||||
... = (yh ∘ yg) ∘ wb : assoc
|
||||
(yh ∘ wc) ∘ xg = yh ∘ wc ∘ xg : by rewrite assoc
|
||||
... = yh ∘ yg ∘ wb : by rewrite H
|
||||
... = (yh ∘ yg) ∘ wb : by rewrite assoc
|
||||
|
||||
definition square_prepostcompose {xa xb xc yb yc yd : ob}
|
||||
{xg : xb ⟶ xc} {yg : yb ⟶ yc} {wb : xb ⟶ yb} {wc : xc ⟶ yc}
|
||||
|
|
|
|||
|
|
@ -73,24 +73,24 @@ namespace is_equiv
|
|||
let retrf'a := retr f (f' a) in
|
||||
have eq1 : _ = _,
|
||||
from calc ap f secta ⬝ ff'a
|
||||
= retrfa ⬝ ff'a : ap _ (@adj _ _ f _ _)
|
||||
... = ap (f ∘ invf) ff'a ⬝ retrf'a : ap_con_eq_con
|
||||
... = ap f (ap invf ff'a) ⬝ retrf'a : ap_compose invf f,
|
||||
= retrfa ⬝ ff'a : by rewrite adj
|
||||
... = ap (f ∘ invf) ff'a ⬝ retrf'a : by rewrite ap_con_eq_con
|
||||
... = ap f (ap invf ff'a) ⬝ retrf'a : by rewrite ap_compose,
|
||||
have eq2 : _ = _,
|
||||
from calc retrf'a
|
||||
= (ap f (ap invf ff'a))⁻¹ ⬝ (ap f secta ⬝ ff'a) : eq_inv_con_of_con_eq _ _ _ eq1⁻¹
|
||||
= (ap f (ap invf ff'a))⁻¹ ⬝ (ap f secta ⬝ ff'a) : eq_inv_con_of_con_eq _ _ _ eq1⁻¹
|
||||
... = (ap f (ap invf ff'a))⁻¹ ⬝ (ap f secta ⬝ Hty a) : ap_inv invf ff'a
|
||||
... = (ap f (ap invf ff'a))⁻¹ ⬝ (Hty (invf (f a)) ⬝ ap f' secta) : ap_con_eq_con_ap
|
||||
... = ((ap f (ap invf ff'a))⁻¹ ⬝ Hty (invf (f a))) ⬝ ap f' secta : con.assoc
|
||||
... = (ap f (ap invf ff'a)⁻¹ ⬝ Hty (invf (f a))) ⬝ ap f' secta : ap_inv
|
||||
... = (Hty (invf (f' a)) ⬝ ap f' (ap invf ff'a)⁻¹) ⬝ ap f' secta : ap_con_eq_con_ap
|
||||
... = (Hty (invf (f' a)) ⬝ (ap f' (ap invf ff'a))⁻¹) ⬝ ap f' secta : ap_inv
|
||||
... = Hty (invf (f' a)) ⬝ ((ap f' (ap invf ff'a))⁻¹ ⬝ ap f' secta) : con.assoc,
|
||||
... = (ap f (ap invf ff'a))⁻¹ ⬝ (Hty (invf (f a)) ⬝ ap f' secta) : by rewrite ap_con_eq_con_ap
|
||||
... = ((ap f (ap invf ff'a))⁻¹ ⬝ Hty (invf (f a))) ⬝ ap f' secta : by rewrite con.assoc
|
||||
... = (ap f (ap invf ff'a)⁻¹ ⬝ Hty (invf (f a))) ⬝ ap f' secta : by rewrite ap_inv
|
||||
... = (Hty (invf (f' a)) ⬝ ap f' (ap invf ff'a)⁻¹) ⬝ ap f' secta : by rewrite ap_con_eq_con_ap
|
||||
... = (Hty (invf (f' a)) ⬝ (ap f' (ap invf ff'a))⁻¹) ⬝ ap f' secta : by rewrite ap_inv
|
||||
... = Hty (invf (f' a)) ⬝ ((ap f' (ap invf ff'a))⁻¹ ⬝ ap f' secta) : by rewrite con.assoc,
|
||||
have eq3 : _ = _,
|
||||
from calc (Hty (invf (f' a)))⁻¹ ⬝ retrf'a
|
||||
= (ap f' (ap invf ff'a))⁻¹ ⬝ ap f' secta : inv_con_eq_of_eq_con _ _ _ eq2
|
||||
... = (ap f' (ap invf ff'a)⁻¹) ⬝ ap f' secta : ap_inv
|
||||
... = ap f' ((ap invf ff'a)⁻¹ ⬝ secta) : ap_con,
|
||||
... = (ap f' (ap invf ff'a)⁻¹) ⬝ ap f' secta : by rewrite ap_inv
|
||||
... = ap f' ((ap invf ff'a)⁻¹ ⬝ secta) : by rewrite ap_con,
|
||||
eq3) in
|
||||
is_equiv.mk (inv f) sect' retr' adj'
|
||||
end
|
||||
|
|
@ -110,25 +110,25 @@ namespace is_equiv
|
|||
let retrfa := ret (f a) in
|
||||
have eq1 : ap f (sec a) = _,
|
||||
from calc ap f (sec a)
|
||||
= idp ⬝ ap f (sec a) : !idp_con⁻¹
|
||||
... = (ret (f a) ⬝ (ret (f a))⁻¹) ⬝ ap f (sec a) : {!con.right_inv⁻¹}
|
||||
... = ((ret fgfa)⁻¹ ⬝ ap (f ∘ g) (ret (f a))) ⬝ ap f (sec a) : {!con_ap_eq_con⁻¹}
|
||||
... = ((ret fgfa)⁻¹ ⬝ fgretrfa) ⬝ ap f (sec a) : {ap_compose g f _}
|
||||
... = (ret fgfa)⁻¹ ⬝ (fgretrfa ⬝ ap f (sec a)) : !con.assoc,
|
||||
= idp ⬝ ap f (sec a) : by rewrite idp_con
|
||||
... = (ret (f a) ⬝ (ret (f a))⁻¹) ⬝ ap f (sec a) : by rewrite con.right_inv
|
||||
... = ((ret fgfa)⁻¹ ⬝ ap (f ∘ g) (ret (f a))) ⬝ ap f (sec a) : by rewrite con_ap_eq_con
|
||||
... = ((ret fgfa)⁻¹ ⬝ fgretrfa) ⬝ ap f (sec a) : by rewrite ap_compose
|
||||
... = (ret fgfa)⁻¹ ⬝ (fgretrfa ⬝ ap f (sec a)) : by rewrite con.assoc,
|
||||
have eq2 : ap f (sec a) ⬝ idp = (ret fgfa)⁻¹ ⬝ (fgretrfa ⬝ ap f (sec a)),
|
||||
from !con_idp ⬝ eq1,
|
||||
have eq3 : idp = _,
|
||||
from calc idp
|
||||
= (ap f (sec a))⁻¹ ⬝ ((ret fgfa)⁻¹ ⬝ (fgretrfa ⬝ ap f (sec a))) : eq_inv_con_of_con_eq _ _ _ eq2
|
||||
... = ((ap f (sec a))⁻¹ ⬝ (ret fgfa)⁻¹) ⬝ (fgretrfa ⬝ ap f (sec a)) : !con.assoc'
|
||||
... = (ap f (sec a)⁻¹ ⬝ (ret fgfa)⁻¹) ⬝ (fgretrfa ⬝ ap f (sec a)) : {!ap_inv⁻¹}
|
||||
... = ((ap f (sec a)⁻¹ ⬝ (ret fgfa)⁻¹) ⬝ fgretrfa) ⬝ ap f (sec a) : !con.assoc'
|
||||
... = ((retrfa⁻¹ ⬝ ap (f ∘ g) (ap f (sec a)⁻¹)) ⬝ fgretrfa) ⬝ ap f (sec a) : {!con_ap_eq_con⁻¹}
|
||||
... = ((retrfa⁻¹ ⬝ fgfinvsect) ⬝ fgretrfa) ⬝ ap f (sec a) : {ap_compose g f _}
|
||||
... = (retrfa⁻¹ ⬝ (fgfinvsect ⬝ fgretrfa)) ⬝ ap f (sec a) : {!con.assoc'⁻¹}
|
||||
... = retrfa⁻¹ ⬝ ap f (ap g (ap f (sec a)⁻¹) ⬝ ap g (ret (f a))) ⬝ ap f (sec a) : {!ap_con⁻¹}
|
||||
... = retrfa⁻¹ ⬝ (ap f (ap g (ap f (sec a)⁻¹) ⬝ ap g (ret (f a))) ⬝ ap f (sec a)) : !con.assoc'⁻¹
|
||||
... = retrfa⁻¹ ⬝ ap f ((ap g (ap f (sec a)⁻¹) ⬝ ap g (ret (f a))) ⬝ sec a) : {!ap_con⁻¹},
|
||||
... = ((ap f (sec a))⁻¹ ⬝ (ret fgfa)⁻¹) ⬝ (fgretrfa ⬝ ap f (sec a)) : by rewrite con.assoc'
|
||||
... = (ap f (sec a)⁻¹ ⬝ (ret fgfa)⁻¹) ⬝ (fgretrfa ⬝ ap f (sec a)) : by rewrite ap_inv
|
||||
... = ((ap f (sec a)⁻¹ ⬝ (ret fgfa)⁻¹) ⬝ fgretrfa) ⬝ ap f (sec a) : by rewrite con.assoc'
|
||||
... = ((retrfa⁻¹ ⬝ ap (f ∘ g) (ap f (sec a)⁻¹)) ⬝ fgretrfa) ⬝ ap f (sec a) : by rewrite con_ap_eq_con
|
||||
... = ((retrfa⁻¹ ⬝ fgfinvsect) ⬝ fgretrfa) ⬝ ap f (sec a) : by rewrite ap_compose
|
||||
... = (retrfa⁻¹ ⬝ (fgfinvsect ⬝ fgretrfa)) ⬝ ap f (sec a) : by rewrite con.assoc'
|
||||
... = retrfa⁻¹ ⬝ ap f (ap g (ap f (sec a)⁻¹) ⬝ ap g (ret (f a))) ⬝ ap f (sec a) : by rewrite ap_con
|
||||
... = retrfa⁻¹ ⬝ (ap f (ap g (ap f (sec a)⁻¹) ⬝ ap g (ret (f a))) ⬝ ap f (sec a)) : by rewrite con.assoc'
|
||||
... = retrfa⁻¹ ⬝ ap f ((ap g (ap f (sec a)⁻¹) ⬝ ap g (ret (f a))) ⬝ sec a) : by rewrite -ap_con,
|
||||
have eq4 : ret (f a) = ap f ((ap g (ap f (sec a)⁻¹) ⬝ ap g (ret (f a))) ⬝ sec a),
|
||||
from eq_of_idp_eq_inv_con _ _ eq3,
|
||||
eq4)
|
||||
|
|
@ -204,10 +204,10 @@ namespace is_equiv
|
|||
definition equiv_rect_comp (P : B → Type)
|
||||
(df : Π (x : A), P (f x)) (x : A) : equiv_rect f P df (f x) = df x :=
|
||||
calc equiv_rect f P df (f x)
|
||||
= transport P (retr f (f x)) (df (f⁻¹ (f x))) : idp
|
||||
... = transport P (eq.ap f (sect f x)) (df (f⁻¹ (f x))) : adj f
|
||||
... = transport (P ∘ f) (sect f x) (df (f⁻¹ (f x))) : transport_compose
|
||||
... = df x : apD df (sect f x)
|
||||
= transport P (retr f (f x)) (df (f⁻¹ (f x))) : by esimp
|
||||
... = transport P (eq.ap f (sect f x)) (df (f⁻¹ (f x))) : by rewrite adj
|
||||
... = transport (P ∘ f) (sect f x) (df (f⁻¹ (f x))) : by rewrite -transport_compose
|
||||
... = df x : by rewrite (apD df (sect f x))
|
||||
|
||||
end
|
||||
|
||||
|
|
|
|||
|
|
@ -58,7 +58,7 @@ namespace morphism
|
|||
theorem left_inverse_eq_right_inverse {f : a ⟶ b} {g g' : hom b a}
|
||||
(Hl : g ∘ f = id) (Hr : f ∘ g' = id) : g = g' :=
|
||||
calc
|
||||
g = g ∘ id : (id_right g)⁻¹
|
||||
g = g ∘ id : by rewrite id_right
|
||||
... = g ∘ f ∘ g' : by rewrite -Hr
|
||||
... = (g ∘ f) ∘ g' : by rewrite assoc
|
||||
... = id ∘ g' : by rewrite Hl
|
||||
|
|
|
|||
Loading…
Reference in a new issue