# How can I get a list of the positions of the running minima in a list?

I want the positions of the (sequential) running minima in a list, that is, the positions of entries that have the minimum value of all the elements in that list, up to and including that entry. For instance, given the list {3,4,4,2,5,5,1}, the output should be {1,4,7}.

• Flatten@Position[list, x_ /; x < 4]? Feb 28, 2015 at 23:29
• What does "new minimum" mean? You probably need Split. Feb 28, 2015 at 23:37
• This question feels familiar; if anyone recalls something similar please link it in these comments. Mar 1, 2015 at 2:52
• @Mr.Wizard: Yeah, I think I had an answer for something similar, will go through my ans. and check...
– ciao
Mar 1, 2015 at 2:58
• Related: (1754), (38325). Somewhat related: (30438) Mar 1, 2015 at 3:09

lst = {3, 4, 4, 2, 5, 5, 1};


Assuming by "new minimum" you mean "running minima", you can use

Accumulate@Most@Join[{1}, Length /@ Split[FoldList[Min, First@lst, Rest@lst]]]
(* {1, 4, 7}  *)


We get the same results with:

Accumulate@Most@Join[{1}, Length /@ Split[FoldList[Min, lst]]] (* thanks: Mr. Wizard *)


and

ReplacePart[#, p : _ :> If[p == 1 || #[[p]] < Min[#[[;; p - 1]]], p, ## &[]]] &[lst]

• At least the first of these answers is incorrect. For input lst = {3, 4, 4, 2, 5, 5, 1, 6, 9, 2}, the output is {1, 4, 7, 10} but note that the final 2 in lst is not a true running minimum (there is a lower 1 earlier in lst) and hence there should be no position 10 in the output. Mar 1, 2015 at 0:58
• Thanks @DavidG.Stork. You are right; only the last one gives the sequential minima (I hope :)). I will delete the first four.
– kglr
Mar 1, 2015 at 1:18
• Mar 1, 2015 at 3:00
• Thank you @Mr.Wizard. The two-argument form also works in version 9.0.1.0 despite the syntax highlighting that suggest missing argument.
– kglr
Mar 1, 2015 at 3:10
• @kguler My self-answer to the linked question above explains how to resolve that. :-) Mar 1, 2015 at 3:13

Update: Something else I came up with, cleaner and generally faster by a goodly margin than below and much faster in my tests against other answers I tested:

f3 = Module[{mp = First@Pick[Range@Length@#,
If[VectorQ[#, IntegerQ], Subtract[#, Min@#],
Unitize@Subtract[#, Min@#]], 0] &, lst = #},
NestWhileList[mp[lst[[;; # - 1]]] &, mp[lst], # != 1 &][[-1 ;; 1 ;; -1]]] &;


I'll leave the earlier attempts for reference.

f = Module[{lst = #,nextpos = 1,
minpos = First@Pick[Range@Length@#,
If[VectorQ[#, IntegerQ], Subtract[#, Min@#],
Unitize@Subtract[#, Min@#]], 0],
rec = First@# + 1, min, v1, v2},

min = lst[[minpos]];

{v1, v2} =
Reap@NestWhileList[lst[[Sow[ nextpos = First@Pick[Range[nextpos, minpos],
UnitStep@Subtract[lst[[nextpos ;; minpos]], #], 0]]]] &,
rec, # != min &];

{Rest@v1, First@v2}] &;

f[{20,30,50,4,5,6,8,2,3,1,0,4}]

(* {{20, 4, 2, 1, 0}, {1, 4, 8, 10, 11}} *)


Returns record values and positions.

Should be order+ magnitude faster on integer lists with duplication, competitive on sparse and/or non-integer ones.

The same short-circuiting can be used to dramatically improve the performance of kguler's answer by simply adding the restriction:

Accumulate@
Most@Join[{1}, Length /@ Split[FoldList[Min, First@lst,
Rest@(lst[[;; First@Pick[Range@Length@lst,
If[VectorQ[#, IntegerQ], Subtract[lst, Min@lst],
Unitize@Subtract[lst, Min@lst]], 0]]])]]]


N.b. - when I checked, a few of the earlier answers appear to return incorrect results...

• f3 tests slow for me. I am using: SeedRandom[1]; list = RandomInteger[9999999, 500000]; list -= Accumulate@RandomInteger[1, 500000]; Mar 1, 2015 at 8:51
• Hm... wait, now your older f also seems slower even after a restart. Would you test my new method please? Mar 1, 2015 at 8:53
• @Mr.Wizard: Sure, give me a few minutes. Just did quick bmark against accepted on 1M integer lists with 1k,10k,100k,1M distincts, was 16-40X faster. Testing yours now...
– ciao
Mar 1, 2015 at 8:55
• I swear yours was testing faster for me ten minutes ago but now it seems slower; I guess I changed list but I cannot remember how. Mar 1, 2015 at 8:56
• @Mr.Wizard: Yes. If the lists are structured specifically in the form you make, there are more efficient methods (like yours, pretty BTW, and +1 inbound), but those methods suffer over other cases...
– ciao
Mar 1, 2015 at 9:06

Update: here is a more efficient method also using Min and FoldList (from kguler) but with my own style. It is significantly faster than his code and far more efficient that my earlier attempts below.

If the input list has a decreasing trend this method is the fastest yet posted. However if the data is uniformly distributed rasher's optimization will on average be considerably faster.

list = {3, 4, 4, 2, 5, 5, 1, 6, 9, 2};

SparseArray[Differences@# ~Prepend~ 1]["AdjacencyLists"] & @ FoldList[Min, list]

{1, 4, 7}


Not highly efficient but rather direct:

list = {3, 4, 4, 2, 5, 5, 1, 6, 9, 2};

f[{min_, pos_}, new_] :=
{If[new < min, Sow[pos]; new, min], pos + 1}

Reap[Fold[f, {∞, 1}, list]][[2, 1]]

{1, 4, 7}


An adaptation of Simon's method from How to pick increasing numbers from the list:

Module[{i = ∞},
Join @@ Position[list, x_ /; x < i && (i = x; True), Heads -> False]
]

{1, 4, 7}

• Just a note - sparse solutions fail if lists are non-decreasing, returning {} instead of first ele.
– ciao
Mar 2, 2015 at 9:22
• @rasher I forgot about that case; thanks! Mar 2, 2015 at 19:15
• No worries - it popped up in a check when I was benching various methods - I thought "WTF? no way MW's was wrong...". An unimaginably small probability that the test lists generated would contain such a list... time go to Monte Carlo and hit the tables ;-)
– ciao
Mar 2, 2015 at 22:38
Length /@ Select[Table[Take[lst, i], {i, Length[lst]}], Last[#] == Min[#] &]


(* {1,4,7} *)