Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,61 +1,162 @@
|
|||
/*REXX pgm lists a bunch of esthetic numbers in bases 2 ──► 16, & base 10 in two ranges.*/
|
||||
parse arg baseL baseH range /*obtain optional arguments from the CL*/
|
||||
if baseL=='' | baseL=="," then baseL= 2 /*Not specified? Then use the default.*/
|
||||
if baseH=='' | baseH=="," then baseH=16 /* " " " " " " */
|
||||
if range=='' | range=="," then range=1000..9999 /* " " " " " " */
|
||||
-- 15 Nov 2025
|
||||
include Setting
|
||||
numeric digits 21
|
||||
|
||||
do radix=baseL to baseH; #= 0; if radix<2 then iterate /*process the bases. */
|
||||
start= radix * 4; stop = radix * 6
|
||||
$=; do i=1 until #==stop; y= base(i, radix) /*convert I to base Y*/
|
||||
if \esthetic(y, radix) then iterate /*not esthetic? Skip*/
|
||||
#= # + 1; if #<start then iterate /*is # below range?*/
|
||||
$= $ y /*append # to $ list.*/
|
||||
end /*i*/
|
||||
say
|
||||
say center(' base ' radix", the" th(start) '──►' th(stop) ,
|
||||
"esthetic numbers ", max(80, length($) - 1), '─')
|
||||
say strip($)
|
||||
end /*radix*/
|
||||
say; g= 25
|
||||
parse var range start '..' stop
|
||||
say center(' base 10 esthetic numbers between' start "and" stop '(inclusive) ', g*5-1,"─")
|
||||
#= 0; $=
|
||||
do k=start to stop; if \esthetic(k, 10) then iterate; #= # + 1; $= $ k
|
||||
if #//g==0 then do; say strip($); $=; end
|
||||
end /*k*/
|
||||
say strip($); say; say # ' esthetic numbers listed.'
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
PorA: _= pos(z, @u); p= substr(@u, _-1, 1); a= substr(@u, _+1, 1); return
|
||||
th: parse arg th; return th || word('th st nd rd', 1+(th//10)*(th//100%10\==1)*(th//10<4))
|
||||
vv: parse arg v,_; vr= x2d(v) + _; if vr==-1 then vr= r; return d2x(vr)
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
base: procedure expose @u; arg x 1 #,toB,inB,,y /*Y is assigned a "null" value. */
|
||||
if tob=='' then tob= 10 /*maybe assign a default for TObase. */
|
||||
if inb=='' then inb= 10 /* " " " " " INbase. */
|
||||
@l= '0123456789abcdef'; @u= @l; upper @u /*two versions of hexadecimal digits. */
|
||||
if inB\==10 then do; #= 0 /*only convert if not base 10. */
|
||||
do j=1 for length(x) /*convert X: base inB ──► base 10. */
|
||||
#= # * inB + pos(substr(x, j, 1), @u) -1 /*build new number.*/
|
||||
end /*j*/ /* [↑] this also verifies digits. */
|
||||
end
|
||||
if toB==10 then return # /*if TOB is ten, then simply return #.*/
|
||||
do while # >= toB /*convert #: base 10 ──► base toB.*/
|
||||
y= substr(@l, (# // toB) + 1, 1)y /*construct the output number. */
|
||||
#= # % toB /* ··· and whittle # down also. */
|
||||
end /*while*/ /* [↑] algorithm may leave a residual.*/
|
||||
return substr(@l, # + 1, 1)y /*prepend the residual, if any. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
esthetic: procedure expose @u; arg x,r; L= length(x); if L==1 then return 1
|
||||
if x<2 then return 0
|
||||
do d=0 to r-1; _= d2x(d); if pos(_ || _, x)\==0 then return 0
|
||||
end /*d*/ /* [↑] check for a duplicated digits. */
|
||||
do j=1 for L; @.j= substr(x, j, 1) /*assign (base) digits to stemmed array*/
|
||||
end /*j*/
|
||||
if L==2 then do; z= @.1; call PorA; if @.2==p | @.2==a then nop
|
||||
else return 0
|
||||
end
|
||||
do e=2 to L-1; z= @.e; pe= e - 1; ae= e + 1
|
||||
if (z==vv(@.pe,-1)|z==vv(@.pe,1))&(z==vv(@.ae,-1)|z==vv(@.ae,1)) then iterate
|
||||
return 0
|
||||
end /*e*/; return 1
|
||||
say 'ESTHETIC NUMBERS'
|
||||
say version
|
||||
say
|
||||
call Task1
|
||||
call Task2 1000,9999
|
||||
call Task2 1.0e8,1.3e8
|
||||
call Timer 'R'
|
||||
call Generate
|
||||
call Task3 1.0e8,1.3e8,1
|
||||
call Task3 1.0e11,1.3e11,0
|
||||
call Task3 1.0e14,1.3e14,0
|
||||
call Task3 1.0e17,1.3e17,0
|
||||
call Task3 1.0e20,1.3e20,0
|
||||
call Timer 'R'
|
||||
exit
|
||||
|
||||
Task1:
|
||||
-- Shows ranges Esthetic numbers in bases 2 thru 16
|
||||
procedure
|
||||
do base=2 to 16
|
||||
n=0; n1=base*4; n2=base*6; d=0
|
||||
say 'Brute-force: Base' base 'Index' n1 'thru' n2'...'
|
||||
do i=1 until n=n2
|
||||
if base=10 then
|
||||
j=i
|
||||
else
|
||||
j=D2n(i,base)
|
||||
if Esthetic(j) then do
|
||||
n+=1
|
||||
if n>=n1 & n<=n2 then do
|
||||
d+=1
|
||||
call CharOut ,j' '
|
||||
if d//20=0 then
|
||||
say
|
||||
end
|
||||
end
|
||||
end i
|
||||
say; say
|
||||
end base
|
||||
return
|
||||
|
||||
Task2:
|
||||
-- Shows range Esthetic numbers in base 10
|
||||
-- using brute-force algorithm
|
||||
procedure
|
||||
arg n1,n2
|
||||
say 'Brute-force: Base 10 from' n1 'to' n2'...'
|
||||
n=0
|
||||
do i=n1 to n2
|
||||
if Esthetic(i) then do
|
||||
n+=1
|
||||
call CharOut ,i' '
|
||||
if n//10=0 then
|
||||
say
|
||||
end
|
||||
end i
|
||||
say
|
||||
say n 'found'
|
||||
say
|
||||
return
|
||||
|
||||
Esthetic:
|
||||
-- Is a number Esthetic?
|
||||
procedure
|
||||
arg xx
|
||||
if xx<10 then
|
||||
return 1
|
||||
dig='0123456789ABCDEF'
|
||||
est=1; a=SubStr(xx,1,1)
|
||||
do i=2 to Length(xx)
|
||||
b=SubStr(xx,i,1)
|
||||
if Abs(Pos(a,dig)-Pos(b,dig))<>1 then do
|
||||
est=0
|
||||
leave
|
||||
end
|
||||
a=b
|
||||
end i
|
||||
return est
|
||||
|
||||
Generate:
|
||||
-- Generate all Esthetic numbers
|
||||
-- needed for the stretch task and beyond
|
||||
-- Iterative solution
|
||||
procedure expose Esth. Work1. Work2.
|
||||
say 'Generate up to' Digits() 'digits...'
|
||||
do i=1 to 9
|
||||
work1.i=i; Esth.i=i
|
||||
end
|
||||
work1.0=9; n=9
|
||||
do Digits()-1
|
||||
w=0
|
||||
do i=1 to work1.0
|
||||
a=work1.i; b=Right(a,1)
|
||||
if b > 0 then do
|
||||
w+=1; work2.w=a||(b-1)
|
||||
end
|
||||
if b < 9 then do
|
||||
w+=1; work2.w=a||(b+1)
|
||||
end
|
||||
end i
|
||||
work2.0=w
|
||||
do i=1 to w
|
||||
work1.i=work2.i; n+=1; Esth.n=work2.i
|
||||
end i
|
||||
work1.0=w
|
||||
end
|
||||
Esth.0=n
|
||||
say n 'found'
|
||||
say
|
||||
return
|
||||
|
||||
Task3:
|
||||
-- Shows range Esthetic numbers in base 10
|
||||
-- using the generated array
|
||||
procedure expose Esth.
|
||||
arg n1,n2,all
|
||||
say 'Generated: Base 10 from' n1 'to' n2'...'
|
||||
i1=0; i2=0
|
||||
do i=1 to Esth.0
|
||||
a=Esth.i
|
||||
if a<n1 then
|
||||
iterate i
|
||||
if i1=0 then
|
||||
i1=i
|
||||
if a>n2 then do
|
||||
i2=i-1
|
||||
leave i
|
||||
end
|
||||
end i
|
||||
n=i2-i1+1
|
||||
if all then do
|
||||
k=0
|
||||
do i=i1 to i2
|
||||
k+=1
|
||||
call CharOut ,Esth.i' '
|
||||
if k//5=0 then
|
||||
say
|
||||
end i
|
||||
say
|
||||
end
|
||||
else do
|
||||
do i=i1 for 5
|
||||
call CharOut ,Esth.i' '
|
||||
end
|
||||
say; say '...'
|
||||
do i=i2-4 for 5
|
||||
call CharOut ,Esth.i' '
|
||||
end
|
||||
say
|
||||
end
|
||||
say n 'found'
|
||||
say
|
||||
return
|
||||
|
||||
-- D2n (convert decimal to base n)
|
||||
include Base
|
||||
-- Timer
|
||||
include Timer
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue