test/Tools/isac/Interpret/inform.sml
author Walther Neuper <wneuper@ist.tugraz.at>
Thu, 22 Dec 2016 11:36:20 +0100
changeset 59279 255c853ea2f0
parent 59269 1da53d1540fe
child 59348 ddfabb53082c
permissions -rw-r--r--
renamed Ctree.ptree --> Ctree.ctree
akargl@42176
     1
(* Title: tests on inform.sml
akargl@42176
     2
   Author: Walther Neuper 060225,
neuper@37906
     3
   (c) due to copyright terms 
neuper@37906
     4
*)
neuper@37906
     5
neuper@37906
     6
"-----------------------------------------------------------------";
neuper@37906
     7
"table of contents -----------------------------------------------";
neuper@37906
     8
"-----------------------------------------------------------------";
neuper@37906
     9
"appendForm with miniscript with mini-subpbl:";
neuper@37906
    10
"--------- appendFormula: on Res + equ_nrls ----------------------";
neuper@37906
    11
"--------- appendFormula: on Frm + equ_nrls ----------------------";
neuper@37906
    12
"--------- appendFormula: on Res + NO deriv ----------------------";
neuper@37906
    13
"--------- appendFormula: on Res + late deriv --------------------";
neuper@37906
    14
"--------- appendFormula: on Res + late deriv [x = 3 + -2]---///--";
neuper@37906
    15
"replaceForm with miniscript with mini-subpbl:";
neuper@37906
    16
"--------- replaceFormula: on Res + = ----------------------------";
neuper@37906
    17
"--------- replaceFormula: on Res + = 1st Nd ---------------------";
neuper@37906
    18
"--------- replaceFormula: on Frm + = 1st Nd ---------------------";
neuper@37906
    19
"--------- replaceFormula: cut calculation -----------------------";
neuper@37906
    20
"--------- replaceFormula: cut calculation -----------------------";
neuper@37906
    21
(* 040307 copied from informtest.sml ... old versions
neuper@37906
    22
"--------- maximum-example, UC: Modeling / modifyCalcHead --------";*)
neuper@37906
    23
"--------- syntax error ------------------------------------------";
neuper@37906
    24
"CAS-command:";
neuper@37906
    25
"--------- CAS-command on ([],Pbl) -------------------------------";
neuper@37906
    26
"--------- CAS-command on ([],Pbl) FE-interface ------------------";
neuper@37906
    27
"--------- inform [rational,simplification] ----------------------";
neuper@37906
    28
"--------- Take as 1st tac, start with <NEW> (CAS input) ---------";
neuper@37906
    29
"--------- Take as 1st tac, start from exp -----------------------";
neuper@37906
    30
"--------- init_form, start with <NEW> (CAS input) ---------------";
neuper@42423
    31
"--------- build fun check_err_patt ------------------------------";
neuper@42426
    32
"--------- build fun check_err_patt ?bdv -------------------------";
neuper@42428
    33
"--------- build fun check_error_patterns ------------------------";
neuper@42428
    34
"--------- embed fun check_error_patterns ------------------------";
neuper@48895
    35
"--------- build fun get_fillpats --------------------------------";
neuper@42430
    36
"--------- embed fun find_fillpatterns ---------------------------";
neuper@48895
    37
"--------- build fun is_exactly_equal, inputFillFormula ----------";
wneuper@59262
    38
"--------- fun appl_adds -----------------------------------------";
wneuper@59264
    39
"--------- fun concat_deriv --------------------------------------";
wneuper@59264
    40
"--------- handle an input formula -------------------------------";
wneuper@59264
    41
"--------- fun dropwhile' ----------------------------------------";
neuper@37906
    42
"-----------------------------------------------------------------";
neuper@37906
    43
"-----------------------------------------------------------------";
neuper@37906
    44
"-----------------------------------------------------------------";
neuper@37906
    45
neuper@37906
    46
neuper@37906
    47
"--------- appendFormula: on Res + equ_nrls ----------------------";
neuper@37906
    48
"--------- appendFormula: on Res + equ_nrls ----------------------";
neuper@37906
    49
"--------- appendFormula: on Res + equ_nrls ----------------------";
neuper@48790
    50
 val Prog sc = (#scr o get_met) ["Test","squ-equ-test-subpbl1"];
neuper@37906
    51
 (writeln o term2str) sc;
neuper@48790
    52
 val Prog sc = (#scr o get_met) ["Test","solve_linear"];
neuper@37906
    53
 (writeln o term2str) sc;
neuper@37906
    54
s1210629013@55445
    55
 reset_states ();
neuper@41970
    56
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
    57
	    ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
    58
	     ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
    59
 Iterator 1; moveActiveRoot 1;
wneuper@59248
    60
 autoCalculate 1 CompleteCalcHead;
wneuper@59248
    61
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
wneuper@59248
    62
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
neuper@37906
    63
wneuper@59123
    64
 appendFormula 1 "-2 * 1 + (1 + x) = 0" (*|> Future.join*); refFormula 1 (get_pos 1 1);
neuper@37906
    65
 val ((pt,_),_) = get_calc 1;
wneuper@59279
    66
 val str = pr_ctree pr_short pt;
neuper@48895
    67
if str =
neuper@48895
    68
(".    ----- pblobj -----\n" ^
neuper@48895
    69
"1.   x + 1 = 2\n" ^
neuper@48895
    70
"2.   x + 1 + -1 * 2 = 0\n" ^
neuper@48895
    71
"2.1.   x + 1 + -1 * 2 = 0\n" ^
neuper@48895
    72
"2.2.   1 + x + -1 * 2 = 0\n" ^
neuper@48895
    73
"2.3.   1 + (x + -1 * 2) = 0\n" ^
neuper@48895
    74
"2.4.   1 + (x + -2) = 0\n" ^
neuper@48895
    75
"2.5.   1 + (x + -2 * 1) = 0\n" ^
neuper@48895
    76
"2.6.   1 + x + -2 * 1 = 0\n" ) then ()
neuper@48895
    77
else error "inform.sml: diff.behav.appendFormula: on Res + equ 1";
neuper@37906
    78
neuper@37906
    79
 moveDown 1 ([ ],Pbl); refFormula 1 ([1],Frm); (*x + 1 = 2*)
neuper@37906
    80
 moveDown 1 ([1],Frm); refFormula 1 ([1],Res); (*x + 1 + -1 * 2 = 0*)
neuper@37906
    81
neuper@37906
    82
 (*the seven steps of detailed derivation*)
neuper@37906
    83
 moveDown 1 ([1  ],Res); refFormula 1 ([2,1],Frm); 
neuper@37906
    84
 moveDown 1 ([2,1],Frm); refFormula 1 ([2,1],Res);
neuper@37906
    85
 moveDown 1 ([2,1],Res); refFormula 1 ([2,2],Res);
neuper@37906
    86
 moveDown 1 ([2,2],Res); refFormula 1 ([2,3],Res); 
neuper@37906
    87
 moveDown 1 ([2,3],Res); refFormula 1 ([2,4],Res);
neuper@37906
    88
 moveDown 1 ([2,4],Res); refFormula 1 ([2,5],Res);
neuper@37906
    89
 moveDown 1 ([2,5],Res); refFormula 1 ([2,6],Res);
neuper@37906
    90
 val ((pt,_),_) = get_calc 1;
neuper@37906
    91
 if "-2 * 1 + (1 + x) = 0" = term2str (fst (get_obj g_result pt [2,6])) then()
neuper@38031
    92
 else error "inform.sml: diff.behav.appendFormula: on Res + equ 2";
neuper@37906
    93
neuper@37906
    94
 fetchProposedTactic 1; (*takes Iterator 1 _1_*)
neuper@48895
    95
(* <ERROR> error in kernel </ERROR> ALREADY IN 2009-2*)
neuper@48895
    96
(*========== inhibit exn WN1130701 broken at Isabelle2002 --> 2009-2 =============
neuper@37906
    97
 val (_,(tac,_,_)::_) = get_calc 1;
neuper@37906
    98
 if tac = Rewrite_Set "Test_simplify" then ()
neuper@38031
    99
 else error "inform.sml: diff.behav.appendFormula: on Res + equ 3";
neuper@48895
   100
============ inhibit exn WN1130701 broken at Isabelle2002 --> 2009-2 ============*)
akargl@42209
   101
wneuper@59248
   102
 autoCalculate 1 CompleteCalc;
neuper@37906
   103
 val ((pt,_),_) = get_calc 1;
neuper@37906
   104
 if "[x = 1]" = term2str (fst (get_obj g_result pt [])) then ()
neuper@38031
   105
 else error "inform.sml: diff.behav.appendFormula: on Res + equ 4";
wneuper@59248
   106
 (* autoCalculate 1 CompleteCalc;
neuper@37906
   107
   val ((pt,p),_) = get_calc 1;
neuper@37906
   108
   (writeln o istates2str) (get_obj g_loc pt [ ]);  
neuper@37906
   109
   (writeln o istates2str) (get_obj g_loc pt [1]);  
neuper@37906
   110
   (writeln o istates2str) (get_obj g_loc pt [2]);  
neuper@37906
   111
   (writeln o istates2str) (get_obj g_loc pt [3]);  
neuper@37906
   112
   (writeln o istates2str) (get_obj g_loc pt [3,1]);  
neuper@37906
   113
   (writeln o istates2str) (get_obj g_loc pt [3,2]);  
neuper@37906
   114
   (writeln o istates2str) (get_obj g_loc pt [4]);  
neuper@37906
   115
neuper@37906
   116
   *)
neuper@37906
   117
"----------------------------------------------------------";
akargl@42176
   118
akargl@42176
   119
 val fod = make_deriv (@{theory "Isac"}) Atools_erls 
neuper@37906
   120
		       ((#rules o rep_rls) Test_simplify)
akargl@42176
   121
		       (sqrt_right false (@{theory "Pure"})) NONE 
neuper@37906
   122
		       (str2term "x + 1 + -1 * 2 = 0");
neuper@37906
   123
 (writeln o trtas2str) fod;
neuper@37906
   124
akargl@42176
   125
 val ifod = make_deriv (@{theory "Isac"}) Atools_erls 
neuper@37906
   126
		       ((#rules o rep_rls) Test_simplify)
akargl@42176
   127
		       (sqrt_right false (@{theory "Pure"})) NONE 
neuper@37906
   128
		       (str2term "-2 * 1 + (1 + x) = 0");
neuper@37906
   129
 (writeln o trtas2str) ifod;
akargl@42176
   130
 fun equal (_,_,(t1, _)) (_,_,(t2, _)) = t1 = t2;
neuper@37906
   131
 val (fod', rifod') = dropwhile' equal (rev fod) (rev ifod);
neuper@37906
   132
 val der = fod' @ (map rev_deriv' rifod');
neuper@37906
   133
 (writeln o trtas2str) der;
neuper@37906
   134
 "----------------------------------------------------------";
wneuper@59252
   135
DEconstrCalcTree 1;
neuper@37906
   136
neuper@37906
   137
"--------- appendFormula: on Frm + equ_nrls ----------------------";
neuper@37906
   138
"--------- appendFormula: on Frm + equ_nrls ----------------------";
neuper@37906
   139
"--------- appendFormula: on Frm + equ_nrls ----------------------";
s1210629013@55445
   140
 reset_states ();
neuper@41970
   141
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   142
	    ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   143
	     ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   144
 Iterator 1; moveActiveRoot 1;
wneuper@59248
   145
 autoCalculate 1 CompleteCalcHead;
wneuper@59248
   146
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1) (*x + 1 = 2*);
wneuper@59123
   147
 appendFormula 1 "2+ -1 + x = 2" (*|> Future.join*); refFormula 1 (get_pos 1 1);
neuper@37906
   148
neuper@37906
   149
 moveDown 1 ([],Pbl); refFormula 1 ([1],Frm) (*x + 1 = 2*);
neuper@37906
   150
neuper@37906
   151
 moveDown 1 ([1  ],Frm); refFormula 1 ([1,1],Frm); 
neuper@37906
   152
 moveDown 1 ([1,1],Frm); refFormula 1 ([1,1],Res); 
neuper@37906
   153
 moveDown 1 ([1,1],Res); refFormula 1 ([1,2],Res); 
neuper@37906
   154
 moveDown 1 ([1,2],Res); refFormula 1 ([1,3],Res); 
neuper@37906
   155
 moveDown 1 ([1,3],Res); refFormula 1 ([1,4],Res); 
neuper@37906
   156
 moveDown 1 ([1,4],Res); refFormula 1 ([1,5],Res); 
neuper@37906
   157
 moveDown 1 ([1,5],Res); refFormula 1 ([1,6],Res); 
neuper@37906
   158
 val ((pt,_),_) = get_calc 1;
neuper@37906
   159
 if "2 + -1 + x = 2" = term2str (fst (get_obj g_result pt [1,6])) then()
neuper@38031
   160
 else error "inform.sml: diff.behav.appendFormula: on Frm + equ 1";
neuper@37906
   161
neuper@37906
   162
 fetchProposedTactic 1; (*takes Iterator 1 _1_*)
neuper@37906
   163
 val (_,(tac,_,_)::_) = get_calc 1;
wneuper@59253
   164
 case tac of Rewrite_Set "norm_equation" => ()
wneuper@59253
   165
 | _ => error "inform.sml: diff.behav.appendFormula: on Frm + equ 2";
wneuper@59248
   166
 autoCalculate 1 CompleteCalc;
neuper@37906
   167
 val ((pt,_),_) = get_calc 1;
neuper@37906
   168
 if "[x = 1]" = term2str (fst (get_obj g_result pt [])) then ()
neuper@38031
   169
 else error "inform.sml: diff.behav.appendFormula: on Frm + equ 3";
wneuper@59252
   170
DEconstrCalcTree 1;
neuper@37906
   171
neuper@37906
   172
"--------- appendFormula: on Res + NO deriv ----------------------";
neuper@37906
   173
"--------- appendFormula: on Res + NO deriv ----------------------";
neuper@37906
   174
"--------- appendFormula: on Res + NO deriv ----------------------";
s1210629013@55445
   175
 reset_states ();
neuper@41970
   176
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   177
	    ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   178
	     ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   179
 Iterator 1; moveActiveRoot 1;
wneuper@59248
   180
 autoCalculate 1 CompleteCalcHead;
wneuper@59248
   181
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
wneuper@59248
   182
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
neuper@37906
   183
wneuper@59123
   184
 appendFormula 1 "x = 2" (*|> Future.join*);
neuper@37906
   185
 val ((pt,p),_) = get_calc 1;
wneuper@59279
   186
 val str = pr_ctree pr_short pt;
neuper@37906
   187
 writeln str;
neuper@37906
   188
 if str = ".    ----- pblobj -----\n1.   x + 1 = 2\n" andalso p = ([1], Res)
neuper@37906
   189
 then ()
neuper@38031
   190
 else error "inform.sml: diff.behav.appendFormula: Res + NOder 1";
neuper@37906
   191
neuper@37906
   192
 fetchProposedTactic 1;
neuper@37906
   193
 val (_,(tac,_,_)::_) = get_calc 1;
wneuper@59253
   194
 case tac of Rewrite_Set "Test_simplify" => ()
wneuper@59253
   195
 | _ => error "inform.sml: diff.behav.appendFormula: Res + NOder 2";
wneuper@59248
   196
 autoCalculate 1 CompleteCalc;
neuper@37906
   197
 val ((pt,_),_) = get_calc 1;
neuper@37906
   198
 if "[x = 1]" = term2str (fst (get_obj g_result pt [])) then ()
neuper@38031
   199
 else error "inform.sml: diff.behav.appendFormula: on Frm + equ 3";
wneuper@59252
   200
DEconstrCalcTree 1;
neuper@37906
   201
neuper@37906
   202
"--------- appendFormula: on Res + late deriv --------------------";
neuper@37906
   203
"--------- appendFormula: on Res + late deriv --------------------";
neuper@37906
   204
"--------- appendFormula: on Res + late deriv --------------------";
s1210629013@55445
   205
 reset_states ();
neuper@41970
   206
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   207
	    ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   208
	     ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   209
 Iterator 1; moveActiveRoot 1;
wneuper@59248
   210
 autoCalculate 1 CompleteCalcHead;
wneuper@59248
   211
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
wneuper@59248
   212
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
neuper@37906
   213
wneuper@59123
   214
 appendFormula 1 "x = 1" (*|> Future.join*);
neuper@37906
   215
 val ((pt,p),_) = get_calc 1;
wneuper@59279
   216
 val str = pr_ctree pr_short pt;
neuper@37906
   217
 writeln str;
neuper@37906
   218
 if str = ".    ----- pblobj -----\n1.   x + 1 = 2\n2.   x + 1 + -1 * 2 = 0\n3.    ----- pblobj -----\n3.1.   -1 + x = 0\n3.2.   x = 0 + -1 * -1\n3.2.1.   x = 0 + -1 * -1\n3.2.2.   x = 0 + 1\n" andalso p = ([3,2], Res)
neuper@37906
   219
 then () (*finds 1 step too early: ([3,2], Res) "x = 1" also by script !!!*)
neuper@38031
   220
 else error "inform.sml: diff.behav.appendFormula: Res + late d 1";
akargl@42176
   221
neuper@37906
   222
 fetchProposedTactic 1;
neuper@37906
   223
 val (_,(tac,_,_)::_) = get_calc 1;
wneuper@59253
   224
 case tac of Check_Postcond ["LINEAR", "univariate", "equation", "test"] => ()
wneuper@59253
   225
 | _ => error "inform.sml: diff.behav.appendFormula: Res + late d 2";
wneuper@59248
   226
 autoCalculate 1 CompleteCalc;
neuper@37906
   227
 val ((pt,_),_) = get_calc 1;
neuper@37906
   228
 if "[x = 1]" = term2str (fst (get_obj g_result pt [])) then ()
neuper@38031
   229
 else error "inform.sml: diff.behav.appendFormula: Res + late d 3";
wneuper@59252
   230
DEconstrCalcTree 1;
neuper@37906
   231
neuper@37906
   232
"--------- appendFormula: on Res + late deriv [x = 3 + -2]---///--";
neuper@37906
   233
"--------- appendFormula: on Res + late deriv [x = 3 + -2]---///--";
neuper@37906
   234
"--------- appendFormula: on Res + late deriv [x = 3 + -2]---///--";
s1210629013@55445
   235
 reset_states ();
neuper@41970
   236
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   237
	    ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   238
	     ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   239
 Iterator 1; moveActiveRoot 1;
wneuper@59248
   240
 autoCalculate 1 CompleteCalcHead;
wneuper@59248
   241
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
wneuper@59248
   242
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
wneuper@59123
   243
 appendFormula 1 "[x = 3 + -2*1]" (*|> Future.join*);
neuper@37906
   244
 val ((pt,p),_) = get_calc 1;
wneuper@59279
   245
 val str = pr_ctree pr_short pt;
neuper@37906
   246
 writeln str;
neuper@37906
   247
 if str=".    ----- pblobj -----\n1.   x + 1 = 2\n2.   x + 1 + -1 * 2 = 0\n3.    ----- pblobj -----\n3.1.   -1 + x = 0\n3.2.   x = 0 + -1 * -1\n4.   [x = 1]\n4.1.   [x = 1]\n4.2.   [x = -2 + 3]\n4.3.   [x = 3 + -2]\n" then ()
neuper@38031
   248
 else error "inform.sml: diff.behav.appendFormula: Res + latEE 1";
wneuper@59248
   249
 autoCalculate 1 CompleteCalc;
neuper@37906
   250
 val ((pt,p),_) = get_calc 1;
neuper@37906
   251
 if "[x = 3 + -2 * 1]" = term2str (fst (get_obj g_result pt [])) then ()
neuper@37906
   252
 (*       ~~~~~~~~~~ simplify as last step in any script ?!*)
neuper@38031
   253
 else error "inform.sml: diff.behav.appendFormula: Res + latEE 2";
wneuper@59252
   254
DEconstrCalcTree 1;
neuper@37906
   255
neuper@37906
   256
"--------- replaceFormula: on Res + = ----------------------------";
neuper@37906
   257
"--------- replaceFormula: on Res + = ----------------------------";
neuper@37906
   258
"--------- replaceFormula: on Res + = ----------------------------";
s1210629013@55445
   259
 reset_states ();
neuper@41970
   260
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   261
	    ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   262
	     ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   263
 Iterator 1; moveActiveRoot 1;
wneuper@59248
   264
 autoCalculate 1 CompleteCalcHead;
wneuper@59248
   265
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
wneuper@59248
   266
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
wneuper@59248
   267
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*-1 + x*);
neuper@37906
   268
neuper@37906
   269
 replaceFormula 1 "-2 * 1 + (1 + x) = 0"; refFormula 1 (get_pos 1 1);
neuper@37906
   270
 val ((pt,_),_) = get_calc 1;
wneuper@59279
   271
 val str = pr_ctree pr_short pt;
akargl@42176
   272
neuper@48895
   273
(* before AK110725 this was
neuper@48895
   274
".    ----- pblobj -----\n
neuper@48895
   275
1.   x + 1 = 2\n
neuper@48895
   276
2.   x + 1 + -1 * 2 = 0\n
neuper@48895
   277
2.1.   x + 1 + -1 * 2 = 0\n
neuper@48895
   278
2.2.   1 + x + -1 * 2 = 0\n
neuper@48895
   279
2.3.   1 + (x + -1 * 2) = 0\n
neuper@48895
   280
2.4.   1 + (x + -2) = 0\n
neuper@48895
   281
2.5.   1 + (x + -2 * 1) = 0\n
neuper@48895
   282
2.6.   1 + x + -2 * 1 = 0\n";
neuper@48895
   283
*)
neuper@48895
   284
if str = 
neuper@48895
   285
".    ----- pblobj -----\n"^
neuper@48895
   286
"1.   x + 1 = 2\n"^
neuper@48895
   287
"2.   x + 1 + -1 * 2 = 0\n"^
neuper@48895
   288
"2.1.   x + 1 + -1 * 2 = 0\n"^
neuper@48895
   289
"2.2.   1 + x + -1 * 2 = 0\n"^
neuper@48895
   290
"2.3.   1 + (x + -1 * 2) = 0\n"^
neuper@48895
   291
"2.4.   1 + (x + -2) = 0\n"^
neuper@48895
   292
"2.5.   1 + (x + -2 * 1) = 0\n"^
neuper@48895
   293
"2.6.   1 + x + -2 * 1 = 0\n" then()
neuper@48895
   294
else error "inform.sml: diff.behav.replaceFormula: on Res += 1";
akargl@42176
   295
wneuper@59248
   296
 autoCalculate 1 CompleteCalc;
akargl@42176
   297
 val ((pt,pos as (p,_)),_) = get_calc 1;
akargl@42176
   298
 if pos = ([],Res) andalso "[x = 1]" = (term2str o fst) (get_obj g_result pt p) then()
neuper@38031
   299
 else error "inform.sml: diff.behav.replaceFormula: on Res + = 2";
wneuper@59252
   300
DEconstrCalcTree 1;
neuper@37906
   301
neuper@37906
   302
"--------- replaceFormula: on Res + = 1st Nd ---------------------";
neuper@37906
   303
"--------- replaceFormula: on Res + = 1st Nd ---------------------";
neuper@37906
   304
"--------- replaceFormula: on Res + = 1st Nd ---------------------";
s1210629013@55445
   305
 reset_states ();
neuper@41970
   306
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   307
	    ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   308
	     ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   309
 Iterator 1; moveActiveRoot 1;
wneuper@59248
   310
 autoCalculate 1 CompleteCalcHead;
wneuper@59248
   311
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
wneuper@59248
   312
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
neuper@37906
   313
neuper@37906
   314
 replaceFormula 1 "x + 1 = 4 + -2"; refFormula 1 (get_pos 1 1);
neuper@37906
   315
 val ((pt,_),_) = get_calc 1;
wneuper@59279
   316
 val str = pr_ctree pr_short pt;
neuper@37906
   317
 writeln str;
akargl@42176
   318
 if str= ".    ----- pblobj -----\n1.   x + 1 = 2\n1.1.   x + 1 = 2\n1.2.   1 + x = 2\n1.3.   1 + x = -2 + 4\n1.4.   x + 1 = -2 + 4\n" then ()
neuper@38031
   319
 else error "inform.sml: diff.behav.replaceFormula: on Res 1 + = 1";
wneuper@59248
   320
 autoCalculate 1 CompleteCalc;
akargl@42176
   321
 val ((pt,pos as (p,_)),_) = get_calc 1;
akargl@42176
   322
 if pos = ([],Res) andalso "[x = 1]" = (term2str o fst)(get_obj g_result pt p) then()
neuper@38031
   323
 else error "inform.sml: diff.behav.replaceFormula: on Res + = 2";
wneuper@59252
   324
DEconstrCalcTree 1;
neuper@37906
   325
neuper@37906
   326
"--------- replaceFormula: on Frm + = 1st Nd ---------------------";
neuper@37906
   327
"--------- replaceFormula: on Frm + = 1st Nd ---------------------";
neuper@37906
   328
"--------- replaceFormula: on Frm + = 1st Nd ---------------------";
s1210629013@55445
   329
 reset_states ();
neuper@41970
   330
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   331
	    ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   332
	     ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   333
 Iterator 1; moveActiveRoot 1;
wneuper@59248
   334
 autoCalculate 1 CompleteCalcHead;
wneuper@59248
   335
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
neuper@37906
   336
neuper@37906
   337
 replaceFormula 1 "x + 1 = 4 + -2"; refFormula 1 (get_pos 1 1);
neuper@37906
   338
 val ((pt,_),_) = get_calc 1;
wneuper@59279
   339
 val str = pr_ctree pr_short pt;
neuper@37906
   340
 writeln str;
akargl@42176
   341
 if str= ".    ----- pblobj -----\n1.   x + 1 = 2\n1.1.   x + 1 = 2\n1.2.   1 + x = 2\n1.3.   1 + x = -2 + 4\n1.4.   x + 1 = -2 + 4\n" then ()
neuper@38031
   342
 else error "inform.sml: diff.behav.replaceFormula: on Frm 1 + = 1";
wneuper@59248
   343
 autoCalculate 1 CompleteCalc;
akargl@42176
   344
 val ((pt,pos as (p,_)),_) = get_calc 1;
akargl@42176
   345
 if pos = ([],Res) andalso "[x = 1]" = (term2str o fst)(get_obj g_result pt p) then()
neuper@38031
   346
 else error "inform.sml: diff.behav.replaceFormula: on Frm 1 + = 2";
wneuper@59252
   347
DEconstrCalcTree 1;
neuper@37906
   348
neuper@37906
   349
"--------- replaceFormula: cut calculation -----------------------";
neuper@37906
   350
"--------- replaceFormula: cut calculation -----------------------";
neuper@37906
   351
"--------- replaceFormula: cut calculation -----------------------";
s1210629013@55445
   352
 reset_states ();
neuper@41970
   353
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   354
	    ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   355
	     ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   356
 Iterator 1; moveActiveRoot 1;
wneuper@59248
   357
 autoCalculate 1 CompleteCalc;
neuper@37906
   358
 moveActiveRoot 1; moveActiveDown 1;
neuper@37906
   359
 if get_pos 1 1 = ([1], Frm) then ()
neuper@38031
   360
 else error "inform.sml: diff.behav. cut calculation 1";
neuper@37906
   361
neuper@37906
   362
 replaceFormula 1 "x + 1 = 4 + -2"; refFormula 1 (get_pos 1 1);
neuper@37906
   363
 val ((pt,p),_) = get_calc 1;
wneuper@59279
   364
 val str = pr_ctree pr_short pt;
neuper@37906
   365
 writeln str;
neuper@37906
   366
 if p = ([1], Res) then ()
neuper@38031
   367
 else error "inform.sml: diff.behav. cut calculation 2";
neuper@37906
   368
neuper@37906
   369
neuper@37906
   370
(* 040307 copied from informtest.sml; ... old version 
neuper@37906
   371
 "---------------- maximum-example, UC: Modeling / modifyCalcHead -";
neuper@37906
   372
 "---------------- maximum-example, UC: Modeling / modifyCalcHead -";
neuper@37906
   373
 "---------------- maximum-example, UC: Modeling / modifyCalcHead -";
neuper@37906
   374
neuper@37906
   375
 val p = ([],Pbl);
neuper@37906
   376
 val elems = ["fixedValues [r=Arbfix]","maximum A","valuesFor [a,b]",
neuper@37906
   377
	      "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
neuper@37906
   378
	      "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]",
neuper@37906
   379
	      "relations [A=a*b, a/2=r*sin alpha, b/2=r*cos alpha]",
neuper@37906
   380
	      (*^^^ these are the elements for the root-problem (in variants)*)
neuper@37906
   381
              (*vvv these are elements required for subproblems*)
neuper@37906
   382
	      "boundVariable a","boundVariable b","boundVariable alpha",
neuper@37906
   383
	      "interval {x::real. 0 <= x & x <= 2*r}",
neuper@37906
   384
	      "interval {x::real. 0 <= x & x <= 2*r}",
neuper@37906
   385
	      "interval {x::real. 0 <= x & x <= pi}",
neuper@37906
   386
	      "errorBound (eps=(0::real))"]
neuper@37906
   387
 (*specifying is not interesting for this example*)
neuper@38058
   388
 val spec = ("DiffApp", ["maximum_of","function"], 
neuper@37906
   389
	     ["DiffApp","max_by_calculus"]);
neuper@37906
   390
 (*the empty model with descriptions for user-guidance by Model_Problem*)
neuper@37906
   391
 val empty_model = [Given ["fixedValues []"],
neuper@37906
   392
		    Find ["maximum", "valuesFor"],
neuper@37906
   393
		    Relate ["relations []"]];
neuper@37906
   394
neuper@37906
   395
neuper@37906
   396
 (*!!!!!!!!!!!!!!!!! DON'T USE me FOR FINDING nxt !!!!!!!!!!!!!!!!!!*)
neuper@37906
   397
 val (p,_,f,nxt,_,pt) = CalcTreeTEST [(elems, spec)];
neuper@37906
   398
 (*val nxt = ("Model_Problem", ...*)
neuper@37924
   399
 val pbl = get_obj g_pbl pt (fst p); (writeln o (itms2str_ ctxt)) pbl; 
neuper@37906
   400
neuper@37906
   401
 val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   402
 (*nxt = Add_Given "fixedValues [r = Arbfix]"*)
neuper@37924
   403
 val pbl = get_obj g_pbl pt (fst p); (writeln o (itms2str_ ctxt)) pbl; 
neuper@37906
   404
(*[
neuper@37906
   405
(0 ,[] ,false ,#Given ,Inc fixedValues [] ,(??.empty, [])),
neuper@37906
   406
(0 ,[] ,false ,#Find ,Inc maximum ,(??.empty, [])),
neuper@37906
   407
(0 ,[] ,false ,#Find ,Inc valuesFor ,(??.empty, [])),
neuper@37906
   408
(0 ,[] ,false ,#Relate ,Inc relations [] ,(??.empty, []))]*)
neuper@37906
   409
neuper@37906
   410
 (*the empty CalcHead is checked w.r.t the model and re-established as such*)
neuper@37906
   411
 val (b,pt,ocalhd) = input_icalhd pt (p,"", empty_model, Pbl, e_spec);
neuper@37924
   412
 val pbl = get_obj g_pbl pt (fst p); (writeln o (itms2str_ ctxt)) pbl; 
neuper@38031
   413
 if ocalhd2str ocalhd = "(Pbl, ??.empty, [\n(0 ,[] ,false ,#Given ,Inc fixedValues [] ,(??.empty, [])),\n(0 ,[] ,false ,#Find ,Inc maximum ,(??.empty, [])),\n(0 ,[] ,false ,#Find ,Inc valuesFor ,(??.empty, [])),\n(0 ,[] ,false ,#Relate ,Inc relations [] ,(??.empty, []))], [], \n(\"e_domID\", [\"e_pblID\"], [\"e_metID\"]) )" then () else error "informtest.sml: diff.behav. max 1";
neuper@37906
   414
neuper@37906
   415
 (*there is one input to the model (could be more)*)
neuper@37906
   416
 val (b,pt,ocalhd) = 
neuper@37906
   417
     input_icalhd pt (p,"", [Given ["fixedValues [r=Arbfix]"],
neuper@37906
   418
			     Find ["maximum", "valuesFor"],
neuper@37906
   419
			     Relate ["relations"]], Pbl, e_spec);
neuper@37924
   420
 val pbl = get_obj g_pbl pt (fst p); (writeln o (itms2str_ ctxt)) pbl; 
neuper@37906
   421
 if ocalhd2str ocalhd = "(Pbl, ??.empty, [\n(1 ,[1,2,3] ,true ,#Given ,Cor fixedValues [r = Arbfix] ,(fix_, [[r = Arbfix]])),\n(0 ,[] ,false ,#Find ,Inc maximum ,(??.empty, [])),\n(0 ,[] ,false ,#Find ,Inc valuesFor ,(??.empty, [])),\n(0 ,[] ,false ,#Relate ,Inc relations [] ,(??.empty, []))], [], \n(\"e_domID\", [\"e_pblID\"], [\"e_metID\"]) )" then () 
neuper@38031
   422
 else error "informtest.sml: diff.behav. max 2";
neuper@37906
   423
neuper@37906
   424
 (*this input is complete in variant 3, but the ME doesn't recognize FIXXXXME
neuper@37906
   425
 val (b,pt''''',ocalhd) = 
neuper@37906
   426
     input_icalhd pt (p,"", [Given ["fixedValues [r=Arbfix]"],
neuper@37906
   427
			     Find ["maximum A", "valuesFor [a,b]"],
neuper@37906
   428
			     Relate ["relations [A=a*b, a/2=r*sin alpha, \
neuper@37906
   429
				     \b/2=r*cos alpha]"]], Pbl, e_spec);
neuper@37924
   430
 val pbl = get_obj g_pbl pt''''' (fst p); (writeln o (itms2str_ ctxt)) pbl; 
neuper@37906
   431
 if ocalhd2str ocalhd = ------------^^^^^^^^^^ missing !!!*)
neuper@37906
   432
neuper@37906
   433
 (*this input is complete in variant 1 (variant 3 does not work yet)*)
neuper@37906
   434
 val (b,pt''''',ocalhd) = 
neuper@37906
   435
     input_icalhd pt (p,"", [Given ["fixedValues [r=Arbfix]"],
neuper@37906
   436
			     Find ["maximum A", "valuesFor [a,b]"],
neuper@37906
   437
			     Relate ["relations [A=a*b, \
neuper@37906
   438
				     \(a/2)^^^2 + (b/2)^^^2 = r^^^2]"]], 
neuper@37906
   439
		      Pbl, e_spec);
neuper@37924
   440
 val pbl = get_obj g_pbl pt''''' (fst p); (writeln o (itms2str_ ctxt)) pbl; 
neuper@37906
   441
neuper@37906
   442
 modifycalcheadOK2xml 111 (bool2str b) ocalhd;
neuper@37906
   443
*)
wneuper@59252
   444
DEconstrCalcTree 1;
neuper@37906
   445
neuper@37906
   446
"--------- syntax error ------------------------------------------";
neuper@37906
   447
"--------- syntax error ------------------------------------------";
neuper@37906
   448
"--------- syntax error ------------------------------------------";
s1210629013@55445
   449
 reset_states ();
neuper@41970
   450
 CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   451
	    ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   452
	     ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   453
 Iterator 1; moveActiveRoot 1;
wneuper@59248
   454
 autoCalculate 1 CompleteCalcHead;
wneuper@59248
   455
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 = 2*)
wneuper@59248
   456
 autoCalculate 1 (Step 1); refFormula 1 (get_pos 1 1);(*x + 1 + -1 * 2 = 0*);
neuper@37906
   457
neuper@37906
   458
 appendFormula 1 " x - "; (*<ERROR> syntax error in ' x - ' </ERROR>*)
neuper@37906
   459
 val ((pt,_),_) = get_calc 1;
wneuper@59279
   460
 val str = pr_ctree pr_short pt;
neuper@37906
   461
 writeln str;
neuper@37906
   462
 if str = ".    ----- pblobj -----\n1.   x + 1 = 2\n" then ()
neuper@38031
   463
 else error "inform.sml: diff.behav.appendFormula: syntax error";
wneuper@59252
   464
DEconstrCalcTree 1;
neuper@37906
   465
neuper@37906
   466
"--------- CAS-command on ([],Pbl) -------------------------------";
neuper@37906
   467
"--------- CAS-command on ([],Pbl) -------------------------------";
neuper@37906
   468
"--------- CAS-command on ([],Pbl) -------------------------------";
neuper@37906
   469
val (p,_,f,nxt,_,pt) = 
neuper@37906
   470
    CalcTreeTEST [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
neuper@37906
   471
val ifo = "solve(x+1=2,x)";
neuper@37906
   472
val (_,(_,c,(pt,p))) = inform ([],[],(pt,p)) "solve(x+1=2,x)";
neuper@37906
   473
show_pt pt;
neuper@37906
   474
val nxt = ("Apply_Method",Apply_Method ["Test","squ-equ-test-subpbl1"]);
neuper@37906
   475
val (p,_,f,nxt,_,pt) = me nxt p [] pt;
neuper@37906
   476
if p = ([1], Frm) andalso f2str f = "x + 1 = 2" then ()
neuper@38031
   477
else error "inform.sml: diff.behav. CAScmd ([],Pbl)";
wneuper@59252
   478
DEconstrCalcTree 1;
neuper@37906
   479
neuper@37906
   480
"--------- CAS-command on ([],Pbl) FE-interface ------------------";
neuper@37906
   481
"--------- CAS-command on ([],Pbl) FE-interface ------------------";
neuper@37906
   482
"--------- CAS-command on ([],Pbl) FE-interface ------------------";
s1210629013@55445
   483
reset_states ();
neuper@37906
   484
CalcTree [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
neuper@37906
   485
Iterator 1;
neuper@37906
   486
moveActiveRoot 1;
neuper@37906
   487
replaceFormula 1 "solve(x+1=2,x)";
wneuper@59248
   488
autoCalculate 1 CompleteCalc;
neuper@37906
   489
val ((pt,p),_) = get_calc 1;
neuper@37906
   490
show_pt pt;
neuper@37906
   491
if p = ([], Res) then ()
neuper@38031
   492
else error "inform.sml: diff.behav. CAScmd ([],Pbl) FE-interface";
wneuper@59252
   493
DEconstrCalcTree 1;
neuper@37906
   494
neuper@37906
   495
"--------- inform [rational,simplification] ----------------------";
neuper@37906
   496
"--------- inform [rational,simplification] ----------------------";
neuper@37906
   497
"--------- inform [rational,simplification] ----------------------";
s1210629013@55445
   498
reset_states ();
neuper@52105
   499
CalcTree [(["Term (a * x / (b * x) + c * x / (d * x) + e / f)", "normalform N"],
neuper@52105
   500
	("Rational", ["rational", "simplification"], ["simplification", "of_rationals"]))];
neuper@37906
   501
Iterator 1; moveActiveRoot 1;
wneuper@59248
   502
autoCalculate 1 CompleteCalcHead;
neuper@52105
   503
neuper@52105
   504
"--- (-1) give a preview on the calculation without any input";
neuper@52105
   505
(*
wneuper@59248
   506
autoCalculate 1 CompleteCalc;
neuper@52105
   507
val ((pt, p), _) = get_calc 1;
neuper@52105
   508
show_pt pt;
neuper@52105
   509
[
neuper@52105
   510
(([], Frm), Simplify (a * x / (b * x) + c * x / (d * x) + e / f)),
neuper@52105
   511
(([1], Frm), a * x / (b * x) + c * x / (d * x) + e / f),
neuper@52105
   512
(([1], Res), a / b + c / d + e / f),                             <--- (1) input arbitrary
neuper@52105
   513
(([2], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   514
(([3], Res), (a * (d * f) + b * (c * f) + b * (d * e)) / (b * (d * f))),
neuper@52105
   515
(([4], Res), (a * d * f + b * c * f + b * d * e) / (b * d * f)), <--- (2) input next
neuper@52105
   516
(([], Res), (a * d * f + b * c * f + b * d * e) / (b * d * f))]  <--- (3) is also final result
neuper@52105
   517
                                                                          EXAMPLE NOT OPTIMAL
neuper@52105
   518
*)
neuper@52105
   519
"--- (0) user input as the *first* step does not work, thus impdo at least 1 step";
wneuper@59248
   520
autoCalculate 1 (Step 1);
wneuper@59248
   521
autoCalculate 1 (Step 1);
neuper@52105
   522
val ((pt, p), _) = get_calc 1;
neuper@52105
   523
(*show_pt pt;
neuper@52105
   524
[
neuper@52105
   525
(([], Frm), Simplify (a * x / (b * x) + c * x / (d * x) + e / f)),
neuper@52105
   526
(([1], Frm), a * x / (b * x) + c * x / (d * x) + e / f),
neuper@52105
   527
(([1], Res), a / b + c / d + e / f)] 
neuper@52105
   528
*)
neuper@52105
   529
"--- (1) input an arbitrary next formula";
wneuper@59123
   530
appendFormula 1 "((a * d) + (c * b)) / (b * d) + e / f" (*|> Future.join*);
neuper@52105
   531
val ((pt, p), _) = get_calc 1;
neuper@52105
   532
(*show_pt pt;
neuper@52105
   533
[
neuper@52105
   534
(([], Frm), Simplify (a * x / (b * x) + c * x / (d * x) + e / f)),
neuper@52105
   535
(([1], Frm), a * x / (b * x) + c * x / (d * x) + e / f),
neuper@52105
   536
(([1], Res), a / b + c / d + e / f),
neuper@52105
   537
(([2,1], Frm), a / b + c / d + e / f),
neuper@52105
   538
(([2,1], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   539
(([2,2], Res), (a * d + c * b) / (b * d) + e / f),
neuper@52105
   540
(([2], Res), (a * d + c * b) / (b * d) + e / f)] 
neuper@52105
   541
*)
neuper@37906
   542
val ((pt,p),_) = get_calc 1;
neuper@52105
   543
if p = ([2], Res) andalso (length o children o (get_nd pt)) (fst p) = 2 then ()
neuper@38031
   544
else error ("inform.sml: [rational,simplification] 1");
neuper@37906
   545
neuper@52105
   546
"--- (2) input the next formula that would be presented by mat-engine";
neuper@52105
   547
(* generate a preview:
wneuper@59248
   548
autoCalculate 1 (Step 1);
neuper@52105
   549
val ((pt, p), _) = get_calc 1;
neuper@52105
   550
show_pt pt;
neuper@52105
   551
[
neuper@52105
   552
(([], Frm), Simplify (a * x / (b * x) + c * x / (d * x) + e / f)),
neuper@52105
   553
(([1], Frm), a * x / (b * x) + c * x / (d * x) + e / f),
neuper@52105
   554
(([1], Res), a / b + c / d + e / f),
neuper@52105
   555
(([2,1], Frm), a / b + c / d + e / f),
neuper@52105
   556
(([2,1], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   557
(([2,2], Res), (a * d + c * b) / (b * d) + e / f),
neuper@52105
   558
(([2], Res), (a * d + c * b) / (b * d) + e / f),
neuper@52105
   559
(([3], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f))]   <--- input this
neuper@52105
   560
*)
wneuper@59123
   561
appendFormula 1 "(b * d * e + b * c * f + a * d * f) / (b * d * f)" (*|> Future.join*);
neuper@52105
   562
val ((pt, p), _) = get_calc 1;
neuper@52105
   563
(*show_pt pt;
neuper@52105
   564
[
neuper@52105
   565
(([], Frm), Simplify (a * x / (b * x) + c * x / (d * x) + e / f)),
neuper@52105
   566
(([1], Frm), a * x / (b * x) + c * x / (d * x) + e / f),
neuper@52105
   567
(([1], Res), a / b + c / d + e / f),
neuper@52105
   568
(([2,1], Frm), a / b + c / d + e / f),
neuper@52105
   569
(([2,1], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   570
(([2,2], Res), (a * d + c * b) / (b * d) + e / f),
neuper@52105
   571
(([2], Res), (a * d + c * b) / (b * d) + e / f),
neuper@52105
   572
(([3], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f))] 
neuper@52105
   573
*)
neuper@52105
   574
if p = ([3], Res) andalso (length o children o (get_nd pt)) (fst p) = 0 then ()
neuper@38031
   575
else error ("inform.sml: [rational,simplification] 2");
neuper@37906
   576
neuper@52105
   577
"--- (3) input the exact final result";
wneuper@59123
   578
appendFormula 1 "(b * d * e + b * c * f + a * d * f) / (b * d * f)" (*|> Future.join*);
neuper@52105
   579
val ((pt, p), _) = get_calc 1;
neuper@52105
   580
(*show_pt pt;
neuper@52105
   581
[
neuper@52105
   582
(([], Frm), Simplify (a * x / (b * x) + c * x / (d * x) + e / f)),
neuper@52105
   583
(([1], Frm), a * x / (b * x) + c * x / (d * x) + e / f),
neuper@52105
   584
(([1], Res), a / b + c / d + e / f),
neuper@52105
   585
(([2,1], Frm), a / b + c / d + e / f),
neuper@52105
   586
(([2,1], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   587
(([2,2], Res), (a * d + c * b) / (b * d) + e / f),
neuper@52105
   588
(([2], Res), (a * d + c * b) / (b * d) + e / f),
neuper@52105
   589
(([3], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   590
(([4,1], Frm), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   591
(([4,1], Res), (a * (d * f) + b * (c * f) + b * (d * e)) / (b * (d * f))),
neuper@52105
   592
(([4,2], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   593
(([4], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f))] 
neuper@52105
   594
*)
neuper@52105
   595
if p = ([4], Res) andalso (length o children o (get_nd pt)) (fst p) = 2 then ()
neuper@38031
   596
else error ("inform.sml: [rational,simplification] 3");
neuper@52105
   597
neuper@52105
   598
"--- (4) finish the calculation + check the postcondition (in the future)";
wneuper@59248
   599
autoCalculate 1 CompleteCalc;
neuper@52105
   600
val ((pt, p), _) = get_calc 1;
neuper@52105
   601
val (t, asm) = get_obj g_result pt [];
neuper@52105
   602
if term2str t = "(a * d * f + b * c * f + b * d * e) / (b * d * f)" andalso
neuper@52105
   603
terms2str asm = "[\"b * d * f ~= 0\",\"d ~= 0\",\"b ~= 0\"," ^
neuper@52105
   604
  "\"a * x / (b * x) + c * x / (d * x) + e / f is_ratpolyexp\"]"
neuper@52105
   605
then () else error "inform [rational,simplification] changed at end";
neuper@52105
   606
(*show_pt pt;
neuper@52105
   607
[
neuper@52105
   608
(([], Frm), Simplify (a * x / (b * x) + c * x / (d * x) + e / f)),
neuper@52105
   609
(([1], Frm), a * x / (b * x) + c * x / (d * x) + e / f),
neuper@52105
   610
(([1], Res), a / b + c / d + e / f),
neuper@52105
   611
(([2,1], Frm), a / b + c / d + e / f),
neuper@52105
   612
(([2,1], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   613
(([2,2], Res), (a * d + c * b) / (b * d) + e / f),
neuper@52105
   614
(([2], Res), (a * d + c * b) / (b * d) + e / f),
neuper@52105
   615
(([3], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   616
(([4,1], Frm), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   617
(([4,1], Res), (a * (d * f) + b * (c * f) + b * (d * e)) / (b * (d * f))),
neuper@52105
   618
(([4,2], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   619
(([4], Res), (b * d * e + b * c * f + a * d * f) / (b * d * f)),
neuper@52105
   620
(([5], Res), (a * (d * f) + b * (c * f) + b * (d * e)) / (b * (d * f))),
neuper@52105
   621
(([6], Res), (a * d * f + b * c * f + b * d * e) / (b * d * f)),
neuper@52105
   622
(([], Res), (a * d * f + b * c * f + b * d * e) / (b * d * f))] 
neuper@52105
   623
*)
wneuper@59252
   624
DEconstrCalcTree 1;
neuper@37906
   625
neuper@37906
   626
"--------- Take as 1st tac, start with <NEW> (CAS input) ---------";
neuper@37906
   627
"--------- Take as 1st tac, start with <NEW> (CAS input) ---------";
neuper@37906
   628
"--------- Take as 1st tac, start with <NEW> (CAS input) ---------";
neuper@37906
   629
val t = str2term "Diff (x^^^2 + x + 1, x)";
neuper@37906
   630
case t of Const ("Diff.Diff", _) $ _ => ()
neuper@37906
   631
	| _ => raise 
neuper@37906
   632
	      error "diff.sml behav.changed for CAS Diff (..., x)";
neuper@37906
   633
atomty t;
neuper@37906
   634
"-----------------------------------------------------------------";
s1210629013@55445
   635
(*1>*)reset_states ();
neuper@37906
   636
(*2>*)CalcTree [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
neuper@37906
   637
(*3>*)Iterator 1;moveActiveRoot 1;
neuper@37906
   638
"----- here the Headline has been finished";
neuper@37906
   639
(*4>*)moveActiveFormula 1 ([],Pbl);
neuper@37906
   640
(*5>*)replaceFormula 1 "Diff (x^2 + x + 1, x)";
neuper@37906
   641
val ((pt,_),_) = get_calc 1;
neuper@37906
   642
val PblObj {probl, meth, spec, fmz, env, loc, ...} = get_obj I pt [];
neuper@37926
   643
val NONE = env;
neuper@37926
   644
val (SOME istate, NONE) = loc;
wneuper@59111
   645
default_print_depth 5;
neuper@37906
   646
writeln"-----------------------------------------------------------";
neuper@37906
   647
spec;
neuper@37924
   648
writeln (itms2str_ ctxt probl);
neuper@37924
   649
writeln (itms2str_ ctxt meth);
neuper@48895
   650
writeln (istate2str (fst istate));
neuper@37906
   651
neuper@37906
   652
refFormula 1 ([],Pbl) (*--> correct CalcHead*);
neuper@37906
   653
 (*081016 NOT necessary (but leave it in Java):*)
wneuper@59248
   654
(*6>*)(*completeCalcHead*)autoCalculate 1 CompleteCalcHead;
neuper@37906
   655
"----- here the CalcHead has been completed --- ONCE MORE ?????";
neuper@37906
   656
neuper@37906
   657
(***difference II***)
neuper@37906
   658
val ((pt,p),_) = get_calc 1;
neuper@37906
   659
(*val p = ([], Pbl)*)
neuper@37906
   660
val PblObj {probl, meth, spec, fmz, env, loc, ...} = get_obj I pt [];
neuper@37926
   661
val NONE = env;
neuper@37926
   662
val (SOME istate, NONE) = loc;
wneuper@59111
   663
default_print_depth 5; writeln (istate2str (fst istate));  default_print_depth 3;
neuper@37906
   664
(*ScrState ([],
neuper@37926
   665
 [], NONE,
neuper@37906
   666
 ??.empty, Sundef, false)*)
wneuper@59111
   667
default_print_depth 5; spec; default_print_depth 3;
neuper@38050
   668
(*("Isac",
neuper@37906
   669
      ["derivative_of", "function"],
neuper@37906
   670
      ["diff", "differentiate_on_R"]) : spec*)
neuper@37924
   671
writeln (itms2str_ ctxt probl);
neuper@37906
   672
(*[
neuper@37906
   673
(1 ,[1] ,true ,#Given ,Cor functionTerm (x ^^^ 2 + x + 1) ,(f_, [x ^^^ 2 + x + 1])),
neuper@37906
   674
(2 ,[1] ,true ,#Given ,Cor differentiateFor x ,(v_, [x])),
akargl@42176
   675
(3 ,[1] ,true ,#Find ,Cor derivative f_'_f ,(f_'_f, [f_'_f]))]*)
neuper@37924
   676
writeln (itms2str_ ctxt meth);
neuper@37906
   677
(*[
neuper@37906
   678
(1 ,[1] ,true ,#Given ,Cor functionTerm (x ^^^ 2 + x + 1) ,(f_, [x ^^^ 2 + x + 1])),
neuper@37906
   679
(2 ,[1] ,true ,#Given ,Cor differentiateFor x ,(v_, [x])),
akargl@42176
   680
(3 ,[1] ,true ,#Find ,Cor derivative f_'_f ,(f_'_f, [f_'_f]))]*)
neuper@37906
   681
writeln"-----------------------------------------------------------";
neuper@37906
   682
(*7>*)fetchProposedTactic 1 (*--> Apply_Method*);
neuper@37906
   683
(*WN081028 fixed <ERROR> helpless </ERROR> by inform returning ...(.,Met)*)
wneuper@59248
   684
autoCalculate 1 CompleteCalc;
neuper@37906
   685
val ((pt,p),_) = get_calc 1;
neuper@37906
   686
val Form res = (#1 o pt_extract) (pt, ([],Res));
neuper@37906
   687
show_pt pt;
neuper@37906
   688
if p = ([], Res) andalso term2str res = "1 + 2 * x" then ()
neuper@38031
   689
else error "diff.sml behav.changed for Diff (x^2 + x + 1, x)";
wneuper@59252
   690
DEconstrCalcTree 1;
neuper@37906
   691
neuper@37906
   692
"--------- Take as 1st tac, start from exp -----------------------";
neuper@37906
   693
"--------- Take as 1st tac, start from exp -----------------------";
neuper@37906
   694
"--------- Take as 1st tac, start from exp -----------------------";
neuper@37906
   695
(*the following input is copied from BridgeLog Java <==> SML,
neuper@37906
   696
  omitting unnecessary inputs*)
s1210629013@55445
   697
(*1>*)reset_states ();
akargl@42176
   698
(*2>*)CalcTree [(["functionTerm (x^2 + x + 1)", "differentiateFor x", "derivative f_'_f"],("Isac",["derivative_of","function"],["diff","differentiate_on_R"]))];
neuper@37906
   699
(*3>*)Iterator 1; moveActiveRoot 1;
neuper@37906
   700
wneuper@59248
   701
(*6>*)(*completeCalcHead*)autoCalculate 1 CompleteCalcHead;
neuper@37906
   702
(***difference II***)
neuper@37906
   703
val ((pt,_),_) = get_calc 1;
neuper@37906
   704
val PblObj {probl, meth, spec, fmz, env, loc, ...} = get_obj I pt [];
neuper@37926
   705
val NONE = env;
neuper@37926
   706
val (SOME istate, NONE) = loc;
wneuper@59111
   707
default_print_depth 5; writeln (istate2str (fst istate));  default_print_depth 3;
neuper@37906
   708
(*ScrState ([],
neuper@37926
   709
 [], NONE,
neuper@37906
   710
 ??.empty, Sundef, false)*)
wneuper@59111
   711
default_print_depth 5; spec; default_print_depth 3;
neuper@38050
   712
(*("Isac",
neuper@37906
   713
      ["derivative_of", "function"],
neuper@37906
   714
      ["diff", "differentiate_on_R"]) : spec*)
neuper@37924
   715
writeln (itms2str_ ctxt probl);
neuper@37906
   716
(*[
neuper@37906
   717
(1 ,[1] ,true ,#Given ,Cor functionTerm (x ^^^ 2 + x + 1) ,(f_, [x ^^^ 2 + x + 1])),
neuper@37906
   718
(2 ,[1] ,true ,#Given ,Cor differentiateFor x ,(v_, [x])),
akargl@42176
   719
(3 ,[1] ,true ,#Find ,Cor derivative f_'_f ,(f_'_f, [f_'_f]))]*)
neuper@37924
   720
writeln (itms2str_ ctxt meth);
neuper@37906
   721
(*[
neuper@37906
   722
(1 ,[1] ,true ,#Given ,Cor functionTerm (x ^^^ 2 + x + 1) ,(f_, [x ^^^ 2 + x + 1])),
neuper@37906
   723
(2 ,[1] ,true ,#Given ,Cor differentiateFor x ,(v_, [x])),
akargl@42176
   724
(3 ,[1] ,true ,#Find ,Cor derivative f_'_f ,(f_'_f, [f_'_f]))]*)
neuper@37906
   725
writeln"-----------------------------------------------------------";
neuper@37906
   726
(*7>*)fetchProposedTactic 1 (*--> Apply_Method*);
wneuper@59248
   727
autoCalculate 1 (Step 1);
neuper@37906
   728
val ((pt,p),_) = get_calc 1;
neuper@37906
   729
val Form res = (#1 o pt_extract) (pt, p);
neuper@37906
   730
if term2str res = "d_d x (x ^^^ 2 + x + 1)" then ()
neuper@38031
   731
else error "diff.sml Diff (x^2 + x + 1, x) from exp";
wneuper@59252
   732
DEconstrCalcTree 1;
neuper@37906
   733
neuper@37906
   734
"--------- init_form, start with <NEW> (CAS input) ---------------";
neuper@37906
   735
"--------- init_form, start with <NEW> (CAS input) ---------------";
neuper@37906
   736
"--------- init_form, start with <NEW> (CAS input) ---------------";
s1210629013@55445
   737
reset_states ();
neuper@37906
   738
CalcTree [([], ("e_domID", ["e_pblID"], ["e_metID"]))];
neuper@37906
   739
(*[[from sml: > @@@@@begin@@@@@
neuper@37906
   740
[[from sml:  1 
neuper@37906
   741
[[from sml: <CALCTREE>
neuper@37906
   742
[[from sml:    <CALCID> 1 </CALCID>
neuper@37906
   743
[[from sml: </CALCTREE>
neuper@37906
   744
[[from sml: @@@@@end@@@@@*)
neuper@37906
   745
Iterator 1;
neuper@37906
   746
(*[[from sml: > @@@@@begin@@@@@
neuper@37906
   747
[[from sml:  1 
neuper@37906
   748
[[from sml: <ADDUSER>
neuper@37906
   749
[[from sml:   <CALCID> 1 </CALCID>
neuper@37906
   750
[[from sml:   <USERID> 1 </USERID>
neuper@37906
   751
[[from sml: </ADDUSER>
neuper@37906
   752
[[from sml: @@@@@end@@@@@*)
neuper@37906
   753
moveActiveRoot 1;
neuper@37906
   754
(*[[from sml: > @@@@@begin@@@@@
neuper@37906
   755
[[from sml:  1 
neuper@37906
   756
[[from sml: <CALCITERATOR>
neuper@37906
   757
[[from sml:   <CALCID> 1 </CALCID>
neuper@37906
   758
[[from sml:   <POSITION>
neuper@37906
   759
[[from sml:     <INTLIST>
neuper@37906
   760
[[from sml:     </INTLIST>
neuper@37906
   761
[[from sml:     <POS> Pbl </POS>
neuper@37906
   762
[[from sml:   </POSITION>
neuper@37906
   763
[[from sml: </CALCITERATOR>
neuper@37906
   764
[[from sml: @@@@@end@@@@@*)
neuper@37906
   765
getFormulaeFromTo 1 ([],Pbl) ([],Pbl) 0 false;
neuper@37906
   766
(*[[from sml: > @@@@@begin@@@@@                STILL CORRECT
neuper@37906
   767
[[from sml:  1 
neuper@37906
   768
[[from sml: <GETELEMENTSFROMTO>
neuper@37906
   769
[[from sml:   <CALCID> 1 </CALCID>
neuper@37906
   770
[[from sml:   <FORMHEADS>
neuper@37906
   771
[[from sml:     <CALCFORMULA>
neuper@37906
   772
[[from sml:       <POSITION>
neuper@37906
   773
[[from sml:         <INTLIST>
neuper@37906
   774
[[from sml:         </INTLIST>
neuper@37906
   775
[[from sml:         <POS> Pbl </POS>
neuper@37906
   776
[[from sml:       </POSITION>
neuper@37906
   777
[[from sml:       <FORMULA>
neuper@37906
   778
[[from sml:         <MATHML>
neuper@37906
   779
[[from sml:           <ISA> ________________________________________________ </ISA>
neuper@37906
   780
[[from sml:         </MATHML>
neuper@37906
   781
[[from sml: 
neuper@37906
   782
[[from sml:       </FORMULA>
neuper@37906
   783
[[from sml:     </CALCFORMULA>
neuper@37906
   784
[[from sml:   </FORMHEADS>
neuper@37906
   785
[[from sml: </GETELEMENTSFROMTO>
neuper@37906
   786
[[from sml: @@@@@end@@@@@*)
neuper@37906
   787
refFormula 1 ([],Pbl);
neuper@37906
   788
(*[[from sml: > @@@@@begin@@@@@                STILL CORRECT
neuper@37906
   789
[[from sml:  1 
neuper@37906
   790
[[from sml: <REFFORMULA>
neuper@37906
   791
[[from sml:   <CALCID> 1 </CALCID>
neuper@37906
   792
[[from sml:   <CALCHEAD status = "incorrect">
neuper@37906
   793
[[from sml:     <POSITION>
neuper@37906
   794
[[from sml:       <INTLIST>
neuper@37906
   795
[[from sml:       </INTLIST>
neuper@37906
   796
[[from sml:       <POS> Pbl </POS>
neuper@37906
   797
[[from sml:     </POSITION>
neuper@37906
   798
[[from sml:     <HEAD>
neuper@37906
   799
[[from sml:       <MATHML>
neuper@37906
   800
[[from sml:         <ISA> Problem (e_domID, [e_pblID]) </ISA>
neuper@37906
   801
[[from sml:       </MATHML>
neuper@37906
   802
[[from sml:     </HEAD>
neuper@37906
   803
[[from sml:     <MODEL>
neuper@37906
   804
[[from sml:       <GIVEN>  </GIVEN>
neuper@37906
   805
[[from sml:       <WHERE>  </WHERE>
neuper@37906
   806
[[from sml:       <FIND>  </FIND>
neuper@37906
   807
[[from sml:       <RELATE>  </RELATE>
neuper@37906
   808
[[from sml:     </MODEL>
neuper@37906
   809
[[from sml:     <BELONGSTO> Pbl </BELONGSTO>
neuper@37906
   810
[[from sml:     <SPECIFICATION>
neuper@37906
   811
[[from sml:       <THEORYID> e_domID </THEORYID>
neuper@37906
   812
[[from sml:       <PROBLEMID>
neuper@37906
   813
[[from sml:         <STRINGLIST>
neuper@37906
   814
[[from sml:           <STRING> e_pblID </STRING>
neuper@37906
   815
[[from sml:         </STRINGLIST>
neuper@37906
   816
[[from sml:       </PROBLEMID>
neuper@37906
   817
[[from sml:       <METHODID>
neuper@37906
   818
[[from sml:         <STRINGLIST>
neuper@37906
   819
[[from sml:           <STRING> e_metID </STRING>
neuper@37906
   820
[[from sml:         </STRINGLIST>
neuper@37906
   821
[[from sml:       </METHODID>
neuper@37906
   822
[[from sml:     </SPECIFICATION>
neuper@37906
   823
[[from sml:   </CALCHEAD>
neuper@37906
   824
[[from sml: </REFFORMULA>
neuper@37906
   825
[[from sml: @@@@@end@@@@@*)
neuper@37906
   826
moveActiveFormula 1 ([],Pbl);
neuper@37906
   827
(*[[from sml: > @@@@@begin@@@@@
neuper@37906
   828
[[from sml:  1 
neuper@37906
   829
[[from sml: <CALCITERATOR>
neuper@37906
   830
[[from sml:   <CALCID> 1 </CALCID>
neuper@37906
   831
[[from sml:   <POSITION>
neuper@37906
   832
[[from sml:     <INTLIST>
neuper@37906
   833
[[from sml:     </INTLIST>
neuper@37906
   834
[[from sml:     <POS> Pbl </POS>
neuper@37906
   835
[[from sml:   </POSITION>
neuper@37906
   836
[[from sml: </CALCITERATOR>
neuper@37906
   837
[[from sml: @@@@@end@@@@@*)
neuper@37906
   838
replaceFormula 1 "Simplify (1+2)";
neuper@37906
   839
(*[[from sml: > @@@@@begin@@@@@
neuper@37906
   840
[[from sml:  1 
neuper@37906
   841
[[from sml: <REPLACEFORMULA>
neuper@37906
   842
[[from sml:   <CALCID> 1 </CALCID>
neuper@37906
   843
[[from sml:   <CALCCHANGED>
neuper@37906
   844
[[from sml:     <UNCHANGED>
neuper@37906
   845
[[from sml:       <INTLIST>
neuper@37906
   846
[[from sml:       </INTLIST>
neuper@37906
   847
[[from sml:       <POS> Pbl </POS>
neuper@37906
   848
[[from sml:     </UNCHANGED>
neuper@37906
   849
[[from sml:     <DELETED>
neuper@37906
   850
[[from sml:       <INTLIST>
neuper@37906
   851
[[from sml:       </INTLIST>
neuper@37906
   852
[[from sml:       <POS> Pbl </POS>
neuper@37906
   853
[[from sml:     </DELETED>
neuper@37906
   854
[[from sml:     <GENERATED>
neuper@37906
   855
[[from sml:       <INTLIST>
neuper@37906
   856
[[from sml:       </INTLIST>
neuper@37906
   857
[[from sml:       <POS> Met </POS>                           DIFFERENCE: Pbl
neuper@37906
   858
[[from sml:     </GENERATED>
neuper@37906
   859
[[from sml:   </CALCCHANGED>
neuper@37906
   860
[[from sml: </REPLACEFORMULA>
neuper@37906
   861
[[from sml: @@@@@end@@@@@*)
neuper@37906
   862
getFormulaeFromTo 1 ([],Pbl) ([],Pbl) 0 false(*              DIFFERENCE: Pbl*);
neuper@37906
   863
(*@@@@@begin@@@@@
neuper@37906
   864
 1
neuper@37906
   865
<GETELEMENTSFROMTO>
neuper@37906
   866
  <CALCID> 1 </CALCID>
neuper@37906
   867
  <FORMHEADS>
neuper@37906
   868
    <CALCFORMULA>
neuper@37906
   869
      <POSITION>
neuper@37906
   870
        <INTLIST>
neuper@37906
   871
        </INTLIST>
neuper@37906
   872
        <POS> Pbl </POS>
neuper@37906
   873
      </POSITION>
neuper@37906
   874
      <FORMULA>
neuper@37906
   875
        <MATHML>
neuper@37906
   876
          <ISA> Simplify (1 + 2) </ISA>                      WORKS !!!!!
neuper@37906
   877
        </MATHML>
neuper@37906
   878
      </FORMULA>
neuper@37906
   879
    </CALCFORMULA>
neuper@37906
   880
  </FORMHEADS>
neuper@37906
   881
</GETELEMENTSFROMTO>
neuper@37906
   882
@@@@@end@@@@@*)
neuper@37906
   883
getFormulaeFromTo 1 ([],Pbl) ([],Met) 0 false;
neuper@37906
   884
(*[[from sml: > @@@@@begin@@@@@
neuper@37906
   885
[[from sml:  1 
neuper@37906
   886
[[from sml: <SYSERROR>
neuper@37906
   887
[[from sml:   <CALCID> 1 </CALCID>
neuper@37906
   888
[[from sml:   <ERROR> error in getFormulaeFromTo </ERROR>
neuper@37906
   889
[[from sml: </SYSERROR>
neuper@37906
   890
[[from sml: @@@@@end@@@@@*)
neuper@37906
   891
(*step into getFormulaeFromTo --- bug corrected...*)
neuper@42423
   892
neuper@42423
   893
"--------- build fun check_err_patt ------------------------------";
neuper@42423
   894
"--------- build fun check_err_patt ------------------------------";
neuper@42423
   895
"--------- build fun check_err_patt ------------------------------";
neuper@42426
   896
val subst = [(str2term "bdv", str2term "x")]: subst;
neuper@42423
   897
val rls = norm_Rational
neuper@42423
   898
val pat = parse_patt @{theory} "(?a + ?b)/(?b + ?c) = ?a / ?c";
neuper@42423
   899
val (res, inf) = (str2term "(2 + 3)/(3 + 4)", str2term "2 / 4");
neuper@42423
   900
val (res, inf) = (str2term "(2 + 3)/(3 + 4)", str2term "1 / 2");
neuper@42423
   901
neuper@42426
   902
val (res', _, _, rewritten) = (*rewritten: the lhs of the pattern matches in res*)
neuper@42423
   903
  rew_sub thy 1 [] e_rew_ord e_rls false [] (Trueprop $ pat) res;
neuper@42423
   904
if rewritten then NONE else SOME "e_errpatID";
neuper@42423
   905
neuper@42423
   906
val norm_res = case rewrite_set_ (Isac()) false rls res' of
neuper@42423
   907
  NONE => res'
neuper@42423
   908
| SOME (norm_res, _) => norm_res
neuper@42423
   909
neuper@42423
   910
val norm_inf = case rewrite_set_ (Isac()) false rls inf of
neuper@42423
   911
  NONE => inf
neuper@42423
   912
| SOME (norm_inf, _) => norm_inf;
neuper@42423
   913
neuper@42423
   914
res' = inf;
neuper@42423
   915
norm_res = norm_inf;
neuper@42423
   916
neuper@42423
   917
val pat = parse_patt @{theory} "(?a + ?b)/?a = ?b";
neuper@42423
   918
val (res, inf) = (str2term "(2 + 3)/2", str2term "3");
neuper@42426
   919
if check_err_patt (res, inf) subst ("errpatID", pat) rls = SOME "errpatID"
neuper@42423
   920
then () else error "error patt example1 changed";
neuper@42423
   921
neuper@42423
   922
val pat = parse_patt @{theory} "(?a + ?b)/(?a + ?c) = ?b / ?c";
neuper@42423
   923
val (res, inf) = (str2term "(2 + 3)/(2 + 4)", str2term "3 / 4");
neuper@42426
   924
if check_err_patt (res, inf) subst ("errpatID", pat) rls = SOME "errpatID"
neuper@42423
   925
then () else error "error patt example2 changed";
neuper@42423
   926
neuper@42423
   927
val pat = parse_patt @{theory} "(?a + ?b)/(?b + ?c) = ?a / ?c";
neuper@42423
   928
val (res, inf) = (str2term "(2 + 3)/(3 + 4)", str2term "2 / 4");
neuper@42426
   929
if check_err_patt (res, inf) subst ("errpatID", pat) rls = SOME "errpatID"
neuper@42423
   930
then () else error "error patt example3 changed";
neuper@42423
   931
neuper@42423
   932
val inf =  str2term "1 / 2";
neuper@42426
   933
if check_err_patt (res, inf) subst ("errpatID", pat) rls = SOME "errpatID"
neuper@42423
   934
then () else error "error patt example3 changed";
neuper@42423
   935
neuper@42426
   936
"--------- build fun check_err_patt ?bdv -------------------------";
neuper@42426
   937
"--------- build fun check_err_patt ?bdv -------------------------";
neuper@42426
   938
"--------- build fun check_err_patt ?bdv -------------------------";
neuper@42426
   939
val subst = [(str2term "bdv", str2term "x")]: subst;
neuper@42426
   940
val t = str2term "d_d x (x ^^^ 2 + sin (x ^^^ 4))";
neuper@42426
   941
val SOME (t, _) = rewrite_set_inst_ thy false subst norm_diff t;
neuper@42426
   942
if term2str t = "2 * x + cos (x ^^^ 4) * 4 * x ^^^ 3" then ()
neuper@42426
   943
else error "build fun check_err_patt ?bdv changed 1"; 
neuper@42423
   944
neuper@42426
   945
val rls = norm_diff
neuper@42426
   946
val pat = parse_patt @{theory} "d_d ?bdv (sin ?u) = cos (d_d ?bdv ?u)"; 
neuper@42426
   947
val (res, inf) = (str2term "2 * x + d_d x (sin (x ^^^ 4))", str2term "2 * x + cos (4 * x ^^^ 3)");
neuper@42426
   948
neuper@42426
   949
val (res', _, _, rewritten) = (*rewritten: the lhs of the pattern matches in res*)
neuper@42426
   950
  rew_sub thy 1 subst e_rew_ord e_rls false [] (Trueprop $ pat) res;
neuper@42426
   951
if term2str res' = "2 * x + cos (d_d x (x ^^^ 4))" andalso rewritten then ()
neuper@42426
   952
else error "build fun check_err_patt ?bdv changed 2";
neuper@42426
   953
neuper@42426
   954
val norm_res = case rewrite_set_inst_ (Isac()) false subst rls  res' of
neuper@42426
   955
  NONE => res'
neuper@42426
   956
| SOME (norm_res, _) => norm_res;
neuper@42426
   957
if term2str norm_res = "2 * x + cos (4 * x ^^^ 3)" then ()
neuper@42426
   958
else error "build fun check_err_patt ?bdv changed 3";
neuper@42426
   959
neuper@42426
   960
val norm_inf = case rewrite_set_inst_ (Isac()) false subst rls inf of
neuper@42426
   961
  NONE => inf
neuper@42426
   962
| SOME (norm_inf, _) => norm_inf;
neuper@42426
   963
if term2str norm_inf = "2 * x + cos (4 * x ^^^ 3)" then ()
neuper@42426
   964
else error "build fun check_err_patt ?bdv changed 4";
neuper@42426
   965
neuper@42426
   966
res' = inf;
neuper@42426
   967
if norm_res = norm_inf then ()
neuper@42426
   968
else error "build fun check_err_patt ?bdv changed 5";
neuper@42426
   969
neuper@42426
   970
if check_err_patt (res, inf) (subst: subst) ("errpatID": errpatID, pat) rls = SOME "errpatID"
neuper@42426
   971
then () else error "error patt example1 changed";
neuper@42426
   972
neuper@42428
   973
"--------- build fun check_error_patterns ------------------------";
neuper@42428
   974
"--------- build fun check_error_patterns ------------------------";
neuper@42428
   975
"--------- build fun check_error_patterns ------------------------";
neuper@42428
   976
val (res, inf) =
neuper@42428
   977
  (str2term "d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))",
neuper@42428
   978
   str2term "d_d x (x ^^^ 2) + cos (4 * x ^^^ 3)");
neuper@48790
   979
val {errpats, nrls = rls, scr = Prog prog, ...} = get_met ["diff", "differentiate_on_R"]
neuper@42426
   980
neuper@42428
   981
val env = [(str2term "v_v", str2term "x")];
neuper@42428
   982
val errpats =
neuper@42428
   983
  [e_errpat, (*generalised for testing*)
neuper@42428
   984
   ("chain-rule-diff-both",
neuper@42428
   985
     [parse_patt @{theory} "d_d ?bdv (sin ?u) = cos (d_d ?bdv ?u)",
neuper@42428
   986
      parse_patt @{theory} "d_d ?bdv (cos ?u) = - sin (d_d ?bdv ?u)",
neuper@42428
   987
      parse_patt @{theory} "d_d ?bdv (?u ^^^ ?n) = ?n * ?u ^^^ (?n - 1)",
neuper@42428
   988
      parse_patt @{theory} "d_d ?bdv (LogExp.ln ?u) = 1 / ?u",
neuper@42428
   989
      parse_patt @{theory} "d_d ?bdv (LogExp.ln ?u) = 1 / d_d ?bdv ?u"],
neuper@42428
   990
     [@{thm diff_sin_chain}, @{thm diff_cos_chain}, @{thm diff_pow_chain}, 
neuper@42428
   991
      @{thm diff_ln_chain}, @{thm  diff_exp_chain}])]: errpat list;
neuper@42428
   992
case check_error_patterns (res, inf) (prog, env) (errpats, rls) of SOME _ => () 
neuper@42428
   993
| NONE => error "check_error_patterns broken";
wneuper@59252
   994
DEconstrCalcTree 1;
neuper@42428
   995
neuper@42428
   996
"--------- embed fun check_error_patterns ------------------------";
neuper@42428
   997
"--------- embed fun check_error_patterns ------------------------";
neuper@42428
   998
"--------- embed fun check_error_patterns ------------------------";
s1210629013@55445
   999
reset_states ();
neuper@42428
  1000
CalcTree
neuper@42428
  1001
[(["functionTerm (x ^ 2 + sin (x ^ 4))", "differentiateFor x", "derivative f_f'"], 
neuper@42428
  1002
  ("Isac", ["derivative_of","function"], ["diff","differentiate_on_R"]))];
neuper@42428
  1003
Iterator 1;
neuper@42428
  1004
moveActiveRoot 1;
wneuper@59248
  1005
autoCalculate 1 CompleteCalcHead;
wneuper@59248
  1006
autoCalculate 1 (Step 1);
wneuper@59248
  1007
autoCalculate 1 (Step 1);(*([1], Res), d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))*)
wneuper@59248
  1008
(*autoCalculate 1 (Step 1);([2], Res), d_d x (x ^^^ 2) + cos (x ^^^ 4) * d_d x (x ^^^ 4)*)
neuper@42428
  1009
neuper@42428
  1010
"~~~~~ fun appendFormula, args:"; val (cI, (ifo:cterm')) = (1, "d_d x (x ^ 2) + cos (4 * x ^ 3)");
neuper@42428
  1011
val cs = get_calc cI
neuper@42428
  1012
val pos as (_,p_) = get_pos cI 1; (*pos = ([1], Res)*)
neuper@42428
  1013
val cs' = 
neuper@42428
  1014
    case step pos cs of
neuper@42428
  1015
	    ("ok", cs') => cs';
neuper@42428
  1016
neuper@42428
  1017
val (_, _, (pt, ([2], Res))) = cs';
neuper@42428
  1018
(*show_pt pt;
neuper@42428
  1019
  [(([], Frm), Diff (x ^^^ 2 + sin (x ^^^ 4), x)),
neuper@42428
  1020
   (([1], Frm), d_d x (x ^^^ 2 + sin (x ^^^ 4))),
neuper@42428
  1021
   (([1], Res), d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))), <<=== input follos: "...+ cos(4.x^3)"
neuper@42428
  1022
   (([2], Res), d_d x (x ^^^ 2) + cos (x ^^^ 4) * d_d x (x ^^^ 4))] *)
neuper@42428
  1023
neuper@42428
  1024
"~~~~~ fun inform, args:"; val ((cs as (_, _, ptp as (pt, pos as (p, p_))): calcstate'), istr) =
neuper@42428
  1025
  (cs', (encode ifo));
neuper@42428
  1026
val 	SOME f_in = parse (assoc_thy "Isac") istr
wneuper@59188
  1027
val f_in = Thm.term_of f_in
neuper@42428
  1028
val pos_pred = lev_back' pos
neuper@42428
  1029
			(* f_pred ---"step pos cs"---> f_succ in appendFormula
neuper@42428
  1030
   TODO.WN120517: one starting point for redesign of pos' *)
neuper@42432
  1031
val (f_pred, f_succ) = (get_curr_formula (pt, pos_pred), get_curr_formula (pt, pos));
neuper@42428
  1032
	
neuper@42428
  1033
term2str f_pred = "d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))";
neuper@42428
  1034
term2str f_succ = "d_d x (x ^^^ 2) + cos (x ^^^ 4) * d_d x (x ^^^ 4)";
neuper@42428
  1035
neuper@42428
  1036
			f_succ = f_in; (* = false*)
neuper@42428
  1037
cas_input f_in; (* = NONE*)
neuper@42428
  1038
val msg_calcstate' = compare_step ([], [], (pt, pos_pred)) f_in
neuper@42428
  1039
val ("no derivation found", calcstate') = msg_calcstate';
neuper@42428
  1040
			                 val pp = par_pblobj pt p
neuper@48790
  1041
			                 val {errpats, nrls, scr = Prog prog, ...} = get_met (get_obj g_metID pt pp)
neuper@42428
  1042
			                 val ScrState (env, _, _, _, _, _) = get_istate pt pos;
neuper@42428
  1043
                 case check_error_patterns (f_pred, f_in) (prog, env) (errpats, nrls) of
neuper@42428
  1044
			                   SOME errpatID => ("error pattern #" ^ errpatID ^ "#", calcstate')
neuper@42428
  1045
			                 | NONE => msg_calcstate';
neuper@42428
  1046
neuper@42428
  1047
"~~~~~ from inform return val:"; val () = ();
neuper@42428
  1048
case check_error_patterns (f_pred, f_in) (prog, env) (errpats, nrls) of
neuper@42428
  1049
			  SOME errpatID => ()
neuper@42428
  1050
			| NONE => error "check_error_patterns broken";
neuper@42428
  1051
neuper@42428
  1052
"--- final check:";
neuper@42428
  1053
case inform cs' (encode ifo) of
neuper@42428
  1054
  ("error pattern #chain-rule-diff-both#", calcstate') => ()
neuper@42428
  1055
| _ => error "inform with (positive) check_error_patterns broken"
neuper@42428
  1056
neuper@48895
  1057
"--------- build fun get_fillpats --------------------------------";
neuper@48895
  1058
"--------- build fun get_fillpats --------------------------------";
neuper@48895
  1059
"--------- build fun get_fillpats --------------------------------";
neuper@48895
  1060
(*cause for this test was: wrong thy in Build_Thydata.thy in 
neuper@48895
  1061
  insert_fillpats ["IsacKnowledge", "Diff", "Theorems", "diff_sin_chain"]*)
neuper@48895
  1062
val f_curr = str2term "d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))"
neuper@48895
  1063
val errpatID = "chain-rule-diff-both"
neuper@48895
  1064
  val {errpats, scr = Prog prog, ...} = get_met ["diff", "differentiate_on_R"]
neuper@48895
  1065
val env = 
neuper@48895
  1066
  [(str2term "f_f", str2term "x ^^^ 2 + sin (x ^^^ 4)"),
neuper@48895
  1067
   (str2term "v_v", str2term "x"),
neuper@48895
  1068
   (str2term "f_f'", str2term "d_d x (x ^^^ 2 + sin (x ^^^ 4))")]
neuper@48895
  1069
  val subst = get_bdv_subst prog env
neuper@48895
  1070
  val errpatthms = errpats
neuper@48895
  1071
    |> filter ((curry op = errpatID) o (#1: errpat -> errpatID))
neuper@48895
  1072
    |> map (#3: errpat -> thm list)
neuper@48895
  1073
    |> flat;
neuper@48895
  1074
"~~~~~ fun get_fillpats, args:"; val (subst, form, errpatID, thm) =
neuper@48895
  1075
  (subst, f_curr, errpatID, hd (*simulate beginning of "map"*) errpatthms);
neuper@48895
  1076
        val thmDeriv = Thm.get_name_hint thm
neuper@48895
  1077
        val (part, thyID) = thy_containing_thm thmDeriv
neuper@48895
  1078
        val theID = [part, thyID, "Theorems", thmID_of_derivation_name thmDeriv]
neuper@48895
  1079
        val Hthm {fillpats, ...} = get_the theID
neuper@48895
  1080
        val some = map (get_fillform subst (thm, form) errpatID) fillpats;
neuper@48895
  1081
"~~~~~ fun get_fillform, args:";
neuper@48895
  1082
  val ((subs_opt, subst), (thm, form), errpatID, (fillpatID, pat, erpaID)) =
neuper@48895
  1083
  (subst, (thm, form), errpatID, hd (*simulate beginning of "map"*) fillpats);
neuper@48895
  1084
  val (form', _, _, rewritten) =
neuper@48895
  1085
        rew_sub (Isac()) 1 subst e_rew_ord e_rls false [] (Trueprop $ pat) form;
neuper@48895
  1086
"~~~~~ fun rew_sub, args:"; val (thy, i, bdv, tless, rls, put_asm, lrd:lrd list, r, t) = 
neuper@48895
  1087
  ((Isac()), 1, subst, e_rew_ord, e_rls, false, [], (Trueprop $ pat), form);
neuper@48895
  1088
     val (lhs, rhs) = (HOLogic.dest_eq o HOLogic.dest_Trueprop
neuper@48895
  1089
                       o Logic.strip_imp_concl) r;
neuper@48895
  1090
(*/-------------catch the planned exception*)
neuper@48895
  1091
(let
neuper@48895
  1092
     val r' = Envir.subst_term (Pattern.match thy (lhs, t) 
neuper@48895
  1093
					      (Vartab.empty, Vartab.empty)) r;
neuper@48895
  1094
in 111 end
neuper@48895
  1095
) handle PATTERN (*because only a subterm matches*) => 111;
neuper@48895
  1096
case t of t1 $ t2 => 
neuper@48895
  1097
	  let val (t2', asm2, lrd, rew2) = rew_sub thy i bdv tless rls put_asm (lrd@[R]) r t2
neuper@48895
  1098
	  in 
neuper@48895
  1099
	    if rew2 then (t1 $ t2', asm2, lrd, true) else
neuper@48895
  1100
	      let val (t1', asm1, lrd, rew1) = rew_sub thy i bdv tless rls put_asm (lrd@[L]) r t1
neuper@48895
  1101
	      in if rew1 then (t1' $ t2, asm1, lrd, true) else (t1 $ t2,[], lrd, false) end
neuper@48895
  1102
	  end;
neuper@48895
  1103
(*catch the planned exception-------------/*)
neuper@48895
  1104
neuper@48895
  1105
val t1 $ t2 = t;
neuper@48895
  1106
val (t2', asm2, lrd, rew2) = rew_sub thy i bdv tless rls put_asm (lrd@[R]) r t2;
neuper@48895
  1107
"~~~~~ fun rew_sub, args:"; val (thy, i, bdv, tless, rls, put_asm, lrd:lrd list, r, t) = 
neuper@48895
  1108
  (thy, i, bdv, tless, rls, put_asm, (lrd@[R]), r, t2);
neuper@48895
  1109
     val (lhs, rhs) = (HOLogic.dest_eq o HOLogic.dest_Trueprop o Logic.strip_imp_concl) r;
neuper@48895
  1110
     val r' = Envir.subst_term (Pattern.match thy (lhs, t) (Vartab.empty, Vartab.empty)) r;
neuper@48895
  1111
     val p' = map HOLogic.dest_Trueprop ((fst o Logic.strip_prems) (Logic.count_prems r', [], r'));
neuper@48895
  1112
     val t' = (snd o HOLogic.dest_eq o HOLogic.dest_Trueprop o Logic.strip_imp_concl) r';
neuper@48895
  1113
if term2str t' = "cos (x ^^^ 4) * d_d x ?_dummy_1" then ()
neuper@48895
  1114
  else error "get_fillpats changed 1"
wneuper@59252
  1115
DEconstrCalcTree 1;
neuper@48895
  1116
neuper@42430
  1117
"--------- embed fun find_fillpatterns ---------------------------";
neuper@42430
  1118
"--------- embed fun find_fillpatterns ---------------------------";
neuper@42430
  1119
"--------- embed fun find_fillpatterns ---------------------------";
s1210629013@55445
  1120
reset_states ();
neuper@42430
  1121
CalcTree
neuper@42430
  1122
[(["functionTerm (x ^ 2 + sin (x ^ 4))", "differentiateFor x", "derivative f_f'"], 
neuper@42430
  1123
  ("Isac", ["derivative_of","function"], ["diff","differentiate_on_R"]))];
neuper@42430
  1124
Iterator 1;
neuper@42430
  1125
moveActiveRoot 1;
wneuper@59248
  1126
autoCalculate 1 CompleteCalcHead;
wneuper@59248
  1127
autoCalculate 1 (Step 1);
wneuper@59248
  1128
autoCalculate 1 (Step 1);(*([1], Res), d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))*)
wneuper@59123
  1129
appendFormula 1 "d_d x (x ^ 2) + cos (4 * x ^ 3)" (*|> Future.join*);
neuper@42430
  1130
  (*<CALCMESSAGE> error pattern #chain-rule-diff-both# </CALCMESSAGE>*)
neuper@42432
  1131
  (*or
neuper@42432
  1132
    <CALCMESSAGE> no derivation found </CALCMESSAGE>*)
neuper@42430
  1133
neuper@42433
  1134
"~~~~~ fun findFillpatterns, args:"; val (cI, errpatID) = (1, "chain-rule-diff-both");
neuper@42430
  1135
  val ((pt, _), _) = get_calc cI
neuper@42430
  1136
				val pos = get_pos cI 1;
neuper@42432
  1137
"~~~~~ fun find_fillpatterns, args:"; val ((pt, pos as (p, _)), errpatID) = ((pt, pos), errpatID);
neuper@42432
  1138
	    val f_curr = get_curr_formula (pt, pos); (* = "d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))"*)
neuper@42430
  1139
    val pp = par_pblobj pt p
neuper@48895
  1140
    val {errpats, scr = Prog prog, ...} = get_met (get_obj g_metID pt pp)
neuper@42430
  1141
    val ScrState (env, _, _, _, _, _) = get_istate pt pos
neuper@42430
  1142
    val subst = get_bdv_subst prog env
neuper@42430
  1143
    val errpatthms = errpats
neuper@42430
  1144
      |> filter ((curry op = errpatID) o (#1: errpat -> errpatID))
neuper@42430
  1145
      |> map (#3: errpat -> thm list)
neuper@42430
  1146
      |> flat;
neuper@42430
  1147
neuper@42430
  1148
case map (get_fillpats subst f_curr errpatID) errpatthms |> flat of
neuper@42433
  1149
  ("fill-d_d-arg", tm, thm, subs_opt) :: _ => if term2str tm = 
neuper@42432
  1150
    "d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4)) =\nd_d x (x ^^^ 2) + cos (x ^^^ 4) * d_d x ?_dummy_1"
neuper@42432
  1151
    then () else error "find_fillpatterns changed 1a"
neuper@42432
  1152
| _ => error "find_fillpatterns changed 1b"
neuper@42430
  1153
neuper@42430
  1154
"~~~~~ fun get_fillpats, args:"; val (subst, form, errpatID, thm) =
neuper@42432
  1155
  (subst, f_curr, errpatID, hd (*simulate beginning of "map"*) errpatthms);
neuper@42430
  1156
        val thmDeriv = Thm.get_name_hint thm
neuper@42430
  1157
        val (part, thyID) = thy_containing_thm thmDeriv
neuper@42430
  1158
        val theID = [part, thyID, "Theorems", thmID_of_derivation_name thmDeriv]
neuper@42430
  1159
        val Hthm {fillpats, ...} = get_the theID
neuper@42433
  1160
        val some = map (get_fillform subst (thm, form) errpatID) fillpats;
neuper@42430
  1161
neuper@42430
  1162
case some |> filter is_some |> map the of
neuper@42433
  1163
  ("fill-d_d-arg", tm, thm, subsopt) :: _ => if term2str tm = 
neuper@42432
  1164
    "d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4)) =\nd_d x (x ^^^ 2) + cos (x ^^^ 4) * d_d x ?_dummy_1"
neuper@42432
  1165
    then () else error "find_fillpatterns changed 2a"
neuper@42432
  1166
| _ => error "find_fillpatterns changed 2b"
neuper@42430
  1167
neuper@42433
  1168
"~~~~~ fun get_fillform, args:";
neuper@42433
  1169
  val ((subs_opt, subst), (thm, form), errpatID, (fillpatID, pat, erpaID)) =
neuper@42433
  1170
  (subst, (thm, form), errpatID, hd (*simulate beginning of "map"*) fillpats);
neuper@42433
  1171
val (form', _, _, rewritten) =
neuper@42432
  1172
      rew_sub (Isac()) 1 subst e_rew_ord e_rls false [] (Trueprop $ pat) form;
neuper@42432
  1173
neuper@42432
  1174
if term2str form' = "d_d x (x ^^^ 2) + cos (x ^^^ 4) * d_d x ?_dummy_1" then ()
neuper@42432
  1175
else error "find_fillpatterns changed 3";
neuper@42432
  1176
neuper@42433
  1177
"~~~~~ to findFillpatterns return val:"; val (fillpats) =
neuper@42433
  1178
  (map (get_fillpats (subs_opt, subst) f_curr errpatID) errpatthms |> flat) (*only from "hd errpatthms"*);
neuper@42432
  1179
neuper@42450
  1180
"vvv--- dropped this code WN120730";
neuper@42433
  1181
val msg = "fill patterns " ^
neuper@42433
  1182
  ((map ((apsnd term2str) o quad2pair) fillpats) |> map pair2str_ |> strs2str_);
neuper@42450
  1183
msg =
neuper@42432
  1184
  "fill patterns #fill-d_d-arg#d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))" ^
neuper@42432
  1185
    " =\nd_d x (x ^^^ 2) + cos (x ^^^ 4) * d_d x ?_dummy_1" ^
neuper@42432
  1186
  "#fill-both-args#d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))" ^
neuper@42432
  1187
    " =\nd_d x (x ^^^ 2) + cos ?_dummy_2 * d_d x ?_dummy_3" ^
neuper@42432
  1188
  "#fill-d_d#d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))" ^
neuper@42432
  1189
    " =\nd_d x (x ^^^ 2) + cos (x ^^^ 4) * ?_dummy_1 x (x ^^^ 4)" ^
neuper@42432
  1190
  "#fill-inner-deriv#d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))" ^
neuper@42432
  1191
    " =\nd_d x (x ^^^ 2) + cos (x ^^^ 4) * ?_dummy_1" ^
neuper@42450
  1192
  "#fill-all#d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4)) = d_d x (x ^^^ 2) + ?_dummy_1#";
neuper@42450
  1193
"^^^--- dropped this code WN120730";
neuper@42450
  1194
neuper@42450
  1195
if (map #1 fillpats) =
neuper@42450
  1196
  ["fill-d_d-arg", "fill-both-args", "fill-d_d", "fill-inner-deriv", "fill-all"]
neuper@42450
  1197
then () else error "find_fillpatterns changed 4b";
wneuper@59252
  1198
DEconstrCalcTree 1;
neuper@42450
  1199
neuper@42437
  1200
"--------- build fun is_exactly_equal, inputFillFormula ----------";
neuper@42437
  1201
"--------- build fun is_exactly_equal, inputFillFormula ----------";
neuper@42437
  1202
"--------- build fun is_exactly_equal, inputFillFormula ----------";
s1210629013@55445
  1203
reset_states ();
neuper@42437
  1204
CalcTree
neuper@42437
  1205
[(["functionTerm (x ^ 2 + sin (x ^ 4))", "differentiateFor x", "derivative f_f'"], 
neuper@42437
  1206
  ("Isac", ["derivative_of","function"], ["diff","differentiate_on_R"]))];
neuper@42437
  1207
Iterator 1;
neuper@42437
  1208
moveActiveRoot 1;
wneuper@59248
  1209
autoCalculate 1 CompleteCalcHead;
wneuper@59248
  1210
autoCalculate 1 (Step 1);
wneuper@59248
  1211
autoCalculate 1 (Step 1);(*([1], Res), d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))*)
wneuper@59123
  1212
appendFormula 1 "d_d x (x ^ 2) + cos (4 * x ^ 3)" (*|> Future.join*); (*<<<<<<<=========================*)
neuper@42437
  1213
(* the check for errpat is maximally liberal (whole term modulo "nrls" from "type met"),
neuper@42437
  1214
  would recognize "cos (4 * x ^ (4 - 1)) + 2 * x" as well.
neuper@42437
  1215
  results in <CALCMESSAGE> error pattern #chain-rule-diff-both# </CALCMESSAGE>
neuper@42437
  1216
  instead of <CALCMESSAGE> no derivation found </CALCMESSAGE> *)
neuper@42437
  1217
  val ((pt,pos), _) = get_calc 1;
neuper@42437
  1218
  val p = get_pos 1 1;
neuper@42437
  1219
  val (Form f, _, asms) = pt_extract (pt, p);
neuper@42437
  1220
wneuper@59253
  1221
  if p = ([1], Res) andalso term2str f = "d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))" then
wneuper@59253
  1222
    case get_obj g_tac pt (fst p) of Rewrite_Inst (["(bdv, x)"], 
wneuper@59253
  1223
      ("diff_sum", thm)) =>
wneuper@59253
  1224
      if (term2str o Thm.prop_of) thm = "d_d ?bdv (?u + ?v) = d_d ?bdv ?u + d_d ?bdv ?v" then ()
wneuper@59253
  1225
      else error "embed fun get_fillform changed 11"
wneuper@59253
  1226
    | _ => error "embed fun get_fillform changed 12"
wneuper@59253
  1227
  else error "embed fun get_fillform changed 13";
neuper@42437
  1228
neuper@42437
  1229
findFillpatterns 1 "chain-rule-diff-both"; (*<<<<<<<=================================*)
neuper@42437
  1230
(*<CALCMESSAGE> fill patterns #fill-d_d-arg#d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4)) =
neuper@42437
  1231
  d_d x (x ^^^ 2) + cos (x ^^^ 4) * d_d x ?_dummy_1#fill-both-args#...#...#... *)
neuper@42437
  1232
  val ((pt,pos),_) = get_calc 1;
neuper@42437
  1233
  val p = get_pos 1 1;
neuper@42437
  1234
neuper@42437
  1235
  val (Form f, _, asms) = pt_extract (pt, p);
wneuper@59253
  1236
  if p = ([1], Res) andalso term2str f = "d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))" then
wneuper@59253
  1237
    case get_obj g_tac pt (fst p) of Rewrite_Inst (["(bdv, x)"], 
wneuper@59253
  1238
      ("diff_sum", thm)) =>
wneuper@59253
  1239
      if (term2str o Thm.prop_of) thm = "d_d ?bdv (?u + ?v) = d_d ?bdv ?u + d_d ?bdv ?v" then ()
wneuper@59253
  1240
      else error "embed fun get_fillform changed 21"
wneuper@59253
  1241
    | _ => error "embed fun get_fillform changed 22"
wneuper@59253
  1242
  else error "embed fun get_fillform changed 23";
neuper@42437
  1243
neuper@42437
  1244
requestFillformula 1 ("chain-rule-diff-both", "fill-both-args");(*<<<<<<<============*)
neuper@42437
  1245
  (*<AUTOCALC> ([1], Res) ([2], Res) ([2], Res) </AUTOCALC>*)
neuper@42437
  1246
  val ((pt,pos),_) = get_calc 1;
neuper@42437
  1247
  val p = get_pos 1 1;
neuper@42437
  1248
  val (Form f, _, asms) = pt_extract (pt, p);
wneuper@59253
  1249
  if p = ([1], Res) andalso existpt [2] pt
wneuper@59253
  1250
    andalso term2str f = "d_d x (x ^^^ 2) + d_d x (sin (x ^^^ 4))"
wneuper@59253
  1251
  then case get_obj g_tac pt (fst p) of Rewrite_Inst (["(bdv, x)"], 
wneuper@59253
  1252
      ("diff_sum", thm)) =>
wneuper@59253
  1253
      if (term2str o Thm.prop_of) thm = "d_d ?bdv (?u + ?v) = d_d ?bdv ?u + d_d ?bdv ?v" then ()
wneuper@59253
  1254
      else error "embed fun get_fillform changed 31"
wneuper@59253
  1255
    | _ => error "embed fun get_fillform changed 32"
wneuper@59253
  1256
  else error "embed fun get_fillform changed 33";
neuper@42437
  1257
neuper@42437
  1258
(* input a formula which exactly fills the gaps in a "fillformula"
neuper@42437
  1259
   presented to the learner immediately before by "requestFillformula (errpatID, fillpatID)":
neuper@42437
  1260
   errpatID: lhs of the respective thm = lhs of fillformula with fillpatID.
neuper@42437
  1261
   the respective thm is in the ctree ................
neuper@42437
  1262
*)
neuper@42437
  1263
"~~~~~ fun inputFillFormula, args:"; val (cI, ifo) =
neuper@42437
  1264
  (1, "d_d x (x ^^^ 2) + cos (x ^^^ 4) * d_d x (x ^^^ 4)");
neuper@42437
  1265
    val ((pt, _), _) = get_calc cI
neuper@42437
  1266
    val pos = get_pos cI 1;
neuper@42437
  1267
neuper@42437
  1268
"~~~~~ fun is_exactly_equal, args:"; val ((pt, pos as (p, p_)), istr) = ((pt, pos), ifo);
neuper@42437
  1269
  val SOME ifo = parseNEW (assoc_thy "Isac" |> thy2ctxt) istr
neuper@42437
  1270
  val p' = lev_on p;
neuper@42437
  1271
  val tac = get_obj g_tac pt p';
wneuper@59252
  1272
val Rewrite_Inst ([bbb as "(bdv, x)"], ("diff_sin_chain", ttt)) = tac;
wneuper@59253
  1273
if (term2str o Thm.prop_of) ttt = "d_d ?bdv (sin ?u) = cos ?u * d_d ?bdv ?u" then ()
wneuper@59252
  1274
else error "inputFillFormula changed 10";
neuper@42437
  1275
  val Appl rew = applicable_in pos pt tac;
neuper@42437
  1276
  val Rewrite_Inst' (_, _, _, _, _, _, _, (res, _)) = rew;
neuper@42437
  1277
neuper@42437
  1278
"~~~~~ to inputFillFormula return val:"; val ("ok", tac) = ("ok", tac);
neuper@42437
  1279
  val ("ok", (_, c, ptp as (_,p'))) = locatetac tac (pt, pos);
neuper@42437
  1280
    upd_calc cI (ptp, []);
neuper@42437
  1281
    upd_ipos cI 1 p';
neuper@42437
  1282
    autocalculateOK2xml cI pos (if null c then p' else last_elem c) p';
neuper@42437
  1283
neuper@42437
  1284
"~~~~~ final check:";
neuper@42437
  1285
val ((pt, _),_) = get_calc 1;
neuper@42437
  1286
val p = get_pos 1 1;
neuper@42437
  1287
val (Form f, _, asms) = pt_extract (pt, p);
wneuper@59253
  1288
  if p = ([2], Res) andalso term2str f = "d_d x (x ^^^ 2) + cos (x ^^^ 4) * d_d x (x ^^^ 4)"
wneuper@59253
  1289
  then case get_obj g_tac pt (fst p) of Rewrite_Inst (["(bdv, x)"], 
wneuper@59253
  1290
      ("diff_sin_chain", thm)) =>
wneuper@59253
  1291
      if (term2str o Thm.prop_of) thm = "d_d ?bdv (sin ?u) = cos ?u * d_d ?bdv ?u" then ()
wneuper@59253
  1292
      else error "inputFillFormula changed 111"
wneuper@59253
  1293
    | _ => error "inputFillFormula changed 112"
wneuper@59253
  1294
  else error "inputFillFormula changed 113";
neuper@42437
  1295
wneuper@59262
  1296
"--------- fun appl_adds -----------------------------------------";
wneuper@59262
  1297
"--------- fun appl_adds -----------------------------------------";
wneuper@59262
  1298
"--------- fun appl_adds -----------------------------------------";
wneuper@59262
  1299
(* val (dI, oris, ppc, pbt, selct::ss) = 
wneuper@59262
  1300
       (dI, pors, probl, ppc, map itms2fstr probl);
wneuper@59262
  1301
   ...vvv
wneuper@59262
  1302
   *)
wneuper@59262
  1303
(* val (dI, oris, ppc, pbt, (selct::ss))=
wneuper@59262
  1304
       (#1 (some_spec ospec spec), oris, []:itm list,
wneuper@59262
  1305
	((#ppc o get_pbt) (#2 (some_spec ospec spec))),(imodel2fstr imodel));
wneuper@59262
  1306
   val iii = appl_adds dI oris ppc pbt (selct::ss); 
wneuper@59262
  1307
   tracing(itms2str_ thy iii);
wneuper@59262
  1308
wneuper@59262
  1309
 val itm = appl_add' dI oris ppc pbt selct;
wneuper@59262
  1310
 val ppc = insert_ppc' itm ppc;
wneuper@59262
  1311
wneuper@59262
  1312
 val _::selct::ss = (selct::ss);
wneuper@59262
  1313
 val itm = appl_add' dI oris ppc pbt selct;
wneuper@59262
  1314
 val ppc = insert_ppc' itm ppc;
wneuper@59262
  1315
wneuper@59262
  1316
 val _::selct::ss = (selct::ss);
wneuper@59262
  1317
 val itm = appl_add' dI oris ppc pbt selct;
wneuper@59262
  1318
 val ppc = insert_ppc' itm ppc;
wneuper@59262
  1319
 tracing(itms2str_ thy ppc);
wneuper@59262
  1320
wneuper@59262
  1321
 val _::selct::ss = (selct::ss);
wneuper@59262
  1322
 val itm = appl_add' dI oris ppc pbt selct;
wneuper@59262
  1323
 val ppc = insert_ppc' itm ppc;
wneuper@59262
  1324
   *)
wneuper@59264
  1325
"--------- fun concat_deriv --------------------------------------";
wneuper@59264
  1326
"--------- fun concat_deriv --------------------------------------";
wneuper@59264
  1327
"--------- fun concat_deriv --------------------------------------";
wneuper@59264
  1328
(*
wneuper@59264
  1329
 val ({rew_ord, erls, rules,...}, fo, ifo) = 
wneuper@59264
  1330
     (rep_rls Test_simplify, str2term "x+1+ -1*2=0", str2term "-2*1+(x+1)=0");
wneuper@59264
  1331
 (tracing o trtas2str) fod';
wneuper@59264
  1332
> ["
wneuper@59264
  1333
(x + 1 + -1 * 2 = 0, Thm ("radd_commute","?m + ?n = ?n + ?m"), (-1 * 2 + (x + 1) = 0, []))","
wneuper@59264
  1334
(-1 * 2 + (x + 1) = 0, Thm ("radd_commute","?m + ?n = ?n + ?m"), (-1 * 2 + (1 + x) = 0, []))","
wneuper@59264
  1335
(-1 * 2 + (1 + x) = 0, Thm ("radd_left_commute","?x + (?y + ?z) = ?y + (?x + ?z)"), (1 + (-1 * 2 + x) = 0, []))","
wneuper@59264
  1336
(1 + (-1 * 2 + x) = 0, Thm ("#mult_Float ((~1,0), (0,0)) __ ((2,0), (0,0))","-1 * 2 = -2"), (1 + (-2 + x) = 0, []))"]
wneuper@59264
  1337
val it = () : unit
wneuper@59264
  1338
 (tracing o trtas2str) (map rev_deriv' rifod');
wneuper@59264
  1339
> ["
wneuper@59264
  1340
(1 + (-2 + x) = 0, Thm ("sym_#mult_Float ((~2,0), (0,0)) __ ((1,0), (0,0))","-2 = -2 * 1"), (1 + (-2 * 1 + x) = 0, []))","
wneuper@59264
  1341
(1 + (-2 * 1 + x) = 0, Thm ("sym_radd_left_commute","?y + (?x + ?z) = ?x + (?y + ?z)"), (-2 * 1 + (1 + x) = 0, []))","
wneuper@59264
  1342
(-2 * 1 + (1 + x) = 0, Thm ("sym_radd_commute","?n + ?m = ?m + ?n"), (-2 * 1 + (x + 1) = 0, []))"]
wneuper@59264
  1343
val it = () : unit
wneuper@59264
  1344
*)
wneuper@59264
  1345
"--------- handle an input formula -------------------------------";
wneuper@59264
  1346
"--------- handle an input formula -------------------------------";
wneuper@59264
  1347
"--------- handle an input formula -------------------------------";
wneuper@59264
  1348
(*
wneuper@59264
  1349
Untersuchung zur Formeleingabe (appendFormula, replaceFormla) zu einer Anregung von Alan Krempler:
wneuper@59264
  1350
Welche RICHTIGEN Formeln koennen NICHT abgeleitet werden, 
wneuper@59264
  1351
wenn Abteilungen nur auf gleichem Level gesucht werden ?
wneuper@59264
  1352
WN.040216 
wneuper@59264
  1353
wneuper@59264
  1354
Beispiele zum Equationsolver von Richard Lang aus /src/sml/kbtest/rlang.sml
wneuper@59264
  1355
wneuper@59264
  1356
------------------------------------------------------------------------------
wneuper@59264
  1357
"Schalk I s.87 Bsp 52a ((5*x)/(x - 2) - x/(x+2)=4)";
wneuper@59264
  1358
------------------------------------------------------------------------------
wneuper@59264
  1359
1. "5 * x / (x - 2) - x / (x + 2) = 4"
wneuper@59264
  1360
...
wneuper@59264
  1361
4. "12 * x + 4 * x ^^^ 2 = 4 * (-4 + x ^^^ 2)",Subproblem["normalize", "poly"..
wneuper@59264
  1362
...
wneuper@59264
  1363
4.3. "16 + 12 * x = 0", Subproblem["degree_1", "polynomial", "univariate"..
wneuper@59264
  1364
...
wneuper@59264
  1365
4.3.3. "[x = -4 / 3]")), Check_elementwise "Assumptions"
wneuper@59264
  1366
...
wneuper@59264
  1367
"[x = -4 / 3]"
wneuper@59264
  1368
------------------------------------------------------------------------------
wneuper@59264
  1369
(1)..(6): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite verschiebt [Ableitung ware in 4.3.n]
wneuper@59264
  1370
wneuper@59264
  1371
(4.1)..(4.3): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite verschiebt [Ableitung ware in 4.3.n]
wneuper@59264
  1372
------------------------------------------------------------------------------
wneuper@59264
  1373
wneuper@59264
  1374
wneuper@59264
  1375
------------------------------------------------------------------------------
wneuper@59264
  1376
"Schalk I s.87 Bsp 55b (x/(x^^^2 - 6*x+9) - 1/(x^^^2 - 3*x) =1/x)";
wneuper@59264
  1377
------------------------------------------------------------------------------
wneuper@59264
  1378
1. "x / (x ^^^ 2 - 6 * x + 9) - 1 / (x ^^^ 2 - 3 * x) = 1 / x"
wneuper@59264
  1379
...
wneuper@59264
  1380
4. "(3 + (-1 * x + x ^^^ 2)) * x = 1 * (9 * x + (x ^^^ 3 + -6 * x ^^^ 2))"
wneuper@59264
  1381
                         Subproblem["normalize", "polynomial", "univariate"..
wneuper@59264
  1382
...
wneuper@59264
  1383
4.4. "-6 * x + 5 * x ^^^ 2 = 0", Subproblem["bdv_only", "degree_2", "poly"..
wneuper@59264
  1384
...
wneuper@59264
  1385
4.4.4. "[x = 0, x = 6 / 5]", Check_elementwise "Assumptions"
wneuper@59264
  1386
4.4.5. "[x = 0, x = 6 / 5]"
wneuper@59264
  1387
...
wneuper@59264
  1388
5. "[x = 0, x = 6 / 5]", Check_elementwise "Assumptions"
wneuper@59264
  1389
   "[x = 6 / 5]"
wneuper@59264
  1390
------------------------------------------------------------------------------
wneuper@59264
  1391
(1)..(4): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite schiebt [Ableitung waere in 4.4.x]
wneuper@59264
  1392
wneuper@59264
  1393
(4.1)..(4.4.5): keine 'richtige' Eingabe kann abgeleitet werden, die dem Ergebnis "[x = 6 / 5]" aequivalent ist [Ableitung waere in 5.]
wneuper@59264
  1394
------------------------------------------------------------------------------
wneuper@59264
  1395
wneuper@59264
  1396
wneuper@59264
  1397
------------------------------------------------------------------------------
wneuper@59264
  1398
"Schalk II s.56 Bsp 73b (sqrt(x+1)+sqrt(4*x+4)=sqrt(9*x+9))";
wneuper@59264
  1399
------------------------------------------------------------------------------
wneuper@59264
  1400
1. "sqrt (x + 1) + sqrt (4 * x + 4) = sqrt (9 * x + 9)"
wneuper@59264
  1401
...
wneuper@59264
  1402
6. "13 + 13 * x + -2 * sqrt ((4 + 4 * x) * (9 + 9 * x)) = 1 + x"
wneuper@59264
  1403
                             Subproblem["sq", "root'", "univariate", "equation"]
wneuper@59264
  1404
...
wneuper@59264
  1405
6.6. "144 + 288 * x + 144 * x ^^^ 2 = 144 + x ^^^ 2 + 288 * x + 143 * x ^^^ 2"
wneuper@59264
  1406
                Subproblem["normalize", "polynomial", "univariate", "equation"]
wneuper@59264
  1407
...
wneuper@59264
  1408
6.6.3 "0 = 0"    Subproblem["degree_0", "polynomial", "univariate", "equation"]
wneuper@59264
  1409
...                                       Or_to_List
wneuper@59264
  1410
6.6.3.2 "UniversalList"
wneuper@59264
  1411
------------------------------------------------------------------------------
wneuper@59264
  1412
(1)..(6): keine 'richtige' Eingabe kann abgeleitet werden, die eine der Wurzeln auf die andere Seite verschieb [Ableitung ware in 6.6.n]
wneuper@59264
  1413
wneuper@59264
  1414
(6.1)..(6.3): keine 'richtige' Eingabe kann abgeleitet werden, die einen Summanden auf die andere Seite verschiebt [Ableitung ware in 6.6.n]
wneuper@59264
  1415
------------------------------------------------------------------------------
wneuper@59264
  1416
*)
wneuper@59264
  1417
(*sh. comments auf 498*)
wneuper@59264
  1418
"--------- fun dropwhile' ----------------------------------------";
wneuper@59264
  1419
"--------- fun dropwhile' ----------------------------------------";
wneuper@59264
  1420
"--------- fun dropwhile' ----------------------------------------";
wneuper@59264
  1421
(*
wneuper@59264
  1422
 fun equal a b = a=b;
wneuper@59264
  1423
 val foder = [0,1,2,3,4,5]; val ifoder = [11,12,3,4,5];
wneuper@59264
  1424
 val r_foder = rev foder;  val r_ifoder = rev ifoder;
wneuper@59264
  1425
 dropwhile' equal r_foder r_ifoder;
wneuper@59264
  1426
> vval it = ([0, 1, 2, 3], [3, 12, 11]) : int list * int list
wneuper@59264
  1427
wneuper@59264
  1428
 val foder = [3,4,5]; val ifoder = [11,12,3,4,5];
wneuper@59264
  1429
 val r_foder = rev foder;  val r_ifoder = rev ifoder;
wneuper@59264
  1430
 dropwhile' equal r_foder r_ifoder;
wneuper@59264
  1431
> val it = ([3], [3, 12, 11]) : int list * int list
wneuper@59264
  1432
wneuper@59264
  1433
 val foder = [5]; val ifoder = [11,12,3,4,5];
wneuper@59264
  1434
 val r_foder = rev foder;  val r_ifoder = rev ifoder;
wneuper@59264
  1435
 dropwhile' equal r_foder r_ifoder;
wneuper@59264
  1436
> val it = ([5], [5, 4, 3, 12, 11]) : int list * int list
wneuper@59264
  1437
wneuper@59264
  1438
 val foder = [10,11,12,13,14,15]; val ifoder = [11,12,3,4,5];
wneuper@59264
  1439
 val r_foder = rev foder;  val r_ifoder = rev ifoder;
wneuper@59264
  1440
 dropwhile' equal r_foder r_ifoder;
wneuper@59264
  1441
> *** dropwhile': did not start with equal elements*)