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

Improve this question
$\endgroup$
5
  • $\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
    Commented Aug 4, 2015 at 20:57
  • $\begingroup$ Please include in your question the exact code you are using that does not work properly. $\endgroup$
    – bbgodfrey
    Commented Aug 4, 2015 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
    Commented Aug 4, 2015 at 21:16
  • $\begingroup$ Thanks for finding my mistake, I fixed it in my question. Your suggestion worked though. Thank you. $\endgroup$
    – John Houlihan
    Commented Aug 4, 2015 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
    Commented Aug 4, 2015 at 21:58

4 Answers 4

Reset to default
6
$\begingroup$ 
r1 = Pick[r, Thread[# >= FoldList[Max, #]]] &@r[[All, 1]]

ListLinePlot@r1

Mathematica graphics

Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ Well, +1, if only for the spectacular graphics ;-) $\endgroup$
    – ciao
    Commented Aug 4, 2015 at 22:43
  • $\begingroup$ @ciao ListLinePlot[r1[[All, 1]], Axes -> False] :P $\endgroup$
    – Dr. belisarius
    Commented Aug 4, 2015 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]]] &]]]
Improve this answer
$\endgroup$
2
$\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}}

Improve this answer
$\endgroup$
4
  • $\begingroup$ This is approx. 10 times slower than the solution by belisarius, even for this small sample data. $\endgroup$
    – Karsten7
    Commented Aug 5, 2015 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
    Commented Aug 5, 2015 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$
    – Karsten7
    Commented Aug 5, 2015 at 0:37
  • $\begingroup$ @Karsten7. - I made a mistake. Recheck with AbsoluteTiming showed mine as 4.4 times slower. Sorry. $\endgroup$
    – Bob Hanlon
    Commented Aug 5, 2015 at 1:04
1
$\begingroup$ 
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}};

Using IncreasingFilter by Sander Huisman

IncreasingFilter = ResourceFunction["IncreasingFilter"];

result = IncreasingFilter @ data

{{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}}

This agrees with the accepted answer:

result == r1

True

ListPlot[result, Joined -> True, Mesh -> All, MeshStyle -> Red]

enter image description here

Improve this answer
$\endgroup$

Not the answer you're looking for? Browse other questions tagged or ask your own question.