RosettaCodeData/Task/Esthetic-numbers/Mathematica/esthetic-numbers.math

22 lines
919 B
Plaintext

ClearAll[EstheticNumbersRangeHelper, EstheticNumbersRange]
EstheticNumbersRangeHelper[power_, mima : {mi_, max_}, b_ : 10] := Module[{steps, cands},
steps = Tuples[{-1, 1}, power - 1];
steps = Accumulate[Prepend[#, 0]] & /@ steps;
cands = Table[Select[# + ConstantArray[s, power] & /@ steps, AllTrue[Between[{0, b - 1}]]], {s, 1, b - 1}];
cands //= Catenate;
cands //= Map[FromDigits[#, b] &];
cands = Select[cands, Between[mima]];
BaseForm[#, b] & /@ cands
]
EstheticNumbersRange[{min_, max_}, b_ : 10] := Module[{mi, ma},
{mi, ma} = Log[b, {min, max}];
mi //= Ceiling;
ma //= Ceiling;
ma = Max[ma, 1];
mi = Max[mi, 1];
Catenate[EstheticNumbersRangeHelper[#, {min, max}, b] & /@ Range[mi, ma]]
]
Table[{b, EstheticNumbersRange[{1, If[b == 2, 100000, If[b == 3, 100000, b^4]]}, b][[4 b ;; 6 b]]}, {b, 2, 16}] // Grid
EstheticNumbersRange[{1000, 9999}]
EstheticNumbersRange[{10^8, 1.3 10^8}]