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