Find zero crossing in a list

Question

I'm looking for a function that finds the index of the zero-crossing points of a list. Before I go making my own subroutine to do this, I was wondering if anyone knows of any built-in Mathematica function for it.

Example of what I want:

list = {-2,-1,0,1,2,3,4,3,1,-2,-4,8,9,10};
ZeroCrossing[list] returns: {3,10,12}

Thanks,

EDIT:

Per whuber's suggestion, I'm adding my findings to the initial question, instead of just in a solution.

I've checked LabVIEW (the other language I know well), and it considers "Bounces" ({1,0,2}, {-2,0,1}) and duplicates ({1,0,0,2}) to be zero-crossings. It outputs a T/F value for each array index.

Example:

ZeroCrossing[{1,0,2}]
(* Returns: {F,T,T} *)
ZeroCrossing[{1,0,0,2,3}]
(* Returns: {F,T,T,T,F} *)

Answer 1

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}}

Answer 2

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}

Answer 3

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.

Answer 4

Here's another way:

list = {-2, -1, 0, 1, 2, 3, 4, 3, 1, -2, -4, 8, 9, 10};
f = Interpolation[list, InterpolationOrder -> 0];
zeroCrossings = Reduce[(Sign[f[i]] Sign[f[i - 1]] < 0 || Sign[f[i]] Sign[f[i - 1]] == 0) && 
    1 < i < Length@list - 1, i, Integers] /. {x_Equal :> Last@x, Or -> List}
(* {3, 4, 10, 12} *)

You can see that it gets the positions, but the presence of a zeros in the third position introduces an ambiguity – did it cross zero when it when from -1 to 0 or 0 to 1? This can be easily handled though:

First /@ Split[zeroCrossings, #2 - #1 == 1 &]
(* {3, 10, 12} *)

Answer 5

Possible contenders for beauty and speed contests are covered by previous answers. There remains few in the "there is also" category with modest, if any, claims for speed or beauty. Among them is ReplaceList using rules that represent the required patterns:

Define

crsngsRL = Function[{list, pattern},
    ReplaceList[list,
    {a__, b : Alternatives @@ PatternSequence @@@ pattern, ___}
       :> {1 + Length[{a}], Length[{a}] + Length[{b}]}]]

Using @whuber's test list:

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

crsngsRL[lW,{{_?Negative,(0)..., _?Positive}, {_? Positive, (0) ...,_?Negative}}]
crsngsRL[Sign /@ lW, {{-1, (0) ..., 1}, {1, (0) ..., -1}}]
(* {{2, 3}, {3, 4}, {7, 11}, {15, 16}} *)

Further examples with alternative definitions of "crossing" :

crsngsRL[lW, {{_?NonNegative, _?Negative}, {_?NonPositive, _?  Positive}}] 
(* {{2, 3}, {3, 4}, {6, 7}, {10, 11}, {12, 13}, {14, 15}, {15, 16}} *)
crsngsRL[lW, {{_?NonNegative, _?NonPositive},{_?NonPositive, _?NonNegative}}]
(* {{2, 3}, {3, 4}, {4, 5}, {5, 6}, {6, 7}, {7, 8}, {8, 9}, {9, 10}, 
    {10, 11}, {11, 12}, {12, 13}, {13, 14}, {14, 15}, {15, 16}, 
    {17, 18}, {18, 19}} *)
crsngsRL[lW, {{_?Negative, _?Positive}, {_?Positive, _?Negative}}]
(* {{2, 3}, {3, 4}, {15, 16}} *)

Zero-bounces:

crsngsRL[Sign /@ lW, {{-1, (0) ..., -1}, {1, (0) ..., 1}}]
(* {{4, 7}, {11, 13}, {13, 15}, {16, 17}} *)

Up-crossings (from a negative to a positive number possibly through a sequence of zeros):

crsngsRL[Sign /@ lW, {{-1, (0) ..., 1}}]
(* {{2, 3}, {7, 11}} *)

Down-crossings (from a positive to a negative number possibly through a sequence of zeros):

crsngsRL[Sign /@ lW, {{1, (0) ..., -1}}]
(* {{3, 4}, {15, 16}} *)    

Update: Crossing other numbers, say 1 (instead of 0):

crsngsRL[lW, {{_?(# < 1 &), (1)..., _?(# > 1 &)}, {_?(# > 1 &), (1)..., _?(# < 1 &)}}]
(* or *) crsngsRL[Sign /@ (lW - 1), {{1, (0) ..., -1}, {-1, (0) ..., 1}}]
(* {{14, 15}, {15, 16}} *)

Crossing another list:

Let

 lW2 = {0, 2, 1, -2, 0, -1, -1, 0, 0, -1, 1, 0, 1, 0, 2, 2, -3, 0, 0};

The points where the list lW crosses lW2 from above or from below are:

 crsngsRL[Sign /@ (lW - lW2), {{1, (0) ..., -1}, {-1, (0) ..., 1}}]
 (* {{2, 6}, {10, 16}}  *)

Answer 6

Sadly, the built-in functions for this don't give the answers you're looking for.

Position[Normal[ContourDetect[list]], 1] 

{{3}, {9}, {12}}

that 9 should be a 10.

Position[Normal[CrossingDetect[list]], 1]

{{9}, {12}}

Answer 7

If there are no zeros, a simple function based on DavidC's answer works fine:

list = {-2, -1, 0, 1, 2, 3, 4, 3, 1, -2, -4, 8, 9, 10};
Flatten[Position[Abs[PadLeft[Differences[Sign[list]], Length[list]]],2]]

This returns {10, 12}. With a slight modification, it returns the correct positions even if there are zeros:

list = {-2, -1, 0, 1, 2, 3, 4, 3, 1, -2, -4, 8, 9, 10};
Flatten[Position[Abs[PadLeft[Differences[Sign[list + 10^-999]], Length[list]]], 2]]

This returns {3, 10, 12}

Of course, if you are working in the range of numbers around 10^-999, use something even smaller.

Answer 8

1. Map the number list to a sign list
2. Pattern match zero crossing sublists
3. Find positions of zero crossing sublists

In:

xs = {-2, -1, 0, 1, 2, 3, 4, 3, 1, -2, -4, 8, 9, 10};
ys = {0, -1, 1, -2, 0, 0, -1, 0, 0, 0, 1, 0, 1, 0, 2, -1, -3, 0, 0};

zeroCrossing[xs_] := Module[{b, xss, yss, pattern, patterns},
  xss = Subsequences@Sign@xs;
  pattern[b_] = {-b, x___, b} /; x == Nothing || AllTrue[{x}, # == 0 &];
  patterns = pattern /@ {1, -1};
  yss = Cases[xss, #] & /@ patterns // Catenate // Union;
  SequencePosition[Sign@xs, #] & /@ yss // Catenate // SortBy[First]]

zeroCrossing@xs
zeroCrossing@ys

Out:

{{2, 4}, {9, 10}, {11, 12}}
{{2, 3}, {3, 4}, {7, 11}, {15, 16}}