用子列表中的第一项替换子列表

Question

我对Mathematica很新,我对这个问题很难过.我有一个如下所示的列表:

{{1, 1, 1}, {0}, {1}}

我想用第一个元素替换每个子列表.因此,上面的列表应该转换为:

{1,0,1}

我反复浏览文档并用Google搜索了几个小时.我确信这很简单,但我无法弄清楚.我从这个列表开始:

{1, 1, 1, 0, 1}

我需要知道有多少个1的运行,显然是2.所以,我使用Split将列表分成连续的1和0的组.通过在此列表上使用长度,我可以得到总运行次数,即3.现在,我只需要计算1的运行次数.如果我可以如上所述转换列表,我可以将列表中的项目相加以得到答案.

我希望这是有道理的.谢谢你的帮助!

Answer 1

建议的解决方案非常快,但是如果你想要极高的效率(巨大的列表),这里有另一个更快的数量级(制定为纯函数):

Total[Clip[Differences@#,{0, 1}]] + First[#] &

例如:

In[86]:= 
largeTestList = RandomInteger[{0,1},{10^6}];
Count[Split[largeTestList],{1..}]//Timing
Count[Split[largeTestList][[All,1]],1]//Timing
Total[Clip[Differences@#,{0, 1}]] + First[#] &@largeTestList//Timing

Out[87]= {0.328,249887}
Out[88]= {0.203,249887}
Out[89]= {0.015,249887}

编辑

我并没有承诺发起"大枪战",但是当我们参与其中时,让我把最大的枪 - 编译到C:

runsOf1C = 
 Compile[{{lst, _Integer, 1}},
   Module[{r = Table[0, {Length[lst] - 1}], i = 1, ctr = First[lst]},
    For[i = 2, i <= Length[lst], i++,
      If[lst[[i]] == 1 && lst[[i - 1]] == 0, ctr++]];
      ctr],
  CompilationTarget -> "C", RuntimeOptions -> "Speed"]

现在,

In[157]:= 
hugeTestList=RandomInteger[{0,1},{10^7}];
Total[Clip[ListCorrelate[{-1,1},#],{0,1}]]+First[#]&@hugeTestList//AbsoluteTiming
runsOf1C[hugeTestList]//AbsoluteTiming

Out[158]= {0.1872000,2499650}
Out[159]= {0.0780000,2499650}

当然,这不是一个优雅的解决方案,但它很简单.

编辑2

改进@Sjoerd的优化,这个将比runsOf1C静止快约1.5 :

runsOf1CAlt = 
Compile[{{lst, _Integer, 1}},
  Module[{r = Table[0, {Length[lst] - 1}], i = 1, ctr = First[lst]},
    For[i = 2, i <= Length[lst], i++,
     If[lst[[i]] == 1,
      If[lst[[i - 1]] == 0, ctr++];
      i++
     ]];
    ctr],
  CompilationTarget -> "C", RuntimeOptions -> "Speed"]

Answer 2

你实际上有两个问题,一个来自标题和潜伏在它背后的问题.第一个答案是:

First/@ list

第二个,计算1的运行次数,已被多次回答,但这个解决方案

Total[Clip[ListCorrelate[{-1, 1}, #], {0, 1}]] + First[#] &

比Leonid的解决方案快约50%.注意我增加了测试列表的长度以获得更好的时序:

largeTestList = RandomInteger[{0, 1}, {10000000}];
Count[Split[largeTestList], {1 ..}] // AbsoluteTiming
Count[Split[largeTestList][[All, 1]], 1] // AbsoluteTiming
Total[Clip[Differences@#, {0, 1}]] + First[#] &@ largeTestList // AbsoluteTiming
(Tr@Unitize@Differences@# + Tr@#[[{1, -1}]])/2 &@ largeTestList // AbsoluteTiming
Total[Clip[ListCorrelate[{-1, 1}, #], {0, 1}]] + First[#] &@
  largeTestList // AbsoluteTiming


Out[680]= {3.4361965, 2498095}

Out[681]= {2.4531403, 2498095}

Out[682]= {0.2710155, 2498095}

Out[683]= {0.2530145, 2498095}

Out[684]= {0.1710097, 2498095}

在列昂尼德的编辑攻击之后,我即将放弃,但我发现了一个可能的优化,所以继续战斗...... [Mr.Wizard,Leonid和我应该因为扰乱SO的和平而被投入监狱]

runsOf1Cbis = 
 Compile[{{lst, _Integer, 1}}, 
  Module[{r = Table[0, {Length[lst] - 1}], i = 1, ctr = First[lst]}, 
   For[i = 2, i <= Length[lst], i++, 
    If[lst[[i]] == 1 && lst[[i - 1]] == 0, ctr++; i++]];
   ctr], CompilationTarget -> "C", RuntimeOptions -> "Speed"]

largeTestList = RandomInteger[{0, 1}, {10000000}]; 
Total[Clip[ListCorrelate[{-1, 1}, #], {0, 1}]] + First[#] &@
    largeTestList // AbsoluteTiming
runsOf1C[largeTestList] // AbsoluteTiming
runsOf1Cbis[largeTestList] // AbsoluteTiming


Out[869]= {0.1770101, 2500910}

Out[870]= {0.0960055, 2500910}

Out[871]= {0.0810046, 2500910}

结果各不相同,但我的改善率在10%到30%之间.

优化可能很难发现,但i++如果{0,1}测试成功则是额外的.您不能在连续的位置拥有其中两个.

而且,在这里,优化了Leonid优化我的优化优化(我希望这不会拖累,或者我将遭受堆栈溢出):

runsOf1CDitto = 
 Compile[{{lst, _Integer, 1}}, 
  Module[{i = 1, ctr = First[lst]}, 
   For[i = 2, i <= Length[lst], i++, 
    If[lst[[i]] == 1, If[lst[[i - 1]] == 0, ctr++];
     i++]];
   ctr], CompilationTarget -> "C", RuntimeOptions -> "Speed"]

largeTestList = RandomInteger[{0, 1}, {10000000}]; 
Total[Clip[ListCorrelate[{-1, 1}, #], {0, 1}]] + First[#] &@
  largeTestList // AbsoluteTiming
runsOf1C[largeTestList] // AbsoluteTiming
runsOf1Cbis[largeTestList] // AbsoluteTiming
runsOf1CAlt[largeTestList] // AbsoluteTiming
runsOf1CDitto[largeTestList] // AbsoluteTiming


Out[907]= {0.1760101, 2501382}

Out[908]= {0.0990056, 2501382}

Out[909]= {0.0780045, 2501382}

Out[910]= {0.0670038, 2501382}

Out[911]= {0.0600034, 2501382}

幸运的是,Leonid在他的代码中有一个多余的初始化,可以删除.

Answer 3

这是列昂尼德Differences方法的一种变化,稍微快一些:

(Tr@Unitize@Differences@# + Tr@#[[{1,-1}]])/2 &

比较(使用Tr两者):

list = RandomInteger[1, 1*^7];

Tr[Clip[Differences@#, {0,1}]] + First[#] & @ list //timeAvg

(Tr@Unitize@Differences@# + Tr@#[[{1,-1}]])/2 & @ list //timeAvg

0.1186

0.0904

由于这已经成为代码效率竞争,这是我的下一步努力:

(Tr@BitXor[Most@#, Rest@#] + Tr@#[[{1, -1}]])/2 &

另外,我使用Mathematica 7获得了非常不同的结果,所以我将它们包括在这里以供参考:

largeTestList = RandomInteger[{0, 1}, {10000000}];
Count[Split[largeTestList], {1 ..}] // AbsoluteTiming
Count[Split[largeTestList][[All, 1]], 1] // AbsoluteTiming
Total[Clip[Differences@#, {0, 1}]] + First[#] &@largeTestList // AbsoluteTiming
(Tr@Unitize@Differences@# + Tr@#[[{1, -1}]])/2 &@largeTestList // AbsoluteTiming
Total[Clip[ListCorrelate[{-1, 1}, #], {0, 1}]] + First[#] &@largeTestList // AbsoluteTiming
(Tr@BitXor[Most@#, Rest@#] + Tr@#[[{1, -1}]])/2 &@largeTestList // AbsoluteTiming

{1.3400766, 2499840}

{0.9670553, 2499840}

{0.1460084, 2499840}

{0.1070061, 2499840}

{0.3710213, 2499840}

{0.0480028, 2499840}

Answer 4

我这样做:

Count[Split[{1, 1, 1, 0, 1}][[All, 1]], 1]

要么

Total[First /@ Split[{1, 1, 1, 0, 1}]]

Answer 5

另一种方法,Count用于查找包含一些重复次数1的列表:

In[20]:= Count[Split[{1, 1, 1, 0, 1}], {1 ..}]

Out[20]= 2