| author | paulson | 
| Tue, 01 Sep 1998 15:05:36 +0200 | |
| changeset 5418 | a895ab904b85 | 
| parent 5143 | b94cd208f073 | 
| child 5459 | 1dbaf888f4e7 | 
| permissions | -rw-r--r-- | 
| 5078 | 1 | (* Title : RealAbs.ML | 
| 2 | Author : Jacques D. Fleuriot | |
| 3 | Copyright : 1998 University of Cambridge | |
| 4 | Description : Absolute value function for the reals | |
| 5 | *) | |
| 6 | ||
| 7 | open RealAbs; | |
| 8 | ||
| 9 | (*---------------------------------------------------------------------------- | |
| 10 | Properties of the absolute value function over the reals | |
| 11 | (adapted version of previously proved theorems about abs) | |
| 12 | ----------------------------------------------------------------------------*) | |
| 13 | Goalw [rabs_def] "rabs r = (if 0r<=r then r else %~r)"; | |
| 14 | by (Step_tac 1); | |
| 15 | qed "rabs_iff"; | |
| 16 | ||
| 17 | Goalw [rabs_def] "rabs 0r = 0r"; | |
| 18 | by (rtac (real_le_refl RS if_P) 1); | |
| 19 | qed "rabs_zero"; | |
| 20 | ||
| 21 | Addsimps [rabs_zero]; | |
| 22 | ||
| 23 | Goalw [rabs_def] "rabs 0r = %~0r"; | |
| 24 | by (stac real_minus_zero 1); | |
| 25 | by (rtac if_cancel 1); | |
| 26 | qed "rabs_minus_zero"; | |
| 27 | ||
| 28 | val [prem] = goalw thy [rabs_def] "0r<=x ==> rabs x = x"; | |
| 29 | by (rtac (prem RS if_P) 1); | |
| 30 | qed "rabs_eqI1"; | |
| 31 | ||
| 32 | val [prem] = goalw thy [rabs_def] "0r<x ==> rabs x = x"; | |
| 33 | by (simp_tac (simpset() addsimps [(prem RS real_less_imp_le),rabs_eqI1]) 1); | |
| 34 | qed "rabs_eqI2"; | |
| 35 | ||
| 36 | val [prem] = goalw thy [rabs_def,real_le_def] "x<0r ==> rabs x = %~x"; | |
| 37 | by (simp_tac (simpset() addsimps [prem,if_not_P]) 1); | |
| 38 | qed "rabs_minus_eqI2"; | |
| 39 | ||
| 5143 
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
 paulson parents: 
5078diff
changeset | 40 | Goal "x<=0r ==> rabs x = %~x"; | 
| 5078 | 41 | by (dtac real_le_imp_less_or_eq 1); | 
| 42 | by (fast_tac (HOL_cs addIs [rabs_minus_zero,rabs_minus_eqI2]) 1); | |
| 43 | qed "rabs_minus_eqI1"; | |
| 44 | ||
| 45 | Goalw [rabs_def,real_le_def] "0r<= rabs x"; | |
| 46 | by (full_simp_tac (simpset() setloop (split_tac [expand_if])) 1); | |
| 47 | by (blast_tac (claset() addDs [real_minus_zero_less_iff RS iffD2, | |
| 48 | real_less_asym]) 1); | |
| 49 | qed "rabs_ge_zero"; | |
| 50 | ||
| 51 | Goal "rabs(rabs x)=rabs x"; | |
| 52 | by (res_inst_tac [("r1","rabs x")] (rabs_iff RS ssubst) 1);
 | |
| 53 | by (blast_tac (claset() addIs [if_P,rabs_ge_zero]) 1); | |
| 54 | qed "rabs_idempotent"; | |
| 55 | ||
| 56 | Goalw [rabs_def] "(x=0r) = (rabs x = 0r)"; | |
| 57 | by (full_simp_tac (simpset() setloop (split_tac [expand_if])) 1); | |
| 58 | qed "rabs_zero_iff"; | |
| 59 | ||
| 60 | Goal "(x ~= 0r) = (rabs x ~= 0r)"; | |
| 61 | by (full_simp_tac (simpset() addsimps [rabs_zero_iff RS sym] | |
| 62 | setloop (split_tac [expand_if])) 1); | |
| 63 | qed "rabs_not_zero_iff"; | |
| 64 | ||
| 65 | Goalw [rabs_def] "x<=rabs x"; | |
| 66 | by (full_simp_tac (simpset() addsimps [real_le_refl] setloop (split_tac [expand_if])) 1); | |
| 67 | by (auto_tac (claset() addDs [not_real_leE RS real_less_imp_le], | |
| 68 | simpset() addsimps [real_le_zero_iff])); | |
| 69 | qed "rabs_ge_self"; | |
| 70 | ||
| 71 | Goalw [rabs_def] "%~x<=rabs x"; | |
| 72 | by (full_simp_tac (simpset() addsimps [real_le_refl, | |
| 73 | real_ge_zero_iff] setloop (split_tac [expand_if])) 1); | |
| 74 | qed "rabs_ge_minus_self"; | |
| 75 | ||
| 76 | (* case splits nightmare *) | |
| 77 | Goalw [rabs_def] "rabs(x*y) = (rabs x)*(rabs y)"; | |
| 78 | by (auto_tac (claset(),simpset() addsimps [real_minus_mult_eq1, | |
| 79 | real_minus_mult_commute,real_minus_mult_eq2] setloop (split_tac [expand_if]))); | |
| 80 | by (blast_tac (claset() addDs [real_le_mult_order]) 1); | |
| 81 | by (auto_tac (claset() addSDs [not_real_leE],simpset())); | |
| 82 | by (EVERY1[dtac real_mult_le_zero, assume_tac, dtac real_le_anti_sym]); | |
| 83 | by (EVERY[dtac real_mult_le_zero 3, assume_tac 3, dtac real_le_anti_sym 3]); | |
| 84 | by (dtac real_mult_less_zero1 5 THEN assume_tac 5); | |
| 85 | by (auto_tac (claset() addDs [real_less_asym,sym], | |
| 86 | simpset() addsimps [real_minus_mult_eq2 RS sym] @real_mult_ac)); | |
| 87 | qed "rabs_mult"; | |
| 88 | ||
| 5143 
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
 paulson parents: 
5078diff
changeset | 89 | Goalw [rabs_def] "x~= 0r ==> rabs(rinv(x)) = rinv(rabs(x))"; | 
| 5078 | 90 | by (auto_tac (claset(),simpset() addsimps [real_minus_rinv] | 
| 91 | setloop (split_tac [expand_if]))); | |
| 92 | by (ALLGOALS(dtac not_real_leE)); | |
| 93 | by (etac real_less_asym 1); | |
| 94 | by (blast_tac (claset() addDs [real_le_imp_less_or_eq, | |
| 95 | real_rinv_gt_zero]) 1); | |
| 96 | by (dtac (rinv_not_zero RS not_sym) 1); | |
| 97 | by (rtac (real_rinv_less_zero RSN (2,real_less_asym)) 1); | |
| 98 | by (assume_tac 2); | |
| 99 | by (blast_tac (claset() addSDs [real_le_imp_less_or_eq]) 1); | |
| 100 | qed "rabs_rinv"; | |
| 101 | ||
| 102 | val [prem] = goal thy "y ~= 0r ==> rabs(x*rinv(y)) = rabs(x)*rinv(rabs(y))"; | |
| 103 | by (res_inst_tac [("c1","rabs y")] (real_mult_left_cancel RS subst) 1);
 | |
| 104 | by (simp_tac (simpset() addsimps [(rabs_not_zero_iff RS sym), prem]) 1); | |
| 105 | by (simp_tac (simpset() addsimps [(rabs_mult RS sym) ,real_mult_inv_right, | |
| 106 | prem,rabs_not_zero_iff RS sym] @ real_mult_ac) 1); | |
| 107 | qed "rabs_mult_rinv"; | |
| 108 | ||
| 109 | Goal "rabs(x+y) <= rabs x + rabs y"; | |
| 110 | by (EVERY1 [res_inst_tac [("Q1","0r<=x+y")] (expand_if RS ssubst), rtac conjI]);
 | |
| 111 | by (asm_simp_tac (simpset() addsimps [rabs_eqI1,real_add_le_mono,rabs_ge_self]) 1); | |
| 112 | by (asm_simp_tac (simpset() addsimps [not_real_leE,rabs_minus_eqI2,real_add_le_mono, | |
| 113 | rabs_ge_minus_self,real_minus_add_eq]) 1); | |
| 114 | qed "rabs_triangle_ineq"; | |
| 115 | ||
| 116 | Goal "rabs(w + x + y + z) <= rabs(w) + rabs(x) + rabs(y) + rabs(z)"; | |
| 117 | by (full_simp_tac (simpset() addsimps [real_add_assoc]) 1); | |
| 118 | by (blast_tac (claset() addSIs [(rabs_triangle_ineq RS real_le_trans), | |
| 119 | real_add_left_le_mono1,real_le_refl]) 1); | |
| 120 | qed "rabs_triangle_ineq_four"; | |
| 121 | ||
| 122 | Goalw [rabs_def] "rabs(%~x)=rabs(x)"; | |
| 123 | by (auto_tac (claset() addSDs [not_real_leE,real_less_asym] addIs [real_le_anti_sym], | |
| 124 | simpset() addsimps [real_ge_zero_iff] setloop (split_tac [expand_if]))); | |
| 125 | qed "rabs_minus_cancel"; | |
| 126 | ||
| 127 | Goal "rabs(x + %~y) <= rabs x + rabs y"; | |
| 128 | by (res_inst_tac [("x1","y")] (rabs_minus_cancel RS subst) 1);
 | |
| 129 | by (rtac rabs_triangle_ineq 1); | |
| 130 | qed "rabs_triangle_minus_ineq"; | |
| 131 | ||
| 132 | Goal "rabs (x + y + (%~l + %~m)) <= rabs(x + %~l) + rabs(y + %~m)"; | |
| 133 | by (full_simp_tac (simpset() addsimps [real_add_assoc]) 1); | |
| 134 | by (res_inst_tac [("x1","y")] (real_add_left_commute RS ssubst) 1);
 | |
| 135 | by (rtac (real_add_assoc RS subst) 1); | |
| 136 | by (rtac rabs_triangle_ineq 1); | |
| 137 | qed "rabs_sum_triangle_ineq"; | |
| 138 | ||
| 139 | Goal "[| rabs x < r; rabs y < s |] ==> rabs(x+y) < r+s"; | |
| 140 | by (rtac real_le_less_trans 1); | |
| 141 | by (rtac rabs_triangle_ineq 1); | |
| 142 | by (REPEAT (ares_tac [real_add_less_mono] 1)); | |
| 143 | qed "rabs_add_less"; | |
| 144 | ||
| 5143 
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
 paulson parents: 
5078diff
changeset | 145 | Goal "[| rabs x < r; rabs y < s |] ==> rabs(x+ %~y) < r+s"; | 
| 5078 | 146 | by (rotate_tac 1 1); | 
| 147 | by (dtac (rabs_minus_cancel RS ssubst) 1); | |
| 148 | by (asm_simp_tac (simpset() addsimps [rabs_add_less]) 1); | |
| 149 | qed "rabs_add_minus_less"; | |
| 150 | ||
| 151 | (* lemmas manipulating terms *) | |
| 152 | Goal "(0r*x<r)=(0r<r)"; | |
| 153 | by (Simp_tac 1); | |
| 154 | qed "real_mult_0_less"; | |
| 155 | ||
| 156 | Goal "[| 0r<y; x<r; y*r<t*s |] ==> y*x<t*s"; | |
| 157 | (*why PROOF FAILED for this*) | |
| 158 | by (best_tac (claset() addIs [real_mult_less_mono2, real_less_trans]) 1); | |
| 159 | qed "real_mult_less_trans"; | |
| 160 | ||
| 161 | Goal "!!(x::real) y.[| 0r<=y; x<r; y*r<t*s; 0r<t*s|] ==> y*x<t*s"; | |
| 162 | by (dtac real_le_imp_less_or_eq 1); | |
| 163 | by (fast_tac (HOL_cs addEs [(real_mult_0_less RS iffD2),real_mult_less_trans]) 1); | |
| 164 | qed "real_mult_le_less_trans"; | |
| 165 | ||
| 166 | (* proofs lifted from previous older version *) | |
| 167 | Goal "[| rabs x<r; rabs y<s |] ==> rabs(x*y)<r*s"; | |
| 168 | by (simp_tac (simpset() addsimps [rabs_mult]) 1); | |
| 169 | by (rtac real_mult_le_less_trans 1); | |
| 170 | by (rtac rabs_ge_zero 1); | |
| 171 | by (assume_tac 1); | |
| 172 | by (blast_tac (HOL_cs addIs [rabs_ge_zero, real_mult_less_mono1, | |
| 173 | real_le_less_trans]) 1); | |
| 174 | by (blast_tac (HOL_cs addIs [rabs_ge_zero, real_mult_order, | |
| 175 | real_le_less_trans]) 1); | |
| 176 | qed "rabs_mult_less"; | |
| 177 | ||
| 5143 
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
 paulson parents: 
5078diff
changeset | 178 | Goal "[| rabs x < r; rabs y < s |] \ | 
| 5078 | 179 | \ ==> rabs(x)*rabs(y)<r*s"; | 
| 180 | by (auto_tac (claset() addIs [rabs_mult_less], | |
| 181 | simpset() addsimps [rabs_mult RS sym])); | |
| 182 | qed "rabs_mult_less2"; | |
| 183 | ||
| 5143 
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
 paulson parents: 
5078diff
changeset | 184 | Goal "1r < rabs x ==> rabs y <= rabs(x*y)"; | 
| 5078 | 185 | by (cut_inst_tac [("x1","y")] (rabs_ge_zero RS real_le_imp_less_or_eq) 1);
 | 
| 186 | by (EVERY1[etac disjE,rtac real_less_imp_le]); | |
| 187 | by (dres_inst_tac [("W","1r")]  real_less_sum_gt_zero 1);
 | |
| 188 | by (forw_inst_tac [("y","rabs x + %~1r")] real_mult_order 1);
 | |
| 189 | by (assume_tac 1); | |
| 190 | by (rtac real_sum_gt_zero_less 1); | |
| 191 | by (asm_full_simp_tac (simpset() addsimps [real_add_mult_distrib2, | |
| 192 | rabs_mult, real_mult_commute,real_minus_mult_eq1 RS sym]) 1); | |
| 193 | by (dtac sym 1); | |
| 194 | by (asm_full_simp_tac (simpset() addsimps [real_le_refl,rabs_mult]) 1); | |
| 195 | qed "rabs_mult_le"; | |
| 196 | ||
| 5143 
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
 paulson parents: 
5078diff
changeset | 197 | Goal "[| 1r < rabs x; r < rabs y|] ==> r < rabs(x*y)"; | 
| 5078 | 198 | by (fast_tac (HOL_cs addIs [rabs_mult_le, real_less_le_trans]) 1); | 
| 199 | qed "rabs_mult_gt"; | |
| 200 | ||
| 5143 
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
 paulson parents: 
5078diff
changeset | 201 | Goal "rabs(x)<r ==> 0r<r"; | 
| 5078 | 202 | by (blast_tac (claset() addSIs [real_le_less_trans,rabs_ge_zero]) 1); | 
| 203 | qed "rabs_less_gt_zero"; | |
| 204 | ||
| 205 | Goalw [rabs_def] "rabs 1r = 1r"; | |
| 206 | by (auto_tac (claset() addSDs [not_real_leE RS real_less_asym], | |
| 207 | simpset() addsimps [real_zero_less_one] setloop (split_tac [expand_if]))); | |
| 208 | qed "rabs_one"; | |
| 209 | ||
| 210 | Goal "[| 0r < x ; x < r |] ==> rabs x < r"; | |
| 211 | by (asm_simp_tac (simpset() addsimps [rabs_eqI2]) 1); | |
| 212 | qed "rabs_lessI"; | |
| 213 | ||
| 214 | Goal "rabs x =x | rabs x = %~x"; | |
| 215 | by (cut_inst_tac [("R1.0","0r"),("R2.0","x")] real_linear 1);
 | |
| 216 | by (fast_tac (claset() addIs [rabs_eqI2,rabs_minus_eqI2, | |
| 217 | rabs_zero,rabs_minus_zero]) 1); | |
| 218 | qed "rabs_disj"; | |
| 219 | ||
| 5143 
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
 paulson parents: 
5078diff
changeset | 220 | Goal "rabs x = y ==> x = y | %~x = y"; | 
| 5078 | 221 | by (dtac sym 1); | 
| 222 | by (hyp_subst_tac 1); | |
| 223 | by (res_inst_tac [("x1","x")] (rabs_disj RS disjE) 1);
 | |
| 224 | by (REPEAT(Asm_simp_tac 1)); | |
| 225 | qed "rabs_eq_disj"; | |
| 226 | ||
| 227 | Goal "(rabs x < r) = (%~r<x & x<r)"; | |
| 228 | by (Step_tac 1); | |
| 229 | by (rtac (real_less_swap_iff RS iffD2) 1); | |
| 230 | by (asm_simp_tac (simpset() addsimps [(rabs_ge_minus_self | |
| 231 | RS real_le_less_trans)]) 1); | |
| 232 | by (asm_simp_tac (simpset() addsimps [(rabs_ge_self | |
| 233 | RS real_le_less_trans)]) 1); | |
| 234 | by (EVERY1 [dtac (real_less_swap_iff RS iffD1), rotate_tac 1, | |
| 235 | dtac (real_minus_minus RS subst), | |
| 236 |             cut_inst_tac [("x","x")] rabs_disj, dtac disjE ]);
 | |
| 237 | by (assume_tac 3 THEN Auto_tac); | |
| 238 | qed "rabs_interval_iff"; | |
| 239 |