Tag Info

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


25

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


15

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

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

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

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


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


12

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


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


9

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


9

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


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

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


7

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


7

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


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

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

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


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


4

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


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

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

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


3

Try to read Documentation on functions Solve and Reduce and tutorial Solving Equations. Look through this forum, I bet this is a duplicate question. There is also a guide: Diophantine Equations. {x1, x2, x3} /. Solve[x1 + x2 + x3 == 16 && 1 <= x1 <= 6 && 1 <= x2 <= 6 && 1 <= x3 <= 6, {x1, x2, x3}, Integers] ...


3

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


3

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



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