# Find the data set for boundary/edge of ListPlot

I have a data set, say, {$$x_i, y_i$$}. After plotting which looks like the following How can I get the data set for the boundary from this. Here is the link for my data

• This should be relevant. Jul 31 at 6:35
• @HighPerformanceMark edited
– Doon
Jul 31 at 7:49
• Please post the data set. Jul 31 at 10:59
• @cvgmt posted it
– Doon
Jul 31 at 17:04

Also use NonConvexHullMesh.

pts = Import["xy.dat"];
reg = ResourceFunction["NonConvexHullMesh"][pts, .001];
bdreg = RegionBoundary[reg];
dist = RegionDistance[bdreg];
bdpts = Select[pts, dist[#] == 0 &];
Graphics[{{Green, bdreg}, {Opacity[.2], Yellow, reg}, {Red,
Point[bdpts]}}, AspectRatio -> 1] im is the image.

pts = -Cross /@ DeleteDuplicates[Round[Position[ImageData[im, "Byte"], {25, 204, 255, 255}], 2]];


If you plot the points as huge disks, you can only see the circular boundary of those disks that have a center point on the boundary of the region. In the interior nearby disks cover it.

To check which disks are covered, I used the 10 nearest points to each point, and checked which disks were covered at some random but large radius.

sets = N[Nearest[pts, pts, {∞, 10}]];
R = 50.;

cover = If[# < #2, {{#, #2}}, {{#, π}, {-π, #2}}] & @@
ArcTan @@ With[{ca = #2[] - #[], db = #2[] - #[]},
{{ca, ca}, {db, db}} + {{db, -db}, {-ca, ca}} Sqrt[4. #3 #3/(ca ca + db db) - 1.]] &;


cover[pt1, pt2, r] gives 1 or 2 intervals within -pi to pi, which tell which what part of the circle with center pt1 is covered by a disk with center pt2 given radius r.

Those not fully covered are used:

which = Table[Interval[{-π, π}] === Interval @@ Catenate[cover[sets[[i, 1]], #, R] & /@ Rest[sets[[i]]]], {i, Length[sets]}];
boundaryPts = Pick[pts, which, False];

Show[ListLinePlot[boundaryPts[[Last[FindShortestTour[boundaryPts]]]]],
ListPlot[pts, PlotStyle -> Red]] Little different, the parameters need adjusting

A rough attempt edge detect vertically and horizontally

Using Coolwater's really nice use of ShortestPath to plot v = Table[
Position[xy[[All, 1]], #] & /@
MinMax[Select[xy, i + 0.001 > #[] > i &][[All, 1]]], {i, 0.01,
0.026, 0.001}] // Flatten
h = Table[
Position[xy[[All, 2]], #] & /@
MinMax[Select[xy, j + 0.0001 > #[] > j &][[All, 2]]], {j,
0.03255, 0.03365, 0.0001}] // Flatten
Join[v, h]
xy[[#]] & /@ %

Show[ListPlot[{xy, %}, PlotStyle -> {Black
, Red}], ListLinePlot[%[[Last[FindShortestTour[%]]]]]]