如何获取列表并生成所有增加长度的列表？

Question

Mathematica专家的任何简单问题都在这里：

给出一个清单，说

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

我希望从开始到结束返回所有长度1,2,3,...Length[data]的列表，以便我得到以下内容

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

我查看了M中的命令以找到一个可以使用的命令，我可以（查看所有Map和Nest *函数，但不是我可以看到如何使用它）。我确信它在那里，但我现在没有看到它。

现在我做这个愚蠢的Do循环来构建它

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

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

问题是：Mathematica是否有内置命令来执行上述操作？

更新上午8点

我已经删除了我在一小时前完成的测试，并将很快重新发布。我需要运行它们几次并取平均值，因为这是进行此性能测试的更好方法。

更新上午9点

好的，我已经在下面显示的所有解决方案上重新运行了性能测试。 8种方法。 对于每种方法，我运行它5次并取平均值。 我为n={1000, 5000, 10000, 15000, 25000, 30000}执行了此操作，其中n是要处理的原始列表的长度。

不能超过30,000，将用完ram。我只有4 GB的RAM。

我创建了一个名为makeTable[n, methods]的小函数，它为特定的n生成性能表。测试代码在下面（快速编写，所以不是最干净的代码，不是非常实用，因为我必须去:)，但它在下面，任何人都可以更改/清理它等...如果他们想要

结论：Kguler方法是最快的，Thies方法对于大n（30,000）几乎相同，因此对于所有实际目的，可能 Thies和Kguler方法可以宣布为获胜者对于大n？但由于Kguler对小n来说也是最快的，所以到目前为止，他获得了明显的优势。

同样，下面的测试代码是任何人检查并运行以查看我是否可能在某处发生错误。正如Leonid正确预测的那样，链表方法对于大n来说并不是很好。

我认为需要更多的测试，因为只取5的平均值可能还不够，还有其他考虑因素我可能会错过。这不是一个确切的测试，只是一个粗略的想法。

我尝试在运行测试时不要使用电脑。我使用AbsoluteTiming []来测量cpu。

以下是生成的表格的屏幕截图

这是测试代码：

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

现在运行，执行

makeTable[1000, methods]

警告，除非你有数亿GB，否则不要尝试超过30,000的东西，否则M可能不会返回。它发生在我身上，不得不重新启动电脑。

更新12/26/11 3:30 PM

我看到Thies有这个算法的更新版本（我在方法表中称它为thies2），所以我再次重新运行所有内容，这里是更新的表，我删除了链表版本，因为它在对于大n来说，提前不要快，而这次，我每次运行它们10次（不是上面的5次），然后取平均值）。我还使用出厂设置启动了M fresh（重新启动它，按住alt-shift键，以便所有设置都恢复到原始设置以防万一）

到目前为止

结论

Kugler对于较小的n是最快的，即n <20,000。 对于较大的n，现在Thies第二个版本比Thies版本1更快，现在它远远领先于Kugler方法的大n。祝贺Thies，目前在此次性能测试中处于领先地位。但是出于所有实际目的，我会说Thies和Kugler方法对于大n来说都是最快的，而Kugler对于小n来说仍然是最快的。

下面是表格及其下方的更新测试代码。任何人都可以自由地为自己运行测试，以防万一我可能会忽视某些事情。

目前的测试代码：

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

运行类型

n=1000
makeTable[n, methods]

感谢大家的回答，我从所有人那里学到了很多。

Answer 1

您可以使用

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

f@{a,b,c,d,e}提供{{a}, {a, b}, {a, b, c}, {a, b, c, d}, {a, b, c, d, e}}。

使用ReplaceList的替代方案 - 比f慢得多，但......为什么不呢？：

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

Answer 2

我建议：

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

或者这个：

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

---

kguler的回答激发了我写这个：

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

但由于 Mathematica的缓慢附加，这比他的方法慢。

Answer 3

这是另一种方法，与参与Take的方法大致同样有效，但使用Internal`Bag功能：

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

我并不认为它比基于Take的更简单，但它似乎是Internal`Bag在工作中的一个简单例子 - 因为这正是问题的类型这些可以成功使用（并且可能存在显式位置列表不可用或计算成本高的情况）。

比较，基于链表的解决方案：

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

在大型列表上会慢一个数量级。

Answer 4

另一个想法：

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

<强>更新

这个版本通过省略每次计算长度来加快一点：

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

Answer 5

可能不是最有效的，但另一种方法：

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

例如：

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

给出：

  

{{a}，{a，b}，{a，b，c}，{a，b，c，d}，{a，b，c，d，ee}}