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