Perfect numbers: Difference between revisions
(Factor) |
imported>Arakov |
||
(396 intermediate revisions by more than 100 users not shown) | |||
Line 1: | Line 1: | ||
[[category:Discrete math]] |
|||
{{task|Discrete math}}Write a function which says whether a number is perfect. |
|||
{{task|Prime Numbers}} |
|||
Write a function which says whether a number is perfect. |
|||
A number is perfect if the sum of its factors is equal to twice the number. An equivalent condition is that <tt>n</tt> is perfect if the sum of <tt>n</tt>'s factors that are less than <tt>n</tt> is equal to <tt>n</tt>. |
|||
<br> |
|||
Note: The faster [[Lucas-Lehmer test]] is used to find primes of the form 2<sup>''n''</sup>-1, all ''known'' perfect numbers can be derived from these primes using the formula (2<sup>''n''</sup> - 1) × 2<sup>''n'' - 1</sup>. It is not known if there are any odd perfect numbers. |
|||
[[wp:Perfect_numbers|A perfect number]] is a positive integer that is the sum of its proper positive divisors excluding the number itself. |
|||
Equivalently, a perfect number is a number that is half the sum of all of its positive divisors (including itself). |
|||
'''See also''' |
|||
* [[Rational Arithmetic]] |
|||
Note: The faster [[Lucas-Lehmer test]] is used to find primes of the form <big> 2<sup>''n''</sup>-1</big>, all ''known'' perfect numbers can be derived from these primes |
|||
using the formula <big> (2<sup>''n''</sup> - 1) × 2<sup>''n'' - 1</sup></big>. |
|||
It is not known if there are any odd perfect numbers (any that exist are larger than <big>10<sup>2000</sup></big>). |
|||
The number of ''known'' perfect numbers is '''51''' (as of December, 2018), and the largest known perfect number contains '''49,724,095''' decimal digits. |
|||
;See also: |
|||
:* [[Rational Arithmetic]] |
|||
:* [[oeis:A000396|Perfect numbers on OEIS]] |
|||
:* [http://www.oddperfect.org/ Odd Perfect] showing the current status of bounds on odd perfect numbers. |
|||
<br><br> |
|||
=={{header|11l}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="11l">F perf(n) |
|||
V sum = 0 |
|||
L(i) 1 .< n |
|||
I n % i == 0 |
|||
sum += i |
|||
R sum == n |
|||
L(i) 1..10000 |
|||
I perf(i) |
|||
print(i, end' ‘ ’)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 28 496 8128 |
|||
</pre> |
|||
=={{header|360 Assembly}}== |
|||
===Simple code=== |
|||
{{trans|PL/I}} |
|||
For maximum compatibility, this program uses only the basic instruction set (S/360) |
|||
and two ASSIST macros (XDECO,XPRNT) to keep it as short as possible. |
|||
The only added optimization is the loop up to n/2 instead of n-1. |
|||
With 31 bit integers the limit is 2,147,483,647. |
|||
<syntaxhighlight lang="360asm">* Perfect numbers 15/05/2016 |
|||
PERFECTN CSECT |
|||
USING PERFECTN,R13 prolog |
|||
SAVEAREA B STM-SAVEAREA(R15) " |
|||
DC 17F'0' " |
|||
STM STM R14,R12,12(R13) " |
|||
ST R13,4(R15) " |
|||
ST R15,8(R13) " |
|||
LR R13,R15 " |
|||
LA R6,2 i=2 |
|||
LOOPI C R6,NN do i=2 to nn |
|||
BH ELOOPI |
|||
LR R1,R6 i |
|||
BAL R14,PERFECT |
|||
LTR R0,R0 if perfect(i) |
|||
BZ NOTPERF |
|||
XDECO R6,PG edit i |
|||
XPRNT PG,L'PG print i |
|||
NOTPERF LA R6,1(R6) i=i+1 |
|||
B LOOPI |
|||
ELOOPI L R13,4(0,R13) epilog |
|||
LM R14,R12,12(R13) " |
|||
XR R15,R15 " |
|||
BR R14 exit |
|||
PERFECT SR R9,R9 function perfect(n); sum=0 |
|||
LA R7,1 j |
|||
LR R8,R1 n |
|||
SRA R8,1 n/2 |
|||
LOOPJ CR R7,R8 do j=1 to n/2 |
|||
BH ELOOPJ |
|||
LR R4,R1 n |
|||
SRDA R4,32 |
|||
DR R4,R7 n/j |
|||
LTR R4,R4 if mod(n,j)=0 |
|||
BNZ NOTMOD |
|||
AR R9,R7 sum=sum+j |
|||
NOTMOD LA R7,1(R7) j=j+1 |
|||
B LOOPJ |
|||
ELOOPJ SR R0,R0 r0=false |
|||
CR R9,R1 if sum=n |
|||
BNE NOTEQ |
|||
BCTR R0,0 r0=true |
|||
NOTEQ BR R14 return(r0); end perfect |
|||
NN DC F'10000' |
|||
PG DC CL12' ' buffer |
|||
YREGS |
|||
END PERFECTN</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
===Some optimizations=== |
|||
{{trans|REXX}} |
|||
Use of optimizations found in Rexx algorithms and use of packed decimal to have bigger numbers. |
|||
With 15 digit decimal integers the limit is 999,999,999,999,999. |
|||
<syntaxhighlight lang="360asm">* Perfect numbers 15/05/2016 |
|||
PERFECPO CSECT |
|||
USING PERFECPO,R13 prolog |
|||
SAVEAREA B STM-SAVEAREA(R15) " |
|||
DC 17F'0' " |
|||
STM STM R14,R12,12(R13) " |
|||
ST R13,4(R15) " |
|||
ST R15,8(R13) " |
|||
LR R13,R15 " |
|||
ZAP I,I1 i=i1 |
|||
LOOPI CP I,I2 do i=i1 to i2 |
|||
BH ELOOPI |
|||
LA R1,I r1=@i |
|||
BAL R14,PERFECT perfect(i) |
|||
LTR R0,R0 if perfect(i) |
|||
BZ NOTPERF |
|||
UNPK PG(16),I unpack i |
|||
OI PG+15,X'F0' |
|||
XPRNT PG,16 print i |
|||
NOTPERF AP I,=P'1' i=i+1 |
|||
B LOOPI |
|||
ELOOPI L R13,4(0,R13) epilog |
|||
LM R14,R12,12(R13) " |
|||
XR R15,R15 " |
|||
BR R14 exit |
|||
PERFECT EQU * function perfect(n); |
|||
ZAP N,0(8,R1) n=%r1 |
|||
CP N,=P'6' if n=6 |
|||
BNE NOT6 |
|||
L R0,=F'-1' r0=true |
|||
B RETURN return(true) |
|||
NOT6 ZAP PW,N n |
|||
SP PW,=P'1' n-1 |
|||
ZAP PW2,PW n-1 |
|||
DP PW2,=PL8'9' (n-1)/9 |
|||
ZAP R,PW2+8(8) if mod((n-1),9)<>0 |
|||
BZ ZERO |
|||
SR R0,R0 r0=false |
|||
B RETURN return(false) |
|||
ZERO ZAP PW2,N n |
|||
DP PW2,=PL8'2' n/2 |
|||
ZAP SUM,PW2(8) sum=n/2 |
|||
AP SUM,=P'3' sum=n/2+3 |
|||
ZAP J,=P'3' j=3 |
|||
LOOPJ ZAP PW,J do loop on j |
|||
MP PW,J j*j |
|||
CP PW,N while j*j<=n |
|||
BH ELOOPJ |
|||
ZAP PW2,N n |
|||
DP PW2,J n/j |
|||
CP PW2+8(8),=P'0' if mod(n,j)<>0 |
|||
BNE NEXTJ |
|||
AP SUM,J sum=sum+j |
|||
ZAP PW2,N n |
|||
DP PW2,J n/j |
|||
AP SUM,PW2(8) sum=sum+j+n/j |
|||
NEXTJ AP J,=P'1' j=j+1 |
|||
B LOOPJ next j |
|||
ELOOPJ SR R0,R0 r0=false |
|||
CP SUM,N if sum=n |
|||
BNE RETURN |
|||
BCTR R0,0 r0=true |
|||
RETURN BR R14 return(r0); end perfect |
|||
I1 DC PL8'1' |
|||
I2 DC PL8'200000000000' |
|||
I DS PL8 |
|||
PG DC CL16' ' buffer |
|||
N DS PL8 |
|||
SUM DS PL8 |
|||
J DS PL8 |
|||
R DS PL8 |
|||
C DS CL16 |
|||
PW DS PL8 |
|||
PW2 DS PL16 |
|||
YREGS |
|||
END PERFECPO</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
0000000000000006 |
|||
0000000000000028 |
|||
0000000000000496 |
|||
0000000000008128 |
|||
0000000033550337 |
|||
0000008589869056 |
|||
0000137438691328 |
|||
</pre> |
|||
=={{header|AArch64 Assembly}}== |
|||
{{works with|as|Raspberry Pi 3B version Buster 64 bits}} |
|||
<syntaxhighlight lang="aarch64 assembly"> |
|||
/* ARM assembly AARCH64 Raspberry PI 3B */ |
|||
/* program perfectNumber64.s */ |
|||
/* use Euclide Formula : if M=(2puis p)-1 is prime M * (M+1)/2 is perfect see Wikipedia */ |
|||
/*******************************************/ |
|||
/* Constantes file */ |
|||
/*******************************************/ |
|||
/* for this file see task include a file in language AArch64 assembly */ |
|||
.include "../includeConstantesARM64.inc" |
|||
.equ MAXI, 63 |
|||
/*********************************/ |
|||
/* Initialized data */ |
|||
/*********************************/ |
|||
.data |
|||
sMessResult: .asciz "Perfect : @ \n" |
|||
szMessOverflow: .asciz "Overflow in function isPrime.\n" |
|||
szCarriageReturn: .asciz "\n" |
|||
/*********************************/ |
|||
/* UnInitialized data */ |
|||
/*********************************/ |
|||
.bss |
|||
sZoneConv: .skip 24 |
|||
/*********************************/ |
|||
/* code section */ |
|||
/*********************************/ |
|||
.text |
|||
.global main |
|||
main: // entry of program |
|||
mov x4,2 // start 2 |
|||
mov x3,1 // counter 2 power |
|||
1: // begin loop |
|||
lsl x4,x4,1 // 2 power |
|||
sub x0,x4,1 // - 1 |
|||
bl isPrime // is prime ? |
|||
cbz x0,2f // no |
|||
sub x0,x4,1 // yes |
|||
mul x1,x0,x4 // multiply m by m-1 |
|||
lsr x0,x1,1 // divide by 2 |
|||
bl displayPerfect // and display |
|||
2: |
|||
add x3,x3,1 // next power of 2 |
|||
cmp x3,MAXI |
|||
blt 1b |
|||
100: // standard end of the program |
|||
mov x0,0 // return code |
|||
mov x8,EXIT // request to exit program |
|||
svc 0 // perform the system call |
|||
qAdrszCarriageReturn: .quad szCarriageReturn |
|||
qAdrsMessResult: .quad sMessResult |
|||
/******************************************************************/ |
|||
/* Display perfect number */ |
|||
/******************************************************************/ |
|||
/* x0 contains the number */ |
|||
displayPerfect: |
|||
stp x1,lr,[sp,-16]! // save registers |
|||
ldr x1,qAdrsZoneConv |
|||
bl conversion10 // call décimal conversion |
|||
ldr x0,qAdrsMessResult |
|||
ldr x1,qAdrsZoneConv // insert conversion in message |
|||
bl strInsertAtCharInc |
|||
bl affichageMess // display message |
|||
100: |
|||
ldp x1,lr,[sp],16 // restaur 2 registers |
|||
ret // return to address lr x30 |
|||
qAdrsZoneConv: .quad sZoneConv |
|||
/***************************************************/ |
|||
/* is a number prime ? */ |
|||
/***************************************************/ |
|||
/* x0 contains the number */ |
|||
/* x0 return 1 if prime else 0 */ |
|||
//2147483647 OK |
|||
//4294967297 NOK |
|||
//131071 OK |
|||
//1000003 OK |
|||
//10001363 OK |
|||
isPrime: |
|||
stp x1,lr,[sp,-16]! // save registres |
|||
stp x2,x3,[sp,-16]! // save registres |
|||
mov x2,x0 |
|||
sub x1,x0,#1 |
|||
cmp x2,0 |
|||
beq 99f // return zero |
|||
cmp x2,2 // for 1 and 2 return 1 |
|||
ble 2f |
|||
mov x0,#2 |
|||
bl moduloPuR64 |
|||
bcs 100f // error overflow |
|||
cmp x0,#1 |
|||
bne 99f // no prime |
|||
cmp x2,3 |
|||
beq 2f |
|||
mov x0,#3 |
|||
bl moduloPuR64 |
|||
blt 100f // error overflow |
|||
cmp x0,#1 |
|||
bne 99f |
|||
cmp x2,5 |
|||
beq 2f |
|||
mov x0,#5 |
|||
bl moduloPuR64 |
|||
bcs 100f // error overflow |
|||
cmp x0,#1 |
|||
bne 99f // Pas premier |
|||
cmp x2,7 |
|||
beq 2f |
|||
mov x0,#7 |
|||
bl moduloPuR64 |
|||
bcs 100f // error overflow |
|||
cmp x0,#1 |
|||
bne 99f // Pas premier |
|||
cmp x2,11 |
|||
beq 2f |
|||
mov x0,#11 |
|||
bl moduloPuR64 |
|||
bcs 100f // error overflow |
|||
cmp x0,#1 |
|||
bne 99f // Pas premier |
|||
cmp x2,13 |
|||
beq 2f |
|||
mov x0,#13 |
|||
bl moduloPuR64 |
|||
bcs 100f // error overflow |
|||
cmp x0,#1 |
|||
bne 99f // Pas premier |
|||
2: |
|||
cmn x0,0 // carry à zero no error |
|||
mov x0,1 // prime |
|||
b 100f |
|||
99: |
|||
cmn x0,0 // carry à zero no error |
|||
mov x0,#0 // prime |
|||
100: |
|||
ldp x2,x3,[sp],16 // restaur des 2 registres |
|||
ldp x1,lr,[sp],16 // restaur des 2 registres |
|||
ret |
|||
/**************************************************************/ |
|||
/********************************************************/ |
|||
/* Compute modulo de b power e modulo m */ |
|||
/* Exemple 4 puissance 13 modulo 497 = 445 */ |
|||
/********************************************************/ |
|||
/* x0 number */ |
|||
/* x1 exposant */ |
|||
/* x2 modulo */ |
|||
moduloPuR64: |
|||
stp x1,lr,[sp,-16]! // save registres |
|||
stp x3,x4,[sp,-16]! // save registres |
|||
stp x5,x6,[sp,-16]! // save registres |
|||
stp x7,x8,[sp,-16]! // save registres |
|||
stp x9,x10,[sp,-16]! // save registres |
|||
cbz x0,100f |
|||
cbz x1,100f |
|||
mov x8,x0 |
|||
mov x7,x1 |
|||
mov x6,1 // result |
|||
udiv x4,x8,x2 |
|||
msub x9,x4,x2,x8 // remainder |
|||
1: |
|||
tst x7,1 // if bit = 1 |
|||
beq 2f |
|||
mul x4,x9,x6 |
|||
umulh x5,x9,x6 |
|||
mov x6,x4 |
|||
mov x0,x6 |
|||
mov x1,x5 |
|||
bl divisionReg128U // division 128 bits |
|||
cbnz x1,99f // overflow |
|||
mov x6,x3 // remainder |
|||
2: |
|||
mul x8,x9,x9 |
|||
umulh x5,x9,x9 |
|||
mov x0,x8 |
|||
mov x1,x5 |
|||
bl divisionReg128U |
|||
cbnz x1,99f // overflow |
|||
mov x9,x3 |
|||
lsr x7,x7,1 |
|||
cbnz x7,1b |
|||
mov x0,x6 // result |
|||
cmn x0,0 // carry à zero no error |
|||
b 100f |
|||
99: |
|||
ldr x0,qAdrszMessOverflow |
|||
bl affichageMess // display error message |
|||
cmp x0,0 // carry set error |
|||
mov x0,-1 // code erreur |
|||
100: |
|||
ldp x9,x10,[sp],16 // restaur des 2 registres |
|||
ldp x7,x8,[sp],16 // restaur des 2 registres |
|||
ldp x5,x6,[sp],16 // restaur des 2 registres |
|||
ldp x3,x4,[sp],16 // restaur des 2 registres |
|||
ldp x1,lr,[sp],16 // restaur des 2 registres |
|||
ret // retour adresse lr x30 |
|||
qAdrszMessOverflow: .quad szMessOverflow |
|||
/***************************************************/ |
|||
/* division d un nombre de 128 bits par un nombre de 64 bits */ |
|||
/***************************************************/ |
|||
/* x0 contient partie basse dividende */ |
|||
/* x1 contient partie haute dividente */ |
|||
/* x2 contient le diviseur */ |
|||
/* x0 retourne partie basse quotient */ |
|||
/* x1 retourne partie haute quotient */ |
|||
/* x3 retourne le reste */ |
|||
divisionReg128U: |
|||
stp x6,lr,[sp,-16]! // save registres |
|||
stp x4,x5,[sp,-16]! // save registres |
|||
mov x5,#0 // raz du reste R |
|||
mov x3,#128 // compteur de boucle |
|||
mov x4,#0 // dernier bit |
|||
1: |
|||
lsl x5,x5,#1 // on decale le reste de 1 |
|||
tst x1,1<<63 // test du bit le plus à gauche |
|||
lsl x1,x1,#1 // on decale la partie haute du quotient de 1 |
|||
beq 2f |
|||
orr x5,x5,#1 // et on le pousse dans le reste R |
|||
2: |
|||
tst x0,1<<63 |
|||
lsl x0,x0,#1 // puis on decale la partie basse |
|||
beq 3f |
|||
orr x1,x1,#1 // et on pousse le bit de gauche dans la partie haute |
|||
3: |
|||
orr x0,x0,x4 // position du dernier bit du quotient |
|||
mov x4,#0 // raz du bit |
|||
cmp x5,x2 |
|||
blt 4f |
|||
sub x5,x5,x2 // on enleve le diviseur du reste |
|||
mov x4,#1 // dernier bit à 1 |
|||
4: |
|||
// et boucle |
|||
subs x3,x3,#1 |
|||
bgt 1b |
|||
lsl x1,x1,#1 // on decale le quotient de 1 |
|||
tst x0,1<<63 |
|||
lsl x0,x0,#1 // puis on decale la partie basse |
|||
beq 5f |
|||
orr x1,x1,#1 |
|||
5: |
|||
orr x0,x0,x4 // position du dernier bit du quotient |
|||
mov x3,x5 |
|||
100: |
|||
ldp x4,x5,[sp],16 // restaur des 2 registres |
|||
ldp x6,lr,[sp],16 // restaur des 2 registres |
|||
ret // retour adresse lr x30 |
|||
/********************************************************/ |
|||
/* File Include fonctions */ |
|||
/********************************************************/ |
|||
/* for this file see task include a file in language AArch64 assembly */ |
|||
.include "../includeARM64.inc" |
|||
</syntaxhighlight> |
|||
<pre> |
|||
Perfect : 6 |
|||
Perfect : 28 |
|||
Perfect : 496 |
|||
Perfect : 8128 |
|||
Perfect : 33550336 |
|||
Perfect : 8589869056 |
|||
Perfect : 137438691328 |
|||
Perfect : 2305843008139952128 |
|||
Perfect : 8070450532247928832 |
|||
</pre> |
|||
=={{header|Action!}}== |
|||
<syntaxhighlight lang="action!">PROC Main() |
|||
DEFINE MAXNUM="10000" |
|||
CARD ARRAY pds(MAXNUM+1) |
|||
CARD i,j |
|||
FOR i=2 TO MAXNUM |
|||
DO |
|||
pds(i)=1 |
|||
OD |
|||
FOR i=2 TO MAXNUM |
|||
DO |
|||
FOR j=i+i TO MAXNUM STEP i |
|||
DO |
|||
pds(j)==+i |
|||
OD |
|||
OD |
|||
FOR i=2 TO MAXNUM |
|||
DO |
|||
IF pds(i)=i THEN |
|||
PrintCE(i) |
|||
FI |
|||
OD |
|||
RETURN</syntaxhighlight> |
|||
{{out}} |
|||
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Perfect_numbers.png Screenshot from Atari 8-bit computer] |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=={{header|Ada}}== |
=={{header|Ada}}== |
||
< |
<syntaxhighlight lang="ada">function Is_Perfect(N : Positive) return Boolean is |
||
Sum : Natural := 0; |
Sum : Natural := 0; |
||
begin |
begin |
||
Line 18: | Line 514: | ||
end loop; |
end loop; |
||
return Sum = N; |
return Sum = N; |
||
end Is_Perfect;</ |
end Is_Perfect;</syntaxhighlight> |
||
=={{header|ALGOL 60}}== |
|||
{{works with|A60}} |
|||
<syntaxhighlight lang="algol60"> |
|||
begin |
|||
comment - return p mod q; |
|||
integer procedure mod(p, q); |
|||
value p, q; integer p, q; |
|||
begin |
|||
mod := p - q * entier(p / q); |
|||
end; |
|||
comment - return true if n is perfect, otherwise false; |
|||
boolean procedure isperfect(n); |
|||
value n; integer n; |
|||
begin |
|||
integer sum, f1, f2; |
|||
sum := 1; |
|||
f1 := 1; |
|||
for f1 := f1 + 1 while (f1 * f1) <= n do |
|||
begin |
|||
if mod(n, f1) = 0 then |
|||
begin |
|||
sum := sum + f1; |
|||
f2 := n / f1; |
|||
if f2 > f1 then sum := sum + f2; |
|||
end; |
|||
end; |
|||
isperfect := (sum = n); |
|||
end; |
|||
comment - exercise the procedure; |
|||
integer i, found; |
|||
outstring(1,"Searching up to 10000 for perfect numbers\n"); |
|||
found := 0; |
|||
for i := 2 step 1 until 10000 do |
|||
if isperfect(i) then |
|||
begin |
|||
outinteger(1,i); |
|||
found := found + 1; |
|||
end; |
|||
outstring(1,"\n"); |
|||
outinteger(1,found); |
|||
outstring(1,"perfect numbers were found"); |
|||
end |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Searching up to 10000 for perfect numbers |
|||
6 28 496 8128 |
|||
4 perfect numbers were found |
|||
</pre> |
|||
=={{header|ALGOL 68}}== |
=={{header|ALGOL 68}}== |
||
{{works with|ALGOL 68|Revision 1 - no extensions to language used}} |
{{works with|ALGOL 68|Revision 1 - no extensions to language used}} |
||
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny]}} |
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny]}} |
||
{{works with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d]}} |
{{works with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d]}} |
||
< |
<syntaxhighlight lang="algol68">PROC is perfect = (INT candidate)BOOL: ( |
||
INT sum :=1; |
INT sum :=1; |
||
FOR f1 FROM 2 TO ENTIER ( sqrt(candidate)*(1+2*small real) ) WHILE |
FOR f1 FROM 2 TO ENTIER ( sqrt(candidate)*(1+2*small real) ) WHILE |
||
Line 45: | Line 594: | ||
IF is perfect(i) THEN print((i, new line)) FI |
IF is perfect(i) THEN print((i, new line)) FI |
||
OD |
OD |
||
)</ |
)</syntaxhighlight> |
||
{{Out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
+6 |
+6 |
||
Line 54: | Line 603: | ||
+33550336 |
+33550336 |
||
</pre> |
</pre> |
||
=={{header|ALGOL W}}== |
|||
Based on the Algol 68 version. |
|||
<syntaxhighlight lang="algolw">begin |
|||
% returns true if n is perfect, false otherwise % |
|||
% n must be > 0 % |
|||
logical procedure isPerfect ( integer value candidate ) ; |
|||
begin |
|||
integer sum; |
|||
sum := 1; |
|||
for f1 := 2 until round( sqrt( candidate ) ) do begin |
|||
if candidate rem f1 = 0 then begin |
|||
integer f2; |
|||
sum := sum + f1; |
|||
f2 := candidate div f1; |
|||
% avoid e.g. counting 2 twice as a factor of 4 % |
|||
if f2 > f1 then sum := sum + f2 |
|||
end if_candidate_rem_f1_eq_0 ; |
|||
end for_f1 ; |
|||
sum = candidate |
|||
end isPerfect ; |
|||
% test isPerfect % |
|||
for n := 2 until 10000 do if isPerfect( n ) then write( n ); |
|||
end.</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=={{header|AppleScript}}== |
|||
===Functional=== |
|||
{{Trans|JavaScript}} |
|||
<syntaxhighlight lang="applescript">-- PERFECT NUMBERS ----------------------------------------------------------- |
|||
-- perfect :: integer -> bool |
|||
on perfect(n) |
|||
-- isFactor :: integer -> bool |
|||
script isFactor |
|||
on |λ|(x) |
|||
n mod x = 0 |
|||
end |λ| |
|||
end script |
|||
-- quotient :: number -> number |
|||
script quotient |
|||
on |λ|(x) |
|||
n / x |
|||
end |λ| |
|||
end script |
|||
-- sum :: number -> number -> number |
|||
script sum |
|||
on |λ|(a, b) |
|||
a + b |
|||
end |λ| |
|||
end script |
|||
-- Integer factors of n below the square root |
|||
set lows to filter(isFactor, enumFromTo(1, (n ^ (1 / 2)) as integer)) |
|||
-- low and high factors (quotients of low factors) tested for perfection |
|||
(n > 1) and (foldl(sum, 0, (lows & map(quotient, lows))) / 2 = n) |
|||
end perfect |
|||
-- TEST ---------------------------------------------------------------------- |
|||
on run |
|||
filter(perfect, enumFromTo(1, 10000)) |
|||
--> {6, 28, 496, 8128} |
|||
end run |
|||
-- GENERIC FUNCTIONS --------------------------------------------------------- |
|||
-- enumFromTo :: Int -> Int -> [Int] |
|||
on enumFromTo(m, n) |
|||
if m > n then |
|||
set d to -1 |
|||
else |
|||
set d to 1 |
|||
end if |
|||
set lst to {} |
|||
repeat with i from m to n by d |
|||
set end of lst to i |
|||
end repeat |
|||
return lst |
|||
end enumFromTo |
|||
-- filter :: (a -> Bool) -> [a] -> [a] |
|||
on filter(f, xs) |
|||
tell mReturn(f) |
|||
set lst to {} |
|||
set lng to length of xs |
|||
repeat with i from 1 to lng |
|||
set v to item i of xs |
|||
if |λ|(v, i, xs) then set end of lst to v |
|||
end repeat |
|||
return lst |
|||
end tell |
|||
end filter |
|||
-- foldl :: (a -> b -> a) -> a -> [b] -> a |
|||
on foldl(f, startValue, xs) |
|||
tell mReturn(f) |
|||
set v to startValue |
|||
set lng to length of xs |
|||
repeat with i from 1 to lng |
|||
set v to |λ|(v, item i of xs, i, xs) |
|||
end repeat |
|||
return v |
|||
end tell |
|||
end foldl |
|||
-- map :: (a -> b) -> [a] -> [b] |
|||
on map(f, xs) |
|||
tell mReturn(f) |
|||
set lng to length of xs |
|||
set lst to {} |
|||
repeat with i from 1 to lng |
|||
set end of lst to |λ|(item i of xs, i, xs) |
|||
end repeat |
|||
return lst |
|||
end tell |
|||
end map |
|||
-- Lift 2nd class handler function into 1st class script wrapper |
|||
-- mReturn :: Handler -> Script |
|||
on mReturn(f) |
|||
if class of f is script then |
|||
f |
|||
else |
|||
script |
|||
property |λ| : f |
|||
end script |
|||
end if |
|||
end mReturn</syntaxhighlight> |
|||
{{Out}} |
|||
<syntaxhighlight lang="applescript">{6, 28, 496, 8128}</syntaxhighlight> |
|||
---- |
|||
===Idiomatic=== |
|||
====Sum of proper divisors==== |
|||
<syntaxhighlight lang="applescript">on aliquotSum(n) |
|||
if (n < 2) then return 0 |
|||
set sum to 1 |
|||
set sqrt to n ^ 0.5 |
|||
set limit to sqrt div 1 |
|||
if (limit = sqrt) then |
|||
set sum to sum + limit |
|||
set limit to limit - 1 |
|||
end if |
|||
repeat with i from 2 to limit |
|||
if (n mod i is 0) then set sum to sum + i + n div i |
|||
end repeat |
|||
return sum |
|||
end aliquotSum |
|||
on isPerfect(n) |
|||
if (n > 1.37438691328E+11) then return missing value -- Too high for perfection to be determinable. |
|||
-- All the known perfect numbers listed in Wikipedia end with either 6 or 28. |
|||
-- These endings are either preceded by odd digits or are the numbers themselves. |
|||
tell (n mod 10) to ¬ |
|||
return ((((it = 6) and ((n mod 20 = 16) or (n = 6))) or ¬ |
|||
((it = 8) and ((n mod 200 = 128) or (n = 28)))) and ¬ |
|||
(my aliquotSum(n) = n)) |
|||
end isPerfect |
|||
local output, n |
|||
set output to {} |
|||
repeat with n from 1 to 10000 |
|||
if (isPerfect(n)) then set end of output to n |
|||
end repeat |
|||
return output</syntaxhighlight> |
|||
{{output}} |
|||
<syntaxhighlight lang="applescript">{6, 28, 496, 8128}</syntaxhighlight> |
|||
====Euclid==== |
|||
<syntaxhighlight lang="applescript">on isPerfect(n) |
|||
-- All the known perfect numbers listed in Wikipedia end with either 6 or 28. |
|||
-- These endings are either preceded by odd digits or are the numbers themselves. |
|||
tell (n mod 10) to ¬ |
|||
if not (((it = 6) and ((n mod 20 = 16) or (n = 6))) or ((it = 8) and ((n mod 200 = 128) or (n = 28)))) then ¬ |
|||
return false |
|||
-- Work through the only seven primes p where (2 ^ p - 1) is also prime |
|||
-- and (2 ^ p - 1) * (2 ^ (p - 1)) is a number that AppleScript can handle. |
|||
repeat with p in {2, 3, 5, 7, 13, 17, 19} |
|||
tell (2 ^ p - 1) * (2 ^ (p - 1)) |
|||
if (it < n) then |
|||
else |
|||
return (it = n) |
|||
end if |
|||
end tell |
|||
end repeat |
|||
return missing value |
|||
end isPerfect |
|||
local output, n |
|||
set output to {} |
|||
repeat with n from 2 to 33551000 by 2 |
|||
if (isPerfect(n)) then set end of output to n |
|||
end repeat |
|||
return output</syntaxhighlight> |
|||
{{output}} |
|||
<syntaxhighlight lang="applescript">{6, 28, 496, 8128, 33550336}</syntaxhighlight> |
|||
====Practical==== |
|||
But since AppleScript can only physically manage seven of the known perfect numbers, they may as well be in a look-up list for maximum efficiency: |
|||
<syntaxhighlight lang="applescript">on isPerfect(n) |
|||
if (n > 1.37438691328E+11) then return missing value -- Too high for perfection to be determinable. |
|||
return (n is in {6, 28, 496, 8128, 33550336, 8.589869056E+9, 1.37438691328E+11}) |
|||
end isPerfect</syntaxhighlight> |
|||
=={{header|ARM Assembly}}== |
|||
{{works with|as|Raspberry Pi}} |
|||
<syntaxhighlight lang="arm assembly"> |
|||
/* ARM assembly Raspberry PI */ |
|||
/* program perfectNumber.s */ |
|||
/* REMARK 1 : this program use routines in a include file |
|||
see task Include a file language arm assembly |
|||
for the routine affichageMess conversion10 |
|||
see at end of this program the instruction include */ |
|||
/* for constantes see task include a file in arm assembly */ |
|||
/************************************/ |
|||
/* Constantes */ |
|||
/************************************/ |
|||
.include "../constantes.inc" |
|||
.equ MAXI, 1<<31 |
|||
/*********************************/ |
|||
/* Initialized data */ |
|||
/*********************************/ |
|||
.data |
|||
sMessResultPerf: .asciz "Perfect : @ \n" |
|||
szCarriageReturn: .asciz "\n" |
|||
/*********************************/ |
|||
/* UnInitialized data */ |
|||
/*********************************/ |
|||
.bss |
|||
sZoneConv: .skip 24 |
|||
/*********************************/ |
|||
/* code section */ |
|||
/*********************************/ |
|||
.text |
|||
.global main |
|||
main: @ entry of program |
|||
mov r2,#2 @ begin first number |
|||
1: @ begin loop |
|||
mov r5,#1 @ sum |
|||
mov r4,#2 @ first divisor 1 |
|||
2: |
|||
udiv r0,r2,r4 @ compute divisor 2 |
|||
mls r3,r0,r4,r2 @ remainder |
|||
cmp r3,#0 |
|||
bne 3f @ remainder = 0 ? |
|||
add r5,r5,r0 @ add divisor 2 |
|||
add r5,r5,r4 @ add divisor 1 |
|||
3: |
|||
add r4,r4,#1 @ increment divisor |
|||
cmp r4,r0 @ divisor 1 < divisor 2 |
|||
blt 2b @ yes -> loop |
|||
cmp r2,r5 @ compare number and divisors sum |
|||
bne 4f @ not equal |
|||
mov r0,r2 @ equal -> display |
|||
ldr r1,iAdrsZoneConv |
|||
bl conversion10 @ call décimal conversion |
|||
ldr r0,iAdrsMessResultPerf |
|||
ldr r1,iAdrsZoneConv @ insert conversion in message |
|||
bl strInsertAtCharInc |
|||
bl affichageMess @ display message |
|||
4: |
|||
add r2,#2 @ no perfect number odd < 10 puis 1500 |
|||
cmp r2,#MAXI @ end ? |
|||
blo 1b @ no -> loop |
|||
100: @ standard end of the program |
|||
mov r0, #0 @ return code |
|||
mov r7, #EXIT @ request to exit program |
|||
svc #0 @ perform the system call |
|||
iAdrszCarriageReturn: .int szCarriageReturn |
|||
iAdrsMessResultPerf: .int sMessResultPerf |
|||
iAdrsZoneConv: .int sZoneConv |
|||
/***************************************************/ |
|||
/* ROUTINES INCLUDE */ |
|||
/***************************************************/ |
|||
.include "../affichage.inc" |
|||
</syntaxhighlight> |
|||
<pre> |
|||
Perfect : 6 |
|||
Perfect : 28 |
|||
Perfect : 496 |
|||
Perfect : 8128 |
|||
Perfect : 33550336 |
|||
</pre> |
|||
=={{header|Arturo}}== |
|||
<syntaxhighlight lang="rebol">divisors: $[n][ select 1..(n/2)+1 'i -> 0 = n % i ] |
|||
perfect?: $[n][ n = sum divisors n ] |
|||
loop 2..1000 'i [ |
|||
if perfect? i -> print i |
|||
]</syntaxhighlight> |
|||
=={{header|AutoHotkey}}== |
=={{header|AutoHotkey}}== |
||
This will find the first 8 perfect numbers. |
This will find the first 8 perfect numbers. |
||
< |
<syntaxhighlight lang="autohotkey">Loop, 30 { |
||
If isMersennePrime(A_Index + 1) |
If isMersennePrime(A_Index + 1) |
||
res .= "Perfect number: " perfectNum(A_Index + 1) "`n" |
res .= "Perfect number: " perfectNum(A_Index + 1) "`n" |
||
Line 78: | Line 943: | ||
Return false |
Return false |
||
Return true |
Return true |
||
}</ |
}</syntaxhighlight> |
||
=={{header|AWK}}== |
=={{header|AWK}}== |
||
< |
<syntaxhighlight lang="awk">$ awk 'func perf(n){s=0;for(i=1;i<n;i++)if(n%i==0)s+=i;return(s==n)} |
||
BEGIN{for(i=1;i<10000;i++)if(perf(i))print i}' |
BEGIN{for(i=1;i<10000;i++)if(perf(i))print i}' |
||
6 |
6 |
||
28 |
28 |
||
496 |
496 |
||
8128</ |
8128</syntaxhighlight> |
||
=={{header|Axiom}}== |
|||
{{trans|Mathematica}} |
|||
Using the interpreter, define the function: |
|||
<syntaxhighlight lang="axiom">perfect?(n:Integer):Boolean == reduce(+,divisors n) = 2*n</syntaxhighlight> |
|||
Alternatively, using the Spad compiler: |
|||
<syntaxhighlight lang="axiom">)abbrev package TESTP TestPackage |
|||
TestPackage() : withma |
|||
perfect?: Integer -> Boolean |
|||
== |
|||
add |
|||
import IntegerNumberTheoryFunctions |
|||
perfect? n == reduce("+",divisors n) = 2*n</syntaxhighlight> |
|||
Examples (testing 496, testing 128, finding all perfect numbers in 1...10000): |
|||
<syntaxhighlight lang="axiom">perfect? 496 |
|||
perfect? 128 |
|||
[i for i in 1..10000 | perfect? i]</syntaxhighlight> |
|||
{{Out}} |
|||
<syntaxhighlight lang="axiom">true |
|||
false |
|||
[6,28,496,8128]</syntaxhighlight> |
|||
=={{header|BASIC}}== |
=={{header|BASIC}}== |
||
{{works with|QuickBasic|4.5}} |
{{works with|QuickBasic|4.5}} |
||
< |
<syntaxhighlight lang="qbasic">FUNCTION perf(n) |
||
sum = 0 |
sum = 0 |
||
for i = 1 to n - 1 |
for i = 1 to n - 1 |
||
Line 102: | Line 989: | ||
perf = 0 |
perf = 0 |
||
END IF |
END IF |
||
END FUNCTION</ |
END FUNCTION</syntaxhighlight> |
||
==={{header|BASIC256}}=== |
|||
{{trans|FreeBASIC}} |
|||
<syntaxhighlight lang="basic256"> |
|||
function isPerfect(n) |
|||
if (n < 2) or (n mod 2 = 1) then return False |
|||
#asumimos que los números impares no son perfectos |
|||
sum = 1 |
|||
for i = 2 to sqr(n) |
|||
if n mod i = 0 then |
|||
sum += i |
|||
q = n \ i |
|||
if q > i then sum += q |
|||
end if |
|||
next |
|||
return n = sum |
|||
end function |
|||
print "Los primeros 5 números perfectos son:" |
|||
for i = 2 to 233550336 |
|||
if isPerfect(i) then print i; " "; |
|||
next i |
|||
end |
|||
</syntaxhighlight> |
|||
==={{header|Craft Basic}}=== |
|||
<syntaxhighlight lang="basic">for n = 1 to 10000 |
|||
let s = 0 |
|||
for i = 1 to n / 2 |
|||
if n % i = 0 then |
|||
let s = s + i |
|||
endif |
|||
next i |
|||
if s = n then |
|||
print n, " ", |
|||
endif |
|||
wait |
|||
next n</syntaxhighlight> |
|||
{{out| Output}}<pre>6 28 496 8128 </pre> |
|||
==={{header|IS-BASIC}}=== |
|||
<syntaxhighlight lang="is-basic">100 PROGRAM "PerfectN.bas" |
|||
110 FOR X=1 TO 10000 |
|||
120 IF PERFECT(X) THEN PRINT X; |
|||
130 NEXT |
|||
140 DEF PERFECT(N) |
|||
150 IF N<2 OR MOD(N,2)<>0 THEN LET PERFECT=0:EXIT DEF |
|||
160 LET S=1 |
|||
170 FOR I=2 TO SQR(N) |
|||
180 IF MOD(N,I)=0 THEN LET S=S+I+N/I |
|||
190 NEXT |
|||
200 LET PERFECT=N=S |
|||
210 END DEF</syntaxhighlight> |
|||
==={{header|Sinclair ZX81 BASIC}}=== |
|||
Call this subroutine and it will (eventually) return <tt>PERFECT</tt> = 1 if <tt>N</tt> is perfect or <tt>PERFECT</tt> = 0 if it is not. |
|||
<syntaxhighlight lang="basic">2000 LET SUM=0 |
|||
2010 FOR F=1 TO N-1 |
|||
2020 IF N/F=INT (N/F) THEN LET SUM=SUM+F |
|||
2030 NEXT F |
|||
2040 LET PERFECT=SUM=N |
|||
2050 RETURN</syntaxhighlight> |
|||
==={{header|True BASIC}}=== |
|||
<syntaxhighlight lang="basic"> |
|||
FUNCTION perf(n) |
|||
IF n < 2 or ramainder(n,2) = 1 then LET perf = 0 |
|||
LET sum = 0 |
|||
FOR i = 1 to n-1 |
|||
IF remainder(n,i) = 0 then LET sum = sum+i |
|||
NEXT i |
|||
IF sum = n then |
|||
LET perf = 1 |
|||
ELSE |
|||
LET perf = 0 |
|||
END IF |
|||
END FUNCTION |
|||
PRINT "Los primeros 5 números perfectos son:" |
|||
FOR i = 1 to 33550336 |
|||
IF perf(i) = 1 then PRINT i; " "; |
|||
NEXT i |
|||
PRINT |
|||
PRINT "Presione cualquier tecla para salir" |
|||
END |
|||
</syntaxhighlight> |
|||
=={{header|BBC BASIC}}== |
|||
===BASIC version=== |
|||
<syntaxhighlight lang="bbcbasic"> FOR n% = 2 TO 10000 STEP 2 |
|||
IF FNperfect(n%) PRINT n% |
|||
NEXT |
|||
END |
|||
DEF FNperfect(N%) |
|||
LOCAL I%, S% |
|||
S% = 1 |
|||
FOR I% = 2 TO SQR(N%)-1 |
|||
IF N% MOD I% = 0 S% += I% + N% DIV I% |
|||
NEXT |
|||
IF I% = SQR(N%) S% += I% |
|||
= (N% = S%)</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
===Assembler version=== |
|||
{{works with|BBC BASIC for Windows}} |
|||
<syntaxhighlight lang="bbcbasic"> DIM P% 100 |
|||
[OPT 2 :.S% xor edi,edi |
|||
.perloop mov eax,ebx : cdq : div ecx : or edx,edx : loopnz perloop : inc ecx |
|||
add edi,ecx : add edi,eax : loop perloop : mov eax,edi : shr eax,1 : ret : ] |
|||
FOR B% = 2 TO 35000000 STEP 2 |
|||
C% = SQRB% |
|||
IF B% = USRS% PRINT B% |
|||
NEXT |
|||
END</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
4 |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
33550336 |
|||
</pre> |
|||
=={{header|Bracmat}}== |
|||
<syntaxhighlight lang="bracmat">( ( perf |
|||
= sum i |
|||
. 0:?sum |
|||
& 0:?i |
|||
& whl |
|||
' ( !i+1:<!arg:?i |
|||
& ( mod$(!arg.!i):0&!sum+!i:?sum |
|||
| |
|||
) |
|||
) |
|||
& !sum:!arg |
|||
) |
|||
& 0:?n |
|||
& whl |
|||
' ( !n+1:~>10000:?n |
|||
& (perf$!n&out$!n|) |
|||
) |
|||
);</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>6 |
|||
28 |
|||
496 |
|||
8128</pre> |
|||
=={{header|Burlesque}}== |
|||
<syntaxhighlight lang="burlesque">Jfc++\/2.*==</syntaxhighlight> |
|||
<syntaxhighlight lang="burlesque">blsq) 8200ro{Jfc++\/2.*==}f[ |
|||
{6 28 496 8128}</syntaxhighlight> |
|||
=={{header|C}}== |
=={{header|C}}== |
||
{{trans|D}} |
{{trans|D}} |
||
<syntaxhighlight lang="c">#include "stdio.h" |
|||
<lang c>#include "stdio.h" |
|||
#include "math.h" |
#include "math.h" |
||
Line 133: | Line 1,195: | ||
return 0; |
return 0; |
||
}</ |
}</syntaxhighlight> |
||
Using functions from [[Factors of an integer#Prime factoring]]: |
|||
<syntaxhighlight lang="c">int main() |
|||
{ |
|||
int j; |
|||
ulong fac[10000], n, sum; |
|||
sieve(); |
|||
for (n = 2; n < 33550337; n++) { |
|||
j = get_factors(n, fac) - 1; |
|||
for (sum = 0; j && sum <= n; sum += fac[--j]); |
|||
if (sum == n) printf("%lu\n", n); |
|||
} |
|||
return 0; |
|||
}</syntaxhighlight> |
|||
=={{header|C sharp|C#}}== |
=={{header|C sharp|C#}}== |
||
{{trans|C++}} |
{{trans|C++}} |
||
<syntaxhighlight lang="csharp">static void Main(string[] args) |
|||
<lang csharp> |
|||
static void Main(string[] args) |
|||
{ |
{ |
||
Console.WriteLine("Perfect numbers from 1 to 33550337:"); |
Console.WriteLine("Perfect numbers from 1 to 33550337:"); |
||
Line 154: | Line 1,231: | ||
{ |
{ |
||
int sum = 0; |
int sum = 0; |
||
for (int i = 1; i < num |
for (int i = 1; i < num; i++) |
||
{ |
{ |
||
if (num % i == 0) |
if (num % i == 0) |
||
Line 160: | Line 1,237: | ||
} |
} |
||
return |
return sum == num ; |
||
}</syntaxhighlight> |
|||
===Version using Lambdas, will only work from version 3 of C# on=== |
|||
<syntaxhighlight lang="csharp">static void Main(string[] args) |
|||
{ |
|||
Console.WriteLine("Perfect numbers from 1 to 33550337:"); |
|||
for (int x = 0; x < 33550337; x++) |
|||
{ |
|||
if (IsPerfect(x)) |
|||
Console.WriteLine(x + " is perfect."); |
|||
} |
|||
Console.ReadLine(); |
|||
} |
} |
||
</lang> |
|||
static bool IsPerfect(int num) |
|||
{ |
|||
return Enumerable.Range(1, num - 1).Sum(n => num % n == 0 ? n : 0 ) == num; |
|||
}</syntaxhighlight> |
|||
=={{header|C++}}== |
=={{header|C++}}== |
||
{{works with|gcc}} |
{{works with|gcc}} |
||
< |
<syntaxhighlight lang="cpp">#include <iostream> |
||
using namespace std ; |
using namespace std ; |
||
int divisor_sum( int number ) { |
|||
int sum = 0 ; |
|||
for ( int i = 1 ; i < number ; i++ ) |
|||
if ( number % i == 0 ) |
|||
sum += i ; |
|||
return sum; |
|||
} |
|||
int main( ) { |
int main( ) { |
||
cout << "Perfect numbers from 1 to 33550337:\n" ; |
cout << "Perfect numbers from 1 to 33550337:\n" ; |
||
for ( int num = 1 ; num < 33550337 ; num++ ) { |
for ( int num = 1 ; num < 33550337 ; num++ ) { |
||
if ( |
if (divisor_sum(num) == num) |
||
cout << num << '\n' ; |
cout << num << '\n' ; |
||
} |
} |
||
return 0 ; |
return 0 ; |
||
} |
} |
||
</syntaxhighlight> |
|||
bool is_perfect( int number ) { |
|||
int sum = 0 ; |
|||
for ( int i = 1 ; i < number + 1 ; i++ ) |
|||
if ( number % i == 0 ) |
|||
sum += i ; |
|||
return ( ( sum == 2 * number ) || ( sum - number == number ) ) ; |
|||
}</lang> |
|||
=={{header|Clojure}}== |
=={{header|Clojure}}== |
||
< |
<syntaxhighlight lang="clojure">(defn proper-divisors [n] |
||
(if (< n 4) |
(if (< n 4) |
||
[1] |
|||
( |
(->> (range 2 (inc (quot n 2))) |
||
(filter #(zero? (rem n %))) |
|||
) |
|||
(cons 1)))) |
|||
(defn perfect? [n] |
(defn perfect? [n] |
||
( |
(= (reduce + (proper-divisors n)) n))</syntaxhighlight> |
||
)</lang> |
|||
{{trans|Haskell}} |
|||
<syntaxhighlight lang="clojure">(defn perfect? [n] |
|||
(->> (for [i (range 1 n)] :when (zero? (rem n i))] i) |
|||
(reduce +) |
|||
(= n)))</syntaxhighlight> |
|||
===Functional version=== |
|||
<syntaxhighlight lang="clojure">(defn perfect? [n] |
|||
(= (reduce + (filter #(zero? (rem n %)) (range 1 n))) n))</syntaxhighlight> |
|||
=={{header|COBOL}}== |
|||
{{trans|D}} |
|||
{{works with|Visual COBOL}} |
|||
main.cbl: |
|||
<syntaxhighlight lang="cobol"> $set REPOSITORY "UPDATE ON" |
|||
IDENTIFICATION DIVISION. |
|||
PROGRAM-ID. perfect-main. |
|||
ENVIRONMENT DIVISION. |
|||
CONFIGURATION SECTION. |
|||
REPOSITORY. |
|||
FUNCTION perfect |
|||
. |
|||
DATA DIVISION. |
|||
WORKING-STORAGE SECTION. |
|||
01 i PIC 9(8). |
|||
PROCEDURE DIVISION. |
|||
PERFORM VARYING i FROM 2 BY 1 UNTIL 33550337 = i |
|||
IF FUNCTION perfect(i) = 0 |
|||
DISPLAY i |
|||
END-IF |
|||
END-PERFORM |
|||
GOBACK |
|||
. |
|||
END PROGRAM perfect-main.</syntaxhighlight> |
|||
perfect.cbl: |
|||
<syntaxhighlight lang="cobol"> IDENTIFICATION DIVISION. |
|||
FUNCTION-ID. perfect. |
|||
DATA DIVISION. |
|||
LOCAL-STORAGE SECTION. |
|||
01 max-val PIC 9(8). |
|||
01 total PIC 9(8) VALUE 1. |
|||
01 i PIC 9(8). |
|||
01 q PIC 9(8). |
|||
LINKAGE SECTION. |
|||
01 n PIC 9(8). |
|||
01 is-perfect PIC 9. |
|||
PROCEDURE DIVISION USING VALUE n RETURNING is-perfect. |
|||
COMPUTE max-val = FUNCTION INTEGER(FUNCTION SQRT(n)) + 1 |
|||
PERFORM VARYING i FROM 2 BY 1 UNTIL i = max-val |
|||
IF FUNCTION MOD(n, i) = 0 |
|||
ADD i TO total |
|||
DIVIDE n BY i GIVING q |
|||
IF q > i |
|||
ADD q TO total |
|||
END-IF |
|||
END-IF |
|||
END-PERFORM |
|||
IF total = n |
|||
MOVE 0 TO is-perfect |
|||
ELSE |
|||
MOVE 1 TO is-perfect |
|||
END-IF |
|||
GOBACK |
|||
. |
|||
END FUNCTION perfect.</syntaxhighlight> |
|||
=={{header|CoffeeScript}}== |
|||
Optimized version, for fun. |
|||
<syntaxhighlight lang="coffeescript">is_perfect_number = (n) -> |
|||
do_factors_add_up_to n, 2*n |
|||
do_factors_add_up_to = (n, desired_sum) -> |
|||
# We mildly optimize here, by taking advantage of |
|||
# the fact that the sum_of_factors( (p^m) * x) |
|||
# is (1 + ... + p^m-1 + p^m) * sum_factors(x) when |
|||
# x is not itself a multiple of p. |
|||
p = smallest_prime_factor(n) |
|||
if p == n |
|||
return desired_sum == p + 1 |
|||
# ok, now sum up all powers of p that |
|||
# divide n |
|||
sum_powers = 1 |
|||
curr_power = 1 |
|||
while n % p == 0 |
|||
curr_power *= p |
|||
sum_powers += curr_power |
|||
n /= p |
|||
# if desired_sum does not divide sum_powers, we |
|||
# can short circuit quickly |
|||
return false unless desired_sum % sum_powers == 0 |
|||
# otherwise, recurse |
|||
do_factors_add_up_to n, desired_sum / sum_powers |
|||
smallest_prime_factor = (n) -> |
|||
for i in [2..n] |
|||
return n if i*i > n |
|||
return i if n % i == 0 |
|||
# tests |
|||
do -> |
|||
# This is pretty fast... |
|||
for n in [2..100000] |
|||
console.log n if is_perfect_number n |
|||
# For big numbers, let's just sanity check the known ones. |
|||
known_perfects = [ |
|||
33550336 |
|||
8589869056 |
|||
137438691328 |
|||
] |
|||
for n in known_perfects |
|||
throw Error("fail") unless is_perfect_number(n) |
|||
throw Error("fail") if is_perfect_number(n+1)</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
> coffee perfect_numbers.coffee |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
{{trans|Haskell}} |
{{trans|Haskell}} |
||
< |
<syntaxhighlight lang="lisp">(defun perfectp (n) |
||
(= n (loop for i from 1 below n when (= 0 (mod n i)) sum i)))</ |
(= n (loop for i from 1 below n when (= 0 (mod n i)) sum i)))</syntaxhighlight> |
||
=={{header|D}}== |
=={{header|D}}== |
||
===Functional Version=== |
|||
Based on the Algol version: |
|||
< |
<syntaxhighlight lang="d">import std.stdio, std.algorithm, std.range; |
||
bool |
bool isPerfectNumber1(in uint n) pure nothrow |
||
in { |
|||
assert(n > 0); |
|||
} body { |
|||
return n == iota(1, n - 1).filter!(i => n % i == 0).sum; |
|||
} |
|||
void main() { |
|||
iota(1, 10_000).filter!isPerfectNumber1.writeln; |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>[6, 28, 496, 8128]</pre> |
|||
===Faster Imperative Version=== |
|||
{{trans|Algol}} |
|||
<syntaxhighlight lang="d">import std.stdio, std.math, std.range, std.algorithm; |
|||
bool isPerfectNumber2(in int n) pure nothrow { |
|||
if (n < 2) |
if (n < 2) |
||
return false; |
return false; |
||
int max = cast(int)sqrt(cast(real)n) + 1; |
|||
int tot = 1; |
|||
int total = 1; |
|||
foreach (immutable i; 2 .. cast(int)real(n).sqrt + 1) |
|||
if (n % i == 0) { |
if (n % i == 0) { |
||
immutable int q = n / i; |
|||
total += i; |
|||
if (q > i) |
if (q > i) |
||
total += q; |
|||
} |
} |
||
return |
return total == n; |
||
} |
} |
||
void main() { |
void main() { |
||
10_000.iota.filter!isPerfectNumber2.writeln; |
|||
for (int n; n < 33_550_337; n++) |
|||
}</syntaxhighlight> |
|||
if (perfect(n)) |
|||
{{out}} |
|||
printf("%d\n", n); |
|||
<pre>[6, 28, 496, 8128]</pre> |
|||
}</lang> |
|||
With a <code>33_550_337.iota</code> it outputs: |
|||
<pre>[6, 28, 496, 8128, 33550336]</pre> |
|||
=={{header| |
=={{header|Dart}}== |
||
=== Explicit Iterative Version === |
|||
<syntaxhighlight lang="d">/* |
|||
* Function to test if a number is a perfect number |
|||
* A number is a perfect number if it is equal to the sum of all its divisors |
|||
* Input: Positive integer n |
|||
* Output: true if n is a perfect number, false otherwise |
|||
*/ |
|||
bool isPerfect(int n){ |
|||
//Generate a list of integers in the range 1 to n-1 : [1, 2, ..., n-1] |
|||
List<int> range = new List<int>.generate(n-1, (int i) => i+1); |
|||
//Create a list that filters the divisors of n from range |
|||
<lang e>pragma.enable("accumulator") |
|||
List<int> divisors = new List.from(range.where((i) => n%i == 0)); |
|||
//Sum the all the divisors |
|||
int sumOfDivisors = 0; |
|||
for (int i = 0; i < divisors.length; i++){ |
|||
sumOfDivisors = sumOfDivisors + divisors[i]; |
|||
} |
|||
// A number is a perfect number if it is equal to the sum of its divisors |
|||
// We return the test if n is equal to sumOfDivisors |
|||
return n == sumOfDivisors; |
|||
}</syntaxhighlight> |
|||
=== Compact Version === |
|||
{{trans|Julia}} |
|||
<syntaxhighlight lang="d">isPerfect(n) => |
|||
n == new List.generate(n-1, (i) => n%(i+1) == 0 ? i+1 : 0).fold(0, (p,n)=>p+n);</syntaxhighlight> |
|||
In either case, if we test to find all the perfect numbers up to 1000, we get: |
|||
<syntaxhighlight lang="d">main() => |
|||
new List.generate(1000,(i)=>i+1).where(isPerfect).forEach(print);</syntaxhighlight> |
|||
{{out}} |
|||
<pre>6 |
|||
28 |
|||
496</pre> |
|||
=={{header|Delphi}}== |
|||
See [[#Pascal]]. |
|||
=={{header|Dyalect}}== |
|||
<syntaxhighlight lang="dyalect">func isPerfect(num) { |
|||
var sum = 0 |
|||
for i in 1..<num { |
|||
if !i { |
|||
break |
|||
} |
|||
if num % i == 0 { |
|||
sum += i |
|||
} |
|||
} |
|||
return sum == num |
|||
} |
|||
let max = 33550337 |
|||
print("Perfect numbers from 0 to \(max):") |
|||
for x in 0..max { |
|||
if isPerfect(x) { |
|||
print("\(x) is perfect") |
|||
} |
|||
}</syntaxhighlight> |
|||
=={{header|E}}== |
|||
<syntaxhighlight lang="e">pragma.enable("accumulator") |
|||
def isPerfectNumber(x :int) { |
def isPerfectNumber(x :int) { |
||
var sum := 0 |
var sum := 0 |
||
Line 240: | Line 1,553: | ||
} |
} |
||
return sum <=> x |
return sum <=> x |
||
}</ |
}</syntaxhighlight> |
||
=={{header|EasyLang}}== |
|||
<syntaxhighlight lang=easylang> |
|||
func perf n . |
|||
for i = 1 to n - 1 |
|||
if n mod i = 0 |
|||
sum += i |
|||
. |
|||
. |
|||
return if sum = n |
|||
. |
|||
for i = 2 to 10000 |
|||
if perf i = 1 |
|||
print i |
|||
. |
|||
. |
|||
</syntaxhighlight> |
|||
=={{header|Eiffel}}== |
|||
<syntaxhighlight lang="eiffel"> |
|||
class |
|||
APPLICATION |
|||
create |
|||
make |
|||
feature |
|||
make |
|||
do |
|||
io.put_string (" 6 is perfect...%T") |
|||
io.put_boolean (is_perfect_number (6)) |
|||
io.new_line |
|||
io.put_string (" 77 is perfect...%T") |
|||
io.put_boolean (is_perfect_number (77)) |
|||
io.new_line |
|||
io.put_string ("128 is perfect...%T") |
|||
io.put_boolean (is_perfect_number (128)) |
|||
io.new_line |
|||
io.put_string ("496 is perfect...%T") |
|||
io.put_boolean (is_perfect_number (496)) |
|||
end |
|||
is_perfect_number (n: INTEGER): BOOLEAN |
|||
-- Is 'n' a perfect number? |
|||
require |
|||
n_positive: n > 0 |
|||
local |
|||
sum: INTEGER |
|||
do |
|||
across |
|||
1 |..| (n - 1) as c |
|||
loop |
|||
if n \\ c.item = 0 then |
|||
sum := sum + c.item |
|||
end |
|||
end |
|||
Result := sum = n |
|||
end |
|||
end |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 is perfect... True |
|||
77 is perfect... False |
|||
128 is perfect... False |
|||
496 is perfect... True |
|||
</pre> |
|||
=={{header|Elena}}== |
|||
ELENA 6.x: |
|||
<syntaxhighlight lang="elena">import system'routines; |
|||
import system'math; |
|||
import extensions; |
|||
extension extension |
|||
{ |
|||
isPerfect() |
|||
= new Range(1, self - 1).selectBy::(n => (self.mod(n) == 0).iif(n,0) ).summarize(new Integer()) == self; |
|||
} |
|||
public program() |
|||
{ |
|||
for(int n := 1; n < 10000; n += 1) |
|||
{ |
|||
if(n.isPerfect()) |
|||
{ console.printLine(n," is perfect") } |
|||
}; |
|||
console.readChar() |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 is perfect |
|||
28 is perfect |
|||
496 is perfect |
|||
8128 is perfect |
|||
</pre> |
|||
=={{header|Elixir}}== |
|||
<syntaxhighlight lang="elixir">defmodule RC do |
|||
def is_perfect(1), do: false |
|||
def is_perfect(n) when n > 1 do |
|||
Enum.sum(factor(n, 2, [1])) == n |
|||
end |
|||
defp factor(n, i, factors) when n < i*i , do: factors |
|||
defp factor(n, i, factors) when n == i*i , do: [i | factors] |
|||
defp factor(n, i, factors) when rem(n,i)==0, do: factor(n, i+1, [i, div(n,i) | factors]) |
|||
defp factor(n, i, factors) , do: factor(n, i+1, factors) |
|||
end |
|||
IO.inspect (for i <- 1..10000, RC.is_perfect(i), do: i)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
[6, 28, 496, 8128] |
|||
</pre> |
|||
=={{header|Erlang}}== |
=={{header|Erlang}}== |
||
< |
<syntaxhighlight lang="erlang">is_perfect(X) -> |
||
X == lists:sum([N || N <- lists:seq(1,X-1), X rem N == 0]).</ |
X == lists:sum([N || N <- lists:seq(1,X-1), X rem N == 0]).</syntaxhighlight> |
||
=={{header| |
=={{header|ERRE}}== |
||
<syntaxhighlight lang="erre">PROGRAM PERFECT |
|||
<lang false>[0\1[\$@$@-][\$@$@$@$@\/*=[@\$@+@@]?1+]#%=]p: |
|||
45p;!." "28p;!. { 0 -1 }</lang> |
|||
PROCEDURE PERFECT(N%->OK%) |
|||
LOCAL I%,S% |
|||
S%=1 |
|||
FOR I%=2 TO SQR(N%)-1 DO |
|||
IF N% MOD I%=0 THEN S%+=I%+N% DIV I% |
|||
END FOR |
|||
IF I%=SQR(N%) THEN S%+=I% |
|||
OK%=(N%=S%) |
|||
END PROCEDURE |
|||
BEGIN |
|||
PRINT(CHR$(12);) ! CLS |
|||
FOR N%=2 TO 10000 STEP 2 DO |
|||
PERFECT(N%->OK%) |
|||
IF OK% THEN PRINT(N%) |
|||
END FOR |
|||
END PROGRAM</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=={{header|F_Sharp|F#}}== |
|||
<syntaxhighlight lang="fsharp">let perf n = n = List.fold (+) 0 (List.filter (fun i -> n % i = 0) [1..(n-1)]) |
|||
for i in 1..10000 do if (perf i) then printfn "%i is perfect" i</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>6 is perfect |
|||
28 is perfect |
|||
496 is perfect |
|||
8128 is perfect</pre> |
|||
=={{header|Factor}}== |
=={{header|Factor}}== |
||
< |
<syntaxhighlight lang="factor">USING: kernel math math.primes.factors sequences ; |
||
IN: rosettacode.perfect-numbers |
IN: rosettacode.perfect-numbers |
||
: perfect? ( n -- ? ) [ divisors sum ] [ 2 * ] bi = ;</ |
: perfect? ( n -- ? ) [ divisors sum ] [ 2 * ] bi = ;</syntaxhighlight> |
||
=={{header|FALSE}}== |
|||
<syntaxhighlight lang="false">[0\1[\$@$@-][\$@$@$@$@\/*=[@\$@+@@]?1+]#%=]p: |
|||
45p;!." "28p;!. { 0 -1 }</syntaxhighlight> |
|||
=={{header|Forth}}== |
=={{header|Forth}}== |
||
< |
<syntaxhighlight lang="forth">: perfect? ( n -- ? ) |
||
1 |
1 |
||
over 2/ 1+ 2 ?do |
over 2/ 1+ 2 ?do |
||
over i mod 0= if i + then |
over i mod 0= if i + then |
||
loop |
loop |
||
= ;</ |
= ;</syntaxhighlight> |
||
=={{header|Fortran}}== |
=={{header|Fortran}}== |
||
{{works with|Fortran|90 and later}} |
{{works with|Fortran|90 and later}} |
||
< |
<syntaxhighlight lang="fortran">FUNCTION isPerfect(n) |
||
LOGICAL :: isPerfect |
LOGICAL :: isPerfect |
||
INTEGER, INTENT(IN) :: n |
INTEGER, INTENT(IN) :: n |
||
Line 276: | Line 1,747: | ||
END DO |
END DO |
||
IF (factorsum == n) isPerfect = .TRUE. |
IF (factorsum == n) isPerfect = .TRUE. |
||
END FUNCTION isPerfect</ |
END FUNCTION isPerfect</syntaxhighlight> |
||
=={{header|FreeBASIC}}== |
|||
{{trans|C (with some modifications)}} |
|||
<syntaxhighlight lang="freebasic">' FB 1.05.0 Win64 |
|||
Function isPerfect(n As Integer) As Boolean |
|||
If n < 2 Then Return False |
|||
If n Mod 2 = 1 Then Return False '' we can assume odd numbers are not perfect |
|||
Dim As Integer sum = 1, q |
|||
For i As Integer = 2 To Sqr(n) |
|||
If n Mod i = 0 Then |
|||
sum += i |
|||
q = n \ i |
|||
If q > i Then sum += q |
|||
End If |
|||
Next |
|||
Return n = sum |
|||
End Function |
|||
Print "The first 5 perfect numbers are : " |
|||
For i As Integer = 2 To 33550336 |
|||
If isPerfect(i) Then Print i; " "; |
|||
Next |
|||
Print |
|||
Print "Press any key to quit" |
|||
Sleep</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
The first 5 perfect numbers are : |
|||
6 28 496 8128 33550336 |
|||
</pre> |
|||
=={{header|Frink}}== |
|||
<syntaxhighlight lang="frink">isPerfect = {|n| sum[allFactors[n, true, false]] == n} |
|||
println[select[1 to 1000, isPerfect]]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>[1, 6, 28, 496] |
|||
</pre> |
|||
=={{header|FunL}}== |
|||
<syntaxhighlight lang="funl">def perfect( n ) = sum( d | d <- 1..n if d|n ) == 2n |
|||
println( (1..500).filter(perfect) )</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
(6, 28, 496) |
|||
</pre> |
|||
=={{header|FutureBasic}}== |
|||
<syntaxhighlight lang="futurebasic"> |
|||
_maxNum = 10000 |
|||
local fn IsPerfectNumber( n as long ) as BOOL |
|||
————————————————————————————————————————————— |
|||
if ( n < 2 ) then exit fn = NO |
|||
if ( n mod 2 == 1 ) then exit fn = NO |
|||
long sum = 1, q, i |
|||
for i = 2 to sqr(n) |
|||
if ( n mod i == 0 ) |
|||
sum += i |
|||
q = n / i |
|||
if ( q > i ) then sum += q |
|||
end if |
|||
next |
|||
end fn = ( n == sum ) |
|||
printf @"Perfect numbers in range %ld..%ld",2,_maxNum |
|||
long i |
|||
for i = 2 To _maxNum |
|||
if ( fn IsPerfectNumber(i) ) then print i |
|||
next |
|||
HandleEvents |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Perfect numbers in range 2..10000 |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=={{header|GAP}}== |
|||
<syntaxhighlight lang="gap">Filtered([1 .. 10000], n -> Sum(DivisorsInt(n)) = 2*n); |
|||
# [ 6, 28, 496, 8128 ]</syntaxhighlight> |
|||
=={{header|Go}}== |
|||
<syntaxhighlight lang="go">package main |
|||
import "fmt" |
|||
func computePerfect(n int64) bool { |
|||
var sum int64 |
|||
for i := int64(1); i < n; i++ { |
|||
if n%i == 0 { |
|||
sum += i |
|||
} |
|||
} |
|||
return sum == n |
|||
} |
|||
// following function satisfies the task, returning true for all |
|||
// perfect numbers representable in the argument type |
|||
func isPerfect(n int64) bool { |
|||
switch n { |
|||
case 6, 28, 496, 8128, 33550336, 8589869056, |
|||
137438691328, 2305843008139952128: |
|||
return true |
|||
} |
|||
return false |
|||
} |
|||
// validation |
|||
func main() { |
|||
for n := int64(1); ; n++ { |
|||
if isPerfect(n) != computePerfect(n) { |
|||
panic("bug") |
|||
} |
|||
if n%1e3 == 0 { |
|||
fmt.Println("tested", n) |
|||
} |
|||
} |
|||
} |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
tested 1000 |
|||
tested 2000 |
|||
tested 3000 |
|||
... |
|||
</pre> |
|||
=={{header|Groovy}}== |
=={{header|Groovy}}== |
||
Solution: |
Solution: |
||
< |
<syntaxhighlight lang="groovy">def isPerfect = { n -> |
||
n > 4 && (n == (2..Math.sqrt(n)).findAll { n % it == 0 }.inject(1) { factorSum, i -> factorSum += i + n/i }) |
n > 4 && (n == (2..Math.sqrt(n)).findAll { n % it == 0 }.inject(1) { factorSum, i -> factorSum += i + n/i }) |
||
}</ |
}</syntaxhighlight> |
||
Test program: |
Test program: |
||
< |
<syntaxhighlight lang="groovy">(0..10000).findAll { isPerfect(it) }.each { println it }</syntaxhighlight> |
||
{{Out}} |
|||
Output: |
|||
<pre>6 |
<pre>6 |
||
28 |
28 |
||
496 |
496 |
||
8128</pre> |
8128</pre> |
||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
<syntaxhighlight lang="haskell">perfect n = |
|||
<lang haskell>perf n = n == sum [i | i <- [1..n-1], n `mod` i == 0]</lang> |
|||
n == sum [i | i <- [1..n-1], n `mod` i == 0]</syntaxhighlight> |
|||
Create a list of known perfects: |
|||
<syntaxhighlight lang="haskell">perfect = |
|||
(\x -> (2 ^ x - 1) * (2 ^ (x - 1))) <$> |
|||
filter (\x -> isPrime x && isPrime (2 ^ x - 1)) maybe_prime |
|||
where |
|||
maybe_prime = scanl1 (+) (2 : 1 : cycle [2, 2, 4, 2, 4, 2, 4, 6]) |
|||
isPrime n = all ((/= 0) . (n `mod`)) $ takeWhile (\x -> x * x <= n) maybe_prime |
|||
isPerfect n = f n perfect |
|||
where |
|||
f n (p:ps) = |
|||
case compare n p of |
|||
EQ -> True |
|||
LT -> False |
|||
GT -> f n ps |
|||
main :: IO () |
|||
main = do |
|||
mapM_ print $ take 10 perfect |
|||
mapM_ (print . (\x -> (x, isPerfect x))) [6, 27, 28, 29, 496, 8128, 8129]</syntaxhighlight> |
|||
or, restricting the search space to improve performance: |
|||
<syntaxhighlight lang="haskell">isPerfect :: Int -> Bool |
|||
isPerfect n = |
|||
let lows = filter ((0 ==) . rem n) [1 .. floor (sqrt (fromIntegral n))] |
|||
in 1 < n && |
|||
n == |
|||
quot |
|||
(sum |
|||
(lows ++ |
|||
[ y |
|||
| x <- lows |
|||
, let y = quot n x |
|||
, x /= y ])) |
|||
2 |
|||
main :: IO () |
|||
main = print $ filter isPerfect [1 .. 10000]</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>[6,28,496,8128]</pre> |
|||
=={{header|HicEst}}== |
=={{header|HicEst}}== |
||
< |
<syntaxhighlight lang="hicest"> DO i = 1, 1E4 |
||
IF( perfect(i) ) WRITE() i |
IF( perfect(i) ) WRITE() i |
||
ENDDO |
ENDDO |
||
Line 307: | Line 1,962: | ||
ENDDO |
ENDDO |
||
perfect = sum == n |
perfect = sum == n |
||
END</ |
END</syntaxhighlight> |
||
=={{header|Icon}} and {{header|Unicon}}== |
|||
<syntaxhighlight lang="icon">procedure main(arglist) |
|||
limit := \arglist[1] | 100000 |
|||
write("Perfect numbers from 1 to ",limit,":") |
|||
every write(isperfect(1 to limit)) |
|||
write("Done.") |
|||
end |
|||
procedure isperfect(n) #: returns n if n is perfect |
|||
local sum,i |
|||
every (sum := 0) +:= (n ~= divisors(n)) |
|||
if sum = n then return n |
|||
end |
|||
link factors</syntaxhighlight> |
|||
{{libheader|Icon Programming Library}} [http://www.cs.arizona.edu/icon/library/src/procs/factors.icn Uses divisors from factors] |
|||
{{Out}} |
|||
<pre>Perfect numbers from 1 to 100000: |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
Done.</pre> |
|||
=={{header|J}}== |
=={{header|J}}== |
||
< |
<syntaxhighlight lang="j">is_perfect=: +: = >:@#.~/.~&.q:@(6>.<.)</syntaxhighlight> |
||
The program defined above, like programs found here in other languages, assumes that the input will be a scalar positive integer. |
|||
Examples of use, including extensions beyond those assumptions: |
Examples of use, including extensions beyond those assumptions: |
||
< |
<syntaxhighlight lang="j"> is_perfect 33550336 |
||
1 |
1 |
||
I. is_perfect i. 100000 |
|||
6 28 496 8128 |
6 28 496 8128 |
||
Line 323: | Line 2,004: | ||
10 11 12 13 14 15 16 17 18 19 |
10 11 12 13 14 15 16 17 18 19 |
||
20 21 22 23 24 25 26 27 28 29 |
20 21 22 23 24 25 26 27 28 29 |
||
is_perfect zero_through_twentynine |
|||
is_pos_int=: 0&< *. ]=>. |
|||
(is_perfect"0 *. is_pos_int) zero_through_twentynine |
|||
0 0 0 0 0 0 1 0 0 0 |
0 0 0 0 0 0 1 0 0 0 |
||
0 0 0 0 0 0 0 0 0 0 |
0 0 0 0 0 0 0 0 0 0 |
||
0 0 0 0 0 0 0 0 1 0 |
0 0 0 0 0 0 0 0 1 0 |
||
is_perfect 191561942608236107294793378084303638130997321548169216x |
|||
1</syntaxhighlight> |
|||
More efficient version based on [http://jsoftware.com/pipermail/programming/2014-June/037695.html comments] by Henry Rich and Roger Hui (comment train seeded by Jon Hough). |
|||
=={{header|Java}}== |
=={{header|Java}}== |
||
< |
<syntaxhighlight lang="java">public static boolean perf(int n){ |
||
int sum= 0; |
int sum= 0; |
||
for(int i= 1;i < n;i++){ |
for(int i= 1;i < n;i++){ |
||
Line 338: | Line 2,022: | ||
} |
} |
||
return sum == n; |
return sum == n; |
||
}</ |
}</syntaxhighlight> |
||
Or for arbitrary precision:[[Category:Arbitrary precision]] |
Or for arbitrary precision:[[Category:Arbitrary precision]] |
||
< |
<syntaxhighlight lang="java">import java.math.BigInteger; |
||
public static boolean perf(BigInteger n){ |
public static boolean perf(BigInteger n){ |
||
Line 351: | Line 2,035: | ||
} |
} |
||
return sum.equals(n); |
return sum.equals(n); |
||
}</ |
}</syntaxhighlight> |
||
=={{header|JavaScript}}== |
=={{header|JavaScript}}== |
||
===Imperative=== |
|||
{{trans|Java}} |
{{trans|Java}} |
||
<lang |
<syntaxhighlight lang="javascript">function is_perfect(n) |
||
{ |
|||
var sum = 0; |
|||
var sum = 1, i, sqrt=Math.floor(Math.sqrt(n)); |
|||
for (i = sqrt-1; i>1; i--) |
|||
if (n % i == 0) { |
|||
{ |
|||
sum += i; |
|||
if (n % i == 0) { |
|||
sum += i + n/i; |
|||
} |
|||
return sum == n; |
|||
} |
|||
if(n % sqrt == 0) |
|||
sum += sqrt + (sqrt*sqrt == n ? 0 : n/sqrt); |
|||
return sum === n; |
|||
} |
} |
||
for (var i = 1; i < 10000; i++) { |
|||
if (is_perfect(i)) { |
|||
print(i); |
|||
} |
|||
}</lang> |
|||
var i; |
|||
Output: |
|||
for (i = 1; i < 10000; i++) |
|||
{ |
|||
if (is_perfect(i)) |
|||
print(i); |
|||
}</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>6 |
<pre>6 |
||
28 |
28 |
||
Line 377: | Line 2,070: | ||
8128</pre> |
8128</pre> |
||
===Functional=== |
|||
====ES5==== |
|||
Naive version (brute force) |
|||
<syntaxhighlight lang="javascript">(function (nFrom, nTo) { |
|||
function perfect(n) { |
|||
return n === range(1, n - 1).reduce( |
|||
function (a, x) { |
|||
return n % x ? a : a + x; |
|||
}, 0 |
|||
); |
|||
} |
|||
function range(m, n) { |
|||
return Array.apply(null, Array(n - m + 1)).map(function (x, i) { |
|||
return m + i; |
|||
}); |
|||
} |
|||
return range(nFrom, nTo).filter(perfect); |
|||
})(1, 10000);</syntaxhighlight> |
|||
Output: |
|||
<syntaxhighlight lang="javascript">[6, 28, 496, 8128]</syntaxhighlight> |
|||
Much faster (more efficient factorisation) |
|||
<syntaxhighlight lang="javascript">(function (nFrom, nTo) { |
|||
function perfect(n) { |
|||
var lows = range(1, Math.floor(Math.sqrt(n))).filter(function (x) { |
|||
return (n % x) === 0; |
|||
}); |
|||
return n > 1 && lows.concat(lows.map(function (x) { |
|||
return n / x; |
|||
})).reduce(function (a, x) { |
|||
return a + x; |
|||
}, 0) / 2 === n; |
|||
} |
|||
function range(m, n) { |
|||
return Array.apply(null, Array(n - m + 1)).map(function (x, i) { |
|||
return m + i; |
|||
}); |
|||
} |
|||
return range(nFrom, nTo).filter(perfect) |
|||
})(1, 10000);</syntaxhighlight> |
|||
Output: |
|||
<syntaxhighlight lang="javascript">[6, 28, 496, 8128]</syntaxhighlight> |
|||
Note that the filter function, though convenient and well optimised, is not strictly necessary. |
|||
We can always replace it with a more general monadic bind (chain) function, which is essentially just concat map |
|||
(Monadic return/inject for lists is simply lambda x --> [x], inlined here, and fail is [].) |
|||
<syntaxhighlight lang="javascript">(function (nFrom, nTo) { |
|||
// MONADIC CHAIN (bind) IN LIEU OF FILTER |
|||
// ( monadic return for lists is just lambda x -> [x] ) |
|||
return chain( |
|||
rng(nFrom, nTo), |
|||
function mPerfect(n) { |
|||
return (chain( |
|||
rng(1, Math.floor(Math.sqrt(n))), |
|||
function (y) { |
|||
return (n % y) === 0 && n > 1 ? [y, n / y] : []; |
|||
} |
|||
).reduce(function (a, x) { |
|||
return a + x; |
|||
}, 0) / 2 === n) ? [n] : []; |
|||
} |
|||
); |
|||
/******************************************************************/ |
|||
// Monadic bind (chain) for lists |
|||
function chain(xs, f) { |
|||
return [].concat.apply([], xs.map(f)); |
|||
} |
|||
function rng(m, n) { |
|||
return Array.apply(null, Array(n - m + 1)).map(function (x, i) { |
|||
return m + i; |
|||
}); |
|||
} |
|||
})(1, 10000);</syntaxhighlight> |
|||
Output: |
|||
<syntaxhighlight lang="javascript">[6, 28, 496, 8128]</syntaxhighlight> |
|||
====ES6==== |
|||
<syntaxhighlight lang="javascript">(() => { |
|||
const main = () => |
|||
enumFromTo(1, 10000).filter(perfect); |
|||
// perfect :: Int -> Bool |
|||
const perfect = n => { |
|||
const |
|||
lows = enumFromTo(1, Math.floor(Math.sqrt(n))) |
|||
.filter(x => (n % x) === 0); |
|||
return n > 1 && lows.concat(lows.map(x => n / x)) |
|||
.reduce((a, x) => (a + x), 0) / 2 === n; |
|||
}; |
|||
// GENERIC -------------------------------------------- |
|||
// enumFromTo :: Int -> Int -> [Int] |
|||
const enumFromTo = (m, n) => |
|||
Array.from({ |
|||
length: n - m + 1 |
|||
}, (_, i) => i + m) |
|||
// MAIN --- |
|||
return main(); |
|||
})();</syntaxhighlight> |
|||
{{Out}} |
|||
<syntaxhighlight lang="javascript">[6, 28, 496, 8128]</syntaxhighlight> |
|||
=={{header|jq}}== |
|||
<syntaxhighlight lang="jq"> |
|||
def is_perfect: |
|||
. as $in |
|||
| $in == reduce range(1;$in) as $i |
|||
(0; if ($in % $i) == 0 then $i + . else . end); |
|||
# Example: |
|||
range(1;10001) | select( is_perfect )</syntaxhighlight> |
|||
{{Out}} |
|||
$ jq -n -f is_perfect.jq |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
=={{header|Julia}}== |
|||
{{works with|Julia|0.6}} |
|||
<syntaxhighlight lang="julia">isperfect(n::Integer) = n == sum([n % i == 0 ? i : 0 for i = 1:(n - 1)]) |
|||
perfects(n::Integer) = filter(isperfect, 1:n) |
|||
@show perfects(10000)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>perfects(10000) = [6, 28, 496, 8128]</pre> |
|||
=={{header|K}}== |
|||
{{trans|J}} |
|||
<syntaxhighlight lang="k"> perfect:{(x>2)&x=+/-1_{d:&~x!'!1+_sqrt x;d,_ x%|d}x} |
|||
perfect 33550336 |
|||
1 |
|||
a@&perfect'a:!10000 |
|||
6 28 496 8128 |
|||
m:3 10#!30 |
|||
(0 1 2 3 4 5 6 7 8 9 |
|||
10 11 12 13 14 15 16 17 18 19 |
|||
20 21 22 23 24 25 26 27 28 29) |
|||
perfect'/: m |
|||
(0 0 0 0 0 0 1 0 0 0 |
|||
0 0 0 0 0 0 0 0 0 0 |
|||
0 0 0 0 0 0 0 0 1 0)</syntaxhighlight> |
|||
=={{header|Kotlin}}== |
|||
{{trans|C}} |
|||
<syntaxhighlight lang="scala">// version 1.0.6 |
|||
fun isPerfect(n: Int): Boolean = when { |
|||
n < 2 -> false |
|||
n % 2 == 1 -> false // there are no known odd perfect numbers |
|||
else -> { |
|||
var tot = 1 |
|||
var q: Int |
|||
for (i in 2 .. Math.sqrt(n.toDouble()).toInt()) { |
|||
if (n % i == 0) { |
|||
tot += i |
|||
q = n / i |
|||
if (q > i) tot += q |
|||
} |
|||
} |
|||
n == tot |
|||
} |
|||
} |
|||
fun main(args: Array<String>) { |
|||
// expect a run time of about 6 minutes on a typical laptop |
|||
println("The first five perfect numbers are:") |
|||
for (i in 2 .. 33550336) if (isPerfect(i)) print("$i ") |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
The first five perfect numbers are: |
|||
6 28 496 8128 33550336 |
|||
</pre> |
|||
=={{header|LabVIEW}}== |
|||
{{VI solution|LabVIEW_Perfect_numbers.png}} |
|||
=={{header|Lambdatalk}}== |
|||
===simple & slow=== |
|||
<syntaxhighlight lang="scheme"> |
|||
{def perf |
|||
{def perf.sum |
|||
{lambda {:n :sum :i} |
|||
{if {>= :i :n} |
|||
then {= :sum :n} |
|||
else {perf.sum :n |
|||
{if {= {% :n :i} 0} |
|||
then {+ :sum :i} |
|||
else :sum} |
|||
{+ :i 1}} }}} |
|||
{lambda {:n} |
|||
{perf.sum :n 0 2} }} |
|||
-> perf |
|||
{S.replace \s by space in |
|||
{S.map {lambda {:i} {if {perf :i} then :i else}} |
|||
{S.serie 2 1000 2}}} |
|||
-> 6 28 496 // 5200ms |
|||
</syntaxhighlight> |
|||
Too slow (and stackoverflow) to go further. |
|||
===improved=== |
|||
<syntaxhighlight lang="scheme"> |
|||
{def lt_perfect |
|||
{def lt_perfect.sum |
|||
{lambda {:n :sum :i} |
|||
{if {> :i 1} |
|||
then {lt_perfect.sum :n |
|||
{if {= {% :n :i} 0} |
|||
then {+ :sum :i {floor {/ :n :i}}} |
|||
else :sum} |
|||
{- :i 1}} |
|||
else :sum }}} |
|||
{lambda {:n} |
|||
{let { {:n :n} |
|||
{:sqrt {floor {sqrt :n}}} |
|||
{:sum {lt_perfect.sum :n 1 {- {floor {sqrt :n}} 0} }} |
|||
{:foo {if {= {* :sqrt :sqrt} :n} |
|||
then 0 |
|||
else {floor {/ :n :sqrt}}}} |
|||
} {= :n {if {= {% :n :sqrt} 0} |
|||
then {+ :sum :sqrt :foo} |
|||
else :sum}} }}} |
|||
-> lt_perfect |
|||
-> {S.replace \s by space in |
|||
{S.map {lambda {:i} {if {lt_perfect :i} then :i else}} |
|||
{S.serie 6 10000 2}}} |
|||
-> 28 496 8128 // 7500ms |
|||
</syntaxhighlight> |
|||
===calling javascript=== |
|||
Following the javascript entry. |
|||
<syntaxhighlight lang="scheme"> |
|||
{S.replace \s by space in |
|||
{S.map {lambda {:i} {if {js_perfect :i} then :i else}} |
|||
{S.serie 2 10000}}} |
|||
-> 6 28 496 8128 // 80ms |
|||
{script |
|||
LAMBDATALK.DICT["js_perfect"] = function() { |
|||
function js_perfect(n) { |
|||
var sum = 1, i, sqrt=Math.floor(Math.sqrt(n)); |
|||
for (i = sqrt-1; i>1; i--) { |
|||
if (n % i == 0) |
|||
sum += i + n/i; |
|||
} |
|||
if(n % sqrt == 0) |
|||
sum += sqrt + (sqrt*sqrt == n ? 0 : n/sqrt); |
|||
return sum === n; |
|||
} |
|||
var args = arguments[0].trim(); |
|||
return (js_perfect( Number(args) )) ? "true" : "false" |
|||
}; |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|Lasso}}== |
|||
<syntaxhighlight lang="lasso">#!/usr/bin/lasso9 |
|||
define isPerfect(n::integer) => { |
|||
#n < 2 ? return false |
|||
return #n == ( |
|||
with i in generateSeries(1, math_floor(math_sqrt(#n)) + 1) |
|||
where #n % #i == 0 |
|||
let q = #n / #i |
|||
sum (#q > #i ? (#i == 1 ? 1 | #q + #i) | 0) |
|||
) |
|||
} |
|||
with x in generateSeries(1, 10000) |
|||
where isPerfect(#x) |
|||
select #x</syntaxhighlight> |
|||
{{Out}} |
|||
<syntaxhighlight lang="lasso">6, 28, 496, 8128</syntaxhighlight> |
|||
=={{header|Liberty BASIC}}== |
|||
<syntaxhighlight lang="lb">for n =1 to 10000 |
|||
if perfect( n) =1 then print n; " is perfect." |
|||
next n |
|||
end |
|||
function perfect( n) |
|||
sum =0 |
|||
for i =1 TO n /2 |
|||
if n mod i =0 then |
|||
sum =sum +i |
|||
end if |
|||
next i |
|||
if sum =n then |
|||
perfect= 1 |
|||
else |
|||
perfect =0 |
|||
end if |
|||
end function</syntaxhighlight> |
|||
=={{header|Lingo}}== |
|||
<syntaxhighlight lang="lingo">on isPercect (n) |
|||
sum = 1 |
|||
cnt = n/2 |
|||
repeat with i = 2 to cnt |
|||
if n mod i = 0 then sum = sum + i |
|||
end repeat |
|||
return sum=n |
|||
end</syntaxhighlight> |
|||
=={{header|Logo}}== |
=={{header|Logo}}== |
||
< |
<syntaxhighlight lang="logo">to perfect? :n |
||
output equal? :n apply "sum filter [equal? 0 modulo :n ?] iseq 1 :n/2 |
output equal? :n apply "sum filter [equal? 0 modulo :n ?] iseq 1 :n/2 |
||
end</ |
end</syntaxhighlight> |
||
=={{header|Lua}}== |
|||
<syntaxhighlight lang="lua">function isPerfect(x) |
|||
local sum = 0 |
|||
for i = 1, x-1 do |
|||
sum = (x % i) == 0 and sum + i or sum |
|||
end |
|||
return sum == x |
|||
end</syntaxhighlight> |
|||
=={{header|M2000 Interpreter}}== |
|||
<syntaxhighlight lang="m2000 interpreter"> |
|||
Module PerfectNumbers { |
|||
Function Is_Perfect(n as decimal) { |
|||
s=1 : sN=Sqrt(n) |
|||
last= n=sN*sN |
|||
t=n |
|||
If n mod 2=0 then s+=2+n div 2 |
|||
i=3 : sN-- |
|||
While i<sN { |
|||
if n mod i=0 then t=n div i :i=max.data(n div t, i): s+=t+ i |
|||
i++ |
|||
} |
|||
=n=s |
|||
} |
|||
Inventory Known1=2@, 3@ |
|||
IsPrime=lambda Known1 (x as decimal) -> { |
|||
=0=1 |
|||
if exist(Known1, x) then =1=1 : exit |
|||
if x<=5 OR frac(x) then {if x == 2 OR x == 3 OR x == 5 then Append Known1, x : =1=1 |
|||
Break} |
|||
if frac(x/2) else exit |
|||
if frac(x/3) else exit |
|||
x1=sqrt(x):d = 5@ |
|||
{if frac(x/d ) else exit |
|||
d += 2: if d>x1 then Append Known1, x : =1=1 : exit |
|||
if frac(x/d) else exit |
|||
d += 4: if d<= x1 else Append Known1, x : =1=1: exit |
|||
loop} |
|||
} |
|||
\\ Check a perfect and a non perfect number |
|||
p=2 : n=3 : n1=2 |
|||
Document Doc$ |
|||
IsPerfect( 0, 28) |
|||
IsPerfect( 0, 1544) |
|||
While p<32 { ' max 32 |
|||
if isprime(2^p-1@) then { |
|||
perf=(2^p-1@)*2@^(p-1@) |
|||
Rem Print perf |
|||
\\ decompose pretty fast the Perferct Numbers |
|||
\\ all have a series of 2 and last a prime equal to perf/2^(p-1) |
|||
inventory queue factors |
|||
For i=1 to p-1 { |
|||
Append factors, 2@ |
|||
} |
|||
Append factors, perf/2^(p-1) |
|||
\\ end decompose |
|||
Rem Print factors |
|||
IsPerfect(factors, Perf) |
|||
} |
|||
p++ |
|||
} |
|||
Clipboard Doc$ |
|||
\\ exit here. No need for Exit statement |
|||
Sub IsPerfect(factors, n) |
|||
s=false |
|||
if n<10000 or type$(factors)<>"Inventory" then { |
|||
s=Is_Perfect(n) |
|||
} else { |
|||
local mm=each(factors, 1, -2), f =true |
|||
while mm {if eval(mm)<>2 then f=false |
|||
} |
|||
if f then if n/2@**(len(mm)-1)= factors(len(factors)-1!) then s=true |
|||
} |
|||
Local a$=format$("{0} is {1}perfect number", n, If$(s->"", "not ")) |
|||
Doc$=a$+{ |
|||
} |
|||
Print a$ |
|||
End Sub |
|||
} |
|||
PerfectNumbers |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre style="height:30ex;overflow:scroll"> |
|||
28 is perfect number |
|||
1544 is not perfect number |
|||
6 is perfect number |
|||
28 is perfect number |
|||
496 is perfect number |
|||
8128 is perfect number |
|||
33550336 is perfect number |
|||
8589869056 is perfect number |
|||
137438691328 is perfect number |
|||
2305843008139952128 is perfect number |
|||
</pre > |
|||
=={{header|M4}}== |
=={{header|M4}}== |
||
< |
<syntaxhighlight lang="m4">define(`for', |
||
`ifelse($#,0,``$0'', |
`ifelse($#,0,``$0'', |
||
`ifelse(eval($2<=$3),1, |
`ifelse(eval($2<=$3),1, |
||
Line 402: | Line 2,547: | ||
for(`x',`2',`33550336', |
for(`x',`2',`33550336', |
||
`ifelse(isperfect(x),1,`x |
`ifelse(isperfect(x),1,`x |
||
')')</ |
')')</syntaxhighlight> |
||
=={{header| |
=={{header|MAD}}== |
||
<syntaxhighlight lang="mad"> NORMAL MODE IS INTEGER |
|||
R FUNCTION THAT CHECKS IF NUMBER IS PERFECT |
|||
INTERNAL FUNCTION(N) |
|||
ENTRY TO PERFCT. |
|||
DSUM = 0 |
|||
THROUGH SUMMAT, FOR CAND=1, 1, CAND.GE.N |
|||
SUMMAT WHENEVER N/CAND*CAND.E.N, DSUM = DSUM+CAND |
|||
FUNCTION RETURN DSUM.E.N |
|||
END OF FUNCTION |
|||
R PRINT PERFECT NUMBERS UP TO 10,000 |
|||
THROUGH SHOW, FOR I=1, 1, I.G.10000 |
|||
SHOW WHENEVER PERFCT.(I), PRINT FORMAT FMT,I |
|||
VECTOR VALUES FMT = $I5*$ |
|||
PRINT COMMENT $ $ |
|||
END OF PROGRAM |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=={{header|Maple}}== |
|||
<syntaxhighlight lang="maple">isperfect := proc(n) return evalb(NumberTheory:-SumOfDivisors(n) = 2*n); end proc: |
|||
isperfect(6); |
|||
true</syntaxhighlight> |
|||
=={{header|Mathematica}} / {{header|Wolfram Language}}== |
|||
Custom function: |
Custom function: |
||
< |
<syntaxhighlight lang="mathematica">PerfectQ[i_Integer] := Total[Divisors[i]] == 2 i</syntaxhighlight> |
||
Examples (testing 496, testing 128, finding all perfect numbers in 1...10000): |
Examples (testing 496, testing 128, finding all perfect numbers in 1...10000): |
||
< |
<syntaxhighlight lang="mathematica">PerfectQ[496] |
||
PerfectQ[128] |
PerfectQ[128] |
||
Flatten[PerfectQ/@Range[10000]//Position[#,True]&]</ |
Flatten[PerfectQ/@Range[10000]//Position[#,True]&]</syntaxhighlight> |
||
gives back: |
gives back: |
||
<syntaxhighlight lang="mathematica">True |
|||
<lang Mathematica>True |
|||
False |
False |
||
{6,28,496,8128}</ |
{6,28,496,8128}</syntaxhighlight> |
||
=={{header|MATLAB}}== |
|||
Standard algorithm: |
|||
<syntaxhighlight lang="matlab">function perf = isPerfect(n) |
|||
total = 0; |
|||
for k = 1:n-1 |
|||
if ~mod(n, k) |
|||
total = total+k; |
|||
end |
|||
end |
|||
perf = total == n; |
|||
end</syntaxhighlight> |
|||
Faster algorithm: |
|||
<syntaxhighlight lang="matlab">function perf = isPerfect(n) |
|||
if n < 2 |
|||
perf = false; |
|||
else |
|||
total = 1; |
|||
k = 2; |
|||
quot = n; |
|||
while k < quot && total <= n |
|||
if ~mod(n, k) |
|||
total = total+k; |
|||
quot = n/k; |
|||
if quot ~= k |
|||
total = total+quot; |
|||
end |
|||
end |
|||
k = k+1; |
|||
end |
|||
perf = total == n; |
|||
end |
|||
end</syntaxhighlight> |
|||
=={{header|Maxima}}== |
|||
<syntaxhighlight lang="maxima">".."(a, b) := makelist(i, i, a, b)$ |
|||
infix("..")$ |
|||
perfectp(n) := is(divsum(n) = 2*n)$ |
|||
sublist(1 .. 10000, perfectp); |
|||
/* [6, 28, 496, 8128] */</syntaxhighlight> |
|||
=={{header|MAXScript}}== |
=={{header|MAXScript}}== |
||
< |
<syntaxhighlight lang="maxscript">fn isPerfect n = |
||
( |
( |
||
local sum = 0 |
local sum = 0 |
||
Line 428: | Line 2,650: | ||
) |
) |
||
sum == n |
sum == n |
||
)</ |
)</syntaxhighlight> |
||
=={{header|Microsoft Small Basic}}== |
|||
{{trans|BBC BASIC}} |
|||
<syntaxhighlight lang="microsoftsmallbasic"> |
|||
For n = 2 To 10000 Step 2 |
|||
VerifyIfPerfect() |
|||
If isPerfect = 1 Then |
|||
TextWindow.WriteLine(n) |
|||
EndIf |
|||
EndFor |
|||
Sub VerifyIfPerfect |
|||
s = 1 |
|||
sqrN = Math.SquareRoot(n) |
|||
If Math.Remainder(n, 2) = 0 Then |
|||
s = s + 2 + Math.Floor(n / 2) |
|||
EndIf |
|||
i = 3 |
|||
while i <= sqrN - 1 |
|||
If Math.Remainder(n, i) = 0 Then |
|||
s = s + i + Math.Floor(n / i) |
|||
EndIf |
|||
i = i + 1 |
|||
EndWhile |
|||
If i * i = n Then |
|||
s = s + i |
|||
EndIf |
|||
If n = s Then |
|||
isPerfect = 1 |
|||
Else |
|||
isPerfect = 0 |
|||
EndIf |
|||
EndSub |
|||
</syntaxhighlight> |
|||
=={{header|Modula-2}}== |
|||
{{trans|BBC BASIC}} |
|||
{{works with|ADW Modula-2|any (Compile with the linker option ''Console Application'').}} |
|||
<syntaxhighlight lang="modula2"> |
|||
MODULE PerfectNumbers; |
|||
FROM SWholeIO IMPORT |
|||
WriteCard; |
|||
FROM STextIO IMPORT |
|||
WriteLn; |
|||
FROM RealMath IMPORT |
|||
sqrt; |
|||
VAR |
|||
N: CARDINAL; |
|||
PROCEDURE IsPerfect(N: CARDINAL): BOOLEAN; |
|||
VAR |
|||
S, I: CARDINAL; |
|||
SqrtN: REAL; |
|||
BEGIN |
|||
S := 1; |
|||
SqrtN := sqrt(FLOAT(N)); |
|||
IF N REM 2 = 0 THEN |
|||
S := S + 2 + N / 2; |
|||
END; |
|||
I := 3; |
|||
WHILE FLOAT(I) <= SqrtN - 1.0 DO |
|||
IF N REM I = 0 THEN |
|||
S := S + I + N / I; |
|||
END; |
|||
I := I + 1; |
|||
END; |
|||
IF I * I = N THEN |
|||
S := S + I; |
|||
END; |
|||
RETURN (N = S); |
|||
END IsPerfect; |
|||
BEGIN |
|||
FOR N := 2 TO 10000 BY 2 DO |
|||
IF IsPerfect(N) THEN |
|||
WriteCard(N, 5); |
|||
WriteLn; |
|||
END; |
|||
END; |
|||
END PerfectNumbers. |
|||
</syntaxhighlight> |
|||
=={{header|Nanoquery}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="nanoquery">def perf(n) |
|||
sum = 0 |
|||
for i in range(1, n - 1) |
|||
if (n % i) = 0 |
|||
sum += i |
|||
end |
|||
end |
|||
return sum = n |
|||
end</syntaxhighlight> |
|||
=={{header|Nim}}== |
|||
<syntaxhighlight lang="nim">import math |
|||
proc isPerfect(n: int): bool = |
|||
var sum: int = 1 |
|||
for d in 2 .. int(n.toFloat.sqrt): |
|||
if n mod d == 0: |
|||
inc sum, d |
|||
let q = n div d |
|||
if q != d: inc sum, q |
|||
result = n == sum |
|||
for n in 2..10_000: |
|||
if n.isPerfect: |
|||
echo n</syntaxhighlight> |
|||
{{out}} |
|||
<pre>6 |
|||
28 |
|||
496 |
|||
8128</pre> |
|||
=={{header|Objeck}}== |
|||
<syntaxhighlight lang="objeck">bundle Default { |
|||
class Test { |
|||
function : Main(args : String[]) ~ Nil { |
|||
"Perfect numbers from 1 to 33550337:"->PrintLine(); |
|||
for(num := 1 ; num < 33550337; num += 1;) { |
|||
if(IsPerfect(num)) { |
|||
num->PrintLine(); |
|||
}; |
|||
}; |
|||
} |
|||
function : native : IsPerfect(number : Int) ~ Bool { |
|||
sum := 0 ; |
|||
for(i := 1; i < number; i += 1;) { |
|||
if (number % i = 0) { |
|||
sum += i; |
|||
}; |
|||
}; |
|||
return sum = number; |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
=={{header|OCaml}}== |
=={{header|OCaml}}== |
||
< |
<syntaxhighlight lang="ocaml">let perf n = |
||
let sum = ref 0 in |
let sum = ref 0 in |
||
for i = 1 to n-1 do |
for i = 1 to n-1 do |
||
Line 437: | Line 2,801: | ||
sum := !sum + i |
sum := !sum + i |
||
done; |
done; |
||
!sum = n</ |
!sum = n</syntaxhighlight> |
||
Functional style: |
Functional style: |
||
< |
<syntaxhighlight lang="ocaml">(* range operator *) |
||
let rec (--) a b = |
let rec (--) a b = |
||
if a > b then |
if a > b then |
||
Line 446: | Line 2,810: | ||
a :: (a+1) -- b |
a :: (a+1) -- b |
||
let perf n = n = List.fold_left (+) 0 (List.filter (fun i -> n mod i = 0) (1 -- (n-1)))</ |
let perf n = n = List.fold_left (+) 0 (List.filter (fun i -> n mod i = 0) (1 -- (n-1)))</syntaxhighlight> |
||
=={{header|Oforth}}== |
|||
<syntaxhighlight lang="oforth">: isPerfect(n) | i | 0 n 2 / loop: i [ n i mod ifZero: [ i + ] ] n == ; </syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
#isPerfect 10000 seq filter . |
|||
[6, 28, 496, 8128] |
|||
</pre> |
|||
=={{header|Odin}}== |
|||
<syntaxhighlight lang="Go"> |
|||
package perfect_numbers |
|||
import "core:fmt" |
|||
main :: proc() { |
|||
fmt.println("\nPerfect numbers from 1 to 100,000:\n") |
|||
for num in 1 ..< 100001 { |
|||
if divisor_sum(num) == num { |
|||
fmt.print("num:", num, "\n") |
|||
} |
|||
if num % 10000 == 0 { |
|||
fmt.print("Count:", num, "\n") |
|||
} |
|||
} |
|||
} |
|||
divisor_sum :: proc(number: int) -> int { |
|||
sum := 0 |
|||
for i in 1 ..< number { |
|||
if number % i == 0 { |
|||
sum += i} |
|||
} |
|||
return sum |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Perfect numbers from 1 to 100,000: |
|||
num: 6 |
|||
num: 28 |
|||
num: 496 |
|||
num: 8128 |
|||
</pre> |
|||
=={{header|ooRexx}}== |
|||
<syntaxhighlight lang="oorexx">-- first perfect number over 10000 is 33550336...let's not be crazy |
|||
loop i = 1 to 10000 |
|||
if perfectNumber(i) then say i "is a perfect number" |
|||
end |
|||
::routine perfectNumber |
|||
use strict arg n |
|||
sum = 0 |
|||
-- the largest possible factor is n % 2, so no point in |
|||
-- going higher than that |
|||
loop i = 1 to n % 2 |
|||
if n // i == 0 then sum += i |
|||
end |
|||
return sum = n</syntaxhighlight> |
|||
{{out}} |
|||
<pre>6 is a perfect number |
|||
28 is a perfect number |
|||
496 is a perfect number |
|||
8128 is a perfect number</pre> |
|||
=={{header|Oz}}== |
=={{header|Oz}}== |
||
< |
<syntaxhighlight lang="oz">declare |
||
fun {IsPerfect N} |
fun {IsPerfect N} |
||
fun {IsNFactor I} N mod I == 0 end |
fun {IsNFactor I} N mod I == 0 end |
||
Line 460: | Line 2,891: | ||
in |
in |
||
{Show {Filter {List.number 1 10000 1} IsPerfect}} |
{Show {Filter {List.number 1 10000 1} IsPerfect}} |
||
{Show {IsPerfect 33550336}}</ |
{Show {IsPerfect 33550336}}</syntaxhighlight> |
||
=={{header|PARI/GP}}== |
|||
===Using built-in methods=== |
|||
<syntaxhighlight lang="parigp"> |
|||
isPerfect(n)=sigma(n,-1)==2 |
|||
</syntaxhighlight> |
|||
or |
|||
<syntaxhighlight lang="parigp"> |
|||
isPerfect(n)=sigma(n)==2*n |
|||
</syntaxhighlight> |
|||
Show perfect numbers |
|||
<syntaxhighlight lang="parigp"> |
|||
forprime(p=2, 2281, |
|||
if(isprime(2^p-1), |
|||
print(p"\t",(2^p-1)*2^(p-1)))) |
|||
</syntaxhighlight> |
|||
faster alternative showing them still using built-in methods |
|||
<syntaxhighlight lang="parigp"> |
|||
[n|n<-[1..10^4],sigma(n,-1)==2] |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
[6, 28, 496, 8128] |
|||
</pre> |
|||
===Faster with Lucas-Lehmer test=== |
|||
<syntaxhighlight lang="parigp">p=2;n=3;n1=2; |
|||
while(p<2281, |
|||
if(isprime(p), |
|||
s=Mod(4,n); |
|||
for(i=3,p, |
|||
s=s*s-2); |
|||
if(s==0 || p==2, |
|||
print("(2^"p"-1)2^("p"-1)=\t"n1*n"\n"))); |
|||
p++; n1=n+1; n=2*n+1)</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>(2^2-1)2^(2-1)= 6 |
|||
(2^3-1)2^(3-1)= 28 |
|||
(2^5-1)2^(5-1)= 496 |
|||
(2^7-1)2^(7-1)= 8128 |
|||
(2^13-1)2^(13-1)= 33550336 |
|||
(2^17-1)2^(17-1)= 8589869056 |
|||
(2^19-1)2^(19-1)= 137438691328 |
|||
(2^31-1)2^(31-1)= 2305843008139952128 |
|||
(2^61-1)2^(61-1)= 2658455991569831744654692615953842176 |
|||
(2^89-1)2^(89-1)= 191561942608236107294793378084303638130997321548169216</pre> |
|||
=={{header|Pascal}}== |
|||
<syntaxhighlight lang="pascal">program PerfectNumbers; |
|||
function isPerfect(number: longint): boolean; |
|||
var |
|||
i, sum: longint; |
|||
begin |
|||
sum := 1; |
|||
for i := 2 to round(sqrt(real(number))) do |
|||
if (number mod i = 0) then |
|||
sum := sum + i + (number div i); |
|||
isPerfect := (sum = number); |
|||
end; |
|||
var |
|||
candidate: longint; |
|||
begin |
|||
writeln('Perfect numbers from 1 to 33550337:'); |
|||
for candidate := 2 to 33550337 do |
|||
if isPerfect(candidate) then |
|||
writeln (candidate, ' is a perfect number.'); |
|||
end.</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
Perfect numbers from 1 to 33550337: |
|||
6 is a perfect number. |
|||
28 is a perfect number. |
|||
496 is a perfect number. |
|||
8128 is a perfect number. |
|||
33550336 is a perfect number. |
|||
</pre> |
|||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
=== Functions === |
|||
<lang perl>sub perf { |
|||
<syntaxhighlight lang="perl">sub perf { |
|||
my $n = shift; |
my $n = shift; |
||
my $sum = 0; |
my $sum = 0; |
||
Line 472: | Line 2,989: | ||
} |
} |
||
return $sum == $n; |
return $sum == $n; |
||
}</ |
}</syntaxhighlight> |
||
Functional style: |
Functional style: |
||
< |
<syntaxhighlight lang="perl">use List::Util qw(sum); |
||
sub perf { |
sub perf { |
||
my $n = shift; |
my $n = shift; |
||
$n == sum(0, grep {$n % $_ == 0} 1..$n-1); |
$n == sum(0, grep {$n % $_ == 0} 1..$n-1); |
||
}</ |
}</syntaxhighlight> |
||
=== Modules === |
|||
The functions above are terribly slow. As usual, this is easier and faster with modules. Both ntheory and Math::Pari have useful functions for this. |
|||
{{libheader|ntheory}} |
|||
A simple predicate: |
|||
<syntaxhighlight lang="perl">use ntheory qw/divisor_sum/; |
|||
sub is_perfect { my $n = shift; divisor_sum($n) == 2*$n; }</syntaxhighlight> |
|||
Use this naive method to show the first 5. Takes about 15 seconds: |
|||
<syntaxhighlight lang="perl">use ntheory qw/divisor_sum/; |
|||
for (1..33550336) { |
|||
print "$_\n" if divisor_sum($_) == 2*$_; |
|||
}</syntaxhighlight> |
|||
Or we can be clever and look for 2^(p-1) * (2^p-1) where 2^p -1 is prime. The first 20 takes about a second. |
|||
<syntaxhighlight lang="perl">use ntheory qw/forprimes is_prime/; |
|||
use bigint; |
|||
forprimes { |
|||
my $n = 2**$_ - 1; |
|||
print "$_\t", $n * 2**($_-1),"\n" if is_prime($n); |
|||
} 2, 4500;</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
2 6 |
|||
3 28 |
|||
5 496 |
|||
7 8128 |
|||
13 33550336 |
|||
17 8589869056 |
|||
19 137438691328 |
|||
31 2305843008139952128 |
|||
61 2658455991569831744654692615953842176 |
|||
89 191561942608236107294793378084303638130997321548169216 |
|||
... 107, 127, 521, 607, 1279, 2203, 2281, 3217, 4253, 4423 ... |
|||
</pre> |
|||
We can speed this up even more using a faster program for printing the large results, as well as a faster primality solution. The first 38 in about 1 second with most of the time printing the large results. Caveat: this goes well past the current bound for odd perfect numbers and does not check for them. |
|||
<syntaxhighlight lang="perl">use ntheory qw/forprimes is_mersenne_prime/; |
|||
use Math::GMP qw/:constant/; |
|||
forprimes { |
|||
print "$_\t", (2**$_-1)*2**($_-1),"\n" if is_mersenne_prime($_); |
|||
} 7_000_000;</syntaxhighlight> |
|||
In addition to generating even perfect numbers, we can also have a fast function which returns true when a given even number is perfect: |
|||
<syntaxhighlight lang="perl">use ntheory qw(is_mersenne_prime valuation); |
|||
sub is_even_perfect { |
|||
my ($n) = @_; |
|||
my $v = valuation($n, 2) || return; |
|||
my $m = ($n >> $v); |
|||
($m & ($m + 1)) && return; |
|||
($m >> $v) == 1 || return; |
|||
is_mersenne_prime($v + 1); |
|||
}</syntaxhighlight> |
|||
=={{header|Phix}}== |
|||
<!--(phixonline)--> |
|||
=== naive/native === |
|||
<syntaxhighlight lang="phix"> |
|||
function is_perfect(integer n) |
|||
return sum(factors(n,-1))=n |
|||
end function |
|||
for i=2 to 100000 do |
|||
if is_perfect(i) then ?i end if |
|||
end for |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=== gmp version === |
|||
{{libheader|Phix/mpfr}} |
|||
<syntaxhighlight lang="phix"> |
|||
with javascript_semantics |
|||
-- demo\rosetta\Perfect_numbers.exw (includes native and cheat versions) |
|||
include mpfr.e |
|||
atom t0 = time(), t1 = t0+1 |
|||
integer maxprime = 4423, -- 19937 (rather slow) |
|||
lim = length(get_primes_le(maxprime)) |
|||
mpz n = mpz_init(), m = mpz_init() |
|||
for i=1 to lim do |
|||
integer p = get_prime(i) |
|||
mpz_ui_pow_ui(n, 2, p) |
|||
mpz_sub_ui(n, n, 1) |
|||
if mpz_prime(n) then |
|||
mpz_ui_pow_ui(m, 2, p-1) |
|||
mpz_mul(n, n, m) |
|||
string ns = mpz_get_short_str(n,comma_fill:=true), |
|||
et = elapsed_short(time()-t0,5,"(%s)") |
|||
printf(1, "%d %s %s\n",{p,ns,et}) |
|||
elsif time()>t1 then |
|||
progress("%d/%d (%.1f%%)\r",{p,maxprime,i/lim*100}) |
|||
t1 = time()+1 |
|||
end if |
|||
end for |
|||
?elapsed(time()-t0) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
2 6 |
|||
3 28 |
|||
5 496 |
|||
7 8,128 |
|||
13 33,550,336 |
|||
17 8,589,869,056 |
|||
19 137,438,691,328 |
|||
31 2,305,843,008,139,952,128 |
|||
61 2,658,455,991,569,831,744,654,692,615,953,842,176 |
|||
89 191,561,942,608,236,...,997,321,548,169,216 (54 digits) |
|||
107 13,164,036,458,569,6...,943,117,783,728,128 (65 digits) |
|||
127 14,474,011,154,664,5...,349,131,199,152,128 (77 digits) |
|||
521 23,562,723,457,267,3...,492,160,555,646,976 (314 digits) |
|||
607 141,053,783,706,712,...,570,759,537,328,128 (366 digits) |
|||
1279 54,162,526,284,365,8...,345,764,984,291,328 (770 digits) |
|||
2203 1,089,258,355,057,82...,580,834,453,782,528 (1,327 digits) |
|||
2281 99,497,054,337,086,4...,375,675,139,915,776 (1,373 digits) |
|||
3217 33,570,832,131,986,7...,888,332,628,525,056 (1,937 digits) (9s) |
|||
4253 18,201,749,040,140,4...,848,437,133,377,536 (2,561 digits) (24s) |
|||
4423 40,767,271,711,094,4...,020,642,912,534,528 (2,663 digits) (28s) |
|||
"28.4s" |
|||
</pre> |
|||
Beyond that it gets rather slow: |
|||
<pre> |
|||
9689 11,434,731,753,038,6...,982,558,429,577,216 (5,834 digits) (6:28) |
|||
9941 598,885,496,387,336,...,478,324,073,496,576 (5,985 digits) (7:31) |
|||
11213 3,959,613,212,817,94...,255,702,691,086,336 (6,751 digits) (11:32) |
|||
19937 931,144,559,095,633,...,434,790,271,942,656 (12,003 digits) (1:22:32) |
|||
</pre> |
|||
=== cheating === |
|||
{{trans|Picat}} |
|||
<syntaxhighlight lang="phix"> |
|||
include mpfr.e |
|||
atom t0 = time() |
|||
mpz n = mpz_init(), m = mpz_init() |
|||
sequence validp = {2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607, |
|||
1279, 2203, 2281, 3217, 4253, 4423, 9689, 9941, 11213, |
|||
19937, 21701, 23209, 44497, 86243, 110503, 132049, 216091, |
|||
756839, 859433, 1257787, 1398269, 2976221, 3021377, 6972593, |
|||
13466917, 20996011, 24036583, 25964951, 30402457, 32582657, |
|||
37156667, 42643801, 43112609, 57885161, |
|||
74207281, 77232917, 82589933} |
|||
if platform()=JS then validp = validp[1..35] end if -- (keep it under 5s) |
|||
for p in validp do |
|||
mpz_ui_pow_ui(n, 2, p) |
|||
mpz_sub_ui(n, n, 1) |
|||
mpz_ui_pow_ui(m, 2, p-1) |
|||
mpz_mul(n, n, m) |
|||
string ns = mpz_get_short_str(n,comma_fill:=true), |
|||
et = elapsed_short(time()-t0,5,"(%s)") |
|||
printf(1, "%d %s %s\n",{p,ns,et}) |
|||
end for |
|||
?elapsed(time()-t0) |
|||
</syntaxhighlight> |
|||
<pre> |
|||
2 6 |
|||
3 28 |
|||
5 496 |
|||
7 8,128 |
|||
13 33,550,336 |
|||
17 8,589,869,056 |
|||
19 137,438,691,328 |
|||
31 2,305,843,008,139,952,128 |
|||
61 2,658,455,991,569,831,744,654,692,615,953,842,176 |
|||
89 191,561,942,608,236,...,997,321,548,169,216 (54 digits) |
|||
107 13,164,036,458,569,6...,943,117,783,728,128 (65 digits) |
|||
127 14,474,011,154,664,5...,349,131,199,152,128 (77 digits) |
|||
521 23,562,723,457,267,3...,492,160,555,646,976 (314 digits) |
|||
607 141,053,783,706,712,...,570,759,537,328,128 (366 digits) |
|||
1279 54,162,526,284,365,8...,345,764,984,291,328 (770 digits) |
|||
2203 1,089,258,355,057,82...,580,834,453,782,528 (1,327 digits) |
|||
2281 99,497,054,337,086,4...,375,675,139,915,776 (1,373 digits) |
|||
3217 33,570,832,131,986,7...,888,332,628,525,056 (1,937 digits) |
|||
4253 18,201,749,040,140,4...,848,437,133,377,536 (2,561 digits) |
|||
4423 40,767,271,711,094,4...,020,642,912,534,528 (2,663 digits) |
|||
9689 11,434,731,753,038,6...,982,558,429,577,216 (5,834 digits) |
|||
9941 598,885,496,387,336,...,478,324,073,496,576 (5,985 digits) |
|||
11213 3,959,613,212,817,94...,255,702,691,086,336 (6,751 digits) |
|||
19937 931,144,559,095,633,...,434,790,271,942,656 (12,003 digits) |
|||
21701 1,006,564,970,546,40...,865,255,141,605,376 (13,066 digits) |
|||
23209 81,153,776,582,351,0...,048,603,941,666,816 (13,973 digits) |
|||
44497 365,093,519,915,713,...,965,353,031,827,456 (26,790 digits) |
|||
86243 144,145,836,177,303,...,480,957,360,406,528 (51,924 digits) |
|||
110503 13,620,458,213,388,4...,255,233,603,862,528 (66,530 digits) |
|||
132049 13,145,129,545,436,9...,438,491,774,550,016 (79,502 digits) |
|||
216091 27,832,745,922,032,7...,263,416,840,880,128 (130,100 digits) |
|||
756839 15,161,657,022,027,0...,971,600,565,731,328 (455,663 digits) |
|||
859433 83,848,822,675,015,7...,651,540,416,167,936 (517,430 digits) |
|||
1257787 849,732,889,343,651,...,394,028,118,704,128 (757,263 digits) |
|||
1398269 331,882,354,881,177,...,668,017,723,375,616 (841,842 digits) |
|||
2976221 194,276,425,328,791,...,106,724,174,462,976 (1,791,864 digits) |
|||
3021377 811,686,848,628,049,...,147,573,022,457,856 (1,819,050 digits) |
|||
6972593 9,551,760,305,212,09...,914,475,123,572,736 (4,197,919 digits) |
|||
13466917 42,776,415,902,185,6...,230,460,863,021,056 (8,107,892 digits) |
|||
20996011 7,935,089,093,651,70...,903,578,206,896,128 (12,640,858 digits) |
|||
24036583 44,823,302,617,990,8...,680,460,572,950,528 (14,471,465 digits) (5s) |
|||
25964951 7,462,098,419,004,44...,245,874,791,088,128 (15,632,458 digits) (8s) |
|||
30402457 49,743,776,545,907,0...,934,536,164,704,256 (18,304,103 digits) (10s) |
|||
32582657 77,594,685,533,649,8...,428,476,577,120,256 (19,616,714 digits) (13s) |
|||
37156667 20,453,422,553,410,5...,147,975,074,480,128 (22,370,543 digits) (16s) |
|||
42643801 1,442,850,579,600,99...,314,837,377,253,376 (25,674,127 digits) (20s) |
|||
43112609 50,076,715,684,982,3...,909,221,145,378,816 (25,956,377 digits) (24s) |
|||
57885161 169,296,395,301,618,...,179,626,270,130,176 (34,850,340 digits) (29s) |
|||
74207281 45,112,996,270,669,0...,008,557,930,315,776 (44,677,235 digits) (36s) |
|||
77232917 10,920,015,213,433,6...,001,402,016,301,056 (46,498,850 digits) (43s) |
|||
82589933 1,108,477,798,641,48...,798,007,191,207,936 (49,724,095 digits) (50s) |
|||
"50.6s" |
|||
</pre> |
|||
=={{header|PHP}}== |
|||
{{trans|C++}} |
|||
<syntaxhighlight lang="php">function is_perfect($number) |
|||
{ |
|||
$sum = 0; |
|||
for($i = 1; $i < $number; $i++) |
|||
{ |
|||
if($number % $i == 0) |
|||
$sum += $i; |
|||
} |
|||
return $sum == $number; |
|||
} |
|||
echo "Perfect numbers from 1 to 33550337:" . PHP_EOL; |
|||
for($num = 1; $num < 33550337; $num++) |
|||
{ |
|||
if(is_perfect($num)) |
|||
echo $num . PHP_EOL; |
|||
}</syntaxhighlight> |
|||
=={{header|Picat}}== |
|||
===Simple divisors/1 function=== |
|||
First is the slow <code>perfect1/1</code> that use the simple divisors/1 function: |
|||
<syntaxhighlight lang="picat">go => |
|||
println(perfect1=[I : I in 1..10_000, perfect1(I)]), |
|||
nl. |
|||
perfect1(N) => sum(divisors(N)) == N. |
|||
divisors(N) = [J: J in 1..1+N div 2, N mod J == 0].</syntaxhighlight> |
|||
{{out}} |
|||
<pre>perfect1 = [1,6,28,496,8128]</pre> |
|||
===Using formula for perfect number candidates=== |
|||
The formula for perfect number candidates is: 2^(p-1)*(2^p-1) for prime p. This is used to find some more perfect numbers in reasonable time. <code>perfect2/1</code> is a faster version of checking if a number is perfect. |
|||
<syntaxhighlight lang="picat">go2 => |
|||
println("Using the formula: 2^(p-1)*(2^p-1) for prime p"), |
|||
foreach(P in primes(32)) |
|||
PF=perfectf(P), |
|||
% Check that it is really a perfect number |
|||
if perfect2(PF) then |
|||
printf("%w (prime %w)\n",PF,P) |
|||
end |
|||
end, |
|||
nl. |
|||
% Formula for perfect number candidates: |
|||
% 2^(p-1)*(2^p-1) where p is a prime |
|||
% |
|||
perfectf(P) = (2**(P-1))*((2**P)-1). |
|||
% Faster check of a perfect number |
|||
perfect2(N) => sum_divisors(N) == N. |
|||
% Sum of divisors |
|||
table |
|||
sum_divisors(N) = Sum => |
|||
sum_divisors(2,N,1,Sum). |
|||
sum_divisors(I,N,Sum0,Sum), I > floor(sqrt(N)) => |
|||
Sum = Sum0. |
|||
% I is a divisor of N |
|||
sum_divisors(I,N,Sum0,Sum), N mod I == 0 => |
|||
Sum1 = Sum0 + I, |
|||
(I != N div I -> |
|||
Sum2 = Sum1 + N div I |
|||
; |
|||
Sum2 = Sum1 |
|||
), |
|||
sum_divisors(I+1,N,Sum2,Sum). |
|||
% I is not a divisor of N. |
|||
sum_divisors(I,N,Sum0,Sum) => |
|||
sum_divisors(I+1,N,Sum0,Sum).</syntaxhighlight> |
|||
{{out}} |
|||
<pre>6 (prime 2) |
|||
28 (prime 3) |
|||
496 (prime 5) |
|||
8128 (prime 7) |
|||
33550336 (prime 13) |
|||
8589869056 (prime 17) |
|||
137438691328 (prime 19) |
|||
2305843008139952128 (prime 31) |
|||
CPU time 118.039 seconds. Backtracks: 0</pre> |
|||
===Using list of the primes generating the perfect numbers=== |
|||
Now let's cheat a little. At https://en.wikipedia.org/wiki/Perfect_number there is a list of the first 48 primes that generates perfect numbers according to the formula 2^(p-1)*(2^p-1) for prime p. |
|||
The perfect numbers are printed only if they has < 80 digits, otherwise the number of digits are shown. The program stops when reaching a number with more than 100 000 digits. (Note: The major time running this program is getting the number of digits.) |
|||
<syntaxhighlight lang="picat">go3 => |
|||
ValidP = [2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607, |
|||
1279, 2203, 2281, 3217, 4253, 4423, 9689, 9941, 11213, |
|||
19937, 21701, 23209, 44497, 86243, 110503, 132049, 216091, |
|||
756839, 859433, 1257787, 1398269, 2976221, 3021377, 6972593, |
|||
13466917, 20996011, 24036583, 25964951, 30402457, 32582657, |
|||
37156667, 42643801, 43112609, 57885161], |
|||
foreach(P in ValidP) |
|||
printf("prime %w: ", P), |
|||
PF = perfectf(P), |
|||
Len = PF.to_string.len, |
|||
if Len < 80 then |
|||
println(PF) |
|||
else |
|||
println(len=Len) |
|||
end, |
|||
if Len >= 100_000 then |
|||
fail |
|||
end |
|||
end, |
|||
nl.</syntaxhighlight> |
|||
{{out}} |
|||
<pre>prime 2: 6 |
|||
prime 3: 28 |
|||
prime 5: 496 |
|||
prime 7: 8128 |
|||
prime 13: 33550336 |
|||
prime 17: 8589869056 |
|||
prime 19: 137438691328 |
|||
prime 31: 2305843008139952128 |
|||
prime 61: 2658455991569831744654692615953842176 |
|||
prime 89: 191561942608236107294793378084303638130997321548169216 |
|||
prime 107: 13164036458569648337239753460458722910223472318386943117783728128 |
|||
prime 127: 14474011154664524427946373126085988481573677491474835889066354349131199152128 |
|||
prime 521: len = 314 |
|||
prime 607: len = 366 |
|||
prime 1279: len = 770 |
|||
prime 2203: len = 1327 |
|||
prime 2281: len = 1373 |
|||
prime 3217: len = 1937 |
|||
prime 4253: len = 2561 |
|||
prime 4423: len = 2663 |
|||
prime 9689: len = 5834 |
|||
prime 9941: len = 5985 |
|||
prime 11213: len = 6751 |
|||
prime 19937: len = 12003 |
|||
prime 21701: len = 13066 |
|||
prime 23209: len = 13973 |
|||
prime 44497: len = 26790 |
|||
prime 86243: len = 51924 |
|||
prime 110503: len = 66530 |
|||
prime 132049: len = 79502 |
|||
prime 216091: len = 130100</pre> |
|||
=={{header|PicoLisp}}== |
=={{header|PicoLisp}}== |
||
< |
<syntaxhighlight lang="picolisp">(de perfect (N) |
||
(let C 0 |
(let C 0 |
||
(for I (/ N 2) |
(for I (/ N 2) |
||
(and (=0 (% N I)) (inc 'C I)) ) |
(and (=0 (% N I)) (inc 'C I)) ) |
||
(= C N) ) )</ |
(= C N) ) )</syntaxhighlight> |
||
<syntaxhighlight lang="picolisp">(de faster (N) |
|||
(let (C 1 Stop (sqrt N)) |
|||
(for (I 2 (<= I Stop) (inc I)) |
|||
(and |
|||
(=0 (% N I)) |
|||
(inc 'C (+ (/ N I) I)) ) ) |
|||
(= C N) ) )</syntaxhighlight> |
|||
=={{header|PL/I}}== |
|||
<syntaxhighlight lang="pl/i">perfect: procedure (n) returns (bit(1)); |
|||
declare n fixed; |
|||
declare sum fixed; |
|||
declare i fixed binary; |
|||
sum = 0; |
|||
do i = 1 to n-1; |
|||
if mod(n, i) = 0 then sum = sum + i; |
|||
end; |
|||
return (sum=n); |
|||
end perfect;</syntaxhighlight> |
|||
==={{header|PL/I-80}}=== |
|||
<syntaxhighlight lang="pl/i">perfect_search: procedure options (main); |
|||
%replace |
|||
search_limit by 10000, |
|||
true by '1'b, |
|||
false by '0'b; |
|||
dcl (k, found) fixed bin; |
|||
put skip list ('Searching for perfect numbers up to '); |
|||
put edit (search_limit) (f(5)); |
|||
found = 0; |
|||
do k = 2 to search_limit; |
|||
if isperfect(k) then |
|||
do; |
|||
put skip list(k); |
|||
found = found + 1; |
|||
end; |
|||
end; |
|||
put skip list (found, ' perfect numbers were found'); |
|||
/* return true if n is perfect, otherwise false */ |
|||
isperfect: procedure(n) returns (bit(1)); |
|||
dcl (n, sum, f1, f2) fixed bin; |
|||
sum = 1; /* 1 is a proper divisor of every number */ |
|||
f1 = 2; |
|||
do while ((f1 * f1) <= n); |
|||
if mod(n, f1) = 0 then |
|||
do; |
|||
sum = sum + f1; |
|||
f2 = n / f1; |
|||
/* don't double count identical co-factors! */ |
|||
if f2 > f1 then sum = sum + f2; |
|||
end; |
|||
f1 = f1 + 1; |
|||
end; |
|||
return (sum = n); |
|||
end isperfect; |
|||
end perfect_search;</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Searching for perfect numbers up to 10000 |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
4 perfect numbers were found |
|||
</pre> |
|||
=={{header|PL/M}}== |
|||
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator) |
|||
<syntaxhighlight lang="pli">100H: /* FIND SOME PERFECT NUMBERS: NUMBERS EQUAL TO THE SUM OF THEIR PROPER */ |
|||
/* DIVISORS */ |
|||
/* CP/M SYSTEM CALL AND I/O ROUTINES */ |
|||
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */ |
|||
DECLARE FN BYTE, ARG ADDRESS; |
|||
GOTO 5; |
|||
END BDOS; |
|||
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END; |
|||
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END; |
|||
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END; |
|||
PR$NUMBER: PROCEDURE( N ); |
|||
DECLARE N ADDRESS; |
|||
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE; |
|||
V = N; |
|||
W = LAST( N$STR ); |
|||
N$STR( W ) = '$'; |
|||
N$STR( W := W - 1 ) = '0' + ( V MOD 10 ); |
|||
DO WHILE( ( V := V / 10 ) > 0 ); |
|||
N$STR( W := W - 1 ) = '0' + ( V MOD 10 ); |
|||
END; |
|||
CALL PR$STRING( .N$STR( W ) ); |
|||
END PR$NUMBER; |
|||
/* TASK */ |
|||
/* RETURNS TRUE IF N IS PERFECT, 0 OTHERWISE */ |
|||
IS$PERFECT: PROCEDURE( N )BYTE; |
|||
DECLARE N ADDRESS; |
|||
DECLARE ( F1, F2, SUM ) ADDRESS; |
|||
SUM = 1; |
|||
F1 = 2; |
|||
F2 = N; |
|||
DO WHILE( F1 * F1 <= N ); |
|||
IF N MOD F1 = 0 THEN DO; |
|||
SUM = SUM + F1; |
|||
F2 = N / F1; |
|||
/* AVOID COUNTING E.G., 2 TWICE AS A FACTOR OF 4 */ |
|||
IF F2 > F1 THEN SUM = SUM + F2; |
|||
END; |
|||
F1 = F1 + 1; |
|||
END; |
|||
RETURN SUM = N; |
|||
END IS$PERFECT ; |
|||
/* TEST IS$PERFECT */ |
|||
DECLARE N ADDRESS; |
|||
DO N = 2 TO 10$000; |
|||
IF IS$PERFECT( N ) THEN DO; |
|||
CALL PR$CHAR( ' ' ); |
|||
CALL PR$NUMBER( N ); |
|||
END; |
|||
END; |
|||
EOF</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 28 496 8128 |
|||
</pre> |
|||
Alternative, much faster version. |
|||
{{Trans|Action!}} |
|||
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator) |
|||
<syntaxhighlight lang="pli">100H: /* FIND SOME PERFECT NUMBERS: NUMBERS EQUAL TO THE SUM OF THEIR PROPER */ |
|||
/* DIVISORS */ |
|||
/* CP/M SYSTEM CALL AND I/O ROUTINES */ |
|||
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */ |
|||
DECLARE FN BYTE, ARG ADDRESS; |
|||
GOTO 5; |
|||
END BDOS; |
|||
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END; |
|||
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END; |
|||
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END; |
|||
PR$NUMBER: PROCEDURE( N ); |
|||
DECLARE N ADDRESS; |
|||
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE; |
|||
V = N; |
|||
W = LAST( N$STR ); |
|||
N$STR( W ) = '$'; |
|||
N$STR( W := W - 1 ) = '0' + ( V MOD 10 ); |
|||
DO WHILE( ( V := V / 10 ) > 0 ); |
|||
N$STR( W := W - 1 ) = '0' + ( V MOD 10 ); |
|||
END; |
|||
CALL PR$STRING( .N$STR( W ) ); |
|||
END PR$NUMBER; |
|||
/* TASK - TRANSLATION OF ACTION! */ |
|||
DECLARE MAX$NUM LITERALLY '10$000'; |
|||
DECLARE PDS( 10$001 ) ADDRESS; |
|||
DECLARE ( I, J ) ADDRESS; |
|||
DO I = 2 TO MAX$NUM; |
|||
PDS( I ) = 1; |
|||
END; |
|||
DO I = 2 TO MAX$NUM; |
|||
DO J = I + I TO MAX$NUM BY I; |
|||
PDS( J ) = PDS( J ) + I; |
|||
END; |
|||
END; |
|||
DO I = 2 TO MAX$NUM; |
|||
IF PDS( I ) = I THEN DO; |
|||
CALL PR$NUMBER( I ); |
|||
CALL PR$NL; |
|||
END; |
|||
END; |
|||
EOF</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=={{header|PowerShell}}== |
|||
<syntaxhighlight lang="powershell">Function IsPerfect($n) |
|||
{ |
|||
$sum=0 |
|||
for($i=1;$i-lt$n;$i++) |
|||
{ |
|||
if($n%$i -eq 0) |
|||
{ |
|||
$sum += $i |
|||
} |
|||
} |
|||
return $sum -eq $n |
|||
} |
|||
Returns "True" if the given number is perfect and "False" if it's not.</syntaxhighlight> |
|||
=={{header|Prolog}}== |
|||
===Classic approach=== |
|||
Works with SWI-Prolog |
|||
<syntaxhighlight lang="prolog">tt_divisors(X, N, TT) :- |
|||
Q is X / N, |
|||
( 0 is X mod N -> (Q = N -> TT1 is N + TT; |
|||
TT1 is N + Q + TT); |
|||
TT = TT1), |
|||
( sqrt(X) > N + 1 -> N1 is N+1, tt_divisors(X, N1, TT1); |
|||
TT1 = X). |
|||
perfect(X) :- |
|||
tt_divisors(X, 2, 1). |
|||
perfect_numbers(N, L) :- |
|||
numlist(2, N, LN), |
|||
include(perfect, LN, L).</syntaxhighlight> |
|||
===Faster method=== |
|||
Since a perfect number is of the form 2^(n-1) * (2^n - 1), we can eliminate a lot of candidates by merely factoring out the 2s and seeing if the odd portion is (2^(n+1)) - 1. |
|||
<syntaxhighlight lang="prolog"> |
|||
perfect(N) :- |
|||
factor_2s(N, Chk, Exp), |
|||
Chk =:= (1 << (Exp+1)) - 1, |
|||
prime(Chk). |
|||
factor_2s(N, S, D) :- factor_2s(N, 0, S, D). |
|||
factor_2s(D, S, D, S) :- getbit(D, 0) =:= 1, !. |
|||
factor_2s(N, E, D, S) :- |
|||
E2 is E + 1, N2 is N >> 1, factor_2s(N2, E2, D, S). |
|||
% check if a number is prime |
|||
% |
|||
wheel235(L) :- |
|||
W = [4, 2, 4, 2, 4, 6, 2, 6 | W], |
|||
L = [1, 2, 2 | W]. |
|||
prime(N) :- |
|||
N >= 2, |
|||
wheel235(W), |
|||
prime(N, 2, W). |
|||
prime(N, D, _) :- D*D > N, !. |
|||
prime(N, D, [A|As]) :- |
|||
N mod D =\= 0, |
|||
D2 is D + A, prime(N, D2, As). |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
?- between(1, 10_000, N), perfect(N). |
|||
N = 6 ; |
|||
N = 28 ; |
|||
N = 496 ; |
|||
N = 8128 ; |
|||
false. |
|||
</pre> |
|||
===Functional approach=== |
|||
Works with SWI-Prolog and module lambda, written by <b>Ulrich Neumerkel</b> found there http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl |
|||
<syntaxhighlight lang="prolog">:- use_module(library(lambda)). |
|||
is_divisor(V, N) :- |
|||
0 =:= V mod N. |
|||
is_perfect(N) :- |
|||
N1 is floor(N/2), |
|||
numlist(1, N1, L), |
|||
f_compose_1(foldl((\X^Y^Z^(Z is X+Y)), 0), filter(is_divisor(N)), F), |
|||
call(F, L, N). |
|||
f_perfect_numbers(N, L) :- |
|||
numlist(2, N, LN), |
|||
filter(is_perfect, LN, L). |
|||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
|||
% functionnal predicates |
|||
%% foldl(Pred, Init, List, R). |
|||
% |
|||
foldl(_Pred, Val, [], Val). |
|||
foldl(Pred, Val, [H | T], Res) :- |
|||
call(Pred, Val, H, Val1), |
|||
foldl(Pred, Val1, T, Res). |
|||
%% filter(Pred, LstIn, LstOut) |
|||
% |
|||
filter(_Pre, [], []). |
|||
filter(Pred, [H|T], L) :- |
|||
filter(Pred, T, L1), |
|||
( call(Pred,H) -> L = [H|L1]; L = L1). |
|||
%% f_compose_1(Pred1, Pred2, Pred1(Pred2)). |
|||
% |
|||
f_compose_1(F,G, \X^Z^(call(G,X,Y), call(F,Y,Z))).</syntaxhighlight> |
|||
=={{header|PureBasic}}== |
=={{header|PureBasic}}== |
||
< |
<syntaxhighlight lang="purebasic">Procedure is_Perfect_number(n) |
||
Protected summa, i=1, result=#False |
Protected summa, i=1, result=#False |
||
Repeat |
Repeat |
||
Line 501: | Line 3,676: | ||
EndIf |
EndIf |
||
ProcedureReturn result |
ProcedureReturn result |
||
EndProcedure</ |
EndProcedure</syntaxhighlight> |
||
=={{header|Python}}== |
=={{header|Python}}== |
||
;Relative timings: |
|||
<lang python>def perf(n): |
|||
Relative timings for sifting the integers from 1 to 50_000 inclusive for perfect numbers. |
|||
{| class="wikitable" |
|||
! style="font-weight:bold;" | Function |
|||
! style="font-weight:bold;" | Time |
|||
! style="font-weight:bold;" | Type |
|||
|- |
|||
| perf4 |
|||
| 1 |
|||
| Optimised procedural |
|||
|- |
|||
| perfect |
|||
| 1.6 |
|||
| Optimised functional |
|||
|- |
|||
| perf1 |
|||
| 259 |
|||
| Procedural |
|||
|- |
|||
| perf2 |
|||
| 273 |
|||
| Functional |
|||
|} |
|||
===Python: Procedural=== |
|||
<syntaxhighlight lang="python">def perf1(n): |
|||
sum = 0 |
sum = 0 |
||
for i in |
for i in range(1, n): |
||
if n % i == 0: |
if n % i == 0: |
||
sum += i |
sum += i |
||
return sum == n</ |
return sum == n</syntaxhighlight> |
||
Functional style: |
|||
===Python: Optimised Procedural=== |
|||
<lang python>perf = lambda n: n == sum(i for i in xrange(1, n) if n % i == 0)</lang> |
|||
<syntaxhighlight lang="python">from itertools import chain, cycle, accumulate |
|||
def factor2(n): |
|||
def prime_powers(n): |
|||
# c goes through 2, 3, 5, then the infinite (6n+1, 6n+5) series |
|||
for c in accumulate(chain([2, 1, 2], cycle([2,4]))): |
|||
if c*c > n: break |
|||
if n%c: continue |
|||
d,p = (), c |
|||
while not n%c: |
|||
n,p,d = n//c, p*c, d + (p,) |
|||
yield(d) |
|||
if n > 1: yield((n,)) |
|||
r = [1] |
|||
for e in prime_powers(n): |
|||
r += [a*b for a in r for b in e] |
|||
return r |
|||
def perf4(n): |
|||
"Using most efficient prime factoring routine from: http://rosettacode.org/wiki/Factors_of_an_integer#Python" |
|||
return 2 * n == sum(factor2(n))</syntaxhighlight> |
|||
===Python: Functional=== |
|||
<syntaxhighlight lang="python">def perf2(n): |
|||
return n == sum(i for i in range(1, n) if n % i == 0) |
|||
print ( |
|||
list(filter(perf2, range(1, 10001))) |
|||
)</syntaxhighlight> |
|||
<syntaxhighlight lang="python">'''Perfect numbers''' |
|||
from math import sqrt |
|||
# perfect :: Int - > Bool |
|||
def perfect(n): |
|||
'''Is n the sum of its proper divisors other than 1 ?''' |
|||
root = sqrt(n) |
|||
lows = [x for x in enumFromTo(2)(int(root)) if 0 == (n % x)] |
|||
return 1 < n and ( |
|||
n == 1 + sum(lows + [n / x for x in lows if root != x]) |
|||
) |
|||
# main :: IO () |
|||
def main(): |
|||
'''Test''' |
|||
print([ |
|||
x for x in enumFromTo(1)(10000) if perfect(x) |
|||
]) |
|||
# GENERIC ------------------------------------------------- |
|||
# enumFromTo :: (Int, Int) -> [Int] |
|||
def enumFromTo(m): |
|||
'''Integer enumeration from m to n.''' |
|||
return lambda n: list(range(m, 1 + n)) |
|||
if __name__ == '__main__': |
|||
main()</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>[6, 28, 496, 8128]</pre> |
|||
=={{header|Quackery}}== |
|||
<code>factors</code> is defined at [http://rosettacode.org/wiki/Factors_of_an_integer#Quackery Factors of an integer]. |
|||
<syntaxhighlight lang="quackery"> [ 0 swap witheach + ] is sum ( [ --> n ) |
|||
[ factors -1 pluck dip sum = ] is perfect ( n --> n ) |
|||
say "Perfect numbers less than 10000:" cr |
|||
10000 times |
|||
[ i^ 1+ perfect if [ i^ 1+ echo cr ] ] |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Perfect numbers less than 10000: |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=={{header|R}}== |
=={{header|R}}== |
||
< |
<syntaxhighlight lang="r">is.perf <- function(n){ |
||
if (n==0|n==1) return(FALSE) |
if (n==0|n==1) return(FALSE) |
||
s <- seq (1,n-1) |
s <- seq (1,n-1) |
||
Line 524: | Line 3,817: | ||
# Usage - Warning High Memory Usage |
# Usage - Warning High Memory Usage |
||
is.perf(28) |
is.perf(28) |
||
sapply(c(6,28,496,8128,33550336),is.perf)</ |
sapply(c(6,28,496,8128,33550336),is.perf)</syntaxhighlight> |
||
=={{header|Racket}}== |
|||
<syntaxhighlight lang="racket">#lang racket |
|||
(require math) |
|||
(define (perfect? n) |
|||
(= |
|||
(* n 2) |
|||
(sum (divisors n)))) |
|||
; filtering to only even numbers for better performance |
|||
(filter perfect? (filter even? (range 1e5))) |
|||
;-> '(0 6 28 496 8128)</syntaxhighlight> |
|||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
Naive (very slow) version |
|||
<syntaxhighlight lang="raku" line>sub is-perf($n) { $n == [+] grep $n %% *, 1 .. $n div 2 } |
|||
# used as |
|||
put ((1..Inf).hyper.grep: {.&is-perf})[^4];</syntaxhighlight> |
|||
{{out}} |
|||
<pre>6 28 496 8128</pre> |
|||
Much, much faster version: |
|||
<syntaxhighlight lang="raku" line>my @primes = lazy (2,3,*+2 … Inf).grep: { .is-prime }; |
|||
my @perfects = lazy gather for @primes { |
|||
my $n = 2**$_ - 1; |
|||
take $n * 2**($_ - 1) if $n.is-prime; |
|||
} |
|||
.put for @perfects[^12];</syntaxhighlight> |
|||
{{out}} |
|||
<pre>6 |
|||
28 |
|||
496 |
|||
8128 |
|||
33550336 |
|||
8589869056 |
|||
137438691328 |
|||
2305843008139952128 |
|||
2658455991569831744654692615953842176 |
|||
191561942608236107294793378084303638130997321548169216 |
|||
13164036458569648337239753460458722910223472318386943117783728128 |
|||
14474011154664524427946373126085988481573677491474835889066354349131199152128</pre> |
|||
=={{header|REBOL}}== |
|||
<syntaxhighlight lang="rebol">perfect?: func [n [integer!] /local sum] [ |
|||
sum: 0 |
|||
repeat i (n - 1) [ |
|||
if zero? remainder n i [ |
|||
sum: sum + i |
|||
] |
|||
] |
|||
sum = n |
|||
]</syntaxhighlight> |
|||
=={{header|REXX}}== |
|||
===Classic REXX version of ooRexx=== |
|||
This version is a '''Classic Rexx''' version of the '''ooRexx''' program as of 14-Sep-2013. |
|||
<syntaxhighlight lang="rexx">/*REXX version of the ooRexx program (the code was modified to run with Classic REXX).*/ |
|||
do i=1 to 10000 /*statement changed: LOOP ──► DO*/ |
|||
if perfectNumber(i) then say i "is a perfect number" |
|||
end |
|||
exit |
|||
perfectNumber: procedure; parse arg n /*statements changed: ROUTINE,USE*/ |
|||
sum=0 |
|||
do i=1 to n%2 /*statement changed: LOOP ──► DO*/ |
|||
if n//i==0 then sum=sum+i /*statement changed: sum += i */ |
|||
end |
|||
return sum=n</syntaxhighlight> |
|||
'''output''' when using the default of 10000: |
|||
<pre> |
|||
6 is a perfect number |
|||
28 is a perfect number |
|||
496 is a perfect number |
|||
8128 is a perfect number |
|||
</pre> |
|||
===Classic REXX version of PL/I=== |
|||
This version is a '''Classic REXX''' version of the '''PL/I''' program as of 14-Sep-2013, a REXX '''say''' statement |
|||
<br>was added to display the perfect numbers. Also, an epilog was written for the re-worked function. |
|||
<syntaxhighlight lang="rexx">/*REXX version of the PL/I program (code was modified to run with Classic REXX). */ |
|||
parse arg low high . /*obtain the specified number(s).*/ |
|||
if high=='' & low=='' then high=34000000 /*if no arguments, use a range. */ |
|||
if low=='' then low=1 /*if no LOW, then assume unity.*/ |
|||
if high=='' then high=low /*if no HIGH, then assume LOW. */ |
|||
do i=low to high /*process the single # or range. */ |
|||
if perfect(i) then say i 'is a perfect number.' |
|||
end /*i*/ |
|||
exit |
|||
perfect: procedure; parse arg n /*get the number to be tested. */ |
|||
sum=0 /*the sum of the factors so far. */ |
|||
do i=1 for n-1 /*starting at 1, find all factors*/ |
|||
if n//i==0 then sum=sum+i /*I is a factor of N, so add it.*/ |
|||
end /*i*/ |
|||
return sum=n /*if the sum matches N, perfect! */</syntaxhighlight> |
|||
'''output''' when using the input defaults of: <tt> 1 10000 </tt> |
|||
The output is the same as for the ooRexx version (above). |
|||
===traditional method=== |
|||
Programming note: this traditional method takes advantage of a few shortcuts: |
|||
:::* testing only goes up to the (integer) square root of '''X''' |
|||
:::* testing bypasses the test of the first and last factors |
|||
:::* the ''corresponding factor'' is also used when a factor is found |
|||
<syntaxhighlight 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*/ |
|||
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */ |
|||
if low=='' then low=1 /*if no LOW, then assume unity. */ |
|||
if high=='' then high=low /*if no HIGH, then assume LOW. */ |
|||
w=length(high) /*use W for formatting the output. */ |
|||
numeric digits max(9,w+2) /*ensure enough digits to handle number*/ |
|||
do i=low to high /*process the single number or a range.*/ |
|||
if isPerfect(i) then say right(i,w) 'is a perfect number.' |
|||
end /*i*/ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
isPerfect: procedure; parse arg x /*obtain the number to be tested. */ |
|||
if x<6 then return 0 /*perfect numbers can't be < six. */ |
|||
s=1 /*the first factor of X. ___*/ |
|||
do j=2 while j*j<=x /*starting at 2, find the factors ≤√ X */ |
|||
if x//j\==0 then iterate /*J isn't a factor of X, so skip it.*/ |
|||
s = s + j + x%j /* ··· add it and the other factor. */ |
|||
end /*j*/ /*(above) is marginally faster. */ |
|||
return s==x /*if the sum matches X, it's perfect! */</syntaxhighlight> |
|||
'''output''' when using the default inputs: |
|||
<pre> |
|||
6 is a perfect number. |
|||
28 is a perfect number. |
|||
496 is a perfect number. |
|||
8128 is a perfect number. |
|||
33550336 is a perfect number. |
|||
</pre> |
|||
For 10,000 numbers tested, this version is '''19.6''' times faster than the ooRexx program logic.<br> |
|||
For 10,000 numbers tested, this version is '''25.6''' times faster than the PL/I program logic. |
|||
<br><br>Note: For the above timings, only 10,000 numbers were tested. |
|||
===optimized using digital root=== |
|||
This REXX version makes use of the fact that all ''known'' perfect numbers > 6 have a ''digital root'' of '''1'''. |
|||
<syntaxhighlight lang="rexx">/*REXX program tests if a number (or a range of numbers) is/are perfect. */ |
|||
parse arg low high . /*obtain the specified number(s). */ |
|||
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */ |
|||
if low=='' then low=1 /*if no LOW, then assume unity. */ |
|||
if high=='' then high=low /*if no HIGH, then assume LOW. */ |
|||
w=length(high) /*use W for formatting the output. */ |
|||
numeric digits max(9,w+2) /*ensure enough digits to handle number*/ |
|||
do i=low to high /*process the single number or a range.*/ |
|||
if isPerfect(i) then say right(i,w) 'is a perfect number.' |
|||
end /*i*/ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
isPerfect: procedure; parse arg x 1 y /*obtain the number to be tested. */ |
|||
if x==6 then return 1 /*handle the special case of six. */ |
|||
/*[↓] perfect number's digitalRoot = 1*/ |
|||
do until y<10 /*find the digital root of Y. */ |
|||
parse var y r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end /*k*/ |
|||
y=r /*find digital root of the digit root. */ |
|||
end /*until*/ /*wash, rinse, repeat ··· */ |
|||
if r\==1 then return 0 /*Digital root ¬ 1? Then ¬ perfect. */ |
|||
s=1 /*the first factor of X. ___*/ |
|||
do j=2 while j*j<=x /*starting at 2, find the factors ≤√ X */ |
|||
if x//j\==0 then iterate /*J isn't a factor of X, so skip it. */ |
|||
s = s + j + x%j /*··· add it and the other factor. */ |
|||
end /*j*/ /*(above) is marginally faster. */ |
|||
return s==x /*if the sum matches X, it's perfect! */</syntaxhighlight> |
|||
'''output''' is the same as the traditional version and is about '''5.3''' times faster (testing '''34,000,000''' numbers). |
|||
===optimized using only even numbers=== |
|||
This REXX version uses the fact that all ''known'' perfect numbers are ''even''. |
|||
<syntaxhighlight 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*/ |
|||
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */ |
|||
if low=='' then low=1 /*if no LOW, then assume unity. */ |
|||
low=low+low//2 /*if LOW is odd, bump it by one. */ |
|||
if high=='' then high=low /*if no HIGH, then assume LOW. */ |
|||
w=length(high) /*use W for formatting the output. */ |
|||
numeric digits max(9,w+2) /*ensure enough digits to handle number*/ |
|||
do i=low to high by 2 /*process the single number or a range.*/ |
|||
if isPerfect(i) then say right(i,w) 'is a perfect number.' |
|||
end /*i*/ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
isPerfect: procedure; parse arg x 1 y /*obtain the number to be tested. */ |
|||
if x==6 then return 1 /*handle the special case of six. */ |
|||
do until y<10 /*find the digital root of Y. */ |
|||
parse var y 1 r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end /*k*/ |
|||
y=r /*find digital root of the digital root*/ |
|||
end /*until*/ /*wash, rinse, repeat ··· */ |
|||
if r\==1 then return 0 /*Digital root ¬ 1 ? Then ¬ perfect.*/ |
|||
s=3 + x%2 /*the first 3 factors of X. ___*/ |
|||
do j=3 while j*j<=x /*starting at 3, find the factors ≤√ X */ |
|||
if x//j\==0 then iterate /*J isn't a factor o f X, so skip it.*/ |
|||
s = s + j + x%j /* ··· add it and the other factor. */ |
|||
end /*j*/ /*(above) is marginally faster. */ |
|||
return s==x /*if sum matches X, then it's perfect!*/</syntaxhighlight> |
|||
'''output''' is the same as the traditional version and is about '''11.5''' times faster (testing '''34,000,000''' numbers). |
|||
===Lucas-Lehmer method=== |
|||
This version uses memoization to implement a fast version of the Lucas-Lehmer test. |
|||
<syntaxhighlight lang="rexx">/*REXX program tests if a number (or a range of numbers) is/are perfect. */ |
|||
parse arg low high . /*obtain the optional arguments from CL*/ |
|||
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */ |
|||
if low=='' then low=1 /*if no LOW, then assume unity. */ |
|||
low=low+low//2 /*if LOW is odd, bump it by one. */ |
|||
if high=='' then high=low /*if no HIGH, then assume LOW. */ |
|||
w=length(high) /*use W for formatting the output. */ |
|||
numeric digits max(9,w+2) /*ensure enough digits to handle number*/ |
|||
@.=0; @.1=2 /*highest magic number and its index. */ |
|||
do i=low to high by 2 /*process the single number or a range.*/ |
|||
if isPerfect(i) then say right(i,w) 'is a perfect number.' |
|||
end /*i*/ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
isPerfect: procedure expose @.; parse arg x /*obtain the number to be tested. */ |
|||
/*Lucas-Lehmer know that perfect */ |
|||
/* numbers can be expressed as: */ |
|||
/* [2**n - 1] * [2** (n-1) ] */ |
|||
if @.0<x then do @.1=@.1 while @._<=x; _=(2**@.1-1)*2**(@.1-1); @.0=_; @._=_ |
|||
end /*@.1*/ /*uses memoization for the formula. */ |
|||
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer test? */ |
|||
s = 3 + x%2 /*we know the following factors: */ |
|||
/* 1 ('cause Mama said so.) */ |
|||
/* 2 ('cause it's even.) */ |
|||
/* x÷2 ( " " " ) ___*/ |
|||
do j=3 while j*j<=x /*starting at 3, find the factors ≤√ X */ |
|||
if x//j\==0 then iterate /*J divides X evenly, so ··· */ |
|||
s=s + j + x%j /*··· add it and the other factor. */ |
|||
end /*j*/ /*(above) is marginally faster. */ |
|||
return s==x /*if the sum matches X, it's perfect!*/</syntaxhighlight> |
|||
'''output''' is the same as the traditional version and is about '''75''' times faster (testing '''34,000,000''' numbers). |
|||
===Lucas-Lehmer + other optimizations=== |
|||
This version uses the Lucas-Lehmer method, digital roots, and restricts itself to ''even'' numbers, and |
|||
<br>also utilizes a check for the last-two-digits as per François Édouard Anatole Lucas (in 1891). |
|||
Also, in the first '''do''' loop, the index <big>'''i'''</big> is ''fast advanced'' according to the last number tested. |
|||
An integer square root function was added to limit the factorization of a number. |
|||
<syntaxhighlight 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*/ |
|||
if high=='' & low=="" then high=34000000 /*No arguments? Then use a range. */ |
|||
if low=='' then low=1 /*if no LOW, then assume unity. */ |
|||
low=low+low//2 /*if LOW is odd, bump it by one. */ |
|||
if high=='' then high=low /*if no HIGH, then assume LOW. */ |
|||
w=length(high) /*use W for formatting the output. */ |
|||
numeric digits max(9,w+2) /*ensure enough decimal digits for nums*/ |
|||
@. =0; @.1=2; !.=2; _=' 6' /*highest magic number and its index.*/ |
|||
!._=22; !.16=12; !.28=8; !.36=20; !.56=20; !.76=20; !.96=20 |
|||
/* [↑] "Lucas' numbers, in 1891. */ |
|||
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.' |
|||
i=i+!.? /*use a fast advance for the DO index. */ |
|||
end /*i*/ /* [↑] note: the DO index is modified.*/ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
isPerfect: procedure expose @. !. ? /*expose (make global) some variables. */ |
|||
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 !.?==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) } ║ |
|||
╚═════════════════════════════════════════════╝*/ |
|||
if @.0<x then do @.1=@.1 while @._<=x; _=(2**@.1-1)*2**(@.1-1); @.0=_; @._=_ |
|||
end /*@.1*/ /* [↑] uses memoization for formula. */ |
|||
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer? Not perfect*/ |
|||
/*[↓] perfect numbers digital root = 1*/ |
|||
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 /*k*/ |
|||
y=d /*find digital root of the digital root*/ |
|||
end /*until*/ /*wash, rinse, repeat ··· */ |
|||
if d\==1 then return 0 /*Is digital root ¬ 1? Then ¬ perfect.*/ |
|||
s=3 + x%2 /*we know the following factors: unity,*/ |
|||
z=x /*2, and x÷2 (x is even). */ |
|||
q=1; do while q<=z; q=q*4 ; end /*while q≤z*/ /* _____*/ |
|||
r=0 /* [↓] R will be the integer √ X */ |
|||
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 /*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*/ |
|||
end /*j*/ |
|||
return s==x /*if the sum matches X, then perfect! */</syntaxhighlight> |
|||
'''output''' is the same as the traditional version and is about '''500''' times faster (testing '''34,000,000''' numbers). <br><br> |
|||
=={{header|Ring}}== |
|||
<syntaxhighlight lang="ring"> |
|||
for i = 1 to 10000 |
|||
if perfect(i) see i + nl ok |
|||
next |
|||
func perfect n |
|||
sum = 0 |
|||
for i = 1 to n - 1 |
|||
if n % i = 0 sum = sum + i ok |
|||
next |
|||
if sum = n return 1 else return 0 ok |
|||
return sum |
|||
</syntaxhighlight> |
|||
=={{header|RPL}}== |
|||
≪ 0 SWAP 1 |
|||
'''WHILE''' DUP2 > '''REPEAT''' |
|||
'''IF''' DUP2 MOD NOT '''THEN''' ROT OVER + ROT ROT '''END''' |
|||
1 + '''END''' |
|||
DROP == |
|||
≫ ''''PFCT?'''' STO |
|||
≪ |
|||
{ } 1 1000 '''FOR''' n |
|||
'''IF''' n '''PFCT?''' '''THEN''' n + '''END''' '''NEXT''' |
|||
≫ ''''TASK'''' STO |
|||
{{out}} |
|||
<pre> |
|||
1: { 6 28 496 } |
|||
</pre> |
|||
A vintage HP-28S needs 157 seconds to collect all perfect numbers under 100... |
|||
=={{header|Ruby}}== |
=={{header|Ruby}}== |
||
< |
<syntaxhighlight lang="ruby">def perf(n) |
||
sum = 0 |
|||
for i in 1...n |
|||
if n % i == 0 |
sum += i if n % i == 0 |
||
end |
|||
sum += i |
|||
sum == n |
|||
end</syntaxhighlight> |
|||
Functional style: |
|||
<syntaxhighlight lang="ruby">def perf(n) |
|||
n == (1...n).select {|i| n % i == 0}.inject(:+) |
|||
end</syntaxhighlight> |
|||
Faster version: |
|||
<syntaxhighlight lang="ruby">def perf(n) |
|||
divisors = [] |
|||
for i in 1..Integer.sqrt(n) |
|||
divisors << i << n/i if n % i == 0 |
|||
end |
|||
divisors.uniq.inject(:+) == 2*n |
|||
end</syntaxhighlight> |
|||
Test: |
|||
<syntaxhighlight lang="ruby">for n in 1..10000 |
|||
puts n if perf(n) |
|||
end</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
===Fast (Lucas-Lehmer)=== |
|||
Generate and memoize perfect numbers as needed. |
|||
<syntaxhighlight lang="ruby">require "prime" |
|||
def mersenne_prime_pow?(p) |
|||
# Lucas-Lehmer test; expects prime as argument |
|||
return true if p == 2 |
|||
m_p = ( 1 << p ) - 1 |
|||
s = 4 |
|||
(p-2).times{ s = (s**2 - 2) % m_p } |
|||
s == 0 |
|||
end |
|||
@perfect_numerator = Prime.each.lazy.select{|p| mersenne_prime_pow?(p)}.map{|p| 2**(p-1)*(2**p-1)} |
|||
@perfects = @perfect_numerator.take(1).to_a |
|||
def perfect?(num) |
|||
@perfects << @perfect_numerator.next until @perfects.last >= num |
|||
@perfects.include? num |
|||
end |
|||
# demo |
|||
p (1..10000).select{|num| perfect?(num)} |
|||
t1 = Time.now |
|||
p perfect?(13164036458569648337239753460458722910223472318386943117783728128) |
|||
p Time.now - t1 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
[6, 28, 496, 8128] |
|||
true |
|||
0.001053954 |
|||
</pre> |
|||
As the task states, it is not known if there are any odd perfect numbers (any that exist are larger than 10**2000). This program tests 10**2001 in about 30 seconds - but only for even perfects. |
|||
=={{header|Run BASIC}}== |
|||
<syntaxhighlight lang="runbasic">for i = 1 to 10000 |
|||
if perf(i) then print i;" "; |
|||
next i |
|||
FUNCTION perf(n) |
|||
for i = 1 TO n - 1 |
|||
IF n MOD i = 0 THEN sum = sum + i |
|||
next i |
|||
IF sum = n THEN perf = 1 |
|||
END FUNCTION</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>6 28 496 8128</pre> |
|||
=={{header|Rust}}== |
|||
<syntaxhighlight lang="rust"> |
|||
fn main ( ) { |
|||
fn factor_sum(n: i32) -> i32 { |
|||
let mut v = Vec::new(); //create new empty array |
|||
for x in 1..n-1 { //test vaules 1 to n-1 |
|||
if n%x == 0 { //if current x is a factor of n |
|||
v.push(x); //add x to the array |
|||
} |
|||
} |
|||
let mut sum = v.iter().sum(); //iterate over array and sum it up |
|||
return sum; |
|||
} |
|||
fn perfect_nums(n: i32) { |
|||
for x in 2..n { //test numbers from 1-n |
|||
if factor_sum(x) == x {//call factor_sum on each value of x, if return value is = x |
|||
println!("{} is a perfect number.", x); //print value of x |
|||
} |
|||
} |
|||
} |
|||
perfect_nums(10000); |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|SASL}}== |
|||
Copied from the SASL manual, page 22: |
|||
<syntaxhighlight lang="sasl"> |
|||
|| The function which takes a number and returns a list of its factors (including one but excluding itself) |
|||
|| can be written |
|||
factors n = { a <- 1.. n/2; n rem a = 0 } |
|||
|| If we define a perfect number as one which is equal to the sum of its factors (for example 6 = 3 + 2 + 1 is perfect) |
|||
|| we can write the list of all perfect numbers as |
|||
perfects = { n <- 1... ; n = sum(factors n) } |
|||
</syntaxhighlight> |
|||
=={{header|S-BASIC}}== |
|||
<syntaxhighlight lang="basic"> |
|||
$lines |
|||
rem - return p mod q |
|||
function mod(p, q = integer) = integer |
|||
end = p - q * (p/q) |
|||
rem - return true if n is perfect, otherwise false |
|||
function isperfect(n = integer) = integer |
|||
var sum, f1, f2 = integer |
|||
sum = 1 |
|||
f1 = 2 |
|||
while (f1 * f1) <= n do |
|||
begin |
|||
if mod(n, f1) = 0 then |
|||
begin |
|||
sum = sum + f1 |
|||
f2 = n / f1 |
|||
if f2 > f1 then sum = sum + f2 |
|||
end |
end |
||
f1 = f1 + 1 |
|||
end |
end |
||
end = (sum = n) |
|||
end</lang> |
|||
rem - exercise the function |
|||
Functional style: |
|||
<lang ruby>def perf(n) |
|||
var k, found = integer |
|||
n == (1...n).select {|i| n % i == 0}.inject(0) {|sum, i| sum + i} |
|||
end</lang> |
|||
print "Searching up to"; search_limit; " for perfect numbers ..." |
|||
found = 0 |
|||
for k = 2 to search_limit |
|||
if isperfect(k) then |
|||
begin |
|||
print k |
|||
found = found + 1 |
|||
end |
|||
next k |
|||
print found; " were found" |
|||
end |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Searching up to 10000 for perfect numbers ... |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
4 were found |
|||
</pre> |
|||
=={{header|Scala}}== |
=={{header|Scala}}== |
||
< |
<syntaxhighlight lang="scala">def perfectInt(input: Int) = ((2 to sqrt(input).toInt).collect {case x if input % x == 0 => x + input / x}).sum == input - 1</syntaxhighlight> |
||
'''or''' |
|||
<syntaxhighlight lang="scala">def perfect(n: Int) = |
|||
(for (x <- 2 to n/2 if n % x == 0) yield x).sum + 1 == n |
|||
</syntaxhighlight> |
|||
=={{header|Scheme}}== |
=={{header|Scheme}}== |
||
< |
<syntaxhighlight lang="scheme">(define (perf n) |
||
(let loop ((i 1) |
(let loop ((i 1) |
||
(sum 0)) |
(sum 0)) |
||
Line 551: | Line 4,337: | ||
(loop (+ i 1) (+ sum i))) |
(loop (+ i 1) (+ sum i))) |
||
(else |
(else |
||
(loop (+ i 1) sum)))))</ |
(loop (+ i 1) sum)))))</syntaxhighlight> |
||
=={{header|Seed7}}== |
|||
<syntaxhighlight lang="seed7">$ include "seed7_05.s7i"; |
|||
const func boolean: isPerfect (in integer: n) is func |
|||
result |
|||
var boolean: isPerfect is FALSE; |
|||
local |
|||
var integer: i is 0; |
|||
var integer: sum is 1; |
|||
var integer: q is 0; |
|||
begin |
|||
for i range 2 to sqrt(n) do |
|||
if n rem i = 0 then |
|||
sum +:= i; |
|||
q := n div i; |
|||
if q > i then |
|||
sum +:= q; |
|||
end if; |
|||
end if; |
|||
end for; |
|||
isPerfect := sum = n; |
|||
end func; |
|||
const proc: main is func |
|||
local |
|||
var integer: n is 0; |
|||
begin |
|||
for n range 2 to 33550336 do |
|||
if isPerfect(n) then |
|||
writeln(n); |
|||
end if; |
|||
end for; |
|||
end func;</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
33550336 |
|||
</pre> |
|||
=={{header|Sidef}}== |
|||
<syntaxhighlight lang="ruby">func is_perfect(n) { |
|||
n.sigma == 2*n |
|||
} |
|||
for n in (1..10000) { |
|||
say n if is_perfect(n) |
|||
}</syntaxhighlight> |
|||
Alternatively, a more efficient check for even perfect numbers: |
|||
<syntaxhighlight lang="ruby">func is_even_perfect(n) { |
|||
var square = (8*n + 1) |
|||
square.is_square || return false |
|||
var t = ((square.isqrt + 1) / 2) |
|||
t.is_smooth(2) || return false |
|||
t-1 -> is_prime |
|||
} |
|||
for n in (1..10000) { |
|||
say n if is_even_perfect(n) |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=={{header|Simula}}== |
|||
<syntaxhighlight lang="simula">BOOLEAN PROCEDURE PERF(N); INTEGER N; |
|||
BEGIN |
|||
INTEGER SUM; |
|||
FOR I := 1 STEP 1 UNTIL N-1 DO |
|||
IF MOD(N, I) = 0 THEN |
|||
SUM := SUM + I; |
|||
PERF := SUM = N; |
|||
END PERF;</syntaxhighlight> |
|||
=={{header|Slate}}== |
=={{header|Slate}}== |
||
< |
<syntaxhighlight lang="slate">n@(Integer traits) isPerfect |
||
[ |
[ |
||
(((2 to: n // 2 + 1) select: [| :m | (n rem: m) isZero]) |
(((2 to: n // 2 + 1) select: [| :m | (n rem: m) isZero]) |
||
inject: 1 into: #+ `er) = n |
inject: 1 into: #+ `er) = n |
||
].</ |
].</syntaxhighlight> |
||
=={{header|Smalltalk}}== |
=={{header|Smalltalk}}== |
||
<syntaxhighlight lang="smalltalk">Integer extend [ |
|||
<lang smalltalk>Integer extend [ |
|||
"Translation of the C version; this is faster..." |
"Translation of the C version; this is faster..." |
||
Line 582: | Line 4,452: | ||
inject: 1 into: [ :a :b | a + b ] ) = self |
inject: 1 into: [ :a :b | a + b ] ) = self |
||
] |
] |
||
].</ |
].</syntaxhighlight> |
||
< |
<syntaxhighlight lang="smalltalk">1 to: 9000 do: [ :p | (p isPerfect) ifTrue: [ p printNl ] ]</syntaxhighlight> |
||
=={{header|SparForte}}== |
|||
As a structured script. |
|||
<syntaxhighlight lang="ada">#!/usr/local/bin/spar |
|||
pragma annotate( summary, "perfect" ); |
|||
pragma annotate( description, "In mathematics, a perfect number is a positive integer" ); |
|||
pragma annotate( description, "that is the sum of its proper positive divisors, that is," ); |
|||
pragma annotate( description, "the sum of the positive divisors excluding the number" ); |
|||
pragma annotate( description, "itself." ); |
|||
pragma annotate( see_also, "http://en.wikipedia.org/wiki/Perfect_number" ); |
|||
pragma annotate( author, "Ken O. Burtch" ); |
|||
pragma license( unrestricted ); |
|||
pragma restriction( no_external_commands ); |
|||
procedure perfect is |
|||
function is_perfect( n : positive ) return boolean is |
|||
total : natural := 0; |
|||
begin |
|||
for i in 1..n-1 loop |
|||
if n mod i = 0 then |
|||
total := @+i; |
|||
end if; |
|||
end loop; |
|||
return total = natural( n ); |
|||
end is_perfect; |
|||
number : positive; |
|||
result : boolean; |
|||
begin |
|||
number := 6; |
|||
result := is_perfect( number ); |
|||
put( number ) @ ( " : " ) @ ( result ); |
|||
new_line; |
|||
number := 18; |
|||
result := is_perfect( number ); |
|||
put( number ) @ ( " : " ) @ ( result ); |
|||
new_line; |
|||
number := 28; |
|||
result := is_perfect( number ); |
|||
put( number ) @ ( " : " ) @ ( result ); |
|||
new_line; |
|||
end perfect;</syntaxhighlight> |
|||
=={{header|Swift}}== |
|||
{{trans|Java}} |
|||
<syntaxhighlight lang="swift">func perfect(n:Int) -> Bool { |
|||
var sum = 0 |
|||
for i in 1..<n { |
|||
if n % i == 0 { |
|||
sum += i |
|||
} |
|||
} |
|||
return sum == n |
|||
} |
|||
for i in 1..<10000 { |
|||
if perfect(i) { |
|||
println(i) |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
</pre> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
< |
<syntaxhighlight lang="tcl">proc perfect n { |
||
set sum 0 |
set sum 0 |
||
for {set i 1} {$i <= $n} {incr i} { |
for {set i 1} {$i <= $n} {incr i} { |
||
Line 593: | Line 4,535: | ||
} |
} |
||
expr {$sum == 2*$n} |
expr {$sum == 2*$n} |
||
}</ |
}</syntaxhighlight> |
||
=={{header|Ursala}}== |
=={{header|Ursala}}== |
||
< |
<syntaxhighlight lang="ursala">#import std |
||
#import nat |
#import nat |
||
is_perfect = ~&itB&& ^(~&,~&t+ iota); ^E/~&l sum:-0+ ~| not remainder</ |
is_perfect = ~&itB&& ^(~&,~&t+ iota); ^E/~&l sum:-0+ ~| not remainder</syntaxhighlight> |
||
This test program applies the function to a list of the first five hundred natural |
This test program applies the function to a list of the first five hundred natural |
||
numbers and deletes the imperfect ones. |
numbers and deletes the imperfect ones. |
||
< |
<syntaxhighlight lang="ursala">#cast %nL |
||
examples = is_perfect*~ iota 500</ |
examples = is_perfect*~ iota 500</syntaxhighlight> |
||
{{Out}} |
|||
output: |
|||
<pre><6,28,496></pre> |
<pre><6,28,496></pre> |
||
=={{header|VBA}}== |
|||
{{trans|Phix}} |
|||
Using [[Factors_of_an_integer#VBA]], slightly adapted. |
|||
<syntaxhighlight lang="vb">Private Function Factors(x As Long) As String |
|||
Application.Volatile |
|||
Dim i As Long |
|||
Dim cooresponding_factors As String |
|||
Factors = 1 |
|||
corresponding_factors = x |
|||
For i = 2 To Sqr(x) |
|||
If x Mod i = 0 Then |
|||
Factors = Factors & ", " & i |
|||
If i <> x / i Then corresponding_factors = x / i & ", " & corresponding_factors |
|||
End If |
|||
Next i |
|||
If x <> 1 Then Factors = Factors & ", " & corresponding_factors |
|||
End Function |
|||
Private Function is_perfect(n As Long) |
|||
fs = Split(Factors(n), ", ") |
|||
Dim f() As Long |
|||
ReDim f(UBound(fs)) |
|||
For i = 0 To UBound(fs) |
|||
f(i) = Val(fs(i)) |
|||
Next i |
|||
is_perfect = WorksheetFunction.Sum(f) - n = n |
|||
End Function |
|||
Public Sub main() |
|||
Dim i As Long |
|||
For i = 2 To 100000 |
|||
If is_perfect(i) Then Debug.Print i |
|||
Next i |
|||
End Sub</syntaxhighlight>{{out}} |
|||
<pre> 6 |
|||
28 |
|||
496 |
|||
8128 </pre> |
|||
=={{header|VBScript}}== |
|||
<syntaxhighlight lang="vb">Function IsPerfect(n) |
|||
IsPerfect = False |
|||
i = n - 1 |
|||
sum = 0 |
|||
Do While i > 0 |
|||
If n Mod i = 0 Then |
|||
sum = sum + i |
|||
End If |
|||
i = i - 1 |
|||
Loop |
|||
If sum = n Then |
|||
IsPerfect = True |
|||
End If |
|||
End Function |
|||
WScript.StdOut.Write IsPerfect(CInt(WScript.Arguments(0))) |
|||
WScript.StdOut.WriteLine</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
C:\>cscript /nologo perfnum.vbs 6 |
|||
True |
|||
C:\>cscript /nologo perfnum.vbs 29 |
|||
False |
|||
C:\> |
|||
</pre> |
|||
=={{header|V (Vlang)}}== |
|||
{{trans|go}} |
|||
<syntaxhighlight lang="v (vlang)">fn compute_perfect(n i64) bool { |
|||
mut sum := i64(0) |
|||
for i := i64(1); i < n; i++ { |
|||
if n%i == 0 { |
|||
sum += i |
|||
} |
|||
} |
|||
return sum == n |
|||
} |
|||
// following fntion satisfies the task, returning true for all |
|||
// perfect numbers representable in the argument type |
|||
fn is_perfect(n i64) bool { |
|||
return n in [i64(6), 28, 496, 8128, 33550336, 8589869056, |
|||
137438691328, 2305843008139952128] |
|||
} |
|||
// validation |
|||
fn main() { |
|||
for n := i64(1); ; n++ { |
|||
if is_perfect(n) != compute_perfect(n) { |
|||
panic("bug") |
|||
} |
|||
if n%i64(1e3) == 0 { |
|||
println("tested $n") |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
tested 1000 |
|||
tested 2000 |
|||
tested 3000 |
|||
... |
|||
</pre> |
|||
=={{header|Wren}}== |
|||
===Version 1=== |
|||
{{trans|D}} |
|||
Restricted to the first four perfect numbers as the fifth one is very slow to emerge. |
|||
<syntaxhighlight lang="wren">var isPerfect = Fn.new { |n| |
|||
if (n <= 2) return false |
|||
var tot = 1 |
|||
for (i in 2..n.sqrt.floor) { |
|||
if (n%i == 0) { |
|||
tot = tot + i |
|||
var q = (n/i).floor |
|||
if (q > i) tot = tot + q |
|||
} |
|||
} |
|||
return n == tot |
|||
} |
|||
System.print("The first four perfect numbers are:") |
|||
var count = 0 |
|||
var i = 2 |
|||
while (count < 4) { |
|||
if (isPerfect.call(i)) { |
|||
System.write("%(i) ") |
|||
count = count + 1 |
|||
} |
|||
i = i + 2 // there are no known odd perfect numbers |
|||
} |
|||
System.print()</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 28 496 8128 |
|||
</pre> |
|||
===Version 2=== |
|||
{{libheader|Wren-math}} |
|||
This makes use of the fact that all known perfect numbers are of the form <big> (2<sup>''n''</sup> - 1) × 2<sup>''n'' - 1</sup></big> where <big> (2<sup>''n''</sup> - 1)</big> is prime and finds the first seven perfect numbers instantly. The numbers are too big after that to be represented accurately by Wren. |
|||
<syntaxhighlight lang="wren">import "./math" for Int |
|||
var isPerfect = Fn.new { |n| |
|||
if (n <= 2) return false |
|||
var tot = 1 |
|||
for (i in 2..n.sqrt.floor) { |
|||
if (n%i == 0) { |
|||
tot = tot + i |
|||
var q = (n/i).floor |
|||
if (q > i) tot = tot + q |
|||
} |
|||
} |
|||
return n == tot |
|||
} |
|||
System.print("The first seven perfect numbers are:") |
|||
var count = 0 |
|||
var p = 2 |
|||
while (count < 7) { |
|||
var n = 2.pow(p) - 1 |
|||
if (Int.isPrime(n)) { |
|||
n = n * 2.pow(p-1) |
|||
if (isPerfect.call(n)) { |
|||
System.write("%(n) ") |
|||
count = count + 1 |
|||
} |
|||
} |
|||
p = p + 1 |
|||
} |
|||
System.print()</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 28 496 8128 33550336 8589869056 137438691328 |
|||
</pre> |
|||
=={{header|XPL0}}== |
|||
<syntaxhighlight lang="xpl0">include c:\cxpl\codes; \intrinsic 'code' declarations |
|||
func Perfect(N); \Return 'true' if N is a perfect number |
|||
int N, S, I, Q; |
|||
[S:= 1; |
|||
for I:= 2 to sqrt(N) do |
|||
[Q:= N/I; |
|||
if rem(0)=0 then S:= S+I+Q; |
|||
]; |
|||
return S=N & N#1; |
|||
]; |
|||
int A, N; |
|||
[for A:= 1 to 16 do |
|||
[N:= (1<<A - 1) * 1<<(A-1); |
|||
if Perfect(N) then [IntOut(0, N); CrLf(0)]; |
|||
]; |
|||
]</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
6 |
|||
28 |
|||
496 |
|||
8128 |
|||
33550336 |
|||
</pre> |
|||
=={{header|Yabasic}}== |
|||
{{trans|True BASIC}} |
|||
<syntaxhighlight lang="basic"> |
|||
sub isPerfect(n) |
|||
if (n < 2) or mod(n, 2) = 1 then return false : endif |
|||
// asumimos que los números impares no son perfectos |
|||
sum = 0 |
|||
for i = 1 to n-1 |
|||
if mod(n,i) = 0 then sum = sum + i : endif |
|||
next i |
|||
if sum = n then return true else return false : endif |
|||
end sub |
|||
print "Los primeros 5 numeros perfectos son:" |
|||
for i = 1 to 33550336 |
|||
if isPerfect(i) then print i, " ", : endif |
|||
next i |
|||
print |
|||
end |
|||
</syntaxhighlight> |
|||
=={{header|Zig}}== |
|||
<syntaxhighlight lang="zig"> |
|||
const std = @import("std"); |
|||
const expect = std.testing.expect; |
|||
const stdout = std.io.getStdOut().outStream(); |
|||
pub fn main() !void { |
|||
var i: u32 = 2; |
|||
try stdout.print("The first few perfect numbers are: ", .{}); |
|||
while (i <= 10_000) : (i += 2) if (propersum(i) == i) |
|||
try stdout.print("{} ", .{i}); |
|||
try stdout.print("\n", .{}); |
|||
} |
|||
fn propersum(n: u32) u32 { |
|||
var sum: u32 = 1; |
|||
var d: u32 = 2; |
|||
while (d * d <= n) : (d += 1) if (n % d == 0) { |
|||
sum += d; |
|||
const q = n / d; |
|||
if (q > d) |
|||
sum += q; |
|||
}; |
|||
return sum; |
|||
} |
|||
test "Proper divisors" { |
|||
expect(propersum(28) == 28); |
|||
expect(propersum(71) == 1); |
|||
expect(propersum(30) == 42); |
|||
} |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
The first few perfect numbers are: 6 28 496 8128 |
|||
</pre> |
|||
=={{header|zkl}}== |
|||
{{trans|D}} |
|||
<syntaxhighlight lang="zkl">fcn isPerfectNumber1(n) |
|||
{ n == [1..n-1].filter('wrap(i){ n % i == 0 }).sum(); }</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
[1..0d10_000].filter(isPerfectNumber1).println(); |
|||
L(6,28,496,8128) |
|||
</pre> |
Revision as of 12:56, 25 January 2024
You are encouraged to solve this task according to the task description, using any language you may know.
Write a function which says whether a number is perfect.
A perfect number is a positive integer that is the sum of its proper positive divisors excluding the number itself.
Equivalently, a perfect number is a number that is half the sum of all of its positive divisors (including itself).
Note: The faster Lucas-Lehmer test is used to find primes of the form 2n-1, all known perfect numbers can be derived from these primes
using the formula (2n - 1) × 2n - 1.
It is not known if there are any odd perfect numbers (any that exist are larger than 102000).
The number of known perfect numbers is 51 (as of December, 2018), and the largest known perfect number contains 49,724,095 decimal digits.
- See also
-
- Rational Arithmetic
- Perfect numbers on OEIS
- Odd Perfect showing the current status of bounds on odd perfect numbers.
11l
F perf(n)
V sum = 0
L(i) 1 .< n
I n % i == 0
sum += i
R sum == n
L(i) 1..10000
I perf(i)
print(i, end' ‘ ’)
- Output:
6 28 496 8128
360 Assembly
Simple code
For maximum compatibility, this program uses only the basic instruction set (S/360) and two ASSIST macros (XDECO,XPRNT) to keep it as short as possible. The only added optimization is the loop up to n/2 instead of n-1. With 31 bit integers the limit is 2,147,483,647.
* Perfect numbers 15/05/2016
PERFECTN CSECT
USING PERFECTN,R13 prolog
SAVEAREA B STM-SAVEAREA(R15) "
DC 17F'0' "
STM STM R14,R12,12(R13) "
ST R13,4(R15) "
ST R15,8(R13) "
LR R13,R15 "
LA R6,2 i=2
LOOPI C R6,NN do i=2 to nn
BH ELOOPI
LR R1,R6 i
BAL R14,PERFECT
LTR R0,R0 if perfect(i)
BZ NOTPERF
XDECO R6,PG edit i
XPRNT PG,L'PG print i
NOTPERF LA R6,1(R6) i=i+1
B LOOPI
ELOOPI L R13,4(0,R13) epilog
LM R14,R12,12(R13) "
XR R15,R15 "
BR R14 exit
PERFECT SR R9,R9 function perfect(n); sum=0
LA R7,1 j
LR R8,R1 n
SRA R8,1 n/2
LOOPJ CR R7,R8 do j=1 to n/2
BH ELOOPJ
LR R4,R1 n
SRDA R4,32
DR R4,R7 n/j
LTR R4,R4 if mod(n,j)=0
BNZ NOTMOD
AR R9,R7 sum=sum+j
NOTMOD LA R7,1(R7) j=j+1
B LOOPJ
ELOOPJ SR R0,R0 r0=false
CR R9,R1 if sum=n
BNE NOTEQ
BCTR R0,0 r0=true
NOTEQ BR R14 return(r0); end perfect
NN DC F'10000'
PG DC CL12' ' buffer
YREGS
END PERFECTN
- Output:
6 28 496 8128
Some optimizations
Use of optimizations found in Rexx algorithms and use of packed decimal to have bigger numbers. With 15 digit decimal integers the limit is 999,999,999,999,999.
* Perfect numbers 15/05/2016
PERFECPO CSECT
USING PERFECPO,R13 prolog
SAVEAREA B STM-SAVEAREA(R15) "
DC 17F'0' "
STM STM R14,R12,12(R13) "
ST R13,4(R15) "
ST R15,8(R13) "
LR R13,R15 "
ZAP I,I1 i=i1
LOOPI CP I,I2 do i=i1 to i2
BH ELOOPI
LA R1,I r1=@i
BAL R14,PERFECT perfect(i)
LTR R0,R0 if perfect(i)
BZ NOTPERF
UNPK PG(16),I unpack i
OI PG+15,X'F0'
XPRNT PG,16 print i
NOTPERF AP I,=P'1' i=i+1
B LOOPI
ELOOPI L R13,4(0,R13) epilog
LM R14,R12,12(R13) "
XR R15,R15 "
BR R14 exit
PERFECT EQU * function perfect(n);
ZAP N,0(8,R1) n=%r1
CP N,=P'6' if n=6
BNE NOT6
L R0,=F'-1' r0=true
B RETURN return(true)
NOT6 ZAP PW,N n
SP PW,=P'1' n-1
ZAP PW2,PW n-1
DP PW2,=PL8'9' (n-1)/9
ZAP R,PW2+8(8) if mod((n-1),9)<>0
BZ ZERO
SR R0,R0 r0=false
B RETURN return(false)
ZERO ZAP PW2,N n
DP PW2,=PL8'2' n/2
ZAP SUM,PW2(8) sum=n/2
AP SUM,=P'3' sum=n/2+3
ZAP J,=P'3' j=3
LOOPJ ZAP PW,J do loop on j
MP PW,J j*j
CP PW,N while j*j<=n
BH ELOOPJ
ZAP PW2,N n
DP PW2,J n/j
CP PW2+8(8),=P'0' if mod(n,j)<>0
BNE NEXTJ
AP SUM,J sum=sum+j
ZAP PW2,N n
DP PW2,J n/j
AP SUM,PW2(8) sum=sum+j+n/j
NEXTJ AP J,=P'1' j=j+1
B LOOPJ next j
ELOOPJ SR R0,R0 r0=false
CP SUM,N if sum=n
BNE RETURN
BCTR R0,0 r0=true
RETURN BR R14 return(r0); end perfect
I1 DC PL8'1'
I2 DC PL8'200000000000'
I DS PL8
PG DC CL16' ' buffer
N DS PL8
SUM DS PL8
J DS PL8
R DS PL8
C DS CL16
PW DS PL8
PW2 DS PL16
YREGS
END PERFECPO
- Output:
0000000000000006 0000000000000028 0000000000000496 0000000000008128 0000000033550337 0000008589869056 0000137438691328
AArch64 Assembly
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program perfectNumber64.s */
/* use Euclide Formula : if M=(2puis p)-1 is prime M * (M+1)/2 is perfect see Wikipedia */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeConstantesARM64.inc"
.equ MAXI, 63
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessResult: .asciz "Perfect : @ \n"
szMessOverflow: .asciz "Overflow in function isPrime.\n"
szCarriageReturn: .asciz "\n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
mov x4,2 // start 2
mov x3,1 // counter 2 power
1: // begin loop
lsl x4,x4,1 // 2 power
sub x0,x4,1 // - 1
bl isPrime // is prime ?
cbz x0,2f // no
sub x0,x4,1 // yes
mul x1,x0,x4 // multiply m by m-1
lsr x0,x1,1 // divide by 2
bl displayPerfect // and display
2:
add x3,x3,1 // next power of 2
cmp x3,MAXI
blt 1b
100: // standard end of the program
mov x0,0 // return code
mov x8,EXIT // request to exit program
svc 0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrsMessResult: .quad sMessResult
/******************************************************************/
/* Display perfect number */
/******************************************************************/
/* x0 contains the number */
displayPerfect:
stp x1,lr,[sp,-16]! // save registers
ldr x1,qAdrsZoneConv
bl conversion10 // call décimal conversion
ldr x0,qAdrsMessResult
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
bl affichageMess // display message
100:
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
qAdrsZoneConv: .quad sZoneConv
/***************************************************/
/* is a number prime ? */
/***************************************************/
/* x0 contains the number */
/* x0 return 1 if prime else 0 */
//2147483647 OK
//4294967297 NOK
//131071 OK
//1000003 OK
//10001363 OK
isPrime:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
mov x2,x0
sub x1,x0,#1
cmp x2,0
beq 99f // return zero
cmp x2,2 // for 1 and 2 return 1
ble 2f
mov x0,#2
bl moduloPuR64
bcs 100f // error overflow
cmp x0,#1
bne 99f // no prime
cmp x2,3
beq 2f
mov x0,#3
bl moduloPuR64
blt 100f // error overflow
cmp x0,#1
bne 99f
cmp x2,5
beq 2f
mov x0,#5
bl moduloPuR64
bcs 100f // error overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,7
beq 2f
mov x0,#7
bl moduloPuR64
bcs 100f // error overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,11
beq 2f
mov x0,#11
bl moduloPuR64
bcs 100f // error overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,13
beq 2f
mov x0,#13
bl moduloPuR64
bcs 100f // error overflow
cmp x0,#1
bne 99f // Pas premier
2:
cmn x0,0 // carry à zero no error
mov x0,1 // prime
b 100f
99:
cmn x0,0 // carry à zero no error
mov x0,#0 // prime
100:
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
/**************************************************************/
/********************************************************/
/* Compute modulo de b power e modulo m */
/* Exemple 4 puissance 13 modulo 497 = 445 */
/********************************************************/
/* x0 number */
/* x1 exposant */
/* x2 modulo */
moduloPuR64:
stp x1,lr,[sp,-16]! // save registres
stp x3,x4,[sp,-16]! // save registres
stp x5,x6,[sp,-16]! // save registres
stp x7,x8,[sp,-16]! // save registres
stp x9,x10,[sp,-16]! // save registres
cbz x0,100f
cbz x1,100f
mov x8,x0
mov x7,x1
mov x6,1 // result
udiv x4,x8,x2
msub x9,x4,x2,x8 // remainder
1:
tst x7,1 // if bit = 1
beq 2f
mul x4,x9,x6
umulh x5,x9,x6
mov x6,x4
mov x0,x6
mov x1,x5
bl divisionReg128U // division 128 bits
cbnz x1,99f // overflow
mov x6,x3 // remainder
2:
mul x8,x9,x9
umulh x5,x9,x9
mov x0,x8
mov x1,x5
bl divisionReg128U
cbnz x1,99f // overflow
mov x9,x3
lsr x7,x7,1
cbnz x7,1b
mov x0,x6 // result
cmn x0,0 // carry à zero no error
b 100f
99:
ldr x0,qAdrszMessOverflow
bl affichageMess // display error message
cmp x0,0 // carry set error
mov x0,-1 // code erreur
100:
ldp x9,x10,[sp],16 // restaur des 2 registres
ldp x7,x8,[sp],16 // restaur des 2 registres
ldp x5,x6,[sp],16 // restaur des 2 registres
ldp x3,x4,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
qAdrszMessOverflow: .quad szMessOverflow
/***************************************************/
/* division d un nombre de 128 bits par un nombre de 64 bits */
/***************************************************/
/* x0 contient partie basse dividende */
/* x1 contient partie haute dividente */
/* x2 contient le diviseur */
/* x0 retourne partie basse quotient */
/* x1 retourne partie haute quotient */
/* x3 retourne le reste */
divisionReg128U:
stp x6,lr,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
mov x5,#0 // raz du reste R
mov x3,#128 // compteur de boucle
mov x4,#0 // dernier bit
1:
lsl x5,x5,#1 // on decale le reste de 1
tst x1,1<<63 // test du bit le plus à gauche
lsl x1,x1,#1 // on decale la partie haute du quotient de 1
beq 2f
orr x5,x5,#1 // et on le pousse dans le reste R
2:
tst x0,1<<63
lsl x0,x0,#1 // puis on decale la partie basse
beq 3f
orr x1,x1,#1 // et on pousse le bit de gauche dans la partie haute
3:
orr x0,x0,x4 // position du dernier bit du quotient
mov x4,#0 // raz du bit
cmp x5,x2
blt 4f
sub x5,x5,x2 // on enleve le diviseur du reste
mov x4,#1 // dernier bit à 1
4:
// et boucle
subs x3,x3,#1
bgt 1b
lsl x1,x1,#1 // on decale le quotient de 1
tst x0,1<<63
lsl x0,x0,#1 // puis on decale la partie basse
beq 5f
orr x1,x1,#1
5:
orr x0,x0,x4 // position du dernier bit du quotient
mov x3,x5
100:
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x6,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
Perfect : 6 Perfect : 28 Perfect : 496 Perfect : 8128 Perfect : 33550336 Perfect : 8589869056 Perfect : 137438691328 Perfect : 2305843008139952128 Perfect : 8070450532247928832
Action!
PROC Main()
DEFINE MAXNUM="10000"
CARD ARRAY pds(MAXNUM+1)
CARD i,j
FOR i=2 TO MAXNUM
DO
pds(i)=1
OD
FOR i=2 TO MAXNUM
DO
FOR j=i+i TO MAXNUM STEP i
DO
pds(j)==+i
OD
OD
FOR i=2 TO MAXNUM
DO
IF pds(i)=i THEN
PrintCE(i)
FI
OD
RETURN
- Output:
Screenshot from Atari 8-bit computer
6 28 496 8128
Ada
function Is_Perfect(N : Positive) return Boolean is
Sum : Natural := 0;
begin
for I in 1..N - 1 loop
if N mod I = 0 then
Sum := Sum + I;
end if;
end loop;
return Sum = N;
end Is_Perfect;
ALGOL 60
begin
comment - return p mod q;
integer procedure mod(p, q);
value p, q; integer p, q;
begin
mod := p - q * entier(p / q);
end;
comment - return true if n is perfect, otherwise false;
boolean procedure isperfect(n);
value n; integer n;
begin
integer sum, f1, f2;
sum := 1;
f1 := 1;
for f1 := f1 + 1 while (f1 * f1) <= n do
begin
if mod(n, f1) = 0 then
begin
sum := sum + f1;
f2 := n / f1;
if f2 > f1 then sum := sum + f2;
end;
end;
isperfect := (sum = n);
end;
comment - exercise the procedure;
integer i, found;
outstring(1,"Searching up to 10000 for perfect numbers\n");
found := 0;
for i := 2 step 1 until 10000 do
if isperfect(i) then
begin
outinteger(1,i);
found := found + 1;
end;
outstring(1,"\n");
outinteger(1,found);
outstring(1,"perfect numbers were found");
end
- Output:
Searching up to 10000 for perfect numbers 6 28 496 8128 4 perfect numbers were found
ALGOL 68
PROC is perfect = (INT candidate)BOOL: (
INT sum :=1;
FOR f1 FROM 2 TO ENTIER ( sqrt(candidate)*(1+2*small real) ) WHILE
IF candidate MOD f1 = 0 THEN
sum +:= f1;
INT f2 = candidate OVER f1;
IF f2 > f1 THEN
sum +:= f2
FI
FI;
# WHILE # sum <= candidate DO
SKIP
OD;
sum=candidate
);
test:(
FOR i FROM 2 TO 33550336 DO
IF is perfect(i) THEN print((i, new line)) FI
OD
)
- Output:
+6 +28 +496 +8128 +33550336
ALGOL W
Based on the Algol 68 version.
begin
% returns true if n is perfect, false otherwise %
% n must be > 0 %
logical procedure isPerfect ( integer value candidate ) ;
begin
integer sum;
sum := 1;
for f1 := 2 until round( sqrt( candidate ) ) do begin
if candidate rem f1 = 0 then begin
integer f2;
sum := sum + f1;
f2 := candidate div f1;
% avoid e.g. counting 2 twice as a factor of 4 %
if f2 > f1 then sum := sum + f2
end if_candidate_rem_f1_eq_0 ;
end for_f1 ;
sum = candidate
end isPerfect ;
% test isPerfect %
for n := 2 until 10000 do if isPerfect( n ) then write( n );
end.
- Output:
6 28 496 8128
AppleScript
Functional
-- PERFECT NUMBERS -----------------------------------------------------------
-- perfect :: integer -> bool
on perfect(n)
-- isFactor :: integer -> bool
script isFactor
on |λ|(x)
n mod x = 0
end |λ|
end script
-- quotient :: number -> number
script quotient
on |λ|(x)
n / x
end |λ|
end script
-- sum :: number -> number -> number
script sum
on |λ|(a, b)
a + b
end |λ|
end script
-- Integer factors of n below the square root
set lows to filter(isFactor, enumFromTo(1, (n ^ (1 / 2)) as integer))
-- low and high factors (quotients of low factors) tested for perfection
(n > 1) and (foldl(sum, 0, (lows & map(quotient, lows))) / 2 = n)
end perfect
-- TEST ----------------------------------------------------------------------
on run
filter(perfect, enumFromTo(1, 10000))
--> {6, 28, 496, 8128}
end run
-- GENERIC FUNCTIONS ---------------------------------------------------------
-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if m > n then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end enumFromTo
-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
tell mReturn(f)
set lst to {}
set lng to length of xs
repeat with i from 1 to lng
set v to item i of xs
if |λ|(v, i, xs) then set end of lst to v
end repeat
return lst
end tell
end filter
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
- Output:
{6, 28, 496, 8128}
Idiomatic
Sum of proper divisors
on aliquotSum(n)
if (n < 2) then return 0
set sum to 1
set sqrt to n ^ 0.5
set limit to sqrt div 1
if (limit = sqrt) then
set sum to sum + limit
set limit to limit - 1
end if
repeat with i from 2 to limit
if (n mod i is 0) then set sum to sum + i + n div i
end repeat
return sum
end aliquotSum
on isPerfect(n)
if (n > 1.37438691328E+11) then return missing value -- Too high for perfection to be determinable.
-- All the known perfect numbers listed in Wikipedia end with either 6 or 28.
-- These endings are either preceded by odd digits or are the numbers themselves.
tell (n mod 10) to ¬
return ((((it = 6) and ((n mod 20 = 16) or (n = 6))) or ¬
((it = 8) and ((n mod 200 = 128) or (n = 28)))) and ¬
(my aliquotSum(n) = n))
end isPerfect
local output, n
set output to {}
repeat with n from 1 to 10000
if (isPerfect(n)) then set end of output to n
end repeat
return output
- Output:
{6, 28, 496, 8128}
Euclid
on isPerfect(n)
-- All the known perfect numbers listed in Wikipedia end with either 6 or 28.
-- These endings are either preceded by odd digits or are the numbers themselves.
tell (n mod 10) to ¬
if not (((it = 6) and ((n mod 20 = 16) or (n = 6))) or ((it = 8) and ((n mod 200 = 128) or (n = 28)))) then ¬
return false
-- Work through the only seven primes p where (2 ^ p - 1) is also prime
-- and (2 ^ p - 1) * (2 ^ (p - 1)) is a number that AppleScript can handle.
repeat with p in {2, 3, 5, 7, 13, 17, 19}
tell (2 ^ p - 1) * (2 ^ (p - 1))
if (it < n) then
else
return (it = n)
end if
end tell
end repeat
return missing value
end isPerfect
local output, n
set output to {}
repeat with n from 2 to 33551000 by 2
if (isPerfect(n)) then set end of output to n
end repeat
return output
- Output:
{6, 28, 496, 8128, 33550336}
Practical
But since AppleScript can only physically manage seven of the known perfect numbers, they may as well be in a look-up list for maximum efficiency:
on isPerfect(n)
if (n > 1.37438691328E+11) then return missing value -- Too high for perfection to be determinable.
return (n is in {6, 28, 496, 8128, 33550336, 8.589869056E+9, 1.37438691328E+11})
end isPerfect
ARM Assembly
/* ARM assembly Raspberry PI */
/* program perfectNumber.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
.equ MAXI, 1<<31
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessResultPerf: .asciz "Perfect : @ \n"
szCarriageReturn: .asciz "\n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
mov r2,#2 @ begin first number
1: @ begin loop
mov r5,#1 @ sum
mov r4,#2 @ first divisor 1
2:
udiv r0,r2,r4 @ compute divisor 2
mls r3,r0,r4,r2 @ remainder
cmp r3,#0
bne 3f @ remainder = 0 ?
add r5,r5,r0 @ add divisor 2
add r5,r5,r4 @ add divisor 1
3:
add r4,r4,#1 @ increment divisor
cmp r4,r0 @ divisor 1 < divisor 2
blt 2b @ yes -> loop
cmp r2,r5 @ compare number and divisors sum
bne 4f @ not equal
mov r0,r2 @ equal -> display
ldr r1,iAdrsZoneConv
bl conversion10 @ call décimal conversion
ldr r0,iAdrsMessResultPerf
ldr r1,iAdrsZoneConv @ insert conversion in message
bl strInsertAtCharInc
bl affichageMess @ display message
4:
add r2,#2 @ no perfect number odd < 10 puis 1500
cmp r2,#MAXI @ end ?
blo 1b @ no -> loop
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsMessResultPerf: .int sMessResultPerf
iAdrsZoneConv: .int sZoneConv
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"
Perfect : 6 Perfect : 28 Perfect : 496 Perfect : 8128 Perfect : 33550336
Arturo
divisors: $[n][ select 1..(n/2)+1 'i -> 0 = n % i ]
perfect?: $[n][ n = sum divisors n ]
loop 2..1000 'i [
if perfect? i -> print i
]
AutoHotkey
This will find the first 8 perfect numbers.
Loop, 30 {
If isMersennePrime(A_Index + 1)
res .= "Perfect number: " perfectNum(A_Index + 1) "`n"
}
MsgBox % res
perfectNum(N) {
Return 2**(N - 1) * (2**N - 1)
}
isMersennePrime(N) {
If (isPrime(N)) && (isPrime(2**N - 1))
Return true
}
isPrime(N) {
Loop, % Floor(Sqrt(N))
If (A_Index > 1 && !Mod(N, A_Index))
Return false
Return true
}
AWK
$ awk 'func perf(n){s=0;for(i=1;i<n;i++)if(n%i==0)s+=i;return(s==n)}
BEGIN{for(i=1;i<10000;i++)if(perf(i))print i}'
6
28
496
8128
Axiom
Using the interpreter, define the function:
perfect?(n:Integer):Boolean == reduce(+,divisors n) = 2*n
Alternatively, using the Spad compiler:
)abbrev package TESTP TestPackage
TestPackage() : withma
perfect?: Integer -> Boolean
==
add
import IntegerNumberTheoryFunctions
perfect? n == reduce("+",divisors n) = 2*n
Examples (testing 496, testing 128, finding all perfect numbers in 1...10000):
perfect? 496
perfect? 128
[i for i in 1..10000 | perfect? i]
- Output:
true
false
[6,28,496,8128]
BASIC
FUNCTION perf(n)
sum = 0
for i = 1 to n - 1
IF n MOD i = 0 THEN
sum = sum + i
END IF
NEXT i
IF sum = n THEN
perf = 1
ELSE
perf = 0
END IF
END FUNCTION
BASIC256
function isPerfect(n)
if (n < 2) or (n mod 2 = 1) then return False
#asumimos que los números impares no son perfectos
sum = 1
for i = 2 to sqr(n)
if n mod i = 0 then
sum += i
q = n \ i
if q > i then sum += q
end if
next
return n = sum
end function
print "Los primeros 5 números perfectos son:"
for i = 2 to 233550336
if isPerfect(i) then print i; " ";
next i
end
Craft Basic
for n = 1 to 10000
let s = 0
for i = 1 to n / 2
if n % i = 0 then
let s = s + i
endif
next i
if s = n then
print n, " ",
endif
wait
next n
- Output:
6 28 496 8128
IS-BASIC
100 PROGRAM "PerfectN.bas"
110 FOR X=1 TO 10000
120 IF PERFECT(X) THEN PRINT X;
130 NEXT
140 DEF PERFECT(N)
150 IF N<2 OR MOD(N,2)<>0 THEN LET PERFECT=0:EXIT DEF
160 LET S=1
170 FOR I=2 TO SQR(N)
180 IF MOD(N,I)=0 THEN LET S=S+I+N/I
190 NEXT
200 LET PERFECT=N=S
210 END DEF
Sinclair ZX81 BASIC
Call this subroutine and it will (eventually) return PERFECT = 1 if N is perfect or PERFECT = 0 if it is not.
2000 LET SUM=0
2010 FOR F=1 TO N-1
2020 IF N/F=INT (N/F) THEN LET SUM=SUM+F
2030 NEXT F
2040 LET PERFECT=SUM=N
2050 RETURN
True BASIC
FUNCTION perf(n)
IF n < 2 or ramainder(n,2) = 1 then LET perf = 0
LET sum = 0
FOR i = 1 to n-1
IF remainder(n,i) = 0 then LET sum = sum+i
NEXT i
IF sum = n then
LET perf = 1
ELSE
LET perf = 0
END IF
END FUNCTION
PRINT "Los primeros 5 números perfectos son:"
FOR i = 1 to 33550336
IF perf(i) = 1 then PRINT i; " ";
NEXT i
PRINT
PRINT "Presione cualquier tecla para salir"
END
BBC BASIC
BASIC version
FOR n% = 2 TO 10000 STEP 2
IF FNperfect(n%) PRINT n%
NEXT
END
DEF FNperfect(N%)
LOCAL I%, S%
S% = 1
FOR I% = 2 TO SQR(N%)-1
IF N% MOD I% = 0 S% += I% + N% DIV I%
NEXT
IF I% = SQR(N%) S% += I%
= (N% = S%)
- Output:
6 28 496 8128
Assembler version
DIM P% 100
[OPT 2 :.S% xor edi,edi
.perloop mov eax,ebx : cdq : div ecx : or edx,edx : loopnz perloop : inc ecx
add edi,ecx : add edi,eax : loop perloop : mov eax,edi : shr eax,1 : ret : ]
FOR B% = 2 TO 35000000 STEP 2
C% = SQRB%
IF B% = USRS% PRINT B%
NEXT
END
- Output:
4 6 28 496 8128 33550336
Bracmat
( ( perf
= sum i
. 0:?sum
& 0:?i
& whl
' ( !i+1:<!arg:?i
& ( mod$(!arg.!i):0&!sum+!i:?sum
|
)
)
& !sum:!arg
)
& 0:?n
& whl
' ( !n+1:~>10000:?n
& (perf$!n&out$!n|)
)
);
- Output:
6 28 496 8128
Burlesque
Jfc++\/2.*==
blsq) 8200ro{Jfc++\/2.*==}f[
{6 28 496 8128}
C
#include "stdio.h"
#include "math.h"
int perfect(int n) {
int max = (int)sqrt((double)n) + 1;
int tot = 1;
int i;
for (i = 2; i < max; i++)
if ( (n % i) == 0 ) {
tot += i;
int q = n / i;
if (q > i)
tot += q;
}
return tot == n;
}
int main() {
int n;
for (n = 2; n < 33550337; n++)
if (perfect(n))
printf("%d\n", n);
return 0;
}
Using functions from Factors of an integer#Prime factoring:
int main()
{
int j;
ulong fac[10000], n, sum;
sieve();
for (n = 2; n < 33550337; n++) {
j = get_factors(n, fac) - 1;
for (sum = 0; j && sum <= n; sum += fac[--j]);
if (sum == n) printf("%lu\n", n);
}
return 0;
}
C#
static void Main(string[] args)
{
Console.WriteLine("Perfect numbers from 1 to 33550337:");
for (int x = 0; x < 33550337; x++)
{
if (IsPerfect(x))
Console.WriteLine(x + " is perfect.");
}
Console.ReadLine();
}
static bool IsPerfect(int num)
{
int sum = 0;
for (int i = 1; i < num; i++)
{
if (num % i == 0)
sum += i;
}
return sum == num ;
}
Version using Lambdas, will only work from version 3 of C# on
static void Main(string[] args)
{
Console.WriteLine("Perfect numbers from 1 to 33550337:");
for (int x = 0; x < 33550337; x++)
{
if (IsPerfect(x))
Console.WriteLine(x + " is perfect.");
}
Console.ReadLine();
}
static bool IsPerfect(int num)
{
return Enumerable.Range(1, num - 1).Sum(n => num % n == 0 ? n : 0 ) == num;
}
C++
#include <iostream>
using namespace std ;
int divisor_sum( int number ) {
int sum = 0 ;
for ( int i = 1 ; i < number ; i++ )
if ( number % i == 0 )
sum += i ;
return sum;
}
int main( ) {
cout << "Perfect numbers from 1 to 33550337:\n" ;
for ( int num = 1 ; num < 33550337 ; num++ ) {
if (divisor_sum(num) == num)
cout << num << '\n' ;
}
return 0 ;
}
Clojure
(defn proper-divisors [n]
(if (< n 4)
[1]
(->> (range 2 (inc (quot n 2)))
(filter #(zero? (rem n %)))
(cons 1))))
(defn perfect? [n]
(= (reduce + (proper-divisors n)) n))
(defn perfect? [n]
(->> (for [i (range 1 n)] :when (zero? (rem n i))] i)
(reduce +)
(= n)))
Functional version
(defn perfect? [n]
(= (reduce + (filter #(zero? (rem n %)) (range 1 n))) n))
COBOL
main.cbl:
$set REPOSITORY "UPDATE ON"
IDENTIFICATION DIVISION.
PROGRAM-ID. perfect-main.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
REPOSITORY.
FUNCTION perfect
.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 i PIC 9(8).
PROCEDURE DIVISION.
PERFORM VARYING i FROM 2 BY 1 UNTIL 33550337 = i
IF FUNCTION perfect(i) = 0
DISPLAY i
END-IF
END-PERFORM
GOBACK
.
END PROGRAM perfect-main.
perfect.cbl:
IDENTIFICATION DIVISION.
FUNCTION-ID. perfect.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 max-val PIC 9(8).
01 total PIC 9(8) VALUE 1.
01 i PIC 9(8).
01 q PIC 9(8).
LINKAGE SECTION.
01 n PIC 9(8).
01 is-perfect PIC 9.
PROCEDURE DIVISION USING VALUE n RETURNING is-perfect.
COMPUTE max-val = FUNCTION INTEGER(FUNCTION SQRT(n)) + 1
PERFORM VARYING i FROM 2 BY 1 UNTIL i = max-val
IF FUNCTION MOD(n, i) = 0
ADD i TO total
DIVIDE n BY i GIVING q
IF q > i
ADD q TO total
END-IF
END-IF
END-PERFORM
IF total = n
MOVE 0 TO is-perfect
ELSE
MOVE 1 TO is-perfect
END-IF
GOBACK
.
END FUNCTION perfect.
CoffeeScript
Optimized version, for fun.
is_perfect_number = (n) ->
do_factors_add_up_to n, 2*n
do_factors_add_up_to = (n, desired_sum) ->
# We mildly optimize here, by taking advantage of
# the fact that the sum_of_factors( (p^m) * x)
# is (1 + ... + p^m-1 + p^m) * sum_factors(x) when
# x is not itself a multiple of p.
p = smallest_prime_factor(n)
if p == n
return desired_sum == p + 1
# ok, now sum up all powers of p that
# divide n
sum_powers = 1
curr_power = 1
while n % p == 0
curr_power *= p
sum_powers += curr_power
n /= p
# if desired_sum does not divide sum_powers, we
# can short circuit quickly
return false unless desired_sum % sum_powers == 0
# otherwise, recurse
do_factors_add_up_to n, desired_sum / sum_powers
smallest_prime_factor = (n) ->
for i in [2..n]
return n if i*i > n
return i if n % i == 0
# tests
do ->
# This is pretty fast...
for n in [2..100000]
console.log n if is_perfect_number n
# For big numbers, let's just sanity check the known ones.
known_perfects = [
33550336
8589869056
137438691328
]
for n in known_perfects
throw Error("fail") unless is_perfect_number(n)
throw Error("fail") if is_perfect_number(n+1)
- Output:
> coffee perfect_numbers.coffee 6 28 496 8128
Common Lisp
(defun perfectp (n)
(= n (loop for i from 1 below n when (= 0 (mod n i)) sum i)))
D
Functional Version
import std.stdio, std.algorithm, std.range;
bool isPerfectNumber1(in uint n) pure nothrow
in {
assert(n > 0);
} body {
return n == iota(1, n - 1).filter!(i => n % i == 0).sum;
}
void main() {
iota(1, 10_000).filter!isPerfectNumber1.writeln;
}
- Output:
[6, 28, 496, 8128]
Faster Imperative Version
import std.stdio, std.math, std.range, std.algorithm;
bool isPerfectNumber2(in int n) pure nothrow {
if (n < 2)
return false;
int total = 1;
foreach (immutable i; 2 .. cast(int)real(n).sqrt + 1)
if (n % i == 0) {
immutable int q = n / i;
total += i;
if (q > i)
total += q;
}
return total == n;
}
void main() {
10_000.iota.filter!isPerfectNumber2.writeln;
}
- Output:
[6, 28, 496, 8128]
With a 33_550_337.iota
it outputs:
[6, 28, 496, 8128, 33550336]
Dart
Explicit Iterative Version
/*
* Function to test if a number is a perfect number
* A number is a perfect number if it is equal to the sum of all its divisors
* Input: Positive integer n
* Output: true if n is a perfect number, false otherwise
*/
bool isPerfect(int n){
//Generate a list of integers in the range 1 to n-1 : [1, 2, ..., n-1]
List<int> range = new List<int>.generate(n-1, (int i) => i+1);
//Create a list that filters the divisors of n from range
List<int> divisors = new List.from(range.where((i) => n%i == 0));
//Sum the all the divisors
int sumOfDivisors = 0;
for (int i = 0; i < divisors.length; i++){
sumOfDivisors = sumOfDivisors + divisors[i];
}
// A number is a perfect number if it is equal to the sum of its divisors
// We return the test if n is equal to sumOfDivisors
return n == sumOfDivisors;
}
Compact Version
isPerfect(n) =>
n == new List.generate(n-1, (i) => n%(i+1) == 0 ? i+1 : 0).fold(0, (p,n)=>p+n);
In either case, if we test to find all the perfect numbers up to 1000, we get:
main() =>
new List.generate(1000,(i)=>i+1).where(isPerfect).forEach(print);
- Output:
6 28 496
Delphi
See #Pascal.
Dyalect
func isPerfect(num) {
var sum = 0
for i in 1..<num {
if !i {
break
}
if num % i == 0 {
sum += i
}
}
return sum == num
}
let max = 33550337
print("Perfect numbers from 0 to \(max):")
for x in 0..max {
if isPerfect(x) {
print("\(x) is perfect")
}
}
E
pragma.enable("accumulator")
def isPerfectNumber(x :int) {
var sum := 0
for d ? (x % d <=> 0) in 1..!x {
sum += d
if (sum > x) { return false }
}
return sum <=> x
}
EasyLang
func perf n .
for i = 1 to n - 1
if n mod i = 0
sum += i
.
.
return if sum = n
.
for i = 2 to 10000
if perf i = 1
print i
.
.
Eiffel
class
APPLICATION
create
make
feature
make
do
io.put_string (" 6 is perfect...%T")
io.put_boolean (is_perfect_number (6))
io.new_line
io.put_string (" 77 is perfect...%T")
io.put_boolean (is_perfect_number (77))
io.new_line
io.put_string ("128 is perfect...%T")
io.put_boolean (is_perfect_number (128))
io.new_line
io.put_string ("496 is perfect...%T")
io.put_boolean (is_perfect_number (496))
end
is_perfect_number (n: INTEGER): BOOLEAN
-- Is 'n' a perfect number?
require
n_positive: n > 0
local
sum: INTEGER
do
across
1 |..| (n - 1) as c
loop
if n \\ c.item = 0 then
sum := sum + c.item
end
end
Result := sum = n
end
end
- Output:
6 is perfect... True 77 is perfect... False 128 is perfect... False 496 is perfect... True
Elena
ELENA 6.x:
import system'routines;
import system'math;
import extensions;
extension extension
{
isPerfect()
= new Range(1, self - 1).selectBy::(n => (self.mod(n) == 0).iif(n,0) ).summarize(new Integer()) == self;
}
public program()
{
for(int n := 1; n < 10000; n += 1)
{
if(n.isPerfect())
{ console.printLine(n," is perfect") }
};
console.readChar()
}
- Output:
6 is perfect 28 is perfect 496 is perfect 8128 is perfect
Elixir
defmodule RC do
def is_perfect(1), do: false
def is_perfect(n) when n > 1 do
Enum.sum(factor(n, 2, [1])) == n
end
defp factor(n, i, factors) when n < i*i , do: factors
defp factor(n, i, factors) when n == i*i , do: [i | factors]
defp factor(n, i, factors) when rem(n,i)==0, do: factor(n, i+1, [i, div(n,i) | factors])
defp factor(n, i, factors) , do: factor(n, i+1, factors)
end
IO.inspect (for i <- 1..10000, RC.is_perfect(i), do: i)
- Output:
[6, 28, 496, 8128]
Erlang
is_perfect(X) ->
X == lists:sum([N || N <- lists:seq(1,X-1), X rem N == 0]).
ERRE
PROGRAM PERFECT
PROCEDURE PERFECT(N%->OK%)
LOCAL I%,S%
S%=1
FOR I%=2 TO SQR(N%)-1 DO
IF N% MOD I%=0 THEN S%+=I%+N% DIV I%
END FOR
IF I%=SQR(N%) THEN S%+=I%
OK%=(N%=S%)
END PROCEDURE
BEGIN
PRINT(CHR$(12);) ! CLS
FOR N%=2 TO 10000 STEP 2 DO
PERFECT(N%->OK%)
IF OK% THEN PRINT(N%)
END FOR
END PROGRAM
- Output:
6 28 496 8128
F#
let perf n = n = List.fold (+) 0 (List.filter (fun i -> n % i = 0) [1..(n-1)])
for i in 1..10000 do if (perf i) then printfn "%i is perfect" i
- Output:
6 is perfect 28 is perfect 496 is perfect 8128 is perfect
Factor
USING: kernel math math.primes.factors sequences ;
IN: rosettacode.perfect-numbers
: perfect? ( n -- ? ) [ divisors sum ] [ 2 * ] bi = ;
FALSE
[0\1[\$@$@-][\$@$@$@$@\/*=[@\$@+@@]?1+]#%=]p:
45p;!." "28p;!. { 0 -1 }
Forth
: perfect? ( n -- ? )
1
over 2/ 1+ 2 ?do
over i mod 0= if i + then
loop
= ;
Fortran
FUNCTION isPerfect(n)
LOGICAL :: isPerfect
INTEGER, INTENT(IN) :: n
INTEGER :: i, factorsum
isPerfect = .FALSE.
factorsum = 1
DO i = 2, INT(SQRT(REAL(n)))
IF(MOD(n, i) == 0) factorsum = factorsum + i + (n / i)
END DO
IF (factorsum == n) isPerfect = .TRUE.
END FUNCTION isPerfect
FreeBASIC
' FB 1.05.0 Win64
Function isPerfect(n As Integer) As Boolean
If n < 2 Then Return False
If n Mod 2 = 1 Then Return False '' we can assume odd numbers are not perfect
Dim As Integer sum = 1, q
For i As Integer = 2 To Sqr(n)
If n Mod i = 0 Then
sum += i
q = n \ i
If q > i Then sum += q
End If
Next
Return n = sum
End Function
Print "The first 5 perfect numbers are : "
For i As Integer = 2 To 33550336
If isPerfect(i) Then Print i; " ";
Next
Print
Print "Press any key to quit"
Sleep
- Output:
The first 5 perfect numbers are : 6 28 496 8128 33550336
Frink
isPerfect = {|n| sum[allFactors[n, true, false]] == n}
println[select[1 to 1000, isPerfect]]
- Output:
[1, 6, 28, 496]
FunL
def perfect( n ) = sum( d | d <- 1..n if d|n ) == 2n
println( (1..500).filter(perfect) )
- Output:
(6, 28, 496)
FutureBasic
_maxNum = 10000
local fn IsPerfectNumber( n as long ) as BOOL
—————————————————————————————————————————————
if ( n < 2 ) then exit fn = NO
if ( n mod 2 == 1 ) then exit fn = NO
long sum = 1, q, i
for i = 2 to sqr(n)
if ( n mod i == 0 )
sum += i
q = n / i
if ( q > i ) then sum += q
end if
next
end fn = ( n == sum )
printf @"Perfect numbers in range %ld..%ld",2,_maxNum
long i
for i = 2 To _maxNum
if ( fn IsPerfectNumber(i) ) then print i
next
HandleEvents
- Output:
Perfect numbers in range 2..10000 6 28 496 8128
GAP
Filtered([1 .. 10000], n -> Sum(DivisorsInt(n)) = 2*n);
# [ 6, 28, 496, 8128 ]
Go
package main
import "fmt"
func computePerfect(n int64) bool {
var sum int64
for i := int64(1); i < n; i++ {
if n%i == 0 {
sum += i
}
}
return sum == n
}
// following function satisfies the task, returning true for all
// perfect numbers representable in the argument type
func isPerfect(n int64) bool {
switch n {
case 6, 28, 496, 8128, 33550336, 8589869056,
137438691328, 2305843008139952128:
return true
}
return false
}
// validation
func main() {
for n := int64(1); ; n++ {
if isPerfect(n) != computePerfect(n) {
panic("bug")
}
if n%1e3 == 0 {
fmt.Println("tested", n)
}
}
}
- Output:
tested 1000 tested 2000 tested 3000 ...
Groovy
Solution:
def isPerfect = { n ->
n > 4 && (n == (2..Math.sqrt(n)).findAll { n % it == 0 }.inject(1) { factorSum, i -> factorSum += i + n/i })
}
Test program:
(0..10000).findAll { isPerfect(it) }.each { println it }
- Output:
6 28 496 8128
Haskell
perfect n =
n == sum [i | i <- [1..n-1], n `mod` i == 0]
Create a list of known perfects:
perfect =
(\x -> (2 ^ x - 1) * (2 ^ (x - 1))) <$>
filter (\x -> isPrime x && isPrime (2 ^ x - 1)) maybe_prime
where
maybe_prime = scanl1 (+) (2 : 1 : cycle [2, 2, 4, 2, 4, 2, 4, 6])
isPrime n = all ((/= 0) . (n `mod`)) $ takeWhile (\x -> x * x <= n) maybe_prime
isPerfect n = f n perfect
where
f n (p:ps) =
case compare n p of
EQ -> True
LT -> False
GT -> f n ps
main :: IO ()
main = do
mapM_ print $ take 10 perfect
mapM_ (print . (\x -> (x, isPerfect x))) [6, 27, 28, 29, 496, 8128, 8129]
or, restricting the search space to improve performance:
isPerfect :: Int -> Bool
isPerfect n =
let lows = filter ((0 ==) . rem n) [1 .. floor (sqrt (fromIntegral n))]
in 1 < n &&
n ==
quot
(sum
(lows ++
[ y
| x <- lows
, let y = quot n x
, x /= y ]))
2
main :: IO ()
main = print $ filter isPerfect [1 .. 10000]
- Output:
[6,28,496,8128]
HicEst
DO i = 1, 1E4
IF( perfect(i) ) WRITE() i
ENDDO
END ! end of "main"
FUNCTION perfect(n)
sum = 1
DO i = 2, n^0.5
sum = sum + (MOD(n, i) == 0) * (i + INT(n/i))
ENDDO
perfect = sum == n
END
Icon and Unicon
- Output:
Perfect numbers from 1 to 100000: 6 28 496 8128 Done.
J
is_perfect=: +: = >:@#.~/.~&.q:@(6>.<.)
Examples of use, including extensions beyond those assumptions:
is_perfect 33550336
1
I. is_perfect i. 100000
6 28 496 8128
] zero_through_twentynine =. i. 3 10
0 1 2 3 4 5 6 7 8 9
10 11 12 13 14 15 16 17 18 19
20 21 22 23 24 25 26 27 28 29
is_perfect zero_through_twentynine
0 0 0 0 0 0 1 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 1 0
is_perfect 191561942608236107294793378084303638130997321548169216x
1
More efficient version based on comments by Henry Rich and Roger Hui (comment train seeded by Jon Hough).
Java
public static boolean perf(int n){
int sum= 0;
for(int i= 1;i < n;i++){
if(n % i == 0){
sum+= i;
}
}
return sum == n;
}
Or for arbitrary precision:
import java.math.BigInteger;
public static boolean perf(BigInteger n){
BigInteger sum= BigInteger.ZERO;
for(BigInteger i= BigInteger.ONE;
i.compareTo(n) < 0;i=i.add(BigInteger.ONE)){
if(n.mod(i).equals(BigInteger.ZERO)){
sum= sum.add(i);
}
}
return sum.equals(n);
}
JavaScript
Imperative
function is_perfect(n)
{
var sum = 1, i, sqrt=Math.floor(Math.sqrt(n));
for (i = sqrt-1; i>1; i--)
{
if (n % i == 0) {
sum += i + n/i;
}
}
if(n % sqrt == 0)
sum += sqrt + (sqrt*sqrt == n ? 0 : n/sqrt);
return sum === n;
}
var i;
for (i = 1; i < 10000; i++)
{
if (is_perfect(i))
print(i);
}
- Output:
6 28 496 8128
Functional
ES5
Naive version (brute force)
(function (nFrom, nTo) {
function perfect(n) {
return n === range(1, n - 1).reduce(
function (a, x) {
return n % x ? a : a + x;
}, 0
);
}
function range(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
return range(nFrom, nTo).filter(perfect);
})(1, 10000);
Output:
[6, 28, 496, 8128]
Much faster (more efficient factorisation)
(function (nFrom, nTo) {
function perfect(n) {
var lows = range(1, Math.floor(Math.sqrt(n))).filter(function (x) {
return (n % x) === 0;
});
return n > 1 && lows.concat(lows.map(function (x) {
return n / x;
})).reduce(function (a, x) {
return a + x;
}, 0) / 2 === n;
}
function range(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
return range(nFrom, nTo).filter(perfect)
})(1, 10000);
Output:
[6, 28, 496, 8128]
Note that the filter function, though convenient and well optimised, is not strictly necessary. We can always replace it with a more general monadic bind (chain) function, which is essentially just concat map (Monadic return/inject for lists is simply lambda x --> [x], inlined here, and fail is [].)
(function (nFrom, nTo) {
// MONADIC CHAIN (bind) IN LIEU OF FILTER
// ( monadic return for lists is just lambda x -> [x] )
return chain(
rng(nFrom, nTo),
function mPerfect(n) {
return (chain(
rng(1, Math.floor(Math.sqrt(n))),
function (y) {
return (n % y) === 0 && n > 1 ? [y, n / y] : [];
}
).reduce(function (a, x) {
return a + x;
}, 0) / 2 === n) ? [n] : [];
}
);
/******************************************************************/
// Monadic bind (chain) for lists
function chain(xs, f) {
return [].concat.apply([], xs.map(f));
}
function rng(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
})(1, 10000);
Output:
[6, 28, 496, 8128]
ES6
(() => {
const main = () =>
enumFromTo(1, 10000).filter(perfect);
// perfect :: Int -> Bool
const perfect = n => {
const
lows = enumFromTo(1, Math.floor(Math.sqrt(n)))
.filter(x => (n % x) === 0);
return n > 1 && lows.concat(lows.map(x => n / x))
.reduce((a, x) => (a + x), 0) / 2 === n;
};
// GENERIC --------------------------------------------
// enumFromTo :: Int -> Int -> [Int]
const enumFromTo = (m, n) =>
Array.from({
length: n - m + 1
}, (_, i) => i + m)
// MAIN ---
return main();
})();
- Output:
[6, 28, 496, 8128]
jq
def is_perfect:
. as $in
| $in == reduce range(1;$in) as $i
(0; if ($in % $i) == 0 then $i + . else . end);
# Example:
range(1;10001) | select( is_perfect )
- Output:
$ jq -n -f is_perfect.jq 6 28 496 8128
Julia
isperfect(n::Integer) = n == sum([n % i == 0 ? i : 0 for i = 1:(n - 1)])
perfects(n::Integer) = filter(isperfect, 1:n)
@show perfects(10000)
- Output:
perfects(10000) = [6, 28, 496, 8128]
K
perfect:{(x>2)&x=+/-1_{d:&~x!'!1+_sqrt x;d,_ x%|d}x}
perfect 33550336
1
a@&perfect'a:!10000
6 28 496 8128
m:3 10#!30
(0 1 2 3 4 5 6 7 8 9
10 11 12 13 14 15 16 17 18 19
20 21 22 23 24 25 26 27 28 29)
perfect'/: m
(0 0 0 0 0 0 1 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 1 0)
Kotlin
// version 1.0.6
fun isPerfect(n: Int): Boolean = when {
n < 2 -> false
n % 2 == 1 -> false // there are no known odd perfect numbers
else -> {
var tot = 1
var q: Int
for (i in 2 .. Math.sqrt(n.toDouble()).toInt()) {
if (n % i == 0) {
tot += i
q = n / i
if (q > i) tot += q
}
}
n == tot
}
}
fun main(args: Array<String>) {
// expect a run time of about 6 minutes on a typical laptop
println("The first five perfect numbers are:")
for (i in 2 .. 33550336) if (isPerfect(i)) print("$i ")
}
- Output:
The first five perfect numbers are: 6 28 496 8128 33550336
LabVIEW
This image is a VI Snippet, an executable image of LabVIEW code. The LabVIEW version is shown on the top-right hand corner. You can download it, then drag-and-drop it onto the LabVIEW block diagram from a file browser, and it will appear as runnable, editable code.
Lambdatalk
simple & slow
{def perf
{def perf.sum
{lambda {:n :sum :i}
{if {>= :i :n}
then {= :sum :n}
else {perf.sum :n
{if {= {% :n :i} 0}
then {+ :sum :i}
else :sum}
{+ :i 1}} }}}
{lambda {:n}
{perf.sum :n 0 2} }}
-> perf
{S.replace \s by space in
{S.map {lambda {:i} {if {perf :i} then :i else}}
{S.serie 2 1000 2}}}
-> 6 28 496 // 5200ms
Too slow (and stackoverflow) to go further.
improved
{def lt_perfect
{def lt_perfect.sum
{lambda {:n :sum :i}
{if {> :i 1}
then {lt_perfect.sum :n
{if {= {% :n :i} 0}
then {+ :sum :i {floor {/ :n :i}}}
else :sum}
{- :i 1}}
else :sum }}}
{lambda {:n}
{let { {:n :n}
{:sqrt {floor {sqrt :n}}}
{:sum {lt_perfect.sum :n 1 {- {floor {sqrt :n}} 0} }}
{:foo {if {= {* :sqrt :sqrt} :n}
then 0
else {floor {/ :n :sqrt}}}}
} {= :n {if {= {% :n :sqrt} 0}
then {+ :sum :sqrt :foo}
else :sum}} }}}
-> lt_perfect
-> {S.replace \s by space in
{S.map {lambda {:i} {if {lt_perfect :i} then :i else}}
{S.serie 6 10000 2}}}
-> 28 496 8128 // 7500ms
calling javascript
Following the javascript entry.
{S.replace \s by space in
{S.map {lambda {:i} {if {js_perfect :i} then :i else}}
{S.serie 2 10000}}}
-> 6 28 496 8128 // 80ms
{script
LAMBDATALK.DICT["js_perfect"] = function() {
function js_perfect(n) {
var sum = 1, i, sqrt=Math.floor(Math.sqrt(n));
for (i = sqrt-1; i>1; i--) {
if (n % i == 0)
sum += i + n/i;
}
if(n % sqrt == 0)
sum += sqrt + (sqrt*sqrt == n ? 0 : n/sqrt);
return sum === n;
}
var args = arguments[0].trim();
return (js_perfect( Number(args) )) ? "true" : "false"
};
}
Lasso
#!/usr/bin/lasso9
define isPerfect(n::integer) => {
#n < 2 ? return false
return #n == (
with i in generateSeries(1, math_floor(math_sqrt(#n)) + 1)
where #n % #i == 0
let q = #n / #i
sum (#q > #i ? (#i == 1 ? 1 | #q + #i) | 0)
)
}
with x in generateSeries(1, 10000)
where isPerfect(#x)
select #x
- Output:
6, 28, 496, 8128
Liberty BASIC
for n =1 to 10000
if perfect( n) =1 then print n; " is perfect."
next n
end
function perfect( n)
sum =0
for i =1 TO n /2
if n mod i =0 then
sum =sum +i
end if
next i
if sum =n then
perfect= 1
else
perfect =0
end if
end function
Lingo
on isPercect (n)
sum = 1
cnt = n/2
repeat with i = 2 to cnt
if n mod i = 0 then sum = sum + i
end repeat
return sum=n
end
Logo
to perfect? :n
output equal? :n apply "sum filter [equal? 0 modulo :n ?] iseq 1 :n/2
end
Lua
function isPerfect(x)
local sum = 0
for i = 1, x-1 do
sum = (x % i) == 0 and sum + i or sum
end
return sum == x
end
M2000 Interpreter
Module PerfectNumbers {
Function Is_Perfect(n as decimal) {
s=1 : sN=Sqrt(n)
last= n=sN*sN
t=n
If n mod 2=0 then s+=2+n div 2
i=3 : sN--
While i<sN {
if n mod i=0 then t=n div i :i=max.data(n div t, i): s+=t+ i
i++
}
=n=s
}
Inventory Known1=2@, 3@
IsPrime=lambda Known1 (x as decimal) -> {
=0=1
if exist(Known1, x) then =1=1 : exit
if x<=5 OR frac(x) then {if x == 2 OR x == 3 OR x == 5 then Append Known1, x : =1=1
Break}
if frac(x/2) else exit
if frac(x/3) else exit
x1=sqrt(x):d = 5@
{if frac(x/d ) else exit
d += 2: if d>x1 then Append Known1, x : =1=1 : exit
if frac(x/d) else exit
d += 4: if d<= x1 else Append Known1, x : =1=1: exit
loop}
}
\\ Check a perfect and a non perfect number
p=2 : n=3 : n1=2
Document Doc$
IsPerfect( 0, 28)
IsPerfect( 0, 1544)
While p<32 { ' max 32
if isprime(2^p-1@) then {
perf=(2^p-1@)*2@^(p-1@)
Rem Print perf
\\ decompose pretty fast the Perferct Numbers
\\ all have a series of 2 and last a prime equal to perf/2^(p-1)
inventory queue factors
For i=1 to p-1 {
Append factors, 2@
}
Append factors, perf/2^(p-1)
\\ end decompose
Rem Print factors
IsPerfect(factors, Perf)
}
p++
}
Clipboard Doc$
\\ exit here. No need for Exit statement
Sub IsPerfect(factors, n)
s=false
if n<10000 or type$(factors)<>"Inventory" then {
s=Is_Perfect(n)
} else {
local mm=each(factors, 1, -2), f =true
while mm {if eval(mm)<>2 then f=false
}
if f then if n/2@**(len(mm)-1)= factors(len(factors)-1!) then s=true
}
Local a$=format$("{0} is {1}perfect number", n, If$(s->"", "not "))
Doc$=a$+{
}
Print a$
End Sub
}
PerfectNumbers
- Output:
28 is perfect number 1544 is not perfect number 6 is perfect number 28 is perfect number 496 is perfect number 8128 is perfect number 33550336 is perfect number 8589869056 is perfect number 137438691328 is perfect number 2305843008139952128 is perfect number
M4
define(`for',
`ifelse($#,0,``$0'',
`ifelse(eval($2<=$3),1,
`pushdef(`$1',$2)$4`'popdef(`$1')$0(`$1',incr($2),$3,`$4')')')')dnl
define(`ispart',
`ifelse(eval($2*$2<=$1),1,
`ifelse(eval($1%$2==0),1,
`ifelse(eval($2*$2==$1),1,
`ispart($1,incr($2),eval($3+$2))',
`ispart($1,incr($2),eval($3+$2+$1/$2))')',
`ispart($1,incr($2),$3)')',
$3)')
define(`isperfect',
`eval(ispart($1,2,1)==$1)')
for(`x',`2',`33550336',
`ifelse(isperfect(x),1,`x
')')
MAD
NORMAL MODE IS INTEGER
R FUNCTION THAT CHECKS IF NUMBER IS PERFECT
INTERNAL FUNCTION(N)
ENTRY TO PERFCT.
DSUM = 0
THROUGH SUMMAT, FOR CAND=1, 1, CAND.GE.N
SUMMAT WHENEVER N/CAND*CAND.E.N, DSUM = DSUM+CAND
FUNCTION RETURN DSUM.E.N
END OF FUNCTION
R PRINT PERFECT NUMBERS UP TO 10,000
THROUGH SHOW, FOR I=1, 1, I.G.10000
SHOW WHENEVER PERFCT.(I), PRINT FORMAT FMT,I
VECTOR VALUES FMT = $I5*$
PRINT COMMENT $ $
END OF PROGRAM
- Output:
6 28 496 8128
Maple
isperfect := proc(n) return evalb(NumberTheory:-SumOfDivisors(n) = 2*n); end proc:
isperfect(6);
true
Mathematica / Wolfram Language
Custom function:
PerfectQ[i_Integer] := Total[Divisors[i]] == 2 i
Examples (testing 496, testing 128, finding all perfect numbers in 1...10000):
PerfectQ[496]
PerfectQ[128]
Flatten[PerfectQ/@Range[10000]//Position[#,True]&]
gives back:
True
False
{6,28,496,8128}
MATLAB
Standard algorithm:
function perf = isPerfect(n)
total = 0;
for k = 1:n-1
if ~mod(n, k)
total = total+k;
end
end
perf = total == n;
end
Faster algorithm:
function perf = isPerfect(n)
if n < 2
perf = false;
else
total = 1;
k = 2;
quot = n;
while k < quot && total <= n
if ~mod(n, k)
total = total+k;
quot = n/k;
if quot ~= k
total = total+quot;
end
end
k = k+1;
end
perf = total == n;
end
end
Maxima
".."(a, b) := makelist(i, i, a, b)$
infix("..")$
perfectp(n) := is(divsum(n) = 2*n)$
sublist(1 .. 10000, perfectp);
/* [6, 28, 496, 8128] */
MAXScript
fn isPerfect n =
(
local sum = 0
for i in 1 to (n-1) do
(
if mod n i == 0 then
(
sum += i
)
)
sum == n
)
Microsoft Small Basic
For n = 2 To 10000 Step 2
VerifyIfPerfect()
If isPerfect = 1 Then
TextWindow.WriteLine(n)
EndIf
EndFor
Sub VerifyIfPerfect
s = 1
sqrN = Math.SquareRoot(n)
If Math.Remainder(n, 2) = 0 Then
s = s + 2 + Math.Floor(n / 2)
EndIf
i = 3
while i <= sqrN - 1
If Math.Remainder(n, i) = 0 Then
s = s + i + Math.Floor(n / i)
EndIf
i = i + 1
EndWhile
If i * i = n Then
s = s + i
EndIf
If n = s Then
isPerfect = 1
Else
isPerfect = 0
EndIf
EndSub
Modula-2
MODULE PerfectNumbers;
FROM SWholeIO IMPORT
WriteCard;
FROM STextIO IMPORT
WriteLn;
FROM RealMath IMPORT
sqrt;
VAR
N: CARDINAL;
PROCEDURE IsPerfect(N: CARDINAL): BOOLEAN;
VAR
S, I: CARDINAL;
SqrtN: REAL;
BEGIN
S := 1;
SqrtN := sqrt(FLOAT(N));
IF N REM 2 = 0 THEN
S := S + 2 + N / 2;
END;
I := 3;
WHILE FLOAT(I) <= SqrtN - 1.0 DO
IF N REM I = 0 THEN
S := S + I + N / I;
END;
I := I + 1;
END;
IF I * I = N THEN
S := S + I;
END;
RETURN (N = S);
END IsPerfect;
BEGIN
FOR N := 2 TO 10000 BY 2 DO
IF IsPerfect(N) THEN
WriteCard(N, 5);
WriteLn;
END;
END;
END PerfectNumbers.
Nanoquery
def perf(n)
sum = 0
for i in range(1, n - 1)
if (n % i) = 0
sum += i
end
end
return sum = n
end
Nim
import math
proc isPerfect(n: int): bool =
var sum: int = 1
for d in 2 .. int(n.toFloat.sqrt):
if n mod d == 0:
inc sum, d
let q = n div d
if q != d: inc sum, q
result = n == sum
for n in 2..10_000:
if n.isPerfect:
echo n
- Output:
6 28 496 8128
Objeck
bundle Default {
class Test {
function : Main(args : String[]) ~ Nil {
"Perfect numbers from 1 to 33550337:"->PrintLine();
for(num := 1 ; num < 33550337; num += 1;) {
if(IsPerfect(num)) {
num->PrintLine();
};
};
}
function : native : IsPerfect(number : Int) ~ Bool {
sum := 0 ;
for(i := 1; i < number; i += 1;) {
if (number % i = 0) {
sum += i;
};
};
return sum = number;
}
}
}
OCaml
let perf n =
let sum = ref 0 in
for i = 1 to n-1 do
if n mod i = 0 then
sum := !sum + i
done;
!sum = n
Functional style:
(* range operator *)
let rec (--) a b =
if a > b then
[]
else
a :: (a+1) -- b
let perf n = n = List.fold_left (+) 0 (List.filter (fun i -> n mod i = 0) (1 -- (n-1)))
Oforth
: isPerfect(n) | i | 0 n 2 / loop: i [ n i mod ifZero: [ i + ] ] n == ;
- Output:
#isPerfect 10000 seq filter . [6, 28, 496, 8128]
Odin
package perfect_numbers
import "core:fmt"
main :: proc() {
fmt.println("\nPerfect numbers from 1 to 100,000:\n")
for num in 1 ..< 100001 {
if divisor_sum(num) == num {
fmt.print("num:", num, "\n")
}
if num % 10000 == 0 {
fmt.print("Count:", num, "\n")
}
}
}
divisor_sum :: proc(number: int) -> int {
sum := 0
for i in 1 ..< number {
if number % i == 0 {
sum += i}
}
return sum
}
- Output:
Perfect numbers from 1 to 100,000: num: 6 num: 28 num: 496 num: 8128
ooRexx
-- first perfect number over 10000 is 33550336...let's not be crazy
loop i = 1 to 10000
if perfectNumber(i) then say i "is a perfect number"
end
::routine perfectNumber
use strict arg n
sum = 0
-- the largest possible factor is n % 2, so no point in
-- going higher than that
loop i = 1 to n % 2
if n // i == 0 then sum += i
end
return sum = n
- Output:
6 is a perfect number 28 is a perfect number 496 is a perfect number 8128 is a perfect number
Oz
declare
fun {IsPerfect N}
fun {IsNFactor I} N mod I == 0 end
Factors = {Filter {List.number 1 N-1 1} IsNFactor}
in
{Sum Factors} == N
end
fun {Sum Xs} {FoldL Xs Number.'+' 0} end
in
{Show {Filter {List.number 1 10000 1} IsPerfect}}
{Show {IsPerfect 33550336}}
PARI/GP
Using built-in methods
isPerfect(n)=sigma(n,-1)==2
or
isPerfect(n)=sigma(n)==2*n
Show perfect numbers
forprime(p=2, 2281,
if(isprime(2^p-1),
print(p"\t",(2^p-1)*2^(p-1))))
faster alternative showing them still using built-in methods
[n|n<-[1..10^4],sigma(n,-1)==2]
- Output:
[6, 28, 496, 8128]
Faster with Lucas-Lehmer test
p=2;n=3;n1=2;
while(p<2281,
if(isprime(p),
s=Mod(4,n);
for(i=3,p,
s=s*s-2);
if(s==0 || p==2,
print("(2^"p"-1)2^("p"-1)=\t"n1*n"\n")));
p++; n1=n+1; n=2*n+1)
- Output:
(2^2-1)2^(2-1)= 6 (2^3-1)2^(3-1)= 28 (2^5-1)2^(5-1)= 496 (2^7-1)2^(7-1)= 8128 (2^13-1)2^(13-1)= 33550336 (2^17-1)2^(17-1)= 8589869056 (2^19-1)2^(19-1)= 137438691328 (2^31-1)2^(31-1)= 2305843008139952128 (2^61-1)2^(61-1)= 2658455991569831744654692615953842176 (2^89-1)2^(89-1)= 191561942608236107294793378084303638130997321548169216
Pascal
program PerfectNumbers;
function isPerfect(number: longint): boolean;
var
i, sum: longint;
begin
sum := 1;
for i := 2 to round(sqrt(real(number))) do
if (number mod i = 0) then
sum := sum + i + (number div i);
isPerfect := (sum = number);
end;
var
candidate: longint;
begin
writeln('Perfect numbers from 1 to 33550337:');
for candidate := 2 to 33550337 do
if isPerfect(candidate) then
writeln (candidate, ' is a perfect number.');
end.
- Output:
Perfect numbers from 1 to 33550337: 6 is a perfect number. 28 is a perfect number. 496 is a perfect number. 8128 is a perfect number. 33550336 is a perfect number.
Perl
Functions
sub perf {
my $n = shift;
my $sum = 0;
foreach my $i (1..$n-1) {
if ($n % $i == 0) {
$sum += $i;
}
}
return $sum == $n;
}
Functional style:
use List::Util qw(sum);
sub perf {
my $n = shift;
$n == sum(0, grep {$n % $_ == 0} 1..$n-1);
}
Modules
The functions above are terribly slow. As usual, this is easier and faster with modules. Both ntheory and Math::Pari have useful functions for this.
A simple predicate:
use ntheory qw/divisor_sum/;
sub is_perfect { my $n = shift; divisor_sum($n) == 2*$n; }
Use this naive method to show the first 5. Takes about 15 seconds:
use ntheory qw/divisor_sum/;
for (1..33550336) {
print "$_\n" if divisor_sum($_) == 2*$_;
}
Or we can be clever and look for 2^(p-1) * (2^p-1) where 2^p -1 is prime. The first 20 takes about a second.
use ntheory qw/forprimes is_prime/;
use bigint;
forprimes {
my $n = 2**$_ - 1;
print "$_\t", $n * 2**($_-1),"\n" if is_prime($n);
} 2, 4500;
- Output:
2 6 3 28 5 496 7 8128 13 33550336 17 8589869056 19 137438691328 31 2305843008139952128 61 2658455991569831744654692615953842176 89 191561942608236107294793378084303638130997321548169216 ... 107, 127, 521, 607, 1279, 2203, 2281, 3217, 4253, 4423 ...
We can speed this up even more using a faster program for printing the large results, as well as a faster primality solution. The first 38 in about 1 second with most of the time printing the large results. Caveat: this goes well past the current bound for odd perfect numbers and does not check for them.
use ntheory qw/forprimes is_mersenne_prime/;
use Math::GMP qw/:constant/;
forprimes {
print "$_\t", (2**$_-1)*2**($_-1),"\n" if is_mersenne_prime($_);
} 7_000_000;
In addition to generating even perfect numbers, we can also have a fast function which returns true when a given even number is perfect:
use ntheory qw(is_mersenne_prime valuation);
sub is_even_perfect {
my ($n) = @_;
my $v = valuation($n, 2) || return;
my $m = ($n >> $v);
($m & ($m + 1)) && return;
($m >> $v) == 1 || return;
is_mersenne_prime($v + 1);
}
Phix
naive/native
function is_perfect(integer n)
return sum(factors(n,-1))=n
end function
for i=2 to 100000 do
if is_perfect(i) then ?i end if
end for
- Output:
6 28 496 8128
gmp version
with javascript_semantics
-- demo\rosetta\Perfect_numbers.exw (includes native and cheat versions)
include mpfr.e
atom t0 = time(), t1 = t0+1
integer maxprime = 4423, -- 19937 (rather slow)
lim = length(get_primes_le(maxprime))
mpz n = mpz_init(), m = mpz_init()
for i=1 to lim do
integer p = get_prime(i)
mpz_ui_pow_ui(n, 2, p)
mpz_sub_ui(n, n, 1)
if mpz_prime(n) then
mpz_ui_pow_ui(m, 2, p-1)
mpz_mul(n, n, m)
string ns = mpz_get_short_str(n,comma_fill:=true),
et = elapsed_short(time()-t0,5,"(%s)")
printf(1, "%d %s %s\n",{p,ns,et})
elsif time()>t1 then
progress("%d/%d (%.1f%%)\r",{p,maxprime,i/lim*100})
t1 = time()+1
end if
end for
?elapsed(time()-t0)
- Output:
2 6 3 28 5 496 7 8,128 13 33,550,336 17 8,589,869,056 19 137,438,691,328 31 2,305,843,008,139,952,128 61 2,658,455,991,569,831,744,654,692,615,953,842,176 89 191,561,942,608,236,...,997,321,548,169,216 (54 digits) 107 13,164,036,458,569,6...,943,117,783,728,128 (65 digits) 127 14,474,011,154,664,5...,349,131,199,152,128 (77 digits) 521 23,562,723,457,267,3...,492,160,555,646,976 (314 digits) 607 141,053,783,706,712,...,570,759,537,328,128 (366 digits) 1279 54,162,526,284,365,8...,345,764,984,291,328 (770 digits) 2203 1,089,258,355,057,82...,580,834,453,782,528 (1,327 digits) 2281 99,497,054,337,086,4...,375,675,139,915,776 (1,373 digits) 3217 33,570,832,131,986,7...,888,332,628,525,056 (1,937 digits) (9s) 4253 18,201,749,040,140,4...,848,437,133,377,536 (2,561 digits) (24s) 4423 40,767,271,711,094,4...,020,642,912,534,528 (2,663 digits) (28s) "28.4s"
Beyond that it gets rather slow:
9689 11,434,731,753,038,6...,982,558,429,577,216 (5,834 digits) (6:28) 9941 598,885,496,387,336,...,478,324,073,496,576 (5,985 digits) (7:31) 11213 3,959,613,212,817,94...,255,702,691,086,336 (6,751 digits) (11:32) 19937 931,144,559,095,633,...,434,790,271,942,656 (12,003 digits) (1:22:32)
cheating
include mpfr.e
atom t0 = time()
mpz n = mpz_init(), m = mpz_init()
sequence validp = {2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607,
1279, 2203, 2281, 3217, 4253, 4423, 9689, 9941, 11213,
19937, 21701, 23209, 44497, 86243, 110503, 132049, 216091,
756839, 859433, 1257787, 1398269, 2976221, 3021377, 6972593,
13466917, 20996011, 24036583, 25964951, 30402457, 32582657,
37156667, 42643801, 43112609, 57885161,
74207281, 77232917, 82589933}
if platform()=JS then validp = validp[1..35] end if -- (keep it under 5s)
for p in validp do
mpz_ui_pow_ui(n, 2, p)
mpz_sub_ui(n, n, 1)
mpz_ui_pow_ui(m, 2, p-1)
mpz_mul(n, n, m)
string ns = mpz_get_short_str(n,comma_fill:=true),
et = elapsed_short(time()-t0,5,"(%s)")
printf(1, "%d %s %s\n",{p,ns,et})
end for
?elapsed(time()-t0)
2 6 3 28 5 496 7 8,128 13 33,550,336 17 8,589,869,056 19 137,438,691,328 31 2,305,843,008,139,952,128 61 2,658,455,991,569,831,744,654,692,615,953,842,176 89 191,561,942,608,236,...,997,321,548,169,216 (54 digits) 107 13,164,036,458,569,6...,943,117,783,728,128 (65 digits) 127 14,474,011,154,664,5...,349,131,199,152,128 (77 digits) 521 23,562,723,457,267,3...,492,160,555,646,976 (314 digits) 607 141,053,783,706,712,...,570,759,537,328,128 (366 digits) 1279 54,162,526,284,365,8...,345,764,984,291,328 (770 digits) 2203 1,089,258,355,057,82...,580,834,453,782,528 (1,327 digits) 2281 99,497,054,337,086,4...,375,675,139,915,776 (1,373 digits) 3217 33,570,832,131,986,7...,888,332,628,525,056 (1,937 digits) 4253 18,201,749,040,140,4...,848,437,133,377,536 (2,561 digits) 4423 40,767,271,711,094,4...,020,642,912,534,528 (2,663 digits) 9689 11,434,731,753,038,6...,982,558,429,577,216 (5,834 digits) 9941 598,885,496,387,336,...,478,324,073,496,576 (5,985 digits) 11213 3,959,613,212,817,94...,255,702,691,086,336 (6,751 digits) 19937 931,144,559,095,633,...,434,790,271,942,656 (12,003 digits) 21701 1,006,564,970,546,40...,865,255,141,605,376 (13,066 digits) 23209 81,153,776,582,351,0...,048,603,941,666,816 (13,973 digits) 44497 365,093,519,915,713,...,965,353,031,827,456 (26,790 digits) 86243 144,145,836,177,303,...,480,957,360,406,528 (51,924 digits) 110503 13,620,458,213,388,4...,255,233,603,862,528 (66,530 digits) 132049 13,145,129,545,436,9...,438,491,774,550,016 (79,502 digits) 216091 27,832,745,922,032,7...,263,416,840,880,128 (130,100 digits) 756839 15,161,657,022,027,0...,971,600,565,731,328 (455,663 digits) 859433 83,848,822,675,015,7...,651,540,416,167,936 (517,430 digits) 1257787 849,732,889,343,651,...,394,028,118,704,128 (757,263 digits) 1398269 331,882,354,881,177,...,668,017,723,375,616 (841,842 digits) 2976221 194,276,425,328,791,...,106,724,174,462,976 (1,791,864 digits) 3021377 811,686,848,628,049,...,147,573,022,457,856 (1,819,050 digits) 6972593 9,551,760,305,212,09...,914,475,123,572,736 (4,197,919 digits) 13466917 42,776,415,902,185,6...,230,460,863,021,056 (8,107,892 digits) 20996011 7,935,089,093,651,70...,903,578,206,896,128 (12,640,858 digits) 24036583 44,823,302,617,990,8...,680,460,572,950,528 (14,471,465 digits) (5s) 25964951 7,462,098,419,004,44...,245,874,791,088,128 (15,632,458 digits) (8s) 30402457 49,743,776,545,907,0...,934,536,164,704,256 (18,304,103 digits) (10s) 32582657 77,594,685,533,649,8...,428,476,577,120,256 (19,616,714 digits) (13s) 37156667 20,453,422,553,410,5...,147,975,074,480,128 (22,370,543 digits) (16s) 42643801 1,442,850,579,600,99...,314,837,377,253,376 (25,674,127 digits) (20s) 43112609 50,076,715,684,982,3...,909,221,145,378,816 (25,956,377 digits) (24s) 57885161 169,296,395,301,618,...,179,626,270,130,176 (34,850,340 digits) (29s) 74207281 45,112,996,270,669,0...,008,557,930,315,776 (44,677,235 digits) (36s) 77232917 10,920,015,213,433,6...,001,402,016,301,056 (46,498,850 digits) (43s) 82589933 1,108,477,798,641,48...,798,007,191,207,936 (49,724,095 digits) (50s) "50.6s"
PHP
function is_perfect($number)
{
$sum = 0;
for($i = 1; $i < $number; $i++)
{
if($number % $i == 0)
$sum += $i;
}
return $sum == $number;
}
echo "Perfect numbers from 1 to 33550337:" . PHP_EOL;
for($num = 1; $num < 33550337; $num++)
{
if(is_perfect($num))
echo $num . PHP_EOL;
}
Picat
Simple divisors/1 function
First is the slow perfect1/1
that use the simple divisors/1 function:
go =>
println(perfect1=[I : I in 1..10_000, perfect1(I)]),
nl.
perfect1(N) => sum(divisors(N)) == N.
divisors(N) = [J: J in 1..1+N div 2, N mod J == 0].
- Output:
perfect1 = [1,6,28,496,8128]
Using formula for perfect number candidates
The formula for perfect number candidates is: 2^(p-1)*(2^p-1) for prime p. This is used to find some more perfect numbers in reasonable time. perfect2/1
is a faster version of checking if a number is perfect.
go2 =>
println("Using the formula: 2^(p-1)*(2^p-1) for prime p"),
foreach(P in primes(32))
PF=perfectf(P),
% Check that it is really a perfect number
if perfect2(PF) then
printf("%w (prime %w)\n",PF,P)
end
end,
nl.
% Formula for perfect number candidates:
% 2^(p-1)*(2^p-1) where p is a prime
%
perfectf(P) = (2**(P-1))*((2**P)-1).
% Faster check of a perfect number
perfect2(N) => sum_divisors(N) == N.
% Sum of divisors
table
sum_divisors(N) = Sum =>
sum_divisors(2,N,1,Sum).
sum_divisors(I,N,Sum0,Sum), I > floor(sqrt(N)) =>
Sum = Sum0.
% I is a divisor of N
sum_divisors(I,N,Sum0,Sum), N mod I == 0 =>
Sum1 = Sum0 + I,
(I != N div I ->
Sum2 = Sum1 + N div I
;
Sum2 = Sum1
),
sum_divisors(I+1,N,Sum2,Sum).
% I is not a divisor of N.
sum_divisors(I,N,Sum0,Sum) =>
sum_divisors(I+1,N,Sum0,Sum).
- Output:
6 (prime 2) 28 (prime 3) 496 (prime 5) 8128 (prime 7) 33550336 (prime 13) 8589869056 (prime 17) 137438691328 (prime 19) 2305843008139952128 (prime 31) CPU time 118.039 seconds. Backtracks: 0
Using list of the primes generating the perfect numbers
Now let's cheat a little. At https://en.wikipedia.org/wiki/Perfect_number there is a list of the first 48 primes that generates perfect numbers according to the formula 2^(p-1)*(2^p-1) for prime p.
The perfect numbers are printed only if they has < 80 digits, otherwise the number of digits are shown. The program stops when reaching a number with more than 100 000 digits. (Note: The major time running this program is getting the number of digits.)
go3 =>
ValidP = [2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607,
1279, 2203, 2281, 3217, 4253, 4423, 9689, 9941, 11213,
19937, 21701, 23209, 44497, 86243, 110503, 132049, 216091,
756839, 859433, 1257787, 1398269, 2976221, 3021377, 6972593,
13466917, 20996011, 24036583, 25964951, 30402457, 32582657,
37156667, 42643801, 43112609, 57885161],
foreach(P in ValidP)
printf("prime %w: ", P),
PF = perfectf(P),
Len = PF.to_string.len,
if Len < 80 then
println(PF)
else
println(len=Len)
end,
if Len >= 100_000 then
fail
end
end,
nl.
- Output:
prime 2: 6 prime 3: 28 prime 5: 496 prime 7: 8128 prime 13: 33550336 prime 17: 8589869056 prime 19: 137438691328 prime 31: 2305843008139952128 prime 61: 2658455991569831744654692615953842176 prime 89: 191561942608236107294793378084303638130997321548169216 prime 107: 13164036458569648337239753460458722910223472318386943117783728128 prime 127: 14474011154664524427946373126085988481573677491474835889066354349131199152128 prime 521: len = 314 prime 607: len = 366 prime 1279: len = 770 prime 2203: len = 1327 prime 2281: len = 1373 prime 3217: len = 1937 prime 4253: len = 2561 prime 4423: len = 2663 prime 9689: len = 5834 prime 9941: len = 5985 prime 11213: len = 6751 prime 19937: len = 12003 prime 21701: len = 13066 prime 23209: len = 13973 prime 44497: len = 26790 prime 86243: len = 51924 prime 110503: len = 66530 prime 132049: len = 79502 prime 216091: len = 130100
PicoLisp
(de perfect (N)
(let C 0
(for I (/ N 2)
(and (=0 (% N I)) (inc 'C I)) )
(= C N) ) )
(de faster (N)
(let (C 1 Stop (sqrt N))
(for (I 2 (<= I Stop) (inc I))
(and
(=0 (% N I))
(inc 'C (+ (/ N I) I)) ) )
(= C N) ) )
PL/I
perfect: procedure (n) returns (bit(1));
declare n fixed;
declare sum fixed;
declare i fixed binary;
sum = 0;
do i = 1 to n-1;
if mod(n, i) = 0 then sum = sum + i;
end;
return (sum=n);
end perfect;
PL/I-80
perfect_search: procedure options (main);
%replace
search_limit by 10000,
true by '1'b,
false by '0'b;
dcl (k, found) fixed bin;
put skip list ('Searching for perfect numbers up to ');
put edit (search_limit) (f(5));
found = 0;
do k = 2 to search_limit;
if isperfect(k) then
do;
put skip list(k);
found = found + 1;
end;
end;
put skip list (found, ' perfect numbers were found');
/* return true if n is perfect, otherwise false */
isperfect: procedure(n) returns (bit(1));
dcl (n, sum, f1, f2) fixed bin;
sum = 1; /* 1 is a proper divisor of every number */
f1 = 2;
do while ((f1 * f1) <= n);
if mod(n, f1) = 0 then
do;
sum = sum + f1;
f2 = n / f1;
/* don't double count identical co-factors! */
if f2 > f1 then sum = sum + f2;
end;
f1 = f1 + 1;
end;
return (sum = n);
end isperfect;
end perfect_search;
- Output:
Searching for perfect numbers up to 10000 6 28 496 8128 4 perfect numbers were found
PL/M
... under CP/M (or an emulator)
100H: /* FIND SOME PERFECT NUMBERS: NUMBERS EQUAL TO THE SUM OF THEIR PROPER */
/* DIVISORS */
/* CP/M SYSTEM CALL AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
DECLARE FN BYTE, ARG ADDRESS;
GOTO 5;
END BDOS;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$NUMBER: PROCEDURE( N );
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
/* TASK */
/* RETURNS TRUE IF N IS PERFECT, 0 OTHERWISE */
IS$PERFECT: PROCEDURE( N )BYTE;
DECLARE N ADDRESS;
DECLARE ( F1, F2, SUM ) ADDRESS;
SUM = 1;
F1 = 2;
F2 = N;
DO WHILE( F1 * F1 <= N );
IF N MOD F1 = 0 THEN DO;
SUM = SUM + F1;
F2 = N / F1;
/* AVOID COUNTING E.G., 2 TWICE AS A FACTOR OF 4 */
IF F2 > F1 THEN SUM = SUM + F2;
END;
F1 = F1 + 1;
END;
RETURN SUM = N;
END IS$PERFECT ;
/* TEST IS$PERFECT */
DECLARE N ADDRESS;
DO N = 2 TO 10$000;
IF IS$PERFECT( N ) THEN DO;
CALL PR$CHAR( ' ' );
CALL PR$NUMBER( N );
END;
END;
EOF
- Output:
6 28 496 8128
Alternative, much faster version.
... under CP/M (or an emulator)
100H: /* FIND SOME PERFECT NUMBERS: NUMBERS EQUAL TO THE SUM OF THEIR PROPER */
/* DIVISORS */
/* CP/M SYSTEM CALL AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
DECLARE FN BYTE, ARG ADDRESS;
GOTO 5;
END BDOS;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$NUMBER: PROCEDURE( N );
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
/* TASK - TRANSLATION OF ACTION! */
DECLARE MAX$NUM LITERALLY '10$000';
DECLARE PDS( 10$001 ) ADDRESS;
DECLARE ( I, J ) ADDRESS;
DO I = 2 TO MAX$NUM;
PDS( I ) = 1;
END;
DO I = 2 TO MAX$NUM;
DO J = I + I TO MAX$NUM BY I;
PDS( J ) = PDS( J ) + I;
END;
END;
DO I = 2 TO MAX$NUM;
IF PDS( I ) = I THEN DO;
CALL PR$NUMBER( I );
CALL PR$NL;
END;
END;
EOF
- Output:
6 28 496 8128
PowerShell
Function IsPerfect($n)
{
$sum=0
for($i=1;$i-lt$n;$i++)
{
if($n%$i -eq 0)
{
$sum += $i
}
}
return $sum -eq $n
}
Returns "True" if the given number is perfect and "False" if it's not.
Prolog
Classic approach
Works with SWI-Prolog
tt_divisors(X, N, TT) :-
Q is X / N,
( 0 is X mod N -> (Q = N -> TT1 is N + TT;
TT1 is N + Q + TT);
TT = TT1),
( sqrt(X) > N + 1 -> N1 is N+1, tt_divisors(X, N1, TT1);
TT1 = X).
perfect(X) :-
tt_divisors(X, 2, 1).
perfect_numbers(N, L) :-
numlist(2, N, LN),
include(perfect, LN, L).
Faster method
Since a perfect number is of the form 2^(n-1) * (2^n - 1), we can eliminate a lot of candidates by merely factoring out the 2s and seeing if the odd portion is (2^(n+1)) - 1.
perfect(N) :-
factor_2s(N, Chk, Exp),
Chk =:= (1 << (Exp+1)) - 1,
prime(Chk).
factor_2s(N, S, D) :- factor_2s(N, 0, S, D).
factor_2s(D, S, D, S) :- getbit(D, 0) =:= 1, !.
factor_2s(N, E, D, S) :-
E2 is E + 1, N2 is N >> 1, factor_2s(N2, E2, D, S).
% check if a number is prime
%
wheel235(L) :-
W = [4, 2, 4, 2, 4, 6, 2, 6 | W],
L = [1, 2, 2 | W].
prime(N) :-
N >= 2,
wheel235(W),
prime(N, 2, W).
prime(N, D, _) :- D*D > N, !.
prime(N, D, [A|As]) :-
N mod D =\= 0,
D2 is D + A, prime(N, D2, As).
- Output:
?- between(1, 10_000, N), perfect(N). N = 6 ; N = 28 ; N = 496 ; N = 8128 ; false.
Functional approach
Works with SWI-Prolog and module lambda, written by Ulrich Neumerkel found there http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl
:- use_module(library(lambda)).
is_divisor(V, N) :-
0 =:= V mod N.
is_perfect(N) :-
N1 is floor(N/2),
numlist(1, N1, L),
f_compose_1(foldl((\X^Y^Z^(Z is X+Y)), 0), filter(is_divisor(N)), F),
call(F, L, N).
f_perfect_numbers(N, L) :-
numlist(2, N, LN),
filter(is_perfect, LN, L).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% functionnal predicates
%% foldl(Pred, Init, List, R).
%
foldl(_Pred, Val, [], Val).
foldl(Pred, Val, [H | T], Res) :-
call(Pred, Val, H, Val1),
foldl(Pred, Val1, T, Res).
%% filter(Pred, LstIn, LstOut)
%
filter(_Pre, [], []).
filter(Pred, [H|T], L) :-
filter(Pred, T, L1),
( call(Pred,H) -> L = [H|L1]; L = L1).
%% f_compose_1(Pred1, Pred2, Pred1(Pred2)).
%
f_compose_1(F,G, \X^Z^(call(G,X,Y), call(F,Y,Z))).
PureBasic
Procedure is_Perfect_number(n)
Protected summa, i=1, result=#False
Repeat
If Not n%i
summa+i
EndIf
i+1
Until i>=n
If summa=n
result=#True
EndIf
ProcedureReturn result
EndProcedure
Python
- Relative timings
Relative timings for sifting the integers from 1 to 50_000 inclusive for perfect numbers.
Function | Time | Type |
---|---|---|
perf4 | 1 | Optimised procedural |
perfect | 1.6 | Optimised functional |
perf1 | 259 | Procedural |
perf2 | 273 | Functional |
Python: Procedural
def perf1(n):
sum = 0
for i in range(1, n):
if n % i == 0:
sum += i
return sum == n
Python: Optimised Procedural
from itertools import chain, cycle, accumulate
def factor2(n):
def prime_powers(n):
# c goes through 2, 3, 5, then the infinite (6n+1, 6n+5) series
for c in accumulate(chain([2, 1, 2], cycle([2,4]))):
if c*c > n: break
if n%c: continue
d,p = (), c
while not n%c:
n,p,d = n//c, p*c, d + (p,)
yield(d)
if n > 1: yield((n,))
r = [1]
for e in prime_powers(n):
r += [a*b for a in r for b in e]
return r
def perf4(n):
"Using most efficient prime factoring routine from: http://rosettacode.org/wiki/Factors_of_an_integer#Python"
return 2 * n == sum(factor2(n))
Python: Functional
def perf2(n):
return n == sum(i for i in range(1, n) if n % i == 0)
print (
list(filter(perf2, range(1, 10001)))
)
'''Perfect numbers'''
from math import sqrt
# perfect :: Int - > Bool
def perfect(n):
'''Is n the sum of its proper divisors other than 1 ?'''
root = sqrt(n)
lows = [x for x in enumFromTo(2)(int(root)) if 0 == (n % x)]
return 1 < n and (
n == 1 + sum(lows + [n / x for x in lows if root != x])
)
# main :: IO ()
def main():
'''Test'''
print([
x for x in enumFromTo(1)(10000) if perfect(x)
])
# GENERIC -------------------------------------------------
# enumFromTo :: (Int, Int) -> [Int]
def enumFromTo(m):
'''Integer enumeration from m to n.'''
return lambda n: list(range(m, 1 + n))
if __name__ == '__main__':
main()
- Output:
[6, 28, 496, 8128]
Quackery
factors
is defined at Factors of an integer.
[ 0 swap witheach + ] is sum ( [ --> n )
[ factors -1 pluck dip sum = ] is perfect ( n --> n )
say "Perfect numbers less than 10000:" cr
10000 times
[ i^ 1+ perfect if [ i^ 1+ echo cr ] ]
- Output:
Perfect numbers less than 10000: 6 28 496 8128
R
is.perf <- function(n){
if (n==0|n==1) return(FALSE)
s <- seq (1,n-1)
x <- n %% s
m <- data.frame(s,x)
out <- with(m, s[x==0])
return(sum(out)==n)
}
# Usage - Warning High Memory Usage
is.perf(28)
sapply(c(6,28,496,8128,33550336),is.perf)
Racket
#lang racket
(require math)
(define (perfect? n)
(=
(* n 2)
(sum (divisors n))))
; filtering to only even numbers for better performance
(filter perfect? (filter even? (range 1e5)))
;-> '(0 6 28 496 8128)
Raku
(formerly Perl 6) Naive (very slow) version
sub is-perf($n) { $n == [+] grep $n %% *, 1 .. $n div 2 }
# used as
put ((1..Inf).hyper.grep: {.&is-perf})[^4];
- Output:
6 28 496 8128
Much, much faster version:
my @primes = lazy (2,3,*+2 … Inf).grep: { .is-prime };
my @perfects = lazy gather for @primes {
my $n = 2**$_ - 1;
take $n * 2**($_ - 1) if $n.is-prime;
}
.put for @perfects[^12];
- Output:
6 28 496 8128 33550336 8589869056 137438691328 2305843008139952128 2658455991569831744654692615953842176 191561942608236107294793378084303638130997321548169216 13164036458569648337239753460458722910223472318386943117783728128 14474011154664524427946373126085988481573677491474835889066354349131199152128
REBOL
perfect?: func [n [integer!] /local sum] [
sum: 0
repeat i (n - 1) [
if zero? remainder n i [
sum: sum + i
]
]
sum = n
]
REXX
Classic REXX version of ooRexx
This version is a Classic Rexx version of the ooRexx program as of 14-Sep-2013.
/*REXX version of the ooRexx program (the code was modified to run with Classic REXX).*/
do i=1 to 10000 /*statement changed: LOOP ──► DO*/
if perfectNumber(i) then say i "is a perfect number"
end
exit
perfectNumber: procedure; parse arg n /*statements changed: ROUTINE,USE*/
sum=0
do i=1 to n%2 /*statement changed: LOOP ──► DO*/
if n//i==0 then sum=sum+i /*statement changed: sum += i */
end
return sum=n
output when using the default of 10000:
6 is a perfect number 28 is a perfect number 496 is a perfect number 8128 is a perfect number
Classic REXX version of PL/I
This version is a Classic REXX version of the PL/I program as of 14-Sep-2013, a REXX say statement
was added to display the perfect numbers. Also, an epilog was written for the re-worked function.
/*REXX version of the PL/I program (code was modified to run with Classic REXX). */
parse arg low high . /*obtain the specified number(s).*/
if high=='' & low=='' then high=34000000 /*if no arguments, use a range. */
if low=='' then low=1 /*if no LOW, then assume unity.*/
if high=='' then high=low /*if no HIGH, then assume LOW. */
do i=low to high /*process the single # or range. */
if perfect(i) then say i 'is a perfect number.'
end /*i*/
exit
perfect: procedure; parse arg n /*get the number to be tested. */
sum=0 /*the sum of the factors so far. */
do i=1 for n-1 /*starting at 1, find all factors*/
if n//i==0 then sum=sum+i /*I is a factor of N, so add it.*/
end /*i*/
return sum=n /*if the sum matches N, perfect! */
output when using the input defaults of: 1 10000
The output is the same as for the ooRexx version (above).
traditional method
Programming note: this traditional method takes advantage of a few shortcuts:
- testing only goes up to the (integer) square root of X
- testing bypasses the test of the first and last factors
- the corresponding factor is also used when a factor is found
/*REXX program tests if a number (or a range of numbers) is/are perfect. */
parse arg low high . /*obtain optional arguments from the CL*/
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */
if low=='' then low=1 /*if no LOW, then assume unity. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough digits to handle number*/
do i=low to high /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure; parse arg x /*obtain the number to be tested. */
if x<6 then return 0 /*perfect numbers can't be < six. */
s=1 /*the first factor of X. ___*/
do j=2 while j*j<=x /*starting at 2, find the factors ≤√ X */
if x//j\==0 then iterate /*J isn't a factor of X, so skip it.*/
s = s + j + x%j /* ··· add it and the other factor. */
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, it's perfect! */
output when using the default inputs:
6 is a perfect number. 28 is a perfect number. 496 is a perfect number. 8128 is a perfect number. 33550336 is a perfect number.
For 10,000 numbers tested, this version is 19.6 times faster than the ooRexx program logic.
For 10,000 numbers tested, this version is 25.6 times faster than the PL/I program logic.
Note: For the above timings, only 10,000 numbers were tested.
optimized using digital root
This REXX version makes use of the fact that all known perfect numbers > 6 have a digital root of 1.
/*REXX program tests if a number (or a range of numbers) is/are perfect. */
parse arg low high . /*obtain the specified number(s). */
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */
if low=='' then low=1 /*if no LOW, then assume unity. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough digits to handle number*/
do i=low to high /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure; parse arg x 1 y /*obtain the number to be tested. */
if x==6 then return 1 /*handle the special case of six. */
/*[↓] perfect number's digitalRoot = 1*/
do until y<10 /*find the digital root of Y. */
parse var y r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end /*k*/
y=r /*find digital root of the digit root. */
end /*until*/ /*wash, rinse, repeat ··· */
if r\==1 then return 0 /*Digital root ¬ 1? Then ¬ perfect. */
s=1 /*the first factor of X. ___*/
do j=2 while j*j<=x /*starting at 2, find the factors ≤√ X */
if x//j\==0 then iterate /*J isn't a factor of X, so skip it. */
s = s + j + x%j /*··· add it and the other factor. */
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, it's perfect! */
output is the same as the traditional version and is about 5.3 times faster (testing 34,000,000 numbers).
optimized using only even numbers
This REXX version uses the fact that all known perfect numbers are even.
/*REXX program tests if a number (or a range of numbers) is/are perfect. */
parse arg low high . /*obtain optional arguments from the CL*/
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */
if low=='' then low=1 /*if no LOW, then assume unity. */
low=low+low//2 /*if LOW is odd, bump it by one. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough digits to handle number*/
do i=low to high by 2 /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure; parse arg x 1 y /*obtain the number to be tested. */
if x==6 then return 1 /*handle the special case of six. */
do until y<10 /*find the digital root of Y. */
parse var y 1 r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end /*k*/
y=r /*find digital root of the digital root*/
end /*until*/ /*wash, rinse, repeat ··· */
if r\==1 then return 0 /*Digital root ¬ 1 ? Then ¬ perfect.*/
s=3 + x%2 /*the first 3 factors of X. ___*/
do j=3 while j*j<=x /*starting at 3, find the factors ≤√ X */
if x//j\==0 then iterate /*J isn't a factor o f X, so skip it.*/
s = s + j + x%j /* ··· add it and the other factor. */
end /*j*/ /*(above) is marginally faster. */
return s==x /*if sum matches X, then it's perfect!*/
output is the same as the traditional version and is about 11.5 times faster (testing 34,000,000 numbers).
Lucas-Lehmer method
This version uses memoization to implement a fast version of the Lucas-Lehmer test.
/*REXX program tests if a number (or a range of numbers) is/are perfect. */
parse arg low high . /*obtain the optional arguments from CL*/
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */
if low=='' then low=1 /*if no LOW, then assume unity. */
low=low+low//2 /*if LOW is odd, bump it by one. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough digits to handle number*/
@.=0; @.1=2 /*highest magic number and its index. */
do i=low to high by 2 /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure expose @.; parse arg x /*obtain the number to be tested. */
/*Lucas-Lehmer know that perfect */
/* numbers can be expressed as: */
/* [2**n - 1] * [2** (n-1) ] */
if @.0<x then do @.1=@.1 while @._<=x; _=(2**@.1-1)*2**(@.1-1); @.0=_; @._=_
end /*@.1*/ /*uses memoization for the formula. */
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer test? */
s = 3 + x%2 /*we know the following factors: */
/* 1 ('cause Mama said so.) */
/* 2 ('cause it's even.) */
/* x÷2 ( " " " ) ___*/
do j=3 while j*j<=x /*starting at 3, find the factors ≤√ X */
if x//j\==0 then iterate /*J divides X evenly, so ··· */
s=s + j + x%j /*··· add it and the other factor. */
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, it's perfect!*/
output is the same as the traditional version and is about 75 times faster (testing 34,000,000 numbers).
Lucas-Lehmer + other optimizations
This version uses the Lucas-Lehmer method, digital roots, and restricts itself to even numbers, and
also utilizes a check for the last-two-digits as per François Édouard Anatole Lucas (in 1891).
Also, in the first do loop, the index i is fast advanced according to the last number tested.
An integer square root function was added to limit the factorization of a number.
/*REXX program tests if a number (or a range of numbers) is/are perfect. */
parse arg low high . /*obtain optional arguments from the CL*/
if high=='' & low=="" then high=34000000 /*No arguments? Then use a range. */
if low=='' then low=1 /*if no LOW, then assume unity. */
low=low+low//2 /*if LOW is odd, bump it by one. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough decimal digits for nums*/
@. =0; @.1=2; !.=2; _=' 6' /*highest magic number and its index.*/
!._=22; !.16=12; !.28=8; !.36=20; !.56=20; !.76=20; !.96=20
/* [↑] "Lucas' numbers, in 1891. */
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.'
i=i+!.? /*use a fast advance for the DO index. */
end /*i*/ /* [↑] note: the DO index is modified.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure expose @. !. ? /*expose (make global) some variables. */
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 !.?==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) } ║
╚═════════════════════════════════════════════╝*/
if @.0<x then do @.1=@.1 while @._<=x; _=(2**@.1-1)*2**(@.1-1); @.0=_; @._=_
end /*@.1*/ /* [↑] uses memoization for formula. */
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer? Not perfect*/
/*[↓] perfect numbers digital root = 1*/
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 /*k*/
y=d /*find digital root of the digital root*/
end /*until*/ /*wash, rinse, repeat ··· */
if d\==1 then return 0 /*Is digital root ¬ 1? Then ¬ perfect.*/
s=3 + x%2 /*we know the following factors: unity,*/
z=x /*2, and x÷2 (x is even). */
q=1; do while q<=z; q=q*4 ; end /*while q≤z*/ /* _____*/
r=0 /* [↓] R will be the integer √ X */
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 /*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*/
end /*j*/
return s==x /*if the sum matches X, then perfect! */
output is the same as the traditional version and is about 500 times faster (testing 34,000,000 numbers).
Ring
for i = 1 to 10000
if perfect(i) see i + nl ok
next
func perfect n
sum = 0
for i = 1 to n - 1
if n % i = 0 sum = sum + i ok
next
if sum = n return 1 else return 0 ok
return sum
RPL
≪ 0 SWAP 1 WHILE DUP2 > REPEAT IF DUP2 MOD NOT THEN ROT OVER + ROT ROT END 1 + END DROP == ≫ 'PFCT?' STO ≪ { } 1 1000 FOR n IF n PFCT? THEN n + END NEXT ≫ 'TASK' STO
- Output:
1: { 6 28 496 }
A vintage HP-28S needs 157 seconds to collect all perfect numbers under 100...
Ruby
def perf(n)
sum = 0
for i in 1...n
sum += i if n % i == 0
end
sum == n
end
Functional style:
def perf(n)
n == (1...n).select {|i| n % i == 0}.inject(:+)
end
Faster version:
def perf(n)
divisors = []
for i in 1..Integer.sqrt(n)
divisors << i << n/i if n % i == 0
end
divisors.uniq.inject(:+) == 2*n
end
Test:
for n in 1..10000
puts n if perf(n)
end
- Output:
6 28 496 8128
Fast (Lucas-Lehmer)
Generate and memoize perfect numbers as needed.
require "prime"
def mersenne_prime_pow?(p)
# Lucas-Lehmer test; expects prime as argument
return true if p == 2
m_p = ( 1 << p ) - 1
s = 4
(p-2).times{ s = (s**2 - 2) % m_p }
s == 0
end
@perfect_numerator = Prime.each.lazy.select{|p| mersenne_prime_pow?(p)}.map{|p| 2**(p-1)*(2**p-1)}
@perfects = @perfect_numerator.take(1).to_a
def perfect?(num)
@perfects << @perfect_numerator.next until @perfects.last >= num
@perfects.include? num
end
# demo
p (1..10000).select{|num| perfect?(num)}
t1 = Time.now
p perfect?(13164036458569648337239753460458722910223472318386943117783728128)
p Time.now - t1
- Output:
[6, 28, 496, 8128] true 0.001053954
As the task states, it is not known if there are any odd perfect numbers (any that exist are larger than 10**2000). This program tests 10**2001 in about 30 seconds - but only for even perfects.
Run BASIC
for i = 1 to 10000
if perf(i) then print i;" ";
next i
FUNCTION perf(n)
for i = 1 TO n - 1
IF n MOD i = 0 THEN sum = sum + i
next i
IF sum = n THEN perf = 1
END FUNCTION
- Output:
6 28 496 8128
Rust
fn main ( ) {
fn factor_sum(n: i32) -> i32 {
let mut v = Vec::new(); //create new empty array
for x in 1..n-1 { //test vaules 1 to n-1
if n%x == 0 { //if current x is a factor of n
v.push(x); //add x to the array
}
}
let mut sum = v.iter().sum(); //iterate over array and sum it up
return sum;
}
fn perfect_nums(n: i32) {
for x in 2..n { //test numbers from 1-n
if factor_sum(x) == x {//call factor_sum on each value of x, if return value is = x
println!("{} is a perfect number.", x); //print value of x
}
}
}
perfect_nums(10000);
}
SASL
Copied from the SASL manual, page 22:
|| The function which takes a number and returns a list of its factors (including one but excluding itself)
|| can be written
factors n = { a <- 1.. n/2; n rem a = 0 }
|| If we define a perfect number as one which is equal to the sum of its factors (for example 6 = 3 + 2 + 1 is perfect)
|| we can write the list of all perfect numbers as
perfects = { n <- 1... ; n = sum(factors n) }
S-BASIC
$lines
rem - return p mod q
function mod(p, q = integer) = integer
end = p - q * (p/q)
rem - return true if n is perfect, otherwise false
function isperfect(n = integer) = integer
var sum, f1, f2 = integer
sum = 1
f1 = 2
while (f1 * f1) <= n do
begin
if mod(n, f1) = 0 then
begin
sum = sum + f1
f2 = n / f1
if f2 > f1 then sum = sum + f2
end
f1 = f1 + 1
end
end = (sum = n)
rem - exercise the function
var k, found = integer
print "Searching up to"; search_limit; " for perfect numbers ..."
found = 0
for k = 2 to search_limit
if isperfect(k) then
begin
print k
found = found + 1
end
next k
print found; " were found"
end
- Output:
Searching up to 10000 for perfect numbers ... 6 28 496 8128 4 were found
Scala
def perfectInt(input: Int) = ((2 to sqrt(input).toInt).collect {case x if input % x == 0 => x + input / x}).sum == input - 1
or
def perfect(n: Int) =
(for (x <- 2 to n/2 if n % x == 0) yield x).sum + 1 == n
Scheme
(define (perf n)
(let loop ((i 1)
(sum 0))
(cond ((= i n)
(= sum n))
((= 0 (modulo n i))
(loop (+ i 1) (+ sum i)))
(else
(loop (+ i 1) sum)))))
Seed7
$ include "seed7_05.s7i";
const func boolean: isPerfect (in integer: n) is func
result
var boolean: isPerfect is FALSE;
local
var integer: i is 0;
var integer: sum is 1;
var integer: q is 0;
begin
for i range 2 to sqrt(n) do
if n rem i = 0 then
sum +:= i;
q := n div i;
if q > i then
sum +:= q;
end if;
end if;
end for;
isPerfect := sum = n;
end func;
const proc: main is func
local
var integer: n is 0;
begin
for n range 2 to 33550336 do
if isPerfect(n) then
writeln(n);
end if;
end for;
end func;
- Output:
6 28 496 8128 33550336
Sidef
func is_perfect(n) {
n.sigma == 2*n
}
for n in (1..10000) {
say n if is_perfect(n)
}
Alternatively, a more efficient check for even perfect numbers:
func is_even_perfect(n) {
var square = (8*n + 1)
square.is_square || return false
var t = ((square.isqrt + 1) / 2)
t.is_smooth(2) || return false
t-1 -> is_prime
}
for n in (1..10000) {
say n if is_even_perfect(n)
}
- Output:
6 28 496 8128
Simula
BOOLEAN PROCEDURE PERF(N); INTEGER N;
BEGIN
INTEGER SUM;
FOR I := 1 STEP 1 UNTIL N-1 DO
IF MOD(N, I) = 0 THEN
SUM := SUM + I;
PERF := SUM = N;
END PERF;
Slate
n@(Integer traits) isPerfect
[
(((2 to: n // 2 + 1) select: [| :m | (n rem: m) isZero])
inject: 1 into: #+ `er) = n
].
Smalltalk
Integer extend [
"Translation of the C version; this is faster..."
isPerfectC [ |tot| tot := 1.
(2 to: (self sqrt) + 1) do: [ :i |
(self rem: i) = 0
ifTrue: [ |q|
tot := tot + i.
q := self // i.
q > i ifTrue: [ tot := tot + q ]
]
].
^ tot = self
]
"... but this seems more idiomatic"
isPerfect [
^ ( ( ( 2 to: self // 2 + 1) select: [ :a | (self rem: a) = 0 ] )
inject: 1 into: [ :a :b | a + b ] ) = self
]
].
1 to: 9000 do: [ :p | (p isPerfect) ifTrue: [ p printNl ] ]
SparForte
As a structured script.
#!/usr/local/bin/spar
pragma annotate( summary, "perfect" );
pragma annotate( description, "In mathematics, a perfect number is a positive integer" );
pragma annotate( description, "that is the sum of its proper positive divisors, that is," );
pragma annotate( description, "the sum of the positive divisors excluding the number" );
pragma annotate( description, "itself." );
pragma annotate( see_also, "http://en.wikipedia.org/wiki/Perfect_number" );
pragma annotate( author, "Ken O. Burtch" );
pragma license( unrestricted );
pragma restriction( no_external_commands );
procedure perfect is
function is_perfect( n : positive ) return boolean is
total : natural := 0;
begin
for i in 1..n-1 loop
if n mod i = 0 then
total := @+i;
end if;
end loop;
return total = natural( n );
end is_perfect;
number : positive;
result : boolean;
begin
number := 6;
result := is_perfect( number );
put( number ) @ ( " : " ) @ ( result );
new_line;
number := 18;
result := is_perfect( number );
put( number ) @ ( " : " ) @ ( result );
new_line;
number := 28;
result := is_perfect( number );
put( number ) @ ( " : " ) @ ( result );
new_line;
end perfect;
Swift
func perfect(n:Int) -> Bool {
var sum = 0
for i in 1..<n {
if n % i == 0 {
sum += i
}
}
return sum == n
}
for i in 1..<10000 {
if perfect(i) {
println(i)
}
}
- Output:
6 28 496 8128
Tcl
proc perfect n {
set sum 0
for {set i 1} {$i <= $n} {incr i} {
if {$n % $i == 0} {incr sum $i}
}
expr {$sum == 2*$n}
}
Ursala
#import std
#import nat
is_perfect = ~&itB&& ^(~&,~&t+ iota); ^E/~&l sum:-0+ ~| not remainder
This test program applies the function to a list of the first five hundred natural numbers and deletes the imperfect ones.
#cast %nL
examples = is_perfect*~ iota 500
- Output:
<6,28,496>
VBA
Using Factors_of_an_integer#VBA, slightly adapted.
Private Function Factors(x As Long) As String
Application.Volatile
Dim i As Long
Dim cooresponding_factors As String
Factors = 1
corresponding_factors = x
For i = 2 To Sqr(x)
If x Mod i = 0 Then
Factors = Factors & ", " & i
If i <> x / i Then corresponding_factors = x / i & ", " & corresponding_factors
End If
Next i
If x <> 1 Then Factors = Factors & ", " & corresponding_factors
End Function
Private Function is_perfect(n As Long)
fs = Split(Factors(n), ", ")
Dim f() As Long
ReDim f(UBound(fs))
For i = 0 To UBound(fs)
f(i) = Val(fs(i))
Next i
is_perfect = WorksheetFunction.Sum(f) - n = n
End Function
Public Sub main()
Dim i As Long
For i = 2 To 100000
If is_perfect(i) Then Debug.Print i
Next i
End Sub
- Output:
6 28 496 8128
VBScript
Function IsPerfect(n)
IsPerfect = False
i = n - 1
sum = 0
Do While i > 0
If n Mod i = 0 Then
sum = sum + i
End If
i = i - 1
Loop
If sum = n Then
IsPerfect = True
End If
End Function
WScript.StdOut.Write IsPerfect(CInt(WScript.Arguments(0)))
WScript.StdOut.WriteLine
- Output:
C:\>cscript /nologo perfnum.vbs 6 True C:\>cscript /nologo perfnum.vbs 29 False C:\>
V (Vlang)
fn compute_perfect(n i64) bool {
mut sum := i64(0)
for i := i64(1); i < n; i++ {
if n%i == 0 {
sum += i
}
}
return sum == n
}
// following fntion satisfies the task, returning true for all
// perfect numbers representable in the argument type
fn is_perfect(n i64) bool {
return n in [i64(6), 28, 496, 8128, 33550336, 8589869056,
137438691328, 2305843008139952128]
}
// validation
fn main() {
for n := i64(1); ; n++ {
if is_perfect(n) != compute_perfect(n) {
panic("bug")
}
if n%i64(1e3) == 0 {
println("tested $n")
}
}
}
- Output:
tested 1000 tested 2000 tested 3000 ...
Wren
Version 1
Restricted to the first four perfect numbers as the fifth one is very slow to emerge.
var isPerfect = Fn.new { |n|
if (n <= 2) return false
var tot = 1
for (i in 2..n.sqrt.floor) {
if (n%i == 0) {
tot = tot + i
var q = (n/i).floor
if (q > i) tot = tot + q
}
}
return n == tot
}
System.print("The first four perfect numbers are:")
var count = 0
var i = 2
while (count < 4) {
if (isPerfect.call(i)) {
System.write("%(i) ")
count = count + 1
}
i = i + 2 // there are no known odd perfect numbers
}
System.print()
- Output:
6 28 496 8128
Version 2
This makes use of the fact that all known perfect numbers are of the form (2n - 1) × 2n - 1 where (2n - 1) is prime and finds the first seven perfect numbers instantly. The numbers are too big after that to be represented accurately by Wren.
import "./math" for Int
var isPerfect = Fn.new { |n|
if (n <= 2) return false
var tot = 1
for (i in 2..n.sqrt.floor) {
if (n%i == 0) {
tot = tot + i
var q = (n/i).floor
if (q > i) tot = tot + q
}
}
return n == tot
}
System.print("The first seven perfect numbers are:")
var count = 0
var p = 2
while (count < 7) {
var n = 2.pow(p) - 1
if (Int.isPrime(n)) {
n = n * 2.pow(p-1)
if (isPerfect.call(n)) {
System.write("%(n) ")
count = count + 1
}
}
p = p + 1
}
System.print()
- Output:
6 28 496 8128 33550336 8589869056 137438691328
XPL0
include c:\cxpl\codes; \intrinsic 'code' declarations
func Perfect(N); \Return 'true' if N is a perfect number
int N, S, I, Q;
[S:= 1;
for I:= 2 to sqrt(N) do
[Q:= N/I;
if rem(0)=0 then S:= S+I+Q;
];
return S=N & N#1;
];
int A, N;
[for A:= 1 to 16 do
[N:= (1<<A - 1) * 1<<(A-1);
if Perfect(N) then [IntOut(0, N); CrLf(0)];
];
]
- Output:
6 28 496 8128 33550336
Yabasic
sub isPerfect(n)
if (n < 2) or mod(n, 2) = 1 then return false : endif
// asumimos que los números impares no son perfectos
sum = 0
for i = 1 to n-1
if mod(n,i) = 0 then sum = sum + i : endif
next i
if sum = n then return true else return false : endif
end sub
print "Los primeros 5 numeros perfectos son:"
for i = 1 to 33550336
if isPerfect(i) then print i, " ", : endif
next i
print
end
Zig
const std = @import("std");
const expect = std.testing.expect;
const stdout = std.io.getStdOut().outStream();
pub fn main() !void {
var i: u32 = 2;
try stdout.print("The first few perfect numbers are: ", .{});
while (i <= 10_000) : (i += 2) if (propersum(i) == i)
try stdout.print("{} ", .{i});
try stdout.print("\n", .{});
}
fn propersum(n: u32) u32 {
var sum: u32 = 1;
var d: u32 = 2;
while (d * d <= n) : (d += 1) if (n % d == 0) {
sum += d;
const q = n / d;
if (q > d)
sum += q;
};
return sum;
}
test "Proper divisors" {
expect(propersum(28) == 28);
expect(propersum(71) == 1);
expect(propersum(30) == 42);
}
- Output:
The first few perfect numbers are: 6 28 496 8128
zkl
fcn isPerfectNumber1(n)
{ n == [1..n-1].filter('wrap(i){ n % i == 0 }).sum(); }
- Output:
[1..0d10_000].filter(isPerfectNumber1).println(); L(6,28,496,8128)
- Discrete math
- Programming Tasks
- Prime Numbers
- 11l
- 360 Assembly
- AArch64 Assembly
- Action!
- Ada
- ALGOL 60
- ALGOL 68
- ALGOL W
- AppleScript
- ARM Assembly
- Arturo
- AutoHotkey
- AWK
- Axiom
- BASIC
- BASIC256
- Craft Basic
- IS-BASIC
- Sinclair ZX81 BASIC
- True BASIC
- BBC BASIC
- Bracmat
- Burlesque
- C
- C sharp
- C++
- Clojure
- COBOL
- CoffeeScript
- Common Lisp
- D
- Dart
- Delphi
- Dyalect
- E
- EasyLang
- Eiffel
- Elena
- Elixir
- Erlang
- ERRE
- F Sharp
- Factor
- FALSE
- Forth
- Fortran
- FreeBASIC
- Frink
- FunL
- FutureBasic
- GAP
- Go
- Groovy
- Haskell
- HicEst
- Icon
- Unicon
- Icon Programming Library
- J
- Java
- Arbitrary precision
- JavaScript
- Jq
- Julia
- K
- Kotlin
- LabVIEW
- Lambdatalk
- Lasso
- Liberty BASIC
- Lingo
- Logo
- Lua
- M2000 Interpreter
- M4
- MAD
- Maple
- Mathematica
- Wolfram Language
- MATLAB
- Maxima
- MAXScript
- Microsoft Small Basic
- Modula-2
- Nanoquery
- Nim
- Objeck
- OCaml
- Oforth
- Odin
- OoRexx
- Oz
- PARI/GP
- Pascal
- Perl
- Ntheory
- Phix
- Phix/mpfr
- PHP
- Picat
- PicoLisp
- PL/I
- PL/I-80
- PL/M
- PowerShell
- Prolog
- PureBasic
- Python
- Quackery
- R
- Racket
- Raku
- REBOL
- REXX
- Ring
- RPL
- Ruby
- Run BASIC
- Rust
- SASL
- S-BASIC
- Scala
- Scheme
- Seed7
- Sidef
- Simula
- Slate
- Smalltalk
- SparForte
- Swift
- Tcl
- Ursala
- VBA
- VBScript
- V (Vlang)
- Wren
- Wren-math
- XPL0
- Yabasic
- Zig
- Zkl
- Pages with too many expensive parser function calls