2
$\begingroup$

I have a set of points

Ainput = {{0., 0.}, {0.14, 0.049}, {0.27, 0.098}, {0.38, 0.14}, {0.47,
     0.19}, {0.56, 0.23}, {0.63, 0.28}, {0.69, 0.32}, {0.74, 
    0.36}, {0.78, 0.4}, {0.81, 0.44}, {0.83, 0.47}, {0.85, 
    0.51}, {0.86, 0.54}, {0.86, 0.58}, {0.86, 0.61}, {0.85, 
    0.64}, {0.84, 0.67}, {0.83, 0.7}, {0.81, 0.72}, {0.79, 
    0.75}, {0.77, 0.77}, {0.74, 0.8}, {0.72, 0.82}, {0.69, 
    0.84}, {0.66, 0.86}, {0.63, 0.88}, {0.61, 0.89}, {0.58, 
    0.91}, {0.56, 0.92}, {0.53, 0.94}, {0.51, 0.95}, {0.49, 
    0.96}, {0.47, 0.97}, {0.46, 0.98}, {0.44, 0.98}, {0.43, 
    0.99}, {0.42, 0.99}, {0.41, 1.}, {0.42, 0.99}, {0.43, 
    0.99}, {0.44, 0.98}, {0.46, 0.98}, {0.47, 0.97}, {0.49, 
    0.96}, {0.51, 0.95}, {0.53, 0.94}, {0.56, 0.92}, {0.58, 
    0.91}, {0.61, 0.89}, {0.63, 0.88}, {0.66, 0.86}, {0.69, 
    0.84}, {0.72, 0.82}, {0.74, 0.8}, {0.77, 0.77}, {0.79, 
    0.75}, {0.81, 0.72}, {0.83, 0.7}, {0.84, 0.67}, {0.85, 
    0.64}, {0.86, 0.61}, {0.86, 0.58}, {0.86, 0.54}, {0.85, 
    0.51}, {0.83, 0.47}, {0.81, 0.44}, {0.78, 0.4}, {0.74, 
    0.36}, {0.69, 0.32}, {0.63, 0.28}, {0.56, 0.23}, {0.47, 
    0.19}, {0.38, 0.14}, {0.27, 0.097}, {0.14, 0.049}, {0., 0.}};

Then i use plot

ListLinePlot[Ainput, PlotRange -> {{0, 1}, {0, 1}}, PlotStyle -> Black]

Plot of Ainput

And as you can see, this is not a function. But i want to find a way how to delete the points (or lines) to have a function from these points. So in case there are lines above each other (or points) I always want to keep the one with a higher function value.

I would like to get exactly this what you can see on this picture

what i want to get

Any ideas how could I do it? Thank you for any advices.

$\endgroup$
  • 3
    $\begingroup$ One option is ListLinePlot[ Sort[Map[First@MaximalBy[#, Last] &, GatherBy[Ainput, First]]]], but it's very ugly code. $\endgroup$ – Carl Lange Jun 26 at 16:33
3
$\begingroup$

The vertical threshold to split the data is found by locating the peak in the reversed data

Arev = Reverse /@ Ainput;

thresholdVert = Arev[[FindPeaks[Arev[[All, 2]]][[All, 1]]]][[1, 1]]

(* 0.58 *)

Splitting the data into the upper and lower curves

Ainput2 = DeleteDuplicatesBy[#, First] & /@
   GatherBy[Ainput, #[[2]] < thresholdVert &];

The horizontal threshold to switch from one curve to the next is

thresholdHoriz = Min[Ainput2[[2, All, 1]]]

(* 0.41 *)

Define the function using Piecewise

f[t_?NumericQ] := Piecewise[{
   {Interpolation[Select[Ainput2[[1]], #[[1]] < thresholdHoriz &]][t], 
    t < thresholdHoriz}},
  Interpolation[Ainput2[[2]]][t]]

{tmin, tmax} = MinMax[Ainput[[All, 1]]]

(* {0., 0.86} *)

EDIT: The points used in the plot are just the inputs to Interpolation

pts = Join[
   Select[Ainput2[[1]], #[[1]] < thresholdHoriz &],
   Ainput2[[2]]];

Plot[f[t], {t, tmin, tmax}, Epilog -> {Red,
   AbsolutePointSize[3], Point[pts]}]

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ Thank you, this is a good idea. I just have one more question, is it also possible to get coordinates of the points which are in the final plot? I mean the set Ainput but in the final form without the reduce points. $\endgroup$ – Nikol Š Jun 27 at 9:46
2
$\begingroup$

A slightly shorter form of Carl Lange's comment code:

List @@@ Sort @ Normal @ GroupBy[Ainput, First -> Last, Max]

ListLinePlot @ % 
{{0., 0.}, {0.14, 0.049}, {0.27, 0.098}, {0.38, 0.14}, {0.41, 1.},
 {0.42, 0.99}, {0.43, 0.99}, {0.44, 0.98}, {0.46, 0.98}, {0.47, 0.97},
 {0.49, 0.96}, {0.51, 0.95}, {0.53, 0.94}, {0.56, 0.92}, {0.58, 0.91},
 {0.61, 0.89}, {0.63, 0.88}, {0.66, 0.86}, {0.69, 0.84}, {0.72, 0.82},
 {0.74, 0.8}, {0.77, 0.77}, {0.78, 0.4}, {0.79, 0.75}, {0.81, 0.72},
 {0.83, 0.7}, {0.84, 0.67}, {0.85, 0.64}, {0.86, 0.61}}

enter image description here

Is the result as you desire or are you looking for something that will handle that dip at 0.78?

| improve this answer | |
$\endgroup$
  • 2
    $\begingroup$ Much nicer, that third argument to GroupBy is very smooth. Just a slightly golfier way - ListLinePlot is happy to take an association, so you can just do ListLinePlot[KeySort[GroupBy[Ainput, First -> Last, Max]]] $\endgroup$ – Carl Lange Jun 26 at 18:40
  • $\begingroup$ @CarlLange I like that! A List may be what the OP had in mind however. $\endgroup$ – Mr.Wizard Jun 26 at 18:44

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.