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.)

Yes, I believe you need to break it up using Partition. It's not unreasonable to wonder if Position works with patterns such as __ or ___, but I believe it looks at elements one by one, and matches them against the pattern one by one. __ would require a global match. I think Positon[arr, pattern] does an equivalent of Do[If[MatchQ[arr[[i]], pattern], Sow[i]], {i, Length[arr]}]. — Szabolcs, Mar 27 '15 at 01:07

ciao · Accepted Answer · 2015-03-27T06:06:58.140

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:

enter image description here

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.

+1 But please change the color of the f3 curve – Dr. belisarius Mar 27 '15 at 04:27 — Dr. belisarius, Mar 27 '15 at 04:27

score 6 · Answer 2 · edited May 23 '17 at 12:35

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.

score 4 · Answer 3 · answered Mar 27 '15 at 01:31

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

score 4 · Answer 4 · answered Mar 27 '15 at 04:38

4

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`

answered Mar 27 '15 at 04:38

ubpdqn

60,617
3
59
148

score 3 · Answer 5 · answered Dec 25 '23 at 17:38

3

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

Using SequencePosition (new in 10.1)

Last /@ SequencePosition[list, {a_ /; a < 80, b_ /; b >= 80}]

{4, 6, 16}

answered Dec 25 '23 at 17:38

eldo

67,911
5
60
168

score 3 · Answer 6 · answered Mar 27 '15 at 01:26

3

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 *)

answered Mar 27 '15 at 01:26

Dr. belisarius

115,881
13
203
453

2

This made me giggle, +1. – ciao Mar 27 '15 at 04:23
1

@rasher That was the (not) hidden intention :) – Dr. belisarius Mar 27 '15 at 04:24

score 2 · Answer 7 · answered Dec 25 '23 at 18:21

Using SequenceCases and SubsetPosition:

list = {57, 3, 40, 94, 9, 84, 81, 93, 76, 5, 7, 76, 38, 9, 23, 95, 49, 0, 30, 3};
pairs = Alternatives @@ SequenceCases[list, {x_, y_} /; x < 80 <= y]
({40, 94} | {9, 84} | {23, 95})
Union@(Last @@@ SubsetPosition[list, pairs])
({4, 6, 16})

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

7 Answers7