test/Tools/isac/Interpret/inform.sml
author Walther Neuper <wneuper@ist.tugraz.at>
Tue, 18 Oct 2016 12:05:03 +0200
changeset 59252 7d3dbc1171ff
parent 59248 5eba5e6d5266
child 59253 f0bb15a046ae
permissions -rw-r--r--
back-track after desing error in previous changeset

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