Sum of Squares Function

Author

Eric W. Weisstein
August 30, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/NumberTheory/SumofSquaresFunction.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/SumofSquaresFunction.html.

©2008 Wolfram Research, Inc. except for portions noted otherwise

Code

SquaresRepresentations2[d_,n_]:=Module[{x,a},
(a=Array[x,d])/.{ToRules[Reduce[a.a==n,a,Integers]]}
]

Distinct[l_List]:=(Max[l]<2);

MySumOfSquaresB[n_]:=Module[
{b,p,q,primes,powers},
{primes,powers}=Transpose[FactorInteger[n]];
mod1=Flatten[Position[primes,_?(Mod[#,4]==1&)]];
mod3=Flatten[Position[primes,_?(Mod[#,4]==3&)]];
Times@@(1+#&/@powers[[mod1]])
]

MySquaresRUnordered[2,n_Integer?NonNegative]:=Module[
{b,p,q,primes,powers},
{primes,powers}=Transpose[FactorInteger[n]];
mod1=Flatten[Position[primes,_?(Mod[#,4]==1&)]];
mod3=Flatten[Position[primes,_?(Mod[#,4]==3&)]];
If[Or@@(OddQ/@powers[[mod3]]),
0,
(*Else*)
b=Times@@(1+#&/@powers[[mod1]]);
If[EvenQ[b],b,b+1]/2
]
]

MySquaresR[2,0]:=1
MySquaresR[2,1]:=4
MySquaresR[2,n_Integer?NonNegative]:=Module[
{b,p,q,primes,powers},
{primes,powers}=Transpose[FactorInteger[n]];
mod1=Flatten[Position[primes,_?(Mod[#,4]==1&)]];
mod3=Flatten[Position[primes,_?(Mod[#,4]==3&)]];
If[Or@@(OddQ/@powers[[mod3]]),
0,
4Times@@(1+#&/@powers[[mod1]])
]
]

Ordered vs. Unordered

SquaresRepresentations[2,5]

OrderedSquaresRepresentations[2,5]

PowersRepresentations[5,2,2]

Sums

(∑_(n=0)^∞)(((SquaresR[2, n]) exp(-2 π (Sqrt[b (a+n)])))/(Sqrt[a+n]))==(∑_(n=0)^∞)(((SquaresR[2, n]) exp(-2 π (Sqrt[a (b+n)])))/(Sqrt[n-b]))

Sum[((SquaresR[2,n])/(Sqrt[n+a]))Exp[-2π(Sqrt[(n+a)b])],{n,0,∞}]

Sum[((SquaresR[2,n])/(Sqrt[n-b]))Exp[-2π(Sqrt[(n+b)a])],{n,0,∞}]

(Subscript[r, 2])(n)

Sum[SquaresR[2,n],{n,∞}]

Sum[SquaresR[2,n],{n,0,∞}]

Sum[SquaresR[2,n](x^n),{n,15}]

4 (∑_n^∞)(((((-1))^(n+1)) (x^(2 n-1)))/(1-(x^(2 n-1))))==(∑_(n=0)^∞)(SquaresR[2, n]) (x^n)==((EllipticTheta[3, 0, q])^2)==(((((QPochhammer2[(q^2), (q^2)])))^10)/(((((QPochhammer2[q, q])))^4) ((((QPochhammer2[(q^4), (q^4)])))^4)))

4Sum[(((((-1))^(n+1))(x^(2n-1)))/(1-(x^(2n-1)))),{n,∞}]//Timing

Series[1+4Sum[(((((-1))^(n+1))(x^(2n-1)))/(1-(x^(2n-1)))),{n,100}],{x,0,15}]

Sum[SquaresR[2,n](x^n),{n,0,10}]

Sum[SquaresR[2,n](x^n),{n,0,∞}]

4Sum[((((-1))^(n+1))/((x^(-2n+1))-1)),{n,∞}]//Timing

DedekindEtaQ[q_]:=(q^(1/24)) QPochhammer[q,q]

Simplify[(((DedekindEtaQ[(q^2)])^10)/(((DedekindEtaQ[q]DedekindEtaQ[(q^4)]))^4)),q>0]

Series[(((QPochhammer[(q^2),(q^2)])^10)/(((QPochhammer[q,q])^4) ((QPochhammer[(q^4),(q^4)])^4))),{q,0,20}]//Normal

Sum[SquaresR[2,n](q^n),{n,0,20}]

Sum[SquaresR[2,n](q^n),{n,0,∞}]//InputForm

Series[((EllipticTheta[3,0,q])^2),{q,0,20}]//Normal

SeriesCoefficient[((EllipticTheta[3,0,q])^2),{q,0,n}]

GeneratingFunction[SquaresR[2,n],n,q]

GeneratingFunction[SquaresR[2,n],n,q]

Table[SquaresR[2,n],{n,0,20}]

Table[MySquaresR[2,n],{n,0,20}]

Table[Count[Flatten[Outer[List,Sequence@@Table[Range[-4,4],{2}]],1],_?(Plus@@(#^2)==n&)],{n,0,20}]

Table[4Plus@@(Sin[Pi #/2]&/@Divisors[n]),{n,0,20}]

CoefficientList[Series[EllipticTheta[4,0,q]^2,{q,0,20}],q]

CoefficientList[Series[EllipticTheta[3,0,q]^2,{q,0,20}],q]

(Subscript[r, 2])(4)

SquaresR[2,4]

SquaresRepresentations[2,4]

MySquaresRUnordered[2,4]

Select[Flatten[Outer[List,Sequence@@Table[Range[-2,2],{2}]],1],Plus@@(#^2)==4&]

(Subscript[r, 2])(5)

SquaresR[2,5]

SquaresRepresentations[2,5]

MySquaresRUnordered[2,5]

Select[Flatten[Outer[List,Sequence@@Table[Range[-2,2],{2}]],1],Plus@@(#^2)==5&]

(Subscript[r, 2])(d)

Union[Table[Subtract@@{MySquaresRUnordered[2,n],Length[SquaresRepresentations[2,n]]},{n,2,500}]]

Union[Table[Subtract@@{MySquaresR[2,n],SquaresR[2,n]},{n,2,500}]]

(Subscript[r, 3])

Table[Count[Flatten[Outer[List,Sequence@@Table[Range[-4,4],{3}]],2],_?(Plus@@(#^2)==n&)],{n,20}]

Select[Flatten[Outer[List,Sequence@@Table[Range[-2,2],{3}]],2],Plus@@(#^2)==4&]

Table[SquaresR[3,n],{n,0,20}]

Sum[SquaresR[3,n](q^n),{n,0,∞}]//InputForm

Sum[SquaresR[3,n](x^n),{n,0,10}]

GeneratingFunction[SquaresR[3,n],n,q]

CoefficientList[Series[((EllipticTheta[3,0,q])^3),{q,0,15}],q]

SeriesCoefficient[((EllipticTheta[3,0,q])^3),{q,0,n}]

(Subscript[r, 4])

Table[SquaresR[4,n],{n,0,20}]

CoefficientList[Series[((EllipticTheta[3,0,q])^4),{q,0,20}],q]

Table[Count[Flatten[Outer[List,Sequence@@Table[Range[-4,4],{4}]],3],_?(Plus@@(#^2)==n&)],{n,20}]

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

With[{n=4},Select[Flatten[Outer[List,Sequence@@Table[Range[-4,4],{4}]],3],(Plus@@(#^2)==4&)]]

Length[%]

Table[SquaresR[4,n],{n,0,20}]

Sum[SquaresR[4,n](q^n),{n,0,∞}]//InputForm

Sum[SquaresR[4,n](x^n),{n,0,10}]

Table[GeneratingFunction[SquaresR[k,n],n,q]==((EllipticTheta[3,0,q])^k),{k,2,10}]

GeneratingFunction[SquaresR[k,n],n,q]

CoefficientList[Series[((EllipticTheta[3,0,q])^4),{q,0,15}],q]

SeriesCoefficient[((EllipticTheta[3,0,q])^3),{q,0,n}]

(Subscript[r, 4]) (16)

Note that zeros are included in count

SquaresR[4,16]

Select[Flatten[Outer[List,Sequence@@Table[{-4,-2,0,2,4},{4}]],3],Plus@@(#^2)==16&]

Length[%]

But not in the Mathematica enumeration

?SquaresRepresentations

SquaresRepresentations[4,16]

(Subscript[r, 6])

Table[SquaresR[6,n],{n,20}]

χ[d_]:=Switch[Mod[d,4],
1,1,
3,-1,
_,0]

Table[Plus@@(Function[d,16χ[n/d]d^2-4χ[d]d^2]/@Divisors[n]),{n,20}]

(Subscript[r, 8])

Table[SquaresR[8,n],{n,20}]

Table[16 Plus@@(Function[d,(((-1))^(n+d))(d^3)]/@Divisors[n]),{n,20}]

(Subscript[r, 10])

E4[n_]:=Plus@@(Function[d,(-1)^((d-1)/2)d^4]/@Select[Divisors[n],OddQ])
E4p[n_]:=Plus@@(Function[d,(-1)^((n/d-1)/2)d^4]/@Select[Divisors[n],OddQ])
χ4[n_]:=

(Subscript[r, 16])

Table[SquaresR[16,n],{n,20}]

σT[r_,n_]:=Plus@@Function[d,(-1)^(d+n/d)*d^r]/@Divisors[n]

Table[(-(32/3))*(-1)^n*(σT[1,n]+σT[3,n]+σT[5,n])+(-1)^n*(256/3)*Sum[σT[1,k]*σT[5,n-k]-σT[3,k]*σT[3,n-k],{k,n-1}],{n,20}]

(Subscript[r, 24])

Table[SquaresR[24,n],{n,20}]

σD[r_,n_]:=Plus@@Function[d,(-1)^d*d^r]/@Divisors[n]

Table[(16/9)*(-1)^n*(17*σD[3,n]+8*σD[5,n]+2*σD[7,n])+(-1)^n*(512/9)*Plus@@Table[σD[3,k]*σD[7,n-k]-σD[5,k]*σD[5,n-k],{k,n-1}],{n,20}]

Numbers of ways to represent n in terms of  num positive squares

SquareSums[124]

SquareSums/@{10,50,100,150}

SquareSums[200]

SQUARES=OpenWrite["Phosphine:Math Lists:Squares100.out"];

Table[Sort[Apply[Plus,GreedyAll[PowersList[n,2],n],1]],{n,20}]

Write[SQUARES,Table[GreedyAll[PowersList[n,2],n],{n,100}]];

Close[SQUARES];

vectors=Read[OpenRead["Phosphine:Math Lists:Squares100.out"]];

s10=Take[s,10]

squares=Table[Apply[Plus,s[[i]],1],{i,15}]

Require Six Distinct Squares

Select[GreedyAll[PowersList[124,2],124],Distinct[#]&]//Timing

Select[GreedyAll[PowersList[124,2],124],Distinct[#]&]

Select[GreedyAll[PowersList[188,2],188],Distinct[#]&]

PowersList[188,2]

%22.PowersList[188,2]

Representable by a Sum of Five Distinct Squares

Position[Apply[Or,Table[Distinct/@s[[i]],{i,Length[s]}],2],True]//Flatten

l={55,88,103,132,172,176,192,240,268,288,304,368,384,432,448,496,512,752};
sq5=Select[Sort[Join@@Table[4^k l,{k,0,6}]],#<10^5&]

Length[%]

Representable by a Sum of Distinct Squares

Position[Apply[Or,Table[Distinct/@s[[i]],{i,Length[s]}],2],True]//Flatten

Representable by a Sum of Squares

Sum of Squares using Reduce

Reduce[100==x1^2+x2^2+x3^2&&Element[x1|x2|x3,Integers],{x1,x2,x3}]

Reduce[100==x1^2+x2^2+x3^2&&Element[x1|x2|x3,Integers]&&x1≥0&&x2≥0&&x3≥0&&x1≤x2≤x3,{x1,x2,x3}]

Reduce[5==x1^2+x2^2&&Element[x1|x2,Integers],{x1,x2}]

Length[%]

Sum of Squares using SquaresRepresentations

<<NumberTheory`NumberTheoryFunctions`

$Version

SquaresRepresentations[3,100]

Transpose[Table[SquareSums[n],{n,10}]]

?PowersNWays

w=Take[squares,20]

Do[Print[k,". ",Table[Position[Table[Count[squares[[i]],k],{i,100}],j]//Flatten,{j,10}]],
	{k,10}]

Position[squares[[20]],5]//Flatten

s21=Table[PowersNWays[i,2,1],{i,100}]

Table[Position[s21,i]//Flatten,{i,2}]

s22=Table[SumOfNPowerWays[i,2,2],{i,200}]

Table[Position[s22,i]//Flatten,{i,3}]

s23=Table[SumOfNPowerWays[i,2,3],{i,200}]

Table[Position[s23,i]//Flatten,{i,6}]

s24=Table[SumOfNPowerWays[i,2,4],{i,200}]

s24=Append[s24,Table[SumOfNPowerWays[i,2,4],{i,251,400}]]//Flatten

Length[s24]

Table[Position[s24,i]//Flatten,{i,20}]

s25=Table[SumOfNPowerWays[i,2,5],{i,200}]

Table[Position[s25,i]//Flatten,{i,15}]

(Not) Representable by a Sum of Three Squares

<<NumberTheory`

Expand[3(8n+2)+1]

{#,SquaresR[3,#]}&/@Table[7+8n,{n,10}]

{#,SquaresR[3,#]}&/@Table[7+24n,{n,10}]

Expand[{3(8n+2)+1,3(32n+9)+1}]

{#,SquaresR[3,#]}&/@Table[28+96n,{n,10}]

{#,SquaresR[3,#]}&/@Table[7+32n,{n,10}]

SquaresR[3,#]&/@(15 4^Range[0,4])

3#+1&/@{37,149}

{#,SquaresR[3,#]}&/@(112 4^Range[0,5])

Table[8m+7,{m,5}]

SquaresR[3,#]&/@%

Diophantus, Fermat, and Legendre

Diophantus stated that for three squares to exist such that their sum is n=3a+1, a must not be of the form 8l+2.  This is equivalent to the statement that n not be of the form 3(8l+2)+1== 24l+7.  Bachet stated this is not sufficient and said a must not be of the form 8k+2 or 32k+9, i.e., n not of the form 24k+7 or 96k+28.  Fermat noted that n must not be of the form (8m+7)(4^n)