3
$\begingroup$

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?

$\endgroup$

1 Answer 1

2
$\begingroup$
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}}*)
$\endgroup$
1
  • $\begingroup$ 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. $\endgroup$
    – user6546
    Commented Feb 20 at 16:13

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.