Tag Info

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.

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

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

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

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

6

Clear["*"] grid = Tuples[DeleteCases[Range[-15, 15], 0], 4]; cpicked = With[{IntegerQ = FractionalPart[#] == 0 &}, Compile[{{m, _Integer, 1}}, Module[{a = m[[1]], b = m[[2]], c = m[[3]], d = m[[4]], delta1, delta2, r1, r2, r3, r4}, If[(a + c)^2 - 4 (b + d) < 0 || (a - c)^2 - 4 (b - d) < 0, 0, delta1 = Sqrt[(a ...

6

[Update: Improved second code.] There is a system limit on Solve, which you can extend this way: k = 1000000; n = Ceiling[k^(3/2)]; With[{ropts = SystemOptions["ReduceOptions"]}, InternalWithLocalSettings[ SetSystemOptions[ "ReduceOptions" -> "SolveDiscreteSolutionBound" -> n], Solve[x^3 - y^2 == 307 && -k < x < k &&...

6

Much faster to solve for $r$ and check that it's an integer: (it's always rational; no square-roots involved) Solve[(a(a+3)(a(r-5)+(12-r)))/9 == (b(9+b(-14+r)-r))/3, r] // FullSimplify (* {{r -> (a(3+a)(-12+5a)+3(9-14b)b)/((-1+a)a(3+a)-3(-1+b)b)}} *) R = (a(3+a)(-12+5a)+3(9-14b)b)/((-1+a)a(3+a)-3(-1+b)b); With[{s = 10^3}, Do[If[IntegerQ[R] &&...

5

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

5

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

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

5

There is always a trivial solution: $x=n-1,y=1$. You can use brute force to find non trivial solutions. Method 1. Calculate $x^y+y^x$ for all pairs $x < \sqrt{n}$ and $y < \sqrt{n}$. Since we are not interested in trivial solutions, we don't need to check $x > \sqrt{n}$. Then check if we have $n$ in the result list. findNonTrivialPairs[n_]:=...

5

FindInstance does not handle GCD so well so leave it out and try: FindInstance[{Abs[Sqrt[2] - p/q] < 1/q^3}, {p, q}, Integers, 5] (*{{p -> 1, q -> 1}, {p -> 2, q -> 1}, {p -> 3, q -> 2}}*) 3 answers are better than none. You can always do some post processing cleanup to weed out bad solutions but in this case there are none.

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