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