Artin's Constant

Author

Eric W. Weisstein
December 9, 2014

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

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

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

Value

ps=Prime[Range[10^5]];

N[Times@@(1-1/#/(#-1)&/@ps),20]

ps=Prime[Range[10^6]];

N[Times@@(1-1/#/(#-1)&/@ps),20]//Timing

Computation

ModuloOrder[a_,m_]:=Module[{k=1},
While[PowerMod[a,k,m]≠1,k++];
k
] /; GCD[a,m]==1

PrimitiveRoots[p_]:=Select[Range[p-1],PrimitiveRootQ[#,p]&]
PrimitiveRootQ[g_,p_]:=ModuloOrder[g,p]==EulerPhi[p]

PowerFreeQ[1]:=True
PowerFreeQ[n_?PrimeQ]:=True
PowerFreeQ[n_]:=Module[{p=Last/@FactorInteger[n]},First[p]==1||!(Equal@@p)
]
PowerfreePart[p_Integer?Positive,n_Integer?Positive]:=Times@@Power@@@({#[[1]],Mod[#[[2]],p]}&/@FactorInteger[n])
SquareFreePart[n_]:=PowerfreePart[2,n]

SquareFreePart/@Range[17]

Select[Range[110],(Mod[SquareFreePart[#],4]≠1)&]

l=Select[Range[100],(PowerFreeQ[#]&&Mod[SquareFreePart[#],4]≠1)&]

PrimitiveRoots/@Prime[Range[10]]

Timing[prs=PrimitiveRoots/@Prime[Range[80]];]

Function[p,Count[prs,_?(MemberQ[#,p]&)]/80.]/@Take[l,20]

Mean[%]

Via Lucas Numbers and Prime Zeta Function

Exp[-Sum[(LucasL[n]-1)PrimeZetaP[n]/n,{n,2,∞}]]//Timing

N[Exp[-Sum[(LucasL[n]-1)PrimeZetaP[n]/n,{n,2,100}]],100]//Timing

Block[{$MaxExtraPrecision=10^3},N[Exp[-Sum[(LucasL[n]-1`100)PrimeZetaP[n]/n,{n,2,10^3}]],100]]//Timing

Block[{$MaxExtraPrecision=10^3},N[Exp[-Sum[(LucasL[n]-1`200)PrimeZetaP[n]/n,{n,2,3000}]],100]]//Timing

Times Another way

1-1/p/(p-1)

prod=N[1,25];
(Monitor[Do[prod*=With[{p=Prime[k]},1-(1/((-1+p) p))],{k,10^6}],{k,prod}];prod)//Timing

Series

Series[Log[1-(1/((-1+p) p))],{p,∞,10}]

SeriesCoefficient[Log[1-(1/((-1+p) p))],{p,∞,n}]//FullSimplify

FullSimplify[Subtract@@{FunctionExpand[LucasL[n]],((((1/2) (1-(Sqrt[5]))))^n)+((((1/2) (1+(Sqrt[5]))))^n)},Assumptions->n∈Integers]

c[n_]:=-((-1+LucasL[n])/n)

Table[c[n],{n,15}]//FullSimplify

Block[{$MaxExtraPrecision=1000},Accumulate[Table[c[n]PrimeZetaP[n]//N[#,50]&,{n,2,20}]]]//Chop

Exp[Last[%]]

ser=Series[Log[1-(1/((-1+p) p))],{p,∞,2010}][[3]];

Take[ser,10]

Block[{$MaxExtraPrecision=1000},
sums=Exp[Accumulate[N[Table[ser[[k]] PrimeZetaP[k+1],{k,2000}],300]]]
];//Timing

ListPlot[Log10[Abs[Last[sums]-sums]]]

N[Last[sums],-Log10[Abs[sums[[-1]]-sums[[-2]]]]-2]

-Log10[Abs[sums[[-1]]-sums[[-2]]]]-2