WOLFRAM NOTEBOOK

3D Thinning algorithm in Wolfram Language

Source: https://community.wolfram.com/groups/-/m/t/1561268

Here I will explain how to perform 3D Thinning with Wolfram Language. Though I will admit there’s a lot of room for improvement.

In this post I’ll refer to

the medial surface of a 3D object O as the surface comprising the points equidistant from at least 2 points on ∂O
the medial axis of a 3D object as the singular (or non-manifold) edges of the medial surface.
The main idea of this answer is that for a sufficiently dense sampling of points on the boundary of a volume, the vertices, edges, and faces of the Voronoi diagram gives an approximation to the medial surface. Since OP is interested in lines, I will use this to find the medial axis.

— Since the medial surface is geometrically unstable, this answer might be a dead end. —

First here’s the code to find Voronoi faces for a set of points:

VoronoiFaces3D[pts_]:=Block[{minmax,padding,vpts,dm,prims,vnodes,conn,adj,vlines,mr1d,linepairs,normals,planar,faces},minmax=MinMax/@Transpose[pts];padding=Abs[Subtract@@@minmax];vpts=Join[pts,(minmax[[All,1]]-padding)IdentityMatrix[3],(minmax[[All,2]]+padding)IdentityMatrix[3]];dm=DelaunayMesh[vpts];prims=MeshPrimitives[dm,3,"Multicells"True][[1,1]];vnodes=First@*Circumsphere/@prims;conn=dm["ConnectivityMatrix"[3,2]];adj=conn.Transpose[conn];vlines=UpperTriangularize[adj,1]["NonzeroPositions"];mr1d=Quiet@MeshRegion[vnodes,Line[vlines]];conn=mr1d["ConnectivityMatrix"[0,1]];adj=Unitize[conn.Transpose[conn]]-IdentityMatrix[Length[conn],SparseArray];linepairs=Catenate[Insert[#1,2]/@Subsets[{##2},{2}]&@@@adj["MatrixColumns"]];normals=lpNormals[vnodes,linepairs];planar=GatherByList[linepairs,Round[normals,10^-8.]];(*thisismightnotworkforadjacentcoplanarfaces...*)faces=FindFundamentalCycles[Apply[UndirectedEdge,Catenate[Union@@@validEdges[planar,Range[Length[planar]]]],{1}]][[All,All,1,1]];Thread[Polygon[faces]/.Dispatch[Thread[Range[Length[vnodes]]vnodes]]]](*functionintroducedbelow*)GatherByList[list_,representatives_]:=Module[{func},func/:Map[func,_]:=representatives;GatherBy[list,func]]lpNormals=Compile[{{coords,_Real,2},{lp,_Integer,1}},Module[{cross,sgn},cross=Cross[coords[[lp[[2]]]]-coords[[lp[[1]]]],coords[[lp[[3]]]]-coords[[lp[[1]]]]];cross=cross/Sqrt[cross.cross];sgn=Sign[First[cross]];If[sgn0,sgn=Sign[cross[[2]]]];If[sgn0,sgn=Sign[cross[[3]]]];sgn*cross],RuntimeAttributes{Listable},CompilationTarget"C",ParallelizationTrue,RuntimeOptions"Speed"];validEdges=Compile[{{inds,_Integer,1},{k,_Integer}},Module[{i1,i2,i3},i1=inds[[1]];i2=inds[[2]];i3=inds[[3]];Which[i1>i2&&i3>i2,{{{i2,k},{i1,k}},{{i2,k},{i3,k}}},i2>i1&&i3>i2,{{{i1,k},{i2,k}},{{i2,k},{i3,k}}},i1>i2&&i2>i3,{{{i2,k},{i1,k}},{{i3,k},{i2,k}}},True,{{{i1,k},{i2,k}},{{i3,k},{i2,k}}}]],RuntimeAttributes{Listable},CompilationTarget"C",ParallelizationTrue,RuntimeOptions"Speed"];

GatherByList introduced here.

Since I have yet to answer 18893 (with this code), here’s an example:

SeedRandom[10000];pts=RandomReal[{0,1},{1000,3}];faces=VoronoiFaces3D[pts];Graphics3D[MapIndexed[{Lighter[ColorData[112]@@#2,.3],#1}&,faces],PlotRange{{0,1},{0,1},{0,1}},Lighting{{"Ambient",White}},BoxedFalse]

The following function takes in a binary Image3D object, converts it into a BoundaryMeshRegion, approximates the medial surface, finds the approximate medial axis, then converts back into an image. To approximate the medial surface, I simply take the Voronoi faces completely contained in the object.

MedialAxisThinning3D[im3d_Image3D,testpts_:1000,smallsize_:Automatic,seed_:10000]/;ImageType[im3d]==="Bit":=Block[{bd,im3dc,bmr,pts,faces,rmf,ms,se,ma,medialaxis},bd=BorderDimensions[im3d,0];im3dc=ImagePad[im3d,-bd];bmr=ImageMesh[im3dc,Method"DualMarchingCubes"];BlockRandom[SeedRandom[seed];pts=RandomPoint[RegionBoundary[bmr],testpts];];faces=VoronoiFaces3D[pts];rmf=RegionMember[bmr];ms=DiscretizeGraphics[Polygon[Select[faces[[All,1]],And@@rmf[#]&]]];se=Pick[Range[MeshCellCount[ms,1]],UnitStep[2-Differences[ms["ConnectivityMatrix"[1,2]]["RowPointers"]]],0];ma=MeshRegion[MeshCoordinates[ms],MeshCells[ms,{1,se}]];medialaxis=ImageResize[ImagePad[#,-BorderDimensions[#,0]]&[RegionImage[RegionUnion[ma,Point[Tuples[RegionBounds[bmr]]]]]],ImageDimensions[im3dc]];ImagePad[DeleteSmallComponents[Binarize[medialaxis],Replace[smallsize,AutomaticSequence[],{0}],CornerNeighborsFalse],bd]]

We can see there are some heuristic parameters. I haven’t found a way to automatically determine appropriate values.

Note too that this routine can be slow. I think there’s a lot of room for improvement.

Some examples:

im3d=ImageCrop[Binarize[FillingTransform[Closing[ExampleData[{"TestImage3D","Orbits"}],1]]]];medialaxis=MedialAxisThinning3D[im3d];{im3d,medialaxis}

bd=ImagePad[EdgeDetect[ImagePad[im3d,1]],-1];pp=PixelValuePositions[bd,1];towhite=Pick[pp,UnitStep[Transpose[pp][[1]]-40],1];slice=im3d*Dilation[ReplacePixelValue[bd,towhite0],1];{ColorCombine[{bd,medialaxis,.7medialaxis}],ColorCombine[{slice,medialaxis,.7medialaxis}]}

Addendum

Based on papers of Amenta and Attali, a better approximation can be found, but we need to be able to find intersections of spheres efficiently.

◼

Part II

One approach is to apply a topology preserving morphological thinning method. I’ll implement an algorithm by Lee. The main idea is to look at every 3x3x3 cube in the image and to decide which pixels are valid to delete. For the most part I stuck to his approach, except I did not implement the function Octree_Labeling. It’s wildly recursive and Compile does not allow for recursion. Instead I took a transitive closure approach.

The compiled routines are quite messy looking since a lot of things are baked into precomputed lookup tables:

The main routine:

Some examples:

The second argument represents how many iterations of thinning to perform. The default is Infinity:

Other images:

You are using a browser not supported by the Wolfram Cloud

Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.

I understand and wish to continue anyway »