Perfect numbers

From Rosetta Code
(Redirected from Perfect Numbers)
Jump to: navigation, search
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.

See also

Contents

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

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

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

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

[edit] Axiom

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]

[edit] BASIC

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

[edit] BBC BASIC

[edit] BASIC version

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

Output:

         6
        28
       496
      8128

[edit] Assembler version

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

Output:

         4
         6
        28
       496
      8128
  33550336

[edit] Bracmat

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

Output:

6
28
496
8128

[edit] C

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

[edit] C#

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

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

[edit] C++

Works with: gcc
#include <iostream>
using namespace std ;
 
bool is_perfect( int ) ;
 
int main( ) {
cout << "Perfect numbers from 1 to 33550337:\n" ;
for ( int num = 1 ; num < 33550337 ; num++ ) {
if ( is_perfect( num ) )
cout << num << '\n' ;
}
return 0 ;
}
 
bool is_perfect( int number ) {
int sum = 0 ;
for ( int i = 1 ; i < number ; i++ )
if ( number % i == 0 )
sum += i ;
return sum == number ;
}

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

[edit] CoffeeScript

Optimized version, for fun.

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

output

> coffee perfect_numbers.coffee 
6
28
496
8128

[edit] COBOL

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.

[edit] Common Lisp

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

[edit] D

[edit] Functional Version

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

[edit] Faster Imperative Version

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]

[edit] Dart

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

[edit] Compact Version

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

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

[edit] Elixir

def is_perfect(x) do
[1 | lc x inlist :lists.seq(2, div(n, 2)), rem(n, x) == 0, do: x] |> :lists.sum() == n
end
 

[edit] Erlang

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

[edit] F#

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

Output

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

[edit] FALSE

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

[edit] Factor

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

[edit] Forth

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

[edit] Fortran

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

[edit] FunL

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

[edit] GAP

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

[edit] Go

package main
 
import "fmt"
 
// 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)
}
}
}
 
func computePerfect(n int64) bool {
var sum int64
for i := int64(1); i < n; i++ {
if n%i == 0 {
sum += i
}
}
return sum == n
}

Output:

tested 1000
tested 2000
tested 3000
...

[edit] Groovy

Solution:

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

Test program:

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

Output:

6
28
496
8128

[edit] Haskell

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]

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

[edit] Icon and 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
Uses divisors from factors

Sample Output:

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

[edit] J

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

Examples of use, including extensions beyond those assumptions:

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

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

[edit] Java

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

Or for arbitrary precision:

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

[edit] JavaScript

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

[edit] Julia

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

[edit] K

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)

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

[edit] Lasso

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

Output:

6, 28, 496, 8128

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

[edit]

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

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

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

[edit] Mathematica / Wolfram Language

Custom function:

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

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

PerfectQ[496]
PerfectQ[128]
Flatten[PerfectQ/@Range[10000]//Position[#,True]&]

gives back:

True
False
{6,28,496,8128}

[edit] MATLAB

Standard algorithm:

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

Faster algorithm:

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

[edit] Maxima

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

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

[edit] Nimrod

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

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

[edit] OCaml

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

Functional style:

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

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

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

[edit] PARI/GP

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

[edit] Pascal

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

output

Perfect numbers from 1 to 33550337:
6 is a perfect number.
28 is a perfect number.
496 is a perfect number.
8128 is a perfect number.
33550336 is a perfect number.

[edit] Perl

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

[edit] Perl 6

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

[edit] PHP

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

[edit] PicoLisp

(de perfect (N)
(let C 0
(for I (/ N 2)
(and (=0 (% N I)) (inc 'C I)) )
(= C N) ) )

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

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

[edit] Prolog

[edit] Classic approach

Works with SWI-Prolog

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

[edit] Functionnal approach

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

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

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

[edit] Python

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)

[edit] R

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

[edit] Racket

#lang racket
(define (perfect? n)
(= n
(for/fold ((sum 0))
((i (in-range 1 (add1 (floor (/ n 2))))))
(if (= (remainder n i) 0)
(+ sum i)
sum))))
 
 
(filter perfect? (build-list 1000 values))
;-> '(0 6 28 496)

[edit] REBOL

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

[edit] REXX

[edit] Classic REXX version of ooRexx

This version is a Classic Rexx version of the ooRexx program as of 14Sep2013.

/*REXX version of the  ooRexx  pgm (code was modified for 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; 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

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

[edit] Classic REXX version of PL/I

This version is a Classic Rexx version of the PL/I program as of 14Sep2013.

/*REXX version of the PL/I program (code was modified for 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. */
call time 'R'
 
do i=low to high /*process the single # or range. */
if perfect(i) then say i 'is a perfect number.'
end /*i*/
say 'and took' format(time('E'),,2) "seconds."
exit
 
perfect: procedure; parse arg n; /*get the number to be tested. */
sum=0; /*the sum of the factors so far. */
do i=1 to 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 is the same as for the ooRexx version (above).

[edit] 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
  • a 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 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. */
w=length(high) /*use W for formatting output. */
numeric digits max(9,w+2) /*ensure enough digits to handle#*/
do i=low to high /*process the single # or range. */
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ISPERFECT subroutine────────────────*/
isPerfect: procedure; parse arg x /*get 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 factors ≤√X*/
if x//j\==0 then iterate /*J isn't a factor of X, so skip.*/
s = s + j + x%j /*··· add it and the other factor*/
if s>x then return 0 /*Sum too big? It ain't perfect.*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, perfect! */

output using the defaults

       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 all timings, only 10,000 numbers were tested.

[edit] optimized using digital root

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

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

output is the same as the traditional version   and is about 3.1 times faster.

[edit] optimized using only even numbers

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

/*REXX program tests if a number (or a range of numbers) is/are perfect.*/
parse arg low high . /*obtain 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. */
w=length(high) /*use W for formatting output. */
numeric digits max(9,w+2) /*ensure enough digits to handle#*/
do i=low to high /*process the single # or range. */
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ISPERFECT subroutine────────────────*/
isPerfect: procedure; parse arg x 1 y /*get the number to be tested. */
if x//2 then return 0 /*handle special cases of odd #s.*/
if x==6 then return 1 /*handle special case of six. */
if x<28 then return 0 /*now, perfect numbers must be>27*/
 
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
y=r /*find digital root of dig root. */
end /*DO until*/ /*wash, rinse, repeat ··· */
 
if r\==1 then return 0 /*is dig root ¬1? Then ¬perfect.*/
 
s = 3 + x%2 /*the first three factors of X. */
do j=3 while j*j<=x /*starting at 3, find factors ≤√X*/
if x//j\==0 then iterate /*J isn't a factor of X, so skip.*/
s = s + j + x%j /*··· add it and the other factor*/
if s>x then return 0 /*Sum too big? It ain't perfect.*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, perfect! */

output is the same as the traditional version   and is about 4.8 times faster.

[edit] Lucas-Lehmer method

This version uses memoization to implement a fast version of Lucas-Lehmer test,
it is 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 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. */
w=length(high) /*use W for formatting output. */
numeric digits max(9,w+2) /*ensure enough digits to handle#*/
@.=0; @.1=2 /*highest magic # and its index.*/
do i=low to high /*process the single # or range. */
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ISPERFECT subroutine────────────────*/
isPerfect: procedure expose @.; parse arg x /*get the # to be tested.*/
if x//2 then return 0 /*if it's an odd #, it ain't 'un.*/
/*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 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 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 /*Sum too big? It ain't perfect.*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, perfect! */

output is the same as the traditional version   and is about 11.9 times faster.
Programming note:   This last REXX version could be optimized further by incorporating the digital root test.

[edit] Ruby

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

Functional style:

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

Faster version:

def perf(n)
divisors = []
for i in 1..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

[edit] Fast (Lucas-Lehmer)

Generate and memoize perfect numbers as needed.

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

[edit] Run BASIC

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

[edit] Scala

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

or

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

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

[edit] Seed7

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

Output:

6
28
496
8128
33550336

[edit] Slate

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

[edit] Smalltalk

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

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

[edit] Ursala

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

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

#cast %nL
 
examples = is_perfect*~ iota 500

output:

<6,28,496>

[edit] XPL0

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

[edit] zkl

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)
Personal tools
Namespaces

Variants
Actions
Community
Explore
Misc
Toolbox