(* attempts to perserve binary minus as wanted by Austrian teachers

   WN071207

   (c) due to copyright terms

*)

theory PolyMinus imports (*Poly// due to "is_ratpolyexp" in...*) Rational begin

consts

  (*predicates for conditions in rewriting*)

  kleiner     :: "['a, 'a] => bool" 	("_ kleiner _") 

  ist'_monom  :: "'a => bool"		("_ ist'_monom")

  (*the CAS-command*)

  Probe       :: "[bool, bool list] => bool"  

	(*"Probe (3*a+2*b+a = 4*a+2*b) [a=1,b=2]"*)

  (*descriptions for the pbl and met*)

  Pruefe      :: "bool => una"

  mitWert     :: "bool list => tobooll"

  Geprueft    :: "bool => una"

  (*Script-name*)

  ProbeScript :: "[bool, bool list,       bool] 

				      => bool"

                  ("((Script ProbeScript (_ _ =))// (_))" 9)

axiomatization where

  null_minus:            "0 - a = -a" and

  vor_minus_mal:         "- a * b = (-a) * b" and

  (*commute with invariant (a.b).c -association*)

  tausche_plus:		"[| b ist_monom; a kleiner b  |] ==> 

			 (b + a) = (a + b)" and

  tausche_minus:		"[| b ist_monom; a kleiner b  |] ==> 

			 (b - a) = (-a + b)" and

  tausche_vor_plus:	"[| b ist_monom; a kleiner b  |] ==> 

			 (- b + a) = (a - b)" and

  tausche_vor_minus:	"[| b ist_monom; a kleiner b  |] ==> 

			 (- b - a) = (-a - b)" and

  tausche_plus_plus:	"b kleiner c ==> (a + c + b) = (a + b + c)" and

  tausche_plus_minus:	"b kleiner c ==> (a + c - b) = (a - b + c)" and

  tausche_minus_plus:	"b kleiner c ==> (a - c + b) = (a + b - c)" and

  tausche_minus_minus:	"b kleiner c ==> (a - c - b) = (a - b - c)" and

  (*commute with invariant (a.b).c -association*)

  tausche_mal:		"[| b is_atom; a kleiner b  |] ==> 

			 (b * a) = (a * b)" and

  tausche_vor_mal:	"[| b is_atom; a kleiner b  |] ==> 

			 (-b * a) = (-a * b)" and

  tausche_mal_mal:	"[| c is_atom; b kleiner c  |] ==> 

			 (x * c * b) = (x * b * c)" and

  x_quadrat:             "(x * a) * a = x * a ^^^ 2" and

  subtrahiere:               "[| l is_const; m is_const |] ==>  

			     m * v - l * v = (m - l) * v" and

  subtrahiere_von_1:         "[| l is_const |] ==>  

			     v - l * v = (1 - l) * v" and

  subtrahiere_1:             "[| l is_const; m is_const |] ==>  

			     m * v - v = (m - 1) * v" and

  subtrahiere_x_plus_minus:  "[| l is_const; m is_const |] ==>  

			     (x + m * v) - l * v = x + (m - l) * v" and

  subtrahiere_x_plus1_minus: "[| l is_const |] ==>  

			     (x + v) - l * v = x + (1 - l) * v" and

  subtrahiere_x_plus_minus1: "[| m is_const |] ==>  

			     (x + m * v) - v = x + (m - 1) * v" and

  subtrahiere_x_minus_plus:  "[| l is_const; m is_const |] ==>  

			     (x - m * v) + l * v = x + (-m + l) * v" and

  subtrahiere_x_minus1_plus: "[| l is_const |] ==>  

			     (x - v) + l * v = x + (-1 + l) * v" and

  subtrahiere_x_minus_plus1: "[| m is_const |] ==>  

			     (x - m * v) + v = x + (-m + 1) * v" and

  subtrahiere_x_minus_minus: "[| l is_const; m is_const |] ==>  

			     (x - m * v) - l * v = x + (-m - l) * v" and

  subtrahiere_x_minus1_minus:"[| l is_const |] ==>  

			     (x - v) - l * v = x + (-1 - l) * v" and

  subtrahiere_x_minus_minus1:"[| m is_const |] ==>  

			     (x - m * v) - v = x + (-m - 1) * v" and

  addiere_vor_minus:         "[| l is_const; m is_const |] ==>  

			     - (l * v) +  m * v = (-l + m) * v" and

  addiere_eins_vor_minus:    "[| m is_const |] ==>  

			     -  v +  m * v = (-1 + m) * v" and

  subtrahiere_vor_minus:     "[| l is_const; m is_const |] ==>  

			     - (l * v) -  m * v = (-l - m) * v" and

  subtrahiere_eins_vor_minus:"[| m is_const |] ==>  

			     -  v -  m * v = (-1 - m) * v" and

  vorzeichen_minus_weg1:      "l kleiner 0 ==> a + l * b = a - -1*l * b" and

  vorzeichen_minus_weg2:      "l kleiner 0 ==> a - l * b = a + -1*l * b" and

  vorzeichen_minus_weg3:      "l kleiner 0 ==> k + a - l * b = k + a + -1*l * b" and

  vorzeichen_minus_weg4:      "l kleiner 0 ==> k - a - l * b = k - a + -1*l * b" and

  (*klammer_plus_plus = (add_assoc RS sym)*)

  klammer_plus_minus:          "a + (b - c) = (a + b) - c" and

  klammer_minus_plus:          "a - (b + c) = (a - b) - c" and

  klammer_minus_minus:         "a - (b - c) = (a - b) + c" and

  klammer_mult_minus:          "a * (b - c) = a * b - a * c" and

  klammer_minus_mult:          "(b - c) * a = b * a - c * a"

ML \<open>

val thy = @{theory};

(** eval functions **)

(*. get the identifier from specific monomials; see fun ist_monom .*)

(*HACK.WN080107*)

fun increase str = 

    let val s::ss = Symbol.explode str

    in implode ((chr (ord s + 1))::ss) end;

fun identifier (Free (id,_)) = id                            (* 2,   a   *)

  | identifier (Const ("Groups.times_class.times", _) $ Free (num, _) $ Free (id, _)) = 

    id                                                       (* 2*a, a*b *)

  | identifier (Const ("Groups.times_class.times", _) $                          (* 3*a*b    *)

		     (Const ("Groups.times_class.times", _) $

			    Free (num, _) $ Free _) $ Free (id, _)) = 

    if TermC.is_num' num then id

    else "|||||||||||||"

  | identifier (Const ("Atools.pow", _) $ Free (base, _) $ Free (exp, _)) =

    if TermC.is_num' base then "|||||||||||||"                  (* a^2      *)

    else (*increase*) base

  | identifier (Const ("Groups.times_class.times", _) $ Free (num, _) $          (* 3*a^2    *)

		     (Const ("Atools.pow", _) $

			    Free (base, _) $ Free (exp, _))) = 

    if TermC.is_num' num andalso not (TermC.is_num' base) then (*increase*) base

    else "|||||||||||||"

  | identifier _ = "|||||||||||||"(*the "largest" string*);

(*("kleiner", ("PolyMinus.kleiner", eval_kleiner ""))*)

(* order "by alphabet" w.r.t. var: num < (var | num*var) > (var*var | ..) *)

fun eval_kleiner _ _ (p as (Const ("PolyMinus.kleiner",_) $ a $ b)) _  =

     if TermC.is_num b then

	 if TermC.is_num a then (*123 kleiner 32 = True !!!*)

	     if TermC.num_of_term a < TermC.num_of_term b then 

		 SOME ((Rule.term2str p) ^ " = True",

		       HOLogic.Trueprop $ (TermC.mk_equality (p, @{term True})))

	     else SOME ((Rule.term2str p) ^ " = False",

			HOLogic.Trueprop $ (TermC.mk_equality (p, @{term False})))

	 else (* -1 * -2 kleiner 0 *)

	     SOME ((Rule.term2str p) ^ " = False",

		   HOLogic.Trueprop $ (TermC.mk_equality (p, @{term False})))

    else

	if identifier a < identifier b then 

	     SOME ((Rule.term2str p) ^ " = True",

		  HOLogic.Trueprop $ (TermC.mk_equality (p, @{term True})))

	else SOME ((Rule.term2str p) ^ " = False",

		   HOLogic.Trueprop $ (TermC.mk_equality (p, @{term False})))

  | eval_kleiner _ _ _ _ =  NONE;

fun ist_monom (Free (id,_)) = true

  | ist_monom (Const ("Groups.times_class.times", _) $ Free (num, _) $ Free (id, _)) = 

    if TermC.is_num' num then true else false

  | ist_monom _ = false;

(*. this function only accepts the most simple monoms       vvvvvvvvvv .*)

fun ist_monom (Free (id,_)) = true                          (* 2,   a   *)

  | ist_monom (Const ("Groups.times_class.times", _) $ Free _ $ Free (id, _)) = (* 2*a, a*b *)

    if TermC.is_num' id then false else true

  | ist_monom (Const ("Groups.times_class.times", _) $                          (* 3*a*b    *)

		     (Const ("Groups.times_class.times", _) $

			    Free (num, _) $ Free _) $ Free (id, _)) =

    if TermC.is_num' num andalso not (TermC.is_num' id) then true else false

  | ist_monom (Const ("Atools.pow", _) $ Free (base, _) $ Free (exp, _)) = 

    true                                                    (* a^2      *)

  | ist_monom (Const ("Groups.times_class.times", _) $ Free (num, _) $          (* 3*a^2    *)

		     (Const ("Atools.pow", _) $

			    Free (base, _) $ Free (exp, _))) = 

    if TermC.is_num' num then true else false

  | ist_monom _ = false;

(* is this a univariate monomial ? *)

(*("ist_monom", ("PolyMinus.ist'_monom", eval_ist_monom ""))*)

fun eval_ist_monom _ _ (p as (Const ("PolyMinus.ist'_monom",_) $ a)) _  =

    if ist_monom a  then 

	SOME ((Rule.term2str p) ^ " = True",

	      HOLogic.Trueprop $ (TermC.mk_equality (p, @{term True})))

    else SOME ((Rule.term2str p) ^ " = False",

	       HOLogic.Trueprop $ (TermC.mk_equality (p, @{term False})))

  | eval_ist_monom _ _ _ _ =  NONE;

(** rewrite order **)

(** rulesets **)

val erls_ordne_alphabetisch =

    Rule.append_rls "erls_ordne_alphabetisch" Rule.e_rls

	       [Rule.Calc ("PolyMinus.kleiner", eval_kleiner ""),

		Rule.Calc ("PolyMinus.ist'_monom", eval_ist_monom "")

		];

val ordne_alphabetisch = 

  Rule.Rls{id = "ordne_alphabetisch", preconds = [], 

      rew_ord = ("dummy_ord", Rule.dummy_ord), srls = Rule.Erls, calc = [], errpatts = [],

      erls = erls_ordne_alphabetisch, 

      rules = [Rule.Thm ("tausche_plus",TermC.num_str @{thm tausche_plus}),

	       (*"b kleiner a ==> (b + a) = (a + b)"*)

	       Rule.Thm ("tausche_minus",TermC.num_str @{thm tausche_minus}),

	       (*"b kleiner a ==> (b - a) = (-a + b)"*)

	       Rule.Thm ("tausche_vor_plus",TermC.num_str @{thm tausche_vor_plus}),

	       (*"[| b ist_monom; a kleiner b  |] ==> (- b + a) = (a - b)"*)

	       Rule.Thm ("tausche_vor_minus",TermC.num_str @{thm tausche_vor_minus}),

	       (*"[| b ist_monom; a kleiner b  |] ==> (- b - a) = (-a - b)"*)

	       Rule.Thm ("tausche_plus_plus",TermC.num_str @{thm tausche_plus_plus}),

	       (*"c kleiner b ==> (a + c + b) = (a + b + c)"*)

	       Rule.Thm ("tausche_plus_minus",TermC.num_str @{thm tausche_plus_minus}),

	       (*"c kleiner b ==> (a + c - b) = (a - b + c)"*)

	       Rule.Thm ("tausche_minus_plus",TermC.num_str @{thm tausche_minus_plus}),

	       (*"c kleiner b ==> (a - c + b) = (a + b - c)"*)

	       Rule.Thm ("tausche_minus_minus",TermC.num_str @{thm tausche_minus_minus})

	       (*"c kleiner b ==> (a - c - b) = (a - b - c)"*)

	       ], scr = Rule.EmptyScr};

val fasse_zusammen = 

    Rule.Rls{id = "fasse_zusammen", preconds = [], 

	rew_ord = ("dummy_ord", Rule.dummy_ord),

	erls = Rule.append_rls "erls_fasse_zusammen" Rule.e_rls 

			  [Rule.Calc ("Atools.is'_const",eval_const "#is_const_")], 

	srls = Rule.Erls, calc = [], errpatts = [],

	rules = 

	[Rule.Thm ("real_num_collect",TermC.num_str @{thm real_num_collect}), 

	 (*"[| l is_const; m is_const |]==>l * n + m * n = (l + m) * n"*)

	 Rule.Thm ("real_num_collect_assoc_r",TermC.num_str @{thm real_num_collect_assoc_r}),

	 (*"[| l is_const; m..|] ==>  (k + m * n) + l * n = k + (l + m)*n"*)

	 Rule.Thm ("real_one_collect",TermC.num_str @{thm real_one_collect}),	

	 (*"m is_const ==> n + m * n = (1 + m) * n"*)

	 Rule.Thm ("real_one_collect_assoc_r",TermC.num_str @{thm real_one_collect_assoc_r}), 

	 (*"m is_const ==> (k + n) + m * n = k + (m + 1) * n"*)

	 Rule.Thm ("subtrahiere",TermC.num_str @{thm subtrahiere}),

	 (*"[| l is_const; m is_const |] ==> m * v - l * v = (m - l) * v"*)

	 Rule.Thm ("subtrahiere_von_1",TermC.num_str @{thm subtrahiere_von_1}),

	 (*"[| l is_const |] ==> v - l * v = (1 - l) * v"*)

	 Rule.Thm ("subtrahiere_1",TermC.num_str @{thm subtrahiere_1}),

	 (*"[| l is_const; m is_const |] ==> m * v - v = (m - 1) * v"*)

	 Rule.Thm ("subtrahiere_x_plus_minus",TermC.num_str @{thm subtrahiere_x_plus_minus}), 

	 (*"[| l is_const; m..|] ==> (k + m * n) - l * n = k + ( m - l) * n"*)

	 Rule.Thm ("subtrahiere_x_plus1_minus",TermC.num_str @{thm subtrahiere_x_plus1_minus}),

	 (*"[| l is_const |] ==> (x + v) - l * v = x + (1 - l) * v"*)

	 Rule.Thm ("subtrahiere_x_plus_minus1",TermC.num_str @{thm subtrahiere_x_plus_minus1}),

	 (*"[| m is_const |] ==> (x + m * v) - v = x + (m - 1) * v"*)

	 Rule.Thm ("subtrahiere_x_minus_plus",TermC.num_str @{thm subtrahiere_x_minus_plus}), 

	 (*"[| l is_const; m..|] ==> (k - m * n) + l * n = k + (-m + l) * n"*)

	 Rule.Thm ("subtrahiere_x_minus1_plus",TermC.num_str @{thm subtrahiere_x_minus1_plus}),

	 (*"[| l is_const |] ==> (x - v) + l * v = x + (-1 + l) * v"*)

	 Rule.Thm ("subtrahiere_x_minus_plus1",TermC.num_str @{thm subtrahiere_x_minus_plus1}),

	 (*"[| m is_const |] ==> (x - m * v) + v = x + (-m + 1) * v"*)

	 Rule.Thm ("subtrahiere_x_minus_minus",TermC.num_str @{thm subtrahiere_x_minus_minus}), 

	 (*"[| l is_const; m..|] ==> (k - m * n) - l * n = k + (-m - l) * n"*)

	 Rule.Thm ("subtrahiere_x_minus1_minus",TermC.num_str @{thm subtrahiere_x_minus1_minus}),

	 (*"[| l is_const |] ==> (x - v) - l * v = x + (-1 - l) * v"*)

	 Rule.Thm ("subtrahiere_x_minus_minus1",TermC.num_str @{thm subtrahiere_x_minus_minus1}),

	 (*"[| m is_const |] ==> (x - m * v) - v = x + (-m - 1) * v"*)

	 Rule.Calc ("Groups.plus_class.plus", eval_binop "#add_"),

	 Rule.Calc ("Groups.minus_class.minus", eval_binop "#subtr_"),

	 (*MG: Reihenfolge der folgenden 2 Rule.Thm muss so bleiben, wegen

           (a+a)+a --> a + 2*a --> 3*a and not (a+a)+a --> 2*a + a *)

	 Rule.Thm ("real_mult_2_assoc_r",TermC.num_str @{thm real_mult_2_assoc_r}),

	 (*"(k + z1) + z1 = k + 2 * z1"*)

	 Rule.Thm ("sym_real_mult_2",TermC.num_str (@{thm real_mult_2} RS @{thm sym})),

	 (*"z1 + z1 = 2 * z1"*)

	 Rule.Thm ("addiere_vor_minus",TermC.num_str @{thm addiere_vor_minus}),

	 (*"[| l is_const; m is_const |] ==> -(l * v) +  m * v = (-l + m) *v"*)

	 Rule.Thm ("addiere_eins_vor_minus",TermC.num_str @{thm addiere_eins_vor_minus}),

	 (*"[| m is_const |] ==> -  v +  m * v = (-1 + m) * v"*)

	 Rule.Thm ("subtrahiere_vor_minus",TermC.num_str @{thm subtrahiere_vor_minus}),

	 (*"[| l is_const; m is_const |] ==> -(l * v) -  m * v = (-l - m) *v"*)

	 Rule.Thm ("subtrahiere_eins_vor_minus",TermC.num_str @{thm subtrahiere_eins_vor_minus})

	 (*"[| m is_const |] ==> -  v -  m * v = (-1 - m) * v"*)

	 ], scr = Rule.EmptyScr};

val verschoenere = 

  Rule.Rls{id = "verschoenere", preconds = [], 

      rew_ord = ("dummy_ord", Rule.dummy_ord), srls = Rule.Erls, calc = [], errpatts = [],

      erls = Rule.append_rls "erls_verschoenere" Rule.e_rls 

			[Rule.Calc ("PolyMinus.kleiner", eval_kleiner "")], 

      rules = [Rule.Thm ("vorzeichen_minus_weg1",TermC.num_str @{thm vorzeichen_minus_weg1}),

	       (*"l kleiner 0 ==> a + l * b = a - -l * b"*)

	       Rule.Thm ("vorzeichen_minus_weg2",TermC.num_str @{thm vorzeichen_minus_weg2}),

	       (*"l kleiner 0 ==> a - l * b = a + -l * b"*)

	       Rule.Thm ("vorzeichen_minus_weg3",TermC.num_str @{thm vorzeichen_minus_weg3}),

	       (*"l kleiner 0 ==> k + a - l * b = k + a + -l * b"*)

	       Rule.Thm ("vorzeichen_minus_weg4",TermC.num_str @{thm vorzeichen_minus_weg4}),

	       (*"l kleiner 0 ==> k - a - l * b = k - a + -l * b"*)

	       Rule.Calc ("Groups.times_class.times", eval_binop "#mult_"),

	       Rule.Thm ("mult_zero_left",TermC.num_str @{thm mult_zero_left}),    

	       (*"0 * z = 0"*)

	       Rule.Thm ("mult_1_left",TermC.num_str @{thm mult_1_left}),     

	       (*"1 * z = z"*)

	       Rule.Thm ("add_0_left",TermC.num_str @{thm add_0_left}),

	       (*"0 + z = z"*)

	       Rule.Thm ("null_minus",TermC.num_str @{thm null_minus}),

	       (*"0 - a = -a"*)

	       Rule.Thm ("vor_minus_mal",TermC.num_str @{thm vor_minus_mal})

	       (*"- a * b = (-a) * b"*)

	       (*Rule.Thm ("",TermC.num_str @{}),*)

	       (**)

	       ], scr = Rule.EmptyScr} (*end verschoenere*);

val klammern_aufloesen = 

  Rule.Rls{id = "klammern_aufloesen", preconds = [], 

      rew_ord = ("dummy_ord", Rule.dummy_ord), srls = Rule.Erls, calc = [], errpatts = [], erls = Rule.Erls, 

      rules = [Rule.Thm ("sym_add_assoc",

                     TermC.num_str (@{thm add.assoc} RS @{thm sym})),

	       (*"a + (b + c) = (a + b) + c"*)

	       Rule.Thm ("klammer_plus_minus",TermC.num_str @{thm klammer_plus_minus}),

	       (*"a + (b - c) = (a + b) - c"*)

	       Rule.Thm ("klammer_minus_plus",TermC.num_str @{thm klammer_minus_plus}),

	       (*"a - (b + c) = (a - b) - c"*)

	       Rule.Thm ("klammer_minus_minus",TermC.num_str @{thm klammer_minus_minus})

	       (*"a - (b - c) = (a - b) + c"*)

	       ], scr = Rule.EmptyScr};

val klammern_ausmultiplizieren = 

  Rule.Rls{id = "klammern_ausmultiplizieren", preconds = [], 

      rew_ord = ("dummy_ord", Rule.dummy_ord), srls = Rule.Erls, calc = [], errpatts = [], erls = Rule.Erls, 

      rules = [Rule.Thm ("distrib_right" ,TermC.num_str @{thm distrib_right}),

	       (*"(z1.0 + z2.0) * w = z1.0 * w + z2.0 * w"*)

	       Rule.Thm ("distrib_left",TermC.num_str @{thm distrib_left}),

	       (*"w * (z1.0 + z2.0) = w * z1.0 + w * z2.0"*)

	       Rule.Thm ("klammer_mult_minus",TermC.num_str @{thm klammer_mult_minus}),

	       (*"a * (b - c) = a * b - a * c"*)

	       Rule.Thm ("klammer_minus_mult",TermC.num_str @{thm klammer_minus_mult})

	       (*"(b - c) * a = b * a - c * a"*)

	       (*Rule.Thm ("",TermC.num_str @{}),

	       (*""*)*)

	       ], scr = Rule.EmptyScr};

val ordne_monome = 

  Rule.Rls{id = "ordne_monome", preconds = [], 

      rew_ord = ("dummy_ord", Rule.dummy_ord), srls = Rule.Erls, calc = [], errpatts = [], 

      erls = Rule.append_rls "erls_ordne_monome" Rule.e_rls

	       [Rule.Calc ("PolyMinus.kleiner", eval_kleiner ""),

		Rule.Calc ("Atools.is'_atom", eval_is_atom "")

		], 

      rules = [Rule.Thm ("tausche_mal",TermC.num_str @{thm tausche_mal}),

	       (*"[| b is_atom; a kleiner b  |] ==> (b * a) = (a * b)"*)

	       Rule.Thm ("tausche_vor_mal",TermC.num_str @{thm tausche_vor_mal}),

	       (*"[| b is_atom; a kleiner b  |] ==> (-b * a) = (-a * b)"*)

	       Rule.Thm ("tausche_mal_mal",TermC.num_str @{thm tausche_mal_mal}),

	       (*"[| c is_atom; b kleiner c  |] ==> (a * c * b) = (a * b *c)"*)

	       Rule.Thm ("x_quadrat",TermC.num_str @{thm x_quadrat})

	       (*"(x * a) * a = x * a ^^^ 2"*)

	       (*Rule.Thm ("",TermC.num_str @{}),

	       (*""*)*)

	       ], scr = Rule.EmptyScr};

val rls_p_33 = 

    Rule.append_rls "rls_p_33" Rule.e_rls

	       [Rule.Rls_ ordne_alphabetisch,

		Rule.Rls_ fasse_zusammen,

		Rule.Rls_ verschoenere

		];

val rls_p_34 = 

    Rule.append_rls "rls_p_34" Rule.e_rls

	       [Rule.Rls_ klammern_aufloesen,

		Rule.Rls_ ordne_alphabetisch,

		Rule.Rls_ fasse_zusammen,

		Rule.Rls_ verschoenere

		];

val rechnen = 

    Rule.append_rls "rechnen" Rule.e_rls

	       [Rule.Calc ("Groups.times_class.times", eval_binop "#mult_"),

		Rule.Calc ("Groups.plus_class.plus", eval_binop "#add_"),

		Rule.Calc ("Groups.minus_class.minus", eval_binop "#subtr_")

		];

\<close>

setup \<open>KEStore_Elems.add_rlss 

  [("ordne_alphabetisch", (Context.theory_name @{theory}, prep_rls' ordne_alphabetisch)), 

  ("fasse_zusammen", (Context.theory_name @{theory}, prep_rls' fasse_zusammen)), 

  ("verschoenere", (Context.theory_name @{theory}, prep_rls' verschoenere)), 

  ("ordne_monome", (Context.theory_name @{theory}, prep_rls' ordne_monome)), 

  ("klammern_aufloesen", (Context.theory_name @{theory}, prep_rls' klammern_aufloesen)), 

  ("klammern_ausmultiplizieren",

    (Context.theory_name @{theory}, prep_rls' klammern_ausmultiplizieren))]\<close>

(** problems **)

setup \<open>KEStore_Elems.add_pbts

  [(Specify.prep_pbt thy "pbl_vereinf_poly" [] Celem.e_pblID

      (["polynom","vereinfachen"], [], Rule.Erls, NONE, [])),

    (Specify.prep_pbt thy "pbl_vereinf_poly_minus" [] Celem.e_pblID

      (["plus_minus","polynom","vereinfachen"],

        [("#Given", ["Term t_t"]),

          ("#Where", ["t_t is_polyexp",

            "Not (matchsub (?a + (?b + ?c)) t_t | " ^

            "     matchsub (?a + (?b - ?c)) t_t | " ^

            "     matchsub (?a - (?b + ?c)) t_t | " ^

            "     matchsub (?a + (?b - ?c)) t_t )",

            "Not (matchsub (?a * (?b + ?c)) t_t | " ^

            "     matchsub (?a * (?b - ?c)) t_t | " ^

            "     matchsub ((?b + ?c) * ?a) t_t | " ^

            "     matchsub ((?b - ?c) * ?a) t_t )"]),

          ("#Find", ["normalform n_n"])],

        Rule.append_rls "prls_pbl_vereinf_poly" Rule.e_rls 

	        [Rule.Calc ("Poly.is'_polyexp", eval_is_polyexp ""),

	          Rule.Calc ("Tools.matchsub", Tools.eval_matchsub ""),

	          Rule.Thm ("or_true", TermC.num_str @{thm or_true}),

            (*"(?a | True) = True"*)

            Rule.Thm ("or_false", TermC.num_str @{thm or_false}),

            (*"(?a | False) = ?a"*)

            Rule.Thm ("not_true",TermC.num_str @{thm not_true}),

            (*"(~ True) = False"*)

            Rule.Thm ("not_false",TermC.num_str @{thm not_false})

            (*"(~ False) = True"*)], 

       SOME "Vereinfache t_t", [["simplification","for_polynomials","with_minus"]])),

    (Specify.prep_pbt thy "pbl_vereinf_poly_klammer" [] Celem.e_pblID

      (["klammer","polynom","vereinfachen"],

        [("#Given" ,["Term t_t"]),

          ("#Where" ,["t_t is_polyexp",

            "Not (matchsub (?a * (?b + ?c)) t_t | " ^

            "     matchsub (?a * (?b - ?c)) t_t | " ^

            "     matchsub ((?b + ?c) * ?a) t_t | " ^

            "     matchsub ((?b - ?c) * ?a) t_t )"]),

          ("#Find"  ,["normalform n_n"])],

        Rule.append_rls "prls_pbl_vereinf_poly_klammer" Rule.e_rls

          [Rule.Calc ("Poly.is'_polyexp", eval_is_polyexp ""),

	           Rule.Calc ("Tools.matchsub", Tools.eval_matchsub ""),

             Rule.Thm ("or_true", TermC.num_str @{thm or_true}),

             (*"(?a | True) = True"*)

             Rule.Thm ("or_false", TermC.num_str @{thm or_false}),

             (*"(?a | False) = ?a"*)

             Rule.Thm ("not_true",TermC.num_str @{thm not_true}),

             (*"(~ True) = False"*)

             Rule.Thm ("not_false",TermC.num_str @{thm not_false})

             (*"(~ False) = True"*)], 

        SOME "Vereinfache t_t", 

        [["simplification","for_polynomials","with_parentheses"]])),

    (Specify.prep_pbt thy "pbl_vereinf_poly_klammer_mal" [] Celem.e_pblID

      (["binom_klammer","polynom","vereinfachen"],

        [("#Given", ["Term t_t"]),

          ("#Where", ["t_t is_polyexp"]),

          ("#Find", ["normalform n_n"])],

        Rule.append_rls "e_rls" Rule.e_rls [(*for preds in where_*)

			      Rule.Calc ("Poly.is'_polyexp", eval_is_polyexp "")], 

        SOME "Vereinfache t_t", 

        [["simplification","for_polynomials","with_parentheses_mult"]])),

    (Specify.prep_pbt thy "pbl_probe" [] Celem.e_pblID (["probe"], [], Rule.Erls, NONE, [])),

    (Specify.prep_pbt thy "pbl_probe_poly" [] Celem.e_pblID

      (["polynom","probe"],

        [("#Given", ["Pruefe e_e", "mitWert w_w"]),

          ("#Where", ["e_e is_polyexp"]),

          ("#Find", ["Geprueft p_p"])],

        Rule.append_rls "prls_pbl_probe_poly" Rule.e_rls [(*for preds in where_*)

		      Rule.Calc ("Poly.is'_polyexp", eval_is_polyexp "")], 

        SOME "Probe e_e w_w", 

        [["probe","fuer_polynom"]])),

    (Specify.prep_pbt thy "pbl_probe_bruch" [] Celem.e_pblID

      (["bruch","probe"],

        [("#Given" ,["Pruefe e_e", "mitWert w_w"]),

          ("#Where" ,["e_e is_ratpolyexp"]),

          ("#Find"  ,["Geprueft p_p"])],

        Rule.append_rls "prls_pbl_probe_bruch" Rule.e_rls [(*for preds in where_*)

		      Rule.Calc ("Rational.is'_ratpolyexp", eval_is_ratpolyexp "")], 

        SOME "Probe e_e w_w", [["probe","fuer_bruch"]]))]\<close>

(** methods **)

partial_function (tailrec) simplify :: "real \<Rightarrow> real"

  where

"simplify t_t =

  ((Repeat((Try (Rewrite_Set ''ordne_alphabetisch'' False)) @@

           (Try (Rewrite_Set ''fasse_zusammen''     False)) @@

           (Try (Rewrite_Set ''verschoenere''       False)))) t_t)"

setup \<open>KEStore_Elems.add_mets

    [Specify.prep_met thy "met_simp_poly_minus" [] Celem.e_metID

	    (["simplification","for_polynomials","with_minus"],

	      [("#Given" ,["Term t_t"]),

	        ("#Where" ,["t_t is_polyexp",

	            "Not (matchsub (?a + (?b + ?c)) t_t | " ^

	            "     matchsub (?a + (?b - ?c)) t_t | " ^

	            "     matchsub (?a - (?b + ?c)) t_t | " ^

	            "     matchsub (?a + (?b - ?c)) t_t )"]),

	        ("#Find"  ,["normalform n_n"])],

	      {rew_ord'="tless_true", rls' = Rule.e_rls, calc = [], srls = Rule.e_rls,

	        prls = Rule.append_rls "prls_met_simp_poly_minus" Rule.e_rls 

				      [Rule.Calc ("Poly.is'_polyexp", eval_is_polyexp ""),

				        Rule.Calc ("Tools.matchsub", Tools.eval_matchsub ""),

				        Rule.Thm ("and_true",TermC.num_str @{thm and_true}),

                (*"(?a & True) = ?a"*)

                Rule.Thm ("and_false",TermC.num_str @{thm and_false}),

                (*"(?a & False) = False"*)

                Rule.Thm ("not_true",TermC.num_str @{thm not_true}),

                (*"(~ True) = False"*)

                Rule.Thm ("not_false",TermC.num_str @{thm not_false})

                (*"(~ False) = True"*)],

          crls = Rule.e_rls, errpats = [], nrls = rls_p_33},

          @{thm simplify.simps}

	    (*"Script SimplifyScript (t_t::real) =                   " ^

            "  ((Repeat((Try (Rewrite_Set ''ordne_alphabetisch'' False)) @@  " ^

            "           (Try (Rewrite_Set ''fasse_zusammen''     False)) @@  " ^

            "           (Try (Rewrite_Set ''verschoenere''       False)))) t_t)"*))]

\<close>

partial_function (tailrec) simplify2 :: "real \<Rightarrow> real"

  where

"simplify2 t_t =

  ((Repeat((Try (Rewrite_Set ''klammern_aufloesen'' False)) @@

           (Try (Rewrite_Set ''ordne_alphabetisch'' False)) @@

           (Try (Rewrite_Set ''fasse_zusammen''     False)) @@

           (Try (Rewrite_Set ''verschoenere''       False)))) t_t)"

setup \<open>KEStore_Elems.add_mets

    [Specify.prep_met thy "met_simp_poly_parenth" [] Celem.e_metID

	    (["simplification","for_polynomials","with_parentheses"],

	      [("#Given" ,["Term t_t"]),

	        ("#Where" ,["t_t is_polyexp"]),

	        ("#Find"  ,["normalform n_n"])],

	      {rew_ord'="tless_true", rls' = Rule.e_rls, calc = [], srls = Rule.e_rls, 

	        prls = Rule.append_rls "simplification_for_polynomials_prls" Rule.e_rls 

				    [(*for preds in where_*) Rule.Calc("Poly.is'_polyexp",eval_is_polyexp"")],

				  crls = Rule.e_rls, errpats = [], nrls = rls_p_34},

				@{thm simplify2.simps}

	    (*"Script SimplifyScript (t_t::real) =                          " ^

          "  ((Repeat((Try (Rewrite_Set ''klammern_aufloesen'' False)) @@  " ^

          "           (Try (Rewrite_Set ''ordne_alphabetisch'' False)) @@  " ^

          "           (Try (Rewrite_Set ''fasse_zusammen''     False)) @@  " ^

          "           (Try (Rewrite_Set ''verschoenere''       False)))) t_t)"*))]

\<close>

partial_function (tailrec) simplify3 :: "real \<Rightarrow> real"

  where

"simplify3 t_t =

  ((Repeat((Try (Rewrite_Set ''klammern_ausmultiplizieren'' False)) @@

           (Try (Rewrite_Set ''discard_parentheses''        False)) @@

           (Try (Rewrite_Set ''ordne_monome''               False)) @@

           (Try (Rewrite_Set ''klammern_aufloesen''         False)) @@

           (Try (Rewrite_Set ''ordne_alphabetisch''         False)) @@

           (Try (Rewrite_Set ''fasse_zusammen''             False)) @@

           (Try (Rewrite_Set ''verschoenere''               False)))) t_t)"

setup \<open>KEStore_Elems.add_mets

    [Specify.prep_met thy "met_simp_poly_parenth_mult" [] Celem.e_metID

	    (["simplification","for_polynomials","with_parentheses_mult"],

	      [("#Given" ,["Term t_t"]), ("#Where" ,["t_t is_polyexp"]), ("#Find"  ,["normalform n_n"])],

	        {rew_ord'="tless_true", rls' = Rule.e_rls, calc = [], srls = Rule.e_rls, 

	          prls = Rule.append_rls "simplification_for_polynomials_prls" Rule.e_rls 

				      [(*for preds in where_*) Rule.Calc("Poly.is'_polyexp",eval_is_polyexp"")],

				    crls = Rule.e_rls, errpats = [], nrls = rls_p_34},

				  @{thm simplify3.simps}

	    (*"Script SimplifyScript (t_t::real) =                          " ^

            "  ((Repeat((Try (Rewrite_Set ''klammern_ausmultiplizieren'' False)) @@ " ^

            "           (Try (Rewrite_Set ''discard_parentheses''        False)) @@ " ^

            "           (Try (Rewrite_Set ''ordne_monome''               False)) @@ " ^

            "           (Try (Rewrite_Set ''klammern_aufloesen''         False)) @@ " ^

            "           (Try (Rewrite_Set ''ordne_alphabetisch''         False)) @@ " ^

            "           (Try (Rewrite_Set ''fasse_zusammen''             False)) @@ " ^

            "           (Try (Rewrite_Set ''verschoenere''               False)))) t_t)"*))]

\<close>

setup \<open>KEStore_Elems.add_mets

    [Specify.prep_met thy "met_probe" [] Celem.e_metID

	    (["probe"], [],

	      {rew_ord'="tless_true", rls' = Rule.e_rls, calc = [], srls = Rule.e_rls, prls = Rule.Erls, crls = Rule.e_rls,

	        errpats = [], nrls = Rule.Erls}, 

	      @{thm refl})]

\<close>

partial_function (tailrec) mache_probe :: "bool \<Rightarrow> bool list \<Rightarrow> bool"

  where

"mache_probe e_e w_w =

 (let e_e = Take e_e;

      e_e = Substitute w_w e_e

 in (Repeat ((Try (Repeat (Calculate ''TIMES''))) @@

             (Try (Repeat (Calculate ''PLUS'' ))) @@

             (Try (Repeat (Calculate ''MINUS''))))) e_e)"

setup \<open>KEStore_Elems.add_mets

    [Specify.prep_met thy "met_probe_poly" [] Celem.e_metID

	    (["probe","fuer_polynom"],

	      [("#Given" ,["Pruefe e_e", "mitWert w_w"]),

	        ("#Where" ,["e_e is_polyexp"]),

	        ("#Find"  ,["Geprueft p_p"])],

	      {rew_ord'="tless_true", rls' = Rule.e_rls, calc = [], srls = Rule.e_rls, 

	        prls = Rule.append_rls "prls_met_probe_bruch" Rule.e_rls

	            [(*for preds in where_*) Rule.Calc ("Rational.is'_ratpolyexp", eval_is_ratpolyexp "")], 

	        crls = Rule.e_rls, errpats = [], nrls = rechnen}, 

	      @{thm mache_probe.simps}

	    (*"Script ProbeScript (e_e::bool) (w_w::bool list) = " ^

          " (let e_e = Take e_e;                              " ^

          "      e_e = Substitute w_w e_e                     " ^

          " in (Repeat((Try (Repeat (Calculate ''TIMES''))) @@  " ^

          "            (Try (Repeat (Calculate ''PLUS'' ))) @@  " ^

          "            (Try (Repeat (Calculate ''MINUS''))))) e_e)"*))]

\<close>

setup \<open>KEStore_Elems.add_mets

    [Specify.prep_met thy "met_probe_bruch" [] Celem.e_metID

	    (["probe","fuer_bruch"],

	      [("#Given" ,["Pruefe e_e", "mitWert w_w"]),

	        ("#Where" ,["e_e is_ratpolyexp"]),

	        ("#Find"  ,["Geprueft p_p"])],

	      {rew_ord'="tless_true", rls' = Rule.e_rls, calc = [], srls = Rule.e_rls, 

	        prls = Rule.append_rls "prls_met_probe_bruch" Rule.e_rls

	            [(*for preds in where_*) Rule.Calc ("Rational.is'_ratpolyexp", eval_is_ratpolyexp "")], 

	        crls = Rule.e_rls, errpats = [], nrls = Rule.Erls}, 

	      @{thm refl})]

\<close>

end