src/Tools/isac/Knowledge/Integrate.thy
author Walther Neuper <neuper@ist.tugraz.at>
Thu, 23 Sep 2010 14:49:23 +0200
branchisac-update-Isa09-2
changeset 38014 3e11e3c2dc42
parent 37996 eb7d9cbaa3ef
child 40836 69364e021751
permissions -rw-r--r--
updated "op +", "op -", "op *". "HOL.divide" in src & test

find . -type f -exec sed -i s/"\"op +\""/"\"Groups.plus_class.plus\""/g {} \;
find . -type f -exec sed -i s/"\"op -\""/"\"Groups.minus_class.minus\""/g {} \;
find . -type f -exec sed -i s/"\"op *\""/"\"Groups.times_class.times\""/g {} \;
find . -type f -exec sed -i s/"\"HOL.divide\""/"\"Rings.inverse_class.divide\""/g {} \;
     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^^^3, x)"*)
    21   Integrate           :: "[real * real] => real"
    22 
    23   (*Script-names*)
    24   IntegrationScript      :: "[real,real,  real] => real"
    25                   ("((Script IntegrationScript (_ _ =))// (_))" 9)
    26   NamedIntegrationScript :: "[real,real, real=>real,  bool] => bool"
    27                   ("((Script NamedIntegrationScript (_ _ _=))// (_))" 9)
    28 
    29 axioms 
    30 (*stated as axioms, todo: prove as theorems
    31   'bdv' is a constant handled on the meta-level 
    32    specifically as a 'bound variable'            *)
    33 
    34   integral_const:    "Not (bdv occurs_in u) ==> Integral u D bdv = u * bdv"
    35   integral_var:      "Integral bdv D bdv = bdv ^^^ 2 / 2"
    36 
    37   integral_add:      "Integral (u + v) D bdv =  
    38 		     (Integral u D bdv) + (Integral v D bdv)"
    39   integral_mult:     "[| Not (bdv occurs_in u); bdv occurs_in v |] ==>  
    40 		     Integral (u * v) D bdv = u * (Integral v D bdv)"
    41 (*WN080222: this goes into sub-terms, too ...
    42   call_for_new_c:    "[| Not (matches (u + new_c v) a); Not (a is_f_x) |] ==>  
    43 		     a = a + new_c a"
    44 *)
    45   integral_pow:      "Integral bdv ^^^ n D bdv = bdv ^^^ (n+1) / (n + 1)"
    46 
    47 ML {*
    48 val thy = @{theory};
    49 
    50 (** eval functions **)
    51 
    52 val c = Free ("c", HOLogic.realT);
    53 (*.create a new unique variable 'c..' in a term; for use by Calc in a rls;
    54    an alternative to do this would be '(Try (Calculate new_c_) (new_c es__))'
    55    in the script; this will be possible if currying doesnt take the value
    56    from a variable, but the value '(new_c es__)' itself.*)
    57 fun new_c term = 
    58     let fun selc var = 
    59 	    case (explode o id_of) var of
    60 		"c"::[] => true
    61 	      |	"c"::"_"::is => (case (int_of_str o implode) is of
    62 				     SOME _ => true
    63 				   | NONE => false)
    64               | _ => false;
    65 	fun get_coeff c = case (explode o id_of) c of
    66 	      		      "c"::"_"::is => (the o int_of_str o implode) is
    67 			    | _ => 0;
    68         val cs = filter selc (vars term);
    69     in 
    70 	case cs of
    71 	    [] => c
    72 	  | [c] => Free ("c_2", HOLogic.realT)
    73 	  | cs => 
    74 	    let val max_coeff = maxl (map get_coeff cs)
    75 	    in Free ("c_"^string_of_int (max_coeff + 1), HOLogic.realT) end
    76     end;
    77 
    78 (*WN080222
    79 (*("new_c", ("Integrate.new'_c", eval_new_c "#new_c_"))*)
    80 fun eval_new_c _ _ (p as (Const ("Integrate.new'_c",_) $ t)) _ =
    81      SOME ((term2str p) ^ " = " ^ term2str (new_c p),
    82 	  Trueprop $ (mk_equality (p, new_c p)))
    83   | eval_new_c _ _ _ _ = NONE;
    84 *)
    85 
    86 (*WN080222:*)
    87 (*("add_new_c", ("Integrate.add'_new'_c", eval_add_new_c "#add_new_c_"))
    88   add a new c to a term or a fun-equation;
    89   this is _not in_ the term, because only applied to _whole_ term*)
    90 fun eval_add_new_c (_:string) "Integrate.add'_new'_c" p (_:theory) =
    91     let val p' = case p of
    92 		     Const ("op =", T) $ lh $ rh => 
    93 		     Const ("op =", T) $ lh $ mk_add rh (new_c rh)
    94 		   | p => mk_add p (new_c p)
    95     in SOME ((term2str p) ^ " = " ^ term2str p',
    96 	  Trueprop $ (mk_equality (p, p')))
    97     end
    98   | eval_add_new_c _ _ _ _ = NONE;
    99 
   100 
   101 (*("is_f_x", ("Integrate.is'_f'_x", eval_is_f_x "is_f_x_"))*)
   102 fun eval_is_f_x _ _(p as (Const ("Integrate.is'_f'_x", _)
   103 					   $ arg)) _ =
   104     if is_f_x arg
   105     then SOME ((term2str p) ^ " = True",
   106 	       Trueprop $ (mk_equality (p, HOLogic.true_const)))
   107     else SOME ((term2str p) ^ " = False",
   108 	       Trueprop $ (mk_equality (p, HOLogic.false_const)))
   109   | eval_is_f_x _ _ _ _ = NONE;
   110 
   111 calclist':= overwritel (!calclist', 
   112    [(*("new_c", ("Integrate.new'_c", eval_new_c "new_c_")),*)
   113     ("add_new_c", ("Integrate.add'_new'_c", eval_add_new_c "add_new_c_")),
   114     ("is_f_x", ("Integrate.is'_f'_x", eval_is_f_x "is_f_idextifier_"))
   115     ]);
   116 *}
   117 ML {*
   118 (** rulesets **)
   119 
   120 (*.rulesets for integration.*)
   121 val integration_rules = 
   122     Rls {id="integration_rules", preconds = [], 
   123 	 rew_ord = ("termlessI",termlessI), 
   124 	 erls = Rls {id="conditions_in_integration_rules", 
   125 		     preconds = [], 
   126 		     rew_ord = ("termlessI",termlessI), 
   127 		     erls = Erls, 
   128 		     srls = Erls, calc = [],
   129 		     rules = [(*for rewriting conditions in Thm's*)
   130 			      Calc ("Atools.occurs'_in", 
   131 				    eval_occurs_in "#occurs_in_"),
   132 			      Thm ("not_true",num_str @{thm not_true}),
   133 			      Thm ("not_false",@{thm not_false})
   134 			      ],
   135 		     scr = EmptyScr}, 
   136 	 srls = Erls, calc = [],
   137 	 rules = [
   138 		  Thm ("integral_const",num_str @{thm integral_const}),
   139 		  Thm ("integral_var",num_str @{thm integral_var}),
   140 		  Thm ("integral_add",num_str @{thm integral_add}),
   141 		  Thm ("integral_mult",num_str @{thm integral_mult}),
   142 		  Thm ("integral_pow",num_str @{thm integral_pow}),
   143 		  Calc ("Groups.plus_class.plus", eval_binop "#add_")(*for n+1*)
   144 		  ],
   145 	 scr = EmptyScr};
   146 *}
   147 ML {*
   148 val add_new_c = 
   149     Seq {id="add_new_c", preconds = [], 
   150 	 rew_ord = ("termlessI",termlessI), 
   151 	 erls = Rls {id="conditions_in_add_new_c", 
   152 		     preconds = [], 
   153 		     rew_ord = ("termlessI",termlessI), 
   154 		     erls = Erls, 
   155 		     srls = Erls, calc = [],
   156 		     rules = [Calc ("Tools.matches", eval_matches""),
   157 			      Calc ("Integrate.is'_f'_x", 
   158 				    eval_is_f_x "is_f_x_"),
   159 			      Thm ("not_true",num_str @{thm not_true}),
   160 			      Thm ("not_false",num_str @{thm not_false})
   161 			      ],
   162 		     scr = EmptyScr}, 
   163 	 srls = Erls, calc = [],
   164 	 rules = [ (*Thm ("call_for_new_c", num_str @{thm call_for_new_c}),*)
   165 		   Cal1 ("Integrate.add'_new'_c", eval_add_new_c "new_c_")
   166 		   ],
   167 	 scr = EmptyScr};
   168 *}
   169 ML {*
   170 
   171 (*.rulesets for simplifying Integrals.*)
   172 
   173 (*.for simplify_Integral adapted from 'norm_Rational_rls'.*)
   174 val norm_Rational_rls_noadd_fractions = 
   175 Rls {id = "norm_Rational_rls_noadd_fractions", preconds = [], 
   176      rew_ord = ("dummy_ord",dummy_ord), 
   177      erls = norm_rat_erls, srls = Erls, calc = [],
   178      rules = [(*Rls_ common_nominator_p_rls,!!!*)
   179 	      Rls_ (*rat_mult_div_pow original corrected WN051028*)
   180 		  (Rls {id = "rat_mult_div_pow", preconds = [], 
   181 		       rew_ord = ("dummy_ord",dummy_ord), 
   182 		       erls = (*FIXME.WN051028 e_rls,*)
   183 		       append_rls "e_rls-is_polyexp" e_rls
   184 				  [Calc ("Poly.is'_polyexp", 
   185 					 eval_is_polyexp "")],
   186 				  srls = Erls, calc = [],
   187 				  rules = [Thm ("rat_mult",num_str @{thm rat_mult}),
   188 	       (*"?a / ?b * (?c / ?d) = ?a * ?c / (?b * ?d)"*)
   189 	       Thm ("rat_mult_poly_l",num_str @{thm rat_mult_poly_l}),
   190 	       (*"?c is_polyexp ==> ?c * (?a / ?b) = ?c * ?a / ?b"*)
   191 	       Thm ("rat_mult_poly_r",num_str @{thm rat_mult_poly_r}),
   192 	       (*"?c is_polyexp ==> ?a / ?b * ?c = ?a * ?c / ?b"*)
   193 
   194 	       Thm ("real_divide_divide1_mg",
   195                      num_str @{thm real_divide_divide1_mg}),
   196 	       (*"y ~= 0 ==> (u / v) / (y / z) = (u * z) / (y * v)"*)
   197 	       Thm ("divide_divide_eq_right", 
   198                      num_str @{thm divide_divide_eq_right}),
   199 	       (*"?x / (?y / ?z) = ?x * ?z / ?y"*)
   200 	       Thm ("divide_divide_eq_left",
   201                      num_str @{thm divide_divide_eq_left}),
   202 	       (*"?x / ?y / ?z = ?x / (?y * ?z)"*)
   203 	       Calc ("Rings.inverse_class.divide"  ,eval_cancel "#divide_e"),
   204 	      
   205 	       Thm ("rat_power", num_str @{thm rat_power})
   206 		(*"(?a / ?b) ^^^ ?n = ?a ^^^ ?n / ?b ^^^ ?n"*)
   207 	       ],
   208       scr = Script ((term_of o the o (parse thy)) "empty_script")
   209       }),
   210 		Rls_ make_rat_poly_with_parentheses,
   211 		Rls_ cancel_p_rls,(*FIXME:cancel_p does NOT order sometimes*)
   212 		Rls_ rat_reduce_1
   213 		],
   214        scr = Script ((term_of o the o (parse thy)) "empty_script")
   215        }:rls;
   216 
   217 (*.for simplify_Integral adapted from 'norm_Rational'.*)
   218 val norm_Rational_noadd_fractions = 
   219    Seq {id = "norm_Rational_noadd_fractions", preconds = [], 
   220        rew_ord = ("dummy_ord",dummy_ord), 
   221        erls = norm_rat_erls, srls = Erls, calc = [],
   222        rules = [Rls_ discard_minus,
   223 		Rls_ rat_mult_poly,(* removes double fractions like a/b/c    *)
   224 		Rls_ make_rat_poly_with_parentheses, (*WN0510 also in(#)below*)
   225 		Rls_ cancel_p_rls, (*FIXME.MG:cancel_p does NOT order sometim*)
   226 		Rls_ norm_Rational_rls_noadd_fractions,(* the main rls (#)   *)
   227 		Rls_ discard_parentheses1 (* mult only                       *)
   228 		],
   229        scr = Script ((term_of o the o (parse thy)) "empty_script")
   230        }:rls;
   231 
   232 (*.simplify terms before and after Integration such that  
   233    ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
   234    common denominator as done by norm_Rational or make_ratpoly_in.
   235    This is a copy from 'make_ratpoly_in' with respective reduction of rules and
   236    *1* expand the term, ie. distribute * and / over +
   237 .*)
   238 val separate_bdv2 =
   239     append_rls "separate_bdv2"
   240 	       collect_bdv
   241 	       [Thm ("separate_bdv", num_str @{thm separate_bdv}),
   242 		(*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
   243 		Thm ("separate_bdv_n", num_str @{thm separate_bdv_n}),
   244 		Thm ("separate_1_bdv", num_str @{thm separate_1_bdv}),
   245 		(*"?bdv / ?b = (1 / ?b) * ?bdv"*)
   246 		Thm ("separate_1_bdv_n", num_str @{thm separate_1_bdv_n})(*,
   247 			  (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
   248 			  *****Thm ("add_divide_distrib", 
   249 			  *****num_str @{thm add_divide_distrib})
   250 			  (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)----------*)
   251 		];
   252 val simplify_Integral = 
   253   Seq {id = "simplify_Integral", preconds = []:term list, 
   254        rew_ord = ("dummy_ord", dummy_ord),
   255       erls = Atools_erls, srls = Erls,
   256       calc = [], (*asm_thm = [],*)
   257       rules = [Thm ("left_distrib",num_str @{thm left_distrib}),
   258  	       (*"(?z1.0 + ?z2.0) * ?w = ?z1.0 * ?w + ?z2.0 * ?w"*)
   259 	       Thm ("add_divide_distrib",num_str @{thm add_divide_distrib}),
   260  	       (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)
   261 	       (*^^^^^ *1* ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)
   262 	       Rls_ norm_Rational_noadd_fractions,
   263 	       Rls_ order_add_mult_in,
   264 	       Rls_ discard_parentheses,
   265 	       (*Rls_ collect_bdv, from make_polynomial_in*)
   266 	       Rls_ separate_bdv2,
   267 	       Calc ("Rings.inverse_class.divide"  ,eval_cancel "#divide_e")
   268 	       ],
   269       scr = EmptyScr}:rls;      
   270 
   271 
   272 (*simplify terms before and after Integration such that  
   273    ..a.x^2/2 + b.x^3/3.. is made to ..a/2.x^2 + b/3.x^3.. (and NO
   274    common denominator as done by norm_Rational or make_ratpoly_in.
   275    This is a copy from 'make_polynomial_in' with insertions from 
   276    'make_ratpoly_in' 
   277 THIS IS KEPT FOR COMPARISON ............................................   
   278 * val simplify_Integral = prep_rls(
   279 *   Seq {id = "", preconds = []:term list, 
   280 *        rew_ord = ("dummy_ord", dummy_ord),
   281 *       erls = Atools_erls, srls = Erls,
   282 *       calc = [], (*asm_thm = [],*)
   283 *       rules = [Rls_ expand_poly,
   284 * 	       Rls_ order_add_mult_in,
   285 * 	       Rls_ simplify_power,
   286 * 	       Rls_ collect_numerals,
   287 * 	       Rls_ reduce_012,
   288 * 	       Thm ("realpow_oneI",num_str @{thm realpow_oneI}),
   289 * 	       Rls_ discard_parentheses,
   290 * 	       Rls_ collect_bdv,
   291 * 	       (*below inserted from 'make_ratpoly_in'*)
   292 * 	       Rls_ (append_rls "separate_bdv"
   293 * 			 collect_bdv
   294 * 			 [Thm ("separate_bdv", num_str @{thm separate_bdv}),
   295 * 			  (*"?a * ?bdv / ?b = ?a / ?b * ?bdv"*)
   296 * 			  Thm ("separate_bdv_n", num_str @{thm separate_bdv_n}),
   297 * 			  Thm ("separate_1_bdv", num_str @{thm separate_1_bdv}),
   298 * 			  (*"?bdv / ?b = (1 / ?b) * ?bdv"*)
   299 * 			  Thm ("separate_1_bdv_n", num_str @{thm separate_1_bdv_n})(*,
   300 * 			  (*"?bdv ^^^ ?n / ?b = 1 / ?b * ?bdv ^^^ ?n"*)
   301 * 			  Thm ("add_divide_distrib", 
   302 * 				 num_str @{thm add_divide_distrib})
   303 * 			   (*"(?x + ?y) / ?z = ?x / ?z + ?y / ?z"*)*)
   304 * 			  ]),
   305 * 	       Calc ("Rings.inverse_class.divide"  ,eval_cancel "#divide_e")
   306 * 	       ],
   307 *       scr = EmptyScr
   308 *       }:rls); 
   309 .......................................................................*)
   310 
   311 val integration = 
   312     Seq {id="integration", preconds = [], 
   313 	 rew_ord = ("termlessI",termlessI), 
   314 	 erls = Rls {id="conditions_in_integration", 
   315 		     preconds = [], 
   316 		     rew_ord = ("termlessI",termlessI), 
   317 		     erls = Erls, 
   318 		     srls = Erls, calc = [],
   319 		     rules = [],
   320 		     scr = EmptyScr}, 
   321 	 srls = Erls, calc = [],
   322 	 rules = [ Rls_ integration_rules,
   323 		   Rls_ add_new_c,
   324 		   Rls_ simplify_Integral
   325 		   ],
   326 	 scr = EmptyScr};
   327 ruleset' := 
   328 overwritelthy @{theory} (!ruleset', 
   329 	    [("integration_rules", prep_rls integration_rules),
   330 	     ("add_new_c", prep_rls add_new_c),
   331 	     ("simplify_Integral", prep_rls simplify_Integral),
   332 	     ("integration", prep_rls integration),
   333 	     ("separate_bdv2", separate_bdv2),
   334 	     ("norm_Rational_noadd_fractions", norm_Rational_noadd_fractions),
   335 	     ("norm_Rational_rls_noadd_fractions", 
   336 	      norm_Rational_rls_noadd_fractions)
   337 	     ]);
   338 *}
   339 ML {*
   340 
   341 (** problems **)
   342 
   343 store_pbt
   344  (prep_pbt thy "pbl_fun_integ" [] e_pblID
   345  (["integrate","function"],
   346   [("#Given" ,["functionTerm f_f", "integrateBy v_v"]),
   347    ("#Find"  ,["antiDerivative F_F"])
   348   ],
   349   append_rls "e_rls" e_rls [(*for preds in where_*)], 
   350   SOME "Integrate (f_f, v_v)", 
   351   [["diff","integration"]]));
   352  
   353 (*here "named" is used differently from Differentiation"*)
   354 store_pbt
   355  (prep_pbt thy "pbl_fun_integ_nam" [] e_pblID
   356  (["named","integrate","function"],
   357   [("#Given" ,["functionTerm f_f", "integrateBy v_v"]),
   358    ("#Find"  ,["antiDerivativeName F_F"])
   359   ],
   360   append_rls "e_rls" e_rls [(*for preds in where_*)], 
   361   SOME "Integrate (f_f, v_v)", 
   362   [["diff","integration","named"]]));
   363  
   364 *}
   365 ML {*
   366 (** methods **)
   367 
   368 store_met
   369     (prep_met thy "met_diffint" [] e_metID
   370 	      (["diff","integration"],
   371 	       [("#Given" ,["functionTerm f_f", "integrateBy v_v"]),
   372 		("#Find"  ,["antiDerivative F_F"])
   373 		],
   374 	       {rew_ord'="tless_true", rls'=Atools_erls, calc = [], 
   375 		srls = e_rls, 
   376 		prls=e_rls,
   377 	     crls = Atools_erls, nrls = e_rls},
   378 "Script IntegrationScript (f_f::real) (v_v::real) =                " ^
   379 "  (let t_t = Take (Integral f_f D v_v)                             " ^
   380 "   in (Rewrite_Set_Inst [(bdv,v_v)] integration False) (t_t::real))"
   381 ));
   382   *}
   383 ML {*
   384 
   385 store_met
   386     (prep_met thy "met_diffint_named" [] e_metID
   387 	      (["diff","integration","named"],
   388 	       [("#Given" ,["functionTerm f_f", "integrateBy v_v"]),
   389 		("#Find"  ,["antiDerivativeName F_F"])
   390 		],
   391 	       {rew_ord'="tless_true", rls'=Atools_erls, calc = [], 
   392 		srls = e_rls, 
   393 		prls=e_rls,
   394 		crls = Atools_erls, nrls = e_rls},
   395 "Script NamedIntegrationScript (f_f::real) (v_v::real) (F_F::real=>real) = " ^
   396 "  (let t_t = Take (F_F v_v = Integral f_f D v_v)                            " ^
   397 "   in ((Try (Rewrite_Set_Inst [(bdv,v_v)] simplify_Integral False)) @@  " ^
   398 "       (Rewrite_Set_Inst [(bdv,v_v)] integration False)) t_t)            "
   399     ));
   400 *}
   401 
   402 end