Detect and fix invalid polygon
I expect there's a simpler way to do this, but here is a possibility. FIrst, discretize the polygon, and then find the boundary:
boundary = RegionBoundary @ DiscretizeRegion @ poly
Simplify the boundary using an undocumented, internal function:
boundary = Region`Mesh`MergeCells @ boundary
Notice the defect is gone. Convert the output to a BoundaryMesh
and extract the polygon:
simple = MeshPrimitives[
BoundaryMeshRegion[MeshCoordinates[boundary], MeshCells[boundary, 1]],
2
]
{Polygon[{{2440.37, 163.438}, {2437.38, 166.855}, {2446.11, 174.504}, {2435.2, 183.216}, {2418.95, 168.237}, {2428.72, 160.067}, {2420.63, 153.885}, {2431.45, 142.989}, {2442.18, 152.113}, {2435.84, 159.581}}]}
The fixed polygon:
Graphics[{FaceForm[None], EdgeForm[Black], simple}]
And finally, here are the above steps packages as a function:
fixPolygon[poly_Polygon] := With[
{boundary = Region`Mesh`MergeCells @ RegionBoundary @ DiscretizeRegion @ poly},
MeshPrimitives[
BoundaryMeshRegion[MeshCoordinates[boundary], MeshCells[boundary, 1]],
2
]
]
Another example using a polygon from the comments:
fixPolygon @ Polygon @ {{3, 3}/2, {3, 3}, {0,1}, {3, 1}, {2, 2},{3, 3}/2}
{Polygon[{{3., 3.}, {0., 1.}, {3., 1.}, {2., 2.}}]}