Just another update

This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions

View file

@ -1,9 +1,15 @@
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).
[[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: 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.
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>).
'''See also'''
* [[Rational Arithmetic]]
*[[oeis:A000396|Perfect numbers on OEIS]]
* [[oeis:A000396|Perfect numbers on OEIS]]
* [http://www.oddperfect.org/ Odd Perfect] showing the current status of bounds on odd perfect numbers.

View file

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

View file

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

View file

@ -0,0 +1,24 @@
class
PERFECT_NUMBERS
feature
perfect(n:INTEGER):BOOLEAN
require
n_positive: n>0
local
sum, i: INTEGER
do
from
i:=1
until
i=n
loop
if n\\i=0 then
sum:=sum+i
end
i:= i+1
end
if sum= n then
RESULT:= TRUE
end
end
end

View file

@ -0,0 +1,20 @@
class
APPLICATION
inherit
ARGUMENTS
create
make
feature
make
do
create perfect
io.put_string ("%N 6 is perfect...%T")
io.put_boolean (perfect.perfect (6))
io.put_string ("%N77 is perfect...%T")
io.put_boolean (perfect.perfect (77))
io.put_string ("%N496 is perfect...%T")
io.put_boolean (perfect.perfect (496))
end
perfect: PERFECT_NUMBERS
end

View file

@ -0,0 +1,3 @@
def is_perfect(x) do
[1 | lc x inlist :lists.seq(2, div(n, 2)), rem(n, x) == 0, do: x] |> :lists.sum() == n
end

View file

@ -1 +1 @@
is_perfect=: = [: +/ ((0=]|[)i.) # i.
is_perfect=: +: = >:@#.~/.~&.q:@(6>.<.)

View file

@ -1,14 +1,15 @@
is_perfect 33550336
1
}.I. is_perfect"0 i. 10000
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_pos_int=: 0&< *. ]=>.
(is_perfect"0 *. is_pos_int) zero_through_twentynine
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

View file

@ -0,0 +1,9 @@
function perf = isPerfect(n)
total = 0;
for k = 1:n-1
if ~mod(n, k)
total = total+k;
end
end
perf = total == n;
end

View file

@ -0,0 +1,20 @@
function perf = isPerfect(n)
if n < 2
perf = false;
else
total = 1;
k = 2;
quot = n;
while k < quot && total <= n
if ~mod(n, k)
total = total+k;
quot = n/k;
if quot ~= k
total = total+quot;
end
end
k = k+1;
end
perf = total == n;
end
end

View file

@ -0,0 +1,2 @@
use ntheory qw/divisor_sum/;
sub is_perfect { my $n = shift; divisor_sum($n) == 2*$n; }

View file

@ -0,0 +1,4 @@
use ntheory qw/divisor_sum/;
for (1..33550336) {
print "$_\n" if divisor_sum($_) == 2*$_;
}

View file

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

View file

@ -1,13 +1,12 @@
/*REXX version of the ooRexx pgm (code was modified for Classic REXX).*/
do i=1 to 10000 /*statement changed: LOOP ──► DO*/
if perfectNumber(i) then say i "is a perfect number"
do i=1 to 10000 /*statement changed: LOOP ──► DO*/
if perfectNumber(i) then say i "is a perfect number"
end
exit
perfectNumber: procedure; 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*/
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

View file

@ -3,17 +3,15 @@ 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. */
call time 'R'
do i=low to high /*process the single # or range. */
if perfect(i) then say i 'is a perfect number.'
if perfect(i) then say i 'is a perfect number.'
end /*i*/
say 'and took' format(time('E'),,2) "seconds."
exit
perfect: procedure; parse arg n; /*get the number to be tested. */
sum=0; /*the sum of the factors so far. */
do i=1 to 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! */
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! */

View file

@ -7,14 +7,14 @@ w=length(high) /*use W for formatting output. */
numeric digits max(9,w+2) /*ensure enough digits to handle#*/
do i=low to high /*process the single # or range. */
if isperfect(i) then say right(i,w) 'is a perfect number.'
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. */
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*/
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.*/

View file

@ -7,22 +7,21 @@ w=length(high) /*use W for formatting output. */
numeric digits max(9,w+2) /*ensure enough digits to handle#*/
do i=low to high /*process the single # or range. */
if isperfect(i) then say right(i,w) 'is a perfect number.'
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. */
isPerfect: procedure; parse arg x 1 y /*get the number to be tested. */
if x==6 then return 1 /*handle special case of six. */
if x<28 then return 0 /*now, perfect numbers must be>27*/
do until length(y)==1 /*find the digital root of Y. */
parse var y 1 r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end
/*[↓] 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 ··· */
if r\==1 then return 0 /*is dig root ¬1? Then ¬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 factors ≤√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.*/

View file

@ -2,28 +2,28 @@
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#*/
do i=low to high /*process the single # or range. */
if isperfect(i) then say right(i,w) 'is a perfect 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//2 then return 0 /*handle special cases of odd #s.*/
isPerfect: procedure; parse arg x 1 y /*get the number to be tested. */
if x==6 then return 1 /*handle special case of six. */
if x<28 then return 0 /*now, perfect numbers must be>27*/
do until length(y)==1 /*find the digital root of Y. */
parse var y 1 r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end
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 ··· */
if r\==1 then return 0 /*is dig root ¬1? Then ¬perfect.*/
s = 3 + x%2 /*the first three factors of X. */
do j=3 while j*j<=x /*starting at 3, find factors ≤√X*/
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.*/

View file

@ -2,17 +2,17 @@
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 /*process the single # or range. */
if isperfect(i) then say right(i,w) 'is a perfect 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 expose @.; parse arg x /*get the # to be tested.*/
if x//2 then return 0 /*if it's an odd #, it ain't 'un.*/
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) ] */

View file

@ -0,0 +1,46 @@
/*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.*/
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 output. */
numeric digits max(9,w+2) /*ensure enough digits to handle#*/
@. =0; @.1=2; !.=2; _=' 6' /*highest magic # and its index.*/
!._=22; !.16=12; !.28=8; !.36=20; !.56=20; !.76=20; !.96=20
/* [↑] "Lucas' numbers, 1891. */
do i=low to high by 0 /*process the single # or range. */
if isPerfect(i) then say right(i,w) 'is a perfect number.'
i=i+!.? /*use a fast advance for DO loop.*/
end /*i*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────ISPERFECT subroutine────────────────*/
isPerfect: procedure expose @. !. ? /*expose (make global) some vars.*/
parse arg x 1 y '' -2 ? /*#, another copy, and last digit*/
if x==6 then return 1 /*handle special case of six. */
if !.?==2 then return 0 /*test last 2digs: 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 test? */
/*[↓] 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 /*until*/ /*wash, rinse, repeat ··· */
if r\==1 then return 0 /*Digital root ¬1? Then ¬perfect.*/
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! */

View file

@ -0,0 +1,24 @@
require "prime"
def mersenne_prime_pow?(p)
# Lucas-Lehmer test; expects prime as argument
return true if p == 2
m_p = ( 1 << p ) - 1
s = 4
(p-2).times{ s = (s**2 - 2) % m_p }
s == 0
end
@perfect_numerator = Prime.each.lazy.select{|p| mersenne_prime_pow?(p)}.map{|p| 2**(p-1)*(2**p-1)}
@perfects = @perfect_numerator.take(1).to_a
def perfect?(num)
@perfects << @perfect_numerator.next until @perfects.last >= num
@perfects.include? num
end
# demo
p (1..10000).select{|num| perfect?(num)}
t1 = Time.now
p perfect?(13164036458569648337239753460458722910223472318386943117783728128)
p Time.now - t1

View file

@ -0,0 +1,2 @@
def perfect(n: Int) =
(for (x <- 2 to n/2 if n % x == 0) yield x).sum + 1 == n