Sum Over Solutions to an Equation

Question

Two Related Questions

1. Is there any general built-in functionality for computing a sum over solutions to an equation? This is common in number theory. For example, computing sums of the following form...

$$F(n)=\sum_{i+j+k=n}f(i,j,k)$$

where i, j, and k are nonnegative integers.

Note: The above is just an example. I would like to be able to sum over solutions to other simple equations where IntegerPartitions[] does not apply, like $i^2+j+k=n$.

---

2. A related question: How can I sum over a set of sets using the $Sum[]$ function? Because if the answer to question 1 is "no", then I would hope I could still use $Sum[]$ to sum over a set of solutions (sets).

• For example, I know

$$\sum_{i \in \{a,b,c\}}f(i,j)$$

can be computed with

Sum[f[i,j],{i,{a,b,c}}]

giving

$$f[a, j] + f[b, j] + f[c, j]$$

• What I'm looking for is a way for Mathematica to compute

$$\sum_{\{i,j\} \in \{(a,x),(b,y),(c,z)\}}f(i,j)$$

to give

$$f[a, x] + f[b, y] + f[c, z]$$

I would expect/want Mathematica to give that using the code

Sum[f[i,j],{{i,j},{{a,x},{b,y},{c,z}}]

but that gives an error.

Any ideas?

Answer 1

1.

n=7;
Total[f@@@IntegerPartitions[n,{3}]]
(*f[3, 2, 2] + f[3, 3, 1] + f[4, 2, 1] + f[5, 1, 1]*)

Revised for the additional condition to not make any use of IntegerPartitions and to Select on an arbitrary condition.

n=7;
g[{i_,j_,k_}]:=i^2+j+k==n;
Select[Partition[Flatten[Table[{i,j,k},{i,1,n},{j,1,n},{k,1,n}]],3],g]
(*{{1,1,5},{1,2,4},{1,3,3},{1,4,2},{1,5,1},{2,1,2},{2,2,1}}*)

Revised for non-negative

n=7;
g[{i_,j_,k_}]:=i^2+j+k==n;
Select[Partition[Flatten[Table[{i,j,k},{i,0,n},{j,0,n},{k,0,n}]],3],g]

(*{{0,0,7},{0,1,6},{0,2,5},{0,3,4},{0,4,3},{0,5,2},{0,6,1},{0,7,0},
   {1,0,6},{1,1,5},{1,2,4},{1,3,3},{1,4,2},{1,5, 1},{1,6,0},
   {2,0,3},{2,1,2},{2,2,1},{2,3,0}}*)

2.

Total[f@@@{{a,x},{b,y},{c,z}}]
(*f[a, x] + f[b, y] + f[c, z]*)

There are almost always a dozen different ways of doing almost anything in Mathematica

Answer 2

Clear["Global`*"]

For the first part

F[n_] := Sum[f[i, j, k], {i, 1, n - 2}, {j, 1, n - i - 1}, {k, 1, n - i - j}];

F /@ Range[5]

(* {0, 0, f[1, 1, 1], f[1, 1, 1] + f[1, 1, 2] + f[1, 2, 1] + f[2, 1, 1], 
 f[1, 1, 1] + f[1, 1, 2] + f[1, 1, 3] + f[1, 2, 1] + f[1, 2, 2] + f[1, 3, 1] +
   f[2, 1, 1] + f[2, 1, 2] + f[2, 2, 1] + f[3, 1, 1]} *)

For the second part

Sum[f @@ i, {i, {{a, x}, {b, y}, {c, z}}}]

(* f[a, x] + f[b, y] + f[c, z] *)

Or using Total

Total[f @@@ {{a, x}, {b, y}, {c, z}}]

(* f[a, x] + f[b, y] + f[c, z] *)

EDIT: For the modified first part

Clear["Global`*"]

F[n_Integer?Positive] := Module[{inst = FindInstance[
     {i^2 + j + k == n, i > 0, j > 0, k > 0}, 
    {i, j, k}, Integers, n^3]},
  Total[f[i, j, k] /. inst]]

F[12]

(* f[1, 1, 10] + f[1, 2, 9] + f[1, 3, 8] + f[1, 4, 7] + f[1, 5, 6] + 
  f[1, 6, 5] + f[1, 7, 4] + f[1, 8, 3] + f[1, 9, 2] + f[1, 10, 1] + 
  f[2, 1, 7] + f[2, 2, 6] + f[2, 3, 5] + f[2, 4, 4] + f[2, 5, 3] + 
  f[2, 6, 2] + f[2, 7, 1] + f[3, 1, 2] + f[3, 2, 1] *)

Answer 3

For your more complicated example, you can use Solve to find the needed triples:

set = Values @ Solve[
    i^2 + j + k == 13 && i > 0 && j > 0 && k > 0,
    {i, j, k},
    Integers
]

{{1, 1, 11}, {1, 2, 10}, {1, 3, 9}, {1, 4, 8}, {1, 5, 7}, {1, 6, 6}, {1, 7, 5}, {1, 8, 4}, {1, 9, 3}, {1, 10, 2}, {1, 11, 1}, {2, 1, 8}, {2, 2, 7}, {2, 3, 6}, {2, 4, 5}, {2, 5, 4}, {2, 6, 3}, {2, 7, 2}, {2, 8, 1}, {3, 1, 3}, {3, 2, 2}, {3, 3, 1}}

Then you can use one of the methods from the other answers to form the desired sum, e.g.:

Sum[f @@ t, {t, set}]

f[1, 1, 11] + f[1, 2, 10] + f[1, 3, 9] + f[1, 4, 8] + f[1, 5, 7] + f[1, 6, 6] + f[1, 7, 5] + f[1, 8, 4] + f[1, 9, 3] + f[1, 10, 2] + f[1, 11, 1] + f[2, 1, 8] + f[2, 2, 7] + f[2, 3, 6] + f[2, 4, 5] + f[2, 5, 4] + f[2, 6, 3] + f[2, 7, 2] + f[2, 8, 1] + f[3, 1, 3] + f[3, 2, 2] + f[3, 3, 1]

or

Total[f @@@ set]

f[1, 1, 11] + f[1, 2, 10] + f[1, 3, 9] + f[1, 4, 8] + f[1, 5, 7] + f[1, 6, 6] + f[1, 7, 5] + f[1, 8, 4] + f[1, 9, 3] + f[1, 10, 2] + f[1, 11, 1] + f[2, 1, 8] + f[2, 2, 7] + f[2, 3, 6] + f[2, 4, 5] + f[2, 5, 4] + f[2, 6, 3] + f[2, 7, 2] + f[2, 8, 1] + f[3, 1, 3] + f[3, 2, 2] + f[3, 3, 1]

Answer 4

Overall concept: Sum is built around iterators. If you are wanting to sum up something based on criteria other than sequential iterators, you are better off generating a list and just saying to add everything in the list (i.e., Total).

Most of the other answers are excellent. Here are my favorites, with explanations rooted in the overall concept above.

Question 1:

Generate a list containing the answers and call Total to add them all up. Using your example:

Total[f[i,j,k]/.Solve[{i+j+k==13,i>0,j>0,k>0},{i,j,k},Integers]]

Here, Solve[{i+j+k==13,i>0,j>0,k>0},{i,j,k},Integers]] generates replacement rules for all of the cases that meet your criterion, f[i,j,k]/. puts those solutions into the function, and Total adds them all up.

When Version 12 comes out, you can do this even more concisely:

Total[f[i,j,k]/.Solve[i+j+k==13,{i,j,k},PositiveIntegers]]

Question 2:

Again, use Total. This time make a list of the parameter lists, and use the @@@ version of Apply:

Total[f@@@set]

This takes elements of set and puts them in f as parameters, so f@@@{{i1,j1,k1},{i2,j2,k2}} returns {f[i1,j1,k1],f[i2,j2,k2]}

You can generate your set however you like, but if it is based on the first example, you could do it like this:

set={i,j,k}/.Solve[{i+j+k==13,i>0,j>0,k>0},{i,j,k},Integers]

Answer 5

For the first part, if the equation is linear, use IntegerPartitions together with Permutations:

Total[f @@@ Join @@ Permutations /@ IntegerPartitions[7, {3}]]

f[1, 1, 5] + f[1, 2, 4] + f[1, 3, 3] + f[1, 4, 2] + f[1, 5, 1] + f[2, 1, 4] + f[2, 2, 3] + f[2, 3, 2] + f[2, 4, 1] + f[3, 1, 3] + f[3, 2, 2] + f[3, 3, 1] + f[4, 1, 2] + f[4, 2, 1] + f[5, 1, 1]

If you want to include zero, use the third argument of IntegerPartitions to supply an explicit list of values to choose from:

Total[f @@@ Join @@ Permutations /@ IntegerPartitions[7, {3}, Range[0, 7]]]

f[0, 0, 7] + f[0, 1, 6] + f[0, 2, 5] + f[0, 3, 4] + f[0, 4, 3] + f[0, 5, 2] + f[0, 6, 1] + f[0, 7, 0] + f[1, 0, 6] + f[1, 1, 5] + f[1, 2, 4] + f[1, 3, 3] + f[1, 4, 2] + f[1, 5, 1] + f[1, 6, 0] + f[2, 0, 5] + f[2, 1, 4] + f[2, 2, 3] + f[2, 3, 2] + f[2, 4, 1] + f[2, 5, 0] + f[3, 0, 4] + f[3, 1, 3] + f[3, 2, 2] + f[3, 3, 1] + f[3, 4, 0] + f[4, 0, 3] + f[4, 1, 2] + f[4, 2, 1] + f[4, 3, 0] + f[5, 0, 2] + f[5, 1, 1] + f[5, 2, 0] + f[6, 0, 1] + f[6, 1, 0] + f[7, 0, 0]

If you're not into @@@ @@ /@ voodoo, the same can be done with

Total[Apply[f, Apply[Join, Map[Permutations, IntegerPartitions[7, {3}]]], {1}]]

For more complicated equations, you can use Solve over the integers:

Total[f[i, j, k] /. Solve[i^2 + j + k == 7, {i, j, k}, PositiveIntegers]]

f[1, 1, 5] + f[1, 2, 4] + f[1, 3, 3] + f[1, 4, 2] + f[1, 5, 1] + f[2, 1, 2] + f[2, 2, 1]

If you want to include zero:

Total[f[i, j, k] /. Solve[i^2 + j + k == 7, {i, j, k}, NonNegativeIntegers]]

f[0, 0, 7] + f[0, 1, 6] + f[0, 2, 5] + f[0, 3, 4] + f[0, 4, 3] + f[0, 5, 2] + f[0, 6, 1] + f[0, 7, 0] + f[1, 0, 6] + f[1, 1, 5] + f[1, 2, 4] + f[1, 3, 3] + f[1, 4, 2] + f[1, 5, 1] + f[1, 6, 0] + f[2, 0, 3] + f[2, 1, 2] + f[2, 2, 1] + f[2, 3, 0]