TransWikia.com

Iterated differential operator

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 $.

3 Answers

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] &

enter image description here

The coefficients are Stirling numbers of the first kind, StirlingS1

Table[StirlingS1[n, m], {n, 2, 7}, {m, 1, n}] // Grid

enter image description here

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

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP