Find zero crossing in a list

There are different kinds of zero crossings:

  • ..., -1, 1, ... is a crossing between two values
  • ..., -1, 0, 1, ... is a crossing at a zero
  • ..., -1, 0, 0, ..., 0, 1, ... is a crossing for a range of zeros

and non zero crossings:

  • ..., -1, 0, -1, ... is not a (transverse) crossing at all
  • ..., -1, 0, 0, ..., 0, -1, ... is not a crossing either
  • 0, 0, ..., 1, ... is not a crossing
  • ..., 1, 0, 0, ..., 0 is not a crossing.

Thus, the output ought not to be just a single index for each crossing, but an interval of indexes. E.g., for {-2,-1,0,1,2,3,4,3,1,-2,-4,8,9,10} the output should be the set of ranges {2,4}, {9,10}, and {11,12}. From those you can select a unique value for the crossing if you must. (The mid-range of each would be a good choice, giving {3, 9.5, 11.5} instead of {3, 10, 12}.)

The procedure to find these intervals is not difficult or inefficient, but it might seem a little tricky, so the following code breaks it into simple steps and saves each step for inspection.

zeroCrossings[l_List] := Module[{t, u, v},
  t = {Sign[l], Range[Length[l]]} // Transpose; (* List of -1, 0, 1 only *)
  u = Select[t, First[#] != 0 &];               (* Ignore zeros *)
  v = SplitBy[u, First];                        (* Group into runs of + and - values *)
  {Most[Max[#[[All, 2]]] & /@ v], Rest[Min[#[[All, 2]]] & /@ v]} // Transpose
]

Example

zeroCrossings[l = {0, -1, 1, -2, 0, 0, -1, 0, 0, 0, 1, 0, 1, 0, 2, -1, -3, 0, 0}]

{{2, 3}, {3, 4}, {7, 11}, {15, 16}}

This approach has a laudable symmetry: when the list is presented in reverse, we obtain exactly the same set of zero crossings (which is not the case for the example in the question):

Reverse /@ Reverse[Map[Length[l] + 1 - # &, zeroCrossings[Reverse[l]], {2}]]

{{2, 3}, {3, 4}, {7, 11}, {15, 16}}


Zeros can be removed from the original list, provided that we keep track of the positions of the remaining numbers. Then we only need to detect when the sign changes from one remaining number to the next. 

zeroCrossings[l_] := 
  Module[{z, nz},
    z[v_] := Complement[Range[Length[v]], Flatten@Position[v, 0]];
    nz[[{#, # + 1}]] & /@ z[Differences[Sign@l[[(nz = z[l])]]]]
  ]

Example

Using whuber's list:

zeroCrossings[{0, -1, 1, -2, 0, 0, -1, 0, 0, 0, 1, 0, 1, 0, 2, -1, -3, 0, 0}]

{{2, 3}, {3, 4}, {7, 11}, {15, 16}}

Analysis

The list:

l = {0, -1, 1, -2, 0, 0, -1, 0, 0, 0, 1, 0, 1, 0, 2, -1, -3, 0, 0}

Positions of the non-zero values in the list:

Complement[Range[Length[l]], Flatten@Position[l, 0]]

{2, 3, 4, 7, 11, 13, 15, 16, 17}

The Non-zero numbers themselves:

l[[%]]

{-1, 1, -2, -1, 1, 1, 2, -1, -3}

Signs of the non-zero numbers:

Sign[%]

{-1, 1, -1, -1, 1, 1, 1, -1, -1}

Differences between the signs of the non-zero numbers. Non-zero differences, of which there are 4, signal zero-crossings.

Differences[%]

{2, -2, 0, 2, 0, 0, -2, 0}

Starting positions for the zero-crossings :

Complement[Range[Length[%]], Flatten@Position[%, 0]]

{1, 2, 4, 7}

The positions where the zero crossings begin:

{2, 3, 4, 7, 11, 13, 15, 16, 17}[[%]]

{2, 3, 7, 15}


Optimizations

Here is a refactoring and optimization of whuber's method. It uses SparseArray Properties to quickly find all non-zero positions, and recasts the Split operation as a generic one which is faster than Split with a custom test function or SplitBy. It then splits the actual list of positions using my dynamicPartition function from Partitioning with varying partition size.

zeroCrossings3[a_List] :=
  With[{idx = SparseArray[a]["AdjacencyLists"]},
    {Max /@ Most@#, Min /@ Rest@#}\[Transpose] & @
      dynamicPartition[idx, Length /@ Split @ Sign[a][[idx]] ]
  ]

Here is an optimized version of David's method, also leveraging SparseArray Properties:

davidZC2[l_] := SparseArray[#]["AdjacencyLists"] & /. SApos_ :>
  With[{c = SApos[l]}, {c[[#]], c[[# + 1]]}\[Transpose] & @ 
    SApos @ Differences @ Sign @ l[[c]]
  ]

Timings

Here are comparative timings for my refactored code versus the originals. I renamed David's function davidZC to differentiate it from whuber's function.

SetAttributes[timeAvg, HoldFirst]
timeAvg[func_] := Do[If[# > 0.3, Return[#/5^i]] & @@ Timing@Do[func, {5^i}], {i, 0, 15}]

SeedRandom[7]
a = Accumulate @ RandomInteger[{-1, 1}, 1500000];

zeroCrossings[a]  // timeAvg
zeroCrossings3[a] // timeAvg

2.246

0.0718

davidZC[a]  // timeAvg
davidZC2[a] // timeAvg

1.123

0.03244

About 1.5 orders of magnitude faster than the original in both cases. David's method is an improvement upon whuber's, being twice as fast in this test.

Tags:

Pattern Matching

List Manipulation

Recent Posts