{{task|Discrete math}}

Write a function which says whether a number is perfect.

[[wp:Perfect_numbers|A perfect number]] is a positive integer that is the sum of its proper positive divisors excluding the number itself.

Equivalently, a perfect number is a number that is half the sum of all of its positive divisors (including itself).

Note: The faster [[Lucas-Lehmer test]] is used to find primes of the form 2^''n''-1, all ''known'' perfect numbers can be derived from these primes using the formula (2^''n'' - 1) × 2^{''n'' - 1}.

It is not known if there are any odd perfect numbers (any that exist are larger than 10²⁰⁰⁰).

The number of ''known'' perfect numbers is '''50''' (as of September, 2018), and the largest known perfect number contains over '''46''' million decimal digits.

;See also: :* [[Rational Arithmetic]] :* [[oeis:A000396|Perfect numbers on OEIS]] :* [http://www.oddperfect.org/ Odd Perfect] showing the current status of bounds on odd perfect numbers.

360 Assembly

Simple code

{{trans|PL/I}} For maximum compatibility, this program uses only the basic instruction set (S/360) and two ASSIST macros (XDECO,XPRNT) to keep it as short as possible. The only added optimization is the loop up to n/2 instead of n-1. With 31 bit integers the limit is 2,147,483,647.

*        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

{{out}}

           6
          28
         496
        8128

Some optimizations

{{trans|REXX}} Use of optimizations found in Rexx algorithms and use of packed decimal to have bigger numbers. With 15 digit decimal integers the limit is 999,999,999,999,999.

*        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

{{out}}

0000000000000006
0000000000000028
0000000000000496
0000000000008128
0000000033550337
0000008589869056
0000137438691328

Ada

function Is_Perfect(N : Positive) return Boolean is
   Sum : Natural := 0;
begin
   for I in 1..N - 1 loop
      if N mod I = 0 then
         Sum := Sum + I;
      end if;
   end loop;
   return Sum = N;
end Is_Perfect;

ALGOL 68

{{works with|ALGOL 68|Revision 1 - no extensions to language used}} {{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny]}} {{works with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d]}}

PROC is perfect = (INT candidate)BOOL: (
  INT sum :=1;
  FOR f1 FROM 2 TO ENTIER ( sqrt(candidate)*(1+2*small real) ) WHILE
    IF candidate MOD f1 = 0 THEN
      sum +:= f1;
      INT f2 = candidate OVER f1;
      IF f2 > f1 THEN
        sum +:= f2
      FI
    FI;
# WHILE # sum <= candidate DO
    SKIP
  OD;
  sum=candidate
);

test:(
  FOR i FROM 2 TO 33550336 DO
    IF is perfect(i) THEN print((i, new line)) FI
  OD
)

{{Out}}

         +6
        +28
       +496
      +8128
  +33550336

ALGOL W

Based on the Algol 68 version.

begin
    % returns true if n is perfect, false otherwise                %
    % n must be > 0                                                %
    logical procedure isPerfect ( integer value candidate ) ;
        begin
            integer sum;
            sum    := 1;
            for f1 := 2 until round( sqrt( candidate ) ) do begin
                if candidate rem f1 = 0 then begin
                    integer f2;
                    sum := sum + f1;
                    f2  := candidate div f1;
                    % avoid e.g. counting 2 twice as a factor of 4 %
                    if f2 > f1 then sum := sum + f2
                end if_candidate_rem_f1_eq_0 ;
            end for_f1 ;
            sum = candidate
        end isPerfect ;

    % test isPerfect                                               %
    for n := 2 until 10000 do if isPerfect( n ) then write( n );
end.

{{out}}

             6
            28
           496
          8128

AppleScript

{{Trans|JavaScript}}

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

{{Out}}

{6, 28, 496, 8128}

AutoHotkey

This will find the first 8 perfect numbers.

Loop, 30 {
  If isMersennePrime(A_Index + 1)
    res .= "Perfect number: " perfectNum(A_Index + 1) "`n"
}

MsgBox % res

perfectNum(N) {
  Return 2**(N - 1) * (2**N - 1)
}

isMersennePrime(N) {
  If (isPrime(N)) && (isPrime(2**N - 1))
    Return true
}

isPrime(N) {
  Loop, % Floor(Sqrt(N))
    If (A_Index > 1 && !Mod(N, A_Index))
      Return false
  Return true
}

AWK

$ awk 'func perf(n){s=0;for(i=1;i<n;i++)if(n%i==0)s+=i;return(s==n)}
BEGIN{for(i=1;i<10000;i++)if(perf(i))print i}'
6
28
496
8128

Axiom

{{trans|Mathematica}} Using the interpreter, define the function:

perfect?(n:Integer):Boolean == reduce(+,divisors n) = 2*n

Alternatively, using the Spad compiler:

)abbrev package TESTP TestPackage
TestPackage() : withma
    perfect?: Integer -> Boolean
  ==
    add
      import IntegerNumberTheoryFunctions
      perfect? n == reduce("+",divisors n) = 2*n

Examples (testing 496, testing 128, finding all perfect numbers in 1...10000):

perfect? 496
perfect? 128
[i for i in 1..10000 | perfect? i]

{{Out}}

true
false
[6,28,496,8128]

BASIC

{{works with|QuickBasic|4.5}}

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

==={{header|IS-BASIC}}=== 100 PROGRAM "PerfectN.bas" 110 FOR X=1 TO 10000 120 IF PERFECT(X) THEN PRINT X; 130 NEXT 140 DEF PERFECT(N) 150 IF N<2 OR MOD(N,2)<>0 THEN LET PERFECT=0:EXIT DEF 160 LET S=1 170 FOR I=2 TO SQR(N) 180 IF MOD(N,I)=0 THEN LET S=S+I+N/I 190 NEXT 200 LET PERFECT=N=S 210 END DEF

=
## Sinclair ZX81 BASIC
=
Call this subroutine and it will (eventually) return <tt>PERFECT</tt> = 1 if <tt>N</tt> is perfect or <tt>PERFECT</tt> = 0 if it is not.

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

BBC BASIC

BASIC version

      FOR n% = 2 TO 10000 STEP 2
        IF FNperfect(n%) PRINT n%
      NEXT
      END

      DEF FNperfect(N%)
      LOCAL I%, S%
      S% = 1
      FOR I% = 2 TO SQR(N%)-1
        IF N% MOD I% = 0 S% += I% + N% DIV I%
      NEXT
      IF I% = SQR(N%) S% += I%
      = (N% = S%)

{{Out}}

         6
        28
       496
      8128

Assembler version

{{works with|BBC BASIC for Windows}}

      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

{{Out}}

         4
         6
        28
       496
      8128
  33550336

Bracmat

( ( perf
  =   sum i
    .   0:?sum
      & 0:?i
      &   whl
        ' ( !i+1:<!arg:?i
          & ( mod$(!arg.!i):0&!sum+!i:?sum
            |
            )
          )
      & !sum:!arg
  )
& 0:?n
&   whl
  ' ( !n+1:~>10000:?n
    & (perf$!n&out$!n|)
    )
);

{{Out}}

6
28
496
8128

C

{{trans|D}}

#include "stdio.h"
#include "math.h"

int perfect(int n) {
    int max = (int)sqrt((double)n) + 1;
    int tot = 1;
    int i;

    for (i = 2; i < max; i++)
        if ( (n % i) == 0 ) {
            tot += i;
            int q = n / i;
            if (q > i)
                tot += q;
        }

    return tot == n;
}

int main() {
    int n;
    for (n = 2; n < 33550337; n++)
        if (perfect(n))
            printf("%d\n", n);

    return 0;
}

Using functions from [[Factors of an integer#Prime factoring]]:

int main()
{
	int j;
	ulong fac[10000], n, sum;

	sieve();

	for (n = 2; n < 33550337; n++) {
		j = get_factors(n, fac) - 1;
		for (sum = 0; j && sum <= n; sum += fac[--j]);
		if (sum == n) printf("%lu\n", n);
	}

	return 0;
}

C#

{{trans|C++}}

static void Main(string[] args)
{
	Console.WriteLine("Perfect numbers from 1 to 33550337:");

	for (int x = 0; x < 33550337; x++)
	{
		if (IsPerfect(x))
			Console.WriteLine(x + " is perfect.");
	}

	Console.ReadLine();
}

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

	return sum == num ;
}

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

static void Main(string[] args)
{
	Console.WriteLine("Perfect numbers from 1 to 33550337:");

	for (int x = 0; x < 33550337; x++)
	{
		if (IsPerfect(x))
			Console.WriteLine(x + " is perfect.");
	}

	Console.ReadLine();
}

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

C++

{{works with|gcc}}

#include <iostream>
using namespace std ;

int divisor_sum( int number ) {
   int sum = 0 ;
   for ( int i = 1 ; i < number ; i++ )
      if ( number % i == 0 )
         sum += i ;
   return sum;
}

int main( ) {
   cout << "Perfect numbers from 1 to 33550337:\n" ;
   for ( int num = 1 ; num < 33550337 ; num++ ) {
      if (divisor_sum(num) == num)
         cout << num << '\n' ;
   }
   return 0 ;
}

Clojure

(defn proper-divisors [n]
  (if (< n 4)
    [1]
    (->> (range 2 (inc (quot n 2)))
         (filter #(zero? (rem n %)))
         (cons 1))))

(defn perfect? [n]
  (= (reduce + (proper-divisors n)) n))

{{trans|Haskell}}

(defn perfect? [n]
  (->> (for [i (range 1 n)] :when (zero? (rem n i))] i)
       (reduce +)
       (= n)))

Functional version

(defn perfect? [n]
	(= (reduce + (filter #(zero? (rem n %)) (range 1 n))) n))

CoffeeScript

Optimized version, for fun.

is_perfect_number = (n) ->
  do_factors_add_up_to n, 2*n

do_factors_add_up_to = (n, desired_sum) ->
  # We mildly optimize here, by taking advantage of
  # the fact that the sum_of_factors( (p^m) * x)
  # is (1 + ... + p^m-1 + p^m) * sum_factors(x) when
  # x is not itself a multiple of p.

  p = smallest_prime_factor(n)
  if p == n
    return desired_sum == p + 1

  # ok, now sum up all powers of p that
  # divide n
  sum_powers = 1
  curr_power = 1
  while n % p == 0
    curr_power *= p
    sum_powers += curr_power
    n /= p

  # if desired_sum does not divide sum_powers, we
  # can short circuit quickly
  return false unless desired_sum % sum_powers == 0

  # otherwise, recurse
  do_factors_add_up_to n, desired_sum / sum_powers

smallest_prime_factor = (n) ->
  for i in [2..n]
    return n if i*i > n
    return i if n % i == 0

# tests
do ->
  # This is pretty fast...
  for n in [2..100000]
    console.log n if is_perfect_number n

  # For big numbers, let's just sanity check the known ones.
  known_perfects = [
    33550336
    8589869056
    137438691328
  ]
  for n in known_perfects
    throw Error("fail") unless is_perfect_number(n)
    throw Error("fail") if is_perfect_number(n+1)

{{Out}}

> coffee perfect_numbers.coffee
6
28
496
8128

COBOL

{{trans|D}} {{works with|Visual COBOL}} main.cbl:

      $set REPOSITORY "UPDATE ON"

       IDENTIFICATION DIVISION.
       PROGRAM-ID. perfect-main.

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION perfect
           .
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  i                      PIC 9(8).

       PROCEDURE DIVISION.
           PERFORM VARYING i FROM 2 BY 1 UNTIL 33550337 = i
               IF FUNCTION perfect(i) = 0
                   DISPLAY i
               END-IF
           END-PERFORM

           GOBACK
           .
       END PROGRAM perfect-main.

perfect.cbl:

       IDENTIFICATION DIVISION.
       FUNCTION-ID. perfect.

       DATA DIVISION.
       LOCAL-STORAGE SECTION.
       01  max-val                 PIC 9(8).
       01  total                   PIC 9(8) VALUE 1.
       01  i                       PIC 9(8).
       01  q                       PIC 9(8).

       LINKAGE SECTION.
       01  n                       PIC 9(8).
       01  is-perfect              PIC 9.

       PROCEDURE DIVISION USING VALUE n RETURNING is-perfect.
           COMPUTE max-val = FUNCTION INTEGER(FUNCTION SQRT(n)) + 1

           PERFORM VARYING i FROM 2 BY 1 UNTIL i = max-val
               IF FUNCTION MOD(n, i) = 0
                   ADD i TO total

                   DIVIDE n BY i GIVING q
                   IF q > i
                       ADD q TO total
                   END-IF
               END-IF
           END-PERFORM

           IF total = n
               MOVE 0 TO is-perfect
           ELSE
               MOVE 1 TO is-perfect
           END-IF

           GOBACK
           .
       END FUNCTION perfect.

Common Lisp

{{trans|Haskell}}

(defun perfectp (n)
  (= n (loop for i from 1 below n when (= 0 (mod n i)) sum i)))

D

Functional Version

import std.stdio, std.algorithm, std.range;

bool isPerfectNumber1(in uint n) pure nothrow
in {
    assert(n > 0);
} body {
    return n == iota(1, n - 1).filter!(i => n % i == 0).sum;
}

void main() {
    iota(1, 10_000).filter!isPerfectNumber1.writeln;
}

{{out}}

[6, 28, 496, 8128]

Faster Imperative Version

{{trans|Algol}}

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

{{out}}

[6, 28, 496, 8128]

With a 33_550_337.iota it outputs:

[6, 28, 496, 8128, 33550336]

Dart

Explicit Iterative Version

/*
 * Function to test if a number is a perfect number
 * A number is a perfect number if it is equal to the sum of all its divisors
 * Input: Positive integer n
 * Output: true if n is a perfect number, false otherwise
 */
bool isPerfect(int n){
    //Generate a list of integers in the range 1 to n-1 : [1, 2, ..., n-1]
    List<int> range = new List<int>.generate(n-1, (int i) => i+1);

    //Create a list that filters the divisors of n from range
    List<int> divisors = new List.from(range.where((i) => n%i == 0));

    //Sum the all the divisors
    int sumOfDivisors = 0;
    for (int i = 0; i < divisors.length; i++){
        sumOfDivisors = sumOfDivisors + divisors[i];
    }

    // A number is a perfect number if it is equal to the sum of its divisors
    // We return the test if n is equal to sumOfDivisors
    return n == sumOfDivisors;
}

Compact Version

{{trans|Julia}}

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

In either case, if we test to find all the perfect numbers up to 1000, we get:

main() =>
    new List.generate(1000,(i)=>i+1).where(isPerfect).forEach(print);

{{out}}

6
28
496

Dyalect

func isPerfect(num) {
    var sum = 0
    for i in 1..(num - 1) {
        if !i {
            break
        }
        if num % i == 0 {
            sum += i
        }
    }
    return sum == num
}

const max = 33550337
print("Perfect numbers from 0 to \(max):")

for x in 0..max {
    if isPerfect(x) {
        print("\(x) is perfect")
    }
}

E

pragma.enable("accumulator")
def isPerfectNumber(x :int) {
  var sum := 0
  for d ? (x % d <=> 0) in 1..!x {
    sum += d
    if (sum > x) { return false }
  }
  return sum <=> x
}

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

{{out}}

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

Elena

ELENA 4.x:

import system'routines;
import system'math;
import extensions;

extension extension
{
    isPerfect()
        = new Range(1, self - 1).selectBy:(n => (self.mod:n == 0).iif(n,0) ).summarize(new Integer()) == self;
}

public program()
{
    for(int n := 1, n < 10000, n += 1)
    {
        if(n.isPerfect())
            { console.printLine(n," is perfect") }
    };

    console.readChar()
}

{{out}}

6 is perfect
28 is perfect
496 is perfect
8128 is perfect

Elixir

defmodule RC do
  def is_perfect(1), do: false
  def is_perfect(n) when n > 1 do
    Enum.sum(factor(n, 2, [1])) == n
  end

  defp factor(n, i, factors) when n <  i*i   , do: factors
  defp factor(n, i, factors) when n == i*i   , do: [i | factors]
  defp factor(n, i, factors) when rem(n,i)==0, do: factor(n, i+1, [i, div(n,i) | factors])
  defp factor(n, i, factors)                 , do: factor(n, i+1, factors)
end

IO.inspect (for i <- 1..10000, RC.is_perfect(i), do: i)

{{out}}

[6, 28, 496, 8128]

Erlang

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

ERRE

PROGRAM PERFECT

PROCEDURE PERFECT(N%->OK%)
      LOCAL I%,S%
      S%=1
      FOR I%=2 TO SQR(N%)-1 DO
        IF N% MOD I%=0 THEN S%+=I%+N% DIV I%
      END FOR
      IF I%=SQR(N%) THEN S%+=I%
      OK%=(N%=S%)
END PROCEDURE

BEGIN
    PRINT(CHR$(12);) ! CLS
    FOR N%=2 TO 10000 STEP 2 DO
       PERFECT(N%->OK%)
       IF OK% THEN PRINT(N%)
    END FOR
END PROGRAM

{{Out}}

         6
        28
       496
      8128

=={{header|F_Sharp|F#}}==

let perf n = n = List.fold (+) 0 (List.filter (fun i -> n % i = 0) [1..(n-1)])

for i in 1..10000 do if (perf i) then printfn "%i is perfect" i

{{Out}}

6 is perfect
28 is perfect
496 is perfect
8128 is perfect

FALSE

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

Factor

USING: kernel math math.primes.factors sequences ;
IN: rosettacode.perfect-numbers

: perfect? ( n -- ? )  [ divisors sum ] [ 2 * ] bi = ;

Forth

: perfect? ( n -- ? )
  1
  over 2/ 1+ 2 ?do
    over i mod 0= if i + then
  loop
  = ;

Fortran

{{works with|Fortran|90 and later}}

FUNCTION isPerfect(n)
  LOGICAL :: isPerfect
  INTEGER, INTENT(IN) :: n
  INTEGER :: i, factorsum

  isPerfect = .FALSE.
  factorsum = 1
  DO i = 2, INT(SQRT(REAL(n)))
     IF(MOD(n, i) == 0) factorsum = factorsum + i + (n / i)
  END DO
  IF (factorsum == n) isPerfect = .TRUE.
END FUNCTION isPerfect

FreeBASIC

{{trans|C (with some modifications)}}

' 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

{{out}}

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

FunL

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

println( (1..500).filter(perfect) )

{{out}}

(6, 28, 496)

GAP

Filtered([1 .. 10000], n -> Sum(DivisorsInt(n)) = 2*n);
# [ 6, 28, 496, 8128 ]

Go

package main

import "fmt"

func computePerfect(n int64) bool {
    var sum int64
    for i := int64(1); i < n; i++ {
        if n%i == 0 {
            sum += i
        }
    }
    return sum == n
}

// following function satisfies the task, returning true for all
// perfect numbers representable in the argument type
func isPerfect(n int64) bool {
    switch n {
    case 6, 28, 496, 8128, 33550336, 8589869056,
        137438691328, 2305843008139952128:
        return true
    }
    return false
}

// validation
func main() {
    for n := int64(1); ; n++ {
        if isPerfect(n) != computePerfect(n) {
            panic("bug")
        }
        if n%1e3 == 0 {
            fmt.Println("tested", n)
        }
    }
}

{{Out}}

tested 1000
tested 2000
tested 3000
...

Groovy

Solution:

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

Test program:

(0..10000).findAll { isPerfect(it) }.each { println it }

{{Out}}

6
28
496
8128

Haskell

perfect n =
    n == sum [i | i <- [1..n-1], n `mod` i == 0]

Create a list of known perfects:

perfect =
  (\x -> (2 ^ x - 1) * (2 ^ (x - 1))) <$>
  filter (\x -> isPrime x && isPrime (2 ^ x - 1)) maybe_prime
  where
    maybe_prime = scanl1 (+) (2 : 1 : cycle [2, 2, 4, 2, 4, 2, 4, 6])
    isPrime n = all ((/= 0) . (n `mod`)) $ takeWhile (\x -> x * x <= n) maybe_prime

isPerfect n = f n perfect
  where
    f n (p:ps) =
      case compare n p of
        EQ -> True
        LT -> False
        GT -> f n ps

main :: IO ()
main = do
  mapM_ print $ take 10 perfect
  mapM_ (print . (\x -> (x, isPerfect x))) [6, 27, 28, 29, 496, 8128, 8129]

or, restricting the search space to improve performance:

isPerfect :: Int -> Bool
isPerfect n =
  let lows = filter ((0 ==) . rem n) [1 .. floor (sqrt (fromIntegral n))]
  in 1 < n &&
     n ==
     quot
       (sum
          (lows ++
           [ y
           | x <- lows
           , let y = quot n x
           , x /= y ]))
       2

main :: IO ()
main = print $ filter isPerfect [1 .. 10000]

{{Out}}

[6,28,496,8128]

HicEst

   DO i = 1, 1E4
      IF( perfect(i) ) WRITE() i
   ENDDO
END ! end of "main"

FUNCTION perfect(n)
   sum = 1
   DO i = 2, n^0.5
      sum = sum + (MOD(n, i) == 0) * (i + INT(n/i))
   ENDDO
   perfect = sum == n
END

=={{header|Icon}} and {{header|Unicon}}==

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

{{libheader|Icon Programming Library}} [http://www.cs.arizona.edu/icon/library/src/procs/factors.icn Uses divisors from factors]

{{Out}}

Perfect numbers from 1 to 100000:
6
28
496
8128
Done.

J

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

Examples of use, including extensions beyond those assumptions:

   is_perfect 33550336
1
   I. is_perfect i. 100000
6 28 496 8128

   ] zero_through_twentynine =. i. 3 10
 0  1  2  3  4  5  6  7  8  9
10 11 12 13 14 15 16 17 18 19
20 21 22 23 24 25 26 27 28 29
   is_perfect zero_through_twentynine
0 0 0 0 0 0 1 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 1 0
   is_perfect 191561942608236107294793378084303638130997321548169216x
1

More efficient version based on [http://jsoftware.com/pipermail/programming/2014-June/037695.html comments] by Henry Rich and Roger Hui (comment train seeded by Jon Hough).

Java

public static boolean perf(int n){
	int sum= 0;
	for(int i= 1;i < n;i++){
		if(n % i == 0){
			sum+= i;
		}
	}
	return sum == n;
}

Or for arbitrary precision:[[Category:Arbitrary precision]]

import java.math.BigInteger;

public static boolean perf(BigInteger n){
	BigInteger sum= BigInteger.ZERO;
	for(BigInteger i= BigInteger.ONE;
	i.compareTo(n) < 0;i=i.add(BigInteger.ONE)){
		if(n.mod(i).equals(BigInteger.ZERO)){
			sum= sum.add(i);
		}
	}
	return sum.equals(n);
}

JavaScript

Imperative

{{trans|Java}}

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

{{Out}}

6
28
496
8128

Functional

=ES5=

Naive version (brute force)

(function (nFrom, nTo) {

  function perfect(n) {
    return n === range(1, n - 1).reduce(
      function (a, x) {
        return n % x ? a : a + x;
      }, 0
    );
  }

  function range(m, n) {
    return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
      return m + i;
    });
  }

  return range(nFrom, nTo).filter(perfect);

})(1, 10000);

Output:

[6, 28, 496, 8128]

Much faster (more efficient factorisation)

(function (nFrom, nTo) {

  function perfect(n) {
    var lows = range(1, Math.floor(Math.sqrt(n))).filter(function (x) {
      return (n % x) === 0;
    });

    return n > 1 && lows.concat(lows.map(function (x) {
      return n / x;
    })).reduce(function (a, x) {
      return a + x;
    }, 0) / 2 === n;
  }

  function range(m, n) {
    return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
      return m + i;
    });
  }

  return range(nFrom, nTo).filter(perfect)

})(1, 10000);

Output:

[6, 28, 496, 8128]

Note that the filter function, though convenient and well optimised, is not strictly necessary. We can always replace it with a more general monadic bind (chain) function, which is essentially just concat map (Monadic return/inject for lists is simply lambda x --> [x], inlined here, and fail is [].)

(function (nFrom, nTo) {

  // MONADIC CHAIN (bind) IN LIEU OF FILTER
  // ( monadic return for lists is just lambda x -> [x] )

  return chain(
    rng(nFrom, nTo),

    function mPerfect(n) {
      return (chain(
        rng(1, Math.floor(Math.sqrt(n))),
        function (y) {
          return (n % y) === 0 && n > 1 ? [y, n / y] : [];
        }
      ).reduce(function (a, x) {
        return a + x;
      }, 0) / 2 === n) ? [n] : [];
    }

  );

  /******************************************************************/

  // Monadic bind (chain) for lists
  function chain(xs, f) {
    return [].concat.apply([], xs.map(f));
  }

  function rng(m, n) {
    return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
      return m + i;
    });
  }

})(1, 10000);

Output:

[6, 28, 496, 8128]

=ES6=

(() => {
    const main = () =>
        enumFromTo(1, 10000).filter(perfect);

    // perfect :: Int -> Bool
    const perfect = n => {
        const
            lows = enumFromTo(1, Math.floor(Math.sqrt(n)))
            .filter(x => (n % x) === 0);

        return n > 1 && lows.concat(lows.map(x => n / x))
            .reduce((a, x) => (a + x), 0) / 2 === n;
    };

    // GENERIC --------------------------------------------

    // enumFromTo :: Int -> Int -> [Int]
    const enumFromTo = (m, n) =>
        Array.from({
            length: n - m + 1
        }, (_, i) => i + m)

    // MAIN ---
    return main();
})();

{{Out}}

[6, 28, 496, 8128]

jq

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

# Example:
range(1;10001) | select( is_perfect )

{{Out}} $ jq -n -f is_perfect.jq 6 28 496 8128

Julia

{{works with|Julia|0.6}}

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)

{{out}}

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

K

{{trans|J}}

   perfect:{(x>2)&x=+/-1_{d:&~x!'!1+_sqrt x;d,_ x%|d}x}
   perfect 33550336
1

   a@&perfect'a:!10000
6 28 496 8128

   m:3 10#!30
(0 1 2 3 4 5 6 7 8 9
 10 11 12 13 14 15 16 17 18 19
 20 21 22 23 24 25 26 27 28 29)

   perfect'/: m
(0 0 0 0 0 0 1 0 0 0
 0 0 0 0 0 0 0 0 0 0
 0 0 0 0 0 0 0 0 1 0)

Kotlin

{{trans|C}}

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

{{out}}

The first five perfect numbers are:
6 28 496 8128 33550336

LabVIEW

{{VI solution|LabVIEW_Perfect_numbers.png}}

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

{{Out}}

6, 28, 496, 8128

Liberty BASIC

for n =1 to 10000
    if perfect( n) =1 then print n; " is perfect."
next n

end

function perfect( n)
    sum =0
    for i =1 TO n /2
        if n mod i =0 then
            sum =sum +i
        end if
    next i
    if sum =n then
        perfect= 1
    else
        perfect =0
    end if
end function

Lingo

on isPercect (n)
  sum = 1
  cnt = n/2
  repeat with i = 2 to cnt
    if n mod i = 0 then sum = sum + i
  end repeat
  return sum=n
end

Logo

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

Lua

function isPerfect(x)
    local sum = 0
    for i = 1, x-1 do
	sum = (x % i) == 0 and sum + i or sum
    end
    return sum == x
end

M2000 Interpreter

Module PerfectNumbers {
      Function Is_Perfect(n as decimal) {
            s=1 : sN=Sqrt(n)
            last= n=sN*sN
            t=n
            If n mod 2=0 then s+=2+n div 2
            i=3 : sN--
            While i<sN {
            if  n mod i=0 then t=n div i :i=max.data(n div t, i): s+=t+ i
            i++
            }
            =n=s
      }
      Inventory Known1=2@, 3@
      IsPrime=lambda  Known1 (x as decimal) -> {
                  =0=1
                  if exist(Known1, x) then =1=1 : exit
                  if x<=5 OR frac(x) then {if x == 2 OR x == 3 OR x == 5 then Append Known1, x  : =1=1
                  Break}
                  if frac(x/2) else exit
                  if frac(x/3) else exit
                  x1=sqrt(x):d = 5@
                  {if frac(x/d ) else exit
                        d += 2: if d>x1 then Append Known1, x : =1=1 : exit
                        if frac(x/d) else exit
                        d += 4: if d<= x1 else Append Known1, x :  =1=1: exit
                   loop}
            }
      \\ Check a perfect and a non perfect number
      p=2 : n=3 : n1=2
      Document Doc$
      IsPerfect( 0, 28)
      IsPerfect( 0, 1544)
      While p<32  { ' max 32
            if isprime(2^p-1@) then {
                   perf=(2^p-1@)*2@^(p-1@)
                   Rem  Print perf
                   \\ decompose pretty fast the Perferct Numbers
                   \\ all have a series of 2 and last a prime equal to perf/2^(p-1)
                   inventory queue factors
                   For i=1 to p-1 {
                         Append factors, 2@
                  }
                  Append factors, perf/2^(p-1)
                  \\ end decompose
                  Rem Print factors
                  IsPerfect(factors, Perf)
            }
            p++
      }

      Clipboard Doc$
      \\ exit here. No need for Exit statement
      Sub IsPerfect(factors, n)
            s=false
            if n<10000 or type$(factors)<>"Inventory" then {
                  s=Is_Perfect(n)
            } else {
                  local mm=each(factors, 1, -2), f =true
                  while mm {if eval(mm)<>2 then f=false
                  }
                  if f then if n/2@**(len(mm)-1)= factors(len(factors)-1!) then s=true
            }
            Local a$=format$("{0} is {1}perfect number", n, If$(s->"", "not "))
            Doc$=a$+{
            }
            Print a$
      End Sub
}

PerfectNumbers

{{out}}

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