4

I have the following data: Data.csv

It crates the following image:

enter image description here

Im trying to make a concave hull so that I can create an outline of the region. I have tried to use all versions of the alphaShapes2D code found in this answer. I think have pinpointed the issue, it seems my points are too close. In the latest versions of the code it create a "complex infinity". While in the first version it just creates incredibly large numbers, when computing the radii of the tetrahedrons. I tried to manually remove these error by adding another line to the code. Each time it creates the error MeshRegion::dgcellr: Degenerate cells including Polygon[{22,19,21}] have been removed.

Any ideas how to make this work?

So if I edit the data to delete duplicates, which I overlooked. The edited code works. However the latest version alphaShapes2DC still outputs the same error even if the duplicates are removed.

P.S. Here is the version of the code I tried to modify:

 alphaShapes2D[points_, crit_] := Module[{alphacriteria, del =Quiet@DelaunayMesh@points, 
 tetras,tetcoords, tetradii, tetradii2, selectExternalFaces}, 
 alphacriteria[tetrahedra_, radii_, rmax_] := 
 Pick[tetrahedra, UnitStep@Subtract[rmax, radii], 1];
 selectExternalFaces[facets_] := MeshRegion[points, facets];
 If[Head[del] === EmptyRegion, del, tetras = MeshCells[del, 2];
 tetcoords = MeshPrimitives[del, 2][[All, 1]];
 tetradii = Quiet@Thread[Circumsphere[tetcoords]][[All, 2]];
 tetradii2 = If[# < 1, #, 1] & /@ tetradii;
 selectExternalFaces@alphacriteria[tetras, tetradii2, crit]]
 ]
Giovanni Baez
  • 967
  • 5
  • 12

1 Answers1

3

There were some duplicated points which induced division by zero when their distance popped up as a dividend somewhere. I also sprayed in some additional points in the interior to prevent that the middle of the figure is "thinned" out too fast.

a = Developer`ToPackedArray[N@Import["borderdata.csv", "Data"]];
x = Join[
   DeleteDuplicates[a],
   ConstantArray[0., {1, 2}],
   CirclePoints[{0.015, 0}, 16],
   CirclePoints[{0.0075, Pi/8}, 8]
   ];
Show[alphaShapes2D[x, 0.006], Graphics[Point[x]]]

enter image description here

I am not sure though whether this is what you wanted to achieve.

Henrik Schumacher
  • 106,770
  • 7
  • 179
  • 309