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[8]:= ddt = (D[#,t] &);
In[9]:= diffop = (t**ddt - a) ** (t**ddt - b) ** (t**ddt - a);
In[10]:= differentialOperate[diffop, f[t]]
2 2
Out[10]= -(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[11]:= L0 = x;
In[12]:= ddx = (D[#,x] &);
In[13]:= L1 = a*x^(3/2)*ddx + b*x^2*ddx^2;
In[14]:= differentialOperate[commutator[L0,L1], f[t,x]]
3/2 2 (0,1)
Out[14]= -(a x f[t, x]) - 2 b x f [t, x]
In[15]:= 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[15]= ----------------------- + -------------------- +
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[24]:= L0 = Function[{x}, x]; (* or could use #& *)
In[25]:= L1 = Function[{x}, a*x^(3/2)*(D[#,x]&) + b*x^2*(D[#,x]&)^2];
In[26]:= differentialOperate[commutator[L0[t], L1[t]], f[s,t]]
3/2 2 (0,1)
Out[26]= -(a t f[s, t]) - 2 b t f [s, t]
In[27]:= 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[27]= ----------------------- + -------------------- +
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