¿Cómo tomar una lista y generar todas las listas de mayor longitud?

Question

Cualquier pregunta fácil para los expertos en Mathematica aquí:

dado una lista, dicen

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

y yo quiero volver todas las listas de longitud 1,2,3,...Length[data] empezando desde el principio hasta el final, por lo que tengo lo siguiente para el anterior

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

miré a los comandos M para encontrar una lista para su uso, y pude (mirado a todas las funciones del nido de Mapa y *, pero no es que yo puedo ver cómo utilizar para esto). Estoy seguro de que está allí, pero no lo estoy viendo ahora.

ahora ya esta tonta bucle Do construirlo

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

{{a},{a,b},{a,b,c}} 

pregunta es: ¿Mathematica tiene una acumulación de comando para hacer lo anterior?

actualización 08 a.m.

He eliminado las pruebas que he hecho hace una hora y va a reposting ellos de nuevo pronto. Necesito ejecutarlos varias veces y tomar un promedio, ya que es la mejor manera de hacer esta prueba de rendimiento.

actualización 09 a.m.

Ok, he volver a ejecutar las pruebas de rendimiento en todas las soluciones que se muestran a continuación. 8 métodos. Para cada método, lo ejecuto 5 veces y tomé el promedio. Lo hice para n={1000, 5000, 10000, 15000, 25000, 30000} donde n es la longitud de la lista original para procesar.

no puede ir mucho más de 30.000, se quedará sin memoria RAM. Solo tengo 4 GB de ram.

Hice una pequeña función llamada makeTable[n, methods] que genera la tabla de rendimiento para n específico. el código de prueba está debajo (escrito rápidamente así que no es el código más limpio, no es muy funcional, ya que tengo que ir :), pero está abajo y cualquiera puede cambiarlo/limpiarlo, etc ... si lo desean

conclusión: método Kguler fue el más rápido, con el método de Thies casi el mismo para n grande, (30000), por lo que a efectos prácticos, puede ser Thies y Kguler métodos pueden ser declarados como los ganadores de gran n? Pero dado que Kguler también es el más rápido para n pequeña, hasta ahora, tiene la ventaja clara.

De nuevo, el código de prueba está debajo para que cualquiera pueda verificarlo y ejecutarlo para ver si podría haber cometido un error en alguna parte. Como Leonid predijo correctamente, el método de lista vinculada no le fue demasiado bien a n grande.

Creo que se necesitan más pruebas, ya que solo tomar la media de 5 podría no ser suficiente, también otras consideraciones que podría haber pasado por alto. Esta no es una prueba exacta, solo una aproximada para tener una idea.

Traté de no usar el PC tanto durante la ejecución de las pruebas. Usé AbsoluteTiming [] para medir la CPU.

Aquí es captura de pantalla de las tablas generadas

Aquí está el código de prueba:

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} 
    ] 
    ]; 

ahora para ejecutar, hacer

makeTable[1000, methods] 

Advertencia, no lo hacen pruebe algo más de 30,000 a menos que tenga un billón de GB, de lo contrario M podría no regreso. Me pasó a mí y tuve que reiniciar la PC.

actualización 12/26/11 15:30

veo que Thies tiene una versión más reciente de este algoritmo (que lo llamaron thies2 en la tabla de métodos), por lo que volver a ejecutar todo de nuevo, aquí es la tabla actualizada, eliminé la versión de la lista enlazada ya que se sabe de antemano que no será rápida para n grande, y esta vez, la ejecuto cada una 10 veces (no 5 como arriba) y luego tomé la media). También empecé ajuste de fábrica usando fresca M (reiniciado la celebración de teclas ALT-SHIFT para que todos los ajustes están de vuelta a la configuración original por si acaso)

conclusión hasta ahora

Kugler es más rápido para los pequeños n, es decir, n < 20,000. Para una n mayor, ahora la segunda versión de Thies es más rápida que la versión 1 de Thies y ahora avanza muy ligeramente por delante del método de Kugler para n grande. Felicidades a Thies, el líder actual en esta prueba de rendimiento. Pero para todos los propósitos prácticos, diría que los métodos de Thies y Kugler son los más rápidos para n grande, y Kugler sigue siendo el más rápido para n más pequeños.

A continuación se muestran las tablas y el código de prueba actualizado debajo de ellas. Cualquiera es libre de ejecutar las pruebas por sí mismo, en caso de que pueda pasar por alto algo.

El código de prueba actual:

$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} 
    ] 
    ]; 

Para ejecutar tipo

n=1000 
makeTable[n, methods] 

Gracias por todos por sus respuestas, he aprendido de todos ellos.

Answer 1

Otra idea:

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

Actualización:

Esta versión es un poco más rápido al omitir el cálculo de la longitud de cada vez:

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

Answer 2

Puede utilizar

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

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

Una alternativa usando ReplaceList - mucho más lento que f, pero ... ¿por qué no?:

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

Answer 3

propongo esto:

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

O esto:

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

---

respuesta de kguler me inspiró a escribir esto:

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

Pero esto es más lento que su método debido a de Mathematica agrega lentamente.

Answer 4

Aquí hay otro método que es más o menos tan eficaz como la que implica Take, pero utiliza la funcionalidad Internal`Bag:

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

No pretendo que es más sencilla que la basado en Take, pero parece ser un ejemplo simple de Internal`Bag en el trabajo, ya que este es exactamente el tipo de problema para el cual se pueden usar con éxito (y podría haber casos en los que las listas de posiciones explícitas no estarían disponibles o serían costosas de calcular).

sólo para comparar, la solución basada en listas enlazadas:

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

habrá un orden de magnitud más lento en grandes listas.

Answer 5

Probablemente no es el más eficiente, pero otro enfoque:

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

Por ejemplo:

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

da:

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