RosettaCodeData/Task/Unprimeable-numbers/Mathematica/unprimeable-numbers.math
2023-07-01 13:44:08 -04:00

43 lines
754 B
Text

ClearAll[Unprimeable]
Unprimeable[in_Integer] := Module[{id, new, pos},
id = IntegerDigits[in];
pos = Catenate@Table[
Table[
new = id;
new[[d]] = n;
new
,
{n, 0, 9}
]
,
{d, Length[id]}
];
pos //= Map[FromDigits];
NoneTrue[pos, PrimeQ]
]
res = {};
PrintTemporary[Dynamic[{Length[res], i}]];
i = 0;
While[Length[res] < 600,
If[Unprimeable[i],
AppendTo[res, i]
];
i++
];
PrintTemporary[Dynamic[{lastdig, i}]];
out = Table[
i = lastdig;
While[! Unprimeable[i],
i += 10
];
i
,
{lastdig, 0, 9}
];
res[[;; 35]]
res[[600]]
lastdigit = IntegerDigits /* Last;
Print["Least unprimeable number ending in ", lastdigit[#], ": ", #] & /@ SortBy[out, lastdigit];