       Re: Commutators and Operator Powers in Mathematica

• To: mathgroup at smc.vnet.net
• Subject: [mg16849] Re: [mg16635] Commutators and Operator Powers in Mathematica
• From: Daniel Lichtblau <danl>
• Date: Thu, 1 Apr 1999 21:35:22 -0500
• References: <199903191753.MAA09744@smc.vnet.net.>
• Sender: owner-wri-mathgroup at wolfram.com

```Alan Lewis wrote:
>
> I am looking for any links or suggestions on implementing
> commutation relations  and powers of differential operators
> in mathematica.
>
> As an example, I have two operators L0 and L1 that act on arbitrary
> (well say infinitely differentiable) functions f[x]
>
>  L0 simply multiplies f[x] by x.
>  L1  = a x^(3/2) D[f[x],x] + b x^2 D[f[x],{x,2}]
>
> where a,b are constants independent of x. The second line is not
> meant to be working math. code but is just meant to explain the action
> of this differential operator.
>
> Now what I want to do is be able to evaluate repeated commutators
> and powers of these operators. For example, the first commutator
> should evaluate to:
>
> [L0,L1]f[x] = x L1 f[x] - L1 (x f[x]) =
>
>              -a x^(3/2) f[x] - 2 b x^2 D[f[x],x]
>
> I would also like to evaluate powers such as
> L1^n, meaning the operator acts on f[x] n times. Repeated
> commutators are expressions like
>
> [L1,[L0,L1]] or [L0,[L0,L1]], etc.
>
> The action of L1 is just an example, but the general class of operators
> I am interested in are always the sum of a first and second derivative
> with simple expressions like the above in front of the derivative.
> And L0 is always multiplication by x.
>
> Thanks in advance for any suggestions,
> Alan

My last response left alot to be desired. After some clean-up by myself
and a couple of rounds back and forth with Andrzej Kozlowski, who found
and repaired at least one bug and pointed out some other issues, I have
a cleaner version prepared.

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[L1__ ** L2_, expr_] :=
Expand[differentialOperate[L1,differentialOperate[L2,expr]]]
commutator[L1_, L2_] := L1 ** L2 - L2 ** L1
differentialOperate[L1_^n_Integer, expr_] /; n>1 :=
Nest[Expand[differentialOperate[L1,#]]&, expr, n]

One can easily modify this to handle different commutator relations, I
just included the one most commonly used.

Here is an example from a sci.math.symbolic question last year that
prompted the earlier version of the code.

In:= ddt = (D[#,t] &);

In:= diffop = (t**ddt - a) ** (t**ddt - b) ** (t**ddt - a);

In:= differentialOperate[diffop, f[t]]

2                                    2
Out= -(a  b f[t]) + t f'[t] - 2 a t f'[t] + a  t f'[t] - b t f'[t] +

2               2             2           3  (3)
>    2 a b t f'[t] + 3 t  f''[t] - 2 a t  f''[t] - b t  f''[t] + t  f   [t]

Here are the examples from this post. One can of course play around with
e.g. Expand, Together, Collect, and Simplify to do all manner of
regrouping.

In:= L0 = x;

In:= ddx = (D[#,x] &);

In:= L1 = a*x^(3/2)*ddx + b*x^2*ddx^2;

In:= differentialOperate[commutator[L0,L1], f[t,x]]

3/2                 2  (0,1)
Out= -(a x    f[t, x]) - 2 b x  f     [t, x]

In:= differentialOperate[L1^2, f[t,x]]

3/2  (0,1)            2  2  (0,1)
3 a b x    f     [t, x]   3 a  x  f     [t, x]
Out= ----------------------- + -------------------- +
4                       2

2  2  (0,2)                5/2  (0,2)          2  3  (0,2)
>    2 b  x  f     [t, x] + 5 a b x    f     [t, x] + a  x  f     [t, x] +

2  3  (0,3)                7/2  (0,3)          2  4  (0,4)
>    4 b  x  f     [t, x] + 2 a b x    f     [t, x] + b  x  f     [t, x]

Andrzej noted that one might prefer to work with pure functions. I show
by example how that may be done using this code. It is a bit awkward due
to inability to nest functions with anonymous variables (cannot scope
the '#' symbols).

In:= L0 = Function[{x}, x]; (* or could use #& *)

In:= L1 = Function[{x}, a*x^(3/2)*(D[#,x]&) + b*x^2*(D[#,x]&)^2];

In:= differentialOperate[commutator[L0[t], L1[t]], f[s,t]]

3/2                 2  (0,1)
Out= -(a t    f[s, t]) - 2 b t  f     [s, t]

In:= differentialOperate[L1[t]^2, f[t,x]]

3/2  (1,0)            2  2  (1,0)
3 a b t    f     [t, x]   3 a  t  f     [t, x]
Out= ----------------------- + -------------------- +
4                       2

2  2  (2,0)                5/2  (2,0)          2  3  (2,0)
>    2 b  t  f     [t, x] + 5 a b t    f     [t, x] + a  t  f     [t, x] +

2  3  (3,0)                7/2  (3,0)          2  4  (4,0)
>    4 b  t  f     [t, x] + 2 a b t    f     [t, x] + b  t  f     [t, x]

Daniel Lichtblau
Wolfram Research

```

• Prev by Date: Re: controlling the size of tick marks
• Next by Date: binomial distribution
• Previous by thread: Re: controlling the size of tick marks
• Next by thread: binomial distribution