3
$\begingroup$

I want to create a list of all roots of quadratics with coefficients in a range of $-5$ to $5$

I tried this : NSolve[Range[-5,5]*z^2+Range[-5,5]*z+Range[-5,5] == 0] but this gives me a list of 2 complex numbers. I tried searching but didn't find any clear answer to how to solve this.

$\endgroup$
7
$\begingroup$

I´ve done this a few years ago, one gets pretty pictures of the solution. Here is my translation of my former function in the English language. The code is for readability and understanding and can be optimized.

In a first step all the equations are set up, then useless equations (like 0*x^2+0*x+5==0) filtered out. Next equations with a common factor are filtered out. then the solutions are computed and the output is done.

    Clear[polynomsolutions];
polynomSolutions[list_List, pointSize_, opts : OptionsPattern[]] := 
 Module[{ temp, points, eqns, sols, coeffs, gr},
  coeffs = Tuples[list, 3];
  coeffs = 
   DeleteCases[
    coeffs, {0, 0, _}]; (*eliminate equations without solution *)

  coeffs = Union @ (coeffs / Apply[GCD, coeffs, {1}]); (* e.q: (4,4,
  2)\[Rule] (2,2,1) *)
  temp = coeffs.{x^2, x, 1};
  eqns = Thread[temp == 0];
  sols =  Solve[#, {x}] & /@ eqns // N;
  points = x /. sols;
  points = Union @ Flatten @ points;
  points = {Re[#], Im[#]} & /@ points;
  (*gr = {PointSize[0.0025],Hue[Norm[#]],Point[#]}&/@punkte;*)

  gr = {PointSize[pointSize], Point[#]} & /@ points;
  Print[StringForm["Number of equations ``", Length @ coeffs]];
  Graphics [gr, FilterRules[{opts}, Options[Graphics]]]
  ]

If one runs the program for all equations with coefficients in the range -20...20 with the following code you get a nice picture.

polynomSolutions[Range[-20, 20], 0.0015, Frame -> True, 
 FrameTicks -> {Range[-3, 3], Range[-3, 3]}, 
 PlotRange -> {{-3, 3}, {-3, 3}}]

enter image description here

It is also interesting to look at solutions of polynomial of degree greater than 2

$\endgroup$
  • $\begingroup$ really nice+1 :) $\endgroup$ – ubpdqn Dec 4 '16 at 13:15
2
$\begingroup$

I am not sure if 1331 (11x 11 x 11) polynomials (666 if remove those that are just the negative of others in list). If so (demonstrating 10):

res = {{x^2, x, 1}.# == 0, x /. NSolve[{x^2, x, 1}.# == 0, x]} & /@ 
   Union[Tuples[Range[-5, 5], 3], SameTest -> (#1 == -#2 &)];
Length[res]
Grid[res[[1 ;; 10]], Frame -> All]

enter image description here

$\endgroup$
2
$\begingroup$

You are solving something like this:

Range[-5, 5]*z^2 + Range[-5, 5]*z + Range[-5, 5] == 0

enter image description here

I'm not sure what exactly you want to obtain, but if you want to solve $ax^2+bx+c=0$ for all combinations of $a,b,c$ (i.e., $2x^2+2x+2=0$, but also $-5x^2+2x-1=0$ etc.):

sol1 = DeleteDuplicates @ Sort @ Flatten[#, 2]& @
   Table[z /. Solve[a z^2 + b z + c == 0, z], {a, -5, 5}, {b, -5, 5}, {c, -5, 5}];

Length @ sol1

578

sol2 = Cases[sol1, {x__?NumericQ}, Infinity];

Length @ sol2

576

(because there are z and {z} in sol1).

Part of the output:

sol2[[100 ;; 200]]

enter image description here

$\endgroup$
1
$\begingroup$

Here is a slight simplification + extension of mgamer's code for visualizing roots of polynomials with integer coefficients:

With[{l = Range[-5, 5]}, 
     Table[Graphics[{PointSize[0.0015], 
                     Point[ReIm[DeleteDuplicates[Flatten[(\[FormalX] /. 
                                NSolve[FromDigits[#, \[FormalX]], \[FormalX]]) & /@ 
                           Select[DeleteCases[Tuples[l, deg + 1], {0, __}],
                                  (GCD @@ # == 1 &)]]]]]}, 
                    Frame -> True, PlotLabel -> Row[{"degree = ", deg}], PlotRange -> 3],
           {deg, 2, 4}] // GraphicsRow]

plot of polynomial roots

$\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.