Delaunay Triangulations

Math 282 Computational Geometry

(Based on code from Joseph O’Rourke.)

First, generate a set of 2D points with coords in [-1, 1] :

pts=RandomReal[{-1,1},{20,2}];

Graphics[{Blue,PointSize[0.02],Point[pts]},Frame->True]

Mathematica can easily create the Delaunay triangulation.  Mathematica gives us the triangulation as a “mesh region”:

ℛ=DelaunayMesh[pts]

Note that ℛ can be entered by EscscREsc.

You can see the contents of ℛ like this:

?ℛ

You can find out what kind of expression is stored in ℛ using the Head function:

Head@ℛ

Now show Delaunay triangulation.

delaunayGraphic=HighlightMesh[ℛ,{Style[0,Blue,PointSize[Medium]],Style[1,Purple],Style[2,LightCyan]}]

We can extract the 2D cells from the triangulation.

We will store the triangles in a list Δs. Note the cells are graphics objects Polygon, specified using indices in our list pts.

Δs=MeshCells[ℛ,2]

We can also extract the indexes of the polygons.

We can do this by looping over triangles in the list Δs:

listOfIndexes={};
Do[
AppendTo[listOfIndexes,tri[[1]]],  (* need [[1]] to get the indices from the polygon *)
{tri,Δs}]
listOfIndexes

Here is a slick way to do the same thing:

First/@Δs

Now convert the indexes to 2D coordinates (ordered pairs)

Here is a simple way to do it:

listOfTriPts = {};
Do[
AppendTo[listOfTriPts,pts[[idx]]],
{idx,listOfIndexes}];
listOfTriPts

And here is a slick way:

pts[[#]]& /@listOfIndexes

We can then display both the Delaunay triangulation and the circumcircle of a triangle

c1=Circumsphere[listOfTriPts[[1]]]

Show[
delaunayGraphic,
Graphics[{Orange,Opacity[0.4],Polygon[listOfTriPts[[1]]],Opacity[1],c1}],
PlotRange->{{-2,2},{-2,2}}
]

We could also show the circumcircles of all triangles in the Delaunay triangulation

listOfSpheres=Circumsphere/@listOfTriPts;

Show[
delaunayGraphic,
Graphics[{Orange,listOfSpheres}],
PlotRange->{{-2,2},{-2,2}}
]

Or we could show one circle after another like this:

Manipulate[
Show[
delaunayGraphic,
Graphics[{Orange,Opacity[0.5],Polygon[listOfTriPts[[i]]],Opacity[1],listOfSpheres[[i]]}],
PlotRange->{{-2,2},{-2,2}}
],
{i,1,Length[listOfTriPts],1}
]