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

Question

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

Answer 1

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]

Answer 2

Despite there already being an accepted answer, my entry:

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

Answer 3

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}

Answer 4

Length /@ Select[Table[Take[lst, i], {i, Length[lst]}], Last[#] == Min[#] &]

(* {1,4,7} *)