test/Tools/isac/Knowledge/polyminus.sml
author wneuper <walther.neuper@jku.at>
Mon, 19 Apr 2021 15:02:00 +0200
changeset 60230 0ca0f9363ad3
parent 59997 46fe5a8c3911
child 60237 e534316f9e07
permissions -rw-r--r--
long identifiers for occurences in test/../termC.sml
wneuper@59582
     1
(* title:  Knowledge/polyminus.sml
neuper@37906
     2
   author: Walther Neuper
neuper@37906
     3
   WN071207,
neuper@37906
     4
   (c) due to copyright terms
neuper@37906
     5
*)
neuper@38037
     6
"--------------------------------------------------------";
neuper@38037
     7
"--------------------------------------------------------";
neuper@38037
     8
"table of contents --------------------------------------";
neuper@38037
     9
"--------------------------------------------------------";
neuper@38037
    10
"----------- fun eval_ist_monom -------------------------";
neuper@38037
    11
"----------- watch order_add_mult  ----------------------";
neuper@38037
    12
"----------- build predicate for +- ordering ------------";
neuper@38037
    13
"----------- build fasse_zusammen -----------------------";
neuper@38037
    14
"----------- build verschoenere -------------------------";
neuper@38037
    15
"----------- met simplification for_polynomials with_minu";
neuper@38080
    16
"----------- me simplification.for_polynomials.with_minus";
neuper@38037
    17
"----------- pbl polynom vereinfachen p.33 --------------";
neuper@38037
    18
"----------- met probe fuer_polynom ---------------------";
neuper@38037
    19
"----------- pbl polynom probe --------------------------";
neuper@38037
    20
"----------- pbl klammer polynom vereinfachen p.34 ------";
neuper@38037
    21
"----------- try fun applyTactics -----------------------";
neuper@38037
    22
"----------- pbl binom polynom vereinfachen p.39 --------";
neuper@38037
    23
"----------- pbl binom polynom vereinfachen: cube -------";
walther@59968
    24
"----------- Refine.refine Vereinfache -------------------------";
walther@59973
    25
"----------- *** Problem.prep_input: syntax error in '#Where' of [v";
neuper@38037
    26
"--------------------------------------------------------";
neuper@38037
    27
"--------------------------------------------------------";
neuper@38037
    28
"--------------------------------------------------------";
neuper@38037
    29
neuper@41929
    30
val thy = @{theory "PolyMinus"};
neuper@37906
    31
neuper@37906
    32
"----------- fun eval_ist_monom ----------------------------------";
neuper@37906
    33
"----------- fun eval_ist_monom ----------------------------------";
neuper@37906
    34
"----------- fun eval_ist_monom ----------------------------------";
walther@60230
    35
ist_monom (TermC.str2term "12");
walther@60230
    36
case eval_ist_monom 0 0 (TermC.str2term "12 ist_monom") 0 of
neuper@37926
    37
    SOME ("12 ist_monom = True", _) => ()
neuper@38031
    38
  | _ => error "polyminus.sml: 12 ist_monom = True";
neuper@37906
    39
walther@60230
    40
case eval_ist_monom 0 0 (TermC.str2term "a ist_monom") 0 of
neuper@37926
    41
    SOME ("a ist_monom = True", _) => ()
neuper@38031
    42
  | _ => error "polyminus.sml: a ist_monom = True";
neuper@37906
    43
walther@60230
    44
case eval_ist_monom 0 0 (TermC.str2term "(3*a) ist_monom") 0 of
neuper@37926
    45
    SOME ("3 * a ist_monom = True", _) => ()
neuper@38031
    46
  | _ => error "polyminus.sml: 3 * a ist_monom = True";
neuper@37906
    47
walther@60230
    48
case eval_ist_monom 0 0 (TermC.str2term "(a^^^2) ist_monom") 0 of 
neuper@37926
    49
   SOME ("a ^^^ 2 ist_monom = True", _) => ()
neuper@38031
    50
  | _ => error "polyminus.sml: a^^^2 ist_monom = True";
neuper@37906
    51
walther@60230
    52
case eval_ist_monom 0 0 (TermC.str2term "(3*a^^^2) ist_monom") 0 of
neuper@37926
    53
    SOME ("3 * a ^^^ 2 ist_monom = True", _) => ()
neuper@38031
    54
  | _ => error "polyminus.sml: 3*a^^^2 ist_monom = True";
neuper@37906
    55
walther@60230
    56
case eval_ist_monom 0 0 (TermC.str2term "(a*b) ist_monom") 0 of
neuper@37926
    57
    SOME ("a * b ist_monom = True", _) => ()
neuper@38031
    58
  | _ => error "polyminus.sml: a*b ist_monom = True";
neuper@37906
    59
walther@60230
    60
case eval_ist_monom 0 0 (TermC.str2term "(3*a*b) ist_monom") 0 of
neuper@37926
    61
    SOME ("3 * a * b ist_monom = True", _) => ()
neuper@38031
    62
  | _ => error "polyminus.sml: 3*a*b ist_monom = True";
neuper@37906
    63
neuper@37906
    64
neuper@37906
    65
"----------- watch order_add_mult  -------------------------------";
neuper@37906
    66
"----------- watch order_add_mult  -------------------------------";
neuper@37906
    67
"----------- watch order_add_mult  -------------------------------";
neuper@37906
    68
"----- with these simple variables it works...";
walther@59901
    69
(*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
walther@59901
    70
Rewrite.trace_on:=false;
walther@60230
    71
val t = TermC.str2term "((a + d) + c) + b";
walther@59868
    72
val SOME (t,_) = rewrite_set_ thy false order_add_mult t; UnparseC.term t;
walther@59868
    73
if UnparseC.term t = "a + (b + (c + d))" then ()
neuper@38031
    74
else error "polyminus.sml 1 watch order_add_mult";
walther@59901
    75
Rewrite.trace_on:=false;
neuper@37906
    76
neuper@37906
    77
"----- the same stepwise...";
neuper@41929
    78
val od = ord_make_polynomial true (@{theory "Poly"});
walther@60230
    79
val t = TermC.str2term "((a + d) + c) + b";
neuper@37906
    80
"((a + d) + c) + b"; 
walther@59868
    81
val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.commute} t; UnparseC.term t;
neuper@37906
    82
"b + ((a + d) + c)";
walther@59868
    83
val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.commute} t; UnparseC.term t;
neuper@37906
    84
"b + (c + (a + d))";
walther@59868
    85
val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.left_commute} t;UnparseC.term t;
neuper@37906
    86
"b + (a + (c + d))";
walther@59868
    87
val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.left_commute} t;UnparseC.term t;
neuper@37906
    88
"a + (b + (c + d))";
walther@59868
    89
if UnparseC.term t = "a + (b + (c + d))" then ()
neuper@38031
    90
else error "polyminus.sml 2 watch order_add_mult";
neuper@37906
    91
neuper@37906
    92
"----- if parentheses are right, left_commute is (almost) sufficient...";
walther@60230
    93
val t = TermC.str2term "a + (d + (c + b))";
neuper@37906
    94
"a + (d + (c + b))";
walther@59868
    95
val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.left_commute} t;UnparseC.term t;
neuper@37906
    96
"a + (c + (d + b))";
walther@59868
    97
val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.commute} t;UnparseC.term t;
neuper@37906
    98
"a + (c + (b + d))";
walther@59868
    99
val SOME (t,_) = rewrite_ thy od Rule_Set.empty true @{thm add.left_commute} t;UnparseC.term t;
neuper@37906
   100
"a + (b + (c + d))";
neuper@37906
   101
neuper@37906
   102
"----- but we do not want the parentheses at right; thus: cond.rew.";
neuper@37906
   103
"WN0712707 complicated monomials do not yet work ...";
walther@60230
   104
val t = TermC.str2term "((5*a + 4*d) + 3*c) + 2*b";
walther@59868
   105
val SOME (t,_) = rewrite_set_ thy false order_add_mult t; UnparseC.term t;
walther@59868
   106
if UnparseC.term t = "2 * b + (3 * c + (4 * d + 5 * a))" then ()
neuper@38031
   107
else error "polyminus.sml: order_add_mult changed";
neuper@37906
   108
neuper@37906
   109
"----- here we see rew_sub going into subterm with ord.rew....";
neuper@41929
   110
val od = ord_make_polynomial false (@{theory "Poly"});
walther@60230
   111
val t = TermC.str2term "b + a + c + d";
walther@59868
   112
val SOME (t,_) = rewrite_ thy od Rule_Set.empty false @{thm add.commute} t; UnparseC.term t;
walther@59868
   113
val SOME (t,_) = rewrite_ thy od Rule_Set.empty false @{thm add.commute} t; UnparseC.term t;
neuper@37906
   114
(*@@@ rew_sub gosub: t = d + (b + a + c)
neuper@37906
   115
  @@@ rew_sub begin: t = b + a + c*)
neuper@37906
   116
neuper@37906
   117
neuper@37906
   118
"----------- build predicate for +- ordering ---------------------";
neuper@37906
   119
"----------- build predicate for +- ordering ---------------------";
neuper@37906
   120
"----------- build predicate for +- ordering ---------------------";
neuper@37906
   121
"a" < "b";
neuper@37906
   122
"ba" < "ab";
neuper@37906
   123
"123" < "a"; (*unused due to ---vvv*)
neuper@37906
   124
"12" < "3"; (*true !!!*)
neuper@37906
   125
neuper@37906
   126
" a kleiner b ==> (b + a) = (a + b)";
walther@60230
   127
TermC.str2term "aaa";
walther@60230
   128
TermC.str2term "222 * aaa";
neuper@42390
   129
walther@60230
   130
case eval_kleiner 0 0 (TermC.str2term "123 kleiner 32") 0 of
neuper@42390
   131
    SOME ("123 kleiner 32 = False", _) => ()
neuper@38031
   132
  | _ => error "polyminus.sml: 12 kleiner 9 = False";
neuper@42390
   133
walther@60230
   134
case eval_kleiner 0 0 (TermC.str2term "a kleiner b") 0 of
neuper@37926
   135
    SOME ("a kleiner b = True", _) => ()
neuper@38031
   136
  | _ => error "polyminus.sml: a kleiner b = True";
neuper@37906
   137
walther@60230
   138
case eval_kleiner 0 0 (TermC.str2term "(10*g) kleiner f") 0 of
neuper@37926
   139
    SOME ("10 * g kleiner f = False", _) => ()
neuper@38031
   140
  | _ => error "polyminus.sml: 10 * g kleiner f = False";
neuper@37906
   141
walther@60230
   142
case eval_kleiner 0 0 (TermC.str2term "(a^^^2) kleiner b") 0 of
neuper@37926
   143
    SOME ("a ^^^ 2 kleiner b = True", _) => ()
neuper@38031
   144
  | _ => error "polyminus.sml: a ^^^ 2 kleiner b = True";
neuper@37906
   145
walther@60230
   146
case eval_kleiner 0 0 (TermC.str2term "(3*a^^^2) kleiner b") 0 of
neuper@37926
   147
    SOME ("3 * a ^^^ 2 kleiner b = True", _) => ()
neuper@38031
   148
  | _ => error "polyminus.sml: 3 * a ^^^ 2 kleiner b = True";
neuper@37906
   149
walther@60230
   150
case eval_kleiner 0 0 (TermC.str2term "(a*b) kleiner c") 0 of
neuper@37926
   151
    SOME ("a * b kleiner c = True", _) => ()
neuper@38031
   152
  | _ => error "polyminus.sml: a * b kleiner b = True";
neuper@37906
   153
walther@60230
   154
case eval_kleiner 0 0 (TermC.str2term "(3*a*b) kleiner c") 0 of
neuper@37926
   155
    SOME ("3 * a * b kleiner c = True", _) => ()
neuper@38031
   156
  | _ => error "polyminus.sml: 3 * a * b kleiner b = True";
neuper@37906
   157
neuper@42390
   158
"======= compare tausche_plus with real_num_collect";
neuper@37906
   159
val od = dummy_ord;
neuper@37906
   160
neuper@37906
   161
val erls = erls_ordne_alphabetisch;
walther@60230
   162
val t = TermC.str2term "b + a";
walther@59868
   163
val SOME (t,_) = rewrite_ thy od erls false @{thm tausche_plus} t; UnparseC.term t;
walther@59868
   164
if UnparseC.term t = "a + b" then ()
neuper@38031
   165
else error "polyminus.sml: ordne_alphabetisch1 b + a";
neuper@37906
   166
neuper@37906
   167
val erls = Atools_erls;
walther@60230
   168
val t = TermC.str2term "2*a + 3*a";
walther@59868
   169
val SOME (t,_) = rewrite_ thy od erls false @{thm real_num_collect} t; UnparseC.term t;
neuper@37906
   170
neuper@42390
   171
"======= test rewrite_, rewrite_set_";
walther@59901
   172
(*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
neuper@37906
   173
val erls = erls_ordne_alphabetisch;
walther@60230
   174
val t = TermC.str2term "b + a";
walther@59868
   175
val SOME (t,_) = rewrite_set_ thy false ordne_alphabetisch t; UnparseC.term t;
walther@59868
   176
if UnparseC.term t = "a + b" then ()
neuper@38031
   177
else error "polyminus.sml: ordne_alphabetisch a + b";
neuper@37906
   178
walther@60230
   179
val t = TermC.str2term "2*b + a";
walther@59868
   180
val SOME (t,_) = rewrite_set_ thy false ordne_alphabetisch t; UnparseC.term t;
walther@59868
   181
if UnparseC.term t = "a + 2 * b" then ()
neuper@38031
   182
else error "polyminus.sml: ordne_alphabetisch a + 2 * b";
neuper@37906
   183
walther@60230
   184
val t = TermC.str2term "a + c + b";
walther@59868
   185
val SOME (t,_) = rewrite_set_ thy false ordne_alphabetisch t; UnparseC.term t;
walther@59868
   186
if UnparseC.term t = "a + b + c" then ()
neuper@38031
   187
else error "polyminus.sml: ordne_alphabetisch a + b + c";
neuper@37906
   188
neuper@42390
   189
"======= rewrite goes into subterms";
walther@60230
   190
val t = TermC.str2term "a + c + b + d";
walther@59868
   191
val SOME (t,_) = rewrite_ thy od erls false @{thm tausche_plus_plus} t; UnparseC.term t;
walther@59868
   192
if UnparseC.term t = "a + b + c + d" then ()
neuper@38031
   193
else error "polyminus.sml: ordne_alphabetisch1 a + b + c + d";
neuper@37906
   194
walther@60230
   195
val t = TermC.str2term "a + c + d + b";
walther@59868
   196
val SOME (t,_) = rewrite_set_ thy false ordne_alphabetisch t; UnparseC.term t;
walther@59868
   197
if UnparseC.term t = "a + b + c + d" then ()
neuper@38031
   198
else error "polyminus.sml: ordne_alphabetisch2 a + b + c + d";
neuper@37906
   199
neuper@42390
   200
"======= here we see rew_sub going into subterm with cond.rew....";
walther@60230
   201
val t = TermC.str2term "b + a + c + d";
walther@59868
   202
val SOME (t,_) = rewrite_ thy od erls false @{thm tausche_plus} t; UnparseC.term t;
walther@59868
   203
if UnparseC.term t = "a + b + c + d" then ()
neuper@38031
   204
else error "polyminus.sml: ordne_alphabetisch3 a + b + c + d";
neuper@37906
   205
neuper@42390
   206
"======= compile rls for the most complicated terms";
walther@60230
   207
val t = TermC.str2term "5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12";
neuper@37906
   208
"5 * e + 6 * f - 8 * g - 9 - 7 * e - 4 * f + 10 * g + 12";
neuper@37926
   209
val SOME (t,_) = rewrite_set_ thy false ordne_alphabetisch t; 
walther@59868
   210
if UnparseC.term t = "- 9 + 12 + 5 * e - 7 * e + 6 * f - 4 * f - 8 * g + 10 * g"
neuper@38031
   211
then () else error "polyminus.sml: ordne_alphabetisch finished";
neuper@37906
   212
neuper@37906
   213
neuper@37906
   214
"----------- build fasse_zusammen --------------------------------";
neuper@37906
   215
"----------- build fasse_zusammen --------------------------------";
neuper@37906
   216
"----------- build fasse_zusammen --------------------------------";
walther@60230
   217
val t = TermC.str2term "- 9 + 12 + 5 * e - 7 * e + 6 * f - 4 * f - 8 * g + 10 * g";
neuper@37926
   218
val SOME (t,_) = rewrite_set_ thy false fasse_zusammen t;
walther@59868
   219
if UnparseC.term t = "3 + -2 * e + 2 * f + 2 * g" then ()
neuper@38031
   220
else error "polyminus.sml: fasse_zusammen finished";
neuper@37906
   221
neuper@37906
   222
"----------- build verschoenere ----------------------------------";
neuper@37906
   223
"----------- build verschoenere ----------------------------------";
neuper@37906
   224
"----------- build verschoenere ----------------------------------";
walther@60230
   225
val t = TermC.str2term "3 + -2 * e + 2 * f + 2 * g";
neuper@37926
   226
val SOME (t,_) = rewrite_set_ thy false verschoenere t;
walther@59868
   227
if UnparseC.term t = "3 - 2 * e + 2 * f + 2 * g" then ()
neuper@38031
   228
else error "polyminus.sml: verschoenere 3 + -2 * e ...";
neuper@37906
   229
walther@59901
   230
(*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
walther@59901
   231
Rewrite.trace_on:=false;
neuper@37906
   232
neuper@37906
   233
"----------- met simplification for_polynomials with_minus -------";
neuper@37906
   234
"----------- met simplification for_polynomials with_minus -------";
neuper@37906
   235
"----------- met simplification for_polynomials with_minus -------";
neuper@37906
   236
val str = 
wneuper@59585
   237
"Program SimplifyScript (t_t::real) =                \
walther@59637
   238
\  (((Try (Rewrite_Set ordne_alphabetisch False)) #>     \
walther@59637
   239
\    (Try (Rewrite_Set fasse_zusammen False)) #>     \
neuper@38080
   240
\    (Try (Rewrite_Set verschoenere False))) t_t)"
walther@60230
   241
val sc = (inst_abs o Thm.term_of o the o (TermC.parse thy)) str;
walther@60230
   242
TermC.atomty sc;
neuper@37906
   243
neuper@38080
   244
"----------- me simplification.for_polynomials.with_minus";
neuper@38080
   245
"----------- me simplification.for_polynomials.with_minus";
neuper@38080
   246
"----------- me simplification.for_polynomials.with_minus";
neuper@38080
   247
val c = [];
neuper@38080
   248
val (p,_,f,nxt,_,pt) = 
neuper@38080
   249
      CalcTreeTEST 
neuper@38083
   250
        [(["Term (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12)",
neuper@38080
   251
           "normalform N"],
walther@59997
   252
	          ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
walther@59997
   253
	           ["simplification", "for_polynomials", "with_minus"]))];
neuper@38080
   254
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@38085
   255
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@38085
   256
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@38085
   257
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@38085
   258
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@38085
   259
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   260
neuper@38085
   261
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@38085
   262
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@38085
   263
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@38085
   264
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@38085
   265
val (p,_,f,nxt,_,pt) = me nxt p c pt;
walther@59749
   266
if f2str f = "3 - 2 * e + 2 * f + 2 * g" 
walther@59749
   267
then case nxt of End_Proof' => () | _ =>  error "me simplification.for_polynomials.with_minus 1"
walther@59749
   268
else error "polyminus.sml: me simplification.for_polynomials.with_minus 2";
neuper@38085
   269
neuper@37906
   270
"----------- pbl polynom vereinfachen p.33 -----------------------";
neuper@37906
   271
"----------- pbl polynom vereinfachen p.33 -----------------------";
neuper@37906
   272
"----------- pbl polynom vereinfachen p.33 -----------------------";
neuper@37906
   273
"----------- 140 c ---";
s1210629013@55445
   274
reset_states ();
neuper@38083
   275
CalcTree [(["Term (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12)",
neuper@37906
   276
	    "normalform N"],
walther@59997
   277
	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
walther@59997
   278
	    ["simplification", "for_polynomials", "with_minus"]))];
neuper@37906
   279
moveActiveRoot 1;
wneuper@59248
   280
autoCalculate 1 CompleteCalc;
walther@59983
   281
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   282
if p = ([], Res) andalso 
walther@59868
   283
   UnparseC.term (get_obj g_res pt (fst p)) = "3 - 2 * e + 2 * f + 2 * g"
neuper@38031
   284
then () else error "polyminus.sml: Vereinfache (3 - 2 * e + 2 * f...";
neuper@37906
   285
neuper@42390
   286
"======= 140 d ---";
s1210629013@55445
   287
reset_states ();
neuper@38083
   288
CalcTree [(["Term (-r - 2*s - 3*t + 5 + 4*r + 8*s - 5*t - 2)",
neuper@37906
   289
	    "normalform N"],
walther@59997
   290
	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
walther@59997
   291
	    ["simplification", "for_polynomials", "with_minus"]))];
neuper@37906
   292
moveActiveRoot 1;
wneuper@59248
   293
autoCalculate 1 CompleteCalc;
walther@59983
   294
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   295
if p = ([], Res) andalso 
walther@59868
   296
   UnparseC.term (get_obj g_res pt (fst p)) = "3 + 3 * r + 6 * s - 8 * t"
neuper@38031
   297
then () else error "polyminus.sml: Vereinfache 140 d)";
neuper@37906
   298
neuper@42390
   299
"======= 139 c ---";
s1210629013@55445
   300
reset_states ();
neuper@38083
   301
CalcTree [(["Term (3*e - 6*f - 8*e - 4*f + 5*e + 7*f)",
neuper@37906
   302
	    "normalform N"],
walther@59997
   303
	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
walther@59997
   304
	    ["simplification", "for_polynomials", "with_minus"]))];
neuper@37906
   305
moveActiveRoot 1;
wneuper@59248
   306
autoCalculate 1 CompleteCalc;
walther@59983
   307
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   308
if p = ([], Res) andalso 
walther@59868
   309
   UnparseC.term (get_obj g_res pt (fst p)) = "- (3 * f)"
neuper@38031
   310
then () else error "polyminus.sml: Vereinfache 139 c)";
neuper@37906
   311
neuper@42390
   312
"======= 139 b ---";
s1210629013@55445
   313
reset_states ();
neuper@38083
   314
CalcTree [(["Term (8*u - 5*v - 5*u + 7*v - 6*u - 3*v)",
neuper@37906
   315
	    "normalform N"],
walther@59997
   316
	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
walther@59997
   317
	    ["simplification", "for_polynomials", "with_minus"]))];
neuper@37906
   318
moveActiveRoot 1;
wneuper@59248
   319
autoCalculate 1 CompleteCalc;
walther@59983
   320
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   321
if p = ([], Res) andalso 
walther@59868
   322
   UnparseC.term (get_obj g_res pt (fst p)) = "-3 * u - v"
neuper@38031
   323
then () else error "polyminus.sml: Vereinfache 139 b)";
neuper@37906
   324
neuper@42390
   325
"======= 138 a ---";
s1210629013@55445
   326
reset_states ();
neuper@38083
   327
CalcTree [(["Term (2*u - 3*v - 6*u + 5*v)",
neuper@37906
   328
	    "normalform N"],
walther@59997
   329
	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
walther@59997
   330
	    ["simplification", "for_polynomials", "with_minus"]))];
neuper@37906
   331
moveActiveRoot 1;
wneuper@59248
   332
autoCalculate 1 CompleteCalc;
walther@59983
   333
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   334
if p = ([], Res) andalso 
walther@59868
   335
   UnparseC.term (get_obj g_res pt (fst p)) = "-4 * u + 2 * v"
neuper@38031
   336
then () else error "polyminus.sml: Vereinfache 138 a)";
neuper@37906
   337
neuper@37906
   338
"----------- met probe fuer_polynom ------------------------------";
neuper@37906
   339
"----------- met probe fuer_polynom ------------------------------";
neuper@37906
   340
"----------- met probe fuer_polynom ------------------------------";
neuper@37906
   341
val str = 
wneuper@59585
   342
"Program ProbeScript (e_e::bool) (w_s::bool list) =\
neuper@37991
   343
\ (let e_e = Take e_e;                             \
neuper@38085
   344
\      e_e = Substitute w_s e_e                    \
walther@59637
   345
\ in (Repeat((Try (Repeat (Calculate ''TIMES''))) #>  \
walther@59637
   346
\            (Try (Repeat (Calculate ''PLUS''))) #>  \
wneuper@59488
   347
\            (Try (Repeat (Calculate ''MINUS''))))) e_e)"
walther@60230
   348
val sc = (inst_abs o Thm.term_of o the o (TermC.parse thy)) str;
walther@60230
   349
TermC.atomty sc;
neuper@37906
   350
neuper@37906
   351
"----------- pbl polynom probe -----------------------------------";
neuper@37906
   352
"----------- pbl polynom probe -----------------------------------";
neuper@37906
   353
"----------- pbl polynom probe -----------------------------------";
s1210629013@55445
   354
reset_states ();
bonzai@41949
   355
CalcTree [(["Pruefe ((5::int)*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12 =\
wneuper@59582
   356
	    \3 - 2 * e + 2 * f + 2 * (g::int))",
wneuper@59582
   357
	    "mitWert [e = (1::int), f = (2::int), g = (3::int)]",
neuper@37906
   358
	    "Geprueft b"],
walther@59997
   359
	   ("PolyMinus",["polynom", "probe"],
walther@59997
   360
	    ["probe", "fuer_polynom"]))];
neuper@37906
   361
moveActiveRoot 1;
wneuper@59248
   362
autoCalculate 1 CompleteCalc;
wneuper@59248
   363
(* autoCalculate 1 CompleteCalcHead;
walther@59747
   364
   autoCalculate 1 (Steps 1);
walther@59747
   365
   autoCalculate 1 (Steps 1);
walther@59868
   366
   val ((pt,p),_) = get_calc 1; UnparseC.term (get_obj g_res pt (fst p));
neuper@37906
   367
@@@@@WN081114 gives "??.empty", all "Pruefe" are the same,
neuper@37906
   368
although analogies work in interface.sml: FIXME.WN081114 in "Pruefe"*)
neuper@37906
   369
val ((pt,p),_) = get_calc 1;
walther@59868
   370
if p = ([], Res) andalso UnparseC.term (get_obj g_res pt (fst p)) = "11 = 11"
neuper@38031
   371
then () else error "polyminus.sml: Probe 11 = 11";
walther@59983
   372
Test_Tool.show_pt pt;
t@42115
   373
neuper@37906
   374
"----------- pbl klammer polynom vereinfachen p.34 ---------------";
neuper@37906
   375
"----------- pbl klammer polynom vereinfachen p.34 ---------------";
neuper@37906
   376
"----------- pbl klammer polynom vereinfachen p.34 ---------------";
s1210629013@55445
   377
reset_states ();
neuper@38083
   378
CalcTree [(["Term (2*u - 5 - (3 - 4*u) + (8*u + 9))",
neuper@37906
   379
	    "normalform N"],
walther@59997
   380
	   ("PolyMinus",["klammer", "polynom", "vereinfachen"],
walther@59997
   381
	    ["simplification", "for_polynomials", "with_parentheses"]))];
neuper@37906
   382
moveActiveRoot 1;
wneuper@59248
   383
autoCalculate 1 CompleteCalc;
neuper@37906
   384
val ((pt,p),_) = get_calc 1;
neuper@37906
   385
if p = ([], Res) andalso 
walther@59868
   386
   UnparseC.term (get_obj g_res pt (fst p)) = "1 + 14 * u"
neuper@38031
   387
then () else error "polyminus.sml: Vereinfache (2*u - 5 - (3 - ...";
walther@59983
   388
Test_Tool.show_pt pt;
neuper@37906
   389
neuper@42390
   390
"======= probe p.34 -----";
s1210629013@55445
   391
reset_states ();
wneuper@59582
   392
CalcTree [(["Pruefe (2*u - 5 - (3 - 4*u) + (8*u + 9) = 1 + 14 * (u::int))",
wneuper@59582
   393
	    "mitWert [u = (2::int)]",
neuper@37906
   394
	    "Geprueft b"],
walther@59997
   395
	   ("PolyMinus",["polynom", "probe"],
walther@59997
   396
	    ["probe", "fuer_polynom"]))];
neuper@37906
   397
moveActiveRoot 1;
wneuper@59248
   398
autoCalculate 1 CompleteCalc;
neuper@37906
   399
val ((pt,p),_) = get_calc 1;
walther@59868
   400
if p = ([], Res) andalso UnparseC.term (get_obj g_res pt (fst p)) = "29 = 29"
neuper@38031
   401
then () else error "polyminus.sml: Probe 29 = 29";
walther@59983
   402
Test_Tool.show_pt pt;
neuper@37906
   403
neuper@37906
   404
"----------- try fun applyTactics --------------------------------";
neuper@37906
   405
"----------- try fun applyTactics --------------------------------";
neuper@37906
   406
"----------- try fun applyTactics --------------------------------";
s1210629013@55445
   407
reset_states ();
neuper@38083
   408
CalcTree [(["Term (5*e + 6*f - 8*g - 9 - 7*e - 4*f + 10*g + 12)",
neuper@37906
   409
	    "normalform N"],
walther@59997
   410
	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
walther@59997
   411
	    ["simplification", "for_polynomials", "with_minus"]))];
neuper@37906
   412
moveActiveRoot 1;
wneuper@59248
   413
autoCalculate 1 CompleteCalcHead;
walther@59747
   414
autoCalculate 1 (Steps 1);
walther@59747
   415
autoCalculate 1 (Steps 1);
walther@59983
   416
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   417
"----- 1 ^^^";
neuper@37906
   418
fetchApplicableTactics 1 0 p;
walther@59823
   419
val appltacs = specific_from_prog pt p;
neuper@37906
   420
applyTactic 1 p (hd appltacs) (*addiere_x_plus_minus*);
walther@59983
   421
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   422
"----- 2 ^^^";
walther@59901
   423
(*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
neuper@37906
   424
val erls = erls_ordne_alphabetisch;
walther@60230
   425
val t = TermC.str2term "- 9 + 12 + 5 * e - 7 * e + (6 - 4) * f - 8 * g + 10 * g";
neuper@37926
   426
val SOME (t',_) = 
wneuper@59592
   427
    rewrite_ (@{theory "Isac_Knowledge"}) e_rew_ord erls false @{thm tausche_minus} t;
walther@59868
   428
UnparseC.term t';     "- 9 + 12 + 5 * e - 7 * e + (- 4 + 6) * f - 8 * g + 10 * g";
neuper@37906
   429
walther@60230
   430
val t = TermC.str2term "- 9 + 12 + 5 * e - 7 * e + (6 - 4) * f - 8 * g + 10 * g";
neuper@37926
   431
val NONE = 
wneuper@59592
   432
    rewrite_ (@{theory "Isac_Knowledge"}) e_rew_ord erls false @{thm tausche_minus_plus} t;
neuper@37906
   433
walther@60230
   434
val t = TermC.str2term "- 9 + 12 + 5 * e - 7 * e + (6 - 4) * f - 8 * g + 10 * g";
neuper@37926
   435
val SOME (t',_) = 
wneuper@59592
   436
    rewrite_set_ (@{theory "Isac_Knowledge"}) false ordne_alphabetisch t;
walther@59868
   437
UnparseC.term t';     "- 9 + 12 + 5 * e - 7 * e - 8 * g + 10 * g + (- 4 + 6) * f";
walther@59901
   438
Rewrite.trace_on := false;
neuper@37906
   439
neuper@37906
   440
walther@59823
   441
applyTactic 1 p (hd (specific_from_prog pt p)) (*tausche_minus*);
walther@59983
   442
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   443
"----- 3 ^^^";
walther@59823
   444
applyTactic 1 p (hd (specific_from_prog pt p)) (**);
walther@59983
   445
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   446
"----- 4 ^^^";
walther@59823
   447
applyTactic 1 p (hd (specific_from_prog pt p)) (**);
walther@59983
   448
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   449
"----- 5 ^^^";
walther@59823
   450
applyTactic 1 p (hd (specific_from_prog pt p)) (**);
walther@59983
   451
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   452
"----- 6 ^^^";
neuper@37906
   453
neuper@37906
   454
(*<CALCMESSAGE> failure </CALCMESSAGE>
walther@59823
   455
applyTactic 1 p (hd (specific_from_prog pt p)) (**);
walther@59983
   456
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   457
"----- 7 ^^^";
neuper@37906
   458
*)
wneuper@59248
   459
autoCalculate 1 CompleteCalc;
walther@59983
   460
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   461
(*independent from failure above: met_simp_poly_minus not confluent:
neuper@37906
   462
(([9], Res), - (8 * g) + 10 * g + (3 - 2 * e + 2 * f)),
neuper@37906
   463
(([], Res), - (8 * g) + 10 * g + (3 - 2 * e + 2 * f))]
neuper@37906
   464
~~~~~~~~~~~###~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
t@42115
   465
neuper@37906
   466
neuper@42107
   467
"#############################################################################";
s1210629013@55445
   468
reset_states ();
neuper@38083
   469
CalcTree [(["Term (- (8 * g) + 10 * g + h)",
neuper@37906
   470
	    "normalform N"],
walther@59997
   471
	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
walther@59997
   472
	    ["simplification", "for_polynomials", "with_minus"]))];
neuper@37906
   473
moveActiveRoot 1;
wneuper@59248
   474
autoCalculate 1 CompleteCalc;
walther@59983
   475
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
walther@59868
   476
if p = ([], Res) andalso UnparseC.term (get_obj g_res pt (fst p)) = "2 * g + h"
neuper@38031
   477
then () else error "polyminus.sml: addiere_vor_minus";
neuper@37906
   478
neuper@37906
   479
neuper@42107
   480
"#############################################################################";
s1210629013@55445
   481
reset_states ();
neuper@38083
   482
CalcTree [(["Term (- (8 * g) + 10 * g + f)",
neuper@37906
   483
	    "normalform N"],
walther@59997
   484
	   ("PolyMinus",["plus_minus", "polynom", "vereinfachen"],
walther@59997
   485
	    ["simplification", "for_polynomials", "with_minus"]))];
neuper@37906
   486
moveActiveRoot 1;
wneuper@59248
   487
autoCalculate 1 CompleteCalc;
walther@59983
   488
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
walther@59868
   489
if p = ([], Res) andalso UnparseC.term (get_obj g_res pt (fst p)) = "f + 2 * g"
neuper@38031
   490
then () else error "polyminus.sml: tausche_vor_plus";
neuper@37906
   491
neuper@37906
   492
"----------- pbl binom polynom vereinfachen p.39 -----------------";
neuper@37906
   493
"----------- pbl binom polynom vereinfachen p.39 -----------------";
neuper@37906
   494
"----------- pbl binom polynom vereinfachen p.39 -----------------";
neuper@37906
   495
val rls = klammern_ausmultiplizieren;
walther@60230
   496
val t = TermC.str2term "(3 * a + 2) * (4 * a - 1)";
walther@59868
   497
val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
neuper@37906
   498
"3 * a * (4 * a) - 3 * a * 1 + (2 * (4 * a) - 2 * 1)";
neuper@37906
   499
val rls = discard_parentheses;
walther@59868
   500
val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
neuper@37906
   501
"3 * a * 4 * a - 3 * a * 1 + (2 * 4 * a - 2 * 1)";
neuper@37906
   502
val rls = ordne_monome;
walther@59868
   503
val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
neuper@37906
   504
"3 * 4 * a * a - 1 * 3 * a + (2 * 4 * a - 1 * 2)";
neuper@37906
   505
(*
walther@60230
   506
val t = TermC.str2term "3 * a * 4 * a";
neuper@37906
   507
val rls = ordne_monome;
walther@59868
   508
val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
neuper@37906
   509
*)
neuper@37906
   510
val rls = klammern_aufloesen;
walther@59868
   511
val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
neuper@37906
   512
"3 * 4 * a * a - 1 * 3 * a + 2 * 4 * a - 1 * 2";
neuper@37906
   513
val rls = ordne_alphabetisch;
neuper@37906
   514
(*TODO: make is_monom more general, a*a=a^2, ...*)
walther@59868
   515
val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
neuper@37906
   516
"3 * 4 * a * a - 1 * 2 - 1 * 3 * a + 2 * 4 * a";
neuper@41977
   517
(*STOPPED.WN080104
neuper@37906
   518
val rls = fasse_zusammen;
walther@59868
   519
val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
neuper@37906
   520
val rls = verschoenere;
walther@59868
   521
val SOME (t,_) = rewrite_set_ thy false rls t; UnparseC.term t;
neuper@37906
   522
*)
neuper@37906
   523
neuper@37906
   524
(*@@@@@@@*)
s1210629013@55445
   525
reset_states ();
neuper@38083
   526
CalcTree [(["Term ((3*a + 2) * (4*a - 1))",
neuper@37906
   527
	    "normalform N"],
walther@59997
   528
	   ("PolyMinus",["binom_klammer", "polynom", "vereinfachen"],
walther@59997
   529
	    ["simplification", "for_polynomials", "with_parentheses_mult"]))];
neuper@37906
   530
moveActiveRoot 1;
wneuper@59248
   531
autoCalculate 1 CompleteCalc;
walther@59983
   532
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
neuper@37906
   533
if p = ([], Res) andalso 
walther@59868
   534
   UnparseC.term (get_obj g_res pt (fst p)) = "-2 + 12 * a ^^^ 2 + 5 * a"
neuper@38031
   535
then () else error "polyminus.sml: Vereinfache (2*u - 5 - (3 - ...";
t@42111
   536
neuper@37906
   537
"----------- pbl binom polynom vereinfachen: cube ----------------";
neuper@37906
   538
"----------- pbl binom polynom vereinfachen: cube ----------------";
neuper@37906
   539
"----------- pbl binom polynom vereinfachen: cube ----------------";
s1210629013@55445
   540
reset_states ();
neuper@38083
   541
CalcTree [(["Term (8*(a - q) + a - 2*q + 3*(a - 2*q))", "normalform N"],
walther@59997
   542
	   ("PolyMinus",["binom_klammer", "polynom", "vereinfachen"],
walther@59997
   543
	    ["simplification", "for_polynomials", "with_parentheses_mult"]))];
neuper@37906
   544
moveActiveRoot 1;
wneuper@59248
   545
autoCalculate 1 CompleteCalc;
walther@59983
   546
val ((pt,p),_) = get_calc 1; Test_Tool.show_pt pt;
walther@59868
   547
if p = ([], Res) andalso UnparseC.term (get_obj g_res pt (fst p)) = "12 * a - 16 * q" 
neuper@42107
   548
then () else error "pbl binom polynom vereinfachen: cube";
neuper@37906
   549
walther@59968
   550
"----------- Refine.refine Vereinfache ----------------------------------";
walther@59968
   551
"----------- Refine.refine Vereinfache ----------------------------------";
walther@59968
   552
"----------- Refine.refine Vereinfache ----------------------------------";
neuper@42390
   553
val fmz = ["Term (8*(a - q) + a - 2*q + 3*(a - 2*(q::real)))", "normalform (N::real)"];
wneuper@59348
   554
(*default_print_depth 11;*)
walther@60230
   555
val TermC.matches = Refine.refine fmz ["vereinfachen"];
wneuper@59348
   556
(*default_print_depth 3;*)
neuper@37906
   557
neuper@37906
   558
"----- go into details, if it seems not to work -----";
neuper@37906
   559
"--- does the predicate evaluate correctly ?";
walther@60230
   560
val t = TermC.str2term 
neuper@42390
   561
	    "matchsub (?a * (?b - ?c)) (8 * (a - q) + a - 2 * q + 3 * (a - 2 * (q::real)))";
walther@59603
   562
val ma = eval_matchsub "" "Prog_Expr.matchsub" t thy;
neuper@37906
   563
case ma of
neuper@37926
   564
    SOME ("matchsub (?a * (?b - ?c)) (8 * (a - q) + \
neuper@37906
   565
	  \a - 2 * q + 3 * (a - 2 * q)) = True", _) => ()
neuper@38031
   566
  | _ => error "polyminus.sml matchsub (?a * (?b - ?c)...A";
neuper@37906
   567
neuper@37906
   568
"--- does the respective prls rewrite ?";
walther@59852
   569
val prls = Rule_Set.append_rules "prls_pbl_vereinf_poly" Rule_Set.empty 
walther@59878
   570
	     [Eval ("Poly.is'_polyexp", eval_is_polyexp ""),
walther@59878
   571
	      Eval ("Prog_Expr.matchsub", eval_matchsub ""),
neuper@38085
   572
	      Thm ("or_true",@{thm or_true}),
neuper@37906
   573
	      (*"(?a | True) = True"*)
neuper@38085
   574
	      Thm ("or_false",@{thm or_false}),
neuper@37906
   575
	      (*"(?a | False) = ?a"*)
walther@59871
   576
	      Thm ("not_true",ThmC.numerals_to_Free @{thm not_true}),
neuper@37906
   577
	      (*"(~ True) = False"*)
walther@59871
   578
	      Thm ("not_false",ThmC.numerals_to_Free @{thm not_false})
neuper@37906
   579
	      (*"(~ False) = True"*)];
walther@59901
   580
(*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
neuper@37926
   581
val SOME (t', _) = rewrite_set_ thy false prls t;
walther@59901
   582
Rewrite.trace_on := false;
neuper@37906
   583
neuper@37906
   584
"--- does the respective prls rewrite the whole predicate ?";
walther@60230
   585
val t = TermC.str2term 
neuper@37906
   586
	    "Not (matchsub (?a * (?b + ?c)) (8 * (a - q) + a - 2 * q) | \
neuper@37906
   587
	    \     matchsub (?a * (?b - ?c)) (8 * (a - q) + a - 2 * q) | \
neuper@37906
   588
	    \     matchsub ((?b + ?c) * ?a) (8 * (a - q) + a - 2 * q) | \
neuper@37906
   589
	    \     matchsub ((?b - ?c) * ?a) (8 * (a - q) + a - 2 * q) )";
walther@59901
   590
(*Rewrite.trace_on := true; ..stopped Test_Isac.thy*)
neuper@37926
   591
val SOME (t', _) = rewrite_set_ thy false prls t;
walther@59901
   592
Rewrite.trace_on := false;
walther@59868
   593
if UnparseC.term t' = "False" then ()
neuper@38031
   594
else error "polyminus.sml Not (matchsub (?a * (?b + ?c)) (8 ...";
neuper@37906
   595
walther@59973
   596
"----------- *** Problem.prep_input: syntax error in '#Where' of [v";
walther@59973
   597
"----------- *** Problem.prep_input: syntax error in '#Where' of [v";
walther@59973
   598
"----------- *** Problem.prep_input: syntax error in '#Where' of [v";
neuper@38037
   599
(*see test/../termC.sml for details*)
walther@60230
   600
val t = TermC.parse_patt thy "t_t is_polyexp";
walther@60230
   601
val t = TermC.parse_patt thy ("Not (matchsub (?a + (?b + ?c)) t_t | " ^
neuper@38037
   602
	                "     matchsub (?a + (?b - ?c)) t_t | " ^
neuper@38037
   603
	                "     matchsub (?a - (?b + ?c)) t_t | " ^
neuper@38037
   604
	                "     matchsub (?a + (?b - ?c)) t_t )");
neuper@42390
   605
(*show_types := true;
walther@59868
   606
if UnparseC.term t = "~ (matchsub ((?a::real) + ((?b::real) + (?c::real))) (t_t::real) |\n   matchsub (?a + (?b - ?c)) t_t |\n   matchsub (?a - (?b + ?c)) t_t | matchsub (?a + (?b - ?c)) t_t)"
neuper@38038
   607
then () else error "polyminus.sml type-structure of \"?a :: real\" changed 1";
neuper@42390
   608
show_types := false;*)
walther@59868
   609
if UnparseC.term t =
wneuper@59371
   610
  "\<not> (matchsub (?a + (?b + ?c)) t_t \<or>\n        " ^
wneuper@59371
   611
  "matchsub (?a + (?b - ?c)) t_t \<or>\n        " ^
wneuper@59371
   612
  "matchsub (?a - (?b + ?c)) t_t \<or> " ^
wneuper@59371
   613
  "matchsub (?a + (?b - ?c)) t_t)"
neuper@42390
   614
then () else error "polyminus.sml type-structure of \"?a :: real\" changed 1";
neuper@37906
   615