test/Tools/isac/OLDTESTS/root-equ.sml
author Walther Neuper <wneuper@ist.tugraz.at>
Thu, 22 Dec 2016 11:36:20 +0100
changeset 59279 255c853ea2f0
parent 59188 c477d0f79ab9
child 59497 8952c43fdce3
permissions -rw-r--r--
renamed Ctree.ptree --> Ctree.ctree
neuper@37906
     1
(* use"../systest/root-equ.sml";
neuper@37906
     2
   use"systest/root-equ.sml";
neuper@37906
     3
   use"root-equ.sml";
neuper@37906
     4
   trace_rewrite:= true;
neuper@37906
     5
   trace_rewrite:= false;
neuper@37906
     6
neuper@37906
     7
   method "sqrt-equ-test", _NOT_ "square-equation" 
neuper@37906
     8
*)
neuper@37906
     9
neuper@37906
    10
neuper@37906
    11
" ================= equation with x =(-12)/5, but L ={} ======= ";
neuper@37906
    12
" _________________ rewrite _________________ ";
neuper@37906
    13
neuper@37906
    14
neuper@37906
    15
" ================= equation with result={4} ================== ";
neuper@37906
    16
" -------------- model, specify ------------ ";
neuper@37906
    17
"  ________________ rewrite _________________";
neuper@37906
    18
" _________________ rewrite_ x=4_________________ ";
neuper@37906
    19
" _________________ rewrite + cappend _________________ ";
neuper@37906
    20
" _________________ me Free_Solve _________________ ";
neuper@37906
    21
" _________________ me + tacs input _________________ ";
neuper@37906
    22
(*" _______________ me + nxt_step from script _________---> scriptnew.sml*)
neuper@37906
    23
(*" _________________ me + nxt_step from script (check_elementwise..)______ 
neuper@37906
    24
                     ...       L_a = Tac subproblem_equation_dummy; ";*)
neuper@37906
    25
(*" _______________ me + root-equ: 1.norm_equation  ___---> scriptnew.sml*)
neuper@37906
    26
neuper@37906
    27
val c = [];
neuper@37906
    28
neuper@37906
    29
neuper@37906
    30
neuper@37906
    31
neuper@37906
    32
(*
wneuper@59188
    33
> val t = (Thm.term_of o the o (parse thy)) "#2^^^#3";
neuper@37906
    34
> val eval_fn = the (assoc (!eval_list, "pow"));
neuper@37926
    35
> val (SOME (id,t')) = get_pair thy "pow" eval_fn t;
neuper@37934
    36
> Syntax.string_of_term (thy2ctxt thy) t';
neuper@37906
    37
*)
neuper@37906
    38
(******************************************************************)
neuper@37906
    39
(*                  -------------------------------------         *)
neuper@37906
    40
" _________________ equation with x =(-12)/5, but L ={} ------- ";
neuper@37906
    41
(*                  -------------------------------------         *)
neuper@37906
    42
" _________________ rewrite _________________ ";
neuper@38058
    43
val thy' = "Test";
neuper@37906
    44
val ct = "sqrt(9+4*x)=sqrt x + sqrt(-3+x)";
neuper@37906
    45
val thm = ("square_equation_left","");
neuper@37926
    46
val SOME (ct,asm) = rewrite thy' "tless_true" "tval_rls" true thm ct;
neuper@37906
    47
(*"9 + 4 * x = (sqrt x + sqrt (-3 + x)) ^^^ 2"*)
neuper@37906
    48
val rls = ("Test_simplify");
neuper@37906
    49
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
    50
(*"9 + 4 * x = -3 + (2 * x + 2 * sqrt (x ^^^ 2 + -3 * x))"*)
neuper@37906
    51
val rls = ("rearrange_assoc");
neuper@37906
    52
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
    53
(*"9 + 4 * x = -3 + 2 * x + 2 * sqrt (x ^^^ 2 + -3 * x)"*)
neuper@37906
    54
val rls = ("isolate_root"); 
neuper@37906
    55
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
    56
(*"sqrt (x ^^^ 2 + -3 * x) =
neuper@37906
    57
(-3 + 2 * x + -1 * (9 + 4 * x)) // (-1 * 2)"*)
neuper@37906
    58
val rls = ("Test_simplify");
neuper@37906
    59
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
    60
(*"sqrt (x ^^^ 2 + -3 * x) = 6 + x"*)
neuper@37906
    61
val thm = ("square_equation_left","");
neuper@37906
    62
val (ct,asm') = the (rewrite thy' "tless_true" "tval_rls" true thm ct);
neuper@37906
    63
val asm = asm union asm';
neuper@37906
    64
(*"x ^^^ 2 + -3 * x = (6 + x) ^^^ 2"*)
neuper@37906
    65
val rls = ("Test_simplify");
neuper@37906
    66
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
    67
(*"x ^^^ 2 + -3 * x = 36 + (x ^^^ 2 + 12 * x)"*)
neuper@37906
    68
val rls = ("norm_equation");
neuper@37906
    69
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
    70
(*"x ^^^ 2 + -3 * x + -1 * (36 + (x ^^^ 2 + 12 * x)) = 0"*)
neuper@37906
    71
val rls = ("Test_simplify");
neuper@37906
    72
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
    73
(*"-36 + -15 * x = 0"*)
neuper@37906
    74
val rls = ("isolate_bdv");
neuper@37906
    75
val (ct,_) = the (rewrite_set_inst thy' false 
neuper@37906
    76
		  [("bdv","x::real")] rls ct);
neuper@37906
    77
(*"x = (0 + -1 * -36) // -15"*)
neuper@37906
    78
val rls = ("Test_simplify");
neuper@37906
    79
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@38031
    80
if ct<>"x = -12 / 5"then error "new behaviour in testexample"else ();
neuper@37906
    81
neuper@37906
    82
(* 
neuper@37906
    83
val ct = "x = (-12) / 5" : cterm'
neuper@37906
    84
> asm;
neuper@37906
    85
val it =
neuper@37906
    86
  ["(+0) <= sqrt x  + sqrt ((-3) + x) ","(+0) <= 9 + 4 * x",
neuper@37906
    87
   "(+0) <= (-3) * x + x ^^^ 2","(+0) <= 6 + x"] : cterm' list
neuper@37906
    88
*)
neuper@37906
    89
neuper@37906
    90
neuper@37906
    91
neuper@37906
    92
neuper@37906
    93
neuper@37906
    94
" ================== equation with result={4} ================== ";
neuper@37906
    95
" ================== equation with result={4} ================== ";
neuper@37906
    96
" ================== equation with result={4} ================== ";
neuper@37906
    97
neuper@37906
    98
" -------------- model, specify ------------ ";
neuper@37906
    99
" -------------- model, specify ------------ ";
neuper@37906
   100
" -------------- model, specify ------------ ";
neuper@37906
   101
" --- subproblem 1: linear-equation --- ";
neuper@37906
   102
val origin = ["equation (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
neuper@37906
   103
	   "bound_variable x","error_bound 0"(*,
neuper@37906
   104
	   "solutions L::real set" ,
neuper@37906
   105
	  "L = {bdv. || ((%x. l) bdv) - ((%x. r) bdv) || < eps}"*)];
neuper@38050
   106
val thy = (theory "Isac");
neuper@37906
   107
val formals = map (the o (parse thy)) origin;
neuper@37906
   108
neuper@37906
   109
val given  = ["equation (l=(r::real))",
neuper@37906
   110
	     "bound_variable bdv",   (* TODO type *) 
neuper@37906
   111
	     "error_bound eps"];
neuper@37906
   112
val where_ = [(*"(l=r) is_root_equation_in bdv", 5.3.yy*)
neuper@37906
   113
	      "bdv is_var",
neuper@37906
   114
	      "eps is_const_expr"];
neuper@37906
   115
val find   = ["solutions (L::bool list)"];
neuper@37906
   116
val with_  = [(* parseold ...
neuper@37906
   117
	  "L = {bdv. || ((%x. l) bdv) - ((%x. r) bdv) || < eps}"*)];
neuper@37906
   118
val chkpbl = map (the o (parse thy)) (given @ where_ @ find @ with_);
neuper@37906
   119
val givens = map (the o (parse thy)) given;
neuper@37906
   120
parseold thy "L = {bdv. || ((%x. l) bdv) - ((%x. r) bdv) || < apx}";
neuper@37906
   121
(* 31.1.00 
neuper@37906
   122
val tag__forms = chktyps thy (formals, givens);
wneuper@59188
   123
map ((atomty) o Thm.term_of) tag__forms;       *)
neuper@37906
   124
neuper@37906
   125
" --- subproblem 2: linear-equation --- ";
neuper@37906
   126
val origin = ["x + 4 = (0::real)","x::real"];
neuper@37906
   127
val formals = map (the o (parse thy)) origin;
neuper@37906
   128
neuper@37906
   129
val given  = ["equation (l=(0::real))",
neuper@37906
   130
	     "bound_variable bdv"];
neuper@37906
   131
val where_ = ["l is_linear_in bdv","bdv is_const"];
neuper@37906
   132
val find   = ["l::real"];
neuper@37906
   133
val with_  = ["l = (%x. l) bdv"];
neuper@37906
   134
val chkpbl = map (the o (parseold thy)) (given @ where_ @ find @ with_);
neuper@37906
   135
val givens = map (the o (parse thy)) given;
neuper@37906
   136
neuper@37906
   137
val tag__forms = chktyps thy (formals, givens);
wneuper@59188
   138
map ((atomty) o Thm.term_of) tag__forms;
neuper@37906
   139
neuper@37906
   140
neuper@37906
   141
neuper@37906
   142
" _________________ rewrite_ x+4_________________ ";
neuper@37906
   143
" _________________ rewrite_ x+4_________________ ";
neuper@37906
   144
" _________________ rewrite_ x+4_________________ ";
wneuper@59188
   145
val t = (Thm.term_of o the o (parse thy)) "sqrt(9+4*x)=sqrt x + sqrt(5+x)";
neuper@37969
   146
val thm = num_str @{thm square_equation_left};
neuper@37906
   147
val (t,asm) = the (rewrite_ thy tless_true tval_rls true thm t);
neuper@37906
   148
val rls = Test_simplify;
neuper@37906
   149
val (t,_) = the (rewrite_set_ thy false rls t);
neuper@37906
   150
val rls = rearrange_assoc;	  
neuper@37906
   151
val (t,_) = the (rewrite_set_ thy false rls t);
neuper@37906
   152
val rls = isolate_root;		  
neuper@37906
   153
val (t,_) = the (rewrite_set_ thy false rls t);
neuper@37906
   154
				  
neuper@37906
   155
val rls = Test_simplify;	  
neuper@37906
   156
val (t,_) = the (rewrite_set_ thy false rls t);
neuper@37906
   157
(*
neuper@37906
   158
sqrt (x ^^^ 2 + 5 * x) =
neuper@37906
   159
(5 + 2 * x + (-1 * 9 + -1 * (4 * x))) / (-1 * 2)
neuper@37906
   160
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
neuper@37906
   161
### trying thm 'rdistr_div_right'
neuper@37906
   162
### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
neuper@37906
   163
(5 + 2 * x) / (-1 * 2) + (-1 * 9 + -1 * (4 * x)) / (-1 * 2)
neuper@37906
   164
### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
neuper@37906
   165
(5 + 2 * x) / (-1 * 2) + (-1 * 9 / (-1 * 2) + -1 * (4 * x) / (-1 * 2))
neuper@37906
   166
### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
neuper@37906
   167
5 / (-1 * 2) + 2 * x / (-1 * 2) +
neuper@37906
   168
(-1 * 9 / (-1 * 2) + -1 * (4 * x) / (-1 * 2))
neuper@37906
   169
neuper@37906
   170
### trying thm 'radd_left_commute'
neuper@37906
   171
### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
neuper@37906
   172
-1 * 9 / (-1 * 2) +
neuper@37906
   173
(5 / (-1 * 2) + 2 * x / (-1 * 2) + -1 * (4 * x) / (-1 * 2))
neuper@37906
   174
### trying thm 'radd_assoc'
neuper@37906
   175
### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
neuper@37906
   176
-1 * 9 / (-1 * 2) +
neuper@37906
   177
(5 / (-1 * 2) + (2 * x / (-1 * 2) + -1 * (4 * x) / (-1 * 2)))
neuper@37906
   178
neuper@37906
   179
### trying thm 'radd_real_const_eq'
neuper@37906
   180
### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
neuper@37906
   181
-1 * 9 / (-1 * 2) + (5 / (-1 * 2) + (2 * x + -1 * (4 * x)) / (-1 * 2))
neuper@37906
   182
### rewrites to: sqrt (x ^^^ 2 + 5 * x) =
neuper@37906
   183
-1 * 9 / (-1 * 2) + (5 + (2 * x + -1 * (4 * x))) / (-1 * 2)
neuper@37906
   184
### rewrites to: sqrt (x ^^^ 2 + 5 * x) = 
neuper@37906
   185
(-1 * 9 + (5 + (2 * x + -1 * (4 * x)))) / (-1 * 2)
neuper@37906
   186
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
neuper@37906
   187
neuper@37906
   188
28.8.02: ruleset besser zusammenstellen !!!
neuper@37906
   189
*)
neuper@37969
   190
val thm = num_str @{thm square_equation_left};
neuper@37906
   191
val (t,asm') = the (rewrite_ thy tless_true tval_rls true thm t);
neuper@37906
   192
val asm = asm union asm';
neuper@37906
   193
val rls = Test_simplify;
neuper@37906
   194
val (t,_) = the (rewrite_set_ thy false rls t);
neuper@37906
   195
val rls = norm_equation;	  
neuper@37906
   196
val (t,_) = the (rewrite_set_ thy false rls t);
neuper@37906
   197
val rls = Test_simplify;	  
neuper@37906
   198
val (t,_) = the (rewrite_set_ thy false rls t);
neuper@37906
   199
val rls = isolate_bdv;
neuper@37906
   200
val subst = [(str2term "bdv", str2term "x")];
neuper@37906
   201
val (t,_) = the (rewrite_set_inst_ thy false subst rls t);
neuper@37906
   202
val rls = Test_simplify;
neuper@37906
   203
val (t,_) = the (rewrite_set_ thy false rls t);
neuper@37906
   204
val t' = term2str t;
neuper@37906
   205
if t' = "x = 4" then ()
neuper@38031
   206
else error "root-equ.sml: new behav. in rewrite_ x+4";
neuper@37906
   207
neuper@37906
   208
" _________________ rewrite x=4_________________ ";
neuper@37906
   209
" _________________ rewrite x=4_________________ ";
neuper@37906
   210
" _________________ rewrite x=4_________________ ";
neuper@37906
   211
(*
neuper@37969
   212
rewrite thy' "tless_true" "tval_rls" true (num_str @{thm rbinom_power_2}) ct;
wneuper@59188
   213
atomty ((#prop o Thm.rep_thm) (!tthm));
wneuper@59188
   214
atomty (Thm.term_of (!tct));
neuper@37906
   215
*)
neuper@38058
   216
val thy' = "Test";
neuper@37906
   217
val ct = "sqrt(9+4*x)=sqrt x + sqrt(5+x)";
neuper@37906
   218
(*1*)val thm = ("square_equation_left","");
neuper@37906
   219
val (ct,asm) = the (rewrite thy' "tless_true" "tval_rls" true thm ct);
neuper@37906
   220
"9 + 4 * x = (sqrt x + sqrt (5 + x)) ^^^ 2";
neuper@37906
   221
(*2*)val rls = "Test_simplify";
neuper@37906
   222
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
   223
"9 + 4 * x = 5 + (2 * x + 2 * sqrt (x ^^^ 2 + 5 * x))";
neuper@37906
   224
(*3*)val rls = "rearrange_assoc";
neuper@37906
   225
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
   226
"9 + 4 * x = 5 + 2 * x + 2 * sqrt (x ^^^ 2 + 5 * x)";
neuper@37906
   227
(*4*)val rls = "isolate_root";
neuper@37906
   228
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
   229
"sqrt (x ^^^ 2 + 5 * x) = (5 + 2 * x + -1 * (9 + 4 * x)) // (-1 * 2)";
neuper@37906
   230
(*5*)val rls = "Test_simplify";
neuper@37906
   231
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
   232
"sqrt (x ^^^ 2 + 5 * x) = 2 + x";
neuper@37906
   233
(*6*)val thm = ("square_equation_left","");
neuper@37906
   234
val (ct,asm') = the (rewrite thy' "tless_true" "tval_rls" true thm ct);
neuper@37906
   235
val asm = asm union asm';
neuper@37906
   236
"x ^^^ 2 + 5 * x = (2 + x) ^^^ 2";
neuper@37906
   237
(*7*)val rls = "Test_simplify";
neuper@37906
   238
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
   239
"x ^^^ 2 + 5 * x = 4 + (x ^^^ 2 + 4 * x)";
neuper@37906
   240
(*8*)val rls = "norm_equation";
neuper@37906
   241
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
   242
"x ^^^ 2 + 5 * x + -1 * (4 + (x ^^^ 2 + 4 * x)) = 0";
neuper@37906
   243
(*9*)val rls = "Test_simplify";
neuper@37906
   244
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@37906
   245
"-4 + x = 0";
neuper@37906
   246
(*10*)val rls = "isolate_bdv";
neuper@37906
   247
val (ct,_) = the (rewrite_set_inst thy' false 
neuper@37906
   248
		  [("bdv","x")] rls ct);
neuper@37906
   249
"x = 0 + -1 * -4";
neuper@37906
   250
(*11*)val rls = "Test_simplify";
neuper@37906
   251
val (ct,_) = the (rewrite_set thy' false rls ct);
neuper@38031
   252
if ct="x = 4" then () else error "new behaviour in test-example";
neuper@37906
   253
neuper@37906
   254
neuper@37906
   255
neuper@37906
   256
neuper@37906
   257
" _________________ rewrite + cappend _________________ ";
neuper@37906
   258
" _________________ rewrite + cappend _________________ ";
neuper@37906
   259
" _________________ rewrite + cappend _________________ ";
neuper@38058
   260
val thy' = "Test";
neuper@37906
   261
val ct = str2term"sqrt(9+4*x)=sqrt x + sqrt(5+x)";
neuper@37906
   262
val ctl = ["sqrt(9+4*x)=sqrt x + sqrt(5+x)","x::real","0"];
neuper@37906
   263
val oris = prep_ori ctl thy 
neuper@37906
   264
		    ((#ppc o get_pbt)
neuper@37906
   265
			 ["sqroot-test","univariate","equation","test"]);
neuper@37906
   266
val loc = e_istate;
wneuper@59279
   267
val (pt,pos) = (e_ctree,[]);
neuper@37906
   268
val (pt,_) = cappend_problem pt pos loc e_fmz (oris,empty_spec,e_term);
neuper@37906
   269
val pt = update_branch pt [] TransitiveB;
neuper@37906
   270
(*
neuper@37906
   271
val pt = update_model pt [] (map init_item (snd (get_obj g_origin pt [])));
neuper@37906
   272
*)
neuper@37906
   273
(*val pt = update_model pt [] (fst (get_obj g_origin pt [])); *)
neuper@37906
   274
val pt = update_domID  pt [] "Test";
neuper@37906
   275
val pt = update_pblID  pt [] ["Test",
neuper@37906
   276
			      "equations","univariate","square-root"];
neuper@37906
   277
val pt = update_metID  pt [] ["Test","sqrt-equ-test"];
neuper@37906
   278
val pt = update_pbl    pt [] [];
neuper@37906
   279
val pt = update_met    pt [] [];
neuper@37906
   280
(*
neuper@37906
   281
> get_obj g_spec pt [];
neuper@37906
   282
val it = ("e_domID",["e_pblID"],("e_domID","e_metID")) : spec
neuper@37906
   283
> val pt = update_domID  pt [] "RatArith";
neuper@37906
   284
> get_obj g_spec pt [];
neuper@37906
   285
val it = ("RatArith",["e_pblID"],("e_domID","e_metID")) : spec
neuper@37906
   286
> val pt = update_pblID  pt [] ["RatArith",
neuper@37906
   287
			      "equations","univariate","square-root"];
neuper@37906
   288
> get_obj g_spec pt [];
neuper@37906
   289
("RatArith",["RatArith","equations","univariate","square-root"],
neuper@37906
   290
   ("e_domID","e_metID")) : spec
neuper@37906
   291
> val pt = update_metID  pt [] ("RatArith","sqrt-equ-test");
neuper@37906
   292
> get_obj g_spec pt [];
neuper@37906
   293
  ("RatArith",["RatArith","equations","univariate","square-root"],
neuper@37906
   294
   ("RatArith","sqrt-equ-test")) : spec
neuper@37906
   295
*)
neuper@37906
   296
neuper@37906
   297
neuper@37906
   298
val pos = [1]:pos;
neuper@37906
   299
val (pt,_) = cappend_parent pt pos loc ct (Tac "repeat") TransitiveB;
neuper@37906
   300
neuper@37906
   301
val pos = (lev_on o lev_dn) pos;
neuper@37906
   302
val thm = ("square_equation_left",""); val ctold = ct;
neuper@37906
   303
val (ct,asm) = the (rewrite thy' "tless_true" ("tval_rls") true thm (term2str ct));
neuper@37906
   304
val (pt,_) = cappend_atomic pt pos loc ctold (Tac (fst thm)) (str2term ct,[])Complete;
neuper@37906
   305
(*val pt = union_asm pt [] (map (rpair []) asm);*)
neuper@37906
   306
neuper@37906
   307
val pos = lev_on pos;
neuper@37906
   308
val rls = ("Test_simplify"); val ctold = str2term ct;
neuper@37906
   309
val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   310
val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
neuper@37906
   311
neuper@37906
   312
val pos = lev_on pos;
neuper@37906
   313
val rls = ("rearrange_assoc"); val ctold = str2term ct;
neuper@37906
   314
val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   315
val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
neuper@37906
   316
neuper@37906
   317
val pos = lev_on pos;
neuper@37906
   318
val rls = ("isolate_root"); val ctold = str2term ct;
neuper@37906
   319
val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   320
val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
neuper@37906
   321
neuper@37906
   322
val pos = lev_on pos;
neuper@37906
   323
val rls = ("Test_simplify"); val ctold = str2term ct;
neuper@37906
   324
val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   325
val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
neuper@37906
   326
neuper@37906
   327
val pos = lev_on pos;
neuper@37906
   328
val thm = ("square_equation_left",""); val ctold = str2term ct;
neuper@37906
   329
val (ct,asm) = the (rewrite thy' "tless_true" "tval_rls" true thm ct);
neuper@37906
   330
val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
neuper@37906
   331
(*val pt = union_asm pt [] (map (rpair []) asm);*)
neuper@37906
   332
neuper@37906
   333
val pos = lev_up pos;
neuper@37906
   334
val (pt,_) = append_result pt pos e_istate (str2term ct,[]) Complete;
neuper@37906
   335
neuper@37906
   336
val pos = lev_on pos;
neuper@37906
   337
val rls = ("Test_simplify"); val ctold = str2term ct;
neuper@37906
   338
val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   339
val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
neuper@37906
   340
neuper@37906
   341
val pos = lev_on pos;
neuper@37906
   342
val rls = ("norm_equation"); val ctold = str2term ct;
neuper@37906
   343
val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   344
val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
neuper@37906
   345
neuper@37906
   346
val pos = lev_on pos;
neuper@37906
   347
val rls = ("Test_simplify"); val ctold = str2term ct;
neuper@37906
   348
val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   349
val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
neuper@37906
   350
neuper@37906
   351
(* --- see comments in interface_ME_ISA/instantiate''
neuper@37906
   352
val rlsdat' = instantiate_rls' thy' [("bdv","x")] ("isolate_bdv");
neuper@37906
   353
val (ct,_) = the (rewrite_set thy'  false 
neuper@37906
   354
		                 ("#isolate_bdv",rlsdat') ct);   *)
neuper@37906
   355
val pos = lev_on pos;
neuper@37906
   356
val rls = ("isolate_bdv"); val ctold = str2term ct;
neuper@37906
   357
val (ct,_) = the (rewrite_set_inst thy'  false 
neuper@37906
   358
		  [("bdv","x")] rls ct);
neuper@37906
   359
val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
neuper@37906
   360
neuper@37906
   361
val pos = lev_on pos;
neuper@37906
   362
val rls = ("Test_simplify"); val ctold = str2term ct;  
neuper@37906
   363
val (ct,_) = the (rewrite_set thy'  false rls ct);
neuper@37906
   364
val (pt,_) = cappend_atomic pt pos loc ctold (Tac rls) (str2term ct,[]) Complete;
neuper@37906
   365
neuper@37906
   366
val pos = lev_up pos;
neuper@37906
   367
val (pt,pos) = append_result pt pos e_istate (str2term ct,[]) Complete;
neuper@37906
   368
get_assumptions_ pt ([],Res);
neuper@37906
   369
wneuper@59279
   370
writeln (pr_ctree pr_short pt);
neuper@37906
   371
(* aus src.24-11-99:
neuper@37906
   372
.   sqrt(9+4*x)=sqrt x + sqrt(5+x), x, (+0)
neuper@37906
   373
1.   sqrt(9+4*x)=sqrt x + sqrt(5+x)
neuper@37906
   374
1.1.   sqrt(9+4*x)=sqrt x + sqrt(5+x)
neuper@37906
   375
1.2.   9 + 4 * x = (sqrt x  + sqrt (5 + x) ) ^^^ 2
neuper@37906
   376
1.3.   9 + 4 * x = 5 + ((+2) * x + (+2) * sqrt (5 * x + x ^^^ 2) )
neuper@37906
   377
1.4.   9 + 4 * x = 5 + (+2) * x + (+2) * sqrt (5 * x + x ^^^ 2) 
neuper@37906
   378
1.5.   sqrt (5 * x + x ^^^ 2)  = (5 + (+2) * x + (-1) * (9 + 4 * x)) / ((-1) * (+2))
neuper@37906
   379
1.6.   sqrt (5 * x + x ^^^ 2)  = (+2) + x
neuper@37906
   380
2.   5 * x + x ^^^ 2 = ((+2) + x) ^^^ 2
neuper@37906
   381
3.   5 * x + x ^^^ 2 = 4 + (4 * x + x ^^^ 2)     ###12.12.99: indent 2.1. !?!
neuper@37906
   382
4.   5 * x + x ^^^ 2 + (-1) * (4 + (4 * x + x ^^^ 2)) = (+0)
neuper@37906
   383
5.   (-4) + x = (+0)
neuper@37906
   384
6.   x = (+0) + (-1) * (-4)
neuper@37906
   385
*)
neuper@37906
   386
neuper@37906
   387
(*
wneuper@59188
   388
val t = (Thm.term_of o the o (parse thy)) "solutions (L::real set)";
neuper@37906
   389
atomty t;
neuper@37906
   390
*)
neuper@37906
   391
neuper@37906
   392
neuper@37906
   393
(*- 20.9.02: Free_Solve would need the erls (for conditions of rules)
neuper@37906
   394
    from thy ???, i.e. together with the *_simplify ?!!!? ----------
neuper@37906
   395
" _________________ me Free_Solve _________________ ";
neuper@37906
   396
" _________________ me Free_Solve _________________ ";
neuper@37906
   397
" _________________ me Free_Solve _________________ ";
neuper@37906
   398
val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
neuper@37906
   399
	   "solveFor x","errorBound (eps=0)",
neuper@37906
   400
	   "solutions L"(*,
neuper@37906
   401
      "L = {bdv. || ((%x. l) bdv) - ((%x. r) bdv) || < eps}"*)];
neuper@37906
   402
val (dI',pI',mI') =
neuper@38058
   403
  ("Test",["sqroot-test","univariate","equation","test"],
neuper@38058
   404
   ("Test","sqrt-equ-test"));
neuper@37906
   405
val p = e_pos'; val c = []; 
neuper@37906
   406
val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
neuper@37906
   407
neuper@37906
   408
val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;
neuper@37906
   409
(*val nxt = ("Add_Given", Add_Given "equation (sqrt (#9 + #4 * x)  = sqrt x  + sqrt (#5 + x) )");*)
neuper@37906
   410
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   411
(* val nxt = ("Add_Given",Add_Given "bound_variable x");*)
neuper@37906
   412
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   413
(* val nxt = ("Add_Given",Add_Given "error_bound #0");*)
neuper@37906
   414
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   415
(* val nxt = ("Add_Find",Add_Find "solutions L"); *)
neuper@37906
   416
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38058
   417
(* val nxt = ("Specify_Theory",Specify_Theory "DiffAppl");
neuper@37906
   418
> get_obj g_spec pt (fst p);
neuper@37906
   419
val it = ("e_domID",["e_pblID"],("e_domID","e_metID")) : spec*)
neuper@37906
   420
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   421
(*val nxt = ("Specify_Problem", Specify_Problem *)
neuper@37906
   422
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38058
   423
(*val nxt = ("Specify_Method",Specify_Method ("DiffAppl","sqrt-equ-test"));*)
neuper@37906
   424
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@38058
   425
(*val nxt = ("Apply_Method",Apply_Method ("DiffAppl","sqrt-equ-test"));*)
neuper@37906
   426
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   427
val nxt = ("Free_Solve",Free_Solve);
neuper@37906
   428
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@37906
   429
get_obj g_spec pt [];
neuper@37906
   430
neuper@37906
   431
"--- -2 ---";
neuper@37906
   432
get_form ("Take",Take"sqrt(9+4*x)=sqrt x + sqrt(5+x)") p pt;
neuper@37906
   433
val (p,_,f,nxt,_,pt)=
neuper@37906
   434
me ("Take",Take "sqrt(9+4*x)=sqrt x + sqrt(5+x)") p [3] pt;
neuper@37906
   435
(* 15.4.
neuper@37906
   436
"--- -1 ---";
neuper@37906
   437
get_form ("Begin_Trans",Begin_Trans) p pt;
neuper@37906
   438
val (p,_,f,nxt,_,pt)=
neuper@37906
   439
me ("Begin_Trans",Begin_Trans) p [4] pt; *)
neuper@37906
   440
neuper@37906
   441
"--- 1 ---";
neuper@37906
   442
get_form ("Rewrite_Asm",Rewrite_Asm ("square_equation_left","")) p pt;
neuper@37906
   443
val (p,_,f,nxt,_,pt)=
neuper@37906
   444
me ("Rewrite_Asm",Rewrite_Asm ("square_equation_left","")) p [5] pt;
neuper@37906
   445
"--- 2 ---";
neuper@37906
   446
get_form ("Rewrite_Set",Rewrite_Set "Test_simplify")p pt;
neuper@37906
   447
val (p,_,f,nxt,_,pt)=
neuper@37906
   448
me ("Rewrite_Set",Rewrite_Set "Test_simplify")p [6] pt;
neuper@37906
   449
"--- 3 ---";
neuper@37906
   450
get_form ("Rewrite_Set",Rewrite_Set "rearrange_assoc") p pt;
neuper@37906
   451
val (p,_,f,nxt,_,pt)=
neuper@37906
   452
me ("Rewrite_Set",Rewrite_Set "rearrange_assoc") p [7] pt;
neuper@37906
   453
"--- 4 ---";
neuper@37906
   454
get_form ("Rewrite_Set",Rewrite_Set "isolate_root") p pt;
neuper@37906
   455
val (p,_,f,nxt,_,pt)=
neuper@37906
   456
me ("Rewrite_Set",Rewrite_Set "isolate_root") p [8] pt;
neuper@37906
   457
"--- 5 ---";
neuper@37906
   458
get_form ("Rewrite_Set",Rewrite_Set "Test_simplify") p pt;
neuper@37906
   459
val (p,_,f,nxt,_,pt)=
neuper@37906
   460
me ("Rewrite_Set",Rewrite_Set "Test_simplify") p [9] pt;
neuper@37906
   461
"--- 6 ---";
neuper@37906
   462
get_form ("Rewrite_Asm",Rewrite_Asm ("square_equation_left","")) p pt;
neuper@37906
   463
val (p,_,f,nxt,_,pt)=
neuper@37906
   464
me ("Rewrite_Asm",Rewrite_Asm ("square_equation_left","")) p [10] pt;
neuper@37906
   465
(* 15.4.
neuper@37906
   466
"--- ---";
neuper@37906
   467
get_form ("End_Trans",End_Trans) p pt;
neuper@37906
   468
val (p,_,f,nxt,_,pt)=
neuper@37906
   469
me ("End_Trans",End_Trans) p [11] pt; *)
neuper@37906
   470
"--- 7 ---";
neuper@37906
   471
get_form ("Rewrite_Set",Rewrite_Set "Test_simplify") p pt;
neuper@37906
   472
val (p,_,f,nxt,_,pt)=
neuper@37906
   473
me ("Rewrite_Set",Rewrite_Set "Test_simplify") p [12] pt;
neuper@37906
   474
"--- 8 ---";
neuper@37906
   475
get_form ("Rewrite_Set",Rewrite_Set "norm_equation") p pt;
neuper@37906
   476
val (p,_,f,nxt,_,pt)=
neuper@37906
   477
me ("Rewrite_Set",Rewrite_Set "norm_equation") p [13] pt;
neuper@37906
   478
"--- 9 ---";
neuper@37906
   479
get_form ("Rewrite_Set",Rewrite_Set "Test_simplify") p pt;
neuper@37906
   480
val (p,_,f,nxt,_,pt)=
neuper@37906
   481
me ("Rewrite_Set",Rewrite_Set "Test_simplify") p [14] pt;
neuper@37906
   482
"--- 10 ---.";
neuper@37906
   483
get_form ("Rewrite_Set_Inst",Rewrite_Set_Inst (["(bdv,x)"],"isolate_bdv")) p pt;
neuper@37906
   484
val (p,_,f,nxt,_,pt)=
neuper@37906
   485
me ("Rewrite_Set",Rewrite_Set_Inst (["(bdv,x)"],"isolate_bdv")) p [15] pt;
neuper@37906
   486
"--- 11 ---";
neuper@37906
   487
get_form ("Rewrite_Set",Rewrite_Set "Test_simplify") p pt;
neuper@37906
   488
val ((p,p_),_,f,nxt,_,pt)=
neuper@37906
   489
me ("Rewrite_Set",Rewrite_Set "Test_simplify") p [16] pt;
neuper@37906
   490
(* 5.4.00.: ---
neuper@38058
   491
get_form ("Check_Postcond",Check_Postcond ("Test","solve-root-equation")) (p,Met) pt;
neuper@37906
   492
val (p,_,f,nxt,_,pt)=
neuper@38058
   493
me ("Check_Postcond",Check_Postcond ("Test","solve-root-equation")) (p,Met) [17] pt;
neuper@37906
   494
--- *) 
wneuper@59279
   495
writeln (pr_ctree pr_short pt);
neuper@37906
   496
writeln("result: "^(get_obj g_result pt [])^"\n==================================================================="*;
neuper@37906
   497
*)
neuper@37906
   498
neuper@37906
   499
neuper@37906
   500
" _________________ me + tacs input _________________ ";
neuper@37906
   501
" _________________ me + tacs input _________________ ";
neuper@37906
   502
" _________________ me + tacs input _________________ ";
neuper@37906
   503
val fmz = ["equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))",
neuper@37906
   504
	   "solveFor x","errorBound (eps=0)",
neuper@37906
   505
	   "solutions L"];
neuper@37906
   506
val (dI',pI',mI') =
neuper@38058
   507
  ("Test",["sqroot-test","univariate","equation","test"],
neuper@37906
   508
   ["Test","sqrt-equ-test"]);
neuper@37906
   509
"--- s1 ---";
neuper@37906
   510
(*val p = e_pos'; val c = []; 
neuper@37906
   511
val (mI,m) = ("Init_Proof",Init_Proof (fmz, (dI',pI',mI')));
neuper@37906
   512
val (p,_,f,nxt,_,pt) = me (mI,m) p c EmptyPtree;*)
neuper@37906
   513
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
   514
"--- s1b ---";
neuper@37906
   515
val nxt = ("Model_Problem",
neuper@37906
   516
	   Model_Problem(*["sqroot-test","univariate","equation","test"]*));
neuper@37906
   517
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   518
"--- s2 ---";
neuper@37906
   519
val nxt = ("Add_Given",
neuper@37906
   520
Add_Given "equality (sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x))");
neuper@37906
   521
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   522
"--- s3 ---";
neuper@37906
   523
val nxt = ("Add_Given",Add_Given "solveFor x");
neuper@37906
   524
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   525
(*"--- s4 ---";
neuper@37906
   526
val nxt = ("Add_Given",Add_Given "errorBound (eps = 0)");
neuper@37906
   527
val (p,_,f,nxt,_,pt) = me nxt p c pt;*)
neuper@37906
   528
"--- s5 ---";
neuper@37906
   529
val nxt = ("Add_Find",Add_Find "solutions L");
neuper@37906
   530
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   531
"--- s6 ---";
neuper@38058
   532
val nxt = ("Specify_Theory",Specify_Theory "Test");
neuper@37906
   533
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   534
"--- s7 ---";
neuper@37906
   535
val nxt = ("Specify_Problem",
neuper@37906
   536
Specify_Problem ["sqroot-test","univariate","equation","test"]);
neuper@37906
   537
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   538
"--- s8 ---";
neuper@37906
   539
val nxt = ("Specify_Method",Specify_Method ["Test","sqrt-equ-test"]);
neuper@37906
   540
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   541
"--- s9 ---";
neuper@37906
   542
val nxt = ("Apply_Method",Apply_Method ["Test","sqrt-equ-test"]);
neuper@37906
   543
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   544
"--- 1 ---";
neuper@37906
   545
val nxt = ("Rewrite",Rewrite ("square_equation_left",""));
neuper@37906
   546
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   547
neuper@37906
   548
(*.9.6.03
neuper@37906
   549
 val t = str2term "sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x)";
neuper@37926
   550
 val SOME (t',asm) = rewrite_set_ thy false rls t;
neuper@37906
   551
 term2str t';
neuper@37906
   552
 trace_rewrite:=true; 
neuper@37906
   553
 trace_rewrite:=false; 
neuper@37906
   554
*)
neuper@37906
   555
neuper@37906
   556
(*me------------
neuper@37906
   557
 val (mI,m) = nxt; val pos' as (p,p_) = p; 
neuper@37906
   558
neuper@37906
   559
 val Appl m = applicable_in (p,p_) pt m; 
neuper@37906
   560
(*solve*)
neuper@37906
   561
      val pp = par_pblobj pt p;
neuper@37906
   562
      val metID = get_obj g_metID pt pp;
neuper@37906
   563
      val sc = (#scr o get_met) metID;
neuper@37906
   564
      val is = get_istate pt (p,p_);
neuper@37906
   565
      val thy' = get_obj g_domID pt pp;
neuper@37906
   566
      val thy = assoc_thy thy';
neuper@37906
   567
      val d = e_rls;
neuper@37906
   568
    val Steps [(m',f',pt',p',c',s')] = 
neuper@37906
   569
	     locate_gen thy' m  (pt,(p,p_)) (sc,d) is;
neuper@37906
   570
         val is' = get_istate pt' p';
neuper@37906
   571
	 next_tac thy' (pt'(*'*),p') sc is';  
neuper@37906
   572
neuper@37906
   573
neuper@37906
   574
neuper@37906
   575
wneuper@59188
   576
val ttt = (Thm.term_of o the o (parse Test.thy))
neuper@37981
   577
"Let (((While contains_root e_e Do\
neuper@37906
   578
\Rewrite square_equation_left True @@\
neuper@37906
   579
\Try (Rewrite_Set Test_simplify False) @@\
neuper@37906
   580
\Try (Rewrite_Set rearrange_assoc False) @@\
neuper@37906
   581
\Try (Rewrite_Set Test_simplify False)) @@\
neuper@37906
   582
\Try (Rewrite_Set norm_equation False) @@\
neuper@37906
   583
\Try (Rewrite_Set Test_simplify False) @@\
neuper@37981
   584
\Rewrite_Set_Inst [(bdv, v_v)] isolate_bdv False @@\
neuper@37906
   585
\Try (Rewrite_Set Test_simplify False))\
neuper@37906
   586
\e_)";
neuper@37906
   587
neuper@37906
   588
-------------------------*)
neuper@37906
   589
neuper@37906
   590
neuper@37906
   591
"--- 2 ---";
neuper@37906
   592
val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
neuper@37906
   593
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   594
"--- 3 ---";
neuper@37906
   595
val nxt = ("Rewrite_Set",Rewrite_Set "rearrange_assoc");
neuper@37906
   596
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   597
"--- 4 ---";
neuper@37906
   598
val nxt = ("Rewrite_Set",Rewrite_Set "isolate_root");
neuper@37906
   599
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   600
"--- 5 ---";
neuper@37906
   601
val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
neuper@37906
   602
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   603
"--- 6 ---";
neuper@37906
   604
val nxt = ("Rewrite",Rewrite ("square_equation_left",""));
neuper@37906
   605
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   606
"--- 7 ---";
neuper@37906
   607
val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
neuper@37906
   608
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   609
"--- 8<> ---";
neuper@37906
   610
val nxt = ("Rewrite_Set",Rewrite_Set "rearrange_assoc");
neuper@37906
   611
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   612
"--- 9<> ---";
neuper@37906
   613
val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
neuper@37906
   614
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   615
"--- 10<> ---";
neuper@37906
   616
val nxt = ("Rewrite_Set",Rewrite_Set "norm_equation");
neuper@37906
   617
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   618
"--- 11<> ---.";
neuper@37906
   619
val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
neuper@37906
   620
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   621
"--- 12<> ---";
neuper@37906
   622
val nxt = ("Rewrite_Set_Inst",Rewrite_Set_Inst (["(bdv,x)"],"isolate_bdv"));
neuper@37906
   623
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   624
"--- 13<> ---";
neuper@37906
   625
val nxt = ("Rewrite_Set",Rewrite_Set "Test_simplify");
neuper@37906
   626
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   627
"--- 1<> ---";
neuper@37906
   628
val nxt = ("Check_Postcond",Check_Postcond ["sqroot-test","univariate","equation","test"]);
neuper@37906
   629
val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
neuper@37906
   630
(* val nxt = ("End_Proof'",End_Proof');*)
neuper@37906
   631
if f <> (Form' (FormKF (~1,EdUndef,0,Nundef,"[x = 4]")))
neuper@38031
   632
then error "root-equ.sml: diff.behav. in me + tacs input"
neuper@37906
   633
else ();
neuper@37906
   634
wneuper@59279
   635
writeln (pr_ctree pr_short pt);
neuper@37906
   636
writeln("result: "^((term2str o fst o (get_obj g_result pt)) [])^
neuper@37906
   637
"\n==============================================================");
neuper@37906
   638