Plot all real and imaginary roots of FindRoot vrs k

I'm looking to plot all real and imaginary roots of this cubic equation

eq[x_,k_]:=x^3-5x^2+x-k


as a function of a real parameter k.

Step 1: to get an idea, I first compare solutions by the two functions NSolve and FindRoot with a given range, for that I use

root1[k_]:= Solve[eq[x,k] == 0,x,Cubics->True]

(* For k=2, root1[2] gives : {{{x -> 4.879057633484047},{x -> 0.06047118325797629 + 0.6373840752906359 I},
{x -> 0.06047118325797629 - 0.6373840752906359 I}}} *)

root2[k_]:= FindRoot[eq[x,k] == 0,{x,#}]&/@{-5,-2,0,2,5,10}

(* For k=2, root2[2] gives : {{{x -> 0.1031932441958189}, {x -> 0.1031957295973283}, {x ->
0.1031928872111299}, {x -> 0.1031958817666505}, {x ->
4.879057633484048}, {x -> 4.879057633484049}}}  *)


The problem at this level is that for the same value of k=2 I can't find the same complex roots by FindRoot, why?

Step 2: Then I try to plot all real parts Re[root2[k]] vrs k and all imaginary parts Im[root2[k]] vrs k of solutions, I form a table {k,root1[k]} for k∈[-5,5] but then I don't know how to do it

data=Table[{k,root1[k]},{k,-5,5,1}]//N

(* {{-5., {{x ->
4.536629621205803 + 0. I}, {x -> -0.8434044873336737 +
2.220446049250313*10^-16 I}, {x ->
1.306774866127871 - 2.220446049250313*10^-16 I}}}, {-4., {{x ->
4.592614742039923 +
1.480297366166875*10^-16 I}, {x -> -0.7515320715475298 +
2.220446049250313*10^-16 I}, {x ->
1.158917329507606 - 2.220446049250313*10^-16 I}}}, {-3., {{x ->
1.}, {x -> -0.6457513110645907}, {x ->
4.645751311064591}}}, {-2., {{x ->
4.696392779347097 +
7.401486830834377*10^-17 I}, {x -> -0.518198699326341 +
4.440892098500626*10^-16 I}, {x ->
0.8218059199792439 - 4.440892098500626*10^-16 I}}}, {-1., {{x ->
4.744826077681923 +
3.700743415417188*10^-17 I}, {x -> -0.3488942175007166 +
4.440892098500626*10^-16 I}, {x ->
0.6040681398187938 - 4.440892098500626*10^-16 I}}}, {0., {{x ->
0.}, {x -> 0.2087121525220801}, {x ->
4.79128784747792}}}, {1., {{x ->
0.08201204045934052 + 0.4472778999095655 I}, {x ->
0.08201204045934052 - 0.4472778999095655 I}, {x ->
4.835975919081319}}}, {2., {{x -> 4.879057633484047}, {x ->
0.06047118325797629 + 0.6373840752906359 I}, {x ->
0.06047118325797629 - 0.6373840752906359 I}}}, {3., {{x ->
4.920676006565271}, {x ->
0.03966199671736437 + 0.7798071907703745 I}, {x ->
0.03966199671736437 - 0.7798071907703745 I}}}, {4., {{x ->
4.960954381704582}, {x ->
0.0195228091477091 + 0.8977278700998234 I}, {x ->
0.0195228091477091 - 0.8977278700998234 I}}}, {5., {{x ->
0. - 1. I}, {x -> 0. + 1. I}, {x -> 5.}}}} *)


Clear["Global*"]

eq[x_, k_] := x^3 - 5 x^2 + x - k

root1[k_] = SolveValues[eq[x, k] == 0, x] // Simplify;

sol1 = root1[2] // N

(* {4.87906, 0.0604712 + 0.637384 I, 0.0604712 - 0.637384 I} *)


From the documentation, "If all equations and starting values are real, then FindRoot will search only for real roots . If any are complex, it will also search for complex roots ."

root2[k_] :=
Flatten[Values /@ (FindRoot[eq[x, k] == 0, {x, #}] & /@ {5, 0.1 + 0.7 I,
0.1 - 0.7 I})]

sol2 = root2[2]

(* {4.87906, 0.0604712 + 0.637384 I, 0.0604712 - 0.637384 I} *)

sol1 - sol2

(* {-8.88178*10^-16, 6.245*10^-17 - 3.33067*10^-16 I,
6.245*10^-17 + 3.33067*10^-16 I} *)

reim[k_] = ComplexExpand[ReIm[root1[k]]] // Simplify;

Show[
ParametricPlot[Evaluate@reim[k], {k, -5, 5},
PlotLegends -> Automatic,
AspectRatio -> 1,
PlotPoints -> 100,
MaxRecursion -> 5,
WorkingPrecision -> 15],
Graphics[{
Red, AbsolutePointSize[4],
Point[ReIm[sol1]]}],
AxesLabel -> {Re, Im}]


EDIT: Plotting Re and Im separately,

Column[
Plot[
Evaluate@#@root1@k, {k, -5, 5},
PlotStyle -> {Blue, Red, Dashed},
PlotLabel -> #,
PlotLegends -> Automatic,
PlotPoints -> 75,
MaxRecursion -> 5,
WorkingPrecision -> 15] & /@ {Re, Im}]


Clear[root2];
root2[k_, init : _List :
{5, (1 + 7 I)/10, (1 - 7 I)/10}] :=
Flatten[Values /@ (
FindRoot[eq[x, k] == 0, {x, #}] & /@
init)]

Column[
ListLinePlot[
#@Transpose@Table[root2[k,
Piecewise[{{{9/2, 1/2, -1/2}, k <= 0},
{{9/2, I/2, -I/2}, k > 0}}]],
{k, -5, 5, 1/20}],
DataRange -> {-5, 5},
PlotStyle -> {Blue, Red, Dashed},
PlotLabel -> #,
PlotLegends -> Automatic] & /@
{Re, Im}]


Clear["Global*"]

EDIT 2: Re the comment

FindRootrequires tailored starting values. You cannot blindly reuse a previous solution.

Clear["Global*"]

eq[x_, k_] = 1 - k^2/x^2 - 1/(x(x - 20));

root1[k_] = SolveValues[
{eq[x, k] == 0, -5 <= k <= 5}, x] // Simplify;

Column[
Plot[
Evaluate@#@root1@k, {k, -5, 5},
PlotRange -> All,
PlotStyle ->
{Green, {Blue, Dashed}, {Red, Dotted}},
PlotLabel -> #,
PlotLegends -> Automatic,
PlotPoints -> 75,
MaxRecursion -> 5,
WorkingPrecision -> 15] & /@ {Re, Im}]


Since one of the roots is essentially constant, avoid taking its derivative. From the documentation, "FindRoot[lhs == rhs, {x, x0, x1}] searches for a solution using x0 and x1 as the first two values of x, avoiding the use of derivatives."

root2[k_] := Flatten[
Values /@ (
FindRoot[eq[x, k] == 0, {x, # - 10^-3, # + 10^-3}] & /@
Piecewise[{{{20, k, -k}, k <= 0},
{{20, -k, k}, k > 0}}])]

Column[
ListLinePlot[
#@Transpose@
Table[root2[k], {k, -5, 5, 1/20}],
DataRange -> {-5, 5},
PlotStyle ->
{Green, {Blue, Dashed}, {Red, Dotted}},
PlotLabel -> #,
PlotLegends -> Automatic] & /@
{Re, Im}] // Quiet


• Thank you so much @Bob Hanlon, please I want to plot all Re[root2[k]] vrs k and all Im[root2[k]] vrs k in separated figures. How to do it? Feb 4, 2023 at 23:09
• @ BobHanlon, I didn't understand your plot. Please can you plot : Re[root2[k]]: {4.87906, 0.0604712 , 0.0604712} vrsk and Im[root2[k]]: {0, 0.637384,- 0.637384} vrs k separately. Feb 5, 2023 at 0:05
• @ BobHanlon, thank you so much. Feb 5, 2023 at 6:32
• root2[k_] := Flatten[Values /@ (FindRoot[eq[x, k] == 0, {x, # - 10^-3, # + 10^-3}] & /@ {20, k, -k})] would give essentially the same plots; however, the insight into branch behavior shown with root1` is lost. Feb 5, 2023 at 17:54
• If you have additional questions ask them on this or similar forums Feb 5, 2023 at 18:28