2
$\begingroup$

I generated a number of plots. Let us assume that we now have these plots simply as an image. How do I get the coordinates of the extrema in this image?

I am interested in getting the coordinates as pairs of x and y, for each color in the plot.

Here is an example of such an image:

enter image description here

$\endgroup$
2
  • $\begingroup$ You mean a Graphics-object or a pixel image? $\endgroup$ Feb 1, 2019 at 16:07
  • $\begingroup$ @UlrichNeumann I'm pretty sure they mean they have just a pixel image, which would complicate things a lot. $\endgroup$
    – MassDefect
    Feb 1, 2019 at 16:45

3 Answers 3

5
$\begingroup$

If "image" is a Graphics-object try

pic = Plot[{Sin[x]/x, Exp[-.1 x] Sin[x]}, {x, 0, 20}]  (*two functions*) 

lines = Cases[pic, Line[p_] -> p, Infinity] (*get the points*)

Evaluate all extrema and plot

extrema = Map[Cases[
Partition[#, 3,1], {{_, a_}, p : {_, b_}, {_, c_}} /; a < b && c < b || a > b && c > b -> p] &, lines] 
Show[pic, Graphics[Point[extrema ]]]

enter image description here

$\endgroup$
3
  • $\begingroup$ Thank you for your answer. However, I assume that I no longer have or know the function that resulted in the plots. I only have the "image". $\endgroup$ Feb 1, 2019 at 15:41
  • $\begingroup$ I didn't use the knowledge of the function! One questiom : Are you looking for all extrema or only the global? $\endgroup$ Feb 1, 2019 at 15:42
  • $\begingroup$ All the extrema. $\endgroup$ Feb 1, 2019 at 15:46
4
$\begingroup$

If "image" is a pixel image (named pic , sorry, don't know how to include pic="image" in the coding ) try:

dc = Rest@DominantColors[pic] (* dominant colors without white*)

curves = Map[ListPlot[PixelValuePositions[pic, #, .1 ],Axes -> False, PlotStyle -> #] &, dc] (* three colored curves *)

Get the points of the different curves

points = Cases[curves  , Point[pi_] -> pi, Infinity];

...see my first answer

$\endgroup$
3
$\begingroup$

Ulrich's approach for a Graphics-object misses the end points. You can use FindPeaks to also catch the end points.

pic = Plot[{Sin[x]/x, Exp[-.1 x] Sin[x]}, {x, 0, 20}];  (*two functions*)

lines = Cases[pic, Line[p_] -> p, Infinity]; (*get the points*)

max = Flatten[(#[[FindPeaks[#[[All, 2]]][[All, 1]]]] & /@ lines), 1];

min = Flatten[(#[[FindPeaks[(# /. {x_?NumericQ, y_?NumericQ} :> {x, -y})[[All,
             2]]][[All, 1]]]] & /@ lines), 1];

Show[pic, Epilog -> {AbsolutePointSize[4],
   Red, Point[max],
   Blue, Point[min]}]

enter image description here

$\endgroup$
1
  • $\begingroup$ @ BobHanlon Thanks, I didn't know FindPeaks $\endgroup$ Feb 2, 2019 at 9:35

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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