src/Tools/isac/Knowledge/Diff.thy
author Mathias Lehnfeld <s1210629013@students.fh-hagenberg.at>
Mon, 27 Jan 2014 21:49:27 +0100
changeset 55359 73dc85c025ab
parent 55339 cccd24e959ba
child 55363 d78bc1342183
permissions -rw-r--r--
cleanup, naming: 'KEStore_Elems' in Tests now 'Test_KEStore_Elems', 'store_pbts' now 'add_pbts'
     1 (* differentiation over the reals
     2    author: Walther Neuper
     3    000516   
     4  *)
     5 
     6 theory Diff imports Calculus Trig LogExp Rational Root Poly Atools begin
     7 
     8 ML {*
     9 @{term "sin x"}
    10 *}
    11 
    12 consts
    13 
    14   d_d           :: "[real, real]=> real"
    15 (*sin, cos      :: "real => real"      already in Isabelle2009-2*)
    16 (*
    17   log, ln       :: "real => real"
    18   nlog          :: "[real, real] => real"
    19   exp           :: "real => real"         ("E'_ ^^^ _" 80)
    20 *)
    21   (*descriptions in the related problems*)
    22   derivativeEq  :: "bool => una"
    23 
    24   (*predicates*)
    25   primed        :: "'a => 'a" (*"primed A" -> "A'"*)
    26 
    27   (*the CAS-commands, eg. "Diff (2*x^^^3, x)", 
    28 			  "Differentiate (A = s * (a - s), s)"*)
    29   Diff           :: "[real * real] => real"
    30   Differentiate  :: "[bool * real] => bool"
    31 
    32   (*subproblem and script-name*)
    33   differentiate  :: "[ID * (ID list) * ID, real,real] => real"
    34                	   ("(differentiate (_)/ (_ _ ))" 9)
    35   DiffScr        :: "[real,real,  real] => real"
    36                    ("((Script DiffScr (_ _ =))// (_))" 9)
    37   DiffEqScr      :: "[bool,real,  bool] => bool"
    38                    ("((Script DiffEqScr (_ _ =))// (_))" 9)
    39 
    40 text {*a variant of the derivatives defintion:
    41 
    42   d_d            :: "(real => real) => (real => real)"
    43 
    44   advantages:
    45 (1) no variable 'bdv' on the meta-level required
    46 (2) chain_rule "d_d (%x. (u (v x))) = (%x. (d_d u)) (v x) * d_d v"
    47 (3) and no specialized chain-rules required like
    48     diff_sin_chain "d_d bdv (sin u)    = cos u * d_d bdv u"
    49 
    50   disadvantage: d_d (%x. 1 + x^2) = ... differs from high-school notation
    51 *}
    52 
    53 axiomatization where (*stated as axioms, todo: prove as theorems
    54         'bdv' is a constant on the meta-level  *)
    55   diff_const:     "[| Not (bdv occurs_in a) |] ==> d_d bdv a = 0" and
    56   diff_var:       "d_d bdv bdv = 1" and
    57   diff_prod_const:"[| Not (bdv occurs_in u) |] ==>  
    58 					 d_d bdv (u * v) = u * d_d bdv v" and
    59 
    60   diff_sum:       "d_d bdv (u + v)     = d_d bdv u + d_d bdv v" and
    61   diff_dif:       "d_d bdv (u - v)     = d_d bdv u - d_d bdv v" and
    62   diff_prod:      "d_d bdv (u * v)     = d_d bdv u * v + u * d_d bdv v" and
    63   diff_quot:      "Not (v = 0) ==> (d_d bdv (u / v) =  
    64 	           (d_d bdv u * v - u * d_d bdv v) / v ^^^ 2)" and
    65 
    66   diff_sin:       "d_d bdv (sin bdv)   = cos bdv" and
    67   diff_sin_chain: "d_d bdv (sin u)     = cos u * d_d bdv u" and
    68   diff_cos:       "d_d bdv (cos bdv)   = - sin bdv" and
    69   diff_cos_chain: "d_d bdv (cos u)     = - sin u * d_d bdv u" and
    70   diff_pow:       "d_d bdv (bdv ^^^ n) = n * (bdv ^^^ (n - 1))" and
    71   diff_pow_chain: "d_d bdv (u ^^^ n)   = n * (u ^^^ (n - 1)) * d_d bdv u" and
    72   diff_ln:        "d_d bdv (ln bdv)    = 1 / bdv" and
    73   diff_ln_chain:  "d_d bdv (ln u)      = d_d bdv u / u" and
    74   diff_exp:       "d_d bdv (exp bdv)   = exp bdv" and
    75   diff_exp_chain: "d_d bdv (exp u)     = exp u * d_d x u" and
    76 (*
    77   diff_sqrt      "d_d bdv (sqrt bdv)  = 1 / (2 * sqrt bdv)"
    78   diff_sqrt_chain"d_d bdv (sqrt u)    = d_d bdv u / (2 * sqrt u)"
    79 *)
    80   (*...*)
    81 
    82   frac_conv:       "[| bdv occurs_in b; 0 < n |] ==>  
    83 		    a / (b ^^^ n) = a * b ^^^ (-n)" and
    84   frac_sym_conv:   "n < 0 ==> a * b ^^^ n = a / b ^^^ (-n)" and
    85 
    86   sqrt_conv_bdv:   "sqrt bdv = bdv ^^^ (1 / 2)" and
    87   sqrt_conv_bdv_n: "sqrt (bdv ^^^ n) = bdv ^^^ (n / 2)" and
    88   sqrt_conv:       "bdv occurs_in u ==> sqrt u = u ^^^ (1 / 2)" and
    89   sqrt_sym_conv:   "u ^^^ (a / 2) = sqrt (u ^^^ a)" and
    90 
    91   root_conv:       "bdv occurs_in u ==> nroot n u = u ^^^ (1 / n)" and
    92   root_sym_conv:   "u ^^^ (a / b) = nroot b (u ^^^ a)" and
    93 
    94   realpow_pow_bdv: "(bdv ^^^ b) ^^^ c = bdv ^^^ (b * c)"
    95 
    96 ML {*
    97 val thy = @{theory};
    98 
    99 (** eval functions **)
   100 
   101 fun primed (Const (id, T)) = Const (id ^ "'", T)
   102   | primed (Free (id, T)) = Free (id ^ "'", T)
   103   | primed t = error ("primed called with arg = '"^ term2str t ^"'");
   104 
   105 (*("primed", ("Diff.primed", eval_primed "#primed"))*)
   106 fun eval_primed _ _ (p as (Const ("Diff.primed",_) $ t)) _ =
   107     SOME ((term2str p) ^ " = " ^ term2str (primed t),
   108 	  Trueprop $ (mk_equality (p, primed t)))
   109   | eval_primed _ _ _ _ = NONE;
   110 *}
   111 setup {* KEStore_Elems.add_calcs
   112   [("primed", ("Diff.primed", eval_primed "#primed"))] *}
   113 ML {*
   114 (** rulesets **)
   115 
   116 (*.converts a term such that differentiation works optimally.*)
   117 val diff_conv =   
   118     Rls {id="diff_conv", 
   119 	 preconds = [], 
   120 	 rew_ord = ("termlessI",termlessI), 
   121 	 erls = append_rls "erls_diff_conv" e_rls 
   122 			   [Calc ("Atools.occurs'_in", eval_occurs_in ""),
   123 			    Thm ("not_true",num_str @{thm not_true}),
   124 			    Thm ("not_false",num_str @{thm not_false}),
   125 			    Calc ("Orderings.ord_class.less",eval_equ "#less_"),
   126 			    Thm ("and_true",num_str @{thm and_true}),
   127 			    Thm ("and_false",num_str @{thm and_false})
   128 			    ], 
   129 	 srls = Erls, calc = [], errpatts = [],
   130 	 rules =
   131   [Thm ("frac_conv", num_str @{thm frac_conv}),
   132      (*"?bdv occurs_in ?b \<Longrightarrow> 0 < ?n \<Longrightarrow> ?a / ?b ^^^ ?n = ?a * ?b ^^^ - ?n"*)
   133 		   Thm ("sqrt_conv_bdv", num_str @{thm sqrt_conv_bdv}),
   134 		     (*"sqrt ?bdv = ?bdv ^^^ (1 / 2)"*)
   135 		   Thm ("sqrt_conv_bdv_n", num_str @{thm sqrt_conv_bdv_n}),
   136 		     (*"sqrt (?bdv ^^^ ?n) = ?bdv ^^^ (?n / 2)"*)
   137 		   Thm ("sqrt_conv", num_str @{thm sqrt_conv}),
   138 		     (*"?bdv occurs_in ?u \<Longrightarrow> sqrt ?u = ?u ^^^ (1 / 2)"*)
   139 		   Thm ("root_conv", num_str @{thm root_conv}),
   140 		     (*"?bdv occurs_in ?u \<Longrightarrow> nroot ?n ?u = ?u ^^^ (1 / ?n)"*)
   141 		   Thm ("realpow_pow_bdv", num_str @{thm realpow_pow_bdv}),
   142 		     (* "(?bdv ^^^ ?b) ^^^ ?c = ?bdv ^^^ (?b * ?c)"*)
   143 		   Calc ("Groups.times_class.times", eval_binop "#mult_"),
   144 		   Thm ("rat_mult",num_str @{thm rat_mult}),
   145 		     (*a / b * (c / d) = a * c / (b * d)*)
   146 		   Thm ("times_divide_eq_right",num_str @{thm times_divide_eq_right}),
   147 		     (*?x * (?y / ?z) = ?x * ?y / ?z*)
   148 		   Thm ("times_divide_eq_left",num_str @{thm times_divide_eq_left})
   149 		     (*?y / ?z * ?x = ?y * ?x / ?z*)
   150 		 ],
   151 	 scr = EmptyScr};
   152 *}
   153 ML {*
   154 (*.beautifies a term after differentiation.*)
   155 val diff_sym_conv =   
   156     Rls {id="diff_sym_conv", 
   157 	 preconds = [], 
   158 	 rew_ord = ("termlessI",termlessI), 
   159 	 erls = append_rls "erls_diff_sym_conv" e_rls 
   160 			   [Calc ("Orderings.ord_class.less",eval_equ "#less_")
   161 			    ], 
   162 	 srls = Erls, calc = [], errpatts = [],
   163 	 rules = [Thm ("frac_sym_conv", num_str @{thm frac_sym_conv}),
   164 		  Thm ("sqrt_sym_conv", num_str @{thm sqrt_sym_conv}),
   165 		  Thm ("root_sym_conv", num_str @{thm root_sym_conv}),
   166 		  Thm ("sym_real_mult_minus1",
   167 		       num_str (@{thm real_mult_minus1} RS @{thm sym})),
   168 		      (*- ?z = "-1 * ?z"*)
   169 		  Thm ("rat_mult",num_str @{thm rat_mult}),
   170 		  (*a / b * (c / d) = a * c / (b * d)*)
   171 		  Thm ("times_divide_eq_right",num_str @{thm times_divide_eq_right}),
   172 		  (*?x * (?y / ?z) = ?x * ?y / ?z*)
   173 		  Thm ("times_divide_eq_left",num_str @{thm times_divide_eq_left}),
   174 		  (*?y / ?z * ?x = ?y * ?x / ?z*)
   175 		  Calc ("Groups.times_class.times", eval_binop "#mult_")
   176 		 ],
   177 	 scr = EmptyScr};
   178 
   179 (*..*)
   180 val srls_diff = 
   181     Rls {id="srls_differentiate..", 
   182 	 preconds = [], 
   183 	 rew_ord = ("termlessI",termlessI), 
   184 	 erls = e_rls, 
   185 	 srls = Erls, calc = [], errpatts = [],
   186 	 rules = [Calc("Tools.lhs", eval_lhs "eval_lhs_"),
   187 		  Calc("Tools.rhs", eval_rhs "eval_rhs_"),
   188 		  Calc("Diff.primed", eval_primed "Diff.primed")
   189 		  ],
   190 	 scr = EmptyScr};
   191 *}
   192 ML {*
   193 (*..*)
   194 val erls_diff = 
   195     append_rls "erls_differentiate.." e_rls
   196                [Thm ("not_true",num_str @{thm not_true}),
   197 		Thm ("not_false",num_str @{thm not_false}),
   198 		
   199 		Calc ("Atools.ident",eval_ident "#ident_"),    
   200 		Calc ("Atools.is'_atom",eval_is_atom "#is_atom_"),
   201 		Calc ("Atools.occurs'_in",eval_occurs_in ""),
   202 		Calc ("Atools.is'_const",eval_const "#is_const_")
   203 		];
   204 
   205 (*.rules for differentiation, _no_ simplification.*)
   206 val diff_rules =
   207     Rls {id="diff_rules", preconds = [], rew_ord = ("termlessI",termlessI), 
   208 	 erls = erls_diff, srls = Erls, calc = [], errpatts = [],
   209 	 rules = [Thm ("diff_sum",num_str @{thm diff_sum}),
   210 		  Thm ("diff_dif",num_str @{thm diff_dif}),
   211 		  Thm ("diff_prod_const",num_str @{thm diff_prod_const}),
   212 		  Thm ("diff_prod",num_str @{thm diff_prod}),
   213 		  Thm ("diff_quot",num_str @{thm diff_quot}),
   214 		  Thm ("diff_sin",num_str @{thm diff_sin}),
   215 		  Thm ("diff_sin_chain",num_str @{thm diff_sin_chain}),
   216 		  Thm ("diff_cos",num_str @{thm diff_cos}),
   217 		  Thm ("diff_cos_chain",num_str @{thm diff_cos_chain}),
   218 		  Thm ("diff_pow",num_str @{thm diff_pow}),
   219 		  Thm ("diff_pow_chain",num_str @{thm diff_pow_chain}),
   220 		  Thm ("diff_ln",num_str @{thm diff_ln}),
   221 		  Thm ("diff_ln_chain",num_str @{thm diff_ln_chain}),
   222 		  Thm ("diff_exp",num_str @{thm diff_exp}),
   223 		  Thm ("diff_exp_chain",num_str @{thm diff_exp_chain}),
   224 (*
   225 		  Thm ("diff_sqrt",num_str @{thm diff_sqrt}),
   226 		  Thm ("diff_sqrt_chain",num_str @{thm diff_sqrt_chain}),
   227 *)
   228 		  Thm ("diff_const",num_str @{thm diff_const}),
   229 		  Thm ("diff_var",num_str @{thm diff_var})
   230 		  ],
   231 	 scr = EmptyScr};
   232 *}
   233 ML {*
   234 (*.normalisation for checking user-input.*)
   235 val norm_diff = 
   236   Rls
   237     {id="norm_diff", preconds = [], rew_ord = ("termlessI",termlessI), 
   238      erls = Erls, srls = Erls, calc = [], errpatts = [],
   239      rules = [Rls_ diff_rules, Rls_ norm_Poly ],
   240      scr = EmptyScr};
   241 *}
   242 setup {* KEStore_Elems.add_rlss 
   243   [("erls_diff", (Context.theory_name @{theory}, prep_rls erls_diff)), 
   244   ("diff_rules", (Context.theory_name @{theory}, prep_rls diff_rules)), 
   245   ("norm_diff", (Context.theory_name @{theory}, prep_rls norm_diff)), 
   246   ("diff_conv", (Context.theory_name @{theory}, prep_rls diff_conv)), 
   247   ("diff_sym_conv", (Context.theory_name @{theory}, prep_rls diff_sym_conv))] *}
   248 ML {*
   249 (** problem types **)
   250 
   251 store_pbt
   252  (prep_pbt thy "pbl_fun" [] e_pblID
   253  (["function"], [], e_rls, NONE, []));
   254 
   255 store_pbt
   256  (prep_pbt thy "pbl_fun_deriv" [] e_pblID
   257  (["derivative_of","function"],
   258   [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
   259    ("#Find"  ,["derivative f_f'"])
   260   ],
   261   append_rls "e_rls" e_rls [],
   262   SOME "Diff (f_f, v_v)", [["diff","differentiate_on_R"],
   263 			 ["diff","after_simplification"]]));
   264 
   265 (*here "named" is used differently from Integration"*)
   266 store_pbt
   267  (prep_pbt thy "pbl_fun_deriv_nam" [] e_pblID
   268  (["named","derivative_of","function"],
   269   [("#Given" ,["functionEq f_f","differentiateFor v_v"]),
   270    ("#Find"  ,["derivativeEq f_f'"])
   271   ],
   272   append_rls "e_rls" e_rls [],
   273   SOME "Differentiate (f_f, v_v)", [["diff","differentiate_equality"]]));
   274 *}
   275 setup {* KEStore_Elems.add_pbts
   276   [(prep_pbt thy "pbl_fun" [] e_pblID (["function"], [], e_rls, NONE, [])),
   277     (prep_pbt thy "pbl_fun_deriv" [] e_pblID
   278       (["derivative_of","function"],
   279         [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
   280           ("#Find"  ,["derivative f_f'"])],
   281         append_rls "e_rls" e_rls [],
   282         SOME "Diff (f_f, v_v)", [["diff","differentiate_on_R"],
   283 			  ["diff","after_simplification"]])),
   284     (*here "named" is used differently from Integration"*)
   285     (prep_pbt thy "pbl_fun_deriv_nam" [] e_pblID
   286       (["named","derivative_of","function"],
   287         [("#Given" ,["functionEq f_f","differentiateFor v_v"]),
   288           ("#Find"  ,["derivativeEq f_f'"])],
   289         append_rls "e_rls" e_rls [],
   290         SOME "Differentiate (f_f, v_v)",
   291         [["diff","differentiate_equality"]]))] *}
   292 ML {*
   293 
   294 (** methods **)
   295 
   296 store_met
   297  (prep_met thy "met_diff" [] e_metID
   298  (["diff"], [],
   299    {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
   300     crls = Atools_erls, errpats = [], nrls = norm_diff}, "empty_script"));
   301 
   302 store_met
   303  (prep_met thy "met_diff_onR" [] e_metID
   304  (["diff","differentiate_on_R"],
   305    [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
   306     ("#Find"  ,["derivative f_f'"])
   307     ],
   308    {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = e_rls, 
   309     prls=e_rls, crls = Atools_erls, errpats = [], nrls = norm_diff},
   310 "Script DiffScr (f_f::real) (v_v::real) =                          " ^
   311 " (let f_f' = Take (d_d v_v f_f)                                    " ^
   312 " in (((Try (Rewrite_Set_Inst [(bdv,v_v)] diff_conv False)) @@    " ^
   313 " (Repeat                                                        " ^
   314 "   ((Repeat (Rewrite_Inst [(bdv,v_v)] diff_sum        False)) Or " ^
   315 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod_const False)) Or " ^
   316 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod       False)) Or " ^
   317 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_quot       True )) Or " ^
   318 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin        False)) Or " ^
   319 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin_chain  False)) Or " ^
   320 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos        False)) Or " ^
   321 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos_chain  False)) Or " ^
   322 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow        False)) Or " ^
   323 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow_chain  False)) Or " ^
   324 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln         False)) Or " ^
   325 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln_chain   False)) Or " ^
   326 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp        False)) Or " ^
   327 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp_chain  False)) Or " ^
   328 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_const      False)) Or " ^
   329 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_var        False)) Or " ^
   330 "    (Repeat (Rewrite_Set             make_polynomial False)))) @@ " ^
   331 " (Try (Rewrite_Set_Inst [(bdv,v_v)] diff_sym_conv False)))) f_f')"
   332 ));
   333 *}
   334 ML {*
   335 store_met
   336  (prep_met thy "met_diff_simpl" [] e_metID
   337  (["diff","diff_simpl"],
   338    [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
   339     ("#Find"  ,["derivative f_f'"])
   340     ],
   341    {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = e_rls,
   342     prls=e_rls, crls = Atools_erls, errpats = [], nrls = norm_diff},
   343 "Script DiffScr (f_f::real) (v_v::real) =                          " ^
   344 " (let f_f' = Take (d_d v_v f_f)                                    " ^
   345 " in ((     " ^
   346 " (Repeat                                                        " ^
   347 "   ((Repeat (Rewrite_Inst [(bdv,v_v)] diff_sum        False)) Or " ^
   348 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod_const False)) Or " ^
   349 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod       False)) Or " ^
   350 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_quot       True )) Or " ^
   351 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin        False)) Or " ^
   352 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin_chain  False)) Or " ^
   353 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos        False)) Or " ^
   354 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos_chain  False)) Or " ^
   355 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow        False)) Or " ^
   356 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow_chain  False)) Or " ^
   357 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln         False)) Or " ^
   358 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln_chain   False)) Or " ^
   359 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp        False)) Or " ^
   360 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp_chain  False)) Or " ^
   361 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_const      False)) Or " ^
   362 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_var        False)) Or " ^
   363 "    (Repeat (Rewrite_Set             make_polynomial False))))  " ^
   364 " )) f_f')"
   365  ));
   366     
   367 store_met
   368  (prep_met thy "met_diff_equ" [] e_metID
   369  (["diff","differentiate_equality"],
   370    [("#Given" ,["functionEq f_f","differentiateFor v_v"]),
   371    ("#Find"  ,["derivativeEq f_f'"])
   372   ],
   373    {rew_ord'="tless_true", rls' = erls_diff, calc = [], 
   374     srls = srls_diff, prls=e_rls, crls=Atools_erls, errpats = [], nrls = norm_diff},
   375 "Script DiffEqScr (f_f::bool) (v_v::real) =                          " ^
   376 " (let f_f' = Take ((primed (lhs f_f)) = d_d v_v (rhs f_f))            " ^
   377 " in (((Try (Rewrite_Set_Inst [(bdv,v_v)] diff_conv False)) @@      " ^
   378 " (Repeat                                                          " ^
   379 "   ((Repeat (Rewrite_Inst [(bdv,v_v)] diff_sum        False)) Or   " ^
   380 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_dif        False)) Or   " ^
   381 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod_const False)) Or   " ^
   382 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod       False)) Or   " ^
   383 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_quot       True )) Or   " ^
   384 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin        False)) Or   " ^
   385 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin_chain  False)) Or   " ^
   386 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos        False)) Or   " ^
   387 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos_chain  False)) Or   " ^
   388 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow        False)) Or   " ^
   389 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow_chain  False)) Or   " ^
   390 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln         False)) Or   " ^
   391 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln_chain   False)) Or   " ^
   392 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp        False)) Or   " ^
   393 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp_chain  False)) Or   " ^
   394 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_const      False)) Or   " ^
   395 "    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_var        False)) Or   " ^
   396 "    (Repeat (Rewrite_Set             make_polynomial False)))) @@ " ^
   397 " (Try (Rewrite_Set_Inst [(bdv,v_v)] diff_sym_conv False)))) f_f')"
   398 ));
   399 
   400 store_met
   401  (prep_met thy "met_diff_after_simp" [] e_metID
   402  (["diff","after_simplification"],
   403    [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
   404     ("#Find"  ,["derivative f_f'"])
   405     ],
   406    {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, prls=e_rls,
   407     crls=Atools_erls, errpats = [], nrls = norm_Rational},
   408 "Script DiffScr (f_f::real) (v_v::real) =                          " ^
   409 " (let f_f' = Take (d_d v_v f_f)                                    " ^
   410 " in ((Try (Rewrite_Set norm_Rational False)) @@                 " ^
   411 "     (Try (Rewrite_Set_Inst [(bdv,v_v)] diff_conv False)) @@     " ^
   412 "     (Try (Rewrite_Set_Inst [(bdv,v_v)] norm_diff False)) @@     " ^
   413 "     (Try (Rewrite_Set_Inst [(bdv,v_v)] diff_sym_conv False)) @@ " ^
   414 "     (Try (Rewrite_Set norm_Rational False))) f_f')"
   415 ));
   416 
   417 
   418 (** CAS-commands **)
   419 
   420 (*.handle cas-input like "Diff (a * x^3 + b, x)".*)
   421 (* val (t, pairl) = strip_comb (str2term "Diff (a * x^3 + b, x)");
   422    val [Const ("Product_Type.Pair", _) $ t $ bdv] = pairl;
   423    *)
   424 fun argl2dtss [Const ("Product_Type.Pair", _) $ t $ bdv] =
   425     [((term_of o the o (parse thy)) "functionTerm", [t]),
   426      ((term_of o the o (parse thy)) "differentiateFor", [bdv]),
   427      ((term_of o the o (parse thy)) "derivative", 
   428       [(term_of o the o (parse thy)) "f_f'"])
   429      ]
   430   | argl2dtss _ = error "Diff.ML: wrong argument for argl2dtss";
   431 *}
   432 setup {* KEStore_Elems.add_cas
   433   [((term_of o the o (parse thy)) "Diff",
   434 	      (("Isac", ["derivative_of","function"], ["no_met"]), argl2dtss))] *}
   435 ML {*
   436 
   437 (*.handle cas-input like "Differentiate (A = s * (a - s), s)".*)
   438 (* val (t, pairl) = strip_comb (str2term "Differentiate (A = s * (a - s), s)");
   439    val [Const ("Product_Type.Pair", _) $ t $ bdv] = pairl;
   440    *)
   441 fun argl2dtss [Const ("Product_Type.Pair", _) $ t $ bdv] =
   442     [((term_of o the o (parse thy)) "functionEq", [t]),
   443      ((term_of o the o (parse thy)) "differentiateFor", [bdv]),
   444      ((term_of o the o (parse thy)) "derivativeEq", 
   445       [(term_of o the o (parse thy)) "f_f'::bool"])
   446      ]
   447   | argl2dtss _ = error "Diff.ML: wrong argument for argl2dtss";
   448 *}
   449 setup {* KEStore_Elems.add_cas
   450   [((term_of o the o (parse thy)) "Differentiate",  
   451 	      (("Isac", ["named","derivative_of","function"], ["no_met"]), argl2dtss))] *}
   452 end