test/Tools/isac/Interpret/rewtools.sml
author Alexander Kargl <akargl@brgkepler.net>
Mon, 25 Jul 2011 14:19:22 +0200
branchdecompose-isar
changeset 42181 77f1173be5c0
parent 42125 f442b64622e4
child 42399 c5bb245afb58
permissions -rw-r--r--
intermed: uncommented tests
akargl@42181
     1
(* Title: test for rewtools.sml
neuper@37906
     2
   authors: Walther Neuper 2000, 2006
neuper@37906
     3
*)
neuper@37906
     4
neuper@38061
     5
"--------------------------------------------------------";
neuper@38061
     6
"--------------------------------------------------------";
neuper@38061
     7
"table of contents --------------------------------------";
neuper@38061
     8
"--------------------------------------------------------";
neuper@38062
     9
"----------- fun make_isac ------------------------------";
neuper@38061
    10
"----------- fun collect_isab_thys ----------------------";
neuper@38061
    11
"----------- fun thy_containing_thm ---------------------";
neuper@38061
    12
"----------- fun thy_containing_rls ---------------------";
neuper@38061
    13
"----------- fun thy_containing_cal ---------------------";
neuper@38061
    14
"----------- initContext Thy_ Integration-demo ----------";
neuper@38061
    15
"----------- initContext..Thy_, fun context_thm ---------";
neuper@38061
    16
"----------- initContext..Thy_, fun context_rls ---------";
neuper@38061
    17
"----------- checkContext..Thy_, fun context_thy --------";
neuper@38061
    18
"----------- checkContext..Thy_, fun context_rls --------";
neuper@38061
    19
"----------- checkContext..Thy_ on last formula ---------"; 
neuper@38061
    20
"----------- fun guh2theID ------------------------------";
neuper@38061
    21
"----------- debugging on Tests/solve_linear_as_rootpbl -";
neuper@38061
    22
"--------------------------------------------------------";
neuper@38061
    23
"----------- fun string_of_thmI for_[.]_) ---------------";
neuper@38061
    24
"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[";
neuper@38061
    25
"--------------------------------------------------------";
neuper@38061
    26
"----------- fun filter_appl_rews -----------------------";
neuper@38061
    27
"----------- fun is_contained_in ------------------------";
neuper@38061
    28
"--------------------------------------------------------";
neuper@38061
    29
"--------------------------------------------------------";
neuper@37906
    30
neuper@37906
    31
neuper@38062
    32
"----------- fun make_isac ------------------------------";
neuper@38062
    33
"----------- fun make_isac ------------------------------";
neuper@38062
    34
"----------- fun make_isac ------------------------------";
neuper@38062
    35
"----- rlsthmsNOTisac: in rls requested from Isabelle ---";
neuper@38062
    36
map #1 (rlsthmsNOTisac : (string * thm) list) = (*WN101011, Isabelle2009-2*)
neuper@38061
    37
["refl", "o_apply", "del_base", "del_rec", "LENGTH_CONS", "LENGTH_NIL",
neuper@38061
    38
 "list_diff_def", "take_Nil", "take_Cons", "if_True", "if_False",
neuper@38061
    39
 "sym_real_mult_minus1", "left_distrib", "right_distrib",
neuper@38061
    40
 "sym_realpow_twoI", "sym_realpow_addI", "mult_1_right",
neuper@38061
    41
 "sym_real_mult_2", "mult_1_left", "mult_zero_left", "mult_zero_right",
neuper@38061
    42
 "add_0_left", "add_0_right", "divide_zero_left", "sym_real_mult_assoc",
neuper@38061
    43
 "real_le_refl", "minus_minus", "real_mult_commute", "real_mult_assoc",
neuper@38061
    44
 "add_commute", "add_left_commute", "add_assoc", "minus_mult_left",
neuper@38061
    45
 "right_minus", "sym_add_assoc", "left_diff_distrib",
neuper@38061
    46
 "right_diff_distrib", "minus_divide_left", "times_divide_eq_right",
neuper@38061
    47
 "times_divide_eq_left", "divide_divide_eq_left",
neuper@38061
    48
 "divide_divide_eq_right", "divide_1", "add_divide_distrib",
neuper@38061
    49
 "sym_rmult_assoc"]; 
neuper@38061
    50
if length rlsthmsNOTisac > 40 then () 
neuper@38061
    51
else error "rewtools.sml: some rlsthmsNOTisac dropped";
neuper@37906
    52
neuper@38062
    53
"----- FIXME: rlsthmsNOTisac DOES contain thms from isac ---";
neuper@38062
    54
map (Thm.derivation_name o #2) rlsthmsNOTisac;
neuper@38062
    55
"----- FIXME: sym_* in rlsthmsNOTisac DOES contain thms from isac ---";
neuper@38062
    56
val symthms = [("real_mult_minus1", @{thm real_mult_minus1}),
neuper@38062
    57
               ("realpow_twoI", @{thm realpow_twoI}),
neuper@38062
    58
               ("realpow_addI", @{thm realpow_addI}),
neuper@38062
    59
               ("real_mult_2", @{thm real_mult_2}),
neuper@38062
    60
               ("real_mult_assoc", @{thm real_mult_assoc}),
neuper@38062
    61
               ("add_assoc", @{thm add_assoc}),
neuper@38062
    62
               ("rmult_assoc", @{thm rmult_assoc})];
neuper@38062
    63
map (Thm.derivation_name o #2) symthms;
neuper@38062
    64
 
neuper@37906
    65
neuper@38061
    66
"----------- fun collect_isab_thys ----------------------";
neuper@38061
    67
"----------- fun collect_isab_thys ----------------------";
neuper@38061
    68
"----------- fun collect_isab_thys ----------------------";
akargl@42108
    69
val ancestors = Theory.ancestors_of @{theory "Complex_Main"};
neuper@38061
    70
val isabthms = (flat o (map Theory.axioms_of)) ancestors;
neuper@38061
    71
neuper@38061
    72
val isacrules = (flat o (map (thms_of_rls o #2 o #2))) (! ruleset');
neuper@37906
    73
(*thms from rulesets*)
akargl@42181
    74
(*=== inhibit exn AK110725 =============================================================
neuper@37906
    75
val isacrlsthms = ((map rep_thm_G') o flat o 
akargl@42181
    76
		 (map (PureThy.all_thms_of_rls o #2 o #2))) (!ruleset');
neuper@37906
    77
length isacrlsthms;
neuper@37906
    78
(*takes a few seconds...
neuper@37906
    79
val isacrlsthms = gen_distinct eq_thmI isacrlsthms;
neuper@37906
    80
length isacrlsthms;
neuper@37906
    81
"----- theorems used in isac's rulesets -----vvvvvvvvvvvvvvvvvvvvv";
neuper@37906
    82
print_depth 99; map #1 isacrlsthms; print_depth 3;
neuper@37906
    83
"----- theorems used in isac's rulesets -----^^^^^^^^^^^^^^^^^^^^^";
neuper@37906
    84
...*)
neuper@37906
    85
akargl@42181
    86
neuper@37906
    87
(!theory');
neuper@37906
    88
map #2 (!theory');
neuper@37936
    89
map (PureThy.all_thms_of o #2) (!theory');
neuper@37936
    90
val isacthms = (flat o (map (PureThy.all_thms_of o #2))) (!theory');
neuper@37906
    91
(*takes a few seconds...
neuper@37906
    92
val rlsthmsNOTisac = gen_diff eq_thmI (isacrlsthms, isacthms);
neuper@37906
    93
length rlsthmsNOTisac;
neuper@37906
    94
"----- theorems from rulesets NOT def. in isac -----vvvvvvvvvvvvvv";
neuper@37906
    95
print_depth 99; map #1 rlsthmsNOTisac; print_depth 3;
neuper@37906
    96
"----- theorems from rulesets NOT def. in isac -----^^^^^^^^^^^^^^";
neuper@37906
    97
...*)
neuper@37906
    98
neuper@37906
    99
"----- for 'fun make_isab_thm_thy'";
neuper@37936
   100
inter eq_thmI isacrlsthms (PureThy.all_thms_of (nth 1 ancestors));
neuper@37936
   101
inter eq_thmI;
neuper@37936
   102
(inter eq_thmI);
neuper@37936
   103
(inter eq_thmI) isacrlsthms;
neuper@37906
   104
(*takes a few seconds...
neuper@37936
   105
curry (inter eq_thmI) isacrlsthms (PureThy.all_thms_of (nth 9 ancestors));
neuper@37906
   106
neuper@37906
   107
val thy = (nth 52 ancestors);
neuper@37936
   108
val sec = ((inter eq_thmI) isacrlsthms o PureThy.all_thms_of) (nth 52 ancestors);
neuper@37936
   109
length (PureThy.all_thms_of (nth 9 ancestors));
neuper@37906
   110
length sec;
neuper@37906
   111
...*)
neuper@37906
   112
(*takes 1 minute...
neuper@37906
   113
print_depth 99; 
neuper@37936
   114
map ((inter eq_thmI) rlsthmsNOTisac o PureThy.all_thms_of) ancestors;
neuper@37906
   115
print_depth 3;
neuper@37906
   116
*)
neuper@37906
   117
neuper@37906
   118
(*takes some seconds...
neuper@37906
   119
val isab_thm_thy = (flat o (map (make_isab_thm_thy rlsthmsNOTisac)))
neuper@37906
   120
		       ((#ancestors o rep_theory) first_isac_thy);
neuper@37906
   121
print_depth 99; isab_thm_thy; print_depth 3;
neuper@37906
   122
*)
akargl@42181
   123
=== inhibit exn AK110725 =============================================================*)
neuper@37906
   124
neuper@37906
   125
neuper@38061
   126
"----------- fun thy_containing_thm ---------------------";
neuper@38061
   127
"----------- fun thy_containing_thm ---------------------";
neuper@38061
   128
"----------- fun thy_containing_thm ---------------------";
akargl@42181
   129
val (str, (thy', thy)) = ("real_diff_minus",("Root", @{theory Root}));
neuper@37906
   130
if thy_contains_thm str ("XXX",thy) then ()
akargl@42181
   131
  else error "rewtools.sml: NOT thy_contains_thm (real_diff_minus,(Root.thy,.";
neuper@37906
   132
(rev (!theory'));
akargl@42181
   133
dropuntil (curry op = thy');
akargl@42181
   134
dropuntil ((curry op = thy') o (#1:theory' * theory -> theory'));
akargl@42181
   135
val startsearch = dropuntil ((curry op = thy') o 
neuper@37906
   136
			     (#1:theory' * theory -> theory')) 
neuper@37906
   137
			    (rev (!theory'));
akargl@42181
   138
neuper@38058
   139
if thy_containing_thm thy' str = ("IsacKnowledge", "Root") then ()
akargl@42181
   140
  else error "rewtools.sml: NOT thy_containin_thm (real_diff_minus,(Root.thy,.";
neuper@37906
   141
neuper@37906
   142
"----- search the same theorem somewhere further below in the list";
akargl@42181
   143
if thy_contains_thm str ("XXX",@{theory Poly}) then ()
akargl@42181
   144
  else error "rewtools.sml: NOT thy_contains_thm (real_diff_minus,(Poly.thy,.";
akargl@42181
   145
(*=== inhibit exn AK110725 =============================================================
akargl@42181
   146
(* AK110725 "LineEq" can't be "Poly" - change "LineEq" to "Poly"??? *)
neuper@38058
   147
if thy_containing_thm "LinEq" str = ("IsacKnowledge", "Poly") then ()
akargl@42181
   148
  else error "rewtools.sml: NOT thy_containing_thm (real_diff_minus,(Poly.thy,.";
akargl@42181
   149
=== inhibit exn AK110725 =============================================================*)
neuper@37906
   150
neuper@37906
   151
"----- second test -------------------------------";
neuper@37906
   152
show_thes();
neuper@37906
   153
(*args vor thy_containing_thm...*)
neuper@38058
   154
val (thy',str) = ("Test", "radd_commute");
neuper@37906
   155
val startsearch = dropuntil ((curry op= thy') o 
neuper@37906
   156
				     (#1:theory' * theory -> theory')) 
neuper@37906
   157
				    (rev (!theory'));
neuper@37906
   158
length (!theory');
neuper@37906
   159
length startsearch;
neuper@38058
   160
if thy_containing_thm thy' str = ("IsacKnowledge", "Test") then ()
neuper@38031
   161
else error "rewtools.sml: diff.behav. in \
neuper@37906
   162
		 \thy_containing_thm Test radd_commute";
neuper@37906
   163
neuper@38061
   164
"----------- fun thy_containing_rls ---------------------";
neuper@38061
   165
"----------- fun thy_containing_rls ---------------------";
neuper@38061
   166
"----------- fun thy_containing_rls ---------------------";
neuper@38058
   167
val thy' = "Biegelinie";
neuper@37906
   168
val dropthys = takewhile [] (not o (curry op= thy') o 
neuper@37906
   169
			     (#1:theory' * theory -> theory')) 
neuper@37906
   170
			 (rev (!theory'));
neuper@37906
   171
if length (!theory') <> length dropthys then ()
neuper@38031
   172
else error "rewtools.sml: diff.behav. in thy_containing_rls 1";
neuper@37906
   173
val dropthy's = map (get_thy o (#1 : (theory' * theory) -> theory'))
neuper@37906
   174
		    dropthys;
neuper@37906
   175
print_depth 99; dropthy's; print_depth 3;
neuper@37906
   176
neuper@38061
   177
(*WN100819=======================================================
neuper@38061
   178
WN100819 THIS DATE MUST BE WRONG: at this date changeset 37934:56f10b13005e
neuper@38061
   179
finished update ME/calchead.sml + pushed updates over all sml+test
neuper@38061
   180
neuper@37906
   181
"Isac" mem dropthy's;
neuper@37906
   182
op mem ("Isac", dropthy's);
neuper@37906
   183
(op mem) o swap;
neuper@37906
   184
((op mem) o swap) (dropthy's, "Isac");
neuper@37906
   185
curry ((op mem) o swap);
neuper@37906
   186
curry ((op mem) o swap) dropthy's "Isac";
neuper@37906
   187
val startsearch = filter_out ((curry ((op mem) o swap) dropthy's) o	 
neuper@37906
   188
			      ((#1 o #2) : rls' * (theory' * rls) -> theory'))
neuper@37906
   189
			     (rev (!ruleset'));
neuper@37906
   190
print_depth 99; map (#1 o #2) startsearch; print_depth 3;
neuper@37906
   191
if length (!ruleset') <> length startsearch then ()
neuper@38031
   192
else error "rewtools.sml: diff.behav. in thy_containing_rls 2";
neuper@37906
   193
akargl@42181
   194
neuper@37906
   195
val rls' = "norm_Poly";
neuper@37906
   196
case assoc (startsearch, rls') of
neuper@37926
   197
    SOME (thy', _) => thyID2theory' thy'
neuper@38031
   198
  | _ => error ("thy_containing_rls : rls '"^str^
neuper@37906
   199
			  "' not in !rulset' und thy '"^thy'^"'");
neuper@37906
   200
neuper@38058
   201
if thy_containing_rls thy' rls' = ("IsacKnowledge", "Poly") then ()
neuper@38031
   202
else error "rewtools.sml: diff.behav. in thy_containing_rls 3";
neuper@37906
   203
neuper@37906
   204
neuper@38061
   205
"----------- fun thy_containing_cal ---------------------";
neuper@38061
   206
"----------- fun thy_containing_cal ---------------------";
neuper@38061
   207
"----------- fun thy_containing_cal ---------------------";
neuper@38058
   208
val thy' = "Atools";
neuper@37906
   209
val dropthys = takewhile [] (not o (curry op= thy') o 
neuper@37906
   210
			     (#1:theory' * theory -> theory')) 
neuper@37906
   211
			 (rev (!theory'));
neuper@37906
   212
length dropthys <> length (!theory');
neuper@37906
   213
val dropthy's = map (get_thy o (#1 : (theory' * theory) -> theory'))
neuper@37906
   214
		    dropthys;
neuper@37906
   215
neuper@37906
   216
(rev (!calclist'));
neuper@37906
   217
map #1 (rev (!calclist'));
neuper@37906
   218
map (#1 : calc -> string) (rev (!calclist'));
neuper@37906
   219
val startsearch = filter_out ((curry ((op mem) o swap) dropthy's) o
neuper@37906
   220
			      (#1 : calc -> string)) (rev (!calclist'));
neuper@38061
   221
WN100819 =====================================================*)
neuper@37906
   222
neuper@38061
   223
"----------- initContext Thy_ Integration-demo ----------";
neuper@38061
   224
"----------- initContext Thy_ Integration-demo ----------";
neuper@38061
   225
"----------- initContext Thy_ Integration-demo ----------";
neuper@37906
   226
states:=[];
neuper@37906
   227
CalcTree
neuper@37906
   228
[(["functionTerm (2 * x)","integrateBy x","antiDerivative FF"], 
neuper@38058
   229
  ("Integrate",["integrate","function"],
neuper@37906
   230
  ["diff","integration"]))];
neuper@37906
   231
Iterator 1;
neuper@37906
   232
moveActiveRoot 1;
neuper@37906
   233
autoCalculate 1 CompleteCalc;
neuper@37906
   234
interSteps 1 ([1],Res);
neuper@37906
   235
interSteps 1 ([1,1],Res);
neuper@37906
   236
val ((pt,p),_) = get_calc 1; show_pt pt;
neuper@37906
   237
if existpt' ([1,1,1], Frm) pt then ()
neuper@38031
   238
else error "integrate.sml: interSteps on Rewrite_Set_Inst 1";
neuper@37906
   239
initContext  1 Thy_ ([1,1,1], Frm);
neuper@37906
   240
neuper@38061
   241
"----------- initContext..Thy_, fun context_thm ---------";
neuper@38061
   242
"----------- initContext..Thy_, fun context_thm ---------";
neuper@38061
   243
"----------- initContext..Thy_, fun context_thm ---------";
neuper@41970
   244
states:=[]; (*start of calculation, return No.1*)
neuper@41970
   245
CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   246
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   247
   ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   248
Iterator 1; moveActiveRoot 1;
neuper@37906
   249
autoCalculate 1 CompleteCalc;
neuper@37906
   250
neuper@37906
   251
"----- no thy-context at result -----";
neuper@37906
   252
val p = ([], Res);
neuper@37906
   253
initContext 1 Thy_ p;
neuper@37906
   254
neuper@37906
   255
interSteps 1 ([2], Res);
neuper@37906
   256
interSteps 1 ([3,1], Res);
neuper@37906
   257
val ((pt,_),_) = get_calc 1; show_pt pt;
neuper@37906
   258
neuper@37906
   259
val p = ([2,4], Res);
neuper@37906
   260
val tac = Rewrite ("radd_left_commute","");
neuper@37906
   261
initContext 1 Thy_ p;
neuper@37906
   262
(*Res->Res, Rewrite "radd_left_commute 1 + (-2 + x) = 0 -> -2 + (1 + x) = 0
neuper@37906
   263
  --- in initContext..Thy_ ---*)
neuper@37906
   264
val ContThm {thm,result,...} = context_thy (pt,p) tac;
neuper@37906
   265
if thm = "thy_isac_Test-thm-radd_left_commute" 
neuper@37906
   266
   andalso term2str result = "-2 + (1 + x) = 0" then ()
neuper@38031
   267
else error"rewtools.sml initContext..Th_ thy_Test-thm-radd_left_commute";
neuper@37906
   268
akargl@42108
   269
neuper@37906
   270
val p = ([3,1,1], Frm);
neuper@37906
   271
val tac = Rewrite_Inst (["(bdv, x)"],("risolate_bdv_add",""));
neuper@37906
   272
initContext 1 Thy_ p;
neuper@37906
   273
(*Frm->Res, Rewrite_Inst "risolate_bdv_add"  -1 + x = 0 -> x = 0 + -1 * -1
neuper@37906
   274
  --- in initContext..Thy_ ---*)
neuper@37906
   275
val ContThmInst {thm,result,...} = context_thy (pt,p) tac;
neuper@37906
   276
if thm =  "thy_isac_Test-thm-risolate_bdv_add"
neuper@37906
   277
   andalso term2str result = "x = 0 + -1 * -1" then ()
neuper@38031
   278
else error "rewtools.sml initContext..Th_ thy_Test-thm-risolate_bdv_add";
neuper@37906
   279
neuper@37906
   280
initContext 1 Thy_ ([2,5], Res);
neuper@37906
   281
(*Res->Res, Calculate "plus"  -2 + (1 + x) = 0 -> -1 + x = 0
neuper@37906
   282
  --- in initContext..Thy_ ---*)
neuper@37906
   283
neuper@37906
   284
neuper@38061
   285
"----------- initContext..Thy_, fun context_rls ---------";
neuper@38061
   286
"----------- initContext..Thy_, fun context_rls ---------";
neuper@38061
   287
"----------- initContext..Thy_, fun context_rls ---------";
neuper@37906
   288
(*using pt from above*)
neuper@37906
   289
val p = ([1], Res);
neuper@37906
   290
val tac = Rewrite_Set "Test_simplify";
neuper@37906
   291
initContext 1 Thy_ p;
neuper@37906
   292
(*Res->Res, Rewrite_Set "Test_simplify" x + 1 + -1 * 2 = 0 -> -1 + x = 0
neuper@37906
   293
  --- in initContext..Thy_ ---*)
neuper@37906
   294
val ContRls {rls,result,...} = context_thy (pt,p) tac;
neuper@37906
   295
if rls = "thy_isac_Test-rls-Test_simplify" 
neuper@37906
   296
   andalso term2str result = "-1 + x = 0" then ()
neuper@38031
   297
else error "rewtools.sml initContext..Th_ thy_Test-thm-risolate_bdv_add";
neuper@37906
   298
neuper@37906
   299
val p = ([3,1], Frm);
neuper@37906
   300
val tac = Rewrite_Set_Inst (["(bdv, x)"],"isolate_bdv");
neuper@37906
   301
initContext 1 Thy_ p;
neuper@37906
   302
(*Frm->Res, Rewrite_Set_Inst "isolate_bdv" -1 + x = 0 ->  x = 0 + -1 * -1
neuper@37906
   303
  --- in initContext..Thy_ ---*)
neuper@37906
   304
val ContRlsInst {rls,result,...} = context_thy (pt,p) tac;
neuper@37906
   305
if rls =  "thy_isac_Test-rls-isolate_bdv"
neuper@37906
   306
   andalso term2str result = "x = 0 + -1 * -1" then ()
neuper@38031
   307
else error "rewtools.sml initContext..Th_ thy_Test-thm-risolate_bdv_add";
neuper@37906
   308
neuper@37906
   309
neuper@38061
   310
"----------- checkContext..Thy_, fun context_thy --------";
neuper@38061
   311
"----------- checkContext..Thy_, fun context_thy --------";
neuper@38061
   312
"----------- checkContext..Thy_, fun context_thy --------";
neuper@37906
   313
(*using pt from above*)
neuper@37906
   314
neuper@37906
   315
val p = ([2,4], Res);
neuper@37906
   316
val tac = Rewrite ("radd_left_commute","");
neuper@37906
   317
checkContext 1 p "thy_Test-thm-radd_left_commute";
neuper@37906
   318
(* radd_left_commute: 1 + (-2 + x) = 0 -> -2 + (1 + x) = 0
neuper@37906
   319
  --- in checkContext..Thy_ ---*)
neuper@37906
   320
val ContThm {thm,result,...} = context_thy (pt,p) tac;
neuper@37906
   321
if thm =  "thy_isac_Test-thm-radd_left_commute"
neuper@37906
   322
   andalso term2str result = "-2 + (1 + x) = 0" then ()
neuper@38031
   323
else error "rewtools.sml checkContext.._ thy_Test-thm-radd_left_commute";
neuper@37906
   324
neuper@37906
   325
val p = ([3,1,1], Frm);
neuper@37906
   326
val tac = Rewrite_Inst (["(bdv,x)"],("risolate_bdv_add",""));
neuper@37906
   327
checkContext 1 p "thy_Test-thm-risolate_bdv_add";
neuper@37906
   328
(* risolate_bdv_add:  -1 + x = 0 -> x = 0 + -1 * -1
neuper@37906
   329
  --- in checkContext..Thy_ ---*)
neuper@37906
   330
val ContThmInst {thm,result,...} = context_thy (pt,p) tac;
neuper@37906
   331
if thm =  "thy_isac_Test-thm-risolate_bdv_add"
neuper@37906
   332
   andalso term2str result = "x = 0 + -1 * -1" then ()
neuper@38031
   333
else error "rewtools.sml checkContext..T_ thy_Test-thm-risolate_bdv_add";
neuper@37906
   334
neuper@37906
   335
val p = ([2,5], Res);
neuper@37906
   336
val tac = Calculate "plus";
neuper@37906
   337
(*checkContext..Thy_ 1 ([2,5], Res);*)
neuper@37906
   338
(*FIXXXME #######################vvvvv kestoreID !!!!!!!!!!!!!!!!*)
neuper@37906
   339
checkContext 1 p ;
neuper@37906
   340
(* Calculate "plus"  -2 + (1 + x) = 0 -> -1 + x = 0
neuper@37906
   341
  --- in checkContext..Thy_ ---*)
neuper@37906
   342
neuper@37906
   343
neuper@38061
   344
"----------- checkContext..Thy_, fun context_rls --------";
neuper@38061
   345
"----------- checkContext..Thy_, fun context_rls --------";
neuper@38061
   346
"----------- checkContext..Thy_, fun context_rls --------";
neuper@37906
   347
(*using pt from above*)
neuper@37906
   348
show_pt pt;
neuper@37906
   349
neuper@37906
   350
val p = ([1], Res);
neuper@37906
   351
val tac = Rewrite_Set "Test_simplify";
neuper@37906
   352
checkContext 1 p "thy_isac_Test-rls-Test_simplify";
neuper@37906
   353
(*Res->Res, Rewrite_Set "Test_simplify" x + 1 + -1 * 2 = 0 -> -1 + x = 0
neuper@37906
   354
  --- in checkContext..Thy_ ---*)
neuper@37906
   355
val ContRls {rls,result,...} = context_thy (pt,p) tac;
neuper@37906
   356
if rls = "thy_isac_Test-rls-Test_simplify" 
neuper@37906
   357
   andalso term2str result = "-1 + x = 0" then ()
neuper@38031
   358
else error "rewtools.sml checkContext..Thy_ thy_Test-rls-Test_simplify";
neuper@37906
   359
neuper@37906
   360
val p = ([3,1], Frm);
neuper@37906
   361
val tac = Rewrite_Set_Inst (["(bdv, x)"],"isolate_bdv");
neuper@37906
   362
checkContext 1 p "thy_Test-rls-isolate_bdv";
neuper@37906
   363
val ContRlsInst {rls,result,...} = context_thy (pt,p) tac;
neuper@37906
   364
if rls = "thy_isac_Test-rls-isolate_bdv" 
neuper@37906
   365
   andalso term2str result = "x = 0 + -1 * -1" then ()
neuper@38031
   366
else error "rewtools.sml checkContext..Thy_ thy_Test-thm-isolate_bdv";
neuper@37906
   367
neuper@38061
   368
"----------- checkContext..Thy_ on last formula ---------"; 
neuper@38061
   369
"----------- checkContext..Thy_ on last formula ---------"; 
neuper@38061
   370
"----------- checkContext..Thy_ on last formula ---------"; 
neuper@41970
   371
states:=[]; (*start of calculation, return No.1*)
neuper@41970
   372
CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"], 
neuper@41970
   373
  ("Test", ["sqroot-test","univariate","equation","test"],
neuper@37906
   374
   ["Test","squ-equ-test-subpbl1"]))];
neuper@37906
   375
Iterator 1; moveActiveRoot 1;
neuper@37906
   376
neuper@37906
   377
autoCalculate 1 CompleteCalcHead;
neuper@37906
   378
autoCalculate 1 (Step 1);
neuper@37906
   379
val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   380
initContext 1 Thy_ ([1], Frm);
neuper@37906
   381
checkContext 1 ([1], Frm) "thy_isac_Test-thm-radd_left_commute";
neuper@37906
   382
neuper@37906
   383
autoCalculate 1 (Step 1);
neuper@37906
   384
val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   385
initContext 1 Thy_ ([1], Res);
neuper@37906
   386
checkContext 1 ([1], Res) "thy_isac_Test-rls-Test_simplify";
neuper@37906
   387
neuper@37906
   388
neuper@38061
   389
"----------- fun guh2theID ------------------------------";
neuper@38061
   390
"----------- fun guh2theID ------------------------------";
neuper@38061
   391
"----------- fun guh2theID ------------------------------";
akargl@42181
   392
neuper@37906
   393
val guh = "thy_scri_ListG-thm-zip_Nil";
akargl@42181
   394
print_depth 999;
akargl@42181
   395
take_fromto 1 4 (Symbol.explode guh);
akargl@42181
   396
take_fromto 5 9 (Symbol.explode guh);
akargl@42181
   397
val rest = takerest (9,(Symbol.explode guh)); 
neuper@37906
   398
neuper@37906
   399
separate "-" rest;
neuper@37906
   400
space_implode "-" rest;
neuper@37906
   401
commas rest;
neuper@37906
   402
neuper@37906
   403
val delim = "-";
neuper@37906
   404
val thyID = takewhile [] (not o (curry op= delim)) rest;
neuper@37906
   405
val rest' = dropuntil (curry op= delim) rest;
neuper@37906
   406
val setc = take_fromto 1 5 rest';
neuper@37906
   407
val xstr = takerest (5, rest');
neuper@37906
   408
neuper@37906
   409
if guh2theID guh = ["IsacScripts", "ListG", "Theorems", "zip_Nil"] then ()
neuper@38031
   410
else error "rewtools.sml: guh2theID thy_scri_ListG-thm-zip_Nil changed";
neuper@37906
   411
neuper@37906
   412
neuper@38061
   413
"----------- debugging on Tests/solve_linear_as_rootpbl -";
neuper@38061
   414
"----------- debugging on Tests/solve_linear_as_rootpbl -";
neuper@38061
   415
"----------- debugging on Tests/solve_linear_as_rootpbl -";
akargl@42108
   416
"----- initContext -----";
neuper@37906
   417
states:=[];
neuper@37906
   418
CalcTree 
neuper@42124
   419
    [(["equality (1+-1*2+x=(0::real))", "solveFor x", "solutions L"],
neuper@38058
   420
      ("Test",
neuper@37906
   421
       ["linear","univariate","equation","test"],
neuper@37906
   422
       ["Test","solve_linear"]))];
neuper@37906
   423
Iterator 1; moveActiveRoot 1;
neuper@37906
   424
autoCalculate 1 CompleteCalcHead;
neuper@37906
   425
neuper@37906
   426
autoCalculate 1 (Step 1); val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   427
if is_curr_endof_calc pt ([1],Frm) then ()
neuper@38031
   428
else error "rewtools.sml is_curr_endof_calc ([1],Frm)";
neuper@37906
   429
neuper@37906
   430
autoCalculate 1 (Step 1); val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
akargl@42125
   431
neuper@37906
   432
if not (is_curr_endof_calc pt ([1],Frm)) then ()
neuper@38031
   433
else error "rewtools.sml is_curr_endof_calc ([1],Frm) not";
neuper@37906
   434
if is_curr_endof_calc pt ([1],Res) then ()
neuper@38031
   435
else error "rewtools.sml is_curr_endof_calc ([1],Res)";
neuper@37906
   436
neuper@37906
   437
initContext 1 Thy_ ([1],Res);
neuper@37906
   438
neuper@37906
   439
"----- checkContext -----";
neuper@37906
   440
states:=[];
neuper@37906
   441
CalcTree 
neuper@42124
   442
    [(["equality (1+-1*2+x=(0::real))", "solveFor x", "solutions L"],
neuper@38058
   443
      ("Test",
neuper@37906
   444
       ["linear","univariate","equation","test"],
neuper@37906
   445
       ["Test","solve_linear"]))];
neuper@37906
   446
Iterator 1; moveActiveRoot 1;
neuper@37906
   447
autoCalculate 1 CompleteCalc;
neuper@37906
   448
interSteps 1 ([1],Res);
akargl@42108
   449
neuper@37906
   450
val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   451
checkContext 1 ([1],Res) "thy_isac_Test-rls-Test_simplify";
neuper@37906
   452
neuper@37906
   453
interSteps 1 ([2],Res);
neuper@37906
   454
val (ptp as (pt,p), tacis) = get_calc 1; show_pt pt;
neuper@37906
   455
neuper@37906
   456
checkContext 1 ([2,1],Res) "thy_isac_Test-rls-Test_simplify";
neuper@37906
   457
checkContext 1 ([2,2],Res) "thy_isac_Test-rls-Test_simplify";
neuper@37906
   458
akargl@42125
   459
neuper@38061
   460
"----------- fun string_of_thmI for_[.]_) ---------------";
neuper@38061
   461
"----------- fun string_of_thmI for_[.]_) ---------------";
neuper@38061
   462
"----------- fun string_of_thmI for_[.]_) ---------------";
neuper@37906
   463
"----- these work ?!?";
akargl@42181
   464
(*========== inhibit exn 110718 ================================================
akargl@42181
   465
(* ERROR: constructor real_minus_eq_cancel has not been declared *)
neuper@37906
   466
val th = sym_thm real_minus_eq_cancel;
neuper@37906
   467
val Th = sym_Thm (Thm ("real_minus_eq_cancel", real_minus_eq_cancel));
akargl@42181
   468
val th'= mk_thm ( @{theory "Isac"} ) ((de_quote o string_of_thm) real_minus_eq_cancel);
akargl@42181
   469
val th'= mk_thm Biegelinie.thy((de_quote o string_of_thm) real_minus_eq_cancel);
neuper@37906
   470
neuper@37906
   471
"----- DIFFERENCE TO ABOVE ?!?: this is still ok, when called in next_tac...";
neuper@37906
   472
val ((pt,(p,p_)), _) = get_calc 1; show_pt pt;
neuper@37906
   473
val Appl (Rewrite' (_,_,_,_,thm',_,_)) =
neuper@37906
   474
    applicable_in (p,p_) pt (Rewrite ("sym_real_minus_eq_cancel",""));
neuper@37906
   475
"- compose stac as done in | appy (*leaf*) by handle_leaf";
akargl@42108
   476
neuper@37906
   477
val (th, sr, E, a, v, t) = 
neuper@38058
   478
    ("Biegelinie", 
neuper@37906
   479
     (#srls o get_met) ["IntegrierenUndKonstanteBestimmen"],
neuper@37906
   480
     [(str2term "q__::bool", str2term "q x = q_0")], 
neuper@37926
   481
     SOME (str2term "q x = q_0"),
neuper@37906
   482
     str2term "q__::bool", 
neuper@37906
   483
     str2term "(Rewrite sym_real_minus_eq_cancel False) (q__::bool)");
neuper@37906
   484
val (a', STac stac) = handle_leaf "next  " th sr E a v t;
neuper@37906
   485
term2str stac;
neuper@37906
   486
"--- but this \"m\" is already corrupted";
neuper@37906
   487
val (m,_) = stac2tac_ EmptyPtree (assoc_thy th) stac;
neuper@37906
   488
"- because in assoc_thm'...";
neuper@37906
   489
val (thy, (thmid, ct')) = (Biegelinie.thy, ("sym_real_minus_eq_cancel",""));
neuper@37906
   490
val "s"::"y"::"m"::"_"::id = explode thmid;
neuper@37969
   491
((num_str o (get_thm thy)) (implode id)) RS sym;
neuper@37906
   492
((get_thm thy) (implode id)) RS sym;
neuper@37906
   493
"... this creates [.]";
neuper@37906
   494
((get_thm thy) (implode id));
neuper@37906
   495
"... while this has _NO_ [.]";
neuper@37906
   496
neuper@37906
   497
"----- thus we repair the [.] in string_of_thmI...";
neuper@37969
   498
val thm = ((num_str o (get_thm thy)) (implode id)) RS sym;
neuper@37906
   499
if string_of_thmI thm = "(?b1 = ?a1) = (- ?b1 = - ?a1)" then ()
neuper@38031
   500
else error ("rewtools.sml: string_of_thmI " ^ string_of_thm thm ^
neuper@37906
   501
		  " = " ^ string_of_thmI thm);
akargl@42108
   502
========== inhibit exn 110718 ================================================*)
neuper@37906
   503
neuper@38061
   504
"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[";
neuper@38061
   505
"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[";
neuper@38061
   506
"----------- (sym_real_minus_eq_cancel, (?b1 = ?a1) ..._[";
neuper@37906
   507
states:=[];
neuper@37906
   508
CalcTree [(["Traegerlaenge L","Streckenlast q_0","Biegelinie y",
neuper@37906
   509
	     "RandbedingungenBiegung [y 0 = 0, y L = 0]",
neuper@37906
   510
	     "RandbedingungenMoment [M_b 0 = 0, M_b L = 0]",
neuper@37906
   511
	     "FunktionsVariable x"],
neuper@38058
   512
	    ("Biegelinie",
neuper@37906
   513
	     ["MomentBestimmte","Biegelinien"],
neuper@37906
   514
	     ["IntegrierenUndKonstanteBestimmen"]))];
neuper@37906
   515
moveActiveRoot 1;
neuper@37906
   516
autoCalculate 1 CompleteCalcHead;
neuper@37906
   517
autoCalculate 1 (Step 1) (*Apply_Method*);
neuper@37906
   518
autoCalculate 1 (Step 1) (*->GENERATED ([1], Frm)*);
akargl@42108
   519
(*========== inhibit exn 110718 ================================================
akargl@42108
   520
neuper@37906
   521
"--- this was corrupted before 'fun string_of_thmI'";
neuper@37906
   522
val ((pt,(p,p_)), _) = get_calc 1; show_pt pt;
neuper@37906
   523
if get_obj g_tac pt p = Rewrite ("sym_real_minus_eq_cancel", 
neuper@37906
   524
				 "(?b1 = ?a1) = (- ?b1 = - ?a1)") then ()
neuper@38031
   525
else error "rewtools.sml: string_of_thmI ?!?";
neuper@37906
   526
neuper@37906
   527
getTactic 1 ([1],Frm);
neuper@38061
   528
"----------- fun filter_appl_rews -----------------------";
neuper@38061
   529
"----------- fun filter_appl_rews -----------------------";
neuper@38061
   530
"----------- fun filter_appl_rews -----------------------";
neuper@37906
   531
val f = str2term "a + z + 2*a + 3*z + 5 + 6";
neuper@38050
   532
val thy = assoc_thy "Isac";
neuper@37906
   533
val subst = [(*TODO.WN071231 test Rewrite_Inst*)];
neuper@37906
   534
val rls = Test_simplify;
neuper@37906
   535
(* val rls = rls_p_33;      filter_appl_rews  ---> length 2
neuper@37906
   536
   val rls = norm_Poly;     filter_appl_rews  ---> length 1
neuper@37906
   537
   *)
neuper@37906
   538
if filter_appl_rews thy subst f rls =
neuper@37906
   539
   [Rewrite ("radd_commute", "?m + ?n = ?n + ?m"),
neuper@37906
   540
    Rewrite ("radd_assoc", "?m + ?n + ?k = ?m + (?n + ?k)"),
neuper@37906
   541
    Calculate "plus"] then () 
neuper@38031
   542
else error "rewtools.sml filter_appl_rews a + z + 2*a + 3*z + 5 + 6";
akargl@42108
   543
============ inhibit exn 110718 ==============================================*)
neuper@37906
   544
neuper@37906
   545
neuper@38061
   546
"----------- fun is_contained_in ------------------------";
neuper@38061
   547
"----------- fun is_contained_in ------------------------";
neuper@38061
   548
"----------- fun is_contained_in ------------------------";
neuper@37969
   549
val r1 = Thm ("real_diff_minus",num_str @{thm real_diff_minus});
neuper@37906
   550
if contains_rule r1 Test_simplify then ()
neuper@38031
   551
else error "rewtools.sml contains_rule Thm";
neuper@37906
   552
neuper@38014
   553
val r1 = Calc ("Groups.plus_class.plus", eval_binop "#add_");
neuper@37906
   554
if contains_rule r1 Test_simplify then ()
neuper@38031
   555
else error "rewtools.sml contains_rule Calc";
neuper@37906
   556
neuper@38014
   557
val r1 = Calc ("Groups.minus_class.minus", eval_binop "#add_");
neuper@37906
   558
if not (contains_rule r1 Test_simplify) then ()
neuper@38031
   559
else error "rewtools.sml contains_rule Calc";