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

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

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

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"]}, Internal`WithLocalSettings[ 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

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

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

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.


5

Consider the convergents and semiconvergents of your irrational number. I have some bulky code to calculate semi-convergents. SemiConvergents[v_, {1}] := Join[{0}, Convergents[v, 1]] SemiConvergents[v_, 1] := Join[{0}, Convergents[v, 1]] SemiConvergents[v_, {n_?OddQ}] := Block[{a = Last[ContinuedFraction[v, n]], c = Take[Convergents[v, n - 1], -...


5

I don't know why FindInstance behaves the way you demonstrate; however, a work-around to generate more solutions is as follows. Use the RandomSeed option for FindInstance. Union[Flatten[ Select[Table[ Quiet[ FindInstance[a/(b + c) + b/(a + c) + c/(a + b) == 4, {a, b, c}, Integers, 3, RandomSeed -> k]], {k, ...


5

The answer by @AnjanKumar is very concise and very fast for $d=400004$; however, it may not be correct for all values of $d$. Some values of $d$ have more than one fundamental solution, that is, there are different classes of solution built on different fundamental solutions. Consider $d=60$ and $n=4$ in $v^2-d*u^2=n$. The previous solution via convergents ...


5

Note that it's hard to know how 'efficient' you need without supplying specific examples. If you're only interested in a single instance, you can reduce this problem to the 0-1 knapsack problem (or equivalently 0-1 ILP) by calling KnapsackSolve. Unfortunately I don't see an immediate (built in) way to find more than one solution with this approach. (* ...


5

You see a number of integral points by inspection: e.g. {1,15},{1,-15},{0,3},{0,-3},{-1,3},{-1,-3}. You can pick a "generator point" and scalar multiply and filter rational solutions to get other integers. For example: Defining addition operation: f[x_] := 9 + 108 x^2 (x + 1) fun[{xa_, ya_}, {"O", "O"}] := {xa, ya} fun[{"O", "O"}, {xa_, ya_}] := {xa, ya} ...


5

Just use Solve instead of Reduce. We can eliminate $p$ by setting f[x_] = Abs[a x + b] + Abs[c x + d] + m x^2 + n x; and looking for $f(1)=f(2)=f(3)=f(4)=f(7)=f(9)=-p$ (which is necessarily integer when all parameters are integers). As suggested by @Akku14, enlarging the search space yields solutions for $m\neq 0$: Solve[Join[{Equal @@ f /@ {1, 2, 3, 4, 7,...


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