5
$\begingroup$

I want to show the solutions of polynomial equations $P_n(x)=y$.

For example, let $P_5(x)=x^5+x^4+x^3+x^2+1=y\ ,\;y\in[-10,10]$,

sol[i_,j_]:=Join[#,{i}]&/@ReIm[x/.NSolve[x^5+x^4+x^3+x+1==i+j I]];
p=Graphics3D[{Opacity[0.25],InfinitePlane[{{0,0,1},{1,0,1},{1,0,0}}]}];
gifs=Table[Show[
    ListPointPlot3D[Flatten[Table[sol[i,0],{i,-10,10,0.1}],1],
    BoxRatios->{1,1,1},AxesOrigin->{0,0,0},Boxed->False,
    ViewPoint->{2Sin[t],2Cos[t],1.5}],p],
    {t,0,2Pi,0.1}];
Export["poly5.gif",gifs, "AnimationRepetitions"->Infinity]

enter image description here

Oh...terrible, the image is constantly shaking, at least the origin point should be fixed.

Secound, I want to get the curves instead of points, $n$ curves when $P_n(x)$. I can only get points if I use NSolve.

Then I can dye according to their distance from the plane, I mean real plane XoY, the distance equal to imaginary part.

And if the curve on that plane, use special colour like red. If the curve just cross the plane, also highlight that point red.

$\endgroup$
2
  • 3
    $\begingroup$ What happens if you add the option SphericalRegion -> True? $\endgroup$ – Michael E2 Dec 11 '17 at 12:06
  • $\begingroup$ Related/duplicates: (16765), (85304), (157271) $\endgroup$ – Michael E2 Dec 11 '17 at 12:10
5
$\begingroup$

Here's another piece of the puzzle, specifically how to get continuous lines instead of points by using Solve and ParametricPlot3D.

p = Graphics3D[{Opacity[0.25], InfinitePlane[{{0, 0, 1}, {1, 0, 1}, {1, 0, 0}}]}];
sol = Solve[x^5 + x^4 + x^3 + x + 1 == y, x]
(* five Root solutions *)
Show[p,
  ParametricPlot3D[Append[ReIm[x], y] /. sol, {y, -10, 10}], 
  BoxRatios -> {1, 1, 1}, AxesOrigin -> {0, 0, 0}, Boxed -> False, Axes -> True]

Mathematica graphics

Animated:

Animated

EDIT:

GalAster points out that this approach has a problem with another polynomial x^4 + x^3 - 2 x - 1.

sol = Solve[x^4 + x^3 - 2 x - 1 == y, x, Quartics -> False]
(* four Root solutions *)
Show[p,
  ParametricPlot3D[Append[ReIm[x], y] /. sol, {y, -10, 10}], 
  BoxRatios -> {1, 1, 1}, AxesOrigin -> {0, 0, 0}, Boxed -> False, Axes -> True,
  , AxesLabel -> {"Re", "Im", "y"}]

Mathematica graphics

Indeed, this has some spurious connectors when the bifurcation occurs and the roots change order. Evidently a well-placed Evaluate fixes this problem.

Show[p,
  ParametricPlot3D[Evaluate[Append[ReIm[x], y] /. sol], {y, -10, 10}, MaxRecursion -> 12],
  BoxRatios -> {1, 1, 1}, AxesOrigin -> {0, 0, 0}, Boxed -> False, Axes -> True,
  AxesLabel -> {"Re", "Im", "y"}]

Mathematica graphics

$\endgroup$
2
  • $\begingroup$ Wow, Root can be used like this! A small commit, Solve[P, x, Quartics -> False, Cubics -> True] or something terrible would happen on some cases. $\endgroup$ – GalAster Dec 12 '17 at 1:21
  • $\begingroup$ Well, not solved, still have problem, try x^4 + x^3 - 2 x - 1 $\endgroup$ – GalAster Dec 12 '17 at 1:26
4
$\begingroup$

This answers the shaking part. As @Michael E2 said, if you add SphericalRegion -> True the shaking goes away

This animation with SphericalRegion -> True

enter image description here

This is without

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.