17
$\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$
3
  • $\begingroup$ Do "blocks" consisting of a single 1 count? In other words, should {1,0,1,0} return 0 or 2? $\endgroup$ 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$
4
  • $\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$ 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$ 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$
4
  • $\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$
4
  • 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$
7
  • $\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$
8
  • $\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$ 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$ 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$
4
  • $\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$ Jul 2 '15 at 21:07
  • $\begingroup$ Probable that is correct because no sequence of any number ! $\endgroup$ Jul 2 '15 at 21:08
  • $\begingroup$ The OP clarified that sequences of a single 1 should count towards the total. $\endgroup$ Jul 2 '15 at 21:30
  • $\begingroup$ In this case replace {n,n ..} by {n ..}. it will work fine. $\endgroup$ 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$
2
  • 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$ Jul 4 '15 at 12:57
  • $\begingroup$ I am thankful that the faith was deserved in this case, @Oleksandr. :) $\endgroup$
    – J. M.'s torpor
    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.