Untouchable numbers: Difference between revisions
→{{header|Nim}}
m (→{{header|Phix}}: added syntax colouring the hard way) |
|||
Line 625:
The count of untouchable numbers ≤ 1000000 is: 150232
</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<lang Mathematica>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])]</lang>
{{out}}
<pre>2 246 342 540 714 804 964 1102 1212 1316 1420 1596 1774 1884
5 248 372 552 718 818 966 1116 1222 1318 1422 1632 1776 1888
52 262 406 556 726 836 976 1128 1236 1326 1438 1642 1806 1894
88 268 408 562 732 848 982 1134 1246 1332 1476 1650 1816 1896
96 276 426 576 738 852 996 1146 1248 1342 1506 1680 1820 1920
120 288 430 584 748 872 1002 1148 1254 1346 1508 1682 1822 1922
124 290 448 612 750 892 1028 1150 1256 1348 1510 1692 1830 1944
146 292 472 624 756 894 1044 1160 1258 1360 1522 1716 1838 1956
162 304 474 626 766 896 1046 1162 1266 1380 1528 1718 1840 1958
188 306 498 628 768 898 1060 1168 1272 1388 1538 1728 1842 1960
206 322 516 658 782 902 1068 1180 1288 1398 1542 1732 1844 1962
210 324 518 668 784 926 1074 1186 1296 1404 1566 1746 1852 1972
216 326 520 670 792 934 1078 1192 1312 1406 1578 1758 1860 1986
238 336 530 708 802 936 1080 1200 1314 1418 1588 1766 1866 1992
196
2
5
89
1212
13863</pre>
=={{header|Nim}}==
| |||