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

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

20
Task/Perfect-numbers/00DESCRIPTION
View file

@ -1,15 +1,19 @@
Write a function which says whether a number is perfect.
[[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).
<br>
[[wp:Perfect_numbers|A perfect number]] is a positive integer that is the sum of its proper positive divisors excluding the number itself.
Note: The faster [[Lucas-Lehmer test]] is used to find primes of the form 2<sup>''n''</sup>-1, all ''known'' perfect numbers can be derived from these primes
using the formula (2<sup>''n''</sup> - 1) × 2<sup>''n'' - 1</sup>.
It is not known if there are any odd perfect numbers (any that exist are larger than 10<sup>2000</sup>).
Equivalently, a perfect number is a number that is half the sum of all of its positive divisors (including itself).
'''See also'''
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>).
;See also:
* [[Rational Arithmetic]]
* [[oeis:A000396|Perfect numbers on OEIS]]
* [http://www.oddperfect.org/ Odd Perfect] showing the current status of bounds on odd perfect numbers.
<br><br>

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

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

@ -0,0 +1,108 @@
-- perfect :: integer -> bool
on perfect(n)
-- isFactor :: integer -> bool
script isFactor
on lambda(x)
n mod x = 0
end lambda
end script
-- quotient :: number -> number
script quotient
on lambda(x)
n / x
end lambda
end script
-- sum :: number -> number -> number
script sum
on lambda(a, b)
a + b
end lambda
end script
-- Integer factors of n below the square root
set lows to filter(isFactor, range(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, range(1, 10000))
--> {6, 28, 496, 8128}
end run
-- GENERIC LIBRARY FUNCTIONS
-- 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 lambda(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 lambda(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 lambda(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- range :: Int -> Int -> [Int]
on range(m, n)
if n < m 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 range
-- 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 lambda : 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}

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

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

@ -0,0 +1,21 @@
#import system.
#import system'routines.
#import system'math.
#import extensions.
#class(extension)extension
{
#method is &perfect
= 1 repeat &till:self &each: n [ (self mod:n == 0) iif:n:0 ] summarize:(Integer new) == self.
}
#symbol program =
[
1 till:10000 &doEach: n
[
(n is &perfect)
? [ console writeLine:n:" is perfect". ].
].
console readChar.
].

7
Task/Perfect-numbers/Elixir/perfect-numbers.elixir
View file

@ -1,8 +1,13 @@
defmodule RC do
def is_perfect(1), do: false
def is_perfect(n) when n > 1 do
(for i <- 1..div(n,2), rem(n,i)==0, do: i) |> Enum.sum == n
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)

20
Task/Perfect-numbers/Go/perfect-numbers.go
View file

@ -2,6 +2,16 @@ 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 {
@ -24,13 +34,3 @@ func main() {
}
}
}
func computePerfect(n int64) bool {
var sum int64
for i := int64(1); i < n; i++ {
if n%i == 0 {
sum += i
}
}
return sum == n
}

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

@ -0,0 +1,24 @@
((nFrom, nTo) => {
// perfect :: Int -> Bool
let perfect = n => {
let lows = range(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;
},
// range :: Int -> Int -> Maybe Int -> [Int]
range = (m, n, step) => {
let d = (step || 1) * (n >= m ? 1 : -1);
return Array.from({
length: Math.floor((n - m) / d) + 1
}, (_, i) => m + (i * d));
};
return range(nFrom, nTo)
.filter(perfect);
})(1, 10000);

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

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

13
Task/Perfect-numbers/Perl/perfect-numbers-7.pl Normal file
View file

@ -0,0 +1,13 @@
use ntheory qw(is_mersenne_prime valuation hammingweight is_power sqrtint);
sub is_even_perfect {
my ($n) = @_;
$n % 2 == 0 || return;
my $square = 8 * $n + 1;
is_power($square, 2) || return;
my $k = (sqrtint($square) + 1) / 2;
hammingweight($k) == 1 && is_mersenne_prime(valuation($k, 2));
}

10
Task/Perfect-numbers/REXX/perfect-numbers-1.rexx
View file

@ -1,12 +1,12 @@
/*REXX version of the ooRexx pgm (code was modified for Classic REXX).*/
do i=1 to 10000 /*statement changed: LOOP ──► DO*/
/*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"
end
exit
perfectNumber: procedure; parse arg n /*statements changed: ROUTINE,USE*/
perfectNumber: procedure; parse arg n /*statements changed: ROUTINE,USE*/
sum=0
do i=1 to n%2 /*statement changed: LOOP ──► DO*/
if n//i==0 then sum=sum+i /*statement changed: sum += i */
do i=1 to n%2 /*statement changed: LOOP ──► DO*/
if n//i==0 then sum=sum+i /*statement changed: sum += i */
end
return sum=n

22
Task/Perfect-numbers/REXX/perfect-numbers-2.rexx
View file

@ -1,17 +1,17 @@
/*REXX version of the PL/I program (code was modified for Classic REXX).*/
parse arg low high . /*obtain the specified number(s).*/
if high=='' & low=='' then high=34000000 /*if no args, use a range.*/
if low=='' then low=1 /*if no LOW, then assume unity.*/
if high=='' then high=low /*if no HIGH, then assume LOW. */
/*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. */
if low=='' then low=1 /*if no LOW, then assume unity.*/
if high=='' then high=low /*if no HIGH, then assume LOW. */
do i=low to high /*process the single # or range. */
do i=low to high /*process the single # or range. */
if perfect(i) then say i 'is a perfect number.'
end /*i*/
exit
perfect: procedure; parse arg n /*get the number to be tested. */
sum=0 /*the sum of the factors so far. */
do i=1 for n-1 /*starting at 1, find all factors*/
if n//i==0 then sum=sum+i /*I is a factor of N, so add it.*/
perfect: procedure; parse arg n /*get the number to be tested. */
sum=0 /*the sum of the factors so far. */
do i=1 for n-1 /*starting at 1, find all factors*/
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! */
return sum=n /*if the sum matches N, perfect! */

41
Task/Perfect-numbers/REXX/perfect-numbers-3.rexx
View file

@ -1,22 +1,21 @@
/*REXX program tests if a number (or a range of numbers) is/are perfect.*/
parse arg low high . /*obtain the specified number(s).*/
if high=='' & low=='' then high=34000000 /*if no args, use a range.*/
if low=='' then low=1 /*if no LOW, then assume unity.*/
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting output. */
numeric digits max(9,w+2) /*ensure enough digits to handle#*/
/*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. */
if low=='' then low=1 /*if no LOW, then assume unity. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough digits to handle number*/
do i=low to high /*process the single # or range. */
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ISPERFECT subroutine────────────────*/
isPerfect: procedure; parse arg x /*get the number to be tested. */
if x<6 then return 0 /*perfect numbers can't be < six.*/
s=1 /*the first factor of X. _*/
do j=2 while j*j<=x /*starting at 2, find factors ≤√X*/
if x//j\==0 then iterate /*J isn't a factor of X, so skip.*/
s = s + j + x%j /*··· add it and the other factor*/
if s>x then return 0 /*Sum too big? It ain't perfect.*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, perfect! */
do i=low to high /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure; parse arg x /*obtain the number to be tested. */
if x<6 then return 0 /*perfect numbers can't be < six. */
s=1 /*the first factor of X. ___*/
do j=2 while j*j<=x /*starting at 2, find the factors ≤√ X */
if x//j\==0 then iterate /*J isn't a factor of X, so skip it.*/
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! */

53
Task/Perfect-numbers/REXX/perfect-numbers-4.rexx
View file

@ -1,29 +1,28 @@
/*REXX program tests if a number (or a range of numbers) is/are perfect.*/
parse arg low high . /*obtain the specified number(s).*/
if high=='' & low=='' then high=34000000 /*if no args, use a range.*/
if low=='' then low=1 /*if no LOW, then assume unity.*/
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting output. */
numeric digits max(9,w+2) /*ensure enough digits to handle#*/
/*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. */
if low=='' then low=1 /*if no LOW, then assume unity. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough digits to handle number*/
do i=low to high /*process the single # or range. */
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ISPERFECT subroutine────────────────*/
isPerfect: procedure; parse arg x 1 y /*get the number to be tested. */
if x==6 then return 1 /*handle special case of six. */
/*[↓] perfect #s digitalRoot = 1.*/
do until y<10 /*find the digital root of Y. */
parse var y r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end
y=r /*find digital root of dig root. */
end /*DO until*/ /*wash, rinse, repeat ··· */
do i=low to high /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure; parse arg x 1 y /*obtain the number to be tested. */
if x==6 then return 1 /*handle the special case of six. */
/*[↓] perfect number's digitalRoot = 1*/
do until y<10 /*find the digital root of Y. */
parse var y r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end /*k*/
y=r /*find digital root of the digit root. */
end /*until*/ /*wash, rinse, repeat ··· */
if r\==1 then return 0 /*Digital root ¬1? Then ¬perfect.*/
s=1 /*the first factor of X. _*/
do j=2 while j*j<=x /*starting at 2, find factors ≤√X*/
if x//j\==0 then iterate /*J isn't a factor of X, so skip.*/
s = s + j + x%j /*··· add it and the other factor*/
if s>x then return 0 /*Sum too big? It ain't perfect.*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, perfect! */
if r\==1 then return 0 /*Digital root ¬ 1? Then ¬ perfect. */
s=1 /*the first factor of X. ___*/
do j=2 while j*j<=x /*starting at 2, find the factors ≤√ X */
if x//j\==0 then iterate /*J isn't a factor of X, so skip it. */
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! */

54
Task/Perfect-numbers/REXX/perfect-numbers-5.rexx
View file

@ -1,31 +1,29 @@
/*REXX program tests if a number (or a range of numbers) is/are perfect.*/
parse arg low high . /*obtain the specified number(s).*/
if high=='' & low=='' then high=34000000 /*if no args, use a range.*/
if low=='' then low=1 /*if no LOW, then assume unity.*/
if low//2 then low=low+1 /*if LOW is odd, bump it by one.*/
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting output. */
numeric digits max(9,w+2) /*ensure enough digits to handle#*/
/*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. */
if low=='' then low=1 /*if no LOW, then assume unity. */
low=low+low//2 /*if LOW is odd, bump it by one. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough digits to handle number*/
do i=low to high by 2 /*process the single # or range. */
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ISPERFECT subroutine────────────────*/
isPerfect: procedure; parse arg x 1 y /*get the number to be tested. */
if x==6 then return 1 /*handle special case of six. */
do i=low to high by 2 /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure; parse arg x 1 y /*obtain the number to be tested. */
if x==6 then return 1 /*handle the special case of six. */
do until y<10 /*find the digital root of Y. */
parse var y r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end
y=r /*find digital root of dig root. */
end /*DO until*/ /*wash, rinse, repeat ··· */
do until y<10 /*find the digital root of Y. */
parse var y 1 r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end /*k*/
y=r /*find digital root of the digital root*/
end /*until*/ /*wash, rinse, repeat ··· */
if r\==1 then return 0 /*is dig root ¬1? Then ¬perfect.*/
s = 3 + x%2 /*the first 3 factors of X. _*/
do j=3 while j*j<=x /*starting at 3, find factors ≤√X*/
if x//j\==0 then iterate /*J isn't a factor of X, so skip.*/
s = s + j + x%j /*··· add it and the other factor*/
if s>x then return 0 /*Sum too big? It ain't perfect.*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, perfect! */
if r\==1 then return 0 /*Digital root ¬ 1 ? Then ¬ perfect.*/
s=3 + x%2 /*the first 3 factors of X. ___*/
do j=3 while j*j<=x /*starting at 3, find the factors ≤√ X */
if x//j\==0 then iterate /*J isn't a factor o f X, so skip it.*/
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!*/

62
Task/Perfect-numbers/REXX/perfect-numbers-6.rexx
View file

@ -1,33 +1,33 @@
/*REXX program tests if a number (or a range of numbers) is/are perfect.*/
parse arg low high . /*obtain the specified number(s).*/
if high=='' & low=='' then high=34000000 /*if no args, use a range.*/
if low=='' then low=1 /*if no LOW, then assume unity.*/
if low//2 then low=low+1 /*if LOW is odd, bump it by one.*/
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting output. */
numeric digits max(9,w+2) /*ensure enough digits to handle#*/
@.=0; @.1=2 /*highest magic # and its index.*/
do i=low to high by 2 /*process the single # or range. */
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ISPERFECT subroutine────────────────*/
isPerfect: procedure expose @.; parse arg x /*get the # to be tested.*/
/*Lucas-Lehmer know that perfect */
/* numbers can be expressed as: */
/* [2**n - 1] * [2** (n-1) ] */
/*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. */
if low=='' then low=1 /*if no LOW, then assume unity. */
low=low+low//2 /*if LOW is odd, bump it by one. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough digits to handle number*/
@.=0; @.1=2 /*highest magic number and its index. */
if @.0<x then do @.1=@.1 while @._<=x; _=(2**@.1-1)*2**(@.1-1); @.0=_; @._=_
end /*@.1*/ /*uses memoization for formula. */
do i=low to high by 2 /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure expose @.; parse arg x /*obtain the number to be tested. */
/*Lucas-Lehmer know that perfect */
/* numbers can be expressed as: */
/* [2**n - 1] * [2** (n-1) ] */
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer test? */
s = 3 + x%2 /*we know the following factors: */
/* 1 ('cause Mama said so.)*/
/* 2 ('cause it's even.) */
/* x÷2 " " " _*/
do j=3 while j*j<=x /*starting at 3, find factors ≤√X*/
if x//j\==0 then iterate /*J divides X evenly, so ... */
s = s + j + x%j /*··· add it and the other factor*/
if s>x then return 0 /*Sum too big? It ain't perfect.*/
end /*j*/ /*(above) is marginally faster. */
return s==x /*if the sum matches X, perfect! */
if @.0<x then do @.1=@.1 while @._<=x; _=(2**@.1-1)*2**(@.1-1); @.0=_; @._=_
end /*@.1*/ /*uses memoization for the formula. */
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer test? */
s = 3 + x%2 /*we know the following factors: */
/* 1 ('cause Mama said so.) */
/* 2 ('cause it's even.) */
/* x÷2 ( " " " ) ___*/
do j=3 while j*j<=x /*starting at 3, find the factors ≤√ X */
if x//j\==0 then iterate /*J divides X evenly, so ··· */
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!*/

86
Task/Perfect-numbers/REXX/perfect-numbers-7.rexx
View file

@ -1,47 +1,47 @@
/*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 args? Then use a range.*/
if low=='' then low=1 /*if no LOW, then assume unity. */
low=low+low//2 /*if LOW is odd, bump it by one. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough decimal digits for nums*/
@. =0; @.1=2; !.=2; _=' 6' /*highest magic number and its index.*/
/*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. */
if low=='' then low=1 /*if no LOW, then assume unity. */
low=low+low//2 /*if LOW is odd, bump it by one. */
if high=='' then high=low /*if no HIGH, then assume LOW. */
w=length(high) /*use W for formatting the output. */
numeric digits max(9,w+2) /*ensure enough decimal digits for nums*/
@. =0; @.1=2; !.=2; _=' 6' /*highest magic number and its index.*/
!._=22; !.16=12; !.28=8; !.36=20; !.56=20; !.76=20; !.96=20
/* [↑] "Lucas' numbers, in 1891. */
do i=low to high by 0 /*process the single number or a range.*/
/* [↑] "Lucas' numbers, in 1891. */
do i=low to high by 0 /*process the single number or a range.*/
if isPerfect(i) then say right(i,w) 'is a perfect number.'
i=i+!.? /*use a fast advance for the DO index. */
end /*i*/ /* [↑] note: the DO index is modified.*/
exit /*stick a fork in it, we're all done. */
/*────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure expose @. !. ? /*expose (make global) some variables. */
parse arg x 1 y '' -2 ? /*# (and copy), and the last 2 digits.*/
if x==6 then return 1 /*handle the special case of six. */
if !.?==2 then return 0 /*test last two digits: François Lucas.*/
/*╔═════════════════════════════════════════════════════════════╗
║ Lucas─Lehmer know that perfect numbers can be expressed as: ║
║ {2^n - 1} * {2^ (n-1) } ║
╚═════════════════════════════════════════════════════════════╝*/
if @.0<x then do @.1=@.1 while @._<=x; _=(2**@.1-1)*2**(@.1-1); @.0=_; @._=_
end /*@.1*/ /* [↑] uses memoization for formula. */
i=i+!.? /*use a fast advance for the DO index. */
end /*i*/ /* [↑] note: the DO index is modified.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPerfect: procedure expose @. !. ? /*expose (make global) some variables. */
parse arg x 1 y '' -2 ? /*# (and copy), and the last 2 digits.*/
if x==6 then return 1 /*handle the special case of six. */
if !.?==2 then return 0 /*test last two digits: François Lucas.*/
/*╔═════════════════════════════════════════════╗
║ Lucas─Lehmer know that perfect numbers can ║
║ be expressed as: [2^n -1] * {2^(n-1) } ║
╚═════════════════════════════════════════════╝*/
if @.0<x then do @.1=@.1 while @._<=x; _=(2**@.1-1)*2**(@.1-1); @.0=_; @._=_
end /*@.1*/ /* [↑] uses memoization for formula. */
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer? Not perfect*/
/*[↓] perfect numbers digital root = 1*/
do until y<10 /*find the digital root of Y. */
parse var y d 2; do k=2 for length(y)-1; d=d+substr(y,k,1); end
y=d /*find digital root of the digital root*/
end /*until ···*/ /*wash, rinse, repeat ··· */
if @.x==0 then return 0 /*Didn't pass Lucas-Lehmer? Not perfect*/
/*[↓] perfect numbers digital root = 1*/
do until y<10 /*find the digital root of Y. */
parse var y d 2; do k=2 for length(y)-1; d=d+substr(y,k,1); end /*k*/
y=d /*find digital root of the digital root*/
end /*until*/ /*wash, rinse, repeat ··· */
if d\==1 then return 0 /*Is digital root ¬ 1? Then ¬ perfect.*/
s=3 + x%2 /*we know the following factors: unity,*/
z=x /*2, and x÷2 (x is even). _____*/
q=1; do while q<=z; q=q*4; end /* [↓] R will be the integer √ X */
r=0
do while q>1; q=q%4; _=z-r-q; r=r%2; if _>=0 then do; z=_; r=r+q; end
end /*while ···*/ /* [↑] compute the integer SQRT of X.*/
/* ___ */
do j=3 to r until s>x /*starting at 3, find factors ≤ √ X */
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! */
if d\==1 then return 0 /*Is digital root ¬ 1? Then ¬ perfect.*/
s=3 + x%2 /*we know the following factors: unity,*/
z=x /*2, and x÷2 (x is even). */
q=1; do while q<=z; q=q*4 ; end /*while q≤z*/ /* _____*/
r=0 /* [↓] R will be the integer √ X */
do while q>1; q=q%4; _=z-r-q; r=r%2; if _>=0 then do; z=_; r=r+q; end
end /*while q>1*/ /* [↑] compute the integer SQRT of X.*/
/* _____*/
do j=3 to r /*starting at 3, find factors ≤ √ X */
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! */

17
Task/Perfect-numbers/Racket/perfect-numbers.rkt
View file

@ -1,12 +1,11 @@
#lang racket
(require math)
(define (perfect? n)
(= n
(for/fold ((sum 0))
((i (in-range 1 (add1 (floor (/ n 2))))))
(if (= (remainder n i) 0)
(+ sum i)
sum))))
(=
(* n 2)
(sum (divisors n))))
(filter perfect? (build-list 1000 values))
;-> '(0 6 28 496)
; filtering to only even numbers for better performance
(filter perfect? (filter even? (range 1e5)))
;-> '(0 6 28 496 8128)