src/Tools/isac/Knowledge/Diff.thy
author Walther Neuper <walther.neuper@jku.at>
Wed, 08 Apr 2020 12:32:51 +0200
changeset 59852 ea7e6679080e
parent 59851 4dd533681fef
child 59861 65ec9f679c3f
permissions -rw-r--r--
use new struct "Rule_Set" for renaming identifiers
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
neuper@37906
    22
  (*the CAS-commands, eg. "Diff (2*x^^^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) =  
neuper@52148
    55
	           (d_d bdv u * v - u * d_d bdv v) / v ^^^ 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
neuper@52148
    61
  diff_pow:       "d_d bdv (bdv ^^^ n) = n * (bdv ^^^ (n - 1))" and
neuper@52148
    62
  diff_pow_chain: "d_d bdv (u ^^^ n)   = n * (u ^^^ (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 |] ==>  
neuper@52148
    74
		    a / (b ^^^ n) = a * b ^^^ (-n)" and
neuper@52148
    75
  frac_sym_conv:   "n < 0 ==> a * b ^^^ n = a / b ^^^ (-n)" and
neuper@37906
    76
neuper@52148
    77
  sqrt_conv_bdv:   "sqrt bdv = bdv ^^^ (1 / 2)" and
neuper@52148
    78
  sqrt_conv_bdv_n: "sqrt (bdv ^^^ n) = bdv ^^^ (n / 2)" and
neuper@52148
    79
  sqrt_conv:       "bdv occurs_in u ==> sqrt u = u ^^^ (1 / 2)" and
neuper@52148
    80
  sqrt_sym_conv:   "u ^^^ (a / 2) = sqrt (u ^^^ a)" and
neuper@37906
    81
neuper@52148
    82
  root_conv:       "bdv occurs_in u ==> nroot n u = u ^^^ (1 / n)" and
neuper@52148
    83
  root_sym_conv:   "u ^^^ (a / b) = nroot b (u ^^^ a)" and
neuper@37906
    84
neuper@37983
    85
  realpow_pow_bdv: "(bdv ^^^ b) ^^^ c = bdv ^^^ (b * c)"
neuper@37906
    86
wneuper@59472
    87
ML \<open>
neuper@37972
    88
val thy = @{theory};
neuper@37972
    89
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)
wneuper@59416
    94
  | primed t = error ("primed called with arg = '"^ Rule.term2str 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)) _ =
wneuper@59416
    98
    SOME ((Rule.term2str p) ^ " = " ^ Rule.term2str (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 
walther@59773
   113
			   [Rule.Num_Calc ("Prog_Expr.occurs'_in", Prog_Expr.eval_occurs_in ""),
wneuper@59416
   114
			    Rule.Thm ("not_true",TermC.num_str @{thm not_true}),
wneuper@59416
   115
			    Rule.Thm ("not_false",TermC.num_str @{thm not_false}),
walther@59773
   116
			    Rule.Num_Calc ("Orderings.ord_class.less", Prog_Expr.eval_equ "#less_"),
wneuper@59416
   117
			    Rule.Thm ("and_true",TermC.num_str @{thm and_true}),
wneuper@59416
   118
			    Rule.Thm ("and_false",TermC.num_str @{thm and_false})
neuper@37954
   119
			    ], 
walther@59851
   120
	 srls = Rule_Set.Empty, calc = [], errpatts = [],
neuper@42449
   121
	 rules =
wneuper@59416
   122
  [Rule.Thm ("frac_conv", TermC.num_str @{thm frac_conv}),
neuper@42449
   123
     (*"?bdv occurs_in ?b \<Longrightarrow> 0 < ?n \<Longrightarrow> ?a / ?b ^^^ ?n = ?a * ?b ^^^ - ?n"*)
wneuper@59416
   124
		   Rule.Thm ("sqrt_conv_bdv", TermC.num_str @{thm sqrt_conv_bdv}),
neuper@42449
   125
		     (*"sqrt ?bdv = ?bdv ^^^ (1 / 2)"*)
wneuper@59416
   126
		   Rule.Thm ("sqrt_conv_bdv_n", TermC.num_str @{thm sqrt_conv_bdv_n}),
neuper@42449
   127
		     (*"sqrt (?bdv ^^^ ?n) = ?bdv ^^^ (?n / 2)"*)
wneuper@59416
   128
		   Rule.Thm ("sqrt_conv", TermC.num_str @{thm sqrt_conv}),
neuper@42449
   129
		     (*"?bdv occurs_in ?u \<Longrightarrow> sqrt ?u = ?u ^^^ (1 / 2)"*)
wneuper@59416
   130
		   Rule.Thm ("root_conv", TermC.num_str @{thm root_conv}),
neuper@42449
   131
		     (*"?bdv occurs_in ?u \<Longrightarrow> nroot ?n ?u = ?u ^^^ (1 / ?n)"*)
wneuper@59416
   132
		   Rule.Thm ("realpow_pow_bdv", TermC.num_str @{thm realpow_pow_bdv}),
neuper@42449
   133
		     (* "(?bdv ^^^ ?b) ^^^ ?c = ?bdv ^^^ (?b * ?c)"*)
walther@59773
   134
		   Rule.Num_Calc ("Groups.times_class.times", (**)eval_binop "#mult_"),
wneuper@59416
   135
		   Rule.Thm ("rat_mult",TermC.num_str @{thm rat_mult}),
neuper@42449
   136
		     (*a / b * (c / d) = a * c / (b * d)*)
wneuper@59416
   137
		   Rule.Thm ("times_divide_eq_right",TermC.num_str @{thm times_divide_eq_right}),
neuper@42449
   138
		     (*?x * (?y / ?z) = ?x * ?y / ?z*)
wneuper@59416
   139
		   Rule.Thm ("times_divide_eq_left",TermC.num_str @{thm times_divide_eq_left})
neuper@42449
   140
		     (*?y / ?z * ?x = ?y * ?x / ?z*)
neuper@37954
   141
		 ],
wneuper@59416
   142
	 scr = Rule.EmptyScr};
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 
walther@59773
   151
			   [Rule.Num_Calc ("Orderings.ord_class.less", Prog_Expr.eval_equ "#less_")
neuper@37954
   152
			    ], 
walther@59851
   153
	 srls = Rule_Set.Empty, calc = [], errpatts = [],
wneuper@59416
   154
	 rules = [Rule.Thm ("frac_sym_conv", TermC.num_str @{thm frac_sym_conv}),
wneuper@59416
   155
		  Rule.Thm ("sqrt_sym_conv", TermC.num_str @{thm sqrt_sym_conv}),
wneuper@59416
   156
		  Rule.Thm ("root_sym_conv", TermC.num_str @{thm root_sym_conv}),
wneuper@59416
   157
		  Rule.Thm ("sym_real_mult_minus1",
wneuper@59389
   158
		       TermC.num_str (@{thm real_mult_minus1} RS @{thm sym})),
neuper@37954
   159
		      (*- ?z = "-1 * ?z"*)
wneuper@59416
   160
		  Rule.Thm ("rat_mult",TermC.num_str @{thm rat_mult}),
neuper@37954
   161
		  (*a / b * (c / d) = a * c / (b * d)*)
wneuper@59416
   162
		  Rule.Thm ("times_divide_eq_right",TermC.num_str @{thm times_divide_eq_right}),
neuper@37954
   163
		  (*?x * (?y / ?z) = ?x * ?y / ?z*)
wneuper@59416
   164
		  Rule.Thm ("times_divide_eq_left",TermC.num_str @{thm times_divide_eq_left}),
neuper@37954
   165
		  (*?y / ?z * ?x = ?y * ?x / ?z*)
walther@59773
   166
		  Rule.Num_Calc ("Groups.times_class.times", (**)eval_binop "#mult_")
neuper@37954
   167
		 ],
wneuper@59416
   168
	 scr = Rule.EmptyScr};
neuper@37954
   169
neuper@37954
   170
(*..*)
neuper@37954
   171
val srls_diff = 
walther@59851
   172
    Rule_Def.Repeat {id="srls_differentiate..", 
neuper@37954
   173
	 preconds = [], 
neuper@37954
   174
	 rew_ord = ("termlessI",termlessI), 
walther@59852
   175
	 erls = Rule_Set.empty, 
walther@59851
   176
	 srls = Rule_Set.Empty, calc = [], errpatts = [],
walther@59773
   177
	 rules = [Rule.Num_Calc("Prog_Expr.lhs", Prog_Expr.eval_lhs "eval_lhs_"),
walther@59773
   178
		  Rule.Num_Calc("Prog_Expr.rhs", Prog_Expr.eval_rhs "eval_rhs_"),
walther@59773
   179
		  Rule.Num_Calc("Diff.primed", eval_primed "Diff.primed")
neuper@37954
   180
		  ],
wneuper@59416
   181
	 scr = Rule.EmptyScr};
wneuper@59472
   182
\<close>
wneuper@59472
   183
ML \<open>
neuper@37954
   184
(*..*)
neuper@37954
   185
val erls_diff = 
walther@59852
   186
    Rule_Set.append_rules "erls_differentiate.." Rule_Set.empty
wneuper@59416
   187
               [Rule.Thm ("not_true",TermC.num_str @{thm not_true}),
wneuper@59416
   188
		Rule.Thm ("not_false",TermC.num_str @{thm not_false}),
neuper@37954
   189
		
walther@59773
   190
		Rule.Num_Calc ("Prog_Expr.ident", Prog_Expr.eval_ident "#ident_"),    
walther@59773
   191
		Rule.Num_Calc ("Prog_Expr.is'_atom", Prog_Expr.eval_is_atom "#is_atom_"),
walther@59773
   192
		Rule.Num_Calc ("Prog_Expr.occurs'_in", Prog_Expr.eval_occurs_in ""),
walther@59773
   193
		Rule.Num_Calc ("Prog_Expr.is'_const", Prog_Expr.eval_const "#is_const_")
neuper@37954
   194
		];
neuper@37954
   195
neuper@37954
   196
(*.rules for differentiation, _no_ simplification.*)
neuper@37954
   197
val diff_rules =
walther@59851
   198
    Rule_Def.Repeat {id="diff_rules", preconds = [], rew_ord = ("termlessI",termlessI), 
walther@59851
   199
	 erls = erls_diff, srls = Rule_Set.Empty, calc = [], errpatts = [],
wneuper@59416
   200
	 rules = [Rule.Thm ("diff_sum",TermC.num_str @{thm diff_sum}),
wneuper@59416
   201
		  Rule.Thm ("diff_dif",TermC.num_str @{thm diff_dif}),
wneuper@59416
   202
		  Rule.Thm ("diff_prod_const",TermC.num_str @{thm diff_prod_const}),
wneuper@59416
   203
		  Rule.Thm ("diff_prod",TermC.num_str @{thm diff_prod}),
wneuper@59416
   204
		  Rule.Thm ("diff_quot",TermC.num_str @{thm diff_quot}),
wneuper@59416
   205
		  Rule.Thm ("diff_sin",TermC.num_str @{thm diff_sin}),
wneuper@59416
   206
		  Rule.Thm ("diff_sin_chain",TermC.num_str @{thm diff_sin_chain}),
wneuper@59416
   207
		  Rule.Thm ("diff_cos",TermC.num_str @{thm diff_cos}),
wneuper@59416
   208
		  Rule.Thm ("diff_cos_chain",TermC.num_str @{thm diff_cos_chain}),
wneuper@59416
   209
		  Rule.Thm ("diff_pow",TermC.num_str @{thm diff_pow}),
wneuper@59416
   210
		  Rule.Thm ("diff_pow_chain",TermC.num_str @{thm diff_pow_chain}),
wneuper@59416
   211
		  Rule.Thm ("diff_ln",TermC.num_str @{thm diff_ln}),
wneuper@59416
   212
		  Rule.Thm ("diff_ln_chain",TermC.num_str @{thm diff_ln_chain}),
wneuper@59416
   213
		  Rule.Thm ("diff_exp",TermC.num_str @{thm diff_exp}),
wneuper@59416
   214
		  Rule.Thm ("diff_exp_chain",TermC.num_str @{thm diff_exp_chain}),
neuper@37954
   215
(*
wneuper@59416
   216
		  Rule.Thm ("diff_sqrt",TermC.num_str @{thm diff_sqrt}),
wneuper@59416
   217
		  Rule.Thm ("diff_sqrt_chain",TermC.num_str @{thm diff_sqrt_chain}),
neuper@37954
   218
*)
wneuper@59416
   219
		  Rule.Thm ("diff_const",TermC.num_str @{thm diff_const}),
wneuper@59416
   220
		  Rule.Thm ("diff_var",TermC.num_str @{thm diff_var})
neuper@37954
   221
		  ],
wneuper@59416
   222
	 scr = Rule.EmptyScr};
wneuper@59472
   223
\<close>
wneuper@59472
   224
ML \<open>
neuper@37954
   225
(*.normalisation for checking user-input.*)
neuper@37954
   226
val norm_diff = 
walther@59851
   227
  Rule_Def.Repeat
neuper@42458
   228
    {id="norm_diff", preconds = [], rew_ord = ("termlessI",termlessI), 
walther@59851
   229
     erls = Rule_Set.Empty, srls = Rule_Set.Empty, calc = [], errpatts = [],
wneuper@59416
   230
     rules = [Rule.Rls_ diff_rules, Rule.Rls_ norm_Poly ],
wneuper@59416
   231
     scr = Rule.EmptyScr};
wneuper@59472
   232
\<close>
wneuper@59472
   233
setup \<open>KEStore_Elems.add_rlss 
s1210629013@55444
   234
  [("erls_diff", (Context.theory_name @{theory}, prep_rls' erls_diff)), 
s1210629013@55444
   235
  ("diff_rules", (Context.theory_name @{theory}, prep_rls' diff_rules)), 
s1210629013@55444
   236
  ("norm_diff", (Context.theory_name @{theory}, prep_rls' norm_diff)), 
s1210629013@55444
   237
  ("diff_conv", (Context.theory_name @{theory}, prep_rls' diff_conv)), 
wneuper@59472
   238
  ("diff_sym_conv", (Context.theory_name @{theory}, prep_rls' diff_sym_conv))]\<close>
s1210629013@55363
   239
neuper@37954
   240
(** problem types **)
wneuper@59472
   241
setup \<open>KEStore_Elems.add_pbts
walther@59852
   242
  [(Specify.prep_pbt thy "pbl_fun" [] Celem.e_pblID (["function"], [], Rule_Set.empty, NONE, [])),
wneuper@59406
   243
    (Specify.prep_pbt thy "pbl_fun_deriv" [] Celem.e_pblID
s1210629013@55339
   244
      (["derivative_of","function"],
s1210629013@55339
   245
        [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
s1210629013@55339
   246
          ("#Find"  ,["derivative f_f'"])],
walther@59852
   247
        Rule_Set.append_rules "empty" Rule_Set.empty [],
s1210629013@55339
   248
        SOME "Diff (f_f, v_v)", [["diff","differentiate_on_R"],
s1210629013@55339
   249
			  ["diff","after_simplification"]])),
s1210629013@55339
   250
    (*here "named" is used differently from Integration"*)
wneuper@59406
   251
    (Specify.prep_pbt thy "pbl_fun_deriv_nam" [] Celem.e_pblID
s1210629013@55339
   252
      (["named","derivative_of","function"],
s1210629013@55339
   253
        [("#Given" ,["functionEq f_f","differentiateFor v_v"]),
s1210629013@55339
   254
          ("#Find"  ,["derivativeEq f_f'"])],
walther@59852
   255
        Rule_Set.append_rules "empty" Rule_Set.empty [],
s1210629013@55339
   256
        SOME "Differentiate (f_f, v_v)",
wneuper@59472
   257
        [["diff","differentiate_equality"]]))]\<close>
s1210629013@55380
   258
wneuper@59472
   259
ML \<open>
neuper@37954
   260
(** CAS-commands **)
neuper@37954
   261
neuper@37954
   262
(*.handle cas-input like "Diff (a * x^3 + b, x)".*)
neuper@37954
   263
(* val (t, pairl) = strip_comb (str2term "Diff (a * x^3 + b, x)");
neuper@41972
   264
   val [Const ("Product_Type.Pair", _) $ t $ bdv] = pairl;
neuper@37954
   265
   *)
neuper@41972
   266
fun argl2dtss [Const ("Product_Type.Pair", _) $ t $ bdv] =
wneuper@59389
   267
    [((Thm.term_of o the o (TermC.parse thy)) "functionTerm", [t]),
wneuper@59389
   268
     ((Thm.term_of o the o (TermC.parse thy)) "differentiateFor", [bdv]),
wneuper@59389
   269
     ((Thm.term_of o the o (TermC.parse thy)) "derivative", 
wneuper@59389
   270
      [(Thm.term_of o the o (TermC.parse thy)) "f_f'"])
neuper@37954
   271
     ]
neuper@38031
   272
  | argl2dtss _ = error "Diff.ML: wrong argument for argl2dtss";
wneuper@59472
   273
\<close>
wneuper@59472
   274
setup \<open>KEStore_Elems.add_mets
wneuper@59473
   275
    [Specify.prep_met thy "met_diff" [] Celem.e_metID
s1210629013@55373
   276
      (["diff"], [],
walther@59852
   277
        {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = Rule_Set.empty, prls=Rule_Set.empty,
s1210629013@55373
   278
          crls = Atools_erls, errpats = [], nrls = norm_diff},
wneuper@59545
   279
        @{thm refl})]
wneuper@59473
   280
\<close>
wneuper@59545
   281
wneuper@59504
   282
partial_function (tailrec) differentiate_on_R :: "real \<Rightarrow> real \<Rightarrow> real"
wneuper@59504
   283
  where
walther@59635
   284
"differentiate_on_R f_f v_v = (
walther@59635
   285
  let
walther@59635
   286
    f_f' = Take (d_d v_v f_f)
walther@59635
   287
  in (
walther@59637
   288
    (Try (Rewrite_Set_Inst [(''bdv'',v_v)] ''diff_conv'')) #> (
walther@59635
   289
    Repeat (
walther@59635
   290
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sum'')) Or
walther@59635
   291
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_prod_const'')) Or
walther@59635
   292
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_prod'')) Or
walther@59635
   293
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_quot'')) Or
walther@59635
   294
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sin'')) Or
walther@59635
   295
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sin_chain'')) Or
walther@59635
   296
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_cos'')) Or
walther@59635
   297
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_cos_chain'')) Or
walther@59635
   298
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_pow'')) Or
walther@59635
   299
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_pow_chain'')) Or
walther@59635
   300
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_ln'')) Or
walther@59635
   301
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_ln_chain'')) Or
walther@59635
   302
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_exp'')) Or
walther@59635
   303
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_exp_chain'')) Or
walther@59635
   304
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_const'')) Or
walther@59635
   305
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_var'')) Or
walther@59637
   306
      (Repeat (Rewrite_Set ''make_polynomial'')))) #> (
walther@59635
   307
    Try (Rewrite_Set_Inst [(''bdv'',v_v)] ''diff_sym_conv''))
walther@59635
   308
    ) f_f')"
wneuper@59473
   309
setup \<open>KEStore_Elems.add_mets
wneuper@59473
   310
    [Specify.prep_met thy "met_diff_onR" [] Celem.e_metID
s1210629013@55373
   311
      (["diff","differentiate_on_R"],
s1210629013@55373
   312
        [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
s1210629013@55373
   313
          ("#Find"  ,["derivative f_f'"])],
walther@59852
   314
        {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = Rule_Set.empty, prls=Rule_Set.empty,
s1210629013@55373
   315
          crls = Atools_erls, errpats = [], nrls = norm_diff},
wneuper@59551
   316
        @{thm differentiate_on_R.simps})]
wneuper@59473
   317
\<close>
wneuper@59545
   318
wneuper@59504
   319
partial_function (tailrec) differentiateX :: "real \<Rightarrow> real \<Rightarrow> real"
wneuper@59504
   320
  where
walther@59635
   321
"differentiateX f_f v_v = (
walther@59635
   322
  let
walther@59635
   323
    f_f' = Take (d_d v_v f_f)
walther@59635
   324
  in (
walther@59635
   325
    Repeat (
walther@59635
   326
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sum'')) Or
walther@59635
   327
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_prod_const'' )) Or
walther@59635
   328
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_prod'')) Or
walther@59635
   329
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_quot'')) Or
walther@59635
   330
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sin'')) Or
walther@59635
   331
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_sin_chain'')) Or
walther@59635
   332
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_cos'')) Or
walther@59635
   333
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_cos_chain'')) Or
walther@59635
   334
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_pow'')) Or
walther@59635
   335
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_pow_chain'')) Or
walther@59635
   336
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_ln'')) Or
walther@59635
   337
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_ln_chain'')) Or
walther@59635
   338
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_exp'')) Or
walther@59635
   339
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_exp_chain'')) Or
walther@59635
   340
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_const'')) Or
walther@59635
   341
      (Repeat (Rewrite_Inst [(''bdv'',v_v)] ''diff_var'')) Or
walther@59635
   342
      (Repeat (Rewrite_Set ''make_polynomial'')))
walther@59635
   343
    ) f_f')"
wneuper@59473
   344
setup \<open>KEStore_Elems.add_mets
wneuper@59473
   345
    [Specify.prep_met thy "met_diff_simpl" [] Celem.e_metID
s1210629013@55373
   346
      (["diff","diff_simpl"],
wneuper@59226
   347
        [("#Given", ["functionTerm f_f","differentiateFor v_v"]),
wneuper@59226
   348
         ("#Find" , ["derivative f_f'"])],
walther@59852
   349
        {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = Rule_Set.empty, prls=Rule_Set.empty,
s1210629013@55373
   350
          crls = Atools_erls, errpats = [], nrls = norm_diff},
wneuper@59551
   351
        @{thm differentiateX.simps})]
wneuper@59473
   352
\<close>
wneuper@59545
   353
wneuper@59504
   354
partial_function (tailrec) differentiate_equality :: "bool \<Rightarrow> real \<Rightarrow> bool"
wneuper@59504
   355
  where
walther@59635
   356
"differentiate_equality f_f v_v = (
walther@59635
   357
  let
walther@59635
   358
    f_f' = Take ((primed (lhs f_f)) = d_d v_v (rhs f_f))
walther@59635
   359
  in (
walther@59637
   360
    (Try (Rewrite_Set_Inst [(''bdv'',v_v)] ''diff_conv'' )) #> (
walther@59635
   361
    Repeat (
walther@59635
   362
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_sum'')) Or
walther@59635
   363
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_dif''        )) Or
walther@59635
   364
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_prod_const'')) Or
walther@59635
   365
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_prod'')) Or
walther@59635
   366
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_quot'')) Or
walther@59635
   367
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_sin'')) Or
walther@59635
   368
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_sin_chain'')) Or
walther@59635
   369
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_cos'')) Or
walther@59635
   370
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_cos_chain'')) Or
walther@59635
   371
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_pow'')) Or
walther@59635
   372
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_pow_chain'')) Or
walther@59635
   373
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_ln'')) Or
walther@59635
   374
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_ln_chain'')) Or
walther@59635
   375
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_exp'')) Or
walther@59635
   376
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_exp_chain'')) Or
walther@59635
   377
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_const'')) Or
walther@59635
   378
      (Repeat (Rewrite_Inst [(''bdv'', v_v)] ''diff_var'')) Or
walther@59637
   379
      (Repeat (Rewrite_Set ''make_polynomial'')))) #> (
walther@59635
   380
    Try (Rewrite_Set_Inst [(''bdv'', v_v)] ''diff_sym_conv'' ))
walther@59635
   381
    ) f_f')"
wneuper@59473
   382
setup \<open>KEStore_Elems.add_mets
wneuper@59473
   383
    [Specify.prep_met thy "met_diff_equ" [] Celem.e_metID
s1210629013@55373
   384
      (["diff","differentiate_equality"],
s1210629013@55373
   385
        [("#Given" ,["functionEq f_f","differentiateFor v_v"]),
s1210629013@55373
   386
          ("#Find"  ,["derivativeEq f_f'"])],
walther@59852
   387
        {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = srls_diff, prls=Rule_Set.empty,
s1210629013@55373
   388
          crls=Atools_erls, errpats = [], nrls = norm_diff},
wneuper@59551
   389
        @{thm differentiate_equality.simps})]
wneuper@59473
   390
\<close>
wneuper@59545
   391
wneuper@59504
   392
partial_function (tailrec) simplify_derivative :: "real \<Rightarrow> real \<Rightarrow> real"
wneuper@59504
   393
  where
walther@59635
   394
"simplify_derivative term bound_variable = (
walther@59635
   395
  let
walther@59634
   396
   term' = Take (d_d bound_variable term)
walther@59635
   397
  in (
walther@59637
   398
    (Try (Rewrite_Set ''norm_Rational'')) #>
walther@59637
   399
    (Try (Rewrite_Set_Inst [(''bdv'', bound_variable)] ''diff_conv'')) #>
walther@59637
   400
    (Try (Rewrite_Set_Inst [(''bdv'', bound_variable)] ''norm_diff'')) #>
walther@59637
   401
    (Try (Rewrite_Set_Inst [(''bdv'', bound_variable)] ''diff_sym_conv'')) #>
walther@59635
   402
    (Try (Rewrite_Set ''norm_Rational''))
walther@59635
   403
    ) term')"
walther@59634
   404
wneuper@59473
   405
setup \<open>KEStore_Elems.add_mets
wneuper@59473
   406
    [Specify.prep_met thy "met_diff_after_simp" [] Celem.e_metID
s1210629013@55373
   407
      (["diff","after_simplification"],
walther@59634
   408
        [("#Given" ,["functionTerm term","differentiateFor bound_variable"]),
walther@59634
   409
          ("#Find"  ,["derivative term'"])],
walther@59852
   410
        {rew_ord'="tless_true", rls' = Rule_Set.empty, calc = [], srls = Rule_Set.empty, prls=Rule_Set.empty,
s1210629013@55373
   411
          crls=Atools_erls, errpats = [], nrls = norm_Rational},
wneuper@59551
   412
        @{thm simplify_derivative.simps})]
wneuper@59472
   413
\<close>
wneuper@59472
   414
setup \<open>KEStore_Elems.add_cas
wneuper@59389
   415
  [((Thm.term_of o the o (TermC.parse thy)) "Diff",
wneuper@59592
   416
	      (("Isac_Knowledge", ["derivative_of","function"], ["no_met"]), argl2dtss))]\<close>
wneuper@59472
   417
ML \<open>
neuper@37954
   418
neuper@37954
   419
(*.handle cas-input like "Differentiate (A = s * (a - s), s)".*)
neuper@37954
   420
(* val (t, pairl) = strip_comb (str2term "Differentiate (A = s * (a - s), s)");
neuper@41972
   421
   val [Const ("Product_Type.Pair", _) $ t $ bdv] = pairl;
neuper@37954
   422
   *)
neuper@41972
   423
fun argl2dtss [Const ("Product_Type.Pair", _) $ t $ bdv] =
wneuper@59389
   424
    [((Thm.term_of o the o (TermC.parse thy)) "functionEq", [t]),
wneuper@59389
   425
     ((Thm.term_of o the o (TermC.parse thy)) "differentiateFor", [bdv]),
wneuper@59389
   426
     ((Thm.term_of o the o (TermC.parse thy)) "derivativeEq", 
wneuper@59389
   427
      [(Thm.term_of o the o (TermC.parse thy)) "f_f'::bool"])
neuper@37954
   428
     ]
neuper@38031
   429
  | argl2dtss _ = error "Diff.ML: wrong argument for argl2dtss";
wneuper@59472
   430
\<close>
wneuper@59472
   431
setup \<open>KEStore_Elems.add_cas
wneuper@59389
   432
  [((Thm.term_of o the o (TermC.parse thy)) "Differentiate",  
wneuper@59592
   433
	      (("Isac_Knowledge", ["named","derivative_of","function"], ["no_met"]), argl2dtss))]\<close>
neuper@55448
   434
	      
neuper@37906
   435
end