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