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