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