src/Tools/isac/Knowledge/Diff.thy
author Mathias Lehnfeld <s1210629013@students.fh-hagenberg.at>
Mon, 27 Jan 2014 21:49:27 +0100
changeset 55359 73dc85c025ab
parent 55339 cccd24e959ba
child 55363 d78bc1342183
permissions -rw-r--r--
cleanup, naming: 'KEStore_Elems' in Tests now 'Test_KEStore_Elems', 'store_pbts' now 'add_pbts'
neuper@37906
     1
(* differentiation over the reals
neuper@37906
     2
   author: Walther Neuper
neuper@37906
     3
   000516   
neuper@37906
     4
 *)
neuper@37906
     5
neuper@37954
     6
theory Diff imports Calculus Trig LogExp Rational Root Poly Atools begin
neuper@37906
     7
neuper@37993
     8
ML {*
neuper@37993
     9
@{term "sin x"}
neuper@37993
    10
*}
neuper@37993
    11
neuper@37906
    12
consts
neuper@37906
    13
neuper@37906
    14
  d_d           :: "[real, real]=> real"
neuper@37993
    15
(*sin, cos      :: "real => real"      already in Isabelle2009-2*)
neuper@37906
    16
(*
neuper@37906
    17
  log, ln       :: "real => real"
neuper@37906
    18
  nlog          :: "[real, real] => real"
neuper@37906
    19
  exp           :: "real => real"         ("E'_ ^^^ _" 80)
neuper@37906
    20
*)
neuper@37906
    21
  (*descriptions in the related problems*)
neuper@37993
    22
  derivativeEq  :: "bool => una"
neuper@37906
    23
neuper@37906
    24
  (*predicates*)
neuper@37906
    25
  primed        :: "'a => 'a" (*"primed A" -> "A'"*)
neuper@37906
    26
neuper@37906
    27
  (*the CAS-commands, eg. "Diff (2*x^^^3, x)", 
neuper@37906
    28
			  "Differentiate (A = s * (a - s), s)"*)
neuper@37906
    29
  Diff           :: "[real * real] => real"
neuper@37906
    30
  Differentiate  :: "[bool * real] => bool"
neuper@37906
    31
neuper@37906
    32
  (*subproblem and script-name*)
neuper@37906
    33
  differentiate  :: "[ID * (ID list) * ID, real,real] => real"
neuper@37906
    34
               	   ("(differentiate (_)/ (_ _ ))" 9)
neuper@37906
    35
  DiffScr        :: "[real,real,  real] => real"
neuper@37906
    36
                   ("((Script DiffScr (_ _ =))// (_))" 9)
neuper@37993
    37
  DiffEqScr      :: "[bool,real,  bool] => bool"
neuper@37906
    38
                   ("((Script DiffEqScr (_ _ =))// (_))" 9)
neuper@37906
    39
neuper@37954
    40
text {*a variant of the derivatives defintion:
neuper@37906
    41
neuper@37954
    42
  d_d            :: "(real => real) => (real => real)"
neuper@37954
    43
neuper@37954
    44
  advantages:
neuper@37954
    45
(1) no variable 'bdv' on the meta-level required
neuper@37954
    46
(2) chain_rule "d_d (%x. (u (v x))) = (%x. (d_d u)) (v x) * d_d v"
neuper@37954
    47
(3) and no specialized chain-rules required like
neuper@37954
    48
    diff_sin_chain "d_d bdv (sin u)    = cos u * d_d bdv u"
neuper@37954
    49
neuper@37954
    50
  disadvantage: d_d (%x. 1 + x^2) = ... differs from high-school notation
neuper@37954
    51
*}
neuper@37954
    52
neuper@52148
    53
axiomatization where (*stated as axioms, todo: prove as theorems
neuper@37906
    54
        'bdv' is a constant on the meta-level  *)
neuper@52148
    55
  diff_const:     "[| Not (bdv occurs_in a) |] ==> d_d bdv a = 0" and
neuper@52148
    56
  diff_var:       "d_d bdv bdv = 1" and
neuper@37983
    57
  diff_prod_const:"[| Not (bdv occurs_in u) |] ==>  
neuper@52148
    58
					 d_d bdv (u * v) = u * d_d bdv v" and
neuper@37906
    59
neuper@52148
    60
  diff_sum:       "d_d bdv (u + v)     = d_d bdv u + d_d bdv v" and
neuper@52148
    61
  diff_dif:       "d_d bdv (u - v)     = d_d bdv u - d_d bdv v" and
neuper@52148
    62
  diff_prod:      "d_d bdv (u * v)     = d_d bdv u * v + u * d_d bdv v" and
neuper@37983
    63
  diff_quot:      "Not (v = 0) ==> (d_d bdv (u / v) =  
neuper@52148
    64
	           (d_d bdv u * v - u * d_d bdv v) / v ^^^ 2)" and
neuper@37906
    65
neuper@52148
    66
  diff_sin:       "d_d bdv (sin bdv)   = cos bdv" and
neuper@52148
    67
  diff_sin_chain: "d_d bdv (sin u)     = cos u * d_d bdv u" and
neuper@52148
    68
  diff_cos:       "d_d bdv (cos bdv)   = - sin bdv" and
neuper@52148
    69
  diff_cos_chain: "d_d bdv (cos u)     = - sin u * d_d bdv u" and
neuper@52148
    70
  diff_pow:       "d_d bdv (bdv ^^^ n) = n * (bdv ^^^ (n - 1))" and
neuper@52148
    71
  diff_pow_chain: "d_d bdv (u ^^^ n)   = n * (u ^^^ (n - 1)) * d_d bdv u" and
neuper@52148
    72
  diff_ln:        "d_d bdv (ln bdv)    = 1 / bdv" and
neuper@52148
    73
  diff_ln_chain:  "d_d bdv (ln u)      = d_d bdv u / u" and
neuper@52148
    74
  diff_exp:       "d_d bdv (exp bdv)   = exp bdv" and
neuper@52148
    75
  diff_exp_chain: "d_d bdv (exp u)     = exp u * d_d x u" and
neuper@37906
    76
(*
neuper@37906
    77
  diff_sqrt      "d_d bdv (sqrt bdv)  = 1 / (2 * sqrt bdv)"
neuper@37906
    78
  diff_sqrt_chain"d_d bdv (sqrt u)    = d_d bdv u / (2 * sqrt u)"
neuper@37906
    79
*)
neuper@37906
    80
  (*...*)
neuper@37906
    81
neuper@37983
    82
  frac_conv:       "[| bdv occurs_in b; 0 < n |] ==>  
neuper@52148
    83
		    a / (b ^^^ n) = a * b ^^^ (-n)" and
neuper@52148
    84
  frac_sym_conv:   "n < 0 ==> a * b ^^^ n = a / b ^^^ (-n)" and
neuper@37906
    85
neuper@52148
    86
  sqrt_conv_bdv:   "sqrt bdv = bdv ^^^ (1 / 2)" and
neuper@52148
    87
  sqrt_conv_bdv_n: "sqrt (bdv ^^^ n) = bdv ^^^ (n / 2)" and
neuper@52148
    88
  sqrt_conv:       "bdv occurs_in u ==> sqrt u = u ^^^ (1 / 2)" and
neuper@52148
    89
  sqrt_sym_conv:   "u ^^^ (a / 2) = sqrt (u ^^^ a)" and
neuper@37906
    90
neuper@52148
    91
  root_conv:       "bdv occurs_in u ==> nroot n u = u ^^^ (1 / n)" and
neuper@52148
    92
  root_sym_conv:   "u ^^^ (a / b) = nroot b (u ^^^ a)" and
neuper@37906
    93
neuper@37983
    94
  realpow_pow_bdv: "(bdv ^^^ b) ^^^ c = bdv ^^^ (b * c)"
neuper@37906
    95
neuper@37954
    96
ML {*
neuper@37972
    97
val thy = @{theory};
neuper@37972
    98
neuper@37954
    99
(** eval functions **)
neuper@37954
   100
neuper@37954
   101
fun primed (Const (id, T)) = Const (id ^ "'", T)
neuper@37954
   102
  | primed (Free (id, T)) = Free (id ^ "'", T)
neuper@38031
   103
  | primed t = error ("primed called with arg = '"^ term2str t ^"'");
neuper@37954
   104
neuper@37954
   105
(*("primed", ("Diff.primed", eval_primed "#primed"))*)
neuper@37954
   106
fun eval_primed _ _ (p as (Const ("Diff.primed",_) $ t)) _ =
neuper@37954
   107
    SOME ((term2str p) ^ " = " ^ term2str (primed t),
neuper@37954
   108
	  Trueprop $ (mk_equality (p, primed t)))
neuper@37954
   109
  | eval_primed _ _ _ _ = NONE;
neuper@37993
   110
*}
s1210629013@52145
   111
setup {* KEStore_Elems.add_calcs
s1210629013@52145
   112
  [("primed", ("Diff.primed", eval_primed "#primed"))] *}
neuper@37993
   113
ML {*
neuper@37954
   114
(** rulesets **)
neuper@37954
   115
neuper@37954
   116
(*.converts a term such that differentiation works optimally.*)
neuper@37954
   117
val diff_conv =   
neuper@37954
   118
    Rls {id="diff_conv", 
neuper@37954
   119
	 preconds = [], 
neuper@37954
   120
	 rew_ord = ("termlessI",termlessI), 
neuper@37954
   121
	 erls = append_rls "erls_diff_conv" e_rls 
neuper@37954
   122
			   [Calc ("Atools.occurs'_in", eval_occurs_in ""),
neuper@37969
   123
			    Thm ("not_true",num_str @{thm not_true}),
neuper@37969
   124
			    Thm ("not_false",num_str @{thm not_false}),
neuper@38045
   125
			    Calc ("Orderings.ord_class.less",eval_equ "#less_"),
neuper@37969
   126
			    Thm ("and_true",num_str @{thm and_true}),
neuper@37993
   127
			    Thm ("and_false",num_str @{thm and_false})
neuper@37954
   128
			    ], 
neuper@42451
   129
	 srls = Erls, calc = [], errpatts = [],
neuper@42449
   130
	 rules =
neuper@42449
   131
  [Thm ("frac_conv", num_str @{thm frac_conv}),
neuper@42449
   132
     (*"?bdv occurs_in ?b \<Longrightarrow> 0 < ?n \<Longrightarrow> ?a / ?b ^^^ ?n = ?a * ?b ^^^ - ?n"*)
neuper@42449
   133
		   Thm ("sqrt_conv_bdv", num_str @{thm sqrt_conv_bdv}),
neuper@42449
   134
		     (*"sqrt ?bdv = ?bdv ^^^ (1 / 2)"*)
neuper@42449
   135
		   Thm ("sqrt_conv_bdv_n", num_str @{thm sqrt_conv_bdv_n}),
neuper@42449
   136
		     (*"sqrt (?bdv ^^^ ?n) = ?bdv ^^^ (?n / 2)"*)
neuper@42449
   137
		   Thm ("sqrt_conv", num_str @{thm sqrt_conv}),
neuper@42449
   138
		     (*"?bdv occurs_in ?u \<Longrightarrow> sqrt ?u = ?u ^^^ (1 / 2)"*)
neuper@42449
   139
		   Thm ("root_conv", num_str @{thm root_conv}),
neuper@42449
   140
		     (*"?bdv occurs_in ?u \<Longrightarrow> nroot ?n ?u = ?u ^^^ (1 / ?n)"*)
neuper@42449
   141
		   Thm ("realpow_pow_bdv", num_str @{thm realpow_pow_bdv}),
neuper@42449
   142
		     (* "(?bdv ^^^ ?b) ^^^ ?c = ?bdv ^^^ (?b * ?c)"*)
neuper@42449
   143
		   Calc ("Groups.times_class.times", eval_binop "#mult_"),
neuper@42449
   144
		   Thm ("rat_mult",num_str @{thm rat_mult}),
neuper@42449
   145
		     (*a / b * (c / d) = a * c / (b * d)*)
neuper@42449
   146
		   Thm ("times_divide_eq_right",num_str @{thm times_divide_eq_right}),
neuper@42449
   147
		     (*?x * (?y / ?z) = ?x * ?y / ?z*)
neuper@42449
   148
		   Thm ("times_divide_eq_left",num_str @{thm times_divide_eq_left})
neuper@42449
   149
		     (*?y / ?z * ?x = ?y * ?x / ?z*)
neuper@37954
   150
		 ],
neuper@37954
   151
	 scr = EmptyScr};
neuper@37993
   152
*}
neuper@37993
   153
ML {*
neuper@37954
   154
(*.beautifies a term after differentiation.*)
neuper@37954
   155
val diff_sym_conv =   
neuper@37954
   156
    Rls {id="diff_sym_conv", 
neuper@37954
   157
	 preconds = [], 
neuper@37954
   158
	 rew_ord = ("termlessI",termlessI), 
neuper@37954
   159
	 erls = append_rls "erls_diff_sym_conv" e_rls 
neuper@38045
   160
			   [Calc ("Orderings.ord_class.less",eval_equ "#less_")
neuper@37954
   161
			    ], 
neuper@42451
   162
	 srls = Erls, calc = [], errpatts = [],
neuper@37969
   163
	 rules = [Thm ("frac_sym_conv", num_str @{thm frac_sym_conv}),
neuper@37969
   164
		  Thm ("sqrt_sym_conv", num_str @{thm sqrt_sym_conv}),
neuper@37969
   165
		  Thm ("root_sym_conv", num_str @{thm root_sym_conv}),
neuper@37954
   166
		  Thm ("sym_real_mult_minus1",
neuper@37969
   167
		       num_str (@{thm real_mult_minus1} RS @{thm sym})),
neuper@37954
   168
		      (*- ?z = "-1 * ?z"*)
neuper@37969
   169
		  Thm ("rat_mult",num_str @{thm rat_mult}),
neuper@37954
   170
		  (*a / b * (c / d) = a * c / (b * d)*)
neuper@37965
   171
		  Thm ("times_divide_eq_right",num_str @{thm times_divide_eq_right}),
neuper@37954
   172
		  (*?x * (?y / ?z) = ?x * ?y / ?z*)
neuper@37965
   173
		  Thm ("times_divide_eq_left",num_str @{thm times_divide_eq_left}),
neuper@37954
   174
		  (*?y / ?z * ?x = ?y * ?x / ?z*)
neuper@38034
   175
		  Calc ("Groups.times_class.times", eval_binop "#mult_")
neuper@37954
   176
		 ],
neuper@37954
   177
	 scr = EmptyScr};
neuper@37954
   178
neuper@37954
   179
(*..*)
neuper@37954
   180
val srls_diff = 
neuper@37954
   181
    Rls {id="srls_differentiate..", 
neuper@37954
   182
	 preconds = [], 
neuper@37954
   183
	 rew_ord = ("termlessI",termlessI), 
neuper@37954
   184
	 erls = e_rls, 
neuper@42451
   185
	 srls = Erls, calc = [], errpatts = [],
neuper@37954
   186
	 rules = [Calc("Tools.lhs", eval_lhs "eval_lhs_"),
neuper@37954
   187
		  Calc("Tools.rhs", eval_rhs "eval_rhs_"),
neuper@37954
   188
		  Calc("Diff.primed", eval_primed "Diff.primed")
neuper@37954
   189
		  ],
neuper@37954
   190
	 scr = EmptyScr};
neuper@37993
   191
*}
neuper@37993
   192
ML {*
neuper@37954
   193
(*..*)
neuper@37954
   194
val erls_diff = 
neuper@37954
   195
    append_rls "erls_differentiate.." e_rls
neuper@37969
   196
               [Thm ("not_true",num_str @{thm not_true}),
neuper@37969
   197
		Thm ("not_false",num_str @{thm not_false}),
neuper@37954
   198
		
neuper@37954
   199
		Calc ("Atools.ident",eval_ident "#ident_"),    
neuper@37954
   200
		Calc ("Atools.is'_atom",eval_is_atom "#is_atom_"),
neuper@37954
   201
		Calc ("Atools.occurs'_in",eval_occurs_in ""),
neuper@37954
   202
		Calc ("Atools.is'_const",eval_const "#is_const_")
neuper@37954
   203
		];
neuper@37954
   204
neuper@37954
   205
(*.rules for differentiation, _no_ simplification.*)
neuper@37954
   206
val diff_rules =
neuper@37954
   207
    Rls {id="diff_rules", preconds = [], rew_ord = ("termlessI",termlessI), 
neuper@42451
   208
	 erls = erls_diff, srls = Erls, calc = [], errpatts = [],
neuper@37969
   209
	 rules = [Thm ("diff_sum",num_str @{thm diff_sum}),
neuper@37969
   210
		  Thm ("diff_dif",num_str @{thm diff_dif}),
neuper@37969
   211
		  Thm ("diff_prod_const",num_str @{thm diff_prod_const}),
neuper@37969
   212
		  Thm ("diff_prod",num_str @{thm diff_prod}),
neuper@37969
   213
		  Thm ("diff_quot",num_str @{thm diff_quot}),
neuper@37969
   214
		  Thm ("diff_sin",num_str @{thm diff_sin}),
neuper@37969
   215
		  Thm ("diff_sin_chain",num_str @{thm diff_sin_chain}),
neuper@37969
   216
		  Thm ("diff_cos",num_str @{thm diff_cos}),
neuper@37969
   217
		  Thm ("diff_cos_chain",num_str @{thm diff_cos_chain}),
neuper@37969
   218
		  Thm ("diff_pow",num_str @{thm diff_pow}),
neuper@37969
   219
		  Thm ("diff_pow_chain",num_str @{thm diff_pow_chain}),
neuper@37969
   220
		  Thm ("diff_ln",num_str @{thm diff_ln}),
neuper@37969
   221
		  Thm ("diff_ln_chain",num_str @{thm diff_ln_chain}),
neuper@37969
   222
		  Thm ("diff_exp",num_str @{thm diff_exp}),
neuper@37969
   223
		  Thm ("diff_exp_chain",num_str @{thm diff_exp_chain}),
neuper@37954
   224
(*
neuper@37969
   225
		  Thm ("diff_sqrt",num_str @{thm diff_sqrt}),
neuper@37969
   226
		  Thm ("diff_sqrt_chain",num_str @{thm diff_sqrt_chain}),
neuper@37954
   227
*)
neuper@37969
   228
		  Thm ("diff_const",num_str @{thm diff_const}),
neuper@37969
   229
		  Thm ("diff_var",num_str @{thm diff_var})
neuper@37954
   230
		  ],
neuper@37954
   231
	 scr = EmptyScr};
neuper@37993
   232
*}
neuper@37993
   233
ML {*
neuper@37954
   234
(*.normalisation for checking user-input.*)
neuper@37954
   235
val norm_diff = 
neuper@42426
   236
  Rls
neuper@42458
   237
    {id="norm_diff", preconds = [], rew_ord = ("termlessI",termlessI), 
neuper@42451
   238
     erls = Erls, srls = Erls, calc = [], errpatts = [],
neuper@42426
   239
     rules = [Rls_ diff_rules, Rls_ norm_Poly ],
neuper@42426
   240
     scr = EmptyScr};
neuper@37993
   241
*}
neuper@52125
   242
setup {* KEStore_Elems.add_rlss 
neuper@52142
   243
  [("erls_diff", (Context.theory_name @{theory}, prep_rls erls_diff)), 
neuper@52142
   244
  ("diff_rules", (Context.theory_name @{theory}, prep_rls diff_rules)), 
neuper@52125
   245
  ("norm_diff", (Context.theory_name @{theory}, prep_rls norm_diff)), 
neuper@52125
   246
  ("diff_conv", (Context.theory_name @{theory}, prep_rls diff_conv)), 
neuper@52125
   247
  ("diff_sym_conv", (Context.theory_name @{theory}, prep_rls diff_sym_conv))] *}
neuper@37993
   248
ML {*
neuper@37954
   249
(** problem types **)
neuper@37954
   250
neuper@37954
   251
store_pbt
neuper@37972
   252
 (prep_pbt thy "pbl_fun" [] e_pblID
neuper@37954
   253
 (["function"], [], e_rls, NONE, []));
neuper@37954
   254
neuper@37954
   255
store_pbt
neuper@37972
   256
 (prep_pbt thy "pbl_fun_deriv" [] e_pblID
neuper@37954
   257
 (["derivative_of","function"],
neuper@37993
   258
  [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
neuper@37993
   259
   ("#Find"  ,["derivative f_f'"])
neuper@37954
   260
  ],
neuper@37954
   261
  append_rls "e_rls" e_rls [],
neuper@37993
   262
  SOME "Diff (f_f, v_v)", [["diff","differentiate_on_R"],
neuper@37954
   263
			 ["diff","after_simplification"]]));
neuper@37954
   264
neuper@37954
   265
(*here "named" is used differently from Integration"*)
neuper@37954
   266
store_pbt
neuper@37972
   267
 (prep_pbt thy "pbl_fun_deriv_nam" [] e_pblID
neuper@37954
   268
 (["named","derivative_of","function"],
neuper@37993
   269
  [("#Given" ,["functionEq f_f","differentiateFor v_v"]),
neuper@37993
   270
   ("#Find"  ,["derivativeEq f_f'"])
neuper@37954
   271
  ],
neuper@37954
   272
  append_rls "e_rls" e_rls [],
neuper@37993
   273
  SOME "Differentiate (f_f, v_v)", [["diff","differentiate_equality"]]));
neuper@37993
   274
*}
s1210629013@55359
   275
setup {* KEStore_Elems.add_pbts
s1210629013@55339
   276
  [(prep_pbt thy "pbl_fun" [] e_pblID (["function"], [], e_rls, NONE, [])),
s1210629013@55339
   277
    (prep_pbt thy "pbl_fun_deriv" [] e_pblID
s1210629013@55339
   278
      (["derivative_of","function"],
s1210629013@55339
   279
        [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
s1210629013@55339
   280
          ("#Find"  ,["derivative f_f'"])],
s1210629013@55339
   281
        append_rls "e_rls" e_rls [],
s1210629013@55339
   282
        SOME "Diff (f_f, v_v)", [["diff","differentiate_on_R"],
s1210629013@55339
   283
			  ["diff","after_simplification"]])),
s1210629013@55339
   284
    (*here "named" is used differently from Integration"*)
s1210629013@55339
   285
    (prep_pbt thy "pbl_fun_deriv_nam" [] e_pblID
s1210629013@55339
   286
      (["named","derivative_of","function"],
s1210629013@55339
   287
        [("#Given" ,["functionEq f_f","differentiateFor v_v"]),
s1210629013@55339
   288
          ("#Find"  ,["derivativeEq f_f'"])],
s1210629013@55339
   289
        append_rls "e_rls" e_rls [],
s1210629013@55339
   290
        SOME "Differentiate (f_f, v_v)",
s1210629013@55339
   291
        [["diff","differentiate_equality"]]))] *}
neuper@37993
   292
ML {*
neuper@37954
   293
neuper@37954
   294
(** methods **)
neuper@37954
   295
neuper@37954
   296
store_met
neuper@37972
   297
 (prep_met thy "met_diff" [] e_metID
neuper@37954
   298
 (["diff"], [],
neuper@37954
   299
   {rew_ord'="tless_true",rls'=Atools_erls,calc = [], srls = e_rls, prls=e_rls,
neuper@42425
   300
    crls = Atools_erls, errpats = [], nrls = norm_diff}, "empty_script"));
neuper@37954
   301
neuper@37954
   302
store_met
neuper@37972
   303
 (prep_met thy "met_diff_onR" [] e_metID
neuper@37954
   304
 (["diff","differentiate_on_R"],
neuper@37993
   305
   [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
neuper@37993
   306
    ("#Find"  ,["derivative f_f'"])
neuper@37954
   307
    ],
neuper@37954
   308
   {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = e_rls, 
neuper@42453
   309
    prls=e_rls, crls = Atools_erls, errpats = [], nrls = norm_diff},
neuper@37993
   310
"Script DiffScr (f_f::real) (v_v::real) =                          " ^
neuper@37993
   311
" (let f_f' = Take (d_d v_v f_f)                                    " ^
neuper@37991
   312
" in (((Try (Rewrite_Set_Inst [(bdv,v_v)] diff_conv False)) @@    " ^
neuper@37954
   313
" (Repeat                                                        " ^
neuper@37991
   314
"   ((Repeat (Rewrite_Inst [(bdv,v_v)] diff_sum        False)) Or " ^
neuper@37991
   315
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod_const False)) Or " ^
neuper@37991
   316
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod       False)) Or " ^
neuper@37991
   317
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_quot       True )) Or " ^
neuper@37991
   318
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin        False)) Or " ^
neuper@37991
   319
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin_chain  False)) Or " ^
neuper@37991
   320
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos        False)) Or " ^
neuper@37991
   321
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos_chain  False)) Or " ^
neuper@37991
   322
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow        False)) Or " ^
neuper@37991
   323
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow_chain  False)) Or " ^
neuper@37991
   324
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln         False)) Or " ^
neuper@37991
   325
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln_chain   False)) Or " ^
neuper@37991
   326
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp        False)) Or " ^
neuper@37991
   327
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp_chain  False)) Or " ^
neuper@37991
   328
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_const      False)) Or " ^
neuper@37991
   329
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_var        False)) Or " ^
neuper@37954
   330
"    (Repeat (Rewrite_Set             make_polynomial False)))) @@ " ^
neuper@37993
   331
" (Try (Rewrite_Set_Inst [(bdv,v_v)] diff_sym_conv False)))) f_f')"
neuper@37954
   332
));
neuper@37993
   333
*}
neuper@37993
   334
ML {*
neuper@37954
   335
store_met
neuper@37972
   336
 (prep_met thy "met_diff_simpl" [] e_metID
neuper@37954
   337
 (["diff","diff_simpl"],
neuper@37993
   338
   [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
neuper@37993
   339
    ("#Find"  ,["derivative f_f'"])
neuper@37954
   340
    ],
neuper@37954
   341
   {rew_ord'="tless_true", rls' = erls_diff, calc = [], srls = e_rls,
neuper@42425
   342
    prls=e_rls, crls = Atools_erls, errpats = [], nrls = norm_diff},
neuper@37993
   343
"Script DiffScr (f_f::real) (v_v::real) =                          " ^
neuper@37993
   344
" (let f_f' = Take (d_d v_v f_f)                                    " ^
neuper@37954
   345
" in ((     " ^
neuper@37954
   346
" (Repeat                                                        " ^
neuper@37991
   347
"   ((Repeat (Rewrite_Inst [(bdv,v_v)] diff_sum        False)) Or " ^
neuper@37991
   348
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod_const False)) Or " ^
neuper@37991
   349
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod       False)) Or " ^
neuper@37991
   350
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_quot       True )) Or " ^
neuper@37991
   351
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin        False)) Or " ^
neuper@37991
   352
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin_chain  False)) Or " ^
neuper@37991
   353
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos        False)) Or " ^
neuper@37991
   354
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos_chain  False)) Or " ^
neuper@37991
   355
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow        False)) Or " ^
neuper@37991
   356
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow_chain  False)) Or " ^
neuper@37991
   357
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln         False)) Or " ^
neuper@37991
   358
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln_chain   False)) Or " ^
neuper@37991
   359
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp        False)) Or " ^
neuper@37991
   360
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp_chain  False)) Or " ^
neuper@37991
   361
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_const      False)) Or " ^
neuper@37991
   362
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_var        False)) Or " ^
neuper@37954
   363
"    (Repeat (Rewrite_Set             make_polynomial False))))  " ^
neuper@37993
   364
" )) f_f')"
neuper@37954
   365
 ));
neuper@37954
   366
    
neuper@37954
   367
store_met
neuper@37972
   368
 (prep_met thy "met_diff_equ" [] e_metID
neuper@37954
   369
 (["diff","differentiate_equality"],
neuper@37993
   370
   [("#Given" ,["functionEq f_f","differentiateFor v_v"]),
neuper@37993
   371
   ("#Find"  ,["derivativeEq f_f'"])
neuper@37954
   372
  ],
neuper@37954
   373
   {rew_ord'="tless_true", rls' = erls_diff, calc = [], 
neuper@42425
   374
    srls = srls_diff, prls=e_rls, crls=Atools_erls, errpats = [], nrls = norm_diff},
neuper@37993
   375
"Script DiffEqScr (f_f::bool) (v_v::real) =                          " ^
neuper@37993
   376
" (let f_f' = Take ((primed (lhs f_f)) = d_d v_v (rhs f_f))            " ^
neuper@37991
   377
" in (((Try (Rewrite_Set_Inst [(bdv,v_v)] diff_conv False)) @@      " ^
neuper@37954
   378
" (Repeat                                                          " ^
neuper@37991
   379
"   ((Repeat (Rewrite_Inst [(bdv,v_v)] diff_sum        False)) Or   " ^
neuper@37991
   380
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_dif        False)) Or   " ^
neuper@37991
   381
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod_const False)) Or   " ^
neuper@37991
   382
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_prod       False)) Or   " ^
neuper@37991
   383
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_quot       True )) Or   " ^
neuper@37991
   384
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin        False)) Or   " ^
neuper@37991
   385
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_sin_chain  False)) Or   " ^
neuper@37991
   386
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos        False)) Or   " ^
neuper@37991
   387
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_cos_chain  False)) Or   " ^
neuper@37991
   388
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow        False)) Or   " ^
neuper@37991
   389
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_pow_chain  False)) Or   " ^
neuper@37991
   390
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln         False)) Or   " ^
neuper@37991
   391
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_ln_chain   False)) Or   " ^
neuper@37991
   392
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp        False)) Or   " ^
neuper@37991
   393
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_exp_chain  False)) Or   " ^
neuper@37991
   394
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_const      False)) Or   " ^
neuper@37991
   395
"    (Repeat (Rewrite_Inst [(bdv,v_v)] diff_var        False)) Or   " ^
neuper@37954
   396
"    (Repeat (Rewrite_Set             make_polynomial False)))) @@ " ^
neuper@37993
   397
" (Try (Rewrite_Set_Inst [(bdv,v_v)] diff_sym_conv False)))) f_f')"
neuper@37954
   398
));
neuper@37954
   399
neuper@37954
   400
store_met
neuper@37972
   401
 (prep_met thy "met_diff_after_simp" [] e_metID
neuper@37954
   402
 (["diff","after_simplification"],
neuper@37993
   403
   [("#Given" ,["functionTerm f_f","differentiateFor v_v"]),
neuper@37993
   404
    ("#Find"  ,["derivative f_f'"])
neuper@37954
   405
    ],
neuper@37954
   406
   {rew_ord'="tless_true", rls' = e_rls, calc = [], srls = e_rls, prls=e_rls,
neuper@42425
   407
    crls=Atools_erls, errpats = [], nrls = norm_Rational},
neuper@37993
   408
"Script DiffScr (f_f::real) (v_v::real) =                          " ^
neuper@37993
   409
" (let f_f' = Take (d_d v_v f_f)                                    " ^
neuper@37954
   410
" in ((Try (Rewrite_Set norm_Rational False)) @@                 " ^
neuper@37991
   411
"     (Try (Rewrite_Set_Inst [(bdv,v_v)] diff_conv False)) @@     " ^
neuper@37991
   412
"     (Try (Rewrite_Set_Inst [(bdv,v_v)] norm_diff False)) @@     " ^
neuper@37991
   413
"     (Try (Rewrite_Set_Inst [(bdv,v_v)] diff_sym_conv False)) @@ " ^
neuper@37993
   414
"     (Try (Rewrite_Set norm_Rational False))) f_f')"
neuper@37954
   415
));
neuper@37954
   416
neuper@37954
   417
neuper@37954
   418
(** CAS-commands **)
neuper@37954
   419
neuper@37954
   420
(*.handle cas-input like "Diff (a * x^3 + b, x)".*)
neuper@37954
   421
(* val (t, pairl) = strip_comb (str2term "Diff (a * x^3 + b, x)");
neuper@41972
   422
   val [Const ("Product_Type.Pair", _) $ t $ bdv] = pairl;
neuper@37954
   423
   *)
neuper@41972
   424
fun argl2dtss [Const ("Product_Type.Pair", _) $ t $ bdv] =
neuper@37954
   425
    [((term_of o the o (parse thy)) "functionTerm", [t]),
neuper@37954
   426
     ((term_of o the o (parse thy)) "differentiateFor", [bdv]),
neuper@37954
   427
     ((term_of o the o (parse thy)) "derivative", 
neuper@37993
   428
      [(term_of o the o (parse thy)) "f_f'"])
neuper@37954
   429
     ]
neuper@38031
   430
  | argl2dtss _ = error "Diff.ML: wrong argument for argl2dtss";
s1210629013@52170
   431
*}
s1210629013@52170
   432
setup {* KEStore_Elems.add_cas
s1210629013@52170
   433
  [((term_of o the o (parse thy)) "Diff",
s1210629013@52170
   434
	      (("Isac", ["derivative_of","function"], ["no_met"]), argl2dtss))] *}
s1210629013@52170
   435
ML {*
neuper@37954
   436
neuper@37954
   437
(*.handle cas-input like "Differentiate (A = s * (a - s), s)".*)
neuper@37954
   438
(* val (t, pairl) = strip_comb (str2term "Differentiate (A = s * (a - s), s)");
neuper@41972
   439
   val [Const ("Product_Type.Pair", _) $ t $ bdv] = pairl;
neuper@37954
   440
   *)
neuper@41972
   441
fun argl2dtss [Const ("Product_Type.Pair", _) $ t $ bdv] =
neuper@37954
   442
    [((term_of o the o (parse thy)) "functionEq", [t]),
neuper@37954
   443
     ((term_of o the o (parse thy)) "differentiateFor", [bdv]),
neuper@37954
   444
     ((term_of o the o (parse thy)) "derivativeEq", 
neuper@37993
   445
      [(term_of o the o (parse thy)) "f_f'::bool"])
neuper@37954
   446
     ]
neuper@38031
   447
  | argl2dtss _ = error "Diff.ML: wrong argument for argl2dtss";
neuper@37954
   448
*}
s1210629013@52170
   449
setup {* KEStore_Elems.add_cas
s1210629013@52170
   450
  [((term_of o the o (parse thy)) "Differentiate",  
s1210629013@52170
   451
	      (("Isac", ["named","derivative_of","function"], ["no_met"]), argl2dtss))] *}
neuper@37906
   452
end