author | paulson |
Wed, 10 Dec 2003 15:59:34 +0100 | |
changeset 14288 | d149e3cbdb39 |
parent 14284 | f1abe67c448a |
permissions | -rw-r--r-- |
10722 | 1 |
(* Title: HOL/Real/RealArith.ML |
2 |
ID: $Id$ |
|
3 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
|
4 |
Copyright 1999 University of Cambridge |
|
5 |
||
14275
031a5a051bb4
Converting more of the "real" development to Isar scripts
paulson
parents:
14268
diff
changeset
|
6 |
Common factor cancellation |
10722 | 7 |
*) |
8 |
||
14275
031a5a051bb4
Converting more of the "real" development to Isar scripts
paulson
parents:
14268
diff
changeset
|
9 |
val real_inverse_eq_divide = thm"real_inverse_eq_divide"; |
031a5a051bb4
Converting more of the "real" development to Isar scripts
paulson
parents:
14268
diff
changeset
|
10 |
val real_mult_less_cancel2 = thm"real_mult_less_cancel2"; |
031a5a051bb4
Converting more of the "real" development to Isar scripts
paulson
parents:
14268
diff
changeset
|
11 |
val real_mult_le_cancel2 = thm"real_mult_le_cancel2"; |
031a5a051bb4
Converting more of the "real" development to Isar scripts
paulson
parents:
14268
diff
changeset
|
12 |
val real_mult_less_cancel1 = thm"real_mult_less_cancel1"; |
031a5a051bb4
Converting more of the "real" development to Isar scripts
paulson
parents:
14268
diff
changeset
|
13 |
val real_mult_le_cancel1 = thm"real_mult_le_cancel1"; |
031a5a051bb4
Converting more of the "real" development to Isar scripts
paulson
parents:
14268
diff
changeset
|
14 |
val real_mult_eq_cancel1 = thm"real_mult_eq_cancel1"; |
031a5a051bb4
Converting more of the "real" development to Isar scripts
paulson
parents:
14268
diff
changeset
|
15 |
val real_mult_eq_cancel2 = thm"real_mult_eq_cancel2"; |
031a5a051bb4
Converting more of the "real" development to Isar scripts
paulson
parents:
14268
diff
changeset
|
16 |
val real_mult_div_cancel1 = thm"real_mult_div_cancel1"; |
031a5a051bb4
Converting more of the "real" development to Isar scripts
paulson
parents:
14268
diff
changeset
|
17 |
val real_mult_div_cancel_disj = thm"real_mult_div_cancel_disj"; |
10722 | 18 |
|
19 |
||
20 |
local |
|
21 |
open Real_Numeral_Simprocs |
|
22 |
in |
|
23 |
||
13462 | 24 |
val rel_real_number_of = [eq_real_number_of, less_real_number_of, |
12018
ec054019c910
Numerals and simprocs for types real and hypreal. The abstract
paulson
parents:
11704
diff
changeset
|
25 |
le_real_number_of_eq_not_less] |
10722 | 26 |
|
27 |
structure CancelNumeralFactorCommon = |
|
28 |
struct |
|
13462 | 29 |
val mk_coeff = mk_coeff |
30 |
val dest_coeff = dest_coeff 1 |
|
10722 | 31 |
val trans_tac = trans_tac |
13462 | 32 |
val norm_tac = |
12018
ec054019c910
Numerals and simprocs for types real and hypreal. The abstract
paulson
parents:
11704
diff
changeset
|
33 |
ALLGOALS (simp_tac (HOL_ss addsimps real_minus_from_mult_simps @ mult_1s)) |
10722 | 34 |
THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@real_mult_minus_simps)) |
12018
ec054019c910
Numerals and simprocs for types real and hypreal. The abstract
paulson
parents:
11704
diff
changeset
|
35 |
THEN ALLGOALS (simp_tac (HOL_ss addsimps real_mult_ac)) |
13462 | 36 |
val numeral_simp_tac = |
10722 | 37 |
ALLGOALS (simp_tac (HOL_ss addsimps rel_real_number_of@bin_simps)) |
38 |
val simplify_meta_eq = simplify_meta_eq |
|
39 |
end |
|
40 |
||
41 |
structure DivCancelNumeralFactor = CancelNumeralFactorFun |
|
42 |
(open CancelNumeralFactorCommon |
|
13485
acf39e924091
tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents:
13462
diff
changeset
|
43 |
val prove_conv = Bin_Simprocs.prove_conv |
10722 | 44 |
val mk_bal = HOLogic.mk_binop "HOL.divide" |
45 |
val dest_bal = HOLogic.dest_bin "HOL.divide" HOLogic.realT |
|
46 |
val cancel = real_mult_div_cancel1 RS trans |
|
47 |
val neg_exchanges = false |
|
48 |
) |
|
49 |
||
50 |
structure EqCancelNumeralFactor = CancelNumeralFactorFun |
|
51 |
(open CancelNumeralFactorCommon |
|
13485
acf39e924091
tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents:
13462
diff
changeset
|
52 |
val prove_conv = Bin_Simprocs.prove_conv |
10722 | 53 |
val mk_bal = HOLogic.mk_eq |
54 |
val dest_bal = HOLogic.dest_bin "op =" HOLogic.realT |
|
55 |
val cancel = real_mult_eq_cancel1 RS trans |
|
56 |
val neg_exchanges = false |
|
57 |
) |
|
58 |
||
59 |
structure LessCancelNumeralFactor = CancelNumeralFactorFun |
|
60 |
(open CancelNumeralFactorCommon |
|
13485
acf39e924091
tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents:
13462
diff
changeset
|
61 |
val prove_conv = Bin_Simprocs.prove_conv |
10722 | 62 |
val mk_bal = HOLogic.mk_binrel "op <" |
63 |
val dest_bal = HOLogic.dest_bin "op <" HOLogic.realT |
|
64 |
val cancel = real_mult_less_cancel1 RS trans |
|
65 |
val neg_exchanges = true |
|
66 |
) |
|
67 |
||
68 |
structure LeCancelNumeralFactor = CancelNumeralFactorFun |
|
69 |
(open CancelNumeralFactorCommon |
|
13485
acf39e924091
tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents:
13462
diff
changeset
|
70 |
val prove_conv = Bin_Simprocs.prove_conv |
10722 | 71 |
val mk_bal = HOLogic.mk_binrel "op <=" |
72 |
val dest_bal = HOLogic.dest_bin "op <=" HOLogic.realT |
|
73 |
val cancel = real_mult_le_cancel1 RS trans |
|
74 |
val neg_exchanges = true |
|
75 |
) |
|
76 |
||
13462 | 77 |
val real_cancel_numeral_factors_relations = |
10722 | 78 |
map prep_simproc |
79 |
[("realeq_cancel_numeral_factor", |
|
13462 | 80 |
["(l::real) * m = n", "(l::real) = m * n"], |
10722 | 81 |
EqCancelNumeralFactor.proc), |
13462 | 82 |
("realless_cancel_numeral_factor", |
83 |
["(l::real) * m < n", "(l::real) < m * n"], |
|
10722 | 84 |
LessCancelNumeralFactor.proc), |
13462 | 85 |
("realle_cancel_numeral_factor", |
86 |
["(l::real) * m <= n", "(l::real) <= m * n"], |
|
12018
ec054019c910
Numerals and simprocs for types real and hypreal. The abstract
paulson
parents:
11704
diff
changeset
|
87 |
LeCancelNumeralFactor.proc)] |
10752
c4f1bf2acf4c
tidying, and separation of HOL-Hyperreal from HOL-Real
paulson
parents:
10722
diff
changeset
|
88 |
|
c4f1bf2acf4c
tidying, and separation of HOL-Hyperreal from HOL-Real
paulson
parents:
10722
diff
changeset
|
89 |
val real_cancel_numeral_factors_divide = prep_simproc |
13462 | 90 |
("realdiv_cancel_numeral_factor", |
91 |
["((l::real) * m) / n", "(l::real) / (m * n)", |
|
92 |
"((number_of v)::real) / (number_of w)"], |
|
93 |
DivCancelNumeralFactor.proc) |
|
10752
c4f1bf2acf4c
tidying, and separation of HOL-Hyperreal from HOL-Real
paulson
parents:
10722
diff
changeset
|
94 |
|
13462 | 95 |
val real_cancel_numeral_factors = |
96 |
real_cancel_numeral_factors_relations @ |
|
12018
ec054019c910
Numerals and simprocs for types real and hypreal. The abstract
paulson
parents:
11704
diff
changeset
|
97 |
[real_cancel_numeral_factors_divide] |
10722 | 98 |
|
99 |
end; |
|
100 |
||
101 |
Addsimprocs real_cancel_numeral_factors; |
|
102 |
||
103 |
||
104 |
(*examples: |
|
105 |
print_depth 22; |
|
106 |
set timing; |
|
107 |
set trace_simp; |
|
13462 | 108 |
fun test s = (Goal s; by (Simp_tac 1)); |
10722 | 109 |
|
12018
ec054019c910
Numerals and simprocs for types real and hypreal. The abstract
paulson
parents:
11704
diff
changeset
|
110 |
test "0 <= (y::real) * -2"; |
11704
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
111 |
test "9*x = 12 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
112 |
test "(9*x) / (12 * (y::real)) = z"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
113 |
test "9*x < 12 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
114 |
test "9*x <= 12 * (y::real)"; |
10722 | 115 |
|
11704
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
116 |
test "-99*x = 132 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
117 |
test "(-99*x) / (132 * (y::real)) = z"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
118 |
test "-99*x < 132 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
119 |
test "-99*x <= 132 * (y::real)"; |
10722 | 120 |
|
11704
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
121 |
test "999*x = -396 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
122 |
test "(999*x) / (-396 * (y::real)) = z"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
123 |
test "999*x < -396 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
124 |
test "999*x <= -396 * (y::real)"; |
10722 | 125 |
|
12018
ec054019c910
Numerals and simprocs for types real and hypreal. The abstract
paulson
parents:
11704
diff
changeset
|
126 |
test "(- ((2::real) * x) <= 2 * y)"; |
11704
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
127 |
test "-99*x = -81 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
128 |
test "(-99*x) / (-81 * (y::real)) = z"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
129 |
test "-99*x <= -81 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
130 |
test "-99*x < -81 * (y::real)"; |
10722 | 131 |
|
11704
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
132 |
test "-2 * x = -1 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
133 |
test "-2 * x = -(y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
134 |
test "(-2 * x) / (-1 * (y::real)) = z"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
135 |
test "-2 * x < -(y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
136 |
test "-2 * x <= -1 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
137 |
test "-x < -23 * (y::real)"; |
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents:
11701
diff
changeset
|
138 |
test "-x <= -23 * (y::real)"; |
10722 | 139 |
*) |
140 |
||
141 |
||
142 |
(** Declarations for ExtractCommonTerm **) |
|
143 |
||
144 |
local |
|
145 |
open Real_Numeral_Simprocs |
|
146 |
in |
|
147 |
||
148 |
structure CancelFactorCommon = |
|
149 |
struct |
|
13462 | 150 |
val mk_sum = long_mk_prod |
151 |
val dest_sum = dest_prod |
|
152 |
val mk_coeff = mk_coeff |
|
153 |
val dest_coeff = dest_coeff |
|
154 |
val find_first = find_first [] |
|
10722 | 155 |
val trans_tac = trans_tac |
156 |
val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@real_mult_ac)) |
|
157 |
end; |
|
158 |
||
159 |
structure EqCancelFactor = ExtractCommonTermFun |
|
160 |
(open CancelFactorCommon |
|
13485
acf39e924091
tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents:
13462
diff
changeset
|
161 |
val prove_conv = Bin_Simprocs.prove_conv |
10722 | 162 |
val mk_bal = HOLogic.mk_eq |
163 |
val dest_bal = HOLogic.dest_bin "op =" HOLogic.realT |
|
164 |
val simplify_meta_eq = cancel_simplify_meta_eq real_mult_eq_cancel1 |
|
165 |
); |
|
166 |
||
167 |
||
168 |
structure DivideCancelFactor = ExtractCommonTermFun |
|
169 |
(open CancelFactorCommon |
|
13485
acf39e924091
tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents:
13462
diff
changeset
|
170 |
val prove_conv = Bin_Simprocs.prove_conv |
10722 | 171 |
val mk_bal = HOLogic.mk_binop "HOL.divide" |
172 |
val dest_bal = HOLogic.dest_bin "HOL.divide" HOLogic.realT |
|
173 |
val simplify_meta_eq = cancel_simplify_meta_eq real_mult_div_cancel_disj |
|
174 |
); |
|
175 |
||
13462 | 176 |
val real_cancel_factor = |
10722 | 177 |
map prep_simproc |
13462 | 178 |
[("real_eq_cancel_factor", ["(l::real) * m = n", "(l::real) = m * n"], EqCancelFactor.proc), |
179 |
("real_divide_cancel_factor", ["((l::real) * m) / n", "(l::real) / (m * n)"], |
|
10722 | 180 |
DivideCancelFactor.proc)]; |
181 |
||
182 |
end; |
|
183 |
||
184 |
Addsimprocs real_cancel_factor; |
|
185 |
||
186 |
||
187 |
(*examples: |
|
188 |
print_depth 22; |
|
189 |
set timing; |
|
190 |
set trace_simp; |
|
13462 | 191 |
fun test s = (Goal s; by (Asm_simp_tac 1)); |
10722 | 192 |
|
193 |
test "x*k = k*(y::real)"; |
|
13462 | 194 |
test "k = k*(y::real)"; |
10722 | 195 |
test "a*(b*c) = (b::real)"; |
196 |
test "a*(b*c) = d*(b::real)*(x*a)"; |
|
197 |
||
198 |
||
199 |
test "(x*k) / (k*(y::real)) = (uu::real)"; |
|
13462 | 200 |
test "(k) / (k*(y::real)) = (uu::real)"; |
10722 | 201 |
test "(a*(b*c)) / ((b::real)) = (uu::real)"; |
202 |
test "(a*(b*c)) / (d*(b::real)*(x*a)) = (uu::real)"; |
|
203 |
||
204 |
(*FIXME: what do we do about this?*) |
|
205 |
test "a*(b*c)/(y*z) = d*(b::real)*(x*a)/z"; |
|
206 |
*) |
|
207 |
||
14284
f1abe67c448a
re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents:
14277
diff
changeset
|
208 |
val real_inverse_less_iff = thm"real_inverse_less_iff"; |
f1abe67c448a
re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents:
14277
diff
changeset
|
209 |
val real_inverse_le_iff = thm"real_inverse_le_iff"; |
10722 | 210 |
|
14288 | 211 |
val pos_real_less_divide_eq = thm"pos_less_divide_eq"; |
212 |
val pos_real_divide_less_eq = thm"pos_divide_less_eq"; |
|
213 |
val pos_real_le_divide_eq = thm"pos_le_divide_eq"; |
|
214 |
val pos_real_divide_le_eq = thm"pos_divide_le_eq"; |