Hot answers tagged

30

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


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


27

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


16

It does not seem surprising that a search space 2000 times larger results in a substantially longer computation time. Here is a much more direct way to find a solution: Sqrt @ IntegerPartitions[2012^2, {5}, Range[2012]^2, 1] {{2011, 63, 7, 2, 1}}


15

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


15

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


15

Here is a way to make FindInstance work and give you a a few random solutions quickly: Flatten /@ ({a -> #, FindInstance[2012^2 == #^2 + b^2 + c^2 + d^2 + e^2, {b, c, d, e}, Integers]} & /@ RandomInteger[2011, 10]) // Column Your equation can be solved for any Abs[a] <= 2012. Here is an app that let's you browse random solutions for any such ...


14

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


12

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


11

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


10

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


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


8

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]


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


8

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


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


6

The difference between $2^n$ and $n^2$ is that $2^n$ is not a function $\bmod 10$ -- that is, $2^{n+10}$ is not congruent to $2^n\bmod 10$. Further $2^n$ is only eventually periodic $\bmod 10^k$, $k \geq 2$. For instance $2^1$ is not congruent to any other $2^n \bmod 100$. On the other hand, polynomial functions are all functions $\bmod\, m$ : f[n+m] is ...


6

This isn't really an answer, but it's too big for a comment. Here's some code to brute force solve the problem (since there wasn't any code provided in the question). It lists all the possible numbers; finds the ones whose product matches; then of those, finds the ones whose sum of squares match, etc.. Module[{h = 50, r, product, squared, fourth, sixth}, ...


6

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


6

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


6

As it happens, I wrote code for this sort of thing a couple of months ago. Am hoping to put it into Wolfram|Alpha some day. sumOfPowers[n_, pow_, use_, exactly_: False] := sumOfPowers[n, pow, use, n + 1, exactly] sumOfPowers[n_, pow_, use_, min_, exactly_: False] := Catch[Module[ {n1 = min, nminus, res}, If[use == 1 && ! IntegerQ[n^(1/pow)], ...


6

Complete brute force. Not guaranteed to run up to 1000 in a reasonable time frame: Select[Table[{d, Reduce[x^3 + d y^3 == 1 && y != 00, {x, y}, Integers]}, {d, 1, 30}], #[[2]] =!= False &] // TableForm


5

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


5

You can use DeleteDuplicates, DeleteDuplicatesBy (Version 10) or GatherBy as follows: ddF = DeleteDuplicates[#, Sort[Last /@ #] == Sort[Last /@ #2] &] &; ddbF = DeleteDuplicatesBy[#,Sort[Last/@#]&]&; fgbF = First /@ GatherBy[#, Sort[Last /@ #] &] &; Examples: sol1 = Solve[ x^2 + y^2 + z^2 == 14^2 && x > 0 && y ...


4

You could use Inner to build the system of inequalities: Reduce[ Inner[ LessEqual, lhs, rhs, And], Variables[{lhs,rhs}], Reals ]


4

The combinations are shown below as 'result. The number of combinations is the number of elements inresult`. The permutations were calculated on each combination and summed. It is possible to count the number of permutations with repetitions without actually producing each one. The trick is to use the formula: n!/n1! n2!...nk! where n stands for the ...


4

Artes's solution is the best, I think. If you just want to treat this as an ordinary Diophantine problem, you can do that with Solve[] (making this approach more or less equivalent to Yves's): {p, q} = {-4, 11}; {r, s} = {16, -1}; {x, y} /. Solve[{(q - s) x - (p - r) y == -Det[{{p, q}, {r, s}}], x > 0, y > 0, Min[p, r] < x < ...


4

It seems to me that for your first stated problem there is a much better method than Solve or Reduce: {m, k, p} = {16, 3, 6}; IntegerPartitions[m, {k}, Range@p] {{6, 6, 4}, {6, 5, 5}} If you want all permutations just use Permutations: Join @@ Permutations /@ % {{6, 6, 4}, {6, 4, 6}, {4, 6, 6}, {6, 5, 5}, {5, 6, 5}, {5, 5, 6}} For your second ...


4

The equation $x^3+d~y^3=1$ becomes $x^3\equiv 1$, mod $d$. Hence, PowerModList[1,1/3,d] gives a list of all positive $x$ between 1 and $d-1$, inclusive, which satisfy $x^3\equiv 1$, mod $d$. For example, $d=20$ implies $x\equiv 1$, mod 20, is the only solution for $x$ between 1 and $d-1=19$. Adding and subtracting multiples of the modulus $d$ gives other ...



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