Count consecutive occurrences in a list above a certain value

Question

I am trying to tally and sort the number of consecutive occurrences in a list above a certain value.

For instance:

data={55.5, 65.3, 100.3, 100.1, 100.5, 98.7, 75.2, 101.3, 102.1}

The totals for this data set would be {3,2} if the tally criteria were all values greater than 100.

As I have worked on this problem, I found the following code:

a = RandomInteger[1, {100}];
Cases[Split[a], {1, ___}] // Tally // Sort

Which is very close to what I am trying to do. In this case, the code provides a sorted list of consecutive integers equal to one.

However, I can't seem to modify the decision criteria to only tally values above a certain criteria.

How might I go about this?

Answer 1

Edit: there is an ambiguity in the question (and my answer) as to whether or not you want to include single-element "runs" in your tally.

---

If you merely want to count the elements in each run and not also return the elements I propose:

Cases[Split @ UnitStep[100 - data], x : {0, __} :> Length@x]

{3, 2}

If you (also) want to return the elements you could use this:

Module[{us = UnitStep[100 - data], tally},
 tally = Cases[Split[us], x : {0, ___} :> Length@x];
 dynamicPartition[Pick[data, us, 0], tally]
]

{{100.3, 100.1, 100.5}, {101.3, 102.1}}

You'll need my dynamicPartition function described here.

---

Timings

Comparing my proposal to rm-rf's:

data = RandomReal[200, 750000];

Cases[Split@UnitStep[100 - data], x : {0, __} :> Length@x]        // Length // Timing

Length /@ Split[data, # > 100 && #2 > 100 &] /. 1 -> Sequence[]   // Length // Timing

Select[Total[Split@Clip[data, {100, 100}, {0, 1}], {2}], # > 1 &] // Length // Timing

{0.109, 93479}

{0.671, 93479}

{0.655, 93479}

Answer 2

One direct way is to use the second argument of Split and find sublists of length > 0:

Length /@ Split[data, # > 100 && #2 > 100 &] /. 1 -> Sequence[]

or by clipping the values before splitting:

Select[Total[Split@Clip[data, {100, 100}, {0, 1}], {2}], # > 1 &]

Answer 3

Not sure about the efficiency but how about defining a test function:

testFunction = (# > 100 &)

and then

Length /@ Select[Split[testFunction /@ data], First]

or if you don't want singletons

Length /@ Cases[Split[testFunction /@ data], {True, __}]

Answer 4

This answer is general and fast, allowing the use of any predicate (not just ones based on a numerical threshold) and using the fact that you'll have alternating runs of elements that satisfy the predicate and elements that don't satisfy the predicate:

runLengths[list_, pred_] :=
 With[{bits = Boole[pred@#] & /@ list},
  Length /@ Part[
    Split[bits],
    If[bits[[1]] == 0,
     Span[2, All, 2],
      Span[1, All, 2]]]]

EDIT to add: Some timings:

bigData = RandomReal[{0, 200}, {10000}];

Do[runLengths[bigData, # >= 100 &], {100}] // Timing

{0.218401, Null}

For comparison, here's Mr. Wizard's approach on my machine:

Do[
  Cases[Split@UnitStep[100 - bigData], x : {0, __} :> Length@x],
  {100}] // Timing

{0.249602, Null}

So it's a little faster, and a little more flexible.

EDIT again to add:

I'm assuming we want to keep runs of length 1; those can always be deleted later in any event.

EDIT the third: just getting rid of 1 at the end adds very little overhead:

Do[DeleteCases[
   runLengths[bigData, # >= 100 &], 1], 
   {100}] // Timing

{0.234002, Null}

Answer 5

As Mr. Wizard pointed out in the comments, my original code tests for elements greater or equal 100, a corrected version is in the edit below.

I interpreted the question to include singletons and came up with the following, which I think performs decently

Length/@DeleteCases[Split[UnitStep[data-100]],{0..}]

Edit

The following tests for elements greater than 100

Length/@DeleteCases[Split[UnitStep[100-data]],{1..}]

Thanks to Mr. Wizard to pointing out mistakes and performance issues in this post!