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