Talk:Rare numbers: Difference between revisions
Content added Content deleted
(→the 1<sup>st</sup> REXX version: added a new talk section.) |
(→the 2nd REXX version: added the 2nd REXX version.) |
||
Line 52: | Line 52: | ||
Not ready for prime time. |
Not ready for prime time. |
||
== the 2<sup>nd</sup> REXX version == |
|||
This is the 2<sup>nd</sup> REXX version, after all of the hints (properties |
|||
of ''rare'' numbers) within Shyam Sunder Gupta's webpage have been incorporated in this REXX program. |
|||
<lang rexx>/*REXX program to calculate and display an specified amount of rare numbers. */ |
|||
numeric digits 20; w= digits() + digits() % 3 /*ensure enough decimal digs for calcs.*/ |
|||
parse arg many start . /*obtain optional argument from the CL.*/ |
|||
if many=='' | many=="," then many= 5 /*Not specified? Then use the default.*/ |
|||
@dr.=0; @dr.2= 1; @dr.5=1 ; @dr.8= 1; @dr.9= 1 /*rare # must have these digital roots.*/ |
|||
@ps.=0; @ps.2= 1; @ps.3= 1; @ps.7= 1; @ps.8= 1 /*perfect squares must end in these.*/ |
|||
@end.=0; @end.1=1; @end.4=1; @end.6=1; @end.9=1 /*rare # must not end in these digits.*/ |
|||
@dif.=0; @dif.2=1; @dif.3=1; @dif.7=1; @dif.8=1; @dif.9=1 /* A─Q mustn't be these digs.*/ |
|||
@noq.=0; @noq.0=1; @noq.1=1; @noq.4=1; @noq.5=1; @noq.6=1; @noq.9=1 /*A=8, Q mustn't be*/ |
|||
@149.=0; @149.1=1; @149.4=1; @149.9=1 /*values for Z that need a even Y. */ |
|||
#= 0 /*the number of rare numbers (so far)*/ |
|||
@n05.=0; do i= 1 to 9; if i==0 | i==5 then iterate; @n05.i= 1; end /*¬1 ¬5*/ |
|||
@eve.=0; do i=-8 by 2 to 8; @eve.i=1; end /*define even " some are negative.*/ |
|||
@odd.=0; do i=-9 by 2 to 9; @odd.i=1; end /* " odd " " " " */ |
|||
/*N=10, 'cause 1 dig #s are palindromic*/ |
|||
do n=10; parse var n a 2 b 3 '' -2 p +1 q /*get 1st\2nd\penultimate\last digits. */ |
|||
if @end.q then iterate /*rare numbers can't end in: 1 4 6 or 9*/ |
|||
if q==3 then iterate |
|||
select /*weed some integers based on 1st digit*/ |
|||
when a==q then do |
|||
if a==2|a==8 then nop /*if A = Q, then A must be 2 or 8. */ |
|||
else iterate /*A not two or eight? Then skip.*/ |
|||
if b\==p then iterate /*B not equal to P? Then skip.*/ |
|||
end |
|||
when a==2 then do; if q\==2 then iterate /*A = 2? Then Q must also be 2. */ |
|||
if b\==p then iterate /*" " " Then B must equal P. */ |
|||
end |
|||
when a==4 then do |
|||
if q\==0 then iterate /*if Q not equal to zero, then skip it.*/ |
|||
_= b - p /*calculate difference between B and P.*/ |
|||
if @eve._ then iterate /*Positive not even? Then skip it.*/ |
|||
end |
|||
when a==6 then do |
|||
if @n05.q then iterate /*Q not a zero or five? Then skip it.*/ |
|||
_= b - p /*calculate difference between B and P.*/ |
|||
if @eve._ then iterate |
|||
end |
|||
when a==8 then do |
|||
if @noq.q then iterate /*Q isn't one of 2, 3, 7, 8? Skip it.*/ |
|||
select |
|||
when q==2 then if b+p\==9 then iterate |
|||
when q==3 then do; if b>p then if b-p\== 7 then iterate |
|||
else if b<p then if b-p\==-3 then iterate |
|||
else if b==p then iterate |
|||
end |
|||
when q==7 then do; if b>1 then if b+p\==11 then iterate |
|||
else if b==0 then if b+p\== 1 then iterate |
|||
end |
|||
when q==8 then if b\==p then iterate |
|||
otherwise nop |
|||
end /*select*/ |
|||
end /* [↓] A is an odd digit. */ |
|||
otherwise n= n + 10**(length(n) - 1) - 1 /*bump N so next N starts with even dig*/ |
|||
iterate /*Now, go and use the next value of N.*/ |
|||
end /*select*/ |
|||
_= a - q; if @dif._ then iterate /*diff of A─Q must be: 0, 1, 4, 5, or 6*/ |
|||
r= reverse(n) /*obtain the reverse of the number N. */ |
|||
if r>n then iterate /*Difference will be negative? Skip it*/ |
|||
if n==r then iterate /*Palindromic? Then it can't be rare.*/ |
|||
d= n-r; parse var d '' -2 y +1 z /*obtain the last 2 digs of difference.*/ |
|||
if @ps.z then iterate /*Not 0, 1, 4, 5, 6, 9? Not perfect sq.*/ |
|||
select |
|||
when z==0 then if y\==0 then iterate /*Does Z = 0? Then Y must be zero. */ |
|||
when z==5 then if y\==2 then iterate /*Does Z = 5? Then Y must be two. */ |
|||
when z==6 then if y//2==0 then iterate /*Does Z = 6? Then Y must be odd. */ |
|||
otherwise if @149.z then if y//2 then iterate /*Z=1,4,9? Y must be even*/ |
|||
end /*select*/ |
|||
s= n+r; parse var s '' -2 y +1 z /*obtain the last two digits of the sum*/ |
|||
if @ps.z then iterate /*Not 0, 2, 5, 8, or 9? Not perfect sq.*/ |
|||
select |
|||
when z==0 then if y\==0 then iterate /*Does Z = 0? Then Y must be zero. */ |
|||
when z==5 then if y\==2 then iterate /*Does Z = 5? Then Y must be two. */ |
|||
when z==6 then if y//2==0 then iterate /*Does Z = 6? Then Y must be odd. */ |
|||
otherwise if @149.z then if y//2 then iterate /*Z=1,4,9? Y must be even*/ |
|||
end /*select*/ |
|||
$= a + b /*a head start on figuring digital root*/ |
|||
do k=3 for length(n) - 2 /*now, process the rest of the digits. */ |
|||
$= $ + substr(n, k, 1) /*add the remainder of the digits in N.*/ |
|||
end /*k*/ |
|||
/*This REXX pgm uses 20 decimal digits.*/ |
|||
do while $>9 /* [◄] Algorithm is good for 111 digs.*/ |
|||
if $>9 then $= left($,1) + substr($,2,1)+ substr($,3,1,0) /*>9? Reduce to a dig*/ |
|||
end /*while*/ |
|||
if \@dr.$ then iterate /*Doesn't have good digital root? Skip*/ |
|||
if iSqrt(s)**2 \== s then iterate /*Not a perfect square? Then skip it. */ |
|||
if iSqrt(d)**2 \== d then iterate /* " " " " " " " */ |
|||
#= # + 1 /*bump the counter of rare numbers. */ |
|||
say right( th(#), length(#) + 9) ' rare number is: ' right( commas(n), w) |
|||
if #>=many then leave /* [↑] W: the width of # with commas.*/ |
|||
end /*n*/ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
commas: parse arg _; do jc=length(_)-3 to 1 by -3; _=insert(',', _, jc); end; return _ |
|||
th: parse arg th;return th||word('th st nd rd',1+(th//10)*(th//100%10\==1)*(th//10<4)) |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
iSqrt: parse arg x; $= 0; q= 1; do while q<=x; q= q*4 |
|||
end /*while q<=x*/ |
|||
do while q>1; q= q % 4; _= x-$-q; $= $ % 2 |
|||
if _>=0 then do; x= _; $= $ + q |
|||
end |
|||
end /*while q>1*/; return $</lang> |