5
$\begingroup$

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

$\endgroup$
5
$\begingroup$

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}

$\endgroup$
15
$\begingroup$

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}

$\endgroup$
  • $\begingroup$ What a slick solution. Is the second one O(n)? $\endgroup$ – lirtosiast Aug 9 at 5:54
  • 2
    $\begingroup$ DeleteDuplicates[lst, GreaterEqual] in case there are equal elements $\endgroup$ – Roman Aug 9 at 8:12
  • $\begingroup$ @lirtosiast, thank you. Leonid says its complexity is quadratic in $n$ in this answer. $\endgroup$ – kglr Aug 9 at 12:40
  • $\begingroup$ You can omit the parentheses in the code golf examples, since the precedence order is […], @* and last @ $\endgroup$ – Lukas Lang Aug 9 at 21:00
  • 1
    $\begingroup$ 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. $\endgroup$ – Mark R Aug 9 at 23:49
6
$\begingroup$

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.

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