author | kleing |
Wed, 07 Jan 2004 07:52:12 +0100 | |
changeset 14343 | 6bc647f472b9 |
parent 14334 | 6137d24eef79 |
child 14352 | a8b1a44d8264 |
permissions | -rw-r--r-- |
14309 | 1 |
(* Title: HOL/Hyperreal/hypreal_arith.ML |
10751 | 2 |
ID: $Id$ |
3 |
Author: Tobias Nipkow, TU Muenchen |
|
4 |
Copyright 1999 TU Muenchen |
|
5 |
||
14309 | 6 |
Simprocs: Common factor cancellation & Rational coefficient handling |
10751 | 7 |
*) |
8 |
||
14309 | 9 |
(****Common factor cancellation****) |
10 |
||
11 |
local |
|
12 |
open Hyperreal_Numeral_Simprocs |
|
13 |
in |
|
14 |
||
15 |
val rel_hypreal_number_of = [eq_hypreal_number_of, less_hypreal_number_of, |
|
16 |
le_hypreal_number_of_eq_not_less]; |
|
17 |
||
18 |
structure CancelNumeralFactorCommon = |
|
19 |
struct |
|
20 |
val mk_coeff = mk_coeff |
|
21 |
val dest_coeff = dest_coeff 1 |
|
22 |
val trans_tac = Real_Numeral_Simprocs.trans_tac |
|
23 |
val norm_tac = |
|
24 |
ALLGOALS (simp_tac (HOL_ss addsimps hypreal_minus_from_mult_simps @ mult_1s)) |
|
25 |
THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@hypreal_mult_minus_simps)) |
|
14331 | 26 |
THEN ALLGOALS (simp_tac (HOL_ss addsimps mult_ac)) |
14309 | 27 |
val numeral_simp_tac = |
28 |
ALLGOALS (simp_tac (HOL_ss addsimps rel_hypreal_number_of@bin_simps)) |
|
29 |
val simplify_meta_eq = simplify_meta_eq |
|
30 |
end |
|
31 |
||
32 |
structure DivCancelNumeralFactor = CancelNumeralFactorFun |
|
33 |
(open CancelNumeralFactorCommon |
|
34 |
val prove_conv = Bin_Simprocs.prove_conv |
|
35 |
val mk_bal = HOLogic.mk_binop "HOL.divide" |
|
36 |
val dest_bal = HOLogic.dest_bin "HOL.divide" hyprealT |
|
37 |
val cancel = mult_divide_cancel_left RS trans |
|
38 |
val neg_exchanges = false |
|
39 |
) |
|
40 |
||
41 |
structure EqCancelNumeralFactor = CancelNumeralFactorFun |
|
42 |
(open CancelNumeralFactorCommon |
|
43 |
val prove_conv = Bin_Simprocs.prove_conv |
|
44 |
val mk_bal = HOLogic.mk_eq |
|
45 |
val dest_bal = HOLogic.dest_bin "op =" hyprealT |
|
46 |
val cancel = mult_cancel_left RS trans |
|
47 |
val neg_exchanges = false |
|
48 |
) |
|
49 |
||
50 |
structure LessCancelNumeralFactor = CancelNumeralFactorFun |
|
51 |
(open CancelNumeralFactorCommon |
|
52 |
val prove_conv = Bin_Simprocs.prove_conv |
|
53 |
val mk_bal = HOLogic.mk_binrel "op <" |
|
54 |
val dest_bal = HOLogic.dest_bin "op <" hyprealT |
|
55 |
val cancel = mult_less_cancel_left RS trans |
|
56 |
val neg_exchanges = true |
|
57 |
) |
|
58 |
||
59 |
structure LeCancelNumeralFactor = CancelNumeralFactorFun |
|
60 |
(open CancelNumeralFactorCommon |
|
61 |
val prove_conv = Bin_Simprocs.prove_conv |
|
62 |
val mk_bal = HOLogic.mk_binrel "op <=" |
|
63 |
val dest_bal = HOLogic.dest_bin "op <=" hyprealT |
|
64 |
val cancel = mult_le_cancel_left RS trans |
|
65 |
val neg_exchanges = true |
|
66 |
) |
|
67 |
||
68 |
val hypreal_cancel_numeral_factors_relations = |
|
69 |
map prep_simproc |
|
70 |
[("hyprealeq_cancel_numeral_factor", |
|
71 |
["(l::hypreal) * m = n", "(l::hypreal) = m * n"], |
|
72 |
EqCancelNumeralFactor.proc), |
|
73 |
("hyprealless_cancel_numeral_factor", |
|
74 |
["(l::hypreal) * m < n", "(l::hypreal) < m * n"], |
|
75 |
LessCancelNumeralFactor.proc), |
|
76 |
("hyprealle_cancel_numeral_factor", |
|
77 |
["(l::hypreal) * m <= n", "(l::hypreal) <= m * n"], |
|
78 |
LeCancelNumeralFactor.proc)]; |
|
79 |
||
80 |
val hypreal_cancel_numeral_factors_divide = prep_simproc |
|
81 |
("hyprealdiv_cancel_numeral_factor", |
|
82 |
["((l::hypreal) * m) / n", "(l::hypreal) / (m * n)", |
|
83 |
"((number_of v)::hypreal) / (number_of w)"], |
|
84 |
DivCancelNumeralFactor.proc); |
|
85 |
||
86 |
val hypreal_cancel_numeral_factors = |
|
87 |
hypreal_cancel_numeral_factors_relations @ |
|
88 |
[hypreal_cancel_numeral_factors_divide]; |
|
89 |
||
90 |
end; |
|
91 |
||
92 |
Addsimprocs hypreal_cancel_numeral_factors; |
|
93 |
||
94 |
||
95 |
(*examples: |
|
96 |
print_depth 22; |
|
97 |
set timing; |
|
98 |
set trace_simp; |
|
99 |
fun test s = (Goal s; by (Simp_tac 1)); |
|
100 |
||
101 |
test "0 <= (y::hypreal) * -2"; |
|
102 |
test "9*x = 12 * (y::hypreal)"; |
|
103 |
test "(9*x) / (12 * (y::hypreal)) = z"; |
|
104 |
test "9*x < 12 * (y::hypreal)"; |
|
105 |
test "9*x <= 12 * (y::hypreal)"; |
|
106 |
||
107 |
test "-99*x = 123 * (y::hypreal)"; |
|
108 |
test "(-99*x) / (123 * (y::hypreal)) = z"; |
|
109 |
test "-99*x < 123 * (y::hypreal)"; |
|
110 |
test "-99*x <= 123 * (y::hypreal)"; |
|
111 |
||
112 |
test "999*x = -396 * (y::hypreal)"; |
|
113 |
test "(999*x) / (-396 * (y::hypreal)) = z"; |
|
114 |
test "999*x < -396 * (y::hypreal)"; |
|
115 |
test "999*x <= -396 * (y::hypreal)"; |
|
116 |
||
117 |
test "-99*x = -81 * (y::hypreal)"; |
|
118 |
test "(-99*x) / (-81 * (y::hypreal)) = z"; |
|
119 |
test "-99*x <= -81 * (y::hypreal)"; |
|
120 |
test "-99*x < -81 * (y::hypreal)"; |
|
121 |
||
122 |
test "-2 * x = -1 * (y::hypreal)"; |
|
123 |
test "-2 * x = -(y::hypreal)"; |
|
124 |
test "(-2 * x) / (-1 * (y::hypreal)) = z"; |
|
125 |
test "-2 * x < -(y::hypreal)"; |
|
126 |
test "-2 * x <= -1 * (y::hypreal)"; |
|
127 |
test "-x < -23 * (y::hypreal)"; |
|
128 |
test "-x <= -23 * (y::hypreal)"; |
|
129 |
*) |
|
130 |
||
131 |
||
132 |
(** Declarations for ExtractCommonTerm **) |
|
133 |
||
134 |
local |
|
135 |
open Hyperreal_Numeral_Simprocs |
|
136 |
in |
|
137 |
||
138 |
structure CancelFactorCommon = |
|
139 |
struct |
|
140 |
val mk_sum = long_mk_prod |
|
141 |
val dest_sum = dest_prod |
|
142 |
val mk_coeff = mk_coeff |
|
143 |
val dest_coeff = dest_coeff |
|
144 |
val find_first = find_first [] |
|
145 |
val trans_tac = Real_Numeral_Simprocs.trans_tac |
|
14331 | 146 |
val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@mult_ac)) |
14309 | 147 |
end; |
148 |
||
149 |
structure EqCancelFactor = ExtractCommonTermFun |
|
150 |
(open CancelFactorCommon |
|
151 |
val prove_conv = Bin_Simprocs.prove_conv |
|
152 |
val mk_bal = HOLogic.mk_eq |
|
153 |
val dest_bal = HOLogic.dest_bin "op =" hyprealT |
|
154 |
val simplify_meta_eq = cancel_simplify_meta_eq mult_cancel_left |
|
155 |
); |
|
156 |
||
157 |
||
158 |
structure DivideCancelFactor = ExtractCommonTermFun |
|
159 |
(open CancelFactorCommon |
|
160 |
val prove_conv = Bin_Simprocs.prove_conv |
|
161 |
val mk_bal = HOLogic.mk_binop "HOL.divide" |
|
162 |
val dest_bal = HOLogic.dest_bin "HOL.divide" hyprealT |
|
163 |
val simplify_meta_eq = cancel_simplify_meta_eq mult_divide_cancel_eq_if |
|
164 |
); |
|
165 |
||
166 |
val hypreal_cancel_factor = |
|
167 |
map prep_simproc |
|
168 |
[("hypreal_eq_cancel_factor", ["(l::hypreal) * m = n", "(l::hypreal) = m * n"], |
|
169 |
EqCancelFactor.proc), |
|
170 |
("hypreal_divide_cancel_factor", ["((l::hypreal) * m) / n", "(l::hypreal) / (m * n)"], |
|
171 |
DivideCancelFactor.proc)]; |
|
172 |
||
173 |
end; |
|
174 |
||
175 |
Addsimprocs hypreal_cancel_factor; |
|
176 |
||
177 |
||
178 |
(*examples: |
|
179 |
print_depth 22; |
|
180 |
set timing; |
|
181 |
set trace_simp; |
|
182 |
fun test s = (Goal s; by (Asm_simp_tac 1)); |
|
183 |
||
184 |
test "x*k = k*(y::hypreal)"; |
|
185 |
test "k = k*(y::hypreal)"; |
|
186 |
test "a*(b*c) = (b::hypreal)"; |
|
187 |
test "a*(b*c) = d*(b::hypreal)*(x*a)"; |
|
188 |
||
189 |
||
190 |
test "(x*k) / (k*(y::hypreal)) = (uu::hypreal)"; |
|
191 |
test "(k) / (k*(y::hypreal)) = (uu::hypreal)"; |
|
192 |
test "(a*(b*c)) / ((b::hypreal)) = (uu::hypreal)"; |
|
193 |
test "(a*(b*c)) / (d*(b::hypreal)*(x*a)) = (uu::hypreal)"; |
|
194 |
||
195 |
(*FIXME: what do we do about this?*) |
|
196 |
test "a*(b*c)/(y*z) = d*(b::hypreal)*(x*a)/z"; |
|
197 |
*) |
|
198 |
||
199 |
||
200 |
(****Augmentation of real linear arithmetic with |
|
201 |
rational coefficient handling****) |
|
202 |
||
10751 | 203 |
local |
204 |
||
205 |
(* reduce contradictory <= to False *) |
|
14331 | 206 |
val simps = [True_implies_equals, |
207 |
inst "a" "(number_of ?v)::hypreal" right_distrib, |
|
14305
f17ca9f6dc8c
tidying first part of HyperArith0.ML, using generic lemmas
paulson
parents:
10751
diff
changeset
|
208 |
divide_1,times_divide_eq_right,times_divide_eq_left]; |
10751 | 209 |
|
210 |
val simprocs = [hypreal_cancel_numeral_factors_divide]; |
|
211 |
||
212 |
fun cvar(th,_ $ (_ $ _ $ var)) = cterm_of (#sign(rep_thm th)) var; |
|
213 |
||
214 |
val hypreal_mult_mono_thms = |
|
215 |
[(rotate_prems 1 hypreal_mult_less_mono2, |
|
216 |
cvar(hypreal_mult_less_mono2, hd(prems_of hypreal_mult_less_mono2))), |
|
14334 | 217 |
(mult_left_mono, |
218 |
cvar(mult_left_mono, hd(tl(prems_of mult_left_mono))))] |
|
10751 | 219 |
|
220 |
in |
|
221 |
||
222 |
val hypreal_arith_setup = |
|
223 |
[Fast_Arith.map_data (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, simpset} => |
|
224 |
{add_mono_thms = add_mono_thms, |
|
225 |
mult_mono_thms = mult_mono_thms @ hypreal_mult_mono_thms, |
|
226 |
inj_thms = inj_thms, |
|
227 |
lessD = lessD, |
|
228 |
simpset = simpset addsimps simps addsimprocs simprocs})]; |
|
229 |
||
230 |
end; |
|
231 |
||
232 |
(* |
|
233 |
Procedure "assoc_fold" needed? |
|
234 |
*) |