author | paulson |
Fri, 05 Jan 2001 10:17:48 +0100 | |
changeset 10784 | 27e4d90b35b5 |
parent 10778 | 2c6605049646 |
child 10797 | 028d22926a41 |
permissions | -rw-r--r-- |
10750 | 1 |
(* Title : HRealAbs.ML |
2 |
Author : Jacques D. Fleuriot |
|
3 |
Copyright : 1998 University of Cambridge |
|
4 |
Description : Absolute value function for the hyperreals |
|
5 |
Similar to RealAbs.thy |
|
6 |
*) |
|
7 |
||
8 |
(*------------------------------------------------------------ |
|
9 |
absolute value on hyperreals as pointwise operation on |
|
10 |
equivalence class representative |
|
11 |
------------------------------------------------------------*) |
|
12 |
||
13 |
Goalw [hrabs_def] |
|
14 |
"abs (number_of v :: hypreal) = \ |
|
15 |
\ (if neg (number_of v) then number_of (bin_minus v) \ |
|
16 |
\ else number_of v)"; |
|
17 |
by (Simp_tac 1); |
|
18 |
qed "hrabs_number_of"; |
|
19 |
Addsimps [hrabs_number_of]; |
|
20 |
||
21 |
Goalw [hrabs_def] |
|
22 |
"abs (Abs_hypreal (hyprel ^^ {X})) = \ |
|
23 |
\ Abs_hypreal(hyprel ^^ {%n. abs (X n)})"; |
|
24 |
by (auto_tac (claset(), |
|
25 |
simpset_of HyperDef.thy |
|
26 |
addsimps [hypreal_zero_def, hypreal_le,hypreal_minus])); |
|
27 |
by (ALLGOALS(Ultra_tac THEN' arith_tac )); |
|
28 |
qed "hypreal_hrabs"; |
|
29 |
||
30 |
(*------------------------------------------------------------ |
|
31 |
Properties of the absolute value function over the reals |
|
32 |
(adapted version of previously proved theorems about abs) |
|
33 |
------------------------------------------------------------*) |
|
34 |
||
35 |
Goal "abs (#0::hypreal) = #0"; |
|
36 |
by (simp_tac (simpset() addsimps [hrabs_def]) 1); |
|
37 |
qed "hrabs_zero"; |
|
38 |
Addsimps [hrabs_zero]; |
|
39 |
||
40 |
Goal "(#0::hypreal)<=x ==> abs x = x"; |
|
41 |
by (asm_simp_tac (simpset() addsimps [hrabs_def]) 1); |
|
42 |
qed "hrabs_eqI1"; |
|
43 |
||
44 |
Goal "(#0::hypreal)<x ==> abs x = x"; |
|
45 |
by (asm_simp_tac (simpset() addsimps [order_less_imp_le, hrabs_eqI1]) 1); |
|
46 |
qed "hrabs_eqI2"; |
|
47 |
||
48 |
Goal "x<(#0::hypreal) ==> abs x = -x"; |
|
49 |
by (asm_simp_tac (simpset() addsimps [hypreal_le_def, hrabs_def]) 1); |
|
50 |
qed "hrabs_minus_eqI2"; |
|
51 |
||
52 |
Goal "x<=(#0::hypreal) ==> abs x = -x"; |
|
53 |
by (auto_tac (claset() addDs [order_antisym], simpset() addsimps [hrabs_def])); |
|
54 |
qed "hrabs_minus_eqI1"; |
|
55 |
||
56 |
Goal "(#0::hypreal)<= abs x"; |
|
57 |
by (auto_tac (claset() addDs [hypreal_minus_zero_less_iff RS iffD2, |
|
58 |
hypreal_less_asym], |
|
59 |
simpset() addsimps [hypreal_le_def, hrabs_def])); |
|
60 |
qed "hrabs_ge_zero"; |
|
61 |
||
62 |
Goal "abs(abs x) = abs (x::hypreal)"; |
|
63 |
by (auto_tac (claset() addDs [hypreal_minus_zero_less_iff RS iffD2, |
|
64 |
hypreal_less_asym], |
|
65 |
simpset() addsimps [hypreal_le_def, hrabs_def])); |
|
66 |
qed "hrabs_idempotent"; |
|
67 |
Addsimps [hrabs_idempotent]; |
|
68 |
||
69 |
Goalw [hrabs_def] "(abs x = (#0::hypreal)) = (x=#0)"; |
|
70 |
by (Simp_tac 1); |
|
71 |
qed "hrabs_zero_iff"; |
|
72 |
AddIffs [hrabs_zero_iff]; |
|
73 |
||
74 |
Goalw [hrabs_def] "(x::hypreal) <= abs x"; |
|
75 |
by (auto_tac (claset() addDs [not_hypreal_leE, order_less_imp_le], |
|
76 |
simpset() addsimps [hypreal_le_zero_iff RS sym])); |
|
77 |
qed "hrabs_ge_self"; |
|
78 |
||
79 |
Goalw [hrabs_def] "-(x::hypreal) <= abs x"; |
|
80 |
by (simp_tac (simpset() addsimps [hypreal_ge_zero_iff]) 1); |
|
81 |
qed "hrabs_ge_minus_self"; |
|
82 |
||
83 |
(* very short proof by "transfer" *) |
|
84 |
Goal "abs(x*(y::hypreal)) = (abs x)*(abs y)"; |
|
85 |
by (res_inst_tac [("z","x")] eq_Abs_hypreal 1); |
|
86 |
by (res_inst_tac [("z","y")] eq_Abs_hypreal 1); |
|
87 |
by (auto_tac (claset(), |
|
88 |
simpset() addsimps [hypreal_hrabs, hypreal_mult,abs_mult])); |
|
89 |
qed "hrabs_mult"; |
|
90 |
Addsimps [hrabs_mult]; |
|
91 |
||
92 |
Goal "abs(inverse(x)) = inverse(abs(x::hypreal))"; |
|
93 |
by (hypreal_div_undefined_case_tac "x=#0" 1); |
|
94 |
by (simp_tac (simpset() addsimps [HYPREAL_DIVIDE_ZERO]) 1); |
|
95 |
by (res_inst_tac [("z","x")] eq_Abs_hypreal 1); |
|
96 |
by (auto_tac (claset(), |
|
97 |
simpset() addsimps [hypreal_hrabs, |
|
98 |
hypreal_inverse,hypreal_zero_def])); |
|
99 |
by (ultra_tac (claset(), simpset() addsimps [abs_inverse]) 1); |
|
100 |
qed "hrabs_inverse"; |
|
101 |
||
102 |
Goal "abs(x+(y::hypreal)) <= abs x + abs y"; |
|
103 |
by (res_inst_tac [("z","x")] eq_Abs_hypreal 1); |
|
104 |
by (res_inst_tac [("z","y")] eq_Abs_hypreal 1); |
|
105 |
by (auto_tac (claset(), |
|
106 |
simpset() addsimps [hypreal_hrabs, hypreal_add,hypreal_le, |
|
107 |
abs_triangle_ineq])); |
|
108 |
qed "hrabs_triangle_ineq"; |
|
109 |
||
110 |
Goal "abs((w::hypreal) + x + y) <= abs(w) + abs(x) + abs(y)"; |
|
111 |
by (auto_tac (claset() addSIs [hrabs_triangle_ineq RS order_trans, |
|
112 |
hypreal_add_left_le_mono1], |
|
113 |
simpset() addsimps [hypreal_add_assoc])); |
|
114 |
qed "hrabs_triangle_ineq_three"; |
|
115 |
||
116 |
Goalw [hrabs_def] "abs(-x)=abs((x::hypreal))"; |
|
117 |
by (auto_tac (claset() addSDs [not_hypreal_leE, hypreal_less_asym] |
|
118 |
addIs [hypreal_le_anti_sym], |
|
119 |
simpset() addsimps [hypreal_ge_zero_iff])); |
|
120 |
qed "hrabs_minus_cancel"; |
|
121 |
Addsimps [hrabs_minus_cancel]; |
|
122 |
||
123 |
val prem1::prem2::rest = goal thy |
|
124 |
"[| abs x < r; abs y < s |] ==> abs(x+y) < r + (s::hypreal)"; |
|
125 |
by (rtac order_le_less_trans 1); |
|
126 |
by (rtac hrabs_triangle_ineq 1); |
|
127 |
by (rtac ([prem1,prem2] MRS hypreal_add_less_mono) 1); |
|
128 |
qed "hrabs_add_less"; |
|
129 |
||
130 |
Goal "[| abs x<r; abs y<s |] ==> abs x * abs y < r * (s::hypreal)"; |
|
131 |
by (subgoal_tac "#0 < r" 1); |
|
132 |
by (asm_full_simp_tac (simpset() addsimps [hrabs_def] |
|
133 |
addsplits [split_if_asm]) 2); |
|
134 |
by (case_tac "y = #0" 1); |
|
135 |
by (asm_full_simp_tac (simpset() addsimps [hypreal_0_less_mult_iff]) 1); |
|
136 |
by (rtac hypreal_mult_less_mono 1); |
|
137 |
by (auto_tac (claset(), |
|
138 |
simpset() addsimps [hrabs_def, linorder_neq_iff] |
|
139 |
addsplits [split_if_asm])); |
|
140 |
qed "hrabs_mult_less"; |
|
141 |
||
142 |
Goal "((#0::hypreal) < abs x) = (x ~= 0)"; |
|
143 |
by (simp_tac (simpset() addsimps [hrabs_def]) 1); |
|
144 |
by (arith_tac 1); |
|
145 |
qed "hypreal_0_less_abs_iff"; |
|
146 |
Addsimps [hypreal_0_less_abs_iff]; |
|
147 |
||
148 |
Goal "abs x < r ==> (#0::hypreal) < r"; |
|
149 |
by (blast_tac (claset() addSIs [order_le_less_trans, hrabs_ge_zero]) 1); |
|
150 |
qed "hrabs_less_gt_zero"; |
|
151 |
||
152 |
Goal "abs x = (x::hypreal) | abs x = -x"; |
|
153 |
by (cut_inst_tac [("x","#0"),("y","x")] hypreal_linear 1); |
|
154 |
by (fast_tac (claset() addIs [hrabs_eqI2,hrabs_minus_eqI2, |
|
155 |
hrabs_zero]) 1); |
|
156 |
qed "hrabs_disj"; |
|
157 |
||
158 |
Goal "abs x = (y::hypreal) ==> x = y | -x = y"; |
|
159 |
by (dtac sym 1); |
|
160 |
by (hyp_subst_tac 1); |
|
161 |
by (res_inst_tac [("x1","x")] (hrabs_disj RS disjE) 1); |
|
162 |
by (REPEAT(Asm_simp_tac 1)); |
|
163 |
qed "hrabs_eq_disj"; |
|
164 |
||
165 |
Goal "(abs x < (r::hypreal)) = (-r < x & x < r)"; |
|
166 |
by (Step_tac 1); |
|
167 |
by (rtac (hypreal_less_swap_iff RS iffD2) 1); |
|
168 |
by (asm_simp_tac (simpset() addsimps [(hrabs_ge_minus_self |
|
169 |
RS order_le_less_trans)]) 1); |
|
170 |
by (asm_simp_tac (simpset() addsimps [(hrabs_ge_self |
|
171 |
RS order_le_less_trans)]) 1); |
|
172 |
by (EVERY1 [dtac (hypreal_less_swap_iff RS iffD1), rotate_tac 1, |
|
173 |
dtac (hypreal_minus_minus RS subst), |
|
174 |
cut_inst_tac [("x","x")] hrabs_disj, dtac disjE ]); |
|
175 |
by (assume_tac 3 THEN Auto_tac); |
|
176 |
qed "hrabs_interval_iff"; |
|
177 |
||
178 |
Goal "(abs x < (r::hypreal)) = (- x < r & x < r)"; |
|
179 |
by (auto_tac (claset(), simpset() addsimps [hrabs_interval_iff])); |
|
180 |
qed "hrabs_interval_iff2"; |
|
181 |
||
182 |
||
183 |
(* Needed in Geom.ML *) |
|
184 |
Goal "(y::hypreal) + - x + (y + - z) = abs (x + - z) ==> y = z | x = y"; |
|
185 |
by (asm_full_simp_tac (simpset() addsimps [hrabs_def] |
|
186 |
addsplits [split_if_asm]) 1); |
|
187 |
qed "hrabs_add_lemma_disj"; |
|
188 |
||
189 |
Goal "abs((x::hypreal) + -y) = abs (y + -x)"; |
|
190 |
by (simp_tac (simpset() addsimps [hrabs_def]) 1); |
|
191 |
qed "hrabs_minus_add_cancel"; |
|
192 |
||
193 |
(* Needed in Geom.ML?? *) |
|
194 |
Goal "(x::hypreal) + - y + (z + - y) = abs (x + - z) ==> y = z | x = y"; |
|
195 |
by (asm_full_simp_tac (simpset() addsimps [hrabs_def] |
|
196 |
addsplits [split_if_asm]) 1); |
|
197 |
qed "hrabs_add_lemma_disj2"; |
|
198 |
||
199 |
||
200 |
(*---------------------------------------------------------- |
|
201 |
Relating hrabs to abs through embedding of IR into IR* |
|
202 |
----------------------------------------------------------*) |
|
203 |
Goalw [hypreal_of_real_def] |
|
204 |
"abs (hypreal_of_real r) = hypreal_of_real (abs r)"; |
|
205 |
by (auto_tac (claset(), simpset() addsimps [hypreal_hrabs])); |
|
206 |
qed "hypreal_of_real_hrabs"; |
|
10778
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
207 |
|
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
208 |
|
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
209 |
(*---------------------------------------------------------------------------- |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
210 |
Embedding of the naturals in the hyperreals |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
211 |
----------------------------------------------------------------------------*) |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
212 |
|
10784 | 213 |
Goal "hypreal_of_nat (m + n) = hypreal_of_nat m + hypreal_of_nat n"; |
214 |
by (simp_tac (simpset() addsimps [hypreal_of_nat_def]) 1); |
|
10778
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
215 |
qed "hypreal_of_nat_add"; |
10784 | 216 |
Addsimps [hypreal_of_nat_add]; |
217 |
||
218 |
Goal "hypreal_of_nat (m * n) = hypreal_of_nat m * hypreal_of_nat n"; |
|
219 |
by (simp_tac (simpset() addsimps [hypreal_of_nat_def]) 1); |
|
220 |
qed "hypreal_of_nat_mult"; |
|
221 |
Addsimps [hypreal_of_nat_mult]; |
|
10778
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
222 |
|
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
223 |
Goalw [hypreal_of_nat_def] |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
224 |
"(n < m) = (hypreal_of_nat n < hypreal_of_nat m)"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
225 |
by (auto_tac (claset() addIs [hypreal_add_less_mono1], simpset())); |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
226 |
qed "hypreal_of_nat_less_iff"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
227 |
Addsimps [hypreal_of_nat_less_iff RS sym]; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
228 |
|
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
229 |
(*------------------------------------------------------------*) |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
230 |
(* naturals embedded in hyperreals *) |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
231 |
(* is a hyperreal c.f. NS extension *) |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
232 |
(*------------------------------------------------------------*) |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
233 |
|
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
234 |
Goalw [hypreal_of_nat_def, hypreal_of_real_def, real_of_nat_def] |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
235 |
"hypreal_of_nat m = Abs_hypreal(hyprel^^{%n. real_of_nat m})"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
236 |
by Auto_tac; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
237 |
qed "hypreal_of_nat_iff"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
238 |
|
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
239 |
Goal "inj hypreal_of_nat"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
240 |
by (simp_tac (simpset() addsimps [inj_on_def, hypreal_of_nat_def]) 1); |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
241 |
qed "inj_hypreal_of_nat"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
242 |
|
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
243 |
Goalw [hypreal_of_nat_def] |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
244 |
"hypreal_of_nat (Suc n) = hypreal_of_nat n + 1hr"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
245 |
by (simp_tac (simpset() addsimps [real_of_nat_Suc]) 1); |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
246 |
qed "hypreal_of_nat_Suc"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
247 |
|
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
248 |
(*"neg" is used in rewrite rules for binary comparisons*) |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
249 |
Goal "hypreal_of_nat (number_of v :: nat) = \ |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
250 |
\ (if neg (number_of v) then #0 \ |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
251 |
\ else (number_of v :: hypreal))"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
252 |
by (simp_tac (simpset() addsimps [hypreal_of_nat_def]) 1); |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
253 |
qed "hypreal_of_nat_number_of"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
254 |
Addsimps [hypreal_of_nat_number_of]; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
255 |
|
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
256 |
Goal "hypreal_of_nat 0 = #0"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
257 |
by (simp_tac (simpset() delsimps [numeral_0_eq_0] |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
258 |
addsimps [numeral_0_eq_0 RS sym]) 1); |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
259 |
qed "hypreal_of_nat_zero"; |
2c6605049646
more tidying, especially to remove real_of_posnat
paulson
parents:
10750
diff
changeset
|
260 |
Addsimps [hypreal_of_nat_zero]; |