8
$\begingroup$

For a set of data: 

data = {{995.703, 0.672849}, {994.229, 0.685626}, {991.774, 
  0.693578}, {988.34, 0.688941}, {983.93, 0.693651}, {978.549, 
  0.704531}, {972.203, 0.731159}, {964.898, 0.73207}, {956.64, 
  0.728275}, {947.438, 0.721113}, {937.301, 0.730698}, {926.239, 
  0.751382}, {914.263, 0.776879}, {901.384, 0.781564}, {887.616, 
  0.783906}, {872.972, 0.780878}, {857.467, 0.786632}, {841.115, 
  0.805397}, {823.934, 0.812883}, {805.939, 0.811252}, {787.149, 
  0.80729}, {767.582, 0.818323}, {747.257, 0.823602}, {726.195, 
  0.830864}, {704.416, 0.846506}, {681.943, 0.842861}, {658.796, 
  0.835349}, {634.999, 0.840299}, {610.575, 0.842808}, {585.549, 
  0.851967}, {559.945, 0.868148}, {533.788, 0.876589}, {507.105, 
  0.864628}, {479.921, 0.857978}, {452.264, 0.858633}, {424.16, 
  0.860653}, {395.637, 0.861047}, {366.724, 0.869318}, {337.45, 
  0.881728}, {307.842, 0.89408}, {277.93, 0.899029}, {247.744, 
  0.894887}, {217.314, 0.885781}, {186.669, 0.880203}, {155.84, 
  0.881892}, {124.857, 0.886459}, {93.7509, 0.890874}, {62.5523, 
  0.891707}, {31.2919, 0.892137}, {0.000686499, 0.891543}, {-31.2906, 
  0.88872}, {-62.5509, 0.883872}, {-93.7495, 0.878692}, {-124.856, 
  0.8776}, {-155.839, 0.876955}, {-186.668, 0.87048}, {-217.313, 
  0.859657}, {-247.743, 0.84553}, {-277.929, 0.824158}, {-307.84, 
  0.789144}, {-337.448, 0.736637}, {-366.723, 0.666945}, {-395.636, 
  0.579511}, {-424.158, 0.476506}, {-452.262, 0.369389}, {-479.92, 
  0.279829}, {-507.104, 0.225048}, {-533.787, 0.206534}, {-559.944, 
  0.204395}, {-585.548, 0.193327}, {-610.574, 0.155006}, {-634.998, 
  0.0983544}, {-658.795, 0.0639628}, {-681.942, 0.0481704}, {-704.416,
   0.00999812}, {-726.194, -0.0540769}, {-747.256, -0.119798}, \
{-767.581, -0.15998}, {-787.148, -0.185997}, {-805.938, -0.21905}, \
{-823.933, -0.22143}, {-841.115, -0.234187}, {-857.466, -0.264621}, \
{-872.972, -0.272263}, {-887.616, -0.288497}, {-901.384, -0.306587}, \
{-914.262, -0.327461}, {-926.238, -0.352601}, {-937.3, -0.369635}, \
{-947.437, -0.385838}, {-956.639, -0.390443}, {-964.897, -0.421895}, \
{-972.203, -0.454918}, {-978.549, -0.454465}, {-983.93, -0.458914}, \
{-988.339, -0.478531}, {-991.774, -0.499764}, {-994.229, -0.512505}, \
{-995.703, -0.531943}, {-996.195, -0.536882}, {-995.703, -0.545775}, \
{-994.229, -0.572064}, {-991.774, -0.582752}, {-988.34, -0.599671}, \
{-983.93, -0.61244}, {-978.55, -0.615791}, {-972.203, -0.631241}, \
{-964.898, -0.641198}, {-956.64, -0.655771}, {-947.438, -0.671423}, \
{-937.301, -0.671268}, {-926.239, -0.681516}, {-914.263, -0.683255}, \
{-901.384, -0.700182}, {-887.616, -0.711777}, {-872.972, -0.719184}, \
{-857.467, -0.734338}, {-841.115, -0.744031}, {-823.934, -0.749785}, \
{-805.939, -0.753024}, {-787.149, -0.758666}, {-767.582, -0.77336}, \
{-747.257, -0.766347}, {-726.195, -0.760521}, {-704.417, -0.759134}, \
{-681.943, -0.770561}, {-658.796, -0.785752}, {-634.999, -0.80005}, \
{-610.575, -0.808609}, {-585.549, -0.814659}, {-559.945, -0.809641}, \
{-533.788, -0.804622}, {-507.105, -0.808619}, {-479.921, -0.814933}, \
{-452.264, -0.824676}, {-424.16, -0.83665}, {-395.637, -0.847347}, \
{-366.724, -0.851243}, {-337.45, -0.849248}, {-307.842, -0.845226}, \
{-277.93, -0.84505}, {-247.744, -0.848463}, {-217.314, -0.853465}, \
{-186.669, -0.856573}, {-155.84, -0.858592}, {-124.857, -0.859054}, \
{-93.7509, -0.862658}, {-62.5523, -0.87145}, {-31.292, -0.877667}, \
{-0.000741419, -0.881224}, {31.2905, -0.884006}, {62.5508, \
-0.884125}, {93.7495, -0.878148}, {124.856, -0.870916}, {155.839, \
-0.862404}, {186.668, -0.852149}, {217.312, -0.834875}, {247.743, \
-0.806898}, {277.929, -0.763839}, {307.84, -0.700117}, {337.448, \
-0.609422}, {366.723, -0.482247}, {395.636, -0.311266}, {424.158, \
-0.104396}, {452.262, 0.115888}, {479.92, 0.310883}, {507.104, 
  0.434027}, {533.787, 0.452608}, {559.944, 0.373157}, {585.548, 
  0.271737}, {610.574, 0.238174}, {634.998, 0.294259}, {658.795, 
  0.388007}, {681.942, 0.431574}, {704.416, 0.400651}, {726.194, 
  0.41664}, {747.256, 0.467887}, {767.581, 0.466103}, {787.148, 
  0.44411}, {805.938, 0.454418}, {823.933, 0.475323}, {841.115, 
  0.453061}, {857.466, 0.482326}, {872.972, 0.527791}, {887.616, 
  0.52652}, {901.384, 0.536385}, {914.262, 0.555416}, {926.238, 
  0.534647}, {937.3, 0.559003}, {947.437, 0.583895}, {956.639, 
  0.590674}, {964.897, 0.615758}, {972.203, 0.604291}, {978.549, 
  0.595058}, {983.93, 0.603277}, {988.339, 0.621725}, {991.774, 
  0.650783}, {994.229, 0.666861}, {995.703, 0.661105}, {996.195, 
  0.649131}, {995.703, 0.653303}, {994.229, 0.680834}, {991.774, 
  0.701984}, {988.34, 0.722025}, {983.93, 0.703909}, {978.55, 
  0.712565}, {972.203, 0.717324}, {964.898, 0.738665}, {956.64, 
  0.762189}, {947.438, 0.750662}, {937.301, 0.756154}, {926.239, 
  0.762045}, {914.263, 0.776795}, {901.384, 0.795037}, {887.616, 
  0.791569}, {872.973, 0.783403}, {857.467, 0.791338}, {841.115, 
  0.801706}, {823.934, 0.821618}, {805.939, 0.833832}, {787.149, 
  0.826512}, {767.582, 0.818115}, {747.257, 0.816921}, {726.195, 
  0.830269}, {704.417, 0.849679}, {681.943, 0.86529}, {658.796, 
  0.872935}, {634.999, 0.852952}, {610.575, 0.852018}, {585.549, 
  0.850589}, {559.945, 0.851081}, {533.789, 0.855915}, {507.105, 
  0.88198}, {479.921, 0.884893}, {452.264, 0.876493}, {424.16, 
  0.879354}, {395.637, 0.884601}, {366.725, 0.885976}, {337.45, 
  0.879266}, {307.842, 0.8827}};

When trying to calculate the area of the Polygon they define using the code 

Area[Polygon[data]]

I get the following error

Unable to compute the area region Polygon[...]`

But Graphics shows the region just fine

Graphics[Polygon[data], AspectRatio->1/GoldenRatio]

enter image description here

Does anyone have any suggestions on how to calculate the area?

| improve this question | |
$\endgroup$
  • 4
    $\begingroup$ Hm, why do you write the numbers as strings? $\endgroup$ – Per Alexandersson Dec 15 '14 at 11:46
  • $\begingroup$ I hadn't realized that. It is the way Mathematica read them from a file and it could work with them whithout problems at least until now. I'll modify that. Maybe that's the reason of all this mess, but i had no problem with other Polygons or plots before. $\endgroup$ – Jose Dec 15 '14 at 11:53
  • $\begingroup$ Thanks Per. I tried your suggestion and changed it with NumberForm but it doesn't affect the result. $\endgroup$ – Jose Dec 15 '14 at 12:05
  • 3
    $\begingroup$ Please post working code, i.e. get rid of the string formatting. Apart from that, your polygon self-intersects, which may be a reason for Areaquitting on the job. For example Area[Polygon[{{0, 0}, {1, 0}, {-1, 1}, {1, 1}, {0, 0}}]] returns the same error. $\endgroup$ – Yves Klett Dec 15 '14 at 12:11
  • 1
    $\begingroup$ @gpap Why would someone want to calculate the area of the convex hull when he is interested in the area itself? $\endgroup$ – halirutan♦ Dec 15 '14 at 13:57
8
$\begingroup$

---EDIT---

@MichaelE2 is right in that it isn't the overlap (or at least not just the overlap) that is to blame. However, it's not just the scaling of the fast dimension either. You can see that if you resample the data by adding another point. Then Area calculates this just fine!

data2[n_] := Transpose[ArrayResample[#, n] & /@ Transpose[data]];

so 

Area@Polygon[data2[Length[data] + 1]]

(* 2017.92 *)

however subsampling to n-1 points gives a rubbish result (still calculates the area without error though).

Area@Polygon[data2[Length[data] - 1]]

(* 8.71444 *)

I have no idea why this happens but the polygons in both the above cases look indistinguishable

With[{disp = Graphics[#, AspectRatio -> 1] &},
 Row[{
   disp@Polygon[data2[Length[data] - 1]],
   disp@Polygon[data2[Length[data] + 1]]}]
 ]

enter image description here

Also, playing with the NIntegrate method options of Area doesn't seem to have much effect either.

---ORIGINAL ANSWER---

I feel compelled to answer this because of my stupid comment :). The problem is with the curve folding back onto itself after a full cycle (around the last 200 points) so all you need to do forget about these 200 points and do what you tried originally:

Area[Polygon[data[[;; 200]]]]
(* 2044 *)

and gives a similar result if you drop the first 200 points:

Area[Polygon[data[[Length[data] - 200 ;;]]]]
(* 2050.41 *)

and the number 200 I worked out by putting it all in a manipulate and looking at where the overlap is:

Manipulate[
 ListLinePlot[data[[;; n]],
  MeshStyle -> Red,
  PlotLabel -> n,
  ImageSize -> 600], {n, 1, Length[data], 1}]
| improve this answer | |
$\endgroup$
  • $\begingroup$ Thanks gpap. You're right and it is related with what people previously said. It is because of overlaps. Thank you everyone. By the way, Does anybody know if there's some special command to avoid this kind of problems? $\endgroup$ – Jose Dec 15 '14 at 18:15
  • $\begingroup$ I should comment more often if it leads to answers instead of comments :-))) +1 $\endgroup$ – halirutan♦ Dec 16 '14 at 22:45
  • $\begingroup$ @halirutan yeah, definitely worked for me ;) $\endgroup$ – gpap Dec 17 '14 at 13:31
8
$\begingroup$

The polygon is very thin. If we scale the points so that the polygon is of good proportions Area works.

GraphicsRow[{
  Graphics[{Red, Polygon[pts]}],
  Graphics[{Red, Polygon[pts.DiagonalMatrix[{1, 1000}]]}]}, 
 Frame -> All]

Mathematica graphics

Area[Polygon[pts.DiagonalMatrix[{1, 1000}]]]/1000
(*  2018.48  *)

One might suppose that round-off error causes the failure of Area; however, Area[Polygon[SetPrecision[pts, Infinity]]] fails as well. The reason behind the success of scaling, or even gpap's workaround, eludes me. It does not appear to be because of overlaps.

However, one should be aware of this issue with overlaps. The region included by a polygon is computed by the even-odd rule. Dropping the first 200 points (gpap's workaround) results in more area being included. The area is correct for each polygon, so it is really a question of which polygon is correct.

| improve this answer | |
$\endgroup$
  • $\begingroup$ But what about Area[Polygon[{{0, 0}, {1, 0}, {0, 1}, {1, 1}}]]? This also fails... $\endgroup$ – Yves Klett Dec 17 '14 at 8:31
  • $\begingroup$ @YvesKlett I hope it was clear that I don't know why it fails or succeeds. So far Area fails if RegionDimension fails. For your example Area@DiscretizeGraphics[Polygon[{{0, 0}, {1, 0}, {0, 1}, {1, 1}}]] succeeds in approximating the area, but DiscretizeGraphics does not work in the OP's case (see user21's answer). Discretizing is what happens with Area[Polygon[{{0, 0}, {1, 0}, {0, 1}, {1, 1.}}]] with a machine precision polygon. But chasing down an internal bug might be futile. $\endgroup$ – Michael E2 Dec 17 '14 at 11:51
  • $\begingroup$ @YvesKlett This difference suggests that your example and the OP's might be due to different bugs: RegionRegionType[Polygon[{{0, 0}, {1, 0}, {0, 1}, {1, 1}}]]` -> "AtomicSymbolic" and RegionRegionType[Polygon[pts]]` -> "LinearGraphics". Different procedures are or might be used on different types. $\endgroup$ – Michael E2 Dec 17 '14 at 13:45
7
$\begingroup$

Here are a few more thoughts:

When you run this through DiscretizeGraphics you get a message about degenerate cells:

DiscretizeGraphics[Polygon[data]];
MeshRegion::dgcell: "The cell Polygon[{39,40,39,41}] is degenerate."

As noted scaling helps:

mr = DiscretizeGraphics[Polygon[data.DiagonalMatrix[{1, 1000}]]]

enter image description here

You can use the Finite Element mesher and specify what should and what should not be a region hole.

(em = NDSolve`FEM`ToElementMesh[mr, "RegionHoles" -> None])["Wireframe"]

enter image description here

In this case nothing should be considered a region hole. (Leaving the "RegionHoles" option out, will produce the same as the DiscretiveGraphics)

You can then compute the area of the region without any holes. It really depends on what you want.

Area[MeshRegion[em]]/1000
2051.7452651013527`
| improve this answer | |
$\endgroup$

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.