       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 := PowerList[GLO, 2, {a, b, c}]
> FactorialList[GLO, d, 2]
> Out = {{1}, {a, b, c}, {a ^ 2, a b, a c, b^ 2, b c, c^ 2}}
> Out = {{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[]]==Total[#2[]]&];
plist = Map[Apply[Times,newv^#[]]&, dtl, {2}];
flist = Map[Apply[Times,Factorial[#[]]]&, dtl, {2}];
{plist, flist}
]

In:= InputForm[powerList[2, {a,b,c}]]

Out//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:= Timing[{pl88,fl88} = powerList[8,vars];]
Out= {0.920057 Second, Null}

In:= LeafCount[pl88]
Out= 163824

In:= LeafCount[fl88]
Out= 12880

Daniel Lichtblau
Wolfram Research

```

• Prev by Date: Re: Re: Re: Hold and Equal
• Next by Date: Re: Overlaying a grid on graphics to guide placement
• Previous by thread: Re: monomials in Graded Lexicographic Order and associated
• Next by thread: Problems with simplify and Sqrt[a^2]