# How to find the numbers $a$, $b$, $c$, $d$ so that the equation has four distinct integral solutions?

I want to find the numbers $$a$$, $$b$$, $$c$$, $$d$$ so that the equation $$x^4 + a x^3 + b x^2 + c x + d=0,$$ where $$d = \dfrac{c^2}{a^2}$$ has four distinct integral solutions.

With Maple, I found some equations like this picture. I don't know how to start with Mathematica. • Look up the FindInstance function.
– ktm
Oct 13, 2018 at 17:06
• My idea was FindInstance as well which works for easier problems: eq = a x^3 + b x^2 + c x; stance[Equal @@@ Flatten@Solve[eq == 0, x], {x, a, b, c}, Integers, 3]. However, for the example of the OP that doesn't work since the general solution contains complex terms. Does anyone know a general answer to such problems? Oct 13, 2018 at 17:32

Let p, q, r and s be the roots, so that the polynomial can be factored as:

poly = (x-p)(x-q)(x-r)(x-s);


One requirement is that $$d=\frac{c^2}{a^2}$$, which means:

eqn = Coefficient[poly, x, 1]^2 == Coefficient[poly, x, 0] Coefficient[poly, x, 3]^2
cond = Coefficient[poly, x, 3] != 0


(-p q r - p q s - p r s - q r s)^2 == p q r (-p - q - r - s)^2 s

-p - q - r - s != 0

The other requirement is that each root is distinct. Putting these together, we can use FindInstance:

sol = FindInstance[
eqn && -10 < p < q < r < s < 10 && p + q + r + s != 0,
{p, q, r, s},
Integers,
10
]


{{p -> -8, q -> -6, r -> -4, s -> -3}, {p -> -3, q -> -2, r -> 6, s -> 9}, {p -> -2, q -> -1, r -> 4, s -> 8}, {p -> -9, q -> -6, r -> 2, s -> 3}, {p -> -9, q -> -6, r -> 4, s -> 6}, {p -> -9, q -> -3, r -> 2, s -> 6}, {p -> -6, q -> -4, r -> 6, s -> 9}, {p -> -9, q -> -2, r -> 3, s -> 6}, {p -> -3, q -> -1, r -> 3, s -> 9}, {p -> -8, q -> -4, r -> 3, s -> 6}}

The corresponding polynomials are then:

Expand[poly /. sol] //Column //TeXForm


$$\begin{array}{l} x^4+21 x^3+158 x^2+504 x+576 \\ x^4-10 x^3-15 x^2+180 x+324 \\ x^4-9 x^3-2 x^2+72 x+64 \\ x^4+10 x^3-15 x^2-180 x+324 \\ x^4+5 x^3-72 x^2-180 x+1296 \\ x^4+4 x^3-57 x^2-72 x+324 \\ x^4-5 x^3-72 x^2+180 x+1296 \\ x^4+2 x^3-63 x^2+36 x+324 \\ x^4-8 x^3-18 x^2+72 x+81 \\ x^4+3 x^3-58 x^2-72 x+576 \\ \end{array}$$

The OP requested all solutions with conditions given on the coefficients $$a$$, $$b$$, $$c$$ and $$d$$.

To answer the new question, let's first simplify eqn as in @JM's answer:

eqn2 = FullSimplify[eqn]


(q r - p s) (-p r + q s) (p q - r s) == 0

Now, suppose one of the roots is zero. Without loss of generality, take $$p=0$$:

eqn2 /. p -> 0


-q^2 r^2 s^2 == 0

The only way the above equation can be satisfied is if one of $$q$$, $$r$$ or $$s$$ is also zero. But then, the roots would not be distinct. So, the combination:

(q r-p s) (-p r+q s) (p q-r s)==0 && p < q < r < s


implies that none of the variables are 0. Another way of seeing this is with:

Reduce[eqn2 && p < q < r < s && p q r s == 0, Integers]


False

Now, let's examine the conditions in your comment for a and d:

-20 <= a <= 50
-20 <= b <= 50
-20 <= c <= 150
-20 <= d <= 150


or:

condA = -50 <= SymmetricPolynomial[1, {p, q, r, s}] <= 20
condB = -20 <= SymmetricPolynomial[2, {p, q, r, s}] <= 50
condC = -150 <= SymmetricPolynomial[3, {p, q, r, s}] <= 20
condD = -20 <= SymmetricPolynomial[4, {p, q, r, s}] <= 150


-50 <= p + q + r + s <= 20

-20 <= p q + p r + q r + p s + q s + r s <= 50

-150 <= p q r + p q s + p r s + q r s <= 20

-20 <= p q r s <= 150

The natural attempt would be to use Solve with the above conditions. However, Solve is unable to make progress within a reasonable amount of time:

TimeConstrained[
Solve[
eqn2 && condA && condB && condC && condD && p < q < r < s,
{p, q, r, s},
Integers
],
250
]


\$Aborted

Restricting the range over which $$p$$, $$q$$, $$r$$ and $$s$$ can vary, and reducing the number of conditions that must be satisfied helps. For instance:

Solve[
eqn2 && condA && condD && -3 < p < q < r < s < 3,
{p, q, r, s},
Integers
]


{{p -> -2, q -> -1, r -> 1, s -> 2}}

The conditions condB and condC can be imposed afterwards, but the range must be large enough to encompass all possible solutions. Examining condA and condD (and realizing that none of the roots are 0) suggests that the smallest possible value for p is -52, and the largest possible value for s is 25. Let's verify:

Reduce[p < -52 && q < r < s && condA && condD && q r s != 0, {p, q, r, s}, Integers]
Reduce[s > 25 && p < q < r && condA && condD && p q r != 0, {p, q, r, s}, Integers]


False

False

Hence, we can perform the following Solve:

sol = Solve[
eqn2 && condA && condD && -53 < p < q < r < s < 26,
{p, q, r, s},
Integers
];
Length[sol]


67

Imposing condB and condC (and $$a \neq 0$$):

final = Cases[sol, v_ /; (condB && condC && p+q+r+s != 0 /. v)];


yields the following polynomials:

Expand[(x-p)(x-q)(x-r)(x-s) /. final] //Column //TeXForm


$$\begin{array}{l} x^4+12 x^3+47 x^2+72 x+36 \\ x^4+3 x^3-8 x^2-12 x+16 \\ x^4-5 x^3-20 x^2+60 x+144 \\ x^4-4 x^3-17 x^2+24 x+36 \\ x^4-8 x^3-18 x^2+72 x+81 \\ x^4-12 x^3-13 x^2+144 x+144 \\ x^4-3 x^3-8 x^2+12 x+16 \\ x^4-6 x^3-7 x^2+36 x+36 \\ x^4-9 x^3-2 x^2+72 x+64 \\ x^4-12 x^3+7 x^2+120 x+100 \\ \end{array}$$

• How can I find all equations, for example, -20 <=a<=50, -20 <=b<=50, -20 <=c<=150, -20 <=d<=150? Oct 14, 2018 at 9:20
• Yes, the symmetric polynomials (i.e. Vieta) were how I arrived at the main equation in my solution (via pen and paper). Nice to see the expansion of the idea! Oct 14, 2018 at 16:42
• Thank you very much. Oct 15, 2018 at 0:18

Call the distinct integers $$p,q,r,s$$. Then find an instance in which $$x^4+a x^3 +bx^2 +cx+d = (x-p)(x-q)(x-r)(x-s) .$$

f = (x - p) (x - q) (x - r) (x - s);
Collect[f, x]
d = Coefficient[f, x, 0];
c = Coefficient[f, x, 1];
a = Coefficient[f, x, 3];
soln = First@FindInstance[
{d == c^2/a^2, p != q != r != s},
{p, q, r, s}]
f /. soln // Expand

(*
{p -> 8, q -> -6, r -> -12, s -> 9}
5184 + 72 x - 162 x^2 + x^3 + x^4
*)


Another solution can be found:

skip = {p, q, r, s} /. soln
sol2 = First@FindInstance[
{d == c^2/a^2, p != q != r != s, Not[MemberQ[skip, p]]},
{p, q, r, s}, Integers]
f/.sol2//Expand

(*
{p -> -1, q -> -2, r -> -4, s -> -8}
64 + 120 x + 70 x^2 + 15 x^3 + x^4
*)


(I am not at a computer with Mathematica, so I will have to defer explanation for another time.)

With[{n = 20, (* number of instances *), bound = 10,
seed = 10 (* seed the PRNG *)},
(x - p) (x - q) (x - r) (x - s) /.
FindInstance[(p q - r s) (q s - p r) (q r - p s) == 0 &&
-bound < p < q < r < s < bound, {p, q, r, s},
Integers, n, RandomSeeding -> seed]]


should return n solutions; change seed to see other solutions, or increase n for more solutions.

• How can I find all equations, for example, -20 <=a<=50, -20 <=b<=50, -20 <=c<=150, -20 <=d<=150? Oct 14, 2018 at 9:19
• Why did you not put that restriction in your question? Oct 14, 2018 at 9:23
• I am sory about this. Can I edit my question? Oct 14, 2018 at 9:29

FindInstance can be slow, and it is not known a priori how many solutions are possible. I tried a different approach. It is fast compared to FindInstance and Solve. I think it gives all the solutions, but is inelegant because of all the duplicates to delete.

Roots $$\{p,q,r,s\}$$ of a quartic multiply together to give the integer polynomial coefficient $$d$$, which is required to equal $$c^2/a^2>0$$. Given square $$d$$, find factorisations into 4 factors with MultiplicativePartitionsMrW from @Mr.Wizard, then test for $$c^2/a^2=d$$.

MultiplicativePartitionsMrW[n_, 1, ___] := {{n}}

MultiplicativePartitionsMrW[n_, k_, x_: 2] :=
Join @@ Table[
If[q < x, {},
Apply[{q, ##} &,
MultiplicativePartitionsMrW[n/q, k - 1, q], {1}]],
{q, Take[#, Ceiling[Length[#]/k]] &[Divisors[n]]}]


We want all factorisations having 4 parts, found with 4 factors $$\ge 2$$, or by prepending $$\{1\}$$ to the solution with 3 factors $$\ge 2$$, or prepending $$\{1,1\}$$ to solutions with 2 factors $$\ge 2$$.

pqrs[d_] :=
Join[
MultiplicativePartitionsMrW[d, 4],
Map[Join[{1}, #] &, MultiplicativePartitionsMrW[d, 3]],
Map[Join[{1, 1}, #] &, MultiplicativePartitionsMrW[d, 2]]
]


There are 8 combinations of signs of $$\{p,q,r,s\}$$ giving positive $$d$$.

signs[{p_, q_, r_, s_}] :=
{{p, q, r, s}, {-p, -q, r, s}, {-p, q, -r, s}, {-p, q, r, -s},
{p, -q, -r, s}, {p, -q, r, -s}, {p, q, -r, -s}, {-p, -q, -r, -s}}


Given roots $$\{p,q,r,s\}$$ corresponding to $$d=p*q*r*s$$, return coefficients $$\{1,a,b,c,d\}$$ if $$a\ne 0$$ and $$d=c^2/a^2$$.

abcd[{p_, q_, r_, s_}] :=
With[{a = -p - q - r - s, c = -q r (p + s) - p s (q + r)},
If[a != 0 && a^2 p q r s == c^2,
{1, a, q (p + r + s) + p (r + s) + r s, c, p q r s}, {}]
]


Given square $$d$$, find solutions, if any, for coefficients $$\{1,a,b,c,d\}$$ with QuarticSolution[d].

QuarticSolution[d_] :=
DeleteCases[
DeleteDuplicates[Map[abcd,
Select[
Flatten[Map[signs, pqrs[d]], 1],
Length[#] === Length[DeleteDuplicates[#]] &]
]],
{}]


For example,

QuarticSolution

{{1, -3, -8, 12, 16}, {1, 3, -8, -12, 16}}

These are the 10 solutions with the additional constraints on the coefficients. Timing is 8ms.

With[{maxd = 150},
Flatten[Table[
Select[
QuarticSolution[d],
-20 <= #[] <= 50 && -20 <= #[] <= 50 &&
-20 <= #[] <= 150 && -20 <= #[] <= maxd &],
{d, Range[Sqrt[maxd]]^2}], 1]
]


{{1, -3, -8, 12, 16},{1, 3, -8, -12, 16}, {1, -6, -7, 36, 36}, {1, -4, -17, 24, 36}, {1, 12, 47, 72, 36}, {1, -9, -2, 72, 64}, {1, -8, -18, 72, 81}, {1, -12, 7, 120, 100}, {1, -5, -20, 60, 144}, {1, -12, -13, 144, 144}}

• I can not get the results. Oct 17, 2018 at 12:36
• Sorry, there was a missing comma in the definition for pqrs, now fixed. Oct 19, 2018 at 17:27
• Thank you very much. I got the results. Oct 20, 2018 at 6:30
• I got 99 equations about 8 seconds. Oct 21, 2018 at 13:47