5
$\begingroup$

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?

$\endgroup$
1
  • 1
    $\begingroup$ Have you seen for example Split and Tally? $\endgroup$ Jul 3, 2013 at 20:02

6 Answers 6

6
$\begingroup$

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.

$\endgroup$
3
  • $\begingroup$ You beat me. :-) $\endgroup$
    – Mr.Wizard
    Jul 3, 2013 at 20:21
  • $\begingroup$ @Mr. Wizard -- But yours has a pretty picture! $\endgroup$
    – bill s
    Jul 3, 2013 at 20:31
  • $\begingroup$ This is perfect. Thank you so much for the help. $\endgroup$
    – user8307
    Jul 5, 2013 at 17:32
5
$\begingroup$
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}

$\endgroup$
4
$\begingroup$

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}

$\endgroup$
4
$\begingroup$
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}

$\endgroup$
2
  • 1
    $\begingroup$ Split[PositionIndex[list][1], #2 - #1 == 1 &] // Map[Length] would do the same thing. $\endgroup$
    – Syed
    2 days ago
  • $\begingroup$ Thanks @Syed! I update my answer :) $\endgroup$ 2 days ago
3
$\begingroup$

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

enter image description here

$\endgroup$
3
$\begingroup$

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

enter image description here

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

{3, 2, 2, 1}

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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