Re: : Re: Help! How to calculate additive partitions?
- To: mathgroup at smc.vnet.net
- Subject: [mg34524] Re: [mg34446] : Re: [mg34432] Help! How to calculate additive partitions?
- From: Andrzej Kozlowski <andrzej at platon.c.u-tokyo.ac.jp>
- Date: Fri, 24 May 2002 02:42:49 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
Here is another (fairly slow) version. Originally I decided not to
send it because it was much slower than Bob Hanlon's solution, but now
that we have chosen variety over efficiency I thought it might be of
interest to add it to the list:
In[1]:=
f[n_,k_]:=Block[{l=Table[Unique[x],{k}],m,p},m=Pattern[#,BlankSequence[]]&/@
l;
p=Partition[l,1];
Map[Length,
ReplaceList[Table[1,{n}],Dispatch[Thread[Unevaluated[m->p]]]],{2}]]
In[2]:=
myPartitions[n_]:=Join@@Table[f[n,k],{k,1,n}]
In[3]:=
myPartitions[6]
Out[3]=
{{6},{1,5},{2,4},{3,3},{4,2},{5,1},{1,1,4},{1,2,3},{2,1,3},{1,3,2},{2,2,2}
,{3,
1,2},{1,4,1},{2,3,1},{3,2,1},{4,1,1},{1,1,1,3},{1,1,2,2},{1,2,1,2},{2,1,1,
2},{1,1,3,1},{1,2,2,1},{2,1,2,1},{1,3,1,1},{2,2,1,1},{3,1,1,1},{1,1,1,1,
2},{1,1,1,2,1},{1,1,2,1,1},{1,2,1,1,1},{2,1,1,1,1},{1,1,1,1,1,1}}
(Probably using Dispatch here is only good "in theory". It should speed
up the execution for very large n, but in practice when the size of n is
large enough for this to begin tp play a role the size of the solution
will make it impractical to use any implementation.)
On Thursday, May 23, 2002, at 07:24 PM, Fred Simons wrote:
> Just for fun, as in Hartmut's mail, some additional remarks.
>
> The solution given by Bob Hanlon and Murray Eisenberg by first
> computing all
> ordered partitions and then the permutations of each of these is no
> doubt
> the fastest way. So let us go to the immediate constructions. My own
> solution was
>
> In[1]:=
> f[0]={{}};
> f[n_Integer] := f[n] = Flatten[Table[{k, ##}& @@@ f[n-k], {k, 1, n}], 1]
>
> Indeed I left out the direct assignment in the indirect assignment,
> thereby
> producing an inefficient function for larger n. I had the idea that this
> function was only to be used for small n. That is not a good argument
> and
> Bobby Treat is quite right by pointing that out. In the sequel I will
> use a
> variant to enable comparisons:
>
> In[3]:=
> f1[n_Integer] := Block[{f},
> f[0]={{}};
> f[m_] :=f[m] = Flatten[Table[{k, ##}& @@@ f[m-k], {k, 1, m}], 1];
> f[n] ]
>
> Rob Pratt mentioned an elegant technique for proving that for each n the
> problem has 2^(n-1) solutions and also implemented it. Hartmut Wolf gave
> another ingenious implementation:
>
> In[8]:=
> f2[n_] := Map[Length,
> Split[#, #2\[Equal]0&]& /@
> Table[IntegerDigits[ k, 2, n], {k, 0, 2^(n-1)-1}], {2}]
>
> Here I give a third implementation of the same idea. We start with the
> number 1. Then we have to decide whether we want to place a marker or
> not.
> When we place a marker, the first number of the solution will be 1 and
> the
> second at least 1; when we do not place a marker, the first number is at
> least 2. Continuing in this way, we construct the solutions step by
> step by
> either increasing the last number or appending a number 1.
>
> In[12]:=
> f3[n_Integer] := Block[{g1, g2},g1[{x___, y_}]:= {x, y+1};
> g2[{x__}]:={x,
> 1};
> Nest[ Join[ g1 /@ #, g2 /@ #]&, {{1}}, n-1] ]
>
> Now we compare these functions:
>
> In[34]:=
> f1[17]// Length // Timing
> f2[17]// Length // Timing
> f3[17]// Length // Timing
> Out[34]=
> {1.81 Second,65536}
> Out[35]=
> {14.01 Second,65536}
> Out[36]=
> {2.91 Second,65536}
>
> I think the difference in timing is due to the size of the intermediate
> results. In function f1 these are slightly smaller than in function f3,
> while function f2 start with a huge structure to arrive at the desired
> result. When we first compute the ordered partitions and then the
> permutations, the intermediate expressions are still considerably
> smaller.
>
> Fred Simons
> Eindhoven University of Technology
>
>
>
Andrzej Kozlowski
Toyama International University
JAPAN
http://platon.c.u-tokyo.ac.jp/andrzej/