Perfect numbers

From Rosetta Code
(Redirected from Perfect Numbers)
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).

See also


Ada[edit]

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

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
PROC is perfect = (INT candidate)BOOL: (
INT sum :=1;
FOR f1 FROM 2 TO ENTIER ( sqrt(candidate)*(1+2*small real) ) WHILE
IF candidate MOD f1 = 0 THEN
sum +:= f1;
INT f2 = candidate OVER f1;
IF f2 > f1 THEN
sum +:= f2
FI
FI;
# WHILE # sum <= candidate DO
SKIP
OD;
sum=candidate
);
 
test:(
FOR i FROM 2 TO 33550336 DO
IF is perfect(i) THEN print((i, new line)) FI
OD
)
Output:
         +6
        +28
       +496
      +8128
  +33550336

AutoHotkey[edit]

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

$ 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[edit]

Translation of: 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() : with
perfect?: Integer -> Boolean
==
add
import IntegerNumberTheoryFunctions
perfect? n == reduce("+",divisors n) = 2*n

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

perfect? 496
perfect? 128
[i for i in 1..10000 | perfect? i]
Output:
true
false
[6,28,496,8128]

BASIC[edit]

Works with: QuickBasic version 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

BBC BASIC[edit]

BASIC version[edit]

      FOR n% = 2 TO 10000 STEP 2
IF FNperfect(n%) PRINT n%
NEXT
END
 
DEF FNperfect(N%)
LOCAL I%, S%
S% = 1
FOR I% = 2 TO SQR(N%)-1
IF N% MOD I% = 0 S% += I% + N% DIV I%
NEXT
IF I% = SQR(N%) S% += I%
= (N% = S%)
Output:
         6
        28
       496
      8128

Assembler version[edit]

      DIM P% 100
[OPT 2 :.S% xor edi,edi
.perloop mov eax,ebx : cdq : div ecx : or edx,edx : loopnz perloop : inc ecx
add edi,ecx : add edi,eax : loop perloop : mov eax,edi : shr eax,1 : ret : ]
 
FOR B% = 2 TO 35000000 STEP 2
C% = SQRB%
IF B% = USRS% PRINT B%
NEXT
END
Output:
         4
         6
        28
       496
      8128
  33550336

Bracmat[edit]

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

C[edit]

Translation of: 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#[edit]

Translation of: 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[edit]

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++[edit]

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

(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))
Translation of: Haskell
(defn perfect? [n]
(->> (for [i (range 1 n)] :when (zero? (rem n i))] i)
(reduce +)
(= n)))

CoffeeScript[edit]

Optimized version, for fun.

is_perfect_number = (n) ->
do_factors_add_up_to n, 2*n
 
do_factors_add_up_to = (n, desired_sum) ->
# We mildly optimize here, by taking advantage of
# the fact that the sum_of_factors( (p^m) * x)
# is (1 + ... + p^m-1 + p^m) * sum_factors(x) when
# x is not itself a multiple of p.
 
p = smallest_prime_factor(n)
if p == n
return desired_sum == p + 1
 
# ok, now sum up all powers of p that
# divide n
sum_powers = 1
curr_power = 1
while n % p == 0
curr_power *= p
sum_powers += curr_power
n /= p
 
# if desired_sum does not divide sum_powers, we
# can short circuit quickly
return false unless desired_sum % sum_powers == 0
 
# otherwise, recurse
do_factors_add_up_to n, desired_sum / sum_powers
 
smallest_prime_factor = (n) ->
for i in [2..n]
return n if i*i > n
return i if n % i == 0
 
# tests
do ->
# This is pretty fast...
for n in [2..100000]
console.log n if is_perfect_number n
 
# For big numbers, let's just sanity check the known ones.
known_perfects = [
33550336
8589869056
137438691328
]
for n in known_perfects
throw Error("fail") unless is_perfect_number(n)
throw Error("fail") if is_perfect_number(n+1)
Output:
> coffee perfect_numbers.coffee 
6
28
496
8128

COBOL[edit]

Translation of: 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[edit]

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

D[edit]

Functional Version[edit]

import std.stdio, std.algorithm, std.range;
 
bool isPerfectNumber1(in uint n) pure nothrow
in {
assert(n > 0);
} body {
return n == iota(1, n - 1).filter!(i => n % i == 0).sum;
}
 
void main() {
iota(1, 10_000).filter!isPerfectNumber1.writeln;
}
Output:
[6, 28, 496, 8128]

Faster Imperative Version[edit]

Translation of: 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;
}
Output:
[6, 28, 496, 8128]

With a 33_550_337.iota it outputs:

[6, 28, 496, 8128, 33550336]

Dart[edit]

Explicit Iterative Version[edit]

/*
* 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[edit]

Translation of: 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);
Output:
6
28
496

E[edit]

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

 
class
APPLICATION
 
create
make
 
feature
 
make
do
io.put_string (" 6 is perfect...%T")
io.put_boolean (is_perfect_number (6))
io.new_line
io.put_string (" 77 is perfect...%T")
io.put_boolean (is_perfect_number (77))
io.new_line
io.put_string ("128 is perfect...%T")
io.put_boolean (is_perfect_number (128))
io.new_line
io.put_string ("496 is perfect...%T")
io.put_boolean (is_perfect_number (496))
end
 
is_perfect_number (n: INTEGER): BOOLEAN
-- Is 'n' a perfect number?
require
n_positive: n > 0
local
sum: INTEGER
do
across
1 |..| (n - 1) as c
loop
if n \\ c.item = 0 then
sum := sum + c.item
end
end
Result := sum = n
end
 
end
 
Output:
  6 is perfect...      True
 77 is perfect...      False
128 is perfect...      False
496 is perfect...      True

Elena[edit]

#import system.
#import system'routines.
#import system'math.
#import extensions.
 
#class(extension)extension
{
#method is &perfect
= 1 repeat &till:self &each: n [ (self mod:n == 0) iif:n:0 ] summarize:(Integer new) == self.
}
 
#symbol program =
[
1 till:10000 &doEach: n
[
(n is &perfect)
 ? [ console writeLine:n:" is perfect". ].
].
 
console readChar.
].

Elixir[edit]

defmodule RC do
def is_perfect(1), do: false
def is_perfect(n) when n > 1 do
Enum.sum(factor(n, 2, [1])) == n
end
 
defp factor(n, i, factors) when n < i*i , do: factors
defp factor(n, i, factors) when n == i*i , do: [i | factors]
defp factor(n, i, factors) when rem(n,i)==0, do: factor(n, i+1, [i, div(n,i) | factors])
defp factor(n, i, factors) , do: factor(n, i+1, factors)
end
 
IO.inspect (for i <- 1..10000, RC.is_perfect(i), do: i)
Output:
[6, 28, 496, 8128]

Erlang[edit]

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

ERRE[edit]

PROGRAM PERFECT
 
PROCEDURE PERFECT(N%->OK%)
LOCAL I%,S%
S%=1
FOR I%=2 TO SQR(N%)-1 DO
IF N% MOD I%=0 THEN S%+=I%+N% DIV I%
END FOR
IF I%=SQR(N%) THEN S%+=I%
OK%=(N%=S%)
END PROCEDURE
 
BEGIN
PRINT(CHR$(12);) ! CLS
FOR N%=2 TO 10000 STEP 2 DO
PERFECT(N%->OK%)
IF OK% THEN PRINT(N%)
END FOR
END PROGRAM
Output:
         6
        28
       496
      8128

F#[edit]

let perf n = n = List.fold (+) 0 (List.filter (fun i -> n % i = 0) [1..(n-1)])
 
for i in 1..10000 do if (perf i) then printfn "%i is perfect" i
Output:
6 is perfect
28 is perfect
496 is perfect
8128 is perfect

FALSE[edit]

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

Factor[edit]

USING: kernel math math.primes.factors sequences ;
IN: rosettacode.perfect-numbers
 
: perfect? ( n -- ? ) [ divisors sum ] [ 2 * ] bi = ;

Forth[edit]

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

Fortran[edit]

Works with: Fortran version 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

FunL[edit]

def perfect( n ) = sum( d | d <- 1..n if d|n ) == 2n
 
println( (1..500).filter(perfect) )
Output:
(6, 28, 496)

GAP[edit]

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

Go[edit]

package main
 
import "fmt"
 
func computePerfect(n int64) bool {
var sum int64
for i := int64(1); i < n; i++ {
if n%i == 0 {
sum += i
}
}
return sum == n
}
 
// following function satisfies the task, returning true for all
// perfect numbers representable in the argument type
func isPerfect(n int64) bool {
switch n {
case 6, 28, 496, 8128, 33550336, 8589869056,
137438691328, 2305843008139952128:
return true
}
return false
}
 
// validation
func main() {
for n := int64(1); ; n++ {
if isPerfect(n) != computePerfect(n) {
panic("bug")
}
if n%1e3 == 0 {
fmt.Println("tested", n)
}
}
}
 
 
Output:
tested 1000
tested 2000
tested 3000
...

Groovy[edit]

Solution:

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

Test program:

(0..10000).findAll { isPerfect(it) }.each { println it }
Output:
6
28
496
8128

Haskell[edit]

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

Create a list of known perfects:

perfect = map (\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 = do
mapM_ print $ take 10 perfect
mapM_ print $ map (\x -> (x, isPerfect x)) [6,27,28,29,496,8128,8129]

HicEst[edit]

   DO i = 1, 1E4
IF( perfect(i) ) WRITE() i
ENDDO
END ! end of "main"
 
FUNCTION perfect(n)
sum = 1
DO i = 2, n^0.5
sum = sum + (MOD(n, i) == 0) * (i + INT(n/i))
ENDDO
perfect = sum == n
END

Icon and Unicon[edit]

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
Uses divisors from factors
Output:
Perfect numbers from 1 to 100000:
6
28
496
8128
Done.

J[edit]

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

Examples of use, including extensions beyond those assumptions:

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

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

Java[edit]

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

Or for arbitrary precision:

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

JavaScript[edit]

Imperative[edit]

Translation of: 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);
}
Output:
6
28
496
8128

Functional (ES5)[edit]

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]

jq[edit]

 
def is_perfect:
. as $in
| $in == reduce range(1;$in) as $i
(0; if ($in % $i) == 0 then $i + . else . end);
 
# Example:
range(1;10001) | select( is_perfect )
Output:
$ jq -n -f is_perfect.jq
6
28
496
8128

Julia[edit]

function isperfect(n)
n == sum([n % i == 0 ? i : 0 for i = 1:n-1])
end
Output:
julia> filter(isperfect, 1:10000)
4-element Int64 Array:
    6
   28
  496
 8128

K[edit]

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

LabVIEW[edit]

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.
LabVIEW Perfect numbers.png

Lasso[edit]

#!/usr/bin/lasso9
 
define isPerfect(n::integer) => {
#n < 2 ? return false
return #n == (
with i in generateSeries(1, math_floor(math_sqrt(#n)) + 1)
where #n % #i == 0
let q = #n / #i
sum (#q > #i ? (#i == 1 ? 1 | #q + #i) | 0)
)
}
 
with x in generateSeries(1, 10000)
where isPerfect(#x)
select #x
Output:
6, 28, 496, 8128

Liberty BASIC[edit]

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

[edit]

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

Lua[edit]

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

M4[edit]

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

Mathematica / Wolfram Language[edit]

Custom function:

PerfectQ[i_Integer] := Total[Divisors[i]] == 2 i

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

PerfectQ[496]
PerfectQ[128]
Flatten[[email protected][10000]//Position[#,True]&]

gives back:

True
False
{6,28,496,8128}

MATLAB[edit]

Standard algorithm:

function perf = isPerfect(n)
total = 0;
for k = 1:n-1
if ~mod(n, k)
total = total+k;
end
end
perf = total == n;
end

Faster algorithm:

function perf = isPerfect(n)
if n < 2
perf = false;
else
total = 1;
k = 2;
quot = n;
while k < quot && total <= n
if ~mod(n, k)
total = total+k;
quot = n/k;
if quot ~= k
total = total+quot;
end
end
k = k+1;
end
perf = total == n;
end
end

Maxima[edit]

".."(a, b) := makelist(i, i, a, b)$
infix("..")$
 
perfectp(n) := is(divsum(n) = 2*n)$
 
sublist(1 .. 10000, perfectp);
/* [6, 28, 496, 8128] */

MAXScript[edit]

fn isPerfect n =
(
local sum = 0
for i in 1 to (n-1) do
(
if mod n i == 0 then
(
sum += i
)
)
sum == n
)

Nim[edit]

import math
 
proc isPerfect(n: int): bool =
var sum: int = 1
for i in 2 .. <(n.toFloat.sqrt+1).toInt:
if n mod i == 0:
sum += (i + n div i)
return (n == sum)
 
for i in 2..10_000:
if isPerfect(i):
echo(i)

Objeck[edit]

bundle Default {  
class Test {
function : Main(args : String[]) ~ Nil {
"Perfect numbers from 1 to 33550337:"->PrintLine();
for(num := 1 ; num < 33550337; num += 1;) {
if(IsPerfect(num)) {
num->PrintLine();
};
};
}
 
function : native : IsPerfect(number : Int) ~ Bool {
sum := 0 ;
for(i := 1; i < number; i += 1;) {
if (number % i = 0) {
sum += i;
};
};
 
return sum = number;
}
}
}

OCaml[edit]

let perf n =
let sum = ref 0 in
for i = 1 to n-1 do
if n mod i = 0 then
sum := !sum + i
done;
!sum = n

Functional style:

(* range operator *)
let rec (--) a b =
if a > b then
[]
else
a :: (a+1) -- b
 
let perf n = n = List.fold_left (+) 0 (List.filter (fun i -> n mod i = 0) (1 -- (n-1)))


Oforth[edit]

: isPerfect(n) { | i | 0 n 2 / loop: i [ n i mod ifZero: [ i + ] ] n == } 
Output:
10000 seq filter(#isPerfect) println
[6, 28, 496, 8128]

ooRexx[edit]

-- first perfect number over 10000 is 33550336...let's not be crazy
loop i = 1 to 10000
if perfectNumber(i) then say i "is a perfect number"
end
 
::routine perfectNumber
use strict arg n
 
sum = 0
 
-- the largest possible factor is n % 2, so no point in
-- going higher than that
loop i = 1 to n % 2
if n // i == 0 then sum += i
end
 
return sum = n
Output:
6 is a perfect number
28 is a perfect number
496 is a perfect number
8128 is a perfect number

Oz[edit]

declare
fun {IsPerfect N}
fun {IsNFactor I} N mod I == 0 end
Factors = {Filter {List.number 1 N-1 1} IsNFactor}
in
{Sum Factors} == N
end
 
fun {Sum Xs} {FoldL Xs Number.'+' 0} end
in
{Show {Filter {List.number 1 10000 1} IsPerfect}}
{Show {IsPerfect 33550336}}

PARI/GP[edit]

Uses built-in method. Faster tests would use the LL test for evens and myriad results on OPNs otherwise.

isPerfect(n)=sigma(n,-1)==2

Show perfect numbers

forprime(p=2, 2281,
if(isprime(2^p-1),
print(p"\t",(2^p-1)*2^(p-1))))

Faster with Lucas-Lehmer test

p=2;n=3;n1=2;
while(p<2281,
if(isprime(p),
s=Mod(4,n);
for(i=3,p,
s=s*s-2);
if(s==0 || p==2,
print("(2^"p"-1)2^("p"-1)=\t"n1*n"\n")));
p++; n1=n+1; n=2*n+1)
Output:
(2^2-1)2^(2-1)= 6
(2^3-1)2^(3-1)= 28
(2^5-1)2^(5-1)= 496
(2^7-1)2^(7-1)= 8128
(2^13-1)2^(13-1)=       33550336
(2^17-1)2^(17-1)=       8589869056
(2^19-1)2^(19-1)=       137438691328
(2^31-1)2^(31-1)=       2305843008139952128
(2^61-1)2^(61-1)=       2658455991569831744654692615953842176
(2^89-1)2^(89-1)=       191561942608236107294793378084303638130997321548169216

Pascal[edit]

program PerfectNumbers;
 
function isPerfect(number: longint): boolean;
var
i, sum: longint;
 
begin
sum := 1;
for i := 2 to round(sqrt(real(number))) do
if (number mod i = 0) then
sum := sum + i + (number div i);
isPerfect := (sum = number);
end;
 
var
candidate: longint;
 
begin
writeln('Perfect numbers from 1 to 33550337:');
for candidate := 2 to 33550337 do
if isPerfect(candidate) then
writeln (candidate, ' is a perfect number.');
end.
Output:
Perfect numbers from 1 to 33550337:
6 is a perfect number.
28 is a perfect number.
496 is a perfect number.
8128 is a perfect number.
33550336 is a perfect number.

Perl[edit]

Functions[edit]

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

Functional style:

use List::Util qw(sum);
 
sub perf {
my $n = shift;
$n == sum(0, grep {$n % $_ == 0} 1..$n-1);
}

Modules[edit]

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:

use ntheory qw/divisor_sum/;
sub is_perfect { my $n = shift; divisor_sum($n) == 2*$n; }

Use this naive method to show the first 5. Takes about 15 seconds:

use ntheory qw/divisor_sum/;
for (1..33550336) {
print "$_\n" if divisor_sum($_) == 2*$_;
}

Or we can be clever and look for 2^(p-1) * (2^p-1) where 2^p -1 is prime. The first 20 takes about a second.

use ntheory qw/forprimes is_prime/;
use bigint;
forprimes {
my $n = 2**$_ - 1;
print "$_\t", $n * 2**($_-1),"\n" if is_prime($n);
} 2, 4500;
Output:
2	6
3	28
5	496
7	8128
13	33550336
17	8589869056
19	137438691328
31	2305843008139952128
61	2658455991569831744654692615953842176
89	191561942608236107294793378084303638130997321548169216
... 107, 127, 521, 607, 1279, 2203, 2281, 3217, 4253, 4423 ...

We can speed this up even more using a faster program for printing the large results, as well as a faster primality solution. The first 38 in about 1 second with most of the time printing the large results. Caveat: this goes well past the current bound for odd perfect numbers and does not check for them.

use ntheory qw/forprimes is_mersenne_prime/;
use Math::GMP qw/:constant/;
forprimes {
print "$_\t", (2**$_-1)*2**($_-1),"\n" if is_mersenne_prime($_);
} 7_000_000;

Perl 6[edit]

sub perf($n) { $n == [+] grep $n %% *, 1 .. $n div 2 }

Phix[edit]

function is_perfect(integer n)
return sum(factors(n,-1))=n
end function
 
for i=2 to 100000 do
if is_perfect(i) then ?i end if
end for
Output:
6
28
496
8128

PHP[edit]

Translation of: C++
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;
}

PicoLisp[edit]

(de perfect (N)
(let C 0
(for I (/ N 2)
(and (=0 (% N I)) (inc 'C I)) )
(= C N) ) )
(de faster (N)
(let (C 1 Stop (sqrt N))
(for (I 2 (<= I Stop) (inc I))
(and
(=0 (% N I))
(inc 'C (+ (/ N I) I)) ) )
(= C N) ) )

PL/I[edit]

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;

PowerShell[edit]

Function IsPerfect($n)
{
$sum=0
for($i=1;$i-lt$n;$i++)
{
if($n%$i -eq 0)
{
$sum += $i
}
}
return $sum -eq $n
}
 
Returns "True" if the given number is perfect and "False" if it's not.

Prolog[edit]

Classic approach[edit]

Works with SWI-Prolog

tt_divisors(X, N, TT) :-
Q is X / N,
( 0 is X mod N -> (Q = N -> TT1 is N + TT;
TT1 is N + Q + TT);
TT = TT1),
( sqrt(X) > N + 1 -> N1 is N+1, tt_divisors(X, N1, TT1);
TT1 = X).
 
perfect(X) :-
tt_divisors(X, 2, 1).
 
perfect_numbers(N, L) :-
numlist(2, N, LN),
include(perfect, LN, L).

Functional approach[edit]

Works with SWI-Prolog and module lambda, written by Ulrich Neumerkel found there http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl

:- use_module(library(lambda)).
 
is_divisor(V, N) :-
0 =:= V mod N.
 
is_perfect(N) :-
N1 is floor(N/2),
numlist(1, N1, L),
f_compose_1(foldl((\X^Y^Z^(Z is X+Y)), 0), filter(is_divisor(N)), F),
call(F, L, N).
 
f_perfect_numbers(N, L) :-
numlist(2, N, LN),
filter(is_perfect, LN, L).
 
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% functionnal predicates
 
%% foldl(Pred, Init, List, R).
%
foldl(_Pred, Val, [], Val).
foldl(Pred, Val, [H | T], Res) :-
call(Pred, Val, H, Val1),
foldl(Pred, Val1, T, Res).
 
%% filter(Pred, LstIn, LstOut)
%
filter(_Pre, [], []).
 
filter(Pred, [H|T], L) :-
filter(Pred, T, L1),
( call(Pred,H) -> L = [H|L1]; L = L1).
 
%% f_compose_1(Pred1, Pred2, Pred1(Pred2)).
%
f_compose_1(F,G, \X^Z^(call(G,X,Y), call(F,Y,Z))).

PureBasic[edit]

Procedure is_Perfect_number(n)
Protected summa, i=1, result=#False
Repeat
If Not n%i
summa+i
EndIf
i+1
Until i>=n
If summa=n
result=#True
EndIf
ProcedureReturn result
EndProcedure

Python[edit]

def perf(n):
sum = 0
for i in xrange(1, n):
if n % i == 0:
sum += i
return sum == n

Functional style:

perf = lambda n: n == sum(i for i in xrange(1, n) if n % i == 0)

R[edit]

is.perf <- function(n){
if (n==0|n==1) return(FALSE)
s <- seq (1,n-1)
x <- n %% s
m <- data.frame(s,x)
out <- with(m, s[x==0])
return(sum(out)==n)
}
# Usage - Warning High Memory Usage
is.perf(28)
sapply(c(6,28,496,8128,33550336),is.perf)

Racket[edit]

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

REBOL[edit]

perfect?:  func [n [integer!] /local sum] [
sum: 0
repeat i (n - 1) [
if zero? remainder n i [
sum: sum + i
]
]
sum = n
]

REXX[edit]

Classic REXX version of ooRexx[edit]

This version is a Classic Rexx version of the ooRexx program as of 14-Sep-2013.

/*REXX version of the  ooRexx  program (the code was modified to run with Classic REXX).*/
do i=1 to 10000 /*statement changed: LOOP ──► DO*/
if perfectNumber(i) then say i "is a perfect number"
end
exit
 
perfectNumber: procedure; parse arg n /*statements changed: ROUTINE,USE*/
sum=0
do i=1 to n%2 /*statement changed: LOOP ──► DO*/
if n//i==0 then sum=sum+i /*statement changed: sum += i */
end
return sum=n

output   when using the default of 10000:

6 is a perfect number
28 is a perfect number
496 is a perfect number
8128 is a perfect number

Classic REXX version of PL/I[edit]

This version is a Classic REXX version of the PL/I program as of 14-Sep-2013,   a REXX   say   statement
was added to display the perfect numbers.   Also, an epilog was written for the re-worked function.

/*REXX version of the  PL/I  program  (code was modified to run with Classic REXX).     */
parse arg low high . /*obtain the specified number(s).*/
if high=='' & low=='' then high=34000000 /*if no args, use a range.*/
if low=='' then low=1 /*if no LOW, then assume unity.*/
if high=='' then high=low /*if no HIGH, then assume LOW. */
 
do i=low to high /*process the single # or range. */
if perfect(i) then say i 'is a perfect number.'
end /*i*/
exit
 
perfect: procedure; parse arg n /*get the number to be tested. */
sum=0 /*the sum of the factors so far. */
do i=1 for n-1 /*starting at 1, find all factors*/
if n//i==0 then sum=sum+i /*I is a factor of N, so add it.*/
end /*i*/
return sum=n /*if the sum matches N, perfect! */

output   when using the input defaults of:   1   10000

The output is the same as for the ooRexx version (above).

traditional method[edit]

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 used when a factor is found
  • testing is stopped if the sum of the factors exceeds   X
/*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. */
if s>x then return 0 /*Is the sum too big? It ain't perfect*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, it's perfect! */

output   when using the default inputs:

       6 is a perfect number.
      28 is a perfect number.
     496 is a perfect number.
    8128 is a perfect number.
33550336 is a perfect number.

For 10,000 numbers tested, this version is   19.6   times faster than the ooRexx program logic.
For 10,000 numbers tested, this version is   25.6   times faster than the   PL/I   program logic.

Note:   For the above timings, only 10,000 numbers were tested.

optimized using digital root[edit]

This REXX version makes use of the fact that all   known   perfect numbers > 6 have a   digital root   of   1.

/*REXX program  tests  if a number  (or a range of numbers)  is/are  perfect.           */
parse arg low high . /*obtain the specified number(s). */
if high=='' & low=='' then high=34000000 /*if no arguments, then use a range. */
if low=='' then low=1 /*if no LOW, then assume unity. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough digits to handle number*/
 
do i=low to high /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure; parse arg x 1 y /*obtain the number to be tested. */
if x==6 then return 1 /*handle the special case of six. */
/*[↓] perfect number's digitalRoot = 1*/
do until y<10 /*find the digital root of Y. */
parse var y r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end /*k*/
y=r /*find digital root of the digit root. */
end /*until*/ /*wash, rinse, repeat ··· */
 
if r\==1 then return 0 /*Digital root ¬ 1? Then ¬ perfect. */
s=1 /*the first factor of X. ___*/
do j=2 while j*j<=x /*starting at 2, find the factors ≤√ X */
if x//j\==0 then iterate /*J isn't a factor of X, so skip it. */
s = s + j + x%j /*··· add it and the other factor. */
if s>x then return 0 /*Is the sum too big? It ain't perfect*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, it's perfect! */

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

optimized using only even numbers[edit]

This REXX version uses the fact that all   known   perfect numbers are   even.

/*REXX program  tests  if a number  (or a range of numbers)  is/are  perfect.           */
parse arg low high . /*obtain optional arguments from the CL*/
if high=='' & low=='' then high=34000000 /*if no argu,ents, 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. */
if s>x then return 0 /*Is the sum too big? It ain't perfect*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if sum matches X, then it's perfect!*/

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

Lucas-Lehmer method[edit]

This version uses memoization to implement a fast version of the Lucas-Lehmer test,
and it's faster than the traditional method by an order of magnitude.

/*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. */
if s>x then return 0 /*Is the sum too big? It ain't perfect*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, it's perfect!*/

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

Lucas-Lehmer + other optimizations[edit]

This version uses the Lucas-Lehmer method, digital roots, and restricts itself to   even   numbers, and
also utilizes a check for the last-two-digits as per François Édouard Anatole Lucas (in 1891).

Also, in the first   do   loop, the index   i   is   fast advanced   according to the last number tested.

An integer square root function was added to limit the factorization of a number.

/*REXX program tests if a number  (or a range of numbers)   is/are  perfect.            */
parse arg low high . /*obtain optional arguments from the CL*/
if high=='' & low=='' then high=34000000 /*No arguments? Then use a range. */
if low=='' then low=1 /*if no LOW, then assume unity. */
low=low+low//2 /*if LOW is odd, bump it by one. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough decimal digits for nums*/
@. =0; @.1=2;  !.=2; _=' 6' /*highest magic number and its index.*/
!._=22;  !.16=12;  !.28=8;  !.36=20;  !.56=20;  !.76=20;  !.96=20
/* [↑] "Lucas' numbers, in 1891. */
do i=low to high by 0 /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
i=i+!.? /*use a fast advance for the DO index. */
end /*i*/ /* [↑] note: the DO index is modified.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure expose @. !. ? /*expose (make global) some variables. */
parse arg x 1 y '' -2  ? /*# (and copy), and the last 2 digits.*/
if x==6 then return 1 /*handle the special case of six. */
if !.?==2 then return 0 /*test last two digits: François Lucas.*/
/*╔═════════════════════════════════════════════╗
║ Lucas─Lehmer know that perfect numbers can ║
║ be expressed as: [2^n -1] * {2^(n-1) } ║
╚═════════════════════════════════════════════╝*/

if @.0<x then do @.1=@.1 while @._<=x; _=(2**@.1-1)*2**(@.1-1); @.0=_; @._=_
end /*@.1*/ /* [↑] uses memoization for formula. */
 
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer? Not perfect*/
/*[↓] perfect numbers digital root = 1*/
do until y<10 /*find the digital root of Y. */
parse var y d 2; do k=2 for length(y)-1; d=d+substr(y,k,1); end /*k*/
y=d /*find digital root of the digital root*/
end /*until*/ /*wash, rinse, repeat ··· */
 
if d\==1 then return 0 /*Is digital root ¬ 1? Then ¬ perfect.*/
s=3 + x%2 /*we know the following factors: unity,*/
z=x /*2, and x÷2 (x is even). */
q=1; do while q<=z; q=q*4 ; end /*while q≤z*/ /* _____*/
r=0 /* [↓] R will be the integer √ X */
do while q>1; q=q%4; _=z-r-q; r=r%2; if _>=0 then do; z=_; r=r+q; end
end /*while q>1*/ /* [↑] compute the integer SQRT of X.*/
/* _____*/
do j=3 to r until s>x /*starting at 3, find factors ≤ √ X */
if x//j==0 then s=s+j+x%j /*J divisible by X? Then add J and X÷J*/
end /*j*/
return s==x /*if the sum matches X, then perfect! */

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

Ring[edit]

 
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
 

Ruby[edit]

def perf(n)
sum = 0
for i in 1...n
sum += i if n % i == 0
end
sum == n
end

Functional style:

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

Faster version:

def perf(n)
divisors = []
for i in 1..Math.sqrt(n)
divisors << i << n/i if n % i == 0
end
divisors.uniq.inject(:+) == 2*n
end

Test:

for n in 1..10000
puts n if perf(n)
end
Output:
6
28
496
8128

Fast (Lucas-Lehmer)[edit]

Generate and memoize perfect numbers as needed.

require "prime"
 
def mersenne_prime_pow?(p)
# Lucas-Lehmer test; expects prime as argument
return true if p == 2
m_p = ( 1 << p ) - 1
s = 4
(p-2).times{ s = (s**2 - 2) % m_p }
s == 0
end
 
@perfect_numerator = Prime.each.lazy.select{|p| mersenne_prime_pow?(p)}.map{|p| 2**(p-1)*(2**p-1)}
@perfects = @perfect_numerator.take(1).to_a
 
def perfect?(num)
@perfects << @perfect_numerator.next until @perfects.last >= num
@perfects.include? num
end
 
# demo
p (1..10000).select{|num| perfect?(num)}
t1 = Time.now
p perfect?(13164036458569648337239753460458722910223472318386943117783728128)
p Time.now - t1
 
Output:
[6, 28, 496, 8128]
true
0.001053954

As the task states, it is not known if there are any odd perfect numbers (any that exist are larger than 10**2000). This program tests 10**2001 in about 30 seconds - but only for even perfects.

Run BASIC[edit]

for i = 1 to 10000
if perf(i) then print i;" ";
next i
 
FUNCTION perf(n)
for i = 1 TO n - 1
IF n MOD i = 0 THEN sum = sum + i
next i
IF sum = n THEN perf = 1
END FUNCTION
Output:
6 28 496 8128

Scala[edit]

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

or

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

Scheme[edit]

(define (perf n)
(let loop ((i 1)
(sum 0))
(cond ((= i n)
(= sum n))
((= 0 (modulo n i))
(loop (+ i 1) (+ sum i)))
(else
(loop (+ i 1) sum)))))

Seed7[edit]

$ include "seed7_05.s7i";
 
const func boolean: isPerfect (in integer: n) is func
result
var boolean: isPerfect is FALSE;
local
var integer: i is 0;
var integer: sum is 1;
var integer: q is 0;
begin
for i range 2 to sqrt(n) do
if n rem i = 0 then
sum +:= i;
q := n div i;
if q > i then
sum +:= q;
end if;
end if;
end for;
isPerfect := sum = n;
end func;
 
const proc: main is func
local
var integer: n is 0;
begin
for n range 2 to 33550336 do
if isPerfect(n) then
writeln(n);
end if;
end for;
end func;
Output:
6
28
496
8128
33550336

Sidef[edit]

func is_perfect(n) {
var sum = 0;
range(1, n-1).each { |i|
i.divides(n) && (sum += i);
};
sum == n;
}
 
range(1, 1000).each { |i|
is_perfect(i) && say i;
}
Output:
6
28
496

Slate[edit]

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

Smalltalk[edit]

Integer extend [
 
"Translation of the C version; this is faster..."
isPerfectC [ |tot| tot := 1.
(2 to: (self sqrt) + 1) do: [ :i |
(self rem: i) = 0
ifTrue: [ |q|
tot := tot + i.
q := self // i.
q > i ifTrue: [ tot := tot + q ]
]
].
^ tot = self
]
 
"... but this seems more idiomatic"
isPerfect [
^ ( ( ( 2 to: self // 2 + 1) select: [ :a | (self rem: a) = 0 ] )
inject: 1 into: [ :a :b | a + b ] ) = self
]
].
1 to: 9000 do: [ :p | (p isPerfect) ifTrue: [ p printNl ] ]

Swift[edit]

Translation of: Java
func perfect(n:Int) -> Bool {
var sum = 0
for i in 1..<n {
if n % i == 0 {
sum += i
}
}
return sum == n
}
 
for i in 1..<10000 {
if perfect(i) {
println(i)
}
}
Output:
6
28
496
8128

Tcl[edit]

proc perfect n {
set sum 0
for {set i 1} {$i <= $n} {incr i} {
if {$n % $i == 0} {incr sum $i}
}
expr {$sum == 2*$n}
}

Ursala[edit]

#import std
#import nat
 
is_perfect = ~&itB&& ^(~&,~&t+ iota); ^E/~&l sum:-0+ ~| not remainder

This test program applies the function to a list of the first five hundred natural numbers and deletes the imperfect ones.

#cast %nL
 
examples = is_perfect*~ iota 500
Output:
<6,28,496>

VBScript[edit]

Function IsPerfect(n)
IsPerfect = False
i = n - 1
sum = 0
Do While i > 0
If n Mod i = 0 Then
sum = sum + i
End If
i = i - 1
Loop
If sum = n Then
IsPerfect = True
End If
End Function
 
WScript.StdOut.Write IsPerfect(CInt(WScript.Arguments(0)))
WScript.StdOut.WriteLine
Output:
C:\>cscript /nologo perfnum.vbs 6
True

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

C:\>

XPL0[edit]

include c:\cxpl\codes;  \intrinsic 'code' declarations
 
func Perfect(N); \Return 'true' if N is a perfect number
int N, S, I, Q;
[S:= 1;
for I:= 2 to sqrt(N) do
[Q:= N/I;
if rem(0)=0 then S:= S+I+Q;
];
return S=N & N#1;
];
 
int A, N;
[for A:= 1 to 16 do
[N:= (1<<A - 1) * 1<<(A-1);
if Perfect(N) then [IntOut(0, N); CrLf(0)];
];
]
Output:
6
28
496
8128
33550336

zkl[edit]

Translation of: D
fcn isPerfectNumber1(n)
{ n == [1..n-1].filter('wrap(i){ n % i == 0 }).sum(); }
Output:
[1..0d10_000].filter(isPerfectNumber1).println();
L(6,28,496,8128)