style(homotopy/circle): clean-up encode-decode proof

This commit is contained in:
Floris van Doorn 2015-11-18 15:08:06 -05:00 committed by Leonardo de Moura
parent 564e8f947d
commit 810a399699
2 changed files with 15 additions and 24 deletions

View file

@ -186,7 +186,7 @@ namespace circle
open int open int
protected definition code (x : circle) : Type₀ := protected definition code [unfold 1] (x : circle) : Type₀ :=
circle.elim_type_on x equiv_succ circle.elim_type_on x equiv_succ
definition transport_code_loop (a : ) : transport circle.code loop a = succ a := definition transport_code_loop (a : ) : transport circle.code loop a = succ a :=
@ -196,10 +196,10 @@ namespace circle
: transport circle.code loop⁻¹ a = pred a := : transport circle.code loop⁻¹ a = pred a :=
ap10 !elim_type_loop_inv a ap10 !elim_type_loop_inv a
protected definition encode {x : circle} (p : base = x) : circle.code x := protected definition encode [unfold 2] {x : circle} (p : base = x) : circle.code x :=
transport circle.code p (of_num 0) -- why is the explicit coercion needed here? transport circle.code p (of_num 0)
protected definition decode {x : circle} : circle.code x → base = x := protected definition decode [unfold 1] {x : circle} : circle.code x → base = x :=
begin begin
induction x, induction x,
{ exact power loop}, { exact power loop},
@ -207,31 +207,21 @@ namespace circle
rewrite [power_con,transport_code_loop]} rewrite [power_con,transport_code_loop]}
end end
--remove this theorem after #484
theorem encode_decode {x : circle} : Π(a : circle.code x), circle.encode (circle.decode a) = a :=
begin
unfold circle.decode, induction x,
{ intro a, esimp [base,base1], --simplify after #587
apply rec_nat_on a,
{ exact idp},
{ intros n p,
apply transport (λ(y : base = base), transport circle.code y _ = _), apply power_con,
rewrite [▸*,con_tr, transport_code_loop, ↑[circle.encode,circle.code] at p], krewrite p},
{ intros n p,
apply transport (λ(y : base = base), transport circle.code y _ = _),
{ exact !power_con_inv ⬝ ap (power loop) !neg_succ⁻¹},
rewrite [▸*,@con_tr _ circle.code,transport_code_loop_inv, ↑[circle.encode] at p, p, -neg_succ]}},
{ apply pathover_of_tr_eq, apply eq_of_homotopy, intro a, apply @is_hset.elim,
esimp [circle.code,base,base1], exact _}
--simplify after #587
end
definition circle_eq_equiv [constructor] (x : circle) : (base = x) ≃ circle.code x := definition circle_eq_equiv [constructor] (x : circle) : (base = x) ≃ circle.code x :=
begin begin
fapply equiv.MK, fapply equiv.MK,
{ exact circle.encode}, { exact circle.encode},
{ exact circle.decode}, { exact circle.decode},
{ exact circle.encode_decode}, { exact abstract [irreducible] begin
induction x,
{ intro a, esimp, apply rec_nat_on a,
{ exact idp},
{ intros n p, rewrite [↑circle.encode, -power_con, con_tr, transport_code_loop],
exact ap succ p},
{ intros n p, rewrite [↑circle.encode, nat_succ_eq_int_succ, neg_succ, -power_con_inv,
@con_tr _ circle.code, transport_code_loop_inv, ↑[circle.encode] at p, p, -neg_succ] }},
{ apply pathover_of_tr_eq, apply eq_of_homotopy, intro a, apply @is_hset.elim,
esimp, exact _} end end},
{ intro p, cases p, exact idp}, { intro p, cases p, exact idp},
end end

View file

@ -804,6 +804,7 @@ by rewrite [neg_succ_of_nat_eq, -of_nat_add_of_nat, neg_add]
definition succ (a : ) := a + (nat.succ zero) definition succ (a : ) := a + (nat.succ zero)
definition pred (a : ) := a - (nat.succ zero) definition pred (a : ) := a - (nat.succ zero)
definition nat_succ_eq_int_succ (n : ) : nat.succ n = int.succ n := idp
definition pred_succ (a : ) : pred (succ a) = a := !sub_add_cancel definition pred_succ (a : ) : pred (succ a) = a := !sub_add_cancel
definition succ_pred (a : ) : succ (pred a) = a := !add_sub_cancel definition succ_pred (a : ) : succ (pred a) = a := !add_sub_cancel
definition neg_succ (a : ) : -succ a = pred (-a) := definition neg_succ (a : ) : -succ a = pred (-a) :=