Rosetta Code

Perfect numbers: Difference between revisions

Page Discussion

Perfect numbers (view source)

Revision as of 12:56, 25 January 2024

33,458 bytes added ,  3 months ago
m
→‎{{header|Elena}}
imported>Arakov
 
(47 intermediate revisions by 22 users not shown)
Line 27:
{{trans|Python}}
 
<langsyntaxhighlight lang="11l">F perf(n)
V sum = 0
L(i) 1 .< n
Line 36:
L(i) 1..10000
I perf(i)
print(i, end' ‘ ’)</langsyntaxhighlight>
 
{{out}}
Line 50:
The only added optimization is the loop up to n/2 instead of n-1.
With 31 bit integers the limit is 2,147,483,647.
<langsyntaxhighlight lang="360asm">* Perfect numbers 15/05/2016
PERFECTN CSECT
USING PERFECTN,R13 prolog
Line 96:
PG DC CL12' ' buffer
YREGS
END PERFECTN</langsyntaxhighlight>
{{out}}
<pre>
Line 108:
Use of optimizations found in Rexx algorithms and use of packed decimal to have bigger numbers.
With 15 digit decimal integers the limit is 999,999,999,999,999.
<langsyntaxhighlight lang="360asm">* Perfect numbers 15/05/2016
PERFECPO CSECT
USING PERFECPO,R13 prolog
Line 183:
PW2 DS PL16
YREGS
END PERFECPO</langsyntaxhighlight>
{{out}}
<pre>
Line 197:
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang="aarch64 assembly">
<lang AArch64 Assembly>
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program perfectNumber64.s */
Line 458:
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
</lang>
<pre>
Perfect : 6
Line 470:
Perfect : 8070450532247928832
</pre>
=={{header|Action!}}==
<syntaxhighlight lang="action!">PROC Main()
DEFINE MAXNUM="10000"
CARD ARRAY pds(MAXNUM+1)
CARD i,j
 
FOR i=2 TO MAXNUM
DO
pds(i)=1
OD
FOR i=2 TO MAXNUM
DO
FOR j=i+i TO MAXNUM STEP i
DO
pds(j)==+i
OD
OD
 
FOR i=2 TO MAXNUM
DO
IF pds(i)=i THEN
PrintCE(i)
FI
OD
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Perfect_numbers.png Screenshot from Atari 8-bit computer]
<pre>
6
28
496
8128
</pre>
 
=={{header|Ada}}==
<langsyntaxhighlight lang="ada">function Is_Perfect(N : Positive) return Boolean is
Sum : Natural := 0;
begin
Line 480 ⟶ 514:
end loop;
return Sum = N;
end Is_Perfect;</langsyntaxhighlight>
 
=={{header|ALGOL 60}}==
{{works with|A60}}
<syntaxhighlight lang="algol60">
begin
 
comment - return p mod q;
integer procedure mod(p, q);
value p, q; integer p, q;
begin
mod := p - q * entier(p / q);
end;
 
comment - return true if n is perfect, otherwise false;
boolean procedure isperfect(n);
value n; integer n;
begin
integer sum, f1, f2;
sum := 1;
f1 := 1;
for f1 := f1 + 1 while (f1 * f1) <= n do
begin
if mod(n, f1) = 0 then
begin
sum := sum + f1;
f2 := n / f1;
if f2 > f1 then sum := sum + f2;
end;
end;
isperfect := (sum = n);
end;
 
comment - exercise the procedure;
integer i, found;
outstring(1,"Searching up to 10000 for perfect numbers\n");
found := 0;
for i := 2 step 1 until 10000 do
if isperfect(i) then
begin
outinteger(1,i);
found := found + 1;
end;
outstring(1,"\n");
outinteger(1,found);
outstring(1,"perfect numbers were found");
 
end
</syntaxhighlight>
{{out}}
<pre>
Searching up to 10000 for perfect numbers
6 28 496 8128
4 perfect numbers were found
</pre>
 
=={{header|ALGOL 68}}==
Line 486 ⟶ 574:
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny]}}
{{works with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d]}}
<langsyntaxhighlight lang="algol68">PROC is perfect = (INT candidate)BOOL: (
INT sum :=1;
FOR f1 FROM 2 TO ENTIER ( sqrt(candidate)*(1+2*small real) ) WHILE
Line 506 ⟶ 594:
IF is perfect(i) THEN print((i, new line)) FI
OD
)</langsyntaxhighlight>
{{Out}}
<pre>
Line 518 ⟶ 606:
=={{header|ALGOL W}}==
Based on the Algol 68 version.
<langsyntaxhighlight lang="algolw">begin
% returns true if n is perfect, false otherwise %
% n must be > 0 %
Line 539 ⟶ 627:
% test isPerfect %
for n := 2 until 10000 do if isPerfect( n ) then write( n );
end.</langsyntaxhighlight>
{{out}}
<pre>
Line 549 ⟶ 637:
 
=={{header|AppleScript}}==
===Functional===
 
{{Trans|JavaScript}}
<langsyntaxhighlight AppleScriptlang="applescript">-- PERFECT NUMBERS -----------------------------------------------------------
 
-- perfect :: integer -> bool
Line 658 ⟶ 746:
end script
end if
end mReturn</langsyntaxhighlight>
{{Out}}
<langsyntaxhighlight AppleScriptlang="applescript">{6, 28, 496, 8128}</langsyntaxhighlight>
----
===Idiomatic===
====Sum of proper divisors====
<syntaxhighlight lang="applescript">on aliquotSum(n)
if (n < 2) then return 0
set sum to 1
set sqrt to n ^ 0.5
set limit to sqrt div 1
if (limit = sqrt) then
set sum to sum + limit
set limit to limit - 1
end if
repeat with i from 2 to limit
if (n mod i is 0) then set sum to sum + i + n div i
end repeat
return sum
end aliquotSum
 
on isPerfect(n)
if (n > 1.37438691328E+11) then return missing value -- Too high for perfection to be determinable.
-- All the known perfect numbers listed in Wikipedia end with either 6 or 28.
-- These endings are either preceded by odd digits or are the numbers themselves.
tell (n mod 10) to ¬
return ((((it = 6) and ((n mod 20 = 16) or (n = 6))) or ¬
((it = 8) and ((n mod 200 = 128) or (n = 28)))) and ¬
(my aliquotSum(n) = n))
end isPerfect
 
local output, n
set output to {}
repeat with n from 1 to 10000
if (isPerfect(n)) then set end of output to n
end repeat
return output</syntaxhighlight>
 
{{output}}
<syntaxhighlight lang="applescript">{6, 28, 496, 8128}</syntaxhighlight>
 
====Euclid====
<syntaxhighlight lang="applescript">on isPerfect(n)
-- All the known perfect numbers listed in Wikipedia end with either 6 or 28.
-- These endings are either preceded by odd digits or are the numbers themselves.
tell (n mod 10) to ¬
if not (((it = 6) and ((n mod 20 = 16) or (n = 6))) or ((it = 8) and ((n mod 200 = 128) or (n = 28)))) then ¬
return false
-- Work through the only seven primes p where (2 ^ p - 1) is also prime
-- and (2 ^ p - 1) * (2 ^ (p - 1)) is a number that AppleScript can handle.
repeat with p in {2, 3, 5, 7, 13, 17, 19}
tell (2 ^ p - 1) * (2 ^ (p - 1))
if (it < n) then
else
return (it = n)
end if
end tell
end repeat
return missing value
end isPerfect
 
local output, n
set output to {}
repeat with n from 2 to 33551000 by 2
if (isPerfect(n)) then set end of output to n
end repeat
return output</syntaxhighlight>
 
{{output}}
<syntaxhighlight lang="applescript">{6, 28, 496, 8128, 33550336}</syntaxhighlight>
 
====Practical====
But since AppleScript can only physically manage seven of the known perfect numbers, they may as well be in a look-up list for maximum efficiency:
 
<syntaxhighlight lang="applescript">on isPerfect(n)
if (n > 1.37438691328E+11) then return missing value -- Too high for perfection to be determinable.
return (n is in {6, 28, 496, 8128, 33550336, 8.589869056E+9, 1.37438691328E+11})
end isPerfect</syntaxhighlight>
 
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
<lang ARM Assembly>
 
/* ARM assembly Raspberry PI */
Line 739 ⟶ 904:
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
</lang>
<pre>
Perfect : 6
Line 748 ⟶ 913:
</pre>
=={{header|Arturo}}==
<langsyntaxhighlight lang="rebol">divisors: $[n][ select 1..(n/2)+1 'i -> 0 = n % i ]
perfect?: $[n][ n = sum divisors n ]
loop 2..1000 'i [
if perfect? i -> print i
]</langsyntaxhighlight>
 
=={{header|AutoHotkey}}==
This will find the first 8 perfect numbers.
<langsyntaxhighlight lang="autohotkey">Loop, 30 {
If isMersennePrime(A_Index + 1)
res .= "Perfect number: " perfectNum(A_Index + 1) "`n"
Line 778 ⟶ 943:
Return false
Return true
}</langsyntaxhighlight>
 
=={{header|AWK}}==
<langsyntaxhighlight 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</langsyntaxhighlight>
 
=={{header|Axiom}}==
{{trans|Mathematica}}
Using the interpreter, define the function:
<langsyntaxhighlight Axiomlang="axiom">perfect?(n:Integer):Boolean == reduce(+,divisors n) = 2*n</langsyntaxhighlight>
Alternatively, using the Spad compiler:
<langsyntaxhighlight Axiomlang="axiom">)abbrev package TESTP TestPackage
TestPackage() : withma
perfect?: Integer -> Boolean
Line 799 ⟶ 964:
add
import IntegerNumberTheoryFunctions
perfect? n == reduce("+",divisors n) = 2*n</langsyntaxhighlight>
 
Examples (testing 496, testing 128, finding all perfect numbers in 1...10000):
<langsyntaxhighlight Axiomlang="axiom">perfect? 496
perfect? 128
[i for i in 1..10000 | perfect? i]</langsyntaxhighlight>
{{Out}}
<langsyntaxhighlight Axiomlang="axiom">true
false
[6,28,496,8128]</langsyntaxhighlight>
 
=={{header|BASIC}}==
{{works with|QuickBasic|4.5}}
<langsyntaxhighlight lang="qbasic">FUNCTION perf(n)
sum = 0
for i = 1 to n - 1
Line 824 ⟶ 989:
perf = 0
END IF
END FUNCTION</langsyntaxhighlight>
 
 
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="basic256">
function isPerfect(n)
if (n < 2) or (n mod 2 = 1) then return False
#asumimos que los números impares no son perfectos
sum = 1
for i = 2 to sqr(n)
if n mod i = 0 then
sum += i
q = n \ i
if q > i then sum += q
end if
next
return n = sum
end function
 
print "Los primeros 5 números perfectos son:"
for i = 2 to 233550336
if isPerfect(i) then print i; " ";
next i
end
</syntaxhighlight>
 
==={{header|Craft Basic}}===
<syntaxhighlight lang="basic">for n = 1 to 10000
 
let s = 0
 
for i = 1 to n / 2
 
if n % i = 0 then
 
let s = s + i
 
endif
 
next i
 
if s = n then
 
print n, " ",
 
endif
 
wait
 
next n</syntaxhighlight>
{{out| Output}}<pre>6 28 496 8128 </pre>
 
==={{header|IS-BASIC}}===
<langsyntaxhighlight ISlang="is-BASICbasic">100 PROGRAM "PerfectN.bas"
110 FOR X=1 TO 10000
120 IF PERFECT(X) THEN PRINT X;
Line 838 ⟶ 1,054:
190 NEXT
200 LET PERFECT=N=S
210 END DEF</langsyntaxhighlight>
 
==={{header|Sinclair ZX81 BASIC}}===
Call this subroutine and it will (eventually) return <tt>PERFECT</tt> = 1 if <tt>N</tt> is perfect or <tt>PERFECT</tt> = 0 if it is not.
<langsyntaxhighlight lang="basic">2000 LET SUM=0
2010 FOR F=1 TO N-1
2020 IF N/F=INT (N/F) THEN LET SUM=SUM+F
2030 NEXT F
2040 LET PERFECT=SUM=N
2050 RETURN</langsyntaxhighlight>
 
==={{header|True BASIC}}===
<syntaxhighlight lang="basic">
FUNCTION perf(n)
IF n < 2 or ramainder(n,2) = 1 then LET perf = 0
LET sum = 0
FOR i = 1 to n-1
IF remainder(n,i) = 0 then LET sum = sum+i
NEXT i
IF sum = n then
LET perf = 1
ELSE
LET perf = 0
END IF
END FUNCTION
 
PRINT "Los primeros 5 números perfectos son:"
FOR i = 1 to 33550336
IF perf(i) = 1 then PRINT i; " ";
NEXT i
 
PRINT
PRINT "Presione cualquier tecla para salir"
END
</syntaxhighlight>
 
=={{header|BBC BASIC}}==
===BASIC version===
<langsyntaxhighlight lang="bbcbasic"> FOR n% = 2 TO 10000 STEP 2
IF FNperfect(n%) PRINT n%
NEXT
Line 863 ⟶ 1,104:
NEXT
IF I% = SQR(N%) S% += I%
= (N% = S%)</langsyntaxhighlight>
{{Out}}
<pre>
Line 874 ⟶ 1,115:
===Assembler version===
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight 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
Line 883 ⟶ 1,124:
IF B% = USRS% PRINT B%
NEXT
END</langsyntaxhighlight>
{{Out}}
<pre>
Line 895 ⟶ 1,136:
 
=={{header|Bracmat}}==
<langsyntaxhighlight lang="bracmat">( ( perf
= sum i
. 0:?sum
Line 912 ⟶ 1,153:
& (perf$!n&out$!n|)
)
);</langsyntaxhighlight>
{{Out}}
<pre>6
Line 918 ⟶ 1,159:
496
8128</pre>
 
=={{header|Burlesque}}==
<syntaxhighlight lang="burlesque">Jfc++\/2.*==</syntaxhighlight>
 
<syntaxhighlight lang="burlesque">blsq) 8200ro{Jfc++\/2.*==}f[
 
{6 28 496 8128}</syntaxhighlight>
 
=={{header|C}}==
{{trans|D}}
<langsyntaxhighlight lang="c">#include "stdio.h"
#include "math.h"
 
Line 947 ⟶ 1,195:
 
return 0;
}</langsyntaxhighlight>
Using functions from [[Factors of an integer#Prime factoring]]:
<langsyntaxhighlight lang="c">int main()
{
int j;
Line 963 ⟶ 1,211:
return 0;
}</langsyntaxhighlight>
 
=={{header|C sharp|C#}}==
{{trans|C++}}
<langsyntaxhighlight lang="csharp">static void Main(string[] args)
{
Console.WriteLine("Perfect numbers from 1 to 33550337:");
Line 990 ⟶ 1,238:
 
return sum == num ;
}</langsyntaxhighlight>
===Version using Lambdas, will only work from version 3 of C# on===
<langsyntaxhighlight lang="csharp">static void Main(string[] args)
{
Console.WriteLine("Perfect numbers from 1 to 33550337:");
Line 1,008 ⟶ 1,256:
{
return Enumerable.Range(1, num - 1).Sum(n => num % n == 0 ? n : 0 ) == num;
}</langsyntaxhighlight>
 
=={{header|C++}}==
{{works with|gcc}}
<langsyntaxhighlight lang="cpp">#include <iostream>
using namespace std ;
 
Line 1,031 ⟶ 1,279:
return 0 ;
}
</syntaxhighlight>
</lang>
 
=={{header|Clojure}}==
<langsyntaxhighlight lang="clojure">(defn proper-divisors [n]
(if (< n 4)
[1]
Line 1,042 ⟶ 1,290:
 
(defn perfect? [n]
(= (reduce + (proper-divisors n)) n))</langsyntaxhighlight>
 
{{trans|Haskell}}
<langsyntaxhighlight lang="clojure">(defn perfect? [n]
(->> (for [i (range 1 n)] :when (zero? (rem n i))] i)
(reduce +)
(= n)))</langsyntaxhighlight>
 
===Functional version===
<langsyntaxhighlight lang="clojure">(defn perfect? [n]
(= (reduce + (filter #(zero? (rem n %)) (range 1 n))) n))</langsyntaxhighlight>
 
=={{header|COBOL}}==
Line 1,058 ⟶ 1,306:
{{works with|Visual COBOL}}
main.cbl:
<langsyntaxhighlight lang="cobol"> $set REPOSITORY "UPDATE ON"
IDENTIFICATION DIVISION.
Line 1,081 ⟶ 1,329:
GOBACK
.
END PROGRAM perfect-main.</langsyntaxhighlight>
 
perfect.cbl:
<langsyntaxhighlight lang="cobol"> IDENTIFICATION DIVISION.
FUNCTION-ID. perfect.
Line 1,120 ⟶ 1,368:
GOBACK
.
END FUNCTION perfect.</langsyntaxhighlight>
 
=={{header|CoffeeScript}}==
Optimized version, for fun.
<langsyntaxhighlight lang="coffeescript">is_perfect_number = (n) ->
do_factors_add_up_to n, 2*n
Line 1,172 ⟶ 1,420:
for n in known_perfects
throw Error("fail") unless is_perfect_number(n)
throw Error("fail") if is_perfect_number(n+1)</langsyntaxhighlight>
{{Out}}
<pre>
Line 1,184 ⟶ 1,432:
=={{header|Common Lisp}}==
{{trans|Haskell}}
<langsyntaxhighlight lang="lisp">(defun perfectp (n)
(= n (loop for i from 1 below n when (= 0 (mod n i)) sum i)))</langsyntaxhighlight>
 
=={{header|D}}==
===Functional Version===
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.range;
 
bool isPerfectNumber1(in uint n) pure nothrow
Line 1,200 ⟶ 1,448:
void main() {
iota(1, 10_000).filter!isPerfectNumber1.writeln;
}</langsyntaxhighlight>
{{out}}
<pre>[6, 28, 496, 8128]</pre>
Line 1,206 ⟶ 1,454:
===Faster Imperative Version===
{{trans|Algol}}
<langsyntaxhighlight lang="d">import std.stdio, std.math, std.range, std.algorithm;
 
bool isPerfectNumber2(in int n) pure nothrow {
Line 1,226 ⟶ 1,474:
void main() {
10_000.iota.filter!isPerfectNumber2.writeln;
}</langsyntaxhighlight>
{{out}}
<pre>[6, 28, 496, 8128]</pre>
Line 1,234 ⟶ 1,482:
=={{header|Dart}}==
=== Explicit Iterative Version ===
<langsyntaxhighlight lang="d">/*
* 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
Line 1,256 ⟶ 1,504:
// We return the test if n is equal to sumOfDivisors
return n == sumOfDivisors;
}</langsyntaxhighlight>
 
=== Compact Version ===
{{trans|Julia}}
<langsyntaxhighlight lang="d">isPerfect(n) =>
n == new List.generate(n-1, (i) => n%(i+1) == 0 ? i+1 : 0).fold(0, (p,n)=>p+n);</langsyntaxhighlight>
 
In either case, if we test to find all the perfect numbers up to 1000, we get:
<langsyntaxhighlight lang="d">main() =>
new List.generate(1000,(i)=>i+1).where(isPerfect).forEach(print);</langsyntaxhighlight>
{{out}}
<pre>6
Line 1,274 ⟶ 1,522:
=={{header|Dyalect}}==
 
<langsyntaxhighlight lang="dyalect">func isPerfect(num) {
var sum = 0
for i in 1..<num {
Line 1,294 ⟶ 1,542:
print("\(x) is perfect")
}
}</langsyntaxhighlight>
 
=={{header|E}}==
<langsyntaxhighlight lang="e">pragma.enable("accumulator")
def isPerfectNumber(x :int) {
var sum := 0
Line 1,305 ⟶ 1,553:
}
return sum <=> x
}</langsyntaxhighlight>
 
=={{header|EasyLang}}==
<syntaxhighlight lang=easylang>
func perf n .
for i = 1 to n - 1
if n mod i = 0
sum += i
.
.
return if sum = n
.
for i = 2 to 10000
if perf i = 1
print i
.
.
</syntaxhighlight>
 
=={{header|Eiffel}}==
<syntaxhighlight lang="eiffel">
<lang Eiffel>
class
APPLICATION
Line 1,350 ⟶ 1,615:
 
end
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,360 ⟶ 1,625:
 
=={{header|Elena}}==
ELENA 46.x:
<langsyntaxhighlight lang="elena">import system'routines;
import system'math;
import extensions;
Line 1,368 ⟶ 1,633:
{
isPerfect()
= new Range(1, self - 1).selectBy::(n => (self.mod:(n) == 0).iif(n,0) ).summarize(new Integer()) == self;
}
public program()
{
for(int n := 1,; n < 10000,; n += 1)
{
if(n.isPerfect())
Line 1,380 ⟶ 1,645:
console.readChar()
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,390 ⟶ 1,655:
 
=={{header|Elixir}}==
<langsyntaxhighlight lang="elixir">defmodule RC do
def is_perfect(1), do: false
def is_perfect(n) when n > 1 do
Line 1,402 ⟶ 1,667:
end
 
IO.inspect (for i <- 1..10000, RC.is_perfect(i), do: i)</langsyntaxhighlight>
 
{{out}}
Line 1,410 ⟶ 1,675:
 
=={{header|Erlang}}==
<langsyntaxhighlight lang="erlang">is_perfect(X) ->
X == lists:sum([N || N <- lists:seq(1,X-1), X rem N == 0]).</langsyntaxhighlight>
 
=={{header|ERRE}}==
<langsyntaxhighlight ERRElang="erre">PROGRAM PERFECT
 
PROCEDURE PERFECT(N%->OK%)
Line 1,432 ⟶ 1,697:
IF OK% THEN PRINT(N%)
END FOR
END PROGRAM</langsyntaxhighlight>
{{Out}}
<pre>
Line 1,442 ⟶ 1,707:
 
=={{header|F_Sharp|F#}}==
<langsyntaxhighlight 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</langsyntaxhighlight>
{{Out}}
<pre>6 is perfect
Line 1,452 ⟶ 1,717:
 
=={{header|Factor}}==
<langsyntaxhighlight lang="factor">USING: kernel math math.primes.factors sequences ;
IN: rosettacode.perfect-numbers
 
: perfect? ( n -- ? ) [ divisors sum ] [ 2 * ] bi = ;</langsyntaxhighlight>
 
=={{header|FALSE}}==
<langsyntaxhighlight lang="false">[0\1[\$@$@-][\$@$@$@$@\/*=[@\$@+@@]?1+]#%=]p:
45p;!." "28p;!. { 0 -1 }</langsyntaxhighlight>
 
=={{header|Forth}}==
<langsyntaxhighlight lang="forth">: perfect? ( n -- ? )
1
over 2/ 1+ 2 ?do
over i mod 0= if i + then
loop
= ;</langsyntaxhighlight>
 
=={{header|Fortran}}==
{{works with|Fortran|90 and later}}
<langsyntaxhighlight lang="fortran">FUNCTION isPerfect(n)
LOGICAL :: isPerfect
INTEGER, INTENT(IN) :: n
Line 1,482 ⟶ 1,747:
END DO
IF (factorsum == n) isPerfect = .TRUE.
END FUNCTION isPerfect</langsyntaxhighlight>
 
=={{header|FreeBASIC}}==
{{trans|C (with some modifications)}}
<langsyntaxhighlight lang="freebasic">' FB 1.05.0 Win64
 
Function isPerfect(n As Integer) As Boolean
Line 1,509 ⟶ 1,774:
Print
Print "Press any key to quit"
Sleep</langsyntaxhighlight>
 
{{out}}
Line 1,515 ⟶ 1,780:
The first 5 perfect numbers are :
6 28 496 8128 33550336
</pre>
 
=={{header|Frink}}==
<syntaxhighlight lang="frink">isPerfect = {|n| sum[allFactors[n, true, false]] == n}
println[select[1 to 1000, isPerfect]]</syntaxhighlight>
 
{{out}}
<pre>[1, 6, 28, 496]
</pre>
 
=={{header|FunL}}==
<langsyntaxhighlight lang="funl">def perfect( n ) = sum( d | d <- 1..n if d|n ) == 2n
 
println( (1..500).filter(perfect) )</langsyntaxhighlight>
 
{{out}}
Line 1,526 ⟶ 1,799:
<pre>
(6, 28, 496)
</pre>
 
=={{header|FutureBasic}}==
<syntaxhighlight lang="futurebasic">
 
_maxNum = 10000
 
local fn IsPerfectNumber( n as long ) as BOOL
—————————————————————————————————————————————
if ( n < 2 ) then exit fn = NO
if ( n mod 2 == 1 ) then exit fn = NO
long sum = 1, q, i
for i = 2 to sqr(n)
if ( n mod i == 0 )
sum += i
q = n / i
if ( q > i ) then sum += q
end if
next
end fn = ( n == sum )
 
printf @"Perfect numbers in range %ld..%ld",2,_maxNum
 
long i
for i = 2 To _maxNum
if ( fn IsPerfectNumber(i) ) then print i
next
 
HandleEvents
</syntaxhighlight>
 
{{out}}
<pre>
Perfect numbers in range 2..10000
6
28
496
8128
</pre>
 
=={{header|GAP}}==
<langsyntaxhighlight lang="gap">Filtered([1 .. 10000], n -> Sum(DivisorsInt(n)) = 2*n);
# [ 6, 28, 496, 8128 ]</langsyntaxhighlight>
 
=={{header|Go}}==
 
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 1,571 ⟶ 1,882:
}
 
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 1,582 ⟶ 1,893:
=={{header|Groovy}}==
Solution:
<langsyntaxhighlight lang="groovy">def isPerfect = { n ->
n > 4 && (n == (2..Math.sqrt(n)).findAll { n % it == 0 }.inject(1) { factorSum, i -> factorSum += i + n/i })
}</langsyntaxhighlight>
Test program:
<langsyntaxhighlight lang="groovy">(0..10000).findAll { isPerfect(it) }.each { println it }</langsyntaxhighlight>
{{Out}}
<pre>6
Line 1,594 ⟶ 1,905:
 
=={{header|Haskell}}==
<langsyntaxhighlight lang="haskell">perfect n =
n == sum [i | i <- [1..n-1], n `mod` i == 0]</langsyntaxhighlight>
 
Create a list of known perfects:
<langsyntaxhighlight lang="haskell">perfect =
(\x -> (2 ^ x - 1) * (2 ^ (x - 1))) <$>
filter (\x -> isPrime x && isPrime (2 ^ x - 1)) maybe_prime
Line 1,616 ⟶ 1,927:
main = do
mapM_ print $ take 10 perfect
mapM_ (print . (\x -> (x, isPerfect x))) [6, 27, 28, 29, 496, 8128, 8129]</langsyntaxhighlight>
 
 
or, restricting the search space to improve performance:
<langsyntaxhighlight lang="haskell">isPerfect :: Int -> Bool
isPerfect n =
let lows = filter ((0 ==) . rem n) [1 .. floor (sqrt (fromIntegral n))]
Line 1,635 ⟶ 1,946:
 
main :: IO ()
main = print $ filter isPerfect [1 .. 10000]</langsyntaxhighlight>
{{Out}}
<pre>[6,28,496,8128]</pre>
 
=={{header|HicEst}}==
<langsyntaxhighlight HicEstlang="hicest"> DO i = 1, 1E4
IF( perfect(i) ) WRITE() i
ENDDO
Line 1,651 ⟶ 1,962:
ENDDO
perfect = sum == n
END</langsyntaxhighlight>
 
=={{header|Icon}} and {{header|Unicon}}==
<langsyntaxhighlight Iconlang="icon">procedure main(arglist)
limit := \arglist[1] | 100000
write("Perfect numbers from 1 to ",limit,":")
Line 1,668 ⟶ 1,979:
end
 
link factors</langsyntaxhighlight>
 
{{libheader|Icon Programming Library}} [http://www.cs.arizona.edu/icon/library/src/procs/factors.icn Uses divisors from factors]
Line 1,681 ⟶ 1,992:
 
=={{header|J}}==
<langsyntaxhighlight lang="j">is_perfect=: +: = >:@#.~/.~&.q:@(6>.<.)</langsyntaxhighlight>
 
Examples of use, including extensions beyond those assumptions:
<langsyntaxhighlight lang="j"> is_perfect 33550336
1
I. is_perfect i. 100000
Line 1,698 ⟶ 2,009:
0 0 0 0 0 0 0 0 1 0
is_perfect 191561942608236107294793378084303638130997321548169216x
1</langsyntaxhighlight>
 
More efficient version based on [http://jsoftware.com/pipermail/programming/2014-June/037695.html comments] by Henry Rich and Roger Hui (comment train seeded by Jon Hough).
 
=={{header|Java}}==
<langsyntaxhighlight lang="java">public static boolean perf(int n){
int sum= 0;
for(int i= 1;i < n;i++){
Line 1,711 ⟶ 2,022:
}
return sum == n;
}</langsyntaxhighlight>
Or for arbitrary precision:[[Category:Arbitrary precision]]
<langsyntaxhighlight lang="java">import java.math.BigInteger;
 
public static boolean perf(BigInteger n){
Line 1,724 ⟶ 2,035:
}
return sum.equals(n);
}</langsyntaxhighlight>
 
=={{header|JavaScript}}==
Line 1,731 ⟶ 2,042:
 
{{trans|Java}}
<langsyntaxhighlight lang="javascript">function is_perfect(n)
{
var sum = 1, i, sqrt=Math.floor(Math.sqrt(n));
Line 1,751 ⟶ 2,062:
if (is_perfect(i))
print(i);
}</langsyntaxhighlight>
 
{{Out}}
Line 1,765 ⟶ 2,076:
Naive version (brute force)
 
<langsyntaxhighlight JavaScriptlang="javascript">(function (nFrom, nTo) {
 
function perfect(n) {
Line 1,783 ⟶ 2,094:
return range(nFrom, nTo).filter(perfect);
 
})(1, 10000);</langsyntaxhighlight>
 
Output:
 
<langsyntaxhighlight JavaScriptlang="javascript">[6, 28, 496, 8128]</langsyntaxhighlight>
 
Much faster (more efficient factorisation)
 
<langsyntaxhighlight JavaScriptlang="javascript">(function (nFrom, nTo) {
 
function perfect(n) {
Line 1,813 ⟶ 2,124:
return range(nFrom, nTo).filter(perfect)
 
})(1, 10000);</langsyntaxhighlight>
 
Output:
 
<langsyntaxhighlight JavaScriptlang="javascript">[6, 28, 496, 8128]</langsyntaxhighlight>
 
Note that the filter function, though convenient and well optimised, is not strictly necessary.
Line 1,823 ⟶ 2,134:
(Monadic return/inject for lists is simply lambda x --> [x], inlined here, and fail is [].)
 
<langsyntaxhighlight JavaScriptlang="javascript">(function (nFrom, nTo) {
 
// MONADIC CHAIN (bind) IN LIEU OF FILTER
Line 1,857 ⟶ 2,168:
}
 
})(1, 10000);</langsyntaxhighlight>
 
Output:
<langsyntaxhighlight JavaScriptlang="javascript">[6, 28, 496, 8128]</langsyntaxhighlight>
 
 
====ES6====
 
<langsyntaxhighlight JavaScriptlang="javascript">(() => {
const main = () =>
enumFromTo(1, 10000).filter(perfect);
Line 1,889 ⟶ 2,200:
// MAIN ---
return main();
})();</langsyntaxhighlight>
 
{{Out}}
<langsyntaxhighlight JavaScriptlang="javascript">[6, 28, 496, 8128]</langsyntaxhighlight>
 
=={{header|jq}}==
<syntaxhighlight lang="jq">
<lang jq>
def is_perfect:
. as $in
Line 1,902 ⟶ 2,213:
 
# Example:
range(1;10001) | select( is_perfect )</langsyntaxhighlight>
{{Out}}
$ jq -n -f is_perfect.jq
Line 1,913 ⟶ 2,224:
{{works with|Julia|0.6}}
 
<langsyntaxhighlight lang="julia">isperfect(n::Integer) = n == sum([n % i == 0 ? i : 0 for i = 1:(n - 1)])
perfects(n::Integer) = filter(isperfect, 1:n)
 
@show perfects(10000)</langsyntaxhighlight>
 
{{out}}
Line 1,923 ⟶ 2,234:
=={{header|K}}==
{{trans|J}}
<langsyntaxhighlight Klang="k"> perfect:{(x>2)&x=+/-1_{d:&~x!'!1+_sqrt x;d,_ x%|d}x}
perfect 33550336
1
Line 1,938 ⟶ 2,249:
(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)</langsyntaxhighlight>
 
=={{header|Kotlin}}==
{{trans|C}}
<langsyntaxhighlight lang="scala">// version 1.0.6
 
fun isPerfect(n: Int): Boolean = when {
Line 1,965 ⟶ 2,276:
println("The first five perfect numbers are:")
for (i in 2 .. 33550336) if (isPerfect(i)) print("$i ")
}</langsyntaxhighlight>
 
{{out}}
Line 1,975 ⟶ 2,286:
=={{header|LabVIEW}}==
{{VI solution|LabVIEW_Perfect_numbers.png}}
 
=={{header|Lambdatalk}}==
 
===simple & slow===
<syntaxhighlight lang="scheme">
{def perf
{def perf.sum
{lambda {:n :sum :i}
{if {>= :i :n}
then {= :sum :n}
else {perf.sum :n
{if {= {% :n :i} 0}
then {+ :sum :i}
else :sum}
{+ :i 1}} }}}
{lambda {:n}
{perf.sum :n 0 2} }}
-> perf
 
{S.replace \s by space in
{S.map {lambda {:i} {if {perf :i} then :i else}}
{S.serie 2 1000 2}}}
-> 6 28 496 // 5200ms
</syntaxhighlight>
 
Too slow (and stackoverflow) to go further.
 
===improved===
 
<syntaxhighlight lang="scheme">
{def lt_perfect
{def lt_perfect.sum
{lambda {:n :sum :i}
{if {> :i 1}
then {lt_perfect.sum :n
{if {= {% :n :i} 0}
then {+ :sum :i {floor {/ :n :i}}}
else :sum}
{- :i 1}}
else :sum }}}
{lambda {:n}
{let { {:n :n}
{:sqrt {floor {sqrt :n}}}
{:sum {lt_perfect.sum :n 1 {- {floor {sqrt :n}} 0} }}
{:foo {if {= {* :sqrt :sqrt} :n}
then 0
else {floor {/ :n :sqrt}}}}
} {= :n {if {= {% :n :sqrt} 0}
then {+ :sum :sqrt :foo}
else :sum}} }}}
-> lt_perfect
 
-> {S.replace \s by space in
{S.map {lambda {:i} {if {lt_perfect :i} then :i else}}
{S.serie 6 10000 2}}}
-> 28 496 8128 // 7500ms
</syntaxhighlight>
 
===calling javascript===
Following the javascript entry.
<syntaxhighlight lang="scheme">
 
{S.replace \s by space in
{S.map {lambda {:i} {if {js_perfect :i} then :i else}}
{S.serie 2 10000}}}
-> 6 28 496 8128 // 80ms
 
{script
LAMBDATALK.DICT["js_perfect"] = function() {
function js_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 args = arguments[0].trim();
return (js_perfect( Number(args) )) ? "true" : "false"
};
 
}
</syntaxhighlight>
 
=={{header|Lasso}}==
<langsyntaxhighlight lang="lasso">#!/usr/bin/lasso9
define isPerfect(n::integer) => {
Line 1,991 ⟶ 2,388:
with x in generateSeries(1, 10000)
where isPerfect(#x)
select #x</langsyntaxhighlight>
{{Out}}
<syntaxhighlight lang ="lasso">6, 28, 496, 8128</langsyntaxhighlight>
 
=={{header|Liberty BASIC}}==
<langsyntaxhighlight lang="lb">for n =1 to 10000
if perfect( n) =1 then print n; " is perfect."
next n
Line 2,014 ⟶ 2,411:
perfect =0
end if
end function</langsyntaxhighlight>
 
=={{header|Lingo}}==
<langsyntaxhighlight lang="lingo">on isPercect (n)
sum = 1
cnt = n/2
Line 2,024 ⟶ 2,421:
end repeat
return sum=n
end</langsyntaxhighlight>
 
=={{header|Logo}}==
<langsyntaxhighlight lang="logo">to perfect? :n
output equal? :n apply "sum filter [equal? 0 modulo :n ?] iseq 1 :n/2
end</langsyntaxhighlight>
 
=={{header|Lua}}==
<langsyntaxhighlight Lualang="lua">function isPerfect(x)
local sum = 0
for i = 1, x-1 do
Line 2,038 ⟶ 2,435:
end
return sum == x
end</langsyntaxhighlight>
 
=={{header|M2000 Interpreter}}==
<syntaxhighlight lang="m2000 interpreter">
<lang M2000 Interpreter>
Module PerfectNumbers {
Function Is_Perfect(n as decimal) {
Line 2,113 ⟶ 2,510:
PerfectNumbers
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,132 ⟶ 2,529:
 
=={{header|M4}}==
<langsyntaxhighlight M4lang="m4">define(`for',
`ifelse($#,0,``$0'',
`ifelse(eval($2<=$3),1,
Line 2,150 ⟶ 2,547:
for(`x',`2',`33550336',
`ifelse(isperfect(x),1,`x
')')</langsyntaxhighlight>
 
=={{header|MAD}}==
 
<langsyntaxhighlight MADlang="mad"> NORMAL MODE IS INTEGER
R FUNCTION THAT CHECKS IF NUMBER IS PERFECT
Line 2,172 ⟶ 2,569:
PRINT COMMENT $ $
END OF PROGRAM
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,183 ⟶ 2,580:
 
=={{header|Maple}}==
<langsyntaxhighlight Maplelang="maple">isperfect := proc(n) return evalb(NumberTheory:-SumOfDivisors(n) = 2*n); end proc:
isperfect(6);
true</langsyntaxhighlight>
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
Custom function:
<langsyntaxhighlight Mathematicalang="mathematica">PerfectQ[i_Integer] := Total[Divisors[i]] == 2 i</langsyntaxhighlight>
Examples (testing 496, testing 128, finding all perfect numbers in 1...10000):
<langsyntaxhighlight Mathematicalang="mathematica">PerfectQ[496]
PerfectQ[128]
Flatten[PerfectQ/@Range[10000]//Position[#,True]&]</langsyntaxhighlight>
gives back:
<syntaxhighlight lang="mathematica">True
<lang Mathematica>True
False
{6,28,496,8128}</langsyntaxhighlight>
 
=={{header|MATLAB}}==
Standard algorithm:
<langsyntaxhighlight MATLABlang="matlab">function perf = isPerfect(n)
total = 0;
for k = 1:n-1
Line 2,209 ⟶ 2,606:
end
perf = total == n;
end</langsyntaxhighlight>
Faster algorithm:
<langsyntaxhighlight MATLABlang="matlab">function perf = isPerfect(n)
if n < 2
perf = false;
Line 2,230 ⟶ 2,627:
perf = total == n;
end
end</langsyntaxhighlight>
 
=={{header|Maxima}}==
<langsyntaxhighlight lang="maxima">".."(a, b) := makelist(i, i, a, b)$
infix("..")$
 
Line 2,239 ⟶ 2,636:
 
sublist(1 .. 10000, perfectp);
/* [6, 28, 496, 8128] */</langsyntaxhighlight>
 
=={{header|MAXScript}}==
<langsyntaxhighlight lang="maxscript">fn isPerfect n =
(
local sum = 0
Line 2,253 ⟶ 2,650:
)
sum == n
)</langsyntaxhighlight>
 
=={{header|Microsoft Small Basic}}==
{{trans|BBC BASIC}}
<langsyntaxhighlight lang="microsoftsmallbasic">
For n = 2 To 10000 Step 2
VerifyIfPerfect()
Line 2,287 ⟶ 2,684:
EndIf
EndSub
</syntaxhighlight>
</lang>
 
=={{header|Modula-2}}==
{{trans|BBC BASIC}}
{{works with|ADW Modula-2|any (Compile with the linker option ''Console Application'').}}
<langsyntaxhighlight lang="modula2">
MODULE PerfectNumbers;
 
Line 2,336 ⟶ 2,733:
END;
END PerfectNumbers.
</syntaxhighlight>
</lang>
 
=={{header|Nanoquery}}==
{{trans|Python}}
<langsyntaxhighlight Nanoquerylang="nanoquery">def perf(n)
sum = 0
for i in range(1, n - 1)
Line 2,348 ⟶ 2,745:
end
return sum = n
end</langsyntaxhighlight>
 
=={{header|Nim}}==
<langsyntaxhighlight lang="nim">import math
 
proc isPerfect(n: int): bool =
Line 2,364 ⟶ 2,761:
for n in 2..10_000:
if n.isPerfect:
echo n</langsyntaxhighlight>
 
{{out}}
Line 2,373 ⟶ 2,770:
 
=={{header|Objeck}}==
<langsyntaxhighlight lang="objeck">bundle Default {
class Test {
function : Main(args : String[]) ~ Nil {
Line 2,395 ⟶ 2,792:
}
}
}</langsyntaxhighlight>
 
=={{header|OCaml}}==
<langsyntaxhighlight lang="ocaml">let perf n =
let sum = ref 0 in
for i = 1 to n-1 do
Line 2,404 ⟶ 2,801:
sum := !sum + i
done;
!sum = n</langsyntaxhighlight>
Functional style:
<langsyntaxhighlight lang="ocaml">(* range operator *)
let rec (--) a b =
if a > b then
Line 2,413 ⟶ 2,810:
a :: (a+1) -- b
 
let perf n = n = List.fold_left (+) 0 (List.filter (fun i -> n mod i = 0) (1 -- (n-1)))</langsyntaxhighlight>
 
=={{header|Oforth}}==
 
<langsyntaxhighlight Oforthlang="oforth">: isPerfect(n) | i | 0 n 2 / loop: i [ n i mod ifZero: [ i + ] ] n == ; </langsyntaxhighlight>
 
{{out}}
Line 2,423 ⟶ 2,820:
#isPerfect 10000 seq filter .
[6, 28, 496, 8128]
</pre>
 
=={{header|Odin}}==
<syntaxhighlight lang="Go">
package perfect_numbers
import "core:fmt"
main :: proc() {
fmt.println("\nPerfect numbers from 1 to 100,000:\n")
for num in 1 ..< 100001 {
if divisor_sum(num) == num {
fmt.print("num:", num, "\n")
}
if num % 10000 == 0 {
fmt.print("Count:", num, "\n")
}
}
}
divisor_sum :: proc(number: int) -> int {
sum := 0
for i in 1 ..< number {
if number % i == 0 {
sum += i}
}
return sum
}
</syntaxhighlight>
{{out}}
<pre>
Perfect numbers from 1 to 100,000:
num: 6
num: 28
num: 496
num: 8128
</pre>
 
=={{header|ooRexx}}==
<langsyntaxhighlight ooRexxlang="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"
Line 2,442 ⟶ 2,872:
end
 
return sum = n</langsyntaxhighlight>
{{out}}
<pre>6 is a perfect number
Line 2,450 ⟶ 2,880:
 
=={{header|Oz}}==
<langsyntaxhighlight lang="oz">declare
fun {IsPerfect N}
fun {IsNFactor I} N mod I == 0 end
Line 2,461 ⟶ 2,891:
in
{Show {Filter {List.number 1 10000 1} IsPerfect}}
{Show {IsPerfect 33550336}}</langsyntaxhighlight>
 
=={{header|PARI/GP}}==
===Using built-in methods===
Uses built-in method. Faster tests would use the LL test for evens and myriad results on OPNs otherwise.
<syntaxhighlight lang="parigp">
<lang parigp>isPerfect(n)=sigma(n,-1)==2</lang>
isPerfect(n)=sigma(n,-1)==2
</syntaxhighlight>
or
<syntaxhighlight lang="parigp">
isPerfect(n)=sigma(n)==2*n
</syntaxhighlight>
 
Show perfect numbers
 
<lang parigp>forprime(p=2, 2281,
<syntaxhighlight lang="parigp">
forprime(p=2, 2281,
if(isprime(2^p-1),
print(p"\t",(2^p-1)*2^(p-1))))</lang>
</syntaxhighlight>
Faster with Lucas-Lehmer test
 
<lang parigp>p=2;n=3;n1=2;
faster alternative showing them still using built-in methods
 
<syntaxhighlight lang="parigp">
[n|n<-[1..10^4],sigma(n,-1)==2]
</syntaxhighlight>
 
{{Out}}
<pre>
[6, 28, 496, 8128]
</pre>
 
===Faster with Lucas-Lehmer test===
<syntaxhighlight lang="parigp">p=2;n=3;n1=2;
while(p<2281,
if(isprime(p),
Line 2,479 ⟶ 2,931:
if(s==0 || p==2,
print("(2^"p"-1)2^("p"-1)=\t"n1*n"\n")));
p++; n1=n+1; n=2*n+1)</langsyntaxhighlight>
{{Out}}
<pre>(2^2-1)2^(2-1)= 6
Line 2,493 ⟶ 2,945:
 
=={{header|Pascal}}==
<langsyntaxhighlight lang="pascal">program PerfectNumbers;
 
function isPerfect(number: longint): boolean;
Line 2,515 ⟶ 2,967:
if isPerfect(candidate) then
writeln (candidate, ' is a perfect number.');
end.</langsyntaxhighlight>
{{Out}}
<pre>
Line 2,528 ⟶ 2,980:
=={{header|Perl}}==
=== Functions ===
<langsyntaxhighlight lang="perl">sub perf {
my $n = shift;
my $sum = 0;
Line 2,537 ⟶ 2,989:
}
return $sum == $n;
}</langsyntaxhighlight>
Functional style:
<langsyntaxhighlight lang="perl">use List::Util qw(sum);
 
sub perf {
my $n = shift;
$n == sum(0, grep {$n % $_ == 0} 1..$n-1);
}</langsyntaxhighlight>
=== Modules ===
The functions above are terribly slow. As usual, this is easier and faster with modules. Both ntheory and Math::Pari have useful functions for this.
{{libheader|ntheory}}
A simple predicate:
<langsyntaxhighlight lang="perl">use ntheory qw/divisor_sum/;
sub is_perfect { my $n = shift; divisor_sum($n) == 2*$n; }</langsyntaxhighlight>
Use this naive method to show the first 5. Takes about 15 seconds:
<langsyntaxhighlight lang="perl">use ntheory qw/divisor_sum/;
for (1..33550336) {
print "$_\n" if divisor_sum($_) == 2*$_;
}</langsyntaxhighlight>
Or we can be clever and look for 2^(p-1) * (2^p-1) where 2^p -1 is prime. The first 20 takes about a second.
<langsyntaxhighlight lang="perl">use ntheory qw/forprimes is_prime/;
use bigint;
forprimes {
my $n = 2**$_ - 1;
print "$_\t", $n * 2**($_-1),"\n" if is_prime($n);
} 2, 4500;</langsyntaxhighlight>
{{out}}
<pre>
Line 2,579 ⟶ 3,031:
 
We can speed this up even more using a faster program for printing the large results, as well as a faster primality solution. The first 38 in about 1 second with most of the time printing the large results. Caveat: this goes well past the current bound for odd perfect numbers and does not check for them.
<langsyntaxhighlight lang="perl">use ntheory qw/forprimes is_mersenne_prime/;
use Math::GMP qw/:constant/;
forprimes {
print "$_\t", (2**$_-1)*2**($_-1),"\n" if is_mersenne_prime($_);
} 7_000_000;</langsyntaxhighlight>
 
In addition to generating even perfect numbers, we can also have a fast function which returns true when a given even number is perfect:
<langsyntaxhighlight lang="perl">use ntheory qw(is_mersenne_prime valuation);
 
sub is_even_perfect {
Line 2,595 ⟶ 3,047:
($m >> $v) == 1 || return;
is_mersenne_prime($v + 1);
}</langsyntaxhighlight>
 
=={{header|Phix}}==
<!--(phixonline)-->
<lang Phix>function is_perfect(integer n)
=== naive/native ===
<syntaxhighlight lang="phix">
function is_perfect(integer n)
return sum(factors(n,-1))=n
end function
Line 2,604 ⟶ 3,059:
for i=2 to 100000 do
if is_perfect(i) then ?i end if
end for</lang>
</syntaxhighlight>
{{out}}
<pre>
Line 2,614 ⟶ 3,070:
=== gmp version ===
{{libheader|Phix/mpfr}}
<syntaxhighlight lang="phix">
<lang Phix>-- demo\rosetta\Perfect_numbers.exw (includes native version above)
with javascript_semantics
-- demo\rosetta\Perfect_numbers.exw (includes native and cheat versions)
include mpfr.e
mpzatom nt0 = mpz_inittime(), pt1 = mpz_init()t0+1
integer maxprime = 4423, -- 19937 (rather slow)
randstate state = gmp_randinit_mt()
lim = length(get_primes_le(maxprime))
for i=2 to 159 do
mpz n = mpz_init(), m = mpz_init()
mpz_ui_pow_ui(n, 2, i)
for i=1 to lim do
integer p = get_prime(i)
mpz_ui_pow_ui(n, 2, p)
mpz_sub_ui(n, n, 1)
if mpz_probable_prime_pmpz_prime(n, state) then
mpz_ui_pow_ui(pm, 2,i p-1)
mpz_mul(n, n,p m)
printf(1,string "%dns = %s\n",{i,mpz_get_strmpz_get_short_str(n,comma_fill:=true)}),
et = elapsed_short(time()-t0,5,"(%s)")
printf(1, "%d %s %s\n",{p,ns,et})
elsif time()>t1 then
progress("%d/%d (%.1f%%)\r",{p,maxprime,i/lim*100})
t1 = time()+1
end if
end for
?elapsed(time()-t0)
n = mpz_free(n)
</syntaxhighlight>
state = gmp_randclear(state)</lang>
{{out}}
<pre>
Line 2,640 ⟶ 3,106:
31 2,305,843,008,139,952,128
61 2,658,455,991,569,831,744,654,692,615,953,842,176
89 191,561,942,608,236,107,294,793,378,084,303,638,130...,997,321,548,169,216 (54 digits)
107 13,164,036,458,569,648,337,239,753,460,458,722,910,223,472,318,3866...,943,117,783,728,128 (65 digits)
127 14,474,011,154,664,524,427,946,373,126,085,988,481,573,677,491,474,835,889,066,3545...,349,131,199,152,128 (77 digits)
521 23,562,723,457,267,3...,492,160,555,646,976 (314 digits)
607 141,053,783,706,712,...,570,759,537,328,128 (366 digits)
1279 54,162,526,284,365,8...,345,764,984,291,328 (770 digits)
2203 1,089,258,355,057,82...,580,834,453,782,528 (1,327 digits)
2281 99,497,054,337,086,4...,375,675,139,915,776 (1,373 digits)
3217 33,570,832,131,986,7...,888,332,628,525,056 (1,937 digits) (9s)
4253 18,201,749,040,140,4...,848,437,133,377,536 (2,561 digits) (24s)
4423 40,767,271,711,094,4...,020,642,912,534,528 (2,663 digits) (28s)
"28.4s"
</pre>
Beyond that it gets rather slow:
<pre>
9689 11,434,731,753,038,6...,982,558,429,577,216 (5,834 digits) (6:28)
9941 598,885,496,387,336,...,478,324,073,496,576 (5,985 digits) (7:31)
11213 3,959,613,212,817,94...,255,702,691,086,336 (6,751 digits) (11:32)
19937 931,144,559,095,633,...,434,790,271,942,656 (12,003 digits) (1:22:32)
</pre>
=== cheating ===
{{trans|Picat}}
<syntaxhighlight lang="phix">
include mpfr.e
atom t0 = time()
mpz n = mpz_init(), m = mpz_init()
sequence validp = {2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607,
1279, 2203, 2281, 3217, 4253, 4423, 9689, 9941, 11213,
19937, 21701, 23209, 44497, 86243, 110503, 132049, 216091,
756839, 859433, 1257787, 1398269, 2976221, 3021377, 6972593,
13466917, 20996011, 24036583, 25964951, 30402457, 32582657,
37156667, 42643801, 43112609, 57885161,
74207281, 77232917, 82589933}
if platform()=JS then validp = validp[1..35] end if -- (keep it under 5s)
for p in validp do
mpz_ui_pow_ui(n, 2, p)
mpz_sub_ui(n, n, 1)
mpz_ui_pow_ui(m, 2, p-1)
mpz_mul(n, n, m)
string ns = mpz_get_short_str(n,comma_fill:=true),
et = elapsed_short(time()-t0,5,"(%s)")
printf(1, "%d %s %s\n",{p,ns,et})
end for
?elapsed(time()-t0)
</syntaxhighlight>
<pre>
2 6
3 28
5 496
7 8,128
13 33,550,336
17 8,589,869,056
19 137,438,691,328
31 2,305,843,008,139,952,128
61 2,658,455,991,569,831,744,654,692,615,953,842,176
89 191,561,942,608,236,...,997,321,548,169,216 (54 digits)
107 13,164,036,458,569,6...,943,117,783,728,128 (65 digits)
127 14,474,011,154,664,5...,349,131,199,152,128 (77 digits)
521 23,562,723,457,267,3...,492,160,555,646,976 (314 digits)
607 141,053,783,706,712,...,570,759,537,328,128 (366 digits)
1279 54,162,526,284,365,8...,345,764,984,291,328 (770 digits)
2203 1,089,258,355,057,82...,580,834,453,782,528 (1,327 digits)
2281 99,497,054,337,086,4...,375,675,139,915,776 (1,373 digits)
3217 33,570,832,131,986,7...,888,332,628,525,056 (1,937 digits)
4253 18,201,749,040,140,4...,848,437,133,377,536 (2,561 digits)
4423 40,767,271,711,094,4...,020,642,912,534,528 (2,663 digits)
9689 11,434,731,753,038,6...,982,558,429,577,216 (5,834 digits)
9941 598,885,496,387,336,...,478,324,073,496,576 (5,985 digits)
11213 3,959,613,212,817,94...,255,702,691,086,336 (6,751 digits)
19937 931,144,559,095,633,...,434,790,271,942,656 (12,003 digits)
21701 1,006,564,970,546,40...,865,255,141,605,376 (13,066 digits)
23209 81,153,776,582,351,0...,048,603,941,666,816 (13,973 digits)
44497 365,093,519,915,713,...,965,353,031,827,456 (26,790 digits)
86243 144,145,836,177,303,...,480,957,360,406,528 (51,924 digits)
110503 13,620,458,213,388,4...,255,233,603,862,528 (66,530 digits)
132049 13,145,129,545,436,9...,438,491,774,550,016 (79,502 digits)
216091 27,832,745,922,032,7...,263,416,840,880,128 (130,100 digits)
756839 15,161,657,022,027,0...,971,600,565,731,328 (455,663 digits)
859433 83,848,822,675,015,7...,651,540,416,167,936 (517,430 digits)
1257787 849,732,889,343,651,...,394,028,118,704,128 (757,263 digits)
1398269 331,882,354,881,177,...,668,017,723,375,616 (841,842 digits)
2976221 194,276,425,328,791,...,106,724,174,462,976 (1,791,864 digits)
3021377 811,686,848,628,049,...,147,573,022,457,856 (1,819,050 digits)
6972593 9,551,760,305,212,09...,914,475,123,572,736 (4,197,919 digits)
13466917 42,776,415,902,185,6...,230,460,863,021,056 (8,107,892 digits)
20996011 7,935,089,093,651,70...,903,578,206,896,128 (12,640,858 digits)
24036583 44,823,302,617,990,8...,680,460,572,950,528 (14,471,465 digits) (5s)
25964951 7,462,098,419,004,44...,245,874,791,088,128 (15,632,458 digits) (8s)
30402457 49,743,776,545,907,0...,934,536,164,704,256 (18,304,103 digits) (10s)
32582657 77,594,685,533,649,8...,428,476,577,120,256 (19,616,714 digits) (13s)
37156667 20,453,422,553,410,5...,147,975,074,480,128 (22,370,543 digits) (16s)
42643801 1,442,850,579,600,99...,314,837,377,253,376 (25,674,127 digits) (20s)
43112609 50,076,715,684,982,3...,909,221,145,378,816 (25,956,377 digits) (24s)
57885161 169,296,395,301,618,...,179,626,270,130,176 (34,850,340 digits) (29s)
74207281 45,112,996,270,669,0...,008,557,930,315,776 (44,677,235 digits) (36s)
77232917 10,920,015,213,433,6...,001,402,016,301,056 (46,498,850 digits) (43s)
82589933 1,108,477,798,641,48...,798,007,191,207,936 (49,724,095 digits) (50s)
"50.6s"
</pre>
 
=={{header|PHP}}==
{{trans|C++}}
<langsyntaxhighlight lang="php">function is_perfect($number)
{
$sum = 0;
Line 2,663 ⟶ 3,224:
if(is_perfect($num))
echo $num . PHP_EOL;
}</langsyntaxhighlight>
 
=={{header|Picat}}==
===Simple divisors/1 function===
First is the slow <code>perfect1/1</code> that use the simple divisors/1 function:
<syntaxhighlight lang="picat">go =>
println(perfect1=[I : I in 1..10_000, perfect1(I)]),
nl.
perfect1(N) => sum(divisors(N)) == N.
divisors(N) = [J: J in 1..1+N div 2, N mod J == 0].</syntaxhighlight>
 
{{out}}
<pre>perfect1 = [1,6,28,496,8128]</pre>
 
===Using formula for perfect number candidates===
The formula for perfect number candidates is: 2^(p-1)*(2^p-1) for prime p. This is used to find some more perfect numbers in reasonable time. <code>perfect2/1</code> is a faster version of checking if a number is perfect.
<syntaxhighlight lang="picat">go2 =>
println("Using the formula: 2^(p-1)*(2^p-1) for prime p"),
foreach(P in primes(32))
PF=perfectf(P),
% Check that it is really a perfect number
if perfect2(PF) then
printf("%w (prime %w)\n",PF,P)
end
end,
nl.
 
% Formula for perfect number candidates:
% 2^(p-1)*(2^p-1) where p is a prime
%
perfectf(P) = (2**(P-1))*((2**P)-1).
 
% Faster check of a perfect number
perfect2(N) => sum_divisors(N) == N.
 
% Sum of divisors
table
sum_divisors(N) = Sum =>
sum_divisors(2,N,1,Sum).
 
sum_divisors(I,N,Sum0,Sum), I > floor(sqrt(N)) =>
Sum = Sum0.
 
% I is a divisor of N
sum_divisors(I,N,Sum0,Sum), N mod I == 0 =>
Sum1 = Sum0 + I,
(I != N div I ->
Sum2 = Sum1 + N div I
;
Sum2 = Sum1
),
sum_divisors(I+1,N,Sum2,Sum).
 
% I is not a divisor of N.
sum_divisors(I,N,Sum0,Sum) =>
sum_divisors(I+1,N,Sum0,Sum).</syntaxhighlight>
 
{{out}}
<pre>6 (prime 2)
28 (prime 3)
496 (prime 5)
8128 (prime 7)
33550336 (prime 13)
8589869056 (prime 17)
137438691328 (prime 19)
2305843008139952128 (prime 31)
 
CPU time 118.039 seconds. Backtracks: 0</pre>
 
===Using list of the primes generating the perfect numbers===
Now let's cheat a little. At https://en.wikipedia.org/wiki/Perfect_number there is a list of the first 48 primes that generates perfect numbers according to the formula 2^(p-1)*(2^p-1) for prime p.
 
The perfect numbers are printed only if they has < 80 digits, otherwise the number of digits are shown. The program stops when reaching a number with more than 100 000 digits. (Note: The major time running this program is getting the number of digits.)
<syntaxhighlight lang="picat">go3 =>
ValidP = [2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607,
1279, 2203, 2281, 3217, 4253, 4423, 9689, 9941, 11213,
19937, 21701, 23209, 44497, 86243, 110503, 132049, 216091,
756839, 859433, 1257787, 1398269, 2976221, 3021377, 6972593,
13466917, 20996011, 24036583, 25964951, 30402457, 32582657,
37156667, 42643801, 43112609, 57885161],
foreach(P in ValidP)
printf("prime %w: ", P),
PF = perfectf(P),
Len = PF.to_string.len,
if Len < 80 then
println(PF)
else
println(len=Len)
end,
if Len >= 100_000 then
fail
end
end,
nl.</syntaxhighlight>
 
{{out}}
<pre>prime 2: 6
prime 3: 28
prime 5: 496
prime 7: 8128
prime 13: 33550336
prime 17: 8589869056
prime 19: 137438691328
prime 31: 2305843008139952128
prime 61: 2658455991569831744654692615953842176
prime 89: 191561942608236107294793378084303638130997321548169216
prime 107: 13164036458569648337239753460458722910223472318386943117783728128
prime 127: 14474011154664524427946373126085988481573677491474835889066354349131199152128
prime 521: len = 314
prime 607: len = 366
prime 1279: len = 770
prime 2203: len = 1327
prime 2281: len = 1373
prime 3217: len = 1937
prime 4253: len = 2561
prime 4423: len = 2663
prime 9689: len = 5834
prime 9941: len = 5985
prime 11213: len = 6751
prime 19937: len = 12003
prime 21701: len = 13066
prime 23209: len = 13973
prime 44497: len = 26790
prime 86243: len = 51924
prime 110503: len = 66530
prime 132049: len = 79502
prime 216091: len = 130100</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(de perfect (N)
(let C 0
(for I (/ N 2)
(and (=0 (% N I)) (inc 'C I)) )
(= C N) ) )</langsyntaxhighlight>
 
<langsyntaxhighlight PicoLisplang="picolisp">(de faster (N)
(let (C 1 Stop (sqrt N))
(for (I 2 (<= I Stop) (inc I))
Line 2,678 ⟶ 3,367:
(=0 (% N I))
(inc 'C (+ (/ N I) I)) ) )
(= C N) ) )</langsyntaxhighlight>
 
=={{header|PL/I}}==
<langsyntaxhighlight PLlang="pl/Ii">perfect: procedure (n) returns (bit(1));
declare n fixed;
declare sum fixed;
Line 2,691 ⟶ 3,380:
end;
return (sum=n);
end perfect;</langsyntaxhighlight>
 
==={{header|PL/I-80}}===
<syntaxhighlight lang="pl/i">perfect_search: procedure options (main);
 
%replace
search_limit by 10000,
true by '1'b,
false by '0'b;
 
dcl (k, found) fixed bin;
 
put skip list ('Searching for perfect numbers up to ');
put edit (search_limit) (f(5));
found = 0;
do k = 2 to search_limit;
if isperfect(k) then
do;
put skip list(k);
found = found + 1;
end;
end;
put skip list (found, ' perfect numbers were found');
 
/* return true if n is perfect, otherwise false */
isperfect: procedure(n) returns (bit(1));
dcl (n, sum, f1, f2) fixed bin;
 
sum = 1; /* 1 is a proper divisor of every number */
f1 = 2;
do while ((f1 * f1) <= n);
if mod(n, f1) = 0 then
do;
sum = sum + f1;
f2 = n / f1;
/* don't double count identical co-factors! */
if f2 > f1 then sum = sum + f2;
end;
f1 = f1 + 1;
end;
return (sum = n);
end isperfect;
 
end perfect_search;</syntaxhighlight>
 
{{out}}
<pre>
Searching for perfect numbers up to 10000
6
28
496
8128
4 perfect numbers were found
</pre>
 
=={{header|PL/M}}==
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
<syntaxhighlight lang="pli">100H: /* FIND SOME PERFECT NUMBERS: NUMBERS EQUAL TO THE SUM OF THEIR PROPER */
/* DIVISORS */
/* CP/M SYSTEM CALL AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
DECLARE FN BYTE, ARG ADDRESS;
GOTO 5;
END BDOS;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$NUMBER: PROCEDURE( N );
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
 
/* TASK */
/* RETURNS TRUE IF N IS PERFECT, 0 OTHERWISE */
IS$PERFECT: PROCEDURE( N )BYTE;
DECLARE N ADDRESS;
DECLARE ( F1, F2, SUM ) ADDRESS;
SUM = 1;
F1 = 2;
F2 = N;
DO WHILE( F1 * F1 <= N );
IF N MOD F1 = 0 THEN DO;
SUM = SUM + F1;
F2 = N / F1;
/* AVOID COUNTING E.G., 2 TWICE AS A FACTOR OF 4 */
IF F2 > F1 THEN SUM = SUM + F2;
END;
F1 = F1 + 1;
END;
RETURN SUM = N;
END IS$PERFECT ;
/* TEST IS$PERFECT */
DECLARE N ADDRESS;
DO N = 2 TO 10$000;
IF IS$PERFECT( N ) THEN DO;
CALL PR$CHAR( ' ' );
CALL PR$NUMBER( N );
END;
END;
EOF</syntaxhighlight>
{{out}}
<pre>
6 28 496 8128
</pre>
 
Alternative, much faster version.
{{Trans|Action!}}
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
<syntaxhighlight lang="pli">100H: /* FIND SOME PERFECT NUMBERS: NUMBERS EQUAL TO THE SUM OF THEIR PROPER */
/* DIVISORS */
/* CP/M SYSTEM CALL AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
DECLARE FN BYTE, ARG ADDRESS;
GOTO 5;
END BDOS;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$NUMBER: PROCEDURE( N );
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
 
/* TASK - TRANSLATION OF ACTION! */
DECLARE MAX$NUM LITERALLY '10$000';
DECLARE PDS( 10$001 ) ADDRESS;
DECLARE ( I, J ) ADDRESS;
DO I = 2 TO MAX$NUM;
PDS( I ) = 1;
END;
DO I = 2 TO MAX$NUM;
DO J = I + I TO MAX$NUM BY I;
PDS( J ) = PDS( J ) + I;
END;
END;
DO I = 2 TO MAX$NUM;
IF PDS( I ) = I THEN DO;
CALL PR$NUMBER( I );
CALL PR$NL;
END;
END;
EOF</syntaxhighlight>
{{out}}
<pre>
6
28
496
8128
</pre>
 
=={{header|PowerShell}}==
<langsyntaxhighlight lang="powershell">Function IsPerfect($n)
{
$sum=0
Line 2,707 ⟶ 3,563:
}
 
Returns "True" if the given number is perfect and "False" if it's not.</langsyntaxhighlight>
 
=={{header|Prolog}}==
===Classic approach===
Works with SWI-Prolog
<langsyntaxhighlight Prologlang="prolog">tt_divisors(X, N, TT) :-
Q is X / N,
( 0 is X mod N -> (Q = N -> TT1 is N + TT;
Line 2,725 ⟶ 3,581:
perfect_numbers(N, L) :-
numlist(2, N, LN),
include(perfect, LN, L).</langsyntaxhighlight>
 
===Faster method===
Since a perfect number is of the form 2^(n-1) * (2^n - 1), we can eliminate a lot of candidates by merely factoring out the 2s and seeing if the odd portion is (2^(n+1)) - 1.
<syntaxhighlight lang="prolog">
<lang Prolog>
perfect(N) :-
factor_2s(N, Chk, Exp),
Line 2,756 ⟶ 3,612:
N mod D =\= 0,
D2 is D + A, prime(N, D2, As).
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,769 ⟶ 3,625:
===Functional approach===
Works with SWI-Prolog and module lambda, written by <b>Ulrich Neumerkel</b> found there http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl
<langsyntaxhighlight Prologlang="prolog">:- use_module(library(lambda)).
 
is_divisor(V, N) :-
Line 2,805 ⟶ 3,661:
%% f_compose_1(Pred1, Pred2, Pred1(Pred2)).
%
f_compose_1(F,G, \X^Z^(call(G,X,Y), call(F,Y,Z))).</langsyntaxhighlight>
 
=={{header|PureBasic}}==
<langsyntaxhighlight PureBasiclang="purebasic">Procedure is_Perfect_number(n)
Protected summa, i=1, result=#False
Repeat
Line 2,820 ⟶ 3,676:
EndIf
ProcedureReturn result
EndProcedure</langsyntaxhighlight>
 
=={{header|Python}}==
Line 2,849 ⟶ 3,705:
 
===Python: Procedural===
<langsyntaxhighlight lang="python">def perf1(n):
sum = 0
for i in range(1, n):
if n % i == 0:
sum += i
return sum == n</langsyntaxhighlight>
 
===Python: Optimised Procedural===
<langsyntaxhighlight lang="python">from itertools import chain, cycle, accumulate
 
def factor2(n):
Line 2,878 ⟶ 3,734:
def perf4(n):
"Using most efficient prime factoring routine from: http://rosettacode.org/wiki/Factors_of_an_integer#Python"
return 2 * n == sum(factor2(n))</langsyntaxhighlight>
 
===Python: Functional===
<langsyntaxhighlight lang="python">def perf2(n):
return n == sum(i for i in range(1, n) if n % i == 0)
 
print (
list(filter(perf2, range(1, 10001)))
)</langsyntaxhighlight>
 
 
 
<langsyntaxhighlight lang="python">'''Perfect numbers'''
 
from math import sqrt
Line 2,924 ⟶ 3,780:
 
if __name__ == '__main__':
main()</langsyntaxhighlight>
{{Out}}
<pre>[6, 28, 496, 8128]</pre>
 
=={{header|Quackery}}==
 
<code>factors</code> is defined at [http://rosettacode.org/wiki/Factors_of_an_integer#Quackery Factors of an integer].
 
<syntaxhighlight lang="quackery"> [ 0 swap witheach + ] is sum ( [ --> n )
 
[ factors -1 pluck dip sum = ] is perfect ( n --> n )
 
say "Perfect numbers less than 10000:" cr
10000 times
[ i^ 1+ perfect if [ i^ 1+ echo cr ] ]
</syntaxhighlight>
 
{{out}}
 
<pre>Perfect numbers less than 10000:
6
28
496
8128
</pre>
 
=={{header|R}}==
<langsyntaxhighlight Rlang="r">is.perf <- function(n){
if (n==0|n==1) return(FALSE)
s <- seq (1,n-1)
Line 2,939 ⟶ 3,817:
# Usage - Warning High Memory Usage
is.perf(28)
sapply(c(6,28,496,8128,33550336),is.perf)</langsyntaxhighlight>
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket">#lang racket
(require math)
 
Line 2,952 ⟶ 3,830:
; filtering to only even numbers for better performance
(filter perfect? (filter even? (range 1e5)))
;-> '(0 6 28 496 8128)</langsyntaxhighlight>
 
=={{header|Raku}}==
(formerly Perl 6)
Naive (very slow) version
<syntaxhighlight lang="raku" perl6line>sub is-perf($n) { $n == [+] grep $n %% *, 1 .. $n div 2 }
 
# used as
put ((1..Inf).hyper.grep: {.&is-perf})[^4];</langsyntaxhighlight>
{{out}}
<pre>6 28 496 8128</pre>
Much, much faster version:
<syntaxhighlight lang="raku" perl6line>my @primes = lazy (2,3,*+2 … Inf).grep: { .is-prime };
my @perfects = lazy gather for @primes {
my $n = 2**$_ - 1;
Line 2,970 ⟶ 3,848:
}
 
.put for @perfects[^12];</langsyntaxhighlight>
 
{{out}}
Line 2,987 ⟶ 3,865:
 
=={{header|REBOL}}==
<langsyntaxhighlight lang="rebol">perfect?: func [n [integer!] /local sum] [
sum: 0
repeat i (n - 1) [
Line 2,995 ⟶ 3,873:
]
sum = n
]</langsyntaxhighlight>
 
=={{header|REXX}}==
===Classic REXX version of ooRexx===
This version is a '''Classic Rexx''' version of the '''ooRexx''' program as of 14-Sep-2013.
<langsyntaxhighlight lang="rexx">/*REXX version of the ooRexx program (the code was modified to run with Classic REXX).*/
do i=1 to 10000 /*statement changed: LOOP ──► DO*/
if perfectNumber(i) then say i "is a perfect number"
Line 3,011 ⟶ 3,889:
if n//i==0 then sum=sum+i /*statement changed: sum += i */
end
return sum=n</langsyntaxhighlight>
'''output''' &nbsp; when using the default of 10000:
<pre>
Line 3,023 ⟶ 3,901:
This version is a '''Classic REXX''' version of the '''PL/I''' program as of 14-Sep-2013, &nbsp; a REXX &nbsp; '''say''' &nbsp; statement
<br>was added to display the perfect numbers. &nbsp; Also, an epilog was written for the re-worked function.
<langsyntaxhighlight lang="rexx">/*REXX version of the PL/I program (code was modified to run with Classic REXX). */
parse arg low high . /*obtain the specified number(s).*/
if high=='' & low=='' then high=34000000 /*if no arguments, use a range. */
Line 3,039 ⟶ 3,917:
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! */</langsyntaxhighlight>
'''output''' &nbsp; when using the input defaults of: &nbsp; <tt> 1 &nbsp; 10000 </tt>
 
Line 3,049 ⟶ 3,927:
:::* &nbsp; testing bypasses the test of the first and last factors
:::* &nbsp; the &nbsp; ''corresponding factor'' &nbsp; is also used when a factor is found
<langsyntaxhighlight lang="rexx">/*REXX program tests if a number (or a range of numbers) is/are perfect. */
parse arg low high . /*obtain optional arguments from the CL*/
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */
Line 3,069 ⟶ 3,947:
s = s + j + x%j /* ··· add it and the other factor. */
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, it's perfect! */</langsyntaxhighlight>
'''output''' &nbsp; when using the default inputs:
<pre>
Line 3,084 ⟶ 3,962:
===optimized using digital root===
This REXX version makes use of the fact that all &nbsp; ''known'' &nbsp; perfect numbers > 6 have a &nbsp; ''digital root'' &nbsp; of &nbsp; '''1'''.
<langsyntaxhighlight 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 arguments, then use a range. */
Line 3,111 ⟶ 3,989:
s = s + j + x%j /*··· add it and the other factor. */
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, it's perfect! */</langsyntaxhighlight>
'''output''' &nbsp; is the same as the traditional version &nbsp; and is about &nbsp; '''5.3''' &nbsp; times faster &nbsp; (testing '''34,000,000''' numbers).
 
===optimized using only even numbers===
This REXX version uses the fact that all &nbsp; ''known'' &nbsp; perfect numbers are &nbsp; ''even''.
<langsyntaxhighlight lang="rexx">/*REXX program tests if a number (or a range of numbers) is/are perfect. */
parse arg low high . /*obtain optional arguments from the CL*/
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */
Line 3,144 ⟶ 4,022:
s = s + j + x%j /* ··· add it and the other factor. */
end /*j*/ /*(above) is marginally faster. */
return s==x /*if sum matches X, then it's perfect!*/</langsyntaxhighlight>
'''output''' &nbsp; is the same as the traditional version &nbsp; and is about &nbsp; '''11.5''' &nbsp; times faster &nbsp; (testing '''34,000,000''' numbers).
 
===Lucas-Lehmer method===
This version uses memoization to implement a fast version of the Lucas-Lehmer test.
<langsyntaxhighlight lang="rexx">/*REXX program tests if a number (or a range of numbers) is/are perfect. */
parse arg low high . /*obtain the optional arguments from CL*/
if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */
Line 3,181 ⟶ 4,059:
s=s + j + x%j /*··· add it and the other factor. */
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, it's perfect!*/</langsyntaxhighlight>
'''output''' &nbsp; is the same as the traditional version &nbsp; and is about &nbsp; '''75''' &nbsp; times faster &nbsp; (testing '''34,000,000''' numbers).
 
Line 3,191 ⟶ 4,069:
 
An integer square root function was added to limit the factorization of a number.
<langsyntaxhighlight lang="rexx">/*REXX program tests if a number (or a range of numbers) is/are perfect. */
parse arg low high . /*obtain optional arguments from the CL*/
if high=='' & low=="" then high=34000000 /*No arguments? Then use a range. */
Line 3,237 ⟶ 4,115:
if x//j==0 then s=s+j+x%j /*J divisible by X? Then add J and X÷J*/
end /*j*/
return s==x /*if the sum matches X, then perfect! */</langsyntaxhighlight>
'''output''' &nbsp; is the same as the traditional version &nbsp; and is about &nbsp; '''500''' &nbsp; times faster &nbsp; (testing '''34,000,000''' numbers). <br><br>
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
for i = 1 to 10000
if perfect(i) see i + nl ok
Line 3,253 ⟶ 4,131:
if sum = n return 1 else return 0 ok
return sum
</syntaxhighlight>
</lang>
 
=={{header|RPL}}==
≪ 0 SWAP 1
'''WHILE''' DUP2 > '''REPEAT'''
'''IF''' DUP2 MOD NOT '''THEN''' ROT OVER + ROT ROT '''END'''
1 + '''END'''
DROP ==
≫ ''''PFCT?'''' STO
≪
{ } 1 1000 '''FOR''' n
'''IF''' n '''PFCT?''' '''THEN''' n + '''END''' '''NEXT'''
≫ ''''TASK'''' STO
{{out}}
<pre>
1: { 6 28 496 }
</pre>
A vintage HP-28S needs 157 seconds to collect all perfect numbers under 100...
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">def perf(n)
sum = 0
for i in 1...n
Line 3,262 ⟶ 4,158:
end
sum == n
end</langsyntaxhighlight>
Functional style:
<langsyntaxhighlight lang="ruby">def perf(n)
n == (1...n).select {|i| n % i == 0}.inject(:+)
end</langsyntaxhighlight>
Faster version:
<langsyntaxhighlight lang="ruby">def perf(n)
divisors = []
for i in 1..Integer.sqrt(n)
Line 3,274 ⟶ 4,170:
end
divisors.uniq.inject(:+) == 2*n
end</langsyntaxhighlight>
Test:
<langsyntaxhighlight lang="ruby">for n in 1..10000
puts n if perf(n)
end</langsyntaxhighlight>
{{out}}
<pre>
Line 3,288 ⟶ 4,184:
===Fast (Lucas-Lehmer)===
Generate and memoize perfect numbers as needed.
<langsyntaxhighlight lang="ruby">require "prime"
 
def mersenne_prime_pow?(p)
Line 3,312 ⟶ 4,208:
p perfect?(13164036458569648337239753460458722910223472318386943117783728128)
p Time.now - t1
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,322 ⟶ 4,218:
 
=={{header|Run BASIC}}==
<langsyntaxhighlight lang="runbasic">for i = 1 to 10000
if perf(i) then print i;" ";
next i
Line 3,331 ⟶ 4,227:
next i
IF sum = n THEN perf = 1
END FUNCTION</langsyntaxhighlight>
{{Out}}
<pre>6 28 496 8128</pre>
 
=={{header|Rust}}==
<langsyntaxhighlight lang="rust">
fn main ( ) {
fn factor_sum(n: i32) -> i32 {
Line 3,358 ⟶ 4,254:
perfect_nums(10000);
}
</syntaxhighlight>
</lang>
 
=={{header|SASL}}==
Copied from the SASL manual, page 22:
<syntaxhighlight lang="sasl">
<lang SASL>
|| The function which takes a number and returns a list of its factors (including one but excluding itself)
|| can be written
Line 3,369 ⟶ 4,265:
|| we can write the list of all perfect numbers as
perfects = { n <- 1... ; n = sum(factors n) }
</syntaxhighlight>
</lang>
 
=={{header|S-BASIC}}==
<syntaxhighlight lang="basic">
$lines
 
rem - return p mod q
function mod(p, q = integer) = integer
end = p - q * (p/q)
 
rem - return true if n is perfect, otherwise false
function isperfect(n = integer) = integer
var sum, f1, f2 = integer
sum = 1
f1 = 2
while (f1 * f1) <= n do
begin
if mod(n, f1) = 0 then
begin
sum = sum + f1
f2 = n / f1
if f2 > f1 then sum = sum + f2
end
f1 = f1 + 1
end
end = (sum = n)
 
rem - exercise the function
 
var k, found = integer
 
print "Searching up to"; search_limit; " for perfect numbers ..."
found = 0
for k = 2 to search_limit
if isperfect(k) then
begin
print k
found = found + 1
end
next k
print found; " were found"
 
end
</syntaxhighlight>
{{out}}
<pre>
Searching up to 10000 for perfect numbers ...
6
28
496
8128
4 were found
</pre>
 
=={{header|Scala}}==
<langsyntaxhighlight lang="scala">def perfectInt(input: Int) = ((2 to sqrt(input).toInt).collect {case x if input % x == 0 => x + input / x}).sum == input - 1</langsyntaxhighlight>
 
'''or'''
 
<langsyntaxhighlight lang="scala">def perfect(n: Int) =
(for (x <- 2 to n/2 if n % x == 0) yield x).sum + 1 == n
</syntaxhighlight>
</lang>
 
=={{header|Scheme}}==
<langsyntaxhighlight lang="scheme">(define (perf n)
(let loop ((i 1)
(sum 0))
Line 3,389 ⟶ 4,337:
(loop (+ i 1) (+ sum i)))
(else
(loop (+ i 1) sum)))))</langsyntaxhighlight>
 
=={{header|Seed7}}==
<langsyntaxhighlight lang="seed7">$ include "seed7_05.s7i";
 
const func boolean: isPerfect (in integer: n) is func
Line 3,423 ⟶ 4,371:
end if;
end for;
end func;</langsyntaxhighlight>
{{Out}}
<pre>
Line 3,434 ⟶ 4,382:
 
=={{header|Sidef}}==
<langsyntaxhighlight lang="ruby">func is_perfect(n) {
n.sigma == 2*n
}
Line 3,440 ⟶ 4,388:
for n in (1..10000) {
say n if is_perfect(n)
}</langsyntaxhighlight>
 
Alternatively, a more efficient check for even perfect numbers:
<langsyntaxhighlight lang="ruby">func is_even_perfect(n) {
 
var square = (8*n + 1)
Line 3,456 ⟶ 4,404:
for n in (1..10000) {
say n if is_even_perfect(n)
}</langsyntaxhighlight>
 
{{out}}
Line 3,467 ⟶ 4,415:
 
=={{header|Simula}}==
<langsyntaxhighlight lang="simula">BOOLEAN PROCEDURE PERF(N); INTEGER N;
BEGIN
INTEGER SUM;
Line 3,474 ⟶ 4,422:
SUM := SUM + I;
PERF := SUM = N;
END PERF;</langsyntaxhighlight>
 
=={{header|Slate}}==
<langsyntaxhighlight lang="slate">n@(Integer traits) isPerfect
[
(((2 to: n // 2 + 1) select: [| :m | (n rem: m) isZero])
inject: 1 into: #+ `er) = n
].</langsyntaxhighlight>
 
=={{header|Smalltalk}}==
<langsyntaxhighlight lang="smalltalk">Integer extend [
 
"Translation of the C version; this is faster..."
Line 3,504 ⟶ 4,452:
inject: 1 into: [ :a :b | a + b ] ) = self
]
].</langsyntaxhighlight>
 
<langsyntaxhighlight lang="smalltalk">1 to: 9000 do: [ :p | (p isPerfect) ifTrue: [ p printNl ] ]</langsyntaxhighlight>
 
=={{header|SparForte}}==
As a structured script.
<syntaxhighlight lang="ada">#!/usr/local/bin/spar
pragma annotate( summary, "perfect" );
pragma annotate( description, "In mathematics, a perfect number is a positive integer" );
pragma annotate( description, "that is the sum of its proper positive divisors, that is," );
pragma annotate( description, "the sum of the positive divisors excluding the number" );
pragma annotate( description, "itself." );
pragma annotate( see_also, "http://en.wikipedia.org/wiki/Perfect_number" );
pragma annotate( author, "Ken O. Burtch" );
pragma license( unrestricted );
 
pragma restriction( no_external_commands );
 
procedure perfect is
 
function is_perfect( n : positive ) return boolean is
total : natural := 0;
begin
for i in 1..n-1 loop
if n mod i = 0 then
total := @+i;
end if;
end loop;
return total = natural( n );
end is_perfect;
 
number : positive;
result : boolean;
begin
number := 6;
result := is_perfect( number );
put( number ) @ ( " : " ) @ ( result );
new_line;
 
number := 18;
result := is_perfect( number );
put( number ) @ ( " : " ) @ ( result );
new_line;
 
number := 28;
result := is_perfect( number );
put( number ) @ ( " : " ) @ ( result );
new_line;
 
end perfect;</syntaxhighlight>
 
=={{header|Swift}}==
{{trans|Java}}
<langsyntaxhighlight Swiftlang="swift">func perfect(n:Int) -> Bool {
var sum = 0
for i in 1..<n {
Line 3,524 ⟶ 4,519:
println(i)
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 3,534 ⟶ 4,529:
 
=={{header|Tcl}}==
<langsyntaxhighlight lang="tcl">proc perfect n {
set sum 0
for {set i 1} {$i <= $n} {incr i} {
Line 3,540 ⟶ 4,535:
}
expr {$sum == 2*$n}
}</langsyntaxhighlight>
 
=={{header|Ursala}}==
<langsyntaxhighlight Ursalalang="ursala">#import std
#import nat
 
is_perfect = ~&itB&& ^(~&,~&t+ iota); ^E/~&l sum:-0+ ~| not remainder</langsyntaxhighlight>
This test program applies the function to a list of the first five hundred natural
numbers and deletes the imperfect ones.
<langsyntaxhighlight Ursalalang="ursala">#cast %nL
 
examples = is_perfect*~ iota 500</langsyntaxhighlight>
{{Out}}
<pre><6,28,496></pre>
Line 3,558 ⟶ 4,553:
{{trans|Phix}}
Using [[Factors_of_an_integer#VBA]], slightly adapted.
<langsyntaxhighlight lang="vb">Private Function Factors(x As Long) As String
Application.Volatile
Dim i As Long
Line 3,586 ⟶ 4,581:
If is_perfect(i) Then Debug.Print i
Next i
End Sub</langsyntaxhighlight>{{out}}
<pre> 6
28
Line 3,593 ⟶ 4,588:
 
=={{header|VBScript}}==
<langsyntaxhighlight lang="vb">Function IsPerfect(n)
IsPerfect = False
i = n - 1
Line 3,609 ⟶ 4,604:
 
WScript.StdOut.Write IsPerfect(CInt(WScript.Arguments(0)))
WScript.StdOut.WriteLine</langsyntaxhighlight>
 
{{out}}
Line 3,620 ⟶ 4,615:
 
C:\>
</pre>
 
 
=={{header|V (Vlang)}}==
{{trans|go}}
<syntaxhighlight lang="v (vlang)">fn compute_perfect(n i64) bool {
mut sum := i64(0)
for i := i64(1); i < n; i++ {
if n%i == 0 {
sum += i
}
}
return sum == n
}
// following fntion satisfies the task, returning true for all
// perfect numbers representable in the argument type
fn is_perfect(n i64) bool {
return n in [i64(6), 28, 496, 8128, 33550336, 8589869056,
137438691328, 2305843008139952128]
}
// validation
fn main() {
for n := i64(1); ; n++ {
if is_perfect(n) != compute_perfect(n) {
panic("bug")
}
if n%i64(1e3) == 0 {
println("tested $n")
}
}
}</syntaxhighlight>
{{Out}}
<pre>
tested 1000
tested 2000
tested 3000
...
</pre>
 
Line 3,626 ⟶ 4,660:
{{trans|D}}
Restricted to the first four perfect numbers as the fifth one is very slow to emerge.
<langsyntaxhighlight ecmascriptlang="wren">var isPerfect = Fn.new { |n|
if (n <= 2) return false
var tot = 1
Line 3,649 ⟶ 4,683:
i = i + 2 // there are no known odd perfect numbers
}
System.print()</langsyntaxhighlight>
 
{{out}}
Line 3,659 ⟶ 4,693:
{{libheader|Wren-math}}
This makes use of the fact that all known perfect numbers are of the form <big> (2<sup>''n''</sup> - 1) × 2<sup>''n'' - 1</sup></big> where <big> (2<sup>''n''</sup> - 1)</big> is prime and finds the first seven perfect numbers instantly. The numbers are too big after that to be represented accurately by Wren.
<langsyntaxhighlight ecmascriptlang="wren">import "./math" for Int
 
var isPerfect = Fn.new { |n|
Line 3,688 ⟶ 4,722:
p = p + 1
}
System.print()</langsyntaxhighlight>
 
{{out}}
Line 3,696 ⟶ 4,730:
 
=={{header|XPL0}}==
<langsyntaxhighlight XPL0lang="xpl0">include c:\cxpl\codes; \intrinsic 'code' declarations
 
func Perfect(N); \Return 'true' if N is a perfect number
Line 3,713 ⟶ 4,747:
if Perfect(N) then [IntOut(0, N); CrLf(0)];
];
]</langsyntaxhighlight>
 
{{out}}
Line 3,723 ⟶ 4,757:
33550336
</pre>
 
 
=={{header|Yabasic}}==
{{trans|True BASIC}}
<syntaxhighlight lang="basic">
sub isPerfect(n)
if (n < 2) or mod(n, 2) = 1 then return false : endif
// asumimos que los números impares no son perfectos
sum = 0
for i = 1 to n-1
if mod(n,i) = 0 then sum = sum + i : endif
next i
if sum = n then return true else return false : endif
end sub
 
print "Los primeros 5 numeros perfectos son:"
for i = 1 to 33550336
if isPerfect(i) then print i, " ", : endif
next i
print
end
</syntaxhighlight>
 
 
=={{header|Zig}}==
<syntaxhighlight lang="zig">
<lang Zig>
const std = @import("std");
const expect = std.testing.expect;
Line 3,755 ⟶ 4,812:
expect(propersum(30) == 42);
}
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 3,762 ⟶ 4,819:
=={{header|zkl}}==
{{trans|D}}
<langsyntaxhighlight lang="zkl">fcn isPerfectNumber1(n)
{ n == [1..n-1].filter('wrap(i){ n % i == 0 }).sum(); }</langsyntaxhighlight>
{{out}}
<pre>
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/80423...349149"