6
$\begingroup$

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

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

4 Answers 4

7
$\begingroup$
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]
$\endgroup$
5
  • 1
    $\begingroup$ 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. $\endgroup$ Mar 1, 2015 at 0:58
  • $\begingroup$ Thanks @DavidG.Stork. You are right; only the last one gives the sequential minima (I hope :)). I will delete the first four. $\endgroup$
    – kglr
    Mar 1, 2015 at 1:18
  • $\begingroup$ There is no need for First@ and Last@ in FoldList. $\endgroup$
    – Mr.Wizard
    Mar 1, 2015 at 3:00
  • $\begingroup$ Thank you @Mr.Wizard. The two-argument form also works in version 9.0.1.0 despite the syntax highlighting that suggest missing argument. $\endgroup$
    – kglr
    Mar 1, 2015 at 3:10
  • $\begingroup$ @kguler My self-answer to the linked question above explains how to resolve that. :-) $\endgroup$
    – Mr.Wizard
    Mar 1, 2015 at 3:13
4
$\begingroup$

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

$\endgroup$
8
  • $\begingroup$ f3 tests slow for me. I am using: SeedRandom[1]; list = RandomInteger[9999999, 500000]; list -= Accumulate@RandomInteger[1, 500000]; $\endgroup$
    – Mr.Wizard
    Mar 1, 2015 at 8:51
  • $\begingroup$ Hm... wait, now your older f also seems slower even after a restart. Would you test my new method please? $\endgroup$
    – Mr.Wizard
    Mar 1, 2015 at 8:53
  • $\begingroup$ @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... $\endgroup$
    – ciao
    Mar 1, 2015 at 8:55
  • $\begingroup$ 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. $\endgroup$
    – Mr.Wizard
    Mar 1, 2015 at 8:56
  • 1
    $\begingroup$ @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... $\endgroup$
    – ciao
    Mar 1, 2015 at 9:06
4
$\begingroup$

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}
$\endgroup$
3
  • 2
    $\begingroup$ Just a note - sparse solutions fail if lists are non-decreasing, returning {} instead of first ele. $\endgroup$
    – ciao
    Mar 2, 2015 at 9:22
  • $\begingroup$ @rasher I forgot about that case; thanks! $\endgroup$
    – Mr.Wizard
    Mar 2, 2015 at 19:15
  • $\begingroup$ 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 ;-) $\endgroup$
    – ciao
    Mar 2, 2015 at 22:38
2
$\begingroup$
Length /@ Select[Table[Take[lst, i], {i, Length[lst]}], Last[#] == Min[#] &]

(* {1,4,7} *)

$\endgroup$

Your Answer

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

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