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