wolfram-mathematica - 包含在 "regular"区域中的 "irregular"点阵上的数据的 ListPlot3D

Question

尝试在 Mathematica 中绘制一些 3D 数据时遇到以下问题。数据最初是在规则格子上计算的，即我计算

data = Flatten[Table[{x,y,f[x,y]},{x,x0,x1,dx},{y,y0,y1,dy}],1]

问题是 f仅在非凸子集中采用实数值 U在飞机上。 U实际上非常讨厌:一个“三角形”区域，其中所有的角都是尖角(想象三个相同圆圈之间的区域，其中任意两个彼此相切)。当我尝试绘制 data 时与 ListPlot3D ，后者在 U 的凸包上绘制了一个曲面。 .

我想知道是否有办法告诉 Mathematica 将自身限制在 U 内.我在想，由于我的观点已经位于“常规”格子上，这应该不会太难，但我还没有找到解决方案。

我知道 RegionFunction选项，但在我的情况下计算非常昂贵，所以我试图找出一种仅使用 data 中已经计算的点的方法。 .

Answer 1

要生成非常漂亮的图片，而不使用数以百万计的点，您可能需要使用非均匀分布的点，其中包括您想要的区域的边界。这是一个有点像你描述的例子。我们从三个相互相切的圆开始。

circPic = Graphics[{Circle[{0, Sqrt[3]}, 1],
  Circle[{-1, 0}, 1], Circle[{1, 0}, 1]}]

我们编写了一个 bool 函数来确定矩形 {0,Sqrt[3]/2} 中的点 {-1/2,1/2} 是否位于所有圆之外，并使用它来生成该区域中的一些点出于兴趣。

inRegionQ[p:{x_, y_}] := Norm[p - {1, 0}] > 1 &&
  Norm[p + {1, 0}] > 1 && Norm[p - {0, Sqrt[3]}] > 1;
rectPoints = N[Flatten[Table[{x, y},
  {x, -1/2, 1/2, 0.02}, {y, 0.05, Sqrt[3]/2, 0.02}], 1]];
regionPoints = Select[rectPoints, inRegionQ];

现在我们生成边界。参数 n 决定了我们在边界上放置的点数。

n = 120;
boundary = N[Join[
  Table[{1 - Cos[t], Sin[t]}, {t, Pi/n, Pi/3, Pi/n}],
  Table[{Cos[t], Sqrt[3] - Sin[t]}, {t, Pi/3 + Pi/n, 2 Pi/3, Pi/n}],
  Table[{Cos[t] - 1, Sin[t]}, {t, Pi/3 - Pi/n, 0, -Pi/n}]]];
points = Join[boundary, regionPoints];

让我们来看看。

Show[circPic, Graphics[Point[points]],
  PlotRange -> {{-3/4, 3/4}, {-0.3, 1.3}}]

现在，我们定义一个函数并使用 ListPlot3D尝试绘制它。

f[x_, y_] := -(1 - Norm[{x - 1, y}]) (1 - Norm[{x + 1, y}])*
  (1 - Norm[{x, y - Sqrt[3]}]);
points3D = {#[[1]], #[[2]], f[#[[1]], #[[2]]]} & /@ points;
pic = ListPlot3D[points3D, Mesh -> All]

不知何故，我们必须删除位于该区域之外的内容。在这个特定的例子中，我们可以使用函数在边界上为零的事实。

DeleteCases[Normal[pic], Polygon[{
  {x1_, y1_, z1_?(Abs[#] < 1/10.0^6 &)},
  {x2_, y2_, z2_?(Abs[#] < 1/10.0^6 &)},
  {x3_, y3_, z3_?(Abs[#] < 1/10.0^6 &)}}, ___],
  Infinity]

非常好，但在尖端附近有几个问题，它绝对不是很普遍，因为它使用了函数的特定属性。如果你检查 pic 的结构，你会发现它包含一个 GraphicsComplex和第一个参数中的前 n 个点 GraphicsComplex正是边界。这里有证据:

Most /@ pic[[1, 1, 1 ;; n]] == boundary

现在边界由三个部分组成，我们想要删除由仅从其中一个部分中选择的点形成的任何三角形。以下代码执行此操作。请注意，boundaryComponents 包含形成边界的那些点的索引，如果 A 是任何一个 B 的子集， someSubsetQ[A,Bs] 返回 true。我们想要删除多多边形中作为边界组件之一的子集的那些三角形索引。这是由 DeleteCases 在以下代码中完成的命令。

哦，让我们也添加一些装饰。

subsetQ[A_, B_] := Complement[A, B] == {};
someSubsetQ[A_, Bs_] := Or @@ Map[subsetQ[A, #] &, Bs];
boundaryComponents = Partition[Prepend[Range[n], n], 1 + n/3, n/3];
Show[pic /. Polygon[triangles_] :> {EdgeForm[Opacity[0.3]],
  Polygon[DeleteCases[triangles, _?(someSubsetQ[#, boundaryComponents] &)]]},
Graphics3D[{Thick, Line[Table[Append[pt, 0],
  {pt, Prepend[boundary, Last[boundary]]}]]}]]