MathGroup Archive 2006

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • Prev by Date: Re: Re: Using a text editor like interface for Mathematica?
  • Next by Date: Re: How to do a family of plots?
  • Previous by thread: Re: Eliminate Complex Roots
  • Next by thread: Exporting Density Plots -- one pixel per point?