Re: monomials in Graded Lexicographic Order and associated

*To*: mathgroup at smc.vnet.net*Subject*: [mg73810] [mg73810] Re: [mg73787] monomials in Graded Lexicographic Order and associated*From*: Daniel Lichtblau <danl at wolfram.com>*Date*: Fri, 2 Mar 2007 06:03:57 -0500 (EST)*References*: <200702280937.EAA24658@smc.vnet.net>

er wrote: > hi, > > i just want to share my code below and ask for any suggestion to speed > up the function FactorialList below, > which takes up about as much time to complete as PowerList, mostly due > to function aux. storing a table of values to avoid repeated > computation seems to be the easiest solution. however, i'm hoping to > avoid that, perhaps by exploiting the particular GLO structure. > thanks. > > here's the usage i'm interested in: "PowerList[GDO,max,{x1,...,xD}] > returns { {{x1\^p1*...*xD^pD:|p|=q},q=0,...,max } where |p|=p1+...+pD; > FactorList[GDO,D,max] returns the corresponding mv-factorial terms: > { {p1!*...*pD!:|p|=q},q=0,...,max }", e.g. > > In[1] := PowerList[GLO, 2, {a, b, c}] > FactorialList[GLO, d, 2] > Out[2] = {{1}, {a, b, c}, {a ^ 2, a b, a c, b^ 2, b c, c^ 2}} > Out[2] = {{1}, {1, 1, 1}, {2, 1, 2, 1, 1, 2}} > > code: > GLO/:PowerList[GLO,0,vars_]:={{1}}; > GLO/:PowerList[GLO,p_,vars_]:=With[{rev=Reverse[vars]}, Join[{{1}}, > Flatten/@Map[Reverse, NestList[rev*Flatten/ > @foldList[#]&,List/@rev,p-1],2]] ]; > GLO/: FactorialList[GLO,d_,p_]:=Map[Times@@Factorial[#]&,aux[d,p],{2}]; This code is missing some parts, for example the definitions of foldList and aux. Anyway, I'd instead use a certain internal function. The idea is (1) Form sums of powers of the sum of the variables. (2) Form a sparse distributed representation of said sum with respect to an appropriate term order. (3) Generate both lists in one go from that representation. powerList[n_Integer, vars_List] /; n>=0 := Module[ {terms=Apply[Plus,vars], dtl, newv, plist, flist}, dtl = Internal`DistributedTermsList[ Sum[terms^j,{j,0,n}], Reverse[vars], MonomialOrder->DegreeLexicographic]; newv = Last[dtl]; dtl = Split[Reverse[First[dtl]], Total[#1[[1]]]==Total[#2[[1]]]&]; plist = Map[Apply[Times,newv^#[[1]]]&, dtl, {2}]; flist = Map[Apply[Times,Factorial[#[[1]]]]&, dtl, {2}]; {plist, flist} ] In[4]:= InputForm[powerList[2, {a,b,c}]] Out[4]//InputForm= {{{1}, {a, b, c}, {a^2, a*b, b^2, a*c, b*c, c^2}}, {{1}, {1, 1, 1}, {2, 1, 2, 1, 1, 2}}} To give some idea of speed or lack thereof, here is how it handles a list of eight variables, to power 8. In[6]:= Timing[{pl88,fl88} = powerList[8,vars];] Out[6]= {0.920057 Second, Null} In[7]:= LeafCount[pl88] Out[7]= 163824 In[8]:= LeafCount[fl88] Out[8]= 12880 Daniel Lichtblau Wolfram Research