在 Mathematica 中绘制 DelaunayTriangulation答案

【问题标题】：Plot DelaunayTriangulation in Mathematica在 Mathematica 中绘制 DelaunayTriangulation
【发布时间】：2011-09-22 02:26:44
【问题描述】：

考虑以下示例 (from Sjoerd Solution on plotting a ConvexHull)

Needs["ComputationalGeometry`"]
pts = RandomReal[{0, 10}, {60, 2}];
dtpts=DelaunayTriangulation[pts]

我现在想为一组点绘制 DelaunayTriangulation，但无法使用 Graphics 找出 Plot 语法。

想法？

【问题讨论】：

标签： graphics geometry wolfram-mathematica

【解决方案1】：

方法一，使用像Sjoerd这样的多边形，但是没有凸包上的点引起的问题：

Graphics[{FaceForm[], EdgeForm[Black], 
  Polygon[pts[[#]] & /@ 
    DeleteCases[dtpts, {i_, _} /; MemberQ[ConvexHull[pts], i]][[All, 
      2]]], Red, Point[pts]}]

方法二，用线连接相邻点：

edges[pts_, {a_, l_List}] := {pts[[a]], #} & /@ pts[[l]]
Graphics[{Line[edges[pts, #]] & /@ dtpts, Red, Point[pts]}]

这两种方法都会导致重复的图元（三个多边形或两条线，因为使用每个点作为起点。）

我们可以稍微修改数据并使用内置的可视化功能：

Graphics[{FaceForm[], EdgeForm[Black], 
  Cases[Normal[
    ListDensityPlot[{##, 0.} & @@@ pts, Mesh -> All]], _Polygon, 
   Infinity], Red, Point[pts]}, ImageSize -> 175]

【讨论】：

我已经在 15 分钟前更改了我的解决方案。我也有一个多边形解决方案准备更新......

【解决方案2】：

Graphics[
  GraphicsComplex[
    pts, 
    {
      Function[{startPt, finishPts},Line[{startPt, #}] & /@ finishPts] @@@ dtpts, 
      Red, Point@Range[Length@pts]
    }
   ]
  ]

如果你需要真正的多边形：

Graphics[
 GraphicsComplex[
  pts, 
  {EdgeForm[Black], 
   Function[{startPt, finishPts}, 
      {FaceForm[RGBColor[RandomReal[], RandomReal[], RandomReal[]]], 
        Polygon[{startPt, ##}]} & @@@ 
          Transpose[{Drop[finishPts, 1], 
                     Drop[RotateRight@finishPts, 1]
                    }
          ]
         ] @@@ dtpts, 
   Red, Point@Range[Length@pts]
  }
 ]
]

【讨论】：

@Sjoerd，再次感谢您！我编辑了我的问题来描述 dtpts。
输出的新解释。这个更好
嗯，它仍然不完美。它们的生成方式，所有多边形在三角测量结果中出现多次。但这是排序和使用 Union 的问题。
@Sjoerd，你知道如何计算边数吗？
@500 brett 定义了一个边函数。您可以使用它，对边缘点进行排序，删除重复项，计数。容易。

【解决方案3】：

我喜欢 Sjoerd 对GraphicsComplex 的使用，但我认为不需要中间的巴洛克式代码。

这似乎工作得很好：

Needs["ComputationalGeometry`"]
pts = RandomReal[{0, 10}, {60, 2}];
dtpts = DelaunayTriangulation[pts];

行

Graphics[GraphicsComplex[
  pts,
  {Line /@ Thread /@ dtpts, Red, Point@Range@Length@pts}
]]

多边形

Graphics[GraphicsComplex[
  pts,
  {
    EdgeForm[Black],
    ( {FaceForm[RGBColor @@ RandomReal[1, 3]], Polygon@#} & /@ 
      Append @@@ Thread@{Partition[#2, 2, 1], #} & ) @@@ dtpts,
    Red,
    Point@Range[Length@pts]
  }
]]

【讨论】：