# How to set a custom number field to solve this equation

x1 , x2 , x3 , x4 and x5 can only be taken from {-1,1,2,4}.

How to set a custom number field to solve this equation.

NumberField = {-1, 1, 2, 4};
Solve[Mod[x1 + x2 + x3 + x4 + x5, 3] == 0, {x1, x2, x3, x4, x5},NumberField]


My question is equivalent to

Solve[ Mod[x1 + x2 + x3 + x4 + x5, 3] == 0 && -1 <= x1 <= 4 && -1 <= x2 <= 4
&& -1 <= x3 <= 4 && -1 <= x4 <= 4 && -1 <= x5 <= 4 && x1 != 0 && x1 != 3 && x2
!= 0 && x2 != 3 && x3 != 0 && x3 != 3 && x4 != 0 && x4 != 3 && x5 != 0 && x5
!= 3, {x1, x2, x3, x4, x5}, Integers]


How to add this custom number field (NumberField = {-1, 1, 2, 4}) to the solve function?

wuyudi had the right idea to use Tuples[], but as the OP notes, trying to generate all of them just to cull entries afterwards can rapidly become combinatorically prohibitive. Instead, use the equivalence of Tuples[] with the problem of generating all the $$m$$-digit base $$b$$ numbers:

With[{nums = {-1, 1, 2, 4}, count = 5},
Table[With[{id = nums[[IntegerDigits[k, Length[nums], count] + 1]]},
If[Mod[Total[id], 3] == 0, id, Nothing]], {k, 0, Length[nums]^count - 1}]]


Another method is to use IntegerPartitions[]:

Flatten[Permutations /@ Select[Flatten[Table[IntegerPartitions[k, {5}, {-1, 1, 2, 4}],
{k, -5, 20}], 1], Mod[Total[#], 3] == 0 &], 1]

Select[Tuples[{-1, 1, 2, 4}, 5], Mod[Total@#, 3] == 0 &]

• But if it is as long as this list RandomSample[Range[1000], 50] // Sort, it will cause memory overflow. Commented Jan 21, 2020 at 0:26

This might not be any better than a brute force check of all tuples, but it can be recast as an integer linear programming problem, mostly with 0-1 variables. The idea is to use a sum of the form -1*a+1*b+2*c+4*d for each of the five variables, enforcing that a+b+c+d==1 and each separately be 0 or 1. We enforce that the sum of these be a multiple of 3. It is easy to see that the multiple must lie between -1 and 6.

vals = {-1, 1, 2, 4};
vars = Array[c, {5, Length[vals]}];
fvars = Flatten[vars];
c1 = Map[Total[#] == 1 &, vars];
c2 = Map[0 <= # <= 1 &, fvars];
c3 = Total[vars.vals] == k*3;
c4 = -1 <= k <= 6;


Now solve the system.

sol = Solve[Flatten[{c1, c2, c3, c4}], Join[{k}, fvars], Integers];

Length[sol]

(* Out[1080]= 320 *)


Is there a need to find/count all possible solutions? One can remove 4 from the list perhaps, since it is equal to 1 mod 3, and that would cut down the complexity of the process.

Also one can remove permutations and cut back further on the size and complexity. This can be done be forcing that successive variables be non-decreasing, for example.

c5 = Apply[LessEqual, vars.vals];
solOrdered =
Solve[Flatten[{c1, c2, c3, c4, c5}], Join[{k}, fvars], Integers];
Length[solOrdered]

(* Out[1086]= 20 *)


Another simple way with little memory usage.

Since Mod is totaly symetric in x1 to x5, find factors {n1, n2, n3, n4} for how many times each element in NumberField may occur. With Table over k, all possible multiples of 3 are adressed.

cond1 = And @@ Thread[0 <= {n1, n2, n3, n4} <= 5]

cond2 = Total[{n1, n2, n3, n4}] == 5

fl = Flatten[Table[{n1, n2, n3, n4} /.
Solve[cond1 && cond2 && (-n1 + n2 + 2 n3 + 4 n4) == k,
{n1, n2, n3, n4}, Integers], {k, -3, 18, 3}], 1]

(*   {{4, 1, 0, 0}, {3, 1, 1, 0}, {4, 0, 0, 1},
{1, 4, 0, 0}, {2, 1, 2, 0}, {3, 0, 1, 1}, {0, 4, 1, 0},
{1, 1, 3, 0}, {1, 3, 0, 1}, {2, 0, 2, 1},{0, 1, 4, 0},
{0, 3, 1, 1}, {1, 0, 3, 1}, {1, 2, 0, 2}, {0, 0, 4, 1},
{0, 2, 1, 2}, {1, 1, 0, 3}, {0, 1, 1, 3}, {1, 0, 0, 4},
{0, 0, 1, 4}}   *)