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