test/Tools/isac/Knowledge/rational.sml
author wenzelm
Mon, 21 Jun 2021 15:36:09 +0200
changeset 60309 70a1d102660d
parent 60270 844610c5c943
permissions -rw-r--r--
more antiquotations for Isabelle/HOL consts/types, without change of semantics;
     1 (* Title: tests for rationals
     2    Author: Walther Neuper
     3    Use is subject to license terms.
     4 *)
     5 
     6 "-----------------------------------------------------------------------------";
     7 "-----------------------------------------------------------------------------";
     8 "table of contents -----------------------------------------------------------";
     9 "-----------------------------------------------------------------------------";
    10 "-------- fun poly_of_term ---------------------------------------------------";
    11 "-------- fun is_poly --------------------------------------------------------";
    12 "-------- fun term_of_poly ---------------------------------------------------";
    13 "-------- integration lev.1 fun factout_p_ -----------------------------------";
    14 "-------- integration lev.1 fun cancel_p_ ------------------------------------";
    15 "-------- integration lev.1 fun common_nominator_p_ --------------------------";
    16 "-------- integration lev.1 fun add_fraction_p_ ------------------------------";
    17 "Rfuns-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
    18 "Rfuns-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
    19 "-------- rls norm_Rational downto fun gcd_poly ------------------------------";
    20 "Rfuns-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
    21 "----------- rewrite_set_ Partial_Fractions norm_Rational --------------------------------------";
    22 "----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
    23 "----------- fun cancel_p with Const AA --------------------------------------------------------";
    24 "-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
    25 "-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
    26 "-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
    27 "Rfuns-------- reverse rewrite ----------------------------------------------------";
    28 "Rfuns-------- 'reverse-ruleset' cancel_p -----------------------------------------";
    29 "-------- investigate rls norm_Rational --------------------------------------";
    30 "-------- examples: rls norm_Rational ----------------------------------------";
    31 "-------- rational numerals --------------------------------------------------";
    32 "-------- examples cancellation from: Mathematik 1 Schalk --------------------";
    33 "-------- examples common denominator from: Mathematik 1 Schalk --------------";
    34 "-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
    35 "-------- examples common denominator and multiplication from: Schalk --------";
    36 "-------- examples double fractions from: Mathematik 1 Schalk ----------------";
    37 "-------- me Schalk I No.186 -------------------------------------------------";
    38 "-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
    39 "-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
    40 "-------- investigate rulesets for cancel_p ----------------------------------";
    41 "-------- fun eval_get_denominator -------------------------------------------";
    42 "-------- several errpats in complicated term --------------------------------";
    43 "-------- WN1309xx non-terminating rls norm_Rational -------------------------";
    44 "-----------------------------------------------------------------------------";
    45 "-----------------------------------------------------------------------------";
    46 
    47 
    48 "-------- fun poly_of_term ---------------------------------------------------";
    49 "-------- fun poly_of_term ---------------------------------------------------";
    50 "-------- fun poly_of_term ---------------------------------------------------";
    51 val thy = @{theory Partial_Fractions};
    52 val ctxt = Proof_Context.init_global @{theory}
    53 val vs = TermC.vars_of (the (parseNEW ctxt "12 * x \<up> 3 * y \<up> 4 * z \<up> 6"));
    54 
    55 if poly_of_term vs (TermC.str2term "12::real") = SOME [(12, [0, 0, 0])]
    56 then () else error "poly_of_term 1 changed";
    57 if poly_of_term vs (TermC.str2term "x::real") = SOME [(1, [1, 0, 0])]
    58 then () else error "poly_of_term 2 changed";
    59 if poly_of_term vs (TermC.str2term "12 * x \<up> 3") = SOME [(12, [3, 0, 0])]
    60 then () else error "poly_of_term 3 changed";
    61 if poly_of_term vs (TermC.str2term "12 * x \<up> 3 * y \<up> 4 * z \<up> 6") = SOME [(12, [3, 4, 6])]
    62 then () else error "poly_of_term 4 changed";
    63 if poly_of_term vs (TermC.str2term "1 + 2 * x \<up> 3 * y \<up> 4 * z \<up> 6 + y") =
    64   SOME [(1, [0, 0, 0]), (1, [0, 1, 0]), (2, [3, 4, 6])]
    65 then () else error "poly_of_term 5 changed";
    66 
    67 (*poly_of_term is quite liberal:*)
    68 (*the coefficient may be somewhere, the order of variables and the parentheses 
    69   within a monomial are arbitrary*)
    70 if poly_of_term vs (TermC.str2term "y \<up> 4 * (x \<up> 3 * 12 * z \<up> 6)") = SOME [(12, [3, 4, 6])]
    71 then () else error "poly_of_term 6 changed";
    72 
    73 (*there may even be more than 1 coefficient:*)
    74 if poly_of_term vs (TermC.str2term "2 * y \<up> 4 * (x \<up> 3 * 6 * z \<up> 6)") = SOME [(12, [3, 4, 6])]
    75 then () else error "poly_of_term 7 changed";
    76 
    77 (*the order and the parentheses within monomials are arbitrary:*)
    78 if poly_of_term vs (TermC.str2term "2 * x \<up> 3 * y \<up> 4 * z \<up> 6 + (7 * y \<up> 8 + 1)")
    79   = SOME [(1, [0, 0, 0]), (7, [0, 8, 0]), (2, [3, 4, 6])]
    80 then () else error "poly_of_term 8 changed";
    81 
    82 "-------- fun is_poly --------------------------------------------------------";
    83 "-------- fun is_poly --------------------------------------------------------";
    84 "-------- fun is_poly --------------------------------------------------------";
    85 if is_poly (TermC.str2term "2 * x \<up> 3 * y \<up> 4 * z \<up> 6 + 7 * y \<up> 8 + 1")
    86 then () else error "is_poly 1 changed";
    87 if not (is_poly (TermC.str2term "2 * (x \<up> 3 * y \<up> 4 * z \<up> 6 + 7) * y \<up> 8 + 1"))
    88 then () else error "is_poly 2 changed";
    89 
    90 "-------- fun term_of_poly ---------------------------------------------------";
    91 "-------- fun term_of_poly ---------------------------------------------------";
    92 "-------- fun term_of_poly ---------------------------------------------------";
    93 val expT = HOLogic.realT
    94 val Free (_, baseT) = (hd o vars o TermC.str2term) "12 * x \<up> 3 * y \<up> 4 * z \<up> 6";
    95 val p = [(1, [0, 0, 0]), (7, [0, 8, 0]), (2, [3, 4, 5])]
    96 val vs = TermC.vars_of (the (parseNEW ctxt "12 * x \<up> 3 * y \<up> 4 * z \<up> 6"))
    97 (*precondition for [(c, es),...]: legth es = length vs*)
    98 ;
    99 if UnparseC.term (term_of_poly baseT expT vs p) = "1 + 7 * y \<up> 8 + 2 * x \<up> 3 * y \<up> 4 * z \<up> 5"
   100 then () else error "term_of_poly 1 changed";
   101 
   102 "-------- integration lev.1 fun factout_p_ -----------------------------------";
   103 "-------- integration lev.1 fun factout_p_ -----------------------------------";
   104 "-------- integration lev.1 fun factout_p_ -----------------------------------";
   105 val t = TermC.str2term "(x \<up> 2 + -1*y \<up> 2) / (x \<up> 2 + -1*x*y)"
   106 val SOME (t', asm) = factout_p_ thy t;
   107 if UnparseC.term t' = "(x + y) * (x + -1 * y) / (x * (x + -1 * y))"
   108 then () else error ("factout_p_ term 1 changed: " ^ UnparseC.term t')
   109 ;
   110 if UnparseC.terms asm = "[\"x \<noteq> 0\",\"x + -1 * y \<noteq> 0\"]"
   111 then () else error "factout_p_ asm 1 changed"
   112 ;
   113 val t = TermC.str2term "nothing + to_cancel ::real";
   114 if NONE = factout_p_ thy t then () else error "factout_p_ doesn't report non-applicable";
   115 ;
   116 val t = TermC.str2term "((3 * x \<up> 2 + 6 *x + 3) / (2*x + 2))";
   117 val SOME (t', asm) = factout_p_ thy t;
   118 if UnparseC.term t' = "(3 + 3 * x) * (1 + x) / (2 * (1 + x))" andalso 
   119   UnparseC.terms asm = "[\"1 + x \<noteq> 0\"]"
   120 then () else error "factout_p_ 1 changed";
   121 
   122 "-------- integration lev.1 fun cancel_p_ ------------------------------------";
   123 "-------- integration lev.1 fun cancel_p_ ------------------------------------";
   124 "-------- integration lev.1 fun cancel_p_ ------------------------------------";
   125 val t = TermC.str2term "(x \<up> 2 + -1*y \<up> 2) / (x \<up> 2 + -1*x*y)"
   126 val SOME (t', asm) = cancel_p_ thy t;
   127 if (UnparseC.term t', UnparseC.terms asm) = ("(x + y) / x", "[\"x \<noteq> 0\"]")
   128 then () else error ("cancel_p_ (t', asm) 1 changed: " ^ UnparseC.term t')
   129 ;
   130 val t = TermC.str2term "nothing + to_cancel ::real";
   131 if NONE = cancel_p_ thy t then () else error "cancel_p_ doesn't report non-applicable";
   132 ;
   133 val t = TermC.str2term "((3 * x \<up> 2 + 6 *x + 3) / (2*x + 2))";
   134 val SOME (t', asm) = cancel_p_ thy t;
   135 if UnparseC.term t' = "(3 + 3 * x) / 2" andalso UnparseC.terms asm = "[]"
   136 then () else error "cancel_p_ 1 changed";
   137 
   138 "-------- integration lev.1 fun common_nominator_p_ --------------------------";
   139 "-------- integration lev.1 fun common_nominator_p_ --------------------------";
   140 "-------- integration lev.1 fun common_nominator_p_ --------------------------";
   141 val t = TermC.str2term ("y / (a*x + b*x + c*x) " ^
   142               (* n1    d1                   *)
   143                 "+ a / (x*y)");
   144               (* n2    d2                   *)
   145 val SOME (t', asm) = common_nominator_p_ thy t;
   146 if UnparseC.term t' =
   147       ("y * y / (x * ((a + b + c) * y)) " ^
   148   (*  n1  *d2'/ (c'* ( d1'        *d2')) *)
   149      "+ a * (a + b + c) / (x * ((a + b + c) * y))")
   150    (*  n2 * d1'         / (c'* ( d1'        *d2')) *)
   151 then () else error "common_nominator_p_ term 1 changed";
   152 if UnparseC.terms asm = "[\"a + b + c \<noteq> 0\",\"y \<noteq> 0\",\"x \<noteq> 0\"]"
   153 then () else error "common_nominator_p_ asm 1 changed"
   154 
   155 "-------- example in mail Nipkow";
   156 val t = TermC.str2term "x/(x \<up> 2 + -1*y \<up> 2) + y/(x \<up> 2 + -1*x*y)";
   157 val SOME (t', asm) = common_nominator_p_ thy t;
   158 if UnparseC.term t' = "x * x / " ^ 
   159                  "((x + -1 * y) * ((x + y) * x))" ^
   160             " +\n" ^ 
   161                  "y * (x + y) / " ^ 
   162                  "((x + -1 * y) * ((x + y) * x))"
   163 then () else error "common_nominator_p_ term 2 changed"
   164 ;
   165 if UnparseC.terms asm = "[\"x + y \<noteq> 0\",\"x \<noteq> 0\",\"x + -1 * y \<noteq> 0\"]"
   166 then () else error "common_nominator_p_ asm 2 changed"
   167 
   168 "-------- example: applicable tested by SML code";
   169 val t = TermC.str2term "nothing / to_add";
   170 if NONE = common_nominator_p_ thy t then () else error "common_nominator_p_ term 3 changed";
   171 ;
   172 val t = TermC.str2term "((x + (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
   173 val SOME (t', asm) = common_nominator_p_ thy t;
   174 if UnparseC.term t' = 
   175    "(x + -1) * (-1 + x) / ((1 + x) * (-1 + x)) +\n(x + 1) * (1 + x) / ((1 + x) * (-1 + x))"
   176   andalso UnparseC.terms asm = "[\"1 + x \<noteq> 0\",\"-1 + x \<noteq> 0\"]"
   177 then () else error "common_nominator_p_ 3 changed";
   178 
   179 "-------- integration lev.1 fun add_fraction_p_ ------------------------------";
   180 "-------- integration lev.1 fun add_fraction_p_ ------------------------------";
   181 "-------- integration lev.1 fun add_fraction_p_ ------------------------------";
   182 val t = TermC.str2term "((x + (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
   183 val SOME (t', asm) = add_fraction_p_ thy t;
   184 if UnparseC.term t' = "(2 + 2 * x \<up> 2) / (-1 + x \<up> 2)" 
   185 then () else error "add_fraction_p_ 3 changed";
   186 ;
   187 if UnparseC.terms asm = "[\"-1 + x \<up> 2 \<noteq> 0\"]"
   188 then () else error "add_fraction_p_ 3 changed";
   189 ;
   190 val t = TermC.str2term "nothing / to_add";
   191 if NONE = add_fraction_p_ thy t then () else error "add_fraction_p_ term 3 changed";
   192 ;
   193 val t = TermC.str2term "((x + (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
   194 val SOME (t', asm) = add_fraction_p_ thy t;
   195 if UnparseC.term t' = "(2 + 2 * x \<up> 2) / (-1 + x \<up> 2)" andalso
   196   UnparseC.terms asm = "[\"-1 + x \<up> 2 \<noteq> 0\"]"
   197 then () else error "add_fraction_p_ 3 changed";
   198 
   199 "-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
   200 "-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
   201 "-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
   202 (* trace down until prepats are evaluated 
   203   (which does not to work, because substitution is not done -- compare rew_sub!);
   204   keep this sequence for the case, factout_p, cancel_p, common_nominator_p, add_fraction_p
   205   (again) get prepat = [] changed to <>[]. *)
   206 val t = TermC.str2term "(x \<up> 2 + -1*y \<up> 2) / (x \<up> 2 + -1*x*y)";
   207 
   208 (*rewrite_set_ @{theory Isac_Knowledge} true cancel t = NONE; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
   209 "~~~~~ fun rewrite_set_, args:"; val (thy, bool, rls, term) = (thy, false, cancel_p, t);
   210 "~~~~~ fun rewrite__set_, args:"; val (thy, i, _, _, (rrls as Rrls _), t) =
   211   (thy, 1, bool, [], rls, term);
   212 (*val (t', asm, rew) = app_rev thy (i+1) rrls t; rew = false!!!!!!!!!!!!!!!!!!!!!*)
   213 "~~~~~ and app_rev, args:"; val (thy, i, rrls, t) = (thy, (i+1), rrls, t);
   214     fun chk_prepat thy erls [] t = true
   215       | chk_prepat thy erls prepat t =
   216         let
   217           fun chk (pres, pat) =
   218             (let 
   219               val subst: Type.tyenv * Envir.tenv =
   220                 Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
   221              in
   222               snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
   223              end) handle Pattern.MATCH => false
   224            fun scan_ f [] = false (*scan_ NEVER called by []*)
   225              | scan_ f (pp::pps) =
   226                if f pp then true else scan_ f pps;
   227         in scan_ chk prepat end;
   228     (* apply the normal_form of a rev-set *)
   229     fun app_rev' thy (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}) t =
   230       if chk_prepat thy erls prepat t
   231       then ((*tracing("### app_rev': t = "^UnparseC.term t);*) normal_form t)
   232       else NONE;
   233 (*  val opt = app_rev' thy rrls t  ..NONE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
   234 "~~~~~ and app_rev', args:"; val (thy, (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}), t) =
   235   (thy, rrls, t);
   236 (* chk_prepat thy erls prepat t = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
   237 (* app_sub thy i rrls t = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
   238 "~~~~~ fun chk_prepat, args:"; val (thy, erls, prepat, t) = (thy, erls, prepat, t);
   239           fun chk (pres, pat) =
   240             (let 
   241               val subst: Type.tyenv * Envir.tenv =
   242                 Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
   243              in
   244               snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
   245              end) handle Pattern.MATCH => false
   246            fun scan_ f [] = false (*scan_ NEVER called by []*)
   247              | scan_ f (pp::pps) =
   248                if f pp then true else scan_ f pps;
   249 
   250 (*========== inhibit exn WN130823: prepat is empty ====================================
   251 (* scan_ chk prepat = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
   252 "~~~~~ fun , args:"; val (f, (pp::pps)) = (chk, prepat);
   253 f;
   254 val ([t1, t2], t) = pp;
   255 UnparseC.term t1 = "?r is_expanded";
   256 UnparseC.term t2 = "?s is_expanded";
   257 UnparseC.term t = "?r / ?s";
   258 (* f pp = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
   259 "~~~~~ fun chk, args:"; val (pres, pat) = (pp);
   260               val subst: Type.tyenv * Envir.tenv =
   261                 Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
   262 (*subst = 
   263   ({}, {(("r", 0), ("real", Var (("r", 0), "real"))), 
   264         (("s", 0), ("real", Var (("s", 0), "real")))}*)
   265 ;
   266               snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
   267 "~~~~~ fun eval__true, args:"; val (thy, i, asms, bdv, rls) =
   268   (thy, (i + 1), (map (Envir.subst_term subst) pres), [], erls);
   269 UnparseC.terms asms;                         (* = "[\"?r is_expanded\",\"?s is_expanded\"]"*)
   270 asms = [@{term True}] orelse asms = []; (* = false*)
   271 asms = [@{term False}]                ; (* = false*)
   272 "~~~~~ fun chk, args:"; val (indets, (a::asms)) = ([], asms);
   273 bdv (*= []: _a list*);
   274 val bdv : (term * term) list = [];
   275 rewrite__set_ thy (i+1) false;
   276 UnparseC.term a = "?r is_expanded"; (*hier m"usste doch der Numerator eingesetzt sein ??????????????*)
   277 val SOME (Const (\<^const_name>\<open>False\<close>, _), []) = rewrite__set_ thy (i+1) false bdv rls a
   278 ============ inhibit exn WN130823: prepat is empty ===================================*)
   279 
   280 "-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
   281 "-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
   282 "-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
   283 val t = TermC.str2term "(12 * x * y) / (8 * y \<up> 2 )";
   284 (* "-------- example 187a": exception Div raised...
   285 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;*)
   286 val t = TermC.str2term "(8 * x \<up> 2 * y * z ) / (18 * x * y \<up> 2 * z )";
   287 (* "-------- example 187b": doesn't terminate...
   288 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;*)
   289 val t = TermC.str2term "(9 * x \<up> 5 * y \<up> 2 * z \<up> 4) / (15 * x \<up> 6 * y \<up> 3 * z )";
   290 (* "-------- example 187c": doesn't terminate...
   291 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;*)
   292 "~~~~~ fun rewrite_set_, args:"; val (thy, bool, rls, term) = (@{theory Isac_Knowledge}, false, cancel_p, t);
   293 (* WN130827: exception Div raised...
   294 rewrite__set_ thy 1 bool [] rls term
   295 *)
   296 "~~~~~ and rewrite__set_, args:"; val (thy, i, _, _, (rrls as Rrls _), t) =
   297   (thy, 1, bool, [], rls, term);
   298 (* WN130827: exception Div raised...
   299 	val (t', asm, rew) = app_rev thy (i+1) rrls t
   300 *)
   301 "~~~~~ fun app_rev, args:"; val (thy, i, rrls, t) = (thy, (i+1), rrls, t);
   302 (* WN130827: exception Div raised...
   303     val opt = app_rev' thy rrls t
   304 *)
   305 "~~~~~ fun app_rev', args:"; val (thy, (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}), t) =
   306   (thy, rrls, t);
   307 chk_prepat thy erls prepat t    = true;
   308 (* WN130827: exception Div raised...
   309 normal_form t
   310 *)
   311 (* lookup Rational.thy, cancel_p: normal_form = cancel_p_ thy*)
   312 "~~~~~ fun cancel_p_, args:"; val (t) = (t);
   313 val opt = check_fraction t;
   314 val SOME (numerator, denominator) = opt
   315         val vs = TermC.vars_of t
   316         val baseT = type_of numerator
   317         val expT = HOLogic.realT
   318 val (SOME a, SOME b) = (poly_of_term vs numerator, poly_of_term vs denominator);
   319 (*"-------- example 187a": exception Div raised...
   320 val a = [(12, [1, 1])]: poly
   321 val b = [(8, [0, 2])]: poly
   322               val ((a', b'), c) = gcd_poly a b
   323 *)
   324 (* "-------- example 187b": doesn't terminate...
   325 val a = [(8, [2, 1, 1])]: poly
   326 val b = [(18, [1, 2, 1])]: poly
   327               val ((a', b'), c) = gcd_poly a b
   328 *)
   329 (* "-------- example 187c": doesn't terminate...
   330 val a = [(9, [5, 2, 4])]: poly
   331 val b = [(15, [6, 3, 1])]: poly
   332               val ((a', b'), c) = gcd_poly a b
   333 *)
   334 
   335 "-------- rls norm_Rational downto fun gcd_poly ------------------------------";
   336 "-------- rls norm_Rational downto fun gcd_poly ------------------------------";
   337 "-------- rls norm_Rational downto fun gcd_poly ------------------------------";
   338 val t = TermC.str2term "(x \<up> 2 - 4)*(3 - y) / ((y \<up> 2 - 9)*(2+x))";
   339 Rewrite.trace_on := false (*true false*);
   340 (* trace stops with ...: (and then jEdit hangs)..
   341 rewrite_set_ thy false norm_Rational t;
   342 :
   343 ###  rls: cancel_p on: (-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /
   344 (-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)
   345 *)
   346 val t = TermC.str2term (*copy from above: "::real" is not required due to " \<up> "*)
   347   ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
   348   "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)");
   349 (*cancel_p_ thy t;
   350 exception Div raised*)
   351 
   352 "~~~~~ fun cancel_p_, args:"; val (t) = (t);
   353 val opt = check_fraction t;
   354 val SOME (numerator, denominator) = opt
   355         val vs = TermC.vars_of t
   356         val baseT = type_of numerator
   357         val expT = HOLogic.realT;
   358 (*default_print_depth 3; 999*)
   359 val (SOME a, SOME b) = (poly_of_term vs numerator, poly_of_term vs denominator);
   360 (*default_print_depth 3; 999*)
   361 (* does not terminate instead of returning ?:
   362         val ((a', b'), c) = gcd_poly a b
   363 val a = [(~12, [0, 0]), (3, [2, 0]), (4, [0, 1]), (~1, [2, 1])]: poly
   364 val b = [(~18, [0, 0]), (~9, [1, 0]), (2, [0, 2]), (1, [1, 2])]: poly
   365 *)
   366 
   367 "-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
   368 "-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
   369 "-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
   370 val thy =  @{theory Isac_Knowledge};
   371 "----- SK060904-2a non-termination of add_fraction_p_";
   372 val t = TermC.str2term (" (a + b * x) / (a + -1 * (b * x)) +  " ^
   373 		         " (-1 * a + b * x) / (a + b * x)      ");
   374 (* rewrite_set_ thy false norm_Rational t
   375 exception Div raised*)
   376 (* rewrite_set_ thy false add_fractions_p t;
   377 exception Div raised*)
   378 "~~~~~ fun rewrite_set_, args:"; val (thy, bool, rls, term) =
   379   (@{theory Isac_Knowledge}, false, add_fractions_p, t);
   380 "~~~~~ and rewrite__set_, args:"; val (thy, i, _, _, (rrls as Rrls _), t) =
   381   (thy, 1, bool, [], rls, term);
   382 (* app_rev thy (i+1) rrls t;
   383 exception Div raised*)
   384 "~~~~~ and app_rev, args:"; val (thy, i, rrls, t) = (thy, (i+1), rrls, t);
   385     fun chk_prepat thy erls [] t = true
   386       | chk_prepat thy erls prepat t =
   387         let
   388           fun chk (pres, pat) =
   389             (let 
   390               val subst: Type.tyenv * Envir.tenv =
   391                 Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
   392              in
   393               snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
   394              end) handle Pattern.MATCH => false
   395            fun scan_ f [] = false (*scan_ NEVER called by []*)
   396              | scan_ f (pp::pps) =
   397                if f pp then true else scan_ f pps;
   398         in scan_ chk prepat end;
   399     (* apply the normal_form of a rev-set *)
   400     fun app_rev' thy (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}) t =
   401       if chk_prepat thy erls prepat t
   402       then ((*tracing("### app_rev': t = "^UnparseC.term t);*) normal_form t)
   403       else NONE;
   404 (*  val opt = app_rev' thy rrls t;
   405 exception Div raised*)
   406 (*  val opt = app_rev' thy rrls t;
   407 exception Div raised*)
   408 "~~~~~ and app_rev', args:"; val (thy, (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}), t) =
   409   (thy, rrls, t);
   410 chk_prepat thy erls prepat t = true       = true;
   411 (*normal_form t
   412 exception Div raised*)
   413 (* lookup Rational.thy, val add_fractions_p: normal_form = add_fraction_p_ thy*)
   414 (*add_fraction_p_ thy t
   415 exception Div raised*)
   416 "~~~~~ fun add_fraction_p_, args:"; val ((_: theory), t) = (thy, t);
   417 val SOME ((n1, d1), (n2, d2)) = check_frac_sum t;
   418 UnparseC.term n1; UnparseC.term d1; UnparseC.term n2; UnparseC.term d2;
   419       val vs = TermC.vars_of t;
   420 (*default_print_depth 3; 999*)
   421 val (SOME _, SOME a, SOME _, SOME b) =
   422   (poly_of_term vs n1, poly_of_term vs d1, poly_of_term vs n2, poly_of_term vs d2);
   423 (*default_print_depth 3; 999*)
   424 (*
   425 val a = [(1, [1, 0, 0]), (~1, [0, 1, 1])]: poly
   426 val b = [(1, [1, 0, 0]), (1, [0, 1, 1])]: poly
   427             val ((a', b'), c) = gcd_poly a b
   428 *)
   429 
   430 "----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
   431 "----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
   432 "----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
   433 val thy = @{theory Isac_Knowledge(*Partial_Fractions*)}
   434 val ctxt = Proof_Context.init_global thy;
   435 
   436 (*---------- (1) with Free A, B  ----------------------------------------------------------------*)
   437 val t = (the o (parseNEW  ctxt)) "3 = A / 2 + A / 4 + (B / 2 + -1 * B / (2::real))";
   438                                 (* required for applying thms in rewriting  \<up> ^*)
   439 (* we get details from here..*)
   440 
   441 Rewrite.trace_on := false;
   442 val SOME (t', _) = Rewrite.rewrite_set_ thy true add_fractions_p t;
   443 Rewrite.trace_on := false;
   444 (* Rewrite.trace_on:
   445 add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
   446                      (* |||||||||||||||||||||||||||||||||||| *)
   447 
   448 val t = (the o (parseNEW  ctxt))(* ||||||||||||||||||||||||| GUESS 1 GUESS 1 GUESS 1 GUESS 1 *)
   449                        "A / 2 + A / 4 + (B / 2 + -1 * B / (2::real))";
   450 "~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
   451 val NONE = (*case*) check_frac_sum t (*of*)
   452 
   453 (* Rewrite.trace_on:
   454 add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
   455                      (*         |||||||||||||||||||||||||||| *)
   456 val t = (the o (parseNEW  ctxt))(* ||||||||||||||||||||||||| GUESS 2 GUESS 2 GUESS 2 GUESS 2 *)
   457                                "A / 4 + (B / 2 + -1 * B / (2::real))";
   458 "~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
   459 val SOME ((n1, d1), (n2, d2)) = (*case*) check_frac_sum t (*of*);
   460 (*+*)if (UnparseC.term n1, UnparseC.term d1) = ("A"                 , "4") andalso
   461 (*+*)   (UnparseC.term n2, UnparseC.term d2) = ("B / 2 + -1 * B / 2", "1")
   462 (*+*)then () else error "check_frac_sum (A / 4 + (B / 2 + -1 * B / (2::real))) changed";
   463 
   464       val vs = TermC.vars_of t;
   465 val (SOME [(1, [1, 0])], SOME [(4, [0, 0])], NONE, SOME [(1, [0, 0])]) =
   466   (*case*) (poly_of_term vs n1, poly_of_term vs d1, poly_of_term vs n2, poly_of_term vs d2) (*of*);
   467 
   468 "~~~~~ fun poly_of_term , args:"; val (vs, t) = (vs, n1);
   469 val SOME [(1, [xxx, 0])] = SOME [monom_of_term vs (1, replicate (length vs) 0) t];
   470 (*+*)if xxx = 1 then () else error "monom_of_term changed"
   471 
   472 "~~~~~ fun monom_of_term , args:"; val (vs, (c, es), (Free (id, _))) =
   473   (vs, (1, replicate (length vs) 0), t);
   474 case vs of [Free ("A", _), Free ("B", _)] =>
   475   if c = 1 andalso id = "A"
   476   then () else error "monom_of_term Free changed 1"
   477 | _ => error "monom_of_term Free changed 2";
   478 
   479 (*---------- (2) with Const AA, BB --------------------------------------------------------------*)
   480 val t = (the o (parseNEW  ctxt)) "3 = AA / 2 + AA / 4 + (BB / 2 + -1 * BB / 2)";
   481                                     (*AA :: real*)
   482 (* we get details from here..*)
   483 
   484 Rewrite.trace_on := false;
   485 val SOME (t', _) = Rewrite.rewrite_set_ thy true add_fractions_p t;
   486 Rewrite.trace_on := false;
   487 (* Rewrite.trace_on:
   488 add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
   489                      (* |||||||||||||||||||||||||||||||||||| *)
   490 val t = (the o (parseNEW  ctxt))(* ||||||||||||||||||||||||| *)
   491                    "AA / 2 + AA / 4 + (BB / 2 + -1 * BB / 2)";
   492 "~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
   493 val NONE = (*case*) check_frac_sum t (*of*)
   494 
   495 (* Rewrite.trace_on:
   496 add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
   497                      (*         |||||||||||||||||||||||||||| *)
   498 val t = (the o (parseNEW  ctxt))(* ||||||||||||||||||||||||| *)
   499                                "AA / 4 + (BB / 2 + -1 * BB / 2)";
   500 "~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
   501 val SOME ((n1, d1), (n2, d2)) = (*case*) check_frac_sum t (*of*);
   502 (*+*)if (UnparseC.term n1, UnparseC.term d1) = ("AA"                 , "4") andalso
   503 (*+*)   (UnparseC.term n2, UnparseC.term d2) = ("BB / 2 + -1 * BB / 2", "1")
   504 (*+*)then () else error "check_frac_sum (AA / 4 + (BB / 2 + -1 * BB / 2)) changed";
   505 
   506       val vs = TermC.vars_of t;
   507 val (SOME [(1, [1, 0])], SOME [(4, [0, 0])], NONE, SOME [(1, [0, 0])]) =
   508   (*case*) (poly_of_term vs n1, poly_of_term vs d1, poly_of_term vs n2, poly_of_term vs d2) (*of*);
   509 
   510 "~~~~~ fun poly_of_term , args:"; val (vs, t) = (vs, n1);
   511 val SOME [(1, [xxx, 0])] = SOME [monom_of_term vs (1, replicate (length vs) 0) t];
   512 (*+*)if xxx = 1 then () else error "monom_of_term changed"
   513 
   514 "~~~~~ fun monom_of_term , args:"; val (vs, (c, es), (Const (id, _))) =
   515   (vs, (1, replicate (length vs) 0), t);
   516 case vs of [Const ("Partial_Fractions.AA", _), Const ("Partial_Fractions.BB", _)] =>
   517   if c = 1 andalso id = "Partial_Fractions.AA"
   518   then () else error "monom_of_term Const changed 1"
   519 | _ => error "monom_of_term Const changed 2";
   520 
   521 "----------- fun cancel_p with Const AA --------------------------------------------------------";
   522 "----------- fun cancel_p with Const AA --------------------------------------------------------";
   523 "----------- fun cancel_p with Const AA --------------------------------------------------------";
   524 val thy = @{theory Partial_Fractions};
   525 val ctxt = Proof_Context.init_global @{theory}
   526 val SOME t = TermC.parseNEW ctxt "2 * AA / 2"; (* Const ("Free ("AA", "real") *)
   527 
   528 val SOME (t', _) = rewrite_set_ thy true cancel_p t;
   529 case t' of
   530   Const (\<^const_name>\<open>divide\<close>, _) $ Const ("Partial_Fractions.AA", _) $ Free ("1", _) => ()
   531 | _ => error "WRONG rewrite_set_ cancel_p (2 * AA / 2) \<longrightarrow> AA changed";
   532 
   533 "~~~~~ fun cancel_p , args:"; val (t) = (t);
   534 val opt = check_fraction t
   535 val SOME (numerator, denominator) = (*case*) opt (*of*);
   536 
   537 if UnparseC.term numerator = "2 * AA" andalso UnparseC.term denominator = "2"
   538 then () else error "check_fraction (2 * AA / 2) changed";
   539         val vs = TermC.vars_of t;
   540 case vs of
   541   [Const ("Partial_Fractions.AA", _)] => ()
   542 | _ => error "rewrite_set_ cancel_p (2 * AA / 2) \<longrightarrow> AA/1  changed";
   543 
   544 
   545 "-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
   546 "-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
   547 "-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
   548 val thy  = @{theory "Rational"};
   549 "-------- WN";
   550 val t = TermC.str2term "(2 + -3 * x) / 9";
   551 if NONE = rewrite_set_ thy false cancel_p t then ()
   552 else error "rewrite_set_ cancel_p must return NONE, if the term cannot be cancelled";
   553 
   554 "-------- example 186a";
   555 val t = TermC.str2term "(14 * x * y) / (x * y)";
   556   is_expanded (TermC.str2term "14 * x * y");
   557   is_expanded (TermC.str2term "x * y");
   558 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   559 if (UnparseC.term t', UnparseC.terms asm) = ("14 / 1", "[]")
   560 then () else error "rational.sml cancel Schalk 186a";
   561 
   562 "-------- example 186b";
   563 val t = TermC.str2term "(60 * a * b) / ( 15 * a  * b )";
   564 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   565 if (UnparseC.term t', UnparseC.terms asm) = ("4 / 1", "[]")
   566 then () else error "rational.sml cancel Schalk 186b";
   567 
   568 "-------- example 186c";
   569 val t = TermC.str2term "(144 * a \<up> 2 * b * c) / (12 * a * b * c)";
   570 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   571 if (UnparseC.term t', UnparseC.terms asm) = ("12 * a / 1", "[]")
   572 then () else error "rational.sml cancel Schalk 186c";
   573 
   574 (* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! exception Div raised !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   575   see --- fun rewrite_set_ downto fun gcd_poly ---
   576 "-------- example 187a";
   577 val t = TermC.str2term "(12 * x * y) / (8 * y \<up> 2 )";
   578 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   579 if (UnparseC.term t', UnparseC.terms asm) = ("3 * x / (2 * y)", "[\"4 * y ~= 0\"]")
   580 then () else error "rational.sml cancel Schalk 187a";
   581 *)
   582 
   583 (* doesn't terminate !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   584   see --- fun rewrite_set_ downto fun gcd_poly ---
   585 "-------- example 187b";
   586 val t = TermC.str2term "(8 * x \<up> 2 * y * z ) / (18 * x * y \<up> 2 * z )";
   587 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   588 if (UnparseC.term t', UnparseC.terms asm) = ("4 * x / (9 * y)", "[\"2 * (z * (y * x)) ~= 0\"]")
   589 then () else error "rational.sml cancel Schalk 187b";
   590 *)
   591 
   592 (* doesn't terminate !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   593   see --- fun rewrite_set_ downto fun gcd_poly ---
   594 "-------- example 187c";
   595 val t = TermC.str2term "(9 * x \<up> 5 * y \<up> 2 * z \<up> 4) / (15 * x \<up> 6 * y \<up> 3 * z )";
   596 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   597 if (UnparseC.term t', UnparseC.terms asm) = 
   598   ("3 * z \<up> 3 / (5 * (y * x))", "[\"3 * (z * (y \<up> 2 * x \<up> 5)) ~= 0\"]") 
   599 then () else error "rational.sml cancel Schalk 187c";
   600 *)
   601 
   602 "-------- example 188a";
   603 val t = TermC.str2term "(-8 + 8 * x) / (-9 + 9 * x)";
   604   is_expanded (TermC.str2term "8 * x + -8");
   605 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   606 if (UnparseC.term t', UnparseC.terms asm) = ("8 / 9", "[]")
   607 then () else error "rational.sml cancel Schalk 188a";
   608 
   609 val t = TermC.str2term "(8*((-1) + x))/(9*((-1) + x))";
   610 val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
   611 if (UnparseC.term t', UnparseC.terms asm) = ("8 / 9", "[]")
   612 then () else error "rational.sml cancel Schalk make_polynomial 1";
   613 
   614 "-------- example 188b";
   615 val t = TermC.str2term "(-15 + 5 * x) / (-18 + 6 * x)";
   616 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   617 if (UnparseC.term t', UnparseC.terms asm) = ("5 / 6", "[]")
   618 then () else error "rational.sml cancel Schalk 188b";
   619 
   620 "-------- example 188c";
   621 val t = TermC.str2term "(a + -1 * b) / (b + -1 * a)";
   622 val SOME (t', asm) = rewrite_set_ thy false  cancel_p t;
   623 if (UnparseC.term t', UnparseC.terms asm) = ("-1 / 1", "[]")
   624 then () else error "rational.sml cancel Schalk 188c";
   625 
   626 is_expanded (TermC.str2term "a + -1 * b") = true;
   627 val t = TermC.str2term "((-1)*(b + (-1) * a))/(1*(b + (-1) * a))";
   628 val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
   629 if (UnparseC.term t', UnparseC.terms asm) = ("(a + -1 * b) / (-1 * a + b)", "[]")
   630 then () else error "rational.sml cancel Schalk make_polynomial 2";
   631 
   632 "-------- example 190a";
   633 val t = TermC.str2term "( 27 * a \<up> 3 + 9 * a \<up> 2 + 3 * a + 1 ) / ( 27 * a \<up> 3 + 18 * a \<up> 2 + 3 * a )";
   634 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   635 if (UnparseC.term t', UnparseC.terms asm) = 
   636   ("(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)", "[\"3 * a + 9 * a \<up> 2 \<noteq> 0\"]")
   637 then () else error "rational.sml cancel Schalk 190a";
   638 
   639 "-------- example 190c";
   640 val t = TermC.str2term "((1 + 9 * a \<up> 2)*(1 + 3 * a))/((3 * a + 9 * a \<up> 2)*(1 + 3 * a))";
   641 val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
   642 if (UnparseC.term t', UnparseC.terms asm) = 
   643   ("(1 + 3 * a + 9 * a \<up> 2 + 27 * a \<up> 3) /\n(3 * a + 18 * a \<up> 2 + 27 * a \<up> 3)", "[]")
   644 then () else error "rational.sml make_polynomial Schalk 190c";
   645 
   646 "-------- example 191a";
   647 val t = TermC.str2term "( x \<up> 2 + -1 * y \<up> 2 ) / ( x + y )";
   648   is_expanded (TermC.str2term "x \<up> 2 + -1 * y \<up> 2") = false; (*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
   649   is_expanded (TermC.str2term "x + y") = true;
   650 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   651 if (UnparseC.term t', UnparseC.terms asm) = ("(x + -1 * y) / 1", "[]")
   652 then () else error "rational.sml make_polynomial Schalk 191a";
   653 
   654 "-------- example 191b";
   655 val t = TermC.str2term "((x + (-1) * y)*(x + y))/((1)*(x + y))";
   656 val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
   657 if (UnparseC.term t', UnparseC.terms asm) = ("(x \<up> 2 + -1 * y \<up> 2) / (x + y)", "[]")
   658 then () else error "rational.sml make_polynomial Schalk 191b";
   659 
   660 "-------- example 191c";
   661 val t = TermC.str2term "( 9 * x \<up> 2 + -30 * x + 25 ) / ( 9 * x \<up> 2 + -25 )";
   662   is_expanded (TermC.str2term "9 * x \<up> 2 + -30 * x + 25") = true;
   663   is_expanded (TermC.str2term "25 + -30*x + 9*x \<up> 2") = true;
   664   is_expanded (TermC.str2term "-25 + 9*x \<up> 2") = true;
   665 
   666 val t = TermC.str2term "(((-5) + 3 * x)*((-5) + 3 * x))/((5 + 3 * x)*((-5) + 3 * x))";
   667 val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
   668 if (UnparseC.term t', UnparseC.terms asm) = ("(25 + -30 * x + 9 * x \<up> 2) / (-25 + 9 * x \<up> 2)", "[]")
   669 then () else error "rational.sml make_polynomial Schalk 191c";
   670 
   671 "-------- example 192b";
   672 val t = TermC.str2term "( 7 * x \<up> 3 + -1 * x \<up> 2 * y ) / ( 7 * x * y \<up> 2 + -1 *  y \<up> 3 )";
   673 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   674 if (UnparseC.term t', UnparseC.terms asm) = ("x \<up> 2 / y \<up> 2", "[\"y \<up> 2 \<noteq> 0\"]")
   675 then () else error "rational.sml cancel_p Schalk 192b";
   676 
   677 val t = TermC.str2term "((x \<up> 2)*(7 * x + (-1) * y))/((y \<up> 2)*(7 * x + (-1) * y))";
   678 val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
   679 if (UnparseC.term t', UnparseC.terms asm) = 
   680   ("(7 * x \<up> 3 + -1 * x \<up> 2 * y) / (7 * x * y \<up> 2 + -1 * y \<up> 3)", "[]")
   681 then () else error "rational.sml make_polynomial Schalk 192b";
   682 
   683 val t = TermC.str2term "((x \<up> 2)*(7 * x + (-1) * y))/((y \<up> 2)*(7 * x + (-1) * y))";
   684 val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
   685 if (UnparseC.term t', UnparseC.terms asm) = 
   686   ("(7 * x \<up> 3 + -1 * x \<up> 2 * y) / (7 * x * y \<up> 2 + -1 * y \<up> 3)", "[]")
   687 then () else error "rational.sml make_polynomial Schalk WN050929 not working";
   688 
   689 "-------- example 193a";
   690 val t = TermC.str2term "( x \<up> 2 + -6 * x + 9 ) / ( x \<up> 2 + -9 )";
   691 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   692 if (UnparseC.term t', UnparseC.terms asm) = ("(-3 + x) / (3 + x)", "[\"3 + x \<noteq> 0\"]")
   693 then () else error "rational.sml cancel_p Schalk 193a";
   694 
   695 "-------- example 193b";
   696 val t = TermC.str2term "( x \<up> 2 + -8 * x + 16 ) / ( 2 * x \<up> 2 + -32 )";
   697 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   698 if (UnparseC.term t', UnparseC.terms asm) = ("(-4 + x) / (8 + 2 * x)", "[\"8 + 2 * x \<noteq> 0\"]")
   699 then () else error "rational.sml cancel_p Schalk 193b";
   700 
   701 "-------- example 193c";
   702 val t = TermC.str2term "( 2 * x + -50 * x \<up> 3 ) / ( 25 * x \<up> 2 + -10 * x + 1 )";
   703 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   704 if (UnparseC.term t', UnparseC.terms asm) = 
   705   ("(2 * x + 10 * x \<up> 2) / (1 + -5 * x)", "[\"1 + -5 * x \<noteq> 0\"]")
   706 then () else error "rational.sml cancel_p Schalk 193c";
   707 
   708 (*WN:*)
   709 val t = TermC.str2term "(-25 + 9*x \<up> 2)/(5 + 3*x)";
   710 val SOME (t, asm) = rewrite_set_ thy false cancel_p t;
   711 if (UnparseC.term t', UnparseC.terms asm) = ("(2 * x + 10 * x \<up> 2) / (1 + -5 * x)", "[]")
   712 then () else error "rational.sml cancel WN 1";
   713 
   714 "-------- example heuberger";
   715 val t = TermC.str2term ("(x \<up> 4 + x * y + x \<up> 3 * y + y \<up> 2) / " ^
   716   "(x + 5 * x \<up> 2 + y + 5 * x * y + x \<up> 2 * y \<up> 3 + x * y \<up> 4)");
   717 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   718 if (UnparseC.term t', UnparseC.terms asm) = 
   719   ("(x \<up> 3 + y) / (1 + 5 * x + x * y \<up> 3)", "[\"1 + 5 * x + x * y \<up> 3 \<noteq> 0\"]")
   720 then () else error "rational.sml cancel_p heuberger";
   721 
   722 "-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
   723 "-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
   724 "-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
   725 (*deleted example 204 ... 236b at update Isabelle2012-->2013*)
   726 
   727 "-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
   728 "-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
   729 "-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
   730 val t = TermC.str2term ("123 = (a*x)/(b*x) + (c*x)/(d*x) + (e*x)/(f*x::real)");
   731 "-------- gcd_poly integration level 1: works on exact term";
   732 if NONE = cancel_p_ thy t then () else error "cancel_p_ works on exact fraction";
   733 if NONE = add_fraction_p_ thy t then () else error "add_fraction_p_ works on exact fraction";
   734 
   735 "-------- gcd_poly integration level 2: picks out ONE appropriate subterm";
   736 val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
   737 if UnparseC.term t' = "123 = a * x / (b * x) + c * x / (d * x) + e / f" 
   738 then () else error "level 2, rewrite_set_ cancel_p: changed";
   739 val SOME (t', asm) = rewrite_set_ thy false add_fractions_p t;
   740 if UnparseC.term t' = "123 = (b * c * x + a * d * x) / (b * d * x) + e * x / (f * x)"
   741 then () else error "level 2, rewrite_set_ add_fractions_p: changed";
   742 
   743 "-------- gcd_poly integration level 3: rewrites all appropriate subterms";
   744 val SOME (t', asm) = rewrite_set_ thy false cancel_p_rls t;
   745 if UnparseC.term t' = "123 = a / b + c / d + e / f"
   746 then () else error "level 3, rewrite_set_ cancel_p_rls: changed";
   747 val SOME (t', asm) = rewrite_set_ thy false add_fractions_p_rls t; (*CREATE add_fractions_p_rls*)
   748 if UnparseC.term t' = "123 = (b * d * e * x + b * c * f * x + a * d * f * x) / (b * d * f * x)"
   749 then () else error "level 3, rewrite_set_ add_fractions_p_rls: changed";
   750 
   751 "-------- gcd_poly integration level 4: iteration cancel_p -- add_fraction_p";
   752 (* simpler variant *)
   753 val testrls = Rule_Set.append_rules "testrls" Rule_Set.empty [Rls_ cancel_p, Rls_ add_fractions_p]
   754 val SOME (t', asm) = rewrite_set_ thy false testrls t;
   755 (*Rewrite.trace_on := false;
   756 #  rls: testrls on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x) 
   757 ##  rls: cancel_p on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x) 
   758 ##  rls: add_fractions_p on: 123 = a * x / (b * x) + c * x / (d * x) + e / f 
   759 ##  rls: cancel_p on: 123 = (b * c * x + a * d * x) / (b * d * x) + e / f 
   760 ##  rls: add_fractions_p on: 123 = (b * c + a * d) / (b * d) + e / f 
   761 ##  rls: cancel_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) 
   762 ##  rls: add_fractions_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) *)
   763 if UnparseC.term t' = "123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)"
   764 then () else error "level 4, rewrite_set_ *_p: changed";
   765 
   766 (* complicated variant *)
   767 val testrls_rls = Rule_Set.append_rules "testrls_rls" Rule_Set.empty [Rls_ cancel_p_rls, Rls_ add_fractions_p_rls];
   768 val SOME (t', asm) = rewrite_set_ thy false testrls_rls t;
   769 (*#  rls: testrls_rls on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x) 
   770 ##  rls: cancel_p_rls on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x) 
   771 ###  rls: cancel_p on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x) 
   772 ###  rls: cancel_p on: 123 = a * x / (b * x) + c * x / (d * x) + e / f 
   773 ###  rls: cancel_p on: 123 = a * x / (b * x) + c / d + e / f 
   774 ###  rls: cancel_p on: 123 = a / b + c / d + e / f 
   775 ##  rls: add_fractions_p_rls on: 123 = a / b + c / d + e / f 
   776 ###  rls: add_fractions_p on: 123 = a / b + c / d + e / f 
   777 ###  rls: add_fractions_p on: 123 = (b * c + a * d) / (b * d) + e / f 
   778 ###  rls: add_fractions_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) 
   779 ##  rls: cancel_p_rls on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) 
   780 ###  rls: cancel_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) 
   781 ##  rls: add_fractions_p_rls on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) 
   782 ###  rls: add_fractions_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) *)
   783 if UnparseC.term t' = "123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)"
   784 then () else error "level 4, rewrite_set_ *_p_rls: changed"
   785 
   786 "-------- gcd_poly integration level 5: cancel_p & add_fraction_p within norm_Rational";
   787 val SOME (t', asm) = rewrite_set_ thy false norm_Rational t;
   788 if UnparseC.term t' = "123 = (a * d * f + b * c * f + b * d * e) / (b * d * f)"
   789 then () else error "level 5, rewrite_set_ norm_Rational: changed"
   790 
   791 "-------- reverse rewrite ----------------------------------------------------";
   792 "-------- reverse rewrite ----------------------------------------------------";
   793 "-------- reverse rewrite ----------------------------------------------------";
   794 (** the term for which reverse rewriting is demonstrated **)
   795 val t = TermC.str2term "(9 + -1 * x \<up> 2) / (9 + 6 * x + x \<up> 2)";
   796 val Rrls {scr = Rfuns {init_state = ini, locate_rule = loc,
   797   next_rule = nex, normal_form = nor, ...},...} = cancel_p;
   798 
   799 (** normal_form produces the result in ONE step **)
   800   val SOME (t',_) = nor t;
   801 if UnparseC.term t' = "(3 + -1 * x) / (3 + x)" then ()
   802 else error "rational.sml normal_form (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
   803 
   804 (** initialize the interpreter state used by the 'me' **)
   805   val (t, _, revsets, _) = ini t;
   806 
   807 if length (hd revsets) = 11 then () else error "length of revset changed";
   808 if (revsets |> nth 1 |> nth 1 |> id_of_thm) = 
   809   (@{thm realpow_twoI} |> Thm.get_name_hint |> ThmC.cut_id)
   810 then () else error "first element of revset changed";
   811 if
   812 (revsets |> nth 1 |> nth 1 |> Rule.to_string) = "Thm (\"realpow_twoI\",?r1 \<up> 2 = ?r1 * ?r1)" andalso
   813 (revsets |> nth 1 |> nth 2 |> Rule.to_string) = "Thm (\"#: 9 = 3 \<up> 2\",9 = 3 \<up> 2)" andalso
   814 (revsets |> nth 1 |> nth 3 |> Rule.to_string) = "Thm (\"#: 6 * x = 2 * (3 * x)\",6 * x = 2 * (3 * x))" 
   815 andalso
   816 (revsets |> nth 1 |> nth 4 |> Rule.to_string) = "Thm (\"#: -3 * x = -1 * (3 * x)\",-3 * x = -1 * (3 * x))" 
   817 andalso
   818 (revsets |> nth 1 |> nth 5 |> Rule.to_string) = "Thm (\"#: 9 = 3 * 3\",9 = 3 * 3)" andalso
   819 (revsets |> nth 1 |> nth 6 |> Rule.to_string) = "Rls_ (\"sym_order_mult_rls_\")" andalso
   820 (revsets |> nth 1 |> nth 7 |> Rule.to_string) = 
   821   "Thm (\"sym_mult.assoc\",?a * (?b * ?c) = ?a * ?b * ?c)"
   822 then () else error "first 7 elements in revset changed"
   823 
   824 (** find the rule 'r' to apply to term 't' **)
   825 (*/------- WN1309: since cancel_ (accepted "-" between monomials) has been replaced by cancel_p_ 
   826   for Isabelle2013, we don't get a working revset, but non-termination:
   827 
   828   val SOME (r as (Thm (str, thm))) = nex revsets t;
   829   :
   830 ((3 * 3 + -1 * x * x) / (3 * 3 + 2 * 3 * x + x * x), 
   831   Rls_ ("sym_order_mult_rls_"), ((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * (3 * x) + x * x), []))", "
   832 ((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * (3 * x) + x * x), 
   833   Thm ("sym_mult.assoc", ""), ((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * 3 * x + x * x), []))", "
   834 ((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * 3 * x + x * x), 
   835   Thm ("sym_mult.assoc", ""), ((3 * 3 + -1 * x * x) / (3 * 3 + 2 * 3 * x + x * x), []))", "
   836 ((3 * 3 + -1 * x * x) / (3 * 3 + 2 * 3 * x + x * x), Rls_ ("sym_order_mult_rls_"), ((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * (3 * x) + x * x), []))", "
   837  :
   838 ### Isabelle2002:
   839   Thm ("sym_#mult_2_3", "6 = 2 * 3")
   840 ### Isabelle2009-2 for cancel_ (not cancel_p_):
   841 if str = "sym_#power_Float ((3,0), (0,0)) __ ((2,0), (0,0))"
   842    andalso ThmC.string_of_thm thm = 
   843            (string_of_thm (Thm.make_thm @{theory "Isac_Knowledge"}
   844                (Trueprop $ (Thm.term_of o the o (TermC.parse thy)) "9 = 3 \<up> 2"))) then ()
   845 else error "rational.sml next_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
   846 \---------------------------------------------------------------------------------------/*)
   847 
   848 (** check, if the rule 'r' applied by the user to 't' belongs to the ruleset;
   849   if the rule is OK, the term resulting from applying the rule is returned,too;
   850   there might be several rule applications inbetween,
   851   which are listed after the head in reverse order **)
   852 (*/-------------------------------------------- Isabelle2013: this gives "error id_of_thm";
   853   we don't repair this, because interaction within "reverse rewriting" never worked properly:
   854 
   855   val (r, (t, asm))::_ = loc revsets t r;
   856 if UnparseC.term t = "(9 - x \<up> 2) / (3 \<up> 2 + 6 * x + x \<up> 2)" andalso asm = []
   857 then () else error "rational.sml locate_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
   858 
   859 (* find the next rule to apply *)
   860   val SOME (r as (Thm (str, thm))) = nex revsets t;
   861 if str = "sym_#power_Float ((3,0), (0,0)) __ ((2,0), (0,0))" andalso
   862    ThmC.string_of_thm thm = (string_of_thm (ThmC_Def.make_thm @{theory "Isac_Knowledge"}
   863                 (Trueprop $ (Thm.term_of o the o (TermC.parse thy)) "9 = 3 \<up> 2"))) then ()
   864 else error "rational.sml next_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
   865 
   866 (*check the next rule*)
   867   val (r, (t, asm)) :: _ = loc revsets t r;
   868 if UnparseC.term t = "(3 \<up> 2 - x \<up> 2) / (3 \<up> 2 + 6 * x + x \<up> 2)" then ()
   869 else error "rational.sml locate_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2) II";
   870 
   871 (*find and check the next rules, rewrite*)
   872   val SOME r = nex revsets t;
   873   val (r,(t,asm))::_ = loc revsets t r;
   874 if UnparseC.term t = "(3 \<up> 2 - x \<up> 2) / (3 \<up> 2 + 2 * 3 * x + x \<up> 2)" then ()
   875 else error "rational.sml locate_rule II";
   876 
   877   val SOME r = nex revsets t;
   878   val (r,(t,asm))::_ = loc revsets t r;
   879 if UnparseC.term t = "(3 - x) * (3 + x) / (3 \<up> 2 + 2 * 3 * x + x \<up> 2)" then ()
   880 else error "rational.sml next_rule II";
   881 
   882   val SOME r = nex revsets t;
   883   val (r,(t,asm))::_ = loc revsets t r;
   884 if UnparseC.term t = "(3 - x) * (3 + x) / ((3 + x) * (3 + x))" then ()
   885 else error "rational.sml next_rule III";
   886 
   887   val SOME r = nex revsets t;
   888   val (r, (t, asm)) :: _ = loc revsets t r;
   889   val ss = UnparseC.term t;
   890 if ss = "(3 - x) / (3 + x)" andalso UnparseC.terms asm = "[\"3 + x ~= 0\"]" then ()
   891 else error "rational.sml: new behav. in rev-set cancel";
   892 \--------------------------------------------------------------------------------------/*)
   893 
   894 "-------- 'reverse-ruleset' cancel_p -----------------------------------------";
   895 "-------- 'reverse-ruleset' cancel_p -----------------------------------------";
   896 "-------- 'reverse-ruleset' cancel_p -----------------------------------------";
   897 (*WN130909: the example below shows, why "reverse rewriting" only worked for
   898   special cases.*)
   899 
   900 (*the term for which reverse rewriting is demonstrated*)
   901 val t = TermC.str2term "(9 + (-1)*x \<up> 2) / (9 + ((-6)*x + x \<up> 2))";
   902 val Rrls {scr=Rfuns {init_state=ini,locate_rule=loc,
   903 		       next_rule=nex,normal_form=nor,...},...} = cancel_p;
   904 
   905 (*normal_form produces the result in ONE step*)
   906 val SOME (t',_) = nor t; 
   907 UnparseC.term t' = "(3 + 1 * x) / (3 + -1 * x)";
   908 
   909 (*initialize the interpreter state used by the 'me'*)
   910 val SOME (t', asm) = cancel_p_ thy t;
   911 UnparseC.term t' = "(3 + x) / (3 + -1 * x)" (*true*);
   912 UnparseC.terms asm = "[\"3 + -1 * x ~= 0\"]" (*true*);
   913 val (t,_,revsets,_) = ini t;
   914 
   915 (* WN.10.10.02: dieser Fall terminiert nicht 
   916            (make_polynomial enth"alt zu viele rules)
   917 WN060823 'init_state' requires rewriting on specified location in the term
   918 default_print_depth 99; Rfuns; default_print_depth 3;
   919 WN060831 cycling "sym_order_mult_rls_" "sym_mult.assoc"
   920          as was with make_polynomial before ?!?*)
   921 
   922 val SOME r = nex revsets t;
   923 eq_Thm (r, Thm ("sym_#power_Float ((3,0), (0,0)) __ ((2,0), (0,0))", 
   924 		mk_thm thy "9 = 3 \<up> 2"));
   925 (*WN060831 *** id_of_thm
   926            Exception- ERROR raised ...
   927 val (r,(t,asm))::_ = loc revsets t r;
   928 UnparseC.term t;
   929 
   930   val SOME r = nex revsets t;
   931   val (r,(t,asm))::_ = loc revsets t r;
   932   UnparseC.term t;
   933 *)                    
   934 
   935 "-------- examples: rls norm_Rational ----------------------------------------";
   936 "-------- examples: rls norm_Rational ----------------------------------------";
   937 "-------- examples: rls norm_Rational ----------------------------------------";
   938 val t = TermC.str2term "(3*x+5)/18 - x/2  - -(3*x - 2)/9 = 0";
   939 val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
   940 if UnparseC.term t' = "1 / 18 = 0" then () else error "rational.sml 1";
   941 
   942 val t = TermC.str2term "(17*x - 51)/9 - (-(13*x - 3)/6) + 11 - (9*x - 7)/4 = 0";
   943 val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
   944 if UnparseC.term t' = "(237 + 65 * x) / 36 = 0" then () 
   945 else error "rational.sml 2";
   946 
   947 val t = TermC.str2term "(1/2 + (5*x)/2) \<up> 2 - ((13*x)/2 - 5/2) \<up> 2 - (6*x) \<up> 2 + 29";
   948 val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
   949 if UnparseC.term t' = "23 + 35 * x + -72 * x \<up> 2" then ()
   950 else error "rational.sml 3";
   951 
   952 (*Rewrite.trace_on:=true;*)
   953 val t = TermC.str2term "Not (6*x is_atom)";
   954 val SOME (t',_) = rewrite_set_ thy false powers_erls t; UnparseC.term t';
   955 \<^const_name>\<open>True\<close>;
   956 val t = TermC.str2term "1 < 2";
   957 val SOME (t',_) = rewrite_set_ thy false powers_erls t; UnparseC.term t';
   958 \<^const_name>\<open>True\<close>;
   959 
   960 val t = TermC.str2term "(6*x) \<up> 2";
   961 val SOME (t',_) = rewrite_ thy dummy_ord powers_erls false 
   962 			   (ThmC.numerals_to_Free @{thm realpow_def_atom}) t;
   963 if UnparseC.term t' = "6 * x * (6 * x) \<up> (2 + -1)" then ()
   964 else error "rational.sml powers_erls (6*x) \<up> 2";
   965 
   966 val t = TermC.str2term "-1 * (-2 * (5 / 2 * (13 * x / 2)))";
   967 val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
   968 if UnparseC.term t' = "65 * x / 2" then () else error "rational.sml 4";
   969 
   970 val t = TermC.str2term "1 - ((13*x)/2 - 5/2) \<up> 2";
   971 val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
   972 if UnparseC.term t' = "(-21 + 130 * x + -169 * x \<up> 2) / 4" then () 
   973 else error "rational.sml 5";
   974 
   975 (*SRAM Schalk I, p.92 Nr. 609a*)
   976 val t = TermC.str2term "2*(3 - x/5)/3 - 4*(1 - x/3) - x/3 - 2*(x/2 - 1/4)/27 +5/54";
   977 val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
   978 if UnparseC.term t' = "(-255 + 112 * x) / 135" then () 
   979 else error "rational.sml 6";
   980 
   981 (*SRAM Schalk I, p.92 Nr. 610c*)
   982 val t = TermC.str2term "((x- 1)/(x+1) + 1) / ((x- 1)/(x+1) - (x+1)/(x- 1)) - 2";
   983 val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
   984 if UnparseC.term t' = "(3 + x) / -2" then () else error "rational.sml 7";
   985 
   986 (*SRAM Schalk I, p.92 Nr. 476a*)
   987 val t = TermC.str2term "(x \<up> 2/(1 - x \<up> 2) + 1)/(x/(1 - x) + 1) * (1 + x)";
   988 (*. a/b : c/d translated to a/b * d/c .*)
   989 val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
   990 if UnparseC.term t' = "1" then () else error "rational.sml 8";
   991 
   992 (*Schalk I, p.92 Nr. 472a*)
   993 val t = TermC.str2term "((8*x \<up> 2 - 32*y \<up> 2)/(2*x + 4*y))/((4*x - 8*y)/(x + y))";
   994 val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
   995 if UnparseC.term t' = "x + y" then () else error "rational.sml p.92 Nr. 472a";
   996 
   997 (*Schalk I, p.70 Nr. 480b: SEE rational.sml --- nonterminating rls norm_Rational ---*)
   998 
   999 (*WN130910 add_fractions_p exception Div raised + history:
  1000 ### WN.2.6.03 from rlang.sml 56a 
  1001 val t = TermC.str2term "(a + b * x) / (a + -1 * (b * x)) + (-1 * a + b * x) / (a + b * x) = 4 * (a * b) / (a \<up> 2 + -1 * b \<up> 2)";
  1002 val NONE = rewrite_set_ thy false add_fractions_p t;
  1003 
  1004 THE ERROR ALREADY OCCURS IN THIS PART:
  1005 val t = TermC.str2term "(a + b * x) / (a + -1 * (b * x)) + (-1 * a + b * x) / (a + b * x)";
  1006 val NONE = add_fraction_p_ thy t;
  1007 
  1008 SEE Test_Some.thy: section {* add_fractions_p downto exception Div raised ===
  1009 *)
  1010 
  1011 "-------- rational numerals --------------------------------------------------";
  1012 "-------- rational numerals --------------------------------------------------";
  1013 "-------- rational numerals --------------------------------------------------";
  1014 (*SRA Schalk I, p.40 Nr. 164b *)
  1015 val t = TermC.str2term "(47/6 - 76/9 + 13/4)/(35/12)";
  1016 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1017 UnparseC.term t;
  1018 if UnparseC.term t = "19 / 21" then ()
  1019 else error "rational.sml: diff.behav. in norm_Rational_mg 1";
  1020 
  1021 (*SRA Schalk I, p.40 Nr. 166a *)
  1022 val t = TermC.str2term "((5/4)/(4+22/7) + 37/20)*(110/3 - 110/9 * 23/11)";
  1023 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1024 UnparseC.term t;
  1025 if UnparseC.term t = "45 / 2" then ()
  1026 else error "rational.sml: diff.behav. in norm_Rational_mg 2";
  1027 
  1028 "-------- examples cancellation from: Mathematik 1 Schalk --------------------";
  1029 "-------- examples cancellation from: Mathematik 1 Schalk --------------------";
  1030 "-------- examples cancellation from: Mathematik 1 Schalk --------------------";
  1031 (* e190c Stefan K.*)
  1032 val t = TermC.str2term "((1 + 9*a \<up> 2) * (1 + 3*a)) / ((3*a + 9*a \<up> 2) * (1 + 3*a))";
  1033 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1034 if UnparseC.term t = "(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)"
  1035 then () else error "rational.sml: diff.behav. in norm_Rational_mg 3";
  1036 
  1037 (* e192b Stefan K.*)
  1038 val t = TermC.str2term "(x \<up> 2 * (7*x + (-1)*y))  /  (y \<up> 2 * (7*x + (-1)*y))";
  1039 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1040 if UnparseC.term t = "x \<up> 2 / y \<up> 2"
  1041 then () else error "rational.sml: diff.behav. in norm_Rational_mg 4";
  1042 
  1043 (*SRC Schalk I, p.66 Nr. 379c *)
  1044 val t = TermC.str2term "(a - b)/(b - a)";
  1045 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1046 UnparseC.term t;
  1047 if UnparseC.term t = "-1"
  1048 then () else error "rational.sml: diff.behav. in norm_Rational_mg 5";
  1049 
  1050 (*SRC Schalk I, p.66 Nr. 380b *)
  1051 val t = TermC.str2term "15*(3*x + 3) * (4*x + 9)  /  (12*(2*x + 7) * (5*x + 5))";
  1052 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1053 if UnparseC.term t = "(27 + 12 * x) / (28 + 8 * x)"
  1054 then () else error "rational.sml: diff.behav. in norm_Rational_mg 6";
  1055 
  1056 (*Schalk I, p.60 Nr. 215c: was not cancelled with Isabelle2002 *)
  1057 val t = TermC.str2term "(a + b) \<up> 4 * (x - y)  /  ((x - y) \<up> 3 * (a + b) \<up> 2)";
  1058 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1059 if UnparseC.term t = "(a \<up> 2 + 2 * a * b + b \<up> 2) / (x \<up> 2 + -2 * x * y + y \<up> 2)"
  1060 then () else error "rational.sml: diff.behav. in norm_Rational_mg 7";
  1061 
  1062 (*SRC Schalk I, p.66 Nr. 381b *)
  1063 val t = TermC.str2term 
  1064 "(4*x \<up> 2 - 20*x + 25)/(2*x - 5) \<up> 3";
  1065 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1066 if UnparseC.term t = "1 / (-5 + 2 * x)"
  1067 then () else error "rational.sml: diff.behav. in norm_Rational_mg 9";
  1068 
  1069 (* e190c Stefan K.*)
  1070 val t = TermC.str2term "((1 + 9*a \<up> 2) * (1 + 3*a))  /  ((3*a + 9*a \<up> 2) * (1 + 3 * a))";
  1071 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1072 if UnparseC.term t =  "(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)"
  1073 then () else error "rational.sml: diff.behav. in norm_Rational_mg 3";
  1074 
  1075 (* e192b Stefan K.*)
  1076 val t = TermC.str2term "(x \<up> 2 * (7*x + (-1)*y))  /  (y \<up> 2 * (7*x + (-1)*y))";
  1077 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1078 if UnparseC.term t = "x \<up> 2 / y \<up> 2"
  1079 then () else error "rational.sml: diff.behav. in norm_Rational_mg 4";
  1080 
  1081 (*SRC Schalk I, p.66 Nr. 379c *)
  1082 val t = TermC.str2term "(a - b) / (b - a)";
  1083 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1084 if UnparseC.term t = "-1"
  1085 then () else error "rational.sml: diff.behav. in norm_Rational_mg 5";
  1086 
  1087 (*SRC Schalk I, p.66 Nr. 380b *)
  1088 val t = TermC.str2term "15*(3*x + 3) * (4*x + 9)  /  (12*(2*x + 7) * (5*x + 5))";
  1089 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1090 if UnparseC.term t = "(27 + 12 * x) / (28 + 8 * x)"
  1091 then () else error "rational.sml: diff.behav. in norm_Rational_mg 6";
  1092 
  1093 (*Schalk I, p.60 Nr. 215c *)
  1094 val t = TermC.str2term "(a + b) \<up> 4 * (x - y)  /  ((x - y) \<up> 3 * (a + b) \<up> 2)";
  1095 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1096 if UnparseC.term t = "(a \<up> 2 + 2 * a * b + b \<up> 2) / (x \<up> 2 + -2 * x * y + y \<up> 2)"
  1097 then () else error "Schalk I, p.60 Nr. 215c: with Isabelle2002 cancellation incomplete, changed";
  1098 
  1099 (* extreme example from somewhere *)
  1100 val t = TermC.str2term 
  1101     ("(a \<up> 4 * x  +  -1*a \<up> 4 * y  +  4*a \<up> 3 * b * x  +  -4*a \<up> 3 * b * y  + " ^
  1102       "6*a \<up> 2 * b \<up> 2 * x  +  -6*a \<up> 2 * b \<up> 2 * y  +  4*a * b \<up> 3 * x  +  -4*a * b \<up> 3 * y  + " ^
  1103       "b \<up> 4 * x  +  -1*b \<up> 4 * y) " ^
  1104   " / (a \<up> 2 * x \<up> 3  +  -3*a \<up> 2 * x \<up> 2 * y  +  3*a \<up> 2 * x * y \<up> 2  +  -1*a \<up> 2 * y \<up> 3 + " ^
  1105       "2*a * b * x \<up> 3  +  -6*a * b * x \<up> 2 * y  +  6*a * b * x * y \<up> 2  +  -2*a * b * y \<up> 3 + " ^
  1106       "b \<up> 2 * x \<up> 3  +  -3*b \<up> 2 * x \<up> 2 * y  +  3*b \<up> 2 * x * y \<up> 2  +  -1*b \<up> 2 * y \<up> 3)")
  1107 val SOME (t, _) = rewrite_set_ thy false cancel_p t;
  1108 if UnparseC.term t = "(a \<up> 2 + 2 * a * b + b \<up> 2) / (x \<up> 2 + -2 * x * y + y \<up> 2)"
  1109 then () else error "with Isabelle2002: NONE -- now SOME changed";
  1110 
  1111 (*Schalk I, p.66 Nr. 381a *)
  1112 (* ATTENTION: here the rls is very slow. In Isabelle2002 this required 2 min *)
  1113 val t = TermC.str2term "18*(a + b) \<up> 3 * (a - b) \<up> 2 / (72*(a - b) \<up> 3 * (a + b) \<up> 2)";
  1114 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1115 if UnparseC.term t = "(a + b) / (4 * a + -4 * b)"
  1116 then () else error "rational.sml: diff.behav. in norm_Rational_mg 8";
  1117 
  1118 (*SRC Schalk I, p.66 Nr. 381b *)
  1119 val t = TermC.str2term "(4*x \<up> 2 - 20*x + 25) / (2*x - 5) \<up> 3";
  1120 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1121 if UnparseC.term t = "1 / (-5 + 2 * x)"
  1122 then () else error "rational.sml: diff.behav. in norm_Rational_mg 9";
  1123 
  1124 (*SRC Schalk I, p.66 Nr. 381c *)
  1125 val t = TermC.str2term "(27*a \<up> 3 + 9*a \<up> 2+3*a+1) / (27*a \<up> 3 + 18*a \<up> 2+3*a)";
  1126 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1127 if UnparseC.term t = "(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)"
  1128 then () else error "rational.sml: diff.behav. in norm_Rational_mg 10";
  1129 
  1130 (*SRC Schalk I, p.66 Nr. 383a *)
  1131 val t = TermC.str2term "(5*a \<up> 2 - 5*a*b) / (a - b) \<up> 2";
  1132 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1133 if UnparseC.term t = "-5 * a / (-1 * a + b)"
  1134 then () else error "rational.sml: diff.behav. in norm_Rational_mg 11";
  1135 
  1136 "----- NOT TERMINATING ?: worked before 0707xx";
  1137 val t = TermC.str2term "(a \<up> 2 - 1)*(b + 1) / ((b \<up> 2 - 1)*(a+1))";
  1138 (* WN130911 "exception Div raised" by 
  1139   cancel_p_ thy (TermC.str2term ("(-1 + -1 * b + a \<up> 2 + a \<up> 2 * b) /" ^
  1140                            "(-1 + -1 * a + b \<up> 2 + a * b \<up> 2)"))
  1141 
  1142 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1143 if UnparseC.term t = "(1 + -1 * a) / (1 + -1 * b)" then ()
  1144 else error "rational.sml MG tests 3e";
  1145 *)
  1146 
  1147 "-------- examples common denominator from: Mathematik 1 Schalk --------------";
  1148 "-------- examples common denominator from: Mathematik 1 Schalk --------------";
  1149 "-------- examples common denominator from: Mathematik 1 Schalk --------------";
  1150 (*SRA Schalk I, p.67 Nr. 403a *)
  1151 val t = TermC.str2term "4/x - 3/y - 1";
  1152 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1153 if UnparseC.term t = "(-3 * x + 4 * y + -1 * x * y) / (x * y)"
  1154 then () else error "rational.sml: diff.behav. in norm_Rational_mg 12";
  1155 
  1156 val t = TermC.str2term "(2*a+3*b)/(b*c) + (3*c+a)/(a*c) - (2*a \<up> 2+3*b*c)/(a*b*c)";
  1157 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1158 if UnparseC.term t = "4 / c"
  1159 then () else error "rational.sml: diff.behav. in norm_Rational_mg 13";
  1160 
  1161 (*SRA Schalk I, p.67 Nr. 410b *)
  1162 val t = TermC.str2term "1/(x+1) + 1/(x+2) - 2/(x+3)";
  1163 (* WN130911 non-termination due to non-termination of
  1164   cancel_p_ thy (TermC.str2term "(5 + 3 * x) / (6 + 11 * x + 6 * x \<up> 2 + x \<up> 3)")
  1165 
  1166 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1167 if UnparseC.term t = "(5 + 3 * x) / (6 + 11 * x + 6 * x \<up> 2 + x \<up> 3)"
  1168 then () else error "rational.sml: diff.behav. in norm_Rational_mg 14";
  1169 *)
  1170 
  1171 (*SRA Schalk I, p.67 Nr. 413b *)
  1172 val t = TermC.str2term "(1 + x)/(1 - x)  -  (1 - x)/(1 + x)  +  2*x/(1 - x \<up> 2)";
  1173 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1174 if UnparseC.term t = "6 * x / (1 + -1 * x \<up> 2)"
  1175 then () else error "rational.sml: diff.behav. in norm_Rational_mg 15";
  1176 
  1177 (*SRA Schalk I, p.68 Nr. 414a *)
  1178 val t = TermC.str2term "(x + 2)/(x - 1)  +  (x - 3)/(x - 2)  -  (x + 1)/((x - 1)*(x - 2))";
  1179 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1180 if UnparseC.term t ="(-2 + -5 * x + 2 * x \<up> 2) / (2 + -3 * x + x \<up> 2)"
  1181 then () else error "rational.sml: diff.behav. in norm_Rational_mg 16";
  1182 
  1183 (*SRA Schalk I, p.68 Nr. 428b *)
  1184 val t = TermC.str2term 
  1185   "1/(a - b) \<up> 2  +  1/(a + b) \<up> 2  -  2/(a \<up> 2 - b \<up> 2)  -  4*(b \<up> 2 - 1)/(a \<up> 2 - b \<up> 2) \<up> 2";
  1186 (* WN130911 non-termination due to non-termination of
  1187   cancel_p_ thy (TermC.str2term "(4 + -4 * b \<up> 2) / (a \<up> 4 + -2 * (a \<up> 2 * b \<up> 2) + b \<up> 4)")
  1188 
  1189 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1190 if UnparseC.term t = "4 / (a \<up> 4 + -2 * a \<up> 2 * b \<up> 2 + b \<up> 4)"
  1191 then () else error "rational.sml: diff.behav. in norm_Rational_mg 18";
  1192 *)
  1193 
  1194 (*SRA Schalk I, p.68 Nr. 430b *)
  1195 val t = TermC.str2term 
  1196   "a \<up> 2/(a - 3*b) - 108*a*b \<up> 3/((a+3*b)*(a \<up> 2 - 9*b \<up> 2)) - 9*b \<up> 2*(a - 3*b)/(a+3*b) \<up> 2";
  1197 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1198 if UnparseC.term t = "a + 3 * b"
  1199 then () else error "rational.sml: diff.behav. in norm_Rational_mg 19";
  1200 
  1201 (*SRA Schalk I, p.68 Nr. 432 *)
  1202 val t = TermC.str2term 
  1203   ("(a \<up> 2 + a*b) / (a \<up> 2 - b \<up> 2)  -  (b \<up> 2 - a*b) / (b \<up> 2 - a \<up> 2)  +  " ^
  1204   "a \<up> 2*(a - b) / (a \<up> 3 - a \<up> 2*b)  -  2*a*(a \<up> 2 - b \<up> 2) / (a \<up> 3 - a*b \<up> 2)  -  " ^
  1205   "2*b \<up> 2 / (a \<up> 2 - b \<up> 2)");
  1206 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1207 if UnparseC.term t = (*"0" ..isabisac15 | Isabelle2017..*)  "0 / (a \<up> 2 + -1 * b \<up> 2)"
  1208 then () else error "rational.sml: diff.behav. in norm_Rational_mg 20";
  1209 
  1210 (* some example *)
  1211 val t = TermC.str2term "3*a / (a*b)  +  x/y";
  1212 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1213 if UnparseC.term t = "(3 * y + b * x) / (b * y)"
  1214 then () else error "rational.sml: diff.behav. in norm_Rational_mg 21";
  1215 
  1216 "-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
  1217 "-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
  1218 "-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
  1219 (*------- SRM Schalk I, p.68 Nr. 436a *)
  1220 val t = TermC.str2term "3*(x+y) / (15*(x - y))  *   25*(x - y) \<up> 2 / (18*(x + y) \<up> 2)";
  1221 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1222 if UnparseC.term t = "(-5 * x + 5 * y) / (-18 * x + -18 * y)"
  1223 then () else error "rational.sml: diff.behav. in norm_Rational_mg 22";
  1224 
  1225 (*------- SRM.test Schalk I, p.68 Nr. 436b *)
  1226 val t = TermC.str2term "5*a*(a - b) \<up> 2*(a + b) \<up> 3/(7*b*(a - b) \<up> 3) * 7*b/(a + b) \<up> 3";
  1227 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1228 if UnparseC.term t = "5 * a / (a + -1 * b)"
  1229 then () else error "rational.sml: diff.behav. in norm_Rational_mg 23";
  1230 
  1231 (*------- Schalk I, p.68 Nr. 437a *)
  1232 val t = TermC.str2term "(3*a - 4*b) / (4*c+3*e)  *  (3*a+4*b)/(9*a \<up> 2 - 16*b \<up> 2)";
  1233 (* raises an exception for unclear reasons:
  1234 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1235 :
  1236 ###  rls: cancel_p on: (9 * a \<up> 2 + -16 * b \<up> 2) / (4 * c + 3 * e) /
  1237 (9 * a \<up> 2 + -16 * b \<up> 2) 
  1238 exception Div raised
  1239 
  1240 BUT
  1241 val t = TermC.str2term 
  1242   ("(9 * a \<up> 2 + -16 * b \<up> 2) / (4 * c + 3 * e) /" ^
  1243   "(9 * a \<up> 2 + -16 * b \<up> 2)");
  1244 NONE = cancel_p_ thy t;
  1245 
  1246 if UnparseC.term t = "1 / (4 * c + 3 * e)" then ()
  1247 else error "rational.sml: diff.behav. in norm_Rational_mg 24";
  1248 *)
  1249 
  1250 "----- S.K. corrected non-termination 060904";
  1251 val t = TermC.str2term "(3*a - 4*b) * (3*a+4*b)/((4*c+3*e)*(9*a \<up> 2 - 16*b \<up> 2))";
  1252 val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
  1253 if UnparseC.term t = 
  1254   "(9 * a \<up> 2 + -16 * b \<up> 2) /\n(36 * a \<up> 2 * c + 27 * a \<up> 2 * e + -64 * b \<up> 2 * c +\n -48 * b \<up> 2 * e)"
  1255 (*"(9 * a \<up> 2 + -16 * b \<up> 2) / (36 * a \<up> 2 * c + 27 * a \<up> 2 * e + -64 * b \<up> 2 * c + -48 * b \<up> 2 * e)"*)
  1256 then () else error "rational.sml: S.K.8..corrected 060904-6";
  1257 
  1258 "----- S.K. corrected non-termination of cancel_p_";
  1259 val t'' = TermC.str2term ("(9 * a \<up> 2 + -16 * b \<up> 2) /" ^
  1260   "(36 * a \<up> 2 * c + (27 * a \<up> 2 * e + (-64 * b \<up> 2 * c + -48 * b \<up> 2 * e)))");
  1261 (* /--- DOES NOT TERMINATE AT TRANSITION isabisac15 --> Isabelle2017 --------------------------\
  1262 val SOME (t',_) = rewrite_set_ thy false cancel_p t'';
  1263 if UnparseC.term t' = "1 / (4 * c + 3 * e)"
  1264 then () else error "rational.sml: diff.behav. in cancel_p S.K.8";
  1265    \--- DOES NOT TERMINATE AT TRANSITION isabisac15 --> Isabelle2017 --------------------------/*)
  1266 
  1267 (*------- Schalk I, p.68 Nr. 437b*)
  1268 val t = TermC.str2term "(a + b)/(x \<up> 2 - y \<up> 2) * ((x - y) \<up> 2/(a \<up> 2 - b \<up> 2))";
  1269 (*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1270 :
  1271 ####  rls: cancel_p on: (a * x \<up> 2 + -2 * (a * (x * y)) + a * y \<up> 2 + b * x \<up> 2 +
  1272  -2 * (b * (x * y)) +
  1273  b * y \<up> 2) /
  1274 (a \<up> 2 * x \<up> 2 + -1 * (a \<up> 2 * y \<up> 2) + -1 * (b \<up> 2 * x \<up> 2) +
  1275  b \<up> 2 * y \<up> 2) 
  1276 exception Div raised
  1277 *)
  1278 
  1279 (*------- SRM Schalk I, p.68 Nr. 438a *)
  1280 val t = TermC.str2term "x*y / (x*y - y \<up> 2)  *  (x \<up> 2 - x*y)";
  1281 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1282 if UnparseC.term t = "x \<up> 2"
  1283 then () else error "rational.sml: diff.behav. in norm_Rational_mg 24";
  1284 
  1285 (*------- SRM Schalk I, p.68 Nr. 439b *)
  1286 val t = TermC.str2term "(4*x \<up> 2 + 4*x + 1)  *  ((x \<up> 2 - 2*x \<up> 3) / (4*x \<up> 2 + 2*x))";
  1287 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1288 if UnparseC.term t = "(x + -4 * x \<up> 3) / 2"
  1289 then () else error "rational.sml: diff.behav. in norm_Rational_mg 25";
  1290 
  1291 (*------- SRM Schalk I, p.68 Nr. 440a *)
  1292 val t = TermC.str2term "(x \<up> 2 - 2*x) / (x \<up> 2 - 3*x)  *  (x - 3) \<up> 2 / (x \<up> 2 - 4)";
  1293 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1294 if UnparseC.term t = "(-3 + x) / (2 + x)"
  1295 then () else error "rational.sml: diff.behav. in norm_Rational_mg 26";
  1296 
  1297 "----- Schalk I, p.68 Nr. 440b SK11 works since 0707xx";
  1298 val t = TermC.str2term "(a \<up> 3 - 9*a) / (a \<up> 3*b - a*b \<up> 3)  *  (a \<up> 2*b + a*b \<up> 2) / (a+3)";
  1299 (* WN130911 non-termination for unclear reasons:
  1300 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1301 
  1302 ... ENDS WITH THIS TRACE:
  1303 :
  1304 ###  rls: cancel_p on: (-9 * (a \<up> 3 * b) + -9 * (a \<up> 2 * b \<up> 2) + a \<up> 5 * b +
  1305  a \<up> 4 * b \<up> 2) /
  1306 (a \<up> 3 * b + -1 * (a * b \<up> 3)) /
  1307 (3 + a)
  1308 BUT THIS IS CORRECTLY RECOGNISED 
  1309 val t = TermC.str2term 
  1310   ("(-9 * (a \<up> 3 * b) + -9 * (a \<up> 2 * b \<up> 2) + a \<up> 5 * b + a \<up> 4 * b \<up> 2)  /" ^
  1311   "(a \<up> 3 * b + -1 * (a * b \<up> 3))  /  (3 + (a::real))");
  1312 AS
  1313 NONE = cancel_p_ thy t;
  1314 
  1315 if UnparseC.term t = "(-3 * a + a \<up> 2) / (a + -1 * b)" then ()
  1316 else error "rational.sml: diff.behav. in norm_Rational 27";
  1317 *)
  1318 
  1319 "----- SK12 works since 0707xx";
  1320 val t = TermC.str2term "(a \<up> 3 - 9*a) * (a \<up> 2*b+a*b \<up> 2)  /  ((a \<up> 3*b - a*b \<up> 3) * (a+3))";
  1321 (* WN130911 non-termination due to non-termination of
  1322   cancel_p_ thy (TermC.str2term "(4 + -4 * b \<up> 2) / (a \<up> 4 + -2 * (a \<up> 2 * b \<up> 2) + b \<up> 4)")
  1323 
  1324 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1325 if UnparseC.term t' = "(-3 * a + a \<up> 2) / (a + -1 * b)" then ()
  1326 else error "rational.sml: diff.behav. in norm_Rational 28";
  1327 *)
  1328 
  1329 "-------- examples common denominator and multiplication from: Schalk --------";
  1330 "-------- examples common denominator and multiplication from: Schalk --------";
  1331 "-------- examples common denominator and multiplication from: Schalk --------";
  1332 (*------- SRAM Schalk I, p.69 Nr. 441b *)
  1333 val t = TermC.str2term "(4*a/3 + 3*b \<up> 2/a \<up> 3 + b/(4*a))*(4*b/(3*a))";
  1334 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1335 if UnparseC.term t = "(36 * b \<up> 3 + 3 * a \<up> 2 * b \<up> 2 + 16 * a \<up> 4 * b) / (9 * a \<up> 4)"
  1336 then () else error "rational.sml: diff.behav. in norm_Rational_mg 28";
  1337 
  1338 (*------- SRAM Schalk I, p.69 Nr. 442b *)
  1339 val t = TermC.str2term ("(15*a \<up> 2/x \<up> 3 - 5*b \<up> 4/x \<up> 2 + 25*c \<up> 2/x) * " ^
  1340   "(x \<up> 3/(5*a*b \<up> 3*c \<up> 3)) + 1/c \<up> 3 * (b*x/a - 3*a/b \<up> 3)");
  1341 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1342 if UnparseC.term t = "5 * x \<up> 2 / (a * b \<up> 3 * c)"
  1343 then () else error "rational.sml: diff.behav. in norm_Rational_mg 29";
  1344 
  1345 (*------- SRAM Schalk I, p.69 Nr. 443b *)
  1346 val t = TermC.str2term "(a/2 + b/3) * (b/3 - a/2)";
  1347 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1348 if UnparseC.term t = "(-9 * a \<up> 2 + 4 * b \<up> 2) / 36"
  1349 then () else error "rational.sml: diff.behav. in norm_Rational_mg 30";
  1350 
  1351 (*------- SRAM Schalk I, p.69 Nr. 445b *)
  1352 val t = TermC.str2term "(a \<up> 2/9 + 2*a/(3*b) + 4/b \<up> 2)*(a/3 - 2/b) + 8/b \<up> 3";
  1353 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1354 if UnparseC.term t = "a \<up> 3 / 27"
  1355 then () else error "rational.sml: diff.behav. in norm_Rational_mg 31";
  1356 
  1357 (*------- SRAM Schalk I, p.69 Nr. 446b *)
  1358 val t = TermC.str2term "(x/(5*x + 4*y) - y/(5*x - 4*y) + 1)*(25*x \<up> 2 - 16*y \<up> 2)";
  1359 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1360 if UnparseC.term t = (*"30 * x \<up> 2 + -9 * x * y + -20 * y \<up> 2" ..isabisac15 | Isabelle2017..*)
  1361                   "(-30 * x \<up> 2 + 9 * x * y + 20 * y \<up> 2) / -1"
  1362 then () else error "rational.sml: diff.behav. in norm_Rational_mg 32";
  1363 
  1364 (*------- SRAM Schalk I, p.69 Nr. 449a *)(*Achtung: rechnet ca 8 Sekunden*)
  1365 val t = TermC.str2term 
  1366 "(2*x \<up> 2/(3*y)+x/y \<up> 2)*(4*x \<up> 4/(9*y \<up> 2)+x \<up> 2/y \<up> 4)*(2*x \<up> 2/(3*y) - x/y \<up> 2)";
  1367 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1368 if UnparseC.term t = "(-81 * x \<up> 4 + 16 * x \<up> 8 * y \<up> 4) / (81 * y \<up> 8)"
  1369 then () else error "rational.sml: diff.behav. in norm_Rational_mg 33";
  1370 
  1371 (*------- SRAM Schalk I, p.69 Nr. 450a *)
  1372 val t = TermC.str2term 
  1373 "(4*x/(3*y)+2*y/(3*x)) \<up> 2 - (2*y/(3*x) - 2*x/y)*(2*y/(3*x)+2*x/y)";
  1374 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1375 if UnparseC.term t = "(52 * x \<up> 2 + 16 * y \<up> 2) / (9 * y \<up> 2)"
  1376 then () else error "rational.sml: diff.behav. in norm_Rational_mg 34";
  1377 
  1378 (*------- SRAM Schalk I, p.69 Nr. 442b --- abgewandelt*)
  1379 val t = TermC.str2term 
  1380   ("(15*a \<up> 4/(a*x \<up> 3)  -  5*a*((b \<up> 4 - 5*c \<up> 2*x) / x \<up> 2))  *  " ^
  1381   "(x \<up> 3/(5*a*b \<up> 3*c \<up> 3))   +   a/c \<up> 3 * (x*(b/a) - 3*b*(a/b \<up> 4))");
  1382 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1383 if UnparseC.term t = "5 * x \<up> 2 / (b \<up> 3 * c)"
  1384 then () else error "rational.sml: diff.behav. in norm_Rational_mg 53";
  1385 
  1386 
  1387 "-------- examples double fractions from: Mathematik 1 Schalk ----------------";
  1388 "-------- examples double fractions from: Mathematik 1 Schalk ----------------";
  1389 "-------- examples double fractions from: Mathematik 1 Schalk ----------------";
  1390 "----- SRD Schalk I, p.69 Nr. 454b";
  1391 val t = TermC.str2term "((2 - x)/(2*a)) / (2*a/(x - 2))";
  1392 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1393 if UnparseC.term t = "(-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2)"
  1394 then () else error "rational.sml: diff.behav. in norm_Rational_mg 35";
  1395 
  1396 "----- SRD Schalk I, p.69 Nr. 455a";
  1397 val t = TermC.str2term "(a \<up> 2 + 1)/(a \<up> 2 - 1) / ((a+1)/(a - 1))";
  1398 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1399 if UnparseC.term t = "(1 + a \<up> 2) / (1 + 2 * a + a \<up> 2)" then ()
  1400 else error "rational.sml: diff.behav. in norm_Rational_mg 36";
  1401 
  1402 "----- Schalk I, p.69 Nr. 455b";
  1403 val t = TermC.str2term "(x \<up> 2 - 4)/(y \<up> 2 - 9)/((2+x)/(3 - y))";
  1404 (* WN130911 non-termination due to non-termination of
  1405   cancel_p_ thy (TermC.str2term ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
  1406                            "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)"))
  1407 
  1408 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1409 if UnparseC.term t = "(2 + -1 * x) / (3 + y)" then ()
  1410 else error "rational.sml: diff.behav. in norm_Rational_mg 37";
  1411 *)
  1412 
  1413 "----- SK060904-1a non-termination of cancel_p_ ?: worked before 0707xx";
  1414 val t = TermC.str2term "(x \<up> 2 - 4)*(3 - y) / ((y \<up> 2 - 9)*(2+x))";
  1415 (* WN130911 non-termination due to non-termination of
  1416   cancel_p_ thy (TermC.str2term ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
  1417                            "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)"))
  1418 
  1419 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1420 if UnparseC.term t = "(2 + -1 * x) / (3 + y)" then ()
  1421 else error "rational.sml: diff.behav. in norm_Rational_mg 37b";
  1422 *)
  1423 
  1424 "----- ?: worked before 0707xx";
  1425 val t = TermC.str2term "(3 + -1 * y) / (-9 + y \<up> 2)";
  1426 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1427 if UnparseC.term t = "-1 / (3 + y)"
  1428 then () else error "rational.sml: -1 / (3 + y) norm_Rational";
  1429 
  1430 "----- SRD Schalk I, p.69 Nr. 456b";
  1431 val t = TermC.str2term "(b \<up> 3 - b \<up> 2) / (b \<up> 2+b) / (b \<up> 2 - 1)";
  1432 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1433 if UnparseC.term t = "b / (1 + 2 * b + b \<up> 2)"
  1434 then () else error "rational.sml: diff.behav. in norm_Rational_mg 38";
  1435 
  1436 "----- SRD Schalk I, p.69 Nr. 457b";
  1437 val t = TermC.str2term "(16*a \<up> 2 - 9*b \<up> 2)/(2*a+3*a*b) / ((4*a+3*b)/(4*a \<up> 2 - 9*a \<up> 2*b \<up> 2))";
  1438 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1439 if UnparseC.term t = "8 * a \<up> 2 + -6 * a * b + -12 * a \<up> 2 * b + 9 * a * b \<up> 2"
  1440 then () else error "rational.sml: diff.behav. in norm_Rational_mg 39";
  1441 
  1442 "----- Schalk I, p.69 Nr. 458b works since 0707";
  1443 val t = TermC.str2term "(2*a \<up> 2*x - a \<up> 2) / (a*x - b*x) / (b \<up> 2*(2*x - 1) / (x*(a - b)))";
  1444 (*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1445 :
  1446 ###  rls: cancel_p on: (-1 * a \<up> 2 + 2 * (a \<up> 2 * x)) / (a * x + -1 * (b * x)) /
  1447 ((-1 * b \<up> 2 + 2 * (b \<up> 2 * x)) / (a * x + -1 * (b * x))) 
  1448 exception Div raised
  1449 
  1450 BUT
  1451 val t = TermC.str2term 
  1452   ("(-1 * a \<up> 2 + 2 * (a \<up> 2 * x)) / (a * x + -1 * (b * x)) /" ^
  1453   "((-1 * b \<up> 2 + 2 * (b \<up> 2 * x)) / (a * x + -1 * (b * x)))");
  1454 NONE = cancel_p_ thy t;
  1455 
  1456 if UnparseC.term t = "a \<up> 2 / b \<up> 2" then ()
  1457 else error "rational.sml: diff.behav. in norm_Rational_mg 39b";
  1458 *)
  1459 
  1460 "----- SRD Schalk I, p.69 Nr. 459b";
  1461 val t = TermC.str2term "(a \<up> 2 - b \<up> 2)/(a*b) / (4*(a+b) \<up> 2/a)";
  1462 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1463 if UnparseC.term t = "(a + -1 * b) / (4 * a * b + 4 * b \<up> 2)" then ()
  1464 else error "rational.sml: diff.behav. in norm_Rational_mg 41";
  1465 
  1466 "----- Schalk I, p.69 Nr. 460b nonterm.SK";
  1467 val t = TermC.str2term "(9*(x \<up> 2 - 8*x + 16) / (4*(y \<up> 2 - 2*y + 1))) / ((3*x - 12) / (16*y - 16))";
  1468 (*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1469 exception Div raised
  1470 
  1471 BUT
  1472 val t = TermC.str2term 
  1473   ("(144 + -72 * x + 9 * x \<up> 2) / (4 + -8 * y + 4 * y \<up> 2) /" ^
  1474   "((-12 + 3 * x) / (-16 + 16 * y))");
  1475 NONE = cancel_p_ thy t;
  1476 
  1477 if UnparseC.term t = !!!!!!!!!!!!!!!!!!!!!!!!!
  1478 then () else error "rational.sml: diff.behav. in norm_Rational_mg 42";
  1479 *)
  1480 
  1481 "----- some variant of the above; was non-terminating before";
  1482 val t = TermC.str2term "9*(x \<up> 2 - 8*x+16)*(16*y - 16)/(4*(y \<up> 2 - 2*y+1)*(3*x - 12))";
  1483 val SOME (t , _) = rewrite_set_ thy false norm_Rational t;
  1484 if UnparseC.term t = "(48 + -12 * x) / (1 + -1 * y)"
  1485 then () else error "some variant of the above; was non-terminating before";
  1486 
  1487 "----- SRD Schalk I, p.70 Nr. 472a";
  1488 val t = TermC.str2term ("((8*x \<up> 2 - 32*y \<up> 2) / (2*x + 4*y))  /  ((4*x - 8*y) / (x + y))");
  1489 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1490 if UnparseC.term t = "x + y"
  1491 then () else error "rational.sml: diff.behav. in norm_Rational_mg 43";
  1492 
  1493 "----- Schalk I, p.70 Nr. 478b ----- Rechenzeit: 5 sec";
  1494 val t = TermC.str2term ("(a - (a*b + b \<up> 2)/(a+b))/(b+(a - b)/(1+(a+b)/(a - b))) / " ^
  1495 		 "((a - a \<up> 2/(a+b))/(a+(a*b)/(a - b)))");
  1496 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1497 if UnparseC.term t = "(2 * a \<up> 3 + 2 * a \<up> 2 * b) / (a \<up> 2 * b + b \<up> 3)"
  1498 then () else error "rational.sml: diff.behav. in norm_Rational_mg 51";
  1499 
  1500 (*SRD Schalk I, p.69 Nr. 461a *)
  1501 val t = TermC.str2term "(2/(x+3) + 2/(x - 3)) / (8*x/(x \<up> 2 - 9))";
  1502 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1503 if UnparseC.term t = "1 / 2"
  1504 then () else error "rational.sml: diff.behav. in norm_Rational_mg 44";
  1505 
  1506 (*SRD Schalk I, p.69 Nr. 464b *)
  1507 val t = TermC.str2term "(a - a/(a - 2)) / (a + a/(a - 2))";
  1508 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1509 if UnparseC.term t = "(-3 + a) / (-1 + a)"
  1510 then () else error "rational.sml: diff.behav. in norm_Rational_mg 45";
  1511 
  1512 (*SRD Schalk I, p.69 Nr. 465b *)
  1513 val t = TermC.str2term "((x+3*y)/9 + (4*y \<up> 2 - 9*z \<up> 2)/(16*x))   /   (x/9 + y/6 + z/4)";
  1514 (* WN130911 non-termination due to non-termination of
  1515   cancel_p_ thy (TermC.str2term 
  1516     ("("(576 * x \<up> 2 + 1728 * (x * y) + 1296 * y \<up> 2 + -2916 * z \<up> 2) /" ^
  1517       "(576 * x \<up> 2 + 864 * (x * y) + 1296 * (x * z))"))
  1518 
  1519 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1520 if UnparseC.term t = "(4 * x + 6 * y + -9 * z) / (4 * x)"
  1521 then () else error "rational.sml: diff.behav. in norm_Rational_mg 46";
  1522 *)
  1523 
  1524 (*SRD Schalk I, p.69 Nr. 466b *)
  1525 val t = TermC.str2term "((1 - 7*(x - 2)/(x \<up> 2 - 4)) / (6/(x+2))) / (3/(x+5)+30/(x \<up> 2 - 25))";
  1526 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1527 if UnparseC.term t = "(25 + -10 * x + x \<up> 2) / 18"
  1528 then () else error "rational.sml: diff.behav. in norm_Rational_mg 47";
  1529 
  1530 (*SRD Schalk I, p.70 Nr. 469 *)
  1531 val t = TermC.str2term ("3*b \<up> 2 / (4*a \<up> 2 - 8*a*b + 4*b \<up> 2) / " ^
  1532   "(a / (a \<up> 2*b - b \<up> 3)  +  (a - b) / (4*a*b \<up> 2 + 4*b \<up> 3)  -  1 / (4*b \<up> 2))");
  1533 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1534 if UnparseC.term t = "-3 * b \<up> 3 / (-2 * a + 2 * b)"
  1535 then () else error "rational.sml: diff.behav. in norm_Rational_mg 48";
  1536 
  1537 "-------- me Schalk I No.186 -------------------------------------------------";
  1538 "-------- me Schalk I No.186 -------------------------------------------------";
  1539 "-------- me Schalk I No.186 -------------------------------------------------";
  1540 val fmz = ["Term ((14 * x * y) / ( x * y ))", "normalform N"];
  1541 val (dI',pI',mI') =
  1542   ("Rational",["rational", "simplification"],
  1543    ["simplification", "of_rationals"]);
  1544 val p = e_pos'; val c = []; 
  1545 val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
  1546 val (p,_,f,nxt,_,pt) = me nxt p c pt;
  1547 val (p,_,f,nxt,_,pt) = me nxt p c pt;
  1548 val (p,_,f,nxt,_,pt) = me nxt p c pt;
  1549 val (p,_,f,nxt,_,pt) = me nxt p c pt;
  1550 val (p,_,f,nxt,_,pt) = me nxt p c pt;
  1551 val (p,_,f,nxt,_,pt) = me nxt p c pt;
  1552 val (p,_,f,nxt,_,pt) = me nxt p c pt;
  1553 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
  1554 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
  1555 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;(*++ for explicit script*)
  1556 val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;(*++ for explicit script*)
  1557 case (f2str f, nxt) of
  1558     ("14", ("End_Proof'", _)) => ()
  1559   | _ => error "rational.sml diff.behav. in me Schalk I No.186";
  1560 
  1561 "-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
  1562 "-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
  1563 "-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
  1564 reset_states ();
  1565 CalcTree [(["Term (((2 - x)/(2*a)) / (2*a/(x - 2)))", "normalform N"], 
  1566   ("Rational", ["rational", "simplification"], ["simplification", "of_rationals"]))];
  1567 Iterator 1;
  1568 moveActiveRoot 1;
  1569 autoCalculate 1 CompleteCalc;
  1570 val ((pt, p), _) = get_calc 1; 
  1571 (*
  1572 Test_Tool.show_pt pt;
  1573 [
  1574 (([], Frm), Simplify ((2 - x) / (2 * a) / (2 * a / (x - 2)))),
  1575 (([1], Frm), (2 - x) / (2 * a) / (2 * a / (x - 2))),
  1576 (([1], Res), (2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))),
  1577 (([2], Res), (2 + -1 * x) / (2 * a) / (2 * a / (-2 + x))),
  1578 (([3], Res), (2 + -1 * x) * (-2 + x) / (2 * a * (2 * a))),
  1579 (([4], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2)),
  1580 (([], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2))] 
  1581 *)
  1582 interSteps 1 ([1], Res);
  1583 val ((pt, p), _) = get_calc 1; 
  1584 (*Test_Tool.show_pt pt;
  1585 [
  1586 (([], Frm), Simplify ((2 - x) / (2 * a) / (2 * a / (x - 2)))),
  1587 (([1], Frm), (2 - x) / (2 * a) / (2 * a / (x - 2))),
  1588 (([1,1], Frm), (2 - x) / (2 * a) / (2 * a / (x - 2))),
  1589 (([1,1], Res), (2 - x) / (2 * a) / (2 * a / (x + -1 * 2))),
  1590 (([1,2], Res), (2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))),
  1591 (([1], Res), (2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))),
  1592 (([2], Res), (2 + -1 * x) / (2 * a) / (2 * a / (-2 + x))),
  1593 (([3], Res), (2 + -1 * x) * (-2 + x) / (2 * a * (2 * a))),
  1594 (([4], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2)),
  1595 (([], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2))] 
  1596 *)
  1597 val (t, asm) = get_obj g_result pt [1, 1];
  1598 if UnparseC.term t = "(2 - x) / (2 * a) / (2 * a / (x + -1 * 2))" andalso UnparseC.terms asm = "[]"
  1599 then () else error "2nd interSteps ..Simp_Rat_Double_No-1 changed on [1, 1]";
  1600 val (t, asm) = get_obj g_result pt [1, 2];
  1601 if UnparseC.term t = "(2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))" andalso UnparseC.terms asm = "[]"
  1602 then () else error "3rd interSteps ..Simp_Rat_Double_No-1 changed on [1, 2]";
  1603 
  1604 
  1605 "-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
  1606 "-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
  1607 "-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
  1608 reset_states ();
  1609 CalcTree [(["Term ((a^2 + -1*b^2) / (a^2 + -2*a*b + b^2))", "normalform N"], 
  1610   ("Rational", ["rational", "simplification"], ["simplification", "of_rationals"]))];
  1611 Iterator 1;
  1612 moveActiveRoot 1;
  1613 autoCalculate 1 CompleteCalc;
  1614 val ((pt, p), _) = get_calc 1;
  1615 (*Test_Tool.show_pt pt;
  1616 [
  1617 (([], Frm), Simplify ((a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2))),
  1618 (([1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2)),
  1619 (([1], Res), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
  1620 (([2], Res), (a + b) / (a + -1 * b)),
  1621 (([], Res), (a + b) / (a + -1 * b))] 
  1622 *)
  1623 interSteps 1 ([2], Res);
  1624 val ((pt, p), _) = get_calc 1;
  1625 (*Test_Tool.show_pt pt;
  1626 [
  1627 (([], Frm), Simplify ((a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2))),
  1628 (([1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2)),
  1629 (([1], Res), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
  1630 (([2,1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
  1631 (([2,1], Res), (a + b) / (a + -1 * b)),
  1632 (([2], Res), (a + b) / (a + -1 * b)),
  1633 (([], Res), (a + b) / (a + -1 * b))] 
  1634 *)
  1635 interSteps 1 ([2,1],Res);
  1636 val ((pt, p), _) = get_calc 1; 
  1637 (*Test_Tool.show_pt pt;
  1638 [
  1639 (([], Frm), Simplify ((a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2))),
  1640 (([1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2)),
  1641 (([1], Res), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
  1642 (([2,1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
  1643 (([2,1,1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
  1644 (([2,1,1], Res), (a \<up> 2 + -1 * (a * b) + a * b + -1 * b \<up> 2) /
  1645 (a \<up> 2 + -2 * (a * b) + 1 * b \<up> 2)),
  1646 (([2,1,2], Res), (a \<up> 2 + -1 * (a * b) + a * b + -1 * b \<up> 2) /
  1647 (a \<up> 2 + -2 * (a * b) + -1 \<up> 2 * b \<up> 2)),
  1648 (([2,1,3], Res), (a \<up> 2 + -1 * (a * b) + a * b + -1 * b \<up> 2) /
  1649 (a \<up> 2 + -2 * (a * b) + (-1 * b) \<up> 2)),
  1650 (([2,1,4], Res), (a * a + -1 * (a * b) + a * b + -1 * b \<up> 2) /
  1651 (a \<up> 2 + -2 * (a * b) + (-1 * b) \<up> 2)),
  1652 (([2,1,5], Res), (a * a + -1 * (a * b) + a * b + -1 * (b * b)) /
  1653 (a \<up> 2 + -2 * (a * b) + (-1 * b) \<up> 2)),
  1654 (([2,1,6], Res), (a * a + -1 * (a * b) + a * b + -1 * (b * b)) /
  1655 (a \<up> 2 + -1 * (2 * (a * b)) + (-1 * b) \<up> 2)),
  1656 (([2,1,7], Res), (a * a + a * (-1 * b) + (b * a + b * (-1 * b))) /
  1657 (a \<up> 2 + 2 * (a * (-1 * b)) + (-1 * b) \<up> 2)),
  1658 (([2,1,8], Res), (a * a + a * (-1 * b) + (b * a + b * (-1 * b))) /
  1659 (a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
  1660 (([2,1,9], Res), (a * (a + -1 * b) + (b * a + b * (-1 * b))) /
  1661 (a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
  1662 (([2,1,10], Res), (a * (a + -1 * b) + b * (a + -1 * b)) /
  1663 (a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
  1664 (([2,1,11], Res), (a + b) * (a + -1 * b) / (a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
  1665 (([2,1,12], Res), (a + b) * (a + -1 * b) / ((a + -1 * b) * (a + -1 * b))),
  1666 (([2,1,13], Res), (a + b) / (a + -1 * b)),
  1667 (([2,1], Res), (a + b) / (a + -1 * b)),
  1668 (([2], Res), (a + b) / (a + -1 * b)),
  1669 (([], Res), (a + b) / (a + -1 * b))] 
  1670 *)
  1671 val newnds = children (get_nd pt [2,1]) (*see "fun detailrls"*);
  1672 if length newnds = 13 then () else error "rational.sml: interSteps cancel_p rev_rew_p";
  1673 
  1674 val p = ([2,1,9],Res);
  1675 getTactic 1 p;
  1676 val (_, tac, _) = ME_Misc.pt_extract (pt, p);
  1677 case tac of SOME (Rewrite ("sym_distrib_left", _)) => ()
  1678 | _ => error "rational.sml: getTactic, sym_real_plus_binom_times1";
  1679 
  1680 
  1681 "-------- investigate rulesets for cancel_p ----------------------------------";
  1682 "-------- investigate rulesets for cancel_p ----------------------------------";
  1683 "-------- investigate rulesets for cancel_p ----------------------------------";
  1684 val thy = @{theory "Rational"};
  1685 val t = TermC.str2term "(a \<up> 2 + -1*b \<up> 2) / (a \<up> 2 + -2*a*b + b \<up> 2)";
  1686 val tt = TermC.str2term "(1 * a + 1 * b) * (1 * a + -1 * b)"(*numerator only*);
  1687 
  1688 "----- with rewrite_set_";
  1689 val SOME (tt',asm) = rewrite_set_ thy false make_polynomial tt;
  1690 if UnparseC.term tt'= "a \<up> 2 + -1 * b \<up> 2" then () else error "rls chancel_p 1";
  1691 val tt = TermC.str2term "((1 * a + -1 * b) * (1 * a + -1 * b))"(*denominator only*);
  1692 val SOME (tt',asm) = rewrite_set_ thy false make_polynomial tt;
  1693 if UnparseC.term tt' = "a \<up> 2 + -2 * a * b + b \<up> 2" then () else error "rls chancel_p 2";
  1694 
  1695 "----- with .make_deriv; WN1130912 not investigated further, will be discontinued";
  1696 val SOME (tt, _) = factout_p_ thy t; 
  1697 if UnparseC.term tt = "(a + b) * (a + -1 * b) / ((a + -1 * b) * (a + -1 * b))"
  1698 then () else error "rls chancel_p 3";
  1699 UnparseC.term tt = "(1 * a + 1 * b) * (1 * a + -1 * b) / ((1 * a + -1 * b) * (1 * a + -1 * b))";
  1700 
  1701 "--- with simpler ruleset";
  1702 val {rules, rew_ord= (_, ro), ...} = Rule_Set.rep (assoc_rls "rev_rew_p");
  1703 val der = .make_deriv thy Atools_erls rules ro NONE tt;
  1704 if length der = 12 then () else error "WN1130912 rls chancel_p 4";
  1705 (*default_print_depth 99;*) writeln (deriv2str der); (*default_print_depth 3;*)
  1706 
  1707 (*default_print_depth 99;*) map (UnparseC.term o #1) der; (*default_print_depth 3;*)
  1708 "...,(-1 * b \<up> 2 + a \<up> 2) / (-2 * (a * b) + a \<up> 2 + (-1 * b) \<up> 2) ]";
  1709 (*default_print_depth 99;*) map (Rule.to_string o #2) der; (*default_print_depth 3;*)
  1710 (*default_print_depth 99;*) map (UnparseC.term o #1 o #3) der; (*default_print_depth 3;*)
  1711 
  1712 val der = .make_deriv thy Atools_erls rules ro NONE 
  1713 	(TermC.str2term "(1 * a + 1 * b) * (1 * a + -1 * b)");
  1714 (*default_print_depth 99;*) writeln (deriv2str der); (*default_print_depth 3;*)
  1715 
  1716 val {rules, rew_ord=(_,ro),...} = Rule_Set.rep (assoc_rls "rev_rew_p");
  1717 val der = .make_deriv thy Atools_erls rules ro NONE 
  1718 	(TermC.str2term "(1 * a + -1 * b) * (1 * a + -1 * b)");
  1719 (*default_print_depth 99;*) writeln (deriv2str der); (*default_print_depth 3;*)
  1720 (*default_print_depth 99;*) map (UnparseC.term o #1) der; (*default_print_depth 3;*)
  1721 (*WN060829 ...postponed*)
  1722 
  1723 
  1724 "-------- fun eval_get_denominator -------------------------------------------";
  1725 "-------- fun eval_get_denominator -------------------------------------------";
  1726 "-------- fun eval_get_denominator -------------------------------------------";
  1727 val thy = @{theory Isac_Knowledge};
  1728 val t = Thm.term_of (the (TermC.parse thy "get_denominator ((a +x)/b)"));
  1729 val SOME (_, t') = eval_get_denominator "" 0 t thy;
  1730 if UnparseC.term t' = "get_denominator ((a + x) / b) = b"
  1731 then () else error "get_denominator ((a + x) / b) = b"
  1732 
  1733 
  1734 "-------- several errpats in complicated term --------------------------------";
  1735 "-------- several errpats in complicated term --------------------------------";
  1736 "-------- several errpats in complicated term --------------------------------";
  1737 (*WN12xxxx TODO: instead of Gabriella's example here (27.Jul.12) find a simpler one
  1738   WN130912: kept this test, although not clear what for*)
  1739 reset_states ();
  1740 CalcTree [(["Term ((5*b + 25)/(a^2 - b^2) * (a - b)/(5*b))", "normalform N"], 
  1741   ("Rational", ["rational", "simplification"], ["simplification", "of_rationals"]))];
  1742 Iterator 1;
  1743 moveActiveRoot 1;
  1744 autoCalculate 1 CompleteCalc;
  1745 val ((pt, p), _) = get_calc 1;
  1746 (*Test_Tool.show_pt pt;
  1747 [
  1748 (([], Frm), Simplify ((5 * b + 25) / (a \<up> 2 - b \<up> 2) * (a - b) / (5 * b))),
  1749 (([1], Frm), (5 * b + 25) / (a \<up> 2 - b \<up> 2) * (a - b) / (5 * b)),
  1750 (([1], Res), (5 * b + 25) / (a \<up> 2 + -1 * b \<up> 2) * (a + -1 * b) / (5 * b)),
  1751 (([2], Res), (5 * b + 25) * (a + -1 * b) / (a \<up> 2 + -1 * b \<up> 2) / (5 * b)),
  1752 (([3], Res), (25 * a + -25 * b + 5 * (a * b) + -5 * b \<up> 2) / (a \<up> 2 + -1 * b \<up> 2) /
  1753 (5 * b)),
  1754 (([4], Res), (25 + 5 * b) / (a + b) / (5 * b)),
  1755 (([5], Res), (25 + 5 * b) / ((a + b) * (5 * b))),
  1756 (([6], Res), (25 + 5 * b) / (5 * (a * b) + 5 * b \<up> 2)),
  1757 (([7], Res), (5 + b) / (a * b + b \<up> 2)),
  1758 (([], Res), (5 + b) / (a * b + b \<up> 2))] *)
  1759 
  1760 
  1761 "-------- WN1309xx non-terminating rls norm_Rational -------------------------";
  1762 "-------- WN1309xx non-terminating rls norm_Rational -------------------------";
  1763 "-------- WN1309xx non-terminating rls norm_Rational -------------------------";
  1764 (*------- Schalk I, p.70 Nr. 480b; a/b : c/d translated to a/b * d/c*)
  1765 val t = TermC.str2term 
  1766   ("((12*x*y / (9*x \<up> 2 - y \<up> 2))  /  (1 / (3*x - y) \<up> 2 - 1 / (3*x + y) \<up> 2))  *  " ^
  1767 	"((1/(x - 5*y) \<up> 2  -  1/(x + 5*y) \<up> 2)  /  (20*x*y / (x \<up> 2 - 25*y \<up> 2)))");
  1768 
  1769 (*1st factor separately simplified *)
  1770 val t = TermC.str2term "((12*x*y / (9*x \<up> 2 - y \<up> 2))  /  (1 / (3*x - y) \<up> 2 - 1 / (3*x + y) \<up> 2))";
  1771 val SOME (t', _) = rewrite_set_ thy false norm_Rational t; 
  1772 if UnparseC.term t' = "(-9 * x \<up> 2 + y \<up> 2) / -1" then () else error "Nr. 480b lhs changed";
  1773 (*2nd factor separately simplified *)
  1774 val t = TermC.str2term "((1/(x - 5*y) \<up> 2  -  1/(x + 5*y) \<up> 2)  /  (20*x*y / (x \<up> 2 - 25*y \<up> 2)))";
  1775 val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
  1776 if UnparseC.term t' = "-1 / (-1 * x \<up> 2 + 25 * y \<up> 2)" then () else error "Nr. 480b rhs changed";
  1777 
  1778 "-------- Schalk I, p.70 Nr. 477a: terms are exploding ?!?";
  1779 val t = TermC.str2term ("b*y/(b - 2*y)/((b \<up> 2 - y \<up> 2)/(b+2*y))  /" ^
  1780 		 "(b \<up> 2*y + b*y \<up> 2) * (a+x) \<up> 2  /  ((b \<up> 2 - 4*y \<up> 2) * (a+2*x) \<up> 2)");
  1781 (*val SOME (t',_) = rewrite_set_ thy false norm_Rational t;
  1782 :
  1783 ###  rls: cancel_p on: (a \<up> 2 * (b * y) + 2 * (a * (b * (x * y))) + b * (x \<up> 2 * y)) /
  1784 (b + -2 * y) /
  1785 ((b \<up> 2 + -1 * y \<up> 2) / (b + 2 * y)) /
  1786 (b \<up> 2 * y + b * y \<up> 2) /
  1787 (a \<up> 2 * b \<up> 2 + -4 * (a \<up> 2 * y \<up> 2) + 4 * (a * (b \<up> 2 * x)) +
  1788  -16 * (a * (x * y \<up> 2)) +
  1789  4 * (b \<up> 2 * x \<up> 2) +
  1790  -16 * (x \<up> 2 * y \<up> 2)) 
  1791 exception Div raised
  1792 
  1793 BUT
  1794 val t = TermC.str2term 
  1795   ("(a \<up> 2 * (b * y) + 2 * (a * (b * (x * y))) + b * (x \<up> 2 * y)) /" ^
  1796   "(b + -2 * y) /" ^
  1797   "((b \<up> 2 + -1 * y \<up> 2) / (b + 2 * y)) /" ^
  1798   "(b \<up> 2 * y + b * y \<up> 2) /" ^
  1799   "(a \<up> 2 * b \<up> 2 + -4 * (a \<up> 2 * y \<up> 2) + 4 * (a * (b \<up> 2 * x)) +" ^
  1800   "-16 * (a * (x * y \<up> 2)) +" ^
  1801   "4 * (b \<up> 2 * x \<up> 2) +" ^
  1802   "-16 * (x \<up> 2 * y \<up> 2))");
  1803 NONE = cancel_p_ thy t;
  1804 *)
  1805 
  1806 (*------- Schalk I, p.70 Nr. 476b in 2003 this worked using 10 sec. *)
  1807 val t = TermC.str2term 
  1808   ("((a \<up> 2 - b \<up> 2)/(2*a*b) + 2*a*b/(a \<up> 2 - b \<up> 2))  /  ((a \<up> 2 + b \<up> 2)/(2*a*b) + 1)    / " ^
  1809    "((a \<up> 2 + b \<up> 2) \<up> 2  /  (a + b) \<up> 2)");
  1810 (* Rewrite.trace_on := true;
  1811 rewrite_set_ thy false norm_Rational t;
  1812 :
  1813 ####  rls: cancel_p on: (2 * (a \<up> 7 * b) + 4 * (a \<up> 6 * b \<up> 2) + 6 * (a \<up> 5 * b \<up> 3) +
  1814  8 * (a \<up> 4 * b \<up> 4) +
  1815  6 * (a \<up> 3 * b \<up> 5) +
  1816  4 * (a \<up> 2 * b \<up> 6) +
  1817  2 * (a * b \<up> 7)) /
  1818 (2 * (a \<up> 9 * b) + 4 * (a \<up> 8 * b \<up> 2) +
  1819  2 * (2 * (a \<up> 7 * b \<up> 3)) +
  1820  4 * (a \<up> 6 * b \<up> 4) +
  1821  -4 * (a \<up> 4 * b \<up> 6) +
  1822  -4 * (a \<up> 3 * b \<up> 7) +
  1823  -4 * (a \<up> 2 * b \<up> 8) +
  1824  -2 * (a * b \<up> 9))
  1825 
  1826 if UnparseC.term t = "1 / (a \<up> 2 + -1 * b \<up> 2)" then ()
  1827 else error "rational.sml: diff.behav. in norm_Rational_mg 49";
  1828 *)
  1829 
  1830 "-------- Schalk I, p.70 Nr. 480a: terms are exploding ?!?";
  1831 val t = TermC.str2term ("(1/x + 1/y + 1/z)  /  (1/x - 1/y - 1/z)  /  " ^
  1832   "(2*x \<up> 2 / (x \<up> 2 - z \<up> 2) / (x / (x + z)  +  x / (x - z)))");
  1833 (* Rewrite.trace_on := true;
  1834 rewrite_set_ thy false norm_Rational t;
  1835 :
  1836 ####  rls: cancel_p on: (2 * (x \<up> 6 * (y \<up> 2 * z)) + 2 * (x \<up> 6 * (y * z \<up> 2)) +
  1837  2 * (x \<up> 5 * (y \<up> 2 * z \<up> 2)) +
  1838  -2 * (x \<up> 4 * (y \<up> 2 * z \<up> 3)) +
  1839  -2 * (x \<up> 4 * (y * z \<up> 4)) +
  1840  -2 * (x \<up> 3 * (y \<up> 2 * z \<up> 4))) /
  1841 (-2 * (x \<up> 6 * (y \<up> 2 * z)) + -2 * (x \<up> 6 * (y * z \<up> 2)) +
  1842  2 * (x \<up> 5 * (y \<up> 2 * z \<up> 2)) +
  1843  2 * (x \<up> 4 * (y \<up> 2 * z \<up> 3)) +
  1844  2 * (x \<up> 4 * (y * z \<up> 4)) +
  1845  -2 * (x \<up> 3 * (y \<up> 2 * z \<up> 4)))
  1846 *)
  1847 
  1848 "-------- Schalk I, p.60 Nr. 215d: terms are exploding, internal loop does not terminate";
  1849 val t = TermC.str2term "(a-b) \<up> 3 * (x+y) \<up> 4 / ((x+y) \<up> 2 * (a-b) \<up> 5)";
  1850 (* Kein Wunder, denn Z???ler und Nenner extra als Polynom dargestellt ergibt:
  1851 
  1852 val t = TermC.str2term "(a-b) \<up> 3 * (x+y) \<up> 4";
  1853 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1854 UnparseC.term t;
  1855 "a \<up> 3 * x \<up> 4 + 4 * a \<up> 3 * x \<up> 3 * y +6 * a \<up> 3 * x \<up> 2 * y \<up> 2 +4 * a \<up> 3 * x * y \<up> 3 +a \<up> 3 * y \<up> 4 +-3 * a \<up> 2 * b * x \<up> 4 +-12 * a \<up> 2 * b * x \<up> 3 * y +-18 * a \<up> 2 * b * x \<up> 2 * y \<up> 2 +-12 * a \<up> 2 * b * x * y \<up> 3 +-3 * a \<up> 2 * b * y \<up> 4 +3 * a * b \<up> 2 * x \<up> 4 +12 * a * b \<up> 2 * x \<up> 3 * y +18 * a * b \<up> 2 * x \<up> 2 * y \<up> 2 +12 * a * b \<up> 2 * x * y \<up> 3 +3 * a * b \<up> 2 * y \<up> 4 +-1 * b \<up> 3 * x \<up> 4 +-4 * b \<up> 3 * x \<up> 3 * y +-6 * b \<up> 3 * x \<up> 2 * y \<up> 2 +-4 * b \<up> 3 * x * y \<up> 3 +-1 * b \<up> 3 * y \<up> 4";
  1856 val t = TermC.str2term "((x+y) \<up> 2 * (a-b) \<up> 5)";
  1857 val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1858 UnparseC.term t;
  1859 "a \<up> 5 * x \<up> 2 + 2 * a \<up> 5 * x * y + a \<up> 5 * y \<up> 2 +-5 * a \<up> 4 * b * x \<up> 2 +-10 * a \<up> 4 * b * x * y +-5 * a \<up> 4 * b * y \<up> 2 +10 * a \<up> 3 * b \<up> 2 * x \<up> 2 +20 * a \<up> 3 * b \<up> 2 * x * y +10 * a \<up> 3 * b \<up> 2 * y \<up> 2 +-10 * a \<up> 2 * b \<up> 3 * x \<up> 2 +-20 * a \<up> 2 * b \<up> 3 * x * y +-10 * a \<up> 2 * b \<up> 3 * y \<up> 2 +5 * a * b \<up> 4 * x \<up> 2 +10 * a * b \<up> 4 * x * y +5 * a * b \<up> 4 * y \<up> 2 +-1 * b \<up> 5 * x \<up> 2 +-2 * b \<up> 5 * x * y +-1 * b \<up> 5 * y \<up> 2";
  1860 
  1861 anscheinend macht dem Rechner das Krzen diese Bruches keinen Spass mehr ...*)
  1862 
  1863 "-------- Schalk I, p.70 Nr. 480b: terms are exploding, Rewrite.trace_on stops at";
  1864 val t = TermC.str2term ("((12*x*y/(9*x \<up> 2 - y \<up> 2))/" ^
  1865 		 "(1/(3*x - y) \<up> 2 - 1/(3*x + y) \<up> 2)) *" ^
  1866 		 "(1/(x - 5*y) \<up> 2 - 1/(x + 5*y) \<up> 2)/" ^
  1867 		 "(20*x*y/(x \<up> 2 - 25*y \<up> 2))");
  1868 (*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
  1869 :
  1870 ####  rls: cancel_p on: (19440 * (x \<up> 8 * y \<up> 2) + -490320 * (x \<up> 6 * y \<up> 4) +
  1871  108240 * (x \<up> 4 * y \<up> 6) +
  1872  -6000 * (x \<up> 2 * y \<up> 8)) /
  1873 (2160 * (x \<up> 8 * y \<up> 2) + -108240 * (x \<up> 6 * y \<up> 4) +
  1874  1362000 * (x \<up> 4 * y \<up> 6) +
  1875  -150000 * (x \<up> 2 * y \<up> 8))
  1876 *)
  1877