Perfect numbers

From Rosetta Code
Revision as of 23:56, 26 July 2010 by rosettacode>Mwn3d (Take "See also" off the TOC and rm the explicit TOC)
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 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 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

Ada

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

  Sum : Natural := 0;

begin

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

end Is_Perfect;</lang>

ALGOL 68

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

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

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

);

test:(

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

)</lang> Output:

         +6
        +28
       +496
      +8128
  +33550336

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#

Translation of: C++

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

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

Console.ReadLine(); }

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

return ((sum == 2 * num || (sum - num == num))); } </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>

FALSE

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

Forth

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

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

Fortran

Works with: Fortran version 90 and later

<lang fortran>FUNCTION isPerfect(n)

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

END FUNCTION isPerfect</lang>

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).equals(BigInteger.ZERO)){ sum= sum.add(i); } } return sum.equals(n); }</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


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

Oz

<lang oz>declare

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

in

 {Show {Filter {List.number 1 10000 1} IsPerfect}}
 {Show {IsPerfect 33550336}}</lang>

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(0, grep {$n % $_ == 0} 1..$n-1);

}</lang>

PicoLisp

<lang PicoLisp>(de perfect (N)

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

PureBasic

<lang PureBasic>Procedure is_Perfect_number(n)

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

EndProcedure</lang>

Python

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

Scala

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

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>