# Quickly processing long lists using SequencePosition

Overview SequencePosition does exactly what I need; however, it seems to be very slow for long lists. Is there an input option that would allow it to process faster? Or, perhaps an alternative function to use? If not, I have written a simple code to perform this task,any recommendation to improve this code?

Details In this case I have a long list with 0s and 1s. I want to make a list of position pairs indicating the beginning and end of each sequence of 1s within the list.

For example, for the list: {0, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 0}, the list of position pairs would be: {{2,3},{5,7}, {10,11}}.

Example Processing with SequencePosition -- base cases, possible combinations of where lists of 1s start and stop.

listA = {0, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 0};
listB = {1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 0};
listC = {1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1};
listD = {0, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1};
listE = {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1};
listF = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
listAll  = {listA, listB, listC, listD, listE, listF};

vPosAll =
SequencePosition[#, {Repeated[1]}, Overlaps -> False] & /@ listAll;
Framed[TableForm[#]] & /@ vPosAll

(*results are as expected*)


Processing with SequencePosition -- long list. Haven't seen this return a result

listLong = RandomInteger[1, 300000];
{timeLong, vPosLong } =
Timing[SequencePosition[listLong, {Repeated[1]}, Overlaps -> False]]

(*takes a long time to process*)


Alternative Write a function to identify the beginning and end of each list of 1s within the long list.

find01Lists[vIn_] := Module[{v01, v10
, has1Q, firstIs1, lastIs1, n01, n10},

(*catch case when the list does not contain a 1*)
has1Q = First@FirstPosition[#, 1, {-1}] > 0 & @ vIn;
If[! has1Q, Return[{-1, -1}]];

(*find the positions where the sequence begins*)
v01 = SequencePosition[vIn, {0, 1}, Overlaps -> False];
(*find the positions where the sequence end*)
v10 = SequencePosition[vIn, {1, 0}, Overlaps -> False];

(*adjust lists, if the sequence begins or ends at the edge*)
{firstIs1, lastIs1} = {MatchQ[First@#, 1], MatchQ[Last@#, 1]} & @
vIn;
If[firstIs1, PrependTo[v01, {1, 1}]];
If[lastIs1, AppendTo[v10, {Length@testList, Length@testList}]];

(*check for errors: length of the lists should be the same*)
If[ Length@v01 != Length@v10, Return[{-1, -1}]];

(*return results*)
Table[{Last@v01[[i]], First@v10[[i]]}, {i, 1, Length@v01}]
]


Apply the function to the example lists

(*test with the examples*)
Framed[{Framed@
TableForm[{Prepend[Range@Length@#, "index:"],
Prepend[#, "data:"]}], find01Lists[#]}] & /@ listAll

(*results are as expected*)


Apply the function to a long list

(*test with a long list*)
longList = RandomInteger[1, 300000];
{timeLongList, posLongList} = Timing[find01Lists[listLong]];
timeLongList
(*reports about 0.1 seconds of processing time*)

(*check first 25 results -- should only see 1 in the extracted lists*)
listLong[[First@# ;; Last@#]] & /@ Take[posLongList, 25]  // TableForm

(*results as expected*)


Question Is there a way to achieve this result more elegantly with built in functions?

v={0,1,1,0,1,1,1,0,0,1,1,0};
Transpose[Lookup[PositionIndex@Differences@Join[{0},v,{0}],{1,-1},{}]-{0,1}]

(*{{2, 3}, {5, 7}, {10, 11}}*)

• Thanks! this is what I was looking for. It handles all special cases and on my system it can process a list with a million entries in less than 0.05 seconds. Feb 20 at 16:13