4
$\begingroup$

My question is very simple but I am not able to find the optimal solution. What I am trying to do is to have a function that give me the position in a list at which the value at position i is bigger than at position i+1. I need only the first of such term since afterwards, I will commute the two via another a function and then test again if everything is ordered. Basically, I am searching for

In[] : findpos[{1,2,3,4,7,4}]
Out [] : 5

My current solution is the following

findpos[a_] := 
Module[{index = {}}, 
For[i = 1, i <= Length[a] - 1, i++, If[a[[i]] > a[[i + 1]], index = Append[index, i]]]; 
Return[First[index]]]

which gives

findpos[{1,2,3,4,7,4}]
5

I will have to call this function maybe many time, so I would like something which run fast and I am almost convinced that a module + a For loop will not be the optimal solution speaking of computation time. I looked at many other questions somehow related ; especially this one How to find the position of elements in a list satisfying criteria

I think I am searching for something of the form

Position[{2, 4, 6, 8, 10}, _?(# > 7 &)]     

But who compare two elements instead of each element to a scalar. I tried to adapt it to my case without success. I tried something of the form

Position[{4, 5, 2, 1}, _?(#1 >= #2 &)]

Any suggestion ?

$\endgroup$
3
  • 1
    $\begingroup$ perhaps SequencePosition ? For example, SequencePosition[#,{x_,y_}/; x>y]&@{1, 2, 3, 4, 7, 4} $\endgroup$
    – kglr
    Mar 12, 2017 at 10:19
  • $\begingroup$ @kglr I was just about to post that when your comment popped up! I think I still will. I hope you don't mind. $\endgroup$
    – Mr.Wizard
    Mar 12, 2017 at 10:19
  • $\begingroup$ @Mr.Wizard, please do post it. $\endgroup$
    – kglr
    Mar 12, 2017 at 10:24

2 Answers 2

6
$\begingroup$

A couple of these methods were incorrect, one terribly so. I believe they are now corrected.


Here are some different ideas:

f1 = SequencePosition[#, {a_, b_} /; a > b, 1][[1, 1]] &;
f2 = Select[Range@Length@#, x \[Function] #[[x]] > #[[x + 1]], 1][[1]] &;
f3 = Module[{i}, LengthWhile[#, # >= i && (i = #; True) &]] &;
f4 = Position[UnitStep@Differences@#, 0, 1, 1][[1, 1]] &;
f5 = SparseArray[UnitStep@Differences@#, Automatic, 1]["AdjacencyLists"][[1]] &;

#[{1, 2, 3, 4, 7, 4}] & /@ {f1, f2, f3, f4, f5}
{5, 5, 5, 5, 5}
#[{2, 2, 5, 4, 7, 4}] & /@ {f1, f2, f3, f4, f5}
{3, 3, 3, 3, 3}

And a beautifully terse one from Alexey Popkov:

f6 = Length@First@Split[#, LessEqual] &;

Benchmarking

A benchmark with the position one third of the way through the list.

Including kglr's functions, and now on a packed array where performance can be highest.

Needs["GeneralUtilities`"]

BenchmarkPlot[
  {f1, f2, f3, f4, f5, f6, fa, fb, fc, fd}, 
  ReplacePart[Sort@RandomReal[1, #], ⌈#/3⌉ -> 2`] &,
  10,
  ImageSize -> 500
]

enter image description here

Shootout

It seems that the old warhorse SparseArray still rules the noncompiled methods. Let's compare it to a WVM compiled f4:

f4C = Compile[{{x, _Real, 1}}, Position[UnitStep@Differences@x, 0][[1, 1]]];

BenchmarkPlot[
  {f4, f5, f4C},
  ReplacePart[Sort@RandomReal[1, #], ⌈#/3⌉ -> 2`] &,
  10
]

enter image description here

So it seems f5 and f4C are pretty similar once we get past a constant factor in f5. f4C is probably easier for most people to understand, and it might be made faster still with compilation to C.

$\endgroup$
14
  • 1
    $\begingroup$ f6 = Length@First@Split[#, Less] &; $\endgroup$ Mar 12, 2017 at 10:43
  • $\begingroup$ @AlexeyPopkov Are you not going to post that as an answer? $\endgroup$
    – Mr.Wizard
    Mar 12, 2017 at 10:43
  • $\begingroup$ It is better if you include this in yours. $\endgroup$ Mar 12, 2017 at 10:44
  • $\begingroup$ @Alexey With credit, I will. $\endgroup$
    – Mr.Wizard
    Mar 12, 2017 at 10:44
  • 1
    $\begingroup$ @Mr.Wizard For an input of {1, 2, 5, 4, 7, 4}, the functions return {3, 3, 5, 3, 5}. Something seems to be incorrect. $\endgroup$ Mar 12, 2017 at 12:08
4
$\begingroup$

Also

ClearAll[fa, fb, fc, fd]
fa = Position[Partition[#, 2, 1], _?(Greater @@ # &), 1, 1] //. {x_} :> x &;
fb = 1 + LengthWhile[Range@Length@#, Function[{x}, #[[x]] <= #[[x + 1]]]] &;
fc = Block[{i = 1}, While[#[[i]] <= #[[i + 1]], i++]; i] &
fd = FirstPosition[Differences@#,_?Negative][[1]]&

#@{1, 2, 3, 4, 7, 4} & /@ {fa, fb, fc, fd}

{5, 5, 5, 5}

#@{1, 2, 5, 4, 7, 4} & /@ {fa, fb, fc, fd}

{3, 3, 3, 3}

Update: The functions fb, fc and fd above work in cases where a position that satisfies condition exists in the input list. To handle the general case where the output may be empty, they can be modified as follows:

fb2 = 1 + LengthWhile[Range[Length[#]-1], Function[{x}, #[[x]] <= #[[x + 1]]]] /. 
      Length[#] -> {} &;
fc2 = Block[{i = 1}, While[i < Length@# && #[[i]] <= #[[i + 1]], i++];
     i /. Length[#] -> {}] &;
fd2 = FirstPosition[Differences@#, _?Negative][[1]] /. "NotFound" -> {} &;

#@{1, 2, 3, 4, 7, 8} & /@ {fa, fb2, fc2, fd2}

{{}, {}, {}, {}}

$\endgroup$
4
  • $\begingroup$ May I add your functions to my benchmark? $\endgroup$
    – Mr.Wizard
    Mar 12, 2017 at 10:40
  • $\begingroup$ @Mr.Wizard, of course -- i am afraid :) $\endgroup$
    – kglr
    Mar 12, 2017 at 10:44
  • $\begingroup$ I didn't get fd into the benchmark but I'm sure I'll find reason to update it again. edit: Sure enough I realized I was unpacking my reals because I left out a single backtick, so fd is now included. $\endgroup$
    – Mr.Wizard
    Mar 12, 2017 at 10:50
  • $\begingroup$ I guess I better handle that case too now. ;-p But later, I'm tired now. $\endgroup$
    – Mr.Wizard
    Mar 12, 2017 at 13:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.