src/Tools/isac/Knowledge/Diff.thy
author wneuper <walther.neuper@jku.at>
Tue, 20 Jul 2021 14:37:56 +0200
changeset 60339 0d22a6bf1fc6
parent 60337 cbad4e18e91b
child 60340 0ee698b0a703
permissions -rw-r--r--
//reduce the number of TermC.parse*; "//"means: tests broken .

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