test/Tools/isac/Knowledge/poly.sml
author Walther Neuper <neuper@ist.tugraz.at>
Sat, 17 Mar 2012 12:52:30 +0100
changeset 42395 308050197b06
parent 41977 a3ce4017f41d
child 48760 5e1e45b3ddef
permissions -rw-r--r--
uncomment test/../root,equation,poly.sml (Isabelle 2002 --> 2011)

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