Re: monomials in Graded Lexicographic Order and associated factorials
- To: mathgroup at smc.vnet.net
- Subject: [mg73808] Re: monomials in Graded Lexicographic Order and associated factorials
- From: "er" <erwann.rogard at gmail.com>
- Date: Thu, 1 Mar 2007 06:09:17 -0500 (EST)
- References: <es3ja3$ogi$1@smc.vnet.net>
hi, i've added the complete corrected code below as i'm told it wasnt.
it also appears that Internal`DistributedTermList would be helful. Is
this feature only for v 5.2? thanks.
In[2]:=
PowerList[GLO,3,{a,b,c}]
Out[2]=
\!\({{1}, {a, b, c}, {a\^2, a\ b, a\ c, b\^2, b\ c, c\^2}, {a\^3, a
\^2\ b,
a\^2\ c, a\ b\^2, a\ b\ c, a\ c\^2, b\^3, b\^2\ c, b\ c\^2, c
\^3}}\)
In[11]:=
FactorialList[GLO,d,3]
Out[11]=
{{1},{1,1,1},{2,1,1,2,1,2},{6,2,2,2,1,2,6,2,2,6}}
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]];
With[{ maxD=5, maxP},
GLO::max="either p=`1` or d=`2` are greater than package defined
maximums:"<>ToString[maxD]<>" and "<>ToString[maxP];
Table[aux[d]=Map[Reverse[Sort[#]] &, Compositions[#, d] & /@ Range[0,
maxP], {1}],{d,1,maxD}];
aux[d_/;d<=maxD,p_/;p<=maxP]:=Take[aux[d],p+1];
aux[d_,p_]:=(Message[GLO::max,d,p];$Failed);
];
On Feb 28, 4:50 am, "er" <erwann.rog... at gmail.com> 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}];