src/Tools/isac/Knowledge/Integrate.thy
author wenzelm
Thu, 10 Jun 2021 12:48:50 +0200
changeset 60291 52921aa0e14a
parent 60290 bb4e8b01b072
child 60294 6623f5cdcb19
permissions -rw-r--r--
clarified theory context: avoid global "val thy = ..." hanging around (left-over from Isabelle2005), which is apt to various pitfalls;
     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 (*new_c	      :: "real => real"        ("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 script; this will be possible if currying doesnt take the value
    50    from a variable, but the value '(new_c es__)' itself.*)
    51 fun new_c term = 
    52     let fun selc var = 
    53 	    case (Symbol.explode o id_of) var of
    54 		"c"::[] => true
    55 	      |	"c"::"_"::is => (case (TermC.int_opt_of_string o implode) is of
    56 				     SOME _ => true
    57 				   | NONE => false)
    58               | _ => false;
    59 	fun get_coeff c = case (Symbol.explode o id_of) c of
    60 	      		      "c"::"_"::is => (the o TermC.int_opt_of_string o implode) is
    61 			    | _ => 0;
    62         val cs = filter selc (TermC.vars term);
    63     in 
    64 	case cs of
    65 	    [] => c
    66 	  | [_] => Free ("c_2", HOLogic.realT)
    67 	  | cs => 
    68 	    let val max_coeff = maxl (map get_coeff cs)
    69 	    in Free ("c_"^string_of_int (max_coeff + 1), HOLogic.realT) end
    70     end;
    71 
    72 (*WN080222
    73 (*("new_c", ("Integrate.new_c", eval_new_c "#new_c_"))*)
    74 fun eval_new_c _ _ (p as (Const ("Integrate.new_c",_) $ t)) _ =
    75      SOME ((UnparseC.term p) ^ " = " ^ UnparseC.term (new_c p),
    76 	  Trueprop $ (mk_equality (p, new_c p)))
    77   | eval_new_c _ _ _ _ = NONE;
    78 *)
    79 
    80 (*WN080222:*)
    81 (*("add_new_c", ("Integrate.add_new_c", eval_add_new_c "#add_new_c_"))
    82   add a new c to a term or a fun-equation;
    83   this is _not in_ the term, because only applied to _whole_ term*)
    84 fun eval_add_new_c (_:string) "Integrate.add_new_c" p (_:theory) =
    85     let val p' = case p of
    86 		     Const ("HOL.eq", T) $ lh $ rh => 
    87 		     Const ("HOL.eq", T) $ lh $ TermC.mk_add rh (new_c rh)
    88 		   | p => TermC.mk_add p (new_c p)
    89     in SOME ((UnparseC.term p) ^ " = " ^ UnparseC.term p',
    90 	  HOLogic.Trueprop $ (TermC.mk_equality (p, p')))
    91     end
    92   | eval_add_new_c _ _ _ _ = NONE;
    93 
    94 
    95 (*("is_f_x", ("Integrate.is_f_x", eval_is_f_x "is_f_x_"))*)
    96 fun eval_is_f_x _ _(p as (Const ("Integrate.is_f_x", _)
    97 					   $ arg)) _ =
    98     if TermC.is_f_x arg
    99     then SOME ((UnparseC.term p) ^ " = True",
   100 	       HOLogic.Trueprop $ (TermC.mk_equality (p, @{term True})))
   101     else SOME ((UnparseC.term p) ^ " = False",
   102 	       HOLogic.Trueprop $ (TermC.mk_equality (p, @{term False})))
   103   | eval_is_f_x _ _ _ _ = NONE;
   104 \<close>
   105 setup \<open>KEStore_Elems.add_calcs
   106   [("add_new_c", ("Integrate.add_new_c", eval_add_new_c "add_new_c_")),
   107     ("is_f_x", ("Integrate.is_f_x", eval_is_f_x "is_f_idextifier_"))]\<close>
   108 ML \<open>
   109 (** rulesets **)
   110 
   111 (*.rulesets for integration.*)
   112 val integration_rules = 
   113     Rule_Def.Repeat {id="integration_rules", preconds = [], 
   114 	 rew_ord = ("termlessI",termlessI), 
   115 	 erls = Rule_Def.Repeat {id="conditions_in_integration_rules", 
   116 		     preconds = [], 
   117 		     rew_ord = ("termlessI",termlessI), 
   118 		     erls = Rule_Set.Empty, 
   119 		     srls = Rule_Set.Empty, calc = [], errpatts = [],
   120 		     rules = [(*for rewriting conditions in Thm's*)
   121 			      Rule.Eval ("Prog_Expr.occurs_in", Prog_Expr.eval_occurs_in "#occurs_in_"),
   122 			      Rule.Thm ("not_true", ThmC.numerals_to_Free @{thm not_true}),
   123 			      Rule.Thm ("not_false",@{thm not_false})
   124 			      ],
   125 		     scr = Rule.Empty_Prog}, 
   126 	 srls = Rule_Set.Empty, calc = [], errpatts = [],
   127 	 rules = [
   128 		  Rule.Thm ("integral_const", ThmC.numerals_to_Free @{thm integral_const}),
   129 		  Rule.Thm ("integral_var", ThmC.numerals_to_Free @{thm integral_var}),
   130 		  Rule.Thm ("integral_add", ThmC.numerals_to_Free @{thm integral_add}),
   131 		  Rule.Thm ("integral_mult", ThmC.numerals_to_Free @{thm integral_mult}),
   132 		  Rule.Thm ("integral_pow", ThmC.numerals_to_Free @{thm integral_pow}),
   133 		  Rule.Eval ("Groups.plus_class.plus", (**)eval_binop "#add_")(*for n+1*)
   134 		  ],
   135 	 scr = Rule.Empty_Prog};
   136 \<close>
   137 ML \<open>
   138 val add_new_c = 
   139     Rule_Set.Sequence {id="add_new_c", preconds = [], 
   140 	 rew_ord = ("termlessI",termlessI), 
   141 	 erls = Rule_Def.Repeat {id="conditions_in_add_new_c", 
   142 		     preconds = [], 
   143 		     rew_ord = ("termlessI",termlessI), 
   144 		     erls = Rule_Set.Empty, 
   145 		     srls = Rule_Set.Empty, calc = [], errpatts = [],
   146 		     rules = [Rule.Eval ("Prog_Expr.matches", Prog_Expr.eval_matches""),
   147 			      Rule.Eval ("Integrate.is_f_x", 
   148 				    eval_is_f_x "is_f_x_"),
   149 			      Rule.Thm ("not_true", ThmC.numerals_to_Free @{thm not_true}),
   150 			      Rule.Thm ("not_false", ThmC.numerals_to_Free @{thm not_false})
   151 			      ],
   152 		     scr = Rule.Empty_Prog}, 
   153 	 srls = Rule_Set.Empty, calc = [], errpatts = [],
   154 	 rules = [ (*Rule.Thm ("call_for_new_c", ThmC.numerals_to_Free @{thm call_for_new_c}),*)
   155 		   Rule.Cal1 ("Integrate.add_new_c", eval_add_new_c "new_c_")
   156 		   ],
   157 	 scr = Rule.Empty_Prog};
   158 \<close>
   159 ML \<open>
   160 
   161 (*.rulesets for simplifying Integrals.*)
   162 
   163 (*.for simplify_Integral adapted from 'norm_Rational_rls'.*)
   164 val norm_Rational_rls_noadd_fractions = 
   165 Rule_Def.Repeat {id = "norm_Rational_rls_noadd_fractions", preconds = [], 
   166      rew_ord = ("dummy_ord",Rewrite_Ord.dummy_ord), 
   167      erls = norm_rat_erls, srls = Rule_Set.Empty, calc = [], errpatts = [],
   168      rules = [(*Rule.Rls_ add_fractions_p_rls,!!!*)
   169 	      Rule.Rls_ (*rat_mult_div_pow original corrected WN051028*)
   170 		  (Rule_Def.Repeat {id = "rat_mult_div_pow", preconds = [], 
   171 		       rew_ord = ("dummy_ord",Rewrite_Ord.dummy_ord), 
   172 		       erls = (*FIXME.WN051028 Rule_Set.empty,*)
   173 		       Rule_Set.append_rules "Rule_Set.empty-is_polyexp" Rule_Set.empty
   174 				  [Rule.Eval ("Poly.is_polyexp", 
   175 					 eval_is_polyexp "")],
   176 				  srls = Rule_Set.Empty, calc = [], errpatts = [],
   177 				  rules = [Rule.Thm ("rat_mult", ThmC.numerals_to_Free @{thm rat_mult}),
   178 	       (*"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
   179 	       Rule.Thm ("rat_mult_poly_l", ThmC.numerals_to_Free @{thm rat_mult_poly_l}),
   180 	       (*"?c is_polyexp ==> ?c * (?a / ?b) = ?c * ?a / ?b"*)
   181 	       Rule.Thm ("rat_mult_poly_r", ThmC.numerals_to_Free @{thm rat_mult_poly_r}),
   182 	       (*"?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"*)
   183 
   184 	       Rule.Thm ("real_divide_divide1_mg",
   185                      ThmC.numerals_to_Free @{thm real_divide_divide1_mg}),
   186 	       (*"y ~= 0 ==> (u / v) / (y / z) = (u * z) / (y * v)"*)
   187 	       Rule.Thm ("divide_divide_eq_right", 
   188                      ThmC.numerals_to_Free @{thm divide_divide_eq_right}),
   189 	       (*"?x / (?y / ?z) = ?x * ?z / ?y"*)
   190 	       Rule.Thm ("divide_divide_eq_left",
   191                      ThmC.numerals_to_Free @{thm divide_divide_eq_left}),
   192 	       (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
   193 	       Rule.Eval ("Rings.divide_class.divide", Prog_Expr.eval_cancel "#divide_e"),
   194 	      
   195 	       Rule.Thm ("rat_power", ThmC.numerals_to_Free @{thm rat_power})
   196 		(*"(?a / ?b)  \<up>  ?n = ?a  \<up>  ?n / ?b  \<up>  ?n"*)
   197 	       ],
   198       scr = Rule.Empty_Prog
   199       }),
   200 		Rule.Rls_ make_rat_poly_with_parentheses,
   201 		Rule.Rls_ cancel_p_rls,(*FIXME:cancel_p does NOT order sometimes*)
   202 		Rule.Rls_ rat_reduce_1
   203 		],
   204        scr = Rule.Empty_Prog
   205        };
   206 
   207 (*.for simplify_Integral adapted from 'norm_Rational'.*)
   208 val norm_Rational_noadd_fractions = 
   209    Rule_Set.Sequence {id = "norm_Rational_noadd_fractions", preconds = [], 
   210        rew_ord = ("dummy_ord",Rewrite_Ord.dummy_ord), 
   211        erls = norm_rat_erls, srls = Rule_Set.Empty, calc = [], errpatts = [],
   212        rules = [Rule.Rls_ discard_minus,
   213 		Rule.Rls_ rat_mult_poly,(* removes double fractions like a/b/c    *)
   214 		Rule.Rls_ make_rat_poly_with_parentheses, (*WN0510 also in(#)below*)
   215 		Rule.Rls_ cancel_p_rls, (*FIXME.MG:cancel_p does NOT order sometim*)
   216 		Rule.Rls_ norm_Rational_rls_noadd_fractions,(* the main rls (#)   *)
   217 		Rule.Rls_ discard_parentheses1 (* mult only                       *)
   218 		],
   219        scr = Rule.Empty_Prog
   220        };
   221 
   222 (*.simplify terms before and after Integration such that  
   223    ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
   224    common denominator as done by norm_Rational or make_ratpoly_in.
   225    This is a copy from 'make_ratpoly_in' with respective reduction of rules and
   226    *1* expand the term, ie. distribute * and / over +
   227 .*)
   228 val separate_bdv2 =
   229     Rule_Set.append_rules "separate_bdv2"
   230 	       collect_bdv
   231 	       [Rule.Thm ("separate_bdv", ThmC.numerals_to_Free @{thm separate_bdv}),
   232 		(*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
   233 		Rule.Thm ("separate_bdv_n", ThmC.numerals_to_Free @{thm separate_bdv_n}),
   234 		Rule.Thm ("separate_1_bdv",  ThmC.numerals_to_Free @{thm separate_1_bdv}),
   235 		(*"?bdv / ?b = (1 / ?b) * ?bdv"*)
   236 		Rule.Thm ("separate_1_bdv_n",  ThmC.numerals_to_Free @{thm separate_1_bdv_n})(*,
   237 			  (*"?bdv  \<up>  ?n / ?b = 1 / ?b * ?bdv  \<up>  ?n"*)
   238 			  *****Rule.Thm ("add_divide_distrib", 
   239 			  ***** ThmC.numerals_to_Free @{thm add_divide_distrib})
   240 			  (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)----------*)
   241 		];
   242 val simplify_Integral = 
   243   Rule_Set.Sequence {id = "simplify_Integral", preconds = []:term list, 
   244        rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord),
   245       erls = Atools_erls, srls = Rule_Set.Empty,
   246       calc = [],  errpatts = [],
   247       rules = [Rule.Thm ("distrib_right", ThmC.numerals_to_Free @{thm distrib_right}),
   248  	       (*"(?z1.0 + ?z2.0) * ?w = ?z1.0 * ?w + ?z2.0 * ?w"*)
   249 	       Rule.Thm ("add_divide_distrib", ThmC.numerals_to_Free @{thm add_divide_distrib}),
   250  	       (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)
   251 	       (*^^^^^ *1* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
   252 	       Rule.Rls_ norm_Rational_noadd_fractions,
   253 	       Rule.Rls_ order_add_mult_in,
   254 	       Rule.Rls_ discard_parentheses,
   255 	       (*Rule.Rls_ collect_bdv, from make_polynomial_in*)
   256 	       Rule.Rls_ separate_bdv2,
   257 	       Rule.Eval ("Rings.divide_class.divide", Prog_Expr.eval_cancel "#divide_e")
   258 	       ],
   259       scr = Rule.Empty_Prog};      
   260 
   261 
   262 (*simplify terms before and after Integration such that  
   263    ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
   264    common denominator as done by norm_Rational or make_ratpoly_in.
   265    This is a copy from 'make_polynomial_in' with insertions from 
   266    'make_ratpoly_in' 
   267 THIS IS KEPT FOR COMPARISON ............................................   
   268 * val simplify_Integral = prep_rls'(
   269 *   Rule_Set.Sequence {id = "", preconds = []:term list, 
   270 *        rew_ord = ("dummy_ord", Rewrite_Ord.dummy_ord),
   271 *       erls = Atools_erls, srls = Rule_Set.Empty,
   272 *       calc = [], (*asm_thm = [],*)
   273 *       rules = [Rule.Rls_ expand_poly,
   274 * 	       Rule.Rls_ order_add_mult_in,
   275 * 	       Rule.Rls_ simplify_power,
   276 * 	       Rule.Rls_ collect_numerals,
   277 * 	       Rule.Rls_ reduce_012,
   278 * 	       Rule.Thm ("realpow_oneI", ThmC.numerals_to_Free @{thm realpow_oneI}),
   279 * 	       Rule.Rls_ discard_parentheses,
   280 * 	       Rule.Rls_ collect_bdv,
   281 * 	       (*below inserted from 'make_ratpoly_in'*)
   282 * 	       Rule.Rls_ (Rule_Set.append_rules "separate_bdv"
   283 * 			 collect_bdv
   284 * 			 [Rule.Thm ("separate_bdv", ThmC.numerals_to_Free @{thm separate_bdv}),
   285 * 			  (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
   286 * 			  Rule.Thm ("separate_bdv_n", ThmC.numerals_to_Free @{thm separate_bdv_n}),
   287 * 			  Rule.Thm ("separate_1_bdv", ThmC.numerals_to_Free @{thm separate_1_bdv}),
   288 * 			  (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
   289 * 			  Rule.Thm ("separate_1_bdv_n", ThmC.numerals_to_Free @{thm separate_1_bdv_n})(*,
   290 * 			  (*"?bdv  \<up>  ?n / ?b = 1 / ?b * ?bdv  \<up>  ?n"*)
   291 * 			  Rule.Thm ("add_divide_distrib", 
   292 * 				  ThmC.numerals_to_Free @{thm add_divide_distrib})
   293 * 			   (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)*)
   294 * 			  ]),
   295 * 	       Rule.Eval ("Rings.divide_class.divide"  , eval_cancel "#divide_e")
   296 * 	       ],
   297 *       scr = Rule.Empty_Prog
   298 *       }); 
   299 .......................................................................*)
   300 
   301 val integration = 
   302     Rule_Set.Sequence {id="integration", preconds = [], 
   303 	 rew_ord = ("termlessI",termlessI), 
   304 	 erls = Rule_Def.Repeat {id="conditions_in_integration", 
   305 		     preconds = [], 
   306 		     rew_ord = ("termlessI",termlessI), 
   307 		     erls = Rule_Set.Empty, 
   308 		     srls = Rule_Set.Empty, calc = [], errpatts = [],
   309 		     rules = [],
   310 		     scr = Rule.Empty_Prog}, 
   311 	 srls = Rule_Set.Empty, calc = [], errpatts = [],
   312 	 rules = [ Rule.Rls_ integration_rules,
   313 		   Rule.Rls_ add_new_c,
   314 		   Rule.Rls_ simplify_Integral
   315 		   ],
   316 	 scr = Rule.Empty_Prog};
   317 
   318 val prep_rls' = Auto_Prog.prep_rls @{theory};
   319 \<close>
   320 rule_set_knowledge
   321   integration_rules = \<open>prep_rls' integration_rules\<close> and
   322   add_new_c = \<open>prep_rls' add_new_c\<close> and
   323   simplify_Integral = \<open>prep_rls' simplify_Integral\<close> and
   324   integration = \<open>prep_rls' integration\<close> and
   325   separate_bdv2 = \<open>prep_rls' separate_bdv2\<close> and
   326   norm_Rational_noadd_fractions = \<open>prep_rls' norm_Rational_noadd_fractions\<close> and
   327   norm_Rational_rls_noadd_fractions = \<open>prep_rls' norm_Rational_rls_noadd_fractions\<close>
   328 
   329 (** problems **)
   330 setup \<open>KEStore_Elems.add_pbts
   331   [(Problem.prep_input @{theory} "pbl_fun_integ" [] Problem.id_empty
   332       (["integrate", "function"],
   333         [("#Given" ,["functionTerm f_f", "integrateBy v_v"]),
   334           ("#Find"  ,["antiDerivative F_F"])],
   335         Rule_Set.append_rules "empty" Rule_Set.empty [(*for preds in where_*)], 
   336         SOME "Integrate (f_f, v_v)", 
   337         [["diff", "integration"]])),
   338     (*here "named" is used differently from Differentiation"*)
   339     (Problem.prep_input @{theory} "pbl_fun_integ_nam" [] Problem.id_empty
   340       (["named", "integrate", "function"],
   341         [("#Given" ,["functionTerm f_f", "integrateBy v_v"]),
   342           ("#Find"  ,["antiDerivativeName F_F"])],
   343         Rule_Set.append_rules "empty" Rule_Set.empty [(*for preds in where_*)], 
   344         SOME "Integrate (f_f, v_v)", 
   345         [["diff", "integration", "named"]]))]\<close>
   346 
   347 (** methods **)
   348 
   349 partial_function (tailrec) integrate :: "real \<Rightarrow> real \<Rightarrow> real"
   350   where
   351 "integrate f_f v_v = (
   352   let
   353     t_t = Take (Integral f_f D v_v)
   354   in
   355     (Rewrite_Set_Inst [(''bdv'', v_v)] ''integration'') t_t)"
   356 setup \<open>KEStore_Elems.add_mets
   357     [MethodC.prep_input @{theory} "met_diffint" [] MethodC.id_empty
   358 	    (["diff", "integration"],
   359 	      [("#Given" ,["functionTerm f_f", "integrateBy v_v"]), ("#Find"  ,["antiDerivative F_F"])],
   360 	      {rew_ord'="tless_true", rls'=Atools_erls, calc = [], srls = Rule_Set.empty, prls=Rule_Set.empty,
   361 	        crls = Atools_erls, errpats = [], nrls = Rule_Set.empty},
   362 	      @{thm integrate.simps})]
   363 \<close>
   364 
   365 partial_function (tailrec) intergrate_named :: "real \<Rightarrow> real \<Rightarrow> (real \<Rightarrow> real) \<Rightarrow> bool"
   366   where
   367 "intergrate_named f_f v_v F_F =(
   368   let
   369     t_t = Take (F_F v_v = Integral f_f D v_v)
   370   in (
   371     (Try (Rewrite_Set_Inst [(''bdv'', v_v)] ''simplify_Integral'')) #>
   372     (Rewrite_Set_Inst [(''bdv'', v_v)] ''integration'')
   373     ) t_t)"
   374 setup \<open>KEStore_Elems.add_mets
   375     [MethodC.prep_input @{theory} "met_diffint_named" [] MethodC.id_empty
   376 	    (["diff", "integration", "named"],
   377 	      [("#Given" ,["functionTerm f_f", "integrateBy v_v"]),
   378 	        ("#Find"  ,["antiDerivativeName F_F"])],
   379 	      {rew_ord'="tless_true", rls'=Atools_erls, calc = [], srls = Rule_Set.empty, prls=Rule_Set.empty,
   380           crls = Atools_erls, errpats = [], nrls = Rule_Set.empty},
   381         @{thm intergrate_named.simps})]
   382 \<close> ML \<open>
   383 \<close> ML \<open>
   384 \<close>
   385 
   386 end