(*.(c) by Richard Lang, 2003 .*)

(* theory collecting all knowledge for RationalEquations

   created by: rlang 

         date: 02.08.12

   changed by: rlang

   last change by: rlang

             date: 02.11.28

*)

theory RatEq imports Rational Equation begin

text \<open>univariate equations over multivariate rational terms:

  In 2003 this type has been integrated into ISAC's equation solver

  by Richard Lang; the root for the solver is Equation.thy.

  The migration Isabelle2002 --> 2011 found that application of theorems like 

  rat_mult_denominator_right: "[|Not(d=0)|] ==> ((a::real) = c / d) = (a*d = c)"

  in rule-sets does not transfer "d ~= 0" to the assumptions; see

  test --- repair NO asms from rls RatEq_eliminate ---.

  Thus the migration dropped update of Check_elementwise, which would require

  these assumptions; see 

  test --- pbl: rational, univariate, equation ---, --- x / (x ^ 2 - 6 * x + 9) - 1 /...

\<close>

consts

  is'_ratequation'_in :: "[bool, real] => bool" ("_ is'_ratequation'_in _")

  (*----------------------scripts-----------------------*)

  Solve'_rat'_equation

             :: "[bool,real, 

		   bool list] => bool list"

               ("((Script Solve'_rat'_equation (_ _ =))// (_))" 9)

axiomatization where

   (* FIXME also in Poly.thy def. --> FIXED*)

   (*real_diff_minus            

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

   real_rat_mult_1:   "a*(b/c) = (a*b)/c" and

   real_rat_mult_2:   "(a/b)*(c/d) = (a*c)/(b*d)" and

   real_rat_mult_3:   "(a/b)*c = (a*c)/b" and

   real_rat_pow:      "(a/b)^^^2 = a^^^2/b^^^2" and

   rat_double_rat_1:   "[|Not(c=0); Not(d=0)|] ==> (a / (c/d) = (a*d) / c)" and

   rat_double_rat_2:   "[|Not(b=0);Not(c=0); Not(d=0)|] ==> 

                                           ((a/b) / (c/d) = (a*d) / (b*c))" and

   rat_double_rat_3:   "[|Not(b=0);Not(c=0)|] ==> ((a/b) / c = a / (b*c))" and

  (* equation to same denominator *)

  rat_mult_denominator_both:

   "[|Not(b=0); Not(d=0)|] ==> ((a::real) / b = c / d) = (a*d = c*b)" and

  rat_mult_denominator_left:

   "[|Not(d=0)|] ==> ((a::real) = c / d) = (a*d = c)" and

  rat_mult_denominator_right:

   "[|Not(b=0)|] ==> ((a::real) / b = c) = (a = c*b)"

ML \<open>

val thy = @{theory};

(*-------------------------functions-----------------------*)

(* is_rateqation_in becomes true, if a bdv is in the denominator of a fraction*)

fun is_rateqation_in t v = 

    let 

	fun coeff_in c v = member op = (TermC.vars c) v;

   	fun finddivide (_ $ _ $ _ $ _) v = error("is_rateqation_in:")

	    (* at the moment there is no term like this, but ....*)

	  | finddivide (t as (Const ("Rings.divide_class.divide",_) $ _ $ b)) v = coeff_in b v

	  | finddivide (_ $ t1 $ t2) v = (finddivide t1 v) 

                                         orelse (finddivide t2 v)

	  | finddivide (_ $ t1) v = (finddivide t1 v)

	  | finddivide _ _ = false;

     in

	finddivide t v

    end;

fun eval_is_ratequation_in _ _ 

       (p as (Const ("RatEq.is'_ratequation'_in",_) $ t $ v)) _  =

    if is_rateqation_in t v then 

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

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

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

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

  | eval_is_ratequation_in _ _ _ _ = ((*tracing"### nichts matcht";*) NONE);

(*-------------------------rulse-----------------------*)

val RatEq_prls = (*15.10.02:just the following order due to subterm evaluation*)

  Rule.append_rls "RatEq_prls" Rule.e_rls 

	     [Rule.Calc ("Atools.ident",eval_ident "#ident_"),

	      Rule.Calc ("Tools.matches", Tools.eval_matches ""),

	      Rule.Calc ("Tools.lhs"    , Tools.eval_lhs ""),

	      Rule.Calc ("Tools.rhs"    , Tools.eval_rhs ""),

	      Rule.Calc ("RatEq.is'_ratequation'_in",eval_is_ratequation_in ""),

	      Rule.Calc ("HOL.eq",eval_equal "#equal_"),

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

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

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

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

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

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

	      ];

(*rls = Rule.merge_rls erls Poly_erls *)

val rateq_erls = 

    Rule.remove_rls "rateq_erls"                             (*WN: ein Hack*)

	(Rule.merge_rls "is_ratequation_in" calculate_Rational

		   (Rule.append_rls "is_ratequation_in"

			Poly_erls

			[(*Rule.Calc ("Rings.divide_class.divide", eval_cancel "#divide_e"),*)

			 Rule.Calc ("RatEq.is'_ratequation'_in",

			       eval_is_ratequation_in "")

			 ]))

	[Rule.Thm ("and_commute",TermC.num_str @{thm and_commute}), (*WN: ein Hack*)

	 Rule.Thm ("or_commute",TermC.num_str @{thm or_commute})    (*WN: ein Hack*)

	 ];

\<close>

setup \<open>KEStore_Elems.add_rlss [("rateq_erls", (Context.theory_name @{theory}, rateq_erls))]\<close>

ML \<open>

val RatEq_crls = 

    Rule.remove_rls "RatEq_crls"                              (*WN: ein Hack*)

	(Rule.merge_rls "is_ratequation_in" calculate_Rational

		   (Rule.append_rls "is_ratequation_in"

			Poly_erls

			[(*Rule.Calc ("Rings.divide_class.divide", eval_cancel "#divide_e"),*)

			 Rule.Calc ("RatEq.is'_ratequation'_in",

			       eval_is_ratequation_in "")

			 ]))

	[Rule.Thm ("and_commute",TermC.num_str @{thm and_commute}), (*WN: ein Hack*)

	 Rule.Thm ("or_commute",TermC.num_str @{thm or_commute})    (*WN: ein Hack*)

	 ];

val RatEq_eliminate = prep_rls'(

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

       rew_ord = ("termlessI", termlessI), erls = rateq_erls, srls = Rule.Erls, 

       calc = [], errpatts = [],

       rules = [

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

	     (* a/b=c/d -> ad=cb *)

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

	     (* a  =c/d -> ad=c  *)

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

	     (* a/b=c   ->  a=cb *)

	    ],

    scr = Rule.Prog ((Thm.term_of o the o (TermC.parse thy)) "empty_script")

    });

\<close>

setup \<open>KEStore_Elems.add_rlss [("RatEq_eliminate",

  (Context.theory_name @{theory}, RatEq_eliminate))]\<close>

ML \<open>

val RatEq_simplify = prep_rls'(

  Rule.Rls {id = "RatEq_simplify", preconds = [], rew_ord = ("termlessI", termlessI),

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

    rules = [

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

	     (*a*(b/c) = (a*b)/c*)

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

	     (*(a/b)*(c/d) = (a*c)/(b*d)*)

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

             (* (a/b)*c = (a*c)/b*)

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

	     (*(a/b)^^^2 = a^^^2/b^^^2*)

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

	     (* a - b = a + (-1) * b *)

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

             (* (a / (c/d) = (a*d) / c) *)

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

             (* ((a/b) / (c/d) = (a*d) / (b*c)) *)

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

             (* ((a/b) / c = a / (b*c) ) *)

	     ],

    scr = Rule.Prog ((Thm.term_of o the o (TermC.parse thy)) "empty_script")

    });

\<close>

setup \<open>KEStore_Elems.add_rlss [("RatEq_simplify",

  (Context.theory_name @{theory}, RatEq_simplify))]\<close>

ML \<open>

(*-------------------------Problem-----------------------*)

(*

(get_pbt ["rational","univariate","equation"]);

show_ptyps(); 

*)

\<close>

setup \<open>KEStore_Elems.add_pbts

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

    (["rational","univariate","equation"],

      [("#Given", ["equality e_e","solveFor v_v"]),

        ("#Where", ["(e_e::bool) is_ratequation_in (v_v::real)"]),

        ("#Find", ["solutions v_v'i'"])],

      RatEq_prls, SOME "solve (e_e::bool, v_v)", [["RatEq","solve_rat_equation"]]))]\<close>

(*-------------------------methods-----------------------*)

setup \<open>KEStore_Elems.add_mets

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

      (["RatEq"], [],

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

          crls=RatEq_crls, errpats = [], nrls = norm_Rational}, "empty_script")]

\<close>

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

  where

"solve_rational_equ e_e v_v =

(let e_e = ((Repeat(Try (Rewrite_Set ''RatEq_simplify'' True))) @@

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

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

            (Repeat(Try (Rewrite_Set ''RatEq_eliminate'' True)))) e_e;

     L_L = SubProblem (''RatEq'', [''univariate'', ''equation''], [''no_met''])

            [BOOL e_e, REAL v_v]

 in Check_elementwise L_L {(v_v::real). Assumptions})"

setup \<open>KEStore_Elems.add_mets

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

      (["RatEq", "solve_rat_equation"],

        [("#Given" ,["equality e_e","solveFor v_v"]),

          ("#Where" ,["(e_e::bool) is_ratequation_in (v_v::real)"]),

          ("#Find"  ,["solutions v_v'i'"])],

        {rew_ord'="termlessI", rls'=rateq_erls, srls=Rule.e_rls, prls=RatEq_prls, calc=[],

          crls=RatEq_crls, errpats = [], nrls = norm_Rational},

        "Script Solve_rat_equation  (e_e::bool) (v_v::real) =                   " ^

          "(let e_e = ((Repeat(Try (Rewrite_Set ''RatEq_simplify''      True))) @@  " ^

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

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

          "           (Repeat(Try (Rewrite_Set ''RatEq_eliminate''     True)))) e_e;" ^

          " (L_L::bool list) = (SubProblem (''RatEq'',[''univariate'',''equation''], [''no_met''])" ^

          "                    [BOOL e_e, REAL v_v])                     " ^

          " in Check_elementwise L_L {(v_v::real). Assumptions})")]

\<close>

setup \<open>KEStore_Elems.add_calcs

  [("is_ratequation_in", ("RatEq.is_ratequation_in", eval_is_ratequation_in ""))]\<close>

end