src/Tools/isac/Knowledge/Integrate.thy
author wneuper <Walther.Neuper@jku.at>
Mon, 01 Jan 2024 11:31:16 +0100
changeset 60789 8fa678b678e8
parent 60682 81fe68e76522
permissions -rw-r--r--
Doc/Specify_Phase 4: start use antiquotations from isar-ref
     1 (* integration over the reals
     2    author: Walther Neuper
     3    050814, 08:51
     4    (c) due to copyright terms
     5 *)
     6 
     7 theory Integrate imports Diff begin
     8 
     9 consts
    10 
    11   Integral            :: "[real, real]=> real" ("Integral _ D _" 91)
    12   add_new_c          :: "real => real"        ("add'_new'_c _" 66) 
    13   is_f_x            :: "real => bool"        ("_ is'_f'_x" 10)
    14 
    15   (*descriptions in the related problems*)
    16   integrateBy         :: "real => una"
    17   antiDerivative      :: "real => una"
    18   antiDerivativeName  :: "(real => real) => una"
    19 
    20   (*the CAS-command, eg. "Integrate (2*x \<up> 3, x)"*)
    21   Integrate           :: "[real * real] => real"
    22 
    23 axiomatization where
    24 (*stated as axioms, todo: prove as theorems
    25   'bdv' is a constant handled on the meta-level 
    26    specifically as a 'bound variable'            *)
    27 
    28 (*Ambiguous input\<^here> produces 3 parse trees -----------------------------\\*)
    29   integral_const:    "Not (bdv occurs_in u) ==> Integral u D bdv = u * bdv" and
    30   integral_var:      "Integral bdv D bdv = bdv \<up> 2 / 2" and
    31 
    32   integral_add:      "Integral (u + v) D bdv =  
    33 		     (Integral u D bdv) + (Integral v D bdv)" and
    34   integral_mult:     "[| Not (bdv occurs_in u); bdv occurs_in v |] ==>  
    35 		     Integral (u * v) D bdv = u * (Integral v D bdv)" and
    36 (*WN080222: this goes into sub-terms, too ...
    37   call_for_new_c:    "[| Not (matches (u + new_c v) a); Not (a is_f_x) |] ==>  
    38 		     a = a + new_c a"
    39 *)
    40   integral_pow:      "Integral bdv \<up> n D bdv = bdv \<up> (n+1) / (n + 1)"
    41 (*Ambiguous input\<^here> produces 3 parse trees -----------------------------//*)
    42 
    43 ML \<open>
    44 (** eval functions **)
    45 
    46 val c = Free ("c", HOLogic.realT);
    47 (*.create a new unique variable 'c..' in a term; for use by \<^rule_eval> in a rls;
    48    an alternative to do this would be '(Try (Calculate new_c_) (new_c es__))'
    49    in the program; this would be possible if currying would not take the value
    50    from a variable, but the value '(new_c es__)' itself.*)
    51 fun new_c term = 
    52   let
    53     fun selc var = 
    54 	    case (Symbol.explode o TermC.id_of) var of
    55 		    "c"::[] => true
    56 	    |	"c" :: "_":: is =>
    57         (case (TermC.int_opt_of_string o implode) is of
    58 				   SOME _ => true
    59 				 | NONE => false)
    60          | _ => false;
    61 	  fun get_coeff c =
    62       case (Symbol.explode o TermC.id_of) c of
    63 	      "c"::"_"::is => (the o TermC.int_opt_of_string o implode) is
    64 			| _ => 0;
    65     val cs = filter selc (TermC.vars term);
    66   in 
    67 	  case cs of
    68 	    [] => c
    69 	  | [_] => Free ("c_2", HOLogic.realT)
    70 	  | cs => 
    71 	    let val max_coeff = maxl (map get_coeff cs)
    72 	    in Free ("c_"^string_of_int (max_coeff + 1), HOLogic.realT) end
    73   end;
    74 
    75 (*WN080222:*)
    76 (*("add_new_c", ("Integrate.add_new_c", eval_add_new_c "#add_new_c_"))
    77   add a new c to a term or a fun-equation;
    78   this is _not in_ the term, because only applied to _whole_ term*)
    79 fun eval_add_new_c (_:string) "Integrate.add_new_c" p (_:Proof.context) =
    80     let val p' = case p of
    81 		     Const (\<^const_name>\<open>HOL.eq\<close>, T) $ lh $ rh => 
    82 		     Const (\<^const_name>\<open>HOL.eq\<close>, T) $ lh $ TermC.mk_add rh (new_c rh)
    83 		   | p => TermC.mk_add p (new_c p)
    84     in SOME ((UnparseC.term @{context} p) ^ " = " ^ UnparseC.term @{context} p',
    85 	  HOLogic.Trueprop $ (TermC.mk_equality (p, p')))
    86     end
    87   | eval_add_new_c _ _ _ _ = NONE;
    88 
    89 
    90 (*("is_f_x", ("Integrate.is_f_x", eval_is_f_x "is_f_x_"))*)
    91 fun eval_is_f_x _ _(p as (Const (\<^const_name>\<open>Integrate.is_f_x\<close>, _)
    92 					   $ arg)) _ =
    93     if TermC.is_f_x arg
    94     then SOME ((UnparseC.term @{context} p) ^ " = True",
    95 	       HOLogic.Trueprop $ (TermC.mk_equality (p, @{term True})))
    96     else SOME ((UnparseC.term @{context} p) ^ " = False",
    97 	       HOLogic.Trueprop $ (TermC.mk_equality (p, @{term False})))
    98   | eval_is_f_x _ _ _ _ = NONE;
    99 \<close>
   100 
   101 calculation add_new_c = \<open>eval_add_new_c "add_new_c_"\<close>
   102 calculation is_f_x = \<open>eval_is_f_x "is_f_idextifier_"\<close>
   103 
   104 ML \<open>
   105 (** rulesets **)
   106 
   107 (*.rulesets for integration.*)
   108 val integration_rules = 
   109   Rule_Def.Repeat {id="integration_rules", preconds = [], 
   110     rew_ord = ("termlessI",termlessI), 
   111     asm_rls = Rule_Def.Repeat {id="conditions_in_integration_rules", 
   112    	  preconds = [], 
   113    	  rew_ord = ("termlessI",termlessI), 
   114    	  asm_rls = Rule_Set.Empty, 
   115    	  prog_rls = Rule_Set.Empty, calc = [], errpatts = [],
   116    	  rules = [(*for rewriting conditions in Thm's*)
   117    		   \<^rule_eval>\<open>Prog_Expr.occurs_in\<close> (Prog_Expr.eval_occurs_in "#occurs_in_"),
   118    		   \<^rule_thm>\<open>not_true\<close>,
   119    		   \<^rule_thm>\<open>not_false\<close>],
   120    	  program = Rule.Empty_Prog}, 
   121     prog_rls = Rule_Set.Empty, calc = [], errpatts = [],
   122     rules = [
   123    	  \<^rule_thm>\<open>integral_const\<close>,
   124    	  \<^rule_thm>\<open>integral_var\<close>,
   125    	  \<^rule_thm>\<open>integral_add\<close>,
   126    	  \<^rule_thm>\<open>integral_mult\<close>,
   127    	  \<^rule_thm>\<open>integral_pow\<close>,
   128    	  \<^rule_eval>\<open>plus\<close> (**)(Calc_Binop.numeric "#add_")(*for n+1*)],
   129     program = Rule.Empty_Prog};
   130 \<close>
   131 ML \<open>
   132 val add_new_c = 
   133   Rule_Set.Sequence {id="add_new_c", preconds = [], 
   134     rew_ord = ("termlessI",termlessI), 
   135     asm_rls = Rule_Def.Repeat {id="conditions_in_add_new_c", 
   136       preconds = [], rew_ord = ("termlessI",termlessI), asm_rls = Rule_Set.Empty, 
   137       prog_rls = Rule_Set.Empty, calc = [], errpatts = [],
   138       rules = [
   139         \<^rule_eval>\<open>Prog_Expr.matches\<close> (Prog_Expr.eval_matches""),
   140    	    \<^rule_eval>\<open>Integrate.is_f_x\<close> (eval_is_f_x "is_f_x_"),
   141    	    \<^rule_thm>\<open>not_true\<close>,
   142    	    \<^rule_thm>\<open>not_false\<close>],
   143       program = Rule.Empty_Prog}, 
   144     prog_rls = Rule_Set.Empty, calc = [], errpatts = [],
   145     rules = [ (*\<^rule_thm>\<open>call_for_new_c\<close>,*)
   146       Rule.Cal1 ("Integrate.add_new_c", eval_add_new_c "new_c_")],
   147     program = Rule.Empty_Prog};
   148 \<close>
   149 ML \<open>
   150 
   151 (*.rulesets for simplifying Integrals.*)
   152 
   153 (*.for simplify_Integral adapted from 'norm_Rational_rls'.*)
   154 val norm_Rational_rls_noadd_fractions = 
   155   Rule_Def.Repeat {id = "norm_Rational_rls_noadd_fractions", preconds = [], 
   156     rew_ord = ("dummy_ord",Rewrite_Ord.function_empty), 
   157     asm_rls = norm_rat_erls, prog_rls = Rule_Set.Empty, calc = [], errpatts = [],
   158     rules = [(*Rule.Rls_ add_fractions_p_rls,!!!*)
   159   	  Rule.Rls_ (*rat_mult_div_pow original corrected WN051028*)
   160   		(Rule_Def.Repeat {id = "rat_mult_div_pow", preconds = [], 
   161   		   rew_ord = ("dummy_ord",Rewrite_Ord.function_empty), 
   162   		   asm_rls = Rule_Set.append_rules "Rule_Set.empty-is_polyexp" Rule_Set.empty
   163   				 [\<^rule_eval>\<open>is_polyexp\<close> (eval_is_polyexp "")],
   164   			 prog_rls = Rule_Set.Empty, calc = [], errpatts = [],
   165   		   rules = [
   166            \<^rule_thm>\<open>rat_mult\<close>, (*"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
   167   	       \<^rule_thm>\<open>rat_mult_poly_l\<close>, (*"?c is_polyexp ==> ?c * (?a / ?b) = ?c * ?a / ?b"*)
   168   	       \<^rule_thm>\<open>rat_mult_poly_r\<close>, (*"?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"*)
   169   
   170   	       \<^rule_thm>\<open>real_divide_divide1_mg\<close>, (*"y ~= 0 ==> (u / v) / (y / z) = (u * z) / (y * v)"*)
   171   	       \<^rule_thm>\<open>divide_divide_eq_right\<close>, (*"?x / (?y / ?z) = ?x * ?z / ?y"*)
   172   	       \<^rule_thm>\<open>divide_divide_eq_left\<close>, (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
   173   	       \<^rule_eval>\<open>divide\<close> (Prog_Expr.eval_cancel "#divide_e"),
   174   	      
   175   	       \<^rule_thm>\<open>rat_power\<close>], (*"(?a / ?b)  \<up>  ?n = ?a  \<up>  ?n / ?b  \<up>  ?n"*)
   176         program = Rule.Empty_Prog}),
   177   		Rule.Rls_ make_rat_poly_with_parentheses,
   178   		Rule.Rls_ cancel_p_rls,(*FIXME:cancel_p does NOT order sometimes*)
   179   		Rule.Rls_ rat_reduce_1],
   180     program = Rule.Empty_Prog};
   181 
   182 (*.for simplify_Integral adapted from 'norm_Rational'.*)
   183 val norm_Rational_noadd_fractions = 
   184   Rule_Set.Sequence {id = "norm_Rational_noadd_fractions", preconds = [], 
   185     rew_ord = ("dummy_ord",Rewrite_Ord.function_empty), 
   186     asm_rls = norm_rat_erls, prog_rls = Rule_Set.Empty, calc = [], errpatts = [],
   187     rules = [Rule.Rls_ discard_minus,
   188   		Rule.Rls_ rat_mult_poly,(* removes double fractions like a/b/c    *)
   189   		Rule.Rls_ make_rat_poly_with_parentheses, (*WN0510 also in(#)below*)
   190   		Rule.Rls_ cancel_p_rls, (*FIXME.MG:cancel_p does NOT order sometim*)
   191   		Rule.Rls_ norm_Rational_rls_noadd_fractions,(* the main rls (#)   *)
   192   		Rule.Rls_ discard_parentheses1], (* mult only                       *)
   193     program = Rule.Empty_Prog};
   194 
   195 (*.simplify terms before and after Integration such that  
   196    ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
   197    common denominator as done by norm_Rational or make_ratpoly_in.
   198    This is a copy from 'make_ratpoly_in' with respective reduction of rules and
   199    *1* expand the term, ie. distribute * and / over +
   200 .*)
   201 val separate_bdv2 =
   202    Rule_Set.append_rules "separate_bdv2" collect_bdv [
   203     \<^rule_thm>\<open>separate_bdv\<close>, (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
   204 		\<^rule_thm>\<open>separate_bdv_n\<close>,
   205 		\<^rule_thm>\<open>separate_1_bdv\<close>, (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
   206 		\<^rule_thm>\<open>separate_1_bdv_n\<close> (*"?bdv  \<up>  ?n / ?b = 1 / ?b * ?bdv  \<up>  ?n"*)
   207     (*
   208 		rule_thm>\<open>add_divide_distrib\<close> (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)*)
   209 		];
   210 val simplify_Integral = 
   211   Rule_Set.Sequence {id = "simplify_Integral", preconds = []:term list, 
   212     rew_ord = ("dummy_ord", Rewrite_Ord.function_empty),
   213     asm_rls = Atools_erls, prog_rls = Rule_Set.Empty,
   214     calc = [],  errpatts = [],
   215     rules = [
   216       \<^rule_thm>\<open>distrib_right\<close>, (*"(?z1.0 + ?z2.0) * ?w = ?z1.0 * ?w + ?z2.0 * ?w"*)
   217 	    \<^rule_thm>\<open>add_divide_distrib\<close>, (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)
   218 	     (*^^^^^ *1* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
   219 	    Rule.Rls_ norm_Rational_noadd_fractions,
   220 	    Rule.Rls_ order_add_mult_in,
   221 	    Rule.Rls_ discard_parentheses,
   222 	    (*Rule.Rls_ collect_bdv, from make_polynomial_in*)
   223 	    Rule.Rls_ separate_bdv2,
   224 	    \<^rule_eval>\<open>divide\<close> (Prog_Expr.eval_cancel "#divide_e")],
   225     program = Rule.Empty_Prog};      
   226 
   227 val integration =
   228   Rule_Set.Sequence {
   229      id="integration", preconds = [], rew_ord = ("termlessI",termlessI), 
   230   	 asm_rls = Rule_Def.Repeat {
   231        id="conditions_in_integration",  preconds = [], rew_ord = ("termlessI",termlessI), 
   232   		 asm_rls = Rule_Set.Empty, prog_rls = Rule_Set.Empty, calc = [], errpatts = [],
   233   		 rules = [], program = Rule.Empty_Prog}, 
   234   	 prog_rls = Rule_Set.Empty, calc = [], errpatts = [],
   235   	 rules = [
   236       Rule.Rls_ integration_rules,
   237   		 Rule.Rls_ add_new_c,
   238   		 Rule.Rls_ simplify_Integral],
   239   	 program = Rule.Empty_Prog};
   240 
   241 val prep_rls' = Auto_Prog.prep_rls @{theory};
   242 \<close>
   243 rule_set_knowledge
   244   integration_rules = \<open>prep_rls' integration_rules\<close> and
   245   add_new_c = \<open>prep_rls' add_new_c\<close> and
   246   simplify_Integral = \<open>prep_rls' simplify_Integral\<close> and
   247   integration = \<open>prep_rls' integration\<close> and
   248   separate_bdv2 = \<open>prep_rls' separate_bdv2\<close> and
   249   norm_Rational_noadd_fractions = \<open>prep_rls' norm_Rational_noadd_fractions\<close> and
   250   norm_Rational_rls_noadd_fractions = \<open>prep_rls' norm_Rational_rls_noadd_fractions\<close>
   251 
   252 (** problems **)
   253 
   254 problem pbl_fun_integ : "integrate/function" =
   255   \<open>Rule_Set.append_rules "empty" Rule_Set.empty [(*for preds in where_*)]\<close>
   256   Method_Ref: "diff/integration"
   257   CAS: "Integrate (f_f, v_v)"
   258   Given: "functionTerm f_f" "integrateBy v_v"
   259   Find: "antiDerivative F_F"
   260 
   261 problem pbl_fun_integ_nam : "named/integrate/function" =
   262   (*here "named" is used differently from Differentiation"*)
   263   \<open>Rule_Set.append_rules "empty" Rule_Set.empty [(*for preds in where_*)]\<close>
   264   Method_Ref: "diff/integration/named"
   265   CAS: "Integrate (f_f, v_v)"
   266   Given: "functionTerm f_f" "integrateBy v_v"
   267   Find: "antiDerivativeName F_F"
   268 
   269 (** methods **)
   270 
   271 partial_function (tailrec) integrate :: "real \<Rightarrow> real \<Rightarrow> real"
   272   where
   273 "integrate f_f v_v = (
   274   let
   275     t_t = Take (Integral f_f D v_v)
   276   in
   277     (Rewrite_Set_Inst [(''bdv'', v_v)] ''integration'') t_t)"
   278 
   279 method met_diffint : "diff/integration" =
   280   \<open>{rew_ord="tless_true", rls'=Atools_erls, calc = [], prog_rls = Rule_Set.empty, where_rls=Rule_Set.empty,
   281 	  errpats = [], rew_rls = Rule_Set.empty}\<close>
   282   Program: integrate.simps
   283   Given: "functionTerm f_f" "integrateBy v_v"
   284   Find: "antiDerivative F_F"
   285 
   286 partial_function (tailrec) intergrate_named :: "real \<Rightarrow> real \<Rightarrow> (real \<Rightarrow> real) \<Rightarrow> bool"
   287   where
   288 "intergrate_named f_f v_v F_F =(
   289   let
   290     t_t = Take (F_F v_v = Integral f_f D v_v)
   291   in (
   292     (Try (Rewrite_Set_Inst [(''bdv'', v_v)] ''simplify_Integral'')) #>
   293     (Rewrite_Set_Inst [(''bdv'', v_v)] ''integration'')
   294     ) t_t)"
   295 
   296 method met_diffint_named : "diff/integration/named" =
   297   \<open>{rew_ord="tless_true", rls'=Atools_erls, calc = [], prog_rls = Rule_Set.empty, where_rls=Rule_Set.empty,
   298     errpats = [], rew_rls = Rule_Set.empty}\<close>
   299   Program: intergrate_named.simps
   300   Given: "functionTerm f_f" "integrateBy v_v"
   301   Find: "antiDerivativeName F_F"
   302 
   303 ML \<open>
   304 \<close> ML \<open>
   305 \<close>
   306 
   307 end