Rosetta Code

Esthetic numbers: Difference between revisions

Page Discussion

Esthetic numbers (view source)

Revision as of 17:12, 10 April 2024

17,624 bytes added ,  1 month ago
Added Easylang
(Added XPL0 example.)
(Added Easylang)
(5 intermediate revisions by 4 users not shown)
Line 942:
............
123456789898987898 123456789898989876 123456789898989878 123456789898989898 </pre>
 
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
 
<syntaxhighlight lang="Delphi">
 
type TIntArray = array of integer;
 
function GetRadixString(L: Integer; Radix: Byte): string;
{Converts integer a string of any radix}
const HexChars: array[0..15] Of char =
('0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
var I: integer;
var S: string;
var Sign: string[1];
begin
Result:='';
If (L < 0) then
begin
Sign:='-';
L:=Abs(L);
end
else Sign:='';
S:='';
repeat
begin
I:=L mod Radix;
S:=HexChars[I] + S;
L:=L div Radix;
end
until L = 0;
Result:=Sign + S;
end;
 
 
 
procedure StrToInts(S: string; var IA: TIntArray);
{Convert numerical string of any radix and convert to numbers}
var I: integer;
begin
for I:=1 to Length(S) do
begin
SetLength(IA,Length(IA)+1);
if S[I]<#$40 then IA[High(IA)]:=Byte(S[I])-$30
else IA[High(IA)]:=(Byte(S[I])-$41)+10;
end;
end;
 
 
 
function IsEsthetic(N: integer; Radix: byte): boolean;
{Check number to see if neighboring digits are no more than one differents.}
var I: integer;
var S: string;
var IA: TIntArray;
begin
Result:=False;
S:=GetRadixString(N,Radix);
StrToInts(S,IA);
for I:=0 to Length(IA)-2 do
if Abs(IA[I+1]-IA[I])<>1 then exit;
Result:=True;
end;
 
 
 
function GetEstheticRange(Memo: TMemo; Range1,Range2,Count1,Count2,Base: integer): integer;
{Find an Esthetic number in the domain of Range and Counts specified}
var I,Cnt: integer;
var S: string;
begin
Cnt:=0; Result:=0;
S:='';
for I:=Range1 to Range2 do
if IsEsthetic(I,Base) then
begin
Inc(Cnt);
if (Cnt>=Count1) and (Cnt<=Count2) then
begin
Inc(Result);
S:=S+' '+GetRadixString(I,Base);
if (Result mod 10)=0 then S:=S+#$0D#$0A;
end;
if Cnt>=Count2 then break;
end;
Memo.Lines.Add(S);
end;
 
 
procedure FindEstheticNumbers(Memo: TMemo);
{Find Esthetic numbers for Rosetta Code problem}
var Base,First,Last,Cnt: integer;
begin
for Base:=2 to 16 do
begin
First:=Base*4; Last:=Base*6;
Memo.Lines.Add(Format('Base %2d: %2dth to %2dth esthetic numbers:',[Base,First,Last]));
Cnt:=GetEstheticRange(Memo,0,High(Integer),First,Last,Base);
Memo.Lines.Add('Count: '+IntToStr(Cnt));
Memo.Lines.Add('');
end;
 
Memo.Lines.Add('Base 10: esthetic numbers between 1000,9999');
Cnt:=GetEstheticRange(Memo,1000,9999,0,High(Integer),10);
Memo.Lines.Add('Count: '+IntToStr(Cnt));
Memo.Lines.Add('');
 
Memo.Lines.Add('Base 10: esthetic numbers between 100000000,130000000');
Cnt:=GetEstheticRange(Memo,100000000,130000000,0,High(Integer),10);
Memo.Lines.Add('Count: '+IntToStr(Cnt));
Memo.Lines.Add('');
end;
 
 
</syntaxhighlight>
{{out}}
<pre>
Base 2: 8th to 12th esthetic numbers:
1010101 10101010 101010101 1010101010 10101010101
Count: 5
 
Base 3: 12th to 18th esthetic numbers:
1012 1210 1212 2101 2121 10101 10121
Count: 7
 
Base 4: 16th to 24th esthetic numbers:
321 323 1010 1012 1210 1212 1232 2101 2121
Count: 9
 
Base 5: 20th to 30th esthetic numbers:
321 323 343 432 434 1010 1012 1210 1212 1232
1234
Count: 11
 
Base 6: 24th to 36th esthetic numbers:
323 343 345 432 434 454 543 545 1010 1012
1210 1212 1232
Count: 13
 
Base 7: 28th to 42th esthetic numbers:
343 345 432 434 454 456 543 545 565 654
656 1010 1012 1210 1212
Count: 15
 
Base 8: 32th to 48th esthetic numbers:
345 432 434 454 456 543 545 565 567 654
656 676 765 767 1010 1012 1210
Count: 17
 
Base 9: 36th to 54th esthetic numbers:
432 434 454 456 543 545 565 567 654 656
676 678 765 767 787 876 878 1010 1012
Count: 19
 
Base 10: 40th to 60th esthetic numbers:
434 454 456 543 545 565 567 654 656 676
678 765 767 787 789 876 878 898 987 989
1010
Count: 21
 
Base 11: 44th to 66th esthetic numbers:
454 456 543 545 565 567 654 656 676 678
765 767 787 789 876 878 898 89A 987 989
9A9 A98 A9A
Count: 23
 
Base 12: 48th to 72th esthetic numbers:
456 543 545 565 567 654 656 676 678 765
767 787 789 876 878 898 89A 987 989 9A9
9AB A98 A9A ABA BA9
Count: 25
 
Base 13: 52th to 78th esthetic numbers:
543 545 565 567 654 656 676 678 765 767
787 789 876 878 898 89A 987 989 9A9 9AB
A98 A9A ABA ABC BA9 BAB BCB
Count: 27
 
Base 14: 56th to 84th esthetic numbers:
545 565 567 654 656 676 678 765 767 787
789 876 878 898 89A 987 989 9A9 9AB A98
A9A ABA ABC BA9 BAB BCB BCD CBA CBC
Count: 29
 
Base 15: 60th to 90th esthetic numbers:
565 567 654 656 676 678 765 767 787 789
876 878 898 89A 987 989 9A9 9AB A98 A9A
ABA ABC BA9 BAB BCB BCD CBA CBC CDC CDE
DCB
Count: 31
 
Base 16: 64th to 96th esthetic numbers:
567 654 656 676 678 765 767 787 789 876
878 898 89A 987 989 9A9 9AB A98 A9A ABA
ABC BA9 BAB BCB BCD CBA CBC CDC CDE DCB
DCD DED DEF
Count: 33
 
Base 10: esthetic numbers between 1000,9999
1010 1012 1210 1212 1232 1234 2101 2121 2123 2321
2323 2343 2345 3210 3212 3232 3234 3432 3434 3454
3456 4321 4323 4343 4345 4543 4545 4565 4567 5432
5434 5454 5456 5654 5656 5676 5678 6543 6545 6565
6567 6765 6767 6787 6789 7654 7656 7676 7678 7876
7878 7898 8765 8767 8787 8789 8987 8989 9876 9878
9898
Count: 61
 
Base 10: esthetic numbers between 100000000,130000000
101010101 101010121 101010123 101012101 101012121 101012123 101012321 101012323 101012343 101012345
101210101 101210121 101210123 101212101 101212121 101212123 101212321 101212323 101212343 101212345
101232101 101232121 101232123 101232321 101232323 101232343 101232345 101234321 101234323 101234343
101234345 101234543 101234545 101234565 101234567 121010101 121010121 121010123 121012101 121012121
121012123 121012321 121012323 121012343 121012345 121210101 121210121 121210123 121212101 121212121
121212123 121212321 121212323 121212343 121212345 121232101 121232121 121232123 121232321 121232323
121232343 121232345 121234321 121234323 121234343 121234345 121234543 121234545 121234565 121234567
123210101 123210121 123210123 123212101 123212121 123212123 123212321 123212323 123212343 123212345
123232101 123232121 123232123 123232321 123232323 123232343 123232345 123234321 123234323 123234343
123234345 123234543 123234545 123234565 123234567 123432101 123432121 123432123 123432321 123432323
123432343 123432345 123434321 123434323 123434343 123434345 123434543 123434545 123434565 123434567
123454321 123454323 123454343 123454345 123454543 123454545 123454565 123454567 123456543 123456545
123456565 123456567 123456765 123456767 123456787 123456789
Count: 126
</pre>
 
 
=={{header|EasyLang}}==
{{trans|Lua}}
<syntaxhighlight>
func$ to n b .
digs$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
if n = 0
return 0
.
s$ = ""
while n > 0
idx = n mod b + 1
n = n div b
s$ = substr digs$ idx 1 & s$
.
return s$
.
func uabs a b .
if a > b
return a - b
.
return b - a
.
func isEsthetic n b .
if n = 0
return 0
.
i = n mod b
n = n div b
while n > 0
j = n mod b
if uabs i j <> 1
return 0
.
n = n div b
i = j
.
return 1
.
for b = 2 to 16
print "Base " & b & ": " & 4 * b & "th to " & 6 * b & "th esthetic numbers:"
n = 1
c = 0
while c < 6 * b
if isEsthetic n b = 1
c += 1
if c >= 4 * b
write to n b & " "
.
.
n += 1
.
print ""
print ""
.
print "Base 10 esthetic numbers between 1000 and 9999:"
for i = 1000 to 9999
if isEsthetic i 10 = 1
write i & " "
.
.
</syntaxhighlight>
 
=={{header|F_Sharp|F#}}==
Line 3,901 ⟶ 4,190:
123454543 123454545 123454565 123454567 123456543 123456545
123456565 123456567 123456765 123456767 123456787 123456789</pre>
 
=={{header|jq}}==
'''Adapted from [[#Wren|Wren]]'''
{{works with|jq}}
'''Also works with gojq, the Go implementation of jq.'''
<syntaxhighlight lang="jq">
### Preliminaries
# _nwise/1 is included here for the sake of gojq:
def _nwise($n):
def n: if length <= $n then . else .[0:$n] , (.[$n:] | n) end;
n;
 
def tobase($b):
def digit: "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"[.:.+1];
def mod: . % $b;
def div: ((. - mod) / $b);
def digits: recurse( select(. > 0) | div) | mod ;
# For jq it would be wise to protect against `infinite` as input, but using `isinfinite` confuses gojq
select( (tostring|test("^[0-9]+$")) and 2 <= $b and $b <= 36)
| if . == 0 then "0"
else [digits | digit] | reverse[1:] | add
end;
 
### Esthetic Numbers
def isEsthetic($b):
if . == 0 then false
else {i: (. % $b), n: ((./$b)|floor) }
| until (.n <= 0;
(.n % $b) as $j
| if (.i - $j)|length != 1 # abs
then .n = -1 #flag
else .n |= ((./$b)|floor)
| .i = $j
end)
| .n != -1
end;
 
# depth-first search
# input: {esths}
def dfs($n; $m; $i):
if ($i >= $n and $i <= $m) then .esths += [$i] else . end
| if ($i == 0 or $i > $m) then .
else ($i % 10) as $d
| ($i*10 + $d - 1) as $i1
| ($i1 + 2) as $i2
| if $d == 0
then dfs($n; $m; $i2)
elif $d == 9
then dfs($n; $m; $i1)
else dfs($n; $m; $i1) | dfs($n; $m; $i2)
end
end;
 
### The tasks
def listEsths(n; n2; m; m2; $perLine; $all):
( {esths: []}
| reduce range(0;10) as $i (.; dfs(n2; m2; $i) )
| "Base 10: \(.esths|length) esthetic numbers between \(n) and \(m)",
if $all
then .esths | _nwise($perLine) | join(" ")
else
(.esths[:$perLine] | join(" ")),
"............",
(.esths[-$perLine:] | join(" "))
end ),
"";
 
def task($maxBase):
range (2; 1+$maxBase) as $b
| "Base \($b): \(4*$b)th to \(6*$b)th esthetic numbers:",
( [{ n: 1, c: 0 }
| while (.c <= 6*$b;
.emit = null
| if (.n|isEsthetic($b))
then .c += 1
| if .c >= 4*$b
then .emit = "\(.n | tobase($b))"
else .
end
else .
end
| .n += 1 )
| select(.emit).emit]
| _nwise(10) | join(" ") ),
"" ;
 
task(16),
 
# the following all use the obvious range limitations for the numbers in question
listEsths(1000; 1010; 9999; 9898; 16; true),
listEsths(1e8; 101010101; 13*1e7; 123456789; 9; true),
listEsths(1e11; 101010101010; 13*1e10; 123456789898; 7; false),
listEsths(1e14; 101010101010101; 13*1e13; 123456789898989; 5; false)
</syntaxhighlight>
{{output}}
(scrollable)
<pre style="height:20lh;overflow:auto">
Base 2: 8th to 12th esthetic numbers:
10101010 101010101 1010101010 10101010101 101010101010
 
Base 3: 12th to 18th esthetic numbers:
1210 1212 2101 2121 10101 10121 12101
 
Base 4: 16th to 24th esthetic numbers:
323 1010 1012 1210 1212 1232 2101 2121 2123
 
Base 5: 20th to 30th esthetic numbers:
323 343 432 434 1010 1012 1210 1212 1232 1234
2101
 
Base 6: 24th to 36th esthetic numbers:
343 345 432 434 454 543 545 1010 1012 1210
1212 1232 1234
 
Base 7: 28th to 42th esthetic numbers:
345 432 434 454 456 543 545 565 654 656
1010 1012 1210 1212 1232
 
Base 8: 32th to 48th esthetic numbers:
432 434 454 456 543 545 565 567 654 656
676 765 767 1010 1012 1210 1212
 
Base 9: 36th to 54th esthetic numbers:
434 454 456 543 545 565 567 654 656 676
678 765 767 787 876 878 1010 1012 1210
 
Base 10: 40th to 60th esthetic numbers:
454 456 543 545 565 567 654 656 676 678
765 767 787 789 876 878 898 987 989 1010
1012
 
Base 11: 44th to 66th esthetic numbers:
456 543 545 565 567 654 656 676 678 765
767 787 789 876 878 898 89A 987 989 9A9
A98 A9A 1010
 
Base 12: 48th to 72th esthetic numbers:
543 545 565 567 654 656 676 678 765 767
787 789 876 878 898 89A 987 989 9A9 9AB
A98 A9A ABA BA9 BAB
 
Base 13: 52th to 78th esthetic numbers:
545 565 567 654 656 676 678 765 767 787
789 876 878 898 89A 987 989 9A9 9AB A98
A9A ABA ABC BA9 BAB BCB CBA
 
Base 14: 56th to 84th esthetic numbers:
565 567 654 656 676 678 765 767 787 789
876 878 898 89A 987 989 9A9 9AB A98 A9A
ABA ABC BA9 BAB BCB BCD CBA CBC CDC
 
Base 15: 60th to 90th esthetic numbers:
567 654 656 676 678 765 767 787 789 876
878 898 89A 987 989 9A9 9AB A98 A9A ABA
ABC BA9 BAB BCB BCD CBA CBC CDC CDE DCB
DCD
 
Base 16: 64th to 96th esthetic numbers:
654 656 676 678 765 767 787 789 876 878
898 89A 987 989 9A9 9AB A98 A9A ABA ABC
BA9 BAB BCB BCD CBA CBC CDC CDE DCB DCD
DED DEF EDC
 
Base 10: 61 esthetic numbers between 1000 and 9999
1010 1012 1210 1212 1232 1234 2101 2121 2123 2321 2323 2343 2345 3210 3212 3232
3234 3432 3434 3454 3456 4321 4323 4343 4345 4543 4545 4565 4567 5432 5434 5454
5456 5654 5656 5676 5678 6543 6545 6565 6567 6765 6767 6787 6789 7654 7656 7676
7678 7876 7878 7898 8765 8767 8787 8789 8987 8989 9876 9878 9898
 
Base 10: 126 esthetic numbers between 100000000 and 130000000
101010101 101010121 101010123 101012101 101012121 101012123 101012321 101012323 101012343
101012345 101210101 101210121 101210123 101212101 101212121 101212123 101212321 101212323
101212343 101212345 101232101 101232121 101232123 101232321 101232323 101232343 101232345
101234321 101234323 101234343 101234345 101234543 101234545 101234565 101234567 121010101
121010121 121010123 121012101 121012121 121012123 121012321 121012323 121012343 121012345
121210101 121210121 121210123 121212101 121212121 121212123 121212321 121212323 121212343
121212345 121232101 121232121 121232123 121232321 121232323 121232343 121232345 121234321
121234323 121234343 121234345 121234543 121234545 121234565 121234567 123210101 123210121
123210123 123212101 123212121 123212123 123212321 123212323 123212343 123212345 123232101
123232121 123232123 123232321 123232323 123232343 123232345 123234321 123234323 123234343
123234345 123234543 123234545 123234565 123234567 123432101 123432121 123432123 123432321
123432323 123432343 123432345 123434321 123434323 123434343 123434345 123434543 123434545
123434565 123434567 123454321 123454323 123454343 123454345 123454543 123454545 123454565
123454567 123456543 123456545 123456565 123456567 123456765 123456767 123456787 123456789
 
Base 10: 911 esthetic numbers between 100000000000 and 130000000000
101010101010 101010101012 101010101210 101010101212 101010101232 101010101234 101010121010
............
123456787678 123456787876 123456787878 123456787898 123456789876 123456789878 123456789898
 
Base 10: 6225 esthetic numbers between 100000000000000 and 130000000000000
101010101010101 101010101010121 101010101010123 101010101012101 101010101012121
............
123456789898767 123456789898787 123456789898789 123456789898987 123456789898989
</pre>
 
=={{header|Julia}}==
Line 6,503 ⟶ 6,987:
5654 5656 5676 5678 6543 6545 6565 6567 6765 6767 6787 6789 7654 7656 7676
7876 7878 7898 8765 8767 8787 8789 8987 8989 9876 9878 9898
</pre>
 
=={{header|RPL}}==
No brute force here, but a step-by-step generation, starting from a seed made up of the list of the digits of the base.
 
Task is accomplished in 999 seconds - precisely - on a basic HP-28S (4-bit CPU, 32 Mb RAM), but just in a few seconds on an iOS-based emulator.
≪ "0123456789ABCDEF" 1 3 PICK SUB
→ deb fin base digits
≪ { }
2 base '''FOR''' j
digits j DUP SUB + '''NEXT'''
1
'''DO'''
DUP2 GET
digits OVER DUP SIZE DUP SUB POS
→ idx nbr pos
≪ '''IF''' pos 1 ≠ '''THEN''' nbr digits pos 1 - DUP SUB + + '''END'''
'''IF''' pos base ≠ '''THEN''' nbr digits pos 1 + DUP SUB + + '''END'''
idx
≫
1 +
'''UNTIL''' DUP fin ≥ '''END'''
DROP deb fin SUB
≫ ≫ '<span style="color:blue">ESTIC</span>' STO
≪
2 16 '''FOR''' b
b 4 * b 6 * b <span style="color:blue">ESTIC</span> '''NEXT'''
59 119 10 <span style="color:blue">ESTIC</span>
≫ '<span style="color:blue">TASK</span>' STO
{{out}}
<pre style="height:40ex;overflow:scroll;">
16: { "10101010" "101010101" "1010101010" "10101010101" "101010101010" }
15: { "1210" "1212" "2101" "2121" "10101" "10121" "12101" }
14: { "323" "1010" "1012" "1210" "1212" "1232" "2101" "2121" "2123" }
13: { "323" "343" "432" "434" "1010" "1012" "1210" "1212" "1232" "1234" "2101" }
12: { "343" "345" "432" "434" "454" "543" "545" "1010" "1012" "1210" "1212" "1232" "1234" }
11: { "345" "432" "434" "454" "456" "543" "545" "565" "654" "656" "1010" "1012" "1210" "1212" "1232" }
10: { "432" "434" "454" "456" "543" "545" "565" "567" "654" "656" "676" "765" "767" "1010" "1012" "1210" "1212" }
9: { "434" "454" "456" "543" "545" "565" "567" "654" "656" "676" "678" "765" "767" "787" "876" "878" "1010" "1012" "1210" }
8: { "454" "456" "543" "545" "565" "567" "654" "656" "676" "678" "765" "767" "787" "789" "876" "878" "898" "987" "989" "1010" "1012" }
7: { "456" "543" "545" "565" "567" "654" "656" "676" "678" "765" "767" "787" "789" "876" "878" "898" "89A" "987" "989" "9A9" "A98" "A9A" "1010" }
6: { "543" "545" "565" "567" "654" "656" "676" "678" "765" "767" "787" "789" "876" "878" "898" "89A" "987" "989" "9A9" "9AB" "A98" "A9A" "ABA" "BA9" "BAB" }
5: { "545" "565" "567" "654" "656" "676" "678" "765" "767" "787" "789" "876" "878" "898" "89A" "987" "989" "9A9" "9AB" "A98" "A9A" "ABA" "ABC" "BA9" "BAB" "BCB" "CBA" }
4: { "565" "567" "654" "656" "676" "678" "765" "767" "787" "789" "876" "878" "898" "89A" "987" "989" "9A9" "9AB" "A98" "A9A" "ABA" "ABC" "BA9" "BAB" "BCB" "BCD" "CBA" "CBC" "CDC" }
3: { "567" "654" "656" "676" "678" "765" "767" "787" "789" "876" "878" "898" "89A" "987" "989" "9A9" "9AB" "A98" "A9A" "ABA" "ABC" "BA9" "BAB" "BCB" "BCD" "CBA" "CBC" "CDC" "CDE" "DCB" "DCD" }
2: { "654" "656" "676" "678" "765" "767" "787" "789" "876" "878" "898" "89A" "987" "989" "9A9" "9AB" "A98" "A9A" "ABA" "ABC" "BA9" "BAB" "BCB" "BCD" "CBA" "CBC" "CDC" "CDE" "DCB" "DCD" "DED" "DEF" "EDC" }
1: { "1010" "1012" "1210" "1212" "1232" "1234" "2101" "2121" "2123" "2321" "2323" "2343" "2345" "3210" "3212" "3232" "3234" "3432" "3434" "3454" "3456" "4321" "4323" "4343" "4345" "4543" "4545" "4565" "4567" "5432" "5434" "5454" "5456" "5654" "5656" "5676" "5678" "6543" "6545" "6565" "6567" "6765" "6767" "6787" "6789" "7654" "7656" "7676" "7678" "7876" "7878" "7898" "8765" "8767" "8787" "8789" "8987" "8989" "9876" "9878" "9898" }
</pre>
 
Line 7,184 ⟶ 7,716:
{{trans|Go}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="ecmascriptwren">import "./fmt" for Conv, Fmt
 
var isEsthetic = Fn.new { |n, b|
Chkas
1,969

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/339659...363438"