|
|
MATHEMATICA
| Table[ First[ Select[ Prime[ Range[100000]], Max[ DigitCount[ # ]]==i & ]], {i, 6}] (* or *)
f[n_, b_] := Block[{k = 10^(n + 1), p = Permutations[ Join[ Table[ b, {i, 1, n}], {x}]], c = Complement[ Table[j, {j, 0, 9}], {b}], q = {}}, Do[q = Append[q, Replace[p, x -> c[[i]], 2]], {i, 1, 9}]; r = Min[ Select[ FromDigits /@ Flatten[q, 1], PrimeQ[ # ] & ]]; If[ r != Infinity, r, While[ !PrimeQ[k] || Count[ IntegerDigits[k], b] != n, k++ ]; k]]; Table[ f[n, 1], {n, 2, 18}]
|
