Defining a Unique Domain for Solving Diophantine Equations

Question

I am working on a research problem in discrete geometry to do with sphere packings, and believe it or not, I have been able to reduce it to finding the solutions to the Diophantine equation, $$n = \frac{x + 2y + 3z}{2}, \text{ where $n,x,y,z \in \{1,2,3,4,5,6,7,8,9\}$}$$

In Mathematica 8 I have attempted to use the "FindInstance" command in order to find these solutions (there are a finite number of them), but I have no way to define the domain $\{1,2,3,4,5,6,7,8,9\}$, it only accepts "Reals", "Integers", etc. as a domain. Is there any way around this?

FindInstance[(x + 2 y + 3 z)/2 == 4, {x, y, z}, {1, 2, 3, 4, 5, 6, 7, 8, 9}, 10]

My idea would be to use that to find 10 instances of the solution, but the domain is undefined.

Answer 1

FindInstance[{(x + 2 y + 3 z)/2 == 4 && 1<= x <= 9 && 1<= 
y <= 9 && 1<= z <= 9}, {x, y, z}, Integers, 10]

gives two solutions: {{x -> 3, y -> 1, z -> 1}, {x -> 1, y -> 2, z -> 1}}

With relaxed constraints,

FindInstance[{(x + 2 y + 3 z)/2 == 4 && -100 <= x <= 100 && -100 <= 
y <= 100 && -100 <= z <= 100}, {x, y, z}, Integers, 10]

gives

 {{x -> 50, y -> -84, z -> 42}, {x -> 47, y -> 87, z -> -71}, 
  {x -> -47, y -> -13, z -> 27}, {x -> 65, y -> 39,  z -> -45}, 
  {x -> -51, y -> -20, z -> 33}, {x -> -79, y -> 99, z -> -37},
  {x -> -47, y -> 92, z -> -43}, {x -> -45, y -> -95,  z -> 81}, 
  {x -> -20, y -> -52, z -> 44}, {x -> -100, y -> 54,   z -> 0}}

Answer 2

Another possibility is perhaps FrobeniusSolve

For example,

Sort@Select[
  ArrayFlatten[FrobeniusSolve[{1, 2, 3}, #] & /@ Range[2, 18, 2], 1], 
  FreeQ[#, 0] && #[[1]] < 10 && #[[2]] < 10 && #[[3]] < 10 &]

gives the following list (53 elements), essentially the same solution as the one posted by Daniel Lichtblau.

{{1, 1, 1}, {1, 1, 3}, {1, 1, 5}, {1, 2, 1}, {1, 2, 3}, {1, 3, 1},

{1, 3, 3}, {1, 4, 1}, {1, 4, 3}, {1, 5, 1}, {1, 6, 1}, {1, 7, 1},

{2, 1, 2}, {2, 1, 4}, {2, 2, 2}, {2, 2, 4}, {2, 3, 2}, {2, 4, 2},

{2, 5, 2}, {3, 1, 1}, {3, 1, 3}, {3, 2, 1}, {3, 2, 3}, {3, 3, 1},

{3, 3, 3}, {3, 4, 1}, {3, 5, 1}, {3, 6, 1}, {4, 1, 2}, {4, 1, 4},

{4, 2, 2}, {4, 3, 2}, {4, 4, 2}, {5, 1, 1}, {5, 1, 3}, {5, 2, 1},

{5, 2, 3}, {5, 3, 1}, {5, 4, 1}, {5, 5, 1}, {6, 1, 2}, {6, 2, 2},

{6, 3, 2}, {7, 1, 1}, {7, 1, 3}, {7, 2, 1}, {7, 3, 1}, {7, 4, 1},

{8, 1, 2}, {8, 2, 2}, {9, 1, 1}, {9, 2, 1}, {9, 3, 1}}

For FrobeniusSolve, this answer by Andrew Moylan might also be of interest.

Answer 3

No reason not to have n a variable as well.

In[786]:= {x, y, z, 
  n} /. {ToRules[
   Reduce[{(x + 2 y + 3 z) == 2 n, 1 <= x <= 9, 1 <= y <= 9, 
     1 <= z <= 9, 1 <= n <= 9}, {x, y, z, n}, Integers]]}

Out[786]= {{1, 1, 1, 3}, {1, 1, 3, 6}, {1, 1, 5, 9}, {1, 2, 1, 4}, {1,
   2, 3, 7}, {1, 3, 1, 5}, {1, 3, 3, 8}, {1, 4, 1, 6}, {1, 4, 3, 
  9}, {1, 5, 1, 7}, {1, 6, 1, 8}, {1, 7, 1, 9}, {2, 1, 2, 5}, {2, 1, 
  4, 8}, {2, 2, 2, 6}, {2, 2, 4, 9}, {2, 3, 2, 7}, {2, 4, 2, 8}, {2, 
  5, 2, 9}, {3, 1, 1, 4}, {3, 1, 3, 7}, {3, 2, 1, 5}, {3, 2, 3, 
  8}, {3, 3, 1, 6}, {3, 3, 3, 9}, {3, 4, 1, 7}, {3, 5, 1, 8}, {3, 6, 
  1, 9}, {4, 1, 2, 6}, {4, 1, 4, 9}, {4, 2, 2, 7}, {4, 3, 2, 8}, {4, 
  4, 2, 9}, {5, 1, 1, 5}, {5, 1, 3, 8}, {5, 2, 1, 6}, {5, 2, 3, 
  9}, {5, 3, 1, 7}, {5, 4, 1, 8}, {5, 5, 1, 9}, {6, 1, 2, 7}, {6, 2, 
  2, 8}, {6, 3, 2, 9}, {7, 1, 1, 6}, {7, 1, 3, 9}, {7, 2, 1, 7}, {7, 
  3, 1, 8}, {7, 4, 1, 9}, {8, 1, 2, 8}, {8, 2, 2, 9}, {9, 1, 1, 
  7}, {9, 2, 1, 8}, {9, 3, 1, 9}}

I confess I'm surprised a sphere packing problem came down to this equation.

Answer 4

Sometimes tt is more reasonable to use Reduce :

Reduce[(x + 2 y + 3 z)/2 == 4 && 1 <= x <= 9 && 1 <= y <= 9 && 1 <= z <= 9, {x, y, z}, Integers]

(x == 1 && y == 2 && z == 1) || (x == 3 && y == 1 && z == 1)

For a larger domain

sols = Reduce[(x + 2 y + 3 z)/2 == 4 && -100 <= x <= 100 && -100 <= y <= 100&&-100 <= z <= 100, 
              {x, y, z}, Integers];

it yields the number of solutions

Length[List @@ sols]

13462

For more advanced usage of Mathematica for diophantine equations see Advanced Algebra tutorial, e.g.

Reduce[0 < x^3 < 1301, x, Integers]

x == 1 || x == 2 || x == 3 || x == 4 || x == 5 || x == 6 || x == 7 ||
x == 8 || x == 9 || x == 10

however slightly increasing the upper bound we get the solution set implicitly

Reduce[0 < x^3 < 1401, x, Integers]

x \[Element] Integers && 1 <= x <= 11

we can change this with :

SetSystemOptions["ReduceOptions" -> {"DiscreteSolutionBound" -> 11}];
Reduce[0 < x^3 < 1401, x, Integers]

x == 1 || x == 2 || x == 3 || x == 4 || x == 5 || x == 6 || x == 7 ||
x == 8 || x == 9 || x == 10 || x == 11