A function which maps $(ax + by)(cx + dy) \mapsto (a \partial_x + b \partial_y) (c \partial_x + d \partial_y)$

Question

I am new to Mathematica and, as the title says, looking for a way of mapping (for example) the polynomial $$(ax + by)(cx + dy) \mapsto \left(a \frac{\partial}{\partial x} + b \frac{\partial}{\partial y}\right) \left(c \frac{\partial}{\partial x} + d \frac{\partial}{\partial y}\right) \\ = ac \frac{\partial^2}{\partial_x^2} + (ac + bd) \frac{\partial}{\partial_x}\frac{\partial}{\partial_y} + bd \frac{\partial^2}{\partial_y^2},$$ where the latter operator operates on some predefined function. The $\{a,b,c,d\}$ are constants.

Of course this is simple to do by hand in the case shown above, but I will need to be doing this for rather large polynomials where the manual way is not possible. A systematic approach of some kind would be appreciated.

Thanks to anyone who can help me.

Answer 1

Maybe something like the following:

L /: L[x___]L[y___] := Sort @ L[x,y]
L /: Power[L[x__], n_Integer?Positive] := L @@ Flatten @ ConstantArray[{x}, n]

toOperator[expr_, var_] := With[
    {op = Collect[expr /. v:var->L[v], _L] /. L[x__] -> Inactive[D][#, x]},
    Activate @ Function @ op
]

For the OP example:

toOperator[(a x + b y)(c x + d y), x|y] //TeXForm

$(a d+b c) \frac{\partial ^2\text{$\#$1}}{\partial x\, \partial y}+a c \frac{\partial ^2\text{$\#$1}}{\partial x\, \partial x}+b d \frac{\partial ^2\text{$\#$1}}{\partial y\, \partial y}\&$

Answer 2

I have one solution.

ClearAll[PolyMap];
PolyMap[p1_ + p2_, vars_] /; (PolynomialQ[p1, vars] && PolynomialQ[p2, vars]) :=  PolyMap[p1, vars] + PolyMap[p2, vars];
PolyMap[a_, vars_] /; VectorQ[vars, ! MemberQ[a, #, Infinity] &] := a*# &;
PolyMap[a_*x_, vars_] /; (VectorQ[vars, ! MemberQ[a, #, Infinity] &] && MemberQ[vars, x]) := a D[#, x] &;
PolyMap[a_*x_^n_, vars_] /; (IntegerQ@n && n > 0 && MemberQ[vars, x] && VectorQ[vars, ! MemberQ[a, #, Infinity] &]) := a*D[#, {x, n}] &;
PolyMap[a_*x_,vars_] /; (PolynomialQ[a x, vars] && MemberQ[vars, x]) := D[#, x] &@*PolyMap[a, vars];
PolyMap[a_*x_^n_, vars_] /; (PolynomialQ[a x^n, vars] && IntegerQ@n && n > 0&& MemberQ[vars, x]) := D[#, {x, n}] &@*PolyMap[a, vars];

Here is an Example:

PolyMap[a x^2 + b x y^4 + c + c/d x y, {x, y}]

It looks a little of ugly, but it works:

PolyMap[a x^2 + b x y^4 + c + c/d x y, {x, y}][x^3 y^3 z^3] // Through
(*(9 c x^2 y^2 z^3)/d + 6 a x y^3 z^3 + c x^3 y^3 z^3*)