How to expand the arithmetics of differential operators in mathematica - wolfram-mathematica

Question

For example, I want mma to expand out the following differential operator
(1+d/dx+x*d2/dy2)^2*(1+y*d/dy)^2
I found Nest is not good enough to do this sort of things.

Answer 1

A bit dated, but see
http://library.wolfram.com/infocenter/Conferences/325/
The section "Some noncommutative algebraic manipulation" gives a few ways to go about this.
The first example, defining a function called differentialOperate, is probably best suited for your purposes.
---edit, reedited---
Here is the code I use. Probably it is (still) missing a few refinements. It is taken from a couple of examples in the notebook mentioned above.
I will define and use an auxiliary predicate, scalarQ. This gives the flexibility of declaring entities other than explicit numerical values to be scalar.
I define a noncommutative multiplication, called ncTimes. Ideally I would just use NonCommutativeMultiply, but Iwas not able to get the pattern matching to behave the way I wanted with respect to zero or one argument forms, or pulling out scalars. (Less technical explanation: it's mojo was more powerful than mine.)
scalarQ[a_?NumericQ] := True
scalarQ[_] := False
ncTimes[] := 1
ncTimes[a_] := a
ncTimes[a_, ncTimes[b_, c], d_] := ncTimes[a, b, c, d]
ncTimes[a_, x_ + y_, b_] := ncTimes[a, x, b] + ncTimes[a, y, b]
ncTimes[a_, i_?scalarQ*c_, b_] := i*ncTimes[a, c, b]
ncTimes[a_, i_?scalarQ, b___] := i*ncTimes[a, b]
differentialOperate[a_, expr_] /; FreeQ[a, D] := a*expr
differentialOperate[L1_ + L2_, expr_] :=
differentialOperate[L1, expr] + differentialOperate[L2, expr]
differentialOperate[a_*L_, expr_] /; FreeQ[a, D] :=
a*differentialOperate[L, expr]
differentialOperate[a : HoldPattern[D[] &], expr_] := a[expr]
differentialOperate[ncTimes[L1, L2_], expr_] :=
Expand[differentialOperate[L1, differentialOperate[L2, expr]]]
differentialOperate[L1_^n_Integer, expr_] /; n > 1 :=
Nest[Expand[differentialOperate[L1, #]] &, expr, n]
In[15]:= ddvar[x_, n_: 1] := D[#, {x, n}] &
Here are some of your examples, both from post and comments.
In[17]:= diffop =
ncTimes[(1 + ddvar[x] + ncTimes[x, ddvar[y, 2]])^2, (1 +
ncTimes[y, ddvar[y]])^2]
Out[17]= ncTimes[(1 + (D[#1, {x, 1}] & ) +
ncTimes[x, D[#1, {y, 2}] & ])^2,
(1 + ncTimes[y, D[#1, {y, 1}] & ])^2]
Apply this operator to f[x,y].
In[25]:= differentialOperate[diffop, f[x, y]]
Out[25]= f[x, y] + 3*y*Derivative[0, 1][f][x, y] +
9*Derivative[0, 2][f][x, y] +
18*x*Derivative[0, 2][f][x, y] + y^2*Derivative[0, 2][f][x, y] +
7*y*Derivative[0, 3][f][x, y] + 14*x*y*Derivative[0, 3][f][x, y] +
25*x^2*Derivative[0, 4][f][x, y] + y^2*Derivative[0, 4][f][x, y] +
2*x*y^2*Derivative[0, 4][f][x, y] +
11*x^2*y*Derivative[0, 5][f][x, y] +
x^2*y^2*Derivative[0, 6][f][x, y] + 2*Derivative[1, 0][f][x, y] +
6*y*Derivative[1, 1][f][x, y] + 18*x*Derivative[1, 2][f][x, y] +
2*y^2*Derivative[1, 2][f][x, y] +
14*x*y*Derivative[1, 3][f][x, y] +
2*x*y^2*Derivative[1, 4][f][x, y] + Derivative[2, 0][f][x, y] +
3*y*Derivative[2, 1][f][x, y] + y^2*Derivative[2, 2][f][x, y]
Those edge cases.
In[26]:= differentialOperate[ncTimes[1, 1], f[t]]
Out[26]= f[t]
We can declare a symbol to be scalar.
In[28]:= scalarQ[a] ^= True;
Now it will get pulled out as a simple multiplier.
In[29]:= differentialOperate[ncTimes[a, b], f[t]]
Out[29]= a b f[t]
---end edit---
Daniel Lichtblau
Wolfram Research