test/Tools/isac/Knowledge/poly.sml
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 28 Sep 2010 09:06:56 +0200
branchisac-update-Isa09-2
changeset 38031 460c24a6a6ba
parent 38022 e6d356fc4d38
child 38036 02a9b2540eb7
permissions -rw-r--r--
tuned error and writeln

# raise error --> error
# writeln in atomtyp, atomty, atomt and xmlsrc
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@38022
    19
"-------- investigate new uniary minus ------------------";
neuper@38022
    20
"-------- Bsple aus Schalk I ----------------------------";
neuper@38022
    21
"-------- Script 'simplification for_polynomials' -------";
neuper@38022
    22
"-------- check pbl  'polynomial simplification' --------";
neuper@38022
    23
"-------- me 'poly. simpl.' Schalk I p.63 No.267b -------";
neuper@38022
    24
"-------- norm_Poly NOT COMPLETE ------------------------";
neuper@38022
    25
"-------- ord_make_polynomial ---------------------------";
neuper@38022
    26
"--------------------------------------------------------";
neuper@38022
    27
"--------------------------------------------------------";
neuper@38022
    28
"--------------------------------------------------------";
neuper@37906
    29
neuper@37906
    30
neuper@38022
    31
"-------- check is'_polyexp is_polyexp ------------------";
neuper@38022
    32
"-------- check is'_polyexp is_polyexp ------------------";
neuper@38022
    33
"-------- check is'_polyexp is_polyexp ------------------";
neuper@38022
    34
if is_polyexp @{term "x / x"} 
neuper@38031
    35
then error "poly.sml: check is'_polyexp is_polyexp" else ();
neuper@38022
    36
neuper@38022
    37
neuper@38022
    38
(*===== inhibit exn ?===========================================================
neuper@37974
    39
"-------- build Script Expand_binoms -----------------------------";
neuper@37974
    40
"-------- build Script Expand_binoms -----------------------------";
neuper@37974
    41
"-------- build Script Expand_binoms -----------------------------";
neuper@37974
    42
val scr_expand_binoms =
neuper@37974
    43
"Script Expand_binoms t_t =" ^
neuper@37974
    44
"(Repeat                       " ^
neuper@37974
    45
"((Try (Repeat (Rewrite real_plus_binom_pow2    False))) @@ " ^
neuper@37974
    46
" (Try (Repeat (Rewrite real_plus_binom_times   False))) @@ " ^
neuper@37974
    47
" (Try (Repeat (Rewrite real_minus_binom_pow2   False))) @@ " ^
neuper@37974
    48
" (Try (Repeat (Rewrite real_minus_binom_times  False))) @@ " ^
neuper@37974
    49
" (Try (Repeat (Rewrite real_plus_minus_binom1  False))) @@ " ^
neuper@37974
    50
" (Try (Repeat (Rewrite real_plus_minus_binom2  False))) @@ " ^
neuper@37974
    51
neuper@37974
    52
" (Try (Repeat (Rewrite mult_1_left             False))) @@ " ^
neuper@37974
    53
" (Try (Repeat (Rewrite mult_zero_left             False))) @@ " ^
neuper@37974
    54
" (Try (Repeat (Rewrite add_0_left      False))) @@ " ^
neuper@37974
    55
neuper@37975
    56
" (Try (Repeat (Calculate PLUS  ))) @@ " ^
neuper@37975
    57
" (Try (Repeat (Calculate TIMES ))) @@ " ^
neuper@37975
    58
" (Try (Repeat (Calculate POWER))) @@ " ^
neuper@37974
    59
neuper@37974
    60
" (Try (Repeat (Rewrite sym_realpow_twoI        False))) @@ " ^
neuper@37974
    61
" (Try (Repeat (Rewrite realpow_plus_1          False))) @@ " ^
neuper@37974
    62
" (Try (Repeat (Rewrite sym_real_mult_2         False))) @@ " ^
neuper@37974
    63
" (Try (Repeat (Rewrite real_mult_2_assoc       False))) @@ " ^
neuper@37974
    64
neuper@37974
    65
" (Try (Repeat (Rewrite real_num_collect        False))) @@ " ^
neuper@37974
    66
" (Try (Repeat (Rewrite real_num_collect_assoc  False))) @@ " ^
neuper@37974
    67
neuper@37974
    68
" (Try (Repeat (Rewrite real_one_collect        False))) @@ " ^
neuper@37974
    69
" (Try (Repeat (Rewrite real_one_collect_assoc  False))) @@ " ^ 
neuper@37974
    70
neuper@37975
    71
" (Try (Repeat (Calculate PLUS  ))) @@ " ^
neuper@37975
    72
" (Try (Repeat (Calculate TIMES ))) @@ " ^
neuper@37975
    73
" (Try (Repeat (Calculate POWER)))) " ^  
neuper@37974
    74
" t_t)";
neuper@37974
    75
val scr_expand_binoms =
neuper@37974
    76
"Script Expand_binoms t_t = t_t";
neuper@37974
    77
neuper@37974
    78
val ---------------------------------------------- = "11111";
neuper@37974
    79
parse thy scr_expand_binoms;
neuper@37974
    80
val ---------------------------------------------- = "22222";
neuper@37974
    81
(*----------------------------------------------
neuper@37974
    82
neuper@37906
    83
"-------- investigate new uniary minus ---------------------------";
neuper@37906
    84
"-------- investigate new uniary minus ---------------------------";
neuper@37906
    85
"-------- investigate new uniary minus ---------------------------";
neuper@37906
    86
val t = (#prop o rep_thm) real_diff_0; (*"0 - ?x = - ?x"*)
neuper@37906
    87
atomty t;
neuper@37906
    88
(*** -------------
neuper@37906
    89
*** Const ( Trueprop, bool => prop)
neuper@37906
    90
*** . Const ( op =, [real, real] => bool)
neuper@37906
    91
*** . . Const ( op -, [real, real] => real)
neuper@37906
    92
*** . . . Const ( 0, real)
neuper@37906
    93
*** . . . Var ((x, 0), real)
neuper@37906
    94
*** . . Const ( uminus, real => real)
neuper@37906
    95
*** . . . Var ((x, 0), real)              *)
neuper@37906
    96
neuper@37906
    97
val t = (term_of o the o (parse thy)) "-1";
neuper@37906
    98
atomty t;
neuper@37906
    99
(*** -------------
neuper@37906
   100
*** Free ( -1, real)                      *)
neuper@37906
   101
val t = (term_of o the o (parse thy)) "- 1";
neuper@37906
   102
atomty t;
neuper@37906
   103
(*** -------------
neuper@37906
   104
*** Const ( uminus, real => real)
neuper@37906
   105
*** . Free ( 1, real)                     *)
neuper@37906
   106
neuper@37906
   107
val t = (term_of o the o (parse thy)) "-x"; (*1-x  syntyx error !!!*)
neuper@37906
   108
atomty t;
neuper@37906
   109
(**** -------------
neuper@37906
   110
*** Free ( -x, real)*)
neuper@37906
   111
val t = (term_of o the o (parse thy)) "- x";
neuper@37906
   112
atomty t;
neuper@37906
   113
(**** -------------
neuper@37906
   114
*** Free ( -x, real) !!!!!!!!!!!!!!!!!!!!!!!! is the same !!!*)
neuper@37906
   115
val t = (term_of o the o (parse thy)) "-(x)";
neuper@37906
   116
atomty t;
neuper@37906
   117
(**** -------------
neuper@37906
   118
*** Free ( -x, real)*)
neuper@37906
   119
neuper@37906
   120
neuper@37906
   121
"-------- Bsple aus Schalk I -------------------------------------";
neuper@37906
   122
"-------- Bsple aus Schalk I -------------------------------------";
neuper@37906
   123
"-------- Bsple aus Schalk I -------------------------------------";
neuper@37906
   124
(*SPB Schalk I p.63 No.267b*)
neuper@37906
   125
val t = str2term
neuper@37906
   126
 	    "(5*x^^^2 + 3) * (2*x^^^7 + 3) - (3*x^^^5 + 8) * (6*x^^^4 - 1)";
neuper@37926
   127
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   128
if (term2str t) = 
neuper@37906
   129
"17 + 15 * x ^^^ 2 + -48 * x ^^^ 4 + 3 * x ^^^ 5 + 6 * x ^^^ 7 + -8 * x ^^^ 9"
neuper@37906
   130
then ()
neuper@38031
   131
else error "poly.sml: diff.behav. in make_polynomial 1";
neuper@37906
   132
neuper@37906
   133
(*SPB Schalk I p.63 No.275b*)
neuper@37906
   134
 val t = str2term
neuper@37906
   135
 	     "(3*x^^^2 - 2*x*y + y^^^2) * (x^^^2 - 2*y^^^2)";
neuper@37926
   136
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   137
 term2str t;
neuper@37906
   138
if (term2str t) = 
neuper@37906
   139
"3 * x ^^^ 4 + -2 * x ^^^ 3 * y + -5 * x ^^^ 2 * y ^^^ 2 + \
neuper@37906
   140
\4 * x * y ^^^ 3 +\n-2 * y ^^^ 4"
neuper@37906
   141
then ()
neuper@38031
   142
else error "poly.sml: diff.behav. in make_polynomial 2";
neuper@37906
   143
neuper@37906
   144
(*SPB Schalk I p.63 No.279b*)
neuper@37906
   145
 val t = str2term
neuper@37906
   146
 	     "(x-a)*(x-b)*(x-c)*(x-d)";
neuper@37926
   147
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   148
 term2str t;
neuper@37906
   149
(* Richtig! *)
neuper@37906
   150
if (term2str t) = 
neuper@37906
   151
"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
   152
then ()
neuper@38031
   153
else error "poly.sml: diff.behav. in make_polynomial 3";
neuper@37906
   154
neuper@37906
   155
(*SPB Schalk I p.63 No.291*)
neuper@37906
   156
 val t = str2term
neuper@37906
   157
 "(5+96*x^^^3+8*x*(-4+(7- 3*x)*4*x))*(5*(2- 3*x)- (-15*x*(-8*x- 5)))";
neuper@37926
   158
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   159
 term2str t;
neuper@37906
   160
if (term2str t) = 
neuper@37906
   161
"50 + -770 * x + 4520 * x ^^^ 2 + -16320 * x ^^^ 3 + -26880 * x ^^^ 4"
neuper@37906
   162
then ()
neuper@38031
   163
else error "poly.sml: diff.behav. in make_polynomial 4";
neuper@37906
   164
neuper@37906
   165
(*SPB Schalk I p.64 No.295c*)
neuper@37906
   166
 val t = str2term
neuper@37906
   167
 "(13*a^^^4*b^^^9*c - 12*a^^^3*b^^^6*c^^^9)^^^2";
neuper@37926
   168
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   169
 term2str t;
neuper@37906
   170
if (term2str t) = 
neuper@37906
   171
"169 * a ^^^ 8 * b ^^^ 18 * c ^^^ 2 + -312 * a ^^^ 7 * b ^^^ 15 * c ^^^ 10\
neuper@37906
   172
\ +\n144 * a ^^^ 6 * b ^^^ 12 * c ^^^ 18"
neuper@37906
   173
then ()
neuper@38031
   174
else error "poly.sml: diff.behav. in make_polynomial 5";
neuper@37906
   175
neuper@37906
   176
(*SPB Schalk I p.64 No.299a*)
neuper@37906
   177
 val t = str2term
neuper@37906
   178
 "(x - y)*(x + y)";
neuper@37926
   179
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   180
 term2str t;
neuper@37906
   181
if (term2str t) = 
neuper@37906
   182
"x ^^^ 2 + -1 * y ^^^ 2"
neuper@37906
   183
then ()
neuper@38031
   184
else error "poly.sml: diff.behav. in make_polynomial 6";
neuper@37906
   185
neuper@37906
   186
(*SPB Schalk I p.64 No.300c*)
neuper@37906
   187
 val t = str2term
neuper@37906
   188
 "(3*x^^^2*y - 1)*(3*x^^^2*y + 1)";
neuper@37926
   189
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   190
 term2str t;
neuper@37906
   191
if (term2str t) = 
neuper@37906
   192
"-1 + 9 * x ^^^ 4 * y ^^^ 2"
neuper@37906
   193
then ()
neuper@38031
   194
else error "poly.sml: diff.behav. in make_polynomial 7";
neuper@37906
   195
neuper@37906
   196
(*SPB Schalk I p.64 No.302*)
neuper@37906
   197
val t = str2term
neuper@37906
   198
 "(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
   199
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   200
if term2str t = "0" then ()
neuper@38031
   201
else error "poly.sml: diff.behav. in make_polynomial 8";
neuper@37906
   202
(* Bei Berechnung sollte 3 mal real_plus_minus_binom1_p aus expand_poly verwendet werden *)
neuper@37906
   203
neuper@37906
   204
neuper@37906
   205
(*SPB Schalk I p.64 No.306a*)
neuper@37906
   206
val t = str2term "((x^^^2 + 1)*(x^^^2 - 1))^^^2";
neuper@37926
   207
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   208
if (term2str t) = "1 + 2 * x ^^^ 4 + 2 * -2 * x ^^^ 4 + x ^^^ 8" then ()
neuper@38031
   209
else error "poly.sml: diff.behav. in make_polynomial: not confluent \
neuper@37906
   210
		 \2 * x ^^^ 4 + 2 * -2 * x ^^^ 4 = -2 * x ^^^ 4 works again";
neuper@37906
   211
neuper@37906
   212
neuper@37906
   213
(*WN071729 when reducing "rls reduce_012_" for Schaerding,
neuper@37906
   214
the above resulted in the term below ... but reduces from then correctly*)
neuper@37906
   215
val t = str2term "1 + 2 * x ^^^ 4 + 2 * -2 * x ^^^ 4 + x ^^^ 8";
neuper@37926
   216
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   217
if (term2str t) = "1 + -2 * x ^^^ 4 + x ^^^ 8" then ()
neuper@38031
   218
else error "poly.sml: diff.behav. in make_polynomial 9b";
neuper@37906
   219
neuper@37906
   220
(*SPB Schalk I p.64 No.296a*)
neuper@37906
   221
val t = str2term "(x - a)^^^3";
neuper@37926
   222
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   223
if (term2str t) = "-1 * a ^^^ 3 + 3 * a ^^^ 2 * x + -3 * a * x ^^^ 2 + x ^^^ 3"
neuper@38031
   224
then () else error "poly.sml: diff.behav. in make_polynomial 10";
neuper@37906
   225
neuper@37906
   226
(*SPB Schalk I p.64 No.296c*)
neuper@37906
   227
val t = str2term "(-3*x - 4*y)^^^3";
neuper@37926
   228
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   229
if (term2str t) = 
neuper@37906
   230
"-27 * x ^^^ 3 + -108 * x ^^^ 2 * y + -144 * x * y ^^^ 2 + -64 * y ^^^ 3"
neuper@38031
   231
then () else error "poly.sml: diff.behav. in make_polynomial 11";
neuper@37906
   232
neuper@37906
   233
(*SPB Schalk I p.62 No.242c*)
neuper@37906
   234
val t = str2term "x^^^(-4)*(x^^^(-4)*y^^^(-2))^^^(-1)*y^^^(-2)";
neuper@37926
   235
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   236
if (term2str t) = "1" then ()
neuper@38031
   237
else error "poly.sml: diff.behav. in make_polynomial 12";
neuper@37906
   238
neuper@37906
   239
(*SPB Schalk I p.60 No.209a*)
neuper@37906
   240
val t = str2term "a^^^(7-x) * a^^^x";
neuper@37926
   241
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   242
if term2str t = "a ^^^ 7" then ()
neuper@38031
   243
else error "poly.sml: diff.behav. in make_polynomial 13";
neuper@37906
   244
neuper@37906
   245
(*SPB Schalk I p.60 No.209d*)
neuper@37906
   246
val t = str2term "d^^^x * d^^^(x+1) * d^^^(2 - 2*x)";
neuper@37926
   247
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   248
if term2str t = "d ^^^ 3" then ()
neuper@38031
   249
else error "poly.sml: diff.behav. in make_polynomial 14";
neuper@37906
   250
neuper@37906
   251
neuper@37906
   252
(*---------------------------------------------------------------------*)
neuper@37906
   253
(*------------------ Bsple bei denen es Probleme gibt------------------*)
neuper@37906
   254
(*---------------------------------------------------------------------*)
neuper@37906
   255
neuper@37906
   256
(*Schalk I p.64 No.303*)
neuper@37906
   257
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
   258
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   259
if term2str t = "1280 * b ^^^ 4" then ()
neuper@38031
   260
else error "poly.sml: diff.behav. in make_polynomial 14b";
neuper@37906
   261
(* Richtig - aber Binomische Formel wurde nicht verwendet! *)
neuper@37906
   262
neuper@37906
   263
neuper@37906
   264
(*--------------------------------------------------------------------*)
neuper@37906
   265
(*----------------------- Eigene Beispiele ---------------------------*)
neuper@37906
   266
(*--------------------------------------------------------------------*)
neuper@37906
   267
(*SPO*)
neuper@37906
   268
val t = str2term "a^^^2*a^^^(-2)";
neuper@37926
   269
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   270
if term2str t = "1" then ()
neuper@38031
   271
else error "poly.sml: diff.behav. in make_polynomial 15";
neuper@37906
   272
(*SPO*)
neuper@37906
   273
val t = str2term "a + a + a";
neuper@37926
   274
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   275
if term2str t = "3 * a" then ()
neuper@38031
   276
else error "poly.sml: diff.behav. in make_polynomial 16";
neuper@37906
   277
(*SPO*)
neuper@37906
   278
val t = str2term "a + b + b + b";
neuper@37926
   279
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   280
if term2str t = "a + 3 * b" then ()
neuper@38031
   281
else error "poly.sml: diff.behav. in make_polynomial 17";
neuper@37906
   282
(*SPO*)
neuper@37906
   283
val t = str2term "a^^^2*b*b^^^(-1)";
neuper@37926
   284
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   285
if term2str t = "a ^^^ 2" then ()
neuper@38031
   286
else error "poly.sml: diff.behav. in make_polynomial 18";
neuper@37906
   287
(*SPO*)
neuper@37906
   288
val t = str2term "a^^^2*a^^^(-2)";
neuper@37926
   289
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   290
if (term2str t) = "1" then ()
neuper@38031
   291
else error "poly.sml: diff.behav. in make_polynomial 19";
neuper@37906
   292
(*SPO*)
neuper@37906
   293
val t = str2term "b + a - b";
neuper@37926
   294
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   295
if (term2str t) = "a" then ()
neuper@38031
   296
else error "poly.sml: diff.behav. in make_polynomial 20";
neuper@37906
   297
(*SPO*)
neuper@37906
   298
val t = str2term "b * a * a";
neuper@37926
   299
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   300
if term2str t = "a ^^^ 2 * b" then ()
neuper@38031
   301
else error "poly.sml: diff.behav. in make_polynomial 21";
neuper@37906
   302
(*SPO*)
neuper@37906
   303
val t = str2term "(a^^^2)^^^3";
neuper@37926
   304
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   305
if term2str t = "a ^^^ 6" then ()
neuper@38031
   306
else error "poly.sml: diff.behav. in make_polynomial 22";
neuper@37906
   307
(*SPO*)
neuper@37906
   308
val t = str2term "x^^^2 * y^^^2 + x * x^^^2 * y";
neuper@37926
   309
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   310
if term2str t = "x ^^^ 3 * y + x ^^^ 2 * y ^^^ 2" then ()
neuper@38031
   311
else error "poly.sml: diff.behav. in make_polynomial 23";
neuper@37906
   312
(*SPO*)
neuper@37906
   313
val t = (term_of o the o (parse thy)) "a^^^2 * (-a)^^^2";
neuper@37926
   314
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   315
if (term2str t) = "a ^^^ 4" then ()
neuper@38031
   316
else error "poly.sml: diff.behav. in make_polynomial 24";
neuper@37906
   317
(*SPO*)
neuper@37906
   318
val t = str2term "a * b * b^^^(-1) + a";
neuper@37926
   319
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   320
if (term2str t) = "2 * a" then ()
neuper@38031
   321
else error "poly.sml: diff.behav. in make_polynomial 25";
neuper@37906
   322
(*SPO*)
neuper@37906
   323
val t = str2term "a*c*b^^^(2*n) + 3*a + 5*b^^^(2*n)*c*b";
neuper@37926
   324
val SOME (t,_) = rewrite_set_ thy false make_polynomial t; term2str t;
neuper@37906
   325
if (term2str t) = "3 * a + 5 * b ^^^ (1 + 2 * n) * c + a * b ^^^ (2 * n) * c"
neuper@38031
   326
then () else error "poly.sml: diff.behav. in make_polynomial 26";
neuper@37906
   327
neuper@37906
   328
neuper@37906
   329
(*MG.27.6.03 -------------vvv-: Verschachtelte Terme -----------*)
neuper@37906
   330
(*SPO*)
neuper@37906
   331
val t = str2term "(1 + (x*y*a) + x)^^^(1 + (x*y*a) + x)";
neuper@37926
   332
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   333
 term2str t;
neuper@37906
   334
if term2str t = "(1 + x + a * x * y) ^^^ (1 + x + a * x * y)"
neuper@38031
   335
 then () else error "poly.sml: diff.behav. in make_polynomial 27";(*SPO*)
neuper@37906
   336
val t = str2term "(1 + x*(y*z)*zz)^^^(1 + x*(y*z)*zz)";
neuper@37926
   337
 val SOME (t,_) = rewrite_set_ thy false make_polynomial t;
neuper@37906
   338
 term2str t;
neuper@37906
   339
if term2str t = "(1 + x * y * z * zz) ^^^ (1 + x * y * z * zz)"
neuper@38031
   340
 then () else error "poly.sml: diff.behav. in make_polynomial 28";
neuper@37906
   341
neuper@37906
   342
"-------- Script 'simplification for_polynomials' ----------------";
neuper@37906
   343
"-------- Script 'simplification for_polynomials' ----------------";
neuper@37906
   344
"-------- Script 'simplification for_polynomials' ----------------";
neuper@37906
   345
val str = 
neuper@37906
   346
"Script SimplifyScript (t_::real) =                \
neuper@37906
   347
\  ((Rewrite_Set norm_Poly False) t_)";
neuper@37906
   348
val sc = ((inst_abs thy) o term_of o the o (parse thy)) str;
neuper@37906
   349
atomty sc;
neuper@37906
   350
neuper@37906
   351
neuper@37906
   352
"-------- check pbl  'polynomial simplification' -----------------";
neuper@37906
   353
"-------- check pbl  'polynomial simplification' -----------------";
neuper@37906
   354
"-------- check pbl  'polynomial simplification' -----------------";
neuper@37967
   355
val fmz = ["TERM ((5*x^^^2 + 3) * (2*x^^^7 + 3) \
neuper@37906
   356
	   \- (3*x^^^5 + 8) * (6*x^^^4 - 1))",
neuper@37906
   357
	   "normalform N"];
neuper@37906
   358
(*0*)
neuper@37906
   359
case refine fmz ["polynomial","simplification"]of
neuper@37906
   360
    [Matches (["polynomial", "simplification"], _)] => ()
neuper@38031
   361
  | _ => error "poly.sml diff.behav. in check pbl, refine";
neuper@37906
   362
(*...if there is an error, then ...*)
neuper@37906
   363
neuper@37906
   364
(*1*)
neuper@37906
   365
print_depth 7;
neuper@37906
   366
val pbt = get_pbt ["polynomial","simplification"];
neuper@37906
   367
print_depth 3;
neuper@37906
   368
(*if there is ...
neuper@37906
   369
> val NoMatch' {Given=gi, Where=wh, Find=fi,...} = match_pbl fmz pbt;
neuper@37906
   370
... then trace_rewrite:*)
neuper@37906
   371
neuper@37906
   372
(*2*)
neuper@37906
   373
trace_rewrite:=true; 
neuper@37906
   374
match_pbl fmz pbt;
neuper@37906
   375
trace_rewrite:=false;
neuper@37906
   376
(*... if there is no rewrite, then there is something wrong with prls*)
neuper@37906
   377
neuper@37906
   378
(*3*)
neuper@37906
   379
print_depth 7;
neuper@37906
   380
val prls = (#prls o get_pbt) ["polynomial","simplification"];
neuper@37906
   381
print_depth 3;
neuper@37906
   382
val t = str2term "((5*x^^^2 + 3) * (2*x^^^7 + 3) \
neuper@37906
   383
		 \- (3*x^^^5 + 8) * (6*x^^^4 - 1)) is_polyexp";
neuper@37906
   384
trace_rewrite:=true; 
neuper@37926
   385
val SOME (t',_) = rewrite_set_ thy false prls t;
neuper@37906
   386
trace_rewrite:=false;
neuper@37906
   387
if t' = HOLogic.true_const then () 
neuper@38031
   388
else error "poly.sml: diff.behav. in check pbl 'polynomial..";
neuper@37906
   389
(*... if this works, but (*1*) does still NOT work, check types:*)
neuper@37906
   390
neuper@37906
   391
(*4*)
neuper@37906
   392
show_types:=true;
neuper@37906
   393
(*
neuper@37906
   394
> val NoMatch' {Given=gi, Where=wh, Find=fi,...} = match_pbl fmz pbt;
neuper@37906
   395
val wh = [False "(t_::real => real) (is_polyexp::real)"]
neuper@37906
   396
......................^^^^^^^^^^^^...............^^^^*)
neuper@37906
   397
val Matches' _ = match_pbl fmz pbt;
neuper@37906
   398
show_types:=false;
neuper@37906
   399
neuper@37906
   400
neuper@37906
   401
"-------- me 'polynomial simplification' Schalk I p.63 No.267b ---";
neuper@37906
   402
"-------- me 'polynomial simplification' Schalk I p.63 No.267b ---";
neuper@37906
   403
"-------- me 'polynomial simplification' Schalk I p.63 No.267b ---";
neuper@37967
   404
val fmz = ["TERM ((5*x^^^2 + 3) * (2*x^^^7 + 3) \
neuper@37906
   405
	   \- (3*x^^^5 + 8) * (6*x^^^4 - 1))",
neuper@37906
   406
	   "normalform N"];
neuper@37906
   407
val (dI',pI',mI') =
neuper@37991
   408
  ("Poly",["polynomial","simplification"],
neuper@37906
   409
   ["simplification","for_polynomials"]);
neuper@37906
   410
val p = e_pos'; val c = []; 
neuper@37906
   411
val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
neuper@37906
   412
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   413
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37924
   414
(writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
neuper@37906
   415
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   416
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   417
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   418
val (p,_,f,nxt,_,pt) = me nxt p c pt;
neuper@37906
   419
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   420
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   421
val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
neuper@37906
   422
if f2str f = 
neuper@37906
   423
"17 + 15 * x ^^^ 2 + -48 * x ^^^ 4 + 3 * x ^^^ 5 + 6 * x ^^^ 7 + -8 * x ^^^ 9"
neuper@38031
   424
then () else error "poly.sml diff.behav. in me Schalk I p.63 No.267b";
neuper@37906
   425
neuper@37906
   426
neuper@37906
   427
"-------- interSteps for Schalk 299a -----------------------------";
neuper@37906
   428
"-------- interSteps for Schalk 299a -----------------------------";
neuper@37906
   429
"-------- interSteps for Schalk 299a -----------------------------";
neuper@37906
   430
states:=[];
neuper@37906
   431
CalcTree
neuper@37967
   432
[(["TERM ((x - y)*(x + y))", "normalform N"], 
neuper@37991
   433
  ("Poly",["polynomial","simplification"],
neuper@37906
   434
  ["simplification","for_polynomials"]))];
neuper@37906
   435
Iterator 1;
neuper@37906
   436
moveActiveRoot 1;
neuper@37906
   437
autoCalculate 1 CompleteCalc;
neuper@37906
   438
val ((pt,p),_) = get_calc 1; show_pt pt;
neuper@37906
   439
neuper@37906
   440
interSteps 1 ([1],Res)(*<ERROR> syserror in detailstep </ERROR>*);
neuper@37906
   441
val ((pt,p),_) = get_calc 1; show_pt pt;
neuper@37906
   442
if existpt' ([1,1], Frm) pt then ()
neuper@38031
   443
else error "poly.sml: interSteps doesnt work again 1";
neuper@37906
   444
neuper@37906
   445
interSteps 1 ([1,1],Res)(*<ERROR> syserror in detailstep </ERROR>*);
neuper@37906
   446
val ((pt,p),_) = get_calc 1; show_pt pt;
neuper@37906
   447
if existpt' ([1,1,1], Frm) pt then ()
neuper@38031
   448
else error "poly.sml: interSteps doesnt work again 2";
neuper@37906
   449
neuper@37906
   450
neuper@37906
   451
"-------- norm_Poly NOT COMPLETE ---------------------------------";
neuper@37906
   452
"-------- norm_Poly NOT COMPLETE ---------------------------------";
neuper@37906
   453
"-------- norm_Poly NOT COMPLETE ---------------------------------";
neuper@37906
   454
trace_rewrite:=true;
neuper@37926
   455
val SOME (f',_) = rewrite_set_ thy false norm_Poly 
neuper@37906
   456
(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
   457
trace_rewrite:=false;
neuper@37906
   458
term2str f';
neuper@37906
   459
neuper@37906
   460
"-------- ord_make_polynomial ------------------------------------";
neuper@37906
   461
"-------- ord_make_polynomial ------------------------------------";
neuper@37906
   462
"-------- ord_make_polynomial ------------------------------------";
neuper@37906
   463
val t1 = str2term "2 * b + (3 * a + 3 * b)";
neuper@37906
   464
val t2 = str2term "3 * a + 3 * b + 2 * b";
neuper@37906
   465
neuper@37906
   466
if ord_make_polynomial true Poly.thy [] (t1, t2) then ()
neuper@38031
   467
else error "poly.sml: diff.behav. in ord_make_polynomial";
neuper@37906
   468
neuper@37906
   469
(*WN071202: ^^^ why then is there no rewriting ...*)
neuper@37906
   470
val term = str2term "2*b + (3*a + 3*b)";
neuper@37926
   471
val NONE = rewrite_set_ Isac.thy false order_add_mult term;
neuper@37906
   472
neuper@37906
   473
(*or why is there no rewriting this way...*)
neuper@37906
   474
val t1 = str2term "2 * b + (3 * a + 3 * b)";
neuper@37906
   475
val t2 = str2term "3 * a + (2 * b + 3 * b)";
neuper@37906
   476
neuper@37906
   477
neuper@37974
   478
----------------------------------------------*)
neuper@38022
   479
===== inhibit exn ?===========================================================*)