32

If not assumed otherwise m and n can be whatever, so you can do e.g. this : Solve[ Prime[n] + Prime[m] == 100, {n, m}, Integers] {{n -> 2, m -> 25}, {n -> 5, m -> 24}, {n -> 7, m -> 23}, {n -> 10, m -> 20}, {n -> 13, m -> 17}, {n -> 15, m -> 16}, {n -> 16, m -> 15}, {n -> 17, m -> 13}, {n -> 20, m -&...


29

There is an especially useful function for this kind of task: FrobeniusSolve[{a, b, c}, d] for finding the list of all solutions to the equation a x + b y + c z == d, where a,b,c are given positive integers and d is an integer, while x,y,z are non-negative integers to be found. There are many solutions (884 of them): FrobeniusSolve[{2, 3, 1}, 100] // Short ...


27

There are many ways to proceed, the best one uses FrobeniusSolve : I Since we know, that a x + b == y /. Solve[{-4 a + b == 11, 16 a + b == -1}, {a, b}] // Simplify {3 x + 5 y == 43} we find FrobeniusSolve[ {3, 5}, 43] {{1, 8}, {6, 5}, {11, 2}} a bit more straightforward way : II {x, y} /. Solve[ (a x + b == y /. Solve[ {-4 a + b == 11, 16 a + b == ...


23

The sum of consecutive numbers from $a$ to $b$ is $$\frac{(a+b)(b-a+1)}{2}$$ hence simply f[n_] := {a, b} /. Solve[(a + b) (b - a + 1)/2 == n && 0 < a < n && 0 < b < n, {a, b}, Integers] f[45] // AbsoluteTiming {0.019466, {{1, 9}, {5, 10}, {7, 11}, {14, 16}, {22, 23}}} It is straightforward and rather fast. As a test ...


21

Just write the problem literally and use Reduce Reduce[ m >= 0 && w >= 0 && b >= 0 && {m, w, b} ∈ Integers && 2 m + 3/2 w + 1/2 b == 20 && m + w + b == 20, {m, w, b}] (* (m == 0 && w == 10 && b == 10) || (m == 2 && w == 7 && b == 11) || (m == 4 && w == 4 &&...


20

We can do this more efficiently using IntegerPartitions: Counts /@ IntegerPartitions[20, {20}, {1, 3, 4}/2] { <|2 -> 6, 3/2 -> 1, 1/2 -> 13|>, <|2 -> 4, 3/2 -> 4, 1/2 -> 12|>, <|2 -> 2, 3/2 -> 7, 1/2 -> 11|>, <|3/2 -> 10, 1/2 -> 10|> } Also as requested code for only one solution: Counts /@ ...


19

A geometrical view of the solutions: s = Solve[(x - 1)^2 + (y - 1)^2 + (z - 1)^2 == 49, {x, y, z}, Integers]; pts = {x, y, z} /. s; subs = Subsets[pts, {2}]; minds = Union[dists = N[EuclideanDistance @@@ subs]][[1 ;; 3]]; Show[Graphics3D[Sphere[{1, 1, 1}, 13/2]], Graphics3D[Line /@ Extract[subs, Position[dists, Alternatives @@ minds]]], ...


18

Another solution: Select[FrobeniusSolve[{20, 15, 5}, 200], Total[#] == 20 &] {{0, 10, 10}, {2, 7, 11}, {4, 4, 12}, {6, 1, 13}} The first element in each list is the number of men, the second element is the number of women, and the third element is the number of babies.


17

The problem we encounter here is an instance of rather unexpected limitations of equation solving functionality (i.e. Modulus option in Reduce), e.g. this question : Strange behaviour of Reduce for Mod[x,1] provides another example which has been fixed in the newest version (9.0) of Mathematica. Since Modulus unexpectedly doesn't work here we can take ...


16

Is this what you are searching for? a = {-4, 11}; b = {16, -1}; dy = (b[[2]] - a[[2]])/(b[[1]] - a[[1]]); offset = u /. Solve[a[[2]] == dy*a[[1]] + u, u][[1]]; coords = {x, y} /. {Reduce[y == dy*x + offset && x > 0 && y > 0, {x, y}, Integers] // ToRules} (* {{1, 8}, {6, 5}, {11, 2}} *) Graphics[{PointSize[Large], ...


13

First, one should mathematically analyze the problem. Obviously there are infinitely many solutions of the form {1, y} and {x, 1}, as well as {x,y} where x == y. So we can exclude such solutions from our search. Another point is remembering SystemOptions["ReduceOptions"]. There were questions dealing with them, so I'm not going to discuss these issues here; ...


13

You can also use InterpolatingPolynomial with Solve, Reduce or Eliminate: a = {-4, 11}; b = {16, -1}; coords = Solve[y == InterpolatingPolynomial[{a, b}, x] && 0 <= x <= 16&&0<=y, {x, y}, Integers][[All, All, 2]]; (* or *) coords={ToRules[Reduce[ y == InterpolatingPolynomial[{a, b}, x] && 0 <= x <= ...


13

A concrete example would be helpful. Here is a simple way to count solutions, illustrated by example. Generate random set of smallish positive integers. nlist = Union[RandomInteger[{8, 80}, 12]] (* Out[1713]= {9, 16, 19, 35, 41, 42, 58, 59, 68, 74, 78} *) Form a product of binomials. prod = Times @@ (1 + x^nlist) (* Out[1714]= (1 + x^9) (1 + x^16) (1 + ...


12

Try : Solve[(x - 1)^2 + (y - 1)^2 + (z - 1)^2 == 49, {x, y, z}, Integers] or Reduce[(x - 1)^2 + (y - 1)^2 + (z - 1)^2 == 49, {x, y, z}, Integers] You can add inequalities as well as : Solve[{(x - 1)^2 + (y - 1)^2 + (z - 1)^2 == 49, x != 1, y != 1, z != 1}, {x, y, z}, Integers]


11

This should work: sols = Solve[{2*x + 3*y + z == 100, x > 0, y > 0, z > 0}, {x, y, z}, Integers]; Length@sols


11

I took it as a challenge to avoid using Solve, which can be slower than a direct assault. If $a$ is the first number in the sum of consecutive positive integers, and $k$ is the count of integers summing to $n$, then $n=k*a+k(k-1)/2$. Solve this for $a=n/k-(k-1)/2$, with bounds $1 \le k \le {\rm Floor}[(\sqrt{8n+1}-1)/2]$. Consider the odd and even divisors ...


10

YAW: Yet Another Way. FindInstance seems created for such tasks: Let m = number of men, w = number of women, b = number of babies. FindInstance[{2 m + (3/2) w + (1/2) b == 20, m + w + b == 20, m >= 0, w >= 0, b >= 0}, {m, w, b}, Integers, 10] (*{{m -> 0, w -> 10, b -> 10}, {m -> 2, w -> 7, b -> 11}, {m -> 4, w -> 4, b -&...


9

Depending on whether you care about permutations or not, here are some ways to go about it. One is to solve a system of equations via Reduce and count the solutions. vars = Array[a, 6]; eqn = Total[vars] == 18; ineqs = Map[0 <= # <= 9 &, vars]; In[558]:= Timing[soln = Reduce[Flatten[{eqn, ineqs}], vars, Integers];] Length[soln] Out[558]= {1....


9

You can do : Reduce[Prime[n] + Prime[m] == 100, {n, m}, Integers]


9

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


9

Could set this up as a 1-0 integer linear programming problem. Module[{vars = Array[a, 10]}, vars*Range[10] /. Solve[Flatten@{vars.Range[10] == 28, Total[vars] == 4, Map[0 <= # <= 1 &, vars]}, vars, Integers] /. 0 -> Nothing] (* Out[98]= {{5, 6, 8, 9}, {5, 6, 7, 10}, {4, 7, 8, 9}, {4, 6, 8, 10}, {4, 5, 9, 10}, {3, 7, 8, 10}, {3,...


9

Here's a guess: The Diophantine problem $$ x^2+y^2+x+y=a$$ is equivalent, via $u=2x+1,v=2y+1$ to finding the odd solutions to $$u^2+v^2=2+4a \,.$$ Whether Solve makes this transformation or not, solving the Pythagorean equation can be done from the prime factorization of $2+4a$. How long Solve takes thus might depend on how long it takes to factor $2+4a$. ...


8

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,...


8

Not all solutions, but the one that minimizes the number of babies to feed LinearProgramming[{0, 0, 1}, {{2, 1.5, .5}, {1, 1, 1}}, {{20, 0}, {20, 0}}, 0, Integers]


8

Dealing with diophantine equations after appropriate restriction of the possible solution space one could play with extension of ExhaustiveSearchMaxPoints. SystemOptions["ReduceOptions" -> "ExhaustiveSearchMaxPoints"] For an example when an extension appears crucial see e.g. Solving/Reducing equations in Z/pZ. Here I just set (I don't insist it is ...


8

For the first problem, if you have enough memory available you could just generate all subsets and count how many times they form a certain sum: aa = {7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20}; Rest@BinCounts[Total /@ Subsets[aa]] {1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 3, 3, 4, 4, 4, 4, 5, 6, 7, 8, 10, 10, 11, 12, 13, 14, 16, ...


7

There are also power series methods for counting these. SeriesCoefficient[ x^(1 + 2 + 3)/(1 - x^1)*1/(1 - x^2)*1/(1 - x^3), {x, 0, 100}] (* Out[118]= 784 *) See also "Supplement to 'Perplexities Related to Fourier's 17 Line Problem'."


7

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


7

The Backsubstitution option will help here. Reduce[ 1 + x + y + x y + z + x z + y z - x y z == 0 && x >= y >= z >= 1, {x, y, z}, Integers, Backsubstitution -> True] (* (x == 5 && y == 4 && z == 3) || (x == 7 && y == 6 && z == 2) || (x == 8 && y == 3 && z == 3) || (x == 9 && ...


7

d[n_] := With[{dv = Divisors[n]}, {#, n/#} & /@ Pick[dv, # < Sqrt[n] & /@ dv]] f[a_, b_] := With[{p = a - 1, q = b}, {(q - p)/2, (p + q)/2}] res[n_] := Rest@Cases[f @@@ d[2 n], {_Integer, _Integer}] So, ListPlot[{#, Length[res[#]]} & /@ Range[1000], Filling -> Axis] ListPlot[DeleteCases[{#, #2 - #1 + 1 & @@ (res[#][[-1]])} & /@...


Only top voted, non community-wiki answers of a minimum length are eligible