1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/test/Tools/isac/Knowledge/rational-1.sml Fri Jul 16 06:57:34 2021 +0200
1.3 @@ -0,0 +1,151 @@
1.4 +(* Title: test/Tools/isac/Knowledge/rational-1.sml
1.5 + Author: Walther Neuper
1.6 + Use is subject to license terms.
1.7 +
1.8 +Test of basic functions and application to complex examples.
1.9 +*)
1.10 +
1.11 +"-----------------------------------------------------------------------------------------------";
1.12 +"-----------------------------------------------------------------------------------------------";
1.13 +"table of contents -----------------------------------------------------------------------------";
1.14 +"-----------------------------------------------------------------------------------------------";
1.15 +"-------- fun poly_of_term ---------------------------------------------------------------------";
1.16 +"-------- fun is_poly --------------------------------------------------------------------------";
1.17 +"-------- fun term_of_poly ---------------------------------------------------------------------";
1.18 +"-------- complex examples: rls norm_Rational --------------------------------------------------";
1.19 +"-------- complex examples cancellation from: Mathematik 1 Schalk ------------------------------";
1.20 +"-----------------------------------------------------------------------------------------------";
1.21 +"-----------------------------------------------------------------------------------------------";
1.22 +
1.23 +
1.24 +"-------- fun poly_of_term ---------------------------------------------------------------------";
1.25 +"-------- fun poly_of_term ---------------------------------------------------------------------";
1.26 +"-------- fun poly_of_term ---------------------------------------------------------------------";
1.27 +val thy = @{theory Partial_Fractions};
1.28 +val vs = TermC.vars_of (TermC.str2term "12 * x \<up> 3 * y \<up> 4 * z \<up> 6");
1.29 +
1.30 +val t = TermC.str2term "-3 + -2 * x ::real";
1.31 +if poly_of_term vs t = SOME [(~3, [0, 0, 0]), (~2, [1, 0, 0])]
1.32 +then () else error "poly_of_term uminus changed";
1.33 +
1.34 +if poly_of_term vs (TermC.str2term "12::real") = SOME [(12, [0, 0, 0])]
1.35 +then () else error "poly_of_term 1 changed";
1.36 +
1.37 +if poly_of_term vs (TermC.str2term "x::real") = SOME [(1, [1, 0, 0])]
1.38 +then () else error "poly_of_term 2 changed";
1.39 +
1.40 +if poly_of_term vs (TermC.str2term "12 * x \<up> 3") = SOME [(12, [3, 0, 0])]
1.41 +then () else error "poly_of_term 3 changed";
1.42 +"~~~~~ fun poly_of_term , args:"; val (vs, t) =
1.43 + (vs, (TermC.str2term "12 * x \<up> 3"));
1.44 +
1.45 + monom_of_term vs (1, replicate (length vs) 0) t;(*poly malformed 1 with x \<up> 3*)
1.46 +"~~~~~ fun monom_of_term , args:"; val (vs, (c, es), (Const ("Groups.times_class.times", _) $ m1 $ m2)) =
1.47 + (vs, (1, replicate (length vs) 0), t);
1.48 + val (c', es') =
1.49 +
1.50 + monom_of_term vs (c, es) m1;
1.51 +"~~~~~ fun monom_of_term , args:"; val (vs, (c, es), (Const ("Transcendental.powr", _) $ (t as Free _) $ (Const ("Num.numeral_class.numeral", _) $ num)) ) =
1.52 + (vs, (c', es'), m2);
1.53 +(*+*)c = 12;
1.54 +(*+*)(num |> HOLogic.dest_numeral |> list_update es (find_index (curry op = t) vs)) = [3, 0, 0];
1.55 +
1.56 +if (c, num |> HOLogic.dest_numeral |> list_update es (find_index (curry op = t) vs)) = (12, [3, 0, 0])
1.57 +then () else error "monom_of_term (powr): return value CHANGED";
1.58 +
1.59 +if poly_of_term vs (TermC.str2term "12 * x \<up> 3 * y \<up> 4 * z \<up> 6") = SOME [(12, [3, 4, 6])]
1.60 +then () else error "poly_of_term 4 changed";
1.61 +
1.62 +if poly_of_term vs (TermC.str2term "1 + 2 * x \<up> 3 * y \<up> 4 * z \<up> 6 + y") =
1.63 + SOME [(1, [0, 0, 0]), (1, [0, 1, 0]), (2, [3, 4, 6])]
1.64 +then () else error "poly_of_term 5 changed";
1.65 +
1.66 +(*poly_of_term is quite liberal:*)
1.67 +(*the coefficient may be somewhere, the order of variables and the parentheses
1.68 + within a monomial are arbitrary*)
1.69 +if poly_of_term vs (TermC.str2term "y \<up> 4 * (x \<up> 3 * 12 * z \<up> 6)") = SOME [(12, [3, 4, 6])]
1.70 +then () else error "poly_of_term 6 changed";
1.71 +
1.72 +(*there may even be more than 1 coefficient:*)
1.73 +if poly_of_term vs (TermC.str2term "2 * y \<up> 4 * (x \<up> 3 * 6 * z \<up> 6)") = SOME [(12, [3, 4, 6])]
1.74 +then () else error "poly_of_term 7 changed";
1.75 +
1.76 +(*the order and the parentheses within monomials are arbitrary:*)
1.77 +if poly_of_term vs (TermC.str2term "2 * x \<up> 3 * y \<up> 4 * z \<up> 6 + (7 * y \<up> 8 + 1)")
1.78 + = SOME [(1, [0, 0, 0]), (7, [0, 8, 0]), (2, [3, 4, 6])]
1.79 +then () else error "poly_of_term 8 changed";
1.80 +
1.81 +(*from --- rls norm_Rational downto fun gcd_poly ---*)
1.82 +val t = TermC.str2term (*copy from above: "::real" is not required due to " \<up> "*)
1.83 + ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
1.84 + "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)");
1.85 +"~~~~~ fun cancel_p_, args:"; val (t) = (t);
1.86 +val opt = check_fraction t;
1.87 +val SOME (numerator, denominator) = opt;
1.88 +(*+*)UnparseC.term numerator = "- 12 + 4 * y + 3 * x \<up> 2 + - 1 * (x \<up> 2 * y)"; (*isa -- isa2*);
1.89 +(*+*)UnparseC.term denominator = "- 18 + - 9 * x + 2 * y \<up> 2 + x * y \<up> 2"; (*isa -- isa2*);
1.90 + val vs = TermC.vars_of t;
1.91 +(*+*)UnparseC.terms vs = "[\"x\", \"y\"]";
1.92 + val baseT = type_of numerator
1.93 + val expT = HOLogic.realT;
1.94 +val (SOME _, SOME _) = (poly_of_term vs numerator, poly_of_term vs denominator); (*isa <> isa2*)
1.95 +
1.96 +"-------- fun is_poly --------------------------------------------------------------------------";
1.97 +"-------- fun is_poly --------------------------------------------------------------------------";
1.98 +"-------- fun is_poly --------------------------------------------------------------------------";
1.99 +if is_poly (TermC.str2term "2 * x \<up> 3 * y \<up> 4 * z \<up> 6 + 7 * y \<up> 8 + 1")
1.100 +then () else error "is_poly 1 changed";
1.101 +if not (is_poly (TermC.str2term "2 * (x \<up> 3 * y \<up> 4 * z \<up> 6 + 7) * y \<up> 8 + 1"))
1.102 +then () else error "is_poly 2 changed";
1.103 +
1.104 +"-------- fun term_of_poly ---------------------------------------------------------------------";
1.105 +"-------- fun term_of_poly ---------------------------------------------------------------------";
1.106 +"-------- fun term_of_poly ---------------------------------------------------------------------";
1.107 +val expT = HOLogic.realT
1.108 +val Free (_, baseT) = (hd o vars o TermC.str2term) "12 * x \<up> 3 * y \<up> 4 * z \<up> 6";
1.109 +val p = [(1, [0, 0, 0]), (7, [0, 8, 0]), (2, [3, 4, 5])]
1.110 +val vs = TermC.vars_of (the (parseNEW ctxt "12 * x \<up> 3 * y \<up> 4 * z \<up> 6"))
1.111 +(*precondition for [(c, es),...]: legth es = length vs*)
1.112 +;
1.113 +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"
1.114 +then () else error "term_of_poly 1 changed";
1.115 +
1.116 +"-------- complex examples: rls norm_Rational --------------------------------------------------";
1.117 +"-------- complex examples: rls norm_Rational --------------------------------------------------";
1.118 +"-------- complex examples: rls norm_Rational --------------------------------------------------";
1.119 +val t = TermC.str2term "(3*x+5)/18 - x/2 - -(3*x - 2)/9 = 0";
1.120 +val SOME (t', _) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
1.121 +if UnparseC.term t' = "1 / 18 = 0" then () else error "rational.sml 1";
1.122 +
1.123 +val t = TermC.str2term "(17*x - 51)/9 - (-(13*x - 3)/6) + 11 - (9*x - 7)/4 = 0";
1.124 +val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
1.125 +if UnparseC.term t' = "(237 + 65 * x) / 36 = 0" then ()
1.126 +else error "rational.sml 2";
1.127 +
1.128 +val t = TermC.str2term "(1/2 + (5*x)/2) \<up> 2 - ((13*x)/2 - 5/2) \<up> 2 - (6*x) \<up> 2 + 29";
1.129 +val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
1.130 +if UnparseC.term t' = "23 + 35 * x + - 72 * x \<up> 2" then ()
1.131 +else error "rational.sml 3";
1.132 +
1.133 +"-------- complex examples cancellation from: Mathematik 1 Schalk ------------------------------";
1.134 +"-------- complex examples cancellation from: Mathematik 1 Schalk ------------------------------";
1.135 +"-------- complex examples cancellation from: Mathematik 1 Schalk ------------------------------";
1.136 +(*Schalk I, p.60 Nr. 215c *)
1.137 +val t = TermC.str2term "(a + b) \<up> 4 * (x - y) / ((x - y) \<up> 3 * (a + b) \<up> 2)";
1.138 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
1.139 +if UnparseC.term t = "(a \<up> 2 + 2 * a * b + b \<up> 2) / (x \<up> 2 + - 2 * x * y + y \<up> 2)"
1.140 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 7";
1.141 +
1.142 +(*SRC Schalk I, p.66 Nr. 381b *)
1.143 +val t = TermC.str2term
1.144 +"(4*x \<up> 2 - 20*x + 25)/(2*x - 5) \<up> 3";
1.145 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
1.146 +if UnparseC.term t = "1 / (- 5 + 2 * x)"
1.147 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 9";
1.148 +
1.149 +(*Schalk I, p.60 Nr. 215c *)
1.150 +val t = TermC.str2term "(a + b) \<up> 4 * (x - y) / ((x - y) \<up> 3 * (a + b) \<up> 2)";
1.151 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
1.152 +if UnparseC.term t = "(a \<up> 2 + 2 * a * b + b \<up> 2) / (x \<up> 2 + - 2 * x * y + y \<up> 2)"
1.153 +then () else error "Schalk I, p.60 Nr. 215c: with Isabelle2002 cancellation incomplete, changed";
1.154 +
2.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2 +++ b/test/Tools/isac/Knowledge/rational-2.sml Fri Jul 16 06:57:34 2021 +0200
2.3 @@ -0,0 +1,1791 @@
2.4 +(* Title: tests for rationals
2.5 + Author: Walther Neuper
2.6 + Use is subject to license terms.
2.7 +*)
2.8 +
2.9 +"-----------------------------------------------------------------------------";
2.10 +"-----------------------------------------------------------------------------";
2.11 +"table of contents -----------------------------------------------------------";
2.12 +"-----------------------------------------------------------------------------";
2.13 +"-------- integration lev.1 fun factout_p_ -----------------------------------";
2.14 +"-------- integration lev.1 fun cancel_p_ ------------------------------------";
2.15 +"-------- integration lev.1 fun common_nominator_p_ --------------------------";
2.16 +"-------- integration lev.1 fun add_fraction_p_ ------------------------------";
2.17 +"Rfuns-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
2.18 +"Rfuns-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
2.19 +"-------- rls norm_Rational downto fun gcd_poly ------------------------------";
2.20 +"Rfuns-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
2.21 +"----------- rewrite_set_ Partial_Fractions norm_Rational --------------------------------------";
2.22 +"----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
2.23 +"----------- fun cancel_p with Const AA --------------------------------------------------------";
2.24 +"-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
2.25 +"-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
2.26 +"-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
2.27 +"Rfuns-------- reverse rewrite ----------------------------------------------------";
2.28 +"Rfuns-------- 'reverse-ruleset' cancel_p -----------------------------------------";
2.29 +"-------- investigate rls norm_Rational --------------------------------------";
2.30 +"-------- examples: rls norm_Rational ----------------------------------------";
2.31 +"-------- rational numerals --------------------------------------------------";
2.32 +"-------- examples cancellation from: Mathematik 1 Schalk --------------------";
2.33 +"-------- examples common denominator from: Mathematik 1 Schalk --------------";
2.34 +"-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
2.35 +"-------- examples common denominator and multiplication from: Schalk --------";
2.36 +"-------- examples double fractions from: Mathematik 1 Schalk ----------------";
2.37 +"-------- me Schalk I No.186 -------------------------------------------------";
2.38 +"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
2.39 +"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
2.40 +"-------- investigate rulesets for cancel_p ----------------------------------";
2.41 +"-------- fun eval_get_denominator -------------------------------------------";
2.42 +"-------- several errpats in complicated term --------------------------------";
2.43 +"-------- WN1309xx non-terminating rls norm_Rational -------------------------";
2.44 +"-----------------------------------------------------------------------------";
2.45 +"-----------------------------------------------------------------------------";
2.46 +
2.47 +
2.48 +"-------- integration lev.1 fun factout_p_ -----------------------------------";
2.49 +"-------- integration lev.1 fun factout_p_ -----------------------------------";
2.50 +"-------- integration lev.1 fun factout_p_ -----------------------------------";
2.51 +val t = TermC.str2term "(x \<up> 2 + -1*y \<up> 2) / (x \<up> 2 + -1*x*y)"
2.52 +val SOME (t', asm) = factout_p_ thy t;
2.53 +if UnparseC.term t' = "(x + y) * (x + - 1 * y) / (x * (x + - 1 * y))"
2.54 +then () else error ("factout_p_ term 1 changed: " ^ UnparseC.term t')
2.55 +;
2.56 +if UnparseC.terms asm = "[\"x \<noteq> 0\", \"x + - 1 * y \<noteq> 0\"]"
2.57 +then () else error "factout_p_ asm 1 changed"
2.58 +;
2.59 +val t = TermC.str2term "nothing + to_cancel ::real";
2.60 +if NONE = factout_p_ thy t then () else error "factout_p_ doesn't report non-applicable";
2.61 +;
2.62 +val t = TermC.str2term "((3 * x \<up> 2 + 6 *x + 3) / (2*x + 2))";
2.63 +val SOME (t', asm) = factout_p_ thy t;
2.64 +if UnparseC.term t' = "(3 + 3 * x) * (1 + x) / (2 * (1 + x))" andalso
2.65 + UnparseC.terms asm = "[\"1 + x \<noteq> 0\"]"
2.66 +then () else error "factout_p_ 1 changed";
2.67 +
2.68 +"-------- integration lev.1 fun cancel_p_ ------------------------------------";
2.69 +"-------- integration lev.1 fun cancel_p_ ------------------------------------";
2.70 +"-------- integration lev.1 fun cancel_p_ ------------------------------------";
2.71 +val t = TermC.str2term "(x \<up> 2 + -1*y \<up> 2) / (x \<up> 2 + -1*x*y)"
2.72 +val SOME (t', asm) = cancel_p_ thy t;
2.73 +if (UnparseC.term t', UnparseC.terms asm) = ("(x + y) / x", "[\"x \<noteq> 0\"]")
2.74 +then () else error ("cancel_p_ (t', asm) 1 changed: " ^ UnparseC.term t')
2.75 +;
2.76 +val t = TermC.str2term "nothing + to_cancel ::real";
2.77 +if NONE = cancel_p_ thy t then () else error "cancel_p_ doesn't report non-applicable";
2.78 +;
2.79 +val t = TermC.str2term "((3 * x \<up> 2 + 6 *x + 3) / (2*x + 2))";
2.80 +val SOME (t', asm) = cancel_p_ thy t;
2.81 +if UnparseC.term t' = "(3 + 3 * x) / 2" andalso UnparseC.terms asm = "[]"
2.82 +then () else error "cancel_p_ 1 changed";
2.83 +
2.84 +"-------- integration lev.1 fun common_nominator_p_ --------------------------";
2.85 +"-------- integration lev.1 fun common_nominator_p_ --------------------------";
2.86 +"-------- integration lev.1 fun common_nominator_p_ --------------------------";
2.87 +val t = TermC.str2term ("y / (a*x + b*x + c*x) " ^
2.88 + (* n1 d1 *)
2.89 + "+ a / (x*y)");
2.90 + (* n2 d2 *)
2.91 +val SOME (t', asm) = common_nominator_p_ thy t;
2.92 +if UnparseC.term t' =
2.93 + ("y * y / (x * ((a + b + c) * y)) " ^
2.94 + (* n1 *d2'/ (c'* ( d1' *d2')) *)
2.95 + "+ a * (a + b + c) / (x * ((a + b + c) * y))")
2.96 + (* n2 * d1' / (c'* ( d1' *d2')) *)
2.97 +then () else error "common_nominator_p_ term 1 changed";
2.98 +if UnparseC.terms asm = "[\"a + b + c \<noteq> 0\", \"y \<noteq> 0\", \"x \<noteq> 0\"]"
2.99 +then () else error "common_nominator_p_ asm 1 changed"
2.100 +
2.101 +"-------- example in mail Nipkow";
2.102 +val t = TermC.str2term "x/(x \<up> 2 + -1*y \<up> 2) + y/(x \<up> 2 + -1*x*y)";
2.103 +val SOME (t', asm) = common_nominator_p_ thy t;
2.104 +if UnparseC.term t' =
2.105 + "x * x / ((x + - 1 * y) * ((x + y) * x)) +\ny * (x + y) / ((x + - 1 * y) * ((x + y) * x))"
2.106 +then () else error "common_nominator_p_ term 2 changed"
2.107 +;
2.108 +if UnparseC.terms asm = "[\"x + y \<noteq> 0\", \"x \<noteq> 0\", \"x + - 1 * y \<noteq> 0\"]"
2.109 +then () else error "common_nominator_p_ asm 2 changed"
2.110 +
2.111 +"-------- example: applicable tested by SML code";
2.112 +val t = TermC.str2term "nothing / to_add";
2.113 +if NONE = common_nominator_p_ thy t then () else error "common_nominator_p_ term 3 changed";
2.114 +;
2.115 +val t = TermC.str2term "((x + (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
2.116 +val SOME (t', asm) = common_nominator_p_ thy t;
2.117 +if UnparseC.term t' =
2.118 + "(x + - 1) * (- 1 + x) / ((1 + x) * (- 1 + x)) +\n(x + 1) * (1 + x) / ((1 + x) * (- 1 + x))"
2.119 + andalso UnparseC.terms asm = "[\"1 + x \<noteq> 0\", \"- 1 + x \<noteq> 0\"]"
2.120 +then () else error "common_nominator_p_ 3 changed";
2.121 +
2.122 +"-------- integration lev.1 fun add_fraction_p_ ------------------------------";
2.123 +"-------- integration lev.1 fun add_fraction_p_ ------------------------------";
2.124 +"-------- integration lev.1 fun add_fraction_p_ ------------------------------";
2.125 +val t = TermC.str2term "((x + (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
2.126 +val SOME (t', asm) = add_fraction_p_ thy t;
2.127 +if UnparseC.term t' = "(2 + 2 * x \<up> 2) / (- 1 + x \<up> 2)"
2.128 +then () else error "add_fraction_p_ 3 changed";
2.129 +;
2.130 +if UnparseC.terms asm = "[\"- 1 + x \<up> 2 \<noteq> 0\"]"
2.131 +then () else error "add_fraction_p_ 3 changed";
2.132 +;
2.133 +val t = TermC.str2term "nothing / to_add";
2.134 +if NONE = add_fraction_p_ thy t then () else error "add_fraction_p_ term 3 changed";
2.135 +;
2.136 +val t = TermC.str2term "((x + (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
2.137 +val SOME (t', asm) = add_fraction_p_ thy t;
2.138 +if UnparseC.term t' = "(2 + 2 * x \<up> 2) / (- 1 + x \<up> 2)" andalso
2.139 + UnparseC.terms asm = "[\"- 1 + x \<up> 2 \<noteq> 0\"]"
2.140 +then () else error "add_fraction_p_ 3 changed";
2.141 +
2.142 +"-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
2.143 +"-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
2.144 +"-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
2.145 +(* trace down until prepats are evaluated
2.146 + (which does not to work, because substitution is not done -- compare rew_sub!);
2.147 + keep this sequence for the case, factout_p, cancel_p, common_nominator_p, add_fraction_p
2.148 + (again) get prepat = [] changed to <>[]. *)
2.149 +val t = TermC.str2term "(x \<up> 2 + -1*y \<up> 2) / (x \<up> 2 + -1*x*y)";
2.150 +
2.151 +(*rewrite_set_ @{theory Isac_Knowledge} true cancel t = NONE; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
2.152 +"~~~~~ fun rewrite_set_, args:"; val (thy, bool, rls, term) = (thy, false, cancel_p, t);
2.153 +"~~~~~ fun rewrite__set_, args:"; val (thy, i, _, _, (rrls as Rrls _), t) =
2.154 + (thy, 1, bool, [], rls, term);
2.155 +(*val (t', asm, rew) = app_rev thy (i+1) rrls t; rew = false!!!!!!!!!!!!!!!!!!!!!*)
2.156 +"~~~~~ and app_rev, args:"; val (thy, i, rrls, t) = (thy, (i+1), rrls, t);
2.157 + fun chk_prepat thy erls [] t = true
2.158 + | chk_prepat thy erls prepat t =
2.159 + let
2.160 + fun chk (pres, pat) =
2.161 + (let
2.162 + val subst: Type.tyenv * Envir.tenv =
2.163 + Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
2.164 + in
2.165 + snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
2.166 + end) handle Pattern.MATCH => false
2.167 + fun scan_ f [] = false (*scan_ NEVER called by []*)
2.168 + | scan_ f (pp::pps) =
2.169 + if f pp then true else scan_ f pps;
2.170 + in scan_ chk prepat end;
2.171 + (* apply the normal_form of a rev-set *)
2.172 + fun app_rev' thy (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}) t =
2.173 + if chk_prepat thy erls prepat t
2.174 + then ((*tracing("### app_rev': t = "^UnparseC.term t);*) normal_form t)
2.175 + else NONE;
2.176 +(* val opt = app_rev' thy rrls t ..NONE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
2.177 +"~~~~~ and app_rev', args:"; val (thy, (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}), t) =
2.178 + (thy, rrls, t);
2.179 +(* chk_prepat thy erls prepat t = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
2.180 +(* app_sub thy i rrls t = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
2.181 +"~~~~~ fun chk_prepat, args:"; val (thy, erls, prepat, t) = (thy, erls, prepat, t);
2.182 + fun chk (pres, pat) =
2.183 + (let
2.184 + val subst: Type.tyenv * Envir.tenv =
2.185 + Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
2.186 + in
2.187 + snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
2.188 + end) handle Pattern.MATCH => false
2.189 + fun scan_ f [] = false (*scan_ NEVER called by []*)
2.190 + | scan_ f (pp::pps) =
2.191 + if f pp then true else scan_ f pps;
2.192 +
2.193 +(*========== inhibit exn WN130823: prepat is empty ====================================
2.194 +(* scan_ chk prepat = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
2.195 +"~~~~~ fun , args:"; val (f, (pp::pps)) = (chk, prepat);
2.196 +f;
2.197 +val ([t1, t2], t) = pp;
2.198 +UnparseC.term t1 = "?r is_expanded";
2.199 +UnparseC.term t2 = "?s is_expanded";
2.200 +UnparseC.term t = "?r / ?s";
2.201 +(* f pp = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
2.202 +"~~~~~ fun chk, args:"; val (pres, pat) = (pp);
2.203 + val subst: Type.tyenv * Envir.tenv =
2.204 + Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
2.205 +(*subst =
2.206 + ({}, {(("r", 0), ("real", Var (("r", 0), "real"))),
2.207 + (("s", 0), ("real", Var (("s", 0), "real")))}*)
2.208 +;
2.209 + snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
2.210 +"~~~~~ fun eval__true, args:"; val (thy, i, asms, bdv, rls) =
2.211 + (thy, (i + 1), (map (Envir.subst_term subst) pres), [], erls);
2.212 +UnparseC.terms asms; (* = "[\"?r is_expanded\",\"?s is_expanded\"]"*)
2.213 +asms = [@{term True}] orelse asms = []; (* = false*)
2.214 +asms = [@{term False}] ; (* = false*)
2.215 +"~~~~~ fun chk, args:"; val (indets, (a::asms)) = ([], asms);
2.216 +bdv (*= []: _a list*);
2.217 +val bdv : (term * term) list = [];
2.218 +rewrite__set_ thy (i+1) false;
2.219 +UnparseC.term a = "?r is_expanded"; (*hier m"usste doch der Numerator eingesetzt sein ??????????????*)
2.220 +val SOME (Const ("HOL.False", _), []) = rewrite__set_ thy (i+1) false bdv rls a
2.221 +============ inhibit exn WN130823: prepat is empty ===================================*)
2.222 +
2.223 +"-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
2.224 +"-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
2.225 +"-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
2.226 +val t = TermC.str2term "(12 * x * y) / (8 * y \<up> 2 )";
2.227 +(* "-------- example 187a": exception Div raised...
2.228 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;*)
2.229 +val t = TermC.str2term "(8 * x \<up> 2 * y * z ) / (18 * x * y \<up> 2 * z )";
2.230 +(* "-------- example 187b": doesn't terminate...
2.231 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;*)
2.232 +val t = TermC.str2term "(9 * x \<up> 5 * y \<up> 2 * z \<up> 4) / (15 * x \<up> 6 * y \<up> 3 * z )";
2.233 +(* "-------- example 187c": doesn't terminate...
2.234 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;*)
2.235 +"~~~~~ fun rewrite_set_, args:"; val (thy, bool, rls, term) = (@{theory Isac_Knowledge}, false, cancel_p, t);
2.236 +(* WN130827: exception Div raised...
2.237 +rewrite__set_ thy 1 bool [] rls term
2.238 +*)
2.239 +"~~~~~ and rewrite__set_, args:"; val (thy, i, _, _, (rrls as Rrls _), t) =
2.240 + (thy, 1, bool, [], rls, term);
2.241 +(* WN130827: exception Div raised...
2.242 + val (t', asm, rew) = app_rev thy (i+1) rrls t
2.243 +*)
2.244 +"~~~~~ fun app_rev, args:"; val (thy, i, rrls, t) = (thy, (i+1), rrls, t);
2.245 +(* WN130827: exception Div raised...
2.246 + val opt = app_rev' thy rrls t
2.247 +*)
2.248 +"~~~~~ fun app_rev', args:"; val (thy, (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}), t) =
2.249 + (thy, rrls, t);
2.250 +chk_prepat thy erls prepat t = true;
2.251 +(* WN130827: exception Div raised...
2.252 +normal_form t
2.253 +*)
2.254 +(* lookup Rational.thy, cancel_p: normal_form = cancel_p_ thy*)
2.255 +"~~~~~ fun cancel_p_, args:"; val (t) = (t);
2.256 +val opt = check_fraction t;
2.257 +val SOME (numerator, denominator) = opt
2.258 + val vs = TermC.vars_of t
2.259 + val baseT = type_of numerator
2.260 + val expT = HOLogic.realT
2.261 +val (SOME a, SOME b) = (poly_of_term vs numerator, poly_of_term vs denominator);
2.262 +(*"-------- example 187a": exception Div raised...
2.263 +val a = [(12, [1, 1])]: poly
2.264 +val b = [(8, [0, 2])]: poly
2.265 + val ((a', b'), c) = gcd_poly a b
2.266 +*)
2.267 +(* "-------- example 187b": doesn't terminate...
2.268 +val a = [(8, [2, 1, 1])]: poly
2.269 +val b = [(18, [1, 2, 1])]: poly
2.270 + val ((a', b'), c) = gcd_poly a b
2.271 +*)
2.272 +(* "-------- example 187c": doesn't terminate...
2.273 +val a = [(9, [5, 2, 4])]: poly
2.274 +val b = [(15, [6, 3, 1])]: poly
2.275 + val ((a', b'), c) = gcd_poly a b
2.276 +*)
2.277 +
2.278 +"-------- rls norm_Rational downto fun gcd_poly ------------------------------";
2.279 +"-------- rls norm_Rational downto fun gcd_poly ------------------------------";
2.280 +"-------- rls norm_Rational downto fun gcd_poly ------------------------------";
2.281 +val t = TermC.str2term "(x \<up> 2 - 4)*(3 - y) / ((y \<up> 2 - 9)*(2+x))";
2.282 +Rewrite.trace_on := false (*true false*);
2.283 +(* trace stops with ...: (and then jEdit hangs)..
2.284 +rewrite_set_ thy false norm_Rational t;
2.285 +:
2.286 +### rls: cancel_p on: (-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /
2.287 +(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)
2.288 +*)
2.289 +val t = TermC.str2term (*copy from above: "::real" is not required due to " \<up> "*)
2.290 + ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
2.291 + "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)");
2.292 +(*cancel_p_ thy t;
2.293 +exception Div raised*)
2.294 +
2.295 +"~~~~~ fun cancel_p_, args:"; val (t) = (t);
2.296 +val opt = check_fraction t;
2.297 +val SOME (numerator, denominator) = opt
2.298 + val vs = TermC.vars_of t
2.299 + val baseT = type_of numerator
2.300 + val expT = HOLogic.realT;
2.301 +(*default_print_depth 3; 999*)
2.302 +val (SOME a, SOME b) = (poly_of_term vs numerator, poly_of_term vs denominator);
2.303 +(*default_print_depth 3; 999*)
2.304 +(* does not terminate instead of returning ?:
2.305 + val ((a', b'), c) = gcd_poly a b
2.306 +val a = [(~12, [0, 0]), (3, [2, 0]), (4, [0, 1]), (~1, [2, 1])]: poly
2.307 +val b = [(~18, [0, 0]), (~9, [1, 0]), (2, [0, 2]), (1, [1, 2])]: poly
2.308 +*)
2.309 +
2.310 +"-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
2.311 +"-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
2.312 +"-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
2.313 +val thy = @{theory Isac_Knowledge};
2.314 +"----- SK060904-2a non-termination of add_fraction_p_";
2.315 +val t = TermC.str2term (" (a + b * x) / (a + -1 * (b * x)) + " ^
2.316 + " (-1 * a + b * x) / (a + b * x) ");
2.317 +(* rewrite_set_ thy false norm_Rational t
2.318 +exception Div raised*)
2.319 +(* rewrite_set_ thy false add_fractions_p t;
2.320 +exception Div raised*)
2.321 +"~~~~~ fun rewrite_set_, args:"; val (thy, bool, rls, term) =
2.322 + (@{theory Isac_Knowledge}, false, add_fractions_p, t);
2.323 +"~~~~~ and rewrite__set_, args:"; val (thy, i, _, _, (rrls as Rrls _), t) =
2.324 + (thy, 1, bool, [], rls, term);
2.325 +(* app_rev thy (i+1) rrls t;
2.326 +exception Div raised*)
2.327 +"~~~~~ and app_rev, args:"; val (thy, i, rrls, t) = (thy, (i+1), rrls, t);
2.328 + fun chk_prepat thy erls [] t = true
2.329 + | chk_prepat thy erls prepat t =
2.330 + let
2.331 + fun chk (pres, pat) =
2.332 + (let
2.333 + val subst: Type.tyenv * Envir.tenv =
2.334 + Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
2.335 + in
2.336 + snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
2.337 + end) handle Pattern.MATCH => false
2.338 + fun scan_ f [] = false (*scan_ NEVER called by []*)
2.339 + | scan_ f (pp::pps) =
2.340 + if f pp then true else scan_ f pps;
2.341 + in scan_ chk prepat end;
2.342 + (* apply the normal_form of a rev-set *)
2.343 + fun app_rev' thy (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}) t =
2.344 + if chk_prepat thy erls prepat t
2.345 + then ((*tracing("### app_rev': t = "^UnparseC.term t);*) normal_form t)
2.346 + else NONE;
2.347 +(* val opt = app_rev' thy rrls t;
2.348 +exception Div raised*)
2.349 +(* val opt = app_rev' thy rrls t;
2.350 +exception Div raised*)
2.351 +"~~~~~ and app_rev', args:"; val (thy, (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}), t) =
2.352 + (thy, rrls, t);
2.353 +chk_prepat thy erls prepat t = true = true;
2.354 +(*normal_form t
2.355 +exception Div raised*)
2.356 +(* lookup Rational.thy, val add_fractions_p: normal_form = add_fraction_p_ thy*)
2.357 +(*add_fraction_p_ thy t
2.358 +exception Div raised*)
2.359 +"~~~~~ fun add_fraction_p_, args:"; val ((_: theory), t) = (thy, t);
2.360 +val SOME ((n1, d1), (n2, d2)) = check_frac_sum t;
2.361 +UnparseC.term n1; UnparseC.term d1; UnparseC.term n2; UnparseC.term d2;
2.362 + val vs = TermC.vars_of t;
2.363 +(*default_print_depth 3; 999*)
2.364 +val (SOME _, SOME a, SOME _, SOME b) =
2.365 + (poly_of_term vs n1, poly_of_term vs d1, poly_of_term vs n2, poly_of_term vs d2);
2.366 +(*default_print_depth 3; 999*)
2.367 +(*
2.368 +val a = [(1, [1, 0, 0]), (~1, [0, 1, 1])]: poly
2.369 +val b = [(1, [1, 0, 0]), (1, [0, 1, 1])]: poly
2.370 + val ((a', b'), c) = gcd_poly a b
2.371 +*)
2.372 +
2.373 +"----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
2.374 +"----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
2.375 +"----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
2.376 +val thy = @{theory Isac_Knowledge(*Partial_Fractions*)}
2.377 +val ctxt = Proof_Context.init_global thy;
2.378 +
2.379 +(*---------- (1) with Free A, B ----------------------------------------------------------------*)
2.380 +val t = (the o (parseNEW ctxt)) "3 = A / 2 + A / 4 + (B / 2 + -1 * B / (2::real))";
2.381 + (* required for applying thms in rewriting \<up> ^*)
2.382 +(* we get details from here..*)
2.383 +
2.384 +Rewrite.trace_on := false;
2.385 +val SOME (t', _) = Rewrite.rewrite_set_ thy true add_fractions_p t;
2.386 +Rewrite.trace_on := false;
2.387 +(* Rewrite.trace_on:
2.388 +add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
2.389 + (* |||||||||||||||||||||||||||||||||||| *)
2.390 +
2.391 +val t = (the o (parseNEW ctxt))(* ||||||||||||||||||||||||| GUESS 1 GUESS 1 GUESS 1 GUESS 1 *)
2.392 + "A / 2 + A / 4 + (B / 2 + -1 * B / (2::real))";
2.393 +"~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
2.394 +val NONE = (*case*) check_frac_sum t (*of*)
2.395 +
2.396 +(* Rewrite.trace_on:
2.397 +add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
2.398 + (* |||||||||||||||||||||||||||| *)
2.399 +val t = (the o (parseNEW ctxt))(* ||||||||||||||||||||||||| GUESS 2 GUESS 2 GUESS 2 GUESS 2 *)
2.400 + "A / 4 + (B / 2 + -1 * B / (2::real))";
2.401 +"~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
2.402 +val SOME ((n1, d1), (n2, d2)) = (*case*) check_frac_sum t (*of*);
2.403 +(*+*)if (UnparseC.term n1, UnparseC.term d1) = ("A" , "4") andalso
2.404 +(*+*) (UnparseC.term n2, UnparseC.term d2) = ("B / 2 + - 1 * B / 2", "1")
2.405 +(*+*)then () else error "check_frac_sum (A / 4 + (B / 2 + -1 * B / (2::real))) changed";
2.406 +
2.407 + val vs = TermC.vars_of t;
2.408 +val (SOME [(1, [1, 0])], SOME [(4, [0, 0])], NONE, SOME [(1, [0, 0])]) =
2.409 + (*case*) (poly_of_term vs n1, poly_of_term vs d1, poly_of_term vs n2, poly_of_term vs d2) (*of*);
2.410 +
2.411 +"~~~~~ fun poly_of_term , args:"; val (vs, t) = (vs, n1);
2.412 +val SOME [(1, [xxx, 0])] = SOME [monom_of_term vs (1, replicate (length vs) 0) t];
2.413 +(*+*)if xxx = 1 then () else error "monom_of_term changed"
2.414 +
2.415 +"~~~~~ fun monom_of_term , args:"; val (vs, (c, es), (Free (id, _))) =
2.416 + (vs, (1, replicate (length vs) 0), t);
2.417 +case vs of [Free ("A", _), Free ("B", _)] =>
2.418 + if c = 1 andalso id = "A"
2.419 + then () else error "monom_of_term Free changed 1"
2.420 +| _ => error "monom_of_term Free changed 2";
2.421 +
2.422 +(*---------- (2) with Const AA, BB --------------------------------------------------------------*)
2.423 +val t = (the o (parseNEW ctxt)) "3 = AA / 2 + AA / 4 + (BB / 2 + -1 * BB / 2)";
2.424 + (*AA :: real*)
2.425 +(* we get details from here..*)
2.426 +
2.427 +Rewrite.trace_on := false;
2.428 +val SOME (t', _) = Rewrite.rewrite_set_ thy true add_fractions_p t;
2.429 +Rewrite.trace_on := false;
2.430 +(* Rewrite.trace_on:
2.431 +add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
2.432 + (* |||||||||||||||||||||||||||||||||||| *)
2.433 +val t = (the o (parseNEW ctxt))(* ||||||||||||||||||||||||| *)
2.434 + "AA / 2 + AA / 4 + (BB / 2 + -1 * BB / 2)";
2.435 +"~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
2.436 +val NONE = (*case*) check_frac_sum t (*of*)
2.437 +
2.438 +(* Rewrite.trace_on:
2.439 +add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
2.440 + (* |||||||||||||||||||||||||||| *)
2.441 +val t = (the o (parseNEW ctxt))(* ||||||||||||||||||||||||| *)
2.442 + "AA / 4 + (BB / 2 + -1 * BB / 2)";
2.443 +"~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
2.444 +val SOME ((n1, d1), (n2, d2)) = (*case*) check_frac_sum t (*of*);
2.445 +(*+*)if (UnparseC.term n1, UnparseC.term d1) = ("AA" , "4") andalso
2.446 +(*+*) (UnparseC.term n2, UnparseC.term d2) = ("BB / 2 + - 1 * BB / 2", "1")
2.447 +(*+*)then () else error "check_frac_sum (AA / 4 + (BB / 2 + -1 * BB / 2)) changed";
2.448 +
2.449 + val vs = TermC.vars_of t;
2.450 +val (SOME [(1, [1, 0])], SOME [(4, [0, 0])], NONE, SOME [(1, [0, 0])]) =
2.451 + (*case*) (poly_of_term vs n1, poly_of_term vs d1, poly_of_term vs n2, poly_of_term vs d2) (*of*);
2.452 +
2.453 +"~~~~~ fun poly_of_term , args:"; val (vs, t) = (vs, n1);
2.454 +val SOME [(1, [xxx, 0])] = SOME [monom_of_term vs (1, replicate (length vs) 0) t];
2.455 +(*+*)if xxx = 1 then () else error "monom_of_term changed"
2.456 +
2.457 +"~~~~~ fun monom_of_term , args:"; val (vs, (c, es), (Const (id, _))) =
2.458 + (vs, (1, replicate (length vs) 0), t);
2.459 +case vs of [Const ("Partial_Fractions.AA", _), Const ("Partial_Fractions.BB", _)] =>
2.460 + if c = 1 andalso id = "Partial_Fractions.AA"
2.461 + then () else error "monom_of_term Const changed 1"
2.462 +| _ => error "monom_of_term Const changed 2";
2.463 +
2.464 +"----------- fun cancel_p with Const AA --------------------------------------------------------";
2.465 +"----------- fun cancel_p with Const AA --------------------------------------------------------";
2.466 +"----------- fun cancel_p with Const AA --------------------------------------------------------";
2.467 +val thy = @{theory Partial_Fractions};
2.468 +val ctxt = Proof_Context.init_global @{theory}
2.469 +val SOME t = TermC.parseNEW ctxt "2 * AA / 2"; (* Const ("Free ("AA", "real") *)
2.470 +
2.471 +val SOME (t', _) = rewrite_set_ thy true cancel_p t;
2.472 +case t' of
2.473 + Const ("Rings.divide_class.divide", _) $ Const ("Partial_Fractions.AA", _) $
2.474 + Const ("Groups.one_class.one", _) => ()
2.475 +| _ => error "WRONG rewrite_set_ cancel_p (2 * AA / 2) \<longrightarrow> AA changed";
2.476 +
2.477 +"~~~~~ fun cancel_p , args:"; val (t) = (t);
2.478 +val opt = check_fraction t
2.479 +val SOME (numerator, denominator) = (*case*) opt (*of*);
2.480 +
2.481 +if UnparseC.term numerator = "2 * AA" andalso UnparseC.term denominator = "2"
2.482 +then () else error "check_fraction (2 * AA / 2) changed";
2.483 + val vs = TermC.vars_of t;
2.484 +case vs of
2.485 + [Const ("Partial_Fractions.AA", _)] => ()
2.486 +| _ => error "rewrite_set_ cancel_p (2 * AA / 2) \<longrightarrow> AA/1 changed";
2.487 +
2.488 +
2.489 +"-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
2.490 +"-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
2.491 +"-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
2.492 +val thy = @{theory "Rational"};
2.493 +"-------- WN";
2.494 +val t = TermC.str2term "(2 + -3 * x) / 9";
2.495 +if NONE = rewrite_set_ thy false cancel_p t then ()
2.496 +else error "rewrite_set_ cancel_p must return NONE, if the term cannot be cancelled";
2.497 +
2.498 +"-------- example 186a";
2.499 +val t = TermC.str2term "(14 * x * y) / (x * y)";
2.500 + is_expanded (TermC.str2term "14 * x * y");
2.501 + is_expanded (TermC.str2term "x * y");
2.502 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.503 +if (UnparseC.term t', UnparseC.terms asm) = ("14 / 1", "[]")
2.504 +then () else error "rational.sml cancel Schalk 186a";
2.505 +
2.506 +"-------- example 186b";
2.507 +val t = TermC.str2term "(60 * a * b) / ( 15 * a * b )";
2.508 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.509 +if (UnparseC.term t', UnparseC.terms asm) = ("4 / 1", "[]")
2.510 +then () else error "rational.sml cancel Schalk 186b";
2.511 +
2.512 +"-------- example 186c";
2.513 +val t = TermC.str2term "(144 * a \<up> 2 * b * c) / (12 * a * b * c)";
2.514 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.515 +if (UnparseC.term t', UnparseC.terms asm) = ("12 * a / 1", "[]")
2.516 +then () else error "rational.sml cancel Schalk 186c";
2.517 +
2.518 +(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! exception Div raised !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2.519 + see --- fun rewrite_set_ downto fun gcd_poly ---
2.520 +"-------- example 187a";
2.521 +val t = TermC.str2term "(12 * x * y) / (8 * y \<up> 2 )";
2.522 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.523 +if (UnparseC.term t', UnparseC.terms asm) = ("3 * x / (2 * y)", "[\"4 * y ~= 0\"]")
2.524 +then () else error "rational.sml cancel Schalk 187a";
2.525 +*)
2.526 +
2.527 +(* doesn't terminate !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2.528 + see --- fun rewrite_set_ downto fun gcd_poly ---
2.529 +"-------- example 187b";
2.530 +val t = TermC.str2term "(8 * x \<up> 2 * y * z ) / (18 * x * y \<up> 2 * z )";
2.531 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.532 +if (UnparseC.term t', UnparseC.terms asm) = ("4 * x / (9 * y)", "[\"2 * (z * (y * x)) ~= 0\"]")
2.533 +then () else error "rational.sml cancel Schalk 187b";
2.534 +*)
2.535 +
2.536 +(* doesn't terminate !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2.537 + see --- fun rewrite_set_ downto fun gcd_poly ---
2.538 +"-------- example 187c";
2.539 +val t = TermC.str2term "(9 * x \<up> 5 * y \<up> 2 * z \<up> 4) / (15 * x \<up> 6 * y \<up> 3 * z )";
2.540 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.541 +if (UnparseC.term t', UnparseC.terms asm) =
2.542 + ("3 * z \<up> 3 / (5 * (y * x))", "[\"3 * (z * (y \<up> 2 * x \<up> 5)) ~= 0\"]")
2.543 +then () else error "rational.sml cancel Schalk 187c";
2.544 +*)
2.545 +
2.546 +"-------- example 188a";
2.547 +val t = TermC.str2term "(-8 + 8 * x) / (-9 + 9 * x)";
2.548 + is_expanded (TermC.str2term "8 * x + -8");
2.549 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.550 +if (UnparseC.term t', UnparseC.terms asm) = ("8 / 9", "[]")
2.551 +then () else error "rational.sml cancel Schalk 188a";
2.552 +
2.553 +val t = TermC.str2term "(8*((-1) + x))/(9*((-1) + x))";
2.554 +val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
2.555 +if (UnparseC.term t', UnparseC.terms asm) = ("8 / 9", "[]")
2.556 +then () else error "rational.sml cancel Schalk make_polynomial 1";
2.557 +
2.558 +"-------- example 188b";
2.559 +val t = TermC.str2term "(-15 + 5 * x) / (-18 + 6 * x)";
2.560 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.561 +if (UnparseC.term t', UnparseC.terms asm) = ("5 / 6", "[]")
2.562 +then () else error "rational.sml cancel Schalk 188b";
2.563 +
2.564 +"-------- example 188c";
2.565 +val t = TermC.str2term "(a + -1 * b) / (b + -1 * a)";
2.566 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.567 +if (UnparseC.term t', UnparseC.terms asm) = ("- 1 / 1", "[]")
2.568 +then () else error "rational.sml cancel Schalk 188c";
2.569 +
2.570 +is_expanded (TermC.str2term "a + -1 * b") = true;
2.571 +val t = TermC.str2term "((- 1)*(b + (-1) * a))/(1*(b + (- 1) * a))";
2.572 +val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
2.573 +if (UnparseC.term t', UnparseC.terms asm) = ("(a + - 1 * b) / (- 1 * a + b)", "[]")
2.574 +then () else error "rational.sml cancel Schalk make_polynomial 2";
2.575 +
2.576 +"-------- example 190a";
2.577 +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 )";
2.578 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.579 +if (UnparseC.term t', UnparseC.terms asm) =
2.580 + ("(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)", "[\"3 * a + 9 * a \<up> 2 \<noteq> 0\"]")
2.581 +then () else error "rational.sml cancel Schalk 190a";
2.582 +
2.583 +"-------- example 190c";
2.584 +val t = TermC.str2term "((1 + 9 * a \<up> 2)*(1 + 3 * a))/((3 * a + 9 * a \<up> 2)*(1 + 3 * a))";
2.585 +val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
2.586 +if (UnparseC.term t', UnparseC.terms asm) =
2.587 + ("(1 + 3 * a + 9 * a \<up> 2 + 27 * a \<up> 3) /\n(3 * a + 18 * a \<up> 2 + 27 * a \<up> 3)", "[]")
2.588 +then () else error "rational.sml make_polynomial Schalk 190c";
2.589 +
2.590 +"-------- example 191a";
2.591 +val t = TermC.str2term "( x \<up> 2 + -1 * y \<up> 2 ) / ( x + y )";
2.592 + is_expanded (TermC.str2term "x \<up> 2 + - 1 * y \<up> 2") = false; (*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
2.593 + is_expanded (TermC.str2term "x + y") = true;
2.594 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.595 +if (UnparseC.term t', UnparseC.terms asm) = ("(x + - 1 * y) / 1", "[]")
2.596 +then () else error "rational.sml make_polynomial Schalk 191a";
2.597 +
2.598 +"-------- example 191b";
2.599 +val t = TermC.str2term "((x + (- 1) * y)*(x + y))/((1)*(x + y))";
2.600 +val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
2.601 +if (UnparseC.term t', UnparseC.terms asm) = ("(x \<up> 2 + - 1 * y \<up> 2) / (x + y)", "[]")
2.602 +then () else error "rational.sml make_polynomial Schalk 191b";
2.603 +
2.604 +"-------- example 191c";
2.605 +val t = TermC.str2term "( 9 * x \<up> 2 + -30 * x + 25 ) / ( 9 * x \<up> 2 + -25 )";
2.606 + is_expanded (TermC.str2term "9 * x \<up> 2 + -30 * x + 25") = true;
2.607 + is_expanded (TermC.str2term "25 + -30*x + 9*x \<up> 2") = true;
2.608 + is_expanded (TermC.str2term "-25 + 9*x \<up> 2") = true;
2.609 +
2.610 +val t = TermC.str2term "(((-5) + 3 * x)*((-5) + 3 * x))/((5 + 3 * x)*((-5) + 3 * x))";
2.611 +val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
2.612 +if (UnparseC.term t', UnparseC.terms asm) = ("(25 + - 30 * x + 9 * x \<up> 2) / (- 25 + 9 * x \<up> 2)", "[]")
2.613 +then () else error "rational.sml make_polynomial Schalk 191c";
2.614 +
2.615 +"-------- example 192b";
2.616 +val t = TermC.str2term "( 7 * x \<up> 3 + - 1 * x \<up> 2 * y ) / ( 7 * x * y \<up> 2 + - 1 * y \<up> 3 )";
2.617 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.618 +if (UnparseC.term t', UnparseC.terms asm) = ("x \<up> 2 / y \<up> 2", "[\"y \<up> 2 \<noteq> 0\"]")
2.619 +then () else error "rational.sml cancel_p Schalk 192b";
2.620 +
2.621 +val t = TermC.str2term "((x \<up> 2)*(7 * x + (-1) * y))/((y \<up> 2)*(7 * x + (-1) * y))";
2.622 +val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
2.623 +if (UnparseC.term t', UnparseC.terms asm) =
2.624 + ("(7 * x \<up> 3 + - 1 * x \<up> 2 * y) /\n(7 * x * y \<up> 2 + - 1 * y \<up> 3)", "[]")
2.625 +then () else error "rational.sml make_polynomial Schalk 192b";
2.626 +
2.627 +val t = TermC.str2term "((x \<up> 2)*(7 * x + (-1) * y))/((y \<up> 2)*(7 * x + (-1) * y))";
2.628 +val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
2.629 +if (UnparseC.term t', UnparseC.terms asm) =
2.630 + ("(7 * x \<up> 3 + - 1 * x \<up> 2 * y) /\n(7 * x * y \<up> 2 + - 1 * y \<up> 3)", "[]")
2.631 +then () else error "rational.sml make_polynomial Schalk WN050929 not working";
2.632 +
2.633 +"-------- example 193a";
2.634 +val t = TermC.str2term "( x \<up> 2 + -6 * x + 9 ) / ( x \<up> 2 + -9 )";
2.635 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.636 +if (UnparseC.term t', UnparseC.terms asm) = ("(- 3 + x) / (3 + x)", "[\"3 + x \<noteq> 0\"]")
2.637 +then () else error "rational.sml cancel_p Schalk 193a";
2.638 +
2.639 +"-------- example 193b";
2.640 +val t = TermC.str2term "( x \<up> 2 + -8 * x + 16 ) / ( 2 * x \<up> 2 + -32 )";
2.641 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.642 +if (UnparseC.term t', UnparseC.terms asm) = ("(- 4 + x) / (8 + 2 * x)", "[\"8 + 2 * x \<noteq> 0\"]")
2.643 +then () else error "rational.sml cancel_p Schalk 193b";
2.644 +
2.645 +"-------- example 193c";
2.646 +val t = TermC.str2term "( 2 * x + -50 * x \<up> 3 ) / ( 25 * x \<up> 2 + -10 * x + 1 )";
2.647 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.648 +if (UnparseC.term t', UnparseC.terms asm) =
2.649 + ("(2 * x + 10 * x \<up> 2) / (1 + - 5 * x)", "[\"1 + - 5 * x \<noteq> 0\"]")
2.650 +then () else error "rational.sml cancel_p Schalk 193c";
2.651 +
2.652 +(*WN: improved with new numerals*)
2.653 +val t = TermC.str2term "(-25 + 9*x \<up> 2)/(5 + 3*x)";
2.654 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.655 +if (UnparseC.term t', UnparseC.terms asm) = ("(- 5 + 3 * x) / 1", "[]")
2.656 +then () else error "rational.sml cancel WN 1";
2.657 +
2.658 +"-------- example heuberger";
2.659 +val t = TermC.str2term ("(x \<up> 4 + x * y + x \<up> 3 * y + y \<up> 2) / " ^
2.660 + "(x + 5 * x \<up> 2 + y + 5 * x * y + x \<up> 2 * y \<up> 3 + x * y \<up> 4)");
2.661 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.662 +if (UnparseC.term t', UnparseC.terms asm) =
2.663 + ("(x \<up> 3 + y) / (1 + 5 * x + x * y \<up> 3)", "[\"1 + 5 * x + x * y \<up> 3 \<noteq> 0\"]")
2.664 +then () else error "rational.sml cancel_p heuberger";
2.665 +
2.666 +"-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
2.667 +"-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
2.668 +"-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
2.669 +(*deleted example 204 ... 236b at update Isabelle2012-->2013*)
2.670 +
2.671 +"-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
2.672 +"-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
2.673 +"-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
2.674 +val t = TermC.str2term ("123 = (a*x)/(b*x) + (c*x)/(d*x) + (e*x)/(f*x::real)");
2.675 +"-------- gcd_poly integration level 1: works on exact term";
2.676 +if NONE = cancel_p_ thy t then () else error "cancel_p_ works on exact fraction";
2.677 +if NONE = add_fraction_p_ thy t then () else error "add_fraction_p_ works on exact fraction";
2.678 +
2.679 +"-------- gcd_poly integration level 2: picks out ONE appropriate subterm";
2.680 +val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
2.681 +if UnparseC.term t' = "123 = a * x / (b * x) + c * x / (d * x) + e / f"
2.682 +then () else error "level 2, rewrite_set_ cancel_p: changed";
2.683 +val SOME (t', asm) = rewrite_set_ thy false add_fractions_p t;
2.684 +if UnparseC.term t' = "123 = (b * c * x + a * d * x) / (b * d * x) + e * x / (f * x)"
2.685 +then () else error "level 2, rewrite_set_ add_fractions_p: changed";
2.686 +
2.687 +"-------- gcd_poly integration level 3: rewrites all appropriate subterms";
2.688 +val SOME (t', asm) = rewrite_set_ thy false cancel_p_rls t;
2.689 +if UnparseC.term t' = "123 = a / b + c / d + e / f"
2.690 +then () else error "level 3, rewrite_set_ cancel_p_rls: changed";
2.691 +val SOME (t', asm) = rewrite_set_ thy false add_fractions_p_rls t; (*CREATE add_fractions_p_rls*)
2.692 +if UnparseC.term t' = "123 = (b * d * e * x + b * c * f * x + a * d * f * x) / (b * d * f * x)"
2.693 +then () else error "level 3, rewrite_set_ add_fractions_p_rls: changed";
2.694 +
2.695 +"-------- gcd_poly integration level 4: iteration cancel_p -- add_fraction_p";
2.696 +(* simpler variant *)
2.697 +val testrls = Rule_Set.append_rules "testrls" Rule_Set.empty [Rls_ cancel_p, Rls_ add_fractions_p]
2.698 +val SOME (t', asm) = rewrite_set_ thy false testrls t;
2.699 +(*Rewrite.trace_on := false;
2.700 +# rls: testrls on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x)
2.701 +## rls: cancel_p on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x)
2.702 +## rls: add_fractions_p on: 123 = a * x / (b * x) + c * x / (d * x) + e / f
2.703 +## rls: cancel_p on: 123 = (b * c * x + a * d * x) / (b * d * x) + e / f
2.704 +## rls: add_fractions_p on: 123 = (b * c + a * d) / (b * d) + e / f
2.705 +## rls: cancel_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)
2.706 +## rls: add_fractions_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) *)
2.707 +if UnparseC.term t' = "123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)"
2.708 +then () else error "level 4, rewrite_set_ *_p: changed";
2.709 +
2.710 +(* complicated variant *)
2.711 +val testrls_rls = Rule_Set.append_rules "testrls_rls" Rule_Set.empty [Rls_ cancel_p_rls, Rls_ add_fractions_p_rls];
2.712 +val SOME (t', asm) = rewrite_set_ thy false testrls_rls t;
2.713 +(*# rls: testrls_rls on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x)
2.714 +## rls: cancel_p_rls on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x)
2.715 +### rls: cancel_p on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x)
2.716 +### rls: cancel_p on: 123 = a * x / (b * x) + c * x / (d * x) + e / f
2.717 +### rls: cancel_p on: 123 = a * x / (b * x) + c / d + e / f
2.718 +### rls: cancel_p on: 123 = a / b + c / d + e / f
2.719 +## rls: add_fractions_p_rls on: 123 = a / b + c / d + e / f
2.720 +### rls: add_fractions_p on: 123 = a / b + c / d + e / f
2.721 +### rls: add_fractions_p on: 123 = (b * c + a * d) / (b * d) + e / f
2.722 +### rls: add_fractions_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)
2.723 +## rls: cancel_p_rls on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)
2.724 +### rls: cancel_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)
2.725 +## rls: add_fractions_p_rls on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)
2.726 +### rls: add_fractions_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) *)
2.727 +if UnparseC.term t' = "123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)"
2.728 +then () else error "level 4, rewrite_set_ *_p_rls: changed"
2.729 +
2.730 +"-------- gcd_poly integration level 5: cancel_p & add_fraction_p within norm_Rational";
2.731 +val SOME (t', asm) = rewrite_set_ thy false norm_Rational t;
2.732 +if UnparseC.term t' = "123 = (a * d * f + b * c * f + b * d * e) / (b * d * f)"
2.733 +then () else error "level 5, rewrite_set_ norm_Rational: changed"
2.734 +
2.735 +"-------- reverse rewrite ----------------------------------------------------";
2.736 +"-------- reverse rewrite ----------------------------------------------------";
2.737 +"-------- reverse rewrite ----------------------------------------------------";
2.738 +(** the term for which reverse rewriting is demonstrated **)
2.739 +val t = TermC.str2term "(9 + -1 * x \<up> 2) / (9 + 6 * x + x \<up> 2)";
2.740 +val Rrls {scr = Rfuns {init_state = ini, locate_rule = loc,
2.741 + next_rule = nex, normal_form = nor, ...},...} = cancel_p;
2.742 +
2.743 +(** normal_form produces the result in ONE step **)
2.744 + val SOME (t', _) = nor t;
2.745 +if UnparseC.term t' = "(3 + - 1 * x) / (3 + x)" then ()
2.746 +else error "rational.sml normal_form (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
2.747 +
2.748 +(** initialize the interpreter state used by the 'me' **)
2.749 + val (t, _, revsets, _) = ini t;
2.750 +
2.751 +if length (hd revsets) = 11 then () else error "length of revset changed";
2.752 +(*//----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)
2.753 +if (revsets |> nth 1 |> nth 1 |> id_of_thm) =
2.754 + (@{thm realpow_twoI} |> Thm.get_name_hint |> ThmC.cut_id)
2.755 +then () else error "first element of revset changed";
2.756 +if
2.757 +(revsets |> nth 1 |> nth 1 |> Rule.to_string) = "Thm (\"realpow_twoI\",?r1 \<up> 2 = ?r1 * ?r1)" andalso
2.758 +(revsets |> nth 1 |> nth 2 |> Rule.to_string) = "Thm (\"#: 9 = 3 \<up> 2\",9 = 3 \<up> 2)" andalso
2.759 +(revsets |> nth 1 |> nth 3 |> Rule.to_string) = "Thm (\"#: 6 * x = 2 * (3 * x)\",6 * x = 2 * (3 * x))"
2.760 +andalso
2.761 +(revsets |> nth 1 |> nth 4 |> Rule.to_string) = "Thm (\"#: -3 * x = -1 * (3 * x)\",-3 * x = -1 * (3 * x))"
2.762 +andalso
2.763 +(revsets |> nth 1 |> nth 5 |> Rule.to_string) = "Thm (\"#: 9 = 3 * 3\",9 = 3 * 3)" andalso
2.764 +(revsets |> nth 1 |> nth 6 |> Rule.to_string) = "Rls_ (\"sym_order_mult_rls_\")" andalso
2.765 +(revsets |> nth 1 |> nth 7 |> Rule.to_string) =
2.766 + "Thm (\"sym_mult.assoc\",?a * (?b * ?c) = ?a * ?b * ?c)"
2.767 +then () else error "first 7 elements in revset changed"
2.768 + \\----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)*)
2.769 +
2.770 +(** find the rule 'r' to apply to term 't' **)
2.771 +(*/------- WN1309: since cancel_ (accepted "-" between monomials) has been replaced by cancel_p_
2.772 + for Isabelle2013, we don't get a working revset, but non-termination:
2.773 +
2.774 + val SOME (r as (Thm (str, thm))) = nex revsets t;
2.775 + :
2.776 +((3 * 3 + -1 * x * x) / (3 * 3 + 2 * 3 * x + x * x),
2.777 + Rls_ ("sym_order_mult_rls_"), ((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * (3 * x) + x * x), []))", "
2.778 +((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * (3 * x) + x * x),
2.779 + Thm ("sym_mult.assoc", ""), ((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * 3 * x + x * x), []))", "
2.780 +((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * 3 * x + x * x),
2.781 + Thm ("sym_mult.assoc", ""), ((3 * 3 + -1 * x * x) / (3 * 3 + 2 * 3 * x + x * x), []))", "
2.782 +((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), []))", "
2.783 + :
2.784 +### Isabelle2002:
2.785 + Thm ("sym_#mult_2_3", "6 = 2 * 3")
2.786 +### Isabelle2009-2 for cancel_ (not cancel_p_):
2.787 +if str = "sym_#power_Float ((3,0), (0,0)) __ ((2,0), (0,0))"
2.788 + andalso ThmC.string_of_thm thm =
2.789 + (string_of_thm (Thm.make_thm @{theory "Isac_Knowledge"}
2.790 + (Trueprop $ (Thm.term_of o the o (TermC.parse thy)) "9 = 3 \<up> 2"))) then ()
2.791 +else error "rational.sml next_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
2.792 +\---------------------------------------------------------------------------------------/*)
2.793 +
2.794 +(** check, if the rule 'r' applied by the user to 't' belongs to the ruleset;
2.795 + if the rule is OK, the term resulting from applying the rule is returned,too;
2.796 + there might be several rule applications inbetween,
2.797 + which are listed after the head in reverse order **)
2.798 +(*/-------------------------------------------- Isabelle2013: this gives "error id_of_thm";
2.799 + we don't repair this, because interaction within "reverse rewriting" never worked properly:
2.800 +
2.801 + val (r, (t, asm))::_ = loc revsets t r;
2.802 +if UnparseC.term t = "(9 - x \<up> 2) / (3 \<up> 2 + 6 * x + x \<up> 2)" andalso asm = []
2.803 +then () else error "rational.sml locate_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
2.804 +
2.805 +(* find the next rule to apply *)
2.806 + val SOME (r as (Thm (str, thm))) = nex revsets t;
2.807 +if str = "sym_#power_Float ((3,0), (0,0)) __ ((2,0), (0,0))" andalso
2.808 + ThmC.string_of_thm thm = (string_of_thm (ThmC_Def.make_thm @{theory "Isac_Knowledge"}
2.809 + (Trueprop $ (Thm.term_of o the o (TermC.parse thy)) "9 = 3 \<up> 2"))) then ()
2.810 +else error "rational.sml next_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
2.811 +
2.812 +(*check the next rule*)
2.813 + val (r, (t, asm)) :: _ = loc revsets t r;
2.814 +if UnparseC.term t = "(3 \<up> 2 - x \<up> 2) / (3 \<up> 2 + 6 * x + x \<up> 2)" then ()
2.815 +else error "rational.sml locate_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2) II";
2.816 +
2.817 +(*find and check the next rules, rewrite*)
2.818 + val SOME r = nex revsets t;
2.819 + val (r,(t,asm))::_ = loc revsets t r;
2.820 +if UnparseC.term t = "(3 \<up> 2 - x \<up> 2) / (3 \<up> 2 + 2 * 3 * x + x \<up> 2)" then ()
2.821 +else error "rational.sml locate_rule II";
2.822 +
2.823 + val SOME r = nex revsets t;
2.824 + val (r,(t,asm))::_ = loc revsets t r;
2.825 +if UnparseC.term t = "(3 - x) * (3 + x) / (3 \<up> 2 + 2 * 3 * x + x \<up> 2)" then ()
2.826 +else error "rational.sml next_rule II";
2.827 +
2.828 + val SOME r = nex revsets t;
2.829 + val (r,(t,asm))::_ = loc revsets t r;
2.830 +if UnparseC.term t = "(3 - x) * (3 + x) / ((3 + x) * (3 + x))" then ()
2.831 +else error "rational.sml next_rule III";
2.832 +
2.833 + val SOME r = nex revsets t;
2.834 + val (r, (t, asm)) :: _ = loc revsets t r;
2.835 + val ss = UnparseC.term t;
2.836 +if ss = "(3 - x) / (3 + x)" andalso UnparseC.terms asm = "[\"3 + x ~= 0\"]" then ()
2.837 +else error "rational.sml: new behav. in rev-set cancel";
2.838 +\--------------------------------------------------------------------------------------/*)
2.839 +
2.840 +"-------- 'reverse-ruleset' cancel_p -----------------------------------------";
2.841 +"-------- 'reverse-ruleset' cancel_p -----------------------------------------";
2.842 +"-------- 'reverse-ruleset' cancel_p -----------------------------------------";
2.843 +(*WN130909: the example below shows, why "reverse rewriting" only worked for
2.844 + special cases.*)
2.845 +
2.846 +(*the term for which reverse rewriting is demonstrated*)
2.847 +val t = TermC.str2term "(9 + (-1)*x \<up> 2) / (9 + ((-6)*x + x \<up> 2))";
2.848 +val Rrls {scr=Rfuns {init_state=ini,locate_rule=loc,
2.849 + next_rule=nex,normal_form=nor,...},...} = cancel_p;
2.850 +
2.851 +(*normal_form produces the result in ONE step*)
2.852 +val SOME (t', _) = nor t;
2.853 +if UnparseC.term t' = "(3 + x) / (3 + - 1 * x)"
2.854 +then () else error "cancel_p normal_form CHANGED";;
2.855 +
2.856 +(*initialize the interpreter state used by the 'me'*)
2.857 +val SOME (t', asm) = cancel_p_ thy t;
2.858 +if (UnparseC.term t', UnparseC.terms asm) = ("(3 + x) / (3 + - 1 * x)", "[\"3 + - 1 * x \<noteq> 0\"]")
2.859 +then () else error "cancel_p CHANGED";;
2.860 +
2.861 +val (t,_,revsets,_) = ini t;
2.862 +
2.863 +(* WN.10.10.02: dieser Fall terminiert nicht
2.864 + (make_polynomial enth"alt zu viele rules)
2.865 +WN060823 'init_state' requires rewriting on specified location in the term
2.866 +default_print_depth 99; Rfuns; default_print_depth 3;
2.867 +WN060831 cycling "sym_order_mult_rls_" "sym_mult.assoc"
2.868 + as was with make_polynomial before ?!?* )
2.869 +
2.870 +val SOME r = nex revsets t;
2.871 +eq_Thm (r, Thm ("sym_#power_Float ((3,0), (0,0)) __ ((2,0), (0,0))",
2.872 + mk_thm thy "9 = 3 \<up> 2"));
2.873 +( *WN060831 *** id_of_thm
2.874 + Exception- ERROR raised ...
2.875 +val (r,(t,asm))::_ = loc revsets t r;
2.876 +UnparseC.term t;
2.877 +
2.878 + val SOME r = nex revsets t;
2.879 + val (r,(t,asm))::_ = loc revsets t r;
2.880 + UnparseC.term t;
2.881 +*)
2.882 +
2.883 +"-------- examples: rls norm_Rational ----------------------------------------";
2.884 +"-------- examples: rls norm_Rational ----------------------------------------";
2.885 +"-------- examples: rls norm_Rational ----------------------------------------";
2.886 +(*Rewrite.trace_on:=true;*)
2.887 +val t = TermC.str2term "Not (6*x is_atom)";
2.888 +val SOME (t',_) = rewrite_set_ thy false powers_erls t; UnparseC.term t';
2.889 +"HOL.True";
2.890 +val t = TermC.str2term "1 < 2";
2.891 +val SOME (t',_) = rewrite_set_ thy false powers_erls t; UnparseC.term t';
2.892 +"HOL.True";
2.893 +
2.894 +val t = TermC.str2term "(6*x) \<up> 2";
2.895 +val SOME (t',_) = rewrite_ thy dummy_ord powers_erls false
2.896 + (ThmC.numerals_to_Free @{thm realpow_def_atom}) t;
2.897 +if UnparseC.term t' = "6 * x * (6 * x) \<up> (2 + - 1)" then ()
2.898 +else error "rational.sml powers_erls (6*x) \<up> 2";
2.899 +
2.900 +val t = TermC.str2term "-1 * (-2 * (5 / 2 * (13 * x / 2)))";
2.901 +val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
2.902 +if UnparseC.term t' = "65 * x / 2" then () else error "rational.sml 4";
2.903 +
2.904 +val t = TermC.str2term "1 - ((13*x)/2 - 5/2) \<up> 2";
2.905 +val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
2.906 +if UnparseC.term t' = "(- 21 + 130 * x + - 169 * x \<up> 2) / 4" then ()
2.907 +else error "rational.sml 5";
2.908 +
2.909 +(*SRAM Schalk I, p.92 Nr. 609a*)
2.910 +val t = TermC.str2term "2*(3 - x/5)/3 - 4*(1 - x/3) - x/3 - 2*(x/2 - 1/4)/27 +5/54";
2.911 +val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
2.912 +if UnparseC.term t' = "(- 255 + 112 * x) / 135" then ()
2.913 +else error "rational.sml 6";
2.914 +
2.915 +(*SRAM Schalk I, p.92 Nr. 610c*)
2.916 +val t = TermC.str2term "((x- 1)/(x+1) + 1) / ((x- 1)/(x+1) - (x+1)/(x- 1)) - 2";
2.917 +val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
2.918 +if UnparseC.term t' = "(3 + x) / - 2" then () else error "rational.sml 7";
2.919 +
2.920 +(*SRAM Schalk I, p.92 Nr. 476a*)
2.921 +val t = TermC.str2term "(x \<up> 2/(1 - x \<up> 2) + 1)/(x/(1 - x) + 1) * (1 + x)";
2.922 +(*. a/b : c/d translated to a/b * d/c .*)
2.923 +val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
2.924 +if UnparseC.term t' = "1" then () else error "rational.sml 8";
2.925 +
2.926 +(*Schalk I, p.92 Nr. 472a*)
2.927 +val t = TermC.str2term "((8*x \<up> 2 - 32*y \<up> 2)/(2*x + 4*y))/((4*x - 8*y)/(x + y))";
2.928 +val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
2.929 +if UnparseC.term t' = "x + y" then () else error "rational.sml p.92 Nr. 472a";
2.930 +
2.931 +(*Schalk I, p.70 Nr. 480b: SEE rational.sml --- nonterminating rls norm_Rational ---*)
2.932 +
2.933 +(*WN130910 add_fractions_p exception Div raised + history:
2.934 +### WN.2.6.03 from rlang.sml 56a
2.935 +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)";
2.936 +val NONE = rewrite_set_ thy false add_fractions_p t;
2.937 +
2.938 +THE ERROR ALREADY OCCURS IN THIS PART:
2.939 +val t = TermC.str2term "(a + b * x) / (a + -1 * (b * x)) + (-1 * a + b * x) / (a + b * x)";
2.940 +val NONE = add_fraction_p_ thy t;
2.941 +
2.942 +SEE Test_Some.thy: section {* add_fractions_p downto exception Div raised ===
2.943 +*)
2.944 +
2.945 +"-------- rational numerals --------------------------------------------------";
2.946 +"-------- rational numerals --------------------------------------------------";
2.947 +"-------- rational numerals --------------------------------------------------";
2.948 +(*SRA Schalk I, p.40 Nr. 164b *)
2.949 +val t = TermC.str2term "(47/6 - 76/9 + 13/4)/(35/12)";
2.950 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.951 +if UnparseC.term t = "19 / 21" then ()
2.952 +else error "rational.sml: diff.behav. in norm_Rational_mg 1";
2.953 +
2.954 +(*SRA Schalk I, p.40 Nr. 166a *)
2.955 +val t = TermC.str2term "((5/4)/(4+22/7) + 37/20)*(110/3 - 110/9 * 23/11)";
2.956 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.957 +if UnparseC.term t = "45 / 2" then ()
2.958 +else error "rational.sml: diff.behav. in norm_Rational_mg 2";
2.959 +
2.960 +"-------- examples cancellation from: Mathematik 1 Schalk --------------------";
2.961 +"-------- examples cancellation from: Mathematik 1 Schalk --------------------";
2.962 +"-------- examples cancellation from: Mathematik 1 Schalk --------------------";
2.963 +(* e190c Stefan K.*)
2.964 +val t = TermC.str2term "((1 + 9*a \<up> 2) * (1 + 3*a)) / ((3*a + 9*a \<up> 2) * (1 + 3*a))";
2.965 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.966 +if UnparseC.term t = "(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)"
2.967 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 3";
2.968 +
2.969 +(* e192b Stefan K.*)
2.970 +val t = TermC.str2term "(x \<up> 2 * (7*x + (-1)*y)) / (y \<up> 2 * (7*x + (-1)*y))";
2.971 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.972 +if UnparseC.term t = "x \<up> 2 / y \<up> 2"
2.973 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 4";
2.974 +
2.975 +(*SRC Schalk I, p.66 Nr. 379c *)
2.976 +val t = TermC.str2term "(a - b)/(b - a)";
2.977 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.978 +if UnparseC.term t = "- 1"
2.979 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 5";
2.980 +
2.981 +(*SRC Schalk I, p.66 Nr. 380b *)
2.982 +val t = TermC.str2term "15*(3*x + 3) * (4*x + 9) / (12*(2*x + 7) * (5*x + 5))";
2.983 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.984 +if UnparseC.term t = "(27 + 12 * x) / (28 + 8 * x)"
2.985 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 6";
2.986 +
2.987 +(* e190c Stefan K.*)
2.988 +val t = TermC.str2term "((1 + 9*a \<up> 2) * (1 + 3*a)) / ((3*a + 9*a \<up> 2) * (1 + 3 * a))";
2.989 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.990 +if UnparseC.term t = "(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)"
2.991 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 3";
2.992 +
2.993 +(* e192b Stefan K.*)
2.994 +val t = TermC.str2term "(x \<up> 2 * (7*x + (-1)*y)) / (y \<up> 2 * (7*x + (-1)*y))";
2.995 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.996 +if UnparseC.term t = "x \<up> 2 / y \<up> 2"
2.997 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 4";
2.998 +
2.999 +(*SRC Schalk I, p.66 Nr. 379c *)
2.1000 +val t = TermC.str2term "(a - b) / (b - a)";
2.1001 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1002 +if UnparseC.term t = "- 1"
2.1003 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 5";
2.1004 +
2.1005 +(*SRC Schalk I, p.66 Nr. 380b *)
2.1006 +val t = TermC.str2term "15*(3*x + 3) * (4*x + 9) / (12*(2*x + 7) * (5*x + 5))";
2.1007 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1008 +if UnparseC.term t = "(27 + 12 * x) / (28 + 8 * x)"
2.1009 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 6";
2.1010 +
2.1011 +(* extreme example from somewhere *)
2.1012 +val t = TermC.str2term
2.1013 + ("(a \<up> 4 * x + -1*a \<up> 4 * y + 4*a \<up> 3 * b * x + -4*a \<up> 3 * b * y + " ^
2.1014 + "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 + " ^
2.1015 + "b \<up> 4 * x + -1*b \<up> 4 * y) " ^
2.1016 + " / (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 + " ^
2.1017 + "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 + " ^
2.1018 + "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)")
2.1019 +val SOME (t, _) = rewrite_set_ thy false cancel_p t;
2.1020 +if UnparseC.term t = "(a \<up> 2 + 2 * a * b + b \<up> 2) / (x \<up> 2 + - 2 * x * y + y \<up> 2)"
2.1021 +then () else error "with Isabelle2002: NONE -- now SOME changed";
2.1022 +
2.1023 +(*Schalk I, p.66 Nr. 381a *)
2.1024 +(* ATTENTION: here the rls is very slow. In Isabelle2002 this required 2 min *)
2.1025 +val t = TermC.str2term "18*(a + b) \<up> 3 * (a - b) \<up> 2 / (72*(a - b) \<up> 3 * (a + b) \<up> 2)";
2.1026 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1027 +if UnparseC.term t = "(a + b) / (4 * a + - 4 * b)"
2.1028 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 8";
2.1029 +
2.1030 +(*SRC Schalk I, p.66 Nr. 381b *)
2.1031 +val t = TermC.str2term "(4*x \<up> 2 - 20*x + 25) / (2*x - 5) \<up> 3";
2.1032 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1033 +if UnparseC.term t = "1 / (- 5 + 2 * x)"
2.1034 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 9";
2.1035 +
2.1036 +(*SRC Schalk I, p.66 Nr. 381c *)
2.1037 +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)";
2.1038 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1039 +if UnparseC.term t = "(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)"
2.1040 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 10";
2.1041 +
2.1042 +(*SRC Schalk I, p.66 Nr. 383a *)
2.1043 +val t = TermC.str2term "(5*a \<up> 2 - 5*a*b) / (a - b) \<up> 2";
2.1044 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1045 +if UnparseC.term t = "- 5 * a / (- 1 * a + b)"
2.1046 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 11";
2.1047 +
2.1048 +"----- NOT TERMINATING ?: worked before 0707xx";
2.1049 +val t = TermC.str2term "(a \<up> 2 - 1)*(b + 1) / ((b \<up> 2 - 1)*(a+1))";
2.1050 +(* WN130911 "exception Div raised" by
2.1051 + cancel_p_ thy (TermC.str2term ("(-1 + -1 * b + a \<up> 2 + a \<up> 2 * b) /" ^
2.1052 + "(-1 + -1 * a + b \<up> 2 + a * b \<up> 2)"))
2.1053 +
2.1054 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1055 +if UnparseC.term t = "(1 + -1 * a) / (1 + -1 * b)" then ()
2.1056 +else error "rational.sml MG tests 3e";
2.1057 +*)
2.1058 +
2.1059 +"-------- examples common denominator from: Mathematik 1 Schalk --------------";
2.1060 +"-------- examples common denominator from: Mathematik 1 Schalk --------------";
2.1061 +"-------- examples common denominator from: Mathematik 1 Schalk --------------";
2.1062 +(*SRA Schalk I, p.67 Nr. 403a *)
2.1063 +val t = TermC.str2term "4/x - 3/y - 1";
2.1064 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1065 +if UnparseC.term t = "(- 3 * x + 4 * y + - 1 * x * y) / (x * y)"
2.1066 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 12";
2.1067 +
2.1068 +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)";
2.1069 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1070 +if UnparseC.term t = "4 / c"
2.1071 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 13";
2.1072 +
2.1073 +(*SRA Schalk I, p.67 Nr. 410b *)
2.1074 +val t = TermC.str2term "1/(x+1) + 1/(x+2) - 2/(x+3)";
2.1075 +(* WN130911 non-termination due to non-termination of
2.1076 + cancel_p_ thy (TermC.str2term "(5 + 3 * x) / (6 + 11 * x + 6 * x \<up> 2 + x \<up> 3)")
2.1077 +
2.1078 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1079 +if UnparseC.term t = "(5 + 3 * x) / (6 + 11 * x + 6 * x \<up> 2 + x \<up> 3)"
2.1080 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 14";
2.1081 +*)
2.1082 +
2.1083 +(*SRA Schalk I, p.67 Nr. 413b *)
2.1084 +val t = TermC.str2term "(1 + x)/(1 - x) - (1 - x)/(1 + x) + 2*x/(1 - x \<up> 2)";
2.1085 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1086 +if UnparseC.term t = "6 * x / (1 + - 1 * x \<up> 2)"
2.1087 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 15";
2.1088 +
2.1089 +(*SRA Schalk I, p.68 Nr. 414a *)
2.1090 +val t = TermC.str2term "(x + 2)/(x - 1) + (x - 3)/(x - 2) - (x + 1)/((x - 1)*(x - 2))";
2.1091 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1092 +if UnparseC.term t ="(- 2 + - 5 * x + 2 * x \<up> 2) / (2 + - 3 * x + x \<up> 2)"
2.1093 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 16";
2.1094 +
2.1095 +(*SRA Schalk I, p.68 Nr. 428b *)
2.1096 +val t = TermC.str2term
2.1097 + "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";
2.1098 +(* WN130911 non-termination due to non-termination of
2.1099 + cancel_p_ thy (TermC.str2term "(4 + -4 * b \<up> 2) / (a \<up> 4 + -2 * (a \<up> 2 * b \<up> 2) + b \<up> 4)")
2.1100 +
2.1101 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1102 +if UnparseC.term t = "4 / (a \<up> 4 + -2 * a \<up> 2 * b \<up> 2 + b \<up> 4)"
2.1103 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 18";
2.1104 +*)
2.1105 +
2.1106 +(*SRA Schalk I, p.68 Nr. 430b *)
2.1107 +val t = TermC.str2term
2.1108 + "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";
2.1109 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1110 +if UnparseC.term t = "a + 3 * b"
2.1111 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 19";
2.1112 +
2.1113 +(*SRA Schalk I, p.68 Nr. 432 *)
2.1114 +val t = TermC.str2term
2.1115 + ("(a \<up> 2 + a*b) / (a \<up> 2 - b \<up> 2) - (b \<up> 2 - a*b) / (b \<up> 2 - a \<up> 2) + " ^
2.1116 + "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) - " ^
2.1117 + "2*b \<up> 2 / (a \<up> 2 - b \<up> 2)");
2.1118 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1119 +if UnparseC.term t = (*"0" ..isabisac15 | Isabelle2017..*) "0 / (a \<up> 2 + - 1 * b \<up> 2)"
2.1120 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 20";
2.1121 +
2.1122 +(* some example *)
2.1123 +val t = TermC.str2term "3*a / (a*b) + x/y";
2.1124 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1125 +if UnparseC.term t = "(3 * y + b * x) / (b * y)"
2.1126 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 21";
2.1127 +
2.1128 +
2.1129 +"-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
2.1130 +"-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
2.1131 +"-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
2.1132 +(*------- SRM Schalk I, p.68 Nr. 436a *)
2.1133 +val t = TermC.str2term "3*(x+y) / (15*(x - y)) * 25*(x - y) \<up> 2 / (18*(x + y) \<up> 2)";
2.1134 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1135 +if UnparseC.term t = "(- 5 * x + 5 * y) / (- 18 * x + - 18 * y)"
2.1136 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 22";
2.1137 +
2.1138 +(*------- SRM.test Schalk I, p.68 Nr. 436b *)
2.1139 +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";
2.1140 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1141 +if UnparseC.term t = "5 * a / (a + - 1 * b)"
2.1142 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 23";
2.1143 +
2.1144 +(*------- Schalk I, p.68 Nr. 437a *)
2.1145 +val t = TermC.str2term "(3*a - 4*b) / (4*c+3*e) * (3*a+4*b)/(9*a \<up> 2 - 16*b \<up> 2)";
2.1146 +(* raises an exception for unclear reasons:
2.1147 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1148 +:
2.1149 +### rls: cancel_p on: (9 * a \<up> 2 + -16 * b \<up> 2) / (4 * c + 3 * e) /
2.1150 +(9 * a \<up> 2 + -16 * b \<up> 2)
2.1151 +exception Div raised
2.1152 +
2.1153 +BUT
2.1154 +val t = TermC.str2term
2.1155 + ("(9 * a \<up> 2 + -16 * b \<up> 2) / (4 * c + 3 * e) /" ^
2.1156 + "(9 * a \<up> 2 + -16 * b \<up> 2)");
2.1157 +NONE = cancel_p_ thy t;
2.1158 +
2.1159 +if UnparseC.term t = "1 / (4 * c + 3 * e)" then ()
2.1160 +else error "rational.sml: diff.behav. in norm_Rational_mg 24";
2.1161 +*)
2.1162 +
2.1163 +"----- S.K. corrected non-termination 060904";
2.1164 +val t = TermC.str2term "(3*a - 4*b) * (3*a+4*b)/((4*c+3*e)*(9*a \<up> 2 - 16*b \<up> 2))";
2.1165 +val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
2.1166 +if UnparseC.term t =
2.1167 + "(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)"
2.1168 +then () else error "rational.sml: S.K.8..corrected 060904-6";
2.1169 +
2.1170 +"----- S.K. corrected non-termination of cancel_p_";
2.1171 +val t'' = TermC.str2term ("(9 * a \<up> 2 + -16 * b \<up> 2) /" ^
2.1172 + "(36 * a \<up> 2 * c + (27 * a \<up> 2 * e + (-64 * b \<up> 2 * c + -48 * b \<up> 2 * e)))");
2.1173 +(* /--- DOES NOT TERMINATE AT TRANSITION isabisac15 --> Isabelle2017 --------------------------\
2.1174 +val SOME (t',_) = rewrite_set_ thy false cancel_p t'';
2.1175 +if UnparseC.term t' = "1 / (4 * c + 3 * e)"
2.1176 +then () else error "rational.sml: diff.behav. in cancel_p S.K.8";
2.1177 + \--- DOES NOT TERMINATE AT TRANSITION isabisac15 --> Isabelle2017 --------------------------/*)
2.1178 +
2.1179 +(*------- Schalk I, p.68 Nr. 437b*)
2.1180 +val t = TermC.str2term "(a + b)/(x \<up> 2 - y \<up> 2) * ((x - y) \<up> 2/(a \<up> 2 - b \<up> 2))";
2.1181 +(*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1182 +:
2.1183 +#### rls: cancel_p on: (a * x \<up> 2 + -2 * (a * (x * y)) + a * y \<up> 2 + b * x \<up> 2 +
2.1184 + -2 * (b * (x * y)) +
2.1185 + b * y \<up> 2) /
2.1186 +(a \<up> 2 * x \<up> 2 + -1 * (a \<up> 2 * y \<up> 2) + -1 * (b \<up> 2 * x \<up> 2) +
2.1187 + b \<up> 2 * y \<up> 2)
2.1188 +exception Div raised
2.1189 +*)
2.1190 +
2.1191 +(*------- SRM Schalk I, p.68 Nr. 438a *)
2.1192 +val t = TermC.str2term "x*y / (x*y - y \<up> 2) * (x \<up> 2 - x*y)";
2.1193 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1194 +if UnparseC.term t = "x \<up> 2"
2.1195 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 24";
2.1196 +
2.1197 +(*------- SRM Schalk I, p.68 Nr. 439b *)
2.1198 +val t = TermC.str2term "(4*x \<up> 2 + 4*x + 1) * ((x \<up> 2 - 2*x \<up> 3) / (4*x \<up> 2 + 2*x))";
2.1199 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1200 +if UnparseC.term t = "(x + - 4 * x \<up> 3) / 2"
2.1201 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 25";
2.1202 +
2.1203 +(*------- SRM Schalk I, p.68 Nr. 440a *)
2.1204 +val t = TermC.str2term "(x \<up> 2 - 2*x) / (x \<up> 2 - 3*x) * (x - 3) \<up> 2 / (x \<up> 2 - 4)";
2.1205 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1206 +if UnparseC.term t = "(- 3 + x) / (2 + x)"
2.1207 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 26";
2.1208 +
2.1209 +"----- Schalk I, p.68 Nr. 440b SK11 works since 0707xx";
2.1210 +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)";
2.1211 +(* WN130911 non-termination for unclear reasons:
2.1212 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1213 +
2.1214 +... ENDS WITH THIS TRACE:
2.1215 +:
2.1216 +### rls: cancel_p on: (-9 * (a \<up> 3 * b) + -9 * (a \<up> 2 * b \<up> 2) + a \<up> 5 * b +
2.1217 + a \<up> 4 * b \<up> 2) /
2.1218 +(a \<up> 3 * b + -1 * (a * b \<up> 3)) /
2.1219 +(3 + a)
2.1220 +BUT THIS IS CORRECTLY RECOGNISED
2.1221 +val t = TermC.str2term
2.1222 + ("(-9 * (a \<up> 3 * b) + -9 * (a \<up> 2 * b \<up> 2) + a \<up> 5 * b + a \<up> 4 * b \<up> 2) /" ^
2.1223 + "(a \<up> 3 * b + -1 * (a * b \<up> 3)) / (3 + (a::real))");
2.1224 +AS
2.1225 +NONE = cancel_p_ thy t;
2.1226 +
2.1227 +if UnparseC.term t = "(-3 * a + a \<up> 2) / (a + -1 * b)" then ()
2.1228 +else error "rational.sml: diff.behav. in norm_Rational 27";
2.1229 +*)
2.1230 +
2.1231 +"----- SK12 works since 0707xx";
2.1232 +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))";
2.1233 +(* WN130911 non-termination due to non-termination of
2.1234 + cancel_p_ thy (TermC.str2term "(4 + -4 * b \<up> 2) / (a \<up> 4 + -2 * (a \<up> 2 * b \<up> 2) + b \<up> 4)")
2.1235 +
2.1236 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1237 +if UnparseC.term t' = "(-3 * a + a \<up> 2) / (a + -1 * b)" then ()
2.1238 +else error "rational.sml: diff.behav. in norm_Rational 28";
2.1239 +*)
2.1240 +
2.1241 +"-------- examples common denominator and multiplication from: Schalk --------";
2.1242 +"-------- examples common denominator and multiplication from: Schalk --------";
2.1243 +"-------- examples common denominator and multiplication from: Schalk --------";
2.1244 +(*------- SRAM Schalk I, p.69 Nr. 441b *)
2.1245 +val t = TermC.str2term "(4*a/3 + 3*b \<up> 2/a \<up> 3 + b/(4*a))*(4*b/(3*a))";
2.1246 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1247 +if UnparseC.term t = "(36 * b \<up> 3 + 3 * a \<up> 2 * b \<up> 2 + 16 * a \<up> 4 * b) /\n(9 * a \<up> 4)"
2.1248 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 28";
2.1249 +
2.1250 +(*------- SRAM Schalk I, p.69 Nr. 442b *)
2.1251 +val t = TermC.str2term ("(15*a \<up> 2/x \<up> 3 - 5*b \<up> 4/x \<up> 2 + 25*c \<up> 2/x) * " ^
2.1252 + "(x \<up> 3/(5*a*b \<up> 3*c \<up> 3)) + 1/c \<up> 3 * (b*x/a - 3*a/b \<up> 3)");
2.1253 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1254 +if UnparseC.term t = "5 * x \<up> 2 / (a * b \<up> 3 * c)"
2.1255 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 29";
2.1256 +
2.1257 +(*------- SRAM Schalk I, p.69 Nr. 443b *)
2.1258 +val t = TermC.str2term "(a/2 + b/3) * (b/3 - a/2)";
2.1259 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1260 +if UnparseC.term t = "(- 9 * a \<up> 2 + 4 * b \<up> 2) / 36"
2.1261 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 30";
2.1262 +
2.1263 +(*------- SRAM Schalk I, p.69 Nr. 445b *)
2.1264 +val t = TermC.str2term "(a \<up> 2/9 + 2*a/(3*b) + 4/b \<up> 2)*(a/3 - 2/b) + 8/b \<up> 3";
2.1265 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1266 +if UnparseC.term t = "a \<up> 3 / 27"
2.1267 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 31";
2.1268 +
2.1269 +(*------- SRAM Schalk I, p.69 Nr. 446b *)
2.1270 +val t = TermC.str2term "(x/(5*x + 4*y) - y/(5*x - 4*y) + 1)*(25*x \<up> 2 - 16*y \<up> 2)";
2.1271 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1272 +if UnparseC.term t = (*"30 * x \<up> 2 + -9 * x * y + -20 * y \<up> 2" ..isabisac15 | Isabelle2017..*)
2.1273 + "(- 30 * x \<up> 2 + 9 * x * y + 20 * y \<up> 2) / - 1"
2.1274 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 32";
2.1275 +
2.1276 +(*------- SRAM Schalk I, p.69 Nr. 449a *)(*Achtung: rechnet ca 8 Sekunden*)
2.1277 +val t = TermC.str2term
2.1278 +"(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)";
2.1279 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1280 +if UnparseC.term t = "(- 81 * x \<up> 4 + 16 * x \<up> 8 * y \<up> 4) / (81 * y \<up> 8)"
2.1281 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 33";
2.1282 +
2.1283 +(*------- SRAM Schalk I, p.69 Nr. 450a *)
2.1284 +val t = TermC.str2term
2.1285 +"(4*x/(3*y)+2*y/(3*x)) \<up> 2 - (2*y/(3*x) - 2*x/y)*(2*y/(3*x)+2*x/y)";
2.1286 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1287 +if UnparseC.term t = "(52 * x \<up> 2 + 16 * y \<up> 2) / (9 * y \<up> 2)"
2.1288 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 34";
2.1289 +
2.1290 +(*------- SRAM Schalk I, p.69 Nr. 442b --- abgewandelt*)
2.1291 +val t = TermC.str2term
2.1292 + ("(15*a \<up> 4/(a*x \<up> 3) - 5*a*((b \<up> 4 - 5*c \<up> 2*x) / x \<up> 2)) * " ^
2.1293 + "(x \<up> 3/(5*a*b \<up> 3*c \<up> 3)) + a/c \<up> 3 * (x*(b/a) - 3*b*(a/b \<up> 4))");
2.1294 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1295 +if UnparseC.term t = "5 * x \<up> 2 / (b \<up> 3 * c)"
2.1296 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 53";
2.1297 +
2.1298 +
2.1299 +"-------- examples double fractions from: Mathematik 1 Schalk ----------------";
2.1300 +"-------- examples double fractions from: Mathematik 1 Schalk ----------------";
2.1301 +"-------- examples double fractions from: Mathematik 1 Schalk ----------------";
2.1302 +"----- SRD Schalk I, p.69 Nr. 454b";
2.1303 +val t = TermC.str2term "((2 - x)/(2*a)) / (2*a/(x - 2))";
2.1304 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1305 +if UnparseC.term t = "(- 4 + 4 * x + - 1 * x \<up> 2) / (4 * a \<up> 2)"
2.1306 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 35";
2.1307 +
2.1308 +"----- SRD Schalk I, p.69 Nr. 455a";
2.1309 +val t = TermC.str2term "(a \<up> 2 + 1)/(a \<up> 2 - 1) / ((a+1)/(a - 1))";
2.1310 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1311 +if UnparseC.term t = "(1 + a \<up> 2) / (1 + 2 * a + a \<up> 2)" then ()
2.1312 +else error "rational.sml: diff.behav. in norm_Rational_mg 36";
2.1313 +
2.1314 +"----- Schalk I, p.69 Nr. 455b";
2.1315 +val t = TermC.str2term "(x \<up> 2 - 4)/(y \<up> 2 - 9)/((2+x)/(3 - y))";
2.1316 +(* WN130911 non-termination due to non-termination of
2.1317 + cancel_p_ thy (TermC.str2term ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
2.1318 + "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)"))
2.1319 +
2.1320 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1321 +if UnparseC.term t = "(2 + -1 * x) / (3 + y)" then ()
2.1322 +else error "rational.sml: diff.behav. in norm_Rational_mg 37";
2.1323 +*)
2.1324 +
2.1325 +"----- SK060904-1a non-termination of cancel_p_ ?: worked before 0707xx";
2.1326 +val t = TermC.str2term "(x \<up> 2 - 4)*(3 - y) / ((y \<up> 2 - 9)*(2+x))";
2.1327 +(* WN130911 non-termination due to non-termination of
2.1328 + cancel_p_ thy (TermC.str2term ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
2.1329 + "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)"))
2.1330 +
2.1331 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1332 +if UnparseC.term t = "(2 + -1 * x) / (3 + y)" then ()
2.1333 +else error "rational.sml: diff.behav. in norm_Rational_mg 37b";
2.1334 +*)
2.1335 +
2.1336 +"----- ?: worked before 0707xx";
2.1337 +val t = TermC.str2term "(3 + -1 * y) / (-9 + y \<up> 2)";
2.1338 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1339 +if UnparseC.term t = "- 1 / (3 + y)"
2.1340 +then () else error "rational.sml: -1 / (3 + y) norm_Rational";
2.1341 +
2.1342 +"----- SRD Schalk I, p.69 Nr. 456b";
2.1343 +val t = TermC.str2term "(b \<up> 3 - b \<up> 2) / (b \<up> 2+b) / (b \<up> 2 - 1)";
2.1344 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1345 +if UnparseC.term t = "b / (1 + 2 * b + b \<up> 2)"
2.1346 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 38";
2.1347 +
2.1348 +"----- SRD Schalk I, p.69 Nr. 457b";
2.1349 +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))";
2.1350 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1351 +if UnparseC.term t = "8 * a \<up> 2 + - 6 * a * b + - 12 * a \<up> 2 * b + 9 * a * b \<up> 2"
2.1352 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 39";
2.1353 +
2.1354 +"----- Schalk I, p.69 Nr. 458b works since 0707";
2.1355 +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)))";
2.1356 +(*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1357 +:
2.1358 +### rls: cancel_p on: (-1 * a \<up> 2 + 2 * (a \<up> 2 * x)) / (a * x + -1 * (b * x)) /
2.1359 +((-1 * b \<up> 2 + 2 * (b \<up> 2 * x)) / (a * x + -1 * (b * x)))
2.1360 +exception Div raised
2.1361 +
2.1362 +BUT
2.1363 +val t = TermC.str2term
2.1364 + ("(-1 * a \<up> 2 + 2 * (a \<up> 2 * x)) / (a * x + -1 * (b * x)) /" ^
2.1365 + "((-1 * b \<up> 2 + 2 * (b \<up> 2 * x)) / (a * x + -1 * (b * x)))");
2.1366 +NONE = cancel_p_ thy t;
2.1367 +
2.1368 +if UnparseC.term t = "a \<up> 2 / b \<up> 2" then ()
2.1369 +else error "rational.sml: diff.behav. in norm_Rational_mg 39b";
2.1370 +*)
2.1371 +
2.1372 +"----- SRD Schalk I, p.69 Nr. 459b";
2.1373 +val t = TermC.str2term "(a \<up> 2 - b \<up> 2)/(a*b) / (4*(a+b) \<up> 2/a)";
2.1374 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1375 +if UnparseC.term t = "(a + - 1 * b) / (4 * a * b + 4 * b \<up> 2)" then ()
2.1376 +else error "rational.sml: diff.behav. in norm_Rational_mg 41";
2.1377 +
2.1378 +"----- Schalk I, p.69 Nr. 460b nonterm.SK";
2.1379 +val t = TermC.str2term "(9*(x \<up> 2 - 8*x + 16) / (4*(y \<up> 2 - 2*y + 1))) / ((3*x - 12) / (16*y - 16))";
2.1380 +(*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1381 +exception Div raised
2.1382 +
2.1383 +BUT
2.1384 +val t = TermC.str2term
2.1385 + ("(144 + -72 * x + 9 * x \<up> 2) / (4 + -8 * y + 4 * y \<up> 2) /" ^
2.1386 + "((-12 + 3 * x) / (-16 + 16 * y))");
2.1387 +NONE = cancel_p_ thy t;
2.1388 +
2.1389 +if UnparseC.term t = !!!!!!!!!!!!!!!!!!!!!!!!!
2.1390 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 42";
2.1391 +*)
2.1392 +
2.1393 +"----- some variant of the above; was non-terminating before";
2.1394 +val t = TermC.str2term "9*(x \<up> 2 - 8*x+16)*(16*y - 16)/(4*(y \<up> 2 - 2*y+1)*(3*x - 12))";
2.1395 +val SOME (t , _) = rewrite_set_ thy false norm_Rational t;
2.1396 +if UnparseC.term t = "(48 + - 12 * x) / (1 + - 1 * y)"
2.1397 +then () else error "some variant of the above; was non-terminating before";
2.1398 +
2.1399 +"----- SRD Schalk I, p.70 Nr. 472a";
2.1400 +val t = TermC.str2term ("((8*x \<up> 2 - 32*y \<up> 2) / (2*x + 4*y)) / ((4*x - 8*y) / (x + y))");
2.1401 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1402 +if UnparseC.term t = "x + y"
2.1403 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 43";
2.1404 +
2.1405 +"----- Schalk I, p.70 Nr. 478b ----- Rechenzeit: 5 sec";
2.1406 +val t = TermC.str2term ("(a - (a*b + b \<up> 2)/(a+b))/(b+(a - b)/(1+(a+b)/(a - b))) / " ^
2.1407 + "((a - a \<up> 2/(a+b))/(a+(a*b)/(a - b)))");
2.1408 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1409 +if UnparseC.term t = "(2 * a \<up> 3 + 2 * a \<up> 2 * b) / (a \<up> 2 * b + b \<up> 3)"
2.1410 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 51";
2.1411 +
2.1412 +(*SRD Schalk I, p.69 Nr. 461a *)
2.1413 +val t = TermC.str2term "(2/(x+3) + 2/(x - 3)) / (8*x/(x \<up> 2 - 9))";
2.1414 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1415 +if UnparseC.term t = "1 / 2"
2.1416 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 44";
2.1417 +
2.1418 +(*SRD Schalk I, p.69 Nr. 464b *)
2.1419 +val t = TermC.str2term "(a - a/(a - 2)) / (a + a/(a - 2))";
2.1420 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1421 +if UnparseC.term t = "(- 3 + a) / (- 1 + a)"
2.1422 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 45";
2.1423 +
2.1424 +(*SRD Schalk I, p.69 Nr. 465b *)
2.1425 +val t = TermC.str2term "((x+3*y)/9 + (4*y \<up> 2 - 9*z \<up> 2)/(16*x)) / (x/9 + y/6 + z/4)";
2.1426 +(* WN130911 non-termination due to non-termination of
2.1427 + cancel_p_ thy (TermC.str2term
2.1428 + ("("(576 * x \<up> 2 + 1728 * (x * y) + 1296 * y \<up> 2 + -2916 * z \<up> 2) /" ^
2.1429 + "(576 * x \<up> 2 + 864 * (x * y) + 1296 * (x * z))"))
2.1430 +
2.1431 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1432 +if UnparseC.term t = "(4 * x + 6 * y + -9 * z) / (4 * x)"
2.1433 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 46";
2.1434 +*)
2.1435 +
2.1436 +(*SRD Schalk I, p.69 Nr. 466b *)
2.1437 +val t = TermC.str2term "((1 - 7*(x - 2)/(x \<up> 2 - 4)) / (6/(x+2))) / (3/(x+5)+30/(x \<up> 2 - 25))";
2.1438 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1439 +if UnparseC.term t = "(25 + - 10 * x + x \<up> 2) / 18"
2.1440 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 47";
2.1441 +
2.1442 +(*SRD Schalk I, p.70 Nr. 469 *)
2.1443 +val t = TermC.str2term ("3*b \<up> 2 / (4*a \<up> 2 - 8*a*b + 4*b \<up> 2) / " ^
2.1444 + "(a / (a \<up> 2*b - b \<up> 3) + (a - b) / (4*a*b \<up> 2 + 4*b \<up> 3) - 1 / (4*b \<up> 2))");
2.1445 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1446 +if UnparseC.term t = "- 3 * b \<up> 3 / (- 2 * a + 2 * b)"
2.1447 +then () else error "rational.sml: diff.behav. in norm_Rational_mg 48";
2.1448 +
2.1449 +(*//----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)
2.1450 +"-------- me Schalk I No.186 -------------------------------------------------";
2.1451 +"-------- me Schalk I No.186 -------------------------------------------------";
2.1452 +"-------- me Schalk I No.186 -------------------------------------------------";
2.1453 +val fmz = ["Term ((14 * x * y) / ( x * y ))", "normalform N"];
2.1454 +val (dI',pI',mI') =
2.1455 + ("Rational",["rational", "simplification"],
2.1456 + ["simplification", "of_rationals"]);
2.1457 +val p = e_pos'; val c = [];
2.1458 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
2.1459 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
2.1460 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
2.1461 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
2.1462 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
2.1463 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
2.1464 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
2.1465 +val (p,_,f,nxt,_,pt) = me nxt p c pt;
2.1466 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
2.1467 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
2.1468 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;(*++ for explicit script*)
2.1469 +val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;(*++ for explicit script*)
2.1470 +case (f2str f, nxt) of
2.1471 + ("14", ("End_Proof'", _)) => ()
2.1472 + | _ => error "rational.sml diff.behav. in me Schalk I No.186";
2.1473 + \\----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)*)
2.1474 +
2.1475 +(*//----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)
2.1476 +"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
2.1477 +"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
2.1478 +"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
2.1479 +reset_states ();
2.1480 +CalcTree [(["Term (((2 - x)/(2*a)) / (2*a/(x - 2)))", "normalform N"],
2.1481 + ("Rational", ["rational", "simplification"], ["simplification", "of_rationals"]))];
2.1482 +Iterator 1;
2.1483 +moveActiveRoot 1;
2.1484 +autoCalculate 1 CompleteCalc;
2.1485 +val ((pt, p), _) = get_calc 1;
2.1486 +(*
2.1487 +Test_Tool.show_pt pt;
2.1488 +[
2.1489 +(([], Frm), Simplify ((2 - x) / (2 * a) / (2 * a / (x - 2)))),
2.1490 +(([1], Frm), (2 - x) / (2 * a) / (2 * a / (x - 2))),
2.1491 +(([1], Res), (2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))),
2.1492 +(([2], Res), (2 + -1 * x) / (2 * a) / (2 * a / (-2 + x))),
2.1493 +(([3], Res), (2 + -1 * x) * (-2 + x) / (2 * a * (2 * a))),
2.1494 +(([4], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2)),
2.1495 +(([], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2))]
2.1496 +*)
2.1497 +interSteps 1 ([1], Res);
2.1498 +val ((pt, p), _) = get_calc 1;
2.1499 +(*Test_Tool.show_pt pt;
2.1500 +[
2.1501 +(([], Frm), Simplify ((2 - x) / (2 * a) / (2 * a / (x - 2)))),
2.1502 +(([1], Frm), (2 - x) / (2 * a) / (2 * a / (x - 2))),
2.1503 +(([1,1], Frm), (2 - x) / (2 * a) / (2 * a / (x - 2))),
2.1504 +(([1,1], Res), (2 - x) / (2 * a) / (2 * a / (x + -1 * 2))),
2.1505 +(([1,2], Res), (2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))),
2.1506 +(([1], Res), (2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))),
2.1507 +(([2], Res), (2 + -1 * x) / (2 * a) / (2 * a / (-2 + x))),
2.1508 +(([3], Res), (2 + -1 * x) * (-2 + x) / (2 * a * (2 * a))),
2.1509 +(([4], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2)),
2.1510 +(([], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2))]
2.1511 +*)
2.1512 +val (t, asm) = get_obj g_result pt [1, 1];
2.1513 +if UnparseC.term t = "(2 - x) / (2 * a) / (2 * a / (x + -1 * 2))" andalso UnparseC.terms asm = "[]"
2.1514 +then () else error "2nd interSteps ..Simp_Rat_Double_No-1 changed on [1, 1]";
2.1515 +val (t, asm) = get_obj g_result pt [1, 2];
2.1516 +if UnparseC.term t = "(2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))" andalso UnparseC.terms asm = "[]"
2.1517 +then () else error "3rd interSteps ..Simp_Rat_Double_No-1 changed on [1, 2]";
2.1518 + \\----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)*)
2.1519 +
2.1520 +
2.1521 +(*//----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)
2.1522 +"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
2.1523 +"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
2.1524 +"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
2.1525 +reset_states ();
2.1526 +CalcTree [(["Term ((a^2 + -1*b^2) / (a^2 + -2*a*b + b^2))", "normalform N"],
2.1527 + ("Rational", ["rational", "simplification"], ["simplification", "of_rationals"]))];
2.1528 +Iterator 1;
2.1529 +moveActiveRoot 1;
2.1530 +autoCalculate 1 CompleteCalc;
2.1531 +val ((pt, p), _) = get_calc 1;
2.1532 +(*Test_Tool.show_pt pt;
2.1533 +[
2.1534 +(([], Frm), Simplify ((a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2))),
2.1535 +(([1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2)),
2.1536 +(([1], Res), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
2.1537 +(([2], Res), (a + b) / (a + -1 * b)),
2.1538 +(([], Res), (a + b) / (a + -1 * b))]
2.1539 +*)
2.1540 +interSteps 1 ([2], Res);
2.1541 +val ((pt, p), _) = get_calc 1;
2.1542 +(*Test_Tool.show_pt pt;
2.1543 +[
2.1544 +(([], Frm), Simplify ((a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2))),
2.1545 +(([1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2)),
2.1546 +(([1], Res), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
2.1547 +(([2,1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
2.1548 +(([2,1], Res), (a + b) / (a + -1 * b)),
2.1549 +(([2], Res), (a + b) / (a + -1 * b)),
2.1550 +(([], Res), (a + b) / (a + -1 * b))]
2.1551 +*)
2.1552 +interSteps 1 ([2,1],Res);
2.1553 +val ((pt, p), _) = get_calc 1;
2.1554 +(*Test_Tool.show_pt pt;
2.1555 +[
2.1556 +(([], Frm), Simplify ((a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2))),
2.1557 +(([1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2)),
2.1558 +(([1], Res), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
2.1559 +(([2,1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
2.1560 +(([2,1,1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
2.1561 +(([2,1,1], Res), (a \<up> 2 + -1 * (a * b) + a * b + -1 * b \<up> 2) /
2.1562 +(a \<up> 2 + -2 * (a * b) + 1 * b \<up> 2)),
2.1563 +(([2,1,2], Res), (a \<up> 2 + -1 * (a * b) + a * b + -1 * b \<up> 2) /
2.1564 +(a \<up> 2 + -2 * (a * b) + -1 \<up> 2 * b \<up> 2)),
2.1565 +(([2,1,3], Res), (a \<up> 2 + -1 * (a * b) + a * b + -1 * b \<up> 2) /
2.1566 +(a \<up> 2 + -2 * (a * b) + (-1 * b) \<up> 2)),
2.1567 +(([2,1,4], Res), (a * a + -1 * (a * b) + a * b + -1 * b \<up> 2) /
2.1568 +(a \<up> 2 + -2 * (a * b) + (-1 * b) \<up> 2)),
2.1569 +(([2,1,5], Res), (a * a + -1 * (a * b) + a * b + -1 * (b * b)) /
2.1570 +(a \<up> 2 + -2 * (a * b) + (-1 * b) \<up> 2)),
2.1571 +(([2,1,6], Res), (a * a + -1 * (a * b) + a * b + -1 * (b * b)) /
2.1572 +(a \<up> 2 + -1 * (2 * (a * b)) + (-1 * b) \<up> 2)),
2.1573 +(([2,1,7], Res), (a * a + a * (-1 * b) + (b * a + b * (-1 * b))) /
2.1574 +(a \<up> 2 + 2 * (a * (-1 * b)) + (-1 * b) \<up> 2)),
2.1575 +(([2,1,8], Res), (a * a + a * (-1 * b) + (b * a + b * (-1 * b))) /
2.1576 +(a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
2.1577 +(([2,1,9], Res), (a * (a + -1 * b) + (b * a + b * (-1 * b))) /
2.1578 +(a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
2.1579 +(([2,1,10], Res), (a * (a + -1 * b) + b * (a + -1 * b)) /
2.1580 +(a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
2.1581 +(([2,1,11], Res), (a + b) * (a + -1 * b) / (a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
2.1582 +(([2,1,12], Res), (a + b) * (a + -1 * b) / ((a + -1 * b) * (a + -1 * b))),
2.1583 +(([2,1,13], Res), (a + b) / (a + -1 * b)),
2.1584 +(([2,1], Res), (a + b) / (a + -1 * b)),
2.1585 +(([2], Res), (a + b) / (a + -1 * b)),
2.1586 +(([], Res), (a + b) / (a + -1 * b))]
2.1587 +*)
2.1588 +val newnds = children (get_nd pt [2,1]) (*see "fun detailrls"*);
2.1589 +if length newnds = 13 then () else error "rational.sml: interSteps cancel_p rev_rew_p";
2.1590 +
2.1591 +val p = ([2,1,9],Res);
2.1592 +getTactic 1 p;
2.1593 +val (_, tac, _) = ME_Misc.pt_extract (pt, p);
2.1594 +case tac of SOME (Rewrite ("sym_distrib_left", _)) => ()
2.1595 +| _ => error "rational.sml: getTactic, sym_real_plus_binom_times1";
2.1596 + \\----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)*)
2.1597 +
2.1598 +
2.1599 +"-------- investigate rulesets for cancel_p ----------------------------------";
2.1600 +"-------- investigate rulesets for cancel_p ----------------------------------";
2.1601 +"-------- investigate rulesets for cancel_p ----------------------------------";
2.1602 +val thy = @{theory "Rational"};
2.1603 +val t = TermC.str2term "(a \<up> 2 + -1*b \<up> 2) / (a \<up> 2 + -2*a*b + b \<up> 2)";
2.1604 +val tt = TermC.str2term "(1 * a + 1 * b) * (1 * a + -1 * b)"(*numerator only*);
2.1605 +
2.1606 +"----- with rewrite_set_";
2.1607 +val SOME (tt',asm) = rewrite_set_ thy false make_polynomial tt;
2.1608 +if UnparseC.term tt'= "a \<up> 2 + - 1 * b \<up> 2" then () else error "rls chancel_p 1";
2.1609 +val tt = TermC.str2term "((1 * a + -1 * b) * (1 * a + -1 * b))"(*denominator only*);
2.1610 +val SOME (tt',asm) = rewrite_set_ thy false make_polynomial tt;
2.1611 +if UnparseC.term tt' = "a \<up> 2 + - 2 * a * b + b \<up> 2" then () else error "rls chancel_p 2";
2.1612 +
2.1613 +"----- with Derive.do_one; WN1130912 not investigated further, will be discontinued";
2.1614 +val SOME (tt, _) = factout_p_ thy t;
2.1615 +if UnparseC.term tt = "(a + b) * (a + - 1 * b) / ((a + - 1 * b) * (a + - 1 * b))"
2.1616 +then () else error "rls chancel_p 3";
2.1617 +
2.1618 +"--- with simpler ruleset";
2.1619 +val {rules, rew_ord= (_, ro), ...} = Rule_Set.rep (assoc_rls "rev_rew_p");
2.1620 +val der = Derive.do_one thy Atools_erls rules ro NONE tt;
2.1621 +if length der = 12 then () else error "WN1130912 rls chancel_p 4";
2.1622 +(*default_print_depth 99;*) writeln (Derive.deriv2str der); (*default_print_depth 3;*)
2.1623 +
2.1624 +(*default_print_depth 99;*) map (UnparseC.term o #1) der; (*default_print_depth 3;*)
2.1625 +"...,(-1 * b \<up> 2 + a \<up> 2) / (-2 * (a * b) + a \<up> 2 + (-1 * b) \<up> 2) ]";
2.1626 +(*default_print_depth 99;*) map (Rule.to_string o #2) der; (*default_print_depth 3;*)
2.1627 +(*default_print_depth 99;*) map (UnparseC.term o #1 o #3) der; (*default_print_depth 3;*)
2.1628 +
2.1629 +val der = Derive.do_one thy Atools_erls rules ro NONE
2.1630 + (TermC.str2term "(1 * a + 1 * b) * (1 * a + -1 * b)");
2.1631 +(*default_print_depth 99;*) writeln (Derive.deriv2str der); (*default_print_depth 3;*)
2.1632 +
2.1633 +val {rules, rew_ord=(_,ro),...} = Rule_Set.rep (assoc_rls "rev_rew_p");
2.1634 +val der = Derive.do_one thy Atools_erls rules ro NONE
2.1635 + (TermC.str2term "(1 * a + -1 * b) * (1 * a + -1 * b)");
2.1636 +(*default_print_depth 99;*) writeln (Derive.deriv2str der); (*default_print_depth 3;*)
2.1637 +(*default_print_depth 99;*) map (UnparseC.term o #1) der; (*default_print_depth 3;*)
2.1638 +(*WN060829 ...postponed*)
2.1639 +
2.1640 +
2.1641 +"-------- fun eval_get_denominator -------------------------------------------";
2.1642 +"-------- fun eval_get_denominator -------------------------------------------";
2.1643 +"-------- fun eval_get_denominator -------------------------------------------";
2.1644 +val thy = @{theory Isac_Knowledge};
2.1645 +val t = Thm.term_of (the (TermC.parse thy "get_denominator ((a +x)/b)"));
2.1646 +val SOME (_, t') = eval_get_denominator "" 0 t thy;
2.1647 +if UnparseC.term t' = "get_denominator ((a + x) / b) = b"
2.1648 +then () else error "get_denominator ((a + x) / b) = b"
2.1649 +
2.1650 +
2.1651 +"-------- several errpats in complicated term --------------------------------";
2.1652 +"-------- several errpats in complicated term --------------------------------";
2.1653 +"-------- several errpats in complicated term --------------------------------";
2.1654 +(*WN12xxxx TODO: instead of Gabriella's example here (27.Jul.12) find a simpler one
2.1655 + WN130912: kept this test, although not clear what for*)
2.1656 +reset_states ();
2.1657 +CalcTree [(["Term ((5*b + 25)/(a^2 - b^2) * (a - b)/(5*b))", "normalform N"],
2.1658 + ("Rational", ["rational", "simplification"], ["simplification", "of_rationals"]))];
2.1659 +Iterator 1;
2.1660 +moveActiveRoot 1;
2.1661 +autoCalculate 1 CompleteCalc;
2.1662 +val ((pt, p), _) = get_calc 1;
2.1663 +(*Test_Tool.show_pt pt;
2.1664 +[
2.1665 +(([], Frm), Simplify ((5 * b + 25) / (a \<up> 2 - b \<up> 2) * (a - b) / (5 * b))),
2.1666 +(([1], Frm), (5 * b + 25) / (a \<up> 2 - b \<up> 2) * (a - b) / (5 * b)),
2.1667 +(([1], Res), (5 * b + 25) / (a \<up> 2 + -1 * b \<up> 2) * (a + -1 * b) / (5 * b)),
2.1668 +(([2], Res), (5 * b + 25) * (a + -1 * b) / (a \<up> 2 + -1 * b \<up> 2) / (5 * b)),
2.1669 +(([3], Res), (25 * a + -25 * b + 5 * (a * b) + -5 * b \<up> 2) / (a \<up> 2 + -1 * b \<up> 2) /
2.1670 +(5 * b)),
2.1671 +(([4], Res), (25 + 5 * b) / (a + b) / (5 * b)),
2.1672 +(([5], Res), (25 + 5 * b) / ((a + b) * (5 * b))),
2.1673 +(([6], Res), (25 + 5 * b) / (5 * (a * b) + 5 * b \<up> 2)),
2.1674 +(([7], Res), (5 + b) / (a * b + b \<up> 2)),
2.1675 +(([], Res), (5 + b) / (a * b + b \<up> 2))] *)
2.1676 +
2.1677 +
2.1678 +"-------- WN1309xx non-terminating rls norm_Rational -------------------------";
2.1679 +"-------- WN1309xx non-terminating rls norm_Rational -------------------------";
2.1680 +"-------- WN1309xx non-terminating rls norm_Rational -------------------------";
2.1681 +(*------- Schalk I, p.70 Nr. 480b; a/b : c/d translated to a/b * d/c*)
2.1682 +val t = TermC.str2term
2.1683 + ("((12*x*y / (9*x \<up> 2 - y \<up> 2)) / (1 / (3*x - y) \<up> 2 - 1 / (3*x + y) \<up> 2)) * " ^
2.1684 + "((1/(x - 5*y) \<up> 2 - 1/(x + 5*y) \<up> 2) / (20*x*y / (x \<up> 2 - 25*y \<up> 2)))");
2.1685 +
2.1686 +(*1st factor separately simplified *)
2.1687 +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))";
2.1688 +val SOME (t', _) = rewrite_set_ thy false norm_Rational t;
2.1689 +if UnparseC.term t' = "(- 9 * x \<up> 2 + y \<up> 2) / - 1" then () else error "Nr. 480b lhs changed";
2.1690 +(*2nd factor separately simplified *)
2.1691 +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)))";
2.1692 +val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
2.1693 +if UnparseC.term t' = "- 1 / (- 1 * x \<up> 2 + 25 * y \<up> 2)" then () else error "Nr. 480b rhs changed";
2.1694 +
2.1695 +"-------- Schalk I, p.70 Nr. 477a: terms are exploding ?!?";
2.1696 +val t = TermC.str2term ("b*y/(b - 2*y)/((b \<up> 2 - y \<up> 2)/(b+2*y)) /" ^
2.1697 + "(b \<up> 2*y + b*y \<up> 2) * (a+x) \<up> 2 / ((b \<up> 2 - 4*y \<up> 2) * (a+2*x) \<up> 2)");
2.1698 +(*val SOME (t',_) = rewrite_set_ thy false norm_Rational t;
2.1699 +:
2.1700 +### rls: cancel_p on: (a \<up> 2 * (b * y) + 2 * (a * (b * (x * y))) + b * (x \<up> 2 * y)) /
2.1701 +(b + -2 * y) /
2.1702 +((b \<up> 2 + -1 * y \<up> 2) / (b + 2 * y)) /
2.1703 +(b \<up> 2 * y + b * y \<up> 2) /
2.1704 +(a \<up> 2 * b \<up> 2 + -4 * (a \<up> 2 * y \<up> 2) + 4 * (a * (b \<up> 2 * x)) +
2.1705 + -16 * (a * (x * y \<up> 2)) +
2.1706 + 4 * (b \<up> 2 * x \<up> 2) +
2.1707 + -16 * (x \<up> 2 * y \<up> 2))
2.1708 +exception Div raised
2.1709 +
2.1710 +BUT
2.1711 +val t = TermC.str2term
2.1712 + ("(a \<up> 2 * (b * y) + 2 * (a * (b * (x * y))) + b * (x \<up> 2 * y)) /" ^
2.1713 + "(b + -2 * y) /" ^
2.1714 + "((b \<up> 2 + -1 * y \<up> 2) / (b + 2 * y)) /" ^
2.1715 + "(b \<up> 2 * y + b * y \<up> 2) /" ^
2.1716 + "(a \<up> 2 * b \<up> 2 + -4 * (a \<up> 2 * y \<up> 2) + 4 * (a * (b \<up> 2 * x)) +" ^
2.1717 + "-16 * (a * (x * y \<up> 2)) +" ^
2.1718 + "4 * (b \<up> 2 * x \<up> 2) +" ^
2.1719 + "-16 * (x \<up> 2 * y \<up> 2))");
2.1720 +NONE = cancel_p_ thy t;
2.1721 +*)
2.1722 +
2.1723 +(*------- Schalk I, p.70 Nr. 476b in 2003 this worked using 10 sec. *)
2.1724 +val t = TermC.str2term
2.1725 + ("((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) / " ^
2.1726 + "((a \<up> 2 + b \<up> 2) \<up> 2 / (a + b) \<up> 2)");
2.1727 +(* Rewrite.trace_on := true;
2.1728 +rewrite_set_ thy false norm_Rational t;
2.1729 +:
2.1730 +#### rls: cancel_p on: (2 * (a \<up> 7 * b) + 4 * (a \<up> 6 * b \<up> 2) + 6 * (a \<up> 5 * b \<up> 3) +
2.1731 + 8 * (a \<up> 4 * b \<up> 4) +
2.1732 + 6 * (a \<up> 3 * b \<up> 5) +
2.1733 + 4 * (a \<up> 2 * b \<up> 6) +
2.1734 + 2 * (a * b \<up> 7)) /
2.1735 +(2 * (a \<up> 9 * b) + 4 * (a \<up> 8 * b \<up> 2) +
2.1736 + 2 * (2 * (a \<up> 7 * b \<up> 3)) +
2.1737 + 4 * (a \<up> 6 * b \<up> 4) +
2.1738 + -4 * (a \<up> 4 * b \<up> 6) +
2.1739 + -4 * (a \<up> 3 * b \<up> 7) +
2.1740 + -4 * (a \<up> 2 * b \<up> 8) +
2.1741 + -2 * (a * b \<up> 9))
2.1742 +
2.1743 +if UnparseC.term t = "1 / (a \<up> 2 + -1 * b \<up> 2)" then ()
2.1744 +else error "rational.sml: diff.behav. in norm_Rational_mg 49";
2.1745 +*)
2.1746 +
2.1747 +"-------- Schalk I, p.70 Nr. 480a: terms are exploding ?!?";
2.1748 +val t = TermC.str2term ("(1/x + 1/y + 1/z) / (1/x - 1/y - 1/z) / " ^
2.1749 + "(2*x \<up> 2 / (x \<up> 2 - z \<up> 2) / (x / (x + z) + x / (x - z)))");
2.1750 +(* Rewrite.trace_on := true;
2.1751 +rewrite_set_ thy false norm_Rational t;
2.1752 +:
2.1753 +#### rls: cancel_p on: (2 * (x \<up> 6 * (y \<up> 2 * z)) + 2 * (x \<up> 6 * (y * z \<up> 2)) +
2.1754 + 2 * (x \<up> 5 * (y \<up> 2 * z \<up> 2)) +
2.1755 + -2 * (x \<up> 4 * (y \<up> 2 * z \<up> 3)) +
2.1756 + -2 * (x \<up> 4 * (y * z \<up> 4)) +
2.1757 + -2 * (x \<up> 3 * (y \<up> 2 * z \<up> 4))) /
2.1758 +(-2 * (x \<up> 6 * (y \<up> 2 * z)) + -2 * (x \<up> 6 * (y * z \<up> 2)) +
2.1759 + 2 * (x \<up> 5 * (y \<up> 2 * z \<up> 2)) +
2.1760 + 2 * (x \<up> 4 * (y \<up> 2 * z \<up> 3)) +
2.1761 + 2 * (x \<up> 4 * (y * z \<up> 4)) +
2.1762 + -2 * (x \<up> 3 * (y \<up> 2 * z \<up> 4)))
2.1763 +*)
2.1764 +
2.1765 +"-------- Schalk I, p.60 Nr. 215d: terms are exploding, internal loop does not terminate";
2.1766 +val t = TermC.str2term "(a-b) \<up> 3 * (x+y) \<up> 4 / ((x+y) \<up> 2 * (a-b) \<up> 5)";
2.1767 +(* Kein Wunder, denn Z???ler und Nenner extra als Polynom dargestellt ergibt:
2.1768 +
2.1769 +val t = TermC.str2term "(a-b) \<up> 3 * (x+y) \<up> 4";
2.1770 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1771 +UnparseC.term t;
2.1772 +"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";
2.1773 +val t = TermC.str2term "((x+y) \<up> 2 * (a-b) \<up> 5)";
2.1774 +val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1775 +UnparseC.term t;
2.1776 +"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";
2.1777 +
2.1778 +anscheinend macht dem Rechner das Krzen diese Bruches keinen Spass mehr ...*)
2.1779 +
2.1780 +"-------- Schalk I, p.70 Nr. 480b: terms are exploding, Rewrite.trace_on stops at";
2.1781 +val t = TermC.str2term ("((12*x*y/(9*x \<up> 2 - y \<up> 2))/" ^
2.1782 + "(1/(3*x - y) \<up> 2 - 1/(3*x + y) \<up> 2)) *" ^
2.1783 + "(1/(x - 5*y) \<up> 2 - 1/(x + 5*y) \<up> 2)/" ^
2.1784 + "(20*x*y/(x \<up> 2 - 25*y \<up> 2))");
2.1785 +(*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
2.1786 +:
2.1787 +#### rls: cancel_p on: (19440 * (x \<up> 8 * y \<up> 2) + -490320 * (x \<up> 6 * y \<up> 4) +
2.1788 + 108240 * (x \<up> 4 * y \<up> 6) +
2.1789 + -6000 * (x \<up> 2 * y \<up> 8)) /
2.1790 +(2160 * (x \<up> 8 * y \<up> 2) + -108240 * (x \<up> 6 * y \<up> 4) +
2.1791 + 1362000 * (x \<up> 4 * y \<up> 6) +
2.1792 + -150000 * (x \<up> 2 * y \<up> 8))
2.1793 +*)
2.1794 +
3.1 --- a/test/Tools/isac/Knowledge/rational.sml Thu Jul 15 20:09:44 2021 +0200
3.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
3.3 @@ -1,1919 +0,0 @@
3.4 -(* Title: tests for rationals
3.5 - Author: Walther Neuper
3.6 - Use is subject to license terms.
3.7 -*)
3.8 -
3.9 -"-----------------------------------------------------------------------------";
3.10 -"-----------------------------------------------------------------------------";
3.11 -"table of contents -----------------------------------------------------------";
3.12 -"-----------------------------------------------------------------------------";
3.13 -"-------- fun poly_of_term ---------------------------------------------------";
3.14 -"-------- fun is_poly --------------------------------------------------------";
3.15 -"-------- fun term_of_poly ---------------------------------------------------";
3.16 -"-------- integration lev.1 fun factout_p_ -----------------------------------";
3.17 -"-------- integration lev.1 fun cancel_p_ ------------------------------------";
3.18 -"-------- integration lev.1 fun common_nominator_p_ --------------------------";
3.19 -"-------- integration lev.1 fun add_fraction_p_ ------------------------------";
3.20 -"Rfuns-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
3.21 -"Rfuns-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
3.22 -"-------- rls norm_Rational downto fun gcd_poly ------------------------------";
3.23 -"Rfuns-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
3.24 -"----------- rewrite_set_ Partial_Fractions norm_Rational --------------------------------------";
3.25 -"----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
3.26 -"----------- fun cancel_p with Const AA --------------------------------------------------------";
3.27 -"-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
3.28 -"-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
3.29 -"-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
3.30 -"Rfuns-------- reverse rewrite ----------------------------------------------------";
3.31 -"Rfuns-------- 'reverse-ruleset' cancel_p -----------------------------------------";
3.32 -"-------- investigate rls norm_Rational --------------------------------------";
3.33 -"-------- examples: rls norm_Rational ----------------------------------------";
3.34 -"-------- rational numerals --------------------------------------------------";
3.35 -"-------- examples cancellation from: Mathematik 1 Schalk --------------------";
3.36 -"-------- examples common denominator from: Mathematik 1 Schalk --------------";
3.37 -"-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
3.38 -"-------- examples common denominator and multiplication from: Schalk --------";
3.39 -"-------- examples double fractions from: Mathematik 1 Schalk ----------------";
3.40 -"-------- me Schalk I No.186 -------------------------------------------------";
3.41 -"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
3.42 -"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
3.43 -"-------- investigate rulesets for cancel_p ----------------------------------";
3.44 -"-------- fun eval_get_denominator -------------------------------------------";
3.45 -"-------- several errpats in complicated term --------------------------------";
3.46 -"-------- WN1309xx non-terminating rls norm_Rational -------------------------";
3.47 -"-----------------------------------------------------------------------------";
3.48 -"-----------------------------------------------------------------------------";
3.49 -
3.50 -
3.51 -"-------- fun poly_of_term ---------------------------------------------------";
3.52 -"-------- fun poly_of_term ---------------------------------------------------";
3.53 -"-------- fun poly_of_term ---------------------------------------------------";
3.54 -val thy = @{theory Partial_Fractions};
3.55 -val vs = TermC.vars_of (TermC.str2term "12 * x \<up> 3 * y \<up> 4 * z \<up> 6");
3.56 -
3.57 -val t = TermC.str2term "-3 + -2 * x ::real";
3.58 -if poly_of_term vs t = SOME [(~3, [0, 0, 0]), (~2, [1, 0, 0])]
3.59 -then () else error "poly_of_term uminus changed";
3.60 -
3.61 -if poly_of_term vs (TermC.str2term "12::real") = SOME [(12, [0, 0, 0])]
3.62 -then () else error "poly_of_term 1 changed";
3.63 -
3.64 -if poly_of_term vs (TermC.str2term "x::real") = SOME [(1, [1, 0, 0])]
3.65 -then () else error "poly_of_term 2 changed";
3.66 -
3.67 -if poly_of_term vs (TermC.str2term "12 * x \<up> 3") = SOME [(12, [3, 0, 0])]
3.68 -then () else error "poly_of_term 3 changed";
3.69 -"~~~~~ fun poly_of_term , args:"; val (vs, t) =
3.70 - (vs, (TermC.str2term "12 * x \<up> 3"));
3.71 -
3.72 - monom_of_term vs (1, replicate (length vs) 0) t;(*poly malformed 1 with x \<up> 3*)
3.73 -"~~~~~ fun monom_of_term , args:"; val (vs, (c, es), (Const ("Groups.times_class.times", _) $ m1 $ m2)) =
3.74 - (vs, (1, replicate (length vs) 0), t);
3.75 - val (c', es') =
3.76 -
3.77 - monom_of_term vs (c, es) m1;
3.78 -"~~~~~ fun monom_of_term , args:"; val (vs, (c, es), (Const ("Transcendental.powr", _) $ (t as Free _) $ (Const ("Num.numeral_class.numeral", _) $ num)) ) =
3.79 - (vs, (c', es'), m2);
3.80 -(*+*)c = 12;
3.81 -(*+*)(num |> HOLogic.dest_numeral |> list_update es (find_index (curry op = t) vs)) = [3, 0, 0];
3.82 -
3.83 -if (c, num |> HOLogic.dest_numeral |> list_update es (find_index (curry op = t) vs)) = (12, [3, 0, 0])
3.84 -then () else error "monom_of_term (powr): return value CHANGED";
3.85 -
3.86 -if poly_of_term vs (TermC.str2term "12 * x \<up> 3 * y \<up> 4 * z \<up> 6") = SOME [(12, [3, 4, 6])]
3.87 -then () else error "poly_of_term 4 changed";
3.88 -
3.89 -if poly_of_term vs (TermC.str2term "1 + 2 * x \<up> 3 * y \<up> 4 * z \<up> 6 + y") =
3.90 - SOME [(1, [0, 0, 0]), (1, [0, 1, 0]), (2, [3, 4, 6])]
3.91 -then () else error "poly_of_term 5 changed";
3.92 -
3.93 -(*poly_of_term is quite liberal:*)
3.94 -(*the coefficient may be somewhere, the order of variables and the parentheses
3.95 - within a monomial are arbitrary*)
3.96 -if poly_of_term vs (TermC.str2term "y \<up> 4 * (x \<up> 3 * 12 * z \<up> 6)") = SOME [(12, [3, 4, 6])]
3.97 -then () else error "poly_of_term 6 changed";
3.98 -
3.99 -(*there may even be more than 1 coefficient:*)
3.100 -if poly_of_term vs (TermC.str2term "2 * y \<up> 4 * (x \<up> 3 * 6 * z \<up> 6)") = SOME [(12, [3, 4, 6])]
3.101 -then () else error "poly_of_term 7 changed";
3.102 -
3.103 -(*the order and the parentheses within monomials are arbitrary:*)
3.104 -if poly_of_term vs (TermC.str2term "2 * x \<up> 3 * y \<up> 4 * z \<up> 6 + (7 * y \<up> 8 + 1)")
3.105 - = SOME [(1, [0, 0, 0]), (7, [0, 8, 0]), (2, [3, 4, 6])]
3.106 -then () else error "poly_of_term 8 changed";
3.107 -
3.108 -(*from --- rls norm_Rational downto fun gcd_poly ---*)
3.109 -val t = TermC.str2term (*copy from above: "::real" is not required due to " \<up> "*)
3.110 - ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
3.111 - "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)");
3.112 -"~~~~~ fun cancel_p_, args:"; val (t) = (t);
3.113 -val opt = check_fraction t;
3.114 -val SOME (numerator, denominator) = opt;
3.115 -(*+*)UnparseC.term numerator = "- 12 + 4 * y + 3 * x \<up> 2 + - 1 * (x \<up> 2 * y)"; (*isa -- isa2*);
3.116 -(*+*)UnparseC.term denominator = "- 18 + - 9 * x + 2 * y \<up> 2 + x * y \<up> 2"; (*isa -- isa2*);
3.117 - val vs = TermC.vars_of t;
3.118 -(*+*)UnparseC.terms vs = "[\"x\", \"y\"]";
3.119 - val baseT = type_of numerator
3.120 - val expT = HOLogic.realT;
3.121 -val (SOME _, SOME _) = (poly_of_term vs numerator, poly_of_term vs denominator); (*isa <> isa2*)
3.122 -
3.123 -"-------- fun is_poly --------------------------------------------------------";
3.124 -"-------- fun is_poly --------------------------------------------------------";
3.125 -"-------- fun is_poly --------------------------------------------------------";
3.126 -if is_poly (TermC.str2term "2 * x \<up> 3 * y \<up> 4 * z \<up> 6 + 7 * y \<up> 8 + 1")
3.127 -then () else error "is_poly 1 changed";
3.128 -if not (is_poly (TermC.str2term "2 * (x \<up> 3 * y \<up> 4 * z \<up> 6 + 7) * y \<up> 8 + 1"))
3.129 -then () else error "is_poly 2 changed";
3.130 -
3.131 -"-------- fun term_of_poly ---------------------------------------------------";
3.132 -"-------- fun term_of_poly ---------------------------------------------------";
3.133 -"-------- fun term_of_poly ---------------------------------------------------";
3.134 -val expT = HOLogic.realT
3.135 -val Free (_, baseT) = (hd o vars o TermC.str2term) "12 * x \<up> 3 * y \<up> 4 * z \<up> 6";
3.136 -val p = [(1, [0, 0, 0]), (7, [0, 8, 0]), (2, [3, 4, 5])]
3.137 -val vs = TermC.vars_of (the (parseNEW ctxt "12 * x \<up> 3 * y \<up> 4 * z \<up> 6"))
3.138 -(*precondition for [(c, es),...]: legth es = length vs*)
3.139 -;
3.140 -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"
3.141 -then () else error "term_of_poly 1 changed";
3.142 -
3.143 -"-------- integration lev.1 fun factout_p_ -----------------------------------";
3.144 -"-------- integration lev.1 fun factout_p_ -----------------------------------";
3.145 -"-------- integration lev.1 fun factout_p_ -----------------------------------";
3.146 -val t = TermC.str2term "(x \<up> 2 + -1*y \<up> 2) / (x \<up> 2 + -1*x*y)"
3.147 -val SOME (t', asm) = factout_p_ thy t;
3.148 -if UnparseC.term t' = "(x + y) * (x + - 1 * y) / (x * (x + - 1 * y))"
3.149 -then () else error ("factout_p_ term 1 changed: " ^ UnparseC.term t')
3.150 -;
3.151 -if UnparseC.terms asm = "[\"x \<noteq> 0\", \"x + - 1 * y \<noteq> 0\"]"
3.152 -then () else error "factout_p_ asm 1 changed"
3.153 -;
3.154 -val t = TermC.str2term "nothing + to_cancel ::real";
3.155 -if NONE = factout_p_ thy t then () else error "factout_p_ doesn't report non-applicable";
3.156 -;
3.157 -val t = TermC.str2term "((3 * x \<up> 2 + 6 *x + 3) / (2*x + 2))";
3.158 -val SOME (t', asm) = factout_p_ thy t;
3.159 -if UnparseC.term t' = "(3 + 3 * x) * (1 + x) / (2 * (1 + x))" andalso
3.160 - UnparseC.terms asm = "[\"1 + x \<noteq> 0\"]"
3.161 -then () else error "factout_p_ 1 changed";
3.162 -
3.163 -"-------- integration lev.1 fun cancel_p_ ------------------------------------";
3.164 -"-------- integration lev.1 fun cancel_p_ ------------------------------------";
3.165 -"-------- integration lev.1 fun cancel_p_ ------------------------------------";
3.166 -val t = TermC.str2term "(x \<up> 2 + -1*y \<up> 2) / (x \<up> 2 + -1*x*y)"
3.167 -val SOME (t', asm) = cancel_p_ thy t;
3.168 -if (UnparseC.term t', UnparseC.terms asm) = ("(x + y) / x", "[\"x \<noteq> 0\"]")
3.169 -then () else error ("cancel_p_ (t', asm) 1 changed: " ^ UnparseC.term t')
3.170 -;
3.171 -val t = TermC.str2term "nothing + to_cancel ::real";
3.172 -if NONE = cancel_p_ thy t then () else error "cancel_p_ doesn't report non-applicable";
3.173 -;
3.174 -val t = TermC.str2term "((3 * x \<up> 2 + 6 *x + 3) / (2*x + 2))";
3.175 -val SOME (t', asm) = cancel_p_ thy t;
3.176 -if UnparseC.term t' = "(3 + 3 * x) / 2" andalso UnparseC.terms asm = "[]"
3.177 -then () else error "cancel_p_ 1 changed";
3.178 -
3.179 -"-------- integration lev.1 fun common_nominator_p_ --------------------------";
3.180 -"-------- integration lev.1 fun common_nominator_p_ --------------------------";
3.181 -"-------- integration lev.1 fun common_nominator_p_ --------------------------";
3.182 -val t = TermC.str2term ("y / (a*x + b*x + c*x) " ^
3.183 - (* n1 d1 *)
3.184 - "+ a / (x*y)");
3.185 - (* n2 d2 *)
3.186 -val SOME (t', asm) = common_nominator_p_ thy t;
3.187 -if UnparseC.term t' =
3.188 - ("y * y / (x * ((a + b + c) * y)) " ^
3.189 - (* n1 *d2'/ (c'* ( d1' *d2')) *)
3.190 - "+ a * (a + b + c) / (x * ((a + b + c) * y))")
3.191 - (* n2 * d1' / (c'* ( d1' *d2')) *)
3.192 -then () else error "common_nominator_p_ term 1 changed";
3.193 -if UnparseC.terms asm = "[\"a + b + c \<noteq> 0\", \"y \<noteq> 0\", \"x \<noteq> 0\"]"
3.194 -then () else error "common_nominator_p_ asm 1 changed"
3.195 -
3.196 -"-------- example in mail Nipkow";
3.197 -val t = TermC.str2term "x/(x \<up> 2 + -1*y \<up> 2) + y/(x \<up> 2 + -1*x*y)";
3.198 -val SOME (t', asm) = common_nominator_p_ thy t;
3.199 -if UnparseC.term t' =
3.200 - "x * x / ((x + - 1 * y) * ((x + y) * x)) +\ny * (x + y) / ((x + - 1 * y) * ((x + y) * x))"
3.201 -then () else error "common_nominator_p_ term 2 changed"
3.202 -;
3.203 -if UnparseC.terms asm = "[\"x + y \<noteq> 0\", \"x \<noteq> 0\", \"x + - 1 * y \<noteq> 0\"]"
3.204 -then () else error "common_nominator_p_ asm 2 changed"
3.205 -
3.206 -"-------- example: applicable tested by SML code";
3.207 -val t = TermC.str2term "nothing / to_add";
3.208 -if NONE = common_nominator_p_ thy t then () else error "common_nominator_p_ term 3 changed";
3.209 -;
3.210 -val t = TermC.str2term "((x + (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
3.211 -val SOME (t', asm) = common_nominator_p_ thy t;
3.212 -if UnparseC.term t' =
3.213 - "(x + - 1) * (- 1 + x) / ((1 + x) * (- 1 + x)) +\n(x + 1) * (1 + x) / ((1 + x) * (- 1 + x))"
3.214 - andalso UnparseC.terms asm = "[\"1 + x \<noteq> 0\", \"- 1 + x \<noteq> 0\"]"
3.215 -then () else error "common_nominator_p_ 3 changed";
3.216 -
3.217 -"-------- integration lev.1 fun add_fraction_p_ ------------------------------";
3.218 -"-------- integration lev.1 fun add_fraction_p_ ------------------------------";
3.219 -"-------- integration lev.1 fun add_fraction_p_ ------------------------------";
3.220 -val t = TermC.str2term "((x + (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
3.221 -val SOME (t', asm) = add_fraction_p_ thy t;
3.222 -if UnparseC.term t' = "(2 + 2 * x \<up> 2) / (- 1 + x \<up> 2)"
3.223 -then () else error "add_fraction_p_ 3 changed";
3.224 -;
3.225 -if UnparseC.terms asm = "[\"- 1 + x \<up> 2 \<noteq> 0\"]"
3.226 -then () else error "add_fraction_p_ 3 changed";
3.227 -;
3.228 -val t = TermC.str2term "nothing / to_add";
3.229 -if NONE = add_fraction_p_ thy t then () else error "add_fraction_p_ term 3 changed";
3.230 -;
3.231 -val t = TermC.str2term "((x + (-1)) / (x + 1)) + ((x + 1) / (x + (-1)))";
3.232 -val SOME (t', asm) = add_fraction_p_ thy t;
3.233 -if UnparseC.term t' = "(2 + 2 * x \<up> 2) / (- 1 + x \<up> 2)" andalso
3.234 - UnparseC.terms asm = "[\"- 1 + x \<up> 2 \<noteq> 0\"]"
3.235 -then () else error "add_fraction_p_ 3 changed";
3.236 -
3.237 -"-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
3.238 -"-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
3.239 -"-------- and app_rev ...traced down from rewrite_set_ until prepats ---------";
3.240 -(* trace down until prepats are evaluated
3.241 - (which does not to work, because substitution is not done -- compare rew_sub!);
3.242 - keep this sequence for the case, factout_p, cancel_p, common_nominator_p, add_fraction_p
3.243 - (again) get prepat = [] changed to <>[]. *)
3.244 -val t = TermC.str2term "(x \<up> 2 + -1*y \<up> 2) / (x \<up> 2 + -1*x*y)";
3.245 -
3.246 -(*rewrite_set_ @{theory Isac_Knowledge} true cancel t = NONE; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
3.247 -"~~~~~ fun rewrite_set_, args:"; val (thy, bool, rls, term) = (thy, false, cancel_p, t);
3.248 -"~~~~~ fun rewrite__set_, args:"; val (thy, i, _, _, (rrls as Rrls _), t) =
3.249 - (thy, 1, bool, [], rls, term);
3.250 -(*val (t', asm, rew) = app_rev thy (i+1) rrls t; rew = false!!!!!!!!!!!!!!!!!!!!!*)
3.251 -"~~~~~ and app_rev, args:"; val (thy, i, rrls, t) = (thy, (i+1), rrls, t);
3.252 - fun chk_prepat thy erls [] t = true
3.253 - | chk_prepat thy erls prepat t =
3.254 - let
3.255 - fun chk (pres, pat) =
3.256 - (let
3.257 - val subst: Type.tyenv * Envir.tenv =
3.258 - Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
3.259 - in
3.260 - snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
3.261 - end) handle Pattern.MATCH => false
3.262 - fun scan_ f [] = false (*scan_ NEVER called by []*)
3.263 - | scan_ f (pp::pps) =
3.264 - if f pp then true else scan_ f pps;
3.265 - in scan_ chk prepat end;
3.266 - (* apply the normal_form of a rev-set *)
3.267 - fun app_rev' thy (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}) t =
3.268 - if chk_prepat thy erls prepat t
3.269 - then ((*tracing("### app_rev': t = "^UnparseC.term t);*) normal_form t)
3.270 - else NONE;
3.271 -(* val opt = app_rev' thy rrls t ..NONE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
3.272 -"~~~~~ and app_rev', args:"; val (thy, (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}), t) =
3.273 - (thy, rrls, t);
3.274 -(* chk_prepat thy erls prepat t = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
3.275 -(* app_sub thy i rrls t = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
3.276 -"~~~~~ fun chk_prepat, args:"; val (thy, erls, prepat, t) = (thy, erls, prepat, t);
3.277 - fun chk (pres, pat) =
3.278 - (let
3.279 - val subst: Type.tyenv * Envir.tenv =
3.280 - Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
3.281 - in
3.282 - snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
3.283 - end) handle Pattern.MATCH => false
3.284 - fun scan_ f [] = false (*scan_ NEVER called by []*)
3.285 - | scan_ f (pp::pps) =
3.286 - if f pp then true else scan_ f pps;
3.287 -
3.288 -(*========== inhibit exn WN130823: prepat is empty ====================================
3.289 -(* scan_ chk prepat = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
3.290 -"~~~~~ fun , args:"; val (f, (pp::pps)) = (chk, prepat);
3.291 -f;
3.292 -val ([t1, t2], t) = pp;
3.293 -UnparseC.term t1 = "?r is_expanded";
3.294 -UnparseC.term t2 = "?s is_expanded";
3.295 -UnparseC.term t = "?r / ?s";
3.296 -(* f pp = false!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
3.297 -"~~~~~ fun chk, args:"; val (pres, pat) = (pp);
3.298 - val subst: Type.tyenv * Envir.tenv =
3.299 - Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
3.300 -(*subst =
3.301 - ({}, {(("r", 0), ("real", Var (("r", 0), "real"))),
3.302 - (("s", 0), ("real", Var (("s", 0), "real")))}*)
3.303 -;
3.304 - snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
3.305 -"~~~~~ fun eval__true, args:"; val (thy, i, asms, bdv, rls) =
3.306 - (thy, (i + 1), (map (Envir.subst_term subst) pres), [], erls);
3.307 -UnparseC.terms asms; (* = "[\"?r is_expanded\",\"?s is_expanded\"]"*)
3.308 -asms = [@{term True}] orelse asms = []; (* = false*)
3.309 -asms = [@{term False}] ; (* = false*)
3.310 -"~~~~~ fun chk, args:"; val (indets, (a::asms)) = ([], asms);
3.311 -bdv (*= []: _a list*);
3.312 -val bdv : (term * term) list = [];
3.313 -rewrite__set_ thy (i+1) false;
3.314 -UnparseC.term a = "?r is_expanded"; (*hier m"usste doch der Numerator eingesetzt sein ??????????????*)
3.315 -val SOME (Const ("HOL.False", _), []) = rewrite__set_ thy (i+1) false bdv rls a
3.316 -============ inhibit exn WN130823: prepat is empty ===================================*)
3.317 -
3.318 -"-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
3.319 -"-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
3.320 -"-------- fun rewrite_set_ cancel_p downto fun gcd_poly ----------------------";
3.321 -val t = TermC.str2term "(12 * x * y) / (8 * y \<up> 2 )";
3.322 -(* "-------- example 187a": exception Div raised...
3.323 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;*)
3.324 -val t = TermC.str2term "(8 * x \<up> 2 * y * z ) / (18 * x * y \<up> 2 * z )";
3.325 -(* "-------- example 187b": doesn't terminate...
3.326 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;*)
3.327 -val t = TermC.str2term "(9 * x \<up> 5 * y \<up> 2 * z \<up> 4) / (15 * x \<up> 6 * y \<up> 3 * z )";
3.328 -(* "-------- example 187c": doesn't terminate...
3.329 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;*)
3.330 -"~~~~~ fun rewrite_set_, args:"; val (thy, bool, rls, term) = (@{theory Isac_Knowledge}, false, cancel_p, t);
3.331 -(* WN130827: exception Div raised...
3.332 -rewrite__set_ thy 1 bool [] rls term
3.333 -*)
3.334 -"~~~~~ and rewrite__set_, args:"; val (thy, i, _, _, (rrls as Rrls _), t) =
3.335 - (thy, 1, bool, [], rls, term);
3.336 -(* WN130827: exception Div raised...
3.337 - val (t', asm, rew) = app_rev thy (i+1) rrls t
3.338 -*)
3.339 -"~~~~~ fun app_rev, args:"; val (thy, i, rrls, t) = (thy, (i+1), rrls, t);
3.340 -(* WN130827: exception Div raised...
3.341 - val opt = app_rev' thy rrls t
3.342 -*)
3.343 -"~~~~~ fun app_rev', args:"; val (thy, (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}), t) =
3.344 - (thy, rrls, t);
3.345 -chk_prepat thy erls prepat t = true;
3.346 -(* WN130827: exception Div raised...
3.347 -normal_form t
3.348 -*)
3.349 -(* lookup Rational.thy, cancel_p: normal_form = cancel_p_ thy*)
3.350 -"~~~~~ fun cancel_p_, args:"; val (t) = (t);
3.351 -val opt = check_fraction t;
3.352 -val SOME (numerator, denominator) = opt
3.353 - val vs = TermC.vars_of t
3.354 - val baseT = type_of numerator
3.355 - val expT = HOLogic.realT
3.356 -val (SOME a, SOME b) = (poly_of_term vs numerator, poly_of_term vs denominator);
3.357 -(*"-------- example 187a": exception Div raised...
3.358 -val a = [(12, [1, 1])]: poly
3.359 -val b = [(8, [0, 2])]: poly
3.360 - val ((a', b'), c) = gcd_poly a b
3.361 -*)
3.362 -(* "-------- example 187b": doesn't terminate...
3.363 -val a = [(8, [2, 1, 1])]: poly
3.364 -val b = [(18, [1, 2, 1])]: poly
3.365 - val ((a', b'), c) = gcd_poly a b
3.366 -*)
3.367 -(* "-------- example 187c": doesn't terminate...
3.368 -val a = [(9, [5, 2, 4])]: poly
3.369 -val b = [(15, [6, 3, 1])]: poly
3.370 - val ((a', b'), c) = gcd_poly a b
3.371 -*)
3.372 -
3.373 -"-------- rls norm_Rational downto fun gcd_poly ------------------------------";
3.374 -"-------- rls norm_Rational downto fun gcd_poly ------------------------------";
3.375 -"-------- rls norm_Rational downto fun gcd_poly ------------------------------";
3.376 -val t = TermC.str2term "(x \<up> 2 - 4)*(3 - y) / ((y \<up> 2 - 9)*(2+x))";
3.377 -Rewrite.trace_on := false (*true false*);
3.378 -(* trace stops with ...: (and then jEdit hangs)..
3.379 -rewrite_set_ thy false norm_Rational t;
3.380 -:
3.381 -### rls: cancel_p on: (-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /
3.382 -(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)
3.383 -*)
3.384 -val t = TermC.str2term (*copy from above: "::real" is not required due to " \<up> "*)
3.385 - ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
3.386 - "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)");
3.387 -(*cancel_p_ thy t;
3.388 -exception Div raised*)
3.389 -
3.390 -"~~~~~ fun cancel_p_, args:"; val (t) = (t);
3.391 -val opt = check_fraction t;
3.392 -val SOME (numerator, denominator) = opt
3.393 - val vs = TermC.vars_of t
3.394 - val baseT = type_of numerator
3.395 - val expT = HOLogic.realT;
3.396 -(*default_print_depth 3; 999*)
3.397 -val (SOME a, SOME b) = (poly_of_term vs numerator, poly_of_term vs denominator);
3.398 -(*default_print_depth 3; 999*)
3.399 -(* does not terminate instead of returning ?:
3.400 - val ((a', b'), c) = gcd_poly a b
3.401 -val a = [(~12, [0, 0]), (3, [2, 0]), (4, [0, 1]), (~1, [2, 1])]: poly
3.402 -val b = [(~18, [0, 0]), (~9, [1, 0]), (2, [0, 2]), (1, [1, 2])]: poly
3.403 -*)
3.404 -
3.405 -"-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
3.406 -"-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
3.407 -"-------- rls norm_Rational downto fun add_fraction_p_ -----------------------";
3.408 -val thy = @{theory Isac_Knowledge};
3.409 -"----- SK060904-2a non-termination of add_fraction_p_";
3.410 -val t = TermC.str2term (" (a + b * x) / (a + -1 * (b * x)) + " ^
3.411 - " (-1 * a + b * x) / (a + b * x) ");
3.412 -(* rewrite_set_ thy false norm_Rational t
3.413 -exception Div raised*)
3.414 -(* rewrite_set_ thy false add_fractions_p t;
3.415 -exception Div raised*)
3.416 -"~~~~~ fun rewrite_set_, args:"; val (thy, bool, rls, term) =
3.417 - (@{theory Isac_Knowledge}, false, add_fractions_p, t);
3.418 -"~~~~~ and rewrite__set_, args:"; val (thy, i, _, _, (rrls as Rrls _), t) =
3.419 - (thy, 1, bool, [], rls, term);
3.420 -(* app_rev thy (i+1) rrls t;
3.421 -exception Div raised*)
3.422 -"~~~~~ and app_rev, args:"; val (thy, i, rrls, t) = (thy, (i+1), rrls, t);
3.423 - fun chk_prepat thy erls [] t = true
3.424 - | chk_prepat thy erls prepat t =
3.425 - let
3.426 - fun chk (pres, pat) =
3.427 - (let
3.428 - val subst: Type.tyenv * Envir.tenv =
3.429 - Pattern.match thy (pat, t) (Vartab.empty, Vartab.empty)
3.430 - in
3.431 - snd (eval__true thy (i + 1) (map (Envir.subst_term subst) pres) [] erls)
3.432 - end) handle Pattern.MATCH => false
3.433 - fun scan_ f [] = false (*scan_ NEVER called by []*)
3.434 - | scan_ f (pp::pps) =
3.435 - if f pp then true else scan_ f pps;
3.436 - in scan_ chk prepat end;
3.437 - (* apply the normal_form of a rev-set *)
3.438 - fun app_rev' thy (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}) t =
3.439 - if chk_prepat thy erls prepat t
3.440 - then ((*tracing("### app_rev': t = "^UnparseC.term t);*) normal_form t)
3.441 - else NONE;
3.442 -(* val opt = app_rev' thy rrls t;
3.443 -exception Div raised*)
3.444 -(* val opt = app_rev' thy rrls t;
3.445 -exception Div raised*)
3.446 -"~~~~~ and app_rev', args:"; val (thy, (Rrls{erls,prepat,scr=Rfuns{normal_form,...},...}), t) =
3.447 - (thy, rrls, t);
3.448 -chk_prepat thy erls prepat t = true = true;
3.449 -(*normal_form t
3.450 -exception Div raised*)
3.451 -(* lookup Rational.thy, val add_fractions_p: normal_form = add_fraction_p_ thy*)
3.452 -(*add_fraction_p_ thy t
3.453 -exception Div raised*)
3.454 -"~~~~~ fun add_fraction_p_, args:"; val ((_: theory), t) = (thy, t);
3.455 -val SOME ((n1, d1), (n2, d2)) = check_frac_sum t;
3.456 -UnparseC.term n1; UnparseC.term d1; UnparseC.term n2; UnparseC.term d2;
3.457 - val vs = TermC.vars_of t;
3.458 -(*default_print_depth 3; 999*)
3.459 -val (SOME _, SOME a, SOME _, SOME b) =
3.460 - (poly_of_term vs n1, poly_of_term vs d1, poly_of_term vs n2, poly_of_term vs d2);
3.461 -(*default_print_depth 3; 999*)
3.462 -(*
3.463 -val a = [(1, [1, 0, 0]), (~1, [0, 1, 1])]: poly
3.464 -val b = [(1, [1, 0, 0]), (1, [0, 1, 1])]: poly
3.465 - val ((a', b'), c) = gcd_poly a b
3.466 -*)
3.467 -
3.468 -"----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
3.469 -"----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
3.470 -"----------- fun check_frac_sum with Free A and Const AA ---------------------------------------";
3.471 -val thy = @{theory Isac_Knowledge(*Partial_Fractions*)}
3.472 -val ctxt = Proof_Context.init_global thy;
3.473 -
3.474 -(*---------- (1) with Free A, B ----------------------------------------------------------------*)
3.475 -val t = (the o (parseNEW ctxt)) "3 = A / 2 + A / 4 + (B / 2 + -1 * B / (2::real))";
3.476 - (* required for applying thms in rewriting \<up> ^*)
3.477 -(* we get details from here..*)
3.478 -
3.479 -Rewrite.trace_on := false;
3.480 -val SOME (t', _) = Rewrite.rewrite_set_ thy true add_fractions_p t;
3.481 -Rewrite.trace_on := false;
3.482 -(* Rewrite.trace_on:
3.483 -add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
3.484 - (* |||||||||||||||||||||||||||||||||||| *)
3.485 -
3.486 -val t = (the o (parseNEW ctxt))(* ||||||||||||||||||||||||| GUESS 1 GUESS 1 GUESS 1 GUESS 1 *)
3.487 - "A / 2 + A / 4 + (B / 2 + -1 * B / (2::real))";
3.488 -"~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
3.489 -val NONE = (*case*) check_frac_sum t (*of*)
3.490 -
3.491 -(* Rewrite.trace_on:
3.492 -add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
3.493 - (* |||||||||||||||||||||||||||| *)
3.494 -val t = (the o (parseNEW ctxt))(* ||||||||||||||||||||||||| GUESS 2 GUESS 2 GUESS 2 GUESS 2 *)
3.495 - "A / 4 + (B / 2 + -1 * B / (2::real))";
3.496 -"~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
3.497 -val SOME ((n1, d1), (n2, d2)) = (*case*) check_frac_sum t (*of*);
3.498 -(*+*)if (UnparseC.term n1, UnparseC.term d1) = ("A" , "4") andalso
3.499 -(*+*) (UnparseC.term n2, UnparseC.term d2) = ("B / 2 + - 1 * B / 2", "1")
3.500 -(*+*)then () else error "check_frac_sum (A / 4 + (B / 2 + -1 * B / (2::real))) changed";
3.501 -
3.502 - val vs = TermC.vars_of t;
3.503 -val (SOME [(1, [1, 0])], SOME [(4, [0, 0])], NONE, SOME [(1, [0, 0])]) =
3.504 - (*case*) (poly_of_term vs n1, poly_of_term vs d1, poly_of_term vs n2, poly_of_term vs d2) (*of*);
3.505 -
3.506 -"~~~~~ fun poly_of_term , args:"; val (vs, t) = (vs, n1);
3.507 -val SOME [(1, [xxx, 0])] = SOME [monom_of_term vs (1, replicate (length vs) 0) t];
3.508 -(*+*)if xxx = 1 then () else error "monom_of_term changed"
3.509 -
3.510 -"~~~~~ fun monom_of_term , args:"; val (vs, (c, es), (Free (id, _))) =
3.511 - (vs, (1, replicate (length vs) 0), t);
3.512 -case vs of [Free ("A", _), Free ("B", _)] =>
3.513 - if c = 1 andalso id = "A"
3.514 - then () else error "monom_of_term Free changed 1"
3.515 -| _ => error "monom_of_term Free changed 2";
3.516 -
3.517 -(*---------- (2) with Const AA, BB --------------------------------------------------------------*)
3.518 -val t = (the o (parseNEW ctxt)) "3 = AA / 2 + AA / 4 + (BB / 2 + -1 * BB / 2)";
3.519 - (*AA :: real*)
3.520 -(* we get details from here..*)
3.521 -
3.522 -Rewrite.trace_on := false;
3.523 -val SOME (t', _) = Rewrite.rewrite_set_ thy true add_fractions_p t;
3.524 -Rewrite.trace_on := false;
3.525 -(* Rewrite.trace_on:
3.526 -add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
3.527 - (* |||||||||||||||||||||||||||||||||||| *)
3.528 -val t = (the o (parseNEW ctxt))(* ||||||||||||||||||||||||| *)
3.529 - "AA / 2 + AA / 4 + (BB / 2 + -1 * BB / 2)";
3.530 -"~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
3.531 -val NONE = (*case*) check_frac_sum t (*of*)
3.532 -
3.533 -(* Rewrite.trace_on:
3.534 -add_fractions_p on: 3 = A / 2 + A / 4 + (B / 2 + -1 * B / 2) --> 3 = A / 2 + A / 4 + 0 / 2 *)
3.535 - (* |||||||||||||||||||||||||||| *)
3.536 -val t = (the o (parseNEW ctxt))(* ||||||||||||||||||||||||| *)
3.537 - "AA / 4 + (BB / 2 + -1 * BB / 2)";
3.538 -"~~~~~ fun add_fraction_p_ , ad-hoc args:"; val (t) = (t);
3.539 -val SOME ((n1, d1), (n2, d2)) = (*case*) check_frac_sum t (*of*);
3.540 -(*+*)if (UnparseC.term n1, UnparseC.term d1) = ("AA" , "4") andalso
3.541 -(*+*) (UnparseC.term n2, UnparseC.term d2) = ("BB / 2 + - 1 * BB / 2", "1")
3.542 -(*+*)then () else error "check_frac_sum (AA / 4 + (BB / 2 + -1 * BB / 2)) changed";
3.543 -
3.544 - val vs = TermC.vars_of t;
3.545 -val (SOME [(1, [1, 0])], SOME [(4, [0, 0])], NONE, SOME [(1, [0, 0])]) =
3.546 - (*case*) (poly_of_term vs n1, poly_of_term vs d1, poly_of_term vs n2, poly_of_term vs d2) (*of*);
3.547 -
3.548 -"~~~~~ fun poly_of_term , args:"; val (vs, t) = (vs, n1);
3.549 -val SOME [(1, [xxx, 0])] = SOME [monom_of_term vs (1, replicate (length vs) 0) t];
3.550 -(*+*)if xxx = 1 then () else error "monom_of_term changed"
3.551 -
3.552 -"~~~~~ fun monom_of_term , args:"; val (vs, (c, es), (Const (id, _))) =
3.553 - (vs, (1, replicate (length vs) 0), t);
3.554 -case vs of [Const ("Partial_Fractions.AA", _), Const ("Partial_Fractions.BB", _)] =>
3.555 - if c = 1 andalso id = "Partial_Fractions.AA"
3.556 - then () else error "monom_of_term Const changed 1"
3.557 -| _ => error "monom_of_term Const changed 2";
3.558 -
3.559 -"----------- fun cancel_p with Const AA --------------------------------------------------------";
3.560 -"----------- fun cancel_p with Const AA --------------------------------------------------------";
3.561 -"----------- fun cancel_p with Const AA --------------------------------------------------------";
3.562 -val thy = @{theory Partial_Fractions};
3.563 -val ctxt = Proof_Context.init_global @{theory}
3.564 -val SOME t = TermC.parseNEW ctxt "2 * AA / 2"; (* Const ("Free ("AA", "real") *)
3.565 -
3.566 -val SOME (t', _) = rewrite_set_ thy true cancel_p t;
3.567 -case t' of
3.568 - Const ("Rings.divide_class.divide", _) $ Const ("Partial_Fractions.AA", _) $
3.569 - Const ("Groups.one_class.one", _) => ()
3.570 -| _ => error "WRONG rewrite_set_ cancel_p (2 * AA / 2) \<longrightarrow> AA changed";
3.571 -
3.572 -"~~~~~ fun cancel_p , args:"; val (t) = (t);
3.573 -val opt = check_fraction t
3.574 -val SOME (numerator, denominator) = (*case*) opt (*of*);
3.575 -
3.576 -if UnparseC.term numerator = "2 * AA" andalso UnparseC.term denominator = "2"
3.577 -then () else error "check_fraction (2 * AA / 2) changed";
3.578 - val vs = TermC.vars_of t;
3.579 -case vs of
3.580 - [Const ("Partial_Fractions.AA", _)] => ()
3.581 -| _ => error "rewrite_set_ cancel_p (2 * AA / 2) \<longrightarrow> AA/1 changed";
3.582 -
3.583 -
3.584 -"-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
3.585 -"-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
3.586 -"-------- rewrite_set_ cancel_p from: Mathematik 1 Schalk Reniets Verlag -----";
3.587 -val thy = @{theory "Rational"};
3.588 -"-------- WN";
3.589 -val t = TermC.str2term "(2 + -3 * x) / 9";
3.590 -if NONE = rewrite_set_ thy false cancel_p t then ()
3.591 -else error "rewrite_set_ cancel_p must return NONE, if the term cannot be cancelled";
3.592 -
3.593 -"-------- example 186a";
3.594 -val t = TermC.str2term "(14 * x * y) / (x * y)";
3.595 - is_expanded (TermC.str2term "14 * x * y");
3.596 - is_expanded (TermC.str2term "x * y");
3.597 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.598 -if (UnparseC.term t', UnparseC.terms asm) = ("14 / 1", "[]")
3.599 -then () else error "rational.sml cancel Schalk 186a";
3.600 -
3.601 -"-------- example 186b";
3.602 -val t = TermC.str2term "(60 * a * b) / ( 15 * a * b )";
3.603 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.604 -if (UnparseC.term t', UnparseC.terms asm) = ("4 / 1", "[]")
3.605 -then () else error "rational.sml cancel Schalk 186b";
3.606 -
3.607 -"-------- example 186c";
3.608 -val t = TermC.str2term "(144 * a \<up> 2 * b * c) / (12 * a * b * c)";
3.609 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.610 -if (UnparseC.term t', UnparseC.terms asm) = ("12 * a / 1", "[]")
3.611 -then () else error "rational.sml cancel Schalk 186c";
3.612 -
3.613 -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! exception Div raised !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3.614 - see --- fun rewrite_set_ downto fun gcd_poly ---
3.615 -"-------- example 187a";
3.616 -val t = TermC.str2term "(12 * x * y) / (8 * y \<up> 2 )";
3.617 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.618 -if (UnparseC.term t', UnparseC.terms asm) = ("3 * x / (2 * y)", "[\"4 * y ~= 0\"]")
3.619 -then () else error "rational.sml cancel Schalk 187a";
3.620 -*)
3.621 -
3.622 -(* doesn't terminate !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3.623 - see --- fun rewrite_set_ downto fun gcd_poly ---
3.624 -"-------- example 187b";
3.625 -val t = TermC.str2term "(8 * x \<up> 2 * y * z ) / (18 * x * y \<up> 2 * z )";
3.626 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.627 -if (UnparseC.term t', UnparseC.terms asm) = ("4 * x / (9 * y)", "[\"2 * (z * (y * x)) ~= 0\"]")
3.628 -then () else error "rational.sml cancel Schalk 187b";
3.629 -*)
3.630 -
3.631 -(* doesn't terminate !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3.632 - see --- fun rewrite_set_ downto fun gcd_poly ---
3.633 -"-------- example 187c";
3.634 -val t = TermC.str2term "(9 * x \<up> 5 * y \<up> 2 * z \<up> 4) / (15 * x \<up> 6 * y \<up> 3 * z )";
3.635 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.636 -if (UnparseC.term t', UnparseC.terms asm) =
3.637 - ("3 * z \<up> 3 / (5 * (y * x))", "[\"3 * (z * (y \<up> 2 * x \<up> 5)) ~= 0\"]")
3.638 -then () else error "rational.sml cancel Schalk 187c";
3.639 -*)
3.640 -
3.641 -"-------- example 188a";
3.642 -val t = TermC.str2term "(-8 + 8 * x) / (-9 + 9 * x)";
3.643 - is_expanded (TermC.str2term "8 * x + -8");
3.644 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.645 -if (UnparseC.term t', UnparseC.terms asm) = ("8 / 9", "[]")
3.646 -then () else error "rational.sml cancel Schalk 188a";
3.647 -
3.648 -val t = TermC.str2term "(8*((-1) + x))/(9*((-1) + x))";
3.649 -val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
3.650 -if (UnparseC.term t', UnparseC.terms asm) = ("8 / 9", "[]")
3.651 -then () else error "rational.sml cancel Schalk make_polynomial 1";
3.652 -
3.653 -"-------- example 188b";
3.654 -val t = TermC.str2term "(-15 + 5 * x) / (-18 + 6 * x)";
3.655 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.656 -if (UnparseC.term t', UnparseC.terms asm) = ("5 / 6", "[]")
3.657 -then () else error "rational.sml cancel Schalk 188b";
3.658 -
3.659 -"-------- example 188c";
3.660 -val t = TermC.str2term "(a + -1 * b) / (b + -1 * a)";
3.661 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.662 -if (UnparseC.term t', UnparseC.terms asm) = ("- 1 / 1", "[]")
3.663 -then () else error "rational.sml cancel Schalk 188c";
3.664 -
3.665 -is_expanded (TermC.str2term "a + -1 * b") = true;
3.666 -val t = TermC.str2term "((- 1)*(b + (-1) * a))/(1*(b + (- 1) * a))";
3.667 -val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
3.668 -if (UnparseC.term t', UnparseC.terms asm) = ("(a + - 1 * b) / (- 1 * a + b)", "[]")
3.669 -then () else error "rational.sml cancel Schalk make_polynomial 2";
3.670 -
3.671 -"-------- example 190a";
3.672 -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 )";
3.673 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.674 -if (UnparseC.term t', UnparseC.terms asm) =
3.675 - ("(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)", "[\"3 * a + 9 * a \<up> 2 \<noteq> 0\"]")
3.676 -then () else error "rational.sml cancel Schalk 190a";
3.677 -
3.678 -"-------- example 190c";
3.679 -val t = TermC.str2term "((1 + 9 * a \<up> 2)*(1 + 3 * a))/((3 * a + 9 * a \<up> 2)*(1 + 3 * a))";
3.680 -val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
3.681 -if (UnparseC.term t', UnparseC.terms asm) =
3.682 - ("(1 + 3 * a + 9 * a \<up> 2 + 27 * a \<up> 3) /\n(3 * a + 18 * a \<up> 2 + 27 * a \<up> 3)", "[]")
3.683 -then () else error "rational.sml make_polynomial Schalk 190c";
3.684 -
3.685 -"-------- example 191a";
3.686 -val t = TermC.str2term "( x \<up> 2 + -1 * y \<up> 2 ) / ( x + y )";
3.687 - is_expanded (TermC.str2term "x \<up> 2 + - 1 * y \<up> 2") = false; (*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
3.688 - is_expanded (TermC.str2term "x + y") = true;
3.689 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.690 -if (UnparseC.term t', UnparseC.terms asm) = ("(x + - 1 * y) / 1", "[]")
3.691 -then () else error "rational.sml make_polynomial Schalk 191a";
3.692 -
3.693 -"-------- example 191b";
3.694 -val t = TermC.str2term "((x + (- 1) * y)*(x + y))/((1)*(x + y))";
3.695 -val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
3.696 -if (UnparseC.term t', UnparseC.terms asm) = ("(x \<up> 2 + - 1 * y \<up> 2) / (x + y)", "[]")
3.697 -then () else error "rational.sml make_polynomial Schalk 191b";
3.698 -
3.699 -"-------- example 191c";
3.700 -val t = TermC.str2term "( 9 * x \<up> 2 + -30 * x + 25 ) / ( 9 * x \<up> 2 + -25 )";
3.701 - is_expanded (TermC.str2term "9 * x \<up> 2 + -30 * x + 25") = true;
3.702 - is_expanded (TermC.str2term "25 + -30*x + 9*x \<up> 2") = true;
3.703 - is_expanded (TermC.str2term "-25 + 9*x \<up> 2") = true;
3.704 -
3.705 -val t = TermC.str2term "(((-5) + 3 * x)*((-5) + 3 * x))/((5 + 3 * x)*((-5) + 3 * x))";
3.706 -val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
3.707 -if (UnparseC.term t', UnparseC.terms asm) = ("(25 + - 30 * x + 9 * x \<up> 2) / (- 25 + 9 * x \<up> 2)", "[]")
3.708 -then () else error "rational.sml make_polynomial Schalk 191c";
3.709 -
3.710 -"-------- example 192b";
3.711 -val t = TermC.str2term "( 7 * x \<up> 3 + - 1 * x \<up> 2 * y ) / ( 7 * x * y \<up> 2 + - 1 * y \<up> 3 )";
3.712 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.713 -if (UnparseC.term t', UnparseC.terms asm) = ("x \<up> 2 / y \<up> 2", "[\"y \<up> 2 \<noteq> 0\"]")
3.714 -then () else error "rational.sml cancel_p Schalk 192b";
3.715 -
3.716 -val t = TermC.str2term "((x \<up> 2)*(7 * x + (-1) * y))/((y \<up> 2)*(7 * x + (-1) * y))";
3.717 -val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
3.718 -if (UnparseC.term t', UnparseC.terms asm) =
3.719 - ("(7 * x \<up> 3 + - 1 * x \<up> 2 * y) /\n(7 * x * y \<up> 2 + - 1 * y \<up> 3)", "[]")
3.720 -then () else error "rational.sml make_polynomial Schalk 192b";
3.721 -
3.722 -val t = TermC.str2term "((x \<up> 2)*(7 * x + (-1) * y))/((y \<up> 2)*(7 * x + (-1) * y))";
3.723 -val SOME (t', asm) = rewrite_set_ thy false make_polynomial t;
3.724 -if (UnparseC.term t', UnparseC.terms asm) =
3.725 - ("(7 * x \<up> 3 + - 1 * x \<up> 2 * y) /\n(7 * x * y \<up> 2 + - 1 * y \<up> 3)", "[]")
3.726 -then () else error "rational.sml make_polynomial Schalk WN050929 not working";
3.727 -
3.728 -"-------- example 193a";
3.729 -val t = TermC.str2term "( x \<up> 2 + -6 * x + 9 ) / ( x \<up> 2 + -9 )";
3.730 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.731 -if (UnparseC.term t', UnparseC.terms asm) = ("(- 3 + x) / (3 + x)", "[\"3 + x \<noteq> 0\"]")
3.732 -then () else error "rational.sml cancel_p Schalk 193a";
3.733 -
3.734 -"-------- example 193b";
3.735 -val t = TermC.str2term "( x \<up> 2 + -8 * x + 16 ) / ( 2 * x \<up> 2 + -32 )";
3.736 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.737 -if (UnparseC.term t', UnparseC.terms asm) = ("(- 4 + x) / (8 + 2 * x)", "[\"8 + 2 * x \<noteq> 0\"]")
3.738 -then () else error "rational.sml cancel_p Schalk 193b";
3.739 -
3.740 -"-------- example 193c";
3.741 -val t = TermC.str2term "( 2 * x + -50 * x \<up> 3 ) / ( 25 * x \<up> 2 + -10 * x + 1 )";
3.742 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.743 -if (UnparseC.term t', UnparseC.terms asm) =
3.744 - ("(2 * x + 10 * x \<up> 2) / (1 + - 5 * x)", "[\"1 + - 5 * x \<noteq> 0\"]")
3.745 -then () else error "rational.sml cancel_p Schalk 193c";
3.746 -
3.747 -(*WN: improved with new numerals*)
3.748 -val t = TermC.str2term "(-25 + 9*x \<up> 2)/(5 + 3*x)";
3.749 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.750 -if (UnparseC.term t', UnparseC.terms asm) = ("(- 5 + 3 * x) / 1", "[]")
3.751 -then () else error "rational.sml cancel WN 1";
3.752 -
3.753 -"-------- example heuberger";
3.754 -val t = TermC.str2term ("(x \<up> 4 + x * y + x \<up> 3 * y + y \<up> 2) / " ^
3.755 - "(x + 5 * x \<up> 2 + y + 5 * x * y + x \<up> 2 * y \<up> 3 + x * y \<up> 4)");
3.756 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.757 -if (UnparseC.term t', UnparseC.terms asm) =
3.758 - ("(x \<up> 3 + y) / (1 + 5 * x + x * y \<up> 3)", "[\"1 + 5 * x + x * y \<up> 3 \<noteq> 0\"]")
3.759 -then () else error "rational.sml cancel_p heuberger";
3.760 -
3.761 -"-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
3.762 -"-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
3.763 -"-------- rewrite_set_ add_fractions_p from: Mathematik 1 Schalk -------------";
3.764 -(*deleted example 204 ... 236b at update Isabelle2012-->2013*)
3.765 -
3.766 -"-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
3.767 -"-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
3.768 -"-------- integration lev.1 -- lev.5: cancel_p_ & add_fractions_p_ -----------";
3.769 -val t = TermC.str2term ("123 = (a*x)/(b*x) + (c*x)/(d*x) + (e*x)/(f*x::real)");
3.770 -"-------- gcd_poly integration level 1: works on exact term";
3.771 -if NONE = cancel_p_ thy t then () else error "cancel_p_ works on exact fraction";
3.772 -if NONE = add_fraction_p_ thy t then () else error "add_fraction_p_ works on exact fraction";
3.773 -
3.774 -"-------- gcd_poly integration level 2: picks out ONE appropriate subterm";
3.775 -val SOME (t', asm) = rewrite_set_ thy false cancel_p t;
3.776 -if UnparseC.term t' = "123 = a * x / (b * x) + c * x / (d * x) + e / f"
3.777 -then () else error "level 2, rewrite_set_ cancel_p: changed";
3.778 -val SOME (t', asm) = rewrite_set_ thy false add_fractions_p t;
3.779 -if UnparseC.term t' = "123 = (b * c * x + a * d * x) / (b * d * x) + e * x / (f * x)"
3.780 -then () else error "level 2, rewrite_set_ add_fractions_p: changed";
3.781 -
3.782 -"-------- gcd_poly integration level 3: rewrites all appropriate subterms";
3.783 -val SOME (t', asm) = rewrite_set_ thy false cancel_p_rls t;
3.784 -if UnparseC.term t' = "123 = a / b + c / d + e / f"
3.785 -then () else error "level 3, rewrite_set_ cancel_p_rls: changed";
3.786 -val SOME (t', asm) = rewrite_set_ thy false add_fractions_p_rls t; (*CREATE add_fractions_p_rls*)
3.787 -if UnparseC.term t' = "123 = (b * d * e * x + b * c * f * x + a * d * f * x) / (b * d * f * x)"
3.788 -then () else error "level 3, rewrite_set_ add_fractions_p_rls: changed";
3.789 -
3.790 -"-------- gcd_poly integration level 4: iteration cancel_p -- add_fraction_p";
3.791 -(* simpler variant *)
3.792 -val testrls = Rule_Set.append_rules "testrls" Rule_Set.empty [Rls_ cancel_p, Rls_ add_fractions_p]
3.793 -val SOME (t', asm) = rewrite_set_ thy false testrls t;
3.794 -(*Rewrite.trace_on := false;
3.795 -# rls: testrls on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x)
3.796 -## rls: cancel_p on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x)
3.797 -## rls: add_fractions_p on: 123 = a * x / (b * x) + c * x / (d * x) + e / f
3.798 -## rls: cancel_p on: 123 = (b * c * x + a * d * x) / (b * d * x) + e / f
3.799 -## rls: add_fractions_p on: 123 = (b * c + a * d) / (b * d) + e / f
3.800 -## rls: cancel_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)
3.801 -## rls: add_fractions_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) *)
3.802 -if UnparseC.term t' = "123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)"
3.803 -then () else error "level 4, rewrite_set_ *_p: changed";
3.804 -
3.805 -(* complicated variant *)
3.806 -val testrls_rls = Rule_Set.append_rules "testrls_rls" Rule_Set.empty [Rls_ cancel_p_rls, Rls_ add_fractions_p_rls];
3.807 -val SOME (t', asm) = rewrite_set_ thy false testrls_rls t;
3.808 -(*# rls: testrls_rls on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x)
3.809 -## rls: cancel_p_rls on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x)
3.810 -### rls: cancel_p on: 123 = a * x / (b * x) + c * x / (d * x) + e * x / (f * x)
3.811 -### rls: cancel_p on: 123 = a * x / (b * x) + c * x / (d * x) + e / f
3.812 -### rls: cancel_p on: 123 = a * x / (b * x) + c / d + e / f
3.813 -### rls: cancel_p on: 123 = a / b + c / d + e / f
3.814 -## rls: add_fractions_p_rls on: 123 = a / b + c / d + e / f
3.815 -### rls: add_fractions_p on: 123 = a / b + c / d + e / f
3.816 -### rls: add_fractions_p on: 123 = (b * c + a * d) / (b * d) + e / f
3.817 -### rls: add_fractions_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)
3.818 -## rls: cancel_p_rls on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)
3.819 -### rls: cancel_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)
3.820 -## rls: add_fractions_p_rls on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)
3.821 -### rls: add_fractions_p on: 123 = (b * d * e + b * c * f + a * d * f) / (b * d * f) *)
3.822 -if UnparseC.term t' = "123 = (b * d * e + b * c * f + a * d * f) / (b * d * f)"
3.823 -then () else error "level 4, rewrite_set_ *_p_rls: changed"
3.824 -
3.825 -"-------- gcd_poly integration level 5: cancel_p & add_fraction_p within norm_Rational";
3.826 -val SOME (t', asm) = rewrite_set_ thy false norm_Rational t;
3.827 -if UnparseC.term t' = "123 = (a * d * f + b * c * f + b * d * e) / (b * d * f)"
3.828 -then () else error "level 5, rewrite_set_ norm_Rational: changed"
3.829 -
3.830 -"-------- reverse rewrite ----------------------------------------------------";
3.831 -"-------- reverse rewrite ----------------------------------------------------";
3.832 -"-------- reverse rewrite ----------------------------------------------------";
3.833 -(** the term for which reverse rewriting is demonstrated **)
3.834 -val t = TermC.str2term "(9 + -1 * x \<up> 2) / (9 + 6 * x + x \<up> 2)";
3.835 -val Rrls {scr = Rfuns {init_state = ini, locate_rule = loc,
3.836 - next_rule = nex, normal_form = nor, ...},...} = cancel_p;
3.837 -
3.838 -(** normal_form produces the result in ONE step **)
3.839 - val SOME (t', _) = nor t;
3.840 -if UnparseC.term t' = "(3 + - 1 * x) / (3 + x)" then ()
3.841 -else error "rational.sml normal_form (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
3.842 -
3.843 -(** initialize the interpreter state used by the 'me' **)
3.844 - val (t, _, revsets, _) = ini t;
3.845 -
3.846 -if length (hd revsets) = 11 then () else error "length of revset changed";
3.847 -(*//----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)
3.848 -if (revsets |> nth 1 |> nth 1 |> id_of_thm) =
3.849 - (@{thm realpow_twoI} |> Thm.get_name_hint |> ThmC.cut_id)
3.850 -then () else error "first element of revset changed";
3.851 -if
3.852 -(revsets |> nth 1 |> nth 1 |> Rule.to_string) = "Thm (\"realpow_twoI\",?r1 \<up> 2 = ?r1 * ?r1)" andalso
3.853 -(revsets |> nth 1 |> nth 2 |> Rule.to_string) = "Thm (\"#: 9 = 3 \<up> 2\",9 = 3 \<up> 2)" andalso
3.854 -(revsets |> nth 1 |> nth 3 |> Rule.to_string) = "Thm (\"#: 6 * x = 2 * (3 * x)\",6 * x = 2 * (3 * x))"
3.855 -andalso
3.856 -(revsets |> nth 1 |> nth 4 |> Rule.to_string) = "Thm (\"#: -3 * x = -1 * (3 * x)\",-3 * x = -1 * (3 * x))"
3.857 -andalso
3.858 -(revsets |> nth 1 |> nth 5 |> Rule.to_string) = "Thm (\"#: 9 = 3 * 3\",9 = 3 * 3)" andalso
3.859 -(revsets |> nth 1 |> nth 6 |> Rule.to_string) = "Rls_ (\"sym_order_mult_rls_\")" andalso
3.860 -(revsets |> nth 1 |> nth 7 |> Rule.to_string) =
3.861 - "Thm (\"sym_mult.assoc\",?a * (?b * ?c) = ?a * ?b * ?c)"
3.862 -then () else error "first 7 elements in revset changed"
3.863 - \\----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)*)
3.864 -
3.865 -(** find the rule 'r' to apply to term 't' **)
3.866 -(*/------- WN1309: since cancel_ (accepted "-" between monomials) has been replaced by cancel_p_
3.867 - for Isabelle2013, we don't get a working revset, but non-termination:
3.868 -
3.869 - val SOME (r as (Thm (str, thm))) = nex revsets t;
3.870 - :
3.871 -((3 * 3 + -1 * x * x) / (3 * 3 + 2 * 3 * x + x * x),
3.872 - Rls_ ("sym_order_mult_rls_"), ((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * (3 * x) + x * x), []))", "
3.873 -((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * (3 * x) + x * x),
3.874 - Thm ("sym_mult.assoc", ""), ((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * 3 * x + x * x), []))", "
3.875 -((3 * 3 + -1 * (x * x)) / (3 * 3 + 2 * 3 * x + x * x),
3.876 - Thm ("sym_mult.assoc", ""), ((3 * 3 + -1 * x * x) / (3 * 3 + 2 * 3 * x + x * x), []))", "
3.877 -((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), []))", "
3.878 - :
3.879 -### Isabelle2002:
3.880 - Thm ("sym_#mult_2_3", "6 = 2 * 3")
3.881 -### Isabelle2009-2 for cancel_ (not cancel_p_):
3.882 -if str = "sym_#power_Float ((3,0), (0,0)) __ ((2,0), (0,0))"
3.883 - andalso ThmC.string_of_thm thm =
3.884 - (string_of_thm (Thm.make_thm @{theory "Isac_Knowledge"}
3.885 - (Trueprop $ (Thm.term_of o the o (TermC.parse thy)) "9 = 3 \<up> 2"))) then ()
3.886 -else error "rational.sml next_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
3.887 -\---------------------------------------------------------------------------------------/*)
3.888 -
3.889 -(** check, if the rule 'r' applied by the user to 't' belongs to the ruleset;
3.890 - if the rule is OK, the term resulting from applying the rule is returned,too;
3.891 - there might be several rule applications inbetween,
3.892 - which are listed after the head in reverse order **)
3.893 -(*/-------------------------------------------- Isabelle2013: this gives "error id_of_thm";
3.894 - we don't repair this, because interaction within "reverse rewriting" never worked properly:
3.895 -
3.896 - val (r, (t, asm))::_ = loc revsets t r;
3.897 -if UnparseC.term t = "(9 - x \<up> 2) / (3 \<up> 2 + 6 * x + x \<up> 2)" andalso asm = []
3.898 -then () else error "rational.sml locate_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
3.899 -
3.900 -(* find the next rule to apply *)
3.901 - val SOME (r as (Thm (str, thm))) = nex revsets t;
3.902 -if str = "sym_#power_Float ((3,0), (0,0)) __ ((2,0), (0,0))" andalso
3.903 - ThmC.string_of_thm thm = (string_of_thm (ThmC_Def.make_thm @{theory "Isac_Knowledge"}
3.904 - (Trueprop $ (Thm.term_of o the o (TermC.parse thy)) "9 = 3 \<up> 2"))) then ()
3.905 -else error "rational.sml next_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2)";
3.906 -
3.907 -(*check the next rule*)
3.908 - val (r, (t, asm)) :: _ = loc revsets t r;
3.909 -if UnparseC.term t = "(3 \<up> 2 - x \<up> 2) / (3 \<up> 2 + 6 * x + x \<up> 2)" then ()
3.910 -else error "rational.sml locate_rule (9 - x \<up> 2) / (9 - 6 * x + x \<up> 2) II";
3.911 -
3.912 -(*find and check the next rules, rewrite*)
3.913 - val SOME r = nex revsets t;
3.914 - val (r,(t,asm))::_ = loc revsets t r;
3.915 -if UnparseC.term t = "(3 \<up> 2 - x \<up> 2) / (3 \<up> 2 + 2 * 3 * x + x \<up> 2)" then ()
3.916 -else error "rational.sml locate_rule II";
3.917 -
3.918 - val SOME r = nex revsets t;
3.919 - val (r,(t,asm))::_ = loc revsets t r;
3.920 -if UnparseC.term t = "(3 - x) * (3 + x) / (3 \<up> 2 + 2 * 3 * x + x \<up> 2)" then ()
3.921 -else error "rational.sml next_rule II";
3.922 -
3.923 - val SOME r = nex revsets t;
3.924 - val (r,(t,asm))::_ = loc revsets t r;
3.925 -if UnparseC.term t = "(3 - x) * (3 + x) / ((3 + x) * (3 + x))" then ()
3.926 -else error "rational.sml next_rule III";
3.927 -
3.928 - val SOME r = nex revsets t;
3.929 - val (r, (t, asm)) :: _ = loc revsets t r;
3.930 - val ss = UnparseC.term t;
3.931 -if ss = "(3 - x) / (3 + x)" andalso UnparseC.terms asm = "[\"3 + x ~= 0\"]" then ()
3.932 -else error "rational.sml: new behav. in rev-set cancel";
3.933 -\--------------------------------------------------------------------------------------/*)
3.934 -
3.935 -"-------- 'reverse-ruleset' cancel_p -----------------------------------------";
3.936 -"-------- 'reverse-ruleset' cancel_p -----------------------------------------";
3.937 -"-------- 'reverse-ruleset' cancel_p -----------------------------------------";
3.938 -(*WN130909: the example below shows, why "reverse rewriting" only worked for
3.939 - special cases.*)
3.940 -
3.941 -(*the term for which reverse rewriting is demonstrated*)
3.942 -val t = TermC.str2term "(9 + (-1)*x \<up> 2) / (9 + ((-6)*x + x \<up> 2))";
3.943 -val Rrls {scr=Rfuns {init_state=ini,locate_rule=loc,
3.944 - next_rule=nex,normal_form=nor,...},...} = cancel_p;
3.945 -
3.946 -(*normal_form produces the result in ONE step*)
3.947 -val SOME (t', _) = nor t;
3.948 -if UnparseC.term t' = "(3 + x) / (3 + - 1 * x)"
3.949 -then () else error "cancel_p normal_form CHANGED";;
3.950 -
3.951 -(*initialize the interpreter state used by the 'me'*)
3.952 -val SOME (t', asm) = cancel_p_ thy t;
3.953 -if (UnparseC.term t', UnparseC.terms asm) = ("(3 + x) / (3 + - 1 * x)", "[\"3 + - 1 * x \<noteq> 0\"]")
3.954 -then () else error "cancel_p CHANGED";;
3.955 -
3.956 -val (t,_,revsets,_) = ini t;
3.957 -
3.958 -(* WN.10.10.02: dieser Fall terminiert nicht
3.959 - (make_polynomial enth"alt zu viele rules)
3.960 -WN060823 'init_state' requires rewriting on specified location in the term
3.961 -default_print_depth 99; Rfuns; default_print_depth 3;
3.962 -WN060831 cycling "sym_order_mult_rls_" "sym_mult.assoc"
3.963 - as was with make_polynomial before ?!?* )
3.964 -
3.965 -val SOME r = nex revsets t;
3.966 -eq_Thm (r, Thm ("sym_#power_Float ((3,0), (0,0)) __ ((2,0), (0,0))",
3.967 - mk_thm thy "9 = 3 \<up> 2"));
3.968 -( *WN060831 *** id_of_thm
3.969 - Exception- ERROR raised ...
3.970 -val (r,(t,asm))::_ = loc revsets t r;
3.971 -UnparseC.term t;
3.972 -
3.973 - val SOME r = nex revsets t;
3.974 - val (r,(t,asm))::_ = loc revsets t r;
3.975 - UnparseC.term t;
3.976 -*)
3.977 -
3.978 -"-------- examples: rls norm_Rational ----------------------------------------";
3.979 -"-------- examples: rls norm_Rational ----------------------------------------";
3.980 -"-------- examples: rls norm_Rational ----------------------------------------";
3.981 -val t = TermC.str2term "(3*x+5)/18 - x/2 - -(3*x - 2)/9 = 0";
3.982 -val SOME (t', _) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
3.983 -if UnparseC.term t' = "1 / 18 = 0" then () else error "rational.sml 1";
3.984 -
3.985 -val t = TermC.str2term "(17*x - 51)/9 - (-(13*x - 3)/6) + 11 - (9*x - 7)/4 = 0";
3.986 -val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
3.987 -if UnparseC.term t' = "(237 + 65 * x) / 36 = 0" then ()
3.988 -else error "rational.sml 2";
3.989 -
3.990 -val t = TermC.str2term "(1/2 + (5*x)/2) \<up> 2 - ((13*x)/2 - 5/2) \<up> 2 - (6*x) \<up> 2 + 29";
3.991 -val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
3.992 -if UnparseC.term t' = "23 + 35 * x + - 72 * x \<up> 2" then ()
3.993 -else error "rational.sml 3";
3.994 -
3.995 -(*Rewrite.trace_on:=true;*)
3.996 -val t = TermC.str2term "Not (6*x is_atom)";
3.997 -val SOME (t',_) = rewrite_set_ thy false powers_erls t; UnparseC.term t';
3.998 -"HOL.True";
3.999 -val t = TermC.str2term "1 < 2";
3.1000 -val SOME (t',_) = rewrite_set_ thy false powers_erls t; UnparseC.term t';
3.1001 -"HOL.True";
3.1002 -
3.1003 -val t = TermC.str2term "(6*x) \<up> 2";
3.1004 -val SOME (t',_) = rewrite_ thy dummy_ord powers_erls false
3.1005 - (ThmC.numerals_to_Free @{thm realpow_def_atom}) t;
3.1006 -if UnparseC.term t' = "6 * x * (6 * x) \<up> (2 + - 1)" then ()
3.1007 -else error "rational.sml powers_erls (6*x) \<up> 2";
3.1008 -
3.1009 -val t = TermC.str2term "-1 * (-2 * (5 / 2 * (13 * x / 2)))";
3.1010 -val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
3.1011 -if UnparseC.term t' = "65 * x / 2" then () else error "rational.sml 4";
3.1012 -
3.1013 -val t = TermC.str2term "1 - ((13*x)/2 - 5/2) \<up> 2";
3.1014 -val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
3.1015 -if UnparseC.term t' = "(- 21 + 130 * x + - 169 * x \<up> 2) / 4" then ()
3.1016 -else error "rational.sml 5";
3.1017 -
3.1018 -(*SRAM Schalk I, p.92 Nr. 609a*)
3.1019 -val t = TermC.str2term "2*(3 - x/5)/3 - 4*(1 - x/3) - x/3 - 2*(x/2 - 1/4)/27 +5/54";
3.1020 -val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
3.1021 -if UnparseC.term t' = "(- 255 + 112 * x) / 135" then ()
3.1022 -else error "rational.sml 6";
3.1023 -
3.1024 -(*SRAM Schalk I, p.92 Nr. 610c*)
3.1025 -val t = TermC.str2term "((x- 1)/(x+1) + 1) / ((x- 1)/(x+1) - (x+1)/(x- 1)) - 2";
3.1026 -val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
3.1027 -if UnparseC.term t' = "(3 + x) / - 2" then () else error "rational.sml 7";
3.1028 -
3.1029 -(*SRAM Schalk I, p.92 Nr. 476a*)
3.1030 -val t = TermC.str2term "(x \<up> 2/(1 - x \<up> 2) + 1)/(x/(1 - x) + 1) * (1 + x)";
3.1031 -(*. a/b : c/d translated to a/b * d/c .*)
3.1032 -val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
3.1033 -if UnparseC.term t' = "1" then () else error "rational.sml 8";
3.1034 -
3.1035 -(*Schalk I, p.92 Nr. 472a*)
3.1036 -val t = TermC.str2term "((8*x \<up> 2 - 32*y \<up> 2)/(2*x + 4*y))/((4*x - 8*y)/(x + y))";
3.1037 -val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
3.1038 -if UnparseC.term t' = "x + y" then () else error "rational.sml p.92 Nr. 472a";
3.1039 -
3.1040 -(*Schalk I, p.70 Nr. 480b: SEE rational.sml --- nonterminating rls norm_Rational ---*)
3.1041 -
3.1042 -(*WN130910 add_fractions_p exception Div raised + history:
3.1043 -### WN.2.6.03 from rlang.sml 56a
3.1044 -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)";
3.1045 -val NONE = rewrite_set_ thy false add_fractions_p t;
3.1046 -
3.1047 -THE ERROR ALREADY OCCURS IN THIS PART:
3.1048 -val t = TermC.str2term "(a + b * x) / (a + -1 * (b * x)) + (-1 * a + b * x) / (a + b * x)";
3.1049 -val NONE = add_fraction_p_ thy t;
3.1050 -
3.1051 -SEE Test_Some.thy: section {* add_fractions_p downto exception Div raised ===
3.1052 -*)
3.1053 -
3.1054 -"-------- rational numerals --------------------------------------------------";
3.1055 -"-------- rational numerals --------------------------------------------------";
3.1056 -"-------- rational numerals --------------------------------------------------";
3.1057 -(*SRA Schalk I, p.40 Nr. 164b *)
3.1058 -val t = TermC.str2term "(47/6 - 76/9 + 13/4)/(35/12)";
3.1059 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1060 -if UnparseC.term t = "19 / 21" then ()
3.1061 -else error "rational.sml: diff.behav. in norm_Rational_mg 1";
3.1062 -
3.1063 -(*SRA Schalk I, p.40 Nr. 166a *)
3.1064 -val t = TermC.str2term "((5/4)/(4+22/7) + 37/20)*(110/3 - 110/9 * 23/11)";
3.1065 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1066 -if UnparseC.term t = "45 / 2" then ()
3.1067 -else error "rational.sml: diff.behav. in norm_Rational_mg 2";
3.1068 -
3.1069 -"-------- examples cancellation from: Mathematik 1 Schalk --------------------";
3.1070 -"-------- examples cancellation from: Mathematik 1 Schalk --------------------";
3.1071 -"-------- examples cancellation from: Mathematik 1 Schalk --------------------";
3.1072 -(* e190c Stefan K.*)
3.1073 -val t = TermC.str2term "((1 + 9*a \<up> 2) * (1 + 3*a)) / ((3*a + 9*a \<up> 2) * (1 + 3*a))";
3.1074 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1075 -if UnparseC.term t = "(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)"
3.1076 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 3";
3.1077 -
3.1078 -(* e192b Stefan K.*)
3.1079 -val t = TermC.str2term "(x \<up> 2 * (7*x + (-1)*y)) / (y \<up> 2 * (7*x + (-1)*y))";
3.1080 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1081 -if UnparseC.term t = "x \<up> 2 / y \<up> 2"
3.1082 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 4";
3.1083 -
3.1084 -(*SRC Schalk I, p.66 Nr. 379c *)
3.1085 -val t = TermC.str2term "(a - b)/(b - a)";
3.1086 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1087 -if UnparseC.term t = "- 1"
3.1088 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 5";
3.1089 -
3.1090 -(*SRC Schalk I, p.66 Nr. 380b *)
3.1091 -val t = TermC.str2term "15*(3*x + 3) * (4*x + 9) / (12*(2*x + 7) * (5*x + 5))";
3.1092 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1093 -if UnparseC.term t = "(27 + 12 * x) / (28 + 8 * x)"
3.1094 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 6";
3.1095 -
3.1096 -(*Schalk I, p.60 Nr. 215c *)
3.1097 -val t = TermC.str2term "(a + b) \<up> 4 * (x - y) / ((x - y) \<up> 3 * (a + b) \<up> 2)";
3.1098 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1099 -if UnparseC.term t = "(a \<up> 2 + 2 * a * b + b \<up> 2) / (x \<up> 2 + - 2 * x * y + y \<up> 2)"
3.1100 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 7";
3.1101 -
3.1102 -(*SRC Schalk I, p.66 Nr. 381b *)
3.1103 -val t = TermC.str2term
3.1104 -"(4*x \<up> 2 - 20*x + 25)/(2*x - 5) \<up> 3";
3.1105 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1106 -if UnparseC.term t = "1 / (- 5 + 2 * x)"
3.1107 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 9";
3.1108 -
3.1109 -(* e190c Stefan K.*)
3.1110 -val t = TermC.str2term "((1 + 9*a \<up> 2) * (1 + 3*a)) / ((3*a + 9*a \<up> 2) * (1 + 3 * a))";
3.1111 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1112 -if UnparseC.term t = "(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)"
3.1113 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 3";
3.1114 -
3.1115 -(* e192b Stefan K.*)
3.1116 -val t = TermC.str2term "(x \<up> 2 * (7*x + (-1)*y)) / (y \<up> 2 * (7*x + (-1)*y))";
3.1117 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1118 -if UnparseC.term t = "x \<up> 2 / y \<up> 2"
3.1119 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 4";
3.1120 -
3.1121 -(*SRC Schalk I, p.66 Nr. 379c *)
3.1122 -val t = TermC.str2term "(a - b) / (b - a)";
3.1123 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1124 -if UnparseC.term t = "- 1"
3.1125 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 5";
3.1126 -
3.1127 -(*SRC Schalk I, p.66 Nr. 380b *)
3.1128 -val t = TermC.str2term "15*(3*x + 3) * (4*x + 9) / (12*(2*x + 7) * (5*x + 5))";
3.1129 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1130 -if UnparseC.term t = "(27 + 12 * x) / (28 + 8 * x)"
3.1131 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 6";
3.1132 -
3.1133 -(*Schalk I, p.60 Nr. 215c *)
3.1134 -val t = TermC.str2term "(a + b) \<up> 4 * (x - y) / ((x - y) \<up> 3 * (a + b) \<up> 2)";
3.1135 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1136 -if UnparseC.term t = "(a \<up> 2 + 2 * a * b + b \<up> 2) / (x \<up> 2 + - 2 * x * y + y \<up> 2)"
3.1137 -then () else error "Schalk I, p.60 Nr. 215c: with Isabelle2002 cancellation incomplete, changed";
3.1138 -
3.1139 -(* extreme example from somewhere *)
3.1140 -val t = TermC.str2term
3.1141 - ("(a \<up> 4 * x + -1*a \<up> 4 * y + 4*a \<up> 3 * b * x + -4*a \<up> 3 * b * y + " ^
3.1142 - "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 + " ^
3.1143 - "b \<up> 4 * x + -1*b \<up> 4 * y) " ^
3.1144 - " / (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 + " ^
3.1145 - "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 + " ^
3.1146 - "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)")
3.1147 -val SOME (t, _) = rewrite_set_ thy false cancel_p t;
3.1148 -if UnparseC.term t = "(a \<up> 2 + 2 * a * b + b \<up> 2) / (x \<up> 2 + - 2 * x * y + y \<up> 2)"
3.1149 -then () else error "with Isabelle2002: NONE -- now SOME changed";
3.1150 -
3.1151 -(*Schalk I, p.66 Nr. 381a *)
3.1152 -(* ATTENTION: here the rls is very slow. In Isabelle2002 this required 2 min *)
3.1153 -val t = TermC.str2term "18*(a + b) \<up> 3 * (a - b) \<up> 2 / (72*(a - b) \<up> 3 * (a + b) \<up> 2)";
3.1154 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1155 -if UnparseC.term t = "(a + b) / (4 * a + - 4 * b)"
3.1156 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 8";
3.1157 -
3.1158 -(*SRC Schalk I, p.66 Nr. 381b *)
3.1159 -val t = TermC.str2term "(4*x \<up> 2 - 20*x + 25) / (2*x - 5) \<up> 3";
3.1160 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1161 -if UnparseC.term t = "1 / (- 5 + 2 * x)"
3.1162 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 9";
3.1163 -
3.1164 -(*SRC Schalk I, p.66 Nr. 381c *)
3.1165 -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)";
3.1166 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1167 -if UnparseC.term t = "(1 + 9 * a \<up> 2) / (3 * a + 9 * a \<up> 2)"
3.1168 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 10";
3.1169 -
3.1170 -(*SRC Schalk I, p.66 Nr. 383a *)
3.1171 -val t = TermC.str2term "(5*a \<up> 2 - 5*a*b) / (a - b) \<up> 2";
3.1172 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1173 -if UnparseC.term t = "- 5 * a / (- 1 * a + b)"
3.1174 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 11";
3.1175 -
3.1176 -"----- NOT TERMINATING ?: worked before 0707xx";
3.1177 -val t = TermC.str2term "(a \<up> 2 - 1)*(b + 1) / ((b \<up> 2 - 1)*(a+1))";
3.1178 -(* WN130911 "exception Div raised" by
3.1179 - cancel_p_ thy (TermC.str2term ("(-1 + -1 * b + a \<up> 2 + a \<up> 2 * b) /" ^
3.1180 - "(-1 + -1 * a + b \<up> 2 + a * b \<up> 2)"))
3.1181 -
3.1182 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1183 -if UnparseC.term t = "(1 + -1 * a) / (1 + -1 * b)" then ()
3.1184 -else error "rational.sml MG tests 3e";
3.1185 -*)
3.1186 -
3.1187 -"-------- examples common denominator from: Mathematik 1 Schalk --------------";
3.1188 -"-------- examples common denominator from: Mathematik 1 Schalk --------------";
3.1189 -"-------- examples common denominator from: Mathematik 1 Schalk --------------";
3.1190 -(*SRA Schalk I, p.67 Nr. 403a *)
3.1191 -val t = TermC.str2term "4/x - 3/y - 1";
3.1192 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1193 -if UnparseC.term t = "(- 3 * x + 4 * y + - 1 * x * y) / (x * y)"
3.1194 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 12";
3.1195 -
3.1196 -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)";
3.1197 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1198 -if UnparseC.term t = "4 / c"
3.1199 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 13";
3.1200 -
3.1201 -(*SRA Schalk I, p.67 Nr. 410b *)
3.1202 -val t = TermC.str2term "1/(x+1) + 1/(x+2) - 2/(x+3)";
3.1203 -(* WN130911 non-termination due to non-termination of
3.1204 - cancel_p_ thy (TermC.str2term "(5 + 3 * x) / (6 + 11 * x + 6 * x \<up> 2 + x \<up> 3)")
3.1205 -
3.1206 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1207 -if UnparseC.term t = "(5 + 3 * x) / (6 + 11 * x + 6 * x \<up> 2 + x \<up> 3)"
3.1208 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 14";
3.1209 -*)
3.1210 -
3.1211 -(*SRA Schalk I, p.67 Nr. 413b *)
3.1212 -val t = TermC.str2term "(1 + x)/(1 - x) - (1 - x)/(1 + x) + 2*x/(1 - x \<up> 2)";
3.1213 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1214 -if UnparseC.term t = "6 * x / (1 + - 1 * x \<up> 2)"
3.1215 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 15";
3.1216 -
3.1217 -(*SRA Schalk I, p.68 Nr. 414a *)
3.1218 -val t = TermC.str2term "(x + 2)/(x - 1) + (x - 3)/(x - 2) - (x + 1)/((x - 1)*(x - 2))";
3.1219 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1220 -if UnparseC.term t ="(- 2 + - 5 * x + 2 * x \<up> 2) / (2 + - 3 * x + x \<up> 2)"
3.1221 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 16";
3.1222 -
3.1223 -(*SRA Schalk I, p.68 Nr. 428b *)
3.1224 -val t = TermC.str2term
3.1225 - "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";
3.1226 -(* WN130911 non-termination due to non-termination of
3.1227 - cancel_p_ thy (TermC.str2term "(4 + -4 * b \<up> 2) / (a \<up> 4 + -2 * (a \<up> 2 * b \<up> 2) + b \<up> 4)")
3.1228 -
3.1229 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1230 -if UnparseC.term t = "4 / (a \<up> 4 + -2 * a \<up> 2 * b \<up> 2 + b \<up> 4)"
3.1231 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 18";
3.1232 -*)
3.1233 -
3.1234 -(*SRA Schalk I, p.68 Nr. 430b *)
3.1235 -val t = TermC.str2term
3.1236 - "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";
3.1237 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1238 -if UnparseC.term t = "a + 3 * b"
3.1239 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 19";
3.1240 -
3.1241 -(*SRA Schalk I, p.68 Nr. 432 *)
3.1242 -val t = TermC.str2term
3.1243 - ("(a \<up> 2 + a*b) / (a \<up> 2 - b \<up> 2) - (b \<up> 2 - a*b) / (b \<up> 2 - a \<up> 2) + " ^
3.1244 - "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) - " ^
3.1245 - "2*b \<up> 2 / (a \<up> 2 - b \<up> 2)");
3.1246 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1247 -if UnparseC.term t = (*"0" ..isabisac15 | Isabelle2017..*) "0 / (a \<up> 2 + - 1 * b \<up> 2)"
3.1248 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 20";
3.1249 -
3.1250 -(* some example *)
3.1251 -val t = TermC.str2term "3*a / (a*b) + x/y";
3.1252 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1253 -if UnparseC.term t = "(3 * y + b * x) / (b * y)"
3.1254 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 21";
3.1255 -
3.1256 -
3.1257 -"-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
3.1258 -"-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
3.1259 -"-------- examples multiply and cancel from: Mathematik 1 Schalk -------------";
3.1260 -(*------- SRM Schalk I, p.68 Nr. 436a *)
3.1261 -val t = TermC.str2term "3*(x+y) / (15*(x - y)) * 25*(x - y) \<up> 2 / (18*(x + y) \<up> 2)";
3.1262 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1263 -if UnparseC.term t = "(- 5 * x + 5 * y) / (- 18 * x + - 18 * y)"
3.1264 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 22";
3.1265 -
3.1266 -(*------- SRM.test Schalk I, p.68 Nr. 436b *)
3.1267 -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";
3.1268 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1269 -if UnparseC.term t = "5 * a / (a + - 1 * b)"
3.1270 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 23";
3.1271 -
3.1272 -(*------- Schalk I, p.68 Nr. 437a *)
3.1273 -val t = TermC.str2term "(3*a - 4*b) / (4*c+3*e) * (3*a+4*b)/(9*a \<up> 2 - 16*b \<up> 2)";
3.1274 -(* raises an exception for unclear reasons:
3.1275 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1276 -:
3.1277 -### rls: cancel_p on: (9 * a \<up> 2 + -16 * b \<up> 2) / (4 * c + 3 * e) /
3.1278 -(9 * a \<up> 2 + -16 * b \<up> 2)
3.1279 -exception Div raised
3.1280 -
3.1281 -BUT
3.1282 -val t = TermC.str2term
3.1283 - ("(9 * a \<up> 2 + -16 * b \<up> 2) / (4 * c + 3 * e) /" ^
3.1284 - "(9 * a \<up> 2 + -16 * b \<up> 2)");
3.1285 -NONE = cancel_p_ thy t;
3.1286 -
3.1287 -if UnparseC.term t = "1 / (4 * c + 3 * e)" then ()
3.1288 -else error "rational.sml: diff.behav. in norm_Rational_mg 24";
3.1289 -*)
3.1290 -
3.1291 -"----- S.K. corrected non-termination 060904";
3.1292 -val t = TermC.str2term "(3*a - 4*b) * (3*a+4*b)/((4*c+3*e)*(9*a \<up> 2 - 16*b \<up> 2))";
3.1293 -val SOME (t, _) = rewrite_set_ thy false make_polynomial t;
3.1294 -if UnparseC.term t =
3.1295 - "(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)"
3.1296 -then () else error "rational.sml: S.K.8..corrected 060904-6";
3.1297 -
3.1298 -"----- S.K. corrected non-termination of cancel_p_";
3.1299 -val t'' = TermC.str2term ("(9 * a \<up> 2 + -16 * b \<up> 2) /" ^
3.1300 - "(36 * a \<up> 2 * c + (27 * a \<up> 2 * e + (-64 * b \<up> 2 * c + -48 * b \<up> 2 * e)))");
3.1301 -(* /--- DOES NOT TERMINATE AT TRANSITION isabisac15 --> Isabelle2017 --------------------------\
3.1302 -val SOME (t',_) = rewrite_set_ thy false cancel_p t'';
3.1303 -if UnparseC.term t' = "1 / (4 * c + 3 * e)"
3.1304 -then () else error "rational.sml: diff.behav. in cancel_p S.K.8";
3.1305 - \--- DOES NOT TERMINATE AT TRANSITION isabisac15 --> Isabelle2017 --------------------------/*)
3.1306 -
3.1307 -(*------- Schalk I, p.68 Nr. 437b*)
3.1308 -val t = TermC.str2term "(a + b)/(x \<up> 2 - y \<up> 2) * ((x - y) \<up> 2/(a \<up> 2 - b \<up> 2))";
3.1309 -(*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1310 -:
3.1311 -#### rls: cancel_p on: (a * x \<up> 2 + -2 * (a * (x * y)) + a * y \<up> 2 + b * x \<up> 2 +
3.1312 - -2 * (b * (x * y)) +
3.1313 - b * y \<up> 2) /
3.1314 -(a \<up> 2 * x \<up> 2 + -1 * (a \<up> 2 * y \<up> 2) + -1 * (b \<up> 2 * x \<up> 2) +
3.1315 - b \<up> 2 * y \<up> 2)
3.1316 -exception Div raised
3.1317 -*)
3.1318 -
3.1319 -(*------- SRM Schalk I, p.68 Nr. 438a *)
3.1320 -val t = TermC.str2term "x*y / (x*y - y \<up> 2) * (x \<up> 2 - x*y)";
3.1321 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1322 -if UnparseC.term t = "x \<up> 2"
3.1323 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 24";
3.1324 -
3.1325 -(*------- SRM Schalk I, p.68 Nr. 439b *)
3.1326 -val t = TermC.str2term "(4*x \<up> 2 + 4*x + 1) * ((x \<up> 2 - 2*x \<up> 3) / (4*x \<up> 2 + 2*x))";
3.1327 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1328 -if UnparseC.term t = "(x + - 4 * x \<up> 3) / 2"
3.1329 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 25";
3.1330 -
3.1331 -(*------- SRM Schalk I, p.68 Nr. 440a *)
3.1332 -val t = TermC.str2term "(x \<up> 2 - 2*x) / (x \<up> 2 - 3*x) * (x - 3) \<up> 2 / (x \<up> 2 - 4)";
3.1333 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1334 -if UnparseC.term t = "(- 3 + x) / (2 + x)"
3.1335 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 26";
3.1336 -
3.1337 -"----- Schalk I, p.68 Nr. 440b SK11 works since 0707xx";
3.1338 -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)";
3.1339 -(* WN130911 non-termination for unclear reasons:
3.1340 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1341 -
3.1342 -... ENDS WITH THIS TRACE:
3.1343 -:
3.1344 -### rls: cancel_p on: (-9 * (a \<up> 3 * b) + -9 * (a \<up> 2 * b \<up> 2) + a \<up> 5 * b +
3.1345 - a \<up> 4 * b \<up> 2) /
3.1346 -(a \<up> 3 * b + -1 * (a * b \<up> 3)) /
3.1347 -(3 + a)
3.1348 -BUT THIS IS CORRECTLY RECOGNISED
3.1349 -val t = TermC.str2term
3.1350 - ("(-9 * (a \<up> 3 * b) + -9 * (a \<up> 2 * b \<up> 2) + a \<up> 5 * b + a \<up> 4 * b \<up> 2) /" ^
3.1351 - "(a \<up> 3 * b + -1 * (a * b \<up> 3)) / (3 + (a::real))");
3.1352 -AS
3.1353 -NONE = cancel_p_ thy t;
3.1354 -
3.1355 -if UnparseC.term t = "(-3 * a + a \<up> 2) / (a + -1 * b)" then ()
3.1356 -else error "rational.sml: diff.behav. in norm_Rational 27";
3.1357 -*)
3.1358 -
3.1359 -"----- SK12 works since 0707xx";
3.1360 -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))";
3.1361 -(* WN130911 non-termination due to non-termination of
3.1362 - cancel_p_ thy (TermC.str2term "(4 + -4 * b \<up> 2) / (a \<up> 4 + -2 * (a \<up> 2 * b \<up> 2) + b \<up> 4)")
3.1363 -
3.1364 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1365 -if UnparseC.term t' = "(-3 * a + a \<up> 2) / (a + -1 * b)" then ()
3.1366 -else error "rational.sml: diff.behav. in norm_Rational 28";
3.1367 -*)
3.1368 -
3.1369 -"-------- examples common denominator and multiplication from: Schalk --------";
3.1370 -"-------- examples common denominator and multiplication from: Schalk --------";
3.1371 -"-------- examples common denominator and multiplication from: Schalk --------";
3.1372 -(*------- SRAM Schalk I, p.69 Nr. 441b *)
3.1373 -val t = TermC.str2term "(4*a/3 + 3*b \<up> 2/a \<up> 3 + b/(4*a))*(4*b/(3*a))";
3.1374 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1375 -if UnparseC.term t = "(36 * b \<up> 3 + 3 * a \<up> 2 * b \<up> 2 + 16 * a \<up> 4 * b) /\n(9 * a \<up> 4)"
3.1376 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 28";
3.1377 -
3.1378 -(*------- SRAM Schalk I, p.69 Nr. 442b *)
3.1379 -val t = TermC.str2term ("(15*a \<up> 2/x \<up> 3 - 5*b \<up> 4/x \<up> 2 + 25*c \<up> 2/x) * " ^
3.1380 - "(x \<up> 3/(5*a*b \<up> 3*c \<up> 3)) + 1/c \<up> 3 * (b*x/a - 3*a/b \<up> 3)");
3.1381 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1382 -if UnparseC.term t = "5 * x \<up> 2 / (a * b \<up> 3 * c)"
3.1383 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 29";
3.1384 -
3.1385 -(*------- SRAM Schalk I, p.69 Nr. 443b *)
3.1386 -val t = TermC.str2term "(a/2 + b/3) * (b/3 - a/2)";
3.1387 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1388 -if UnparseC.term t = "(- 9 * a \<up> 2 + 4 * b \<up> 2) / 36"
3.1389 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 30";
3.1390 -
3.1391 -(*------- SRAM Schalk I, p.69 Nr. 445b *)
3.1392 -val t = TermC.str2term "(a \<up> 2/9 + 2*a/(3*b) + 4/b \<up> 2)*(a/3 - 2/b) + 8/b \<up> 3";
3.1393 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1394 -if UnparseC.term t = "a \<up> 3 / 27"
3.1395 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 31";
3.1396 -
3.1397 -(*------- SRAM Schalk I, p.69 Nr. 446b *)
3.1398 -val t = TermC.str2term "(x/(5*x + 4*y) - y/(5*x - 4*y) + 1)*(25*x \<up> 2 - 16*y \<up> 2)";
3.1399 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1400 -if UnparseC.term t = (*"30 * x \<up> 2 + -9 * x * y + -20 * y \<up> 2" ..isabisac15 | Isabelle2017..*)
3.1401 - "(- 30 * x \<up> 2 + 9 * x * y + 20 * y \<up> 2) / - 1"
3.1402 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 32";
3.1403 -
3.1404 -(*------- SRAM Schalk I, p.69 Nr. 449a *)(*Achtung: rechnet ca 8 Sekunden*)
3.1405 -val t = TermC.str2term
3.1406 -"(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)";
3.1407 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1408 -if UnparseC.term t = "(- 81 * x \<up> 4 + 16 * x \<up> 8 * y \<up> 4) / (81 * y \<up> 8)"
3.1409 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 33";
3.1410 -
3.1411 -(*------- SRAM Schalk I, p.69 Nr. 450a *)
3.1412 -val t = TermC.str2term
3.1413 -"(4*x/(3*y)+2*y/(3*x)) \<up> 2 - (2*y/(3*x) - 2*x/y)*(2*y/(3*x)+2*x/y)";
3.1414 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1415 -if UnparseC.term t = "(52 * x \<up> 2 + 16 * y \<up> 2) / (9 * y \<up> 2)"
3.1416 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 34";
3.1417 -
3.1418 -(*------- SRAM Schalk I, p.69 Nr. 442b --- abgewandelt*)
3.1419 -val t = TermC.str2term
3.1420 - ("(15*a \<up> 4/(a*x \<up> 3) - 5*a*((b \<up> 4 - 5*c \<up> 2*x) / x \<up> 2)) * " ^
3.1421 - "(x \<up> 3/(5*a*b \<up> 3*c \<up> 3)) + a/c \<up> 3 * (x*(b/a) - 3*b*(a/b \<up> 4))");
3.1422 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1423 -if UnparseC.term t = "5 * x \<up> 2 / (b \<up> 3 * c)"
3.1424 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 53";
3.1425 -
3.1426 -
3.1427 -"-------- examples double fractions from: Mathematik 1 Schalk ----------------";
3.1428 -"-------- examples double fractions from: Mathematik 1 Schalk ----------------";
3.1429 -"-------- examples double fractions from: Mathematik 1 Schalk ----------------";
3.1430 -"----- SRD Schalk I, p.69 Nr. 454b";
3.1431 -val t = TermC.str2term "((2 - x)/(2*a)) / (2*a/(x - 2))";
3.1432 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1433 -if UnparseC.term t = "(- 4 + 4 * x + - 1 * x \<up> 2) / (4 * a \<up> 2)"
3.1434 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 35";
3.1435 -
3.1436 -"----- SRD Schalk I, p.69 Nr. 455a";
3.1437 -val t = TermC.str2term "(a \<up> 2 + 1)/(a \<up> 2 - 1) / ((a+1)/(a - 1))";
3.1438 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1439 -if UnparseC.term t = "(1 + a \<up> 2) / (1 + 2 * a + a \<up> 2)" then ()
3.1440 -else error "rational.sml: diff.behav. in norm_Rational_mg 36";
3.1441 -
3.1442 -"----- Schalk I, p.69 Nr. 455b";
3.1443 -val t = TermC.str2term "(x \<up> 2 - 4)/(y \<up> 2 - 9)/((2+x)/(3 - y))";
3.1444 -(* WN130911 non-termination due to non-termination of
3.1445 - cancel_p_ thy (TermC.str2term ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
3.1446 - "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)"))
3.1447 -
3.1448 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1449 -if UnparseC.term t = "(2 + -1 * x) / (3 + y)" then ()
3.1450 -else error "rational.sml: diff.behav. in norm_Rational_mg 37";
3.1451 -*)
3.1452 -
3.1453 -"----- SK060904-1a non-termination of cancel_p_ ?: worked before 0707xx";
3.1454 -val t = TermC.str2term "(x \<up> 2 - 4)*(3 - y) / ((y \<up> 2 - 9)*(2+x))";
3.1455 -(* WN130911 non-termination due to non-termination of
3.1456 - cancel_p_ thy (TermC.str2term ("(-12 + 4 * y + 3 * x \<up> 2 + -1 * (x \<up> 2 * y)) /" ^
3.1457 - "(-18 + -9 * x + 2 * y \<up> 2 + x * y \<up> 2)"))
3.1458 -
3.1459 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1460 -if UnparseC.term t = "(2 + -1 * x) / (3 + y)" then ()
3.1461 -else error "rational.sml: diff.behav. in norm_Rational_mg 37b";
3.1462 -*)
3.1463 -
3.1464 -"----- ?: worked before 0707xx";
3.1465 -val t = TermC.str2term "(3 + -1 * y) / (-9 + y \<up> 2)";
3.1466 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1467 -if UnparseC.term t = "- 1 / (3 + y)"
3.1468 -then () else error "rational.sml: -1 / (3 + y) norm_Rational";
3.1469 -
3.1470 -"----- SRD Schalk I, p.69 Nr. 456b";
3.1471 -val t = TermC.str2term "(b \<up> 3 - b \<up> 2) / (b \<up> 2+b) / (b \<up> 2 - 1)";
3.1472 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1473 -if UnparseC.term t = "b / (1 + 2 * b + b \<up> 2)"
3.1474 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 38";
3.1475 -
3.1476 -"----- SRD Schalk I, p.69 Nr. 457b";
3.1477 -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))";
3.1478 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1479 -if UnparseC.term t = "8 * a \<up> 2 + - 6 * a * b + - 12 * a \<up> 2 * b + 9 * a * b \<up> 2"
3.1480 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 39";
3.1481 -
3.1482 -"----- Schalk I, p.69 Nr. 458b works since 0707";
3.1483 -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)))";
3.1484 -(*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1485 -:
3.1486 -### rls: cancel_p on: (-1 * a \<up> 2 + 2 * (a \<up> 2 * x)) / (a * x + -1 * (b * x)) /
3.1487 -((-1 * b \<up> 2 + 2 * (b \<up> 2 * x)) / (a * x + -1 * (b * x)))
3.1488 -exception Div raised
3.1489 -
3.1490 -BUT
3.1491 -val t = TermC.str2term
3.1492 - ("(-1 * a \<up> 2 + 2 * (a \<up> 2 * x)) / (a * x + -1 * (b * x)) /" ^
3.1493 - "((-1 * b \<up> 2 + 2 * (b \<up> 2 * x)) / (a * x + -1 * (b * x)))");
3.1494 -NONE = cancel_p_ thy t;
3.1495 -
3.1496 -if UnparseC.term t = "a \<up> 2 / b \<up> 2" then ()
3.1497 -else error "rational.sml: diff.behav. in norm_Rational_mg 39b";
3.1498 -*)
3.1499 -
3.1500 -"----- SRD Schalk I, p.69 Nr. 459b";
3.1501 -val t = TermC.str2term "(a \<up> 2 - b \<up> 2)/(a*b) / (4*(a+b) \<up> 2/a)";
3.1502 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1503 -if UnparseC.term t = "(a + - 1 * b) / (4 * a * b + 4 * b \<up> 2)" then ()
3.1504 -else error "rational.sml: diff.behav. in norm_Rational_mg 41";
3.1505 -
3.1506 -"----- Schalk I, p.69 Nr. 460b nonterm.SK";
3.1507 -val t = TermC.str2term "(9*(x \<up> 2 - 8*x + 16) / (4*(y \<up> 2 - 2*y + 1))) / ((3*x - 12) / (16*y - 16))";
3.1508 -(*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1509 -exception Div raised
3.1510 -
3.1511 -BUT
3.1512 -val t = TermC.str2term
3.1513 - ("(144 + -72 * x + 9 * x \<up> 2) / (4 + -8 * y + 4 * y \<up> 2) /" ^
3.1514 - "((-12 + 3 * x) / (-16 + 16 * y))");
3.1515 -NONE = cancel_p_ thy t;
3.1516 -
3.1517 -if UnparseC.term t = !!!!!!!!!!!!!!!!!!!!!!!!!
3.1518 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 42";
3.1519 -*)
3.1520 -
3.1521 -"----- some variant of the above; was non-terminating before";
3.1522 -val t = TermC.str2term "9*(x \<up> 2 - 8*x+16)*(16*y - 16)/(4*(y \<up> 2 - 2*y+1)*(3*x - 12))";
3.1523 -val SOME (t , _) = rewrite_set_ thy false norm_Rational t;
3.1524 -if UnparseC.term t = "(48 + - 12 * x) / (1 + - 1 * y)"
3.1525 -then () else error "some variant of the above; was non-terminating before";
3.1526 -
3.1527 -"----- SRD Schalk I, p.70 Nr. 472a";
3.1528 -val t = TermC.str2term ("((8*x \<up> 2 - 32*y \<up> 2) / (2*x + 4*y)) / ((4*x - 8*y) / (x + y))");
3.1529 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1530 -if UnparseC.term t = "x + y"
3.1531 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 43";
3.1532 -
3.1533 -"----- Schalk I, p.70 Nr. 478b ----- Rechenzeit: 5 sec";
3.1534 -val t = TermC.str2term ("(a - (a*b + b \<up> 2)/(a+b))/(b+(a - b)/(1+(a+b)/(a - b))) / " ^
3.1535 - "((a - a \<up> 2/(a+b))/(a+(a*b)/(a - b)))");
3.1536 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1537 -if UnparseC.term t = "(2 * a \<up> 3 + 2 * a \<up> 2 * b) / (a \<up> 2 * b + b \<up> 3)"
3.1538 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 51";
3.1539 -
3.1540 -(*SRD Schalk I, p.69 Nr. 461a *)
3.1541 -val t = TermC.str2term "(2/(x+3) + 2/(x - 3)) / (8*x/(x \<up> 2 - 9))";
3.1542 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1543 -if UnparseC.term t = "1 / 2"
3.1544 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 44";
3.1545 -
3.1546 -(*SRD Schalk I, p.69 Nr. 464b *)
3.1547 -val t = TermC.str2term "(a - a/(a - 2)) / (a + a/(a - 2))";
3.1548 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1549 -if UnparseC.term t = "(- 3 + a) / (- 1 + a)"
3.1550 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 45";
3.1551 -
3.1552 -(*SRD Schalk I, p.69 Nr. 465b *)
3.1553 -val t = TermC.str2term "((x+3*y)/9 + (4*y \<up> 2 - 9*z \<up> 2)/(16*x)) / (x/9 + y/6 + z/4)";
3.1554 -(* WN130911 non-termination due to non-termination of
3.1555 - cancel_p_ thy (TermC.str2term
3.1556 - ("("(576 * x \<up> 2 + 1728 * (x * y) + 1296 * y \<up> 2 + -2916 * z \<up> 2) /" ^
3.1557 - "(576 * x \<up> 2 + 864 * (x * y) + 1296 * (x * z))"))
3.1558 -
3.1559 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1560 -if UnparseC.term t = "(4 * x + 6 * y + -9 * z) / (4 * x)"
3.1561 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 46";
3.1562 -*)
3.1563 -
3.1564 -(*SRD Schalk I, p.69 Nr. 466b *)
3.1565 -val t = TermC.str2term "((1 - 7*(x - 2)/(x \<up> 2 - 4)) / (6/(x+2))) / (3/(x+5)+30/(x \<up> 2 - 25))";
3.1566 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1567 -if UnparseC.term t = "(25 + - 10 * x + x \<up> 2) / 18"
3.1568 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 47";
3.1569 -
3.1570 -(*SRD Schalk I, p.70 Nr. 469 *)
3.1571 -val t = TermC.str2term ("3*b \<up> 2 / (4*a \<up> 2 - 8*a*b + 4*b \<up> 2) / " ^
3.1572 - "(a / (a \<up> 2*b - b \<up> 3) + (a - b) / (4*a*b \<up> 2 + 4*b \<up> 3) - 1 / (4*b \<up> 2))");
3.1573 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1574 -if UnparseC.term t = "- 3 * b \<up> 3 / (- 2 * a + 2 * b)"
3.1575 -then () else error "rational.sml: diff.behav. in norm_Rational_mg 48";
3.1576 -
3.1577 -(*//----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)
3.1578 -"-------- me Schalk I No.186 -------------------------------------------------";
3.1579 -"-------- me Schalk I No.186 -------------------------------------------------";
3.1580 -"-------- me Schalk I No.186 -------------------------------------------------";
3.1581 -val fmz = ["Term ((14 * x * y) / ( x * y ))", "normalform N"];
3.1582 -val (dI',pI',mI') =
3.1583 - ("Rational",["rational", "simplification"],
3.1584 - ["simplification", "of_rationals"]);
3.1585 -val p = e_pos'; val c = [];
3.1586 -val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
3.1587 -val (p,_,f,nxt,_,pt) = me nxt p c pt;
3.1588 -val (p,_,f,nxt,_,pt) = me nxt p c pt;
3.1589 -val (p,_,f,nxt,_,pt) = me nxt p c pt;
3.1590 -val (p,_,f,nxt,_,pt) = me nxt p c pt;
3.1591 -val (p,_,f,nxt,_,pt) = me nxt p c pt;
3.1592 -val (p,_,f,nxt,_,pt) = me nxt p c pt;
3.1593 -val (p,_,f,nxt,_,pt) = me nxt p c pt;
3.1594 -val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
3.1595 -val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;
3.1596 -val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;(*++ for explicit script*)
3.1597 -val (p,_,f,nxt,_,pt) = me nxt p c pt; f2str f;(*++ for explicit script*)
3.1598 -case (f2str f, nxt) of
3.1599 - ("14", ("End_Proof'", _)) => ()
3.1600 - | _ => error "rational.sml diff.behav. in me Schalk I No.186";
3.1601 - \\----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)*)
3.1602 -
3.1603 -(*//----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)
3.1604 -"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
3.1605 -"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
3.1606 -"-------- interSteps ..Simp_Rat_Double_No-1.xml ------------------------------";
3.1607 -reset_states ();
3.1608 -CalcTree [(["Term (((2 - x)/(2*a)) / (2*a/(x - 2)))", "normalform N"],
3.1609 - ("Rational", ["rational", "simplification"], ["simplification", "of_rationals"]))];
3.1610 -Iterator 1;
3.1611 -moveActiveRoot 1;
3.1612 -autoCalculate 1 CompleteCalc;
3.1613 -val ((pt, p), _) = get_calc 1;
3.1614 -(*
3.1615 -Test_Tool.show_pt pt;
3.1616 -[
3.1617 -(([], Frm), Simplify ((2 - x) / (2 * a) / (2 * a / (x - 2)))),
3.1618 -(([1], Frm), (2 - x) / (2 * a) / (2 * a / (x - 2))),
3.1619 -(([1], Res), (2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))),
3.1620 -(([2], Res), (2 + -1 * x) / (2 * a) / (2 * a / (-2 + x))),
3.1621 -(([3], Res), (2 + -1 * x) * (-2 + x) / (2 * a * (2 * a))),
3.1622 -(([4], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2)),
3.1623 -(([], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2))]
3.1624 -*)
3.1625 -interSteps 1 ([1], Res);
3.1626 -val ((pt, p), _) = get_calc 1;
3.1627 -(*Test_Tool.show_pt pt;
3.1628 -[
3.1629 -(([], Frm), Simplify ((2 - x) / (2 * a) / (2 * a / (x - 2)))),
3.1630 -(([1], Frm), (2 - x) / (2 * a) / (2 * a / (x - 2))),
3.1631 -(([1,1], Frm), (2 - x) / (2 * a) / (2 * a / (x - 2))),
3.1632 -(([1,1], Res), (2 - x) / (2 * a) / (2 * a / (x + -1 * 2))),
3.1633 -(([1,2], Res), (2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))),
3.1634 -(([1], Res), (2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))),
3.1635 -(([2], Res), (2 + -1 * x) / (2 * a) / (2 * a / (-2 + x))),
3.1636 -(([3], Res), (2 + -1 * x) * (-2 + x) / (2 * a * (2 * a))),
3.1637 -(([4], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2)),
3.1638 -(([], Res), (-4 + 4 * x + -1 * x \<up> 2) / (4 * a \<up> 2))]
3.1639 -*)
3.1640 -val (t, asm) = get_obj g_result pt [1, 1];
3.1641 -if UnparseC.term t = "(2 - x) / (2 * a) / (2 * a / (x + -1 * 2))" andalso UnparseC.terms asm = "[]"
3.1642 -then () else error "2nd interSteps ..Simp_Rat_Double_No-1 changed on [1, 1]";
3.1643 -val (t, asm) = get_obj g_result pt [1, 2];
3.1644 -if UnparseC.term t = "(2 + -1 * x) / (2 * a) / (2 * a / (x + -1 * 2))" andalso UnparseC.terms asm = "[]"
3.1645 -then () else error "3rd interSteps ..Simp_Rat_Double_No-1 changed on [1, 2]";
3.1646 - \\----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)*)
3.1647 -
3.1648 -
3.1649 -(*//----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)
3.1650 -"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
3.1651 -"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
3.1652 -"-------- interSteps ..Simp_Rat_Cancel_No-1.xml ------------------------------";
3.1653 -reset_states ();
3.1654 -CalcTree [(["Term ((a^2 + -1*b^2) / (a^2 + -2*a*b + b^2))", "normalform N"],
3.1655 - ("Rational", ["rational", "simplification"], ["simplification", "of_rationals"]))];
3.1656 -Iterator 1;
3.1657 -moveActiveRoot 1;
3.1658 -autoCalculate 1 CompleteCalc;
3.1659 -val ((pt, p), _) = get_calc 1;
3.1660 -(*Test_Tool.show_pt pt;
3.1661 -[
3.1662 -(([], Frm), Simplify ((a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2))),
3.1663 -(([1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2)),
3.1664 -(([1], Res), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
3.1665 -(([2], Res), (a + b) / (a + -1 * b)),
3.1666 -(([], Res), (a + b) / (a + -1 * b))]
3.1667 -*)
3.1668 -interSteps 1 ([2], Res);
3.1669 -val ((pt, p), _) = get_calc 1;
3.1670 -(*Test_Tool.show_pt pt;
3.1671 -[
3.1672 -(([], Frm), Simplify ((a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2))),
3.1673 -(([1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2)),
3.1674 -(([1], Res), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
3.1675 -(([2,1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
3.1676 -(([2,1], Res), (a + b) / (a + -1 * b)),
3.1677 -(([2], Res), (a + b) / (a + -1 * b)),
3.1678 -(([], Res), (a + b) / (a + -1 * b))]
3.1679 -*)
3.1680 -interSteps 1 ([2,1],Res);
3.1681 -val ((pt, p), _) = get_calc 1;
3.1682 -(*Test_Tool.show_pt pt;
3.1683 -[
3.1684 -(([], Frm), Simplify ((a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2))),
3.1685 -(([1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * a * b + b \<up> 2)),
3.1686 -(([1], Res), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
3.1687 -(([2,1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
3.1688 -(([2,1,1], Frm), (a \<up> 2 + -1 * b \<up> 2) / (a \<up> 2 + -2 * (a * b) + b \<up> 2)),
3.1689 -(([2,1,1], Res), (a \<up> 2 + -1 * (a * b) + a * b + -1 * b \<up> 2) /
3.1690 -(a \<up> 2 + -2 * (a * b) + 1 * b \<up> 2)),
3.1691 -(([2,1,2], Res), (a \<up> 2 + -1 * (a * b) + a * b + -1 * b \<up> 2) /
3.1692 -(a \<up> 2 + -2 * (a * b) + -1 \<up> 2 * b \<up> 2)),
3.1693 -(([2,1,3], Res), (a \<up> 2 + -1 * (a * b) + a * b + -1 * b \<up> 2) /
3.1694 -(a \<up> 2 + -2 * (a * b) + (-1 * b) \<up> 2)),
3.1695 -(([2,1,4], Res), (a * a + -1 * (a * b) + a * b + -1 * b \<up> 2) /
3.1696 -(a \<up> 2 + -2 * (a * b) + (-1 * b) \<up> 2)),
3.1697 -(([2,1,5], Res), (a * a + -1 * (a * b) + a * b + -1 * (b * b)) /
3.1698 -(a \<up> 2 + -2 * (a * b) + (-1 * b) \<up> 2)),
3.1699 -(([2,1,6], Res), (a * a + -1 * (a * b) + a * b + -1 * (b * b)) /
3.1700 -(a \<up> 2 + -1 * (2 * (a * b)) + (-1 * b) \<up> 2)),
3.1701 -(([2,1,7], Res), (a * a + a * (-1 * b) + (b * a + b * (-1 * b))) /
3.1702 -(a \<up> 2 + 2 * (a * (-1 * b)) + (-1 * b) \<up> 2)),
3.1703 -(([2,1,8], Res), (a * a + a * (-1 * b) + (b * a + b * (-1 * b))) /
3.1704 -(a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
3.1705 -(([2,1,9], Res), (a * (a + -1 * b) + (b * a + b * (-1 * b))) /
3.1706 -(a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
3.1707 -(([2,1,10], Res), (a * (a + -1 * b) + b * (a + -1 * b)) /
3.1708 -(a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
3.1709 -(([2,1,11], Res), (a + b) * (a + -1 * b) / (a \<up> 2 + 2 * a * (-1 * b) + (-1 * b) \<up> 2)),
3.1710 -(([2,1,12], Res), (a + b) * (a + -1 * b) / ((a + -1 * b) * (a + -1 * b))),
3.1711 -(([2,1,13], Res), (a + b) / (a + -1 * b)),
3.1712 -(([2,1], Res), (a + b) / (a + -1 * b)),
3.1713 -(([2], Res), (a + b) / (a + -1 * b)),
3.1714 -(([], Res), (a + b) / (a + -1 * b))]
3.1715 -*)
3.1716 -val newnds = children (get_nd pt [2,1]) (*see "fun detailrls"*);
3.1717 -if length newnds = 13 then () else error "rational.sml: interSteps cancel_p rev_rew_p";
3.1718 -
3.1719 -val p = ([2,1,9],Res);
3.1720 -getTactic 1 p;
3.1721 -val (_, tac, _) = ME_Misc.pt_extract (pt, p);
3.1722 -case tac of SOME (Rewrite ("sym_distrib_left", _)) => ()
3.1723 -| _ => error "rational.sml: getTactic, sym_real_plus_binom_times1";
3.1724 - \\----------------------------------TOODOO (*Rfuns revsets \<longrightarrow> broken*)*)
3.1725 -
3.1726 -
3.1727 -"-------- investigate rulesets for cancel_p ----------------------------------";
3.1728 -"-------- investigate rulesets for cancel_p ----------------------------------";
3.1729 -"-------- investigate rulesets for cancel_p ----------------------------------";
3.1730 -val thy = @{theory "Rational"};
3.1731 -val t = TermC.str2term "(a \<up> 2 + -1*b \<up> 2) / (a \<up> 2 + -2*a*b + b \<up> 2)";
3.1732 -val tt = TermC.str2term "(1 * a + 1 * b) * (1 * a + -1 * b)"(*numerator only*);
3.1733 -
3.1734 -"----- with rewrite_set_";
3.1735 -val SOME (tt',asm) = rewrite_set_ thy false make_polynomial tt;
3.1736 -if UnparseC.term tt'= "a \<up> 2 + - 1 * b \<up> 2" then () else error "rls chancel_p 1";
3.1737 -val tt = TermC.str2term "((1 * a + -1 * b) * (1 * a + -1 * b))"(*denominator only*);
3.1738 -val SOME (tt',asm) = rewrite_set_ thy false make_polynomial tt;
3.1739 -if UnparseC.term tt' = "a \<up> 2 + - 2 * a * b + b \<up> 2" then () else error "rls chancel_p 2";
3.1740 -
3.1741 -"----- with Derive.do_one; WN1130912 not investigated further, will be discontinued";
3.1742 -val SOME (tt, _) = factout_p_ thy t;
3.1743 -if UnparseC.term tt = "(a + b) * (a + - 1 * b) / ((a + - 1 * b) * (a + - 1 * b))"
3.1744 -then () else error "rls chancel_p 3";
3.1745 -
3.1746 -"--- with simpler ruleset";
3.1747 -val {rules, rew_ord= (_, ro), ...} = Rule_Set.rep (assoc_rls "rev_rew_p");
3.1748 -val der = Derive.do_one thy Atools_erls rules ro NONE tt;
3.1749 -if length der = 12 then () else error "WN1130912 rls chancel_p 4";
3.1750 -(*default_print_depth 99;*) writeln (Derive.deriv2str der); (*default_print_depth 3;*)
3.1751 -
3.1752 -(*default_print_depth 99;*) map (UnparseC.term o #1) der; (*default_print_depth 3;*)
3.1753 -"...,(-1 * b \<up> 2 + a \<up> 2) / (-2 * (a * b) + a \<up> 2 + (-1 * b) \<up> 2) ]";
3.1754 -(*default_print_depth 99;*) map (Rule.to_string o #2) der; (*default_print_depth 3;*)
3.1755 -(*default_print_depth 99;*) map (UnparseC.term o #1 o #3) der; (*default_print_depth 3;*)
3.1756 -
3.1757 -val der = Derive.do_one thy Atools_erls rules ro NONE
3.1758 - (TermC.str2term "(1 * a + 1 * b) * (1 * a + -1 * b)");
3.1759 -(*default_print_depth 99;*) writeln (Derive.deriv2str der); (*default_print_depth 3;*)
3.1760 -
3.1761 -val {rules, rew_ord=(_,ro),...} = Rule_Set.rep (assoc_rls "rev_rew_p");
3.1762 -val der = Derive.do_one thy Atools_erls rules ro NONE
3.1763 - (TermC.str2term "(1 * a + -1 * b) * (1 * a + -1 * b)");
3.1764 -(*default_print_depth 99;*) writeln (Derive.deriv2str der); (*default_print_depth 3;*)
3.1765 -(*default_print_depth 99;*) map (UnparseC.term o #1) der; (*default_print_depth 3;*)
3.1766 -(*WN060829 ...postponed*)
3.1767 -
3.1768 -
3.1769 -"-------- fun eval_get_denominator -------------------------------------------";
3.1770 -"-------- fun eval_get_denominator -------------------------------------------";
3.1771 -"-------- fun eval_get_denominator -------------------------------------------";
3.1772 -val thy = @{theory Isac_Knowledge};
3.1773 -val t = Thm.term_of (the (TermC.parse thy "get_denominator ((a +x)/b)"));
3.1774 -val SOME (_, t') = eval_get_denominator "" 0 t thy;
3.1775 -if UnparseC.term t' = "get_denominator ((a + x) / b) = b"
3.1776 -then () else error "get_denominator ((a + x) / b) = b"
3.1777 -
3.1778 -
3.1779 -"-------- several errpats in complicated term --------------------------------";
3.1780 -"-------- several errpats in complicated term --------------------------------";
3.1781 -"-------- several errpats in complicated term --------------------------------";
3.1782 -(*WN12xxxx TODO: instead of Gabriella's example here (27.Jul.12) find a simpler one
3.1783 - WN130912: kept this test, although not clear what for*)
3.1784 -reset_states ();
3.1785 -CalcTree [(["Term ((5*b + 25)/(a^2 - b^2) * (a - b)/(5*b))", "normalform N"],
3.1786 - ("Rational", ["rational", "simplification"], ["simplification", "of_rationals"]))];
3.1787 -Iterator 1;
3.1788 -moveActiveRoot 1;
3.1789 -autoCalculate 1 CompleteCalc;
3.1790 -val ((pt, p), _) = get_calc 1;
3.1791 -(*Test_Tool.show_pt pt;
3.1792 -[
3.1793 -(([], Frm), Simplify ((5 * b + 25) / (a \<up> 2 - b \<up> 2) * (a - b) / (5 * b))),
3.1794 -(([1], Frm), (5 * b + 25) / (a \<up> 2 - b \<up> 2) * (a - b) / (5 * b)),
3.1795 -(([1], Res), (5 * b + 25) / (a \<up> 2 + -1 * b \<up> 2) * (a + -1 * b) / (5 * b)),
3.1796 -(([2], Res), (5 * b + 25) * (a + -1 * b) / (a \<up> 2 + -1 * b \<up> 2) / (5 * b)),
3.1797 -(([3], Res), (25 * a + -25 * b + 5 * (a * b) + -5 * b \<up> 2) / (a \<up> 2 + -1 * b \<up> 2) /
3.1798 -(5 * b)),
3.1799 -(([4], Res), (25 + 5 * b) / (a + b) / (5 * b)),
3.1800 -(([5], Res), (25 + 5 * b) / ((a + b) * (5 * b))),
3.1801 -(([6], Res), (25 + 5 * b) / (5 * (a * b) + 5 * b \<up> 2)),
3.1802 -(([7], Res), (5 + b) / (a * b + b \<up> 2)),
3.1803 -(([], Res), (5 + b) / (a * b + b \<up> 2))] *)
3.1804 -
3.1805 -
3.1806 -"-------- WN1309xx non-terminating rls norm_Rational -------------------------";
3.1807 -"-------- WN1309xx non-terminating rls norm_Rational -------------------------";
3.1808 -"-------- WN1309xx non-terminating rls norm_Rational -------------------------";
3.1809 -(*------- Schalk I, p.70 Nr. 480b; a/b : c/d translated to a/b * d/c*)
3.1810 -val t = TermC.str2term
3.1811 - ("((12*x*y / (9*x \<up> 2 - y \<up> 2)) / (1 / (3*x - y) \<up> 2 - 1 / (3*x + y) \<up> 2)) * " ^
3.1812 - "((1/(x - 5*y) \<up> 2 - 1/(x + 5*y) \<up> 2) / (20*x*y / (x \<up> 2 - 25*y \<up> 2)))");
3.1813 -
3.1814 -(*1st factor separately simplified *)
3.1815 -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))";
3.1816 -val SOME (t', _) = rewrite_set_ thy false norm_Rational t;
3.1817 -if UnparseC.term t' = "(- 9 * x \<up> 2 + y \<up> 2) / - 1" then () else error "Nr. 480b lhs changed";
3.1818 -(*2nd factor separately simplified *)
3.1819 -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)))";
3.1820 -val SOME (t',_) = rewrite_set_ thy false norm_Rational t; UnparseC.term t';
3.1821 -if UnparseC.term t' = "- 1 / (- 1 * x \<up> 2 + 25 * y \<up> 2)" then () else error "Nr. 480b rhs changed";
3.1822 -
3.1823 -"-------- Schalk I, p.70 Nr. 477a: terms are exploding ?!?";
3.1824 -val t = TermC.str2term ("b*y/(b - 2*y)/((b \<up> 2 - y \<up> 2)/(b+2*y)) /" ^
3.1825 - "(b \<up> 2*y + b*y \<up> 2) * (a+x) \<up> 2 / ((b \<up> 2 - 4*y \<up> 2) * (a+2*x) \<up> 2)");
3.1826 -(*val SOME (t',_) = rewrite_set_ thy false norm_Rational t;
3.1827 -:
3.1828 -### rls: cancel_p on: (a \<up> 2 * (b * y) + 2 * (a * (b * (x * y))) + b * (x \<up> 2 * y)) /
3.1829 -(b + -2 * y) /
3.1830 -((b \<up> 2 + -1 * y \<up> 2) / (b + 2 * y)) /
3.1831 -(b \<up> 2 * y + b * y \<up> 2) /
3.1832 -(a \<up> 2 * b \<up> 2 + -4 * (a \<up> 2 * y \<up> 2) + 4 * (a * (b \<up> 2 * x)) +
3.1833 - -16 * (a * (x * y \<up> 2)) +
3.1834 - 4 * (b \<up> 2 * x \<up> 2) +
3.1835 - -16 * (x \<up> 2 * y \<up> 2))
3.1836 -exception Div raised
3.1837 -
3.1838 -BUT
3.1839 -val t = TermC.str2term
3.1840 - ("(a \<up> 2 * (b * y) + 2 * (a * (b * (x * y))) + b * (x \<up> 2 * y)) /" ^
3.1841 - "(b + -2 * y) /" ^
3.1842 - "((b \<up> 2 + -1 * y \<up> 2) / (b + 2 * y)) /" ^
3.1843 - "(b \<up> 2 * y + b * y \<up> 2) /" ^
3.1844 - "(a \<up> 2 * b \<up> 2 + -4 * (a \<up> 2 * y \<up> 2) + 4 * (a * (b \<up> 2 * x)) +" ^
3.1845 - "-16 * (a * (x * y \<up> 2)) +" ^
3.1846 - "4 * (b \<up> 2 * x \<up> 2) +" ^
3.1847 - "-16 * (x \<up> 2 * y \<up> 2))");
3.1848 -NONE = cancel_p_ thy t;
3.1849 -*)
3.1850 -
3.1851 -(*------- Schalk I, p.70 Nr. 476b in 2003 this worked using 10 sec. *)
3.1852 -val t = TermC.str2term
3.1853 - ("((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) / " ^
3.1854 - "((a \<up> 2 + b \<up> 2) \<up> 2 / (a + b) \<up> 2)");
3.1855 -(* Rewrite.trace_on := true;
3.1856 -rewrite_set_ thy false norm_Rational t;
3.1857 -:
3.1858 -#### rls: cancel_p on: (2 * (a \<up> 7 * b) + 4 * (a \<up> 6 * b \<up> 2) + 6 * (a \<up> 5 * b \<up> 3) +
3.1859 - 8 * (a \<up> 4 * b \<up> 4) +
3.1860 - 6 * (a \<up> 3 * b \<up> 5) +
3.1861 - 4 * (a \<up> 2 * b \<up> 6) +
3.1862 - 2 * (a * b \<up> 7)) /
3.1863 -(2 * (a \<up> 9 * b) + 4 * (a \<up> 8 * b \<up> 2) +
3.1864 - 2 * (2 * (a \<up> 7 * b \<up> 3)) +
3.1865 - 4 * (a \<up> 6 * b \<up> 4) +
3.1866 - -4 * (a \<up> 4 * b \<up> 6) +
3.1867 - -4 * (a \<up> 3 * b \<up> 7) +
3.1868 - -4 * (a \<up> 2 * b \<up> 8) +
3.1869 - -2 * (a * b \<up> 9))
3.1870 -
3.1871 -if UnparseC.term t = "1 / (a \<up> 2 + -1 * b \<up> 2)" then ()
3.1872 -else error "rational.sml: diff.behav. in norm_Rational_mg 49";
3.1873 -*)
3.1874 -
3.1875 -"-------- Schalk I, p.70 Nr. 480a: terms are exploding ?!?";
3.1876 -val t = TermC.str2term ("(1/x + 1/y + 1/z) / (1/x - 1/y - 1/z) / " ^
3.1877 - "(2*x \<up> 2 / (x \<up> 2 - z \<up> 2) / (x / (x + z) + x / (x - z)))");
3.1878 -(* Rewrite.trace_on := true;
3.1879 -rewrite_set_ thy false norm_Rational t;
3.1880 -:
3.1881 -#### rls: cancel_p on: (2 * (x \<up> 6 * (y \<up> 2 * z)) + 2 * (x \<up> 6 * (y * z \<up> 2)) +
3.1882 - 2 * (x \<up> 5 * (y \<up> 2 * z \<up> 2)) +
3.1883 - -2 * (x \<up> 4 * (y \<up> 2 * z \<up> 3)) +
3.1884 - -2 * (x \<up> 4 * (y * z \<up> 4)) +
3.1885 - -2 * (x \<up> 3 * (y \<up> 2 * z \<up> 4))) /
3.1886 -(-2 * (x \<up> 6 * (y \<up> 2 * z)) + -2 * (x \<up> 6 * (y * z \<up> 2)) +
3.1887 - 2 * (x \<up> 5 * (y \<up> 2 * z \<up> 2)) +
3.1888 - 2 * (x \<up> 4 * (y \<up> 2 * z \<up> 3)) +
3.1889 - 2 * (x \<up> 4 * (y * z \<up> 4)) +
3.1890 - -2 * (x \<up> 3 * (y \<up> 2 * z \<up> 4)))
3.1891 -*)
3.1892 -
3.1893 -"-------- Schalk I, p.60 Nr. 215d: terms are exploding, internal loop does not terminate";
3.1894 -val t = TermC.str2term "(a-b) \<up> 3 * (x+y) \<up> 4 / ((x+y) \<up> 2 * (a-b) \<up> 5)";
3.1895 -(* Kein Wunder, denn Z???ler und Nenner extra als Polynom dargestellt ergibt:
3.1896 -
3.1897 -val t = TermC.str2term "(a-b) \<up> 3 * (x+y) \<up> 4";
3.1898 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1899 -UnparseC.term t;
3.1900 -"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";
3.1901 -val t = TermC.str2term "((x+y) \<up> 2 * (a-b) \<up> 5)";
3.1902 -val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1903 -UnparseC.term t;
3.1904 -"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";
3.1905 -
3.1906 -anscheinend macht dem Rechner das Krzen diese Bruches keinen Spass mehr ...*)
3.1907 -
3.1908 -"-------- Schalk I, p.70 Nr. 480b: terms are exploding, Rewrite.trace_on stops at";
3.1909 -val t = TermC.str2term ("((12*x*y/(9*x \<up> 2 - y \<up> 2))/" ^
3.1910 - "(1/(3*x - y) \<up> 2 - 1/(3*x + y) \<up> 2)) *" ^
3.1911 - "(1/(x - 5*y) \<up> 2 - 1/(x + 5*y) \<up> 2)/" ^
3.1912 - "(20*x*y/(x \<up> 2 - 25*y \<up> 2))");
3.1913 -(*val SOME (t, _) = rewrite_set_ thy false norm_Rational t;
3.1914 -:
3.1915 -#### rls: cancel_p on: (19440 * (x \<up> 8 * y \<up> 2) + -490320 * (x \<up> 6 * y \<up> 4) +
3.1916 - 108240 * (x \<up> 4 * y \<up> 6) +
3.1917 - -6000 * (x \<up> 2 * y \<up> 8)) /
3.1918 -(2160 * (x \<up> 8 * y \<up> 2) + -108240 * (x \<up> 6 * y \<up> 4) +
3.1919 - 1362000 * (x \<up> 4 * y \<up> 6) +
3.1920 - -150000 * (x \<up> 2 * y \<up> 8))
3.1921 -*)
3.1922 -