Polygon Circumscribing

Author

Eric W. Weisstein
December 2, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Polygons/PolygonCircumscribing.nb.

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

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

Constant

Plot[Sec[Pi/n],{n,3,20},PlotStyle->Red]

Product

Product[Sec[Pi/n],{n,3,∞}]//Timing

NProduct[Sec[Pi/n],{n,3,∞},WorkingPrecision->30]

V7

Product[Sec[Pi/n],{n,3,∞}]//Timing

Bouwkamp's Double Product

Product[1-(1/((m^2)(((n+1/2))^2))),{n,∞},{m,∞}]//Timing

Pi/2/NProduct[(1-(1/((m^2)(((n+1/2))^2)))),{m,2000},{n,2000}]

FullSimplify[Product[1-(1/((m^2)(((n+1/2))^2))),{n,∞}],m∈Integers&&m>0]

Pi/2/(((((m^2) Cos[(π/m)])/(-4+(m^2)))/.m->1)Limit[(((m^2) Cos[(π/m)])/(-4+(m^2))),m->2]NProduct[(((m^2) Cos[(π/m)])/(-4+(m^2))),{m,3,∞}])

FullSimplify[Together//@FullSimplify[Product[1-(1/((m^2)(((n+1/2))^2))),{m,∞}],n∈Integers&&n>0]]

V7

Product[1-(1/((m^2)(((n+1/2))^2))),{n,∞},{m,∞}]//Timing

Bouwkamp's Sinc Product

Pi/2NProduct[((2π)/(1+2 n ))/Sin[((2 π)/(1+2 n))],{n,∞}]

Pi/2Product[((2π)/(1+2 n ))/Sin[((2 π)/(1+2 n))],{n,∞}]//Timing

V7

Pi/2Product[((2π)/(1+2 n ))/Sin[((2 π)/(1+2 n))],{n,∞}]//Timing

Bouwkamp's Lambda Product

Lambda[x_]:=(1-2^(-x))Zeta[x]

6Exp[NSum[(Lambda[2k]-1)2^(2k)(Zeta[2k]-1-2^(-2k))/k,{k,∞}]]

V6

6Exp[Sum[(Lambda[2k]-1)2^(2k)(Zeta[2k]-1-2^(-2k))/k,{k,∞}]]

V7

6Exp[Sum[(Lambda[2k]-1)2^(2k)(Zeta[2k]-1-2^(-2k))/k,{k,∞}]]//Timing

Bouwkamp's Accelerated Convergence

Plot[(1-((π^2)/(2n^2))+((Pi^4)/(24n^4)))Sec[Pi/n],{n,3,10},PlotStyle->Red]

k1=1/12Sqrt[6]Pi^4(1-Pi^2/2+Pi^4/24)(1-Pi^2/8+Pi^4/384)Csc[Pi^2/Sqrt[6+2Sqrt[3]]]Csc[Pi^2/Sqrt[6-2Sqrt[3]]]

Product[(1-((Pi^2)/(2n^2))+((Pi^4)/(24n^4)))Sec[Pi/n],{n,3,∞}]//Timing

Explicit Summing of Terms

b=Times@@N[Table[(1-((Pi^2)/(2n^2))+((Pi^4)/(24n^4)))Sec[Pi/n],{n,3,10^6}],50];//Timing

k1 b

NProduct

prod[n_?NumericQ]:=(1-((Pi^2)/(2n^2))+((Pi^4)/(24n^4)))Sec[Pi/n]

Integrate with Optimization

k1 NProduct[(1-((Pi^2)/(2n^2))+((Pi^4)/(24n^4)))Sec[Pi/n],{n,3,∞},WorkingPrecision->20,Method->Integrate,VerifyConvergence->False]//Timing

Integrate without Optimization

k1 NProduct[prod[n],{n,3,∞},WorkingPrecision->20,Method->Integrate,VerifyConvergence->False]//Timing

Fit with Optimization

k1 NProduct[(1-((Pi^2)/(2n^2))+((Pi^4)/(24n^4)))Sec[Pi/n],{n,3,∞},WorkingPrecision->25,Method->Fit,VerifyConvergence->False]//Timing

k1 NProduct[(1-((Pi^2)/(2n^2))+((Pi^4)/(24n^4)))Sec[Pi/n],{n,3,∞},WorkingPrecision->50,Method->Fit,VerifyConvergence->False]//Timing

Fit without Optimization

k1 NProduct[prod[n],{n,3,∞},WorkingPrecision->20,Method->Fit,VerifyConvergence->False]//Timing

k1 NProduct[(1-((Pi^2)/(2n^2))+((Pi^4)/(24n^4)))Sec[Pi/n],{n,3,∞},WorkingPrecision->25,Method->Integrate,VerifyConvergence->False]//Timing

Sasha's numerical code

PolygonCircumscribingConstant[p_]:=Module[{sum=0,prev=1,k=2,tmp=1},Block[{$MaxExtraPrecision=Infinity},While[sum-prev≠0,prev=sum;
tmp*=4;
sum+=N[(tmp-1)/k (# (#-1-1/tmp)&[Zeta[k]]),{Infinity,p+5}];
k+=2;]];
If[Precision[sum]>p,sum=SetPrecision[sum,p]];
Exp[2 sum]]

PolygonCircumscribingConstant[50]//Timing

PolygonCircumscribingConstant[100]//Timing

Transforming the Series

Series[Log[Sec[Pi/n]],{n,∞,20}]

A046990/A046991

V6

<<DiscreteMath`RSolve`

SeriesTerm[Log[Sec[Pi x]],{x,0,k}]

FullSimplify[Last[%]]

FullSimplify[%/.k->2k,k∈Integers&&k>0]

V6

$Version

FullSimplify[(((2^(-2+k)) (((I π))^k) (EulerE[-1+k,0]-EulerE[-1+k,1]))/(k (-1+k)!)),Mod[k,2]==1&&k>0]

FullSimplify[(((2^(-2+k)) (((I π))^k) (EulerE[-1+k,0]-EulerE[-1+k,1]))/(k (-1+k)!)),Mod[k,2]==0&&k>0]

Table[(((-1+(2^k)) (((2 I π))^k) Zeta[1-k])/(k!)),{k,2,10,2}]

Table[((2(-1+(2^k)) Zeta[k])/k),{k,2,10,2}]

V7

SeriesCoefficient[Log[Sec[Pi x]],{x,0,k}]

FullSimplify[(((2^(-2+k)) (((I π))^k) (EulerE[-1+k,0]-EulerE[-1+k,1]))/(k (-1+k)!)),Mod[k,2]==1&&k>0]

FullSimplify[(((2^(-2+k)) (((I π))^k) (EulerE[-1+k,0]-EulerE[-1+k,1]))/(k (-1+k)!)),Mod[k,2]==0&&k>0]

Table[-(((-1+(2^k)) (((2 I π))^k) BernoulliB[k])/(k k!)),{k,2,10,2}]

expr1=-(((-1+(2^k)) (((2 I π))^k) BernoulliB[k])/(k k!));

expr2=((2(-1+(2^k)) Zeta[k])/k);

FullSimplify[expr1,Mod[k,2]==0&&k>0]===expr1

FullSimplify[Subtract@@{expr1,expr2},Mod[k,2]==0&&k>0]

ByteCount/@{expr1,expr2}

Simplify

Table[(((-1+(4^k)) Zeta[2 k])/k)(1/(n^(2k))),{k,5}]

FullSimplify[Sum[(((-1+(4^k)) Zeta[2 k])/k)(1/(n^(2k))),{n,3,∞}]]

c=Plus@@N[Table[(((4^(-k)) (-1+(4^k)) (-1+(4^k) (-1+Zeta[2 k])) Zeta[2 k])/k),{k,100}],200]//Timing

c=Plus@@N[Table[(((4^(-k)) (-1+(4^k)) (-1+(4^k) (-1+Zeta[2 k])) Zeta[2 k])/k),{k,200}],200]//Timing

c=Plus@@N[Table[(((4^(-k)) (-1+(4^k)) (-1+(4^k) (-1+Zeta[2 k])) Zeta[2 k])/k),{k,500}],500]

c=Plus@@N[Table[(((4^(-k)) (-1+(4^k)) (-1+(4^k) (-1+Zeta[2 k])) Zeta[2 k])/k),{k,1000}],1000]

c=Plus@@N[Table[(((4^(-k)) (-1+(4^k)) (-1+(4^k) (-1+Zeta[2 k])) Zeta[2 k])/k),{k,1100}],1100]

Take[RealDigits[%%][[1]],110]

Exp[c]

Figure

V5

<<Graphics`Colors`

radii=FoldList[Times,1,Table[Sec[Pi/n],{n,3,20}]];
polygons=MapIndexed[Table[#1Through[{Cos,Sin}[2Pi i/(#2[[1]]+1)]],{i,0,1+#2[[1]]}]&,radii];

Show[Graphics[{
{GrayLevel[.7],Circle[{0,0},#]&/@radii},
Table[{Hue[(i-1)/(Length[polygons]-2)],Line[polygons[[1+i]]]},{i,Length[polygons]-1}]
}],
AspectRatio->Automatic]

V6

radii=FoldList[Times,1,Table[Sec[Pi/n],{n,3,20}]];
polygons=MapIndexed[Table[#1Through[{Cos,Sin}[2Pi i/(#2[[1]]+1)]],{i,0,1+#2[[1]]}]&,radii];

Graphics[{
{GrayLevel[.7],Circle[{0,0},#]&/@radii},
Table[{Hue[(i-1)/(Length[polygons]-2)],Line[polygons[[1+i]]]},{i,Length[polygons]-1}]
}]