src/Tools/isac/Knowledge/PolyEq.thy
author Walther Neuper <neuper@ist.tugraz.at>
Mon, 06 Sep 2010 16:56:22 +0200
branchisac-update-Isa09-2
changeset 37983 03bfbc480107
parent 37982 66f3570ba808
child 37984 972a73d7c50b
permissions -rw-r--r--
corrected format for axioms in remaining theories
     1 (* theory collecting all knowledge 
     2    (predicates 'is_rootEq_in', 'is_sqrt_in', 'is_ratEq_in')
     3    for PolynomialEquations.
     4    alternative dependencies see Isac.thy
     5    created by: rlang 
     6          date: 02.07
     7    changed by: rlang
     8    last change by: rlang
     9              date: 03.06.03
    10    (c) by Richard Lang, 2003
    11 *)
    12 
    13 theory PolyEq imports LinEq RootRatEq begin 
    14 
    15 consts
    16 
    17 (*---------scripts--------------------------*)
    18   Complete'_square
    19              :: "[bool,real, 
    20 		   bool list] => bool list"
    21                ("((Script Complete'_square (_ _ =))// 
    22                   (_))" 9)
    23  (*----- poly ----- *)	 
    24   Normalize'_poly
    25              :: "[bool,real, 
    26 		   bool list] => bool list"
    27                ("((Script Normalize'_poly (_ _=))// 
    28                   (_))" 9)
    29   Solve'_d0'_polyeq'_equation
    30              :: "[bool,real, 
    31 		   bool list] => bool list"
    32                ("((Script Solve'_d0'_polyeq'_equation (_ _ =))// 
    33                   (_))" 9)
    34   Solve'_d1'_polyeq'_equation
    35              :: "[bool,real, 
    36 		   bool list] => bool list"
    37                ("((Script Solve'_d1'_polyeq'_equation (_ _ =))// 
    38                   (_))" 9)
    39   Solve'_d2'_polyeq'_equation
    40              :: "[bool,real, 
    41 		   bool list] => bool list"
    42                ("((Script Solve'_d2'_polyeq'_equation (_ _ =))// 
    43                   (_))" 9)
    44   Solve'_d2'_polyeq'_sqonly'_equation
    45              :: "[bool,real, 
    46 		   bool list] => bool list"
    47                ("((Script Solve'_d2'_polyeq'_sqonly'_equation (_ _ =))// 
    48                   (_))" 9)
    49   Solve'_d2'_polyeq'_bdvonly'_equation
    50              :: "[bool,real, 
    51 		   bool list] => bool list"
    52                ("((Script Solve'_d2'_polyeq'_bdvonly'_equation (_ _ =))// 
    53                   (_))" 9)
    54   Solve'_d2'_polyeq'_pq'_equation
    55              :: "[bool,real, 
    56 		   bool list] => bool list"
    57                ("((Script Solve'_d2'_polyeq'_pq'_equation (_ _ =))// 
    58                   (_))" 9)
    59   Solve'_d2'_polyeq'_abc'_equation
    60              :: "[bool,real, 
    61 		   bool list] => bool list"
    62                ("((Script Solve'_d2'_polyeq'_abc'_equation (_ _ =))// 
    63                   (_))" 9)
    64   Solve'_d3'_polyeq'_equation
    65              :: "[bool,real, 
    66 		   bool list] => bool list"
    67                ("((Script Solve'_d3'_polyeq'_equation (_ _ =))// 
    68                   (_))" 9)
    69   Solve'_d4'_polyeq'_equation
    70              :: "[bool,real, 
    71 		   bool list] => bool list"
    72                ("((Script Solve'_d4'_polyeq'_equation (_ _ =))// 
    73                   (_))" 9)
    74   Biquadrat'_poly
    75              :: "[bool,real, 
    76 		   bool list] => bool list"
    77                ("((Script Biquadrat'_poly (_ _=))// 
    78                   (_))" 9)
    79 
    80 (*-------------------- rules -------------------------------------------------*)
    81 axioms 
    82 
    83   cancel_leading_coeff1: "Not (c =!= 0) ==> (a + b*bdv + c*bdv^^^2 = 0) = 
    84 			                   (a/c + b/c*bdv + bdv^^^2 = 0)"
    85   cancel_leading_coeff2: "Not (c =!= 0) ==> (a - b*bdv + c*bdv^^^2 = 0) = 
    86 			                   (a/c - b/c*bdv + bdv^^^2 = 0)"
    87   cancel_leading_coeff3: "Not (c =!= 0) ==> (a + b*bdv - c*bdv^^^2 = 0) = 
    88 			                   (a/c + b/c*bdv - bdv^^^2 = 0)"
    89 
    90   cancel_leading_coeff4: "Not (c =!= 0) ==> (a +   bdv + c*bdv^^^2 = 0) = 
    91 			                   (a/c + 1/c*bdv + bdv^^^2 = 0)"
    92   cancel_leading_coeff5: "Not (c =!= 0) ==> (a -   bdv + c*bdv^^^2 = 0) = 
    93 			                   (a/c - 1/c*bdv + bdv^^^2 = 0)"
    94   cancel_leading_coeff6: "Not (c =!= 0) ==> (a +   bdv - c*bdv^^^2 = 0) = 
    95 			                   (a/c + 1/c*bdv - bdv^^^2 = 0)"
    96 
    97   cancel_leading_coeff7: "Not (c =!= 0) ==> (    b*bdv + c*bdv^^^2 = 0) = 
    98 			                   (    b/c*bdv + bdv^^^2 = 0)"
    99   cancel_leading_coeff8: "Not (c =!= 0) ==> (    b*bdv - c*bdv^^^2 = 0) = 
   100 			                   (    b/c*bdv - bdv^^^2 = 0)"
   101 
   102   cancel_leading_coeff9: "Not (c =!= 0) ==> (      bdv + c*bdv^^^2 = 0) = 
   103 			                   (      1/c*bdv + bdv^^^2 = 0)"
   104   cancel_leading_coeff10:"Not (c =!= 0) ==> (      bdv - c*bdv^^^2 = 0) = 
   105 			                   (      1/c*bdv - bdv^^^2 = 0)"
   106 
   107   cancel_leading_coeff11:"Not (c =!= 0) ==> (a +      b*bdv^^^2 = 0) = 
   108 			                   (a/b +      bdv^^^2 = 0)"
   109   cancel_leading_coeff12:"Not (c =!= 0) ==> (a -      b*bdv^^^2 = 0) = 
   110 			                   (a/b -      bdv^^^2 = 0)"
   111   cancel_leading_coeff13:"Not (c =!= 0) ==> (         b*bdv^^^2 = 0) = 
   112 			                   (           bdv^^^2 = 0/b)"
   113 
   114   complete_square1:      "(q + p*bdv + bdv^^^2 = 0) = 
   115 		         (q + (p/2 + bdv)^^^2 = (p/2)^^^2)"
   116   complete_square2:      "(    p*bdv + bdv^^^2 = 0) = 
   117 		         (    (p/2 + bdv)^^^2 = (p/2)^^^2)"
   118   complete_square3:      "(      bdv + bdv^^^2 = 0) = 
   119 		         (    (1/2 + bdv)^^^2 = (1/2)^^^2)"
   120 		        
   121   complete_square4:      "(q - p*bdv + bdv^^^2 = 0) = 
   122 		         (q + (p/2 - bdv)^^^2 = (p/2)^^^2)"
   123   complete_square5:      "(q + p*bdv - bdv^^^2 = 0) = 
   124 		         (q + (p/2 - bdv)^^^2 = (p/2)^^^2)"
   125 
   126   square_explicit1:      "(a + b^^^2 = c) = ( b^^^2 = c - a)"
   127   square_explicit2:      "(a - b^^^2 = c) = (-(b^^^2) = c - a)"
   128 
   129   bdv_explicit1:         "(a + bdv = b) = (bdv = - a + b)"
   130   bdv_explicit2:         "(a - bdv = b) = ((-1)*bdv = - a + b)"
   131   bdv_explicit3:         "((-1)*bdv = b) = (bdv = (-1)*b)"
   132 
   133   plus_leq:              "(0 <= a + b) = ((-1)*b <= a)"(*Isa?*)
   134   minus_leq:             "(0 <= a - b) = (     b <= a)"(*Isa?*)
   135 
   136 (*-- normalize --*)
   137   (*WN0509 compare LinEq.all_left "[|Not(b=!=0)|] ==> (a=b) = (a+(-1)*b=0)"*)
   138   all_left:              "[|Not(b=!=0)|] ==> (a = b) = (a - b = 0)"
   139   makex1_x:              "a^^^1  = a"  
   140   real_assoc_1:          "a+(b+c) = a+b+c"
   141   real_assoc_2:          "a*(b*c) = a*b*c"
   142 
   143 (* ---- degree 0 ----*)
   144   d0_true:               "(0=0) = True"
   145   d0_false:              "[|Not(bdv occurs_in a);Not(a=0)|] ==> (a=0) = False"
   146 (* ---- degree 1 ----*)
   147   d1_isolate_add1:
   148    "[|Not(bdv occurs_in a)|] ==> (a + b*bdv = 0) = (b*bdv = (-1)*a)"
   149   d1_isolate_add2:
   150    "[|Not(bdv occurs_in a)|] ==> (a +   bdv = 0) = (  bdv = (-1)*a)"
   151   d1_isolate_div:
   152    "[|Not(b=0);Not(bdv occurs_in c)|] ==> (b*bdv = c) = (bdv = c/b)"
   153 (* ---- degree 2 ----*)
   154   d2_isolate_add1:
   155    "[|Not(bdv occurs_in a)|] ==> (a + b*bdv^^^2=0) = (b*bdv^^^2= (-1)*a)"
   156   d2_isolate_add2:
   157    "[|Not(bdv occurs_in a)|] ==> (a +   bdv^^^2=0) = (  bdv^^^2= (-1)*a)"
   158   d2_isolate_div:
   159    "[|Not(b=0);Not(bdv occurs_in c)|] ==> (b*bdv^^^2=c) = (bdv^^^2=c/b)"
   160 
   161   d2_prescind1:          "(a*bdv + b*bdv^^^2 = 0) = (bdv*(a +b*bdv)=0)"
   162   d2_prescind2:          "(a*bdv +   bdv^^^2 = 0) = (bdv*(a +  bdv)=0)"
   163   d2_prescind3:          "(  bdv + b*bdv^^^2 = 0) = (bdv*(1+b*bdv)=0)"
   164   d2_prescind4:          "(  bdv +   bdv^^^2 = 0) = (bdv*(1+  bdv)=0)"
   165   (* eliminate degree 2 *)
   166   (* thm for neg arguments in sqroot have postfix _neg *)
   167   d2_sqrt_equation1:     "[|(0<=c);Not(bdv occurs_in c)|] ==> 
   168                          (bdv^^^2=c) = ((bdv=sqrt c) | (bdv=(-1)*sqrt c ))"
   169   d2_sqrt_equation1_neg:
   170   "[|(c<0);Not(bdv occurs_in c)|] ==> (bdv^^^2=c) = False"
   171   d2_sqrt_equation2:     "(bdv^^^2=0) = (bdv=0)"
   172   d2_sqrt_equation3:     "(b*bdv^^^2=0) = (bdv=0)"
   173   d2_reduce_equation1:   "(bdv*(a +b*bdv)=0) = ((bdv=0)|(a+b*bdv=0))"
   174   d2_reduce_equation2:   "(bdv*(a +  bdv)=0) = ((bdv=0)|(a+  bdv=0))"
   175   d2_pqformula1:         "[|0<=p^^^2 - 4*q|] ==> (q+p*bdv+   bdv^^^2=0) =
   176                            ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 4*q)/2) 
   177                           | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 4*q)/2))"
   178   d2_pqformula1_neg:     "[|p^^^2 - 4*q<0|] ==> (q+p*bdv+   bdv^^^2=0) = False"
   179   d2_pqformula2:         "[|0<=p^^^2 - 4*q|] ==> (q+p*bdv+1*bdv^^^2=0) = 
   180                            ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 4*q)/2) 
   181                           | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 4*q)/2))"
   182   d2_pqformula2_neg:     "[|p^^^2 - 4*q<0|] ==> (q+p*bdv+1*bdv^^^2=0) = False"
   183   d2_pqformula3:         "[|0<=1 - 4*q|] ==> (q+  bdv+   bdv^^^2=0) = 
   184                            ((bdv= (-1)*(1/2) + sqrt(1 - 4*q)/2) 
   185                           | (bdv= (-1)*(1/2) - sqrt(1 - 4*q)/2))"
   186   d2_pqformula3_neg:     "[|1 - 4*q<0|] ==> (q+  bdv+   bdv^^^2=0) = False"
   187   d2_pqformula4:         "[|0<=1 - 4*q|] ==> (q+  bdv+1*bdv^^^2=0) = 
   188                            ((bdv= (-1)*(1/2) + sqrt(1 - 4*q)/2) 
   189                           | (bdv= (-1)*(1/2) - sqrt(1 - 4*q)/2))"
   190   d2_pqformula4_neg:     "[|1 - 4*q<0|] ==> (q+  bdv+1*bdv^^^2=0) = False"
   191   d2_pqformula5:         "[|0<=p^^^2 - 0|] ==> (  p*bdv+   bdv^^^2=0) =
   192                            ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 0)/2) 
   193                           | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 0)/2))"
   194   (* d2_pqformula5_neg not need p^2 never less zero in R *)
   195   d2_pqformula6:         "[|0<=p^^^2 - 0|] ==> (  p*bdv+1*bdv^^^2=0) = 
   196                            ((bdv= (-1)*(p/2) + sqrt(p^^^2 - 0)/2) 
   197                           | (bdv= (-1)*(p/2) - sqrt(p^^^2 - 0)/2))"
   198   (* d2_pqformula6_neg not need p^2 never less zero in R *)
   199   d2_pqformula7:        "[|0<=1 - 0|] ==> (    bdv+   bdv^^^2=0) = 
   200                            ((bdv= (-1)*(1/2) + sqrt(1 - 0)/2) 
   201                           | (bdv= (-1)*(1/2) - sqrt(1 - 0)/2))"
   202   (* d2_pqformula7_neg not need, because 1<0 ==> False*)
   203   d2_pqformula8:        "[|0<=1 - 0|] ==> (    bdv+1*bdv^^^2=0) = 
   204                            ((bdv= (-1)*(1/2) + sqrt(1 - 0)/2) 
   205                           | (bdv= (-1)*(1/2) - sqrt(1 - 0)/2))"
   206   (* d2_pqformula8_neg not need, because 1<0 ==> False*)
   207   d2_pqformula9:        "[|Not(bdv occurs_in q); 0<= (-1)*4*q|] ==> 
   208                            (q+    1*bdv^^^2=0) = ((bdv= 0 + sqrt(0 - 4*q)/2) 
   209                                                 | (bdv= 0 - sqrt(0 - 4*q)/2))"
   210   d2_pqformula9_neg:
   211    "[|Not(bdv occurs_in q); (-1)*4*q<0|] ==> (q+    1*bdv^^^2=0) = False"
   212   d2_pqformula10:
   213    "[|Not(bdv occurs_in q); 0<= (-1)*4*q|] ==> (q+     bdv^^^2=0) = 
   214            ((bdv= 0 + sqrt(0 - 4*q)/2) 
   215           | (bdv= 0 - sqrt(0 - 4*q)/2))"
   216   d2_pqformula10_neg:
   217    "[|Not(bdv occurs_in q); (-1)*4*q<0|] ==> (q+     bdv^^^2=0) = False"
   218   d2_abcformula1:
   219    "[|0<=b^^^2 - 4*a*c|] ==> (c + b*bdv+a*bdv^^^2=0) =
   220            ((bdv=( -b + sqrt(b^^^2 - 4*a*c))/(2*a)) 
   221           | (bdv=( -b - sqrt(b^^^2 - 4*a*c))/(2*a)))"
   222   d2_abcformula1_neg:
   223    "[|b^^^2 - 4*a*c<0|] ==> (c + b*bdv+a*bdv^^^2=0) = False"
   224   d2_abcformula2:
   225    "[|0<=1 - 4*a*c|]     ==> (c+    bdv+a*bdv^^^2=0) = 
   226            ((bdv=( -1 + sqrt(1 - 4*a*c))/(2*a)) 
   227           | (bdv=( -1 - sqrt(1 - 4*a*c))/(2*a)))"
   228   d2_abcformula2_neg:
   229    "[|1 - 4*a*c<0|]     ==> (c+    bdv+a*bdv^^^2=0) = False"
   230   d2_abcformula3:
   231    "[|0<=b^^^2 - 4*1*c|] ==> (c + b*bdv+  bdv^^^2=0) =
   232            ((bdv=( -b + sqrt(b^^^2 - 4*1*c))/(2*1)) 
   233           | (bdv=( -b - sqrt(b^^^2 - 4*1*c))/(2*1)))"
   234   d2_abcformula3_neg:
   235    "[|b^^^2 - 4*1*c<0|] ==> (c + b*bdv+  bdv^^^2=0) = False"
   236   d2_abcformula4:
   237    "[|0<=1 - 4*1*c|] ==> (c +   bdv+  bdv^^^2=0) =
   238            ((bdv=( -1 + sqrt(1 - 4*1*c))/(2*1)) 
   239           | (bdv=( -1 - sqrt(1 - 4*1*c))/(2*1)))"
   240   d2_abcformula4_neg:
   241    "[|1 - 4*1*c<0|] ==> (c +   bdv+  bdv^^^2=0) = False"
   242   d2_abcformula5:
   243    "[|Not(bdv occurs_in c); 0<=0 - 4*a*c|] ==> (c +  a*bdv^^^2=0) =
   244            ((bdv=( 0 + sqrt(0 - 4*a*c))/(2*a)) 
   245           | (bdv=( 0 - sqrt(0 - 4*a*c))/(2*a)))"
   246   d2_abcformula5_neg:
   247    "[|Not(bdv occurs_in c); 0 - 4*a*c<0|] ==> (c +  a*bdv^^^2=0) = False"
   248   d2_abcformula6:
   249    "[|Not(bdv occurs_in c); 0<=0 - 4*1*c|]     ==> (c+    bdv^^^2=0) = 
   250            ((bdv=( 0 + sqrt(0 - 4*1*c))/(2*1)) 
   251           | (bdv=( 0 - sqrt(0 - 4*1*c))/(2*1)))"
   252   d2_abcformula6_neg:
   253    "[|Not(bdv occurs_in c); 0 - 4*1*c<0|]     ==> (c+    bdv^^^2=0) = False"
   254   d2_abcformula7:
   255    "[|0<=b^^^2 - 0|]     ==> (    b*bdv+a*bdv^^^2=0) = 
   256            ((bdv=( -b + sqrt(b^^^2 - 0))/(2*a)) 
   257           | (bdv=( -b - sqrt(b^^^2 - 0))/(2*a)))"
   258   (* d2_abcformula7_neg not need b^2 never less zero in R *)
   259   d2_abcformula8:
   260    "[|0<=b^^^2 - 0|] ==> (    b*bdv+  bdv^^^2=0) =
   261            ((bdv=( -b + sqrt(b^^^2 - 0))/(2*1)) 
   262           | (bdv=( -b - sqrt(b^^^2 - 0))/(2*1)))"
   263   (* d2_abcformula8_neg not need b^2 never less zero in R *)
   264   d2_abcformula9:
   265    "[|0<=1 - 0|]     ==> (      bdv+a*bdv^^^2=0) = 
   266            ((bdv=( -1 + sqrt(1 - 0))/(2*a)) 
   267           | (bdv=( -1 - sqrt(1 - 0))/(2*a)))"
   268   (* d2_abcformula9_neg not need, because 1<0 ==> False*)
   269   d2_abcformula10:
   270    "[|0<=1 - 0|] ==> (      bdv+  bdv^^^2=0) =
   271            ((bdv=( -1 + sqrt(1 - 0))/(2*1)) 
   272           | (bdv=( -1 - sqrt(1 - 0))/(2*1)))"
   273   (* d2_abcformula10_neg not need, because 1<0 ==> False*)
   274 
   275 (* ---- degree 3 ----*)
   276   d3_reduce_equation1:
   277   "(a*bdv + b*bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (a + b*bdv + c*bdv^^^2=0))"
   278   d3_reduce_equation2:
   279   "(  bdv + b*bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (1 + b*bdv + c*bdv^^^2=0))"
   280   d3_reduce_equation3:
   281   "(a*bdv +   bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (a +   bdv + c*bdv^^^2=0))"
   282   d3_reduce_equation4:
   283   "(  bdv +   bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (1 +   bdv + c*bdv^^^2=0))"
   284   d3_reduce_equation5:
   285   "(a*bdv + b*bdv^^^2 +   bdv^^^3=0) = (bdv=0 | (a + b*bdv +   bdv^^^2=0))"
   286   d3_reduce_equation6:
   287   "(  bdv + b*bdv^^^2 +   bdv^^^3=0) = (bdv=0 | (1 + b*bdv +   bdv^^^2=0))"
   288   d3_reduce_equation7:
   289   "(a*bdv +   bdv^^^2 +   bdv^^^3=0) = (bdv=0 | (1 +   bdv +   bdv^^^2=0))"
   290   d3_reduce_equation8:
   291   "(  bdv +   bdv^^^2 +   bdv^^^3=0) = (bdv=0 | (1 +   bdv +   bdv^^^2=0))"
   292   d3_reduce_equation9:
   293   "(a*bdv             + c*bdv^^^3=0) = (bdv=0 | (a         + c*bdv^^^2=0))"
   294   d3_reduce_equation10:
   295   "(  bdv             + c*bdv^^^3=0) = (bdv=0 | (1         + c*bdv^^^2=0))"
   296   d3_reduce_equation11:
   297   "(a*bdv             +   bdv^^^3=0) = (bdv=0 | (a         +   bdv^^^2=0))"
   298   d3_reduce_equation12:
   299   "(  bdv             +   bdv^^^3=0) = (bdv=0 | (1         +   bdv^^^2=0))"
   300   d3_reduce_equation13:
   301   "(        b*bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (    b*bdv + c*bdv^^^2=0))"
   302   d3_reduce_equation14:
   303   "(          bdv^^^2 + c*bdv^^^3=0) = (bdv=0 | (      bdv + c*bdv^^^2=0))"
   304   d3_reduce_equation15:
   305   "(        b*bdv^^^2 +   bdv^^^3=0) = (bdv=0 | (    b*bdv +   bdv^^^2=0))"
   306   d3_reduce_equation16:
   307   "(          bdv^^^2 +   bdv^^^3=0) = (bdv=0 | (      bdv +   bdv^^^2=0))"
   308   d3_isolate_add1:
   309   "[|Not(bdv occurs_in a)|] ==> (a + b*bdv^^^3=0) = (b*bdv^^^3= (-1)*a)"
   310   d3_isolate_add2:
   311   "[|Not(bdv occurs_in a)|] ==> (a +   bdv^^^3=0) = (  bdv^^^3= (-1)*a)"
   312   d3_isolate_div:
   313    "[|Not(b=0);Not(bdv occurs_in a)|] ==> (b*bdv^^^3=c) = (bdv^^^3=c/b)"
   314   d3_root_equation2:
   315   "(bdv^^^3=0) = (bdv=0)"
   316   d3_root_equation1:
   317   "(bdv^^^3=c) = (bdv = nroot 3 c)"
   318 
   319 (* ---- degree 4 ----*)
   320  (* RL03.FIXME es wir nicht getestet ob u>0 *)
   321  d4_sub_u1
   322  "(c+b*bdv^^^2+a*bdv^^^4=0) =
   323    ((a*u^^^2+b*u+c=0) & (bdv^^^2=u))"
   324 
   325 (* ---- 7.3.02 von Termorder ---- *)
   326 
   327   bdv_collect_1:      "l * bdv + m * bdv = (l + m) * bdv"
   328   bdv_collect_2:      "bdv + m * bdv = (1 + m) * bdv"
   329   bdv_collect_3:      "l * bdv + bdv = (l + 1) * bdv"
   330 
   331 (*  bdv_collect_assoc0_1 "l * bdv + m * bdv + k = (l + m) * bdv + k"
   332     bdv_collect_assoc0_2 "bdv + m * bdv + k = (1 + m) * bdv + k"
   333     bdv_collect_assoc0_3 "l * bdv + bdv + k = (l + 1) * bdv + k"
   334 *)
   335   bdv_collect_assoc1_1:"l * bdv + (m * bdv + k) = (l + m) * bdv + k"
   336   bdv_collect_assoc1_2:"bdv + (m * bdv + k) = (1 + m) * bdv + k"
   337   bdv_collect_assoc1_3:"l * bdv + (bdv + k) = (l + 1) * bdv + k"
   338 
   339   bdv_collect_assoc2_1:"k + l * bdv + m * bdv = k + (l + m) * bdv"
   340   bdv_collect_assoc2_2:"k + bdv + m * bdv = k + (1 + m) * bdv"
   341   bdv_collect_assoc2_3:"k + l * bdv + bdv = k + (l + 1) * bdv"
   342 
   343 
   344   bdv_n_collect_1:     "l * bdv^^^n + m * bdv^^^n = (l + m) * bdv^^^n"
   345   bdv_n_collect_2:     " bdv^^^n + m * bdv^^^n = (1 + m) * bdv^^^n"
   346   bdv_n_collect_3:     "l * bdv^^^n + bdv^^^n = (l + 1) * bdv^^^n"   (*order!*)
   347 
   348   bdv_n_collect_assoc1_1:"l * bdv^^^n + (m * bdv^^^n + k) = (l + m) * bdv^^^n + k"
   349   bdv_n_collect_assoc1_2:"bdv^^^n + (m * bdv^^^n + k) = (1 + m) * bdv^^^n + k"
   350   bdv_n_collect_assoc1_3:"l * bdv^^^n + (bdv^^^n + k) = (l + 1) * bdv^^^n + k"
   351 
   352   bdv_n_collect_assoc2_1:"k + l * bdv^^^n + m * bdv^^^n = k + (l + m) * bdv^^^n"
   353   bdv_n_collect_assoc2_2:"k + bdv^^^n + m * bdv^^^n = k + (1 + m) * bdv^^^n"
   354   bdv_n_collect_assoc2_3:"k + l * bdv^^^n + bdv^^^n = k + (l + 1) * bdv^^^n"
   355 
   356 (*WN.14.3.03*)
   357   real_minus_div:        "- (a / b) = (-1 * a) / b"
   358 
   359   separate_bdv:          "(a * bdv) / b = (a / b) * bdv"
   360   separate_bdv_n:        "(a * bdv ^^^ n) / b = (a / b) * bdv ^^^ n"
   361   separate_1_bdv:        "bdv / b = (1 / b) * bdv"
   362   separate_1_bdv_n:      "bdv ^^^ n / b = (1 / b) * bdv ^^^ n"
   363 
   364 ML {*
   365 val thy = @{theory};
   366 
   367 (*-------------------------rulse-------------------------*)
   368 val PolyEq_prls = (*3.10.02:just the following order due to subterm evaluation*)
   369   append_rls "PolyEq_prls" e_rls 
   370 	     [Calc ("Atools.ident",eval_ident "#ident_"),
   371 	      Calc ("Tools.matches",eval_matches ""),
   372 	      Calc ("Tools.lhs"    ,eval_lhs ""),
   373 	      Calc ("Tools.rhs"    ,eval_rhs ""),
   374 	      Calc ("Poly.is'_expanded'_in",eval_is_expanded_in ""),
   375 	      Calc ("Poly.is'_poly'_in",eval_is_poly_in ""),
   376 	      Calc ("Poly.has'_degree'_in",eval_has_degree_in ""),    
   377               Calc ("Poly.is'_polyrat'_in",eval_is_polyrat_in ""),
   378 	      (*Calc ("Atools.occurs'_in",eval_occurs_in ""),   *) 
   379 	      (*Calc ("Atools.is'_const",eval_const "#is_const_"),*)
   380 	      Calc ("op =",eval_equal "#equal_"),
   381               Calc ("RootEq.is'_rootTerm'_in",eval_is_rootTerm_in ""),
   382 	      Calc ("RatEq.is'_ratequation'_in",eval_is_ratequation_in ""),
   383 	      Thm ("not_true",num_str @{thm not_true}),
   384 	      Thm ("not_false",num_str @{thm not_false}),
   385 	      Thm ("and_true",num_str @{thm and_true}),
   386 	      Thm ("and_false",num_str @{thm and_false}),
   387 	      Thm ("or_true",num_str @{thm or_true}),
   388 	      Thm ("or_false",num_str @{thm or_false})
   389 	       ];
   390 
   391 val PolyEq_erls = 
   392     merge_rls "PolyEq_erls" LinEq_erls
   393     (append_rls "ops_preds" calculate_Rational
   394 		[Calc ("op =",eval_equal "#equal_"),
   395 		 Thm ("plus_leq", num_str @{thm plus_leq}),
   396 		 Thm ("minus_leq", num_str @{thm minus_leq}),
   397 		 Thm ("rat_leq1", num_str @{thm rat_leq1}),
   398 		 Thm ("rat_leq2", num_str @{thm rat_leq2}),
   399 		 Thm ("rat_leq3", num_str @{thm rat_leq3})
   400 		 ]);
   401 
   402 val PolyEq_crls = 
   403     merge_rls "PolyEq_crls" LinEq_crls
   404     (append_rls "ops_preds" calculate_Rational
   405 		[Calc ("op =",eval_equal "#equal_"),
   406 		 Thm ("plus_leq", num_str @{thm plus_leq}),
   407 		 Thm ("minus_leq", num_str @{thm minus_leq}),
   408 		 Thm ("rat_leq1", num_str @{thm rat_leq1}),
   409 		 Thm ("rat_leq2", num_str @{thm rat_leq2}),
   410 		 Thm ("rat_leq3", num_str @{thm rat_leq3})
   411 		 ]);
   412 
   413 val cancel_leading_coeff = prep_rls(
   414   Rls {id = "cancel_leading_coeff", preconds = [], 
   415        rew_ord = ("e_rew_ord",e_rew_ord),
   416       erls = PolyEq_erls, srls = Erls, calc = [], (*asm_thm = [],*)
   417       rules = [Thm ("cancel_leading_coeff1",num_str @{thm cancel_leading_coeff1}),
   418 	       Thm ("cancel_leading_coeff2",num_str @{thm cancel_leading_coeff2}),
   419 	       Thm ("cancel_leading_coeff3",num_str @{thm cancel_leading_coeff3}),
   420 	       Thm ("cancel_leading_coeff4",num_str @{thm cancel_leading_coeff4}),
   421 	       Thm ("cancel_leading_coeff5",num_str @{thm cancel_leading_coeff5}),
   422 	       Thm ("cancel_leading_coeff6",num_str @{thm cancel_leading_coeff6}),
   423 	       Thm ("cancel_leading_coeff7",num_str @{thm cancel_leading_coeff7}),
   424 	       Thm ("cancel_leading_coeff8",num_str @{thm cancel_leading_coeff8}),
   425 	       Thm ("cancel_leading_coeff9",num_str @{thm cancel_leading_coeff9}),
   426 	       Thm ("cancel_leading_coeff10",num_str @{thm cancel_leading_coeff10}),
   427 	       Thm ("cancel_leading_coeff11",num_str @{thm cancel_leading_coeff11}),
   428 	       Thm ("cancel_leading_coeff12",num_str @{thm cancel_leading_coeff12}),
   429 	       Thm ("cancel_leading_coeff13",num_str @{thm cancel_leading_coeff13})
   430 	       ],
   431       scr = Script ((term_of o the o (parse thy)) 
   432       "empty_script")
   433       }:rls);
   434 
   435 val complete_square = prep_rls(
   436   Rls {id = "complete_square", preconds = [], 
   437        rew_ord = ("e_rew_ord",e_rew_ord),
   438       erls = PolyEq_erls, srls = Erls, calc = [], (*asm_thm = [],*)
   439       rules = [Thm ("complete_square1",num_str @{thm complete_square1}),
   440 	       Thm ("complete_square2",num_str @{thm complete_square2}),
   441 	       Thm ("complete_square3",num_str @{thm complete_square3}),
   442 	       Thm ("complete_square4",num_str @{thm complete_square4}),
   443 	       Thm ("complete_square5",num_str @{thm complete_square5})
   444 	       ],
   445       scr = Script ((term_of o the o (parse thy)) 
   446       "empty_script")
   447       }:rls);
   448 
   449 val polyeq_simplify = prep_rls(
   450   Rls {id = "polyeq_simplify", preconds = [], 
   451        rew_ord = ("termlessI",termlessI), 
   452        erls = PolyEq_erls, 
   453        srls = Erls, 
   454        calc = [], 
   455        (*asm_thm = [],*)
   456        rules = [Thm  ("real_assoc_1",num_str @{thm real_assoc_1}),
   457 		Thm  ("real_assoc_2",num_str @{thm real_assoc_2}),
   458 		Thm  ("real_diff_minus",num_str @{thm real_diff_minus}),
   459 		Thm  ("real_unari_minus",num_str @{thm real_unari_minus}),
   460 		Thm  ("realpow_multI",num_str @{thm realpow_multI}),
   461 		Calc ("op +",eval_binop "#add_"),
   462 		Calc ("op -",eval_binop "#sub_"),
   463 		Calc ("op *",eval_binop "#mult_"),
   464 		Calc ("HOL.divide", eval_cancel "#divide_e"),
   465 		Calc ("NthRoot.sqrt",eval_sqrt "#sqrt_"),
   466 		Calc ("Atools.pow" ,eval_binop "#power_"),
   467                 Rls_ reduce_012
   468                 ],
   469        scr = Script ((term_of o the o (parse thy)) "empty_script")
   470        }:rls);
   471 
   472 ruleset' := overwritelthy @{theory} (!ruleset',
   473 		[("cancel_leading_coeff",cancel_leading_coeff),
   474 		 ("complete_square",complete_square),
   475 		 ("PolyEq_erls",PolyEq_erls),(*FIXXXME:del with rls.rls'*)
   476 		 ("polyeq_simplify",polyeq_simplify)]);
   477 
   478 
   479 (* ------------- polySolve ------------------ *)
   480 (* -- d0 -- *)
   481 (*isolate the bound variable in an d0 equation; 'bdv' is a meta-constant*)
   482 val d0_polyeq_simplify = prep_rls(
   483   Rls {id = "d0_polyeq_simplify", preconds = [],
   484        rew_ord = ("e_rew_ord",e_rew_ord),
   485        erls = PolyEq_erls,
   486        srls = Erls, 
   487        calc = [], 
   488        (*asm_thm = [],*)
   489        rules = [Thm("d0_true",num_str @{thm d0_true}),
   490 		Thm("d0_false",num_str @{thm  d0_false})
   491 		],
   492        scr = Script ((term_of o the o (parse thy)) "empty_script")
   493        }:rls);
   494 
   495 (* -- d1 -- *)
   496 (*isolate the bound variable in an d1 equation; 'bdv' is a meta-constant*)
   497 val d1_polyeq_simplify = prep_rls(
   498   Rls {id = "d1_polyeq_simplify", preconds = [],
   499        rew_ord = ("e_rew_ord",e_rew_ord),
   500        erls = PolyEq_erls,
   501        srls = Erls, 
   502        calc = [], 
   503        (*asm_thm = [("d1_isolate_div","")],*)
   504        rules = [
   505 		Thm("d1_isolate_add1",num_str @{thm d1_isolate_add1}), 
   506 		(* a+bx=0 -> bx=-a *)
   507 		Thm("d1_isolate_add2",num_str @{thm d1_isolate_add2}), 
   508 		(* a+ x=0 ->  x=-a *)
   509 		Thm("d1_isolate_div",num_str @{thm d1_isolate_div})    
   510 		(*   bx=c -> x=c/b *)  
   511 		],
   512        scr = Script ((term_of o the o (parse thy)) "empty_script")
   513        }:rls);
   514 
   515 (* -- d2 -- *)
   516 (* isolate the bound variable in an d2 equation with bdv only; 
   517    'bdv' is a meta-constant*)
   518 val d2_polyeq_bdv_only_simplify = prep_rls(
   519   Rls {id = "d2_polyeq_bdv_only_simplify", preconds = [],
   520        rew_ord = ("e_rew_ord",e_rew_ord),
   521        erls = PolyEq_erls,
   522        srls = Erls, 
   523        calc = [], 
   524        (*asm_thm = [("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg",""),
   525                   ("d2_isolate_div","")],*)
   526        rules = [Thm("d2_prescind1",num_str @{thm d2_prescind1}),
   527                 (*   ax+bx^2=0 -> x(a+bx)=0 *)
   528 		Thm("d2_prescind2",num_str @{thm d2_prescind2}),
   529                 (*   ax+ x^2=0 -> x(a+ x)=0 *)
   530 		Thm("d2_prescind3",num_str @{thm d2_prescind3}),
   531                 (*    x+bx^2=0 -> x(1+bx)=0 *)
   532 		Thm("d2_prescind4",num_str @{thm d2_prescind4}),
   533                 (*    x+ x^2=0 -> x(1+ x)=0 *)
   534 		Thm("d2_sqrt_equation1",num_str @{thm d2_sqrt_equation1}),
   535                 (* x^2=c   -> x=+-sqrt(c)*)
   536 		Thm("d2_sqrt_equation1_neg",num_str @{thm d2_sqrt_equation1_neg}),
   537                 (* [0<c] x^2=c  -> [] *)
   538 		Thm("d2_sqrt_equation2",num_str @{thm d2_sqrt_equation2}),
   539                 (*  x^2=0 ->    x=0    *)
   540 		Thm("d2_reduce_equation1",num_str @{thm d2_reduce_equation1}),
   541                 (* x(a+bx)=0 -> x=0 | a+bx=0*)
   542 		Thm("d2_reduce_equation2",num_str @{thm d2_reduce_equation2}),
   543                 (* x(a+ x)=0 -> x=0 | a+ x=0*)
   544 		Thm("d2_isolate_div",num_str @{thm d2_isolate_div})
   545                 (* bx^2=c -> x^2=c/b*)
   546 		],
   547        scr = Script ((term_of o the o (parse thy)) "empty_script")
   548        }:rls);
   549 
   550 (* isolate the bound variable in an d2 equation with sqrt only; 
   551    'bdv' is a meta-constant*)
   552 val d2_polyeq_sq_only_simplify = prep_rls(
   553   Rls {id = "d2_polyeq_sq_only_simplify", preconds = [],
   554        rew_ord = ("e_rew_ord",e_rew_ord),
   555        erls = PolyEq_erls,
   556        srls = Erls, 
   557        calc = [], 
   558        (*asm_thm = [("d2_sqrt_equation1",""),("d2_sqrt_equation1_neg",""),
   559                   ("d2_isolate_div","")],*)
   560        rules = [Thm("d2_isolate_add1",num_str @{thm d2_isolate_add1}),
   561                 (* a+   bx^2=0 -> bx^2=(-1)a*)
   562 		Thm("d2_isolate_add2",num_str @{thm d2_isolate_add2}),
   563                 (* a+    x^2=0 ->  x^2=(-1)a*)
   564 		Thm("d2_sqrt_equation2",num_str @{thm d2_sqrt_equation2}),
   565                 (*  x^2=0 ->    x=0    *)
   566 		Thm("d2_sqrt_equation1",num_str @{thm d2_sqrt_equation1}),
   567                 (* x^2=c   -> x=+-sqrt(c)*)
   568 		Thm("d2_sqrt_equation1_neg",num_str @{thm d2_sqrt_equation1_neg}),
   569                 (* [c<0] x^2=c  -> x=[] *)
   570 		Thm("d2_isolate_div",num_str @{thm d2_isolate_div})
   571                  (* bx^2=c -> x^2=c/b*)
   572 		],
   573        scr = Script ((term_of o the o (parse thy)) "empty_script")
   574        }:rls);
   575 
   576 (* isolate the bound variable in an d2 equation with pqFormula;
   577    'bdv' is a meta-constant*)
   578 val d2_polyeq_pqFormula_simplify = prep_rls(
   579   Rls {id = "d2_polyeq_pqFormula_simplify", preconds = [],
   580        rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
   581        srls = Erls, calc = [], 
   582        rules = [Thm("d2_pqformula1",num_str @{thm d2_pqformula1}),
   583                 (* q+px+ x^2=0 *)
   584 		Thm("d2_pqformula1_neg",num_str @{thm d2_pqformula1_neg}),
   585                 (* q+px+ x^2=0 *)
   586 		Thm("d2_pqformula2",num_str @{thm d2_pqformula2}), 
   587                 (* q+px+1x^2=0 *)
   588 		Thm("d2_pqformula2_neg",num_str @{thm d2_pqformula2_neg}),
   589                 (* q+px+1x^2=0 *)
   590 		Thm("d2_pqformula3",num_str @{thm d2_pqformula3}),
   591                 (* q+ x+ x^2=0 *)
   592 		Thm("d2_pqformula3_neg",num_str @{thm d2_pqformula3_neg}), 
   593                 (* q+ x+ x^2=0 *)
   594 		Thm("d2_pqformula4",num_str @{thm d2_pqformula4}),
   595                 (* q+ x+1x^2=0 *)
   596 		Thm("d2_pqformula4_neg",num_str @{thm d2_pqformula4_neg}),
   597                 (* q+ x+1x^2=0 *)
   598 		Thm("d2_pqformula5",num_str @{thm d2_pqformula5}),
   599                 (*   qx+ x^2=0 *)
   600 		Thm("d2_pqformula6",num_str @{thm d2_pqformula6}),
   601                 (*   qx+1x^2=0 *)
   602 		Thm("d2_pqformula7",num_str @{thm d2_pqformula7}),
   603                 (*    x+ x^2=0 *)
   604 		Thm("d2_pqformula8",num_str @{thm d2_pqformula8}),
   605                 (*    x+1x^2=0 *)
   606 		Thm("d2_pqformula9",num_str @{thm d2_pqformula9}),
   607                 (* q   +1x^2=0 *)
   608 		Thm("d2_pqformula9_neg",num_str @{thm d2_pqformula9_neg}),
   609                 (* q   +1x^2=0 *)
   610 		Thm("d2_pqformula10",num_str @{thm d2_pqformula10}),
   611                 (* q   + x^2=0 *)
   612 		Thm("d2_pqformula10_neg",num_str @{thm d2_pqformula10_neg}),
   613                 (* q   + x^2=0 *)
   614 		Thm("d2_sqrt_equation2",num_str @{thm d2_sqrt_equation2}),
   615                 (*       x^2=0 *)
   616 		Thm("d2_sqrt_equation3",num_str @{thm d2_sqrt_equation3})
   617                (*      1x^2=0 *)
   618 	       ],
   619        scr = Script ((term_of o the o (parse thy)) "empty_script")
   620        }:rls);
   621 
   622 (* isolate the bound variable in an d2 equation with abcFormula; 
   623    'bdv' is a meta-constant*)
   624 val d2_polyeq_abcFormula_simplify = prep_rls(
   625   Rls {id = "d2_polyeq_abcFormula_simplify", preconds = [],
   626        rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
   627        srls = Erls, calc = [], 
   628        rules = [Thm("d2_abcformula1",num_str @{thm d2_abcformula1}),
   629                 (*c+bx+cx^2=0 *)
   630 		Thm("d2_abcformula1_neg",num_str @{thm d2_abcformula1_neg}),
   631                 (*c+bx+cx^2=0 *)
   632 		Thm("d2_abcformula2",num_str @{thm d2_abcformula2}),
   633                 (*c+ x+cx^2=0 *)
   634 		Thm("d2_abcformula2_neg",num_str @{thm d2_abcformula2_neg}),
   635                 (*c+ x+cx^2=0 *)
   636 		Thm("d2_abcformula3",num_str @{thm d2_abcformula3}), 
   637                 (*c+bx+ x^2=0 *)
   638 		Thm("d2_abcformula3_neg",num_str @{thm d2_abcformula3_neg}),
   639                 (*c+bx+ x^2=0 *)
   640 		Thm("d2_abcformula4",num_str @{thm d2_abcformula4}),
   641                 (*c+ x+ x^2=0 *)
   642 		Thm("d2_abcformula4_neg",num_str @{thm d2_abcformula4_neg}),
   643                 (*c+ x+ x^2=0 *)
   644 		Thm("d2_abcformula5",num_str @{thm d2_abcformula5}),
   645                 (*c+   cx^2=0 *)
   646 		Thm("d2_abcformula5_neg",num_str @{thm d2_abcformula5_neg}),
   647                 (*c+   cx^2=0 *)
   648 		Thm("d2_abcformula6",num_str @{thm d2_abcformula6}),
   649                 (*c+    x^2=0 *)
   650 		Thm("d2_abcformula6_neg",num_str @{thm d2_abcformula6_neg}),
   651                 (*c+    x^2=0 *)
   652 		Thm("d2_abcformula7",num_str @{thm d2_abcformula7}),
   653                 (*  bx+ax^2=0 *)
   654 		Thm("d2_abcformula8",num_str @{thm d2_abcformula8}),
   655                 (*  bx+ x^2=0 *)
   656 		Thm("d2_abcformula9",num_str @{thm d2_abcformula9}),
   657                 (*   x+ax^2=0 *)
   658 		Thm("d2_abcformula10",num_str @{thm d2_abcformula10}),
   659                 (*   x+ x^2=0 *)
   660 		Thm("d2_sqrt_equation2",num_str @{thm d2_sqrt_equation2}),
   661                 (*      x^2=0 *)  
   662 		Thm("d2_sqrt_equation3",num_str @{thm d2_sqrt_equation3})
   663                (*     bx^2=0 *)  
   664 	       ],
   665        scr = Script ((term_of o the o (parse thy)) "empty_script")
   666        }:rls);
   667 
   668 (* isolate the bound variable in an d2 equation; 
   669    'bdv' is a meta-constant*)
   670 val d2_polyeq_simplify = prep_rls(
   671   Rls {id = "d2_polyeq_simplify", preconds = [],
   672        rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
   673        srls = Erls, calc = [], 
   674        rules = [Thm("d2_pqformula1",num_str @{thm d2_pqformula1}),
   675                 (* p+qx+ x^2=0 *)
   676 		Thm("d2_pqformula1_neg",num_str @{thm d2_pqformula1_neg}),
   677                 (* p+qx+ x^2=0 *)
   678 		Thm("d2_pqformula2",num_str @{thm d2_pqformula2}),
   679                 (* p+qx+1x^2=0 *)
   680 		Thm("d2_pqformula2_neg",num_str @{thm d2_pqformula2_neg}),
   681                 (* p+qx+1x^2=0 *)
   682 		Thm("d2_pqformula3",num_str @{thm d2_pqformula3}),
   683                 (* p+ x+ x^2=0 *)
   684 		Thm("d2_pqformula3_neg",num_str @{thm d2_pqformula3_neg}),
   685                 (* p+ x+ x^2=0 *)
   686 		Thm("d2_pqformula4",num_str @{thm d2_pqformula4}), 
   687                 (* p+ x+1x^2=0 *)
   688 		Thm("d2_pqformula4_neg",num_str @{thm d2_pqformula4_neg}),
   689                 (* p+ x+1x^2=0 *)
   690 		Thm("d2_abcformula1",num_str @{thm d2_abcformula1}),
   691                 (* c+bx+cx^2=0 *)
   692 		Thm("d2_abcformula1_neg",num_str @{thm d2_abcformula1_neg}),
   693                 (* c+bx+cx^2=0 *)
   694 		Thm("d2_abcformula2",num_str @{thm d2_abcformula2}),
   695                 (* c+ x+cx^2=0 *)
   696 		Thm("d2_abcformula2_neg",num_str @{thm d2_abcformula2_neg}),
   697                 (* c+ x+cx^2=0 *)
   698 		Thm("d2_prescind1",num_str @{thm d2_prescind1}),
   699                 (*   ax+bx^2=0 -> x(a+bx)=0 *)
   700 		Thm("d2_prescind2",num_str @{thm d2_prescind2}),
   701                 (*   ax+ x^2=0 -> x(a+ x)=0 *)
   702 		Thm("d2_prescind3",num_str @{thm d2_prescind3}),
   703                 (*    x+bx^2=0 -> x(1+bx)=0 *)
   704 		Thm("d2_prescind4",num_str @{thm d2_prescind4}),
   705                 (*    x+ x^2=0 -> x(1+ x)=0 *)
   706 		Thm("d2_isolate_add1",num_str @{thm d2_isolate_add1}),
   707                 (* a+   bx^2=0 -> bx^2=(-1)a*)
   708 		Thm("d2_isolate_add2",num_str @{thm d2_isolate_add2}),
   709                 (* a+    x^2=0 ->  x^2=(-1)a*)
   710 		Thm("d2_sqrt_equation1",num_str @{thm d2_sqrt_equation1}),
   711                 (* x^2=c   -> x=+-sqrt(c)*)
   712 		Thm("d2_sqrt_equation1_neg",num_str @{thm d2_sqrt_equation1_neg}),
   713                 (* [c<0] x^2=c   -> x=[]*)
   714 		Thm("d2_sqrt_equation2",num_str @{thm d2_sqrt_equation2}),
   715                 (*  x^2=0 ->    x=0    *)
   716 		Thm("d2_reduce_equation1",num_str @{thm d2_reduce_equation1}),
   717                 (* x(a+bx)=0 -> x=0 | a+bx=0*)
   718 		Thm("d2_reduce_equation2",num_str @{thm d2_reduce_equation2}),
   719                 (* x(a+ x)=0 -> x=0 | a+ x=0*)
   720 		Thm("d2_isolate_div",num_str @{thm d2_isolate_div})
   721                (* bx^2=c -> x^2=c/b*)
   722 	       ],
   723        scr = Script ((term_of o the o (parse thy)) "empty_script")
   724       }:rls);
   725 
   726 (* -- d3 -- *)
   727 (* isolate the bound variable in an d3 equation; 'bdv' is a meta-constant *)
   728 val d3_polyeq_simplify = prep_rls(
   729   Rls {id = "d3_polyeq_simplify", preconds = [],
   730        rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
   731        srls = Erls, calc = [], 
   732        rules = 
   733        [Thm("d3_reduce_equation1",num_str @{thm d3_reduce_equation1}),
   734 	(*a*bdv + b*bdv^^^2 + c*bdv^^^3=0) = 
   735         (bdv=0 | (a + b*bdv + c*bdv^^^2=0)*)
   736 	Thm("d3_reduce_equation2",num_str @{thm d3_reduce_equation2}),
   737 	(*  bdv + b*bdv^^^2 + c*bdv^^^3=0) = 
   738         (bdv=0 | (1 + b*bdv + c*bdv^^^2=0)*)
   739 	Thm("d3_reduce_equation3",num_str @{thm d3_reduce_equation3}),
   740 	(*a*bdv +   bdv^^^2 + c*bdv^^^3=0) = 
   741         (bdv=0 | (a +   bdv + c*bdv^^^2=0)*)
   742 	Thm("d3_reduce_equation4",num_str @{thm d3_reduce_equation4}),
   743 	(*  bdv +   bdv^^^2 + c*bdv^^^3=0) = 
   744         (bdv=0 | (1 +   bdv + c*bdv^^^2=0)*)
   745 	Thm("d3_reduce_equation5",num_str @{thm d3_reduce_equation5}),
   746 	(*a*bdv + b*bdv^^^2 +   bdv^^^3=0) = 
   747         (bdv=0 | (a + b*bdv +   bdv^^^2=0)*)
   748 	Thm("d3_reduce_equation6",num_str @{thm d3_reduce_equation6}),
   749 	(*  bdv + b*bdv^^^2 +   bdv^^^3=0) = 
   750         (bdv=0 | (1 + b*bdv +   bdv^^^2=0)*)
   751 	Thm("d3_reduce_equation7",num_str @{thm d3_reduce_equation7}),
   752 	     (*a*bdv +   bdv^^^2 +   bdv^^^3=0) = 
   753              (bdv=0 | (1 +   bdv +   bdv^^^2=0)*)
   754 	Thm("d3_reduce_equation8",num_str @{thm d3_reduce_equation8}),
   755 	     (*  bdv +   bdv^^^2 +   bdv^^^3=0) = 
   756              (bdv=0 | (1 +   bdv +   bdv^^^2=0)*)
   757 	Thm("d3_reduce_equation9",num_str @{thm d3_reduce_equation9}),
   758 	     (*a*bdv             + c*bdv^^^3=0) = 
   759              (bdv=0 | (a         + c*bdv^^^2=0)*)
   760 	Thm("d3_reduce_equation10",num_str @{thm d3_reduce_equation10}),
   761 	     (*  bdv             + c*bdv^^^3=0) = 
   762              (bdv=0 | (1         + c*bdv^^^2=0)*)
   763 	Thm("d3_reduce_equation11",num_str @{thm d3_reduce_equation11}),
   764 	     (*a*bdv             +   bdv^^^3=0) = 
   765              (bdv=0 | (a         +   bdv^^^2=0)*)
   766 	Thm("d3_reduce_equation12",num_str @{thm d3_reduce_equation12}),
   767 	     (*  bdv             +   bdv^^^3=0) = 
   768              (bdv=0 | (1         +   bdv^^^2=0)*)
   769 	Thm("d3_reduce_equation13",num_str @{thm d3_reduce_equation13}),
   770 	     (*        b*bdv^^^2 + c*bdv^^^3=0) = 
   771              (bdv=0 | (    b*bdv + c*bdv^^^2=0)*)
   772 	Thm("d3_reduce_equation14",num_str @{thm d3_reduce_equation14}),
   773 	     (*          bdv^^^2 + c*bdv^^^3=0) = 
   774              (bdv=0 | (      bdv + c*bdv^^^2=0)*)
   775 	Thm("d3_reduce_equation15",num_str @{thm d3_reduce_equation15}),
   776 	     (*        b*bdv^^^2 +   bdv^^^3=0) = 
   777              (bdv=0 | (    b*bdv +   bdv^^^2=0)*)
   778 	Thm("d3_reduce_equation16",num_str @{thm d3_reduce_equation16}),
   779 	     (*          bdv^^^2 +   bdv^^^3=0) = 
   780              (bdv=0 | (      bdv +   bdv^^^2=0)*)
   781 	Thm("d3_isolate_add1",num_str @{thm d3_isolate_add1}),
   782 	     (*[|Not(bdv occurs_in a)|] ==> (a + b*bdv^^^3=0) = 
   783               (bdv=0 | (b*bdv^^^3=a)*)
   784 	Thm("d3_isolate_add2",num_str @{thm d3_isolate_add2}),
   785              (*[|Not(bdv occurs_in a)|] ==> (a +   bdv^^^3=0) = 
   786               (bdv=0 | (  bdv^^^3=a)*)
   787 	Thm("d3_isolate_div",num_str @{thm d3_isolate_div}),
   788         (*[|Not(b=0)|] ==> (b*bdv^^^3=c) = (bdv^^^3=c/b*)
   789         Thm("d3_root_equation2",num_str @{thm d3_root_equation2}),
   790         (*(bdv^^^3=0) = (bdv=0) *)
   791 	Thm("d3_root_equation1",num_str @{thm d3_root_equation1})
   792        (*bdv^^^3=c) = (bdv = nroot 3 c*)
   793        ],
   794        scr = Script ((term_of o the o (parse thy)) "empty_script")
   795       }:rls);
   796 
   797 (* -- d4 -- *)
   798 (*isolate the bound variable in an d4 equation; 'bdv' is a meta-constant*)
   799 val d4_polyeq_simplify = prep_rls(
   800   Rls {id = "d4_polyeq_simplify", preconds = [],
   801        rew_ord = ("e_rew_ord",e_rew_ord), erls = PolyEq_erls,
   802        srls = Erls, calc = [], 
   803        rules = 
   804        [Thm("d4_sub_u1",num_str @{thm d4_sub_u1)  
   805        (* ax^4+bx^2+c=0 -> x=+-sqrt(ax^2+bx^+c) *)
   806        ],
   807        scr = Script ((term_of o the o (parse thy)) "empty_script")
   808       }:rls);
   809   
   810 ruleset' := 
   811 overwritelthy @{theory} 
   812               (!ruleset',
   813                [("d0_polyeq_simplify", d0_polyeq_simplify),
   814                 ("d1_polyeq_simplify", d1_polyeq_simplify),
   815                 ("d2_polyeq_simplify", d2_polyeq_simplify),
   816                 ("d2_polyeq_bdv_only_simplify", d2_polyeq_bdv_only_simplify),
   817                 ("d2_polyeq_sq_only_simplify", d2_polyeq_sq_only_simplify),
   818                 ("d2_polyeq_pqFormula_simplify", d2_polyeq_pqFormula_simplify),
   819                 ("d2_polyeq_abcFormula_simplify", 
   820                  d2_polyeq_abcFormula_simplify),
   821                 ("d3_polyeq_simplify", d3_polyeq_simplify),
   822 		("d4_polyeq_simplify", d4_polyeq_simplify)
   823 	      ]);
   824     
   825 (*------------------------problems------------------------*)
   826 (*
   827 (get_pbt ["degree_2","polynomial","univariate","equation"]);
   828 show_ptyps(); 
   829 *)
   830 
   831 (*-------------------------poly-----------------------*)
   832 store_pbt
   833  (prep_pbt thy "pbl_equ_univ_poly" [] e_pblID
   834  (["polynomial","univariate","equation"],
   835   [("#Given" ,["equality e_e","solveFor v_v"]),
   836    ("#Where" ,["~((e_e::bool) is_ratequation_in (v_v::real))",
   837 	       "~((lhs e_e) is_rootTerm_in (v_v::real))",
   838 	       "~((rhs e_e) is_rootTerm_in (v_v::real))"]),
   839    ("#Find"  ,["solutions v_i"])
   840    ],
   841   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   842   []));
   843 (*--- d0 ---*)
   844 store_pbt
   845  (prep_pbt thy "pbl_equ_univ_poly_deg0" [] e_pblID
   846  (["degree_0","polynomial","univariate","equation"],
   847   [("#Given" ,["equality e_e","solveFor v_v"]),
   848    ("#Where" ,["matches (?a = 0) e_e",
   849 	       "(lhs e_e) is_poly_in v_v",
   850 	       "((lhs e_e) has_degree_in v_v ) = 0"
   851 	      ]),
   852    ("#Find"  ,["solutions v_i"])
   853   ],
   854   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   855   [["PolyEq","solve_d0_polyeq_equation"]]));
   856 
   857 (*--- d1 ---*)
   858 store_pbt
   859  (prep_pbt thy "pbl_equ_univ_poly_deg1" [] e_pblID
   860  (["degree_1","polynomial","univariate","equation"],
   861   [("#Given" ,["equality e_e","solveFor v_v"]),
   862    ("#Where" ,["matches (?a = 0) e_e",
   863 	       "(lhs e_e) is_poly_in v_v",
   864 	       "((lhs e_e) has_degree_in v_v ) = 1"
   865 	      ]),
   866    ("#Find"  ,["solutions v_i"])
   867   ],
   868   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   869   [["PolyEq","solve_d1_polyeq_equation"]]));
   870 
   871 (*--- d2 ---*)
   872 store_pbt
   873  (prep_pbt thy "pbl_equ_univ_poly_deg2" [] e_pblID
   874  (["degree_2","polynomial","univariate","equation"],
   875   [("#Given" ,["equality e_e","solveFor v_v"]),
   876    ("#Where" ,["matches (?a = 0) e_e",
   877 	       "(lhs e_e) is_poly_in v_v ",
   878 	       "((lhs e_e) has_degree_in v_v ) = 2"]),
   879    ("#Find"  ,["solutions v_i"])
   880   ],
   881   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   882   [["PolyEq","solve_d2_polyeq_equation"]]));
   883 
   884  store_pbt
   885  (prep_pbt thy "pbl_equ_univ_poly_deg2_sqonly" [] e_pblID
   886  (["sq_only","degree_2","polynomial","univariate","equation"],
   887   [("#Given" ,["equality e_e","solveFor v_v"]),
   888    ("#Where" ,["matches ( ?a +    ?v_^^^2 = 0) e_e | " ^
   889 	       "matches ( ?a + ?b*?v_^^^2 = 0) e_e | " ^
   890 	       "matches (         ?v_^^^2 = 0) e_e | " ^
   891 	       "matches (      ?b*?v_^^^2 = 0) e_e" ,
   892 	       "Not (matches (?a +    ?v_ +    ?v_^^^2 = 0) e_e) &" ^
   893 	       "Not (matches (?a + ?b*?v_ +    ?v_^^^2 = 0) e_e) &" ^
   894 	       "Not (matches (?a +    ?v_ + ?c*?v_^^^2 = 0) e_e) &" ^
   895 	       "Not (matches (?a + ?b*?v_ + ?c*?v_^^^2 = 0) e_e) &" ^
   896 	       "Not (matches (        ?v_ +    ?v_^^^2 = 0) e_e) &" ^
   897 	       "Not (matches (     ?b*?v_ +    ?v_^^^2 = 0) e_e) &" ^
   898 	       "Not (matches (        ?v_ + ?c*?v_^^^2 = 0) e_e) &" ^
   899 	       "Not (matches (     ?b*?v_ + ?c*?v_^^^2 = 0) e_e)"]),
   900    ("#Find"  ,["solutions v_i"])
   901   ],
   902   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   903   [["PolyEq","solve_d2_polyeq_sqonly_equation"]]));
   904 
   905 store_pbt
   906  (prep_pbt thy "pbl_equ_univ_poly_deg2_bdvonly" [] e_pblID
   907  (["bdv_only","degree_2","polynomial","univariate","equation"],
   908   [("#Given" ,["equality e_e","solveFor v_v"]),
   909    ("#Where" ,["matches (?a*?v_ +    ?v_^^^2 = 0) e_e | " ^
   910 	       "matches (   ?v_ +    ?v_^^^2 = 0) e_e | " ^
   911 	       "matches (   ?v_ + ?b*?v_^^^2 = 0) e_e | " ^
   912 	       "matches (?a*?v_ + ?b*?v_^^^2 = 0) e_e | " ^
   913 	       "matches (            ?v_^^^2 = 0) e_e | " ^
   914 	       "matches (         ?b*?v_^^^2 = 0) e_e "]),
   915    ("#Find"  ,["solutions v_i"])
   916   ],
   917   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   918   [["PolyEq","solve_d2_polyeq_bdvonly_equation"]]));
   919 
   920 store_pbt
   921  (prep_pbt thy "pbl_equ_univ_poly_deg2_pq" [] e_pblID
   922  (["pqFormula","degree_2","polynomial","univariate","equation"],
   923   [("#Given" ,["equality e_e","solveFor v_v"]),
   924    ("#Where" ,["matches (?a + 1*?v_^^^2 = 0) e_e | " ^
   925 	       "matches (?a +   ?v_^^^2 = 0) e_e"]),
   926    ("#Find"  ,["solutions v_i"])
   927   ],
   928   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   929   [["PolyEq","solve_d2_polyeq_pq_equation"]]));
   930 
   931 store_pbt
   932  (prep_pbt thy "pbl_equ_univ_poly_deg2_abc" [] e_pblID
   933  (["abcFormula","degree_2","polynomial","univariate","equation"],
   934   [("#Given" ,["equality e_e","solveFor v_v"]),
   935    ("#Where" ,["matches (?a +    ?v_^^^2 = 0) e_e | " ^
   936 	       "matches (?a + ?b*?v_^^^2 = 0) e_e"]),
   937    ("#Find"  ,["solutions v_i"])
   938   ],
   939   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   940   [["PolyEq","solve_d2_polyeq_abc_equation"]]));
   941 
   942 (*--- d3 ---*)
   943 store_pbt
   944  (prep_pbt thy "pbl_equ_univ_poly_deg3" [] e_pblID
   945  (["degree_3","polynomial","univariate","equation"],
   946   [("#Given" ,["equality e_e","solveFor v_v"]),
   947    ("#Where" ,["matches (?a = 0) e_e",
   948 	       "(lhs e_e) is_poly_in v_v ",
   949 	       "((lhs e_e) has_degree_in v_v) = 3"]),
   950    ("#Find"  ,["solutions v_i"])
   951   ],
   952   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   953   [["PolyEq","solve_d3_polyeq_equation"]]));
   954 
   955 (*--- d4 ---*)
   956 store_pbt
   957  (prep_pbt thy "pbl_equ_univ_poly_deg4" [] e_pblID
   958  (["degree_4","polynomial","univariate","equation"],
   959   [("#Given" ,["equality e_e","solveFor v_v"]),
   960    ("#Where" ,["matches (?a = 0) e_e",
   961 	       "(lhs e_e) is_poly_in v_v ",
   962 	       "((lhs e_e) has_degree_in v_v) = 4"]),
   963    ("#Find"  ,["solutions v_i"])
   964   ],
   965   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   966   [(*["PolyEq","solve_d4_polyeq_equation"]*)]));
   967 
   968 (*--- normalize ---*)
   969 store_pbt
   970  (prep_pbt thy "pbl_equ_univ_poly_norm" [] e_pblID
   971  (["normalize","polynomial","univariate","equation"],
   972   [("#Given" ,["equality e_e","solveFor v_v"]),
   973    ("#Where" ,["(Not((matches (?a = 0 ) e_e ))) |" ^
   974 	       "(Not(((lhs e_e) is_poly_in v_v)))"]),
   975    ("#Find"  ,["solutions v_i"])
   976   ],
   977   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   978   [["PolyEq","normalize_poly"]]));
   979 (*-------------------------expanded-----------------------*)
   980 store_pbt
   981  (prep_pbt thy "pbl_equ_univ_expand" [] e_pblID
   982  (["expanded","univariate","equation"],
   983   [("#Given" ,["equality e_e","solveFor v_v"]),
   984    ("#Where" ,["matches (?a = 0) e_e",
   985 	       "(lhs e_e) is_expanded_in v_v "]),
   986    ("#Find"  ,["solutions v_i"])
   987    ],
   988   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
   989   []));
   990 
   991 (*--- d2 ---*)
   992 store_pbt
   993  (prep_pbt thy "pbl_equ_univ_expand_deg2" [] e_pblID
   994  (["degree_2","expanded","univariate","equation"],
   995   [("#Given" ,["equality e_e","solveFor v_v"]),
   996    ("#Where" ,["((lhs e_e) has_degree_in v_v) = 2"]),
   997    ("#Find"  ,["solutions v_i"])
   998   ],
   999   PolyEq_prls, SOME "solve (e_e::bool, v_v)",
  1000   [["PolyEq","complete_square"]]));
  1001 
  1002 
  1003 "-------------------------methods-----------------------";
  1004 store_met
  1005  (prep_met thy "met_polyeq" [] e_metID
  1006  (["PolyEq"],
  1007    [],
  1008    {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
  1009     crls=PolyEq_crls, nrls=norm_Rational}, "empty_script"));
  1010 
  1011 store_met
  1012  (prep_met thy "met_polyeq_norm" [] e_metID
  1013  (["PolyEq","normalize_poly"],
  1014    [("#Given" ,["equality e_e","solveFor v_v"]),
  1015    ("#Where" ,["(Not((matches (?a = 0 ) e_e ))) |" ^
  1016 	       "(Not(((lhs e_e) is_poly_in v_v)))"]),
  1017    ("#Find"  ,["solutions v_i"])
  1018   ],
  1019    {rew_ord'="termlessI",
  1020     rls'=PolyEq_erls,
  1021     srls=e_rls,
  1022     prls=PolyEq_prls,
  1023     calc=[],
  1024     crls=PolyEq_crls, nrls=norm_Rational
  1025     "Script Normalize_poly (e_e::bool) (v_v::real) =                     " ^
  1026     "(let e_e =((Try         (Rewrite     all_left          False)) @@  " ^ 
  1027     "          (Try (Repeat (Rewrite     makex1_x         False))) @@  " ^ 
  1028     "          (Try (Repeat (Rewrite_Set expand_binoms    False))) @@  " ^ 
  1029     "          (Try (Repeat (Rewrite_Set_Inst [(bdv,v_::real)]         " ^
  1030     "                                 make_ratpoly_in     False))) @@  " ^
  1031     "          (Try (Repeat (Rewrite_Set polyeq_simplify  False)))) e_e " ^
  1032     " in (SubProblem (PolyEq_,[polynomial,univariate,equation],        " ^
  1033     "                [no_met]) [bool_ e_e, real_ v_]))"
  1034    ));
  1035 
  1036 store_met
  1037  (prep_met thy "met_polyeq_d0" [] e_metID
  1038  (["PolyEq","solve_d0_polyeq_equation"],
  1039    [("#Given" ,["equality e_e","solveFor v_v"]),
  1040    ("#Where" ,["(lhs e_e) is_poly_in v_v ",
  1041 	       "((lhs e_e) has_degree_in v_v) = 0"]),
  1042    ("#Find"  ,["solutions v_i"])
  1043   ],
  1044    {rew_ord'="termlessI",
  1045     rls'=PolyEq_erls,
  1046     srls=e_rls,
  1047     prls=PolyEq_prls,
  1048     calc=[("sqrt", ("NthRoot.sqrt", eval_sqrt "#sqrt_"))],
  1049     crls=PolyEq_crls, nrls=norm_Rational},
  1050    "Script Solve_d0_polyeq_equation  (e_e::bool) (v_v::real)  = " ^
  1051     "(let e_e =  ((Try (Rewrite_Set_Inst [(bdv,v_::real)]      " ^
  1052     "                  d0_polyeq_simplify  False))) e_e        " ^
  1053     " in ((Or_to_List e_e)::bool list))"
  1054  ));
  1055 
  1056 store_met
  1057  (prep_met thy "met_polyeq_d1" [] e_metID
  1058  (["PolyEq","solve_d1_polyeq_equation"],
  1059    [("#Given" ,["equality e_e","solveFor v_v"]),
  1060    ("#Where" ,["(lhs e_e) is_poly_in v_v ",
  1061 	       "((lhs e_e) has_degree_in v_v) = 1"]),
  1062    ("#Find"  ,["solutions v_i"])
  1063   ],
  1064    {rew_ord'="termlessI",
  1065     rls'=PolyEq_erls,
  1066     srls=e_rls,
  1067     prls=PolyEq_prls,
  1068     calc=[("sqrt", ("NthRoot.sqrt", eval_sqrt "#sqrt_"))],
  1069     crls=PolyEq_crls, nrls=norm_Rational(*,
  1070     (*    asm_rls=["d1_polyeq_simplify"],*)
  1071     asm_rls=[],
  1072     asm_thm=[("d1_isolate_div","")]*)},
  1073    "Script Solve_d1_polyeq_equation  (e_e::bool) (v_v::real)  =   " ^
  1074     "(let e_e =  ((Try (Rewrite_Set_Inst [(bdv,v_::real)]        " ^
  1075     "                  d1_polyeq_simplify   True))          @@  " ^
  1076     "            (Try (Rewrite_Set polyeq_simplify  False)) @@  " ^
  1077     "            (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
  1078     " (L_::bool list) = ((Or_to_List e_e)::bool list)            " ^
  1079     " in Check_elementwise L_ {(v_v::real). Assumptions} )"
  1080  ));
  1081 
  1082 store_met
  1083  (prep_met thy "met_polyeq_d22" [] e_metID
  1084  (["PolyEq","solve_d2_polyeq_equation"],
  1085    [("#Given" ,["equality e_e","solveFor v_v"]),
  1086    ("#Where" ,["(lhs e_e) is_poly_in v_v ",
  1087 	       "((lhs e_e) has_degree_in v_v) = 2"]),
  1088    ("#Find"  ,["solutions v_i"])
  1089   ],
  1090    {rew_ord'="termlessI",
  1091     rls'=PolyEq_erls,
  1092     srls=e_rls,
  1093     prls=PolyEq_prls,
  1094     calc=[("sqrt", ("NthRoot.sqrt", eval_sqrt "#sqrt_"))],
  1095     crls=PolyEq_crls, nrls=norm_Rational},
  1096    "Script Solve_d2_polyeq_equation  (e_e::bool) (v_v::real) =      " ^
  1097     "  (let e_e = ((Try (Rewrite_Set_Inst [(bdv,v_::real)]         " ^
  1098     "                    d2_polyeq_simplify           True)) @@   " ^
  1099     "             (Try (Rewrite_Set polyeq_simplify   False)) @@  " ^
  1100     "             (Try (Rewrite_Set_Inst [(bdv,v_::real)]         " ^
  1101     "                    d1_polyeq_simplify            True)) @@  " ^
  1102     "            (Try (Rewrite_Set polyeq_simplify    False)) @@  " ^
  1103     "            (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
  1104     " (L_::bool list) = ((Or_to_List e_e)::bool list)              " ^
  1105     " in Check_elementwise L_ {(v_v::real). Assumptions} )"
  1106  ));
  1107 
  1108 store_met
  1109  (prep_met thy "met_polyeq_d2_bdvonly" [] e_metID
  1110  (["PolyEq","solve_d2_polyeq_bdvonly_equation"],
  1111    [("#Given" ,["equality e_e","solveFor v_v"]),
  1112    ("#Where" ,["(lhs e_e) is_poly_in v_v ",
  1113 	       "((lhs e_e) has_degree_in v_v) = 2"]),
  1114    ("#Find"  ,["solutions v_i"])
  1115   ],
  1116    {rew_ord'="termlessI",
  1117     rls'=PolyEq_erls,
  1118     srls=e_rls,
  1119     prls=PolyEq_prls,
  1120     calc=[("sqrt", ("NthRoot.sqrt", eval_sqrt "#sqrt_"))],
  1121     crls=PolyEq_crls, nrls=norm_Rational},
  1122    "Script Solve_d2_polyeq_bdvonly_equation  (e_e::bool) (v_v::real) =" ^
  1123     "  (let e_e = ((Try (Rewrite_Set_Inst [(bdv,v_::real)]         " ^
  1124     "                   d2_polyeq_bdv_only_simplify    True)) @@  " ^
  1125     "             (Try (Rewrite_Set polyeq_simplify   False)) @@  " ^
  1126     "             (Try (Rewrite_Set_Inst [(bdv,v_::real)]         " ^
  1127     "                   d1_polyeq_simplify             True)) @@  " ^
  1128     "            (Try (Rewrite_Set polyeq_simplify    False)) @@  " ^
  1129     "            (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
  1130     " (L_::bool list) = ((Or_to_List e_e)::bool list)              " ^
  1131     " in Check_elementwise L_ {(v_v::real). Assumptions} )"
  1132  ));
  1133 
  1134 store_met
  1135  (prep_met thy "met_polyeq_d2_sqonly" [] e_metID
  1136  (["PolyEq","solve_d2_polyeq_sqonly_equation"],
  1137    [("#Given" ,["equality e_e","solveFor v_v"]),
  1138    ("#Where" ,["(lhs e_e) is_poly_in v_v ",
  1139 	       "((lhs e_e) has_degree_in v_v) = 2"]),
  1140    ("#Find"  ,["solutions v_i"])
  1141   ],
  1142    {rew_ord'="termlessI",
  1143     rls'=PolyEq_erls,
  1144     srls=e_rls,
  1145     prls=PolyEq_prls,
  1146     calc=[("sqrt", ("NthRoot.sqrt", eval_sqrt "#sqrt_"))],
  1147     crls=PolyEq_crls, nrls=norm_Rational},
  1148    "Script Solve_d2_polyeq_sqonly_equation  (e_e::bool) (v_v::real) =" ^
  1149     "  (let e_e = ((Try (Rewrite_Set_Inst [(bdv,v_::real)]          " ^
  1150     "                   d2_polyeq_sq_only_simplify     True)) @@   " ^
  1151     "            (Try (Rewrite_Set polyeq_simplify    False)) @@   " ^
  1152     "            (Try (Rewrite_Set norm_Rational_parenthesized False))) e_; " ^
  1153     " (L_::bool list) = ((Or_to_List e_e)::bool list)               " ^
  1154     " in Check_elementwise L_ {(v_v::real). Assumptions} )"
  1155  ));
  1156 
  1157 store_met
  1158  (prep_met thy "met_polyeq_d2_pq" [] e_metID
  1159  (["PolyEq","solve_d2_polyeq_pq_equation"],
  1160    [("#Given" ,["equality e_e","solveFor v_v"]),
  1161    ("#Where" ,["(lhs e_e) is_poly_in v_v ",
  1162 	       "((lhs e_e) has_degree_in v_v) = 2"]),
  1163    ("#Find"  ,["solutions v_i"])
  1164   ],
  1165    {rew_ord'="termlessI",
  1166     rls'=PolyEq_erls,
  1167     srls=e_rls,
  1168     prls=PolyEq_prls,
  1169     calc=[("sqrt", ("NthRoot.sqrt", eval_sqrt "#sqrt_"))],
  1170     crls=PolyEq_crls, nrls=norm_Rational},
  1171    "Script Solve_d2_polyeq_pq_equation  (e_e::bool) (v_v::real) =   " ^
  1172     "  (let e_e = ((Try (Rewrite_Set_Inst [(bdv,v_::real)]         " ^
  1173     "                   d2_polyeq_pqFormula_simplify   True)) @@  " ^
  1174     "            (Try (Rewrite_Set polyeq_simplify    False)) @@  " ^
  1175     "            (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
  1176     " (L_::bool list) = ((Or_to_List e_e)::bool list)              " ^
  1177     " in Check_elementwise L_ {(v_v::real). Assumptions} )"
  1178  ));
  1179 
  1180 store_met
  1181  (prep_met thy "met_polyeq_d2_abc" [] e_metID
  1182  (["PolyEq","solve_d2_polyeq_abc_equation"],
  1183    [("#Given" ,["equality e_e","solveFor v_v"]),
  1184    ("#Where" ,["(lhs e_e) is_poly_in v_v ",
  1185 	       "((lhs e_e) has_degree_in v_v) = 2"]),
  1186    ("#Find"  ,["solutions v_i"])
  1187   ],
  1188    {rew_ord'="termlessI",
  1189     rls'=PolyEq_erls,
  1190     srls=e_rls,
  1191     prls=PolyEq_prls,
  1192     calc=[("sqrt", ("NthRoot.sqrt", eval_sqrt "#sqrt_"))],
  1193     crls=PolyEq_crls, nrls=norm_Rational},
  1194    "Script Solve_d2_polyeq_abc_equation  (e_e::bool) (v_v::real) =   " ^
  1195     "  (let e_e = ((Try (Rewrite_Set_Inst [(bdv,v_::real)]          " ^
  1196     "                   d2_polyeq_abcFormula_simplify   True)) @@  " ^
  1197     "            (Try (Rewrite_Set polyeq_simplify     False)) @@  " ^
  1198     "            (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
  1199     " (L_::bool list) = ((Or_to_List e_e)::bool list)               " ^
  1200     " in Check_elementwise L_ {(v_v::real). Assumptions} )"
  1201  ));
  1202 
  1203 store_met
  1204  (prep_met thy "met_polyeq_d3" [] e_metID
  1205  (["PolyEq","solve_d3_polyeq_equation"],
  1206    [("#Given" ,["equality e_e","solveFor v_v"]),
  1207    ("#Where" ,["(lhs e_e) is_poly_in v_v ",
  1208 	       "((lhs e_e) has_degree_in v_v) = 3"]),
  1209    ("#Find"  ,["solutions v_i"])
  1210   ],
  1211    {rew_ord'="termlessI",
  1212     rls'=PolyEq_erls,
  1213     srls=e_rls,
  1214     prls=PolyEq_prls,
  1215     calc=[("sqrt", ("NthRoot.sqrt", eval_sqrt "#sqrt_"))],
  1216     crls=PolyEq_crls, nrls=norm_Rational},
  1217    "Script Solve_d3_polyeq_equation  (e_e::bool) (v_v::real) =     " ^
  1218     "  (let e_e = ((Try (Rewrite_Set_Inst [(bdv,v_::real)]        " ^
  1219     "                    d3_polyeq_simplify           True)) @@  " ^
  1220     "             (Try (Rewrite_Set polyeq_simplify  False)) @@  " ^
  1221     "             (Try (Rewrite_Set_Inst [(bdv,v_::real)]        " ^
  1222     "                    d2_polyeq_simplify           True)) @@  " ^
  1223     "             (Try (Rewrite_Set polyeq_simplify  False)) @@  " ^
  1224     "             (Try (Rewrite_Set_Inst [(bdv,v_::real)]        " ^   
  1225     "                    d1_polyeq_simplify           True)) @@  " ^
  1226     "             (Try (Rewrite_Set polyeq_simplify  False)) @@  " ^
  1227     "             (Try (Rewrite_Set norm_Rational_parenthesized False))) e_;" ^
  1228     " (L_::bool list) = ((Or_to_List e_e)::bool list)             " ^
  1229     " in Check_elementwise L_ {(v_v::real). Assumptions} )"
  1230    ));
  1231 
  1232  (*.solves all expanded (ie. normalized) terms of degree 2.*) 
  1233  (*Oct.02 restriction: 'eval_true 0 =< discriminant' ony for integer values
  1234    by 'PolyEq_erls'; restricted until Float.thy is implemented*)
  1235 store_met
  1236  (prep_met thy "met_polyeq_complsq" [] e_metID
  1237  (["PolyEq","complete_square"],
  1238    [("#Given" ,["equality e_e","solveFor v_v"]),
  1239    ("#Where" ,["matches (?a = 0) e_e", 
  1240 	       "((lhs e_e) has_degree_in v_v) = 2"]),
  1241    ("#Find"  ,["solutions v_i"])
  1242   ],
  1243    {rew_ord'="termlessI",rls'=PolyEq_erls,srls=e_rls,prls=PolyEq_prls,
  1244     calc=[("sqrt", ("NthRoot.sqrt", eval_sqrt "#sqrt_"))],
  1245     crls=PolyEq_crls, nrls=norm_Rational},
  1246    "Script Complete_square (e_e::bool) (v_v::real) =                          " ^
  1247    "(let e_e = ((Try (Rewrite_Set_Inst [(bdv,v_)] cancel_leading_coeff True))" ^
  1248    "        @@ (Try (Rewrite_Set_Inst [(bdv,v_)] complete_square True))     " ^
  1249    "        @@ (Try (Rewrite square_explicit1 False))                       " ^
  1250    "        @@ (Try (Rewrite square_explicit2 False))                       " ^
  1251    "        @@ (Rewrite root_plus_minus True)                               " ^
  1252    "        @@ (Try (Repeat (Rewrite_Inst [(bdv,v_)] bdv_explicit1 False))) " ^
  1253    "        @@ (Try (Repeat (Rewrite_Inst [(bdv,v_)] bdv_explicit2 False))) " ^
  1254    "        @@ (Try (Repeat                                                 " ^
  1255    "                  (Rewrite_Inst [(bdv,v_)] bdv_explicit3 False)))       " ^
  1256    "        @@ (Try (Rewrite_Set calculate_RootRat False))                  " ^
  1257    "        @@ (Try (Repeat (Calculate SQRT)))) e_e                         " ^
  1258    " in ((Or_to_List e_e)::bool list))"
  1259    ));
  1260 
  1261 
  1262 (* termorder hacked by MG *)
  1263 local (*. for make_polynomial_in .*)
  1264 
  1265 open Term;  (* for type order = EQUAL | LESS | GREATER *)
  1266 
  1267 fun pr_ord EQUAL = "EQUAL"
  1268   | pr_ord LESS  = "LESS"
  1269   | pr_ord GREATER = "GREATER";
  1270 
  1271 fun dest_hd' x (Const (a, T)) = (((a, 0), T), 0)
  1272   | dest_hd' x (t as Free (a, T)) =
  1273     if x = t then ((("|||||||||||||", 0), T), 0)                        (*WN*)
  1274     else (((a, 0), T), 1)
  1275   | dest_hd' x (Var v) = (v, 2)
  1276   | dest_hd' x (Bound i) = ((("", i), dummyT), 3)
  1277   | dest_hd' x (Abs (_, T, _)) = ((("", 0), T), 4);
  1278 
  1279 fun size_of_term' x (Const ("Atools.pow",_) $ Free (var,_) $ Free (pot,_)) =
  1280     (case x of                                                          (*WN*)
  1281 	    (Free (xstr,_)) => 
  1282 		(if xstr = var then 1000*(the (int_of_str pot)) else 3)
  1283 	  | _ => raise error ("size_of_term' called with subst = "^
  1284 			      (term2str x)))
  1285   | size_of_term' x (Free (subst,_)) =
  1286     (case x of
  1287 	    (Free (xstr,_)) => (if xstr = subst then 1000 else 1)
  1288 	  | _ => raise error ("size_of_term' called with subst = "^
  1289 			  (term2str x)))
  1290   | size_of_term' x (Abs (_,_,body)) = 1 + size_of_term' x body
  1291   | size_of_term' x (f$t) = size_of_term' x f  +  size_of_term' x t
  1292   | size_of_term' x _ = 1;
  1293 
  1294 
  1295 fun Term_Ord.term_ord' x pr thy (Abs (_, T, t), Abs(_, U, u)) =       (* ~ term.ML *)
  1296       (case Term_Ord.term_ord' x pr thy (t, u) of EQUAL => Term_Ord.typ_ord (T, U) | ord => ord)
  1297   | Term_Ord.term_ord' x pr thy (t, u) =
  1298       (if pr then 
  1299 	 let
  1300 	   val (f, ts) = strip_comb t and (g, us) = strip_comb u;
  1301 	   val _=writeln("t= f@ts= \""^
  1302 	      ((Syntax.string_of_term (thy2ctxt thy)) f)^"\" @ \"["^
  1303 	      (commas(map(string_of_cterm o cterm_of(sign_of thy)) ts))^"]\"");
  1304 	   val _=writeln("u= g@us= \""^
  1305 	      ((Syntax.string_of_term (thy2ctxt thy)) g)^"\" @ \"["^
  1306 	      (commas(map(string_of_cterm o cterm_of(sign_of thy)) us))^"]\"");
  1307 	   val _=writeln("size_of_term(t,u)= ("^
  1308 	      (string_of_int(size_of_term' x t))^", "^
  1309 	      (string_of_int(size_of_term' x u))^")");
  1310 	   val _=writeln("hd_ord(f,g)      = "^((pr_ord o (hd_ord x))(f,g)));
  1311 	   val _=writeln("terms_ord(ts,us) = "^
  1312 			   ((pr_ord o (terms_ord x) str false)(ts,us)));
  1313 	   val _=writeln("-------");
  1314 	 in () end
  1315        else ();
  1316 	 case int_ord (size_of_term' x t, size_of_term' x u) of
  1317 	   EQUAL =>
  1318 	     let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
  1319 	       (case hd_ord x (f, g) of EQUAL => (terms_ord x str pr) (ts, us) 
  1320 	     | ord => ord)
  1321 	     end
  1322 	 | ord => ord)
  1323 and hd_ord x (f, g) =                                        (* ~ term.ML *)
  1324   prod_ord (prod_ord indexname_ord Term_Ord.typ_ord) int_ord (dest_hd' x f, 
  1325 						     dest_hd' x g)
  1326 and terms_ord x str pr (ts, us) = 
  1327     list_ord (term_ord' x pr (assoc_thy "Isac.thy"))(ts, us);
  1328 in
  1329 
  1330 fun ord_make_polynomial_in (pr:bool) thy subst tu = 
  1331     let
  1332 	(* val _=writeln("*** subs variable is: "^(subst2str subst)); *)
  1333     in
  1334 	case subst of
  1335 	    (_,x)::_ => (term_ord' x pr thy tu = LESS)
  1336 	  | _ => raise error ("ord_make_polynomial_in called with subst = "^
  1337 			  (subst2str subst))
  1338     end;
  1339 end;
  1340 
  1341 val order_add_mult_in = prep_rls(
  1342   Rls{id = "order_add_mult_in", preconds = [], 
  1343       rew_ord = ("ord_make_polynomial_in",
  1344 		 ord_make_polynomial_in false Poly.thy),
  1345       erls = e_rls,srls = Erls,
  1346       calc = [],
  1347       (*asm_thm = [],*)
  1348       rules = [Thm ("real_mult_commute",num_str @{thm real_mult_commute}),
  1349 	       (* z * w = w * z *)
  1350 	       Thm ("real_mult_left_commute",num_str @{thm real_mult_left_commute}),
  1351 	       (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
  1352 	       Thm ("real_mult_assoc",num_str @{thm real_mult_assoc}),		
  1353 	       (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
  1354 	       Thm ("add_commute",num_str @{thm add_commute}),	
  1355 	       (*z + w = w + z*)
  1356 	       Thm ("add_left_commute",num_str @{thm add_left_commute}),
  1357 	       (*x + (y + z) = y + (x + z)*)
  1358 	       Thm ("add_assoc",num_str @{thm add_assoc})	               
  1359 	       (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
  1360 	       ], scr = EmptyScr}:rls);
  1361 
  1362 val collect_bdv = prep_rls(
  1363   Rls{id = "collect_bdv", preconds = [], 
  1364       rew_ord = ("dummy_ord", dummy_ord),
  1365       erls = e_rls,srls = Erls,
  1366       calc = [],
  1367       (*asm_thm = [],*)
  1368       rules = [Thm ("bdv_collect_1",num_str @{thm bdv_collect_1}),
  1369 	       Thm ("bdv_collect_2",num_str @{thm bdv_collect_2}),
  1370 	       Thm ("bdv_collect_3",num_str @{thm bdv_collect_3}),
  1371 
  1372 	       Thm ("bdv_collect_assoc1_1",num_str @{thm bdv_collect_assoc1_1}),
  1373 	       Thm ("bdv_collect_assoc1_2",num_str @{thm bdv_collect_assoc1_2}),
  1374 	       Thm ("bdv_collect_assoc1_3",num_str @{thm bdv_collect_assoc1_3}),
  1375 
  1376 	       Thm ("bdv_collect_assoc2_1",num_str @{thm bdv_collect_assoc2_1}),
  1377 	       Thm ("bdv_collect_assoc2_2",num_str @{thm bdv_collect_assoc2_2}),
  1378 	       Thm ("bdv_collect_assoc2_3",num_str @{thm bdv_collect_assoc2_3}),
  1379 
  1380 
  1381 	       Thm ("bdv_n_collect_1",num_str @{thm bdv_n_collect_1}),
  1382 	       Thm ("bdv_n_collect_2",num_str @{thm bdv_n_collect_2}),
  1383 	       Thm ("bdv_n_collect_3",num_str @{thm bdv_n_collect_3}),
  1384 
  1385 	       Thm ("bdv_n_collect_assoc1_1",num_str @{thm bdv_n_collect_assoc1_1}),
  1386 	       Thm ("bdv_n_collect_assoc1_2",num_str @{thm bdv_n_collect_assoc1_2}),
  1387 	       Thm ("bdv_n_collect_assoc1_3",num_str @{thm bdv_n_collect_assoc1_3}),
  1388 
  1389 	       Thm ("bdv_n_collect_assoc2_1",num_str @{thm bdv_n_collect_assoc2_1}),
  1390 	       Thm ("bdv_n_collect_assoc2_2",num_str @{thm bdv_n_collect_assoc2_2}),
  1391 	       Thm ("bdv_n_collect_assoc2_3",num_str @{thm bdv_n_collect_assoc2_3)
  1392 	       ], scr = EmptyScr}:rls);
  1393 
  1394 (*.transforms an arbitrary term without roots to a polynomial [4] 
  1395    according to knowledge/Poly.sml.*) 
  1396 val make_polynomial_in = prep_rls(
  1397   Seq {id = "make_polynomial_in", preconds = []:term list, 
  1398        rew_ord = ("dummy_ord", dummy_ord),
  1399       erls = Atools_erls, srls = Erls,
  1400       calc = [], (*asm_thm = [],*)
  1401       rules = [Rls_ expand_poly,
  1402 	       Rls_ order_add_mult_in,
  1403 	       Rls_ simplify_power,
  1404 	       Rls_ collect_numerals,
  1405 	       Rls_ reduce_012,
  1406 	       Thm ("realpow_oneI",num_str @{thm realpow_oneI}),
  1407 	       Rls_ discard_parentheses,
  1408 	       Rls_ collect_bdv
  1409 	       ],
  1410       scr = EmptyScr
  1411       }:rls);     
  1412 
  1413 val separate_bdvs = 
  1414     append_rls "separate_bdvs"
  1415 	       collect_bdv
  1416 	       [Thm ("separate_bdv", num_str @{separate_bdv}),
  1417 		(*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
  1418 		Thm ("separate_bdv_n", num_str @{separate_bdv_n}),
  1419 		Thm ("separate_1_bdv", num_str @{separate_1_bdv}),
  1420 		(*"?bdv / ?b = (1 / ?b) * ?bdv"*)
  1421 		Thm ("separate_1_bdv_n", num_str @{separate_1_bdv_n}),
  1422 		(*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
  1423 		Thm ("nadd_divide_distrib", 
  1424 		     num_str @{thm nadd_divide_distrib})
  1425 		(*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"
  1426 		      WN051031 DOES NOT BELONG TO HERE*)
  1427 		];
  1428 val make_ratpoly_in = prep_rls(
  1429   Seq {id = "make_ratpoly_in", preconds = []:term list, 
  1430        rew_ord = ("dummy_ord", dummy_ord),
  1431       erls = Atools_erls, srls = Erls,
  1432       calc = [], (*asm_thm = [],*)
  1433       rules = [Rls_ norm_Rational,
  1434 	       Rls_ order_add_mult_in,
  1435 	       Rls_ discard_parentheses,
  1436 	       Rls_ separate_bdvs,
  1437 	       (* Rls_ rearrange_assoc, WN060916 why does cancel_p not work?*)
  1438 	       Rls_ cancel_p
  1439 	       (*Calc ("HOL.divide"  ,eval_cancel "#divide_e") too weak!*)
  1440 	       ],
  1441       scr = EmptyScr}:rls);      
  1442 
  1443 
  1444 ruleset' := overwritelthy @{theory} (!ruleset',
  1445   [("order_add_mult_in", order_add_mult_in),
  1446    ("collect_bdv", collect_bdv),
  1447    ("make_polynomial_in", make_polynomial_in),
  1448    ("make_ratpoly_in", make_ratpoly_in),
  1449    ("separate_bdvs", separate_bdvs)
  1450    ]);
  1451 *}
  1452 
  1453 end
  1454 
  1455 
  1456 
  1457 
  1458 
  1459