How to take a list and generate all lists of increasing length?

Question

Any simple question for Mathematica experts:

Given the list, let's say

Clear[a, b, c]; data = {a, b, c}; 

and I want to return all lists of length 1,2,3,...Length[data] , from the beginning to the end, so that I get the following for the above

 out = {{a}, {a, b}, {a, b, c}} 

I looked at the commands in M ​​to find ready to use, and I could (looked at all the Map and Nest * functions, but not that I could see how to use for this). I am sure that he is, but I do not see him now.

now i am doing this stupid Do loop to build it

 m=Length[data]; First@Reap [Do[Sow[data[[1;;i]]],{i,1,m}]][[2]] {{a},{a,b},{a,b,c}} 

Q: Does Mathematica have a build command to do the above?

8am update

I deleted the tests that I worked an hour ago and will resubmit them soon. I need to run them several times and take an average value, as this is the best way to run this performance test.

9am update

Ok, I ran the performance tests again for all the solutions shown below. 8 methods. For each method, I run it 5 times and accept the average value. I did this for n={1000, 5000, 10000, 15000, 25000, 30000} , where n is the length of the original list to process.

cannot move more than 30,000, the ram will be exhausted. I have only 4 GB of RAM.

I made a small function called makeTable[n, methods] that generates a performance table for a specific n . the test code is below (quickly written, therefore not the cleanest code, not very functional as I need to go :), but it is lower, and anyone can change / clear it, etc. if they want

conclusion: the Kguler method was the fastest, while the Thies method is almost the same for large n (30,000), so for all practical purposes, can the Thies and Kguler methods be declared winners for large n? But since Kguler is also the fastest for small n, it still gets a clear advantage.

Again, the test code below is for anyone who can test and run to see if I can make a mistake somewhere. As Leonid correctly predicted, the linked list method did not burn too well for large n.

I think more tests are needed, as it may not be enough just an average of 5, as well as other considerations that I might have missed. This is not an exact test, just rude to get an idea.

I tried not to use the computer while running the tests. I used AbsoluteTiming [] to measure cpu.

Here is a screenshot of the created tables

Here is the test code:

 methods = {nasser, wizard1, wizard2, wizard3, kguler, leonid1, leonid2, thies}; AppendTo[$ContextPath, "Internal`"]; ClearAll[linkedList, leonid2]; SetAttributes[linkedList, HoldAllComplete]; nasser[lst_] := Module[{m = Length[lst]}, First@Reap [Do[Sow[lst[[1 ;; i]]], {i, 1, m}]][[2]] ]; wizard1[lst_] := Module[{}, Take[lst, #] & /@ Range@Length @lst ]; wizard2[lst_] := Module[{}, Table[Take[#, i], {i, Length@ #}] & @lst ]; wizard3[lst_] := Module[{}, Rest@FoldList [Append, {}, #] & @lst ]; kguler[lst_] := Module[{}, Reverse@NestList [Most, #, Length[#] - 1] & @lst ]; leonid1[lst_] := Module[{b = Bag[{}]}, Map[(StuffBag[b, #]; BagPart[b, All]) &, lst] ]; leonid2[lst_] := Module[{}, Map[List @@ Flatten[#, Infinity, linkedList] &, FoldList[linkedList, linkedList[ First@lst ], Rest@lst ]] ]; thies[lst_] := Module[{}, Drop[ Reverse@ FixedPointList[If[Length[#] > 0, Most, Identity][#] &, lst], 2] ]; makeTable[n_, methods_] := Module[{nTests = Length[methods], nTries = 5, i, j, tests, lst}, lst = Table[RandomReal[], {n}]; tests = Table[0, {nTests}, {nTries}]; For[i = 1, i <= nTests, i++, For[j = 1, j <= nTries, j++, tests[[i, j]] = First@AbsoluteTiming [methods[[i]][lst] ] ] ]; tbl = Table[{ToString[methods[[i]]], Mean[ tests[[i, All]] ]}, {i, nTests}] ; Grid[Join[{{"method", "cpu"}}, tbl], Frame -> All, FrameStyle -> Directive[Thickness[.005], Gray], Spacings -> {0.5, 1} ] ]; 

Now to execute, do

 makeTable[1000, methods] 

Warning, do not try something over 30,000 if you do not have zillion GB, otherwise M cannot return. This happened to me, and I had to restart the computer.

update 12/26/11 3:30 pm

I see that Thies has a newer version of this algorithm (I called it thies2 in the method table), so I restart everything again, here is the updated table, I deleted the linked version of the list, since it is known in advance so as not to be fast for large n, and this time I run them every 10 times (not 5, as mentioned above), and then took the average value). I also started using M fresh using the factory parameter (I restarted it by holding the Alt-Shift keys so that all settings returned to their original settings just in case)

conclusion

Kugler is the fastest for smaller n, that is, n <20,000. For large n, the second version of Thies is now faster than Thies version 1, and now it borders in front, so slightly ahead of the Kugler method for large n. Congratulations to Thies, the current leader in this benchmark. But for all practical purposes, I would say that the Theis and Kugler methods are the fastest for large n, and Kugler remains the fastest for smaller n.

Below are the tables and the updated test code below them. Anyone can freely run tests for themselves, just in case I could miss something.

Current test code:

 $MinPrecision = $MachinePrecision; $MaxPrecision = $MachinePrecision; methods = {nasser, wizard1, wizard2, wizard3, kguler, leonid, thies1, thies2}; AppendTo[$ContextPath, "Internal`"]; nasser[lst_] := Module[{m = Length[lst]}, First@Reap [Do[Sow[lst[[1 ;; i]]], {i, 1, m}]][[2]] ]; wizard1[lst_] := Module[{}, Take[lst, #] & /@ Range@Length @lst ]; wizard2[lst_] := Module[{}, Table[Take[#, i], {i, Length@ #}] & @lst ]; wizard3[lst_] := Module[{}, Rest@FoldList [Append, {}, #] & @lst ]; kguler[lst_] := Module[{}, Reverse@NestList [Most, #, Length[#] - 1] & @lst ]; leonid[lst_] := Module[{b = Bag[{}]}, Map[(StuffBag[b, #]; BagPart[b, All]) &, lst] ]; thies1[lst_] := Module[{}, Drop[ Reverse@ FixedPointList[If[Length[#] > 0, Most, Identity][#] &, lst], 2] ]; thies2[lst_] := Module[{}, Drop[ Reverse@ FixedPointList[If[# =!= {}, Most, Identity][#] &, lst], 2] ]; makeTable[n_Integer, methods_List] := Module[{nTests = Length[methods], nTries = 10, i, j, tests, lst}, lst = Table[RandomReal[], {n}]; tests = Table[0, {nTests}, {nTries}]; For[i = 1, i <= nTests, i++, For[j = 1, j <= nTries, j++, tests[[i, j]] = First@AbsoluteTiming [methods[[i]][lst] ] ] ]; tbl = Table[{ToString[methods[[i]]], Mean[ tests[[i, All]] ]}, {i, nTests}] ; Grid[Join[{{"method", "cpu"}}, tbl], Frame -> All, FrameStyle -> Directive[Thickness[.005], Gray], Spacings -> {0.5, 1} ] ]; 

To run a type

 n=1000 makeTable[n, methods] 

Thanks to everyone for their answers, I learned from all of them.

Answer 1

Another idea:

 Inits[l_] := Drop[ Reverse@FixedPointList [ If[Length[#] > 0, Most, Identity][#] &, l ], 2]; 

Update:

This version is slightly faster, omitting the length calculation every time:

 Inits2[l_] := Drop[ Reverse@FixedPointList [ If[# =!= {}, Most, Identity][#] &, l ], 2]; 

Answer 2

you can use

 f = Reverse@NestList [Most, #, Length[#] - 1] & 

f@ {a,b,c,d,e} gives {{a}, {a, b}, {a, b, c}, {a, b, c, d}, {a, b, c, d, e}} .

The alternative using ReplaceList is much slower than f , but ... why not ?:

 g = ReplaceList[#, {x__, ___} -> {x}] & 

Answer 3

I suggest the following:

 runs[lst_] := Take[lst, #] & /@ Range@Length @lst 

Or that:

 runs2 = Table[Take[#, i], {i, Length@ #}] &; 

---

The answer to the Kyler inspired me to write this:

 Rest@FoldList [Append, {}, #] & 

But this is slower than his method due to the slow Mathematica applications.

Answer 4

Here is another method that is about as effective as with Take , but uses the Internal`Bag functionality:

 AppendTo[$ContextPath, "Internal`"]; runsB[lst_] := Module[{b = Bag[{}]}, Map[(StuffBag[b, #]; BagPart[b, All]) &, lst]]; 

I do not claim that it is simpler than the one based on Take , but it seems to be a simple example of an Internal`Bag at work - since this is exactly the type of problem for which they can be successful (and there may be times when lists explicit positions will either not be available or expensive to calculate).

Just a comparison solution based on linked lists:

 ClearAll[linkedList, runsLL]; SetAttributes[linkedList, HoldAllComplete]; runsLL[lst_] := Map[List @@ Flatten[#, Infinity, linkedList] &, FoldList[linkedList, linkedList[ First@lst ], Rest@lst ]] 

will be an order of magnitude slower on large lists.

Answer 5

This is probably not the most efficient, but a different approach:

 dow[lst_] := lst[[1 ;; #]] & /@ Range@Length @lst 

For instance:

 dow[{a, b, c, d, ee}] 

gives:

{{a}, {a, b}, {a, b, c}, {a, b, c, d}, {a, b, c, d, ee}}