feat(library/data/real/*.lean): migrate theorems from algebra

This commit is contained in:
Jeremy Avigad 2015-06-24 17:14:31 +10:00 committed by Leonardo de Moura
parent 4161b9ccbf
commit a0461262d0
4 changed files with 86 additions and 52 deletions

View file

@ -1058,7 +1058,7 @@ theorem zero_ne_one : ¬ zero = one :=
take H : zero = one,
absurd (quot.exact H) (r_zero_nequiv_one)
definition comm_ring [reducible] : algebra.comm_ring :=
protected definition comm_ring [reducible] : algebra.comm_ring :=
begin
fapply algebra.comm_ring.mk,
exact add,

View file

@ -17,7 +17,7 @@ open -[coercions] rat
local notation 0 := rat.of_num 0
local notation 1 := rat.of_num 1
open -[coercions] nat
open algebra
-- open algebra
open eq.ops
open pnat
@ -217,26 +217,25 @@ definition rep (x : ) : s.reg_seq := some (quot.exists_rep x)
definition re_abs (x : ) : :=
quot.lift_on x (λ a, quot.mk (s.r_abs a)) (take a b Hab, quot.sound (s.r_abs_well_defined Hab))
theorem r_abs_nonneg {x : } : 0 ≤ x → re_abs x = x :=
theorem r_abs_nonneg {x : } : zero ≤ x → re_abs x = x :=
quot.induction_on x (λ a Ha, quot.sound (s.r_equiv_abs_of_ge_zero Ha))
theorem r_abs_nonpos {x : } : x ≤ 0 → re_abs x = -x :=
theorem r_abs_nonpos {x : } : x ≤ zero → re_abs x = -x :=
quot.induction_on x (λ a Ha, quot.sound (s.r_equiv_neg_abs_of_le_zero Ha))
theorem abs_const' (a : ) : const (rat.abs a) = re_abs (const a) := quot.sound (s.r_abs_const a)
theorem re_abs_is_abs : re_abs = algebra.abs := funext
theorem re_abs_is_abs : re_abs = real.abs := funext
(begin
intro x,
rewrite ↑abs,
apply eq.symm,
let Hor := decidable.em (0 ≤ x),
let Hor := decidable.em (zero ≤ x),
apply or.elim Hor,
intro Hor1,
rewrite [(if_pos Hor1), r_abs_nonneg Hor1],
rewrite [abs_of_nonneg Hor1, r_abs_nonneg Hor1],
intro Hor2,
let Hor2' := algebra.le_of_lt (algebra.lt_of_not_ge Hor2),
rewrite [(if_neg Hor2), r_abs_nonpos Hor2']
have Hor2' : x ≤ zero, from le_of_lt (lt_of_not_ge Hor2),
rewrite [abs_of_neg (lt_of_not_ge Hor2), r_abs_nonpos Hor2']
end)
theorem abs_const (a : ) : const (rat.abs a) = abs (const a) :=
@ -254,7 +253,7 @@ theorem approx_spec (x : ) (n : +) : abs (x - (const (approx x n))) ≤ co
some_spec (rat_approx x n)
theorem approx_spec' (x : ) (n : +) : abs ((const (approx x n)) - x) ≤ const n⁻¹ :=
by rewrite algebra.abs_sub; apply approx_spec
by rewrite abs_sub; apply approx_spec
notation `r_seq` := + →
@ -283,26 +282,27 @@ theorem sub_consts2 (a b : ) : const a - const b = const (a - b) := !sub_cons
theorem add_half_const2 (n : +) : const (2 * n)⁻¹ + const (2 * n)⁻¹ = const (n⁻¹) :=
by xrewrite [add_consts2, pnat.add_halves]
set_option pp.all true
theorem cauchy_of_converges_to {X : r_seq} {a : } {N : + → +} (Hc : converges_to X a N) :
cauchy X (λ k, N (2 * k)) :=
begin
intro k m n Hm Hn,
rewrite (rewrite_helper9 a),
apply algebra.le.trans,
apply algebra.abs_add_le_abs_add_abs,
apply algebra.le.trans,
apply algebra.add_le_add,
apply le.trans,
apply abs_add_le_abs_add_abs,
apply le.trans,
apply add_le_add,
apply Hc,
apply Hm,
rewrite algebra.abs_neg,
krewrite abs_neg,
apply Hc,
apply Hn,
xrewrite add_half_const2,
apply !algebra.le.refl
eapply real.le.refl
end
definition Nb (M : + → +) := λ k, max (3 * k) (M (2 * k))
definition Nb (M : + → +) := λ k, pnat.max (3 * k) (M (2 * k))
theorem Nb_spec_right (M : + → +) (k : +) : M (2 * k) ≤ Nb M k := !max_right
@ -316,8 +316,8 @@ theorem lim_seq_reg_helper {X : r_seq} {M : + → +} (Hc : cauchy X M) {m
abs (const (lim_seq Hc m) - X (Nb M m)) + abs (X (Nb M m) - X (Nb M n)) + abs
(X (Nb M n) - const (lim_seq Hc n)) ≤ const (m⁻¹ + n⁻¹) :=
begin
apply algebra.le.trans,
apply algebra.add_le_add_three,
apply le.trans,
apply add_le_add_three,
apply approx_spec',
rotate 1,
apply approx_spec,
@ -336,24 +336,24 @@ theorem lim_seq_reg_helper {X : r_seq} {M : + → +} (Hc : cauchy X M) {m
apply pnat.mul_le_mul_left
end
-- the remaineder is commented out temporarily, until migration is finished.
-- the remainder is commented out temporarily, until migration is finished.
/-theorem lim_seq_reg {X : r_seq} {M : + → +} (Hc : cauchy X M) : s.regular (lim_seq Hc) :=
theorem lim_seq_reg {X : r_seq} {M : + → +} (Hc : cauchy X M) : s.regular (lim_seq Hc) :=
begin
rewrite ↑s.regular,
intro m n,
apply le_of_const_le_const,
rewrite [abs_const, -sub_consts, -sub_eq_add_neg, (rewrite_helper10 (X (Nb M m)) (X (Nb M n)))],--, -sub_consts2, (rewrite_helper10 (X (Nb M m)) (X (Nb M n)))],
apply real.le.trans,
apply algebra.abs_add_three,
apply abs_add_three,
let Hor := decidable.em (M (2 * m) ≥ M (2 * n)),
apply or.elim Hor,
intro Hor1,
apply lim_seq_reg_helper Hc Hor1,
intro Hor2,
let Hor2' := pnat.le_of_lt (pnat.lt_of_not_le Hor2),
rewrite [real.abs_sub (X (Nb M n)), algebra.abs_sub (X (Nb M m)), algebra.abs_sub, -- ???
rat.add.comm, algebra.add_comm_three],
rewrite [real.abs_sub (X (Nb M n)), abs_sub (X (Nb M m)), abs_sub, -- ???
rat.add.comm, add_comm_three],
apply lim_seq_reg_helper Hc Hor2'
end
@ -384,17 +384,17 @@ theorem lim_spec' {x : r_seq} {M : + → +} (Hc : cauchy x M) (k : +) :
theorem lim_spec {x : r_seq} {M : + → +} (Hc : cauchy x M) (k : +) :
abs ((const ((lim_seq Hc) k)) - (lim Hc)) ≤ const (k)⁻¹ :=
by rewrite algebra.abs_sub; apply lim_spec'
by rewrite abs_sub; apply lim_spec'
theorem converges_of_cauchy {X : r_seq} {M : + → +} (Hc : cauchy X M) :
converges_to X (lim Hc) (Nb M) :=
begin
intro k n Hn,
rewrite (rewrite_helper10 (X (Nb M n)) (const (lim_seq Hc n))),
apply algebra.le.trans,
apply algebra.abs_add_three,
apply algebra.le.trans,
apply algebra.add_le_add_three,
apply le.trans,
apply abs_add_three,
apply le.trans,
apply add_le_add_three,
apply Hc,
apply pnat.le.trans,
rotate 1,
@ -417,7 +417,7 @@ theorem converges_of_cauchy {X : r_seq} {M : + → +} (Hc : cauchy X M) :
rewrite 2 add_consts2,
apply const_le_const_of_le,
apply rat.le.trans,
apply add_le_add_three,
apply rat.add_le_add_three,
apply rat.le.refl,
apply inv_ge_of_le,
apply pnat_mul_le_mul_left',
@ -434,6 +434,6 @@ theorem converges_of_cauchy {X : r_seq} {M : + → +} (Hc : cauchy X M) :
apply Nb_spec_left,
rewrite [-*pnat.mul.assoc, p_add_fractions],
apply rat.le.refl
end-/
end
end real

View file

@ -651,9 +651,12 @@ theorem dec_lt : decidable_rel lt :=
apply prop_decidable
end
open [classes] algebra
definition linear_ordered_field [instance] : algebra.discrete_linear_ordered_field :=
⦃ algebra.discrete_linear_ordered_field, comm_ring, ordered_ring,
section migrate_algebra
open [classes] algebra
protected definition discrete_linear_ordered_field [reducible] :
algebra.discrete_linear_ordered_field :=
⦃ algebra.discrete_linear_ordered_field, real.comm_ring, real.ordered_ring,
le_total := le_total,
mul_inv_cancel := mul_inv,
inv_mul_cancel := inv_mul,
@ -663,4 +666,19 @@ definition linear_ordered_field [instance] : algebra.discrete_linear_ordered_fie
decidable_lt := dec_lt
local attribute real.comm_ring [instance]
local attribute real.ordered_ring [instance]
local attribute real.discrete_linear_ordered_field [instance]
definition abs (n : ) : := algebra.abs n
definition sign (n : ) : := algebra.sign n
definition max (a b : ) : := algebra.max a b
definition min (a b : ) : := algebra.min a b
migrate from algebra with real
replacing has_le.ge → ge, has_lt.gt → gt, sub → sub, abs → abs, sign → sign, dvd → dvd,
divide → divide, max → max, min → min
end migrate_algebra
end real

View file

@ -1022,6 +1022,14 @@ infix `<` := lt
definition le (x y : ) := quot.lift_on₂ x y (λ a b, s.r_le a b) s.r_le_well_defined
infix `≤` := le
infix `<=` := le
definition gt [reducible] (a b : ) := lt b a
definition ge [reducible] (a b : ) := le b a
infix >= := real.ge
infix ≥ := real.ge
infix > := real.gt
definition sep (x y : ) := quot.lift_on₂ x y (λ a b, s.r_sep a b) s.r_sep_well_defined
infix `≢` : 50 := sep
@ -1056,13 +1064,13 @@ theorem not_sep_self (x : ) : ¬ x ≢ x :=
theorem not_lt_self (x : ) : ¬ x < x :=
quot.induction_on x (λ s, s.r_not_lt_self s)
theorem le_of_lt (x y : ) : x < y → x ≤ y :=
theorem le_of_lt {x y : } : x < y → x ≤ y :=
quot.induction_on₂ x y (λ s t H', s.r_le_of_lt H')
theorem lt_of_le_of_lt (x y z : ) : x ≤ y → y < z → x < z :=
theorem lt_of_le_of_lt {x y z : } : x ≤ y → y < z → x < z :=
quot.induction_on₃ x y z (λ s t u H H', s.r_lt_of_le_of_lt H H')
theorem lt_of_lt_of_le (x y z : ) : x < y → y ≤ z → x < z :=
theorem lt_of_lt_of_le {x y z : } : x < y → y ≤ z → x < z :=
quot.induction_on₃ x y z (λ s t u H H', s.r_lt_of_lt_of_le H H')
theorem add_lt_add_left_var (x y z : ) : x < y → z + x < z + y :=
@ -1083,11 +1091,11 @@ theorem le_of_lt_or_eq (x y : ) : x < y x = y → x ≤ y :=
apply (or.inr (quot.exact H'))
end)))
section migrate_reals
open [classes] algebra
section migrate_algebra
open [classes] algebra
definition ordered_ring [reducible] : algebra.ordered_ring :=
⦃ algebra.ordered_ring, comm_ring,
protected definition ordered_ring [reducible] : algebra.ordered_ring :=
⦃ algebra.ordered_ring, real.comm_ring,
le_refl := le.refl,
le_trans := le.trans,
mul_pos := mul_gt_zero_of_gt_zero,
@ -1096,16 +1104,27 @@ definition ordered_ring [reducible] : algebra.ordered_ring :=
add_le_add_left := add_le_add_of_le_right,
le_antisymm := eq_of_le_of_ge,
lt_irrefl := not_lt_self,
lt_of_le_of_lt := lt_of_le_of_lt,
lt_of_lt_of_le := lt_of_lt_of_le,
le_of_lt := le_of_lt,
lt_of_le_of_lt := @lt_of_le_of_lt,
lt_of_lt_of_le := @lt_of_lt_of_le,
le_of_lt := @le_of_lt,
add_lt_add_left := add_lt_add_left
local attribute real.ordered_ring [instance]
--set_option migrate.trace true
migrate from algebra with real
end migrate_reals
local attribute real.comm_ring [instance]
local attribute real.ordered_ring [instance]
definition sub (a b : ) : := algebra.sub a b
infix - := real.sub
definition dvd (a b : ) : Prop := algebra.dvd a b
notation a b := real.dvd a b
migrate from algebra with real
replacing has_le.ge → ge, has_lt.gt → gt, sub → sub, dvd → dvd, divide → divide
attribute le.trans lt.trans lt_of_lt_of_le lt_of_le_of_lt ge.trans gt.trans gt_of_gt_of_ge
gt_of_ge_of_gt [trans]
end migrate_algebra
theorem const_le_const_of_le (a b : ) : a ≤ b → const a ≤ const b :=
s.r_const_le_const_of_le
@ -1113,6 +1132,3 @@ theorem le_of_const_le_const (a b : ) : const a ≤ const b → a ≤ b :=
s.r_le_of_const_le_const
end real
--print prefix real
--check @real.lt