Niven's Constant

Author

Eric W. Weisstein
August 3, 2017

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Constants/NivensConstant.nb.

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

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

Min and Max

as=Prepend[Last/@Transpose/@FactorInteger/@Range[2,102],{1}]

h(m)

Min/@as

H(m)

Max/@as

What is this?

bs=Prepend[Array[Times@@Last[Transpose[FactorInteger[#]]]&,99,2],1]

Position[Equal@@@Transpose[{Max/@as,bs}],False,1]//Flatten

Limits

h(m)

as=Prepend[Last/@Transpose/@FactorInteger/@Range[2,10^6],{1}];//Timing

((Plus@@(Min/@as))/(Length[as]))//N

Take[have=Rest[MapIndexed[#1/First[#2]&,FoldList[Plus,0,Min/@as]]],20]

Take[have,12]//InputForm

MakeBoxes[ylabel,TraditionalForm]:=RowBox[{FractionBox["1","n"],RowBox[{UnderoverscriptBox["∑",RowBox[{"m","=","1"}],"n"],RowBox[{"h","(","m",")"}]}]}]

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
ListPlot[Take[have,#],
PlotStyle->Red,PlotJoined->True,
AxesLabel->TraditionalForm/@{n,ylabel},
PlotRange->{1,1.4}
]&/@{100,1000}
]],GraphicsSpacing->-.1
]

hnorm=Rest[MapIndexed[(#1-First[#2])/Sqrt[First[#2]]&,FoldList[Plus,0,Min/@as]]];

((Plus@@(Min/@as)-Length[as])/(Sqrt[Length[as]]))//N

((Zeta[3/2])/(Zeta[3]))//N

MakeBoxes[ylabel,TraditionalForm]:=FractionBox[RowBox[{RowBox[{UnderoverscriptBox["∑",RowBox[{"m","=","1"}],"n"],RowBox[{"h","(","m",")"}]}],"-","n"}],SqrtBox["n"]]

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
ListPlot[Take[hnorm,#],
PlotStyle->Red,PlotJoined->True,
AxesLabel->TraditionalForm/@{n,ylabel}
]&/@{1000,10^4}
]],GraphicsSpacing->-.1
]

Zeta[3/2]/Zeta[3]//N

H(m)

((Plus@@(Max/@as))/(Length[as]))//N

Take[Have=Rest[MapIndexed[#1/First[#2]&,FoldList[Plus,0,Max/@as]]],20]

Take[Have,20]//InputForm

MakeBoxes[ylabel,TraditionalForm]:=RowBox[{FractionBox["1","n"],RowBox[{UnderoverscriptBox["∑",RowBox[{"m","=","1"}],"n"],RowBox[{"H","(","m",")"}]}]}]

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
ListPlot[Take[Have,#],
PlotStyle->Red,PlotJoined->True,
AxesLabel->TraditionalForm/@{n,ylabel}
]&/@{100,1000}
]],GraphicsSpacing->-.1
]

Niven's Constant

(∑_(j=2)^∞)(1-(1/(Zeta[j])))+1

1+Sum[1-(1/(Zeta[j])),{j,2,∞}]

N[1+Sum[1-(1/(Zeta[j])),{j,2,20}],100]//Timing

N[1+Sum[1-(1/(Zeta[j])),{j,2,4000}],1000]//Timing

N[1+Sum[1-(1/(Zeta[j])),{j,2,5000}],1000]//Timing

N[Total[1-1/Zeta[Range[2,5000]]]+1,1000]//Timing

V5

1+Sum[1-(1/(Zeta[j])),{j,2,∞}]

1+NSum[1-(1/(Zeta[j])),{j,2,∞},WorkingPrecision->20]//Timing

1+NSum[1-(1/(Zeta[j])),{j,2,∞},WorkingPrecision->110,NSumTerms->100]//Timing

V6

1+Sum[1-(1/(Zeta[j])),{j,2,∞}]

1+NSum[1-(1/(Zeta[j])),{j,2,∞},WorkingPrecision->20]//Timing

V7

1+Sum[1-(1/(Zeta[j])),{j,2,∞}]

1+NSum[1-(1/(Zeta[j])),{j,2,∞},WorkingPrecision->110,NSumTerms->100]//Timing

V11.2

1+NSum[1-(1/(Zeta[j])),{j,2,∞},WorkingPrecision->110,NSumTerms->100]//Timing

1+NSum[1-(1/(Zeta[j])),{j,2,∞},WorkingPrecision->1000,PrecisionGoal->500]//Timing