从Mathematica中的ContourPlot中提取轮廓

Question

我有两个变量的函数f（x，y），其中我需要知道它过零的曲线的位置。 ContourPlot非常有效地做到了这一点（即：它使用巧妙的多网格方法，而不仅仅是一个强力细粒度扫描），但只是给了我一个情节。我想有一组值{x，y}（具有一些指定的分辨率）或者可能有一些插值函数，它允许我访问这些轮廓的位置。

考虑过从ContourPlot的FullForm中提取这个，但这似乎有点像黑客。有没有更好的方法呢？

Answer 1

如果你最终从ContourPlot中提取点数，这是一种简单的方法：

points = Cases[
  Normal@ContourPlot[Sin[x] Sin[y] == 1/2, {x, -3, 3}, {y, -3, 3}],
  Line[pts_] -> pts,
  Infinity
]

Join @@ points (* if you don't want disjoint components to be separate *)

编辑

ContourPlot似乎没有产生非常精确的轮廓。它们当然是用于绘图而且足够好，但这些要点并不恰好在轮廓上：

In[78]:= Take[Join @@ points /. {x_, y_} -> Sin[x] Sin[y] - 1/2, 10]

Out[78]= {0.000163608, 0.0000781187, 0.000522698, 0.000516078, 
0.000282781, 0.000659909, 0.000626086, 0.0000917416, 0.000470424, 
0.0000545409}

我们可以尝试用自己的方法来追踪轮廓，但是以一般的方式做这件事会很麻烦。这是一个概念，适用于具有平滑轮廓的平滑变化的函数：

1. 从某个点（pt0）开始，沿着f的渐变找到与轮廓的交点。

2. 现在我们在轮廓上有一个点。沿着轮廓的切线移动一个固定的步长（resolution），然后从步骤1开始重复。

这是一个基本实现，仅适用于可以符号区分的函数：

rot90[{x_, y_}] := {y, -x}

step[f_, pt : {x_, y_}, pt0 : {x0_, y0_}, resolution_] :=
 Module[
  {grad, grad0, t, contourPoint},
  grad = D[f, {pt}];
  grad0 = grad /. Thread[pt -> pt0];
  contourPoint = 
    grad0 t + pt0 /. First@FindRoot[f /. Thread[pt -> grad0 t + pt0], {t, 0}];
  Sow[contourPoint];
  grad = grad /. Thread[pt -> contourPoint];
  contourPoint + rot90[grad] resolution
 ]

result = Reap[
   NestList[step[Sin[x] Sin[y] - 1/2, {x, y}, #, .5] &, {1, 1}, 20]
];

ListPlot[{result[[1]], result[[-1, 1]]}, PlotStyle -> {Red, Black}, 
 Joined -> True, AspectRatio -> Automatic, PlotMarkers -> Automatic]



红点是“起点”，而黑点是轮廓的痕迹。

编辑2

也许这是一种更简单，更好的解决方案，可以使用类似的技术使我们从ContourPlot获得的点更精确。从初始点开始，然后沿着渐变移动，直到我们与轮廓相交。

请注意，此实现也适用于无法通过符号进行区分的函数。如果是这种情况，只需将函数定义为f[x_?NumericQ, y_?NumericQ] := ...。

f[x_, y_] := Sin[x] Sin[y] - 1/2

refine[f_, pt0 : {x_, y_}] := 
  Module[{grad, t}, 
    grad = N[{Derivative[1, 0][f][x, y], Derivative[0, 1][f][x, y]}]; 
    pt0 + grad*t /. FindRoot[f @@ (pt0 + grad*t), {t, 0}]
  ]

points = Join @@ Cases[
   Normal@ContourPlot[f[x, y] == 0, {x, -3, 3}, {y, -3, 3}],
   Line[pts_] -> pts,
   Infinity
   ]

refine[f, #] & /@ points

Answer 2

从ContourPlot（可能是由于David Park）提取点数略有不同：

pts = Cases[
   ContourPlot[Cos[x] + Cos[y] == 1/2, {x, 0, 4 Pi}, {y, 0, 4 Pi}], 
   x_GraphicsComplex :> First@x, Infinity];

或（作为{x，y}点列表）

ptsXY = Cases[
   Cases[ContourPlot[
     Cos[x] + Cos[y] == 1/2, {x, 0, 4 Pi}, {y, 0, 4 Pi}], 
    x_GraphicsComplex :> First@x, Infinity], {x_, y_}, Infinity];

修改

正如所讨论的here， Mathematica期刊（在间隔中查找根）中的Paul Abbott的article给出了以下两种选择从ContourPlot获取{x，y}值列表的方法，包括（！）

ContourPlot[...][[1, 1]]

对于上面的例子

ptsXY2 = ContourPlot[
    Cos[x] + Cos[y] == 1/2, {x, 0, 4 Pi}, {y, 0, 4 Pi}][[1, 1]];

和

ptsXY3 = Cases[
   Normal@ContourPlot[
     Cos[x] + Cos[y] == 1/2, {x, 0, 4 Pi}, {y, 0, 4 Pi}], 
   Line[{x__}] :> x, Infinity];

，其中

ptsXY2 == ptsXY == ptsXY3