Обновлено : см. Ниже.
Сначала я подойду к этому, визуализируя мнимые части корней:
Это сразу говорит о трех вещах: 1) первый корень всегда действителен, 2) вторые две являются сопряженными парами, и 3) существует небольшая область около нуля, в которой все три являются действительными.Кроме того, обратите внимание, что исключения только избавились от особой точки в x=0, и мы можем видеть, почему, когда мы увеличиваем:
Затем мы можем использовать EvalutionMonitor для генерации списка корней напрямую:
Map[Module[{f, fcn = #1},
f[x_] := Im[fcn];
Reap[Plot[f[x], {x, 0, 1.5},
Exclusions -> {True, f[x] == 1, f[x] == -1},
EvaluationMonitor :> Sow[{x, f[x]}][[2, 1]] //
SortBy[#, First] &];]
]&, geyvals]
(Обратите внимание, спецификация Part немного странная, Reap возвращает List того, что посеяно как второй элемент в List, так что это приводит к вложенному списку. Кроме того, Plot не производит выборку точек простым способом, поэтому необходимо SortBy.) Может быть более элегантный маршрут, чтобы определить, где последние два корня становятсясложный, но так как их воображаемые части кусочно-непрерывны, просто кажется, что это просто.
Редактировать : Поскольку вы упомянули, что вам нужен автоматический метод генерации, когда некоторые корни становятся сложными, я изучал, что происходит, когда вы заменяете в y -> p + I q.Теперь предполагается, что x реально, но вы уже сделали это в своем решении.В частности, я делаю следующее
In[1] := poly = g.RotationMatrix[Pi/2].h.g /. {y -> p + I q} // ComplexExpand;
In[2] := {pr,pi} = poly /. Complex[a_, b_] :> a + z b & // CoefficientList[#, z] & //
Simplify[#, {x, p, q} \[Element] Reals]&;
, где второй шаг позволяет мне выделить действительные и мнимые части уравнения и упростить их независимо друг от друга.Делать то же самое с общим 2D-полиномом, f + d x + a x^2 + e y + 2 c x y + b y^2, но сделать сложными и x, и y;Я заметил, что Im[poly] = Im[x] D[poly, Im[x]] + Im[y] D[poly,[y]], и это может иметь место и для вашего уравнения.Реализуя x, мнимая часть poly становится q умноженной на x, p и q.Таким образом, установка q=0 всегда дает Im[poly] == 0.Но это не говорит нам ничего нового.Однако, если мы
In[3] := qvals = Cases[List@ToRules@RReduce[ pi == 0 && q != 0, {x,p,q}],
{q -> a_}:> a];
, мы получим несколько формул для q, включая x и p.Для некоторых значений x и p эти формулы могут быть мнимыми, и мы можем использовать Reduce, чтобы определить, где Re[qvals] == 0.Другими словами, мы хотим, чтобы «мнимая» часть y была реальной, и это можно сделать, допустив, чтобы q был нулевым или чисто мнимым.Построение области, где Re[q]==0 и наложение градиентных экстремальных линий с помощью
With[{rngs = Sequence[{x,-2,2},{y,-10,10}]},
Show@{
RegionPlot[Evaluate[Thread[Re[qvals]==0]/.p-> y], rngs],
ContourPlot[g.RotationMatrix[Pi/2].h.g==0,rngs
ContourStyle -> {Darker@Red,Dashed}]}]
, дает
, что подтверждает регионы на первых двух графиках, показывая3 настоящих корня.