Управление наборами решений с нулевой мерой с помощью Manipulate. Тематическое исследование

Чтобы ответить на этот вопрос, мы начнем со следующей задачи с игрушечной моделью, которая здесь является всего лишь примером:

Даны две окружности на плоскости (ее центры (c1 и c2) и радиусы (r1 и r2) )), а также положительное число r3, найдите все окружности с радиусом = r3 (т. е. все точки c3, являющиеся центрами окружностей с радиусом = r3), касательные (внешне и внутренне) к заданным двум окружностям.

В общем, в зависимости от Circle [c1, r1], Circle [c2, r2] и r3 существует 0,1,2, ... 8 возможных решений.Типичный случай с 8 решениями:

Я немного изменил аккуратную реализацию Mathematica, разработанную Хайме Рангель-Мондрагоном в Wolfram Demonstration Project , но ее ядро ​​аналогично:

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, а также перепроектировать Манипулировать структурой с акцентом на изменение количества решений. Если я не ошибаюсь, Solve может работать только численно с Locator в Manipulate , однако здесь Locator кажется решающим для простоты управление c1, r1, c2, r2 , а также для всей реализации.
Сформулируем вопросы:

1. Как мы можем заставить Manipulate беспрепятственно отслеживать случаи с нечетным числом решений (кружки)?

2.Есть ли способ заставить Решить , чтобы найти точные решения лежащих в основе уравнений?

(Я считаю, что ответ Даниэля Лихтблау является лучшим подходом к вопросу 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 до Исчезновение всех решений (напоминающее так называемую структурную неустойчивость) выглядит так:

Манипуляция - довольно мощный инструмент, не только игрушка, и его освоение может быть очень полезным.Рассматриваемые вопросы при появлении в серьезном исследовании часто являются критическими, например: при изучении решений нелинейного дифференциального уравнения, возникновения особенностей в его решениях, качественного поведения динамических систем, бифуркаций, явлений в теории катастроф и так далее.