Table of numbers less than $n$ of a certain type

If I have a large number, for example,

2^11

is there code to list a table of positive integers less than this number which are not of the form

p^k *j

where $p$ is prime and $j\not=p$ is either prime or 1?

Update: The restriction

p^k * j < 2^11

forces (in case j=1)

p^k < 2^11

for each given p. So for each $p$, the largest $k$ (let's denote it $k_p$) for which $p^{k_p}<2^{11}$ is $k_p=$

Floor[11 Log / Log[p]]
• Any conditions on k? Jul 12 '17 at 10:00
• k can only be so large so that the product is less than 2^11. I'll edit the post. Jul 12 '17 at 10:08
• does this give what you need: Pick[#, Not[PrimeQ[FactorInteger[#, 2][[-1, 1]]]] & /@ #] &@ Range[2^11]?
– kglr
Jul 12 '17 at 10:11
• @kglr I don't think so. When I try a smaller number, such as $2^6$, I obtain output {1, 30, 60}, but 2*3*7=42 should also be in the list. Jul 12 '17 at 10:15

max = 2^11;

ps = Prime[Range[PrimePi[max - 1]]];
ks = Range /@ Floor[Log[ps, N[max - 1]]];
js = # /. (# -> Append[ps[[;; First[FirstPosition[ps, n_ /; n > #, -1,
{1}]]]], 1] & /@ DeleteDuplicates[#]) &[Floor[(max - 1) ps^-1]];

Complement[Range[max - 1], Flatten[MapThread[Outer[Times, #, #2] &, {ps^ks, js}]]]

{1, 30, 36, 42, 60, 66, 70, 72, 78, 84, 90, 100, 102, 105, 108, 110 .......

1 is included because i didn't use $k=0$. If thats wrong it should be ks = Range[0, #]& /@ Floor[Log[ps, N[max - 1]]];

If I understand your question correctly, then the form you describe can be tested with the following function:

PKJFormQ[k_Integer] := With[
{factors = FactorInteger[k]},
And[
Length[factors] <= 2,
Length@Cases[factors[[All, 2]], Except, {1}] <= 1]];
SetAttributes[PKJFormQ, Listable];

(I.e., there are at most 2 prime factors and either one or both of the prime factors has an exponent of 1.) You can then use any number of given Mathematica tools (like Pick or Reap) to do the rest; here are a couple examples on the limited range of up to 2^6:

First@Last@Reap@Do[If[!PKJFormQ[k], Sow[k]], {k, 2^6}]

{30, 36, 42, 60}

Pick[#, PKJFormQ[#], False]&@Range[2^6]

{30, 36, 42, 60}

The full list is a bit long for 2^11, so I won't paste it here, but it takes no time to run:

Length@Pick[#, PKJFormQ[#], False]&@Range[2^11]

773

• I think 36 = 2*2*3*3 is missing, because there is two factors with multiplicity >1 Jul 12 '17 at 11:08
• Thanks; good catch! Was because Complement eliminated identical coefficients; now fixed.
– nben
Jul 12 '17 at 17:47