# Finding all solutions to coupled algebraic equations without exhaustive enumeration

Find all $$a,b,c,d,e,f \in \mathbb{N}$$ such that

$$a + b + c = d \cdot e \cdot f$$

and

$$d + e + f = a \cdot b \cdot c$$

(There are a number of similar questions on this site, but none that concentrate on finding all solutions, particularly when permutations expand the solution search space.)

It is easy and fast to find one solution:

FindInstance[
{a + b + c == d e f,
d + e + f == a b c,
{a, b, c, d, e, f} > 0},
{a, b, c, d, e, f}, Integers]


(* {{a -> 2, b -> 3, c -> 1, d -> 2, e -> 3, f -> 1}} *)

Of course this solution (and others, below) can be permuted to find additional (equivalent) solutions.

The full solution set, however, is:

$$\{ (3,2,1), (3,2,1) \}, \{ (1,1,6), (2,2,2) \}, \{ (1,1,8), (1,2,5) \}, \{ (1,1,7), (1,3,3) \}$$ (and, of course, permutations).

I have been unable to algorithmically find all these solutions. I've tried using Solve, Reduce, and the obvious alterations to FindInstance:

FindInstance[
{a + b + c == d e f,
d + e + f == a b c},
{a, b, c, d, e, f}, Integers,4]


which yields one additional solution, but not all four.

I've tried to reduce the solution search space by constraining (without loss of generality) the permutations of each subset of variables:

FindInstance[
{a + b + c == d e f,
d + e + f == a b c,
a >= b >= c > 0,
d >= e >= f > 0, (a != d) \[Or] (b != e) \[Or] (c != f)},
{a, b, c, d, e, f}, Integers]


One can also impose the fact that not all terms $$\{a,b,c \}$$ or $$\{ d,e,f \}$$ can be greater than 2.

The best I've found is:

FindInstance[
{a + b + c == d e f,
d + e + f == a b c,
{a, b, c, d, e, f} > 0,
a >= b >= 2 >= c > 0,
d >= e >= f > 0,
a != f ,
a b  > 4 ,
c == 1},
{a, b, c, d, e, f}, Integers, 4]


There are yet other constraints, but none have yielded all the solutions.

I am explicitly NOT interested in any method that relies on exhaustive enumeration and testing, as might be implemented in Python or other languages without symbol manipulation. Such methods scale poorly with number of equations, variables, upper limits, and so on. After all, how do you know ahead of time that your numerical search need not go to, say, $$10^{10}$$ for each variable?! And how can such simulation ever show that there is NO solution? Or the total number of solutions that do exist? The "human intelligence" in the attached link at the top is the kind of "smarts" I want to implement and exploit in Mathematica.

How can I compute all the solutions (up to permutation) using symbol manipulation?

• No. Natural number: $1,2,3,4...$ Aug 26, 2021 at 23:47
• How is FindInstance symbol manipulation? It could be doing exhaustive search "under the hood". The documentation does not rule that out. Aug 27, 2021 at 0:25
• Simple timing tests on related problems prove that FindInstance does not use exhaustive search (in general). Further, it also can compute that no solution exists to a certain problem where exhaustive search would take infinite time. Aug 27, 2021 at 0:43
• Truu, FindInstance has certain advantages and I have used it to get good results, but it has frustrating limitations which are not documented. In some cases, exhaustive search easily finds solutions when FindInstance can't. Aug 27, 2021 at 0:47
• Reduce[{…, 10 > {a,b,c,d,e,f} > 0},…] does not satisfy your requirements but it works on the toy problem. Aug 27, 2021 at 23:01

You can find solutions with FindInstance and a little detour.

Regard the two onesided equations as polynoms in a  and determine the parameters {b,c,d,e,f} where they both have the same roots.

eqs = {a + b + c == d e f, d + e + f == a b c};
vars = {a, b, c, d, e, f};

resa = Resultant[a + b + c - d e f, -a b c + d + e + f, a]

(*   d + e + f + b c (b + c - d e f)   *)

fi = FindInstance[
Join[{0 == resa}, {1 <= b <= c, 1 <= d <= e <= f}], {b, c, d, e, f},
Integers, 10]

(*   FindInstance::fwsol: Warning: FindInstance found only 6 instance(s), but it was not able to prove 10 instances do not exist. >>

{{b -> 1, c -> 1, d -> 1, e -> 2, f -> 5}, {b -> 1, c -> 1, d -> 1,
e -> 3, f -> 3}, {b -> 1, c -> 1, d -> 2, e -> 2, f -> 2}, {b -> 1,
c -> 2, d -> 1, e -> 1, f -> 8}, {b -> 1, c -> 2, d -> 1, e -> 2,
f -> 3}, {b -> 2, c -> 2, d -> 1, e -> 1, f -> 6}}   *)

eqs /. fi

ss = Union@
Flatten[{{a, b, c, d, e, f} /. First@Solve[#, a]} & /@ eqs /. fi, 2];

thx = Thread[vars -> #] & /@ ss

(*   {{a -> 2, b -> 2, c -> 2, d -> 1, e -> 1, f -> 6},
{a -> 3, b -> 1, c -> 2, d -> 1, e -> 2, f -> 3},
{a -> 5, b -> 1, c -> 2, d -> 1, e -> 1, f -> 8},
{a -> 6, b -> 1, c -> 1, d -> 2, e -> 2, f -> 2},
{a -> 7, b -> 1, c -> 1, d -> 1, e -> 3, f -> 3},
{a -> 8, b -> 1, c -> 1, d -> 1, e -> 2, f -> 5}}   *)

eqs /. thx

(*   {{True, True}, {True, True}, {True, True}, {True, True}, {True,
True}, {True, True}}   *)


Two of these solutions are permutations. this is no proof whether this are all solutions.

• Oh... this is the best, and is in the style of solution I seek. Thanks. ($\checkmark$). The only way it could be better is to (as you note) prove that there are just six solutions (up to permutation). Aug 27, 2021 at 16:25

This code using Do returns

DeleteDuplicates[ With[{M = 9},
Reap@Do[If[a + b + c == d e f && d + e + f == a b c,
Sow[{{a, b, c}, {d, e, f}}]],
{a, 1, M}, {b, a, M}, {c, b, M},
{d, 1, M}, {e, d, M}, {f, e, M}]][[2, 1]],
#1 == Reverse@#2 &]


almost immediately. The similar version using FindInstance

DeleteDuplicates[With[{M = 9},
{{a, b, c}, {d, e, f}} /. FindInstance[
a + b + c == d e f && d + e + f == a b c &&
0 < a <= b <= c <= M && 0 < d <= e <= f <= M,
{a, b, c, d, e, f}, Integers, 10]],
#1 == Reverse@#2 &]


takes over two minutes. I find that sometimes using Do beats FindInstance depending on the specific problem.

In this case, it seems that FindInstance has trouble with two equations and solving one of them is indicated as in the answer of Akku14. The following code uses FindInstance with this insight. Start with the two equations.

{eq1, eq2} = {a + b + c == d e f, d + e + f == a b c};


Solve for the variable c using equation 1 to get

solc = Solve[eq1, c][[1, 1]]
(* c -> -a - b + d e f *)


and substitute it into equation 2 to get

eq3 = eq2 /. solc
(* d + e + f == a b (-a - b + d e f) *)


Finding solutions of this equation (ignoring a warning about not being able to prove more solutions exist) using FindInstance takes almost a minute

find = FindInstance[{eq3, 0 < a <= b, 0 < d <= e <= f},
{a, b, d, e, f}, Integers, 9] // Quiet
(* {{a -> 1, b -> 1, d -> 1, e -> 2, f -> 5},
{a -> 1, b -> 1, d -> 1, e -> 3, f -> 3},
{a -> 1, b -> 1, d -> 2, e -> 2, f -> 2},
{a -> 1, b -> 2, d -> 1, e -> 1, f -> 8},
{a -> 1, b -> 2, d -> 1, e -> 2, f -> 3},
{a -> 2, b -> 2, d -> 1, e -> 1, f -> 6}} *)


Apply the solution rules, restore missing values of c and reshape into solution pairs

solpairs = {{a, b, c}, {d, e, f}} /. solc /. find
(* {{{1, 1, 8}, {1, 2, 5}}, {{1, 1, 7}, {1, 3, 3}},
{{1, 1, 6}, {2, 2, 2}}, {{1, 2, 5}, {1, 1, 8}},
{{1, 2, 3}, {1, 2, 3}}, {{2, 2, 2}, {1, 1, 6}}} *)


Finally, eliminate duplicates from swapping {a,b,c} and {d,e,f}

DeleteDuplicates[sort1st, #1 == Reverse@#2 &]
(* {{{1, 1, 8}, {1, 2, 5}}, {{1, 1, 7}, {1, 3, 3}},
{{1, 1, 6}, {2, 2, 2}}, {{1, 2, 3}, {1, 2, 3}}} *)


to get the four solutions (up to permutations).

• Ah... while exhaustive enumeration may indeed work, I'm looking for a symbolic approach. (Your core algorithm could be implemented in Python, for instance.) I should have been clearer and will edit my question accordingly. Nevertheless, thanks ($+1$). Aug 27, 2021 at 0:04
• I prefer code and principles that work ON GENERAL PROBLEMS, not the simple toy problems such as this. AND on general symbolic problems (which too many engineers avoid). Also, symbolic methods are more generalizable to new problems... you don't have to start a bit simulation again. You might find this instructive: mathematica.stackexchange.com/questions/253744/… Aug 27, 2021 at 0:45