3
$\begingroup$

I am using Mathematica version 9.0 and am trying to compare and remove x-coordinates, and the associated y-coordinate, that are less than previous x-coordinates. Below is an example using sample data.

Raw data:

{{611.011, 1008}, {611.062, 1077}, {611.114, 1193}, {610.958, 894}, {611.009, 1621}, 
 {611.061, -166}, {611.112, 704}, {611.164, 131}, {611.215, 1306}, {692.637, 6394}, 
 {692.688, 6369}, {692.739, 6664}, {692.328, 6790}, {692.379, 7378}, {692.431, 5761}, 
 {692.482, 6750}, {692.533, 6348}, {692.584, 7535}, {692.635, 7365}, {692.686, 7725}, 
 {692.737, 7553}, {692.788, 8649}, {692.839, 8649}, {692.89, 7553}}

Desired outcome:

{{611.011, 1008}, {611.062, 1077}, {611.114, 1193}, {611.164, 131}, {611.215, 1306}, 
 {692.637, 6394}, {692.688, 6369}, {692.739, 6664}, {692.839, 8649}, {692.89, 7553}}

I tried using the suggestion from the answer to the question below, but could not get the code to work properly.

Removing an ordered pair from a list of ordered pairs if the second element in the list is Less than a Value

$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! I hope you will become a regular contributor. To get started, 1) take the introductory Tour now, 2) when you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge, 3) remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign, and 4) give help too, by answering questions in your areas of expertise. $\endgroup$ – bbgodfrey Aug 4 '15 at 20:57
  • $\begingroup$ Please include in your question the exact code you are using that does not work properly. $\endgroup$ – bbgodfrey Aug 4 '15 at 20:58
  • 1
    $\begingroup$ Am I missing something? There's elements in the result that aren't in the target... that said, removing them (last 2 in desired result example), this gets the result I think you're after: Cases[rawdata, {Alternatives @@ FoldList[Max, rawdata[[All, 1]]], _}] $\endgroup$ – ciao Aug 4 '15 at 21:16
  • $\begingroup$ Thanks for finding my mistake, I fixed it in my question. Your suggestion worked though. Thank you. $\endgroup$ – John Houlihan Aug 4 '15 at 21:43
  • 1
    $\begingroup$ @JohnHoulihan: No worries, glad it helped. n.b.: If your lists are much larger than the example, might want to insert a Union (Alternatives @@ Union@FoldList[Max, rawdata[[All, 1]]]) - this will speed things up, since duplicate alternatives need not be checked. $\endgroup$ – ciao Aug 4 '15 at 21:58
5
$\begingroup$
r1 = Pick[r, Thread[# >= FoldList[Max, #]]] &@r[[All, 1]]

ListLinePlot@r1

Mathematica graphics

$\endgroup$
  • 1
    $\begingroup$ Well, +1, if only for the spectacular graphics ;-) $\endgroup$ – ciao Aug 4 '15 at 22:43
  • $\begingroup$ @ciao ListLinePlot[r1[[All, 1]], Axes -> False] :P $\endgroup$ – Dr. belisarius Aug 4 '15 at 22:55
3
$\begingroup$

As an afterthought to my comment - if speed is important, this should handily beat existing answers, particularly on larger cases:

Fold[If[#2[[1]] < #1[[-1, 1]], #1, Append[#1, #2]] &, {First@rawdata},Rest@rawdata]

and this will be even faster:

FixedPoint[Pick[#, UnitStep@Differences[Prepend[#[[All, 1]], 0]], 1] &, rawdata]

finally, fastest I've come up with for larger lists:

rawdata[[Union@FoldList[Min, Reverse@Ordering[First@Transpose@rawdata] //
                     #[[;; First@Pick[Range@Length@#, #, 1]]] &]]]
$\endgroup$
1
$\begingroup$

Using ReplaceRepeated (//.)

data1 = {{611.011, 1008}, {611.062, 1077}, {611.114, 1193}, {610.958, 
    894}, {611.009, 1621}, {611.061, -166}, {611.112, 704}, {611.164, 
    131}, {611.215, 1306}, {692.637, 6394}, {692.688, 6369}, {692.739, 
    6664}, {692.328, 6790}, {692.379, 7378}, {692.431, 5761}, {692.482, 
    6750}, {692.533, 6348}, {692.584, 7535}, {692.635, 7365}, {692.686, 
    7725}, {692.737, 7553}, {692.788, 8649}, {692.839, 8649}, {692.89, 7553}};

data2 = data1 //. ({s___, {x1_, y1_}, {x2_, _}, f___} /; x2 < x1) :>
   {s, {x1, y1}, f}

{{611.011, 1008}, {611.062, 1077}, {611.114, 1193}, {611.164, 131}, {611.215, 1306}, {692.637, 6394}, {692.688, 6369}, {692.739, 6664}, {692.788, 8649}, {692.839, 8649}, {692.89, 7553}}

$\endgroup$
  • $\begingroup$ This is approx. 10 times slower than the solution by belisarius, even for this small sample data. $\endgroup$ – Karsten 7. Aug 5 '15 at 0:03
  • $\begingroup$ @Karsten7. - Starting with a fresh kernel and with this small sample my solution is faster on my system (Mma 10.2 on Mac OS 10.10.4). Although I certainly agree that it does not scale well. $\endgroup$ – Bob Hanlon Aug 5 '15 at 0:17
  • $\begingroup$ I'm using Mma 10.2 on Win 10. Measured by RepeatedTiming this is 8 times slower and measured by AbsoluteTiming it's 5 times slower (independent of kernel freshness). $\endgroup$ – Karsten 7. Aug 5 '15 at 0:37
  • $\begingroup$ @Karsten7. - I made a mistake. Recheck with AbsoluteTiming showed mine as 4.4 times slower. Sorry. $\endgroup$ – Bob Hanlon Aug 5 '15 at 1:04

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.