(* Title: HOL/Real/real_arith0.ML
ID: $Id$
Author: Tobias Nipkow, TU Muenchen
Copyright 1999 TU Muenchen
Simprocs for common factor cancellation & Rational coefficient handling
Instantiation of the generic linear arithmetic package for type real.
*)
(****Common factor cancellation****)
(*To quote from Provers/Arith/cancel_numeral_factor.ML:
This simproc Cancels common coefficients in balanced expressions:
u*#m ~~ u'*#m' == #n*u ~~ #n'*u'
where ~~ is an appropriate balancing operation (e.g. =, <=, <, div, /)
and d = gcd(m,m') and n=m/d and n'=m'/d.
*)
local
open Real_Numeral_Simprocs
in
val rel_real_number_of = [eq_real_number_of, less_real_number_of,
le_real_number_of_eq_not_less]
structure CancelNumeralFactorCommon =
struct
val mk_coeff = mk_coeff
val dest_coeff = dest_coeff 1
val trans_tac = trans_tac
val norm_tac =
ALLGOALS (simp_tac (HOL_ss addsimps real_minus_from_mult_simps @ mult_1s))
THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@real_mult_minus_simps))
THEN ALLGOALS (simp_tac (HOL_ss addsimps mult_ac))
val numeral_simp_tac =
ALLGOALS (simp_tac (HOL_ss addsimps rel_real_number_of@bin_simps))
val simplify_meta_eq = simplify_meta_eq
end
structure DivCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
val prove_conv = Bin_Simprocs.prove_conv
val mk_bal = HOLogic.mk_binop "HOL.divide"
val dest_bal = HOLogic.dest_bin "HOL.divide" HOLogic.realT
val cancel = mult_divide_cancel_left RS trans
val neg_exchanges = false
)
structure EqCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
val prove_conv = Bin_Simprocs.prove_conv
val mk_bal = HOLogic.mk_eq
val dest_bal = HOLogic.dest_bin "op =" HOLogic.realT
val cancel = mult_cancel_left RS trans
val neg_exchanges = false
)
structure LessCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
val prove_conv = Bin_Simprocs.prove_conv
val mk_bal = HOLogic.mk_binrel "op <"
val dest_bal = HOLogic.dest_bin "op <" HOLogic.realT
val cancel = mult_less_cancel_left RS trans
val neg_exchanges = true
)
structure LeCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
val prove_conv = Bin_Simprocs.prove_conv
val mk_bal = HOLogic.mk_binrel "op <="
val dest_bal = HOLogic.dest_bin "op <=" HOLogic.realT
val cancel = mult_le_cancel_left RS trans
val neg_exchanges = true
)
val real_cancel_numeral_factors_relations =
map prep_simproc
[("realeq_cancel_numeral_factor",
["(l::real) * m = n", "(l::real) = m * n"],
EqCancelNumeralFactor.proc),
("realless_cancel_numeral_factor",
["(l::real) * m < n", "(l::real) < m * n"],
LessCancelNumeralFactor.proc),
("realle_cancel_numeral_factor",
["(l::real) * m <= n", "(l::real) <= m * n"],
LeCancelNumeralFactor.proc)]
val real_cancel_numeral_factors_divide = prep_simproc
("realdiv_cancel_numeral_factor",
["((l::real) * m) / n", "(l::real) / (m * n)",
"((number_of v)::real) / (number_of w)"],
DivCancelNumeralFactor.proc)
val real_cancel_numeral_factors =
real_cancel_numeral_factors_relations @
[real_cancel_numeral_factors_divide]
end;
Addsimprocs real_cancel_numeral_factors;
(*examples:
print_depth 22;
set timing;
set trace_simp;
fun test s = (Goal s; by (Simp_tac 1));
test "0 <= (y::real) * -2";
test "9*x = 12 * (y::real)";
test "(9*x) / (12 * (y::real)) = z";
test "9*x < 12 * (y::real)";
test "9*x <= 12 * (y::real)";
test "-99*x = 132 * (y::real)";
test "(-99*x) / (132 * (y::real)) = z";
test "-99*x < 132 * (y::real)";
test "-99*x <= 132 * (y::real)";
test "999*x = -396 * (y::real)";
test "(999*x) / (-396 * (y::real)) = z";
test "999*x < -396 * (y::real)";
test "999*x <= -396 * (y::real)";
test "(- ((2::real) * x) <= 2 * y)";
test "-99*x = -81 * (y::real)";
test "(-99*x) / (-81 * (y::real)) = z";
test "-99*x <= -81 * (y::real)";
test "-99*x < -81 * (y::real)";
test "-2 * x = -1 * (y::real)";
test "-2 * x = -(y::real)";
test "(-2 * x) / (-1 * (y::real)) = z";
test "-2 * x < -(y::real)";
test "-2 * x <= -1 * (y::real)";
test "-x < -23 * (y::real)";
test "-x <= -23 * (y::real)";
*)
(** Declarations for ExtractCommonTerm **)
local
open Real_Numeral_Simprocs
in
structure CancelFactorCommon =
struct
val mk_sum = long_mk_prod
val dest_sum = dest_prod
val mk_coeff = mk_coeff
val dest_coeff = dest_coeff
val find_first = find_first []
val trans_tac = trans_tac
val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@mult_ac))
end;
structure EqCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
val prove_conv = Bin_Simprocs.prove_conv
val mk_bal = HOLogic.mk_eq
val dest_bal = HOLogic.dest_bin "op =" HOLogic.realT
val simplify_meta_eq = cancel_simplify_meta_eq mult_cancel_left
);
structure DivideCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
val prove_conv = Bin_Simprocs.prove_conv
val mk_bal = HOLogic.mk_binop "HOL.divide"
val dest_bal = HOLogic.dest_bin "HOL.divide" HOLogic.realT
val simplify_meta_eq = cancel_simplify_meta_eq mult_divide_cancel_eq_if
);
val real_cancel_factor =
map prep_simproc
[("real_eq_cancel_factor", ["(l::real) * m = n", "(l::real) = m * n"], EqCancelFactor.proc),
("real_divide_cancel_factor", ["((l::real) * m) / n", "(l::real) / (m * n)"],
DivideCancelFactor.proc)];
end;
Addsimprocs real_cancel_factor;
(*examples:
print_depth 22;
set timing;
set trace_simp;
fun test s = (Goal s; by (Asm_simp_tac 1));
test "x*k = k*(y::real)";
test "k = k*(y::real)";
test "a*(b*c) = (b::real)";
test "a*(b*c) = d*(b::real)*(x*a)";
test "(x*k) / (k*(y::real)) = (uu::real)";
test "(k) / (k*(y::real)) = (uu::real)";
test "(a*(b*c)) / ((b::real)) = (uu::real)";
test "(a*(b*c)) / (d*(b::real)*(x*a)) = (uu::real)";
(*FIXME: what do we do about this?*)
test "a*(b*c)/(y*z) = d*(b::real)*(x*a)/z";
*)
(****Instantiation of the generic linear arithmetic package****)
val add_zero_left = thm"Ring_and_Field.add_0";
val add_zero_right = thm"Ring_and_Field.add_0_right";
val real_mult_left_mono =
read_instantiate_sg(sign_of RealBin.thy) [("a","?a::real")] mult_left_mono;
local
(* reduce contradictory <= to False *)
val add_rules =
[order_less_irrefl, real_numeral_0_eq_0, real_numeral_1_eq_1,
real_minus_1_eq_m1,
add_real_number_of, minus_real_number_of, diff_real_number_of,
mult_real_number_of, eq_real_number_of, less_real_number_of,
le_real_number_of_eq_not_less, real_diff_def,
minus_add_distrib, minus_minus, mult_assoc, minus_zero,
add_zero_left, add_zero_right, left_minus, right_minus,
mult_zero_left, mult_zero_right, mult_1, mult_1_right,
minus_mult_left RS sym, minus_mult_right RS sym];
val simprocs = [Real_Times_Assoc.conv, Real_Numeral_Simprocs.combine_numerals,
real_cancel_numeral_factors_divide]@
Real_Numeral_Simprocs.cancel_numerals @
Real_Numeral_Simprocs.eval_numerals;
val mono_ss = simpset() addsimps
[add_mono,add_strict_mono,
real_add_less_le_mono,real_add_le_less_mono];
val add_mono_thms_real =
map (fn s => prove_goal (the_context ()) s
(fn prems => [cut_facts_tac prems 1, asm_simp_tac mono_ss 1]))
["(i <= j) & (k <= l) ==> i + k <= j + (l::real)",
"(i = j) & (k <= l) ==> i + k <= j + (l::real)",
"(i <= j) & (k = l) ==> i + k <= j + (l::real)",
"(i = j) & (k = l) ==> i + k = j + (l::real)",
"(i < j) & (k = l) ==> i + k < j + (l::real)",
"(i = j) & (k < l) ==> i + k < j + (l::real)",
"(i < j) & (k <= l) ==> i + k < j + (l::real)",
"(i <= j) & (k < l) ==> i + k < j + (l::real)",
"(i < j) & (k < l) ==> i + k < j + (l::real)"];
fun cvar(th,_ $ (_ $ _ $ var)) = cterm_of (#sign(rep_thm th)) var;
val real_mult_mono_thms =
[(rotate_prems 1 real_mult_less_mono2,
cvar(real_mult_less_mono2, hd(prems_of real_mult_less_mono2))),
(real_mult_left_mono,
cvar(real_mult_left_mono, hd(tl(prems_of real_mult_left_mono))))]
(* reduce contradictory <= to False *)
val simps = [True_implies_equals,
inst "a" "(number_of ?v)::real" right_distrib,
divide_1,times_divide_eq_right,times_divide_eq_left];
in
val fast_real_arith_simproc = Simplifier.simproc (Theory.sign_of (the_context ()))
"fast_real_arith" ["(m::real) < n","(m::real) <= n", "(m::real) = n"]
Fast_Arith.lin_arith_prover;
val real_arith_setup =
[Fast_Arith.map_data (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, simpset} =>
{add_mono_thms = add_mono_thms @ add_mono_thms_real,
mult_mono_thms = mult_mono_thms @ real_mult_mono_thms,
inj_thms = inj_thms, (*FIXME: add real*)
lessD = lessD, (*Can't change LA_Data_Ref.lessD: the reals are dense!*)
simpset = simpset addsimps add_rules
addsimps simps
addsimprocs simprocs}),
arith_discrete ("RealDef.real",false),
Simplifier.change_simpset_of (op addsimprocs) [fast_real_arith_simproc]];
(* some thms for injection nat => real:
real_of_nat_zero
?zero_eq_numeral_0
real_of_nat_add
*)
end;
(* Some test data [omitting examples that assume the ordering to be discrete!]
Goal "!!a::real. [| a <= b; c <= d; x+y<z |] ==> a+c <= b+d";
by (fast_arith_tac 1);
qed "";
Goal "!!a::real. [| a <= b; b+b <= c |] ==> a+a <= c";
by (fast_arith_tac 1);
qed "";
Goal "!!a::real. [| a+b <= i+j; a<=b; i<=j |] ==> a+a <= j+j";
by (fast_arith_tac 1);
qed "";
Goal "!!a::real. a+b+c <= i+j+k & a<=b & b<=c & i<=j & j<=k --> a+a+a <= k+k+k";
by (arith_tac 1);
qed "";
Goal "!!a::real. [| a+b+c+d <= i+j+k+l; a<=b; b<=c; c<=d; i<=j; j<=k; k<=l |] \
\ ==> a <= l";
by (fast_arith_tac 1);
qed "";
Goal "!!a::real. [| a+b+c+d <= i+j+k+l; a<=b; b<=c; c<=d; i<=j; j<=k; k<=l |] \
\ ==> a+a+a+a <= l+l+l+l";
by (fast_arith_tac 1);
qed "";
Goal "!!a::real. [| a+b+c+d <= i+j+k+l; a<=b; b<=c; c<=d; i<=j; j<=k; k<=l |] \
\ ==> a+a+a+a+a <= l+l+l+l+i";
by (fast_arith_tac 1);
qed "";
Goal "!!a::real. [| a+b+c+d <= i+j+k+l; a<=b; b<=c; c<=d; i<=j; j<=k; k<=l |] \
\ ==> a+a+a+a+a+a <= l+l+l+l+i+l";
by (fast_arith_tac 1);
qed "";
Goal "!!a::real. [| a+b+c+d <= i+j+k+l; a<=b; b<=c; c<=d; i<=j; j<=k; k<=l |] \
\ ==> 6*a <= 5*l+i";
by (fast_arith_tac 1);
qed "";
Goal "a<=b ==> a < b+(1::real)";
by (fast_arith_tac 1);
qed "";
Goal "a<=b ==> a-(3::real) < b";
by (fast_arith_tac 1);
qed "";
Goal "a<=b ==> a-(1::real) < b";
by (fast_arith_tac 1);
qed "";
*)