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.

Nash Wells
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
Sort By:

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
Rohit Namjoshi
Rohit Namjoshi
Posted 3 years ago

Crossposted here.
POSTED BY: Rohit Namjoshi
Nash Wells
Nash Wells
Posted 3 years ago

How do I extract the coordinates?
POSTED BY: Nash Wells
Rohit Namjoshi
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
Nash Wells
Nash Wells
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
Rohit Namjoshi
Rohit Namjoshi
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

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
Updating Name
Updating Name
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,

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

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

@ 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
Rohit Namjoshi
Rohit Namjoshi
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

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

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
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard