Replacing Subscriptions with the First Item in a Sublist

Question

I am new to Mathematica and I came across this problem. I have a list that looks like this:

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

I want to replace each count with its first element. So the above list should be converted to:

 {1,0,1} 

I have repeatedly looked at the documentation and googled for hours. I am sure it is quite simple, but I can not understand. I started with this list:

 {1, 1, 1, 0, 1} 

I need to know how many runs 1 is, which is obvious 2. So, I used Split to split the list into groups of consecutive 1 and 0. Using the length in this list, I can get the total number of runs, which is 3. Now I just need to calculate number of runs 1. If I can convert the list as above, I can simply sum the elements in the list to get an answer.

Hope this makes sense. Thanks for any help!

Answer 1

I would do this:

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

or

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

Answer 2

The proposed solutions are quite quick, however, if you want extreme efficiency (huge lists), here is another one that will be an order of magnitude faster (formulated as a pure function):

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

For example:

 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} 

EDIT

I didn’t want to start the “big shootout”, but while we are on it, let me pull out the biggest pistol compilation in 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"] 

Now

 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} 

Of course, this is not an elegant solution, but it is simple.

EDIT 2

Improving @Sjoerd's optimization, it will be about 1.5 faster than runsOf1C :

 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 3

You actually have two questions, one of the name and the question lurking behind it. The first one answers:

 First/@ list 

The second, counting the number of runs 1, answered many times, but this solution

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

about 50% faster than Leonid's solution. Note. I increased the length of the test list for better time:

 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} 

---

After the attack of Leonid’s collection, I was going to throw a towel, but I noticed a possible optimization, so the battle goes on ... [Mr.Wizard, Leonid and I should be thrown into jail for breaking the world on 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} 

The results are changing, but I get an improvement of 10 to 30%.

Optimization may be difficult to determine, but it is optional i++ if the test {0,1} succeeds. You cannot have two of them in the following places.

---

And now, the optimization optimization optimization of my optimizer by Leonid (I hope this does not pull, or I will suffer from stack overflow):

 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} 

Fortunately for me, Leonid had excessive initialization in his code, which could be removed.

Answer 4

Here is a variant of the Leonid Differences method, which is slightly faster:

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

Comparison (using Tr for both):

 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 

---

Since this has become a code performance competition, here is my next effort:

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

In addition, I get very different results using Mathematica 7, so I include them here for reference:

 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 5

Another approach, using Count to search for lists containing a number of repetitions of 1:

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