Perfect numbers

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 number is perfect if the sum of its factors is equal to twice the number. An equivalent condition is that n is perfect if the sum of n's factors that are less than n is equal to n.

Note: The faster Lucas-Lehmer test is used to find primes of the form 2ⁿ-1, all known perfect numbers can derived from these primes using the formula (2ⁿ - 1) × 2^{n - 1}. It is not known if there are any odd perfect numbers.

See also

• Rational Arithmetic

Ada

<lang ada>function Is_Perfect(N : Positive) return Boolean is

  Sum : Natural := 0;

begin

  for I in 1..N - 1 loop
     if N mod I = 0 then
        Sum := Sum + I;
     end if;
  end loop;
  return Sum = N;

end Is_Perfect;</lang>

ALGOL 68

<lang algol68>PROC is perfect = (INT candidate)BOOL: (

 INT sum :=1;
 FOR f1 FROM 2 TO ENTIER ( sqrt(candidate)*(1+2*small real) ) WHILE
   IF candidate MOD f1 = 0 THEN
     sum +:= f1;
     INT f2 = candidate OVER f1;
     IF f2 > f1 THEN
       sum +:= f2
     FI
   FI;

1. WHILE # sum <= candidate DO

   SKIP 
 OD;
 sum=candidate

);

1. test #

FOR i FROM 2 TO 33550336 DO

 IF is perfect(i) THEN print((i, new line)) FI

OD</lang> Output: <lang algol68> +6

     +28
    +496
   +8128

+33550336</lang>

AutoHotkey

This will find the first 8 perfect numbers. <lang autohotkey>Loop, 30 {

 If isMersennePrime(A_Index + 1)
   res .= "Perfect number: " perfectNum(A_Index + 1) "`n"

}

MsgBox % res

perfectNum(N) {

 Return 2**(N - 1) * (2**N - 1)

}

isMersennePrime(N) {

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

}

isPrime(N) {

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

}</lang>

AWK

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

BASIC

Works with: QuickBasic version 4.5

<lang qbasic>FUNCTION perf(n) sum = 0 for i = 1 to n - 1 IF n MOD i = 0 THEN sum = sum + i END IF NEXT i IF sum = n THEN perf = 1 ELSE perf = 0 END IF END FUNCTION</lang>

C

Translation of: D

<lang c>#include "stdio.h"

1. include "math.h"

int perfect(int n) {

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

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

   return tot == n;

}

int main() {

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

   return 0;

}</lang>

C++

Works with: gcc

<lang cpp>#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 + 1 ; i++ ) 
     if ( number % i == 0 ) 
        sum += i ; 
  return ( ( sum == 2 * number ) || ( sum - number == number ) ) ; 

}</lang>

Clojure

<lang lisp>(defn proper-divisors [n]

 (if (< n 4)
   '(1)
   (cons 1 (filter #(zero? (rem n %)) (range 2 (inc (quot n 2))))))

) (defn perfect? [n]

 (== (reduce + (proper-divisors n)) n)

)</lang>

Common Lisp

Translation of: Haskell

<lang lisp>(defun perfectp (n)

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

D

Based on the Algol version: <lang d>import std.math: sqrt;

bool perfect(int n) {

   if (n < 2)
       return false;
   int max = cast(int)sqrt(cast(real)n) + 1;
   int tot = 1;

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

   return tot == n;

}

void main() {

   for (int n; n < 33_550_337; n++)
       if (perfect(n))
           printf("%d\n", n);

}</lang>

E

<lang e>pragma.enable("accumulator") def isPerfectNumber(x :int) {

 var sum := 0
 for d ? (x % d <=> 0) in 1..!x {
   sum += d
   if (sum > x) { return false }
 }
 return sum <=> x

}</lang>

Erlang

<lang erlang>is_perfect(X) ->

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

Forth

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

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

Fortran

Works with: Fortran version 90 and later

<lang fortran>FUNCTION isPerfect(n)

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

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

END FUNCTION isPerfect</lang>

Groovy

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

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

}</lang>

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

Output:

6
28
496
8128

Haskell

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

J

<lang j>is_perfect=: = [: +/ ((0=]|[)i.) # i.</lang> The program defined above, like programs found here in other languages, assumes that the input will be a scalar positive integer.

Examples of use, including extensions beyond those assumptions: <lang j> is_perfect 33550336 1

  }.I. is_perfect"0 i. 10000

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_pos_int=: 0&< *. ]=>.
  (is_perfect"0 *. is_pos_int) zero_through_twentynine

0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0</lang>

Java

<lang java>public static boolean perf(int n){ int sum= 0; for(int i= 1;i < n;i++){ if(n % i == 0){ sum+= i; } } return sum == n; }</lang> Or for arbitrary precision: <lang java>import java.math.BigInteger;

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

JavaScript

Translation of: Java

<lang javascript>function is_perfect(n) {

   var sum = 0;
   for (var i = 1; i <= n/2; i++) {
       if (n % i == 0) {
           sum += i;
       }
   }
   return sum == n;

}

for (var i = 1; i < 10000; i++) {

   if (is_perfect(i)) {
       print(i);
   }

}</lang>

Output:

6
28
496
8128

Logo

<lang logo>to perfect? :n

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

end</lang>

M4

<lang M4>define(`for',

  `ifelse($#,0,``$0,
  `ifelse(eval($2<=$3),1,
  `pushdef(`$1',$2)$4`'popdef(`$1')$0(`$1',incr($2),$3,`$4')')')')dnl

define(`ispart',

  `ifelse(eval($2*$2<=$1),1,
     `ifelse(eval($1%$2==0),1,
        `ifelse(eval($2*$2==$1),1,
           `ispart($1,incr($2),eval($3+$2))',
           `ispart($1,incr($2),eval($3+$2+$1/$2))')',
        `ispart($1,incr($2),$3)')',
     $3)')

define(`isperfect',

  `eval(ispart($1,2,1)==$1)')

for(`x',`2',`33550336',

  `ifelse(isperfect(x),1,`x

')')</lang>

Mathematica

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

MAXScript

<lang maxscript>fn isPerfect n = (

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

)</lang>

OCaml

<lang ocaml>let perf n =

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

Functional style: <lang ocaml>(* range operator *) let rec (--) a b =

 if a > b then
   []
 else
   a :: (a+1) -- b

let perf n = n = List.fold_left (+) 0 (List.filter (fun i -> n mod i = 0) (1 -- (n-1)))</lang>

Perl

<lang perl>sub perf {

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

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

sub perf {

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

}</lang>

Python

<lang python>def perf(n):

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

Functional style: <lang python>perf = lambda n: n == sum(i for i in xrange(1, n) if n % i == 0)</lang>

R

<lang R>is.perf <- function(n){ if (n==0|n==1) return(FALSE) s <- seq (1,n-1) x <- n %% s m <- data.frame(s,x) out <- with(m, s[x==0]) return(sum(out)==n) }

1. Usage - Warning High Memory Usage

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

Ruby

<lang ruby>def perf(n)

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

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

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

end</lang>

Scheme

<lang scheme>(define (perf n)

 (let loop ((i 1)
            (sum 0))
   (cond ((= i n)
          (= sum n))
         ((= 0 (modulo n i))
          (loop (+ i 1) (+ sum i)))
         (else
          (loop (+ i 1) sum)))))</lang>

Slate

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

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

].</lang>

Smalltalk

<lang smalltalk>Integer extend [

 "Translation of the C version; this is faster..."
 isPerfectC [ |tot| tot := 1.
    (2 to: (self sqrt) + 1) do: [ :i |
       (self rem: i) = 0
       ifTrue: [ |q|
                 tot := tot + i.
                 q := self // i. 
                 q > i ifTrue: [ tot := tot + q ]
       ]
    ].
    ^ tot = self
 ]

 "... but this seems more idiomatic"
 isPerfect [
    ^ ( ( ( 2 to: self // 2 + 1) select: [ :a | (self rem: a) = 0 ] )
        inject: 1 into: [ :a :b | a + b ] ) = self
 ]

].</lang>

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

Tcl

<lang tcl>proc perfect n {

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

}</lang>

Ursala

<lang Ursala>#import std

1. import nat

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

examples = is_perfect*~ iota 500</lang> output:

<6,28,496>