# Positions satisfying pattern and grouped

I have a list of numbers and I am looking for a way to most efficiently find positions of values that satisfy a certain condition and group those positions that are sequential. To illustrate, a simple list can look like

x={1,2,4,6,2,3,4,5,7,9,1,3,4,1}


and I am interested in all numbers that are greater than 2 and so I expect the return to look like:

res={{3,4},{6,7,8,9,10},{12,13}}


Alternatively, I would also need the result being the values in x however grouped in the same manner.

The stress is also on effectivness, this will be applied on a number of 100 MB data files. My initial idea was: Position[x, n_ /; n > 50] // Flatten and then somehow go through the output and determined if the next position is previous plus 1 but I think this is not very effective (also I have no idea how to do it without complex loops).

• You can use Split to do the last step, or fancier stuff from this question. Commented Mar 23, 2016 at 21:15
• @leosenko, your version would look like Split[Flatten@Position[list, n_ /; n > 2], #2 - #1 == 1 &] Commented Mar 24, 2016 at 5:59

You can use the BoolEval function from the BoolEval package. You can load it as follows, for example:

Import["https://bitbucket.org/szhorvat/booleval/raw/8e1eaf980500b5ff066b2b4bf3a61c1ad2e9c02d/BoolEval.m"]


Here is a function based on that:

ClearAll[getSplitPositions];
SetAttributes[getSplitPositions, HoldRest];
getSplitPositions[list_, crit_] :=
With[{pos = Sort@Pick[Range[Length[list]], BoolEval[ crit], 1]},
If[pos === {}, Return[{}]];
InternalPartitionRagged[
pos,
Composition[
Append[#, Length[pos] - Total[#]] &,
Differences,
Prepend[0],
Flatten,
#["NonzeroPositions"] &,
SparseArray,
Unitize,
Differences@# - 1 &
] @ pos
]
];


It does reproduce you desired output:

list = {1, 2, 4, 6, 2, 3, 4, 5, 7, 9, 1, 3, 4, 1};
getSplitPositions[list, list > 2]

(* {{3, 4}, {6, 7, 8, 9, 10}, {12, 13}} *)


And it can handle a list of million numbers in a fraction of a second:

lrgTest = RandomInteger[{1, 1000}, 1000000];
getSplitPositions[lrgTest, 250 < lrgTest < 300] // Length // AbsoluteTiming

(* {0.178297, 46292} *)


It does, however, have an issue - it unpacks, presumably due to certain subtleties of the BoolEval implementation. Here is a version of BoolEval that won't unpack:

ClearAll[BoolEval];
SetAttributes[BoolEval, HoldAll];
BoolEval[condition_] :=
Replace[
Unevaluated[condition],
BoolEvalPrivaterules,
{0, Infinity},
]


In this particular case, the speed is the same, but the memory use should probably be better with this version.

• For people reading this: BoolEval is now fixed and will not unpack. There is a compromise that had to be made: all relational and logical operators that appear literally in the argument of BoolEval are overloaded. BoolEval is meant to be used only with relatively simple and expressions that are literally spelt out. Commented Feb 22, 2017 at 9:57
• @Szabolcs Great! Thanks for the info. Commented Feb 22, 2017 at 13:44
list = {1, 2, 4, 6, 2, 3, 4, 5, 7, 9, 1, 3, 4, 1};

TakeList[
First /@ SequencePosition[list, {x_ /; x > 2}],
Length /@ SequenceSplit[list, {x_ /; x <= 2}]]


{{3, 4}, {6, 7, 8, 9, 10}, {12, 13}}

TakeList[
First /@ SequencePosition[list, {x_ /; x > 4}],
Length /@ SequenceSplit[list, {x_ /; x <= 4}]]


{{4}, {8, 9, 10}}

Using PositionIndex:

Clear["Global*"];
x = {1, 2, 4, 6, 2, 3, 4, 5, 7, 9, 1, 3, 4, 1};
PositionIndex[x] // KeySelect[# > 2 &] // Values // Flatten // Union //
Split[#, #2 - #1 == 1 &] &


{{3, 4}, {6, 7, 8, 9, 10}, {12, 13}}

Using SequenceCases and defining a ConsecutiveQ function:

ConsecutiveQ[list_List] := MatchQ[list, Range[Min[list], Max[list]]]

l = {1, 2, 4, 6, 2, 3, 4, 5, 7, 9, 1, 3, 4, 1};

SequenceCases[Flatten@Position[l, n_ /; n > 2], {__}?ConsecutiveQ]

(*{{3, 4}, {6, 7, 8, 9, 10}, {12, 13}}*)

– Syed
Commented Jan 1 at 3:29
• See the update, please! :-) Commented Jan 1 at 3:42
Clear[g]
g[list_, limit_] := Module[{l, l2},
l = (list - limit);
l2 = Unitize[l] UnitStep[l] Range[Length[list]];
Split[l2, #1 != 0 && #2 != 0 &] /. {0} -> Sequence[]];

g[x, 2]
(*{{3, 4}, {6, 7, 8, 9, 10}, {12, 13}}*)


Testing it with Leonid Shifrin (with only one limit):

g[lrgTest, 250] // Length // AbsoluteTiming
(*{1.25263, 187504}*)

list = {1, 2, 4, 6, 2, 3, 4, 5, 7, 9, 1, 3, 4, 1};


Using FindRanges by an Pöschko (Wolfram Research)

FindRanges = ResourceFunction["FindRanges"];

Range @@@ FindRanges[Flatten @ Position[list, x_ /; x > 2]]


{{3, 4}, {6, 7, 8, 9, 10}, {12, 13}}

x = {1, 2, 4, 6, 2, 3, 4, 5, 7, 9, 1, 3, 4, 1};
y = Flatten[Position[x, _?(# > 2 &)]];
z = SplitBy[
Differences[y], # > 1 &] /. {a : {1, ___} :>
Total[a], {_?(# > 1 &)} :> Nothing};
FoldPairList[TakeDrop, y, z + 1]


-> {{3, 4}, {6, 7, 8, 9, 10}, {12, 13}}