16
$\begingroup$

Is there a short and easier way to count number of sequences in a list?

Let's say I have three lists:

list1 = {0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,0}

list2 = {0,0,1,1,1,0,0,0,0,0,0,0,0,0,1,1,1,1,1}

list3 = {1,1,1,0,0,0,0,0,1,1,0,0,1,1,1,1,0,0,0}

There is one sub-list of 1's at list1, 2 sub-lists (two islands) of 1's at list2 and 3 sub-lists of 1 at list3. So counting function should return to me 1 for list1, 2 for list2 and 3 for list3. I am not interested in number of 1's in a sub-list.

I am using a previous Mathematica version, so I cannot use SequenceCount function. Thank you.

$\endgroup$
  • $\begingroup$ Do "blocks" consisting of a single 1 count? In other words, should {1,0,1,0} return 0 or 2? $\endgroup$ – Michael Seifert Jul 2 '15 at 21:09
  • $\begingroup$ Yes, counts. That list should return 2. $\endgroup$ – gurluk Jul 2 '15 at 21:27
  • $\begingroup$ Related: (78976), (83735) $\endgroup$ – Mr.Wizard Jul 3 '15 at 0:41

10 Answers 10

18
$\begingroup$

Here is one way:

oneseqs[lst_] := Total @ Unitize @ Total[Split[lst], {2}]
$\endgroup$
  • $\begingroup$ I was going to say that it failed to count the 0 sequences, but then I noticed that is exactly what the op wanted. $\endgroup$ – rcollyer Jul 2 '15 at 20:50
  • $\begingroup$ @Leonid That's very elegant and fast. Thank you! $\endgroup$ – gurluk Jul 2 '15 at 20:50
  • $\begingroup$ It counts for this '{0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}' two sequence. $\endgroup$ – Algohi Jul 2 '15 at 21:06
  • $\begingroup$ @Algohi Yes, and this is what it should return in this case, if I understood the question correctly. $\endgroup$ – Leonid Shifrin Jul 2 '15 at 21:30
17
$\begingroup$

This s/b quite quick (particularly with long lists):

MorphologicalEulerNumber[Image@{list}]

And this is even faster...

Length[With[{d = Differences@Prepend[list, 0]}, Pick[d, d, 1]]]

This seems quite quick:

f = Compile[{{z, _Integer, 1}}, Module[{c = True, cnt = 0},
   Do[
    If[c && x == 1, cnt++; c = False; Continue[]];
    If[x == 0, c = True];,
    {x, z}];
   cnt]];
$\endgroup$
  • $\begingroup$ wow, 2.5x faster than Michael's ! $\endgroup$ – SquareOne Jul 2 '15 at 22:06
  • $\begingroup$ @SquareOne: LOL, I'd not even tested it, just recalled it from some work I did for the same kind of problem - counting "islands" of some value. IIRC, I came up with a really fast routine that beat this handily - looking for it now... $\endgroup$ – ciao Jul 2 '15 at 23:57
  • $\begingroup$ @SquareOne: Give the new one a spin... $\endgroup$ – ciao Jul 3 '15 at 0:36
  • $\begingroup$ I wanted to post Differences but you beat me to it. A favorite method of mine for related problems. $\endgroup$ – Mr.Wizard Jul 3 '15 at 0:51
12
$\begingroup$

Another method:

oneseqs[list_] := Count[Append[list, 0] - Prepend[list, 0], 1]

Technically, this counts the number of times the sequence shifts from 0 to 1, but that's effectively the same as the number of blocks of 1's.

EDIT: Here are some performance figures for the four methods proposed thus far:

@Leonard Shifrin:

randlist = RandomInteger[1, 10^6];
Timing[Total@Unitize@Total[Split[randlist], {2}]]

(* {0.834908, 249707} *)

@Michael Seifert:

Timing[Count[Append[randlist, 0] - Prepend[randlist, 0], 1]]  

(* {0.077662, 249707} *)

@SquareOne:

Timing[StringJoin[ToString /@ randlist] // StringCount[#, "1" ..] &] 

(* {1.362467, 249707} *)

@algohi, appropriately modified:

count[list_, n_] := Total@Cases[Split[list], {n ..} :> 1] 
Timing[count[randlist, 1]]  

(* {0.304680, 249707} *)
$\endgroup$
  • 1
    $\begingroup$ Interestingly, I wanted to test the timing of the new (v10.1) function SequenceCount but for it seems it takes ... infinite time. Do you get the same behaviour ? : randlist = RandomInteger[1, 10^4] ; SequenceCount[randlist, {1 ..}]. (It works for 10^3). $\endgroup$ – SquareOne Jul 2 '15 at 21:59
  • 1
    $\begingroup$ @SquareOne Please read (83325) $\endgroup$ – Mr.Wizard Jul 3 '15 at 1:18
  • $\begingroup$ @Mr.Wizard I missed that post. It's a shame ... And why aren't these functions coded at low-level ... I wonder what they would do without MSE contributors. $\endgroup$ – SquareOne Jul 3 '15 at 7:43
  • $\begingroup$ @SquareOne Directorial emphasis appears to be strongly in favor of more functionality over good functionality (fast and bug-free). This is a shame. Nevertheless there are improvements being made. SequencePosition is much faster for verbatim (pattern-free) sequences thanks to the low-level-coded GroupTheory`Tools`SublistPosition which it uses in such cases. $\endgroup$ – Mr.Wizard Jul 3 '15 at 13:18
10
$\begingroup$

I am late to the party but here is my terse contribution:

f1 = Tr @ Split[#][[All, 1]] &

This is quite a bit faster than Leonid's oneseqs:

x = RandomInteger[1, 500000];

oneseqs[x] // RepeatedTiming
f1[x]      // RepeatedTiming
{0.2992, 125166}

{0.0697, 125166}

For speed I propose:

f2 = Length@# - Tr@# & @ UnitStep @ Differences[# ~Append~ 0] &

This is somewhat faster than rasher/ciao's Differences implementation:

Length[With[{d = Differences@Prepend[x, 0]}, Pick[d, d, 1]]] // RepeatedTiming

f2[x] // RepeatedTiming
{0.00900, 125166}

{0.00782, 125166}

Update

Seeking greater speed I considered working in the binary realm. For that:

f3 = Tr @ IntegerDigits[BitShiftLeft@# ~BitXor~ #, 2]/2 &

The array must be converted to an integer first but even with that overhead it is faster:

x = RandomInteger[1, 1*^7];  (* larger array *)

f2[x]                 // RepeatedTiming

f3 @ FromDigits[x, 2] // RepeatedTiming
{0.155, 2498958}

{0.051, 2498958}
$\endgroup$
  • $\begingroup$ Haha. I was looking at this on my phone and saw someone was using the Tr function. I just knew it was MrWizard before I even got finished reading the answer. $\endgroup$ – kale Jul 3 '15 at 2:20
  • $\begingroup$ Nice optimization you sly dog! +1 $\endgroup$ – ciao Jul 3 '15 at 4:03
  • $\begingroup$ @ciao @Mr.Wizard It seems it's even a little bit faster if you use Join instead of Append or Prepend. $\endgroup$ – SquareOne Jul 3 '15 at 8:48
  • $\begingroup$ @SquareOne On a packed integer array Join and and Append appear to perform similarly in 10.1.0. What specific code are you using? $\endgroup$ – Mr.Wizard Jul 3 '15 at 13:22
  • 1
    $\begingroup$ @Mr.Wizard: call me whatever you'd like - I'm called lots of things ;-} $\endgroup$ – ciao Jul 3 '15 at 22:44
7
$\begingroup$

After all these ingenious and interesting solutions only some simple remarks.

Jacob Akkerboom's solution shows that totally readable is a subjective concept. It took me some time before I really understood it (but it is very hot here today). In fact, his solution is an ingenious implementation of what could be done with Fold as well, thereby producing another (slow) solution for this problem:

clusterFu2[list_] := Module[{d = 0}, Fold[(If[#1 < #2, d++]; #2) &, 0, list]; d]

A timing:

randlist = RandomInteger[1, 5*10^6];
clusterFu[randlist] // Timing
clusterFu2[randlist] // Timing
(*
{1.98121, 1251006}
{7.37885, 1251006}
*)

So, to my surprise, Jacob's solution is about 3.5 times as fast as the construction with Fold.

But the Fold construction can be easily compiled:

clusterFu3 = Compile[{{list, _Integer, 1}}, Module[{last = 0, result = 0},
   Do[If[last < z, result++]; last = z, {z, list}]; result],
   CompilationTarget -> "C"];

Now it is even faster than Mr.Wizard's intruiging function f2:

clusterFu[randlist] // Timing
clusterFu3[randlist] // Timing
f2[randlist] // Timing

(*
{1.96561, 1251006}
{0.0312002, 1251006}
{0.0936006, 1251006}
*)
$\endgroup$
  • $\begingroup$ I hope I didn't mislead you with my "totally readable" comment. It was meant as a joke, because the solution is so unconventional. I hope it was a nice puzzle :). I think the reason why it is faster than the Fold solution is quite subtle, but still it makes some sense to me. +1, especially for the Compile solution. $\endgroup$ – Jacob Akkerboom Jul 3 '15 at 15:17
  • $\begingroup$ Hi @Jacob. I am always too serious ... But indeed, your solution is, at least for me, very unusual. Essentially, you have an If statement, of which you placed the second argument as part 0 of your uneveluated expression and the third argument as part 1, and then use the Part function for evaluating al these If's for the consecutive elements of list. Wonderful, deep, and as such a nice puzzle as well. $\endgroup$ – Fred Simons Jul 3 '15 at 15:39
  • $\begingroup$ I can't compile to C (still!) but I'll trust your timings and give a +1. I updated my answer to squeeze as much as possible from top-level Mathematica code and I think I got close to your clusterFu3 based the ratio of timings. $\endgroup$ – Mr.Wizard Jul 3 '15 at 19:28
  • $\begingroup$ I pushed it a bit further and it is now 3X faster than f2 so about the same as your code. $\endgroup$ – Mr.Wizard Jul 3 '15 at 20:48
  • $\begingroup$ @Mr.Wizard According to my tests, your f3 is faster (10-20)% than clusterFu3 for 10^4-10^5 rand.int., slower by (5-10)% only for 10^6-10^7 rand., and for 10^8-10¨^9 it's 50-80% slower. $\endgroup$ – SquareOne Jul 3 '15 at 22:38
5
$\begingroup$

for any number you can use:

count[list_, n_] := Total@Cases[Split[list], {n,n ..} :> 1]
count[list1, 1]
(*1*)
count[list1, 0]
(*2*)
$\endgroup$
  • $\begingroup$ count[{1, 0, 1}, 0] and count[{1, 0, 1}, 1] both return 0, which I don't think is the desired result. $\endgroup$ – Michael Seifert Jul 2 '15 at 21:07
  • $\begingroup$ Probable that is correct because no sequence of any number ! $\endgroup$ – Algohi Jul 2 '15 at 21:08
  • $\begingroup$ The OP clarified that sequences of a single 1 should count towards the total. $\endgroup$ – Michael Seifert Jul 2 '15 at 21:30
  • $\begingroup$ In this case replace {n,n ..} by {n ..}. it will work fine. $\endgroup$ – Algohi Jul 2 '15 at 21:37
4
$\begingroup$

Using StringCount:

StringJoin[ToString /@ list3] // StringCount[#, "1"..] &

3

$\endgroup$
4
$\begingroup$

Not very fast, but totally readable

clusterFu[list_] :=
 Module[
  {d = 0,
   bool = True},
  Unevaluated[
    Set[bool, True]@If[bool, bool = False; d++]
    ][[list]]; d
  ]
$\endgroup$
2
$\begingroup$

Another way:

f[list_] := Plus @@@ ImageData@ HitMissTransform[Image@{list}, {{-1, 1}}, Padding -> 0]
$\endgroup$
2
$\begingroup$

Untested, but this is effectively the same strategy as Michael's:

Count[ListCorrelate[{-1, 1}, list, {-1, 1}, 0], 1]
$\endgroup$
  • 1
    $\begingroup$ It works, and it is faster. Its run time does not seem to be sensitive to whether the input is packed or not, and is 85% that of Michael's in the packed case, and 60% otherwise. (I upvoted before I checked this, because I had faith... but I was not expecting the performance to be insensitive to packing.) $\endgroup$ – Oleksandr R. Jul 4 '15 at 12:57
  • $\begingroup$ I am thankful that the faith was deserved in this case, @Oleksandr. :) $\endgroup$ – J. M. will be back soon Jul 4 '15 at 13:09

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.