Re: Eliminate Complex Roots
- To: mathgroup at smc.vnet.net
- Subject: [mg64469] Re: Eliminate Complex Roots
- From: rudy <rud-x at caramail.com>
- Date: Sat, 18 Feb 2006 02:49:53 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
Hello,
the method with findinstance:
In > (plot1 = ListPlot[Partition[Flatten[N[Table[Flatten[{b, a /.
FindInstance[a^3 + 10*a^2 - 15*a + b == 0, a, Reals, 3]}], {b, -20, 30,
5}]] /. {x_, y1_, y2_, y3_} ->
{x, y1}], 2], PlotJoined -> True, PlotStyle -> Hue[0]];
plot2 = ListPlot[Partition[Flatten[N[Table[
Flatten[{b, a /.
FindInstance[a^3 + 10*a^2 - 15*
a + b == 0, a, Reals, 3]}], {b, -20, 30,
5}]] /. {x_, y1_, y2_, y3_} ->
{x, y2}], 2], PlotJoined -> True, PlotStyle -> Hue[0.4]];
plot3 = ListPlot[Partition[Flatten[N[Table[Flatten[{b, a /.
FindInstance[a^3 + 10*a^2 - 15*a + b == 0, a, Reals, 3]}], {b, -20, 30,
5}]] /. {x_, y1_, y2_, y3_} ->
{x, y3}], 2], PlotJoined -> True, PlotStyle -> Hue[0.2]];
DisplayTogether[plot1, plot2, plot3]) // Timing
Out > {4.562 Second, -Graphics-}
here is a much more efficient way (on my computer) woth NSolve:
In > calcul := Module [{eq, points, resultat, graphe1, graphe2, graphe3},
eq = a^3 + 10*a^2 - 15*a + b == 0;
resultat = Table[Map[{i, #} &, a /.
NSolve[eq /. b -> i, a], {1}], {i, -20, 30, 0.1}] // Flatten[#, 1] &;
points =
Select[#, NumberQ[#[[
1]]] &] & /@
Table[Partition[RotateLeft[
resultat /. {_, a_Complex} -> {rien}, i], 1, 3] //
Flatten[#, 1] &, {i, 3}];
graphe1 = ListPlot[points[[1]], PlotJoined -> True,
PlotStyle -> RGBColor[0, 0.7, 1], DisplayFunction -> Identity];
graphe2 = ListPlot[points[[2]], PlotJoined -> True, PlotStyle ->
RGBColor[1, 0, 0], DisplayFunction -> Identity];
graphe3 = ListPlot[points[[3]],
PlotJoined -> True, PlotStyle -> RGBColor[0.5, 0.8,
0], DisplayFunction -> Identity];
Show[graphe1, graphe2, graphe3, DisplayFunction -> $DisplayFunction]
] // Timing
In > calcul
out > {0.484 Second, -Graphics-}
Regards
Rudy