# Arrange a list in ascending order by deleting list elements

I am new to mathematica and currently learning it by solving some basic problems.

I am trying to arrange a list in ascending order using a detailed IF loop. For instance if we start out with $$\{1,65,40, 155, 120, 122\}$$. My output should be $$\{1,65, 155\}$$. However my code yields a different output. Here it is:

Sample = {1, 65, 40, 155, 120, 122};
(i = 1;
newSample = Sample;
Label[1];
newSample = Delete[newSample, i + 1];
If[newSample[[i]] >= newSample[[i + 1]], Goto[1], i = i + 1 && i <= Length[newSample]-1 ];
Print[newSample]
)
{1,40,155,120,122}


I would greatly appreciate any help on why this is happening and how to fix this code. (I would also be interested in seeing some slick ways to write this same code using other(?) built in functions but my main priority is fixing the above code).

Let me preface by saying kglr's answer is better. But, a working version of your code would be:

sample = {1, 65, 40, 155, 120, 122};

(i = 1;
newSample = sample;
Label[1];
If[i < Length[newSample],
If[newSample[[i]] <= newSample[[i + 1]],
i = i + 1; Goto[1],
newSample = Delete[newSample, i + 1]; Goto[1]
]])

newSample


{1, 65, 155}

Or alternatively

i = 1;
newSample = sample;
While[i < Length[newSample],
If[newSample[[i]] <= newSample[[i + 1]],
i = i + 1,
newSample = Delete[newSample, i + 1];
]]

newSample


{1, 65, 155}

You can use DeleteDuplicates with Greater as the second argument:

DeleteDuplicates[lst, Greater]


{1, 65, 155}

Alternatively, you can use FoldList to apply Max recursively and take Union of the resulting list:

lst = {1, 65, 40, 155, 120, 122};

Union @ FoldList[Max] @ lst


{1, 65, 155}

You can also use DeleteDuplicates in place of Union

DeleteDuplicates @ FoldList[Max] @ lst


{1, 65, 155}

lst //. {a___, b_, c_, d___} /; c < b :> {a, b, d}


{1, 65, 155}

FixedPoint[SequenceReplace[{a___, b_, c_} /; c < b :> Sequence[a, b]], lst]


{1, 65, 155}

Code Golf: Inspired by lirtosiast's answer, we can shade a few bytes using operator forms:

Union@*FoldList[Max]@lst


{1, 65, 155}

FoldList[Max]/*Union@lst


{1, 65, 155}

StringLength /@
{"Union@*FoldList[Max]",
"FoldList[Max]/*Union",
"DeleteDuplicates[#,#>#2&]&",
"Pick[#,#-Max~FoldList~#,0]&"}


{20, 20, 26, 27}

• What a slick solution. Is the second one O(n)? Commented Aug 9, 2019 at 5:54
• DeleteDuplicates[lst, GreaterEqual] in case there are equal elements Commented Aug 9, 2019 at 8:12
• @lirtosiast, thank you. Leonid says its complexity is quadratic in $n$ in this answer.
– kglr
Commented Aug 9, 2019 at 12:40
• You can omit the parentheses in the code golf examples, since the precedence order is […], @* and last @ Commented Aug 9, 2019 at 21:00
• I like using DeleteDuplicates over Union (@kglr gives both solutions) because if you change the function to Min rather than Max, DeleteDuplicates will give you what you want whereas Union will sort the list. Commented Aug 9, 2019 at 23:49

On Code Golf, alephalpha came up with this in 2015:

Pick[#,#-Max~FoldList~#,0]&


Pick[#, # - FoldList[Max, #], 0]&

This is somewhat idiomatic because FoldList[Max, #] is the most obvious expression for running max, but some may prefer to make the vectorized Equal explicit.