Unable to compute the area of region

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

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.


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`