How do I write a condition for Position that uses both the current and previous element?

Question

For example, given

{57, 3, 40, 94, 9, 84, 81, 93, 76, 5, 7, 76, 38, 9, 23, 95, 49, 0, 30, 3}

I'd like to get all the indices at which the elements cross from below 80 to above (or equal to) 80:

{4, 6, 16}

To do so I need the previous element at each current element of the condition.

All the examples for Position seem to use a single Slot, or higher Slots for nested lists, which makes me think maybe there's not a direct way. Do I have to use something like Partition to generate pairs, first? (If so, then I can take it from there; I just wanted to know if Position could do it with some syntax I don't know how to use, e.g. BlankSequence and such.)

Answer 1

Just a quick-n-dirty, for huge lists there's faster ways, will update when time permits.

f = With[{s = Split[#, #1 < 80 && #2 >= 80 &]}, 
    Pick[Accumulate@(Length /@ s), Length /@ s, 2]] &;

f@{57, 3, 40, 94, 9, 84, 81, 93, 76, 5, 7, 76, 38, 9, 23, 95, 49, 0, 30, 3}

(* {4, 6, 16} *)

For large lists, this should be quite snappy:

f4 = With[{p = Partition[#, 2, 1]},
    Pick[Range@Length@p + 1, UnitStep@Subtract[p, 80], {0, 1}]] &;

Even faster:

f5 = Module[{o = Ordering[Join[{80}, #]], c},
    c = First@Pick[Range@Length@o, o, 1];
    Subtract[Intersection[o[[;; c - 1]] + 1, o[[c + 1 ;;]]], 1]] &;

And speedier yet:

f3 = Module[{p},
    p = Pick[Range@Length@#, UnitStep[Subtract[#, 80]], 1];
    If[p =!= {} && p[[1]] == 1, p = Rest@p];
    p[[Pick[Range@Length@p, 
       UnitStep@Subtract[#[[Subtract[p, 1]]], 80], 0]]]] &;

As a comparison, the other answers (so far):

sza = ReplaceList[#, {pre___, x_, y_, ___} /; x < 80 <= y :> 
     Length[{pre}] + 2] &;

kug1 = With[{lst = #}, 
    Select[Range[2, Length@lst], lst[[# - 1]] < 80 <= lst[[#]] &]] &;

kug2 = With[{lst = #}, 
    Pick[Range[2, Length@lst], 
     lst[[# - 1]] < 80 <= lst[[#]] & /@ Range[2, Length@lst]]] &;

ubp = (Flatten@Position[Partition[Sign[# - 80], 2, 1], {-1, 1 | 0}] + 
     1) &;

N.B.: The first three have been fixed to return results as in OP - as written they were not. The 0 alternative was added to ubpdqn`s solution to handle equality.

Using test = RandomInteger[{0, 160}, 110000]; as a test list that will have many transitions, and incrementally increasing the amount of it used:

It can be seen the Replace based solution quickly becomes unusably slow, Kguler's both perform well (and remarkably similarly), f leads those by roughly 50%, f4 is about 4X faster yet, ubpdqn's Sign-based solution falls neatly between f and f4, f5 beats those, and f3 handily beats all (it's buried in the noise of the plot). As usual, all timings on the loungebook.

Answer 2

There is no way to do this with Position without breaking the list up using Partition[list, 2, 1] first. Position looks at elements one by one, and tests each for a match against the pattern. While we can use a pattern such as __ (BlankSequence[]), it won't behave any differently from _ (Blank[]) in Position because it will never be tested against the full list, only against individual list elements.

A trick to use a single pattern matching to find positions of correlated elements is described here, but it doesn't use Position. Applied to your problem, we get:

ReplaceList[list, {pre___, x_, y_, ___} /; x < 80 <= y :> Length[{pre}] + 1]

This is probably not the best way to solve the problem, but it is interesting in that it fully relies on pattern matching, just like Position.

Answer 3

Perhaps:

test = {57, 3, 40, 94, 9, 84, 81, 93, 76, 5, 7, 76, 38, 9, 23, 95, 49,
    0, 30, 3};
Position[Partition[Sign[test - 80], 2, 1], {-1, 1}] + 1

The +1, to get when crossed, would have to modify for equality cases, eg using Alternatives`

Answer 4

lst = {57, 3, 40, 94, 9, 84, 81, 93, 76, 5, 7, 76, 38, 9, 23, 95, 49,  0, 30, 3}
Select[Range[2, Length@lst], lst[[# - 1]] < 80 < lst[[#]] &]
(* {4, 6, 16} *)

Pick[Range[2, Length@lst], lst[[# - 1]] < 80 < lst[[#]] & /@ Range[2, Length@lst]]
(* {4, 6, 16} *)

Answer 5

Just using a chisel to drive a screw:

l = {57, 3, 40, 94, 9, 84, 81, 93, 76, 5, 7, 76, 38, 9, 23, 95, 49, 0,  30, 3};
f = Interpolation[l, InterpolationOrder -> 1]
NDSolve[{k'[x] == f'@x, k[1] == f[1], 
         WhenEvent[k[x] == 80, If[f'[x] >= 0, Print[Ceiling@x]]]},
         k[x], {x, 1, Length@l}]

(* 4,6,16 *)