Solve polynomial for coefficients in a range

Question

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.

Answer 1

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}}]

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

Answer 2

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]

Answer 3

You are solving something like this:

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

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]]

Answer 4

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]