Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: monomials in Graded Lexicographic Order and associated factorials

  • To: mathgroup at smc.vnet.net
  • Subject: [mg73820] [mg73820] Re: [mg73787] monomials in Graded Lexicographic Order and associated factorials
  • From: "erwann rogard" <erwann.rogard at gmail.com>
  • Date: Fri, 2 Mar 2007 06:09:18 -0500 (EST)

hi,

thank you for clarifying Internal`DistributedTermsList. here's my complete
code, with the example revisited and a few remarks.

- complete code:
Needs /@ {"DiscreteMath`Combinatorica`"}
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}];
foldList[vec_]:=FoldList[List,First[vec],Rest[vec]];
aux[d_,p_]:=Map[Reverse[Sort[#]] &, Compositions[#, d] & /@ Range[0, p],
{1}];

- example revisited:
SeedRandom[0]
rand = Array[Random[] &, {8}];
vars = Table[var[i], {i, 1, 8}];
tmp = powerList[8, vars]; // Timing
tmp[[1]] /. MapThread[Rule, {vars, rand}]; // Timing
PowerList[GLO, 8, rand]; // Timing
FactorialList[GLO, 8, 8]; // Timing
Out[35]=
{1.15607 Second,Null}
Out[36]=
{0.16001 Second,Null}
Out[37]=
{0.008001 Second,Null}
Out[38]=
{0.984061 Second,Null}

if flist = ... is ommited from the definition of powerList, subtract
0.15Second from Out[35]

- remarks:
1) i think the speed gap between PowerList and powerList is due to the fact
that the former does not only return the monomials in graded lexicographic
order but actually exploits that particular structure for speed up.
2) factorials takes up almost all the computation time: 0.984/(0.984+0.008),
which is my main problem.
3) also i would rather compute factorials separately from the powers so i
can  do Total[PowerList[__,#]&/@mat] / Factorials[__].

any suggestion would be welcomed,

thanks,

e.

On 2/28/07, Daniel Lichtblau <danl at wolfram.com> wrote:
>
> 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
>
>
>
>


  • Prev by Date: Re: Re: Re: Hold and Equal
  • Next by Date: Re: Numerical integration
  • Previous by thread: Re: monomials in Graded Lexicographic Order and associated factorials
  • Next by thread: Re: Dll problem