neuper@37906
|
1 |
(*.(c) by Richard Lang, 2003 .*)
|
neuper@37906
|
2 |
(* collecting all knowledge for Root Equations
|
neuper@37906
|
3 |
created by: rlang
|
neuper@37906
|
4 |
date: 02.08
|
neuper@37906
|
5 |
changed by: rlang
|
neuper@37906
|
6 |
last change by: rlang
|
neuper@37906
|
7 |
date: 02.11.14
|
neuper@37906
|
8 |
*)
|
neuper@37906
|
9 |
|
s1210629013@55339
|
10 |
theory RootEq imports Root Equation begin
|
neuper@37906
|
11 |
|
neuper@42398
|
12 |
text {* univariate equations containing real square roots:
|
neuper@42398
|
13 |
This type of equations has been used to bootstrap Lucas-Interpretation.
|
neuper@42398
|
14 |
In 2003 this type has been extended and integrated into ISAC's equation solver
|
neuper@42398
|
15 |
by Richard Lang in 2003.
|
neuper@42398
|
16 |
The assumptions (all containing "<") didn't pass the xml-parsers at the
|
neuper@42398
|
17 |
interface between math-engine and front-end.
|
neuper@42398
|
18 |
The migration Isabelle2002 --> 2011 dropped this type of equation, see
|
neuper@42398
|
19 |
test/../rooteq.sml, rootrateq.sml.
|
neuper@42398
|
20 |
*}
|
neuper@42398
|
21 |
|
neuper@37906
|
22 |
consts
|
neuper@37985
|
23 |
|
neuper@37985
|
24 |
is'_rootTerm'_in :: "[real, real] => bool" ("_ is'_rootTerm'_in _")
|
neuper@37950
|
25 |
is'_sqrtTerm'_in :: "[real, real] => bool" ("_ is'_sqrtTerm'_in _")
|
neuper@37950
|
26 |
is'_normSqrtTerm'_in :: "[real, real] => bool" ("_ is'_normSqrtTerm'_in _")
|
neuper@37950
|
27 |
|
neuper@37906
|
28 |
(*----------------------scripts-----------------------*)
|
neuper@37906
|
29 |
Norm'_sq'_root'_equation
|
neuper@37950
|
30 |
:: "[bool,real,
|
neuper@37950
|
31 |
bool list] => bool list"
|
wneuper@59334
|
32 |
("((Script Norm'_sq'_root'_equation (_ _ =))// (_))" 9)
|
neuper@37906
|
33 |
Solve'_sq'_root'_equation
|
neuper@37950
|
34 |
:: "[bool,real,
|
neuper@37950
|
35 |
bool list] => bool list"
|
wneuper@59334
|
36 |
("((Script Solve'_sq'_root'_equation (_ _ =))// (_))" 9)
|
neuper@37906
|
37 |
Solve'_left'_sq'_root'_equation
|
neuper@37950
|
38 |
:: "[bool,real,
|
neuper@37950
|
39 |
bool list] => bool list"
|
wneuper@59334
|
40 |
("((Script Solve'_left'_sq'_root'_equation (_ _ =))// (_))" 9)
|
neuper@37906
|
41 |
Solve'_right'_sq'_root'_equation
|
neuper@37950
|
42 |
:: "[bool,real,
|
neuper@37950
|
43 |
bool list] => bool list"
|
wneuper@59334
|
44 |
("((Script Solve'_right'_sq'_root'_equation (_ _ =))// (_))" 9)
|
neuper@37906
|
45 |
|
neuper@52148
|
46 |
axiomatization where
|
neuper@37906
|
47 |
|
neuper@37906
|
48 |
(* normalize *)
|
neuper@52148
|
49 |
makex1_x: "a^^^1 = a" and
|
neuper@52148
|
50 |
real_assoc_1: "a+(b+c) = a+b+c" and
|
neuper@52148
|
51 |
real_assoc_2: "a*(b*c) = a*b*c" and
|
neuper@37906
|
52 |
|
neuper@37906
|
53 |
(* simplification of root*)
|
neuper@52148
|
54 |
sqrt_square_1: "[|0 <= a|] ==> (sqrt a)^^^2 = a" and
|
neuper@52148
|
55 |
sqrt_square_2: "sqrt (a ^^^ 2) = a" and
|
neuper@52148
|
56 |
sqrt_times_root_1: "sqrt a * sqrt b = sqrt(a*b)" and
|
neuper@52148
|
57 |
sqrt_times_root_2: "a * sqrt b * sqrt c = a * sqrt(b*c)" and
|
neuper@37906
|
58 |
|
neuper@37906
|
59 |
(* isolate one root on the LEFT or RIGHT hand side of the equation *)
|
neuper@37983
|
60 |
sqrt_isolate_l_add1: "[|bdv occurs_in c|] ==>
|
neuper@52148
|
61 |
(a + b*sqrt(c) = d) = (b * sqrt(c) = d+ (-1) * a)" and
|
neuper@37983
|
62 |
sqrt_isolate_l_add2: "[|bdv occurs_in c|] ==>
|
neuper@52148
|
63 |
(a + sqrt(c) = d) = ((sqrt(c) = d+ (-1) * a))" and
|
neuper@37983
|
64 |
sqrt_isolate_l_add3: "[|bdv occurs_in c|] ==>
|
neuper@52148
|
65 |
(a + b*(e/sqrt(c)) = d) = (b * (e/sqrt(c)) = d + (-1) * a)" and
|
neuper@37983
|
66 |
sqrt_isolate_l_add4: "[|bdv occurs_in c|] ==>
|
neuper@52148
|
67 |
(a + b/(f*sqrt(c)) = d) = (b / (f*sqrt(c)) = d + (-1) * a)" and
|
neuper@37983
|
68 |
sqrt_isolate_l_add5: "[|bdv occurs_in c|] ==>
|
neuper@52148
|
69 |
(a + b*(e/(f*sqrt(c))) = d) = (b * (e/(f*sqrt(c))) = d+ (-1) * a)" and
|
neuper@37983
|
70 |
sqrt_isolate_l_add6: "[|bdv occurs_in c|] ==>
|
neuper@52148
|
71 |
(a + b/sqrt(c) = d) = (b / sqrt(c) = d+ (-1) * a)" and
|
neuper@37983
|
72 |
sqrt_isolate_r_add1: "[|bdv occurs_in f|] ==>
|
neuper@52148
|
73 |
(a = d + e*sqrt(f)) = (a + (-1) * d = e*sqrt(f))" and
|
neuper@37983
|
74 |
sqrt_isolate_r_add2: "[|bdv occurs_in f|] ==>
|
neuper@52148
|
75 |
(a = d + sqrt(f)) = (a + (-1) * d = sqrt(f))" and
|
neuper@37906
|
76 |
(* small hack: thm 3,5,6 are not needed if rootnormalize is well done*)
|
neuper@37983
|
77 |
sqrt_isolate_r_add3: "[|bdv occurs_in f|] ==>
|
neuper@52148
|
78 |
(a = d + e*(g/sqrt(f))) = (a + (-1) * d = e*(g/sqrt(f)))" and
|
neuper@37983
|
79 |
sqrt_isolate_r_add4: "[|bdv occurs_in f|] ==>
|
neuper@52148
|
80 |
(a = d + g/sqrt(f)) = (a + (-1) * d = g/sqrt(f))" and
|
neuper@37983
|
81 |
sqrt_isolate_r_add5: "[|bdv occurs_in f|] ==>
|
neuper@52148
|
82 |
(a = d + e*(g/(h*sqrt(f)))) = (a + (-1) * d = e*(g/(h*sqrt(f))))" and
|
neuper@37983
|
83 |
sqrt_isolate_r_add6: "[|bdv occurs_in f|] ==>
|
neuper@52148
|
84 |
(a = d + g/(h*sqrt(f))) = (a + (-1) * d = g/(h*sqrt(f)))" and
|
neuper@37906
|
85 |
|
neuper@37906
|
86 |
(* eliminate isolates sqrt *)
|
neuper@37983
|
87 |
sqrt_square_equation_both_1: "[|bdv occurs_in b; bdv occurs_in d|] ==>
|
neuper@37950
|
88 |
( (sqrt a + sqrt b = sqrt c + sqrt d) =
|
neuper@52148
|
89 |
(a+2*sqrt(a)*sqrt(b)+b = c+2*sqrt(c)*sqrt(d)+d))" and
|
neuper@37983
|
90 |
sqrt_square_equation_both_2: "[|bdv occurs_in b; bdv occurs_in d|] ==>
|
neuper@37950
|
91 |
( (sqrt a - sqrt b = sqrt c + sqrt d) =
|
neuper@52148
|
92 |
(a - 2*sqrt(a)*sqrt(b)+b = c+2*sqrt(c)*sqrt(d)+d))" and
|
neuper@37983
|
93 |
sqrt_square_equation_both_3: "[|bdv occurs_in b; bdv occurs_in d|] ==>
|
neuper@37950
|
94 |
( (sqrt a + sqrt b = sqrt c - sqrt d) =
|
neuper@52148
|
95 |
(a + 2*sqrt(a)*sqrt(b)+b = c - 2*sqrt(c)*sqrt(d)+d))" and
|
neuper@37983
|
96 |
sqrt_square_equation_both_4: "[|bdv occurs_in b; bdv occurs_in d|] ==>
|
neuper@37950
|
97 |
( (sqrt a - sqrt b = sqrt c - sqrt d) =
|
neuper@52148
|
98 |
(a - 2*sqrt(a)*sqrt(b)+b = c - 2*sqrt(c)*sqrt(d)+d))" and
|
neuper@37983
|
99 |
sqrt_square_equation_left_1: "[|bdv occurs_in a; 0 <= a; 0 <= b|] ==>
|
neuper@52148
|
100 |
( (sqrt (a) = b) = (a = (b^^^2)))" and
|
neuper@37983
|
101 |
sqrt_square_equation_left_2: "[|bdv occurs_in a; 0 <= a; 0 <= b*c|] ==>
|
neuper@52148
|
102 |
( (c*sqrt(a) = b) = (c^^^2*a = b^^^2))" and
|
neuper@37983
|
103 |
sqrt_square_equation_left_3: "[|bdv occurs_in a; 0 <= a; 0 <= b*c|] ==>
|
neuper@52148
|
104 |
( c/sqrt(a) = b) = (c^^^2 / a = b^^^2)" and
|
neuper@37906
|
105 |
(* small hack: thm 4-6 are not needed if rootnormalize is well done*)
|
neuper@37983
|
106 |
sqrt_square_equation_left_4: "[|bdv occurs_in a; 0 <= a; 0 <= b*c*d|] ==>
|
neuper@52148
|
107 |
( (c*(d/sqrt (a)) = b) = (c^^^2*(d^^^2/a) = b^^^2))" and
|
neuper@37983
|
108 |
sqrt_square_equation_left_5: "[|bdv occurs_in a; 0 <= a; 0 <= b*c*d|] ==>
|
neuper@52148
|
109 |
( c/(d*sqrt(a)) = b) = (c^^^2 / (d^^^2*a) = b^^^2)" and
|
neuper@37983
|
110 |
sqrt_square_equation_left_6: "[|bdv occurs_in a; 0 <= a; 0 <= b*c*d*e|] ==>
|
neuper@52148
|
111 |
( (c*(d/(e*sqrt (a))) = b) = (c^^^2*(d^^^2/(e^^^2*a)) = b^^^2))" and
|
neuper@37983
|
112 |
sqrt_square_equation_right_1: "[|bdv occurs_in b; 0 <= a; 0 <= b|] ==>
|
neuper@52148
|
113 |
( (a = sqrt (b)) = (a^^^2 = b))" and
|
neuper@37983
|
114 |
sqrt_square_equation_right_2: "[|bdv occurs_in b; 0 <= a*c; 0 <= b|] ==>
|
neuper@52148
|
115 |
( (a = c*sqrt (b)) = ((a^^^2) = c^^^2*b))" and
|
neuper@37983
|
116 |
sqrt_square_equation_right_3: "[|bdv occurs_in b; 0 <= a*c; 0 <= b|] ==>
|
neuper@52148
|
117 |
( (a = c/sqrt (b)) = (a^^^2 = c^^^2/b))" and
|
neuper@37906
|
118 |
(* small hack: thm 4-6 are not needed if rootnormalize is well done*)
|
neuper@37983
|
119 |
sqrt_square_equation_right_4: "[|bdv occurs_in b; 0 <= a*c*d; 0 <= b|] ==>
|
neuper@52148
|
120 |
( (a = c*(d/sqrt (b))) = ((a^^^2) = c^^^2*(d^^^2/b)))" and
|
neuper@37983
|
121 |
sqrt_square_equation_right_5: "[|bdv occurs_in b; 0 <= a*c*d; 0 <= b|] ==>
|
neuper@52148
|
122 |
( (a = c/(d*sqrt (b))) = (a^^^2 = c^^^2/(d^^^2*b)))" and
|
neuper@37983
|
123 |
sqrt_square_equation_right_6: "[|bdv occurs_in b; 0 <= a*c*d*e; 0 <= b|] ==>
|
neuper@37950
|
124 |
( (a = c*(d/(e*sqrt (b)))) = ((a^^^2) = c^^^2*(d^^^2/(e^^^2*b))))"
|
neuper@37950
|
125 |
|
neuper@37950
|
126 |
ML {*
|
neuper@37972
|
127 |
val thy = @{theory};
|
neuper@37972
|
128 |
|
neuper@37950
|
129 |
(*-------------------------functions---------------------*)
|
neuper@37950
|
130 |
(* true if bdv is under sqrt of a Equation*)
|
neuper@37950
|
131 |
fun is_rootTerm_in t v =
|
neuper@37950
|
132 |
let
|
neuper@37950
|
133 |
fun coeff_in c v = member op = (vars c) v;
|
neuper@38031
|
134 |
fun findroot (_ $ _ $ _ $ _) v = error("is_rootTerm_in:")
|
neuper@37950
|
135 |
(* at the moment there is no term like this, but ....*)
|
neuper@37950
|
136 |
| findroot (t as (Const ("Root.nroot",_) $ _ $ t3)) v = coeff_in t3 v
|
neuper@37950
|
137 |
| findroot (_ $ t2 $ t3) v = (findroot t2 v) orelse (findroot t3 v)
|
neuper@37982
|
138 |
| findroot (t as (Const ("NthRoot.sqrt",_) $ t2)) v = coeff_in t2 v
|
neuper@37950
|
139 |
| findroot (_ $ t2) v = (findroot t2 v)
|
neuper@37950
|
140 |
| findroot _ _ = false;
|
neuper@37950
|
141 |
in
|
neuper@37950
|
142 |
findroot t v
|
neuper@37950
|
143 |
end;
|
neuper@37950
|
144 |
|
neuper@37950
|
145 |
fun is_sqrtTerm_in t v =
|
neuper@37950
|
146 |
let
|
neuper@37950
|
147 |
fun coeff_in c v = member op = (vars c) v;
|
neuper@38031
|
148 |
fun findsqrt (_ $ _ $ _ $ _) v = error("is_sqrteqation_in:")
|
neuper@37950
|
149 |
(* at the moment there is no term like this, but ....*)
|
neuper@37950
|
150 |
| findsqrt (_ $ t1 $ t2) v = (findsqrt t1 v) orelse (findsqrt t2 v)
|
neuper@37982
|
151 |
| findsqrt (t as (Const ("NthRoot.sqrt",_) $ a)) v = coeff_in a v
|
neuper@37950
|
152 |
| findsqrt (_ $ t1) v = (findsqrt t1 v)
|
neuper@37950
|
153 |
| findsqrt _ _ = false;
|
neuper@37950
|
154 |
in
|
neuper@37950
|
155 |
findsqrt t v
|
neuper@37950
|
156 |
end;
|
neuper@37950
|
157 |
|
neuper@37950
|
158 |
(* RL: 030518: Is in the rightest subterm of a term a sqrt with bdv,
|
neuper@37950
|
159 |
and the subterm ist connected with + or * --> is normalized*)
|
neuper@37950
|
160 |
fun is_normSqrtTerm_in t v =
|
neuper@37950
|
161 |
let
|
neuper@37950
|
162 |
fun coeff_in c v = member op = (vars c) v;
|
neuper@38031
|
163 |
fun isnorm (_ $ _ $ _ $ _) v = error("is_normSqrtTerm_in:")
|
neuper@37950
|
164 |
(* at the moment there is no term like this, but ....*)
|
neuper@38014
|
165 |
| isnorm (Const ("Groups.plus_class.plus",_) $ _ $ t2) v = is_sqrtTerm_in t2 v
|
neuper@38034
|
166 |
| isnorm (Const ("Groups.times_class.times",_) $ _ $ t2) v = is_sqrtTerm_in t2 v
|
neuper@38014
|
167 |
| isnorm (Const ("Groups.minus_class.minus",_) $ _ $ _) v = false
|
wneuper@59360
|
168 |
| isnorm (Const ("Rings.divide_class.divide",_) $ t1 $ t2) v = (is_sqrtTerm_in t1 v) orelse
|
neuper@37950
|
169 |
(is_sqrtTerm_in t2 v)
|
neuper@37982
|
170 |
| isnorm (Const ("NthRoot.sqrt",_) $ t1) v = coeff_in t1 v
|
neuper@37950
|
171 |
| isnorm (_ $ t1) v = is_sqrtTerm_in t1 v
|
neuper@37950
|
172 |
| isnorm _ _ = false;
|
neuper@37950
|
173 |
in
|
neuper@37950
|
174 |
isnorm t v
|
neuper@37950
|
175 |
end;
|
neuper@37950
|
176 |
|
neuper@37950
|
177 |
fun eval_is_rootTerm_in _ _
|
neuper@37950
|
178 |
(p as (Const ("RootEq.is'_rootTerm'_in",_) $ t $ v)) _ =
|
neuper@37950
|
179 |
if is_rootTerm_in t v then
|
neuper@37950
|
180 |
SOME ((term2str p) ^ " = True",
|
neuper@48760
|
181 |
Trueprop $ (mk_equality (p, @{term True})))
|
neuper@37950
|
182 |
else SOME ((term2str p) ^ " = True",
|
neuper@48760
|
183 |
Trueprop $ (mk_equality (p, @{term False})))
|
neuper@38015
|
184 |
| eval_is_rootTerm_in _ _ _ _ = ((*tracing"### nichts matcht";*) NONE);
|
neuper@37950
|
185 |
|
neuper@37950
|
186 |
fun eval_is_sqrtTerm_in _ _
|
neuper@37950
|
187 |
(p as (Const ("RootEq.is'_sqrtTerm'_in",_) $ t $ v)) _ =
|
neuper@37950
|
188 |
if is_sqrtTerm_in t v then
|
neuper@37950
|
189 |
SOME ((term2str p) ^ " = True",
|
neuper@48760
|
190 |
Trueprop $ (mk_equality (p, @{term True})))
|
neuper@37950
|
191 |
else SOME ((term2str p) ^ " = True",
|
neuper@48760
|
192 |
Trueprop $ (mk_equality (p, @{term False})))
|
neuper@38015
|
193 |
| eval_is_sqrtTerm_in _ _ _ _ = ((*tracing"### nichts matcht";*) NONE);
|
neuper@37950
|
194 |
|
neuper@37950
|
195 |
fun eval_is_normSqrtTerm_in _ _
|
neuper@37950
|
196 |
(p as (Const ("RootEq.is'_normSqrtTerm'_in",_) $ t $ v)) _ =
|
neuper@37950
|
197 |
if is_normSqrtTerm_in t v then
|
neuper@37950
|
198 |
SOME ((term2str p) ^ " = True",
|
neuper@48760
|
199 |
Trueprop $ (mk_equality (p, @{term True})))
|
neuper@37950
|
200 |
else SOME ((term2str p) ^ " = True",
|
neuper@48760
|
201 |
Trueprop $ (mk_equality (p, @{term False})))
|
neuper@38015
|
202 |
| eval_is_normSqrtTerm_in _ _ _ _ = ((*tracing"### nichts matcht";*) NONE);
|
neuper@37950
|
203 |
|
neuper@37950
|
204 |
(*-------------------------rulse-------------------------*)
|
neuper@37950
|
205 |
val RootEq_prls =(*15.10.02:just the following order due to subterm evaluation*)
|
neuper@37950
|
206 |
append_rls "RootEq_prls" e_rls
|
neuper@37950
|
207 |
[Calc ("Atools.ident",eval_ident "#ident_"),
|
neuper@37950
|
208 |
Calc ("Tools.matches",eval_matches ""),
|
neuper@37950
|
209 |
Calc ("Tools.lhs" ,eval_lhs ""),
|
neuper@37950
|
210 |
Calc ("Tools.rhs" ,eval_rhs ""),
|
neuper@37950
|
211 |
Calc ("RootEq.is'_sqrtTerm'_in",eval_is_sqrtTerm_in ""),
|
neuper@37950
|
212 |
Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
|
neuper@37950
|
213 |
Calc ("RootEq.is'_normSqrtTerm'_in",eval_is_normSqrtTerm_in ""),
|
neuper@41922
|
214 |
Calc ("HOL.eq",eval_equal "#equal_"),
|
neuper@37969
|
215 |
Thm ("not_true",num_str @{thm not_true}),
|
neuper@37969
|
216 |
Thm ("not_false",num_str @{thm not_false}),
|
neuper@37969
|
217 |
Thm ("and_true",num_str @{thm and_true}),
|
neuper@37969
|
218 |
Thm ("and_false",num_str @{thm and_false}),
|
neuper@37969
|
219 |
Thm ("or_true",num_str @{thm or_true}),
|
neuper@37969
|
220 |
Thm ("or_false",num_str @{thm or_false})
|
neuper@37950
|
221 |
];
|
neuper@37950
|
222 |
|
neuper@37950
|
223 |
val RootEq_erls =
|
neuper@37950
|
224 |
append_rls "RootEq_erls" Root_erls
|
neuper@37965
|
225 |
[Thm ("divide_divide_eq_left",num_str @{thm divide_divide_eq_left})
|
neuper@37950
|
226 |
];
|
neuper@37950
|
227 |
|
neuper@37950
|
228 |
val RootEq_crls =
|
neuper@37950
|
229 |
append_rls "RootEq_crls" Root_crls
|
neuper@37965
|
230 |
[Thm ("divide_divide_eq_left",num_str @{thm divide_divide_eq_left})
|
neuper@37950
|
231 |
];
|
neuper@37950
|
232 |
|
neuper@37950
|
233 |
val rooteq_srls =
|
neuper@37950
|
234 |
append_rls "rooteq_srls" e_rls
|
neuper@37950
|
235 |
[Calc ("RootEq.is'_sqrtTerm'_in",eval_is_sqrtTerm_in ""),
|
neuper@37950
|
236 |
Calc ("RootEq.is'_normSqrtTerm'_in",eval_is_normSqrtTerm_in""),
|
neuper@37950
|
237 |
Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in "")
|
neuper@37950
|
238 |
];
|
neuper@52125
|
239 |
*}
|
neuper@52125
|
240 |
setup {* KEStore_Elems.add_rlss
|
neuper@52125
|
241 |
[("RootEq_erls", (Context.theory_name @{theory}, RootEq_erls)),
|
neuper@52125
|
242 |
("rooteq_srls", (Context.theory_name @{theory}, rooteq_srls))] *}
|
neuper@52125
|
243 |
ML {*
|
neuper@37950
|
244 |
|
neuper@37950
|
245 |
(*isolate the bound variable in an sqrt equation; 'bdv' is a meta-constant*)
|
s1210629013@55444
|
246 |
val sqrt_isolate = prep_rls'(
|
neuper@37950
|
247 |
Rls {id = "sqrt_isolate", preconds = [], rew_ord = ("termlessI",termlessI),
|
neuper@42451
|
248 |
erls = RootEq_erls, srls = Erls, calc = [], errpatts = [],
|
neuper@37950
|
249 |
rules = [
|
neuper@37969
|
250 |
Thm("sqrt_square_1",num_str @{thm sqrt_square_1}),
|
neuper@37950
|
251 |
(* (sqrt a)^^^2 -> a *)
|
neuper@37969
|
252 |
Thm("sqrt_square_2",num_str @{thm sqrt_square_2}),
|
neuper@37950
|
253 |
(* sqrt (a^^^2) -> a *)
|
neuper@37969
|
254 |
Thm("sqrt_times_root_1",num_str @{thm sqrt_times_root_1}),
|
neuper@37950
|
255 |
(* sqrt a sqrt b -> sqrt(ab) *)
|
neuper@37969
|
256 |
Thm("sqrt_times_root_2",num_str @{thm sqrt_times_root_2}),
|
neuper@37950
|
257 |
(* a sqrt b sqrt c -> a sqrt(bc) *)
|
neuper@37950
|
258 |
Thm("sqrt_square_equation_both_1",
|
neuper@37969
|
259 |
num_str @{thm sqrt_square_equation_both_1}),
|
neuper@37950
|
260 |
(* (sqrt a + sqrt b = sqrt c + sqrt d) ->
|
neuper@37950
|
261 |
(a+2*sqrt(a)*sqrt(b)+b) = c+2*sqrt(c)*sqrt(d)+d) *)
|
neuper@37950
|
262 |
Thm("sqrt_square_equation_both_2",
|
neuper@37969
|
263 |
num_str @{thm sqrt_square_equation_both_2}),
|
neuper@37950
|
264 |
(* (sqrt a - sqrt b = sqrt c + sqrt d) ->
|
neuper@37950
|
265 |
(a-2*sqrt(a)*sqrt(b)+b) = c+2*sqrt(c)*sqrt(d)+d) *)
|
neuper@37950
|
266 |
Thm("sqrt_square_equation_both_3",
|
neuper@37969
|
267 |
num_str @{thm sqrt_square_equation_both_3}),
|
neuper@37950
|
268 |
(* (sqrt a + sqrt b = sqrt c - sqrt d) ->
|
neuper@37950
|
269 |
(a+2*sqrt(a)*sqrt(b)+b) = c-2*sqrt(c)*sqrt(d)+d) *)
|
neuper@37950
|
270 |
Thm("sqrt_square_equation_both_4",
|
neuper@37969
|
271 |
num_str @{thm sqrt_square_equation_both_4}),
|
neuper@37950
|
272 |
(* (sqrt a - sqrt b = sqrt c - sqrt d) ->
|
neuper@37950
|
273 |
(a-2*sqrt(a)*sqrt(b)+b) = c-2*sqrt(c)*sqrt(d)+d) *)
|
neuper@37950
|
274 |
Thm("sqrt_isolate_l_add1",
|
neuper@37969
|
275 |
num_str @{thm sqrt_isolate_l_add1}),
|
neuper@37950
|
276 |
(* a+b*sqrt(x)=d -> b*sqrt(x) = d-a *)
|
neuper@37950
|
277 |
Thm("sqrt_isolate_l_add2",
|
neuper@37969
|
278 |
num_str @{thm sqrt_isolate_l_add2}),
|
neuper@37950
|
279 |
(* a+ sqrt(x)=d -> sqrt(x) = d-a *)
|
neuper@37950
|
280 |
Thm("sqrt_isolate_l_add3",
|
neuper@37969
|
281 |
num_str @{thm sqrt_isolate_l_add3}),
|
neuper@37950
|
282 |
(* a+b*c/sqrt(x)=d->b*c/sqrt(x)=d-a *)
|
neuper@37950
|
283 |
Thm("sqrt_isolate_l_add4",
|
neuper@37969
|
284 |
num_str @{thm sqrt_isolate_l_add4}),
|
neuper@37950
|
285 |
(* a+c/sqrt(x)=d -> c/sqrt(x) = d-a *)
|
neuper@37950
|
286 |
Thm("sqrt_isolate_l_add5",
|
neuper@37969
|
287 |
num_str @{thm sqrt_isolate_l_add5}),
|
neuper@37950
|
288 |
(* a+b*c/f*sqrt(x)=d->b*c/f*sqrt(x)=d-a *)
|
neuper@37950
|
289 |
Thm("sqrt_isolate_l_add6",
|
neuper@37969
|
290 |
num_str @{thm sqrt_isolate_l_add6}),
|
neuper@37950
|
291 |
(* a+c/f*sqrt(x)=d -> c/f*sqrt(x) = d-a *)
|
neuper@37969
|
292 |
(*Thm("sqrt_isolate_l_div",num_str @{thm sqrt_isolate_l_div}),*)
|
neuper@37950
|
293 |
(* b*sqrt(x) = d sqrt(x) d/b *)
|
neuper@37950
|
294 |
Thm("sqrt_isolate_r_add1",
|
neuper@37969
|
295 |
num_str @{thm sqrt_isolate_r_add1}),
|
neuper@37950
|
296 |
(* a= d+e*sqrt(x) -> a-d=e*sqrt(x) *)
|
neuper@37950
|
297 |
Thm("sqrt_isolate_r_add2",
|
neuper@37969
|
298 |
num_str @{thm sqrt_isolate_r_add2}),
|
neuper@37950
|
299 |
(* a= d+ sqrt(x) -> a-d= sqrt(x) *)
|
neuper@37950
|
300 |
Thm("sqrt_isolate_r_add3",
|
neuper@37969
|
301 |
num_str @{thm sqrt_isolate_r_add3}),
|
neuper@37950
|
302 |
(* a=d+e*g/sqrt(x)->a-d=e*g/sqrt(x)*)
|
neuper@37950
|
303 |
Thm("sqrt_isolate_r_add4",
|
neuper@37969
|
304 |
num_str @{thm sqrt_isolate_r_add4}),
|
neuper@37950
|
305 |
(* a= d+g/sqrt(x) -> a-d=g/sqrt(x) *)
|
neuper@37950
|
306 |
Thm("sqrt_isolate_r_add5",
|
neuper@37969
|
307 |
num_str @{thm sqrt_isolate_r_add5}),
|
neuper@37950
|
308 |
(* a=d+e*g/h*sqrt(x)->a-d=e*g/h*sqrt(x)*)
|
neuper@37950
|
309 |
Thm("sqrt_isolate_r_add6",
|
neuper@37969
|
310 |
num_str @{thm sqrt_isolate_r_add6}),
|
neuper@37950
|
311 |
(* a= d+g/h*sqrt(x) -> a-d=g/h*sqrt(x) *)
|
neuper@37969
|
312 |
(*Thm("sqrt_isolate_r_div",num_str @{thm sqrt_isolate_r_div}),*)
|
neuper@37950
|
313 |
(* a=e*sqrt(x) -> a/e = sqrt(x) *)
|
neuper@37950
|
314 |
Thm("sqrt_square_equation_left_1",
|
neuper@37969
|
315 |
num_str @{thm sqrt_square_equation_left_1}),
|
neuper@37950
|
316 |
(* sqrt(x)=b -> x=b^2 *)
|
neuper@37950
|
317 |
Thm("sqrt_square_equation_left_2",
|
neuper@37969
|
318 |
num_str @{thm sqrt_square_equation_left_2}),
|
neuper@37950
|
319 |
(* c*sqrt(x)=b -> c^2*x=b^2 *)
|
neuper@37969
|
320 |
Thm("sqrt_square_equation_left_3",num_str @{thm sqrt_square_equation_left_3}),
|
neuper@37950
|
321 |
(* c/sqrt(x)=b -> c^2/x=b^2 *)
|
neuper@37969
|
322 |
Thm("sqrt_square_equation_left_4",num_str @{thm sqrt_square_equation_left_4}),
|
neuper@37950
|
323 |
(* c*d/sqrt(x)=b -> c^2*d^2/x=b^2 *)
|
neuper@37969
|
324 |
Thm("sqrt_square_equation_left_5",num_str @{thm sqrt_square_equation_left_5}),
|
neuper@37950
|
325 |
(* c/d*sqrt(x)=b -> c^2/d^2x=b^2 *)
|
neuper@37969
|
326 |
Thm("sqrt_square_equation_left_6",num_str @{thm sqrt_square_equation_left_6}),
|
neuper@37950
|
327 |
(* c*d/g*sqrt(x)=b -> c^2*d^2/g^2x=b^2 *)
|
neuper@37969
|
328 |
Thm("sqrt_square_equation_right_1",num_str @{thm sqrt_square_equation_right_1}),
|
neuper@37950
|
329 |
(* a=sqrt(x) ->a^2=x *)
|
neuper@37969
|
330 |
Thm("sqrt_square_equation_right_2",num_str @{thm sqrt_square_equation_right_2}),
|
neuper@37950
|
331 |
(* a=c*sqrt(x) ->a^2=c^2*x *)
|
neuper@37969
|
332 |
Thm("sqrt_square_equation_right_3",num_str @{thm sqrt_square_equation_right_3}),
|
neuper@37950
|
333 |
(* a=c/sqrt(x) ->a^2=c^2/x *)
|
neuper@37969
|
334 |
Thm("sqrt_square_equation_right_4",num_str @{thm sqrt_square_equation_right_4}),
|
neuper@37950
|
335 |
(* a=c*d/sqrt(x) ->a^2=c^2*d^2/x *)
|
neuper@37969
|
336 |
Thm("sqrt_square_equation_right_5",num_str @{thm sqrt_square_equation_right_5}),
|
neuper@37950
|
337 |
(* a=c/e*sqrt(x) ->a^2=c^2/e^2x *)
|
neuper@37969
|
338 |
Thm("sqrt_square_equation_right_6",num_str @{thm sqrt_square_equation_right_6})
|
neuper@37950
|
339 |
(* a=c*d/g*sqrt(x) ->a^2=c^2*d^2/g^2*x *)
|
wneuper@59186
|
340 |
],scr = Prog ((Thm.term_of o the o (parse thy)) "empty_script")
|
neuper@37950
|
341 |
}:rls);
|
neuper@52125
|
342 |
*}
|
neuper@52125
|
343 |
setup {* KEStore_Elems.add_rlss
|
neuper@52125
|
344 |
[("sqrt_isolate", (Context.theory_name @{theory}, sqrt_isolate))] *}
|
neuper@52125
|
345 |
ML {*
|
neuper@52125
|
346 |
|
neuper@37950
|
347 |
(*isolate the bound variable in an sqrt left equation; 'bdv' is a meta-constant*)
|
s1210629013@55444
|
348 |
val l_sqrt_isolate = prep_rls'(
|
neuper@37950
|
349 |
Rls {id = "l_sqrt_isolate", preconds = [],
|
neuper@37950
|
350 |
rew_ord = ("termlessI",termlessI),
|
neuper@42451
|
351 |
erls = RootEq_erls, srls = Erls, calc = [], errpatts = [],
|
neuper@37950
|
352 |
rules = [
|
neuper@37969
|
353 |
Thm("sqrt_square_1",num_str @{thm sqrt_square_1}),
|
neuper@37950
|
354 |
(* (sqrt a)^^^2 -> a *)
|
neuper@37969
|
355 |
Thm("sqrt_square_2",num_str @{thm sqrt_square_2}),
|
neuper@37950
|
356 |
(* sqrt (a^^^2) -> a *)
|
neuper@37969
|
357 |
Thm("sqrt_times_root_1",num_str @{thm sqrt_times_root_1}),
|
neuper@37950
|
358 |
(* sqrt a sqrt b -> sqrt(ab) *)
|
neuper@37969
|
359 |
Thm("sqrt_times_root_2",num_str @{thm sqrt_times_root_2}),
|
neuper@37950
|
360 |
(* a sqrt b sqrt c -> a sqrt(bc) *)
|
neuper@37969
|
361 |
Thm("sqrt_isolate_l_add1",num_str @{thm sqrt_isolate_l_add1}),
|
neuper@37950
|
362 |
(* a+b*sqrt(x)=d -> b*sqrt(x) = d-a *)
|
neuper@37969
|
363 |
Thm("sqrt_isolate_l_add2",num_str @{thm sqrt_isolate_l_add2}),
|
neuper@37950
|
364 |
(* a+ sqrt(x)=d -> sqrt(x) = d-a *)
|
neuper@37969
|
365 |
Thm("sqrt_isolate_l_add3",num_str @{thm sqrt_isolate_l_add3}),
|
neuper@37950
|
366 |
(* a+b*c/sqrt(x)=d->b*c/sqrt(x)=d-a *)
|
neuper@37969
|
367 |
Thm("sqrt_isolate_l_add4",num_str @{thm sqrt_isolate_l_add4}),
|
neuper@37950
|
368 |
(* a+c/sqrt(x)=d -> c/sqrt(x) = d-a *)
|
neuper@37969
|
369 |
Thm("sqrt_isolate_l_add5",num_str @{thm sqrt_isolate_l_add5}),
|
neuper@37950
|
370 |
(* a+b*c/f*sqrt(x)=d->b*c/f*sqrt(x)=d-a *)
|
neuper@37969
|
371 |
Thm("sqrt_isolate_l_add6",num_str @{thm sqrt_isolate_l_add6}),
|
neuper@37950
|
372 |
(* a+c/f*sqrt(x)=d -> c/f*sqrt(x) = d-a *)
|
neuper@37969
|
373 |
(*Thm("sqrt_isolate_l_div",num_str @{thm sqrt_isolate_l_div}),*)
|
neuper@37950
|
374 |
(* b*sqrt(x) = d sqrt(x) d/b *)
|
neuper@37969
|
375 |
Thm("sqrt_square_equation_left_1",num_str @{thm sqrt_square_equation_left_1}),
|
neuper@37950
|
376 |
(* sqrt(x)=b -> x=b^2 *)
|
neuper@37969
|
377 |
Thm("sqrt_square_equation_left_2",num_str @{thm sqrt_square_equation_left_2}),
|
neuper@37950
|
378 |
(* a*sqrt(x)=b -> a^2*x=b^2*)
|
neuper@37969
|
379 |
Thm("sqrt_square_equation_left_3",num_str @{thm sqrt_square_equation_left_3}),
|
neuper@37950
|
380 |
(* c/sqrt(x)=b -> c^2/x=b^2 *)
|
neuper@37969
|
381 |
Thm("sqrt_square_equation_left_4",num_str @{thm sqrt_square_equation_left_4}),
|
neuper@37950
|
382 |
(* c*d/sqrt(x)=b -> c^2*d^2/x=b^2 *)
|
neuper@37969
|
383 |
Thm("sqrt_square_equation_left_5",num_str @{thm sqrt_square_equation_left_5}),
|
neuper@37950
|
384 |
(* c/d*sqrt(x)=b -> c^2/d^2x=b^2 *)
|
neuper@37969
|
385 |
Thm("sqrt_square_equation_left_6",num_str @{thm sqrt_square_equation_left_6})
|
neuper@37950
|
386 |
(* c*d/g*sqrt(x)=b -> c^2*d^2/g^2x=b^2 *)
|
neuper@37950
|
387 |
],
|
wneuper@59186
|
388 |
scr = Prog ((Thm.term_of o the o (parse thy)) "empty_script")
|
neuper@37950
|
389 |
}:rls);
|
neuper@52125
|
390 |
*}
|
neuper@52125
|
391 |
setup {* KEStore_Elems.add_rlss
|
neuper@52125
|
392 |
[("l_sqrt_isolate", (Context.theory_name @{theory}, l_sqrt_isolate))] *}
|
neuper@52125
|
393 |
ML {*
|
neuper@37950
|
394 |
|
neuper@37950
|
395 |
(* -- right 28.8.02--*)
|
neuper@37950
|
396 |
(*isolate the bound variable in an sqrt right equation; 'bdv' is a meta-constant*)
|
s1210629013@55444
|
397 |
val r_sqrt_isolate = prep_rls'(
|
neuper@37950
|
398 |
Rls {id = "r_sqrt_isolate", preconds = [],
|
neuper@37950
|
399 |
rew_ord = ("termlessI",termlessI),
|
neuper@42451
|
400 |
erls = RootEq_erls, srls = Erls, calc = [], errpatts = [],
|
neuper@37950
|
401 |
rules = [
|
neuper@37969
|
402 |
Thm("sqrt_square_1",num_str @{thm sqrt_square_1}),
|
neuper@37950
|
403 |
(* (sqrt a)^^^2 -> a *)
|
neuper@37969
|
404 |
Thm("sqrt_square_2",num_str @{thm sqrt_square_2}),
|
neuper@37950
|
405 |
(* sqrt (a^^^2) -> a *)
|
neuper@37969
|
406 |
Thm("sqrt_times_root_1",num_str @{thm sqrt_times_root_1}),
|
neuper@37950
|
407 |
(* sqrt a sqrt b -> sqrt(ab) *)
|
neuper@37969
|
408 |
Thm("sqrt_times_root_2",num_str @{thm sqrt_times_root_2}),
|
neuper@37950
|
409 |
(* a sqrt b sqrt c -> a sqrt(bc) *)
|
neuper@37969
|
410 |
Thm("sqrt_isolate_r_add1",num_str @{thm sqrt_isolate_r_add1}),
|
neuper@37950
|
411 |
(* a= d+e*sqrt(x) -> a-d=e*sqrt(x) *)
|
neuper@37969
|
412 |
Thm("sqrt_isolate_r_add2",num_str @{thm sqrt_isolate_r_add2}),
|
neuper@37950
|
413 |
(* a= d+ sqrt(x) -> a-d= sqrt(x) *)
|
neuper@37969
|
414 |
Thm("sqrt_isolate_r_add3",num_str @{thm sqrt_isolate_r_add3}),
|
neuper@37950
|
415 |
(* a=d+e*g/sqrt(x)->a-d=e*g/sqrt(x)*)
|
neuper@37969
|
416 |
Thm("sqrt_isolate_r_add4",num_str @{thm sqrt_isolate_r_add4}),
|
neuper@37950
|
417 |
(* a= d+g/sqrt(x) -> a-d=g/sqrt(x) *)
|
neuper@37969
|
418 |
Thm("sqrt_isolate_r_add5",num_str @{thm sqrt_isolate_r_add5}),
|
neuper@37950
|
419 |
(* a=d+e*g/h*sqrt(x)->a-d=e*g/h*sqrt(x)*)
|
neuper@37969
|
420 |
Thm("sqrt_isolate_r_add6",num_str @{thm sqrt_isolate_r_add6}),
|
neuper@37950
|
421 |
(* a= d+g/h*sqrt(x) -> a-d=g/h*sqrt(x) *)
|
neuper@37969
|
422 |
(*Thm("sqrt_isolate_r_div",num_str @{thm sqrt_isolate_r_div}),*)
|
neuper@37950
|
423 |
(* a=e*sqrt(x) -> a/e = sqrt(x) *)
|
neuper@37969
|
424 |
Thm("sqrt_square_equation_right_1",num_str @{thm sqrt_square_equation_right_1}),
|
neuper@37950
|
425 |
(* a=sqrt(x) ->a^2=x *)
|
neuper@37969
|
426 |
Thm("sqrt_square_equation_right_2",num_str @{thm sqrt_square_equation_right_2}),
|
neuper@37950
|
427 |
(* a=c*sqrt(x) ->a^2=c^2*x *)
|
neuper@37969
|
428 |
Thm("sqrt_square_equation_right_3",num_str @{thm sqrt_square_equation_right_3}),
|
neuper@37950
|
429 |
(* a=c/sqrt(x) ->a^2=c^2/x *)
|
neuper@37969
|
430 |
Thm("sqrt_square_equation_right_4",num_str @{thm sqrt_square_equation_right_4}),
|
neuper@37950
|
431 |
(* a=c*d/sqrt(x) ->a^2=c^2*d^2/x *)
|
neuper@37969
|
432 |
Thm("sqrt_square_equation_right_5",num_str @{thm sqrt_square_equation_right_5}),
|
neuper@37950
|
433 |
(* a=c/e*sqrt(x) ->a^2=c^2/e^2x *)
|
neuper@37969
|
434 |
Thm("sqrt_square_equation_right_6",num_str @{thm sqrt_square_equation_right_6})
|
neuper@37950
|
435 |
(* a=c*d/g*sqrt(x) ->a^2=c^2*d^2/g^2*x *)
|
neuper@37950
|
436 |
],
|
wneuper@59186
|
437 |
scr = Prog ((Thm.term_of o the o (parse thy)) "empty_script")
|
neuper@37950
|
438 |
}:rls);
|
neuper@52125
|
439 |
*}
|
neuper@52125
|
440 |
setup {* KEStore_Elems.add_rlss
|
neuper@52125
|
441 |
[("r_sqrt_isolate", (Context.theory_name @{theory}, r_sqrt_isolate))] *}
|
neuper@52125
|
442 |
ML {*
|
neuper@37950
|
443 |
|
s1210629013@55444
|
444 |
val rooteq_simplify = prep_rls'(
|
neuper@37950
|
445 |
Rls {id = "rooteq_simplify",
|
neuper@37950
|
446 |
preconds = [], rew_ord = ("termlessI",termlessI),
|
neuper@42451
|
447 |
erls = RootEq_erls, srls = Erls, calc = [], errpatts = [],
|
neuper@37950
|
448 |
(*asm_thm = [("sqrt_square_1","")],*)
|
neuper@37969
|
449 |
rules = [Thm ("real_assoc_1",num_str @{thm real_assoc_1}),
|
neuper@37950
|
450 |
(* a+(b+c) = a+b+c *)
|
neuper@37969
|
451 |
Thm ("real_assoc_2",num_str @{thm real_assoc_2}),
|
neuper@37950
|
452 |
(* a*(b*c) = a*b*c *)
|
neuper@38014
|
453 |
Calc ("Groups.plus_class.plus",eval_binop "#add_"),
|
neuper@38014
|
454 |
Calc ("Groups.minus_class.minus",eval_binop "#sub_"),
|
neuper@38034
|
455 |
Calc ("Groups.times_class.times",eval_binop "#mult_"),
|
wneuper@59360
|
456 |
Calc ("Rings.divide_class.divide", eval_cancel "#divide_e"),
|
neuper@37982
|
457 |
Calc ("NthRoot.sqrt",eval_sqrt "#sqrt_"),
|
neuper@37950
|
458 |
Calc ("Atools.pow" ,eval_binop "#power_"),
|
neuper@37969
|
459 |
Thm("real_plus_binom_pow2",num_str @{thm real_plus_binom_pow2}),
|
neuper@37969
|
460 |
Thm("real_minus_binom_pow2",num_str @{thm real_minus_binom_pow2}),
|
neuper@37969
|
461 |
Thm("realpow_mul",num_str @{thm realpow_mul}),
|
neuper@37950
|
462 |
(* (a * b)^n = a^n * b^n*)
|
neuper@37969
|
463 |
Thm("sqrt_times_root_1",num_str @{thm sqrt_times_root_1}),
|
neuper@37950
|
464 |
(* sqrt b * sqrt c = sqrt(b*c) *)
|
neuper@37969
|
465 |
Thm("sqrt_times_root_2",num_str @{thm sqrt_times_root_2}),
|
neuper@37950
|
466 |
(* a * sqrt a * sqrt b = a * sqrt(a*b) *)
|
neuper@37969
|
467 |
Thm("sqrt_square_2",num_str @{thm sqrt_square_2}),
|
neuper@37950
|
468 |
(* sqrt (a^^^2) = a *)
|
neuper@37969
|
469 |
Thm("sqrt_square_1",num_str @{thm sqrt_square_1})
|
neuper@37950
|
470 |
(* sqrt a ^^^ 2 = a *)
|
neuper@37950
|
471 |
],
|
wneuper@59186
|
472 |
scr = Prog ((Thm.term_of o the o (parse thy)) "empty_script")
|
neuper@37950
|
473 |
}:rls);
|
neuper@52125
|
474 |
*}
|
neuper@52125
|
475 |
setup {* KEStore_Elems.add_rlss
|
neuper@52125
|
476 |
[("rooteq_simplify", (Context.theory_name @{theory}, rooteq_simplify))] *}
|
neuper@52125
|
477 |
ML {*
|
neuper@37950
|
478 |
|
neuper@37950
|
479 |
(*-------------------------Problem-----------------------*)
|
neuper@37950
|
480 |
(*
|
neuper@37986
|
481 |
(get_pbt ["root'","univariate","equation"]);
|
neuper@37950
|
482 |
show_ptyps();
|
neuper@37950
|
483 |
*)
|
s1210629013@55339
|
484 |
*}
|
s1210629013@55359
|
485 |
setup {* KEStore_Elems.add_pbts
|
s1210629013@55363
|
486 |
(* ---------root----------- *)
|
wneuper@59269
|
487 |
[(Specify.prep_pbt thy "pbl_equ_univ_root" [] e_pblID
|
s1210629013@55339
|
488 |
(["root'","univariate","equation"],
|
s1210629013@55339
|
489 |
[("#Given" ,["equality e_e","solveFor v_v"]),
|
s1210629013@55339
|
490 |
("#Where" ,["(lhs e_e) is_rootTerm_in (v_v::real) | " ^
|
s1210629013@55339
|
491 |
"(rhs e_e) is_rootTerm_in (v_v::real)"]),
|
s1210629013@55339
|
492 |
("#Find" ,["solutions v_v'i'"])],
|
s1210629013@55339
|
493 |
RootEq_prls, SOME "solve (e_e::bool, v_v)", [])),
|
s1210629013@55339
|
494 |
(* ---------sqrt----------- *)
|
wneuper@59269
|
495 |
(Specify.prep_pbt thy "pbl_equ_univ_root_sq" [] e_pblID
|
s1210629013@55339
|
496 |
(["sq","root'","univariate","equation"],
|
s1210629013@55339
|
497 |
[("#Given" ,["equality e_e","solveFor v_v"]),
|
s1210629013@55339
|
498 |
("#Where" ,["( ((lhs e_e) is_sqrtTerm_in (v_v::real)) &" ^
|
s1210629013@55339
|
499 |
" ((lhs e_e) is_normSqrtTerm_in (v_v::real)) ) |" ^
|
s1210629013@55339
|
500 |
"( ((rhs e_e) is_sqrtTerm_in (v_v::real)) &" ^
|
s1210629013@55339
|
501 |
" ((rhs e_e) is_normSqrtTerm_in (v_v::real)) )"]),
|
s1210629013@55339
|
502 |
("#Find" ,["solutions v_v'i'"])],
|
s1210629013@55339
|
503 |
RootEq_prls, SOME "solve (e_e::bool, v_v)", [["RootEq","solve_sq_root_equation"]])),
|
s1210629013@55339
|
504 |
(* ---------normalize----------- *)
|
wneuper@59269
|
505 |
(Specify.prep_pbt thy "pbl_equ_univ_root_norm" [] e_pblID
|
s1210629013@55339
|
506 |
(["normalize","root'","univariate","equation"],
|
s1210629013@55339
|
507 |
[("#Given" ,["equality e_e","solveFor v_v"]),
|
s1210629013@55339
|
508 |
("#Where" ,["( ((lhs e_e) is_sqrtTerm_in (v_v::real)) &" ^
|
s1210629013@55339
|
509 |
" Not((lhs e_e) is_normSqrtTerm_in (v_v::real))) | " ^
|
s1210629013@55339
|
510 |
"( ((rhs e_e) is_sqrtTerm_in (v_v::real)) &" ^
|
s1210629013@55339
|
511 |
" Not((rhs e_e) is_normSqrtTerm_in (v_v::real)))"]),
|
s1210629013@55339
|
512 |
("#Find" ,["solutions v_v'i'"])],
|
s1210629013@55339
|
513 |
RootEq_prls, SOME "solve (e_e::bool, v_v)", [["RootEq","norm_sq_root_equation"]]))] *}
|
neuper@37950
|
514 |
|
neuper@37985
|
515 |
|
s1210629013@55373
|
516 |
(*-------------------------methods-----------------------*)
|
s1210629013@55373
|
517 |
setup {* KEStore_Elems.add_mets
|
s1210629013@55373
|
518 |
[(* ---- root 20.8.02 ---*)
|
wneuper@59269
|
519 |
Specify.prep_met thy "met_rooteq" [] e_metID
|
s1210629013@55373
|
520 |
(["RootEq"], [],
|
s1210629013@55373
|
521 |
{rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
|
s1210629013@55373
|
522 |
crls=RootEq_crls, errpats = [], nrls = norm_Poly}, "empty_script"),
|
s1210629013@55373
|
523 |
(*-- normalize 20.10.02 --*)
|
wneuper@59269
|
524 |
Specify.prep_met thy "met_rooteq_norm" [] e_metID
|
s1210629013@55373
|
525 |
(["RootEq","norm_sq_root_equation"],
|
s1210629013@55373
|
526 |
[("#Given" ,["equality e_e","solveFor v_v"]),
|
s1210629013@55373
|
527 |
("#Where" ,["( ((lhs e_e) is_sqrtTerm_in (v_v::real)) &" ^
|
s1210629013@55373
|
528 |
" Not((lhs e_e) is_normSqrtTerm_in (v_v::real))) | " ^
|
s1210629013@55373
|
529 |
"( ((rhs e_e) is_sqrtTerm_in (v_v::real)) &" ^
|
s1210629013@55373
|
530 |
" Not((rhs e_e) is_normSqrtTerm_in (v_v::real)))"]),
|
s1210629013@55373
|
531 |
("#Find" ,["solutions v_v'i'"])],
|
s1210629013@55373
|
532 |
{rew_ord'="termlessI", rls'=RootEq_erls, srls=e_rls, prls=RootEq_prls, calc=[],
|
s1210629013@55373
|
533 |
crls=RootEq_crls, errpats = [], nrls = norm_Poly},
|
s1210629013@55373
|
534 |
"Script Norm_sq_root_equation (e_e::bool) (v_v::real) = " ^
|
s1210629013@55373
|
535 |
"(let e_e = ((Repeat(Try (Rewrite makex1_x False))) @@ " ^
|
s1210629013@55373
|
536 |
" (Try (Repeat (Rewrite_Set expand_rootbinoms False))) @@ " ^
|
s1210629013@55373
|
537 |
" (Try (Rewrite_Set rooteq_simplify True)) @@ " ^
|
s1210629013@55373
|
538 |
" (Try (Repeat (Rewrite_Set make_rooteq False))) @@ " ^
|
s1210629013@55373
|
539 |
" (Try (Rewrite_Set rooteq_simplify True))) e_e " ^
|
s1210629013@55373
|
540 |
" in ((SubProblem (RootEq',[univariate,equation], " ^
|
wneuper@59345
|
541 |
" [no_met]) [BOOL e_e, REAL v_v])))")
|
wneuper@59345
|
542 |
(*----- broke at Isabelle2015 \<longrightarrow> Isabelle2017, reason unknown -----
|
wneuper@59345
|
543 |
,
|
wneuper@59269
|
544 |
Specify.prep_met thy "met_rooteq_sq" [] e_metID
|
s1210629013@55373
|
545 |
(["RootEq","solve_sq_root_equation"],
|
s1210629013@55373
|
546 |
[("#Given" ,["equality e_e", "solveFor v_v"]),
|
s1210629013@55373
|
547 |
("#Where" ,["(((lhs e_e) is_sqrtTerm_in (v_v::real)) & " ^
|
s1210629013@55373
|
548 |
" ((lhs e_e) is_normSqrtTerm_in (v_v::real))) |" ^
|
s1210629013@55373
|
549 |
"(((rhs e_e) is_sqrtTerm_in (v_v::real)) & " ^
|
s1210629013@55373
|
550 |
" ((rhs e_e) is_normSqrtTerm_in (v_v::real)))"]),
|
s1210629013@55373
|
551 |
("#Find" ,["solutions v_v'i'"])],
|
s1210629013@55373
|
552 |
{rew_ord'="termlessI", rls'=RootEq_erls, srls = rooteq_srls, prls = RootEq_prls, calc = [],
|
s1210629013@55373
|
553 |
crls=RootEq_crls, errpats = [], nrls = norm_Poly},
|
s1210629013@55373
|
554 |
"Script Solve_sq_root_equation (e_e::bool) (v_v::real) = " ^
|
s1210629013@55373
|
555 |
"(let e_e = " ^
|
s1210629013@55373
|
556 |
" ((Try (Rewrite_Set_Inst [(bdv,v_v::real)] sqrt_isolate True)) @@ " ^
|
s1210629013@55373
|
557 |
" (Try (Rewrite_Set rooteq_simplify True)) @@ " ^
|
s1210629013@55373
|
558 |
" (Try (Repeat (Rewrite_Set expand_rootbinoms False))) @@ " ^
|
s1210629013@55373
|
559 |
" (Try (Repeat (Rewrite_Set make_rooteq False))) @@ " ^
|
s1210629013@55373
|
560 |
" (Try (Rewrite_Set rooteq_simplify True)) ) e_e; " ^
|
s1210629013@55373
|
561 |
" (L_L::bool list) = " ^
|
s1210629013@55373
|
562 |
" (if (((lhs e_e) is_sqrtTerm_in v_v) | ((rhs e_e) is_sqrtTerm_in v_v))" ^
|
s1210629013@55373
|
563 |
" then (SubProblem (RootEq',[normalize,root',univariate,equation], " ^
|
s1210629013@55373
|
564 |
" [no_met]) [BOOL e_e, REAL v_v]) " ^
|
s1210629013@55373
|
565 |
" else (SubProblem (RootEq',[univariate,equation], [no_met]) " ^
|
s1210629013@55373
|
566 |
" [BOOL e_e, REAL v_v])) " ^
|
s1210629013@55373
|
567 |
"in Check_elementwise L_L {(v_v::real). Assumptions})"),
|
s1210629013@55373
|
568 |
(*-- right 28.08.02 --*)
|
wneuper@59269
|
569 |
Specify.prep_met thy "met_rooteq_sq_right" [] e_metID
|
s1210629013@55373
|
570 |
(["RootEq","solve_right_sq_root_equation"],
|
s1210629013@55373
|
571 |
[("#Given" ,["equality e_e","solveFor v_v"]),
|
s1210629013@55373
|
572 |
("#Where" ,["(rhs e_e) is_sqrtTerm_in v_v"]),
|
s1210629013@55373
|
573 |
("#Find" ,["solutions v_v'i'"])],
|
s1210629013@55373
|
574 |
{rew_ord' = "termlessI", rls' = RootEq_erls, srls = e_rls, prls = RootEq_prls, calc = [],
|
s1210629013@55373
|
575 |
crls = RootEq_crls, errpats = [], nrls = norm_Poly},
|
s1210629013@55373
|
576 |
"Script Solve_right_sq_root_equation (e_e::bool) (v_v::real) = " ^
|
s1210629013@55373
|
577 |
"(let e_e = " ^
|
s1210629013@55373
|
578 |
" ((Try (Rewrite_Set_Inst [(bdv,v_v::real)] r_sqrt_isolate False)) @@ " ^
|
s1210629013@55373
|
579 |
" (Try (Rewrite_Set rooteq_simplify False)) @@ " ^
|
s1210629013@55373
|
580 |
" (Try (Repeat (Rewrite_Set expand_rootbinoms False))) @@ " ^
|
s1210629013@55373
|
581 |
" (Try (Repeat (Rewrite_Set make_rooteq False))) @@ " ^
|
s1210629013@55373
|
582 |
" (Try (Rewrite_Set rooteq_simplify False))) e_e " ^
|
s1210629013@55373
|
583 |
" in if ((rhs e_e) is_sqrtTerm_in v_v) " ^
|
s1210629013@55373
|
584 |
" then (SubProblem (RootEq',[normalize,root',univariate,equation], " ^
|
s1210629013@55373
|
585 |
" [no_met]) [BOOL e_e, REAL v_v]) " ^
|
s1210629013@55373
|
586 |
" else ((SubProblem (RootEq',[univariate,equation], " ^
|
s1210629013@55373
|
587 |
" [no_met]) [BOOL e_e, REAL v_v])))"),
|
s1210629013@55373
|
588 |
(*-- left 28.08.02 --*)
|
wneuper@59269
|
589 |
Specify.prep_met thy "met_rooteq_sq_left" [] e_metID
|
s1210629013@55373
|
590 |
(["RootEq","solve_left_sq_root_equation"],
|
s1210629013@55373
|
591 |
[("#Given" ,["equality e_e","solveFor v_v"]),
|
s1210629013@55373
|
592 |
("#Where" ,["(lhs e_e) is_sqrtTerm_in v_v"]),
|
s1210629013@55373
|
593 |
("#Find" ,["solutions v_v'i'"])],
|
s1210629013@55373
|
594 |
{rew_ord'="termlessI", rls'=RootEq_erls, srls=e_rls, prls=RootEq_prls, calc=[],
|
s1210629013@55373
|
595 |
crls=RootEq_crls, errpats = [], nrls = norm_Poly},
|
s1210629013@55373
|
596 |
"Script Solve_left_sq_root_equation (e_e::bool) (v_v::real) = " ^
|
s1210629013@55373
|
597 |
"(let e_e = " ^
|
s1210629013@55373
|
598 |
" ((Try (Rewrite_Set_Inst [(bdv,v_v::real)] l_sqrt_isolate False)) @@ " ^
|
s1210629013@55373
|
599 |
" (Try (Rewrite_Set rooteq_simplify False)) @@ " ^
|
s1210629013@55373
|
600 |
" (Try (Repeat (Rewrite_Set expand_rootbinoms False))) @@ " ^
|
s1210629013@55373
|
601 |
" (Try (Repeat (Rewrite_Set make_rooteq False))) @@ " ^
|
s1210629013@55373
|
602 |
" (Try (Rewrite_Set rooteq_simplify False))) e_e " ^
|
s1210629013@55373
|
603 |
" in if ((lhs e_e) is_sqrtTerm_in v_v) " ^
|
s1210629013@55373
|
604 |
" then (SubProblem (RootEq',[normalize,root',univariate,equation], " ^
|
s1210629013@55373
|
605 |
" [no_met]) [BOOL e_e, REAL v_v]) " ^
|
s1210629013@55373
|
606 |
" else ((SubProblem (RootEq',[univariate,equation], " ^
|
wneuper@59345
|
607 |
" [no_met]) [BOOL e_e, REAL v_v])))")
|
wneuper@59345
|
608 |
----- broke at Isabelle2015 \<longrightarrow> Isabelle2017, reason unknown -------*)
|
wneuper@59345
|
609 |
]
|
wneuper@59345
|
610 |
*}
|
s1210629013@55373
|
611 |
|
s1210629013@52145
|
612 |
setup {* KEStore_Elems.add_calcs
|
s1210629013@52145
|
613 |
[("is_rootTerm_in", ("RootEq.is'_rootTerm'_in", eval_is_rootTerm_in"")),
|
s1210629013@52145
|
614 |
("is_sqrtTerm_in", ("RootEq.is'_sqrtTerm'_in", eval_is_sqrtTerm_in"")),
|
s1210629013@52145
|
615 |
("is_normSqrtTerm_in", ("RootEq.is_normSqrtTerm_in", eval_is_normSqrtTerm_in""))] *}
|
neuper@37950
|
616 |
|
neuper@37906
|
617 |
end
|