How to find position where a sequence drops off to zero

Question

Suppose I have a sequence

seq = {0,0,0,1,2,3,1,0,0,0,4,5,8,0}

and I want to find the first position after which the sequence drops to zero (which in this case, is position 7).

Obviously if I want to find all the nonzero elements I could use something like

SparseArray[seq]["NonzeroPositions"]

or even

Position[seq,_?(# > 0 & )]

But what about the place where the sequence drops to zero for the first time, which apparently involves at least two conditionals?

Answer 1

SequencePosition[seq,{_?Positive,0}][[1,1]]

or

Min@SequencePosition[seq, {_?Positive, 0}] (*thanks: corey979 *)

7

To get the position of the first zero preceeded by a positive number:

SequencePosition[seq,{_?Positive,0}][[1,2]]

or

Max@SequencePosition[seq, {_?Positive, 0}, 1]

8

For versions before 10.1, you can use Cases

Cases[seq,{a___,b:Except[0],0,___}:>Length[{a,b}],{0,Infinity}][[1]]

7

Answer 2

I am not sure I quite understand the question.

"I want to find the first position where the sequence drops to zero"

From this description and looking at sequence I would select position 8 rather 7 for that location.

seq = {0,0,0,1,2,3,1,0,0,0,4,5,8,0}

I infer that you want non-zero digits followed by a zero and want the location of that zero.

Here is something that is not elegant but works

First@Select[
  Flatten@Position[seq, 0] ,
  # > First@Flatten@Position[seq, x_ /; x != 0] &
  ]

(* 8 *)

To break it down

Flatten@Position[seq, 0]
(* {1, 2, 3, 8, 9, 10, 14} *)

gives the zero positions and

Flatten@Position[seq, x_ /; x != 0]
(* {4, 5, 6, 7, 11, 12, 13} *)

gives the non-zero positions, the first of these is position 4.

I want to select from the group of zero positions the location which first exceeds the first non-zero digit (4), which is 8 for this example.

First@Select[
  Flatten@Position[seq, 0] ,
  # > First@Flatten@Position[seq, x_ /; x != 0] &
  ]

Answer 3

Very straightforward:

i = 1;
While[Not[seq[[i]] > seq[[i + 1]] && seq[[i + 1]] == 0], i++]
i

7

---

Timings

n = 10^4;
seq = Insert[RandomInteger[{1, 9}, n], 0, n - RandomInteger[{10, 100}]];

Position[seq, 0]

{{9919}}

kglr's answer:

SequencePosition[seq, {_?Positive, 0}][[1, 1]] // RepeatedTiming
Min@SequencePosition[seq, {_?Positive, 0}] // RepeatedTiming

{0.00239, 9918}

{0.00239, 9918}

SequencePosition[seq, {_?Positive, 0}][[1, 2]] // RepeatedTiming
Max@SequencePosition[seq, {_?Positive, 0}, 1] // RepeatedTiming

{0.00239, 9919}

{0.00237, 9919}

Cases[seq, {a___, b : Except[0], 0, ___} :> Length[{a, b}], 
    {0, Infinity}][[1]] // RepeatedTiming

{0.00071, 9918}

Cases is the fastest, and an order of magnitude faster than SequencePosition.

Jack LaVigne's answer:

First@Select[
   Flatten@Position[seq, 0], # > 
     First@Flatten@Position[seq, x_ /; x != 0] &] // RepeatedTiming

{0.0091, 9919}

march's answer:

FirstPosition[seq /. {y : Longest[0 ..], x__} :> Join[{y} + 1, {x}], 
   0] - 1 // RepeatedTiming

{0.281, {9918}}

The slowest method.

FirstPosition[Partition[seq, 2, 1], {Except[0], 0}] // RepeatedTiming

{0.0023, {9918}}

J.M.'s comment:

Length[First[Split[seq, #1 <= #2 || #2 != 0 &]]] // RepeatedTiming

{0.00608, 9918}

---

My answer:

(i = 1; While[Not[seq[[i]] > seq[[i + 1]] && seq[[i + 1]] == 0], i++];
   i) // RepeatedTiming

{0.01701, 9914}

9918

Not competitive in timing, but straightforward in coding.

Answer 4

FirstPosition[seq /. {y : Longest[0 ..], x__} :> Join[{y} + 1, {x}], 0] - 1

The pre-processing could probably be done in a nicer way.

In the interest of finding a better way of using FirstPosition, I hit upon the following, which still requires pre-processing, but this time it doesn't require pattern-matching in the pre-processing:

FirstPosition[Partition[seq, 2, 1], {Except[0], 0}]