neuper@37954: (* some tests are based on specficially simple scripts etc.
neuper@37954:    Author: Walther Neuper 2003
neuper@37954:    (c) due to copyright terms
neuper@37954: *) 
neuper@37906: 
neuper@38007: theory Test imports Atools Poly Rational Root Diff begin
neuper@37906:  
neuper@37906: consts
neuper@37906: 
neuper@37906: (*"cancel":: [real, real] => real    (infixl "'/'/'/" 70) ...divide 2002*)
neuper@37906: 
neuper@37906:   Expand'_binomtest
neuper@37954:              :: "['y,  
neuper@37954: 		    'y] => 'y"
neuper@37954:                ("((Script Expand'_binomtest (_ =))//  
neuper@37954:                    (_))" 9)
neuper@37906: 
neuper@37906:   Solve'_univar'_err
neuper@37954:              :: "[bool,real,bool,  
neuper@37954: 		    bool list] => bool list"
neuper@37954:                ("((Script Solve'_univar'_err (_ _ _ =))//  
neuper@37954:                    (_))" 9)
neuper@37906:   
neuper@37906:   Solve'_linear
neuper@37954:              :: "[bool,real,  
neuper@37954: 		    bool list] => bool list"
neuper@37954:                ("((Script Solve'_linear (_ _ =))//  
neuper@37954:                    (_))" 9)
neuper@37906: 
neuper@37906: (*17.9.02 aus SqRoot.thy------------------------------vvv---*)
neuper@37906: 
neuper@38001:   "is'_root'_free" :: "'a => bool"           ("is'_root'_free _" 10)
neuper@38001:   "contains'_root" :: "'a => bool"           ("contains'_root _" 10)
neuper@37906: 
neuper@37906:   Solve'_root'_equation 
neuper@37954:              :: "[bool,real,  
neuper@37954: 		    bool list] => bool list"
neuper@37954:                ("((Script Solve'_root'_equation (_ _ =))//  
neuper@37954:                    (_))" 9)
neuper@37906: 
neuper@37906:   Solve'_plain'_square 
neuper@37954:              :: "[bool,real,  
neuper@37954: 		    bool list] => bool list"
neuper@37954:                ("((Script Solve'_plain'_square (_ _ =))//  
neuper@37954:                    (_))" 9)
neuper@37906: 
neuper@37906:   Norm'_univar'_equation 
neuper@37954:              :: "[bool,real,  
neuper@37954: 		    bool] => bool"
neuper@37954:                ("((Script Norm'_univar'_equation (_ _ =))//  
neuper@37954:                    (_))" 9)
neuper@37906: 
neuper@37906:   STest'_simplify
neuper@37954:              :: "['z,  
neuper@37954: 		    'z] => 'z"
neuper@37954:                ("((Script STest'_simplify (_ =))//  
neuper@37954:                    (_))" 9)
neuper@37906: 
neuper@37906: (*17.9.02 aus SqRoot.thy------------------------------^^^---*)  
neuper@37906: 
neuper@37954: axioms (*TODO: prove as theorems*)
neuper@37906: 
neuper@37983:   radd_mult_distrib2:      "(k::real) * (m + n) = k * m + k * n"
neuper@37983:   rdistr_right_assoc:      "(k::real) + l * n + m * n = k + (l + m) * n"
neuper@37983:   rdistr_right_assoc_p:    "l * n + (m * n + (k::real)) = (l + m) * n + k"
neuper@37983:   rdistr_div_right:        "((k::real) + l) / n = k / n + l / n"
neuper@37983:   rcollect_right:
neuper@37906:           "[| l is_const; m is_const |] ==> (l::real)*n + m*n = (l + m) * n"
neuper@37983:   rcollect_one_left:
neuper@37906:           "m is_const ==> (n::real) + m * n = (1 + m) * n"
neuper@37983:   rcollect_one_left_assoc:
neuper@37906:           "m is_const ==> (k::real) + n + m * n = k + (1 + m) * n"
neuper@37983:   rcollect_one_left_assoc_p:
neuper@37906:           "m is_const ==> n + (m * n + (k::real)) = (1 + m) * n + k"
neuper@37906: 
neuper@37983:   rtwo_of_the_same:        "a + a = 2 * a"
neuper@37983:   rtwo_of_the_same_assoc:  "(x + a) + a = x + 2 * a"
neuper@37983:   rtwo_of_the_same_assoc_p:"a + (a + x) = 2 * a + x"
neuper@37906: 
neuper@37983:   rcancel_den:             "not(a=0) ==> a * (b / a) = b"
neuper@37983:   rcancel_const:           "[| a is_const; b is_const |] ==> a*(x/b) = a/b*x"
neuper@37983:   rshift_nominator:        "(a::real) * b / c = a / c * b"
neuper@37906: 
neuper@37983:   exp_pow:                 "(a ^^^ b) ^^^ c = a ^^^ (b * c)"
neuper@37983:   rsqare:                  "(a::real) * a = a ^^^ 2"
neuper@37983:   power_1:                 "(a::real) ^^^ 1 = a"
neuper@37983:   rbinom_power_2:          "((a::real) + b)^^^ 2 = a^^^ 2 + 2*a*b + b^^^ 2"
neuper@37906: 
neuper@37983:   rmult_1:                 "1 * k = (k::real)"
neuper@37983:   rmult_1_right:           "k * 1 = (k::real)"
neuper@37983:   rmult_0:                 "0 * k = (0::real)"
neuper@37983:   rmult_0_right:           "k * 0 = (0::real)"
neuper@37983:   radd_0:                  "0 + k = (k::real)"
neuper@37983:   radd_0_right:            "k + 0 = (k::real)"
neuper@37906: 
neuper@37983:   radd_real_const_eq:
neuper@37906:           "[| a is_const; c is_const; d is_const |] ==> a/d + c/d = (a+c)/(d::real)"
neuper@37983:   radd_real_const:
neuper@37906:           "[| a is_const; b is_const; c is_const; d is_const |] ==> a/b + c/d = (a*d + b*c)/(b*(d::real))"  
neuper@37906:   
neuper@37906: (*for AC-operators*)
neuper@37983:   radd_commute:            "(m::real) + (n::real) = n + m"
neuper@37983:   radd_left_commute:       "(x::real) + (y + z) = y + (x + z)"
neuper@37983:   radd_assoc:              "(m::real) + n + k = m + (n + k)"
neuper@37983:   rmult_commute:           "(m::real) * n = n * m"
neuper@37983:   rmult_left_commute:      "(x::real) * (y * z) = y * (x * z)"
neuper@37983:   rmult_assoc:             "(m::real) * n * k = m * (n * k)"
neuper@37906: 
neuper@37906: (*for equations: 'bdv' is a meta-constant*)
neuper@37983:   risolate_bdv_add:       "((k::real) + bdv = m) = (bdv = m + (-1)*k)"
neuper@37983:   risolate_bdv_mult_add:  "((k::real) + n*bdv = m) = (n*bdv = m + (-1)*k)"
neuper@37983:   risolate_bdv_mult:      "((n::real) * bdv = m) = (bdv = m / n)"
neuper@37906: 
neuper@37983:   rnorm_equation_add:
neuper@37906:       "~(b =!= 0) ==> (a = b) = (a + (-1)*b = 0)"
neuper@37906: 
neuper@37906: (*17.9.02 aus SqRoot.thy------------------------------vvv---*) 
neuper@37983:   root_ge0:            "0 <= a ==> 0 <= sqrt a"
neuper@37906:   (*should be dropped with better simplification in eval_rls ...*)
neuper@37983:   root_add_ge0:
neuper@37906: 	"[| 0 <= a; 0 <= b |] ==> (0 <= sqrt a + sqrt b) = True"
neuper@37983:   root_ge0_1:
neuper@37906: 	"[| 0<=a; 0<=b; 0<=c |] ==> (0 <= a * sqrt b + sqrt c) = True"
neuper@37983:   root_ge0_2:
neuper@37906: 	"[| 0<=a; 0<=b; 0<=c |] ==> (0 <= sqrt a + b * sqrt c) = True"
neuper@37906: 
neuper@37906: 
neuper@37983:   rroot_square_inv:         "(sqrt a)^^^ 2 = a"
neuper@37983:   rroot_times_root:         "sqrt a * sqrt b = sqrt(a*b)"
neuper@37983:   rroot_times_root_assoc:   "(a * sqrt b) * sqrt c = a * sqrt(b*c)"
neuper@37983:   rroot_times_root_assoc_p: "sqrt b * (sqrt c * a)= sqrt(b*c) * a"
neuper@37906: 
neuper@37906: 
neuper@37906: (*for root-equations*)
neuper@37983:   square_equation_left:
neuper@37906:           "[| 0 <= a; 0 <= b |] ==> (((sqrt a)=b)=(a=(b^^^ 2)))"
neuper@37983:   square_equation_right:
neuper@37906:           "[| 0 <= a; 0 <= b |] ==> ((a=(sqrt b))=((a^^^ 2)=b))"
neuper@37906:   (*causes frequently non-termination:*)
neuper@37983:   square_equation:  
neuper@37906:           "[| 0 <= a; 0 <= b |] ==> ((a=b)=((a^^^ 2)=b^^^ 2))"
neuper@37906:   
neuper@37983:   risolate_root_add:        "(a+  sqrt c = d) = (  sqrt c = d + (-1)*a)"
neuper@37983:   risolate_root_mult:       "(a+b*sqrt c = d) = (b*sqrt c = d + (-1)*a)"
neuper@37983:   risolate_root_div:        "(a * sqrt c = d) = (  sqrt c = d / a)"
neuper@37906: 
neuper@37906: (*for polynomial equations of degree 2; linear case in RatArith*)
neuper@37983:   mult_square:		"(a*bdv^^^2 = b) = (bdv^^^2 = b / a)"
neuper@37983:   constant_square:       "(a + bdv^^^2 = b) = (bdv^^^2 = b + -1*a)"
neuper@37983:   constant_mult_square:  "(a + b*bdv^^^2 = c) = (b*bdv^^^2 = c + -1*a)"
neuper@37906: 
neuper@37983:   square_equality: 
neuper@37906: 	     "0 <= a ==> (x^^^2 = a) = ((x=sqrt a) | (x=-1*sqrt a))"
neuper@37983:   square_equality_0:
neuper@37906: 	     "(x^^^2 = 0) = (x = 0)"
neuper@37906: 
neuper@37906: (*isolate root on the LEFT hand side of the equation
neuper@37906:   otherwise shuffling from left to right would not terminate*)  
neuper@37906: 
neuper@37983:   rroot_to_lhs:
neuper@37906:           "is_root_free a ==> (a = sqrt b) = (a + (-1)*sqrt b = 0)"
neuper@37983:   rroot_to_lhs_mult:
neuper@37906:           "is_root_free a ==> (a = c*sqrt b) = (a + (-1)*c*sqrt b = 0)"
neuper@37983:   rroot_to_lhs_add_mult:
neuper@37906:           "is_root_free a ==> (a = d+c*sqrt b) = (a + (-1)*c*sqrt b = d)"
neuper@37906: (*17.9.02 aus SqRoot.thy------------------------------^^^---*)  
neuper@37906: 
neuper@37954: ML {*
neuper@37972: val thy = @{theory};
neuper@37972: 
neuper@37954: (** evaluation of numerals and predicates **)
neuper@37954: 
neuper@37954: (*does a term contain a root ?*)
neuper@37954: fun eval_root_free (thmid:string) _ (t as (Const(op0,t0) $ arg)) thy = 
neuper@37954:   if strip_thy op0 <> "is'_root'_free" 
neuper@37954:     then raise error ("eval_root_free: wrong "^op0)
neuper@37954:   else if const_in (strip_thy op0) arg
neuper@37954: 	 then SOME (mk_thmid thmid "" 
neuper@37954: 		    ((Syntax.string_of_term (thy2ctxt thy)) arg) "", 
neuper@37954: 		    Trueprop $ (mk_equality (t, false_as_term)))
neuper@37954:        else SOME (mk_thmid thmid "" 
neuper@37954: 		  ((Syntax.string_of_term (thy2ctxt thy)) arg) "", 
neuper@37954: 		  Trueprop $ (mk_equality (t, true_as_term)))
neuper@37954:   | eval_root_free _ _ _ _ = NONE; 
neuper@37954: 
neuper@37954: (*does a term contain a root ?*)
neuper@37954: fun eval_contains_root (thmid:string) _ 
neuper@37954: 		       (t as (Const("Test.contains'_root",t0) $ arg)) thy = 
neuper@37954:     if member op = (ids_of arg) "sqrt"
neuper@37954:     then SOME (mk_thmid thmid "" 
neuper@37954: 			((Syntax.string_of_term (thy2ctxt thy)) arg) "", 
neuper@37954: 	       Trueprop $ (mk_equality (t, true_as_term)))
neuper@37954:     else SOME (mk_thmid thmid "" 
neuper@37954: 			((Syntax.string_of_term (thy2ctxt thy)) arg) "", 
neuper@37954: 	       Trueprop $ (mk_equality (t, false_as_term)))
neuper@37954:   | eval_contains_root _ _ _ _ = NONE; 
neuper@37954:   
neuper@37954: calclist':= overwritel (!calclist', 
neuper@37954:    [("is_root_free", ("Test.is'_root'_free", 
neuper@37981: 		      eval_root_free"#is_root_free_e")),
neuper@37954:     ("contains_root", ("Test.contains'_root",
neuper@37954: 		       eval_contains_root"#contains_root_"))
neuper@37954:     ]);
neuper@37954: 
neuper@37954: (** term order **)
neuper@38001: fun term_order (_:subst) tu = (term_ordI [] tu = LESS);
neuper@38001: *}
neuper@38001: ML {*
neuper@38001: (** rule sets **)
neuper@37954: 
neuper@37954: val testerls = 
neuper@37954:   Rls {id = "testerls", preconds = [], rew_ord = ("termlessI",termlessI), 
neuper@37954:       erls = e_rls, srls = Erls, 
neuper@37954:       calc = [], 
neuper@37969:       rules = [Thm ("refl",num_str @{thm refl}),
neuper@37965: 	       Thm ("real_le_refl",num_str @{thm real_le_refl}),
neuper@37969: 	       Thm ("radd_left_cancel_le",num_str @{thm radd_left_cancel_le}),
neuper@37969: 	       Thm ("not_true",num_str @{thm not_true}),
neuper@37969: 	       Thm ("not_false",num_str @{thm not_false}),
neuper@37969: 	       Thm ("and_true",num_str @{thm and_true}),
neuper@37969: 	       Thm ("and_false",num_str @{thm and_false}),
neuper@37969: 	       Thm ("or_true",num_str @{thm or_true}),
neuper@37969: 	       Thm ("or_false",num_str @{thm or_false}),
neuper@37969: 	       Thm ("and_commute",num_str @{thm and_commute}),
neuper@37969: 	       Thm ("or_commute",num_str @{thm or_commute}),
neuper@37954: 
neuper@37954: 	       Calc ("Atools.is'_const",eval_const "#is_const_"),
neuper@37954: 	       Calc ("Tools.matches",eval_matches ""),
neuper@37954:     
neuper@37954: 	       Calc ("op +",eval_binop "#add_"),
neuper@37954: 	       Calc ("op *",eval_binop "#mult_"),
neuper@37954: 	       Calc ("Atools.pow" ,eval_binop "#power_"),
neuper@37954: 		    
neuper@37954: 	       Calc ("op <",eval_equ "#less_"),
neuper@37954: 	       Calc ("op <=",eval_equ "#less_equal_"),
neuper@37954: 	     	    
neuper@37954: 	       Calc ("Atools.ident",eval_ident "#ident_")],
neuper@37954:       scr = Script ((term_of o the o (parse thy)) 
neuper@37954:       "empty_script")
neuper@37954:       }:rls;      
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: (*.for evaluation of conditions in rewrite rules.*)
neuper@37954: (*FIXXXXXXME 10.8.02: handle like _simplify*)
neuper@37954: val tval_rls =  
neuper@37954:   Rls{id = "tval_rls", preconds = [], 
neuper@37954:       rew_ord = ("sqrt_right",sqrt_right false (theory "Pure")), 
neuper@37954:       erls=testerls,srls = e_rls, 
neuper@37954:       calc=[],
neuper@37969:       rules = [Thm ("refl",num_str @{thm refl}),
neuper@37965: 	       Thm ("real_le_refl",num_str @{thm real_le_refl}),
neuper@37969: 	       Thm ("radd_left_cancel_le",num_str @{thm radd_left_cancel_le}),
neuper@37969: 	       Thm ("not_true",num_str @{thm not_true}),
neuper@37969: 	       Thm ("not_false",num_str @{thm not_false}),
neuper@37969: 	       Thm ("and_true",num_str @{thm and_true}),
neuper@37969: 	       Thm ("and_false",num_str @{thm and_false}),
neuper@37969: 	       Thm ("or_true",num_str @{thm or_true}),
neuper@37969: 	       Thm ("or_false",num_str @{thm or_false}),
neuper@37969: 	       Thm ("and_commute",num_str @{thm and_commute}),
neuper@38001: 	       Thm ("or_commute",num_str @{thm or_commute}),
neuper@37954: 
neuper@37969: 	       Thm ("real_diff_minus",num_str @{thm real_diff_minus}),
neuper@37954: 
neuper@37969: 	       Thm ("root_ge0",num_str @{thm root_ge0}),
neuper@37969: 	       Thm ("root_add_ge0",num_str @{thm root_add_ge0}),
neuper@37969: 	       Thm ("root_ge0_1",num_str @{thm root_ge0_1}),
neuper@37969: 	       Thm ("root_ge0_2",num_str @{thm root_ge0_2}),
neuper@37954: 
neuper@37954: 	       Calc ("Atools.is'_const",eval_const "#is_const_"),
neuper@37981: 	       Calc ("Test.is'_root'_free",eval_root_free "#is_root_free_e"),
neuper@37954: 	       Calc ("Tools.matches",eval_matches ""),
neuper@37954: 	       Calc ("Test.contains'_root",
neuper@37954: 		     eval_contains_root"#contains_root_"),
neuper@37954:     
neuper@37954: 	       Calc ("op +",eval_binop "#add_"),
neuper@37954: 	       Calc ("op *",eval_binop "#mult_"),
neuper@37982: 	       Calc ("NthRoot.sqrt",eval_sqrt "#sqrt_"),
neuper@37954: 	       Calc ("Atools.pow" ,eval_binop "#power_"),
neuper@37954: 		    
neuper@37954: 	       Calc ("op <",eval_equ "#less_"),
neuper@37954: 	       Calc ("op <=",eval_equ "#less_equal_"),
neuper@37954: 	     	    
neuper@37954: 	       Calc ("Atools.ident",eval_ident "#ident_")],
neuper@37954:       scr = Script ((term_of o the o (parse thy)) 
neuper@37954:       "empty_script")
neuper@37954:       }:rls;      
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: 
neuper@37967: ruleset' := overwritelthy @{theory} (!ruleset',
neuper@37954:   [("testerls", prep_rls testerls)
neuper@37954:    ]);
neuper@37954: 
neuper@37954: 
neuper@37954: (*make () dissappear*)   
neuper@37954: val rearrange_assoc =
neuper@37954:   Rls{id = "rearrange_assoc", preconds = [], 
neuper@37954:       rew_ord = ("e_rew_ord",e_rew_ord), 
neuper@37954:       erls = e_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
neuper@37954:       rules = 
neuper@37974:       [Thm ("sym_add_assoc",num_str (@{thm add_assoc} RS @{thm sym})),
neuper@37969:        Thm ("sym_rmult_assoc",num_str (@{thm rmult_assoc} RS @{thm sym}))],
neuper@37954:       scr = Script ((term_of o the o (parse thy)) 
neuper@37954:       "empty_script")
neuper@37954:       }:rls;      
neuper@37954: 
neuper@37954: val ac_plus_times =
neuper@37954:   Rls{id = "ac_plus_times", preconds = [], rew_ord = ("term_order",term_order),
neuper@37954:       erls = e_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
neuper@37954:       rules = 
neuper@37969:       [Thm ("radd_commute",num_str @{thm radd_commute}),
neuper@37969:        Thm ("radd_left_commute",num_str @{thm radd_left_commute}),
neuper@37974:        Thm ("add_assoc",num_str @{thm add_assoc}),
neuper@37969:        Thm ("rmult_commute",num_str @{thm rmult_commute}),
neuper@37969:        Thm ("rmult_left_commute",num_str @{thm rmult_left_commute}),
neuper@37969:        Thm ("rmult_assoc",num_str @{thm rmult_assoc})],
neuper@37954:       scr = Script ((term_of o the o (parse thy)) 
neuper@37954:       "empty_script")
neuper@37954:       }:rls;      
neuper@37954: 
neuper@37969: (*todo: replace by Rewrite("rnorm_equation_add",num_str @{thm rnorm_equation_add)*)
neuper@37954: val norm_equation =
neuper@37954:   Rls{id = "norm_equation", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
neuper@37954:       erls = tval_rls, srls = e_rls, calc = [], (*asm_thm=[],*)
neuper@38001:       rules = [Thm ("rnorm_equation_add",num_str @{thm rnorm_equation_add})
neuper@37954: 	       ],
neuper@37954:       scr = Script ((term_of o the o (parse thy)) 
neuper@37954:       "empty_script")
neuper@37954:       }:rls;      
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: (** rule sets **)
neuper@37954: 
neuper@37954: val STest_simplify =     (*   vv--- not changed to real by parse*)
neuper@38001:   "Script STest_simplify (t_t::'z) =                           " ^
neuper@37954:   "(Repeat" ^
neuper@37954:   "    ((Try (Repeat (Rewrite real_diff_minus False))) @@        " ^
neuper@37954:   "     (Try (Repeat (Rewrite radd_mult_distrib2 False))) @@  " ^
neuper@37954:   "     (Try (Repeat (Rewrite rdistr_right_assoc False))) @@  " ^
neuper@37954:   "     (Try (Repeat (Rewrite rdistr_right_assoc_p False))) @@" ^
neuper@37954:   "     (Try (Repeat (Rewrite rdistr_div_right False))) @@    " ^
neuper@37954:   "     (Try (Repeat (Rewrite rbinom_power_2 False))) @@      " ^
neuper@37954: 	
neuper@37954:   "     (Try (Repeat (Rewrite radd_commute False))) @@        " ^
neuper@37954:   "     (Try (Repeat (Rewrite radd_left_commute False))) @@   " ^
neuper@37974:   "     (Try (Repeat (Rewrite add_assoc False))) @@          " ^
neuper@37954:   "     (Try (Repeat (Rewrite rmult_commute False))) @@       " ^
neuper@37954:   "     (Try (Repeat (Rewrite rmult_left_commute False))) @@  " ^
neuper@37954:   "     (Try (Repeat (Rewrite rmult_assoc False))) @@         " ^
neuper@37954: 	
neuper@37954:   "     (Try (Repeat (Rewrite radd_real_const_eq False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite radd_real_const False))) @@   " ^
neuper@37975:   "     (Try (Repeat (Calculate PLUS))) @@   " ^
neuper@37975:   "     (Try (Repeat (Calculate TIMES))) @@   " ^
neuper@37954:   "     (Try (Repeat (Calculate divide_))) @@" ^
neuper@37975:   "     (Try (Repeat (Calculate POWER))) @@  " ^
neuper@37954: 	
neuper@37954:   "     (Try (Repeat (Rewrite rcollect_right False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rcollect_one_left False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rcollect_one_left_assoc False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rcollect_one_left_assoc_p False))) @@   " ^
neuper@37954: 	
neuper@37954:   "     (Try (Repeat (Rewrite rshift_nominator False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rcancel_den False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rroot_square_inv False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rroot_times_root False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rroot_times_root_assoc_p False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rsqare False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite power_1 False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rtwo_of_the_same False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rtwo_of_the_same_assoc_p False))) @@   " ^
neuper@37954: 	
neuper@37954:   "     (Try (Repeat (Rewrite rmult_1 False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rmult_1_right False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rmult_0 False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite rmult_0_right False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite radd_0 False))) @@   " ^
neuper@37954:   "     (Try (Repeat (Rewrite radd_0_right False)))) " ^
neuper@38001:   " t_t)";
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: (* expects * distributed over + *)
neuper@37954: val Test_simplify =
neuper@37954:   Rls{id = "Test_simplify", preconds = [], 
neuper@37954:       rew_ord = ("sqrt_right",sqrt_right false (theory "Pure")),
neuper@37954:       erls = tval_rls, srls = e_rls, 
neuper@37954:       calc=[(*since 040209 filled by prep_rls*)],
neuper@37954:       (*asm_thm = [],*)
neuper@37954:       rules = [
neuper@37969: 	       Thm ("real_diff_minus",num_str @{thm real_diff_minus}),
neuper@37969: 	       Thm ("radd_mult_distrib2",num_str @{thm radd_mult_distrib2}),
neuper@37969: 	       Thm ("rdistr_right_assoc",num_str @{thm rdistr_right_assoc}),
neuper@37969: 	       Thm ("rdistr_right_assoc_p",num_str @{thm rdistr_right_assoc_p}),
neuper@37969: 	       Thm ("rdistr_div_right",num_str @{thm rdistr_div_right}),
neuper@37969: 	       Thm ("rbinom_power_2",num_str @{thm rbinom_power_2}),	       
neuper@37954: 
neuper@37969:                Thm ("radd_commute",num_str @{thm radd_commute}), 
neuper@37969: 	       Thm ("radd_left_commute",num_str @{thm radd_left_commute}),
neuper@37974: 	       Thm ("add_assoc",num_str @{thm add_assoc}),
neuper@37969: 	       Thm ("rmult_commute",num_str @{thm rmult_commute}),
neuper@37969: 	       Thm ("rmult_left_commute",num_str @{thm rmult_left_commute}),
neuper@37969: 	       Thm ("rmult_assoc",num_str @{thm rmult_assoc}),
neuper@37954: 
neuper@37969: 	       Thm ("radd_real_const_eq",num_str @{thm radd_real_const_eq}),
neuper@37969: 	       Thm ("radd_real_const",num_str @{thm radd_real_const}),
neuper@37954: 	       (* these 2 rules are invers to distr_div_right wrt. termination.
neuper@37954: 		  thus they MUST be done IMMEDIATELY before calc *)
neuper@37954: 	       Calc ("op +", eval_binop "#add_"), 
neuper@37954: 	       Calc ("op *", eval_binop "#mult_"),
neuper@37981: 	       Calc ("HOL.divide", eval_cancel "#divide_e"),
neuper@37954: 	       Calc ("Atools.pow", eval_binop "#power_"),
neuper@37954: 
neuper@37969: 	       Thm ("rcollect_right",num_str @{thm rcollect_right}),
neuper@37969: 	       Thm ("rcollect_one_left",num_str @{thm rcollect_one_left}),
neuper@37969: 	       Thm ("rcollect_one_left_assoc",num_str @{thm rcollect_one_left_assoc}),
neuper@37969: 	       Thm ("rcollect_one_left_assoc_p",num_str @{thm rcollect_one_left_assoc_p}),
neuper@37954: 
neuper@37969: 	       Thm ("rshift_nominator",num_str @{thm rshift_nominator}),
neuper@37969: 	       Thm ("rcancel_den",num_str @{thm rcancel_den}),
neuper@37969: 	       Thm ("rroot_square_inv",num_str @{thm rroot_square_inv}),
neuper@37969: 	       Thm ("rroot_times_root",num_str @{thm rroot_times_root}),
neuper@37969: 	       Thm ("rroot_times_root_assoc_p",num_str @{thm rroot_times_root_assoc_p}),
neuper@37969: 	       Thm ("rsqare",num_str @{thm rsqare}),
neuper@38001: 	       Thm ("power_1",num_str @{thm power_1}),
neuper@37969: 	       Thm ("rtwo_of_the_same",num_str @{thm rtwo_of_the_same}),
neuper@37969: 	       Thm ("rtwo_of_the_same_assoc_p",num_str @{thm rtwo_of_the_same_assoc_p}),
neuper@37954: 
neuper@37969: 	       Thm ("rmult_1",num_str @{thm rmult_1}),
neuper@37969: 	       Thm ("rmult_1_right",num_str @{thm rmult_1_right}),
neuper@37969: 	       Thm ("rmult_0",num_str @{thm rmult_0}),
neuper@37969: 	       Thm ("rmult_0_right",num_str @{thm rmult_0_right}),
neuper@37969: 	       Thm ("radd_0",num_str @{thm radd_0}),
neuper@37969: 	       Thm ("radd_0_right",num_str @{thm radd_0_right})
neuper@37954: 	       ],
neuper@37954:       scr = Script ((term_of o the o (parse thy)) "empty_script")
neuper@37954: 		    (*since 040209 filled by prep_rls: STest_simplify*)
neuper@37954:       }:rls;      
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: 
neuper@37954: (** rule sets **)
neuper@37954: 
neuper@37954: 
neuper@37954: 
neuper@37954: (*isolate the root in a root-equation*)
neuper@37954: val isolate_root =
neuper@37954:   Rls{id = "isolate_root", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord), 
neuper@37954:       erls=tval_rls,srls = e_rls, calc=[],(*asm_thm = [], *)
neuper@37969:       rules = [Thm ("rroot_to_lhs",num_str @{thm rroot_to_lhs}),
neuper@37969: 	       Thm ("rroot_to_lhs_mult",num_str @{thm rroot_to_lhs_mult}),
neuper@37969: 	       Thm ("rroot_to_lhs_add_mult",num_str @{thm rroot_to_lhs_add_mult}),
neuper@37969: 	       Thm ("risolate_root_add",num_str @{thm risolate_root_add}),
neuper@37969: 	       Thm ("risolate_root_mult",num_str @{thm risolate_root_mult}),
neuper@37969: 	       Thm ("risolate_root_div",num_str @{thm risolate_root_div})       ],
neuper@37954:       scr = Script ((term_of o the o (parse thy)) 
neuper@37954:       "empty_script")
neuper@37954:       }:rls;
neuper@37954: 
neuper@37954: (*isolate the bound variable in an equation; 'bdv' is a meta-constant*)
neuper@37954: val isolate_bdv =
neuper@37954:     Rls{id = "isolate_bdv", preconds = [], rew_ord = ("e_rew_ord",e_rew_ord),
neuper@37954: 	erls=tval_rls,srls = e_rls, calc=[],(*asm_thm = [], *)
neuper@37954: 	rules = 
neuper@37969: 	[Thm ("risolate_bdv_add",num_str @{thm risolate_bdv_add}),
neuper@37969: 	 Thm ("risolate_bdv_mult_add",num_str @{thm risolate_bdv_mult_add}),
neuper@37969: 	 Thm ("risolate_bdv_mult",num_str @{thm risolate_bdv_mult}),
neuper@38001: 	 Thm ("mult_square",num_str @{thm mult_square}),
neuper@38001: 	 Thm ("constant_square",num_str @{thm constant_square}),
neuper@38001: 	 Thm ("constant_mult_square",num_str @{thm constant_mult_square})
neuper@37954: 	 ],
neuper@37954: 	scr = Script ((term_of o the o (parse thy)) 
neuper@37954: 			  "empty_script")
neuper@37954: 	}:rls;      
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: 
neuper@37954: (* association list for calculate_, calculate
neuper@37954:    "op +" etc. not usable in scripts *)
neuper@37954: val calclist = 
neuper@37954:     [
neuper@37954:      (*as Tools.ML*)
neuper@37954:      ("Vars"    ,("Tools.Vars"    ,eval_var "#Vars_")),
neuper@37954:      ("matches",("Tools.matches",eval_matches "#matches_")),
neuper@37954:      ("lhs"    ,("Tools.lhs"    ,eval_lhs "")),
neuper@37954:      (*aus Atools.ML*)
neuper@37954:      ("PLUS"    ,("op +"        ,eval_binop "#add_")),
neuper@37954:      ("TIMES"   ,("op *"        ,eval_binop "#mult_")),
neuper@37981:      ("DIVIDE" ,("HOL.divide"  ,eval_cancel "#divide_e")),
neuper@37954:      ("POWER"  ,("Atools.pow"  ,eval_binop "#power_")),
neuper@37954:      ("is_const",("Atools.is'_const",eval_const "#is_const_")),
neuper@37954:      ("le"      ,("op <"        ,eval_equ "#less_")),
neuper@37954:      ("leq"     ,("op <="       ,eval_equ "#less_equal_")),
neuper@37954:      ("ident"   ,("Atools.ident",eval_ident "#ident_")),
neuper@37954:      (*von hier (ehem.SqRoot*)
neuper@37982:      ("sqrt"    ,("NthRoot.sqrt"   ,eval_sqrt "#sqrt_")),
neuper@37981:      ("Test.is_root_free",("is'_root'_free", eval_root_free"#is_root_free_e")),
neuper@37954:      ("Test.contains_root",("contains'_root",
neuper@37954: 			    eval_contains_root"#contains_root_"))
neuper@37954:      ];
neuper@37954: 
neuper@37967: ruleset' := overwritelthy @{theory} (!ruleset',
neuper@37954:   [("Test_simplify", prep_rls Test_simplify),
neuper@37954:    ("tval_rls", prep_rls tval_rls),
neuper@37954:    ("isolate_root", prep_rls isolate_root),
neuper@37954:    ("isolate_bdv", prep_rls isolate_bdv),
neuper@37954:    ("matches", 
neuper@37954:     prep_rls (append_rls "matches" testerls 
neuper@37954: 			 [Calc ("Tools.matches",eval_matches "#matches_")]))
neuper@37954:    ]);
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: (** problem types **)
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test" [] e_pblID
neuper@37954:  (["test"],
neuper@37954:   [],
neuper@37954:   e_rls, NONE, []));
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_equ" [] e_pblID
neuper@37954:  (["equation","test"],
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@37981:    ("#Where" ,["matches (?a = ?b) e_e"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"])
neuper@37954:   ],
neuper@37954:   assoc_rls "matches",
neuper@37981:   SOME "solve (e_e::bool, v_v)", []));
neuper@37954: 
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_uni" [] e_pblID
neuper@37954:  (["univariate","equation","test"],
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@37981:    ("#Where" ,["matches (?a = ?b) e_e"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"])
neuper@37954:   ],
neuper@37954:   assoc_rls "matches",
neuper@37981:   SOME "solve (e_e::bool, v_v)", []));
neuper@37954: 
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_uni_lin" [] e_pblID
neuper@37954:  (["linear","univariate","equation","test"],
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@38001:    ("#Where" ,["(matches (   v_v = 0) e_e) | (matches (   ?b*v_v = 0) e_e) |" ^
neuper@38001: 	       "(matches (?a+v_v = 0) e_e) | (matches (?a+?b*v_v = 0) e_e)  "]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"])
neuper@37954:   ],
neuper@37954:   assoc_rls "matches", 
neuper@37981:   SOME "solve (e_e::bool, v_v)", [["Test","solve_linear"]]));
neuper@37954: 
neuper@37954: (*25.8.01 ------
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy
neuper@37972:  (["thy"],
neuper@38001:   [("#Given" ,"boolTestGiven g_g"),
neuper@37994:    ("#Find"  ,"boolTestFind f_f")
neuper@37954:   ],
neuper@37954:   []));
neuper@37954: 
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy
neuper@37972:  (["testeq","thy"],
neuper@38001:   [("#Given" ,"boolTestGiven g_g"),
neuper@37994:    ("#Find"  ,"boolTestFind f_f")
neuper@37954:   ],
neuper@37954:   []));
neuper@37954: 
neuper@37954: 
neuper@37981: val ttt = (term_of o the o (parse (theory "Isac"))) "(matches (   v_v = 0) e_e)";
neuper@37954: 
neuper@37954:  ------ 25.8.01*)
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: (** methods **)
neuper@37954: store_met
neuper@37954:  (prep_met (theory "Diff") "met_test" [] e_metID
neuper@37954:  (["Test"],
neuper@37954:    [],
neuper@37954:    {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
neuper@37954:     crls=Atools_erls, nrls=e_rls(*,
neuper@37954:     asm_rls=[],asm_thm=[]*)}, "empty_script"));
neuper@37954: (*
neuper@37954: store_met
neuper@37954:  (prep_met (theory "Script")
neuper@37954:  (e_metID,(*empty method*)
neuper@37954:    [],
neuper@37954:    {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
neuper@37954:     asm_rls=[],asm_thm=[]},
neuper@37954:    "Undef"));*)
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_met
neuper@37972:  (prep_met thy "met_test_solvelin" [] e_metID
neuper@37954:  (["Test","solve_linear"]:metID,
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@37981:     ("#Where" ,["matches (?a = ?b) e_e"]),
neuper@38009:     ("#Find"  ,["solutions v_i'''"])
neuper@37954:     ],
neuper@38001:    {rew_ord' = "e_rew_ord", rls' = tval_rls, srls = e_rls,
neuper@38001:     prls = assoc_rls "matches", calc = [], crls = tval_rls,
neuper@38001:     nrls = Test_simplify},
neuper@38001:  "Script Solve_linear (e_e::bool) (v_v::real)=                     " ^
neuper@38001:  "(let e_e =                                                       " ^
neuper@38001:  "  Repeat                                                         " ^
neuper@38001:  "    (((Rewrite_Set_Inst [(bdv,v_v::real)] isolate_bdv False) @@  " ^
neuper@37981:  "      (Rewrite_Set Test_simplify False))) e_e" ^
neuper@38001:  " in [e_e::bool])"
neuper@37954:  )
neuper@37972: (*, prep_met thy (*test for equations*)
neuper@37954:  (["Test","testeq"]:metID,
neuper@38001:   [("#Given" ,["boolTestGiven g_g"]),
neuper@37994:    ("#Find"  ,["boolTestFind f_f"])
neuper@37954:     ],
neuper@37954:   {rew_ord'="e_rew_ord",rls'="tval_rls",asm_rls=[],
neuper@37954:    asm_thm=[("square_equation_left","")]},
neuper@38001:  "Script Testeq (e_q::bool) =                                         " ^
neuper@37954:    "Repeat                                                            " ^
neuper@38001:    " (let e_e = Try (Repeat (Rewrite rroot_square_inv False e_q));      " ^
neuper@37981:    "      e_e = Try (Repeat (Rewrite square_equation_left True e_e)); " ^
neuper@37981:    "      e_e = Try (Repeat (Rewrite rmult_0 False e_e))                " ^
neuper@37981:    "   in e_e) Until (is_root_free e_e)" (*deleted*)
neuper@37954:  )
neuper@37954: , ---------27.4.02*)
neuper@37954: );
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: 
neuper@37967: ruleset' := overwritelthy @{theory} (!ruleset',
neuper@37954:   [("norm_equation", prep_rls norm_equation),
neuper@37954:    ("ac_plus_times", prep_rls ac_plus_times),
neuper@37954:    ("rearrange_assoc", prep_rls rearrange_assoc)
neuper@37954:    ]);
neuper@37954: 
neuper@37954: 
neuper@37954: fun bin_o (Const (op_,(Type ("fun",
neuper@37954: 	   [Type (s2,[]),Type ("fun",
neuper@37954: 	    [Type (s4,tl4),Type (s5,tl5)])])))) = 
neuper@37954:     if (s2=s4)andalso(s4=s5)then[op_]else[]
neuper@37954:     | bin_o _                                   = [];
neuper@37954: 
neuper@37954: fun bin_op (t1 $ t2) = union op = (bin_op t1) (bin_op t2)
neuper@37954:   | bin_op t         =  bin_o t;
neuper@37954: fun is_bin_op t = ((bin_op t)<>[]);
neuper@37954: 
neuper@37954: fun bin_op_arg1 ((Const (op_,(Type ("fun",
neuper@37954: 	   [Type (s2,[]),Type ("fun",
neuper@37954: 	    [Type (s4,tl4),Type (s5,tl5)])]))))$ arg1 $ arg2) = 
neuper@37954:     arg1;
neuper@37954: fun bin_op_arg2 ((Const (op_,(Type ("fun",
neuper@37954: 	   [Type (s2,[]),Type ("fun",
neuper@37954: 	    [Type (s4,tl4),Type (s5,tl5)])]))))$ arg1 $ arg2) = 
neuper@37954:     arg2;
neuper@37954: 
neuper@37954: 
neuper@37954: exception NO_EQUATION_TERM;
neuper@37954: fun is_equation ((Const ("op =",(Type ("fun",
neuper@37954: 		 [Type (_,[]),Type ("fun",
neuper@37954: 		  [Type (_,[]),Type ("bool",[])])])))) $ _ $ _) 
neuper@37954:                   = true
neuper@37954:   | is_equation _ = false;
neuper@37954: fun equ_lhs ((Const ("op =",(Type ("fun",
neuper@37954: 		 [Type (_,[]),Type ("fun",
neuper@37954: 		  [Type (_,[]),Type ("bool",[])])])))) $ l $ r) 
neuper@37954:               = l
neuper@37954:   | equ_lhs _ = raise NO_EQUATION_TERM;
neuper@37954: fun equ_rhs ((Const ("op =",(Type ("fun",
neuper@37954: 		 [Type (_,[]),Type ("fun",
neuper@37954: 		  [Type (_,[]),Type ("bool",[])])])))) $ l $ r) 
neuper@37954:               = r
neuper@37954:   | equ_rhs _ = raise NO_EQUATION_TERM;
neuper@37954: 
neuper@37954: 
neuper@37954: fun atom (Const (_,Type (_,[])))           = true
neuper@37954:   | atom (Free  (_,Type (_,[])))           = true
neuper@37954:   | atom (Var   (_,Type (_,[])))           = true
neuper@37954: (*| atom (_     (_,"?DUMMY"   ))           = true ..ML-error *)
neuper@37954:   | atom((Const ("Bin.integ_of_bin",_)) $ _) = true
neuper@37954:   | atom _                                 = false;
neuper@37954: 
neuper@37954: fun varids (Const  (s,Type (_,[])))         = [strip_thy s]
neuper@37954:   | varids (Free   (s,Type (_,[])))         = if is_no s then []
neuper@37954: 					      else [strip_thy s]
neuper@37954:   | varids (Var((s,_),Type (_,[])))         = [strip_thy s]
neuper@37954: (*| varids (_      (s,"?DUMMY"   ))         =   ..ML-error *)
neuper@37954:   | varids((Const ("Bin.integ_of_bin",_)) $ _)= [](*8.01: superfluous?*)
neuper@37954:   | varids (Abs(a,T,t)) = union op = [a] (varids t)
neuper@37954:   | varids (t1 $ t2) = union op = (varids t1) (varids t2)
neuper@37954:   | varids _         = [];
neuper@37954: (*> val t = term_of (hd (parse Diophant.thy "x"));
neuper@37954: val t = Free ("x","?DUMMY") : term
neuper@37954: > varids t;
neuper@37954: val it = [] : string list          [] !!! *)
neuper@37954: 
neuper@37954: 
neuper@37954: fun bin_ops_only ((Const op_) $ t1 $ t2) = 
neuper@37954:     if(is_bin_op (Const op_))
neuper@37954:     then(bin_ops_only t1)andalso(bin_ops_only t2)
neuper@37954:     else false
neuper@37954:   | bin_ops_only t =
neuper@37954:     if atom t then true else bin_ops_only t;
neuper@37954: 
neuper@37954: fun polynomial opl t bdVar = (* bdVar TODO *)
neuper@37954:     subset op = (bin_op t, opl) andalso (bin_ops_only t);
neuper@37954: 
neuper@37954: fun poly_equ opl bdVar t = is_equation t (* bdVar TODO *) 
neuper@37954:     andalso polynomial opl (equ_lhs t) bdVar 
neuper@37954:     andalso polynomial opl (equ_rhs t) bdVar
neuper@37954:     andalso (subset op = (varids bdVar, varids (equ_lhs t)) orelse
neuper@37954:              subset op = (varids bdVar, varids (equ_lhs t)));
neuper@37954: 
neuper@37954: (*fun max is =
neuper@37954:     let fun max_ m [] = m 
neuper@37954: 	  | max_ m (i::is) = if m<i then max_ i is else max_ m is;
neuper@37954:     in max_ (hd is) is end;
neuper@37954: > max [1,5,3,7,4,2];
neuper@37954: val it = 7 : int  *)
neuper@37954: 
neuper@37954: fun max (a,b) = if a < b then b else a;
neuper@37954: 
neuper@37954: fun degree addl mul bdVar t =
neuper@37954: let
neuper@37954: fun deg _ _ v (Const  (s,Type (_,[])))         = if v=strip_thy s then 1 else 0
neuper@37954:   | deg _ _ v (Free   (s,Type (_,[])))         = if v=strip_thy s then 1 else 0
neuper@37954:   | deg _ _ v (Var((s,_),Type (_,[])))         = if v=strip_thy s then 1 else 0
neuper@37954: (*| deg _ _ v (_     (s,"?DUMMY"   ))          =   ..ML-error *) 
neuper@37954:   | deg _ _ v((Const ("Bin.integ_of_bin",_)) $ _ )= 0 
neuper@37954:   | deg addl mul v (h $ t1 $ t2) =
neuper@37954:     if subset op = (bin_op h, addl)
neuper@37954:     then max (deg addl mul v t1  ,deg addl mul v t2)
neuper@37954:     else (*mul!*)(deg addl mul v t1)+(deg addl mul v t2)
neuper@37954: in if polynomial (addl @ [mul]) t bdVar
neuper@37954:    then SOME (deg addl mul (id_of bdVar) t) else (NONE:int option)
neuper@37954: end;
neuper@37954: fun degree_ addl mul bdVar t = (* do not export *)
neuper@37954:     let fun opt (SOME i)= i
neuper@37954: 	  | opt  NONE   = 0
neuper@37954: in opt (degree addl mul bdVar t) end;
neuper@37954: 
neuper@37954: 
neuper@37954: fun linear addl mul t bdVar = (degree_ addl mul bdVar t)<2;
neuper@37954: 
neuper@37954: fun linear_equ addl mul bdVar t =
neuper@37954:     if is_equation t 
neuper@37954:     then let val degl = degree_ addl mul bdVar (equ_lhs t);
neuper@37954: 	     val degr = degree_ addl mul bdVar (equ_rhs t)
neuper@37954: 	 in if (degl>0 orelse degr>0)andalso max(degl,degr)<2
neuper@37954: 		then true else false
neuper@37954: 	 end
neuper@37954:     else false;
neuper@37954: (* strip_thy op_  before *)
neuper@37954: fun is_div_op (dv,(Const (op_,(Type ("fun",
neuper@37954: 	   [Type (s2,[]),Type ("fun",
neuper@37954: 	    [Type (s4,tl4),Type (s5,tl5)])])))) )= (dv = strip_thy op_)
neuper@37954:   | is_div_op _ = false;
neuper@37954: 
neuper@37954: fun is_denom bdVar div_op t =
neuper@37954:     let fun is bool[v]dv (Const  (s,Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
neuper@37954: 	  | is bool[v]dv (Free   (s,Type(_,[])))= bool andalso(if v=strip_thy s then true else false) 
neuper@37954: 	  | is bool[v]dv (Var((s,_),Type(_,[])))= bool andalso(if v=strip_thy s then true else false)
neuper@37954: 	  | is bool[v]dv((Const ("Bin.integ_of_bin",_)) $ _) = false
neuper@37954: 	  | is bool[v]dv (h$n$d) = 
neuper@37954: 	      if is_div_op(dv,h) 
neuper@37954: 	      then (is false[v]dv n)orelse(is true[v]dv d)
neuper@37954: 	      else (is bool [v]dv n)orelse(is bool[v]dv d)
neuper@37954: in is false (varids bdVar) (strip_thy div_op) t end;
neuper@37954: 
neuper@37954: 
neuper@37954: fun rational t div_op bdVar = 
neuper@37954:     is_denom bdVar div_op t andalso bin_ops_only t;
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: 
neuper@37954: (** problem types **)
neuper@37954: 
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_uni_plain2" [] e_pblID
neuper@37954:  (["plain_square","univariate","equation","test"],
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@38001:    ("#Where" ,["(matches (?a + ?b*v_v ^^^2 = 0) e_e) |" ^
neuper@38001: 	       "(matches (     ?b*v_v ^^^2 = 0) e_e) |" ^
neuper@37981: 	       "(matches (?a +    v_v ^^^2 = 0) e_e) |" ^
neuper@37981: 	       "(matches (        v_v ^^^2 = 0) e_e)"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"])
neuper@37954:   ],
neuper@37954:   assoc_rls "matches", 
neuper@37981:   SOME "solve (e_e::bool, v_v)", [["Test","solve_plain_square"]]));
neuper@37954: (*
neuper@38001:  val e_e = (term_of o the o (parse thy)) "e_e::bool";
neuper@37954:  val ve = (term_of o the o (parse thy)) "4 + 3*x^^^2 = 0";
neuper@37954:  val env = [(e_,ve)];
neuper@37954: 
neuper@37954:  val pre = (term_of o the o (parse thy))
neuper@38001: 	      "(matches (a + b*v_v ^^^2 = 0, e_e::bool)) |" ^
neuper@38001: 	      "(matches (    b*v_v ^^^2 = 0, e_e::bool)) |" ^
neuper@37981: 	      "(matches (a +   v_v ^^^2 = 0, e_e::bool)) |" ^
neuper@37981: 	      "(matches (      v_v ^^^2 = 0, e_e::bool))";
neuper@37954:  val prei = subst_atomic env pre;
neuper@37954:  val cpre = (cterm_of thy) prei;
neuper@37954: 
neuper@37954:  val SOME (ct,_) = rewrite_set_ thy false tval_rls cpre;
neuper@37954: val ct = "True | False | False | False" : cterm 
neuper@37954: 
neuper@37954: > val SOME (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
neuper@37954: > val SOME (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
neuper@37954: > val SOME (ct,_) = rewrite_ thy sqrt_right tval_rls false or_false ct;
neuper@37954: val ct = "True" : cterm
neuper@37954: 
neuper@37954: *)
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_uni_poly" [] e_pblID
neuper@37954:  (["polynomial","univariate","equation","test"],
neuper@38001:   [("#Given" ,["equality (v_v ^^^2 + p_p * v_v + q__q = 0)","solveFor v_v"]),
neuper@37954:    ("#Where" ,["False"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"]) 
neuper@37954:   ],
neuper@37981:   e_rls, SOME "solve (e_e::bool, v_v)", []));
neuper@37954: 
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_uni_poly_deg2" [] e_pblID
neuper@37954:  (["degree_two","polynomial","univariate","equation","test"],
neuper@38001:   [("#Given" ,["equality (v_v ^^^2 + p_p * v_v + q__q = 0)","solveFor v_v"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"]) 
neuper@37954:   ],
neuper@38001:   e_rls, SOME "solve (v_v ^^^2 + p_p * v_v + q__q = 0, v_v)", []));
neuper@37954: 
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_uni_poly_deg2_pq" [] e_pblID
neuper@37954:  (["pq_formula","degree_two","polynomial","univariate","equation","test"],
neuper@38001:   [("#Given" ,["equality (v_v ^^^2 + p_p * v_v + q__q = 0)","solveFor v_v"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"]) 
neuper@37954:   ],
neuper@38001:   e_rls, SOME "solve (v_v ^^^2 + p_p * v_v + q__q = 0, v_v)", []));
neuper@37954: 
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_uni_poly_deg2_abc" [] e_pblID
neuper@37954:  (["abc_formula","degree_two","polynomial","univariate","equation","test"],
neuper@38001:   [("#Given" ,["equality (a_a * x ^^^2 + b_b * x + c_c = 0)","solveFor v_v"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"]) 
neuper@37954:   ],
neuper@38001:   e_rls, SOME "solve (a_a * x ^^^2 + b_b * x + c_c = 0, v_v)", []));
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_uni_root" [] e_pblID
neuper@37954:  (["squareroot","univariate","equation","test"],
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@37981:    ("#Where" ,["contains_root (e_e::bool)"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"]) 
neuper@37954:   ],
neuper@37954:   append_rls "contains_root" e_rls [Calc ("Test.contains'_root",
neuper@37954: 			  eval_contains_root "#contains_root_")], 
neuper@37981:   SOME "solve (e_e::bool, v_v)", [["Test","square_equation"]]));
neuper@37954: 
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_uni_norm" [] e_pblID
neuper@37954:  (["normalize","univariate","equation","test"],
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@37954:    ("#Where" ,[]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"]) 
neuper@37954:   ],
neuper@37981:   e_rls, SOME "solve (e_e::bool, v_v)", [["Test","norm_univar_equation"]]));
neuper@37954: 
neuper@37954: store_pbt
neuper@37972:  (prep_pbt thy "pbl_test_uni_roottest" [] e_pblID
neuper@37954:  (["sqroot-test","univariate","equation","test"],
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@37981:    (*("#Where" ,["contains_root (e_e::bool)"]),*)
neuper@38009:    ("#Find"  ,["solutions v_i'''"]) 
neuper@37954:   ],
neuper@37981:   e_rls, SOME "solve (e_e::bool, v_v)", []));
neuper@37954: 
neuper@37954: (*
neuper@37954: (#ppc o get_pbt) ["sqroot-test","univariate","equation"];
neuper@37954:   *)
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: 
neuper@37954: 
neuper@37954: store_met
neuper@37972:  (prep_met thy  "met_test_sqrt" [] e_metID
neuper@37954: (*root-equation, version for tests before 8.01.01*)
neuper@37954:  (["Test","sqrt-equ-test"]:metID,
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@37981:    ("#Where" ,["contains_root (e_e::bool)"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"])
neuper@37954:    ],
neuper@37954:   {rew_ord'="e_rew_ord",rls'=tval_rls,
neuper@37954:    srls =append_rls "srls_contains_root" e_rls 
neuper@37954: 		    [Calc ("Test.contains'_root",eval_contains_root "")],
neuper@37954:    prls =append_rls "prls_contains_root" e_rls 
neuper@37954: 		    [Calc ("Test.contains'_root",eval_contains_root "")],
neuper@37954:    calc=[],
neuper@37954:    crls=tval_rls, nrls=e_rls(*,asm_rls=[],
neuper@37954:    asm_thm=[("square_equation_left",""),
neuper@37954: 	    ("square_equation_right","")]*)},
neuper@37982:  "Script Solve_root_equation (e_e::bool) (v_v::real) =  " ^
neuper@37981:  "(let e_e = " ^
neuper@37981:  "   ((While (contains_root e_e) Do" ^
neuper@37954:  "      ((Rewrite square_equation_left True) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set rearrange_assoc False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set isolate_root False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)))) @@" ^
neuper@37954:  "    (Try (Rewrite_Set norm_equation False)) @@" ^
neuper@37954:  "    (Try (Rewrite_Set Test_simplify False)) @@" ^
neuper@37991:  "    (Rewrite_Set_Inst [(bdv,v_v::real)] isolate_bdv False) @@" ^
neuper@37954:  "    (Try (Rewrite_Set Test_simplify False)))" ^
neuper@37981:  "   e_e" ^
neuper@38001:  " in [e_e::bool])"
neuper@37954:   ));
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_met
neuper@37972:  (prep_met thy  "met_test_sqrt2" [] e_metID
neuper@37954: (*root-equation ... for test-*.sml until 8.01*)
neuper@37954:  (["Test","squ-equ-test2"]:metID,
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"])
neuper@37954:    ],
neuper@37954:   {rew_ord'="e_rew_ord",rls'=tval_rls,
neuper@37954:    srls = append_rls "srls_contains_root" e_rls 
neuper@37954: 		     [Calc ("Test.contains'_root",eval_contains_root"")],
neuper@37954:    prls=e_rls,calc=[],
neuper@37954:    crls=tval_rls, nrls=e_rls(*,asm_rls=[],
neuper@37954:    asm_thm=[("square_equation_left",""),
neuper@37954: 	    ("square_equation_right","")]*)},
neuper@37982:  "Script Solve_root_equation (e_e::bool) (v_v::real) =  " ^
neuper@37981:  "(let e_e = " ^
neuper@37981:  "   ((While (contains_root e_e) Do" ^
neuper@37954:  "      ((Rewrite square_equation_left True) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set rearrange_assoc False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set isolate_root False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)))) @@" ^
neuper@37954:  "    (Try (Rewrite_Set norm_equation False)) @@" ^
neuper@37954:  "    (Try (Rewrite_Set Test_simplify False)) @@" ^
neuper@37991:  "    (Rewrite_Set_Inst [(bdv,v_v::real)] isolate_bdv False) @@" ^
neuper@37954:  "    (Try (Rewrite_Set Test_simplify False)))" ^
neuper@37991:  "   e_e;" ^
neuper@38001:  "  (L_L::bool list) = Tac subproblem_equation_dummy;          " ^
neuper@37991:  "  L_L = Tac solve_equation_dummy                             " ^
neuper@37991:  "  in Check_elementwise L_L {(v_v::real). Assumptions})"
neuper@37954:   ));
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_met
neuper@37972:  (prep_met thy "met_test_squ_sub" [] e_metID
neuper@37954: (*tests subproblem fixed linear*)
neuper@37954:  (["Test","squ-equ-test-subpbl1"]:metID,
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"])
neuper@37954:    ],
neuper@37954:   {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
neuper@37954:     crls=tval_rls, nrls=Test_simplify},
neuper@38001:   "Script Solve_root_equation (e_e::bool) (v_v::real) =                " ^
neuper@38001:    " (let e_e = ((Try (Rewrite_Set norm_equation False)) @@            " ^
neuper@38001:    "            (Try (Rewrite_Set Test_simplify False))) e_e;          " ^
neuper@38001:    "(L_L::bool list) = (SubProblem (Test',                             " ^
neuper@38001:    "                                [linear,univariate,equation,test], " ^
neuper@38001:    "                                [Test,solve_linear])" ^
neuper@38001:    "                               [BOOL e_e, REAL v_v])" ^
neuper@37991:    "in Check_elementwise L_L {(v_v::real). Assumptions})"
neuper@37954:   ));
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_met
neuper@37972:  (prep_met thy "met_test_squ_sub2" [] e_metID
neuper@37954:  (*tests subproblem fixed degree 2*)
neuper@37954:  (["Test","squ-equ-test-subpbl2"]:metID,
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"])
neuper@37954:    ],
neuper@37954:   {rew_ord'="e_rew_ord",rls'=tval_rls,srls=e_rls,prls=e_rls,calc=[],
neuper@37954:     crls=tval_rls, nrls=e_rls(*,
neuper@37954:    asm_rls=[],asm_thm=[("square_equation_left",""),
neuper@37954: 	    ("square_equation_right","")]*)},
neuper@37982:    "Script Solve_root_equation (e_e::bool) (v_v::real) =  " ^
neuper@37991:    " (let e_e = Try (Rewrite_Set norm_equation False) e_e;              " ^
neuper@38001:    "(L_L::bool list) = (SubProblem (Test',[linear,univariate,equation,test]," ^
neuper@38001:    "                    [Test,solve_by_pq_formula]) [BOOL e_e, REAL v_v])" ^
neuper@37991:    "in Check_elementwise L_L {(v_v::real). Assumptions})"
neuper@37954:    )); 
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_met
neuper@37972:  (prep_met thy "met_test_squ_nonterm" [] e_metID
neuper@37954:  (*root-equation: see foils..., but notTerminating*)
neuper@37954:  (["Test","square_equation...notTerminating"]:metID,
neuper@37981:   [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@38009:    ("#Find"  ,["solutions v_i'''"])
neuper@37954:    ],
neuper@37954:   {rew_ord'="e_rew_ord",rls'=tval_rls,
neuper@37954:    srls = append_rls "srls_contains_root" e_rls 
neuper@37954: 		     [Calc ("Test.contains'_root",eval_contains_root"")],
neuper@37954:    prls=e_rls,calc=[],
neuper@37954:     crls=tval_rls, nrls=e_rls(*,asm_rls=[],
neuper@37954:    asm_thm=[("square_equation_left",""),
neuper@37954: 	    ("square_equation_right","")]*)},
neuper@37982:  "Script Solve_root_equation (e_e::bool) (v_v::real) =  " ^
neuper@37981:  "(let e_e = " ^
neuper@37981:  "   ((While (contains_root e_e) Do" ^
neuper@37954:  "      ((Rewrite square_equation_left True) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set rearrange_assoc False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set isolate_root False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)))) @@" ^
neuper@37954:  "    (Try (Rewrite_Set norm_equation False)) @@" ^
neuper@37954:  "    (Try (Rewrite_Set Test_simplify False)))" ^
neuper@37991:  "   e_e;" ^
neuper@38001:  "  (L_L::bool list) =                                        " ^
neuper@38001:  "    (SubProblem (Test',[linear,univariate,equation,test]," ^
neuper@38001:  "                 [Test,solve_linear]) [BOOL e_e, REAL v_v])" ^
neuper@37991:  "in Check_elementwise L_L {(v_v::real). Assumptions})"
neuper@37954:   ));
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_met
neuper@37972:  (prep_met thy  "met_test_eq1" [] e_metID
neuper@37954: (*root-equation1:*)
neuper@37954:  (["Test","square_equation1"]:metID,
neuper@37981:    [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@38009:     ("#Find"  ,["solutions v_i'''"])
neuper@37954:     ],
neuper@37954:    {rew_ord'="e_rew_ord",rls'=tval_rls,
neuper@37954:    srls = append_rls "srls_contains_root" e_rls 
neuper@37954: 		     [Calc ("Test.contains'_root",eval_contains_root"")],
neuper@37954:    prls=e_rls,calc=[],
neuper@37954:     crls=tval_rls, nrls=e_rls(*,asm_rls=[],
neuper@37954:    asm_thm=[("square_equation_left",""),
neuper@37954: 	    ("square_equation_right","")]*)},
neuper@37982:  "Script Solve_root_equation (e_e::bool) (v_v::real) =  " ^
neuper@37981:  "(let e_e = " ^
neuper@37981:  "   ((While (contains_root e_e) Do" ^
neuper@37954:  "      ((Rewrite square_equation_left True) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set rearrange_assoc False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set isolate_root False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)))) @@" ^
neuper@37954:  "    (Try (Rewrite_Set norm_equation False)) @@" ^
neuper@37954:  "    (Try (Rewrite_Set Test_simplify False)))" ^
neuper@37991:  "   e_e;" ^
neuper@38001:  "  (L_L::bool list) = (SubProblem (Test',[linear,univariate,equation,test]," ^
neuper@38001:  "                    [Test,solve_linear]) [BOOL e_e, REAL v_v])" ^
neuper@37991:  "  in Check_elementwise L_L {(v_v::real). Assumptions})"
neuper@37954:   ));
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_met
neuper@37972:  (prep_met thy "met_test_squ2" [] e_metID
neuper@37954:  (*root-equation2*)
neuper@37954:  (["Test","square_equation2"]:metID,
neuper@37981:    [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@38009:     ("#Find"  ,["solutions v_i'''"])
neuper@37954:     ],
neuper@37954:    {rew_ord'="e_rew_ord",rls'=tval_rls,
neuper@37954:    srls = append_rls "srls_contains_root" e_rls 
neuper@37954: 		     [Calc ("Test.contains'_root",eval_contains_root"")],
neuper@37954:    prls=e_rls,calc=[],
neuper@37954:     crls=tval_rls, nrls=e_rls(*,asm_rls=[],
neuper@37954:    asm_thm=[("square_equation_left",""),
neuper@37954: 	    ("square_equation_right","")]*)},
neuper@37982:  "Script Solve_root_equation (e_e::bool) (v_v::real)  =  " ^
neuper@37981:  "(let e_e = " ^
neuper@37981:  "   ((While (contains_root e_e) Do" ^
neuper@37954:  "      (((Rewrite square_equation_left True) Or " ^
neuper@37954:  "        (Rewrite square_equation_right True)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set rearrange_assoc False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set isolate_root False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)))) @@" ^
neuper@37954:  "    (Try (Rewrite_Set norm_equation False)) @@" ^
neuper@37954:  "    (Try (Rewrite_Set Test_simplify False)))" ^
neuper@37991:  "   e_e;" ^
neuper@38001:  "  (L_L::bool list) = (SubProblem (Test',[plain_square,univariate,equation,test]," ^
neuper@38001:  "                    [Test,solve_plain_square]) [BOOL e_e, REAL v_v])" ^
neuper@37991:  "  in Check_elementwise L_L {(v_v::real). Assumptions})"
neuper@37954:   ));
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_met
neuper@37972:  (prep_met thy "met_test_squeq" [] e_metID
neuper@37954:  (*root-equation*)
neuper@37954:  (["Test","square_equation"]:metID,
neuper@37981:    [("#Given" ,["equality e_e","solveFor v_v"]),
neuper@38009:     ("#Find"  ,["solutions v_i'''"])
neuper@37954:     ],
neuper@37954:    {rew_ord'="e_rew_ord",rls'=tval_rls,
neuper@37954:    srls = append_rls "srls_contains_root" e_rls 
neuper@37954: 		     [Calc ("Test.contains'_root",eval_contains_root"")],
neuper@37954:    prls=e_rls,calc=[],
neuper@37954:     crls=tval_rls, nrls=e_rls(*,asm_rls=[],
neuper@37954:    asm_thm=[("square_equation_left",""),
neuper@37954: 	    ("square_equation_right","")]*)},
neuper@37982:  "Script Solve_root_equation (e_e::bool) (v_v::real) =  " ^
neuper@37981:  "(let e_e = " ^
neuper@37981:  "   ((While (contains_root e_e) Do" ^
neuper@37954:  "      (((Rewrite square_equation_left True) Or" ^
neuper@37954:  "        (Rewrite square_equation_right True)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set rearrange_assoc False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set isolate_root False)) @@" ^
neuper@37954:  "       (Try (Rewrite_Set Test_simplify False)))) @@" ^
neuper@37954:  "    (Try (Rewrite_Set norm_equation False)) @@" ^
neuper@37954:  "    (Try (Rewrite_Set Test_simplify False)))" ^
neuper@37991:  "   e_e;" ^
neuper@38001:  "  (L_L::bool list) = (SubProblem (Test',[univariate,equation,test]," ^
neuper@38001:  "                    [no_met]) [BOOL e_e, REAL v_v])" ^
neuper@37991:  "  in Check_elementwise L_L {(v_v::real). Assumptions})"
neuper@37954:   ) ); (*#######*)
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_met
neuper@37972:  (prep_met thy "met_test_eq_plain" [] e_metID
neuper@37954:  (*solve_plain_square*)
neuper@37954:  (["Test","solve_plain_square"]:metID,
neuper@37981:    [("#Given",["equality e_e","solveFor v_v"]),
neuper@38001:    ("#Where" ,["(matches (?a + ?b*v_v ^^^2 = 0) e_e) |" ^
neuper@38001: 	       "(matches (     ?b*v_v ^^^2 = 0) e_e) |" ^
neuper@37981: 	       "(matches (?a +    v_v ^^^2 = 0) e_e) |" ^
neuper@37981: 	       "(matches (        v_v ^^^2 = 0) e_e)"]), 
neuper@38009:    ("#Find"  ,["solutions v_i'''"]) 
neuper@37954:    ],
neuper@37954:    {rew_ord'="e_rew_ord",rls'=tval_rls,calc=[],srls=e_rls,
neuper@37954:     prls = assoc_rls "matches",
neuper@37954:     crls=tval_rls, nrls=e_rls(*,
neuper@37954:     asm_rls=[],asm_thm=[]*)},
neuper@37982:   "Script Solve_plain_square (e_e::bool) (v_v::real) =           " ^
neuper@37981:    " (let e_e = ((Try (Rewrite_Set isolate_bdv False)) @@         " ^
neuper@37954:    "            (Try (Rewrite_Set Test_simplify False)) @@     " ^
neuper@37954:    "            ((Rewrite square_equality_0 False) Or        " ^
neuper@37954:    "             (Rewrite square_equality True)) @@            " ^
neuper@37981:    "            (Try (Rewrite_Set tval_rls False))) e_e             " ^
neuper@37981:    "  in ((Or_to_List e_e)::bool list))"
neuper@37954:  ));
neuper@37954: 
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: store_met
neuper@37972:  (prep_met thy "met_test_norm_univ" [] e_metID
neuper@37954:  (["Test","norm_univar_equation"]:metID,
neuper@37981:    [("#Given",["equality e_e","solveFor v_v"]),
neuper@37954:    ("#Where" ,[]), 
neuper@38009:    ("#Find"  ,["solutions v_i'''"]) 
neuper@37954:    ],
neuper@37954:    {rew_ord'="e_rew_ord",rls'=tval_rls,srls = e_rls,prls=e_rls,
neuper@37954:    calc=[],
neuper@37954:     crls=tval_rls, nrls=e_rls(*,asm_rls=[],asm_thm=[]*)},
neuper@37982:   "Script Norm_univar_equation (e_e::bool) (v_v::real) =      " ^
neuper@37981:    " (let e_e = ((Try (Rewrite rnorm_equation_add False)) @@   " ^
neuper@37981:    "            (Try (Rewrite_Set Test_simplify False))) e_e   " ^
neuper@38001:    "  in (SubProblem (Test',[univariate,equation,test],         " ^
neuper@38001:    "                    [no_met]) [BOOL e_e, REAL v_v]))"
neuper@37954:  ));
neuper@37954: 
neuper@37954: 
neuper@37954: 
neuper@37954: (*17.9.02 aus SqRoot.ML------------------------------^^^---*)  
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: 
neuper@37954: (*8.4.03  aus Poly.ML--------------------------------vvv---
neuper@37954:   make_polynomial  ---> make_poly
neuper@37954:   ^-- for user          ^-- for systest _ONLY_*)  
neuper@37954: 
neuper@37954: local (*. for make_polytest .*)
neuper@37954: 
neuper@37954: open Term;  (* for type order = EQUAL | LESS | GREATER *)
neuper@37954: 
neuper@37954: fun pr_ord EQUAL = "EQUAL"
neuper@37954:   | pr_ord LESS  = "LESS"
neuper@37954:   | pr_ord GREATER = "GREATER";
neuper@37954: 
neuper@37954: fun dest_hd' (Const (a, T)) =                          (* ~ term.ML *)
neuper@37954:   (case a of
neuper@37954:      "Atools.pow" => ((("|||||||||||||", 0), T), 0)           (*WN greatest *)
neuper@37954:    | _ => (((a, 0), T), 0))
neuper@37954:   | dest_hd' (Free (a, T)) = (((a, 0), T), 1)
neuper@37954:   | dest_hd' (Var v) = (v, 2)
neuper@37954:   | dest_hd' (Bound i) = ((("", i), dummyT), 3)
neuper@37954:   | dest_hd' (Abs (_, T, _)) = ((("", 0), T), 4);
neuper@37954: (* RL *)
neuper@37954: fun get_order_pow (t $ (Free(order,_))) = 
neuper@37954:     	(case int_of_str (order) of
neuper@37954: 	             SOME d => d
neuper@37954: 		   | NONE   => 0)
neuper@37954:   | get_order_pow _ = 0;
neuper@37954: 
neuper@37954: fun size_of_term' (Const(str,_) $ t) =
neuper@37954:   if "Atools.pow"=str then 1000 + size_of_term' t else 1 + size_of_term' t(*WN*)
neuper@37954:   | size_of_term' (Abs (_,_,body)) = 1 + size_of_term' body
neuper@37954:   | size_of_term' (f$t) = size_of_term' f  +  size_of_term' t
neuper@37954:   | size_of_term' _ = 1;
neuper@37954: 
neuper@38001: fun term_ord' pr thy (Abs (_, T, t), Abs(_, U, u)) =       (* ~ term.ML *)
neuper@38001:       (case term_ord' pr thy (t, u) of EQUAL => Term_Ord.typ_ord (T, U) | ord => ord)
neuper@38001:   | term_ord' pr thy (t, u) =
neuper@37954:       (if pr then 
neuper@37954: 	 let
neuper@37954: 	   val (f, ts) = strip_comb t and (g, us) = strip_comb u;
neuper@37954: 	   val _=writeln("t= f@ts= " ^ "" ^
neuper@37954: 	      ((Syntax.string_of_term (thy2ctxt thy)) f)^ "\" @ " ^ "[" ^
neuper@38001: 	      (commas(map(Syntax.string_of_term (thy2ctxt thy)) ts)) ^ "]\"");
neuper@37954: 	   val _=writeln("u= g@us= " ^ "" ^
neuper@37954: 	      ((Syntax.string_of_term (thy2ctxt thy)) g) ^ "\" @ " ^ "[" ^
neuper@38001: 	      (commas(map(Syntax.string_of_term (thy2ctxt thy)) us))^"]\"");
neuper@37954: 	   val _=writeln("size_of_term(t,u)= ("^
neuper@37954: 	      (string_of_int(size_of_term' t)) ^ ", " ^
neuper@37954: 	      (string_of_int(size_of_term' u)) ^ ")");
neuper@37954: 	   val _=writeln("hd_ord(f,g)      = " ^ ((pr_ord o hd_ord)(f,g)));
neuper@37954: 	   val _=writeln("terms_ord(ts,us) = " ^
neuper@37954: 			   ((pr_ord o terms_ord str false)(ts,us)));
neuper@37954: 	   val _=writeln("-------");
neuper@37954: 	 in () end
neuper@37954:        else ();
neuper@37954: 	 case int_ord (size_of_term' t, size_of_term' u) of
neuper@37954: 	   EQUAL =>
neuper@37954: 	     let val (f, ts) = strip_comb t and (g, us) = strip_comb u in
neuper@37954: 	       (case hd_ord (f, g) of EQUAL => (terms_ord str pr) (ts, us) 
neuper@37954: 	     | ord => ord)
neuper@37954: 	     end
neuper@37954: 	 | ord => ord)
neuper@37954: and hd_ord (f, g) =                                        (* ~ term.ML *)
neuper@37991:   prod_ord (prod_ord Term_Ord.indexname_ord Term_Ord.typ_ord) int_ord (dest_hd' f, dest_hd' g)
neuper@37954: and terms_ord str pr (ts, us) = 
neuper@37991:     list_ord (term_ord' pr (assoc_thy "Isac"))(ts, us);
neuper@37954: in
neuper@37954: 
neuper@37954: fun ord_make_polytest (pr:bool) thy (_:subst) tu = 
neuper@37954:     (term_ord' pr thy(***) tu = LESS );
neuper@37954: 
neuper@37954: end;(*local*)
neuper@38001: *}
neuper@38001: ML {*
neuper@37954: 
neuper@37954: rew_ord' := overwritel (!rew_ord',
neuper@37954: [("termlessI", termlessI),
neuper@37954:  ("ord_make_polytest", ord_make_polytest false thy)
neuper@37954:  ]);
neuper@37954: 
neuper@37954: (*WN060510 this was a preparation for prep_rls ...
neuper@37954: val scr_make_polytest = 
neuper@38001: "Script Expand_binomtest t_t =" ^
neuper@37954: "(Repeat                       " ^
neuper@37954: "((Try (Repeat (Rewrite real_diff_minus         False))) @@ " ^ 
neuper@37954: 
neuper@37971: " (Try (Repeat (Rewrite left_distrib   False))) @@ " ^	 
neuper@37971: " (Try (Repeat (Rewrite right_distrib  False))) @@ " ^	
neuper@37971: " (Try (Repeat (Rewrite left_diff_distrib  False))) @@ " ^	
neuper@37971: " (Try (Repeat (Rewrite right_diff_distrib False))) @@ " ^	
neuper@37954: 
neuper@37971: " (Try (Repeat (Rewrite mult_1_left             False))) @@ " ^		   
neuper@37971: " (Try (Repeat (Rewrite mult_zero_left             False))) @@ " ^		   
neuper@37971: " (Try (Repeat (Rewrite add_0_left      False))) @@ " ^	 
neuper@37954: 
neuper@37954: " (Try (Repeat (Rewrite real_mult_commute       False))) @@ " ^		
neuper@37954: " (Try (Repeat (Rewrite real_mult_left_commute  False))) @@ " ^	
neuper@37954: " (Try (Repeat (Rewrite real_mult_assoc         False))) @@ " ^		
neuper@37971: " (Try (Repeat (Rewrite add_commute        False))) @@ " ^		
neuper@37971: " (Try (Repeat (Rewrite add_left_commute   False))) @@ " ^	 
neuper@37971: " (Try (Repeat (Rewrite add_assoc          False))) @@ " ^	 
neuper@37954: 
neuper@37954: " (Try (Repeat (Rewrite sym_realpow_twoI        False))) @@ " ^	 
neuper@37954: " (Try (Repeat (Rewrite realpow_plus_1          False))) @@ " ^	 
neuper@37954: " (Try (Repeat (Rewrite sym_real_mult_2         False))) @@ " ^		
neuper@37954: " (Try (Repeat (Rewrite real_mult_2_assoc       False))) @@ " ^		
neuper@37954: 
neuper@37954: " (Try (Repeat (Rewrite real_num_collect        False))) @@ " ^		
neuper@37954: " (Try (Repeat (Rewrite real_num_collect_assoc  False))) @@ " ^	
neuper@37954: 
neuper@37954: " (Try (Repeat (Rewrite real_one_collect        False))) @@ " ^		
neuper@37954: " (Try (Repeat (Rewrite real_one_collect_assoc  False))) @@ " ^   
neuper@37954: 
neuper@37975: " (Try (Repeat (Calculate PLUS  ))) @@ " ^
neuper@37975: " (Try (Repeat (Calculate TIMES ))) @@ " ^
neuper@37975: " (Try (Repeat (Calculate POWER)))) " ^  
neuper@38001: " t_t)";
neuper@37954: -----------------------------------------------------*)
neuper@37954: 
neuper@37954: val make_polytest =
neuper@37954:   Rls{id = "make_polytest", preconds = []:term list, 
neuper@37954:       rew_ord = ("ord_make_polytest", ord_make_polytest false (theory "Poly")),
neuper@37954:       erls = testerls, srls = Erls,
neuper@37954:       calc = [("PLUS"  , ("op +", eval_binop "#add_")), 
neuper@37954: 	      ("TIMES" , ("op *", eval_binop "#mult_")),
neuper@37954: 	      ("POWER", ("Atools.pow", eval_binop "#power_"))
neuper@37954: 	      ],
neuper@37954:       (*asm_thm = [],*)
neuper@37969:       rules = [Thm ("real_diff_minus",num_str @{thm real_diff_minus}),
neuper@37954: 	       (*"a - b = a + (-1) * b"*)
neuper@37965: 	       Thm ("left_distrib" ,num_str @{thm left_distrib}),
neuper@37954: 	       (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
neuper@37974: 	       Thm ("right_distrib",num_str @{thm right_distrib}),
neuper@37954: 	       (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
neuper@37965: 	       Thm ("left_diff_distrib" ,num_str @{thm left_diff_distrib}),
neuper@37954: 	       (*"(z1.0 - z2.0) * w = z1.0 * w - z2.0 * w"*)
neuper@37982: 	       Thm ("right_diff_distrib",num_str @{thm right_diff_distrib}),
neuper@37954: 	       (*"w * (z1.0 - z2.0) = w * z1.0 - w * z2.0"*)
neuper@37965: 	       Thm ("mult_1_left",num_str @{thm mult_1_left}),                 
neuper@37954: 	       (*"1 * z = z"*)
neuper@37965: 	       Thm ("mult_zero_left",num_str @{thm mult_zero_left}),        
neuper@37954: 	       (*"0 * z = 0"*)
neuper@37965: 	       Thm ("add_0_left",num_str @{thm add_0_left}),
neuper@37954: 	       (*"0 + z = z"*)
neuper@37954: 
neuper@37954: 	       (*AC-rewriting*)
neuper@37969: 	       Thm ("real_mult_commute",num_str @{thm real_mult_commute}),
neuper@37954: 	       (* z * w = w * z *)
neuper@37969: 	       Thm ("real_mult_left_commute",num_str @{thm real_mult_left_commute}),
neuper@37954: 	       (*z1.0 * (z2.0 * z3.0) = z2.0 * (z1.0 * z3.0)*)
neuper@37969: 	       Thm ("real_mult_assoc",num_str @{thm real_mult_assoc}),		
neuper@37954: 	       (*z1.0 * z2.0 * z3.0 = z1.0 * (z2.0 * z3.0)*)
neuper@37965: 	       Thm ("add_commute",num_str @{thm add_commute}),	
neuper@37954: 	       (*z + w = w + z*)
neuper@37965: 	       Thm ("add_left_commute",num_str @{thm add_left_commute}),
neuper@37954: 	       (*x + (y + z) = y + (x + z)*)
neuper@37965: 	       Thm ("add_assoc",num_str @{thm add_assoc}),	               
neuper@37954: 	       (*z1.0 + z2.0 + z3.0 = z1.0 + (z2.0 + z3.0)*)
neuper@37954: 
neuper@37969: 	       Thm ("sym_realpow_twoI",
neuper@37969:                      num_str (@{thm realpow_twoI} RS @{thm sym})),	
neuper@37954: 	       (*"r1 * r1 = r1 ^^^ 2"*)
neuper@37969: 	       Thm ("realpow_plus_1",num_str @{thm realpow_plus_1}),		
neuper@37954: 	       (*"r * r ^^^ n = r ^^^ (n + 1)"*)
neuper@37969: 	       Thm ("sym_real_mult_2",
neuper@37969:                      num_str (@{thm real_mult_2} RS @{thm sym})),	
neuper@37954: 	       (*"z1 + z1 = 2 * z1"*)
neuper@37969: 	       Thm ("real_mult_2_assoc",num_str @{thm real_mult_2_assoc}),	
neuper@37954: 	       (*"z1 + (z1 + k) = 2 * z1 + k"*)
neuper@37954: 
neuper@37969: 	       Thm ("real_num_collect",num_str @{thm real_num_collect}), 
neuper@37954: 	       (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)
neuper@37969: 	       Thm ("real_num_collect_assoc",num_str @{thm real_num_collect_assoc}),
neuper@37954: 	       (*"[| l is_const; m is_const |] ==>  
neuper@37954: 				l * n + (m * n + k) =  (l + m) * n + k"*)
neuper@37969: 	       Thm ("real_one_collect",num_str @{thm real_one_collect}),	
neuper@37954: 	       (*"m is_const ==> n + m * n = (1 + m) * n"*)
neuper@37969: 	       Thm ("real_one_collect_assoc",num_str @{thm real_one_collect_assoc}), 
neuper@37954: 	       (*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
neuper@37954: 
neuper@37954: 	       Calc ("op +", eval_binop "#add_"), 
neuper@37954: 	       Calc ("op *", eval_binop "#mult_"),
neuper@37954: 	       Calc ("Atools.pow", eval_binop "#power_")
neuper@37954: 	       ],
neuper@37954:       scr = EmptyScr(*Script ((term_of o the o (parse thy)) 
neuper@37954:       scr_make_polytest)*)
neuper@38001:       }:rls; 
neuper@38001: *}
neuper@38001: ML {*     
neuper@38001: (*WN060510 this was done before 'fun prep_rls' ...------------------------
neuper@37954: val scr_expand_binomtest =
neuper@38001: "Script Expand_binomtest t_t =" ^
neuper@37954: "(Repeat                       " ^
neuper@37954: "((Try (Repeat (Rewrite real_plus_binom_pow2    False))) @@ " ^
neuper@37954: " (Try (Repeat (Rewrite real_plus_binom_times   False))) @@ " ^
neuper@37954: " (Try (Repeat (Rewrite real_minus_binom_pow2   False))) @@ " ^
neuper@37954: " (Try (Repeat (Rewrite real_minus_binom_times  False))) @@ " ^
neuper@37954: " (Try (Repeat (Rewrite real_plus_minus_binom1  False))) @@ " ^
neuper@37954: " (Try (Repeat (Rewrite real_plus_minus_binom2  False))) @@ " ^
neuper@37954: 
neuper@37971: " (Try (Repeat (Rewrite mult_1_left             False))) @@ " ^
neuper@37971: " (Try (Repeat (Rewrite mult_zero_left             False))) @@ " ^
neuper@37971: " (Try (Repeat (Rewrite add_0_left      False))) @@ " ^
neuper@37954: 
neuper@37975: " (Try (Repeat (Calculate PLUS  ))) @@ " ^
neuper@37975: " (Try (Repeat (Calculate TIMES ))) @@ " ^
neuper@37975: " (Try (Repeat (Calculate POWER))) @@ " ^
neuper@37954: 
neuper@37954: " (Try (Repeat (Rewrite sym_realpow_twoI        False))) @@ " ^
neuper@37954: " (Try (Repeat (Rewrite realpow_plus_1          False))) @@ " ^
neuper@37954: " (Try (Repeat (Rewrite sym_real_mult_2         False))) @@ " ^
neuper@37954: " (Try (Repeat (Rewrite real_mult_2_assoc       False))) @@ " ^
neuper@37954: 
neuper@37954: " (Try (Repeat (Rewrite real_num_collect        False))) @@ " ^
neuper@37954: " (Try (Repeat (Rewrite real_num_collect_assoc  False))) @@ " ^
neuper@37954: 
neuper@37954: " (Try (Repeat (Rewrite real_one_collect        False))) @@ " ^
neuper@37954: " (Try (Repeat (Rewrite real_one_collect_assoc  False))) @@ " ^ 
neuper@37954: 
neuper@37975: " (Try (Repeat (Calculate PLUS  ))) @@ " ^
neuper@37975: " (Try (Repeat (Calculate TIMES ))) @@ " ^
neuper@37975: " (Try (Repeat (Calculate POWER)))) " ^  
neuper@38001: " t_t)";
neuper@38001: --------------------------------------------------------------------------*)
neuper@37954: 
neuper@37954: val expand_binomtest =
neuper@37954:   Rls{id = "expand_binomtest", preconds = [], 
neuper@37954:       rew_ord = ("termlessI",termlessI),
neuper@37954:       erls = testerls, srls = Erls,
neuper@37954:       calc = [("PLUS"  , ("op +", eval_binop "#add_")), 
neuper@37954: 	      ("TIMES" , ("op *", eval_binop "#mult_")),
neuper@37954: 	      ("POWER", ("Atools.pow", eval_binop "#power_"))
neuper@37954: 	      ],
neuper@38001:       rules = 
neuper@38001:       [Thm ("real_plus_binom_pow2"  ,num_str @{thm real_plus_binom_pow2}),     
neuper@37954: 	       (*"(a + b) ^^^ 2 = a ^^^ 2 + 2 * a * b + b ^^^ 2"*)
neuper@38001:        Thm ("real_plus_binom_times" ,num_str @{thm real_plus_binom_times}),    
neuper@37954: 	      (*"(a + b)*(a + b) = ...*)
neuper@38001:        Thm ("real_minus_binom_pow2" ,num_str @{thm real_minus_binom_pow2}),   
neuper@38001:        (*"(a - b) ^^^ 2 = a ^^^ 2 - 2 * a * b + b ^^^ 2"*)
neuper@38001:        Thm ("real_minus_binom_times",num_str @{thm real_minus_binom_times}),   
neuper@38001:        (*"(a - b)*(a - b) = ...*)
neuper@38001:        Thm ("real_plus_minus_binom1",num_str @{thm real_plus_minus_binom1}),   
neuper@38001:         (*"(a + b) * (a - b) = a ^^^ 2 - b ^^^ 2"*)
neuper@38001:        Thm ("real_plus_minus_binom2",num_str @{thm real_plus_minus_binom2}),   
neuper@38001:         (*"(a - b) * (a + b) = a ^^^ 2 - b ^^^ 2"*)
neuper@38001:        (*RL 020915*)
neuper@38001:        Thm ("real_pp_binom_times",num_str @{thm real_pp_binom_times}), 
neuper@38001:         (*(a + b)*(c + d) = a*c + a*d + b*c + b*d*)
neuper@38001:        Thm ("real_pm_binom_times",num_str @{thm real_pm_binom_times}), 
neuper@38001:         (*(a + b)*(c - d) = a*c - a*d + b*c - b*d*)
neuper@38001:        Thm ("real_mp_binom_times",num_str @{thm real_mp_binom_times}), 
neuper@38001:         (*(a - b)*(c p d) = a*c + a*d - b*c - b*d*)
neuper@38001:        Thm ("real_mm_binom_times",num_str @{thm real_mm_binom_times}), 
neuper@38001:         (*(a - b)*(c p d) = a*c - a*d - b*c + b*d*)
neuper@38001:        Thm ("realpow_multI",num_str @{thm realpow_multI}),                
neuper@38001:         (*(a*b)^^^n = a^^^n * b^^^n*)
neuper@38001:        Thm ("real_plus_binom_pow3",num_str @{thm real_plus_binom_pow3}),
neuper@38001:         (* (a + b)^^^3 = a^^^3 + 3*a^^^2*b + 3*a*b^^^2 + b^^^3 *)
neuper@38001:        Thm ("real_minus_binom_pow3",num_str @{thm real_minus_binom_pow3}),
neuper@38001:         (* (a - b)^^^3 = a^^^3 - 3*a^^^2*b + 3*a*b^^^2 - b^^^3 *)
neuper@37954: 
neuper@37954: 
neuper@38001:      (*  Thm ("left_distrib" ,num_str @{thm left_distrib}),	
neuper@38001: 	 (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)
neuper@38001: 	Thm ("right_distrib",num_str @{thm right_distrib}),	
neuper@38001: 	(*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)
neuper@38001: 	Thm ("left_diff_distrib" ,num_str @{thm left_diff_distrib}),	
neuper@38001: 	(*"(z1.0 - z2.0) * w = z1.0 * w - z2.0 * w"*)
neuper@38001: 	Thm ("right_diff_distrib",num_str @{thm right_diff_distrib}),	
neuper@38001: 	(*"w * (z1.0 - z2.0) = w * z1.0 - w * z2.0"*)
neuper@38001: 	*)
neuper@38001: 	
neuper@38001: 	Thm ("mult_1_left",num_str @{thm mult_1_left}),              
neuper@38001:          (*"1 * z = z"*)
neuper@38001: 	Thm ("mult_zero_left",num_str @{thm mult_zero_left}),              
neuper@38001:          (*"0 * z = 0"*)
neuper@38001: 	Thm ("add_0_left",num_str @{thm add_0_left}),
neuper@38001:          (*"0 + z = z"*)
neuper@37954: 
neuper@38001: 	Calc ("op +", eval_binop "#add_"), 
neuper@38001: 	Calc ("op *", eval_binop "#mult_"),
neuper@38001: 	Calc ("Atools.pow", eval_binop "#power_"),
neuper@38001:         (*	       
neuper@38001: 	 Thm ("real_mult_commute",num_str @{thm real_mult_commute}),		
neuper@38001:         (*AC-rewriting*)
neuper@38001: 	Thm ("real_mult_left_commute",num_str @{thm real_mult_left_commute}),
neuper@38001: 	Thm ("real_mult_assoc",num_str @{thm real_mult_assoc}),
neuper@38001: 	Thm ("add_commute",num_str @{thm add_commute}),	
neuper@38001: 	Thm ("add_left_commute",num_str @{thm add_left_commute}),
neuper@38001: 	Thm ("add_assoc",num_str @{thm add_assoc}),
neuper@38001: 	*)
neuper@38001: 	
neuper@38001: 	Thm ("sym_realpow_twoI",
neuper@38001:               num_str (@{thm realpow_twoI} RS @{thm sym})),
neuper@38001: 	(*"r1 * r1 = r1 ^^^ 2"*)
neuper@38001: 	Thm ("realpow_plus_1",num_str @{thm realpow_plus_1}),			
neuper@38001: 	(*"r * r ^^^ n = r ^^^ (n + 1)"*)
neuper@38001: 	(*Thm ("sym_real_mult_2",
neuper@38001:                 num_str (@{thm real_mult_2} RS @{thm sym})),
neuper@38001: 	(*"z1 + z1 = 2 * z1"*)*)
neuper@38001: 	Thm ("real_mult_2_assoc",num_str @{thm real_mult_2_assoc}),		
neuper@38001: 	(*"z1 + (z1 + k) = 2 * z1 + k"*)
neuper@37954: 
neuper@38001: 	Thm ("real_num_collect",num_str @{thm real_num_collect}), 
neuper@38001: 	(*"[| l is_const; m is_const |] ==> l * n + m * n = (l + m) * n"*)
neuper@38001: 	Thm ("real_num_collect_assoc",num_str @{thm real_num_collect_assoc}),	
neuper@38001: 	(*"[| l is_const; m is_const |] ==>  l * n + (m * n + k) =  (l + m) * n + k"*)
neuper@38001: 	Thm ("real_one_collect",num_str @{thm real_one_collect}),		
neuper@38001: 	(*"m is_const ==> n + m * n = (1 + m) * n"*)
neuper@38001: 	Thm ("real_one_collect_assoc",num_str @{thm real_one_collect_assoc}), 
neuper@38001: 	(*"m is_const ==> k + (n + m * n) = k + (1 + m) * n"*)
neuper@37954: 
neuper@38001: 	Calc ("op +", eval_binop "#add_"), 
neuper@38001: 	Calc ("op *", eval_binop "#mult_"),
neuper@38001: 	Calc ("Atools.pow", eval_binop "#power_")
neuper@38001: 	],
neuper@37954:       scr = EmptyScr
neuper@37954: (*Script ((term_of o the o (parse thy)) scr_expand_binomtest)*)
neuper@37954:       }:rls;      
neuper@37954: 
neuper@37954: 
neuper@37967: ruleset' := overwritelthy @{theory} (!ruleset',
neuper@37954:    [("make_polytest", prep_rls make_polytest),
neuper@37954:     ("expand_binomtest", prep_rls expand_binomtest)
neuper@37954:     ]);
neuper@37954: *}
neuper@37906: 
neuper@37906: end