Group Abstract Group Abstract

Message Boards Message Boards

0
|
5K Views
|
14 Replies
|
2 Total Likes
View groups...
Share
Share this post:

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

Posted 3 years ago

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.

POSTED BY: Nash Wells
14 Replies

@ 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}]
POSTED BY: Hans Dolhaine

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]
POSTED BY: Hans Dolhaine

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]

enter image description here

POSTED BY: Henrik Schachner
Posted 3 years ago

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

enter image description here

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

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

polys = Cases[plt, GraphicsGroup[{pts___}] :> pts, Infinity]
POSTED BY: Hans Dolhaine

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

enter image description here

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

enter image description here

POSTED BY: Henrik Schachner

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

POSTED BY: Hans Dolhaine
Posted 3 years ago

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.

POSTED BY: Updating Name

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.....

POSTED BY: Hans Dolhaine
Posted 3 years ago

Crossposted here.

POSTED BY: Rohit Namjoshi
Posted 3 years ago

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

POSTED BY: Rohit Namjoshi
Posted 3 years ago

How do I extract the coordinates?

POSTED BY: Nash Wells
Posted 3 years ago

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

enter image description here

Each pair has the points for the corresponding equation.

POSTED BY: Rohit Namjoshi
Posted 3 years ago

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.

POSTED BY: Nash Wells
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard