2
$\begingroup$

This is related (in my mind, but probably not in terms of solutions) to this question.

Given a list, I'd like to first find the minimum element (or the leftmost such if there are two); then, among the rest of the list to the right of the found element, the minimum of what remains. Continue until there is only one element left. Thus for example given {7,2,5,3,4,8} the result would be {2,3,4,8} (2 is the minimum. After removing 7 and 2, you are left with {5,3,4,8}, of which 3 is the minimum. Continue.) Given {4, 5, 3, 2, 4, 4, 6, 3, 7, 5, 5, 8} the result would be {2,3,5,5,8}.

It appears that I could use Min together with Position and iterate over the list, removing elements to the left of the last found peak, but is there a more efficient way? (These will be pretty long lists).

Improve this question
$\endgroup$
1
  • $\begingroup$ It would be nice to see your own effort(s) presented in the question. In general, this is not a "do this for me" site... $\endgroup$ Commented Sep 14, 2016 at 22:04

2 Answers 2

Reset to default
6
$\begingroup$ 
list = {4, 5, 3, 2, 4, 4, 6, 3, 7, 5, 5, 8}; Module[{x = 1, ord = Ordering@list}, list[[ Reap[ Scan[ If[# > x, Sow[x = #]] &, ord] ][[2, 1]] ]] ] (* {2, 3, 5, 5, 8} *)

This code by Xavier works similarly (and with similar timing), by going through the elements one-by-one and keeping track of the current lowest-value, but uses Map instead of Scan, Reap, and Sow

Reverse@Map[x = list[[-1]]; If[# <= x, x = #, Nothing] &, Reverse@list]

The above methods are fairly quick, but for efficiency this method by MichaelE2 wins the prize:

list[[DeleteDuplicates@FoldList[Max, Ordering@list]]
Improve this answer
$\endgroup$
4
  • 2
    $\begingroup$ +1. This is a bit faster: list[[First /@ Tally@ FoldList[Max, Ordering@list]]]. $\endgroup$ Commented Sep 13, 2016 at 14:52
  • $\begingroup$ @Xavier In my mind, it is still Jason's algorithm, just with a fast Max replacing a slow If tossed with a bit of "immutability," if I understand that term correctly. My hope was that he'd include it in his answer. But if he doesn't want to, I will post it later. $\endgroup$ Commented Sep 13, 2016 at 15:01
  • 1
    $\begingroup$ @MichaelE2 - I was going to say that the only similarity between yours and mine is the final call to Part, but then I really examined it and I can see the similarity more. I can add it here if you like (I have been slacking off here since I got a real job, my fake internet points tally is no longer growing like it used to) $\endgroup$ Commented Sep 13, 2016 at 15:22
  • $\begingroup$ This has the same speed, but it's clearer, imo: list[[DeleteDuplicates@FoldList[Max, Ordering@list]]]. I suppose it's arguable whether the idea for an algorithm or for the code refactoring should be considered more deserving of points on a site devoted to both. I've got enough f.i.p.s, so feel free to incorporate it, if you're comfortable with that. $\endgroup$ Commented Sep 13, 2016 at 15:41
0
$\begingroup$ 
a = {4, 5, 3, 2, 4, 4, 6, 3, 7, 5, 5, 8}; minimas[list_] := Block[{a, out, f, min, pos}, a = list; out = {}; f := Module[{}, min = First@TakeSmallest[a, 1]; AppendTo[out, min]; pos = First@Flatten@Position[a, min]; a = Drop[a, pos] ]; While[Length@a > 0, f]; out ] minimas[a]

{2, 3, 5, 5, 8}

The timing is also acceptable:

b = RandomInteger[100, 100000]; minb = minimas[b]; // RepeatedTiming

{1.69, Null}

Length @ minb

989

c = RandomInteger[1000, 100000]; minc = minimas[b]; // RepeatedTiming

{0.12, Null}

Length @ minc

86

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.