Mathematica Asked on November 15, 2021
I would like to implement the following differential operator in Mathematica,
$$
prod_{j=1}^n left({mathrm d over mathrm d x}-jright)
$$
On a case by case basis, I can just expand it out and write things in terms of D[f, {x, j}]
for $ j = 1, 2, dots, n $, but I would like to know how to define a function that works for general $ n $.
One can use Composition
(which should be the true meaning of the product of operators) with (pure) Function
:
ClearAll[op, ff]
ff[j_] := f [Function] D[f, x] - j f
op[n_] := Composition @@ Table[ff[j], {j, n}]
op[2][f[x]] // Simplify
2 f[x] - 3 f'[x] + f''[x]
Update
The version without Apply (@@)
(actually Composition
can be also replaced by RightComposition
, because the order seems not to matter much in this case), by virtue of a syntax of Array
able to replace heads:
Clear[op2]
op2[n_] := Array[ff, n, 1, Composition]
Answered by Αλέξανδρος Ζεγγ on November 15, 2021
Clear["Global`*"]
Defining the operator recursively,
dOp[func_, x_Symbol, 1] := dOp[func, x, 1] = D[func, x] - func;
dOp[func_, x_Symbol, n_Integer?Positive] := dOp[func, x, n] =
D[dOp[func, x, n - 1], x] - n*dOp[func, x, n - 1];
For example,
dOp[f[x], x, 2] // Expand
(* 2 f[x] - 3 f'[x] + f''[x] *)
Looking at the first several,
Table[{n, dOp[f[x], x, n] // Expand}, {n, 1, 6}] //
Grid[#, Alignment -> Left, Dividers -> All] &
The coefficients are Stirling numbers of the first kind, StirlingS1
Table[StirlingS1[n, m], {n, 2, 7}, {m, 1, n}] // Grid
Consequently, the operator can alternatively be written as the sum
dOp2[func_, x_Symbol, n_Integer?Positive] :=
Sum[StirlingS1[n + 1, m + 1] D[func, {x, m}], {m, 0, n}]
Verifying the equivalence of the definitions,
And @@ Table[dOp[f[x], x, n] == dOp2[f[x], x, n] // Simplify, {n, 1, 15}]
(* True *)
Answered by Bob Hanlon on November 15, 2021
op[f_, x_, n_] := Block[{d},
Total[MapIndexed[#1*If[#2[[1]] == 1, 1, D[f[x], {x, #2[[1]] - 1}]] &,
CoefficientList[Product[d - j, {j, 1, n}], d]]]]
op[g, y, 2]
gives 2 - 3 g'[y] + g''[y]
Update based on your comment:
op[f_, x_, n_] :=
Block[{d},
Total[MapIndexed[#1*D[f[x], {x, #2[[1]] - 1}] &,
CoefficientList[Product[d - j, {j, 1, n}], d]]]]
op[g, y, 2]
gives 2*g[y] - 3*g'[y] + g''[y]
Answered by flinty on November 15, 2021
Get help from others!
Recent Questions
Recent Answers
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP