Finding [x] and [y] coordinates on curves.

I have a plot with three curves. x is a function of v.
Is there a way to extract a table of the all of the coordinates on the plot?

I am specifically looking for a way to find the average [x] value and the average [y] value for each curve.

Something like this perhaps (for your first function)?

c1 = 1.01/.01
f1[v_, x_] := v^2/2 + c1 ((.7/(v x^2))^.01 - 1) - 1
xvals = Table[{v, x /. FindRoot[f1[v, x] == 0, {x, 1}]}, {v, .2, 2.5, .2}]
ListLinePlot[xvals]

That did not work.

I need to find a way to create a table with the x and v values from the curves so I can find the average for each curve.

The points for each line can be extracted from the ContourPlot.

p3 = ContourPlot[{v^2/2 + 
      1.01/(1.01 - 1) ((0.7/(v x^2))^(1.01 - 1) - 1) == 1/x, 
    v^2/2 + 1.01/(1.01 - 1) ((1.092/(v x^2))^(1.01 - 1) - 1) == 1/x, 
    v^2/2 + 1.01/(1.01 - 1) ((1.3/(v x^2))^(1.01 - 1) - 1) == 
     1/x}, {x, 0.2, 2}, {v, 0.2, 2.5}, 
   PlotLegends -> 
    Placed[{"\[Lambda]<\[Lambda]c", "\[Lambda]=\[Lambda]c", 
      "\[Lambda]>\[Lambda]c"}, {0.8, 0.5}], 
   PlotLabel -> Style["\[Gamma]=1.01", Blue, 20], 
   AspectRatio -> Automatic, PlotPoints -> 100]; (* Added PlotPoints *)

points = p3 // Cases[#, GraphicsComplex[pts___] :> pts, All] & // First;
lineIndexes = p3 // Cases[#, Line[idx___] :> idx, All] &;
linePoints = points[[lineIndexes[[#]]]] & /@ Range@Length@lineIndexes;

ListPlot /@ linePoints

Each pair has the points for the corresponding equation.

How do I extract the coordinates?

Don’t understand the question, the list linepoints has the {x, y} coordinates. linePoints[[1]] gives the coordinates for the first plot, etc.

Crossposted here.

Hello Rohit. Coool.

Do you have any idea what is the purpose of that polygon-stuff?

Greetings, HD

P.S. I made an error when copying the 1st function ( right hand side 1 instead 1/x). With the correct formula FindRoot doesn’t work. I really wonder how they find these contours…

Hi Hans,

If you look at InputForm@p3 there is a GraphicsComplex with a list of coordinates. Those coordinates correspond to all of the points in the plot. Further down there are 6 Line, each with a list of integers. Is that what you mean by “polygon-stuff”? These integers are indexes into the GraphicsComplex list of coordinates. By using those indexes, the points for each line can be extracted.

The crosspost on MSE has a simpler answer in the comments than mine

Cases[Normal@p3, Line[pts_] :> pts, All]

Apparently, the Normal form does the mapping from index to coordinate for each curve. I did not know this.

Hello Rohit,

thank you very much. I know how GraphicsComplex works. What I meant was

plt = ContourPlot[x^2 + y^2, {x, -2, 2}, {y, -2, 2}, Contours -> {1}] 
points = Cases[plt, GraphicsComplex[pts___] :> pts, Infinity];
lineIndexes = plt // Cases[#, Line[idx___] :> idx, Infinity] &;
nps = Flatten[lineIndexes[[#]] & /@ Range@Length@lineIndexes];
ListLinePlot[Flatten[Flatten[points, {2}][[#]] & /@ nps, {2}],  AspectRatio -> Automatic]

and then (there is for sure a more elegant method to access the polygons, the numbers are embedded in plt)

ppp = Polygon[#] & /@ 
Map[plt[[1, 1]][[#]] &, {{742, 561, 410, 644}, {738, 547, 415, 
650}, {693, 470, 428, 692}, {681, 473, 489, 696}, {736, 541, 80,
614}, {737, 544, 117, 616}, {735, 538, 66, 611}, {695, 489, 
487, 670}, {706, 423, 409, 622}, {659, 156, 589, 749}, {646, 
411, 541, 736}, {750, 593, 418, 666}, {686, 431, 411, 
685}, {717, 409, 459, 718}, {701, 434, 412, 700}, {704, 460, 
414, 703}, {748, 587, 436, 654}, {687, 437, 416, 629}, {749, 
589, 439, 660}, {747, 586, 413, 624}, {723, 523, 86, 613}, {721,
520, 70, 610}, {743, 565, 146, 656}, {612, 70, 470, 680}, {676,
446, 443, 661}, {705, 421, 408, 621}, {689, 459, 424, 
640}, {713, 448, 419, 634}, {651, 436, 460, 691}, {744, 569, 
160, 662}, {746, 577, 156, 673}, {615, 86, 473, 681}, {635, 420,
448, 688}, {631, 418, 446, 711}, {745, 575, 140, 671}, {649, 
413, 544, 737}, {626, 414, 434, 708}, {628, 415, 437, 
709}, {617, 146, 550, 739}, {672, 439, 575, 745}, {663, 417, 
569, 744}, {674, 443, 577, 746}, {653, 140, 587, 748}, {716, 
433, 586, 747}, {642, 410, 538, 735}, {616, 117, 547, 
738}, {618, 160, 553, 740}, {637, 66, 559, 741}, {643, 80, 561, 
742}, {657, 416, 565, 743}, {667, 419, 173, 665}, {682, 407, 
421, 683}, {714, 408, 423, 715}, {647, 432, 433, 690}, {694, 
487, 432, 647}, {623, 412, 431, 707}, {741, 559, 407, 
638}, {641, 531, 520, 720}, {740, 553, 420, 664}, {739, 550, 
417, 658}, {731, 428, 523, 732}, {640, 424, 531, 730}, {665, 
173, 593, 750}}, {2}] // Graphics

Greetings, Hans

I need to find a way to create a table with the x and v values from the curves so I can find the average for each curve.

Finding this average is a nice problem for its own sake! One cannot just use the coordinates of these points and calculate its mean, because they are not necessarily equally spaced (using linePoints from the nice solution of @Rohit Namjoshi):

pts = linePoints[[5]];
GraphicsRow[{ListLinePlot[pts], Histogram3D[pts, 30]}]

The easiest way I could think of was simply to convert the graphic into a MeshRegion and then calculate its RegionCentroid:

mesh = DiscretizeGraphics@ListLinePlot[pts, Axes -> False];
regCntd = RegionCentroid[mesh];
mean = Mean[pts]; (* simple mean - to compare *)
RegionPlot[mesh, Epilog -> {PointSize[.03], Red, Point@regCntd, Blue, Point@mean}]

Using your idea I found how to extract the polygons nicely (with my plt from above)

polys = Cases[plt, GraphicsGroup[{pts___}] :> pts, Infinity]

@ Rohit

This is what I meant by “polygon stuff” I was just wondering what is going on with these polygons.

plt = ContourPlot[x^2 + y^2, {x, -2, 2}, {y, -2, 2}, Contours -> {1, 2.2}]
Normal[plt]
poly1 = Cases[Normal@plt, Polygon[pts_] :> pol[pts], Infinity];
Print["Number of polygons in plt"]
Length[poly1]
Graphics[{Opacity[.8], Red, poly1 /. pol :> Polygon}]

Hi Hans,

Interesting. Perhaps it is related to where the function was sampled to generate the contours?

Graphics[{EdgeForm[Black], Opacity[.2], Red, poly1 /. pol :> Polygon}]

Manipulate[
 Graphics[{EdgeForm[Black], Opacity[.2], Red, 
   poly1[[1 ;; n]] /. pol :> Polygon}], {n, 1, Length@poly1, 1}]

This appears to be somewhat related to this old post:
Is there a problem with ContourPlot[] function?

One just needs the option Mesh -> All:

ContourPlot[x^2 + y^2, {x, -2, 2}, {y, -2, 2}, Contours -> {1, 2.2}, 
 Mesh -> All]