使用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演示项目的整洁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的情况是例外的 - 它们在度量方面是零度量的控制范围.因此,改变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])