Unable to compute the area of region

Question

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]       

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

Answer 1

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

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

Answer 2

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]

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.

Answer 3

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

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

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`