Almost Prime

Author

Eric W. Weisstein
February 8, 2006

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

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

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

Additional Authors

Original AlmostPrimePi code by
Robert G. Wilson V
February 7, 2006

Code

AlmostPrimeQ[k_,n_]:=Plus@@(Last/@FactorInteger[n])==k

AlmostPrimePiFast[2,n_] := Total[PrimePi[n/Prime[#]] -# + 1&/@Range[PrimePi[Sqrt[n]]]]
AlmostPrimePiFast[3,n_] :=Sum[PrimePi[n/(Prime[i]Prime[j])]-j+1,{i,PrimePi[n^(1/3)]},{j,i,PrimePi[Sqrt[n/Prime[i]]]}]
AlmostPrimePiFast[4,n_] := Sum[PrimePi[n/(Prime[i]Prime[j]Prime[k])]-k+1,{i,PrimePi[n^(1/4)]},{j,i,PrimePi[(n/Prime[i])^(1/3)]},{k,j,PrimePi[Sqrt[n/(Prime[i]Prime[j])]]}]

AlmostPrimePi[k_Integer,n_]:=Module[{a,i},
a[0]=1;
Sum[PrimePi[n/Times@@Prime[Array[a,k-1]]]-a[k-1]+1,Evaluate[Sequence@@Table[{a[i],a[i-1],PrimePi[(n/Times@@Prime[Array[a,i-1]])^(1/(k-i+1))]},{i,k-1}]]]
]

Enumeration

Select[Range[100],AlmostPrimeQ[1,#]&]

Select[Range[100],AlmostPrimeQ[2,#]&]

Select[Range[100],AlmostPrimeQ[3,#]&]

Select[Range[100],AlmostPrimeQ[4,#]&]

Select[Range[200],AlmostPrimeQ[5,#]&]

Counts

Fast Versions

With[{n=10^3},
Rest[FoldList[Plus,0,Boole[AlmostPrimeQ[2,#]]&/@Range[n]]]==(AlmostPrimePiFast[2,#]&/@Range[n])
]//Timing

With[{n=10^3},
Rest[FoldList[Plus,0,Boole[AlmostPrimeQ[3,#]]&/@Range[n]]]==(AlmostPrimePiFast[3,#]&/@Range[n])
]//Timing

With[{n=10^3},
Rest[FoldList[Plus,0,Boole[AlmostPrimeQ[4,#]]&/@Range[n]]]==(AlmostPrimePiFast[4,#]&/@Range[n])
]//Timing

General Versions

With[{n=10^3},
Rest[FoldList[Plus,0,Boole[AlmostPrimeQ[2,#]]&/@Range[n]]]==(AlmostPrimePi[2,#]&/@Range[n])
]//Timing

With[{n=10^3},
Rest[FoldList[Plus,0,Boole[AlmostPrimeQ[3,#]]&/@Range[n]]]==(AlmostPrimePi[3,#]&/@Range[n])
]//Timing

With[{n=10^3},
Rest[FoldList[Plus,0,Boole[AlmostPrimeQ[4,#]]&/@Range[n]]]==(AlmostPrimePi[4,#]&/@Range[n])
]//Timing