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$
  • 1
    $\begingroup$ Flatten@Position[list, x_ /; x < 4]? $\endgroup$ – Algohi Feb 28 '15 at 23:29
  • $\begingroup$ What does "new minimum" mean? You probably need Split. $\endgroup$ – Szabolcs Feb 28 '15 at 23:37
  • $\begingroup$ This question feels familiar; if anyone recalls something similar please link it in these comments. $\endgroup$ – Mr.Wizard Mar 1 '15 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 '15 at 2:58
  • $\begingroup$ Related: (1754), (38325). Somewhat related: (30438) $\endgroup$ – Mr.Wizard Mar 1 '15 at 3:09
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$
  • 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$ – David G. Stork Mar 1 '15 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 '15 at 1:18
  • $\begingroup$ There is no need for First@ and Last@ in FoldList. $\endgroup$ – Mr.Wizard Mar 1 '15 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 '15 at 3:10
  • $\begingroup$ @kguler My self-answer to the linked question above explains how to resolve that. :-) $\endgroup$ – Mr.Wizard Mar 1 '15 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$
  • $\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 '15 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 '15 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 '15 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 '15 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 '15 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$
  • 2
    $\begingroup$ Just a note - sparse solutions fail if lists are non-decreasing, returning {} instead of first ele. $\endgroup$ – ciao Mar 2 '15 at 9:22
  • $\begingroup$ @rasher I forgot about that case; thanks! $\endgroup$ – Mr.Wizard Mar 2 '15 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 '15 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, privacy policy and cookie policy

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