Perfect numbers: Difference between revisions
(→{{header|REXX}}: added optimized versions. -- ~~~~) |
(→optimized using only even numbers: added more optimization. -- ~~~~) |
||
Line 1,317: | Line 1,317: | ||
if r\==1 then return 0 /*is dig root ¬1? Then ¬perfect.*/ |
if r\==1 then return 0 /*is dig root ¬1? Then ¬perfect.*/ |
||
s= |
s = 3 + x%2 /*the first three factors of X. */ |
||
do j= |
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.*/ |
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*/ |
s = s + j + x%j /*··· add it and the other factor*/ |
||
Line 1,325: | Line 1,325: | ||
return s==x /*if the sum matches X, perfect! */</lang> |
return s==x /*if the sum matches X, perfect! */</lang> |
||
'''output''' is the same as version 1. |
'''output''' is the same as version 1. |
||
===Lucas-Lehmer method=== |
===Lucas-Lehmer method=== |
||
This version uses memoization to implement a fast version of Lucas-Lehmer test, |
This version uses memoization to implement a fast version of Lucas-Lehmer test, |
Revision as of 20:09, 15 September 2013
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
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;
- 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>
Axiom
Using the interpreter, define the function: <lang Axiom>perfect?(n:Integer):Boolean == reduce(+,divisors n) = 2*n</lang> Alternatively, using the Spad compiler: <lang Axiom>)abbrev package TESTP TestPackage TestPackage() : with
perfect?: Integer -> Boolean == add import IntegerNumberTheoryFunctions perfect? n == reduce("+",divisors n) = 2*n</lang>
Examples (testing 496, testing 128, finding all perfect numbers in 1...10000): <lang Axiom>perfect? 496 perfect? 128 [i for i in 1..10000 | perfect? i]</lang> Output: <lang Axiom>true false [6,28,496,8128]</lang>
BASIC
<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>
BBC BASIC
BASIC version
<lang bbcbasic> 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%)</lang>
Output:
6 28 496 8128
Assembler version
<lang bbcbasic> 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</lang>
Output:
4 6 28 496 8128 33550336
Bracmat
<lang 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|) )
);</lang> Output:
6 28 496 8128
C
<lang c>#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;
}</lang> Using functions from Factors of an integer#Prime factoring: <lang c>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; }</lang>
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; i++) { if (num % i == 0) sum += i; }
return sum == num ; }</lang>
Version using Lambdas, will only work from version 3 of C# on
<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) { return Enumerable.Range(1, num - 1).Sum(n => num % n == 0 ? n : 0 ) == num; }</lang>
C++
<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 ; i++ ) if ( number % i == 0 ) sum += i ; return sum == 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>
<lang lisp>(defn perfect? [n]
(= n (reduce + (for [i (range 1 n) :when (= 0 (mod n i))] i))))</lang>
CoffeeScript
Optimized version, for fun. <lang coffeescript>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)</lang>
output
> coffee perfect_numbers.coffee 6 28 496 8128
COBOL
main.cbl: <lang cobol> $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.</lang>
perfect.cbl: <lang cobol> 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.</lang>
Common Lisp
<lang lisp>(defun perfectp (n)
(= n (loop for i from 1 below n when (= 0 (mod n i)) sum i)))</lang>
D
Faster Imperative Version
<lang d>import std.stdio, std.math, std.range, std.algorithm;
bool isPerfectNumber(in int n) pure nothrow {
if (n < 2) return false;
int sum = 1; foreach (immutable i; 2 .. cast(int)sqrt(cast(real)n) + 1) if (n % i == 0) { immutable int q = n / i; sum += i; if (q > i) sum += q; }
return sum == n;
}
void main() {
10_000.iota.filter!isPerfectNumber.writeln;
}</lang>
- Output:
[6, 28, 496, 8128]
With a 33_550_337.iota
it outputs:
[6, 28, 496, 8128, 33550336]
Functional Style
Same output. <lang d>import std.stdio, std.algorithm, std.range;
bool isPerfect(in int n) /*pure nothrow*/ {
return n == iota(1, n - 1).reduce!((s, i) => n % i ? s : s + i);
}
void main() {
iota(3, 10_000).filter!isPerfect.writeln;
}</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>
F#
<lang fsharp>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</lang> Output
6 is perfect 28 is perfect 496 is perfect 8128 is perfect
FALSE
<lang false>[0\1[\$@$@-][\$@$@$@$@\/*=[@\$@+@@]?1+]#%=]p: 45p;!." "28p;!. { 0 -1 }</lang>
Factor
<lang factor>USING: kernel math math.primes.factors sequences ; IN: rosettacode.perfect-numbers
- perfect? ( n -- ? ) [ divisors sum ] [ 2 * ] bi = ;</lang>
Forth
<lang forth>: perfect? ( n -- ? )
1 over 2/ 1+ 2 ?do over i mod 0= if i + then loop = ;</lang>
Fortran
<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>
GAP
<lang gap>Filtered([1 .. 10000], n -> Sum(DivisorsInt(n)) = 2*n);
- [ 6, 28, 496, 8128 ]</lang>
Go
<lang 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
}</lang> Output:
tested 1000 tested 2000 tested 3000 ...
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>
Create a list of known perfects: <lang haskell>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]</lang>
HicEst
<lang 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</lang>
Icon and Unicon
<lang Icon>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</lang>
Sample Output:
Perfect numbers from 1 to 100000: 6 28 496 8128 Done.
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
<lang javascript>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);
}</lang>
Output:
6 28 496 8128
Julia
<lang julia>julia> function isperfect(n) n == sum([n % i == 0 ? i : 0 for i = 1:n-1]) end
- method added to generic function isperfect
julia> function perfects(n) a = ref(Int64) for i = 1:n isperfect(i) && push!(a,i) end return a end
- method added to generic function perfects
julia> perfects(10000) 4-element Int64 Array:
6 28 496 8128</lang>
K
<lang K> 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)</lang>
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.
Liberty BASIC
<lang lb>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</lang>
Logo
<lang logo>to perfect? :n
output equal? :n apply "sum filter [equal? 0 modulo :n ?] iseq 1 :n/2
end</lang>
Lua
<lang 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</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>
Maxima
<lang maxima>".."(a, b) := makelist(i, i, a, b)$ infix("..")$
perfectp(n) := is(divsum(n) = 2*n)$
sublist(1 .. 10000, perfectp); /* [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>
Objeck
<lang 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; } }
}</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>
ooRexx
<lang 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
</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>
PARI/GP
Uses built-in method. Faster tests would use the LL test for evens and myriad results on OPNs otherwise. <lang parigp>isPerfect(n)=sigma(n,-1)==2</lang> Show perfect numbers <lang parigp>forprime(p=2, 2281, if(isprime(2^p-1), print(p"\t",(2^p-1)*2^(p-1))))</lang> Faster with Lucas-Lehmer test <lang parigp>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)</lang> 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
<lang 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.</lang> 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
<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>
Perl 6
<lang perl6>sub perf($n) { $n == [+] grep $n %% *, 1 .. $n div 2 }</lang>
PHP
<lang php>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;
}</lang>
PicoLisp
<lang PicoLisp>(de perfect (N)
(let C 0 (for I (/ N 2) (and (=0 (% N I)) (inc 'C I)) ) (= C N) ) )</lang>
PL/I
<lang 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;</lang>
PowerShell
<lang 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.</lang>
Prolog
Classic approach
Works with SWI-Prolog <lang 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).</lang>
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 <lang Prolog>:- 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))).</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) }
- Usage - Warning High Memory Usage
is.perf(28) sapply(c(6,28,496,8128,33550336),is.perf)</lang>
Racket
<lang 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)</lang>
REBOL
<lang rebol>perfect?: func [n [integer!] /local sum] [
sum: 0 repeat i (n - 1) [ if zero? remainder n i [ sum: sum + i ] ] sum = n
]</lang>
REXX
traditional method
<lang rexx>/*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! */</lang> 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.
optimized using digital root
<lang rexx>/*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*/
do until length(y)==1 /*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 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! */</lang> output is the same as version 1.
optimized using only even numbers
<lang rexx>/*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 length(y)==1 /*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 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! */</lang> output is the same as version 1.
Lucas-Lehmer method
This version uses memoization to implement a fast version of Lucas-Lehmer test,
it is faster than the traditional method by orders of magnitude.
<lang rexx>/*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==1 then return 0 /*if it's an odd number, it ain't*/
/*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! */</lang>
output is the same as version 1.
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(:+)
end</lang>
Run BASIC
<lang runbasic>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</lang>Output:
6 28 496 8128
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>
Seed7
<lang 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;</lang>
Output:
6 28 496 8128 33550336
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
- 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>
- Programming Tasks
- Discrete math
- Ada
- ALGOL 68
- AutoHotkey
- AWK
- Axiom
- BASIC
- BBC BASIC
- Bracmat
- C
- C sharp
- C++
- Clojure
- CoffeeScript
- COBOL
- Common Lisp
- D
- E
- Erlang
- F Sharp
- FALSE
- Factor
- Forth
- Fortran
- GAP
- Go
- Groovy
- Haskell
- HicEst
- Icon
- Unicon
- Icon Programming Library
- J
- Java
- Arbitrary precision
- JavaScript
- Julia
- K
- LabVIEW
- Liberty BASIC
- Logo
- Lua
- M4
- Mathematica
- Maxima
- MAXScript
- Objeck
- OCaml
- OoRexx
- Oz
- PARI/GP
- Pascal
- Perl
- Perl 6
- PHP
- PicoLisp
- PL/I
- PowerShell
- Prolog
- PureBasic
- Python
- R
- Racket
- REBOL
- REXX
- Ruby
- Run BASIC
- Scala
- Scheme
- Seed7
- Slate
- Smalltalk
- Tcl
- Ursala