Count the sequences in an array

Question

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.

Answer 1

Here is one way:

oneseqs[lst_] := Total @ Unitize @ Total[Split[lst], {2}]

Answer 2

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

Answer 3

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} *)

Answer 4

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}

Answer 5

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}
*)

Answer 6

for any number you can use:

count[list_, n_] := Total@Cases[Split[list], {n,n ..} :> 1]
count[list1, 1]
(*1*)
count[list1, 0]
(*2*)

Answer 7

Using StringCount:

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

3

Answer 8

Not very fast, but totally readable

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

Answer 9

Another way:

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

Answer 10

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

Count[ListCorrelate[{-1, 1}, list, {-1, 1}, 0], 1]

Answer 11

a = {0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0};
b = {0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1};
c = {1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0};

Using SequenceCount (new in 10.1)

SequenceCount[#, {1 ..}] & /@ {a, b, c}

{1, 2, 3}

Answer 12

oneSeqs = Tr @* DeleteAdjacentDuplicates;

oneSeqs /@ {list1, list2, list3}

{1, 2, 3}

WolframLanguageData["DeleteAdjacentDuplicates", "VersionIntroduced"]

13.1

Answer 13

Using SequenceSplit and Cases:

l1 = {0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0};
l2 = {0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1};
l3 = {1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0};
f = Length@Cases[SequenceSplit[#, s : {1 ..} :> s], {1 ..}] &;
f /@ {l1, l2, l3}
({1, 2, 3})

Or using SequenceSplit, Pick and ContainsOnly:

f = Length@Pick[#, ContainsOnly[#, {1}] & /@ #] 
    &@SequenceSplit[#, s : {1 ..} :> s] &;
f /@ {l1, l2, l3}
({1, 2, 3})

Answer 14

Using FindPeaks:

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};
Length@*FindPeaks /@ {list1, list2, list3}

{1, 2, 3}