# Extracting counts of contiguous zeros and ones from a binary array

I'm a novice with Mathematica, but you guys have been very helpful to me in the past. I have a binary array [100, J repetitions] consisting of zeroes and ones. I'd like to extract a histogram of the number of contiguous ones in these individual columns.

Assuming I have some variable f[i, j] containing these data what I have is:

Do[
bhist = SparseArray[{1, 1} -> 0, {1, 100}, 0];
index = 1;
Do[If[f[[j, i]] == 1, index++, bhist[[index]] + 1; index = 1],
{i, 1, 100}];
bhista[j] = bhist;,
{j, 1, rep}];


where bhist will record the number of contiguous 1s and how many times that ensemble occurs. This will loop over all j repetitions of the monte carlo.

The problem is that I seem to only be generating zeroes despite the fact that my simulation does generate contiguous 1s. Is my If expression setting the index to 1 before it records the value in my bhist variable? Or is something else going on?

Furthermore, if I wanted to then extract a histogram from bhista, is there a more efficient way of doing this than flattening it and bin counting?

• Have you seen for example Split and Tally? Jul 3, 2013 at 20:02

Here's a hint. Say you have a vector:

x = {0, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1}


This has one triplet and two doublets and one single 1. This information can be extracted:

Length /@ Select[Split[x], Total[#] > 0 &]


which gives

{3, 2, 2, 1}


Now you can apply this to each column of the data matrix.

• You beat me. :-) Jul 3, 2013 at 20:21
• @Mr. Wizard -- But yours has a pretty picture! Jul 3, 2013 at 20:31
• This is perfect. Thank you so much for the help. Jul 5, 2013 at 17:32
list = {0, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1};


Using SequenceSplit (new in 11.3)

Length /@ SequenceSplit[list, {0}]


{3, 2, 2, 1}

Using SequenceCases:

x = {0, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1};
SequenceCases[x, k : {1 ..} :> Length@k]


Using SequenceReplace:

This is for comparison with SequenceCases above.

SequenceReplace[x, {k : {1 ..} :> Length@k, {0 ..} :> Nothing}]


{3, 2, 2, 1}

list = {0, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1};


Using PositionIndex, Split and Extract:

Length /@ Extract[list, List@*Span @@ # &@*MinMax /@
Split[PositionIndex[list][1], #2 - #1 == 1 &]]


{3, 2, 2, 1}

Thanks to @Syed for the following shorter version:

Split[PositionIndex[list][1], #2 - #1 == 1 &] // Map[Length]


{3, 2, 2, 1}

• Split[PositionIndex[list][1], #2 - #1 == 1 &] // Map[Length] would do the same thing.
– Syed
Apr 13 at 4:25
• Thanks @Syed! I update my answer :) Apr 13 at 11:36

I'm not positive that I follow what you're attempting, but I strongly suspect that belisarius's recommendation is correct. Perhaps this is close enough to what you want:

SeedRandom[3]; (* for consistency *)

a = RandomInteger[1, {100}];

Cases[Split[a], {1, ___}] // Tally // Sort

{{{1}, 12}, {{1, 1}, 5}, {{1, 1, 1}, 3}, {{1, 1, 1, 1}, 3}, {{1, 1, 1, 1, 1}, 1}}

Labeled[#2, Length@#] & @@@ % // BarChart


Using ArrayMesh together with BoundaryMesh ( just a different projection ... )

list = {0, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1};

ArrayMesh[list, MeshCellStyle -> {1 -> Red, 0 -> Black}]


Round@AnnotationValue[{BoundaryMesh@ArrayMesh[list], 1}, MeshCellMeasure]


{3, 2, 2, 1}