14326
|
1 |
(* Title: hcomplex_arith.ML
|
|
2 |
Author: Jacques D. Fleuriot
|
|
3 |
Copyright: 2001 University of Edinburgh
|
|
4 |
|
|
5 |
Common factor cancellation
|
|
6 |
*)
|
|
7 |
|
|
8 |
local
|
|
9 |
open HComplex_Numeral_Simprocs
|
|
10 |
in
|
|
11 |
|
|
12 |
val rel_hcomplex_number_of = [eq_hcomplex_number_of];
|
|
13 |
|
|
14 |
|
|
15 |
structure CancelNumeralFactorCommon =
|
|
16 |
struct
|
|
17 |
val mk_coeff = mk_coeff
|
|
18 |
val dest_coeff = dest_coeff 1
|
|
19 |
val trans_tac = Real_Numeral_Simprocs.trans_tac
|
|
20 |
val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps hcomplex_minus_from_mult_simps @ mult_1s))
|
|
21 |
THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@hcomplex_mult_minus_simps))
|
14335
|
22 |
THEN ALLGOALS (simp_tac (HOL_ss addsimps mult_ac))
|
14326
|
23 |
val numeral_simp_tac =
|
|
24 |
ALLGOALS (simp_tac (HOL_ss addsimps rel_hcomplex_number_of@bin_simps))
|
|
25 |
val simplify_meta_eq = simplify_meta_eq
|
|
26 |
end
|
|
27 |
|
|
28 |
|
|
29 |
structure DivCancelNumeralFactor = CancelNumeralFactorFun
|
|
30 |
(open CancelNumeralFactorCommon
|
|
31 |
val prove_conv = Bin_Simprocs.prove_conv
|
|
32 |
val mk_bal = HOLogic.mk_binop "HOL.divide"
|
|
33 |
val dest_bal = HOLogic.dest_bin "HOL.divide" hcomplexT
|
|
34 |
val cancel = mult_divide_cancel_left RS trans
|
|
35 |
val neg_exchanges = false
|
|
36 |
)
|
|
37 |
|
|
38 |
|
|
39 |
structure EqCancelNumeralFactor = CancelNumeralFactorFun
|
|
40 |
(open CancelNumeralFactorCommon
|
|
41 |
val prove_conv = Bin_Simprocs.prove_conv
|
|
42 |
val mk_bal = HOLogic.mk_eq
|
|
43 |
val dest_bal = HOLogic.dest_bin "op =" hcomplexT
|
|
44 |
val cancel = field_mult_cancel_left RS trans
|
|
45 |
val neg_exchanges = false
|
|
46 |
)
|
|
47 |
|
|
48 |
|
|
49 |
val hcomplex_cancel_numeral_factors_relations =
|
|
50 |
map prep_simproc
|
|
51 |
[("hcomplexeq_cancel_numeral_factor",
|
|
52 |
["(l::hcomplex) * m = n", "(l::hcomplex) = m * n"],
|
|
53 |
EqCancelNumeralFactor.proc)];
|
|
54 |
|
|
55 |
val hcomplex_cancel_numeral_factors_divide = prep_simproc
|
|
56 |
("hcomplexdiv_cancel_numeral_factor",
|
|
57 |
["((l::hcomplex) * m) / n", "(l::hcomplex) / (m * n)",
|
|
58 |
"((number_of v)::hcomplex) / (number_of w)"],
|
|
59 |
DivCancelNumeralFactor.proc);
|
|
60 |
|
|
61 |
val hcomplex_cancel_numeral_factors =
|
|
62 |
hcomplex_cancel_numeral_factors_relations @
|
|
63 |
[hcomplex_cancel_numeral_factors_divide];
|
|
64 |
|
|
65 |
end;
|
|
66 |
|
|
67 |
|
|
68 |
Addsimprocs hcomplex_cancel_numeral_factors;
|
|
69 |
|
|
70 |
|
|
71 |
(*examples:
|
|
72 |
print_depth 22;
|
|
73 |
set timing;
|
|
74 |
set trace_simp;
|
|
75 |
fun test s = (Goal s; by (Simp_tac 1));
|
|
76 |
|
|
77 |
|
|
78 |
test "#9*x = #12 * (y::hcomplex)";
|
|
79 |
test "(#9*x) / (#12 * (y::hcomplex)) = z";
|
|
80 |
|
|
81 |
test "#-99*x = #132 * (y::hcomplex)";
|
|
82 |
|
|
83 |
test "#999*x = #-396 * (y::hcomplex)";
|
|
84 |
test "(#999*x) / (#-396 * (y::hcomplex)) = z";
|
|
85 |
|
|
86 |
test "#-99*x = #-81 * (y::hcomplex)";
|
|
87 |
test "(#-99*x) / (#-81 * (y::hcomplex)) = z";
|
|
88 |
|
|
89 |
test "#-2 * x = #-1 * (y::hcomplex)";
|
|
90 |
test "#-2 * x = -(y::hcomplex)";
|
|
91 |
test "(#-2 * x) / (#-1 * (y::hcomplex)) = z";
|
|
92 |
|
|
93 |
*)
|
|
94 |
|
|
95 |
|
|
96 |
(** Declarations for ExtractCommonTerm **)
|
|
97 |
|
|
98 |
local
|
|
99 |
open HComplex_Numeral_Simprocs
|
|
100 |
in
|
|
101 |
|
|
102 |
structure CancelFactorCommon =
|
|
103 |
struct
|
|
104 |
val mk_sum = long_mk_prod
|
|
105 |
val dest_sum = dest_prod
|
|
106 |
val mk_coeff = mk_coeff
|
|
107 |
val dest_coeff = dest_coeff
|
|
108 |
val find_first = find_first []
|
|
109 |
val trans_tac = Real_Numeral_Simprocs.trans_tac
|
14335
|
110 |
val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@mult_ac))
|
14326
|
111 |
end;
|
|
112 |
|
|
113 |
|
|
114 |
structure EqCancelFactor = ExtractCommonTermFun
|
|
115 |
(open CancelFactorCommon
|
|
116 |
val prove_conv = Bin_Simprocs.prove_conv
|
|
117 |
val mk_bal = HOLogic.mk_eq
|
|
118 |
val dest_bal = HOLogic.dest_bin "op =" hcomplexT
|
|
119 |
val simplify_meta_eq = cancel_simplify_meta_eq field_mult_cancel_left
|
|
120 |
);
|
|
121 |
|
|
122 |
|
|
123 |
structure DivideCancelFactor = ExtractCommonTermFun
|
|
124 |
(open CancelFactorCommon
|
|
125 |
val prove_conv = Bin_Simprocs.prove_conv
|
|
126 |
val mk_bal = HOLogic.mk_binop "HOL.divide"
|
|
127 |
val dest_bal = HOLogic.dest_bin "HOL.divide" hcomplexT
|
|
128 |
val simplify_meta_eq = cancel_simplify_meta_eq mult_divide_cancel_eq_if
|
|
129 |
);
|
|
130 |
|
|
131 |
val hcomplex_cancel_factor =
|
|
132 |
map prep_simproc
|
|
133 |
[("hcomplex_eq_cancel_factor", ["(l::hcomplex) * m = n", "(l::hcomplex) = m * n"],
|
|
134 |
EqCancelFactor.proc),
|
|
135 |
("hcomplex_divide_cancel_factor", ["((l::hcomplex) * m) / n", "(l::hcomplex) / (m * n)"],
|
|
136 |
DivideCancelFactor.proc)];
|
|
137 |
|
|
138 |
end;
|
|
139 |
|
|
140 |
Addsimprocs hcomplex_cancel_factor;
|
|
141 |
|
|
142 |
|
|
143 |
(*examples:
|
|
144 |
print_depth 22;
|
|
145 |
set timing;
|
|
146 |
set trace_simp;
|
|
147 |
fun test s = (Goal s; by (Asm_simp_tac 1));
|
|
148 |
|
|
149 |
test "x*k = k*(y::hcomplex)";
|
|
150 |
test "k = k*(y::hcomplex)";
|
|
151 |
test "a*(b*c) = (b::hcomplex)";
|
|
152 |
test "a*(b*c) = d*(b::hcomplex)*(x*a)";
|
|
153 |
|
|
154 |
|
|
155 |
test "(x*k) / (k*(y::hcomplex)) = (uu::hcomplex)";
|
|
156 |
test "(k) / (k*(y::hcomplex)) = (uu::hcomplex)";
|
|
157 |
test "(a*(b*c)) / ((b::hcomplex)) = (uu::hcomplex)";
|
|
158 |
test "(a*(b*c)) / (d*(b::hcomplex)*(x*a)) = (uu::hcomplex)";
|
|
159 |
|
|
160 |
(*FIXME: what do we do about this?*)
|
|
161 |
test "a*(b*c)/(y*z) = d*(b::hcomplex)*(x*a)/z";
|
|
162 |
*)
|
|
163 |
|
|
164 |
|