Re: nested * and ** (rules for commutative quantities)
- To: mathgroup at smc.vnet.net
- Subject: [mg7709] Re: nested * and ** (rules for commutative quantities)
- From: Dick Zacher <dick at loc3.tandem.com>
- Date: Wed, 2 Jul 1997 14:21:29 -0400 (EDT)
- Organization: Tandem Computers
- Sender: owner-wri-mathgroup at wolfram.com
Marlies Brinksma wrote:
> I have a set of operators (let's call them Op[index_,arg2_]).
> Two of these operators commute when their indices are different and they are
> noncommutative otherwise. All operators commute with any scalar quantity.
>
> I would like to define some rules such that expressions like:
>
> Op[3,a] ** Op[2,v] ** 4 ** Op[6,s] ** Op[2,x] ** Op[1,t]
>
> will be automatically changed to:
>
> Times[4, Op[1,t],NonCommutativeMultiply[Op[2,v],Op[2,x]],Op[3,a],Op[6,s]]
>
> It seems to be very simple but I just cannot come to a set of rules which are
> general enough and don't lead to infinite recursion.
First Observation: There is a rather substantial noncommutative algebra
package, NCAlgebra, available on MathSource, complete with 104 pages of
documentation. I haven't used it, as this is out of my area of interest,
but it looks promising.
Second Observation: This problem is harder than it appears to be!
Below is my own brief solution to the problem you posed. It seems to
give the right behaviour, but it is excruciatingly slow for products
with many factors. For example, a product with 10 factors took 92
seconds on a SPARCstation 20. This has given me a renewed appreciation
for the efficiency of Mathematica's built-in algorithms for dealing with
commutative multiplication.
(* Define a test for whether factors commute *)
SetAttributes[commutingQ,Orderless]
(* The first rule is specific to the problem at hand *)
commutingQ[Op[i_,_],Op[j_,_]]:=True/;i=!=j
(* The remaining rules for commutingQ are general *)
commutingQ[a_?NumericQ,b_]:=True
commutingQ[a_,a_]:=True
commutingQ[Power[a_,_],b_]:=True/;commutingQ[a,b]
commutingQ[a_*b_,c_]:=True/;commutingQ[a,c]&&commutingQ[b,c]
commutingQ[a_**b_,c_]:=True/;commutingQ[a,c]&&commutingQ[b,c]
(* We also need rules for NonCommutativeMultiply *)
protectedSymbols=Unprotect[NonCommutativeMultiply];
a_**b_:=a*b/;commutingQ[a,b]
(a_*b_)**c_:=a*(b**c)/;commutingQ[a,c]
a_**(b_*c_):=c*(a**b)/;commutingQ[a,c]
(a_*b_)**(c_*d_):=(a**c)*(b**d)/;commutingQ[a,d]&&commutingQ[b,c]
Protect[Evaluate[protectedSymbols]];
Timing[Op[i,x]**Op[j,y]**3**Op[i,t]**Op[j,w]**Op[i,t]**Op[i,r]**Op[l,e]
//FullForm]
{92.41 Second,
Times[3,NonCommutativeMultiply[Op[j,y],Op[j,w]],
NonCommutativeMultiply[Op[i,x],Power[Op[i,t],2],Op[i,r]],Op[l,e]]}
InputForm[Last[%]]
FullForm[3*Op[j, y]**Op[j, w]*Op[i, x]**Op[i, t]^2**Op[i, r]*Op[l, e]]
Timing[Op[3,a] ** Op[2,v] ** 4 ** Op[6,s] ** Op[2,x] ** Op[1,t]]
{1.6 Second,4 Op[2,v]**Op[2,x] Op[1,t] Op[3,a] Op[6,s]}
In judging the correctness of the above results, keep in mind that
NonCommutativeMultiply has higher precedence than Times.
--
-----------------------------
Dick Zacher
Performance Engineering Dept., Tandem Computers
zacher_dick at tandem.com phone: 408-285-5746 fax: 408-285-7079