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