Arrange a list in ascending order by deleting list elements

Question

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

Answer 1

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}

Answer 2

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}

Update: A few additional alternatives:

ReplaceRepeated:

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

{1, 65, 155}

SequenceReplace + FixedPoint:

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}

Answer 3

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

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

Written more readably:

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.