RosettaCodeData/Task/Untouchable-numbers/Mathematica/untouchable-numbers.math

33 lines
673 B
Plaintext

f = DivisorSigma[1, #] - # &;
limit = 10^5;
c = Not /@ PrimeQ[Range[limit]];
slimit = 15 limit;
s = ConstantArray[False, slimit + 1];
untouchable = {2, 5};
Do[
val = f[i];
If[val <= slimit,
s[[val]] = True
]
,
{i, 6, slimit}
]
Do[
If[! s[[n]],
If[c[[n - 1]],
If[c[[n - 3]],
AppendTo[untouchable, n]
]
]
]
,
{n, 6, limit, 2}
]
Multicolumn[Select[untouchable, LessEqualThan[2000]]]
Count[untouchable, _?(LessEqualThan[2000])]
Count[untouchable, _?(LessEqualThan[10])]
Count[untouchable, _?(LessEqualThan[100])]
Count[untouchable, _?(LessEqualThan[1000])]
Count[untouchable, _?(LessEqualThan[10000])]
Count[untouchable, _?(LessEqualThan[100000])]