author | wenzelm |
Mon, 08 May 2000 20:57:02 +0200 | |
changeset 8838 | 4eaa99f0d223 |
parent 7588 | 26384af93359 |
child 9013 | 9dd0274f76af |
permissions | -rw-r--r-- |
5078 | 1 |
(* Title : RealAbs.ML |
7219 | 2 |
ID : $Id$ |
5078 | 3 |
Author : Jacques D. Fleuriot |
4 |
Copyright : 1998 University of Cambridge |
|
5 |
Description : Absolute value function for the reals |
|
6 |
*) |
|
7 |
||
8 |
(*---------------------------------------------------------------------------- |
|
9 |
Properties of the absolute value function over the reals |
|
10 |
(adapted version of previously proved theorems about abs) |
|
11 |
----------------------------------------------------------------------------*) |
|
8838 | 12 |
Goalw [abs_real_def] "abs r = (if 0r<=r then r else -r)"; |
5459 | 13 |
by Auto_tac; |
8838 | 14 |
qed "abs_iff"; |
5078 | 15 |
|
8838 | 16 |
Goalw [abs_real_def] "abs 0r = 0r"; |
5078 | 17 |
by (rtac (real_le_refl RS if_P) 1); |
8838 | 18 |
qed "abs_zero"; |
5078 | 19 |
|
8838 | 20 |
Addsimps [abs_zero]; |
5078 | 21 |
|
8838 | 22 |
Goalw [abs_real_def] "abs 0r = -0r"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
23 |
by (Simp_tac 1); |
8838 | 24 |
qed "abs_minus_zero"; |
5078 | 25 |
|
8838 | 26 |
Goalw [abs_real_def] "0r<=x ==> abs x = x"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
27 |
by (Asm_simp_tac 1); |
8838 | 28 |
qed "abs_eqI1"; |
5078 | 29 |
|
8838 | 30 |
Goalw [abs_real_def] "0r<x ==> abs x = x"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
31 |
by (Asm_simp_tac 1); |
8838 | 32 |
qed "abs_eqI2"; |
5078 | 33 |
|
8838 | 34 |
Goalw [abs_real_def,real_le_def] "x<0r ==> abs x = -x"; |
7127
48e235179ffb
added parentheses to cope with a possible reduction of the precedence of unary
paulson
parents:
7077
diff
changeset
|
35 |
by (Asm_simp_tac 1); |
8838 | 36 |
qed "abs_minus_eqI2"; |
5078 | 37 |
|
8838 | 38 |
Goalw [abs_real_def] "x<=0r ==> abs x = -x"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
39 |
by (asm_full_simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 40 |
qed "abs_minus_eqI1"; |
5078 | 41 |
|
8838 | 42 |
Goalw [abs_real_def] "0r<= abs x"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
43 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 44 |
qed "abs_ge_zero"; |
5078 | 45 |
|
8838 | 46 |
Goalw [abs_real_def] "abs(abs x)=abs (x::real)"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
47 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 48 |
qed "abs_idempotent"; |
5078 | 49 |
|
8838 | 50 |
Goalw [abs_real_def] "(x=0r) = (abs x = 0r)"; |
5588 | 51 |
by (Full_simp_tac 1); |
8838 | 52 |
qed "abs_zero_iff"; |
5078 | 53 |
|
8838 | 54 |
Goal "(x ~= 0r) = (abs x ~= 0r)"; |
55 |
by (full_simp_tac (simpset() addsimps [abs_zero_iff RS sym]) 1); |
|
56 |
qed "abs_not_zero_iff"; |
|
5078 | 57 |
|
8838 | 58 |
Goalw [abs_real_def] "x<=abs (x::real)"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
59 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 60 |
qed "abs_ge_self"; |
5078 | 61 |
|
8838 | 62 |
Goalw [abs_real_def] "-x<=abs (x::real)"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
63 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 64 |
qed "abs_ge_minus_self"; |
5078 | 65 |
|
66 |
(* case splits nightmare *) |
|
8838 | 67 |
Goalw [abs_real_def] "abs (x * y) = abs x * abs (y::real)"; |
7127
48e235179ffb
added parentheses to cope with a possible reduction of the precedence of unary
paulson
parents:
7077
diff
changeset
|
68 |
by (auto_tac (claset(), |
48e235179ffb
added parentheses to cope with a possible reduction of the precedence of unary
paulson
parents:
7077
diff
changeset
|
69 |
simpset() addsimps [real_minus_mult_eq1, real_minus_mult_commute, |
48e235179ffb
added parentheses to cope with a possible reduction of the precedence of unary
paulson
parents:
7077
diff
changeset
|
70 |
real_minus_mult_eq2])); |
5078 | 71 |
by (blast_tac (claset() addDs [real_le_mult_order]) 1); |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
72 |
by (auto_tac (claset() addSDs [not_real_leE], simpset())); |
5078 | 73 |
by (EVERY1[dtac real_mult_le_zero, assume_tac, dtac real_le_anti_sym]); |
74 |
by (EVERY[dtac real_mult_le_zero 3, assume_tac 3, dtac real_le_anti_sym 3]); |
|
75 |
by (dtac real_mult_less_zero1 5 THEN assume_tac 5); |
|
76 |
by (auto_tac (claset() addDs [real_less_asym,sym], |
|
7127
48e235179ffb
added parentheses to cope with a possible reduction of the precedence of unary
paulson
parents:
7077
diff
changeset
|
77 |
simpset() addsimps [real_minus_mult_eq2 RS sym] @real_mult_ac)); |
8838 | 78 |
qed "abs_mult"; |
5078 | 79 |
|
8838 | 80 |
Goalw [abs_real_def] "x~= 0r ==> abs(rinv(x)) = rinv(abs(x))"; |
7127
48e235179ffb
added parentheses to cope with a possible reduction of the precedence of unary
paulson
parents:
7077
diff
changeset
|
81 |
by (auto_tac (claset(), simpset() addsimps [real_minus_rinv])); |
5078 | 82 |
by (ALLGOALS(dtac not_real_leE)); |
83 |
by (etac real_less_asym 1); |
|
7127
48e235179ffb
added parentheses to cope with a possible reduction of the precedence of unary
paulson
parents:
7077
diff
changeset
|
84 |
by (blast_tac (claset() addDs [real_le_imp_less_or_eq, real_rinv_gt_zero]) 1); |
5078 | 85 |
by (dtac (rinv_not_zero RS not_sym) 1); |
86 |
by (rtac (real_rinv_less_zero RSN (2,real_less_asym)) 1); |
|
87 |
by (assume_tac 2); |
|
88 |
by (blast_tac (claset() addSDs [real_le_imp_less_or_eq]) 1); |
|
8838 | 89 |
qed "abs_rinv"; |
5078 | 90 |
|
8838 | 91 |
Goal "y ~= 0r ==> abs(x*rinv(y)) = abs(x)*rinv(abs(y))"; |
92 |
by (asm_simp_tac (simpset() addsimps [abs_mult, abs_rinv]) 1); |
|
93 |
qed "abs_mult_rinv"; |
|
5078 | 94 |
|
8838 | 95 |
Goalw [abs_real_def] "abs(x+y) <= abs x + abs (y::real)"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
96 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 97 |
qed "abs_triangle_ineq"; |
5078 | 98 |
|
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
99 |
(*Unused, but perhaps interesting as an example*) |
8838 | 100 |
Goal "abs(w + x + y + z) <= abs(w) + abs(x) + abs(y) + abs(z::real)"; |
101 |
by (simp_tac (simpset() addsimps [abs_triangle_ineq RS order_trans]) 1); |
|
102 |
qed "abs_triangle_ineq_four"; |
|
5078 | 103 |
|
8838 | 104 |
Goalw [abs_real_def] "abs(-x)=abs(x::real)"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
105 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 106 |
qed "abs_minus_cancel"; |
5078 | 107 |
|
8838 | 108 |
Goalw [abs_real_def] "abs(x + (-y)) = abs (y + (-(x::real)))"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
109 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 110 |
qed "abs_minus_add_cancel"; |
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5588
diff
changeset
|
111 |
|
8838 | 112 |
Goalw [abs_real_def] "abs(x + (-y)) <= abs x + abs (y::real)"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
113 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 114 |
qed "abs_triangle_minus_ineq"; |
5078 | 115 |
|
8838 | 116 |
Goalw [abs_real_def] "abs x < r --> abs y < s --> abs(x+y) < r+(s::real)"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
117 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 118 |
qed_spec_mp "abs_add_less"; |
5078 | 119 |
|
8838 | 120 |
Goalw [abs_real_def] "abs x < r --> abs y < s --> abs(x+ (-y)) < r+(s::real)"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
121 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0]) 1); |
8838 | 122 |
qed "abs_add_minus_less"; |
5078 | 123 |
|
124 |
(* lemmas manipulating terms *) |
|
125 |
Goal "(0r*x<r)=(0r<r)"; |
|
126 |
by (Simp_tac 1); |
|
127 |
qed "real_mult_0_less"; |
|
128 |
||
129 |
Goal "[| 0r<y; x<r; y*r<t*s |] ==> y*x<t*s"; |
|
5459 | 130 |
by (blast_tac (claset() addSIs [real_mult_less_mono2] |
131 |
addIs [real_less_trans]) 1); |
|
5078 | 132 |
qed "real_mult_less_trans"; |
133 |
||
7127
48e235179ffb
added parentheses to cope with a possible reduction of the precedence of unary
paulson
parents:
7077
diff
changeset
|
134 |
Goal "[| 0r<=y; x<r; y*r<t*s; 0r<t*s|] ==> y*x<t*s"; |
5078 | 135 |
by (dtac real_le_imp_less_or_eq 1); |
5459 | 136 |
by (fast_tac (HOL_cs addEs [real_mult_0_less RS iffD2, |
137 |
real_mult_less_trans]) 1); |
|
5078 | 138 |
qed "real_mult_le_less_trans"; |
139 |
||
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
140 |
(* proofs lifted from previous older version |
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
141 |
FIXME: use a stronger version of real_mult_less_mono *) |
8838 | 142 |
Goal "[| abs x<r; abs y<s |] ==> abs(x*y)<r*(s::real)"; |
143 |
by (simp_tac (simpset() addsimps [abs_mult]) 1); |
|
5078 | 144 |
by (rtac real_mult_le_less_trans 1); |
8838 | 145 |
by (rtac abs_ge_zero 1); |
5078 | 146 |
by (assume_tac 1); |
8838 | 147 |
by (blast_tac (HOL_cs addIs [abs_ge_zero, real_mult_less_mono1, |
5078 | 148 |
real_le_less_trans]) 1); |
8838 | 149 |
by (blast_tac (HOL_cs addIs [abs_ge_zero, real_mult_order, |
5078 | 150 |
real_le_less_trans]) 1); |
8838 | 151 |
qed "abs_mult_less"; |
5078 | 152 |
|
8838 | 153 |
Goal "[| abs x < r; abs y < s |] ==> abs(x)*abs(y)<r*(s::real)"; |
154 |
by (auto_tac (claset() addIs [abs_mult_less], |
|
155 |
simpset() addsimps [abs_mult RS sym])); |
|
156 |
qed "abs_mult_less2"; |
|
5078 | 157 |
|
8838 | 158 |
Goal "1r < abs x ==> abs y <= abs(x*y)"; |
159 |
by (cut_inst_tac [("x1","y")] (abs_ge_zero RS real_le_imp_less_or_eq) 1); |
|
5078 | 160 |
by (EVERY1[etac disjE,rtac real_less_imp_le]); |
161 |
by (dres_inst_tac [("W","1r")] real_less_sum_gt_zero 1); |
|
8838 | 162 |
by (forw_inst_tac [("y","abs x + (-1r)")] real_mult_order 1); |
5078 | 163 |
by (assume_tac 1); |
164 |
by (rtac real_sum_gt_zero_less 1); |
|
165 |
by (asm_full_simp_tac (simpset() addsimps [real_add_mult_distrib2, |
|
8838 | 166 |
real_mult_commute, abs_mult]) 1); |
5078 | 167 |
by (dtac sym 1); |
8838 | 168 |
by (asm_full_simp_tac (simpset() addsimps [abs_mult]) 1); |
169 |
qed "abs_mult_le"; |
|
5078 | 170 |
|
8838 | 171 |
Goal "[| 1r < abs x; r < abs y|] ==> r < abs(x*y)"; |
172 |
by (blast_tac (HOL_cs addIs [abs_mult_le, real_less_le_trans]) 1); |
|
173 |
qed "abs_mult_gt"; |
|
5078 | 174 |
|
8838 | 175 |
Goal "abs(x)<r ==> 0r<r"; |
176 |
by (blast_tac (claset() addSIs [real_le_less_trans,abs_ge_zero]) 1); |
|
177 |
qed "abs_less_gt_zero"; |
|
5078 | 178 |
|
8838 | 179 |
Goalw [abs_real_def] "abs 1r = 1r"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
180 |
by (simp_tac (simpset() addsimps [zero_eq_numeral_0, one_eq_numeral_1]) 1); |
8838 | 181 |
qed "abs_one"; |
5078 | 182 |
|
8838 | 183 |
Goalw [abs_real_def] "abs x =x | abs x = -(x::real)"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
184 |
by (auto_tac (claset(), simpset() addsimps [zero_eq_numeral_0])); |
8838 | 185 |
qed "abs_disj"; |
5078 | 186 |
|
8838 | 187 |
Goalw [abs_real_def] "(abs x < r) = (-r<x & x<(r::real))"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
188 |
by (auto_tac (claset(), simpset() addsimps [zero_eq_numeral_0])); |
8838 | 189 |
qed "abs_interval_iff"; |
5078 | 190 |
|
8838 | 191 |
Goalw [abs_real_def] "(abs x <= r) = (-r<=x & x<=(r::real))"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
192 |
by (auto_tac (claset(), simpset() addsimps [zero_eq_numeral_0])); |
8838 | 193 |
qed "abs_le_interval_iff"; |
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5588
diff
changeset
|
194 |
|
8838 | 195 |
Goalw [abs_real_def] "(abs (x + (-y)) < r) = (y + (-r) < x & x < y + (r::real))"; |
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
196 |
by (auto_tac (claset(), simpset() addsimps [zero_eq_numeral_0])); |
8838 | 197 |
qed "abs_add_minus_interval_iff"; |
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5588
diff
changeset
|
198 |
|
8838 | 199 |
Goalw [abs_real_def] "0r < k ==> 0r < k + abs(x)"; |
200 |
by (auto_tac (claset(), simpset() addsimps [zero_eq_numeral_0])); |
|
201 |
qed "abs_add_pos_gt_zero"; |
|
202 |
||
203 |
Goalw [abs_real_def] "0r < 1r + abs(x)"; |
|
7588
26384af93359
Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents:
7219
diff
changeset
|
204 |
by (auto_tac (claset(), simpset() addsimps [zero_eq_numeral_0, one_eq_numeral_1])); |
8838 | 205 |
qed "abs_add_one_gt_zero"; |
206 |
Addsimps [abs_add_one_gt_zero]; |