math - 使用 Manipulate 控制测量零组解。案例研究

Question

为了解决这个问题，我们从以下玩具模型问题开始，这里只是一个案例研究:

给定平面上的两个圆(其圆心(c1 和 c2)和半径(r1 和 r2))以及正数 r3，找到半径 = r3 的所有圆(即所有点 c3 都是圆心)半径 = r3 的圆的数量)与给定的两个圆相切(外部和内部)。

一般来说，取决于Circle[c1,r1], Circle[c2,r2] and r3有 0,1,2,...8 种可能的解决方案。典型案例有8种解决方案:

我稍微修改了 Jaime Rangel-Mondragon 在 Wolfram Demonstration Project 上简洁的 Mathematica 实现。 ，但其核心是相似的:

Manipulate[{c1, a, c2, b} = pts;
           {r1, r2} = Map[Norm, {a - c1, b - c2}];

            w = Table[
                       Solve[{radius[{x, y} - c1]^2 == (r + k r1)^2, 
                              radius[{x, y} - c2]^2 == (r + l r2)^2}
                            ] // Quiet, 
                       {k, -1, 1, 2}, {l, -1, 1, 2}
                    ];
            w = Select[
                       Cases[Flatten[{{x, y}, r} /. w, 2],
                             {{_Real, _Real}, _Real}
                            ], 
                       Last[#] > 0 &
                     ];
           Graphics[
                    {{Opacity[0.35], EdgeForm[Thin], Gray,
                                                      Disk[c1, r1], Disk[c2, r2]},      
                     {EdgeForm[Thick], Darker[Blue,.5],
                                                   Circle[First[#], Last[#]]& /@ w}
                    },
                       PlotRange -> 8, ImageSize -> {915, 915}
                   ],
           "None" -> {{pts, {{-3, 0}, {1, 0}, {3, 0}, {7, 0}}},
                      {-8, -8}, {8, 8}, Locator}, 
           {{r, 0.3, "r3"}, 0, 8}, 
           TrackedSymbols -> True,
           Initialization :> (radius[z_] := Sqrt[z.z])
         ]

我们可以很容易地得出结论，在一般情况下，我们有偶数个解决方案 0,2,4,6,8，而具有奇数个解决方案 1,3,5,7 的情况是异常(exception) - 它们为零以控制范围来衡量。从而改变Manipulate c1, r1, c2, r2, r3人们可以观察到，跟踪具有奇数个圆圈的案例要困难得多。

可以在基本层面上修改上述方法:求解 c3 的纯符号方程以及重新设计 Manipulate结构，重点是改变解决方案的数量。如果我没记错的话Solve只能与 Locator 进行数字运算在Manipulate ，但是这里Locator似乎对于控制的简单性至关重要c1, r1, c2, r2以及整个实现。
让我们陈述问题:

<强>1。我们如何强制 Manipulate 无缝跟踪具有奇数个解决方案(圆圈)的案例？

<强>2。有什么办法可以制作Solve找到基本方程的精确解？

( 我发现 Daniel Lichtblau 的答案是解决问题 2 的最佳方法，但在这种情况下，仍然有必要草拟一种强调测量零解集的通用技术，同时与 Manipulate 一起使用)

在处理精确解时，这些考虑因素不太重要

例如Solve[x^2 - 3 == 0, x]产量{{x -> -Sqrt[3]}, {x -> Sqrt[3]}}而从上面的情况来看，从Manipulate中提取的稍微困难的方程设置以下参数:

 c1 = {-Sqrt[3], 0};  a = {1, 0};  c2 = {6 - Sqrt[3], 0};  b = {7, 0};     
 {r1, r2} = Map[ Norm, {a - c1, b - c2 }];  
  r = 2.0 - Sqrt[3];

至:

w = Table[Solve[{radius[{x, y} - {x1, y1}]^2 == (r + k r1)^2, 
                 radius[{x, y} - {x2, y2}]^2 == (r + l r2)^2}],
          {k, -1, 1, 2}, {l, -1, 1, 2}];

w = Select[ Cases[ Flatten[ {{x, y}, r} /. w, 2], {{_Real, _Real}, _Real}],    
            Last[#] > 0 &]

我们得到两个解决方案:

{{{1.26795, -3.38871*10^-8}, 0.267949}, {{1.26795, 3.38871*10^-8}, 0.267949}}

同样在相同的参数和方程下，输入:

r = 2 - Sqrt[3]; 

我们没有得到解决方案: {}

但实际上我们想强调的是一个解决方案:

{ {3 -  Sqrt[3], 0 }, 2 -  Sqrt[3] }

事实上，传递到 Graphics两种不同的解决方案和唯一的解决方案之间如此小的差异是无法区分的，但是使用Manipulate我们无法以所需的精度仔细跟踪两个圆的合并，并且通常在降低 r3 时最后观察到的配置在所有解决方案消失之前(提醒所谓的结构不稳定)看起来像这样:

Manipulate它是一个强大的工具，而不仅仅是一个玩具，掌握它可能非常有用。在严肃的研究中出现的所考虑的问题通常是至关重要的，例如:在研究非线性微分方程的解、其解中奇点的出现、动力系统的定性行为、分岔、突变理论中的现象等等。

Answer 1

由于这是一个测量零集，需要一定粒度的工具通常会遇到这个概念的问题。也许更好的方法是明确地寻找奇点轨迹，其中解决方案具有多重性或以其他方式偏离附近的解决方案行为。它将成为判别品种的一部分。特别是，您可以通过将定义多项式设置为零并同时将雅可比行列式设置为零来获取相关部分。

这是您的示例。我最终(wlog)将一个中心放在原点，另一个中心放在(1,0)。

centers = Array[c, {2, 2}];
radii = Array[r, 3];
circ[cen_, rad_, x_, y_] := ({x, y} - cen).({x, y} - cen) - rad^2

我将使用您的“k”来表示这两个多项式。您的公式有对 (k,l)，其中每个都是 +-1。我们可以只使用 k，通过平方排列得到 k^2 中的多项式，然后将其替换为 1。

 polys = 
 Table[Expand[
   circ[centers[[j]], radii[[3]] + k*radii[[j]], x, y]], {j, 2}]

Out[18]= {x^2 + y^2 - 2 x c[1, 1] + c[1, 1]^2 - 2 y c[1, 2] + 
  c[1, 2]^2 - k^2 r[1]^2 - 2 k r[1] r[3] - r[3]^2, 
 x^2 + y^2 - 2 x c[2, 1] + c[2, 1]^2 - 2 y c[2, 2] + c[2, 2]^2 - 
  k^2 r[2]^2 - 2 k r[2] r[3] - r[3]^2}

我们将删除与 k 成线性的部分，对其余部分进行平方，对删除的部分进行平方，然后使两者相等。然后我们还将 k 替换为 unity。

p2 = polys - k*Coefficient[polys, k];
polys2 = Expand[p2^2 - (k*Coefficient[polys, k])^2] /. k -> 1;

我们现在得到雅可比矩阵的行列式并将其添加到酿造中。

discrim = Det[D[polys2, #] & /@ {x, y}];

allrelations = Join[polys2, {discrim}];

现在按照前面提到的那样设置中心(有人认为可以从一开始就这样做)。

ar2 = 
 allrelations /. {c[1, 1] -> 0, c[1, 2] -> 0, c[2, 1] -> 0, 
   c[2, 2] -> 0}

Out[38]= {x^4 + 2 x^2 y^2 + y^4 - 2 x^2 r[1]^2 - 2 y^2 r[1]^2 + 
  r[1]^4 - 2 x^2 r[3]^2 - 2 y^2 r[3]^2 - 2 r[1]^2 r[3]^2 + r[3]^4, 
 x^4 + 2 x^2 y^2 + y^4 - 2 x^2 r[2]^2 - 2 y^2 r[2]^2 + r[2]^4 - 
  2 x^2 r[3]^2 - 2 y^2 r[3]^2 - 2 r[2]^2 r[3]^2 + r[3]^4, 0}

我们现在消除 x 和 y 以获得 r[1]、r[2]、r[3] 参数空间中的轨迹，该轨迹决定我们的解决方案中的多重性。

 gb = GroebnerBasis[ar2, radii, {x, y}, 
   MonomialOrder -> EliminationOrder]

{r[1]^6 - 3 r[1]^4 r[2]^2 + 3 r[1]^2 r[2]^4 - r[2]^6 - 
   8 r[1]^4 r[3]^2 + 8 r[2]^4 r[3]^2 + 16 r[1]^2 r[3]^4 - 
   16 r[2]^2 r[3]^4}

如果我正确地完成了这一切，那么我们现在就有了定义参数空间中轨迹的多项式，其中解集可能会变得愚蠢。在这个集合之外，它们不应该有重数，并且实际计数应该始终是偶数。该集合与真实空间的交集将是半径参数的 3d 空间中的 2d 表面。它将具有 0、2、4、6 或 8 个实解的区域彼此分开。

最后，我会指出，在这个例子中，所讨论的多样性很好地简化为飞机的乘积。我想从几何角度来看这并不太令人惊讶。

Factor[gb[[1]]]

Out[43]= (r[1] - r[2]) (r[1] + r[2]) (r[1] - r[2] - 2 r[3]) (r[1] + 
   r[2] - 2 r[3]) (r[1] - r[2] + 2 r[3]) (r[1] + r[2] + 2 r[3])