5
$\begingroup$

I have a data set, say, {$x_i, y_i$}. After plotting which looks like the following

enter image description here

How can I get the data set for the boundary from this. Here is the link for my data

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

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]

enter image description here

$\endgroup$
7
$\begingroup$

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[[1]] - #[[1]], db = #2[[2]] - #[[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]]

$\endgroup$
3
$\begingroup$

Little different, the parameters need adjusting

A rough attempt edge detect vertically and horizontally

Using Coolwater's really nice use of ShortestPath to plot

enter image description here

v = Table[
   Position[xy[[All, 1]], #] & /@ 
    MinMax[Select[xy, i + 0.001 > #[[2]] > i &][[All, 1]]], {i, 0.01, 
    0.026, 0.001}] // Flatten
h = Table[
   Position[xy[[All, 2]], #] & /@ 
    MinMax[Select[xy, j + 0.0001 > #[[1]] > j &][[All, 2]]], {j, 
    0.03255, 0.03365, 0.0001}] // Flatten
Join[v, h]
xy[[#]] & /@ %

Show[ListPlot[{xy, %}, PlotStyle -> {Black
    , Red}], ListLinePlot[%[[Last[FindShortestTour[%]]]]]]
$\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.