Partitions and Sums of Integer Powers

by Jaime Rangel-Mondragón

Facultad de Informática
Universidad Autónoma de Querétaro
División de Estudios de Posgrado

Centro Universitario
Cerro de las Campanas s/n
C.P. 76010 Querétaro, Qro. 
Mexico

jrangel@sunserver.uaq.mx

Copyright  ©August, 2000, UAQ, Facultad de Informática

Permission is hereby granted to reproduce part or all of this file for any purpose other than direct profit providing that the source is acknowledged.

Off[General::"spell", General::"spell1"]

This work was finished at Wolfram Research Inc., in Champaign IL, USA, while the author was spending two months as a Visiting Scholar. Their assistance and enthusiastic support is gratefully acknowledged. My thanks are also given for the continuous support received from the University of Queretaro in Mexico.

Introduction.

A partition of a positive integer number is a finite nonincreasing sequence of numbers adding up to that number. Take, for instance, the following "proof without words" diagram illustrating the fact that any square number is a sum of odd numbers, where we can see that 1+3+5+7+9+11 is a partition of 36 in odd parts.

li[n_] := 
      Table[{Line[{{0, i}, {i, i}, {i, 0}}]}, {i, 
          n}]
ci[n_] := 
      Table[{RGBColor[(i/n), (j/n), ((i j)/(n^2))], 
          Disk[{i - 0.5, j - 0.5}, 0.35]}, {i, n}, {j, 
          n}]
Show[Graphics[{li[6], ci[6]}], 
        AspectRatio -> Automatic];

The purpose of this notebook is to outline some of the number-theoretical ideas and their implementations surrounding the concept of partitions and sums of integer powers in general. The author has used this material to introduce students to a variety of concepts in number theory, combinatorics and algorithm-design throughout interactive sessions of Mathematica. Because the nature of the subject offers the teacher ample margin to exercise his/her  particular teaching style and personal taste in enhancing or omitting particular sections of this material; for instance, the author always includes a few proofs, discussion sessions, individual problem-solving sessions, collective problem-solving session (these sessions being held simultaneously to cater for continuity), a written assignment, homework and an exam to adequately cover a theme such as this one. Thus, no attempt has been made to include abundant comments in order to provide a suitable framework on which to base a lecture. The proof of the results mentioned throughout the work will be omitted as they all can be found in the references.

Partitions

INTRODUCTION

First, we design an auxiliary function to display lists of numbers as sums of powers

asSum[x_] := asSum[x, 1]

asSum[{a_}, 1] := ToString[a]
asSum[{a_}, p_Integer?Positive] := ToString[a]^p
asSum[{a_, b__}, p_] := 
      DisplayForm[
        RowBox[{asSum[{a}, p], "+", asSum[{b}, p]}]]

asSum[Range[5], 2]

Ferrers graphs are standard representations for partitions

Ferrers[s_] := 
      Module[{i, j, f = Reverse[s]}, 
t = 
          Table[Table[
              If[i ≤ f[[j]], 
                Disk[{i, j}, 0.3], {}], {i, Max[f]}], {j, 
              Length[f]}]; 
Graphics[{RGBColor[1, 0.1, 
              0.2], t, RGBColor[0, 0, 0], t  /.  Disk -> Circle}, 
          PlotRange ->  {{0, 1 + Length[s]}, {0, 1 + Length[s]}}, 
          AspectRatio -> Automatic, 
          DisplayFunction -> Identity]]

Show[Ferrers [{1, 2, 3, 4}], 
        DisplayFunction -> $DisplayFunction];

More generally, let H be a set of positive integers. The set of partitions of n into parts taken from a set H is computed as follows.

partH[_, 0] := {{}}
\(partH[H_, n_] := {}\  /; \ \(\(First[H]\)\(>\)\(n\)\(
\)\)\)
partH[H_, n_] := 
      Module[{h, p, ans}, 
ans = 
          Map[(h = #; 
p = 
                  partH[Select[H, # ≥ h &], 
                    n - h]; 
Map[Join[{h}, #] &, p]) &, 
            H]; 
Flatten[ans, 
          1] ]

partitions[n_] := partH[Range[n], n]
partitionsOdd[n_] := 
      partH[Range[1, n, 2], n]
partitionsDif[n_] := 
      DeleteCases[partitions[n], {___, x_, x_, ___}]

asSum  /@  partitions[5]  //  TableForm

Table[Length[partitions[n]], {n, 10}]

Show[GraphicsArray[Ferrers  /@  partitions[5]], 
        DisplayFunction -> $DisplayFunction, 
        GraphicsSpacing -> {1, 0}];

The generating function for the size of set partH is:

\(f[H_] := Times\  @@ \ \((\(\((1\/\(1 - x\^#\))\) &\) /@ H)\)\)

f[Range[11]] + O[x]^11

This is the fastest way of computing the number of partitions. If we use Length[partitions[200]], for instance, we most probably will produce an error.

Plot[
        Evaluate[Table[Normal[f[Range[n]] + O[x]^6], {n, 5}]], {x, -3, 
          3}];

asSum  /@  partitionsOdd[10] // TableForm

Table[Length[partitionsOdd[n]], {n, 20}]

f[Range[1, 11, 2]] + O[x]^11

asSum  /@  partitionsDif[10] // TableForm

Table[Length[partitionsDif[n]], {n, 20}]

Theorem. The number of partitions of n into unequal parts is equal to the number of its partitions into odd parts

DISTINCTIVE FAMILIES OF PARTITIONS

BINARY PARTITIONS.

Those are sums of powers of 2.

asSum  /@ partH[(2^Range)[0, 5], 10] // TableForm

p = partH[(2^Range)[0, 7], 25];
m = Max[Length  /@  p];
u = PadRight[#, m] &  /@  p;
ListDensityPlot[-Reverse[u],  Mesh  ->  False, 
        AspectRatio -> Automatic, 
        FrameTicks -> None];

Table[Length[partH[(2^Range)[0, 7], n]], {n, 20}]

f[(2^Range)[0, 7]] + O[x]^11

Let c[n] be the number of binary partitions of 2n.

c[0] := 1
c[n_] := c[n] = 
        c[n - 1] + c[⌊n/2⌋]

Table[c[n], {n, 10}]

SUMMANDS NOT MULTIPLE OF 3

asSum  /@ partH[Complement[Range[10], 3  Range[10]], 10] // 
      TableForm

p = 
        partH[Complement[Range[10], 3  Range[10]], 
          15];
m = Max[Length  /@  p];
u = PadRight[#, m] &  /@  p;
ListDensityPlot[-Reverse[u],  Mesh  ->  False, 
        AspectRatio -> Automatic, 
        FrameTicks -> None];

Table[
      Length[partH[Complement[Range[n], 3  Range[n]], n]], {n, 
        20}]

SELF-CONJUGATE PARTITIONS.

They correspond to partitions into odd and unequal parts

selfConjugate[n_] := 
      partitionsOdd[n] ⋂ partitionsUnEqual[n]

asSum  /@ selfConjugate[15]

Table[Length[selfConjugate[n]], {n, 20}]

Times  @@  (1 + (x^Range)[1, 20, 2]) +  O[x]^21

PARTITIONS WITH MINIMAL DIFFERENCE 2

partitionsMinDif2[n_] := 
      Select[partitionsDif[n], 
        Not[MemberQ[Rest[#] - Rest[RotateRight[#]], 1]] &]

asSum  /@ partitionsMinDif2[9] // TableForm

Table[Length[partitionsMinDif2[n]], {n, 20}]

Theorem. The number of partitions of n with minimal difference 2 is equal to the number of partitions of n into parts of the form 5m+1 and 5m+4

asSum  /@ 
        Select[partitions[
            9], (And  @@  (MemberQ[{1, 4}, 
                        Mod[#, 5]] &  /@  #)) &]  // 
      TableForm

\(Times\  @@ \ \((1/
            Map[\((1 - x\^#)\) &, 
              Join[Range[1, 20, 5], Range[4, 20, 5]]])\) + 
      O[x]\^20\)

Theorem. The number of partitions of n into parts no less than 2 and with minimal difference 2 is equal to the number of partitions of n into parts of the form 5m+2 and 5m+3

PARTITIONS IN WHICH NO SUMMAND APPEARS MORE THAN TWICE

atMostTwice[n_] := 
      DeleteCases[partitions[n], {___, x_, ___, x_, ___, x_, ___}]

asSum  /@ atMostTwice[8]

Table[Length[atMostTwice[n]], {n, 20}]

BOUNDED PARTITIONS

There are (({{n + r - 1}, {n}})) partitions of n of size at most r. The first (({{n + r - 2}, {n}})) start with 0. In general, there are (({{n + r - i - 2}, {n - i}})) partitions starting with i.

(Subscript[part, n_, 1]) := {{n}}
(Subscript[part, n_, r_]) := 
      Module[{ans = {}, 
          i}, 
Do[
AppendTo[
            ans, (Join[{i}, #] &) /@ (Subscript[part, n - i, r - 1])], {i, 0, 
            n}]; 
Flatten[ans, 1]]

asSum  /@  (Subscript[part, 5, 3])

To obtain the i-th partition

\(numPart[n_, r_] := Binomial[n + r - 1, n]
\)
(Subscript[ithPart, n_, r_])[i_] := "Out of Range"  /;  
        i > numPart[n, r]
(Subscript[ithPart, n_, 1])[1] := {n}
(Subscript[ithPart, n_, r_])[i_] := 
      Module[{j, k, t}, 
t = 
          Table[0, {n + 
                1}]; 
t[[1]] = 
          numPart[n, 
            r - 1]; 
Do[
t[[j + 1]] = 
            t[[j]] + 
              numPart[n - j, r - 1], {j, n}]; 
PrependTo[t, 
          0]; 
j = 1; 
While[ 
          t[[j]] < 
            i, j++]; 
Join[{j - 2}, 
          (Subscript[ithPart, n - j + 2, r - 1])[
            i - t[[j - 
                  1]]]]]

asSum  /@  Table[(Subscript[ithPart, 5, 3])[i], {i, numPart[5, 3]}]

For example, to find the millionth partition of 100 of size 6.

asSum[(Subscript[ithPart, 100, 6])[1000000]]

A random partition:

asSum[
      (Subscript[ithPart, Random[Integer, {500, 800}], Random[Integer, {5, 10}]])[
        Random[Integer, {(10^8), (10^10)}]]]

These random partitions are not really of the required size. We would like to disregard the 0 and consider the restricted partitions of n, that is, partitions of n into at most r parts each one being at most m.

restrictedPartitions[m_, r_, n_] := 
      Select[partH[Range[m], n], (Length[#] ≤ r) &]

asSum  /@  restrictedPartitions[5, 3, 5]

The number of partitions of n into at most 4 parts each one being at most 5 is

Table[Length[restrictedPartitions[5, 4, n]], {n, 25}]

In general, from the (mr+1)-th element on all of them are zero.

G[m_, 
        r_] := (((∏_(i = r + 1)^(r + m))(1 - (x^i)))/((∏_(i = 1)^m)(1 - (x^i))))

G[5, 4] + O[x]^26

In general, the number of partitions of n into two parts is equal to ⌊n/2⌋+1

Table[Length[restrictedPartitions[n, 2, n]], {n, 10}]

The number of partitions of n into three parts is equal to the nearest integer to (((n + 3))^2)/12.

Table[Length[restrictedPartitions[n, 3, n]], {n, 10}]

Table[Round[((((n + 3))^2)/12)], {n, 10}]

p = restrictedPartitions[15, 3, 15];
m = Max[Length  /@  p];
u = PadRight[#, m] &  /@  p;
ListDensityPlot[-Reverse[u],  Mesh  ->  False, 
        AspectRatio -> Automatic, 
        FrameTicks -> None];

EHRENFEST TECHNIQUES IN NUMBER THEORY

The motivation for this section was to illustrate the following result:

Let us first solve the following problem: Given a list of positive integers, how do you partition it into k parts with equal sums? Providing that the problem has a solution, we can assume that each part forms a non-decreasing sequence.

We apply a technique akin to the solution of the Ehrenfest urn problem. After constructing an approximately optimum starting configuration we proceed to interchange numbers from one partition to another facilitating the convergence to a stable configuration, which is the (non-unique) solution we seek. The choice of which urns are going to be the "sender" and the "recipient" in an interchange is based on their relative sizes. As this method is probabilistic, the time to reach convergence might be relatively large and for that reason, a safety net is provided as an optional parameter in function Ehrenfest; after our experience with urn problems though, we expect a fast convergence. The following output was timed on a 500-MHz pentium pc.

Ehrenfest[li_, k_, safetyNet_:  1000] := 
      Module[{s, t = Table[{}, {k}], i = 1, r, from, to, tot, 
          j = 1}, 
Map[(AppendTo[
                t[[i]], #];  
              i = 1 + Mod[i, k]) &, 
          Sort[li]]; 
s = Plus  @@  # &  /@  
            t; 
tot = 
          Plus  @@ s; 
While[(j < 
                safetyNet) && (Length[Union[s]] > 
                1), 
r = 
            Flatten[Table[
                Table[i, {s[[i]]}], {i, 
                  Length[s]}]]; 
While[(from = 
                r[[Random[
                    Integer, {1, Length[r]}]]]); 
            Length[t[[from]]] == 
              1,]; 
s = 
            tot - s; 
r = 
            Flatten[Table[
                Table[i, {s[[i]]}], {i, 
                  Length[s]}]]; 
While[(to = 
                  r[[Random[
                      Integer, {1, Length[r]}]]]) == 
              from,]; 
i = 
            Random[Integer, {1, 
                Length[t[[
                    from]]]}]; 
AppendTo[
            t[[to]], 
            t[[from, 
              i]]]; 
t = 
            Delete[t, {from, 
                i}]; 
s = Plus  @@  # &  /@  
              t; 
j++
]; 
If[j < safetyNet, Sort[Sort  /@  t], {}]]

Ehrenfest[{1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3}, 3] // Timing

Ehrenfest[{1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3}, 3] // Timing

Ehrenfest[{1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 6}, 4] // 
      Timing

Ehrenfest[{2, 2, 2, 3, 3, 3, 3}, 3] // Timing

The following illustrates the problem that motivated this section.

n = 3;
k = 3;
p = partH[Range[n], n! k];
asSum  /@  p //  TableForm
asSum  /@  (Ehrenfest[#, k]) &  /@  p // 
      TableForm

COMPOSITIONS

Compositions are partitions in which the order is important

compositions[0] := {{}}
\(compositions[n_] := \(compositions[n] = 
        Module[{i}, 
		Flatten[
            Table[\((Join[{i}, #1] &)\) /@ \ compositions[n - i], {i, n}], 
            1]]\)\)

asSum  /@  compositions[5]  //  TableForm

In general, the number of compositions of n with m parts is equal to (({{n - 1}, {m - 1}})). More generally, the number of compositions of n into exactly m parts each one at least k is equal to (({{n - (k - 1) m - 1}, {m - 1}})). For instance, there are (({{5 - 1}, {3 - 1}}))=6 compositions of 5 into three parts and (({{5 - (2 - 1) 2 - 1}, {2 - 1}}))=2 compositions of 5 into two parts each one at least equal to 2 as shown in the previous output. Also, there are (2^(n - 1)) unrestricted compositions of n.

Table[Length[compositions[n]], {n, 10}]

There is a one-to-one correspondence between subsets, binary numbers, positive integer numbers (their decimal equivalents) and compositions.

subSets[0] := {{}}
subSets[n_] := 
      Module[{s = subSets[n - 1]}, 
Join[s, 
          Map[Append[#, n] &, 
            s]]]

binary[n_, s_] := 
      Module[{bn = Table[0, {n}]}, 
bn[[
            s]] = 
          1; 
bn]

dec[{}] := 0
dec[{x___, 
          t_}] := 2 dec[{x}]+t

composit[u_] :=  
      Module[{v}, 
v = 
          Append[u, 
              0]  //.   {{a___, 1, 0, c___} -> {a, 2, "+", 
                  c}, 
{a___, 1, b_, "+", 
                  c___} -> {a, b + 1, "+", 
                  c}, 
{a___, 0, c___} -> {a, 
                  1, "+", c}}; 
StringJoin[
          ToString  /@  Drop[v, -1]]]

Map[{#, u = binary[4, #];  StringJoin[ToString  /@  u], dec[u], 
            composit[u]} &, subSets[4]]  //  MatrixForm

GOLDBACH'S CONJECTURE

Goldbach's conjecture claims that every odd number greater than 7 is equal to the sum of three primes. Euler modified it to: every even number greater than 3 is equal to the sum of two primes. The latter implies the former but not vice-versa.

Goldbach[n_] := 
      Module[{p, a}, 
p = 
          Select[Range[2, n], PrimeQ]; 
a = 
          First[Select[n - p, PrimeQ, 1]]; 
{n - a, 
          a}]

Table[{n, asSum[Goldbach[n]]}, {n, 4, 50, 2}] // TableForm

Sums of Squares

SUMS OF TWO SQUARES

If N is the sum of two unequal positive square numbers, then every power of N is the sum of two squares. For instance, if N=(n^2)+(m^2) then (N^2)=((((n^2)-(m^2)))^2)+(((2  mn))^2).

If N exceeds the sum of two unequal positive squares by k>0, then every power of N is the sum of k+2 positive squares.

Theorem (Fermat). Write the canonical factorization of n in the form

n=(2^α) (∏_(p ≡ 1 (mod 4)))(p^β) \(∏\+\(q\  ≡ 3\ \((mod\ 4)\)\)q\^γ\)

The n can be expressed as a sum of two squares of integers iff all exponents γ are even.

If p is an odd prime then p is representable as a sum of two squares if and only if p≡ 1 (mod 4). The set of positive integers which are sums of two squares is closed under multiplication.

sum2Squares[n_] := 
      Module[{f = FactorInteger[n]}, 
And  @@  
          EvenQ[Last  /@  
              Select[f, (Mod[First[#], 4] == 3) &]]]

Select[Range[100], sum2Squares]

sumTwoSquares[n_] := 
      Module[{t, i, j}, 
t = 
          Table[
j = (Sqrt[n - (i^2)]); 
If[
              IntegerQ[
                j], {{i, 
                  j}, {i, -j}}, {}], {i, ⌈-(Sqrt[n])⌉, ⌊(Sqrt[n])⌋}]; 
Union[
          Sort  /@  Partition[Flatten[t], 2]]]

Do[Print[n, "  ", asSum[#, 2] &  /@  sumTwoSquares[n]], {n, 
        10}]

Table[Length[sumTwoSquares[n]], {n, 35}]

One surprising technique using the Gaussian integer divisors of n is the following (Solution by Stan Wagon Macalester College - see MathSource item # 0207-616)

SumSquares[
        n_] := Union[Sort[{Re[#],  Im[#]}]  &  /@ 
          Select[Divisors[n,  GaussianIntegers -> True],  
            Abs[#]^2  ==  n  &]]

Do[Print[n, "  ", asSum[#, 2] &  /@  SumSquares[n]], {n, 
        10}]

ON THE NUMBER OF REPRESENTATIONS

If (Subscript[d, r,  m])(n) denotes the number of divisors d of n with d ≡ r (mod n), then 

(Jacobi, 1828). The number of representations of the number n ≥ 1 as the sum of two squares is

4( (Subscript[d, 1,  4])(n) - (Subscript[d, 3,  4])(n) )

(Subscript[d, r_, m_])[n_] := 
      Length[Select[Divisors[n], (Mod[#, m] == r) &]]

t = Table[4 ((Subscript[d, 1, 4])[n] - (Subscript[d, 3, 4])[n]), {n, 30}]

Note that negative squares are taken into account.

(lim_(n →  ∝ ))(1/n)(∑_(i = 0)^n) t [i] = π

Plus  @@  (t/30) // N

t represents the number of lattice points that lie on a circle centered at the origin an integral radius.(Gauss)

(Dirichlet, 1840) The number of representations of n ≥ 1 as the sum of a square and twice a square is

2( (Subscript[d, 1,  8])(n) + (Subscript[d, 3,  8])(n) - (Subscript[d, 5,  8])(n) - (Subscript[d, 7,  8])(n) )

n = 9;
\(\(u = 
        Map[{{#, \@\(n - 2  #\^2\)}, {#, \(-\@\(n - 2  #\^2\)\)}} &, 
          Select[Range[⌈\(-n\)\/2⌉, n\/2], 
            IntegerQ[\@\(n - 2  #\^2\)] &]];\)\)
asSum[#, 2] & /@  
      Map[{"2×" <> ToString[First[#]], Last[#]} &, 
        Union[Flatten[u, 1]]]

Table[
      2 ((Subscript[d, 1, 8])[n] + (Subscript[d, 3, 8])[n] - (Subscript[d, 5, 8])[n] - 
            (Subscript[d, 7, 8])[n]), {n, 20}]

(Lorenz,1829) The number of representations of n≥1 as the sum of a square and three times a square is

2( (Subscript[d, 1,  3])(n) - (Subscript[d, 2,  3])(n) ) + 4( (Subscript[d, 4,  12])(n) - (Subscript[d, 8,  12])(n) )

n = 12;
\(\(u = 
        Map[{{#, \@\(n - 3  #\^2\)}, {#, \(-\@\(n - 3  #\^2\)\)}} &, 
          Select[Range[⌈\(-n\)\/3⌉, n\/3], 
            IntegerQ[\@\(n - 3  #\^2\)] &]];\)\)
asSum[#, 2] & /@  
      Map[{"3×" <> ToString[First[#]], Last[#]} &, 
        Union[Flatten[u, 1]]]

Table[
      2 ((Subscript[d, 1, 3])[n] - (Subscript[d, 2, 3])[n]) + 
        4 ((Subscript[d, 4, 12])[n] - (Subscript[d, 8, 12])[n]), {n, 20}]

SUMS OF THREE SQUARES

An integer is a sum of 3 squares if it is not of the form (4^n)(8m+7), n, m ≥ 0. We include 0 among the powers.

sumThreeSquares[n_] := 
      Module[{t, i, j, k}, 
t = 
          Table[
k = (Sqrt[n - (i^2) - (j^2)]); 
If[
              IntegerQ[k], {i, j, 
                k}, {}], {i, ⌈-(Sqrt[n])⌉, ⌊(Sqrt[n])⌋}, {j, ⌈-(Sqrt[n - (i^2)])⌉, ⌊(Sqrt[n - (i^2)])⌋}]; 
Union[Sort  /@  Partition[Flatten[t], 3]]]

Do[Print[n, "  ", asSum[#, 2] &  /@  sumThreeSquares[n]], {n, 
        10}]

Table[Length[sumThreeSquares[n]], {n, 35}]

The positions of the zeroes are:

Select[
      Range[50], (n = #;  While[IntegerQ[n/4], n = n/4];  
          Mod[n, 8] == 7) &]

SUMS OF FOUR SQUARES

(Jacobi,1829) Every positive integer can be represented as a sum of four squares. The number of these representations of n≥1 is:

8 (∑_(d ))d

where the sum is taken over all divisors of n that are not multiples of 4.

sumFourSquares[n_] := 
      Module[{t, i, j, k, l}, 
t = 
          Table[
l = (Sqrt[n - (i^2) - (j^2) - (k^2)]); 
If[
              IntegerQ[
                l], {{i, j, k, l}, {i, j, 
                  k, -l}}, {}], {i, ⌈-(Sqrt[n])⌉, ⌊(Sqrt[n])⌋}, {j, ⌈-(Sqrt[n - (i^2)])⌉, ⌊(Sqrt[n - (i^2)])⌋}, {k, ⌈-(Sqrt[n - (i^2) - (j^2)])⌉, ⌊(Sqrt[n - (i^2) - (j^2)])⌋}]; 
Union[
          Partition[Flatten[t], 4]]]

Do[Print[i, "  ", asSum[#, 2] &  /@  sumFourSquares[i]], {i, 
        2}]

Table[Length[sumFourSquares[n]], {n, 10}]

ListPlot[Table[Length[sumFourSquares[n]]/8, {n, 100}]];

8 Table[
        Plus  @@  Select[Divisors[n], (Mod[#, 4] ≠ 0) &], {n, 
          10}]

(((1 + 2  Plus @@ (x^(Range[10]^2))))^4) + O[x]^11

Every positive integer, with the twelve exceptions below, is a sum of five positive squares.

sumFiveSquares[n_] := 
      Module[{ans = False, i, j, k, l, 
          m}, 
Do[
m = (Sqrt[n - (i^2) - (j^2) - (k^2) - (l^2)]); 
If[IntegerQ[m] && (m > 0), 
            Return[ans = True]], {i, ⌊(Sqrt[n])⌋}, {j, 
            i, ⌊(Sqrt[n - (i^2)])⌋}, {k, 
            j, ⌊(Sqrt[n - (i^2) - (j^2)])⌋}, {l, 
            k, ⌊(Sqrt[n - (i^2) - (j^2) - (k^2)])⌋}]; 
ans]

Select[Range[1000], Not[sumFiveSquares[#]] &] // Timing

The same finite condition applies also to sums of six squares.

SUMS OF MANY SQUARES

powersSum[0, i_] := {{}}

powersSum[n_, i_] := 
      Module[{j, k}, 
k = 
          Map[(j = #; 
Map[Join[{j}, #] &, 
                  powersSum[n - (j^i), i]]) &, 
            Range[(n^(1/i))]]; 
Union[
          Sort  /@  Flatten[k, 1]]]

Do[Print[n, "  ", asSum[#, 2] &  /@  powersSum[n, 2]], {n, 
        10}]

Sums of Powers

SUMS OF CUBES

Do[Print[n, "  ", asSum[#, 3] &  /@  powersSum[n, 3]], {n, 
        10}]

There are only five positive integers equal to the sum of the cubes of their digits

Do[
        If[Plus  @@ IntegerDigits[i]^3 == i, Print[i]], {i, 
          10000}];

SUMS OF UNEQUAL POWERS.

Those sums include powers with the same exponent and unequal base

unEqualPowersSum[n_, k_] := 
      Select[powersSum[n, 
          k], (Length[Union[#]] == Length[#]) &]

Do[Print[
        n, "  ", asSum[#, 2] &  /@  unEqualPowersSum[n, 2]], {n, 
        10}]

Every integer larger than 128 is a sum of unequal squares.

m = Table[0, {40}];
(Map[(m[[#]] = 
                Length[unEqualPowersSum[#, 2]]) &, 
          Select[Range[40], sum2Squares]]; 
m) // 
      Timing

Can you spot the one coming from the Phytagorean triangle (3, 4, 5) in the previous answer?

Do[Print[
        n, "  ", asSum[#, 3] &  /@  unEqualPowersSum[n, 3]], {n, 
        10}]

FERMAT'S EQUATION

Let n>2 be a fixed integer. Consider the series

\(f \((x)\)\  = \ \(\(x\^n + x\^\(n\^2\) + x\^\(n\^3\) +  ... \)
[f \((x)\)]\^2 = \(c\_1\) x + \(c\_2\) x\^2 + \(c\_3\) 
              x\^3 +  ... \)\)

The number of integer solutions to Fermat's equation

(x^n) + (y^n) = (z^n)

is equal to (Subscript[c, k]), where k = (z^n)
For instance, in finding the number of integer solutions of the equation (x^3) + (y^3) = (z^3),

F = (((Plus  @@ (x^((3^Range)[15]))))^2) + 
        O[x]^500000

we realize that (z^3) has to be a member of the list

Exponent[Normal[F], x, List]

that is, z has to be

\(Select[%, IntegerQ[\@#\%3] &]\)

which comes as no surprise as proved by Andrew Wiles.

Sums of Different Powers

In order to avoid trivial solutions, we agreed in including only powers above 2, only integers >2 as bases, except for the summand (1^1), if needed.

diffPowerSum[
        n_] := diffPowerSum[{}, {}, n]⋃Map[
          Join[{{1, 1}}, #] &, 
          diffPowerSum[{}, {}, 
            n - 1]]

diffPowerSum[_, _, 0] := {{}}
diffPowerSum[bas_, ex_, n_] := 
      Module[{ans = {}, b, e, 
          p}, 
Do[
If[
            Not[MemberQ[bas, b]] && 
              Not[MemberQ[ex, e]] && ((b^e) ≤ 
                  n), 
p = 
              diffPowerSum[Join[bas, {b}], Join[ex, {e}], 
                n - (b^e)]; 
AppendTo[ans, 
              Map[Join[{{b, e}}, #] &, p]]]
, {b, 2, 
            n}, {e, 2, n}]; 
ans = 
          Flatten[ans, 1]; 
ans = 
          DeleteCases[ans, {}]; 
Union[
          Sort  /@  (Partition[Flatten[#], 2] & /@ 
                ans)]]

showS[{{a_, k_}}] := ToString[a]^k
showS[{{a_, k_}, b__}] := 
      DisplayForm[RowBox[{showS[{{a, k}}], "+", showS[{b}]}]]

Note that the bases are computed in increasing order.

Do[
d = diffPowerSum[n]; 
If[
        d ≠ {}, Print[n, "\t", showS  /@ d]], {n, 
        50}]

t = Table[Length[diffPowerSum[n]], {n, 50}]

Sums of Differences of Squares.

diffOfSquares[n_] := 
      Module[{a = {}, u, v, 
          s = Select[
              Divisors[
                n], # > (Sqrt[n]) &]}, 
Map[
If[
              Mod[u = # + n/#, 2] == 0  &&  Mod[v = # - n/#, 2] == 0, 
              u = u/2;  
              v = v/2; 
AppendTo[
                a, {#, (u^"2") - (v^"2")}]] &, 
          s]; 
Last  /@  a]

Those congruent to 2 mod 4 cannot be so expressed

r = Select[Range[1, 50], Mod[#, 4] ≠ 2 &]

Map[Print[#, "   ", diffOfSquares[#]] &, r];

Table[Length[diffOfSquares[n]], {n, 100}]

If n exceeds the sum of two unequal positive squares by k>0, then every power of n is the sum of k+2 positive squares.In other words, every power of 6 is the sum of three squares, every power of 7 is the sum of four squares, every power of 8 is the sum of five squares, etc.

A Problem Involving Sums

THE PROBLEM

A customer at a 7-11 store selected four items to buy, and was told that the cost was $7.11.  He was curious that the cost was the same as the store name, so he inquired as to how the figure was derived.
The clerk said that he had simply multiplied the prices of the four individual  items. The customer  protested  that  the four  prices should have been ADDED,  not MULTIPLIED. The  clerk said that that was OK with him, but, the result was still the same: exactly $7.11. What were the costs involved?

u = (7.11^(1/4));  
Do[
l = 
            7.11 - i - j - 
              k; 
If[(l > 0)  &&  (i j k l == 
                  7.11),  Print[{i, j, k, l}]], {i, 0.01, u, 0.01}, {j, i, 
            u, 0.01}, {k, j, u, 0.01}];  //  Timing

So, the items were 1.2, 1.25, 1.5 and 3.16 worth.
However, in order to generalize we need to dwelve into factorizing a number.

FACTORING A NUMBER INTO UNORDERED PRODUCTS

To obtain all possible lists of r elements multiplying up to n.

\(products[n_, r_] := products[n, r, 1]
		\)
products[n_, r_, from_] := {}  /;  (from^r) > n
products[n_, r_, 
        from_] := {Table[from, {r}]}  /;   (from^r) == n
products[n_, 1, from_] := {{n}} 
\(products[n_, r_, from_] := 
      Module[{a, p, 
          ans = {}}, 
Do[
If[
            Mod[n, a] == 0, 
p = 
              products[n/a, r - 1, a]; 
If[p != {}, 
              AppendTo[ans, Map[Join[{a}, #] &, p]]]], {a, 
            from, \@n\%r}]; 
Flatten[ans, 
          1]]		\)

products[12, 5]

To obtain all possible lists of r elements multiplying up to n and adding up to s.

\(prodSum[p_, s_, r_] := prodSum[p, s, r, 1]
		\)
prodSum[p_, s_, r_, 
        from_] := {}  /;  ((from^r) > 
              p)  ||  (p > ((((s/r)))^r))
prodSum[p_, s_, r_, 
        from_] := {Table[
            from, {r}]}  /;   ((from^r) == p)  &&  (r from == 
              s)
\(prodSum[p_, _, r_, 
        from_] := {}\  /; \ \ \(\(from\^r\)\(==\)\(p\)\(	\)\)\)
prodSum[p_, p_, 1, from_] := {{p}} 
prodSum[_, _, 1, _] := {} 
\(prodSum[p_, s_, r_, from_] := 
      Module[{a, q, 
          ans = {}}, 
Do[
If[
            Mod[p, a] == 0, 
q = 
              prodSum[p/a, s - a, r - 1, a]; 
If[q != {}, 
              AppendTo[ans, Map[Join[{a}, #] &, q]]]], {a, 
            from, \@p\%r}]; 
Flatten[ans, 
          1]]		\)

prodSum[12, 10, 5]

Regarding our problem:

prodSum[711000000, 711, 4]  //  Timing

Given a product of r numbers, what are their possible sums ?

t = 
        Table[Table[Length[prodSum[p, s, r]], {p, 25}, {s, 25}], {r, 
            25}];
t[[5]] // MatrixForm

Reading the 12th row above we learn that the possible size-5 sums for 12 are 9, 10 ,11 and 16.

Plus  @@  t // MatrixForm

There is a 4 at the 16th row and 10th column. Hence, there are 4 ways of finding  numbers adding to 10 and multiplying to 16, namely:

prodSum[16, 10, 2]
prodSum[16, 10, 4]
prodSum[16, 10, 5]
prodSum[16, 10, 6]

Note also that, if the product p is prime, the above matrix correctly asserts that there is only one solution of the equation s = p + r - 1 for r>0 and no solution for any other value of s.

For what other amounts are there unique solutions involving four items?

t = Table[{n, prodSum[n 1000000, n, 4]}, {n, 800}];
q = Select[t, (Last[#] ≠ {}) &];
Select[q, (Length[Last[#]] == 1) &]

References

A Pathway into Number Theory 
R.P. Burn 
Cambridge University Press

An Introduction to the Theory of Numbers
I. Niven, H.S. Zuckerman, H.L. Montgomery
John Wiley & Sons

An Introduction to the Theory of Numbers
G.H. Hardy
Oxford Science Publications

Elementary Number Theory
J. Roberts
The MIT Press

The Theory of Partitions
G. E. Andrews
Cambridge Mathematical Library

Eric Weisstein's World of Mathematics
http://mathworld.wolfram.com/

Partial Fractions and Four Classical Theorems of Number Theory
M.D. Hirschhorn
American Mathematical Monthly 107,3, March 2000, pp. 260-264

Handbook of Number Theory
D.S. Mitrinovic, J. Sandor, B. Crstici
Kluwer Academic Publishers, 1996

A Combinatorial Approach to Sums of Integer Powers
G. Mackiw
Mathematics Magazine 73, 1, February 2000

The Impossible Problem
L. Sallows
The Mathematical Intelligencer 17, 1, 1995 pp. 27-33