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


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


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

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

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

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


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

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

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


8

You can find the integer points with Solve: With[{s = 10^5}, Solve[n == 9 + 108 x^2 (1 + x) && -s <= n <= s && -s <= x <= s, {n, x}, Integers]] (* {{n -> -97191, x -> -10}, {n -> -69975, x -> -9}, {n -> -48375, x -> -8}, {n -> -31743, x -> -7}, {n -> -19431, x -> -6}, {n -> -...


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

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

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]])} & /@...


7

There is an inequality between arithmetic and harmonic means of $n$ positive numbers: $$\frac{k_1+\dots+k_n}{n} \geq \frac{n}{\frac{1}{k_1}+\dots \frac{1}{k_n}}$$ where $k_1>0, \dots, k_n>0$. Mathematica ( version $\geq$ 10.1) knows this relation for $n\leq 4$, e.g. Simplify[Mean[#] >= HarmonicMean[#], Min[#] > 0] &[{k1, k2, k3, k4}] True ...


7

You can obtain the smallest solution using the following d = 400004; b = Convergents[Sqrt[d]][[-2]]; {vS, uS} = 2*{Numerator[b], Denominator[b]} {639176293975850025902542507002869107405272920896001249322708894389485\ 74385666998528790229868783788066961187502, \ 1010621404580133400642412209621549153797917953531796195330954316636633\ ...


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


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

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

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


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