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