Perfect numbers

From Rosetta Code
Revision as of 00:37, 4 June 2021 by GordonCharlton (talk | contribs) (Added Quackery.)
Task
Perfect numbers
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



11l

Translation of: Python

<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' ‘ ’)</lang>
Output:
6 28 496 8128

360 Assembly

Simple code

Translation of: 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. <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</lang>
Output:
           6
          28
         496
        8128

Some optimizations

Translation of: 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. <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</lang>
Output:
0000000000000006
0000000000000028
0000000000000496
0000000000008128
0000000033550337
0000008589869056
0000137438691328

AArch64 Assembly

Works with: as version Raspberry Pi 3B version Buster 64 bits

<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" </lang>

Perfect  : 6
Perfect  : 28
Perfect  : 496
Perfect  : 8128
Perfect  : 33550336
Perfect  : 8589869056
Perfect  : 137438691328
Perfect  : 2305843008139952128
Perfect  : 8070450532247928832

Ada

<lang 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;</lang>

ALGOL 68

Works with: ALGOL 68 version Revision 1 - no extensions to language used
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny
Works with: ELLA ALGOL 68 version Any (with appropriate job cards) - tested with release 1.8-8d

<lang algol68>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;
  1. 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

)</lang>

Output:
         +6
        +28
       +496
      +8128
  +33550336

ALGOL W

Based on the Algol 68 version. <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.</lang>

Output:
             6
            28
           496
          8128

AppleScript

Translation of: JavaScript

<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</lang>

Output:

<lang AppleScript>{6, 28, 496, 8128}</lang>

ARM Assembly

Works with: as version Raspberry Pi

<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" </lang>

Perfect  : 6
Perfect  : 28
Perfect  : 496
Perfect  : 8128
Perfect  : 33550336

Arturo

<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 ]</lang>

AutoHotkey

This will find the first 8 perfect numbers. <lang autohotkey>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

}</lang>

AWK

<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}' 6 28 496 8128</lang>

Axiom

Translation of: Mathematica

Using the interpreter, define the function: <lang Axiom>perfect?(n:Integer):Boolean == reduce(+,divisors n) = 2*n</lang> Alternatively, using the Spad compiler: <lang Axiom>)abbrev package TESTP TestPackage TestPackage() : withma

   perfect?: Integer -> Boolean
 ==
   add
     import IntegerNumberTheoryFunctions
     perfect? n == reduce("+",divisors n) = 2*n</lang>

Examples (testing 496, testing 128, finding all perfect numbers in 1...10000): <lang Axiom>perfect? 496 perfect? 128 [i for i in 1..10000 | perfect? i]</lang>

Output:

<lang Axiom>true false [6,28,496,8128]</lang>

BASIC

Works with: QuickBasic version 4.5

<lang qbasic>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</lang>

IS-BASIC

<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</lang>

Sinclair ZX81 BASIC

Call this subroutine and it will (eventually) return PERFECT = 1 if N is perfect or PERFECT = 0 if it is not. <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</lang>

BBC BASIC

BASIC version

<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%)</lang>
Output:
         6
        28
       496
      8128

Assembler version

<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</lang>
Output:
         4
         6
        28
       496
      8128
  33550336

Bracmat

<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|)
   )

);</lang>

Output:
6
28
496
8128

C

Translation of: D

<lang c>#include "stdio.h"

  1. 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;

}</lang> Using functions from Factors of an integer#Prime factoring: <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; }</lang>

C#

Translation of: C++

<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(); }

static bool IsPerfect(int num) { int sum = 0; for (int i = 1; i < num; i++) { if (num % i == 0) sum += i; }

return sum == num ; }</lang>

Version using Lambdas, will only work from version 3 of C# on

<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(); }

static bool IsPerfect(int num) { return Enumerable.Range(1, num - 1).Sum(n => num % n == 0 ? n : 0 ) == num; }</lang>

C++

Works with: gcc

<lang cpp>#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 ; 

} </lang>

Clojure

<lang 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))</lang>
Translation of: Haskell

<lang clojure>(defn perfect? [n]

 (->> (for [i (range 1 n)] :when (zero? (rem n i))] i)
      (reduce +)
      (= n)))</lang>

Functional version

<lang clojure>(defn perfect? [n] (= (reduce + (filter #(zero? (rem n %)) (range 1 n))) n))</lang>

COBOL

Translation of: D
Works with: Visual COBOL

main.cbl: <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.</lang>

perfect.cbl: <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.</lang>

CoffeeScript

Optimized version, for fun. <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
  1. 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)</lang>
Output:
> coffee perfect_numbers.coffee 
6
28
496
8128

Common Lisp

Translation of: Haskell

<lang lisp>(defun perfectp (n)

 (= n (loop for i from 1 below n when (= 0 (mod n i)) sum i)))</lang>

D

Functional Version

<lang d>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;

}</lang>

Output:
[6, 28, 496, 8128]

Faster Imperative Version

Translation of: Algol

<lang d>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;

}</lang>

Output:
[6, 28, 496, 8128]

With a 33_550_337.iota it outputs:

[6, 28, 496, 8128, 33550336]

Dart

Explicit Iterative Version

<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
   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;

}</lang>

Compact Version

Translation of: Julia

<lang d>isPerfect(n) =>

   n == new List.generate(n-1, (i) => n%(i+1) == 0 ? i+1 : 0).fold(0, (p,n)=>p+n);</lang>

In either case, if we test to find all the perfect numbers up to 1000, we get: <lang d>main() =>

   new List.generate(1000,(i)=>i+1).where(isPerfect).forEach(print);</lang>
Output:
6
28
496

Delphi

See #Pascal.

Dyalect

<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")
   }

}</lang>

E

<lang 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

}</lang>

Eiffel

<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 </lang>

Output:
  6 is perfect...      True
 77 is perfect...      False
128 is perfect...      False
496 is perfect...      True

Elena

ELENA 4.x: <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()

}</lang>

Output:
6 is perfect
28 is perfect
496 is perfect
8128 is perfect

Elixir

<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)</lang>

Output:
[6, 28, 496, 8128]

Erlang

<lang erlang>is_perfect(X) ->

   X == lists:sum([N || N <- lists:seq(1,X-1), X rem N == 0]).</lang>

ERRE

<lang 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</lang>

Output:
         6
        28
       496
      8128

F#

<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</lang>

Output:
6 is perfect
28 is perfect
496 is perfect
8128 is perfect

Factor

<lang factor>USING: kernel math math.primes.factors sequences ; IN: rosettacode.perfect-numbers

perfect? ( n -- ? ) [ divisors sum ] [ 2 * ] bi = ;</lang>

FALSE

<lang false>[0\1[\$@$@-][\$@$@$@$@\/*=[@\$@+@@]?1+]#%=]p: 45p;!." "28p;!. { 0 -1 }</lang>

Forth

<lang forth>: perfect? ( n -- ? )

 1
 over 2/ 1+ 2 ?do
   over i mod 0= if i + then
 loop
 = ;</lang>

Fortran

Works with: Fortran version 90 and later

<lang 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</lang>

FreeBASIC

<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</lang>

Output:
The first 5 perfect numbers are :
 6  28  496  8128  33550336

FunL

<lang funl>def perfect( n ) = sum( d | d <- 1..n if d|n ) == 2n

println( (1..500).filter(perfect) )</lang>

Output:
(6, 28, 496)

GAP

<lang gap>Filtered([1 .. 10000], n -> Sum(DivisorsInt(n)) = 2*n);

  1. [ 6, 28, 496, 8128 ]</lang>

Go

<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)
       }
   }

}

</lang>

Output:
tested 1000
tested 2000
tested 3000
...

Groovy

Solution: <lang groovy>def isPerfect = { n ->

   n > 4 && (n == (2..Math.sqrt(n)).findAll { n % it == 0 }.inject(1) { factorSum, i -> factorSum += i + n/i })

}</lang> Test program: <lang groovy>(0..10000).findAll { isPerfect(it) }.each { println it }</lang>

Output:
6
28
496
8128

Haskell

<lang haskell>perfect n =

   n == sum [i | i <- [1..n-1], n `mod` i == 0]</lang>

Create a list of known perfects: <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]</lang>


or, restricting the search space to improve performance: <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]</lang>

Output:
[6,28,496,8128]

HicEst

<lang 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</lang>

Icon and Unicon

<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</lang>

Uses divisors from factors
Output:
Perfect numbers from 1 to 100000:
6
28
496
8128
Done.

J

<lang j>is_perfect=: +: = >:@#.~/.~&.q:@(6>.<.)</lang>

Examples of use, including extensions beyond those assumptions: <lang j> 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</lang>

More efficient version based on comments by Henry Rich and Roger Hui (comment train seeded by Jon Hough).

Java

<lang 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; }</lang> Or for arbitrary precision: <lang java>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); }</lang>

JavaScript

Imperative

Translation of: Java

<lang javascript>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);

}</lang>

Output:
6
28
496
8128

Functional

ES5

Naive version (brute force)

<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);</lang>

Output:

<lang JavaScript>[6, 28, 496, 8128]</lang>

Much faster (more efficient factorisation)

<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);</lang>

Output:

<lang JavaScript>[6, 28, 496, 8128]</lang>

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 [].)

<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);</lang>

Output: <lang JavaScript>[6, 28, 496, 8128]</lang>


ES6

<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();

})();</lang>

Output:

<lang JavaScript>[6, 28, 496, 8128]</lang>

jq

<lang jq> def is_perfect:

 . as $in
 | $in == reduce range(1;$in) as $i
     (0; if ($in % $i) == 0 then $i + . else . end);
  1. Example:

range(1;10001) | select( is_perfect )</lang>

Output:
$ jq -n -f is_perfect.jq
6
28
496
8128

Julia

Works with: Julia version 0.6

<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)</lang>

Output:
perfects(10000) = [6, 28, 496, 8128]

K

Translation of: J

<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)</lang>

Kotlin

Translation of: C

<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 ")    

}</lang>

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.

Lasso

<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</lang>

Output:

<lang lasso>6, 28, 496, 8128</lang>

Liberty BASIC

<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</lang>

Lingo

<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</lang>

<lang logo>to perfect? :n

 output equal? :n  apply "sum  filter [equal? 0  modulo :n ?]  iseq 1 :n/2

end</lang>

Lua

<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</lang>

M2000 Interpreter

<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 </lang>

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

<lang 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

')')</lang>

MAD

<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

</lang>

Output:
    6
   28
  496
 8128

Maple

<lang Maple>isperfect := proc(n) return evalb(NumberTheory:-SumOfDivisors(n) = 2*n); end proc: isperfect(6);

                             true</lang>

Mathematica / Wolfram Language

Custom function: <lang Mathematica>PerfectQ[i_Integer] := Total[Divisors[i]] == 2 i</lang> Examples (testing 496, testing 128, finding all perfect numbers in 1...10000): <lang Mathematica>PerfectQ[496] PerfectQ[128] Flatten[PerfectQ/@Range[10000]//Position[#,True]&]</lang> gives back: <lang Mathematica>True False {6,28,496,8128}</lang>

MATLAB

Standard algorithm: <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</lang> Faster algorithm: <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</lang>

Maxima

<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] */</lang>

MAXScript

<lang 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

)</lang>

Microsoft Small Basic

Translation of: BBC BASIC

<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 </lang>

Modula-2

Translation of: BBC BASIC
Works with: ADW Modula-2 version any (Compile with the linker option Console Application).

<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. </lang>

Nanoquery

Translation of: Python

<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</lang>

Nim

<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</lang>
Output:
6
28
496
8128

Objeck

<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; 
   }
 }

}</lang>

OCaml

<lang 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</lang>

Functional style: <lang ocaml>(* 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)))</lang>

Oforth

<lang Oforth>: isPerfect(n) | i | 0 n 2 / loop: i [ n i mod ifZero: [ i + ] ] n == ; </lang>

Output:
#isPerfect 10000 seq filter .
[6, 28, 496, 8128]

ooRexx

<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</lang>
Output:
6 is a perfect number
28 is a perfect number
496 is a perfect number
8128 is a perfect number

Oz

<lang 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}}</lang>

PARI/GP

Uses built-in method. Faster tests would use the LL test for evens and myriad results on OPNs otherwise. <lang parigp>isPerfect(n)=sigma(n,-1)==2</lang> Show perfect numbers <lang parigp>forprime(p=2, 2281, if(isprime(2^p-1), print(p"\t",(2^p-1)*2^(p-1))))</lang> Faster with Lucas-Lehmer test <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)</lang>

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

<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.</lang>

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

<lang perl>sub perf {

   my $n = shift;
   my $sum = 0;
   foreach my $i (1..$n-1) {
       if ($n % $i == 0) {
           $sum += $i;
       }
   }
   return $sum == $n;

}</lang> Functional style: <lang perl>use List::Util qw(sum);

sub perf {

   my $n = shift;
   $n == sum(0, grep {$n % $_ == 0} 1..$n-1);

}</lang>

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.

Library: ntheory

A simple predicate: <lang perl>use ntheory qw/divisor_sum/; sub is_perfect { my $n = shift; divisor_sum($n) == 2*$n; }</lang> Use this naive method to show the first 5. Takes about 15 seconds: <lang perl>use ntheory qw/divisor_sum/; for (1..33550336) {

 print "$_\n" if divisor_sum($_) == 2*$_;

}</lang> 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. <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;</lang>

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. <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;</lang>

In addition to generating even perfect numbers, we can also have a fast function which returns true when a given even number is perfect: <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);

}</lang>

Phix

<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</lang>

Output:
6
28
496
8128

gmp version

Library: Phix/mpfr

<lang Phix>-- demo\rosetta\Perfect_numbers.exw (includes native version above) include mpfr.e mpz n = mpz_init(), p = mpz_init() randstate state = gmp_randinit_mt() for i=2 to 159 do

   mpz_ui_pow_ui(n, 2, i)
   mpz_sub_ui(n, n, 1)
   if mpz_probable_prime_p(n, state) then
       mpz_ui_pow_ui(p,2,i-1)
       mpz_mul(n,n,p)
       printf(1, "%d  %s\n",{i,mpz_get_str(n,comma_fill:=true)})
   end if

end for n = mpz_free(n) state = gmp_randclear(state)</lang>

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,107,294,793,378,084,303,638,130,997,321,548,169,216
107  13,164,036,458,569,648,337,239,753,460,458,722,910,223,472,318,386,943,117,783,728,128
127  14,474,011,154,664,524,427,946,373,126,085,988,481,573,677,491,474,835,889,066,354,349,131,199,152,128

PHP

Translation of: C++

<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;

}</lang>

PicoLisp

<lang PicoLisp>(de perfect (N)

  (let C 0
     (for I (/ N 2)
        (and (=0 (% N I)) (inc 'C I)) )
     (= C N) ) )</lang>

<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) ) )</lang>

PL/I

<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;</lang>

PowerShell

<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.</lang>

Prolog

Classic approach

Works with SWI-Prolog <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).</lang>

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. <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).

</lang>

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 <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))).</lang>

PureBasic

<lang 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</lang>

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

<lang python>def perf1(n):

   sum = 0
   for i in range(1, n):
       if n % i == 0:
           sum += i
   return sum == n</lang>

Python: Optimised Procedural

<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))</lang>

Python: Functional

<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)))

)</lang>


<lang python>Perfect numbers

from math import sqrt


  1. 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])
   )


  1. main :: IO ()

def main():

   Test
   print([
       x for x in enumFromTo(1)(10000) if perfect(x)
   ])


  1. GENERIC -------------------------------------------------
  1. 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()</lang>
Output:
[6, 28, 496, 8128]

Quackery

factors is defined at Factors of an integer.

<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 ] ] 

</lang>

Output:
Perfect numbers less than 10000:
6
28
496
8128

R

<lang 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) }

  1. Usage - Warning High Memory Usage

is.perf(28) sapply(c(6,28,496,8128,33550336),is.perf)</lang>

Racket

<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)</lang>

Raku

(formerly Perl 6) Naive (very slow) version <lang perl6>sub is-perf($n) { $n == [+] grep $n %% *, 1 .. $n div 2 }

  1. used as

put ((1..Inf).hyper.grep: {.&is-perf})[^4];</lang>

Output:
6 28 496 8128

Much, much faster version: <lang perl6>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];</lang>

Output:
6
28
496
8128
33550336
8589869056
137438691328
2305843008139952128
2658455991569831744654692615953842176
191561942608236107294793378084303638130997321548169216
13164036458569648337239753460458722910223472318386943117783728128
14474011154664524427946373126085988481573677491474835889066354349131199152128

REBOL

<lang rebol>perfect?: func [n [integer!] /local sum] [

   sum: 0
   repeat i (n - 1) [
       if zero? remainder n i [
           sum: sum + i
       ]
   ]
   sum = n

]</lang>

REXX

Classic REXX version of ooRexx

This version is a Classic Rexx version of the ooRexx program as of 14-Sep-2013. <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</lang> 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. <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! */</lang> 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

<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! */</lang>

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. <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! */</lang>

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. <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!*/</lang>

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. <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!*/</lang>

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. <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! */</lang>

output   is the same as the traditional version   and is about   500   times faster   (testing 34,000,000 numbers).

Ring

<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 </lang>

Ruby

<lang ruby>def perf(n)

 sum = 0
 for i in 1...n
   sum += i  if n % i == 0
 end
 sum == n

end</lang> Functional style: <lang ruby>def perf(n)

 n == (1...n).select {|i| n % i == 0}.inject(:+)

end</lang> Faster version: <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</lang> Test: <lang ruby>for n in 1..10000

 puts n if perf(n)

end</lang>

Output:
6
28
496
8128

Fast (Lucas-Lehmer)

Generate and memoize perfect numbers as needed. <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

  1. demo

p (1..10000).select{|num| perfect?(num)} t1 = Time.now p perfect?(13164036458569648337239753460458722910223472318386943117783728128) p Time.now - t1 </lang>

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

<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</lang>

Output:
6 28 496 8128

Rust

<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);

} </lang>

SASL

Copied from the SASL manual, page 22: <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) } </lang>

Scala

<lang scala>def perfectInt(input: Int) = ((2 to sqrt(input).toInt).collect {case x if input % x == 0 => x + input / x}).sum == input - 1</lang>

or

<lang scala>def perfect(n: Int) =

 (for (x <- 2 to n/2 if n % x == 0) yield x).sum + 1 == n

</lang>

Scheme

<lang 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)))))</lang>

Seed7

<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;</lang>
Output:
6
28
496
8128
33550336

Sidef

<lang ruby>func is_perfect(n) {

   n.sigma == 2*n

}

for n in (1..10000) {

   say n if is_perfect(n)

}</lang>

Alternatively, a more efficient check for even perfect numbers: <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)

}</lang>

Output:
6
28
496
8128

Simula

<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;</lang>

Slate

<lang slate>n@(Integer traits) isPerfect [

 (((2 to: n // 2 + 1) select: [| :m | (n rem: m) isZero])
   inject: 1 into: #+ `er) = n

].</lang>

Smalltalk

<lang 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
 ]

].</lang>

<lang smalltalk>1 to: 9000 do: [ :p | (p isPerfect) ifTrue: [ p printNl ] ]</lang>

Swift

Translation of: Java

<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)
   }

}</lang>

Output:
6
28
496
8128

Tcl

<lang 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}

}</lang>

Ursala

<lang Ursala>#import std

  1. import nat

is_perfect = ~&itB&& ^(~&,~&t+ iota); ^E/~&l sum:-0+ ~| not remainder</lang> This test program applies the function to a list of the first five hundred natural numbers and deletes the imperfect ones. <lang Ursala>#cast %nL

examples = is_perfect*~ iota 500</lang>

Output:
<6,28,496>

VBA

Translation of: Phix

Using Factors_of_an_integer#VBA, slightly adapted. <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</lang>
Output:
 6 
 28 
 496 
 8128 

VBScript

<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</lang>

Output:
C:\>cscript /nologo perfnum.vbs 6
True

C:\>cscript /nologo perfnum.vbs 29
False

C:\>

Wren

Version 1

Translation of: D

Restricted to the first four perfect numbers as the fifth one is very slow to emerge. <lang ecmascript>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()</lang>

Output:
6 28 496 8128 

Version 2

Library: Wren-math

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. <lang ecmascript>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()</lang>

Output:
6 28 496 8128 33550336 8589869056 137438691328

XPL0

<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)];
       ];

]</lang>

Output:
6
28
496
8128
33550336

Zig

<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);

} </lang>

Output:
The first few perfect numbers are: 6 28 496 8128 

zkl

Translation of: D

<lang zkl>fcn isPerfectNumber1(n)

  { n == [1..n-1].filter('wrap(i){ n % i == 0 }).sum(); }</lang>
Output:
[1..0d10_000].filter(isPerfectNumber1).println();
L(6,28,496,8128)