src/Tools/isac/Knowledge/Diff.thy
author wenzelm
Sun, 20 Jun 2021 16:26:18 +0200
changeset 60306 51ec2e101e9f
parent 60303 815b0dc8b589
child 60309 70a1d102660d
permissions -rw-r--r--
Isar command 'problem' as combination of KEStore_Elems.add_pbts + Problem.prep_import, without change of semantics;
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"))*)
neuper@37954
    97
fun eval_primed _ _ (p as (Const ("Diff.primed",_) $ 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>
wneuper@59472
   102
setup \<open>KEStore_Elems.add_calcs
wneuper@59472
   103
  [("primed", ("Diff.primed", eval_primed "#primed"))]\<close>
wneuper@59472
   104
ML \<open>
neuper@37954
   105
(** rulesets **)
neuper@37954
   106
neuper@37954
   107
(*.converts a term such that differentiation works optimally.*)
neuper@37954
   108
val diff_conv =   
walther@59851
   109
    Rule_Def.Repeat {id="diff_conv", 
neuper@37954
   110
	 preconds = [], 
neuper@37954
   111
	 rew_ord = ("termlessI",termlessI), 
walther@59852
   112
	 erls = Rule_Set.append_rules "erls_diff_conv" Rule_Set.empty 
wenzelm@60294
   113
			   [\<^rule_eval>\<open>Prog_Expr.occurs_in\<close> (Prog_Expr.eval_occurs_in ""),
wenzelm@60297
   114
			    \<^rule_thm>\<open>not_true\<close>,
wenzelm@60297
   115
			    \<^rule_thm>\<open>not_false\<close>,
wenzelm@60294
   116
			    \<^rule_eval>\<open>less\<close> (Prog_Expr.eval_equ "#less_"),
wenzelm@60297
   117
			    \<^rule_thm>\<open>and_true\<close>,
wenzelm@60297
   118
			    \<^rule_thm>\<open>and_false\<close>
neuper@37954
   119
			    ], 
walther@59851
   120
	 srls = Rule_Set.Empty, calc = [], errpatts = [],
neuper@42449
   121
	 rules =
wenzelm@60297
   122
  [\<^rule_thm>\<open>frac_conv\<close>,
walther@60242
   123
     (*"?bdv occurs_in ?b \<Longrightarrow> 0 < ?n \<Longrightarrow> ?a / ?b \<up> ?n = ?a * ?b \<up> - ?n"*)
wenzelm@60297
   124
		   \<^rule_thm>\<open>sqrt_conv_bdv\<close>,
walther@60242
   125
		     (*"sqrt ?bdv = ?bdv \<up> (1 / 2)"*)
wenzelm@60297
   126
		   \<^rule_thm>\<open>sqrt_conv_bdv_n\<close>,
walther@60242
   127
		     (*"sqrt (?bdv \<up> ?n) = ?bdv \<up> (?n / 2)"*)
wenzelm@60297
   128
		   \<^rule_thm>\<open>sqrt_conv\<close>,
walther@60242
   129
		     (*"?bdv occurs_in ?u \<Longrightarrow> sqrt ?u = ?u \<up> (1 / 2)"*)
wenzelm@60297
   130
		   \<^rule_thm>\<open>root_conv\<close>,
walther@60242
   131
		     (*"?bdv occurs_in ?u \<Longrightarrow> nroot ?n ?u = ?u \<up> (1 / ?n)"*)
wenzelm@60297
   132
		   \<^rule_thm>\<open>realpow_pow_bdv\<close>,
walther@60242
   133
		     (* "(?bdv \<up> ?b) \<up> ?c = ?bdv \<up> (?b * ?c)"*)
wenzelm@60294
   134
		   \<^rule_eval>\<open>times\<close> (**)(eval_binop "#mult_"),
wenzelm@60297
   135
		   \<^rule_thm>\<open>rat_mult\<close>,
neuper@42449
   136
		     (*a / b * (c / d) = a * c / (b * d)*)
wenzelm@60297
   137
		   \<^rule_thm>\<open>times_divide_eq_right\<close>,
neuper@42449
   138
		     (*?x * (?y / ?z) = ?x * ?y / ?z*)
wenzelm@60297
   139
		   \<^rule_thm>\<open>times_divide_eq_left\<close>
neuper@42449
   140
		     (*?y / ?z * ?x = ?y * ?x / ?z*)
neuper@37954
   141
		 ],
walther@59878
   142
	 scr = Rule.Empty_Prog};
wneuper@59472
   143
\<close>
wneuper@59472
   144
ML \<open>
neuper@37954
   145
(*.beautifies a term after differentiation.*)
neuper@37954
   146
val diff_sym_conv =   
walther@59851
   147
    Rule_Def.Repeat {id="diff_sym_conv", 
neuper@37954
   148
	 preconds = [], 
neuper@37954
   149
	 rew_ord = ("termlessI",termlessI), 
walther@59852
   150
	 erls = Rule_Set.append_rules "erls_diff_sym_conv" Rule_Set.empty 
wenzelm@60294
   151
			   [\<^rule_eval>\<open>less\<close> (Prog_Expr.eval_equ "#less_")], 
walther@59851
   152
	 srls = Rule_Set.Empty, calc = [], errpatts = [],
wenzelm@60297
   153
	 rules = [\<^rule_thm>\<open>frac_sym_conv\<close>,
wenzelm@60297
   154
		  \<^rule_thm>\<open>sqrt_sym_conv\<close>,
wenzelm@60297
   155
		  \<^rule_thm>\<open>root_sym_conv\<close>,
wenzelm@60296
   156
		  \<^rule_thm_sym>\<open>real_mult_minus1\<close>,
wenzelm@60296
   157
      (*- ?z = "-1 * ?z"*)
wenzelm@60297
   158
		  \<^rule_thm>\<open>rat_mult\<close>,
neuper@37954
   159
		  (*a / b * (c / d) = a * c / (b * d)*)
wenzelm@60297
   160
		  \<^rule_thm>\<open>times_divide_eq_right\<close>,
neuper@37954
   161
		  (*?x * (?y / ?z) = ?x * ?y / ?z*)
wenzelm@60297
   162
		  \<^rule_thm>\<open>times_divide_eq_left\<close>,
neuper@37954
   163
		  (*?y / ?z * ?x = ?y * ?x / ?z*)
wenzelm@60294
   164
		  \<^rule_eval>\<open>times\<close> (**)(eval_binop "#mult_")
neuper@37954
   165
		 ],
walther@59878
   166
	 scr = Rule.Empty_Prog};
neuper@37954
   167
neuper@37954
   168
(*..*)
neuper@37954
   169
val srls_diff = 
walther@59851
   170
    Rule_Def.Repeat {id="srls_differentiate..", 
neuper@37954
   171
	 preconds = [], 
neuper@37954
   172
	 rew_ord = ("termlessI",termlessI), 
walther@59852
   173
	 erls = Rule_Set.empty, 
walther@59851
   174
	 srls = Rule_Set.Empty, calc = [], errpatts = [],
wenzelm@60294
   175
	 rules = [\<^rule_eval>\<open>Prog_Expr.lhs\<close> (Prog_Expr.eval_lhs "eval_lhs_"),
wenzelm@60294
   176
		  \<^rule_eval>\<open>Prog_Expr.rhs\<close> (Prog_Expr.eval_rhs "eval_rhs_"),
wenzelm@60294
   177
		  \<^rule_eval>\<open>Diff.primed\<close> (eval_primed "Diff.primed")
neuper@37954
   178
		  ],
walther@59878
   179
	 scr = Rule.Empty_Prog};
wneuper@59472
   180
\<close>
wneuper@59472
   181
ML \<open>
neuper@37954
   182
(*..*)
neuper@37954
   183
val erls_diff = 
walther@59852
   184
    Rule_Set.append_rules "erls_differentiate.." Rule_Set.empty
wenzelm@60297
   185
               [\<^rule_thm>\<open>not_true\<close>,
wenzelm@60297
   186
		\<^rule_thm>\<open>not_false\<close>,
neuper@37954
   187
		
wenzelm@60294
   188
		\<^rule_eval>\<open>Prog_Expr.ident\<close> (Prog_Expr.eval_ident "#ident_"),
wenzelm@60294
   189
		\<^rule_eval>\<open>Prog_Expr.is_atom\<close> (Prog_Expr.eval_is_atom "#is_atom_"),
wenzelm@60294
   190
		\<^rule_eval>\<open>Prog_Expr.occurs_in\<close> (Prog_Expr.eval_occurs_in ""),
wenzelm@60294
   191
		\<^rule_eval>\<open>Prog_Expr.is_const\<close> (Prog_Expr.eval_const "#is_const_")
neuper@37954
   192
		];
neuper@37954
   193
neuper@37954
   194
(*.rules for differentiation, _no_ simplification.*)
neuper@37954
   195
val diff_rules =
walther@59851
   196
    Rule_Def.Repeat {id="diff_rules", preconds = [], rew_ord = ("termlessI",termlessI), 
walther@59851
   197
	 erls = erls_diff, srls = Rule_Set.Empty, calc = [], errpatts = [],
wenzelm@60297
   198
	 rules = [\<^rule_thm>\<open>diff_sum\<close>,
wenzelm@60297
   199
		  \<^rule_thm>\<open>diff_dif\<close>,
wenzelm@60297
   200
		  \<^rule_thm>\<open>diff_prod_const\<close>,
wenzelm@60297
   201
		  \<^rule_thm>\<open>diff_prod\<close>,
wenzelm@60297
   202
		  \<^rule_thm>\<open>diff_quot\<close>,
wenzelm@60297
   203
		  \<^rule_thm>\<open>diff_sin\<close>,
wenzelm@60297
   204
		  \<^rule_thm>\<open>diff_sin_chain\<close>,
wenzelm@60297
   205
		  \<^rule_thm>\<open>diff_cos\<close>,
wenzelm@60297
   206
		  \<^rule_thm>\<open>diff_cos_chain\<close>,
wenzelm@60297
   207
		  \<^rule_thm>\<open>diff_pow\<close>,
wenzelm@60297
   208
		  \<^rule_thm>\<open>diff_pow_chain\<close>,
wenzelm@60297
   209
		  \<^rule_thm>\<open>diff_ln\<close>,
wenzelm@60297
   210
		  \<^rule_thm>\<open>diff_ln_chain\<close>,
wenzelm@60297
   211
		  \<^rule_thm>\<open>diff_exp\<close>,
wenzelm@60297
   212
		  \<^rule_thm>\<open>diff_exp_chain\<close>,
neuper@37954
   213
(*
wenzelm@60297
   214
		  \<^rule_thm>\<open>diff_sqrt\<close>,
wenzelm@60297
   215
		  \<^rule_thm>\<open>diff_sqrt_chain\<close>,
neuper@37954
   216
*)
wenzelm@60297
   217
		  \<^rule_thm>\<open>diff_const\<close>,
wenzelm@60297
   218
		  \<^rule_thm>\<open>diff_var\<close>
neuper@37954
   219
		  ],
walther@59878
   220
	 scr = Rule.Empty_Prog};
wneuper@59472
   221
\<close>
wneuper@59472
   222
ML \<open>
neuper@37954
   223
(*.normalisation for checking user-input.*)
neuper@37954
   224
val norm_diff = 
walther@59851
   225
  Rule_Def.Repeat
neuper@42458
   226
    {id="norm_diff", preconds = [], rew_ord = ("termlessI",termlessI), 
walther@59851
   227
     erls = Rule_Set.Empty, srls = Rule_Set.Empty, calc = [], errpatts = [],
wneuper@59416
   228
     rules = [Rule.Rls_ diff_rules, Rule.Rls_ norm_Poly ],
walther@59878
   229
     scr = Rule.Empty_Prog};
wneuper@59472
   230
\<close>
wenzelm@60289
   231
rule_set_knowledge
wenzelm@60286
   232
  erls_diff = \<open>prep_rls' erls_diff\<close> and
wenzelm@60286
   233
  diff_rules = \<open>prep_rls' diff_rules\<close> and
wenzelm@60286
   234
  norm_diff = \<open>prep_rls' norm_diff\<close> and
wenzelm@60286
   235
  diff_conv = \<open>prep_rls' diff_conv\<close> and
wenzelm@60286
   236
  diff_sym_conv = \<open>prep_rls' diff_sym_conv\<close>
s1210629013@55363
   237
wenzelm@60306
   238
wenzelm@60306
   239
(** problems **)
wenzelm@60306
   240
wenzelm@60306
   241
problem pbl_fun : "function" = \<open>Rule_Set.empty\<close>
wenzelm@60306
   242
wenzelm@60306
   243
problem pbl_fun_deriv : "derivative_of/function" =
wenzelm@60306
   244
  \<open>Rule_Set.append_rules "empty" Rule_Set.empty []\<close>
wenzelm@60306
   245
  Method: "diff/differentiate_on_R" "diff/after_simplification"
wenzelm@60306
   246
  CAS: "Diff (f_f, v_v)"
wenzelm@60306
   247
  Given: "functionTerm f_f" "differentiateFor v_v"
wenzelm@60306
   248
  Find: "derivative f_f'"
wenzelm@60306
   249
wenzelm@60306
   250
problem pbl_fun_deriv_nam :
wenzelm@60306
   251
  "named/derivative_of/function" (*here "named" is used differently from Integration"*) =
wenzelm@60306
   252
  \<open>Rule_Set.append_rules "empty" Rule_Set.empty []\<close>
wenzelm@60306
   253
  Method: "diff/differentiate_equality"
wenzelm@60306
   254
  CAS: "Differentiate (f_f, v_v)"
wenzelm@60306
   255
  Given: "functionEq f_f" "differentiateFor v_v"
wenzelm@60306
   256
  Find: "derivativeEq f_f'"
s1210629013@55380
   257
wneuper@59472
   258
ML \<open>
neuper@37954
   259
(** CAS-commands **)
neuper@37954
   260
neuper@37954
   261
(*.handle cas-input like "Diff (a * x^3 + b, x)".*)
neuper@37954
   262
(* val (t, pairl) = strip_comb (str2term "Diff (a * x^3 + b, x)");
neuper@41972
   263
   val [Const ("Product_Type.Pair", _) $ t $ bdv] = pairl;
neuper@37954
   264
   *)
neuper@41972
   265
fun argl2dtss [Const ("Product_Type.Pair", _) $ t $ bdv] =
wenzelm@60291
   266
    [((Thm.term_of o the o (TermC.parse \<^theory>)) "functionTerm", [t]),
wenzelm@60291
   267
     ((Thm.term_of o the o (TermC.parse \<^theory>)) "differentiateFor", [bdv]),
wenzelm@60291
   268
     ((Thm.term_of o the o (TermC.parse \<^theory>)) "derivative", 
wenzelm@60291
   269
      [(Thm.term_of o the o (TermC.parse \<^theory>)) "f_f'"])
neuper@37954
   270
     ]
walther@59962
   271
  | argl2dtss _ = raise ERROR "Diff.ML: wrong argument for argl2dtss";
wneuper@59472
   272
\<close>
wenzelm@60303
   273
wenzelm@60303
   274
method met_diff : "diff" =
wenzelm@60303
   275
  \<open>{rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = Rule_Set.empty, prls=Rule_Set.empty,
wenzelm@60303
   276
    crls = Atools_erls, errpats = [], nrls = norm_diff}\<close>
wneuper@59545
   277
wneuper@59504
   278
partial_function (tailrec) differentiate_on_R :: "real \<Rightarrow> real \<Rightarrow> real"
wneuper@59504
   279
  where
walther@59635
   280
"differentiate_on_R f_f v_v = (
walther@59635
   281
  let
walther@59635
   282
    f_f' = Take (d_d v_v f_f)
walther@59635
   283
  in (
walther@59637
   284
    (Try (Rewrite_Set_Inst [(''bdv'',v_v)] ''diff_conv'')) #> (
walther@59635
   285
    Repeat (
walther@59635
   286
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sum'')) Or
walther@59635
   287
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_prod_const'')) Or
walther@59635
   288
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_prod'')) Or
walther@59635
   289
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_quot'')) Or
walther@59635
   290
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sin'')) Or
walther@59635
   291
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sin_chain'')) Or
walther@59635
   292
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_cos'')) Or
walther@59635
   293
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_cos_chain'')) Or
walther@59635
   294
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_pow'')) Or
walther@59635
   295
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_pow_chain'')) Or
walther@59635
   296
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_ln'')) Or
walther@59635
   297
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_ln_chain'')) Or
walther@59635
   298
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_exp'')) Or
walther@59635
   299
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_exp_chain'')) Or
walther@59635
   300
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_const'')) Or
walther@59635
   301
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_var'')) Or
walther@59637
   302
      (Repeat (Rewrite_Set ''make_polynomial'')))) #> (
walther@59635
   303
    Try (Rewrite_Set_Inst [(''bdv'',v_v)] ''diff_sym_conv''))
walther@59635
   304
    ) f_f')"
wenzelm@60303
   305
wenzelm@60303
   306
method met_diff_onR : "diff/differentiate_on_R" =
wenzelm@60303
   307
  \<open>{rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = Rule_Set.empty, prls=Rule_Set.empty,
wenzelm@60303
   308
    crls = Atools_erls, errpats = [], nrls = norm_diff}\<close>
wenzelm@60303
   309
  Program: differentiate_on_R.simps
wenzelm@60303
   310
  Given: "functionTerm f_f" "differentiateFor v_v"
wenzelm@60303
   311
  Find: "derivative f_f'"
wneuper@59545
   312
wneuper@59504
   313
partial_function (tailrec) differentiateX :: "real \<Rightarrow> real \<Rightarrow> real"
wneuper@59504
   314
  where
walther@59635
   315
"differentiateX f_f v_v = (
walther@59635
   316
  let
walther@59635
   317
    f_f' = Take (d_d v_v f_f)
walther@59635
   318
  in (
walther@59635
   319
    Repeat (
walther@59635
   320
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sum'')) Or
walther@59635
   321
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_prod_const'' )) Or
walther@59635
   322
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_prod'')) Or
walther@59635
   323
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_quot'')) Or
walther@59635
   324
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sin'')) Or
walther@59635
   325
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sin_chain'')) Or
walther@59635
   326
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_cos'')) Or
walther@59635
   327
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_cos_chain'')) Or
walther@59635
   328
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_pow'')) Or
walther@59635
   329
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_pow_chain'')) Or
walther@59635
   330
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_ln'')) Or
walther@59635
   331
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_ln_chain'')) Or
walther@59635
   332
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_exp'')) Or
walther@59635
   333
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_exp_chain'')) Or
walther@59635
   334
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_const'')) Or
walther@59635
   335
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_var'')) Or
walther@59635
   336
      (Repeat (Rewrite_Set ''make_polynomial'')))
walther@59635
   337
    ) f_f')"
wenzelm@60303
   338
wenzelm@60303
   339
method met_diff_simpl : "diff/diff_simpl" =
wenzelm@60303
   340
  \<open>{rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = Rule_Set.empty, prls=Rule_Set.empty,
wenzelm@60303
   341
    crls = Atools_erls, errpats = [], nrls = norm_diff}\<close>
wenzelm@60303
   342
  Program: differentiateX.simps
wenzelm@60303
   343
  Given: "functionTerm f_f" " differentiateFor v_v"
wenzelm@60303
   344
  Find: "derivative f_f'"
wneuper@59545
   345
wneuper@59504
   346
partial_function (tailrec) differentiate_equality :: "bool \<Rightarrow> real \<Rightarrow> bool"
wneuper@59504
   347
  where
walther@59635
   348
"differentiate_equality f_f v_v = (
walther@59635
   349
  let
walther@59635
   350
    f_f' = Take ((primed (lhs f_f)) = d_d v_v (rhs f_f))
walther@59635
   351
  in (
walther@59637
   352
    (Try (Rewrite_Set_Inst [(''bdv'',v_v)] ''diff_conv'' )) #> (
walther@59635
   353
    Repeat (
walther@59635
   354
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_sum'')) Or
walther@59635
   355
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_dif''        )) Or
walther@59635
   356
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_prod_const'')) Or
walther@59635
   357
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_prod'')) Or
walther@59635
   358
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_quot'')) Or
walther@59635
   359
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_sin'')) Or
walther@59635
   360
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_sin_chain'')) Or
walther@59635
   361
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_cos'')) Or
walther@59635
   362
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_cos_chain'')) Or
walther@59635
   363
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_pow'')) Or
walther@59635
   364
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_pow_chain'')) Or
walther@59635
   365
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_ln'')) Or
walther@59635
   366
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_ln_chain'')) Or
walther@59635
   367
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_exp'')) Or
walther@59635
   368
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_exp_chain'')) Or
walther@59635
   369
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_const'')) Or
walther@59635
   370
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_var'')) Or
walther@59637
   371
      (Repeat (Rewrite_Set ''make_polynomial'')))) #> (
walther@59635
   372
    Try (Rewrite_Set_Inst [(''bdv'', v_v)] ''diff_sym_conv'' ))
walther@59635
   373
    ) f_f')"
wenzelm@60303
   374
wenzelm@60303
   375
method met_diff_equ : "diff/differentiate_equality" =
wenzelm@60303
   376
  \<open>{rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = srls_diff, prls=Rule_Set.empty,
wenzelm@60303
   377
    crls=Atools_erls, errpats = [], nrls = norm_diff}\<close>
wenzelm@60303
   378
  Program: differentiate_equality.simps
wenzelm@60303
   379
  Given: "functionEq f_f" "differentiateFor v_v"
wenzelm@60303
   380
  Find: "derivativeEq f_f'"
wneuper@59545
   381
wneuper@59504
   382
partial_function (tailrec) simplify_derivative :: "real \<Rightarrow> real \<Rightarrow> real"
wneuper@59504
   383
  where
walther@59635
   384
"simplify_derivative term bound_variable = (
walther@59635
   385
  let
walther@59634
   386
   term' = Take (d_d bound_variable term)
walther@59635
   387
  in (
walther@59637
   388
    (Try (Rewrite_Set ''norm_Rational'')) #>
walther@59637
   389
    (Try (Rewrite_Set_Inst [(''bdv'', bound_variable)] ''diff_conv'')) #>
walther@59637
   390
    (Try (Rewrite_Set_Inst [(''bdv'', bound_variable)] ''norm_diff'')) #>
walther@59637
   391
    (Try (Rewrite_Set_Inst [(''bdv'', bound_variable)] ''diff_sym_conv'')) #>
walther@59635
   392
    (Try (Rewrite_Set ''norm_Rational''))
walther@59635
   393
    ) term')"
walther@59634
   394
wenzelm@60303
   395
method met_diff_after_simp : "diff/after_simplification" =
wenzelm@60303
   396
  \<open>{rew_ord'="tless_true", rls' = Rule_Set.empty, calc = [], srls = Rule_Set.empty, prls=Rule_Set.empty,
wenzelm@60303
   397
    crls=Atools_erls, errpats = [], nrls = norm_Rational}\<close>
wenzelm@60303
   398
  Program: simplify_derivative.simps
wenzelm@60303
   399
  Given: "functionTerm term" "differentiateFor bound_variable"
wenzelm@60303
   400
  Find: "derivative term'"
wenzelm@60303
   401
wneuper@59472
   402
setup \<open>KEStore_Elems.add_cas
wenzelm@60290
   403
  [((Thm.term_of o the o (TermC.parse @{theory})) "Diff",
walther@59997
   404
	      (("Isac_Knowledge", ["derivative_of", "function"], ["no_met"]), argl2dtss))]\<close>
wneuper@59472
   405
ML \<open>
neuper@37954
   406
neuper@37954
   407
(*.handle cas-input like "Differentiate (A = s * (a - s), s)".*)
neuper@37954
   408
(* val (t, pairl) = strip_comb (str2term "Differentiate (A = s * (a - s), s)");
neuper@41972
   409
   val [Const ("Product_Type.Pair", _) $ t $ bdv] = pairl;
neuper@37954
   410
   *)
neuper@41972
   411
fun argl2dtss [Const ("Product_Type.Pair", _) $ t $ bdv] =
wenzelm@60291
   412
    [((Thm.term_of o the o (TermC.parse \<^theory>)) "functionEq", [t]),
wenzelm@60291
   413
     ((Thm.term_of o the o (TermC.parse \<^theory>)) "differentiateFor", [bdv]),
wenzelm@60291
   414
     ((Thm.term_of o the o (TermC.parse \<^theory>)) "derivativeEq", 
wenzelm@60291
   415
      [(Thm.term_of o the o (TermC.parse \<^theory>)) "f_f'::bool"])
neuper@37954
   416
     ]
walther@59962
   417
  | argl2dtss _ = raise ERROR "Diff.ML: wrong argument for argl2dtss";
wneuper@59472
   418
\<close>
wneuper@59472
   419
setup \<open>KEStore_Elems.add_cas
wenzelm@60290
   420
  [((Thm.term_of o the o (TermC.parse @{theory})) "Differentiate",  
walther@60278
   421
	      (("Isac_Knowledge", ["named", "derivative_of", "function"], ["no_met"]), argl2dtss))]
walther@60278
   422
\<close> ML \<open>
walther@60278
   423
\<close> ML \<open>
walther@60278
   424
\<close>
neuper@37906
   425
end