test/Tools/isac/Knowledge/poly.sml
author Walther Neuper <neuper@ist.tugraz.at>
Fri, 01 Oct 2010 17:27:55 +0200
branchisac-update-Isa09-2
changeset 38039 99cb0d80ff32
parent 38036 02a9b2540eb7
child 38040 967fda58d1b2
permissions -rw-r--r--
tuned: shifted last tests into respective files
neuper@37906
     1
(* testexamples for Poly, polynomials
neuper@37906
     2
   author: Matthias Goldgruber 2003
neuper@37906
     3
   (c) due to copyright terms
neuper@37906
     4
neuper@38022
     5
12345678901234567890123456789012345678901234567890123456789012345678901234567890
neuper@38022
     6
        10        20        30        40        50        60        70        80
neuper@38022
     7
*)
neuper@37906
     8
neuper@38022
     9
(*******************************************************************************
neuper@37906
    10
  WN060104 'SPB' came into 'exp_IsacCore_Simp_Poly_Book.xml'
neuper@37906
    11
	   'SPO' came into 'exp_IsacCore_Simp_Poly_Other.xml'
neuper@38022
    12
*******************************************************************************)
neuper@38022
    13
"--------------------------------------------------------";
neuper@38022
    14
"--------------------------------------------------------";
neuper@38022
    15
"table of contents --------------------------------------";
neuper@38022
    16
"--------------------------------------------------------";
neuper@38022
    17
"-------- check is'_polyexp is_polyexp ------------------";
neuper@38022
    18
"-------- build Script Expand_binoms --------------------";
neuper@38036
    19
"-------- investigate (new) uniary minus ----------------";
neuper@38036
    20
"-------- check make_polynomial with simple terms -------";
neuper@38036
    21
"-------- fun is_multUnordered --------------------------";
neuper@38036
    22
"-------- examples from textbook Schalk I ---------------";
neuper@38022
    23
"-------- Script 'simplification for_polynomials' -------";
neuper@38022
    24
"-------- check pbl  'polynomial simplification' --------";
neuper@38022
    25
"-------- me 'poly. simpl.' Schalk I p.63 No.267b -------";
neuper@38036
    26
"-------- interSteps for Schalk 299a --------------------";
neuper@38022
    27
"-------- norm_Poly NOT COMPLETE ------------------------";
neuper@38022
    28
"-------- ord_make_polynomial ---------------------------";
neuper@38022
    29
"--------------------------------------------------------";
neuper@38022
    30
"--------------------------------------------------------";
neuper@38022
    31
"--------------------------------------------------------";
neuper@37906
    32
neuper@38036
    33
(*-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.
neuper@38039
    34
-.-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.*)
neuper@37906
    35
neuper@38022
    36
"-------- check is'_polyexp is_polyexp ------------------";
neuper@38022
    37
"-------- check is'_polyexp is_polyexp ------------------";
neuper@38022
    38
"-------- check is'_polyexp is_polyexp ------------------";
neuper@38022
    39
if is_polyexp @{term "x / x"} 
neuper@38031
    40
then error "poly.sml: check is'_polyexp is_polyexp" else ();
neuper@38022
    41
neuper@38022
    42
neuper@37974
    43
"-------- build Script Expand_binoms -----------------------------";
neuper@37974
    44
"-------- build Script Expand_binoms -----------------------------";
neuper@37974
    45
"-------- build Script Expand_binoms -----------------------------";
neuper@37974
    46
val scr_expand_binoms =
neuper@37974
    47
"Script Expand_binoms t_t =" ^
neuper@37974
    48
"(Repeat                       " ^
neuper@37974
    49
"((Try (Repeat (Rewrite real_plus_binom_pow2    False))) @@ " ^
neuper@37974
    50
" (Try (Repeat (Rewrite real_plus_binom_times   False))) @@ " ^
neuper@37974
    51
" (Try (Repeat (Rewrite real_minus_binom_pow2   False))) @@ " ^
neuper@37974
    52
" (Try (Repeat (Rewrite real_minus_binom_times  False))) @@ " ^
neuper@37974
    53
" (Try (Repeat (Rewrite real_plus_minus_binom1  False))) @@ " ^
neuper@37974
    54
" (Try (Repeat (Rewrite real_plus_minus_binom2  False))) @@ " ^
neuper@37974
    55
neuper@37974
    56
" (Try (Repeat (Rewrite mult_1_left             False))) @@ " ^
neuper@37974
    57
" (Try (Repeat (Rewrite mult_zero_left             False))) @@ " ^
neuper@37974
    58
" (Try (Repeat (Rewrite add_0_left      False))) @@ " ^
neuper@37974
    59
neuper@37975
    60
" (Try (Repeat (Calculate PLUS  ))) @@ " ^
neuper@37975
    61
" (Try (Repeat (Calculate TIMES ))) @@ " ^
neuper@37975
    62
" (Try (Repeat (Calculate POWER))) @@ " ^
neuper@37974
    63
neuper@37974
    64
" (Try (Repeat (Rewrite sym_realpow_twoI        False))) @@ " ^
neuper@37974
    65
" (Try (Repeat (Rewrite realpow_plus_1          False))) @@ " ^
neuper@37974
    66
" (Try (Repeat (Rewrite sym_real_mult_2         False))) @@ " ^
neuper@37974
    67
" (Try (Repeat (Rewrite real_mult_2_assoc       False))) @@ " ^
neuper@37974
    68
neuper@37974
    69
" (Try (Repeat (Rewrite real_num_collect        False))) @@ " ^
neuper@37974
    70
" (Try (Repeat (Rewrite real_num_collect_assoc  False))) @@ " ^
neuper@37974
    71
neuper@37974
    72
" (Try (Repeat (Rewrite real_one_collect        False))) @@ " ^
neuper@37974
    73
" (Try (Repeat (Rewrite real_one_collect_assoc  False))) @@ " ^ 
neuper@37974
    74
neuper@37975
    75
" (Try (Repeat (Calculate PLUS  ))) @@ " ^
neuper@37975
    76
" (Try (Repeat (Calculate TIMES ))) @@ " ^
neuper@37975
    77
" (Try (Repeat (Calculate POWER)))) " ^  
neuper@37974
    78
" t_t)";
neuper@38036
    79
(*
neuper@37974
    80
val scr_expand_binoms =
neuper@37974
    81
"Script Expand_binoms t_t = t_t";
neuper@38036
    82
*)
neuper@37974
    83
val ---------------------------------------------- = "11111";
neuper@37974
    84
parse thy scr_expand_binoms;
neuper@37974
    85
val ---------------------------------------------- = "22222";
neuper@37974
    86
neuper@38036
    87
neuper@38036
    88
"-------- investigate (new) uniary minus ----------------";
neuper@38036
    89
"-------- investigate (new) uniary minus ----------------";
neuper@38036
    90
"-------- investigate (new) uniary minus ----------------";
neuper@38036
    91
val t = (#prop o rep_thm) @{thm real_diff_0}; (*"0 - ?x = - ?x"*)
neuper@37906
    92
atomty t;
neuper@37906
    93
(*** -------------
neuper@37906
    94
*** Const ( Trueprop, bool => prop)
neuper@37906
    95
*** . Const ( op =, [real, real] => bool)
neuper@37906
    96
*** . . Const ( op -, [real, real] => real)
neuper@37906
    97
*** . . . Const ( 0, real)
neuper@37906
    98
*** . . . Var ((x, 0), real)
neuper@37906
    99
*** . . Const ( uminus, real => real)
neuper@37906
   100
*** . . . Var ((x, 0), real)              *)
neuper@37906
   101
neuper@37906
   102
val t = (term_of o the o (parse thy)) "-1";
neuper@37906
   103
atomty t;
neuper@37906
   104
(*** -------------
neuper@37906
   105
*** Free ( -1, real)                      *)
neuper@37906
   106
val t = (term_of o the o (parse thy)) "- 1";
neuper@37906
   107
atomty t;
neuper@37906
   108
(*** -------------
neuper@37906
   109
*** Const ( uminus, real => real)
neuper@37906
   110
*** . Free ( 1, real)                     *)
neuper@37906
   111
neuper@37906
   112
val t = (term_of o the o (parse thy)) "-x"; (*1-x  syntyx error !!!*)
neuper@37906
   113
atomty t;
neuper@37906
   114
(**** -------------
neuper@37906
   115
*** Free ( -x, real)*)
neuper@37906
   116
val t = (term_of o the o (parse thy)) "- x";
neuper@37906
   117
atomty t;
neuper@37906
   118
(**** -------------
neuper@37906
   119
*** Free ( -x, real) !!!!!!!!!!!!!!!!!!!!!!!! is the same !!!*)
neuper@37906
   120
val t = (term_of o the o (parse thy)) "-(x)";
neuper@37906
   121
atomty t;
neuper@37906
   122
(**** -------------
neuper@37906
   123
*** Free ( -x, real)*)
neuper@37906
   124
neuper@38036
   125
(*-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.
neuper@38036
   126
-.-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.*)
neuper@37906
   127
neuper@38036
   128
"-------- check make_polynomial with simple terms -------";
neuper@38036
   129
"-------- check make_polynomial with simple terms -------";
neuper@38036
   130
"-------- check make_polynomial with simple terms -------";
neuper@38036
   131
"----- check 1 ---";
neuper@38036
   132
val t = str2term "2*3*a";
neuper@38036
   133
val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
neuper@38036
   134
if term2str t = "6 * a" then () else error "check make_polynomial 1";
neuper@38036
   135
neuper@38036
   136
"----- check 2 ---";
neuper@38036
   137
val t = str2term "2*a + 3*a";
neuper@38036
   138
val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
neuper@38036
   139
if term2str t = "5 * a" then () else error "check make_polynomial 2";
neuper@38036
   140
neuper@38036
   141
"----- check 3 ---";
neuper@38036
   142
val t = str2term "2*a + 3*a + 3*a";
neuper@38036
   143
val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
neuper@38036
   144
if term2str t = "8 * a" then () else error "check make_polynomial 3";
neuper@38036
   145
neuper@38036
   146
"----- check 4 ---";
neuper@38036
   147
val t = str2term "3*a - 2*a";
neuper@38036
   148
val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
neuper@38036
   149
if term2str t = "a" then () else error "check make_polynomial 4";
neuper@38036
   150
neuper@38036
   151
"----- check 5 ---";
neuper@38036
   152
val t = str2term "4*(3*a - 2*a)";
neuper@38036
   153
val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
neuper@38036
   154
if term2str t = "4 * a" then () else error "check make_polynomial 5";
neuper@38036
   155
neuper@38036
   156
"----- check 6 ---";
neuper@38036
   157
val t = str2term "4*(3*a^^^2 - 2*a^^^2)";
neuper@38036
   158
val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
neuper@38036
   159
if term2str t = "4 * a ^^^ 2" then () else error "check make_polynomial 6";
neuper@38036
   160
neuper@38036
   161
neuper@38036
   162
"-------- fun is_multUnordered --------------------------";
neuper@38036
   163
"-------- fun is_multUnordered --------------------------";
neuper@38036
   164
"-------- fun is_multUnordered --------------------------";
neuper@38036
   165
val thy = theory "Isac";
neuper@38036
   166
(* 100928 trace_rewrite gives the following (first occurring) difference:
neuper@38036
   167
:
neuper@38036
   168
###  rls: order_mult_ on: 5 * x ^^^ 2 * (2 * x ^^^ 7) + 5 * x ^^^ 2 * 3 + (6 * x ^^^ 7 + 9) + (-1 * (3 * x ^^^ 5 * (6 * x ^^^ 4)) + -1 * (3 * x ^^^ 5 * -1) +
neuper@38036
   169
 (-48 * x ^^^ 4 + 8))
neuper@38036
   170
######  rls: e_rls-is_multUnordered on: p is_multUnordered
neuper@38036
   171
#######  try calc: Poly.is'_multUnordered'
neuper@38036
   172
=======  calc. to: False  !!!!!!!!!!!!! INSTEAD OF TRUE in 2002 !!!!!!!!!!!!!
neuper@38036
   173
*)
neuper@38036
   174
val t = str2term "5 * x ^^^ 2 * (2 * x ^^^ 7) + 5 * x ^^^ 2 * 3 + (6 * x ^^^ 7 + 9) + (-1 * (3 * x ^^^ 5 * (6 * x ^^^ 4)) + -1 * (3 * x ^^^ 5 * -1) +  (-48 * x ^^^ 4 + 8))";
neuper@38036
   175
neuper@38036
   176
"----- is_multUnordered ---";
neuper@38036
   177
val tsort = sort_variables t;
neuper@38036
   178
term2str tsort = "2 * (5 * (x ^^^ 2 * x ^^^ 7)) + 3 * (5 * x ^^^ 2) + 6 * x ^^^ 7 + 9 +\n-1 * (3 * (6 * (x ^^^ 4 * x ^^^ 5))) +\n-1 * (-1 * (3 * x ^^^ 5)) +\n-48 * x ^^^ 4 +\n8";
neuper@38036
   179
is_polyexp t;
neuper@38036
   180
tsort = t;
neuper@38036
   181
is_polyexp t andalso not (t = sort_variables t);
neuper@38036
   182
if is_multUnordered t then () else error "poly.sml diff. is_multUnordered 1";
neuper@38036
   183
neuper@38036
   184
"----- eval_is_multUnordered ---";
neuper@38036
   185
val tm = str2term "(5 * x ^^^ 2 * (2 * x ^^^ 7) + 5 * x ^^^ 2 * 3 + (6 * x ^^^ 7 + 9) + (-1 * (3 * x ^^^ 5 * (6 * x ^^^ 4)) + -1 * (3 * x ^^^ 5 * -1) +  (-48 * x ^^^ 4 + 8))) is_multUnordered";
neuper@38036
   186
case eval_is_multUnordered "testid" "" tm thy of
neuper@38036
   187
    SOME (_, Const ("Trueprop", _) $ 
neuper@38036
   188
                   (Const ("op =", _) $
neuper@38036
   189
                          (Const ("Poly.is'_multUnordered", _) $ _) $ 
neuper@38036
   190
                          Const ("True", _))) => ()
neuper@38036
   191
  | _ => error "poly.sml diff. eval_is_multUnordered";
neuper@38036
   192
neuper@38036
   193
"----- rewrite_set_ ---";
neuper@38039
   194
val SOME (t, _) = rewrite_set_ thy true order_mult_ tm;
neuper@38036
   195
neuper@38039
   196
(*-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.
neuper@38036
   197
-.-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.*)
neuper@38036
   198
neuper@38036
   199
neuper@38036
   200
(*-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.
neuper@38036
   201
-.-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.*)
neuper@38036
   202
neuper@38036
   203
(*===== inhibit exn ?===========================================================
neuper@38036
   204
neuper@38036
   205
neuper@38036
   206
neuper@38036
   207
"-------- examples from textbook Schalk I ---------------";
neuper@38036
   208
"-------- examples from textbook Schalk I ---------------";
neuper@38036
   209
"-------- examples from textbook Schalk I ---------------";
neuper@38036
   210
"-----SPB Schalk I p.63 No.267b ---";
neuper@38036
   211
trace_rewrite := true; tracing "-----SPB Schalk I p.63 No.267b ---begin";
neuper@37906
   212
val t = str2term
neuper@37906
   213
 	    "(5*x^^^2 + 3) * (2*x^^^7 + 3) - (3*x^^^5 + 8) * (6*x^^^4 - 1)";
neuper@37926
   214
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@38036
   215
term2str t;
neuper@38036
   216
trace_rewrite := false; tracing "-----SPB Schalk I p.63 No.267b ---end";
neuper@37906
   217
if (term2str t) = 
neuper@37906
   218
"17 + 15 * x ^^^ 2 + -48 * x ^^^ 4 + 3 * x ^^^ 5 + 6 * x ^^^ 7 + -8 * x ^^^ 9"
neuper@37906
   219
then ()
neuper@38031
   220
else error "poly.sml: diff.behav. in make_polynomial 1";
neuper@37906
   221
neuper@38036
   222
"-----SPB Schalk I p.63 No.275b ---";
neuper@37906
   223
 val t = str2term
neuper@37906
   224
 	     "(3*x^^^2 - 2*x*y + y^^^2) * (x^^^2 - 2*y^^^2)";
neuper@37926
   225
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   226
 term2str t;
neuper@37906
   227
if (term2str t) = 
neuper@37906
   228
"3 * x ^^^ 4 + -2 * x ^^^ 3 * y + -5 * x ^^^ 2 * y ^^^ 2 + \
neuper@37906
   229
\4 * x * y ^^^ 3 +\n-2 * y ^^^ 4"
neuper@37906
   230
then ()
neuper@38031
   231
else error "poly.sml: diff.behav. in make_polynomial 2";
neuper@37906
   232
neuper@38036
   233
"-----SPB Schalk I p.63 No.279b ---";
neuper@37906
   234
 val t = str2term
neuper@37906
   235
 	     "(x-a)*(x-b)*(x-c)*(x-d)";
neuper@37926
   236
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   237
 term2str t;
neuper@37906
   238
(* Richtig! *)
neuper@37906
   239
if (term2str t) = 
neuper@37906
   240
"a * b * c * d + -1 * a * b * c * x + -1 * a * b * d * x + a * b * x ^^^ 2 +\n-1 * a * c * d * x +\na * c * x ^^^ 2 +\na * d * x ^^^ 2 +\n-1 * a * x ^^^ 3 +\n-1 * b * c * d * x +\nb * c * x ^^^ 2 +\nb * d * x ^^^ 2 +\n-1 * b * x ^^^ 3 +\nc * d * x ^^^ 2 +\n-1 * c * x ^^^ 3 +\n-1 * d * x ^^^ 3 +\nx ^^^ 4"
neuper@37906
   241
then ()
neuper@38031
   242
else error "poly.sml: diff.behav. in make_polynomial 3";
neuper@37906
   243
neuper@38036
   244
"-----SPB Schalk I p.63 No.291 ---";
neuper@37906
   245
 val t = str2term
neuper@37906
   246
 "(5+96*x^^^3+8*x*(-4+(7- 3*x)*4*x))*(5*(2- 3*x)- (-15*x*(-8*x- 5)))";
neuper@37926
   247
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   248
 term2str t;
neuper@37906
   249
if (term2str t) = 
neuper@37906
   250
"50 + -770 * x + 4520 * x ^^^ 2 + -16320 * x ^^^ 3 + -26880 * x ^^^ 4"
neuper@37906
   251
then ()
neuper@38031
   252
else error "poly.sml: diff.behav. in make_polynomial 4";
neuper@37906
   253
neuper@38036
   254
"-----SPB Schalk I p.64 No.295c ---";
neuper@37906
   255
 val t = str2term
neuper@37906
   256
 "(13*a^^^4*b^^^9*c - 12*a^^^3*b^^^6*c^^^9)^^^2";
neuper@37926
   257
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   258
 term2str t;
neuper@37906
   259
if (term2str t) = 
neuper@37906
   260
"169 * a ^^^ 8 * b ^^^ 18 * c ^^^ 2 + -312 * a ^^^ 7 * b ^^^ 15 * c ^^^ 10\
neuper@37906
   261
\ +\n144 * a ^^^ 6 * b ^^^ 12 * c ^^^ 18"
neuper@37906
   262
then ()
neuper@38031
   263
else error "poly.sml: diff.behav. in make_polynomial 5";
neuper@37906
   264
neuper@38036
   265
"-----SPB Schalk I p.64 No.299a ---";
neuper@37906
   266
 val t = str2term
neuper@37906
   267
 "(x - y)*(x + y)";
neuper@37926
   268
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   269
 term2str t;
neuper@38036
   270
(*
neuper@38036
   271
if (term2str t) = "x ^^^ 2 + -1 * y ^^^ 2" then ()
neuper@38031
   272
else error "poly.sml: diff.behav. in make_polynomial 6";
neuper@38036
   273
*)
neuper@37906
   274
neuper@38036
   275
"-----SPB Schalk I p.64 No.300c ---";
neuper@37906
   276
 val t = str2term
neuper@37906
   277
 "(3*x^^^2*y - 1)*(3*x^^^2*y + 1)";
neuper@37926
   278
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   279
 term2str t;
neuper@37906
   280
if (term2str t) = 
neuper@37906
   281
"-1 + 9 * x ^^^ 4 * y ^^^ 2"
neuper@37906
   282
then ()
neuper@38031
   283
else error "poly.sml: diff.behav. in make_polynomial 7";
neuper@37906
   284
neuper@38036
   285
"-----SPB Schalk I p.64 No.302 ---";
neuper@37906
   286
val t = str2term
neuper@37906
   287
 "(13*x^^^2 + 5)*(13*x^^^2 - 5) - (5*x^^^2 + 3)*(5*x^^^2 - 3) - (12*x^^^2 + 4)*(12*x^^^2 - 4)";
neuper@37926
   288
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   289
if term2str t = "0" then ()
neuper@38031
   290
else error "poly.sml: diff.behav. in make_polynomial 8";
neuper@37906
   291
(* Bei Berechnung sollte 3 mal real_plus_minus_binom1_p aus expand_poly verwendet werden *)
neuper@37906
   292
neuper@37906
   293
neuper@38036
   294
"-----SPB Schalk I p.64 No.306a ---";
neuper@37906
   295
val t = str2term "((x^^^2 + 1)*(x^^^2 - 1))^^^2";
neuper@37926
   296
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   297
if (term2str t) = "1 + 2 * x ^^^ 4 + 2 * -2 * x ^^^ 4 + x ^^^ 8" then ()
neuper@38031
   298
else error "poly.sml: diff.behav. in make_polynomial: not confluent \
neuper@37906
   299
		 \2 * x ^^^ 4 + 2 * -2 * x ^^^ 4 = -2 * x ^^^ 4 works again";
neuper@37906
   300
neuper@37906
   301
neuper@37906
   302
(*WN071729 when reducing "rls reduce_012_" for Schaerding,
neuper@37906
   303
the above resulted in the term below ... but reduces from then correctly*)
neuper@37906
   304
val t = str2term "1 + 2 * x ^^^ 4 + 2 * -2 * x ^^^ 4 + x ^^^ 8";
neuper@37926
   305
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   306
if (term2str t) = "1 + -2 * x ^^^ 4 + x ^^^ 8" then ()
neuper@38031
   307
else error "poly.sml: diff.behav. in make_polynomial 9b";
neuper@37906
   308
neuper@38036
   309
"-----SPB Schalk I p.64 No.296a ---";
neuper@37906
   310
val t = str2term "(x - a)^^^3";
neuper@37926
   311
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   312
if (term2str t) = "-1 * a ^^^ 3 + 3 * a ^^^ 2 * x + -3 * a * x ^^^ 2 + x ^^^ 3"
neuper@38031
   313
then () else error "poly.sml: diff.behav. in make_polynomial 10";
neuper@37906
   314
neuper@38036
   315
"-----SPB Schalk I p.64 No.296c ---";
neuper@37906
   316
val t = str2term "(-3*x - 4*y)^^^3";
neuper@37926
   317
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   318
if (term2str t) = 
neuper@37906
   319
"-27 * x ^^^ 3 + -108 * x ^^^ 2 * y + -144 * x * y ^^^ 2 + -64 * y ^^^ 3"
neuper@38031
   320
then () else error "poly.sml: diff.behav. in make_polynomial 11";
neuper@37906
   321
neuper@38036
   322
"-----SPB Schalk I p.62 No.242c ---";
neuper@37906
   323
val t = str2term "x^^^(-4)*(x^^^(-4)*y^^^(-2))^^^(-1)*y^^^(-2)";
neuper@37926
   324
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   325
if (term2str t) = "1" then ()
neuper@38031
   326
else error "poly.sml: diff.behav. in make_polynomial 12";
neuper@37906
   327
neuper@38036
   328
"-----SPB Schalk I p.60 No.209a ---";
neuper@37906
   329
val t = str2term "a^^^(7-x) * a^^^x";
neuper@37926
   330
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   331
if term2str t = "a ^^^ 7" then ()
neuper@38031
   332
else error "poly.sml: diff.behav. in make_polynomial 13";
neuper@37906
   333
neuper@38036
   334
"-----SPB Schalk I p.60 No.209d ---";
neuper@37906
   335
val t = str2term "d^^^x * d^^^(x+1) * d^^^(2 - 2*x)";
neuper@37926
   336
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   337
if term2str t = "d ^^^ 3" then ()
neuper@38031
   338
else error "poly.sml: diff.behav. in make_polynomial 14";
neuper@37906
   339
neuper@37906
   340
neuper@37906
   341
(*---------------------------------------------------------------------*)
neuper@37906
   342
(*------------------ Bsple bei denen es Probleme gibt------------------*)
neuper@37906
   343
(*---------------------------------------------------------------------*)
neuper@37906
   344
neuper@38036
   345
"-----Schalk I p.64 No.303 ---";
neuper@37906
   346
val t = str2term "(a + 2*b)*(a^^^2 + 4*b^^^2)*(a - 2*b) - (a - 6*b)*(a^^^2 + 36*b^^^2)*(a + 6*b)";
neuper@37926
   347
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   348
if term2str t = "1280 * b ^^^ 4" then ()
neuper@38031
   349
else error "poly.sml: diff.behav. in make_polynomial 14b";
neuper@37906
   350
(* Richtig - aber Binomische Formel wurde nicht verwendet! *)
neuper@37906
   351
neuper@37906
   352
neuper@37906
   353
(*--------------------------------------------------------------------*)
neuper@37906
   354
(*----------------------- Eigene Beispiele ---------------------------*)
neuper@37906
   355
(*--------------------------------------------------------------------*)
neuper@38036
   356
"-----SPO ---";
neuper@37906
   357
val t = str2term "a^^^2*a^^^(-2)";
neuper@37926
   358
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   359
if term2str t = "1" then ()
neuper@38031
   360
else error "poly.sml: diff.behav. in make_polynomial 15";
neuper@38036
   361
"-----SPO ---";
neuper@37906
   362
val t = str2term "a + a + a";
neuper@37926
   363
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   364
if term2str t = "3 * a" then ()
neuper@38031
   365
else error "poly.sml: diff.behav. in make_polynomial 16";
neuper@38036
   366
"-----SPO ---";
neuper@37906
   367
val t = str2term "a + b + b + b";
neuper@37926
   368
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   369
if term2str t = "a + 3 * b" then ()
neuper@38031
   370
else error "poly.sml: diff.behav. in make_polynomial 17";
neuper@38036
   371
"-----SPO ---";
neuper@37906
   372
val t = str2term "a^^^2*b*b^^^(-1)";
neuper@37926
   373
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   374
if term2str t = "a ^^^ 2" then ()
neuper@38031
   375
else error "poly.sml: diff.behav. in make_polynomial 18";
neuper@38036
   376
"-----SPO ---";
neuper@37906
   377
val t = str2term "a^^^2*a^^^(-2)";
neuper@37926
   378
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   379
if (term2str t) = "1" then ()
neuper@38031
   380
else error "poly.sml: diff.behav. in make_polynomial 19";
neuper@38036
   381
"-----SPO ---";
neuper@37906
   382
val t = str2term "b + a - b";
neuper@37926
   383
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   384
if (term2str t) = "a" then ()
neuper@38031
   385
else error "poly.sml: diff.behav. in make_polynomial 20";
neuper@38036
   386
"-----SPO ---";
neuper@37906
   387
val t = str2term "b * a * a";
neuper@37926
   388
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   389
if term2str t = "a ^^^ 2 * b" then ()
neuper@38031
   390
else error "poly.sml: diff.behav. in make_polynomial 21";
neuper@38036
   391
"-----SPO ---";
neuper@37906
   392
val t = str2term "(a^^^2)^^^3";
neuper@37926
   393
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   394
if term2str t = "a ^^^ 6" then ()
neuper@38031
   395
else error "poly.sml: diff.behav. in make_polynomial 22";
neuper@38036
   396
"-----SPO ---";
neuper@37906
   397
val t = str2term "x^^^2 * y^^^2 + x * x^^^2 * y";
neuper@37926
   398
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   399
if term2str t = "x ^^^ 3 * y + x ^^^ 2 * y ^^^ 2" then ()
neuper@38031
   400
else error "poly.sml: diff.behav. in make_polynomial 23";
neuper@38036
   401
"-----SPO ---";
neuper@37906
   402
val t = (term_of o the o (parse thy)) "a^^^2 * (-a)^^^2";
neuper@37926
   403
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   404
if (term2str t) = "a ^^^ 4" then ()
neuper@38031
   405
else error "poly.sml: diff.behav. in make_polynomial 24";
neuper@38036
   406
"-----SPO ---";
neuper@37906
   407
val t = str2term "a * b * b^^^(-1) + a";
neuper@37926
   408
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   409
if (term2str t) = "2 * a" then ()
neuper@38031
   410
else error "poly.sml: diff.behav. in make_polynomial 25";
neuper@38036
   411
"-----SPO ---";
neuper@37906
   412
val t = str2term "a*c*b^^^(2*n) + 3*a + 5*b^^^(2*n)*c*b";
neuper@37926
   413
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   414
if (term2str t) = "3 * a + 5 * b ^^^ (1 + 2 * n) * c + a * b ^^^ (2 * n) * c"
neuper@38031
   415
then () else error "poly.sml: diff.behav. in make_polynomial 26";
neuper@37906
   416
neuper@37906
   417
neuper@37906
   418
(*MG.27.6.03 -------------vvv-: Verschachtelte Terme -----------*)
neuper@38036
   419
"-----SPO ---";
neuper@37906
   420
val t = str2term "(1 + (x*y*a) + x)^^^(1 + (x*y*a) + x)";
neuper@37926
   421
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   422
 term2str t;
neuper@37906
   423
if term2str t = "(1 + x + a * x * y) ^^^ (1 + x + a * x * y)"
neuper@38031
   424
 then () else error "poly.sml: diff.behav. in make_polynomial 27";(*SPO*)
neuper@37906
   425
val t = str2term "(1 + x*(y*z)*zz)^^^(1 + x*(y*z)*zz)";
neuper@37926
   426
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   427
 term2str t;
neuper@37906
   428
if term2str t = "(1 + x * y * z * zz) ^^^ (1 + x * y * z * zz)"
neuper@38031
   429
 then () else error "poly.sml: diff.behav. in make_polynomial 28";
neuper@37906
   430
neuper@38036
   431
"-------- Script 'simplification for_polynomials' -------";
neuper@38036
   432
"-------- Script 'simplification for_polynomials' -------";
neuper@38036
   433
"-------- Script 'simplification for_polynomials' -------";
neuper@37906
   434
val str = 
neuper@37906
   435
"Script SimplifyScript (t_::real) =                \
neuper@37906
   436
\  ((Rewrite_Set norm_Poly False) t_)";
neuper@37906
   437
val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
   438
atomty sc;
neuper@37906
   439
neuper@37906
   440
neuper@38036
   441
"-------- check pbl  'polynomial simplification' --------";
neuper@38036
   442
"-------- check pbl  'polynomial simplification' --------";
neuper@38036
   443
"-------- check pbl  'polynomial simplification' --------";
neuper@37967
   444
val fmz = ["TERM ((5*x^^^2 + 3) * (2*x^^^7 + 3) \
neuper@37906
   445
	   \- (3*x^^^5 + 8) * (6*x^^^4 - 1))",
neuper@37906
   446
	   "normalform N"];
neuper@38036
   447
"-----0 ---";
neuper@37906
   448
case refine fmz ["polynomial","simplification"]of
neuper@37906
   449
    [Matches (["polynomial", "simplification"], _)] => ()
neuper@38031
   450
  | _ => error "poly.sml diff.behav. in check pbl, refine";
neuper@37906
   451
(*...if there is an error, then ...*)
neuper@37906
   452
neuper@38036
   453
"-----1 ---";
neuper@37906
   454
print_depth 7;
neuper@37906
   455
val pbt = get_pbt ["polynomial","simplification"];
neuper@37906
   456
print_depth 3;
neuper@37906
   457
(*if there is ...
neuper@37906
   458
> val NoMatch' {Given=gi, Where=wh, Find=fi,...} = match_pbl fmz pbt;
neuper@37906
   459
... then trace_rewrite:*)
neuper@37906
   460
neuper@38036
   461
"-----2 ---";
neuper@37906
   462
trace_rewrite:=true; 
neuper@37906
   463
match_pbl fmz pbt;
neuper@37906
   464
trace_rewrite:=false;
neuper@37906
   465
(*... if there is no rewrite, then there is something wrong with prls*)
neuper@37906
   466
neuper@38036
   467
"-----3 ---";
neuper@37906
   468
print_depth 7;
neuper@37906
   469
val prls = (#prls o get_pbt) ["polynomial","simplification"];
neuper@37906
   470
print_depth 3;
neuper@37906
   471
val t = str2term "((5*x^^^2 + 3) * (2*x^^^7 + 3) \
neuper@37906
   472
		 \- (3*x^^^5 + 8) * (6*x^^^4 - 1)) is_polyexp";
neuper@37906
   473
trace_rewrite:=true; 
neuper@37926
   474
val SOME (t',_) = rewrite_set_ thy false prls t;
neuper@37906
   475
trace_rewrite:=false;
neuper@37906
   476
if t' = HOLogic.true_const then () 
neuper@38031
   477
else error "poly.sml: diff.behav. in check pbl 'polynomial..";
neuper@37906
   478
(*... if this works, but (*1*) does still NOT work, check types:*)
neuper@37906
   479
neuper@38036
   480
"-----4 ---";
neuper@37906
   481
show_types:=true;
neuper@37906
   482
(*
neuper@37906
   483
> val NoMatch' {Given=gi, Where=wh, Find=fi,...} = match_pbl fmz pbt;
neuper@37906
   484
val wh = [False "(t_::real => real) (is_polyexp::real)"]
neuper@37906
   485
......................^^^^^^^^^^^^...............^^^^*)
neuper@37906
   486
val Matches' _ = match_pbl fmz pbt;
neuper@37906
   487
show_types:=false;
neuper@37906
   488
neuper@37906
   489
neuper@38036
   490
"-------- me 'poly. simpl.' Schalk I p.63 No.267b -------";
neuper@38036
   491
"-------- me 'poly. simpl.' Schalk I p.63 No.267b -------";
neuper@38036
   492
"-------- me 'poly. simpl.' Schalk I p.63 No.267b -------";
neuper@37967
   493
val fmz = ["TERM ((5*x^^^2 + 3) * (2*x^^^7 + 3) \
neuper@37906
   494
	   \- (3*x^^^5 + 8) * (6*x^^^4 - 1))",
neuper@37906
   495
	   "normalform N"];
neuper@37906
   496
val (dI',pI',mI') =
neuper@37991
   497
  ("Poly",["polynomial","simplification"],
neuper@37906
   498
   ["simplification","for_polynomials"]);
neuper@37906
   499
val p = e_pos'; val c = []; 
neuper@37906
   500
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
   501
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   502
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37924
   503
(writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
neuper@37906
   504
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   505
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   506
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   507
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   508
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   509
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   510
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   511
if f2str f = 
neuper@37906
   512
"17 + 15 * x ^^^ 2 + -48 * x ^^^ 4 + 3 * x ^^^ 5 + 6 * x ^^^ 7 + -8 * x ^^^ 9"
neuper@38031
   513
then () else error "poly.sml diff.behav. in me Schalk I p.63 No.267b";
neuper@37906
   514
neuper@37906
   515
neuper@38036
   516
"-------- interSteps for Schalk 299a --------------------";
neuper@38036
   517
"-------- interSteps for Schalk 299a --------------------";
neuper@38036
   518
"-------- interSteps for Schalk 299a --------------------";
neuper@37906
   519
states:=[];
neuper@37906
   520
CalcTree
neuper@37967
   521
[(["TERM ((x - y)*(x + y))", "normalform N"], 
neuper@37991
   522
  ("Poly",["polynomial","simplification"],
neuper@37906
   523
  ["simplification","for_polynomials"]))];
neuper@37906
   524
Iterator 1;
neuper@37906
   525
moveActiveRoot 1;
neuper@37906
   526
autoCalculate 1 CompleteCalc;
neuper@37906
   527
val ((pt,p),_) = get_calc 1; show_pt pt;
neuper@37906
   528
neuper@37906
   529
interSteps 1 ([1],Res)(*<ERROR> syserror in detailstep </ERROR>*);
neuper@37906
   530
val ((pt,p),_) = get_calc 1; show_pt pt;
neuper@37906
   531
if existpt' ([1,1], Frm) pt then ()
neuper@38031
   532
else error "poly.sml: interSteps doesnt work again 1";
neuper@37906
   533
neuper@37906
   534
interSteps 1 ([1,1],Res)(*<ERROR> syserror in detailstep </ERROR>*);
neuper@37906
   535
val ((pt,p),_) = get_calc 1; show_pt pt;
neuper@37906
   536
if existpt' ([1,1,1], Frm) pt then ()
neuper@38031
   537
else error "poly.sml: interSteps doesnt work again 2";
neuper@37906
   538
neuper@37906
   539
neuper@38036
   540
"-------- norm_Poly NOT COMPLETE ------------------------";
neuper@38036
   541
"-------- norm_Poly NOT COMPLETE ------------------------";
neuper@38036
   542
"-------- norm_Poly NOT COMPLETE ------------------------";
neuper@37906
   543
trace_rewrite:=true;
neuper@37926
   544
val SOME (f',_) = rewrite_set_ thy false norm_Poly 
neuper@37906
   545
(str2term "L = k - 2 * q + (k - 2 * q) + (k - 2 * q) + (k - 2 * q) + senkrecht + oben")(*see poly.sml: -- norm_Poly NOT COMPLETE -- TODO MG*);
neuper@37906
   546
trace_rewrite:=false;
neuper@37906
   547
term2str f';
neuper@37906
   548
neuper@38036
   549
neuper@38036
   550
"-------- ord_make_polynomial ---------------------------";
neuper@38036
   551
"-------- ord_make_polynomial ---------------------------";
neuper@38036
   552
"-------- ord_make_polynomial ---------------------------";
neuper@37906
   553
val t1 = str2term "2 * b + (3 * a + 3 * b)";
neuper@37906
   554
val t2 = str2term "3 * a + 3 * b + 2 * b";
neuper@37906
   555
neuper@37906
   556
if ord_make_polynomial true Poly.thy [] (t1, t2) then ()
neuper@38031
   557
else error "poly.sml: diff.behav. in ord_make_polynomial";
neuper@37906
   558
neuper@37906
   559
(*WN071202: ^^^ why then is there no rewriting ...*)
neuper@37906
   560
val term = str2term "2*b + (3*a + 3*b)";
neuper@37926
   561
val NONE = rewrite_set_ Isac.thy false order_add_mult term;
neuper@37906
   562
neuper@37906
   563
(*or why is there no rewriting this way...*)
neuper@37906
   564
val t1 = str2term "2 * b + (3 * a + 3 * b)";
neuper@37906
   565
val t2 = str2term "3 * a + (2 * b + 3 * b)";
neuper@37906
   566
neuper@37906
   567
neuper@38022
   568
===== inhibit exn ?===========================================================*)
neuper@38039
   569
neuper@38039
   570
neuper@38039
   571
(*========== inhibit exn =======================================================
neuper@38039
   572
============ inhibit exn =====================================================*)
neuper@38039
   573
neuper@38039
   574
(*========== inhibit exn ?======================================================
neuper@38039
   575
============ inhibit exn ?====================================================*)
neuper@38039
   576
neuper@38039
   577
(*-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.
neuper@38039
   578
-.-.-.-.-.-.-isolate response.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.*)