Finding negative sequences in a large list: optimization

Question

I ran across an interesting challenge recently, and I was thinking this community would know how to optimize it.

I have several data sets which have (currently) about 50k-100k points. The sets contain sequences of consecutive positive and negative real numbers, and I'm interested in finding the position where the sequences of negative numbers begin and end (or where the positive sequences begin and end; it is the same problem).

In the near future, these sets will be comes 500k points, or 1000k +. This isn't a struggle for a modern PC but I'd like to write efficient code for beauty's sake anyway.

Being a novice, I wrote this, which works well thanks to the "vanishing function":

testlist // Dimensions

32827

Table[
  If[
    testlist[[i]]*testlist[[i + 1]] < 0,
    i,
    ## &[]
  ]
  , {i, 1, Length[testlist] - 1}]

But, realizing that Table is typically the slowest way to do something in Mathematica, I wrote this, using the same logic operations:

negPos[list_] := 
  If[list[[#]]*list[[# + 1]] < 0, #, ## &[]] & /@ Range[Length[list] - 1]

Both achieve a similar processing time:

Timing[
  Table[
    If[testlist[[i]]*testlist[[i + 1]] < 0, i, ## &[]], 
    {i, 1, Length[testlist] - 1}];]

{0.171875, Null}

Timing[negPos[testlist];]

{0.140625, Null}

But, considering that both run in O[n] time, I would think they could be much faster. I'm too new to Mathematica to know how to optimize either the logic test or memory usage. Does someone know how to optimize this problem?

Answer 1

Code

Using the very fast function intervals from this post by Mr.Wizard,

intervals[a_List] := 
  {a[[Prepend[# + 1, 1]]], a[[Append[#, -1]]]}\[Transpose] &@
     SparseArray[Differences@a, Automatic, 1]["AdjacencyLists"]

We can write:

negativePositions[lst_] := 
  intervals[
     Flatten@SparseArray[UnitStep[lst], Automatic, 1]["NonzeroPositions"]
  ]

Explanation

Let's briefly discuss how this works. The code inside of intervals in negativePositions efficiently finds positions of all negative numbers in the original list. Basically,UnitStep converts all negative numbers to zeros, and all non-negative numbers to ones. Then, SparseArray[data, Automatic, 1] converts the result into a sparse array with the default element 1. The "NonzeroPositions" property of SparseArray give all positions of non-default elements in an array. Since we made 1 a default element, this will find positions of all zeros, which correspond to negative numbers of the original array.

Then, the intervals function takes a sequence of positions (numbers), and combines consecutive numbers, keeping only the first and last of them (thus, intervals). So, it gives us the intervals of positions of negative numbers in the original list, as requested.

Benchmarks

Let us take a sample of a million numbers:

largeTest = RandomInteger[{-100,100},1000000];

We get the result in just a tiny fraction of a second:

negativePositions[largeTest]//Short//AbsoluteTiming

(* 
  {0.078232,{{2,6},{14,14},{16,16},<<250258>>,{999990,999991},{999994,999995},{999998,999999}}}
*)

Answer 2

This is essentially the same algorithm as Leonid's but implemented in terms of Pick instead of sparse arrays:

negativePositions2[lst_] := Module[{a, b},
  a = Pick[Range[Length[lst]], UnitStep[lst], 0];
  b = UnitStep[Differences[a]~Subtract~2];
  Transpose[{Pick[a, b~Prepend~1, 1], Pick[a, b~Append~1, 1]}]]

Answer 3

Leonid's answer is as impressive as it is too advanced for me (a lot). For lesser mortals like me, not as fast but still acceptable performance:

largeTest = RandomInteger[{-100,100},1000000];

a quarter of a second performance for a million length list:

Transpose[{#, Append[Rest[# - 1], Length@#]}] &
    [FoldList[Plus, 1, Length /@ Split@Sign@largeTest]]; 
    // Most//AbsoluteTiming

(*0.243415,Null*)