aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

21
Task/Esthetic-numbers/Mathematica/esthetic-numbers.math Normal file
View file

@ -0,0 +1,21 @@
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}]