Prime Factor

Author

Eric W. Weisstein
July 30, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PrimeNumbers/PrimeFactor.nb.

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

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

Code

PrimeFactorsOmega[n_Integer?Positive]:=Total[FactorInteger[n][[All,2]]]
SetAttributes[PrimeFactorsOmega,Listable]

Number of Prime Factors

Plot

<<Utilities`Plot`

GraphicsGrid[{{
IntegerListPlot[Prepend[Plus@@@Map[Last/@#&,FactorInteger[Range[2,100]],{1}],1],AxesLabel->{n,r[n]}],
ListPlot[Prepend[Plus@@@Map[Last/@#&,FactorInteger[Range[2,1000]],{1}],1],Joined->True,PlotStyle->Red,AxesLabel->{n,r[n]}]
}},ImageSize->500]

Table

PrimeFactorsOmega[Range[50]]

Select[Range[50],OddNumberOfDistinctPrimeFactorsQ]

l=Select[Range[10^5],OddNumberOfDistinctPrimeFactorsQ];

{Length[l]/10.^5,3./Pi^2}

{Tr[1./#^2&/@l],9./2/Pi^2}

{Tr[1./#^4&/@l],15./2/Pi^4}

Multiprimes

{#[[1,1]],#[[All,2]]}&/@Split[Sort[Table[{PrimeFactorsOmega[n],n},{n,100}]],First[#1]===First[#2]&]//Column

Asymptotics

With[{max=2 10^5},
d=Table[PrimeFactorsOmega[n],{n,max}];
s=Rest[FoldList[Plus,0,d]]/Range[max];
Show[
Block[{$DisplayFunction=Identity},
{
ListPlot[Table[{i,s[[i]]},{i,1,max,1000}]],
Plot[Log[Log[n]]+1.0346538,{n,2,max}]
}]
]
]//Timing

ListPlot[Table[(s[[n]]-Log[Log[n]]-1.0346538) Log[n],{n,2,500}]]

ListPlot[Table[(s[[n]]-Log[Log[n]]-1.0346538) Log[n],{n,2,2 10^5,500}]]

EulerGamma-1//N

<<Utilities`Typesetting`

Sum[(Sum[((StieltjesGamma[j])/(j!)),{j,0,k-1}]-1)(((k-1)!)/((Log[n])^k)),{k,3}]//TraditionalForm

Variance

N[EulerGamma+Sum[EulerPhi[k]/k Log[Zeta[k]],{k,2,500}],150]

MertensB2=N[EulerGamma+Sum[EulerPhi[k]/k Log[Zeta[k]],{k,2,1000}],150]

Phi[l_,k_]:=k^l Times@@((1-1/#^l)&/@DistinctPrimeFactors[k])

MertensB2-Pi^2/6+Sum[((Phi[2,k]-EulerPhi[k])/k)Log[Zeta[k]],{k,2,100}]

MertensB2-Pi^2/6+Sum[((Phi[2,k]-EulerPhi[k])/k)Log[Zeta[k]],{k,2,150}]

MertensB2-Pi^2/6+Sum[((Phi[2,k]-EulerPhi[k])/k)Log[Zeta[k]],{k,2,200}]

MertensB2-Pi^2/6+Sum[((Phi[2,k]-EulerPhi[k])/k)Log[Zeta[k]],{k,2,300}]

MertensB2-Pi^2/6+Sum[((Phi[2,k]-EulerPhi[k])/k)Log[Zeta[k]],{k,2,350}]

MertensB2-Pi^2/6+Sum[N[((Phi[2,k]-EulerPhi[k])/k)Log[Zeta[k]],150],{k,2,350}]

ListPlot[Table[N[((Phi[2,k]-EulerPhi[k])/k)Log[Zeta[k]],50],{k,2,100}],PlotJoined->True,PlotRange->{0,10^-20}]

Average Number of Prime Factors for a Random Number

(∑_(n=1)^∞)(ln(1-(1/(Subscript[p, n])))+(1/((Subscript[p, n])-1)))

N[EulerGamma+Sum[Log[1-1/Prime[n]]+1/(Prime[n]-1),{n,1000}],20]

(∑_(n=2)^∞)((ϕ(n) ln(ζ(n)))/n)

N[EulerGamma+Sum[EulerPhi[n]Log[Zeta[n]]/n,{n,2,100}],20]

Block[{$MaxExtraPrecision=1000},EulerGamma+Plus@@N[Table[EulerPhi[n]Log[Zeta[n]]/n,{n,2,1000}],110]
]//Timing

Block[{$MaxExtraPrecision=1000},c=EulerGamma+Plus@@N[Table[EulerPhi[n]Log[Zeta[n]]/n,{n,2,2000}],110]
]//Timing