Tag Info

Hot answers tagged

29

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


25

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


24

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

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


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

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

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


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

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


5

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


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

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

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


3

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


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


2

Cannot test this in Mathematica right now, but pattern matching should work to get the bits that appear next to x. So for instance you could use Cases[Ans,(x == z_)->(z/.C[1]->0),Infinity] That will capture all the terms where x appears on the left of == and will give return what on the right side of that equality with C[1] replaced by 0.


2

Suppose we know the equation of line through the two points, one can generate all points on the line with integer x and of them keep those with integer y. Without invoking solving function. With[{x1 = -4, y1 = 11, x2 = 16, y2 = -1}, Table[{x, (y2 - y1)/(x2 - x1) (x - x1) + y1}, {x, x1, x2}]] // Cases[#, {_, _Integer}] & (* {{-4, 11}, {1, 8}, {6, ...


2

Quiet[Cases[Outer[List, Range[-4, 11], Range[16, -1, -1]], {x_, y_} /; (y - 11)/(x + 4) == (y + 1)/(x - 16), {2}]] This solution shows how to transform linear complexity to quadratic, and provides some relief of the comic variety. ;)


2

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


2

(Getting a bit lengthy for a comment.) Here are several {m,n} pairs that work. {{28, 21}, {168, 120}, {984, 697}, {5740, 4060}, {115, 109}, {3475, 3252}, {620, 604}, {1999, 1969}, {844, 837}, {28704, 28417}, {10259, 10189}, {19060, 18964}, {32575, 32449}, {52244, 52084}, {79699, 79501}, {28564, 28557}, {166488, 166440}, {100803, 100797}, {970228, ...


2

What you have found are not lines of infinite length, unless you can prove that they are, by induction e.g. What I want to show is still not a proof for anything but a solution, not great but works, how to find more such lines. Let generate the data k = 300; l = Reap[Do[If[IntegerQ[Sqrt[1/2 (1 + m - n) (m + n)]], Sow@{n, m}], {n, k}, {m, n + ...



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