MathGroup Archive 2002

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

Search the Archive

RE: : Re: Help! How to calculate additive partitions?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg34526] RE: [mg34446] : Re: [mg34432] Help! How to calculate additive partitions?
  • From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
  • Date: Mon, 27 May 2002 01:15:55 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

Hi Bobby,

I'll answer your "serious question" at the bottom

> -----Original Message-----
> From: DrBob [mailto:majort at cox-internet.com]
To: mathgroup at smc.vnet.net
> Sent: Friday, May 24, 2002 4:45 AM
> 'mathgroup'
> Subject: [mg34526] RE: [mg34446] : Re: [mg34432] Help! How to calculate additive
> partitions?
> 
> 
> In addition to the fun, there's A SERIOUS QUESTION at the bottom of
> this!
> 
> I duplicated f1, f2, f3 below and added three more versions.  
> f4 is Bob
> Hanlon's simple algorithm:
> 
> Needs["DiscreteMath`Combinatorica`"];
> f4[n_Integer?Positive] :=
>   Flatten[Permutations /@ Partitions[n], 1]
> 
> Next is a version that uses MapThread.  It returns the same partitions
> in a different order.
> 
> f5[n_Integer] := Block[{f, h},
>     h = Function[{x, y}, {x, ##} & @@@ y];
>     f[0] = {{}};
>     f[m_] := f[m] =
>         Flatten[MapThread[h, {Reverse[Range[m]], f /@ 
> Range[0, m - 1]}],
> 1];
>     f[n] ]
> 
> Finally, here's a version that uses the Inner product, again returning
> the same partitions in a different order:
> 
> f6[n_Integer] := Block[{f, h},
>     h = Function[{x, y}, {x, ##} & @@@ y];
>     f[0] = {{}};
>     f[1] = {{1}};
>     f[2] = {{1, 1}, {2}};
>     f[m_] := f[m] = Inner[h, Reverse[Range[m]], f /@ Range[0, m - 1],
> Join];
>     f[n] ]
> 
> f1[21] // Length // Timing
> f2[21] // Length // Timing
> f3[21] // Length // Timing
> f4[21] // Length // Timing
> f5[21] // Length // Timing
> f6[21] // Length // Timing
> 
> {8.094 Second, 1048576}
> {56.734 Second, 1048576}
> {10.5 Second, 1048576}
> {2.266 Second, 1048576}
> {7.609 Second, 1048576}
> {7.485 Second, 1048576}
> 
> f5 and f6 have a small advantage over f1, probably because they avoid
> the needless counting involved in Table.  The built-in functions are
> faster... largely because they're built-in, I suspect.
> 
> HERE'S MY QUESTION.  In the definition of f6 I initialize 
> f[1] and f[2]
> explicitly.  This is because the algorithm doesn't work 
> otherwise!  The
> recursion works for n>2, but not n=1 and n=2.  WHY IS THAT?
> 
> I'm really missing some nuance of the Inner product.
> 
> Bobby Treat
> 
> -----Original Message-----
> From: Fred Simons [mailto:f.h.simons at tue.nl] 
To: mathgroup at smc.vnet.net
> Sent: Thursday, May 23, 2002 5:25 AM
> Subject: [mg34526] Re: [mg34446] : Re: [mg34432] Help! How to calculate additive
> partitions?
> 
> 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
> 
> 
> 

The answer is quite simple: Inner isn't that function you conceive it to be!
Terefor you chose it as the *wrong* function for your f6 (essentially a
rewrite of Fred's f1).

Look up in Help:

"Like Dot, Inner effectively contracts the last index of the first tensor
with the first index of the second tensor. Applying Inner to a rank r tensor
and a rank s tensor gives a rank r + s - 2 tensor."

Such observe: 
 
In[6]:= Inner[f, {a, b}, {1, 2}, g]
Out[6]= g[f[a, 1], f[b, 2]]

In[7]:= Inner[f, {{a, b}}, {{1}, {2}}, g]
Out[7]= {{g[f[a, 1], f[b, 2]]}}

In[8]:= Inner[f, {{a, b}}, {{{1}}, {{2}}}, g]
Out[8]= {{{g[f[a, 1], f[b, 2]]}}}

In[9]:= Inner[f, {{{a, b}}}, {{{1}}, {{2}}}, g]
Out[9]= {{{{g[f[a, 1], f[b, 2]]}}}}

or

In[10]:= Inner[f, {{a}, {b}}, {{1, 2}}, g]
Out[10]= {{g[f[a, 1]], g[f[a, 2]]}, {g[f[b, 1]], g[f[b, 2]]}}

In[11]:= Inner[f, {{{a}, {b}}}, {{{1, 2}}}, g]
Out[11]= {{{{g[f[a, 1]], g[f[a, 2]]}}, {{g[f[b, 1]], g[f[b, 2]]}}}}
 
consequently

In[12]:= Inner[f, {a}, {{}}, g]
Out[12]= {}

That kills your algorithm. What do you need instead?

 
In[3]:= Inner[f, {a, b}, {1, 2}, g]
Out[3]= g[f[a, 1], f[b, 2]]

In[4]:= g @@ Thread[f[{a, b}, {1, 2}]]
Out[4]= g[f[a, 1], f[b, 2]]

In[5]:= g @@ MapThread[f, {{a, b}, {1, 2}}]
Out[5]= g[f[a, 1], f[b, 2]]

MapThread and Thread don't have that undesired property of Inner:

In[23]:= g @@ Thread[f[{a}, {{}}]]
Out[23]= g[f[a, {}]]

In[24]:= g @@ MapThread[f, {{a}, {{}}}]
Out[24]= g[f[a, {}]]

Now you can redefine f6;

(1) Using Thread: 
We have to be a little cautious with early evaluation, therefore we
temporarily have to hold h, but Thread with evaluated arguments.
 
In[13]:=
f6bis[n_Integer] := Block[{f, h}, h = Function[{x, y}, {x, ##} & @@@ y];
    f[0] = {{}};
    f[m_] := 
      f[m] = With[{arg1 = Reverse[Range[m]], arg2 = f /@ Range[0, m - 1]}, 
          Join @@ Thread[Unevaluated[h[arg1, arg2]]]];
    f[n]]

In[14]:= f6bis[0]
Out[14]= {{}}
In[15]:= f6bis[1]
Out[15]= {{1}}
In[16]:= f6bis[2]
Out[16]= {{2}, {1, 1}}
In[17]:= f6bis[3]
Out[17]= {{3}, {2, 1}, {1, 2}, {1, 1, 1}}


(2) MapThread (is somewhat easier):
 
In[18]:=
f6bis2[n_Integer] := Block[{f, h}, h = Function[{x, y}, {x, ##} & @@@ y];
    f[0] = {{}};
    f[m_] := 
      f[m] = Join @@ MapThread[h, {Reverse[Range[m]], f /@ Range[0, m -
1]}];
    f[n]]

In[19]:= f6bis2[0]
Out[19]= {{}}
In[20]:= f6bis2[1]
Out[20]= {{1}}
In[21]:= f6bis2[2]
Out[21]= {{2}, {1, 1}}
In[22]:= f6bis2[3]
Out[22]= {{3}, {2, 1}, {1, 2}, {1, 1, 1}}

--
Hartmut



  • Prev by Date: RE: : Re: Help! How to calculate additive partitions?
  • Next by Date: Re: Why do parentheses spuriously appear when I type in a formula?
  • Previous by thread: RE: : Re: Help! How to calculate additive partitions?
  • Next by thread: How to call Mathematica in VB?