Square Number

Author

Eric W. Weisstein
April 19, 2024

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/SquareNumber.nb.

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

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

Figure

dots[n_,m_]:={maindots[n,m],subdots[n,m]}
polygon[n_,m_]:=Module[{i},Line[Table[vertex[n,i,m],{i,0,n}]]]
vertex[n_,i_,m_]:=m Csc[Pi/2]/2 {Cos[2Pi i/n]-1,Sin[2Pi i/n]}
maindots[n_,m_]:=Table[vertex[n,i,m],{i,n-1}]
subdots[n_,m_]:=Module[{i,j},Flatten[Table[vertex[n,i,m]-j/m(vertex[n,i,m]-vertex[n,i-1,m]),{j,m-1},{i,2,n-1}],1]]

PolygonalDiagram[n_,m_,opts___]:=Module[{i,colorfunction=Lookup[{opts},ColorFunction,Hue[#/10]&],vertexlabels=Lookup[{opts},VertexLabels,True]},{Table[polygon[n,i],{i,0,m-1}],PointSize[.1],Table[{colorfunction[i],Point[Flatten[dots[n,i],1]]},{i,0,m-1}],If[vertexlabels,MapIndexed[Text[#2[[1]],#1]&,Union[Sequence@@Table[Flatten[dots[n,i],1],{i,0,m-1}]]]]}]

GraphicsRow[With[{n=4},Graphics/@Table[PolygonalDiagram[n,m],{m,5}]]]

GraphicsRow[With[{n=4},Graphics/@Table[PolygonalDiagram[n,m,ColorFunction->(Red&),VertexLabels->False],{m,5}]]]

Binary

BinaryPlot[f_,{n_,n0_,nmax_}]:=Module[{data=Table[IntegerDigits[Function[n,f][k],2],{k,n0,nmax}],len},
len=Max[Length/@data];
ArrayPlot[Transpose[PadLeft[#,len,0]&/@data],Frame->False]
]

GraphicsColumn[{BinaryPlot[n^2,{n,1,255}],BinaryPlot[n^2,{n,256,256+2 255}]},ImageSize->Large]

Generating Functions: square

Squares

gf=FullSimplify[PowerSum[n^2,{x,n}]]

Series[gf,{x,0,5}]

Nonsquares

Sum[(n+Floor[1/2+Sqrt[n]])x^n,{n,∞}]//FullSimplify

GeneratingFunction[(n+Floor[1/2+Sqrt[n]]),n,z]//FullSimplify

ExponentialGeneratingFunction

Sum[(n+Floor[1/2+Sqrt[n]])((x^n)/(n!)),{n,0,∞}]//FullSimplify

DirichletGeneratingFunction

Sum[(((n+Floor[1/2+Sqrt[n]]))/(n^s)),{n,∞}]//FullSimplify

Lambert Series

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

Ending digits

Expand[(100a+10b+c)^2-(100(100a^2+20a b+b^2+2a c)+(20 b c+c^2))
]

Union[Flatten[Table[Mod[Expand[(100b+10c+d)^2],100],{b,0,9},{c,0,9},{d,0,9}]]]

Union[Flatten[Table[Mod[Expand[(1000a+100b+10c+d)^2],1000],{a,0,9},{b,0,9},{c,0,9},{d,0,9}]]]

Union[Flatten[Table[Mod[Expand[(10000e+1000a+100b+10c+d)^2],10000],{a,0,9},{b,0,9},{c,0,9},{d,0,9},{e,0,9}]]]

FormatSequence[Table[SquareDigits[i],{i,0,55}],46030,0,
	Name->"Digits are squares"
]

Transpose[Table[SquareSums[i],{i,20}]]

Numbers which cannot be represented by distinct squares

Position[Table[DistinctPowersQ[i,2],{i,150}],False]//Flatten

Minimum number of Squares needed to represent a number

s=Transpose[Table[PowerSums[i,2],{i,200}]][[1]];

Table[Position[s,i]//Flatten,{i,5}]

%//TableForm

Initialization

<<IntegerSequences`;
<<EISFormat`;

Numbers whose squares contain exactly 2 distinct digits

Select[Range[100],Length[Union[IntegerDigits[#^2]]]==2&]

Cube square identity

Show[GraphicsArray[
		Table[
	Show[CubeSquare[n],AspectRatio->Automatic,DisplayFunction->Identity],
			{n,2,6}]]]

Ending digits

Last Digit

Table[b^2,{b,0,9}]

Last/@IntegerDigits/@%

Union[%]

Last 2 Digits

TableForm[Table[c(20b+c),{b,0,9},{c,0,9}],TableAlignments->Right]

20b c+c^2

Expand[20(b+5)c+c^2]

TableForm[Table[FromDigits[Take[Join[{0},IntegerDigits[c(20b+c)]],-2]],{b,0,4},{c,9}],TableAlignments->Right]

Union[Flatten[Table[FromDigits[Take[Join[{0},IntegerDigits[c(20b+c)]],-2]],{b,5},{c,9}]]]

Length[%]+1

Numbers Expressible as the Sum of Two Squares

Position[SumOfSquaresQ/@Range[100],True]//Flatten

Primes Expressible as the Sum of two Squares

?PowersList

p=Select[Table[Prime[n],{n,30}],Mod[#,4]≠3&]

sq=Select[GreedyAll[PowersList[#,2],#],Plus@@#==2&]&/@p

i=((Flatten[Position[#[[1]],1]])&/@sq) /. {}->{1,1}

Plus@@@(i^2)

Transpose[i]

Square number figures

Square triangle

Expand[1/2 (n-1)n+1/2 n(n+1)]

A[n_]:=a^2 n/2 Sqrt[3]/2 n

A[n]/A[1]

TriangleCell[x_]:=(x+#)&/@{{0,0},{1,0},{1,Sqrt[3]}/2}

SquareTriangleDiagram[n_,opts___]:=Module[{v=Table[{i-j/2,-j Sqrt[3]/2},{j,n+1},{i,j}],triangles},
triangles=TriangleCell/@Flatten[v[[All,;;-2]],1];
v=Flatten[v,1];
MeshRegion[v,Polygon[triangles]/.Thread[v->Range[Binomial[n+2,2]]],opts]
]

GraphicsRow[Table[SquareTriangleDiagram[n,MeshCellStyle->{1->None,2->Black}],{n,5}]]

Area/@Table[SquareTriangleDiagram[n],{n,10}]2/(Sqrt[3]/2)

Square gnomon

SquareGnomon[n_,opts___]:=Module[{i,j,r=.4},
Graphics[{
Table[Circle[{i,j},r],{i,2,n},{j,n-1}],
Circle[{1,n},r],
Table[{Disk[{i,n},r],Disk[{1,i-1},r]},{i,2,n}]
},opts]
]

GraphicsRow[Table[SquareGnomon[n,PlotRange->{0,6}],{n,5}],Spacings->50]

Triangle Square Identity

Show[GraphicsArray[Table[Show[SquareTriangle8[n],AspectRatio->Automatic,DisplayFunction->Identity],{n,2,5}]]]