3
$\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$
  • 1
    $\begingroup$ perhaps SequencePosition ? For example, SequencePosition[#,{x_,y_}/; x>y]&@{1, 2, 3, 4, 7, 4} $\endgroup$ – kglr Mar 12 '17 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 '17 at 10:19
  • $\begingroup$ @Mr.Wizard, please do post it. $\endgroup$ – kglr Mar 12 '17 at 10:24
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$
  • 1
    $\begingroup$ f6 = Length@First@Split[#, Less] &; $\endgroup$ – Alexey Popkov Mar 12 '17 at 10:43
  • $\begingroup$ @AlexeyPopkov Are you not going to post that as an answer? $\endgroup$ – Mr.Wizard Mar 12 '17 at 10:43
  • $\begingroup$ It is better if you include this in yours. $\endgroup$ – Alexey Popkov Mar 12 '17 at 10:44
  • $\begingroup$ @Alexey With credit, I will. $\endgroup$ – Mr.Wizard Mar 12 '17 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$ – Anjan Kumar Mar 12 '17 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$
  • $\begingroup$ May I add your functions to my benchmark? $\endgroup$ – Mr.Wizard Mar 12 '17 at 10:40
  • $\begingroup$ @Mr.Wizard, of course -- i am afraid :) $\endgroup$ – kglr Mar 12 '17 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 '17 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 '17 at 13:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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