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

RE: A friendly challenge: Generalized Partition

• To: mathgroup at smc.vnet.net
• Subject: [mg34924] RE: [mg34858] A friendly challenge: Generalized Partition
• From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
• Date: Thu, 13 Jun 2002 02:38:12 -0400 (EDT)
• Sender: owner-wri-mathgroup at wolfram.com

> -----Original Message-----
> From: gleam at flashmail.com [mailto:gleam at flashmail.com]
To: mathgroup at smc.vnet.net
> Sent: Tuesday, June 11, 2002 11:00 AM
> Subject: [mg34924] [mg34858] A friendly challenge: Generalized Partition
> 
> 
> In the 4.1 help browser, in Further Examples under Take, there is code
> for a generalized partition function, called gg.  This code is
> somewhat long and extremely slow.  I challenge you to duplicate the
> functionality of this code (ignoring the ggCheckArgs condition), while
> making it 1) as sort as possible, and/or 2) as fast as possible.
> 
> Your function must be in good form, leaving no stray assignments, i.e.
> using the appropriate scoping construct(s).
> 
> For efficiency testing, I will use (where func is your function):
> 
> a = Range[2000];
> b = Table[Random[Integer, {1, 20}], {150}];
> First[Timing[Do[func[a, b], {100}]]]
> 
> I will post my versions after a little while.  For reference, on my
> machine, the function from the help files, omitting the ggCheckArgs
> condition, takes 8 seconds; my fastest version takes 0.33 seconds.  My
> shortest version is 44 characters in length, and takes 0.94 seconds.
> 
> Good luck!
> 
> Paul
> 
> 

Paul,

perhaps it would have been better to put your cards onto the table -- and I
hope that you not only do perfect testing (the proposal above isn't, first
because ggCheckArgs is striktly needed in these cases, second you should
allow 0 in b, third you should test for the algorithmic complexity; this is
only an arbitrary snapshot!) but also I hope you give an analysis of the
different algorithms giving the causes why one or the other algorithm is
superior, and when.

Now considering the example in Help:

In[2]:= s = {a, b, c, d, e, f, g, h, i, j};
In[3]:= t = {2, 3, 0, 4, 1};
 
In[4]:=
ggCheckArgs[s_, t_] := 
  Head[s] === List && VectorQ[t, Head[#] === Integer && # >= 0 &] && 
    Plus @@ t <= Length[s]

In[5]:=
gg[s_, t_] /; ggCheckArgs[s, t] := 
  First /@ Rest[FoldList[Through[{Take, Drop}[#1[[2]], #2]] &, {{}, s}, t]]

I like this algorithm, because it has a clear idea and gives a direct of it.
This is all that should be requested from an example.

Look at the kernel of this algorithm:

In[6]:=
FoldList[Through[{Take, Drop}[#1[[2]], #2]] &, {{}, s}, t]
Out[6]= {{{}, {a, b, c, d, e, f, g, h, i, j}}, 
         {{a, b}, {c, d, e, f, g, h, i, j}}, 
         {{c, d, e}, {f, g, h, i, j}}, 
         {{}, {f, g, h, i, j}}, 
         {{f, g, h, i}, {j}}, 
         {{j}, {}}}

Isn't this pretty?

Here a mild variation:

In[7]:= Remove[ggCheckArgs]
In[8]:=
ggCheckArgs[s_List, {tt__Integer?NonNegative}] := Plus[tt] <= Length[s]
In[9]:=
gg[s_, t_] /; ggCheckArgs[s, t] := 
  Rest[FoldList[Through[{Take, Drop}[#1[[2]], #2]] &, {{}, s}, t]][[All, 1]]

In[10]:= gg[s, t]
Out[10]=
{{a, b}, {c, d, e}, {}, {f, g, h, i}, {j}}
 

No some work for you:

In[13]:= gg0[s_, t_] := 
  Module[{r = {}}, Fold[(AppendTo[r, Take[#1, #2]]; Drop[#1, #2]) &, s, t];
r]

(another mild variation of gg)

 

In[15]:= gg1[s_, t_] :=
  Module[{l = FoldList[Plus, 1, t]},
    Take[s, #] & /@ Transpose[{Drop[l, -1], Drop[l - 1, 1]}]
    ]
 


In[17]:= Off[Take::"seqs"]
In[18]:= gg2[s_, t_] :=
  Module[{l = FoldList[Plus, 1, t]},
    Thread[Take[s, Transpose[{Drop[l, -1], Drop[l - 1, 1]}]], List, -1]
    ]


 
In[20]:= On[Take::"seqs"]
In[21]:= gg3[s_, t_] :=
  Module[{l = FoldList[Plus, 1, t]},
    With[{r = Transpose[{Drop[l, -1], Drop[l - 1, 1]}]}, 
      Thread[Unevaluated[Take[s, r]], List, -1]]
    ]

 

In[23]:= gg4[s_, t_] := Module[{c = 0},
    Map[Take[s, {c + 1, c = c + #}] &, t]]

 

In[25]:= gg5[s_, t_] := Module[{c = 0},
    MapThread[Take[#2, {c + 1, c = c + #1}] &, {t, Table[s, {Length[t]}]}]]

 

In[27]:= gg6[s_, t_] := Module[{c = 0, f},
    Thread[f[s, t], List, -1] /. f -> (Take[#1, {c + 1, c = c + #2}] &)]

 

In[29]:= gg7a[s_, t_] := 
  Module[{c1, c2 = 1, c3 = 1, e2 = Length[t], r, h, rr}, rr = h[];
    While[c2 < e2, c1 = t[[c2++]]; r = {}; 
      While[c1-- > 0, r = {r, s[[c3++]]}]; rr = h[rr, r]]; 
    List @@ Flatten /@ Flatten[rr, Infinity, h]]

 
In[33]:= gg7c[s_, t_] := 
  Module[{c1, c2 = 1, c3 = 1, e2 = Length[t], r, h, rr = {}},
    While[c2 < e2, c1 = t[[c2++]]; r = h[]; 
      While[c1-- > 0, r = h[r, s[[c3++]]]]; 
      rr = {rr, Flatten[r, Infinity, h]}]; Flatten[rr] /. h -> List]

 

In[35]:= gg8c[s_, t_] := 
  Module[{c1, c3 = 1, r, h, rr = {}},
    Scan[(c1 = #; r = h[]; While[c1-- > 0, r = h[r, s[[c3++]]]]; 
          rr = {rr, Flatten[r, Infinity, h]}) &, t]; Flatten[rr] /. h ->
List]

 

In[42]:= gg8e[s_, t_] := Module[{c1, c3 = 1, r, h, rr = Sequence[]},
    Scan[(c1 = #; r = h[]; While[c1-- > 0, r = h[r, s[[c3++]]]]; 
          rr = h[rr, {r}]) &, t]; Block[{h = Sequence}, {rr}]]

 

In[53]:= gg9b[s_, t_] := 
  With[{ll = Range[Length[t]]}, 
    Cases[
      Transpose[{Flatten[Table[#,{t[[#]]}]&/@ll], s}],{#, e_}:>e]&/@ll]
 


In[58]:= gg10[s_, t_] := 
  With[{pp = Table[Unique[Unevaluated[p]], {#}] & /@ t}, 
    Replace[s, Pattern[#, Blank[]] & /@ Flatten[pp] -> pp]]

(This possibly will not work with your generated test data, but it is
obvious, how to repair it! (It works with s and t above).)


 
In[64]:= gg11x[s_, t_] := 
  Flatten /@ 
    Split[Insert[s, {}, List /@ Rest[FoldList[Plus, 1, t]]], #1 =!= {} &]

 


In[68]:= gg11[s_, t_] := 
  ReleaseHold[
    Split[Insert[s, Hold[], 
        List /@ Rest[FoldList[Plus, 1, t]]], #1 =!= Hold[] &]]


There are a thousend more variations. Good luck!

--
Hartmut