aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Perfect-numbers/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Perfect_numbers

25
Task/Perfect-numbers/00-TASK.txt Normal file
View file

@ -0,0 +1,25 @@
[[category:Discrete math]]
{{task|Prime Numbers}}
Write a function which says whether a number is perfect.
<br>
[[wp:Perfect_numbers|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: &nbsp; The faster &nbsp; [[Lucas-Lehmer test]] &nbsp; is used to find primes of the form &nbsp; <big> 2<sup>''n''</sup>-1</big>, &nbsp; all ''known'' perfect numbers can be derived from these primes
using the formula &nbsp; <big> (2<sup>''n''</sup> - 1) × 2<sup>''n'' - 1</sup></big>.
It is not known if there are any odd perfect numbers (any that exist are larger than <big>10<sup>2000</sup></big>).
The number of &nbsp; ''known'' &nbsp; perfect numbers is &nbsp; '''51''' &nbsp; (as of December, 2018), &nbsp; and the largest known perfect number contains &nbsp;'''49,724,095'''&nbsp; decimal digits.
;See also:
:* &nbsp; [[Rational Arithmetic]]
:* &nbsp; [[oeis:A000396|Perfect numbers on OEIS]]
:* &nbsp; [http://www.oddperfect.org/ Odd Perfect] showing the current status of bounds on odd perfect numbers.
<br><br>

10
Task/Perfect-numbers/11l/perfect-numbers.11l Normal file
View file

@ -0,0 +1,10 @@
F perf(n)
V sum = 0
L(i) 1 .< n
I n % i == 0
sum += i
R sum == n
L(i) 1..10000
I perf(i)
print(i, end' ‘ ’)

47
Task/Perfect-numbers/360-Assembly/perfect-numbers-1.360 Normal file
View file

@ -0,0 +1,47 @@
* Perfect numbers 15/05/2016
PERFECTN CSECT
USING PERFECTN,R13 prolog
SAVEAREA B STM-SAVEAREA(R15) "
DC 17F'0' "
STM STM R14,R12,12(R13) "
ST R13,4(R15) "
ST R15,8(R13) "
LR R13,R15 "
LA R6,2 i=2
LOOPI C R6,NN do i=2 to nn
BH ELOOPI
LR R1,R6 i
BAL R14,PERFECT
LTR R0,R0 if perfect(i)
BZ NOTPERF
XDECO R6,PG edit i
XPRNT PG,L'PG print i
NOTPERF LA R6,1(R6) i=i+1
B LOOPI
ELOOPI L R13,4(0,R13) epilog
LM R14,R12,12(R13) "
XR R15,R15 "
BR R14 exit
PERFECT SR R9,R9 function perfect(n); sum=0
LA R7,1 j
LR R8,R1 n
SRA R8,1 n/2
LOOPJ CR R7,R8 do j=1 to n/2
BH ELOOPJ
LR R4,R1 n
SRDA R4,32
DR R4,R7 n/j
LTR R4,R4 if mod(n,j)=0
BNZ NOTMOD
AR R9,R7 sum=sum+j
NOTMOD LA R7,1(R7) j=j+1
B LOOPJ
ELOOPJ SR R0,R0 r0=false
CR R9,R1 if sum=n
BNE NOTEQ
BCTR R0,0 r0=true
NOTEQ BR R14 return(r0); end perfect
NN DC F'10000'
PG DC CL12' ' buffer
YREGS
END PERFECTN

76
Task/Perfect-numbers/360-Assembly/perfect-numbers-2.360 Normal file
View file

@ -0,0 +1,76 @@
* Perfect numbers 15/05/2016
PERFECPO CSECT
USING PERFECPO,R13 prolog
SAVEAREA B STM-SAVEAREA(R15) "
DC 17F'0' "
STM STM R14,R12,12(R13) "
ST R13,4(R15) "
ST R15,8(R13) "
LR R13,R15 "
ZAP I,I1 i=i1
LOOPI CP I,I2 do i=i1 to i2
BH ELOOPI
LA R1,I r1=@i
BAL R14,PERFECT perfect(i)
LTR R0,R0 if perfect(i)
BZ NOTPERF
UNPK PG(16),I unpack i
OI PG+15,X'F0'
XPRNT PG,16 print i
NOTPERF AP I,=P'1' i=i+1
B LOOPI
ELOOPI L R13,4(0,R13) epilog
LM R14,R12,12(R13) "
XR R15,R15 "
BR R14 exit
PERFECT EQU * function perfect(n);
ZAP N,0(8,R1) n=%r1
CP N,=P'6' if n=6
BNE NOT6
L R0,=F'-1' r0=true
B RETURN return(true)
NOT6 ZAP PW,N n
SP PW,=P'1' n-1
ZAP PW2,PW n-1
DP PW2,=PL8'9' (n-1)/9
ZAP R,PW2+8(8) if mod((n-1),9)<>0
BZ ZERO
SR R0,R0 r0=false
B RETURN return(false)
ZERO ZAP PW2,N n
DP PW2,=PL8'2' n/2
ZAP SUM,PW2(8) sum=n/2
AP SUM,=P'3' sum=n/2+3
ZAP J,=P'3' j=3
LOOPJ ZAP PW,J do loop on j
MP PW,J j*j
CP PW,N while j*j<=n
BH ELOOPJ
ZAP PW2,N n
DP PW2,J n/j
CP PW2+8(8),=P'0' if mod(n,j)<>0
BNE NEXTJ
AP SUM,J sum=sum+j
ZAP PW2,N n
DP PW2,J n/j
AP SUM,PW2(8) sum=sum+j+n/j
NEXTJ AP J,=P'1' j=j+1
B LOOPJ next j
ELOOPJ SR R0,R0 r0=false
CP SUM,N if sum=n
BNE RETURN
BCTR R0,0 r0=true
RETURN BR R14 return(r0); end perfect
I1 DC PL8'1'
I2 DC PL8'200000000000'
I DS PL8
PG DC CL16' ' buffer
N DS PL8
SUM DS PL8
J DS PL8
R DS PL8
C DS CL16
PW DS PL8
PW2 DS PL16
YREGS
END PERFECPO

260
Task/Perfect-numbers/AArch64-Assembly/perfect-numbers.aarch64 Normal file
View file

@ -0,0 +1,260 @@
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program perfectNumber64.s */
/* use Euclide Formula : if M=(2puis p)-1 is prime M * (M+1)/2 is perfect see Wikipedia */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeConstantesARM64.inc"
.equ MAXI, 63
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessResult: .asciz "Perfect : @ \n"
szMessOverflow: .asciz "Overflow in function isPrime.\n"
szCarriageReturn: .asciz "\n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
mov x4,2 // start 2
mov x3,1 // counter 2 power
1: // begin loop
lsl x4,x4,1 // 2 power
sub x0,x4,1 // - 1
bl isPrime // is prime ?
cbz x0,2f // no
sub x0,x4,1 // yes
mul x1,x0,x4 // multiply m by m-1
lsr x0,x1,1 // divide by 2
bl displayPerfect // and display
2:
add x3,x3,1 // next power of 2
cmp x3,MAXI
blt 1b
100: // standard end of the program
mov x0,0 // return code
mov x8,EXIT // request to exit program
svc 0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrsMessResult: .quad sMessResult
/******************************************************************/
/* Display perfect number */
/******************************************************************/
/* x0 contains the number */
displayPerfect:
stp x1,lr,[sp,-16]! // save registers
ldr x1,qAdrsZoneConv
bl conversion10 // call décimal conversion
ldr x0,qAdrsMessResult
ldr x1,qAdrsZoneConv // insert conversion in message
bl strInsertAtCharInc
bl affichageMess // display message
100:
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
qAdrsZoneConv: .quad sZoneConv
/***************************************************/
/* is a number prime ? */
/***************************************************/
/* x0 contains the number */
/* x0 return 1 if prime else 0 */
//2147483647 OK
//4294967297 NOK
//131071 OK
//1000003 OK
//10001363 OK
isPrime:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
mov x2,x0
sub x1,x0,#1
cmp x2,0
beq 99f // return zero
cmp x2,2 // for 1 and 2 return 1
ble 2f
mov x0,#2
bl moduloPuR64
bcs 100f // error overflow
cmp x0,#1
bne 99f // no prime
cmp x2,3
beq 2f
mov x0,#3
bl moduloPuR64
blt 100f // error overflow
cmp x0,#1
bne 99f
cmp x2,5
beq 2f
mov x0,#5
bl moduloPuR64
bcs 100f // error overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,7
beq 2f
mov x0,#7
bl moduloPuR64
bcs 100f // error overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,11
beq 2f
mov x0,#11
bl moduloPuR64
bcs 100f // error overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,13
beq 2f
mov x0,#13
bl moduloPuR64
bcs 100f // error overflow
cmp x0,#1
bne 99f // Pas premier
2:
cmn x0,0 // carry à zero no error
mov x0,1 // prime
b 100f
99:
cmn x0,0 // carry à zero no error
mov x0,#0 // prime
100:
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret
/**************************************************************/
/********************************************************/
/* Compute modulo de b power e modulo m */
/* Exemple 4 puissance 13 modulo 497 = 445 */
/********************************************************/
/* x0 number */
/* x1 exposant */
/* x2 modulo */
moduloPuR64:
stp x1,lr,[sp,-16]! // save registres
stp x3,x4,[sp,-16]! // save registres
stp x5,x6,[sp,-16]! // save registres
stp x7,x8,[sp,-16]! // save registres
stp x9,x10,[sp,-16]! // save registres
cbz x0,100f
cbz x1,100f
mov x8,x0
mov x7,x1
mov x6,1 // result
udiv x4,x8,x2
msub x9,x4,x2,x8 // remainder
1:
tst x7,1 // if bit = 1
beq 2f
mul x4,x9,x6
umulh x5,x9,x6
mov x6,x4
mov x0,x6
mov x1,x5
bl divisionReg128U // division 128 bits
cbnz x1,99f // overflow
mov x6,x3 // remainder
2:
mul x8,x9,x9
umulh x5,x9,x9
mov x0,x8
mov x1,x5
bl divisionReg128U
cbnz x1,99f // overflow
mov x9,x3
lsr x7,x7,1
cbnz x7,1b
mov x0,x6 // result
cmn x0,0 // carry à zero no error
b 100f
99:
ldr x0,qAdrszMessOverflow
bl affichageMess // display error message
cmp x0,0 // carry set error
mov x0,-1 // code erreur
100:
ldp x9,x10,[sp],16 // restaur des 2 registres
ldp x7,x8,[sp],16 // restaur des 2 registres
ldp x5,x6,[sp],16 // restaur des 2 registres
ldp x3,x4,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
qAdrszMessOverflow: .quad szMessOverflow
/***************************************************/
/* division d un nombre de 128 bits par un nombre de 64 bits */
/***************************************************/
/* x0 contient partie basse dividende */
/* x1 contient partie haute dividente */
/* x2 contient le diviseur */
/* x0 retourne partie basse quotient */
/* x1 retourne partie haute quotient */
/* x3 retourne le reste */
divisionReg128U:
stp x6,lr,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
mov x5,#0 // raz du reste R
mov x3,#128 // compteur de boucle
mov x4,#0 // dernier bit
1:
lsl x5,x5,#1 // on decale le reste de 1
tst x1,1<<63 // test du bit le plus à gauche
lsl x1,x1,#1 // on decale la partie haute du quotient de 1
beq 2f
orr x5,x5,#1 // et on le pousse dans le reste R
2:
tst x0,1<<63
lsl x0,x0,#1 // puis on decale la partie basse
beq 3f
orr x1,x1,#1 // et on pousse le bit de gauche dans la partie haute
3:
orr x0,x0,x4 // position du dernier bit du quotient
mov x4,#0 // raz du bit
cmp x5,x2
blt 4f
sub x5,x5,x2 // on enleve le diviseur du reste
mov x4,#1 // dernier bit à 1
4:
// et boucle
subs x3,x3,#1
bgt 1b
lsl x1,x1,#1 // on decale le quotient de 1
tst x0,1<<63
lsl x0,x0,#1 // puis on decale la partie basse
beq 5f
orr x1,x1,#1
5:
orr x0,x0,x4 // position du dernier bit du quotient
mov x3,x5
100:
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x6,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"

43
Task/Perfect-numbers/ALGOL-60/perfect-numbers.alg Normal file
View file

@ -0,0 +1,43 @@
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

21
Task/Perfect-numbers/ALGOL-68/perfect-numbers.alg Normal file
View file

@ -0,0 +1,21 @@
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
)

22
Task/Perfect-numbers/ALGOL-W/perfect-numbers.alg Normal file
View file

@ -0,0 +1,22 @@
begin
% returns true if n is perfect, false otherwise %
% n must be > 0 %
logical procedure isPerfect ( integer value candidate ) ;
begin
integer sum;
sum := 1;
for f1 := 2 until round( sqrt( candidate ) ) do begin
if candidate rem f1 = 0 then begin
integer f2;
sum := sum + f1;
f2 := candidate div f1;
% avoid e.g. counting 2 twice as a factor of 4 %
if f2 > f1 then sum := sum + f2
end if_candidate_rem_f1_eq_0 ;
end for_f1 ;
sum = candidate
end isPerfect ;
% test isPerfect %
for n := 2 until 10000 do if isPerfect( n ) then write( n );
end.

74
Task/Perfect-numbers/ARM-Assembly/perfect-numbers.arm Normal file
View file

@ -0,0 +1,74 @@
/* ARM assembly Raspberry PI */
/* program perfectNumber.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
.equ MAXI, 1<<31
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessResultPerf: .asciz "Perfect : @ \n"
szCarriageReturn: .asciz "\n"
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
mov r2,#2 @ begin first number
1: @ begin loop
mov r5,#1 @ sum
mov r4,#2 @ first divisor 1
2:
udiv r0,r2,r4 @ compute divisor 2
mls r3,r0,r4,r2 @ remainder
cmp r3,#0
bne 3f @ remainder = 0 ?
add r5,r5,r0 @ add divisor 2
add r5,r5,r4 @ add divisor 1
3:
add r4,r4,#1 @ increment divisor
cmp r4,r0 @ divisor 1 < divisor 2
blt 2b @ yes -> loop
cmp r2,r5 @ compare number and divisors sum
bne 4f @ not equal
mov r0,r2 @ equal -> display
ldr r1,iAdrsZoneConv
bl conversion10 @ call décimal conversion
ldr r0,iAdrsMessResultPerf
ldr r1,iAdrsZoneConv @ insert conversion in message
bl strInsertAtCharInc
bl affichageMess @ display message
4:
add r2,#2 @ no perfect number odd < 10 puis 1500
cmp r2,#MAXI @ end ?
blo 1b @ no -> loop
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsMessResultPerf: .int sMessResultPerf
iAdrsZoneConv: .int sZoneConv
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"

6
Task/Perfect-numbers/AWK/perfect-numbers.awk Normal file
View file

@ -0,0 +1,6 @@
$ 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

24
Task/Perfect-numbers/Action-/perfect-numbers.action Normal file
View file

@ -0,0 +1,24 @@
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

10
Task/Perfect-numbers/Ada/perfect-numbers.ada Normal file
View file

@ -0,0 +1,10 @@
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;

108
Task/Perfect-numbers/AppleScript/perfect-numbers-1.applescript Normal file
View file

@ -0,0 +1,108 @@
-- PERFECT NUMBERS -----------------------------------------------------------
-- perfect :: integer -> bool
on perfect(n)
-- isFactor :: integer -> bool
script isFactor
on |λ|(x)
n mod x = 0
end |λ|
end script
-- quotient :: number -> number
script quotient
on |λ|(x)
n / x
end |λ|
end script
-- sum :: number -> number -> number
script sum
on |λ|(a, b)
a + b
end |λ|
end script
-- Integer factors of n below the square root
set lows to filter(isFactor, enumFromTo(1, (n ^ (1 / 2)) as integer))
-- low and high factors (quotients of low factors) tested for perfection
(n > 1) and (foldl(sum, 0, (lows & map(quotient, lows))) / 2 = n)
end perfect
-- TEST ----------------------------------------------------------------------
on run
filter(perfect, enumFromTo(1, 10000))
--> {6, 28, 496, 8128}
end run
-- GENERIC FUNCTIONS ---------------------------------------------------------
-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if m > n then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end enumFromTo
-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
tell mReturn(f)
set lst to {}
set lng to length of xs
repeat with i from 1 to lng
set v to item i of xs
if |λ|(v, i, xs) then set end of lst to v
end repeat
return lst
end tell
end filter
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn

1
Task/Perfect-numbers/AppleScript/perfect-numbers-2.applescript Normal file
View file

@ -0,0 +1 @@
{6, 28, 496, 8128}

32
Task/Perfect-numbers/AppleScript/perfect-numbers-3.applescript Normal file
View file

@ -0,0 +1,32 @@
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

1
Task/Perfect-numbers/AppleScript/perfect-numbers-4.applescript Normal file
View file

@ -0,0 +1 @@
{6, 28, 496, 8128}

25
Task/Perfect-numbers/AppleScript/perfect-numbers-5.applescript Normal file
View file

@ -0,0 +1,25 @@
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

1
Task/Perfect-numbers/AppleScript/perfect-numbers-6.applescript Normal file
View file

@ -0,0 +1 @@
{6, 28, 496, 8128, 33550336}

4
Task/Perfect-numbers/AppleScript/perfect-numbers-7.applescript Normal file
View file

@ -0,0 +1,4 @@
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

6
Task/Perfect-numbers/Arturo/perfect-numbers.arturo Normal file
View file

@ -0,0 +1,6 @@
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
]

22
Task/Perfect-numbers/AutoHotkey/perfect-numbers.ahk Normal file
View file

@ -0,0 +1,22 @@
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
}

1
Task/Perfect-numbers/Axiom/perfect-numbers-1.axiom Normal file
View file

@ -0,0 +1 @@
perfect?(n:Integer):Boolean == reduce(+,divisors n) = 2*n

7
Task/Perfect-numbers/Axiom/perfect-numbers-2.axiom Normal file
View file

@ -0,0 +1,7 @@
)abbrev package TESTP TestPackage
TestPackage() : withma
perfect?: Integer -> Boolean
==
add
import IntegerNumberTheoryFunctions
perfect? n == reduce("+",divisors n) = 2*n

3
Task/Perfect-numbers/Axiom/perfect-numbers-3.axiom Normal file
View file

@ -0,0 +1,3 @@
perfect? 496
perfect? 128
[i for i in 1..10000 | perfect? i]

3
Task/Perfect-numbers/Axiom/perfect-numbers-4.axiom Normal file
View file

@ -0,0 +1,3 @@
true
false
[6,28,496,8128]

13
Task/Perfect-numbers/BASIC/perfect-numbers.basic Normal file
View file

@ -0,0 +1,13 @@
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

19
Task/Perfect-numbers/BASIC256/perfect-numbers.basic Normal file
View file

@ -0,0 +1,19 @@
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

13
Task/Perfect-numbers/BBC-BASIC/perfect-numbers-1.basic Normal file
View file

@ -0,0 +1,13 @@
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%)

10
Task/Perfect-numbers/BBC-BASIC/perfect-numbers-2.basic Normal file
View file

@ -0,0 +1,10 @@
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

18
Task/Perfect-numbers/Bracmat/perfect-numbers.bracmat Normal file
View file

@ -0,0 +1,18 @@
( ( 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|)
)
);

1
Task/Perfect-numbers/Burlesque/perfect-numbers-1.blq Normal file
View file

@ -0,0 +1 @@
Jfc++\/2.*==

3
Task/Perfect-numbers/Burlesque/perfect-numbers-2.blq Normal file
View file

@ -0,0 +1,3 @@
blsq) 8200ro{Jfc++\/2.*==}f[
{6 28 496 8128}

19
Task/Perfect-numbers/C++/perfect-numbers.cpp Normal file
View file

@ -0,0 +1,19 @@
#include <iostream>
using namespace std ;
int divisor_sum( int number ) {
int sum = 0 ;
for ( int i = 1 ; i < number ; i++ )
if ( number % i == 0 )
sum += i ;
return sum;
}
int main( ) {
cout << "Perfect numbers from 1 to 33550337:\n" ;
for ( int num = 1 ; num < 33550337 ; num++ ) {
if (divisor_sum(num) == num)
cout << num << '\n' ;
}
return 0 ;
}

24
Task/Perfect-numbers/C-sharp/perfect-numbers-1.cs Normal file
View file

@ -0,0 +1,24 @@
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 ;
}

17
Task/Perfect-numbers/C-sharp/perfect-numbers-2.cs Normal file
View file

@ -0,0 +1,17 @@
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;
}

27
Task/Perfect-numbers/C/perfect-numbers-1.c Normal file
View file

@ -0,0 +1,27 @@
#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;
}

15
Task/Perfect-numbers/C/perfect-numbers-2.c Normal file
View file

@ -0,0 +1,15 @@
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;
}

24
Task/Perfect-numbers/COBOL/perfect-numbers-1.cobol Normal file
View file

@ -0,0 +1,24 @@
$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.

37
Task/Perfect-numbers/COBOL/perfect-numbers-2.cobol Normal file
View file

@ -0,0 +1,37 @@
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.

9
Task/Perfect-numbers/Clojure/perfect-numbers-1.clj Normal file
View file

@ -0,0 +1,9 @@
(defn proper-divisors [n]
(if (< n 4)
[1]
(->> (range 2 (inc (quot n 2)))
(filter #(zero? (rem n %)))
(cons 1))))
(defn perfect? [n]
(= (reduce + (proper-divisors n)) n))

4
Task/Perfect-numbers/Clojure/perfect-numbers-2.clj Normal file
View file

@ -0,0 +1,4 @@
(defn perfect? [n]
(->> (for [i (range 1 n)] :when (zero? (rem n i))] i)
(reduce +)
(= n)))

2
Task/Perfect-numbers/Clojure/perfect-numbers-3.clj Normal file
View file

@ -0,0 +1,2 @@
(defn perfect? [n]
(= (reduce + (filter #(zero? (rem n %)) (range 1 n))) n))

49
Task/Perfect-numbers/CoffeeScript/perfect-numbers.coffee Normal file
View file

@ -0,0 +1,49 @@
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)

2
Task/Perfect-numbers/Common-Lisp/perfect-numbers.lisp Normal file
View file

@ -0,0 +1,2 @@
(defun perfectp (n)
(= n (loop for i from 1 below n when (= 0 (mod n i)) sum i)))

23
Task/Perfect-numbers/Craft-Basic/perfect-numbers.basic Normal file
View file

@ -0,0 +1,23 @@
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

12
Task/Perfect-numbers/D/perfect-numbers-1.d Normal file
View file

@ -0,0 +1,12 @@
import std.stdio, std.algorithm, std.range;
bool isPerfectNumber1(in uint n) pure nothrow
in {
assert(n > 0);
} body {
return n == iota(1, n - 1).filter!(i => n % i == 0).sum;
}
void main() {
iota(1, 10_000).filter!isPerfectNumber1.writeln;
}

21
Task/Perfect-numbers/D/perfect-numbers-2.d Normal file
View file

@ -0,0 +1,21 @@
import std.stdio, std.math, std.range, std.algorithm;
bool isPerfectNumber2(in int n) pure nothrow {
if (n < 2)
return false;
int total = 1;
foreach (immutable i; 2 .. cast(int)real(n).sqrt + 1)
if (n % i == 0) {
immutable int q = n / i;
total += i;
if (q > i)
total += q;
}
return total == n;
}
void main() {
10_000.iota.filter!isPerfectNumber2.writeln;
}

23
Task/Perfect-numbers/Dart/perfect-numbers-1.dart Normal file
View file

@ -0,0 +1,23 @@
/*
* Function to test if a number is a perfect number
* A number is a perfect number if it is equal to the sum of all its divisors
* Input: Positive integer n
* Output: true if n is a perfect number, false otherwise
*/
bool isPerfect(int n){
//Generate a list of integers in the range 1 to n-1 : [1, 2, ..., n-1]
List<int> range = new List<int>.generate(n-1, (int i) => i+1);
//Create a list that filters the divisors of n from range
List<int> divisors = new List.from(range.where((i) => n%i == 0));
//Sum the all the divisors
int sumOfDivisors = 0;
for (int i = 0; i < divisors.length; i++){
sumOfDivisors = sumOfDivisors + divisors[i];
}
// A number is a perfect number if it is equal to the sum of its divisors
// We return the test if n is equal to sumOfDivisors
return n == sumOfDivisors;
}

2
Task/Perfect-numbers/Dart/perfect-numbers-2.dart Normal file
View file

@ -0,0 +1,2 @@
isPerfect(n) =>
n == new List.generate(n-1, (i) => n%(i+1) == 0 ? i+1 : 0).fold(0, (p,n)=>p+n);

2
Task/Perfect-numbers/Dart/perfect-numbers-3.dart Normal file
View file

@ -0,0 +1,2 @@
main() =>
new List.generate(1000,(i)=>i+1).where(isPerfect).forEach(print);

21
Task/Perfect-numbers/Dyalect/perfect-numbers.dyalect Normal file
View file

@ -0,0 +1,21 @@
func isPerfect(num) {
var sum = 0
for i in 1..<num {
if !i {
break
}
if num % i == 0 {
sum += i
}
}
return sum == num
}
let max = 33550337
print("Perfect numbers from 0 to \(max):")
for x in 0..max {
if isPerfect(x) {
print("\(x) is perfect")
}
}

9
Task/Perfect-numbers/E/perfect-numbers.e Normal file
View file

@ -0,0 +1,9 @@
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
}

19
Task/Perfect-numbers/ERRE/perfect-numbers.erre Normal file
View file

@ -0,0 +1,19 @@
PROGRAM PERFECT
PROCEDURE PERFECT(N%->OK%)
LOCAL I%,S%
S%=1
FOR I%=2 TO SQR(N%)-1 DO
IF N% MOD I%=0 THEN S%+=I%+N% DIV I%
END FOR
IF I%=SQR(N%) THEN S%+=I%
OK%=(N%=S%)
END PROCEDURE
BEGIN
PRINT(CHR$(12);) ! CLS
FOR N%=2 TO 10000 STEP 2 DO
PERFECT(N%->OK%)
IF OK% THEN PRINT(N%)
END FOR
END PROGRAM

41
Task/Perfect-numbers/Eiffel/perfect-numbers.e Normal file
View file

@ -0,0 +1,41 @@
class
APPLICATION
create
make
feature
make
do
io.put_string (" 6 is perfect...%T")
io.put_boolean (is_perfect_number (6))
io.new_line
io.put_string (" 77 is perfect...%T")
io.put_boolean (is_perfect_number (77))
io.new_line
io.put_string ("128 is perfect...%T")
io.put_boolean (is_perfect_number (128))
io.new_line
io.put_string ("496 is perfect...%T")
io.put_boolean (is_perfect_number (496))
end
is_perfect_number (n: INTEGER): BOOLEAN
-- Is 'n' a perfect number?
require
n_positive: n > 0
local
sum: INTEGER
do
across
1 |..| (n - 1) as c
loop
if n \\ c.item = 0 then
sum := sum + c.item
end
end
Result := sum = n
end
end

20
Task/Perfect-numbers/Elena/perfect-numbers.elena Normal file
View file

@ -0,0 +1,20 @@
import system'routines;
import system'math;
import extensions;
extension extension
{
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())
{ console.printLine(n," is perfect") }
};
console.readChar()
}

13
Task/Perfect-numbers/Elixir/perfect-numbers.elixir Normal file
View file

@ -0,0 +1,13 @@
defmodule RC do
def is_perfect(1), do: false
def is_perfect(n) when n > 1 do
Enum.sum(factor(n, 2, [1])) == n
end
defp factor(n, i, factors) when n < i*i , do: factors
defp factor(n, i, factors) when n == i*i , do: [i | factors]
defp factor(n, i, factors) when rem(n,i)==0, do: factor(n, i+1, [i, div(n,i) | factors])
defp factor(n, i, factors) , do: factor(n, i+1, factors)
end
IO.inspect (for i <- 1..10000, RC.is_perfect(i), do: i)

2
Task/Perfect-numbers/Erlang/perfect-numbers.erl Normal file
View file

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

3
Task/Perfect-numbers/F-Sharp/perfect-numbers.fs Normal file
View file

@ -0,0 +1,3 @@
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

2
Task/Perfect-numbers/FALSE/perfect-numbers.false Normal file
View file

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

4
Task/Perfect-numbers/Factor/perfect-numbers.factor Normal file
View file

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

6
Task/Perfect-numbers/Forth/perfect-numbers.fth Normal file
View file

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

12
Task/Perfect-numbers/Fortran/perfect-numbers.f Normal file
View file

@ -0,0 +1,12 @@
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

24
Task/Perfect-numbers/FreeBASIC/perfect-numbers.basic Normal file
View file

@ -0,0 +1,24 @@
' FB 1.05.0 Win64
Function isPerfect(n As Integer) As Boolean
If n < 2 Then Return False
If n Mod 2 = 1 Then Return False '' we can assume odd numbers are not perfect
Dim As Integer sum = 1, q
For i As Integer = 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 "The first 5 perfect numbers are : "
For i As Integer = 2 To 33550336
If isPerfect(i) Then Print i; " ";
Next
Print
Print "Press any key to quit"
Sleep

2
Task/Perfect-numbers/Frink/perfect-numbers.frink Normal file
View file

@ -0,0 +1,2 @@
isPerfect = {|n| sum[allFactors[n, true, false]] == n}
println[select[1 to 1000, isPerfect]]

3
Task/Perfect-numbers/FunL/perfect-numbers.funl Normal file
View file

@ -0,0 +1,3 @@
def perfect( n ) = sum( d | d <- 1..n if d|n ) == 2n
println( (1..500).filter(perfect) )

24
Task/Perfect-numbers/FutureBasic/perfect-numbers.basic Normal file
View file

@ -0,0 +1,24 @@
_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

2
Task/Perfect-numbers/GAP/perfect-numbers.gap Normal file
View file

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

36
Task/Perfect-numbers/Go/perfect-numbers.go Normal file
View file

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

3
Task/Perfect-numbers/Groovy/perfect-numbers-1.groovy Normal file
View file

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

1
Task/Perfect-numbers/Groovy/perfect-numbers-2.groovy Normal file
View file

@ -0,0 +1 @@
(0..10000).findAll { isPerfect(it) }.each { println it }

2
Task/Perfect-numbers/Haskell/perfect-numbers-1.hs Normal file
View file

@ -0,0 +1,2 @@
perfect n =
n == sum [i | i <- [1..n-1], n `mod` i == 0]

19
Task/Perfect-numbers/Haskell/perfect-numbers-2.hs Normal file
View file

@ -0,0 +1,19 @@
perfect =
(\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 :: IO ()
main = do
mapM_ print $ take 10 perfect
mapM_ (print . (\x -> (x, isPerfect x))) [6, 27, 28, 29, 496, 8128, 8129]

16
Task/Perfect-numbers/Haskell/perfect-numbers-3.hs Normal file
View file

@ -0,0 +1,16 @@
isPerfect :: Int -> Bool
isPerfect n =
let lows = filter ((0 ==) . rem n) [1 .. floor (sqrt (fromIntegral n))]
in 1 < n &&
n ==
quot
(sum
(lows ++
[ y
| x <- lows
, let y = quot n x
, x /= y ]))
2
main :: IO ()
main = print $ filter isPerfect [1 .. 10000]

12
Task/Perfect-numbers/HicEst/perfect-numbers.hicest Normal file
View file

@ -0,0 +1,12 @@
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

12
Task/Perfect-numbers/IS-BASIC/perfect-numbers.basic Normal file
View file

@ -0,0 +1,12 @@
100 PROGRAM "PerfectN.bas"
110 FOR X=1 TO 10000
120 IF PERFECT(X) THEN PRINT X;
130 NEXT
140 DEF PERFECT(N)
150 IF N<2 OR MOD(N,2)<>0 THEN LET PERFECT=0:EXIT DEF
160 LET S=1
170 FOR I=2 TO SQR(N)
180 IF MOD(N,I)=0 THEN LET S=S+I+N/I
190 NEXT
200 LET PERFECT=N=S
210 END DEF

15
Task/Perfect-numbers/Icon/perfect-numbers.icon Normal file
View file

@ -0,0 +1,15 @@
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

1
Task/Perfect-numbers/J/perfect-numbers-1.j Normal file
View file

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

15
Task/Perfect-numbers/J/perfect-numbers-2.j Normal file
View file

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

9
Task/Perfect-numbers/Java/perfect-numbers-1.java Normal file
View file

@ -0,0 +1,9 @@
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;
}

12
Task/Perfect-numbers/Java/perfect-numbers-2.java Normal file
View file

@ -0,0 +1,12 @@
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);
}

21
Task/Perfect-numbers/JavaScript/perfect-numbers-1.js Normal file
View file

@ -0,0 +1,21 @@
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);
}

19
Task/Perfect-numbers/JavaScript/perfect-numbers-2.js Normal file
View file

@ -0,0 +1,19 @@
(function (nFrom, nTo) {
function perfect(n) {
return n === range(1, n - 1).reduce(
function (a, x) {
return n % x ? a : a + x;
}, 0
);
}
function range(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
return range(nFrom, nTo).filter(perfect);
})(1, 10000);

1
Task/Perfect-numbers/JavaScript/perfect-numbers-3.js Normal file
View file

@ -0,0 +1 @@
[6, 28, 496, 8128]

23
Task/Perfect-numbers/JavaScript/perfect-numbers-4.js Normal file
View file

@ -0,0 +1,23 @@
(function (nFrom, nTo) {
function perfect(n) {
var lows = range(1, Math.floor(Math.sqrt(n))).filter(function (x) {
return (n % x) === 0;
});
return n > 1 && lows.concat(lows.map(function (x) {
return n / x;
})).reduce(function (a, x) {
return a + x;
}, 0) / 2 === n;
}
function range(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
return range(nFrom, nTo).filter(perfect)
})(1, 10000);

1
Task/Perfect-numbers/JavaScript/perfect-numbers-5.js Normal file
View file

@ -0,0 +1 @@
[6, 28, 496, 8128]

35
Task/Perfect-numbers/JavaScript/perfect-numbers-6.js Normal file
View file

@ -0,0 +1,35 @@
(function (nFrom, nTo) {
// MONADIC CHAIN (bind) IN LIEU OF FILTER
// ( monadic return for lists is just lambda x -> [x] )
return chain(
rng(nFrom, nTo),
function mPerfect(n) {
return (chain(
rng(1, Math.floor(Math.sqrt(n))),
function (y) {
return (n % y) === 0 && n > 1 ? [y, n / y] : [];
}
).reduce(function (a, x) {
return a + x;
}, 0) / 2 === n) ? [n] : [];
}
);
/******************************************************************/
// Monadic bind (chain) for lists
function chain(xs, f) {
return [].concat.apply([], xs.map(f));
}
function rng(m, n) {
return Array.apply(null, Array(n - m + 1)).map(function (x, i) {
return m + i;
});
}
})(1, 10000);

1
Task/Perfect-numbers/JavaScript/perfect-numbers-7.js Normal file
View file

@ -0,0 +1 @@
[6, 28, 496, 8128]

25
Task/Perfect-numbers/JavaScript/perfect-numbers-8.js Normal file
View file

@ -0,0 +1,25 @@
(() => {
const main = () =>
enumFromTo(1, 10000).filter(perfect);
// perfect :: Int -> Bool
const perfect = n => {
const
lows = enumFromTo(1, Math.floor(Math.sqrt(n)))
.filter(x => (n % x) === 0);
return n > 1 && lows.concat(lows.map(x => n / x))
.reduce((a, x) => (a + x), 0) / 2 === n;
};
// GENERIC --------------------------------------------
// enumFromTo :: Int -> Int -> [Int]
const enumFromTo = (m, n) =>
Array.from({
length: n - m + 1
}, (_, i) => i + m)
// MAIN ---
return main();
})();

1
Task/Perfect-numbers/JavaScript/perfect-numbers-9.js Normal file
View file

@ -0,0 +1 @@
[6, 28, 496, 8128]

7
Task/Perfect-numbers/Jq/perfect-numbers.jq Normal file
View file

@ -0,0 +1,7 @@
def is_perfect:
. as $in
| $in == reduce range(1;$in) as $i
(0; if ($in % $i) == 0 then $i + . else . end);
# Example:
range(1;10001) | select( is_perfect )

4
Task/Perfect-numbers/Julia/perfect-numbers.julia Normal file
View file

@ -0,0 +1,4 @@
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)

16
Task/Perfect-numbers/K/perfect-numbers.k Normal file
View file

@ -0,0 +1,16 @@
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)

24
Task/Perfect-numbers/Kotlin/perfect-numbers.kotlin Normal file
View file

@ -0,0 +1,24 @@
// version 1.0.6
fun isPerfect(n: Int): Boolean = when {
n < 2 -> false
n % 2 == 1 -> false // there are no known odd perfect numbers
else -> {
var tot = 1
var q: Int
for (i in 2 .. Math.sqrt(n.toDouble()).toInt()) {
if (n % i == 0) {
tot += i
q = n / i
if (q > i) tot += q
}
}
n == tot
}
}
fun main(args: Array<String>) {
// expect a run time of about 6 minutes on a typical laptop
println("The first five perfect numbers are:")
for (i in 2 .. 33550336) if (isPerfect(i)) print("$i ")
}

18
Task/Perfect-numbers/Lambdatalk/perfect-numbers-1.lambdatalk Normal file
View file

@ -0,0 +1,18 @@
{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

26
Task/Perfect-numbers/Lambdatalk/perfect-numbers-2.lambdatalk Normal file
View file

@ -0,0 +1,26 @@
{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

23
Task/Perfect-numbers/Lambdatalk/perfect-numbers-3.lambdatalk Normal file
View file

@ -0,0 +1,23 @@
{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"
};
}

15
Task/Perfect-numbers/Lasso/perfect-numbers-1.lasso Normal file
View file

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

1
Task/Perfect-numbers/Lasso/perfect-numbers-2.lasso Normal file
View file

@ -0,0 +1 @@
6, 28, 496, 8128

19
Task/Perfect-numbers/Liberty-BASIC/perfect-numbers.basic Normal file
View file

@ -0,0 +1,19 @@
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

Some files were not shown because too many files have changed in this diff Show more