Perfect numbers: Difference between revisions
Content added Content deleted
(→{{header|Racket}}: waaay improved impl.) |
m (→Lucas-Lehmer + other optimizations: add/changed comments and whitespace.) |
||
| Line 1,864: | Line 1,864: | ||
An integer square root function was added to limit the factorization of a number. |
An integer square root function was added to limit the factorization of a number. |
||
<lang rexx>/*REXX program tests if a number (or a range of numbers) is/are perfect. */ |
<lang rexx>/*REXX program tests if a number (or a range of numbers) is/are perfect. */ |
||
parse arg low high . /*obtain optional arguments from the CL*/ |
parse arg low high . /*obtain optional arguments from the CL*/ |
||
if high=='' & low=='' then high=34000000 /*No |
if high=='' & low=='' then high=34000000 /*No arguments? Then use a range. */ |
||
if low=='' then low=1 /*if no LOW, then assume unity. */ |
if low=='' then low=1 /*if no LOW, then assume unity. */ |
||
low=low+low//2 /*if LOW is odd, bump it by one. */ |
low=low+low//2 /*if LOW is odd, bump it by one. */ |
||
if high=='' then high=low /*if no HIGH, then assume LOW. */ |
if high=='' then high=low /*if no HIGH, then assume LOW. */ |
||
w=length(high) /*use W for formatting the output. |
w=length(high) /*use W for formatting the output. */ |
||
numeric digits max(9,w+2) /*ensure enough decimal digits for nums*/ |
numeric digits max(9,w+2) /*ensure enough decimal digits for nums*/ |
||
@. =0; @.1=2; !.=2; _=' 6' /*highest magic number and its index.*/ |
@. =0; @.1=2; !.=2; _=' 6' /*highest magic number and its index.*/ |
||
!._=22; !.16=12; !.28=8; !.36=20; !.56=20; !.76=20; !.96=20 |
!._=22; !.16=12; !.28=8; !.36=20; !.56=20; !.76=20; !.96=20 |
||
/* [↑] "Lucas' numbers, in 1891. */ |
/* [↑] "Lucas' numbers, in 1891. */ |
||
do i=low to high by 0 /*process the single number or a range.*/ |
do i=low to high by 0 /*process the single number or a range.*/ |
||
if isPerfect(i) then say right(i,w) 'is a perfect number.' |
if isPerfect(i) then say right(i,w) 'is a perfect number.' |
||
i=i+!.? /*use a fast advance for the DO index. */ |
i=i+!.? /*use a fast advance for the DO index. */ |
||
end /*i*/ /* [↑] note: the DO index is modified.*/ |
end /*i*/ /* [↑] note: the DO index is modified.*/ |
||
exit /*stick a fork in it, we're all done. */ |
exit /*stick a fork in it, we're all done. */ |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
/*────────────────────────────────────────────────────────────────────────────*/ |
|||
isPerfect: procedure expose @. !. ? /*expose (make global) some variables. */ |
isPerfect: procedure expose @. !. ? /*expose (make global) some variables. */ |
||
parse arg x 1 y '' -2 ? /*# (and copy), and the last 2 digits.*/ |
parse arg x 1 y '' -2 ? /*# (and copy), and the last 2 digits.*/ |
||
if x==6 then return 1 /*handle the special case of six. */ |
if x==6 then return 1 /*handle the special case of six. */ |
||
if !.?==2 then return 0 /*test last two digits: François Lucas.*/ |
if !.?==2 then return 0 /*test last two digits: François Lucas.*/ |
||
/*╔════════════════════════════════════════════════════════════════════════════════════╗ |
|||
/*╔═════════════════════════════════════════════════════════════╗ |
|||
║ Lucas─Lehmer know that perfect numbers can be expressed as: [2^n -1] * {2^(n-1) } ║ |
|||
╚════════════════════════════════════════════════════════════════════════════════════╝*/ |
|||
| ⚫ | |||
| ⚫ | |||
╚═════════════════════════════════════════════════════════════╝*/ |
|||
| ⚫ | |||
| ⚫ | |||
end /*@.1*/ /* [↑] uses memoization for formula. */ |
|||
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer? Not perfect*/ |
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer? Not perfect*/ |
||
/*[↓] perfect numbers digital root = 1*/ |
/*[↓] perfect numbers digital root = 1*/ |
||
do until y<10 /*find the digital root of Y. */ |
do until y<10 /*find the digital root of Y. */ |
||
parse var y d 2; do k=2 for length(y)-1; d=d+substr(y,k,1); end |
parse var y d 2; do k=2 for length(y)-1; d=d+substr(y,k,1); end /*k*/ |
||
y=d /*find digital root of the digital root*/ |
y=d /*find digital root of the digital root*/ |
||
end /*until |
end /*until*/ /*wash, rinse, repeat ··· */ |
||
if d\==1 then return 0 /*Is digital root ¬ 1? Then ¬ perfect.*/ |
if d\==1 then return 0 /*Is digital root ¬ 1? Then ¬ perfect.*/ |
||
s=3 + x%2 /*we know the following factors: unity,*/ |
s=3 + x%2 /*we know the following factors: unity,*/ |
||
z=x /*2, and x÷2 (x is even). _____*/ |
z=x /*2, and x÷2 (x is even). _____*/ |
||
q=1; |
q=1; do while q<=z; q=q*4; end /*while q≤z*/ /* [↓] R will be the integer √ X */ |
||
r=0 |
r=0 |
||
do while q>1; q=q%4; _=z-r-q; r=r%2; if _>=0 then do; z=_; r=r+q; end |
|||
end /*while q>1*/ /* [↑] compute the integer SQRT of X.*/ |
|||
/* ___ */ |
/* ___ */ |
||
do j=3 to r until s>x /*starting at 3, find factors ≤ √ X */ |
do j=3 to r until s>x /*starting at 3, find factors ≤ √ X */ |
||
if x//j==0 then s=s+j+x%j /*J divisible by X? Then add J and X÷J*/ |
if x//j==0 then s=s+j+x%j /*J divisible by X? Then add J and X÷J*/ |
||
end /*j*/ |
end /*j*/ |
||
return s==x /*if the sum matches X, then perfect! */</lang> |
return s==x /*if the sum matches X, then perfect! */</lang> |
||
'''output''' is the same as the traditional version and is about '''500''' times faster (testing 34,000,000 numbers). <br><br> |
'''output''' is the same as the traditional version and is about '''500''' times faster (testing 34,000,000 numbers). <br><br> |
||