Abundant, deficient and perfect number classifications: Difference between revisions
| Line 458: | Line 458: | ||
var ps = {2:true, 3:true} |
var ps = {2:true, 3:true} |
||
next: for (var n=5, i=2; n<=t; n+=i, i=6-i) { |
next: for (var n=5, i=2; n<=t; n+=i, i=6-i) { |
||
var s = Math.sqrt( n ) |
|||
for ( var p in ps ) { |
|||
if ( p > s ) break |
|||
if ( n % p ) continue |
|||
continue next |
|||
} |
|||
ps[n] = true |
|||
} |
} |
||
return ps |
return ps |
||
Revision as of 16:24, 1 August 2015
You are encouraged to solve this task according to the task description, using any language you may know.
These define three classifications of positive integers based on their proper divisors.
Let P(n) be the sum of the proper divisors of n, where the proper divisors of n are all positive divisors of n other than n itself.
- if
P(n) < nthen n is classed as deficient (OEIS A005100). - if
P(n) == nthen n is classed as perfect (OEIS A000396). - if
P(n) > nthen n is classed as abundant (OEIS A005101).
Example: 6 has proper divisors 1, 2, and 3. 1 + 2 + 3 = 6 so 6 is classed as a perfect number.
- Task
Calculate how many of the integers 1 to 20,000 inclusive are in each of the three classes and show the result here.
- Cf.
- Aliquot sequence classifications. (The whole series from which this task is a subset).
- Proper divisors
- Amicable pairs
AutoHotkey
<lang autohotkey>Loop {
m := A_index
; getting factors=====================
loop % floor(sqrt(m))
{
if ( mod(m, A_index) == "0" )
{
if ( A_index ** 2 == m )
{
list .= A_index . ":"
sum := sum + A_index
continue
}
if ( A_index != 1 )
{
list .= A_index . ":" . m//A_index . ":"
sum := sum + A_index + m//A_index
}
if ( A_index == "1" )
{
list .= A_index . ":"
sum := sum + A_index
}
}
}
; Factors obtained above===============
if ( sum == m ) && ( sum != 1 )
{
result := "perfect"
perfect++
}
if ( sum > m )
{
result := "Abundant"
Abundant++
}
if ( sum < m ) or ( m == "1" )
{
result := "Deficient"
Deficient++
}
if ( m == 20000 )
{
MsgBox % "number: " . m . "`nFactors:`n" . list . "`nSum of Factors: " . Sum . "`nResult: " . result . "`n_______________________`nTotals up to: " . m . "`nPerfect: " . perfect . "`nAbundant: " . Abundant . "`nDeficient: " . Deficient
ExitApp
}
list := ""
sum := 0
}
esc::ExitApp </lang>
- Output:
number: 20000 Factors: 1:2:10000:4:5000:5:4000:8:2500:10:2000:16:1250:20:1000:25:800:32:625:40:500:50:400:80:250:100:200:125:160: Sum of Factors: 29203 Result: Abundant _______________________ Totals up to: 20000 Perfect: 4 Abundant: 4953 Deficient: 15043
AWK
works with GNU Awk 3.1.5 and with BusyBox v1.21.1 <lang AWK>
- !/bin/gawk -f
function sumprop(num, i,sum,root) { if (num == 1) return 0 sum=1 root=sqrt(num) for ( i=2; i < root; i++) {
if (num % i == 0 )
{
sum = sum + i + num/i
}
}
if (num % root == 0)
{
sum = sum + root
}
return sum }
BEGIN{ limit = 20000 abundant = 0 defiecient =0 perfect = 0
for (j=1; j < limit+1; j++)
{
sump = sumprop(j)
if (sump < j) deficient = deficient + 1
if (sump == j) perfect = perfect + 1
if (sump > j) abundant = abundant + 1
}
print "For 1 through " limit print "Perfect: " perfect print "Abundant: " abundant print "Deficient: " deficient } </lang>
- Output:
For 1 through 20000 Perfect: 4 Abundant: 4953 Deficient: 15043
Bracmat
Two solutions are given. The first solution first decomposes the current number into a multiset of prime factors and then constructs the proper divisors. The second solution finds proper divisors by checking all candidates from 1 up to the square root of the given number. The first solution is a few times faster, because establishing the prime factors of a small enough number (less than 2^32 or less than 2^64, depending on the bitness of Bracmat) is fast. <lang bracmat>( clk$:?t0 & ( multiples
= prime multiplicity
. !arg:(?prime.?multiplicity)
& !multiplicity:0
& 1
| !prime^!multiplicity*(.!multiplicity)
+ multiples$(!prime.-1+!multiplicity)
)
& ( P
= primeFactors prime exp poly S
. !arg^1/67:?primeFactors
& ( !primeFactors:?^1/67&0
| 1:?poly
& whl
' ( !primeFactors:%?prime^?exp*?primeFactors
& !poly*multiples$(!prime.67*!exp):?poly
)
& -1+!poly+1:?poly
& 1:?S
& ( !poly
: ?
+ (#%@?s*?&!S+!s:?S&~)
+ ?
| 1/2*!S
)
)
)
& 0:?deficient:?perfect:?abundant & 0:?n & whl
' ( 1+!n:~>20000:?n
& P$!n
: ( <!n&1+!deficient:?deficient
| !n&1+!perfect:?perfect
| >!n&1+!abundant:?abundant
)
)
& out$(deficient !deficient perfect !perfect abundant !abundant) & clk$:?t1 & out$(flt$(!t1+-1*!t0,2) sec) & clk$:?t2 & ( P
= f h S
. 0:?f
& 0:?S
& whl
' ( 1+!f:?f
& !f^2:~>!n
& ( !arg*!f^-1:~/:?g
& !S+!f:?S
& ( !g:~!f&!S+!g:?S
|
)
|
)
)
& 1/2*!S
)
& 0:?deficient:?perfect:?abundant & 0:?n & whl
' ( 1+!n:~>20000:?n
& P$!n
: ( <!n&1+!deficient:?deficient
| !n&1+!perfect:?perfect
| >!n&1+!abundant:?abundant
)
)
& out$(deficient !deficient perfect !perfect abundant !abundant) & clk$:?t3 & out$(flt$(!t3+-1*!t2,2) sec) );</lang> Output:
deficient 15043 perfect 4 abundant 4953 4,27*10E0 sec deficient 15043 perfect 4 abundant 4953 1,63*10E1 sec
C
<lang c>
- include<stdio.h>
- define d 0
- define p 1
- define a 2
int main(){ int sum_pd=0,i,j; int try_max=0; //1 is deficient by default and can add it deficient list int count_list[3]={1,0,0}; for(i=2;i<=20000;i++){ //Set maximum to check for proper division try_max=i/2; //1 is in all proper division number sum_pd=1; for(j=2;j<try_max;j++){ //Check for proper division if (i%j) continue; //Pass if not proper division //Set new maximum for divisibility check try_max=i/j; //Add j to sum sum_pd+=j; if (j!=try_max) sum_pd+=try_max; } //Categorize summation if (sum_pd<i){ count_list[d]++; continue; } else if (sum_pd>i){ count_list[a]++; continue; } count_list[p]++; } printf("\nThere are %d deficient,",count_list[d]); printf(" %d perfect,",count_list[p]); printf(" %d abundant numbers between 1 and 20000.\n",count_list[a]); return 0; } </lang>
- Output:
There are 15043 deficient, 4 perfect, 4953 abundant numbers between 1 and 20000.
Clojure
<lang clojure>(defn pad-class
[n]
(let [divs (filter #(zero? (mod n %)) (range 1 n))
divs-sum (reduce + divs)]
(cond
(< divs-sum n) :deficient
(= divs-sum n) :perfect
(> divs-sum n) :abundant)))
(def pad-classes (map pad-class (map inc (range))))
(defn count-classes
[n]
(let [classes (take n pad-classes)]
{:perfect (count (filter #(= % :perfect) classes))
:abundant (count (filter #(= % :abundant) classes))
:deficient (count (filter #(= % :deficient) classes))}))</lang>
Example:
<lang clojure>(count-classes 20000)
- => {
- perfect 4,
- abundant 4953,
- deficient 15043}</lang>
Common Lisp
<lang lisp>(defun number-class (n)
(let ((divisor-sum (sum-divisors n)))
(cond ((< divisor-sum n) :deficient)
((= divisor-sum n) :perfect)
((> divisor-sum n) :abundant))))
(defun sum-divisors (n)
(loop :for i :from 1 :to (/ n 2)
:when (zerop (mod n i))
:sum i))
(defun classification ()
(loop :for n :from 1 :to 20000
:for class := (number-class n)
:count (eq class :deficient) :into deficient
:count (eq class :perfect) :into perfect
:count (eq class :abundant) :into abundant
:finally (return (values deficient perfect abundant))))</lang>
Output:
CL-USER> (classification) 15043 4 4953
D
<lang d>void main() /*@safe*/ {
import std.stdio, std.algorithm, std.range;
static immutable properDivs = (in uint n) pure nothrow @safe /*@nogc*/ =>
iota(1, (n + 1) / 2 + 1).filter!(x => n % x == 0 && n != x);
enum Class { deficient, perfect, abundant }
static Class classify(in uint n) pure nothrow @safe /*@nogc*/ {
immutable p = properDivs(n).sum;
with (Class)
return (p < n) ? deficient : ((p == n) ? perfect : abundant);
}
enum rangeMax = 20_000; //iota(1, 1 + rangeMax).map!classify.hashGroup.writeln; iota(1, 1 + rangeMax).map!classify.array.sort().group.writeln;
}</lang>
- Output:
[Tuple!(Class, uint)(deficient, 15043), Tuple!(Class, uint)(perfect, 4), Tuple!(Class, uint)(abundant, 4953)]
Fortran
Although Fortran offers an intrinsic function SIGN(a,b) which returns the absolute value of a with the sign of b, it does not recognise zero as a special case, instead distinguishing only the two conditions b < 0 and b >= 0. Rather than a mess such as SIGN(a*b,b), a suitable SIGN3 function is needed. For it to be acceptable in whole-array expressions, it must have the PURE attribute asserted (signifying that it it may be treated as having a value dependent only on its explicit parameters) and further, that parameters must be declared with the (verbose) new protocol that enables the use of INTENT(IN) as furter assurance to the compiler. Finally, such a function must be associated with INTERFACE arrangements, easily done here merely by placing it within a MODULE.
Alternatively, an explicit DO-loop could simply inspect the KnownSum array and maintain three counts, moreover, doing so in a single pass rather than the three passes needed for the three COUNT statements.
Output:
Inspecting sums of proper divisors for 1 to 20000 Deficient 15043 Perfect! 4 Abundant 4953
<lang Fortran>
MODULE FACTORSTUFF !This protocol evades the need for multiple parameters, or COMMON, or one shapeless main line...
Concocted by R.N.McLean, MMXV.
INTEGER LOTS !The span..
PARAMETER (LOTS = 20000)!Nor is computer storage infinite.
INTEGER KNOWNSUM(LOTS) !Calculate these once.
CONTAINS !Assistants.
SUBROUTINE PREPARESUMF !Initialise the KNOWNSUM array.
Convert the Sieve of Eratoshenes to have each slot contain the sum of the proper divisors of its slot number. Changes to instead count the number of factors, or prime factors, etc. would be simple enough.
INTEGER F !A factor for numbers such as 2F, 3F, 4F, 5F, ...
KNOWNSUM(1) = 0 !Proper divisors of N do not include N.
KNOWNSUM(2:LOTS) = 1 !So, although 1 divides all N without remainder, 1 is excluded for itself.
DO F = 2,LOTS/2 !Step through all the possible divisors of numbers not exceeding LOTS.
FORALL(I = F + F:LOTS:F) KNOWNSUM(I) = KNOWNSUM(I) + F !And augment each corresponding slot.
END DO !Different divisors can hit the same slot. For instance, 6 by 2 and also by 3.
END SUBROUTINE PREPARESUMF !Could alternatively generate all products of prime numbers.
PURE INTEGER FUNCTION SIGN3(N) !Returns -1, 0, +1 according to the sign of N.
Confounded by the intrinsic function SIGN distinguishing only two states: < 0 from >= 0. NOT three-way.
INTEGER, INTENT(IN):: N !The number.
IF (N) 1,2,3 !A three-way result calls for a three-way test.
1 SIGN3 = -1 !Negative.
RETURN
2 SIGN3 = 0 !Zero.
RETURN
3 SIGN3 = +1 !Positive.
END FUNCTION SIGN3 !Rather basic.
END MODULE FACTORSTUFF !Enough assistants.
PROGRAM THREEWAYS !Classify N against the sum of proper divisors of N, for N up to 20,000.
USE FACTORSTUFF !This should help.
INTEGER I !Stepper.
INTEGER TEST(LOTS) !Assesses the three states in one pass.
WRITE (6,*) "Inspecting sums of proper divisors for 1 to",LOTS
CALL PREPARESUMF !Values for every N up to the search limit will be called for at least once.
FORALL(I = 1:LOTS) TEST(I) = SIGN3(KNOWNSUM(I) - I) !How does KnownSum(i) compare to i?
WRITE (6,*) "Deficient",COUNT(TEST .LT. 0) !This means one pass through the array
WRITE (6,*) "Perfect! ",COUNT(TEST .EQ. 0) !For each of three types.
WRITE (6,*) "Abundant ",COUNT(TEST .GT. 0) !Alternatively, make one pass with three counts.
END !Done.
</lang>
Haskell
<lang Haskell>divisors :: (Integral a) => a -> [a] divisors n = filter ((0 ==) . (n `mod`)) [1 .. (n `div` 2)]
classOf :: (Integral a) => a -> Ordering classOf n = compare (sum $ divisors n) n
main :: IO () main = do
let classes = map classOf [1 .. 20000 :: Int]
printRes w c = putStrLn $ w ++ (show . length $ filter (== c) classes)
printRes "deficient: " LT
printRes "perfect: " EQ
printRes "abundant: " GT</lang>
- Output:
deficient: 15043 perfect: 4 abundant: 4953
J
<lang J>factors=: [: /:~@, */&>@{@((^ i.@>:)&.>/)@q:~&__ properDivisors=: factors -. ]</lang>
We can subtract the sum of a number's proper divisors from itself to classify the number:
<lang J> (- +/@properDivisors&>) 1+i.10 1 1 2 1 4 0 6 1 5 2</lang>
Except, we are only concerned with the sign of this difference:
<lang J> *(- +/@properDivisors&>) 1+i.30 1 1 1 1 1 0 1 1 1 1 1 _1 1 1 1 1 1 _1 1 _1 1 1 1 _1 1 1 1 0 1 _1</lang>
Also, we do not care about the individual classification but only about how many numbers fall in each category:
<lang J> #/.~ *(- +/@properDivisors&>) 1+i.20000 15043 4 4953</lang>
So: 15043 deficient, 4 perfect and 4953 abundant numbers in this range.
How do we know which is which? We look at the unique values (which are arranged by their first appearance, scanning the list left to right):
<lang J> ~. *(- +/@properDivisors&>) 1+i.20000 1 0 _1</lang>
The sign of the difference is negative for the abundant case - where the sum is greater than the number. And we rely on order being preserved in sequences (this happens to be a fundamental property of computer memory, also).
JavaScript
<lang Javascript>for (var dpa=[1,0,0], n=2; n<=20000; n+=1) {
for (var ds=0, d=1, e=n/2+1; d<e; d+=1) if (n%d==0) ds+=d
dpa[ds<n ? 0 : ds==n ? 1 : 2]+=1
}
document.write('Deficient:',dpa[0], ', Perfect:',dpa[1], ', Abundant:',dpa[2], '
' )</lang>
Or:
<lang Javascript>for (var dpa=[1,0,0], n=2; n<=20000; n+=1) {
for (var ds=1, d=2, e=Math.sqrt(n); d<e; d+=1) if (n%d==0) ds+=d+n/d
if (n%e==0) ds+=e
dpa[ds<n ? 0 : ds==n ? 1 : 2]+=1
}
document.write('Deficient:',dpa[0], ', Perfect:',dpa[1], ', Abundant:',dpa[2], '
' )</lang>
Or:
<lang Javascript>function primes(t) {
var ps = {2:true, 3:true}
next: for (var n=5, i=2; n<=t; n+=i, i=6-i) {
var s = Math.sqrt( n )
for ( var p in ps ) {
if ( p > s ) break
if ( n % p ) continue
continue next
}
ps[n] = true
}
return ps
}
function factorize(f, t) { var cs = {}, ps = primes(t) for (var n=f; n<=t; n++) if (!ps[n]) cs[n] = factors(n) return cs function factors(n) { for ( var p in ps ) if ( n % p == 0 ) break var ts = {} ts[p] = 1 if ( ps[n /= p] ) { if ( !ts[n]++ ) ts[n]=1 } else { var fs = cs[n] if ( !fs ) cs[n] = fs = factors(n) for ( var e in fs ) ts[e] = fs[e] + (e==p ? 1 : 0) } return ts } }
function pContrib(p, e) { for (var pc=1, n=1, i=1; i<=e; i+=1) pc+=n*=p; return pc }
for (var dpa=[1,0,0], t=20000, cs=factorize(2,t), n=2; n<=t; n+=1) {
var ds=1, fs=cs[n]
if (fs) {
for (var p in fs) ds *= pContrib(p, fs[p])
ds -= n
}
dpa[ds<n ? 0 : ds==n ? 1 : 2]+=1
}
document.write('Deficient:',dpa[0], ', Perfect:',dpa[1], ', Abundant:',dpa[2], '
' )</lang>
- Output:
Deficient:15043, Perfect:4, Abundant:4953
Julia
This post was created with Julia version 0.3.6. The code uses no exotic features and should work for a wide range of Julia versions.
The Math
A natural number can be written as a product of powers of its prime factors,
. Handily Julia has the factor function, which provides these parameters. The sum of n's divisors (n inclusive) is
.
Functions
divisorsum calculates the sum of aliquot divisors. It uses pcontrib to calculate the contribution of each prime factor.
<lang Julia> function pcontrib(p::Int64, a::Int64)
n = one(p)
pcon = one(p)
for i in 1:a
n *= p
pcon += n
end
return pcon
end
function divisorsum(n::Int64)
dsum = one(n)
for (p, a) in factor(n)
dsum *= pcontrib(p, a)
end
dsum -= n
end
</lang>
Perhaps pcontrib could be made more efficient by caching results to avoid repeated calculations.
Main
Use a three element array, iclass, rather than three separate variables to tally the classifications. Take advantage of the fact that the sign of divisorsum(n) - n depends upon its class to increment iclass. 1 is a difficult case, it is deficient by convention, so I manually add its contribution and start the accumulation with 2. All primes are deficient, so I test for those and tally accordingly, bypassing divisorsum.
<lang Julia> const L = 2*10^4 iclasslabel = ["Deficient", "Perfect", "Abundant"] iclass = zeros(Int64, 3) iclass[1] = one(Int64) #by convention 1 is deficient
for n in 2:L
if isprime(n)
iclass[1] += 1
else
iclass[sign(divisorsum(n)-n)+2] += 1
end
end
println("Classification of integers from 1 to ", L) for i in 1:3
println(" ", iclasslabel[i], ", ", iclass[i])
end </lang>
- Output:
Classification of integers from 1 to 20000
Deficient, 15043
Perfect, 4
Abundant, 4953
jq
The definition of proper_divisors is taken from Proper_divisors#jq: <lang jq># unordered def proper_divisors:
. as $n
| if $n > 1 then 1,
( range(2; 1 + (sqrt|floor)) as $i
| if ($n % $i) == 0 then $i,
(($n / $i) | if . == $i then empty else . end)
else empty end)
else empty end;</lang>
The task: <lang jq>def sum(stream): reduce stream as $i (0; . + $i);
def classify:
. as $n | sum(proper_divisors) | if . < $n then "deficient" elif . == $n then "perfect" else "abundant" end;
reduce (range(1; 20001) | classify) as $c ({}; .[$c] += 1 )</lang>
- Output:
<lang sh>$ jq -n -c -f AbundantDeficientPerfect.jq {"deficient":15043,"perfect":4,"abundant":4953}</lang>
Mathematica / Wolfram Language
<lang Mathematica>classify[n_Integer] := Sign[Total[Most@Divisors@n] - n]
StringJoin[
Flatten[Tally[
Table[classify[n], {n, 20000}]] /. {-1 -> "deficient: ",
0 -> " perfect: ", 1 -> " abundant: "}] /.
n_Integer :> ToString[n]]</lang>
- Output:
deficient: 15043 perfect: 4 abundant: 4953
ML
mLite
<lang ocaml>fun proper (number, count, limit, remainder, results) where (count > limit) = rev results | (number, count, limit, remainder, results) = proper (number, count + 1, limit, number rem (count+1), if remainder = 0 then count :: results else results) | number = (proper (number, 1, number div 2, 0, []))
fun is_abundant number = number < (fold (op +, 0) ` proper number); fun is_deficient number = number > (fold (op +, 0) ` proper number); fun is_perfect number = number = (fold (op +, 0) ` proper number);
val one_to_20000 = iota 20000;
print "Abundant numbers between 1 and 20000: "; println ` fold (op +, 0) ` map ((fn n = if n then 1 else 0) o is_abundant) one_to_20000;
print "Deficient numbers between 1 and 20000: "; println ` fold (op +, 0) ` map ((fn n = if n then 1 else 0) o is_deficient) one_to_20000;
print "Perfect numbers between 1 and 20000: "; println ` fold (op +, 0) ` map ((fn n = if n then 1 else 0) o is_perfect) one_to_20000; </lang> Output
Abundant numbers between 1 and 20000: 4953 Deficient numbers between 1 and 20000: 15043 Perfect numbers between 1 and 20000: 4
Oforth
<lang Oforth>Integer method: properDivs { seq(self 2 / ) filter(#[ self swap mod 0 == ]) }
func: numberClasses { | i deficient perfect s |
0 0 ->deficient ->perfect
0 20000 loop: i [
i properDivs sum ->s
s i < ifTrue: [ deficient 1 + ->deficient continue ]
s i == ifTrue: [ perfect 1 + ->perfect continue ]
1 +
]
"Deficients : " print deficient println
"Perfects : " print perfect println
"Abundant : " print println
}</lang>
- Output:
numberClasses Deficients : 15043 Perfects : 4 Abundant : 4953
PARI/GP
<lang parigp>classify(k)= {
my(v=[0,0,0],t); for(n=1,k, t=sigma(n,-1); if(t<2,v[1]++,t>2,v[3]++,v[2]++) ); v;
} classify(20000)</lang>
- Output:
%1 = [15043, 4, 4953]
Pascal
using the slightly modified http://rosettacode.org/wiki/Amicable_pairs#Alternative <lang pascal>program AmicablePairs; {find amicable pairs in a limited region 2..MAX beware that >both< numbers must be smaller than MAX there are 455 amicable pairs up to 524*1000*1000 correct up to
- 437 460122410
} //optimized for freepascal 2.6.4 32-Bit {$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON,peephole,cse,asmcse,regvar}
{$CODEALIGN loop=1,proc=8}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils;
const
MAX = 20000;
//{$IFDEF UNIX} MAX = 524*1000*1000;{$ELSE}MAX = 499*1000*1000;{$ENDIF} type
tValue = LongWord;
tpValue = ^tValue;
tPower = array[0..31] of tValue;
tIndex = record
idxI,
idxS : tValue;
end;
tdpa = array[0..2] of LongWord;
var
power : tPower; PowerFac : tPower; DivSumField : array[0..MAX] of tValue; Indices : array[0..511] of tIndex; DpaCnt : tdpa;
procedure Init; var
i : LongInt;
begin
DivSumField[0]:= 0; For i := 1 to MAX do DivSumField[i]:= 1;
end;
procedure ProperDivs(n: tValue); //Only for output, normally a factorication would do var
su,so : string; i,q : tValue;
begin
su:= '1';
so:= ;
i := 2;
while i*i <= n do
begin
q := n div i;
IF q*i -n = 0 then
begin
su:= su+','+IntToStr(i);
IF q <> i then
so:= ','+IntToStr(q)+so;
end;
inc(i);
end;
writeln(' [',su+so,']');
end;
procedure AmPairOutput(cnt:tValue); var
i : tValue; r : double;
begin
r := 1.0;
For i := 0 to cnt-1 do
with Indices[i] do
begin
writeln(i+1:4,IdxI:12,IDxS:12,' ratio ',IdxS/IDxI:10:7);
if r < IdxS/IDxI then
r := IdxS/IDxI;
IF cnt < 20 then
begin
ProperDivs(IdxI);
ProperDivs(IdxS);
end;
end;
writeln(' max ratio ',r:10:4);
end;
function Check:tValue; var
i,s,n : tValue;
begin
fillchar(DpaCnt,SizeOf(dpaCnt),#0);
n := 0;
For i := 1 to MAX do
begin
//s = sum of proper divs (I) == sum of divs (I) - I
s := DivSumField[i]-i;
IF (s <=MAX) AND (s>i) then
begin
IF DivSumField[s]-s = i then
begin
With indices[n] do
begin
idxI := i;
idxS := s;
end;
inc(n);
end;
end;
inc(DpaCnt[Ord(s>=i)-Ord(s<=i)+1]);
end;
result := n;
end;
Procedure CalcPotfactor(prim:tValue); //PowerFac[k] = (prim^(k+1)-1)/(prim-1) == Sum (i=1..k) prim^i var
k: tValue; Pot, //== prim^k PFac : Int64;
begin
Pot := prim;
PFac := 1;
For k := 0 to High(PowerFac) do
begin
PFac := PFac+Pot;
IF (POT > MAX) then
BREAK;
PowerFac[k] := PFac;
Pot := Pot*prim;
end;
end;
procedure InitPW(prim:tValue); begin
fillchar(power,SizeOf(power),#0); CalcPotfactor(prim);
end;
function NextPotCnt(p: tValue):tValue;inline; //return the first power <> 0 //power == n to base prim var
i : tValue;
begin
result := 0;
repeat
i := power[result];
Inc(i);
IF i < p then
BREAK
else
begin
i := 0;
power[result] := 0;
inc(result);
end;
until false;
power[result] := i;
end;
function Sieve(prim: tValue):tValue; //simple version var
actNumber : tValue;
begin
while prim <= MAX do
begin
InitPW(prim);
//actNumber = actual number = n*prim
//power == n to base prim
actNumber := prim;
while actNumber < MAX do
begin
DivSumField[actNumber] := DivSumField[actNumber] *PowerFac[NextPotCnt(prim)];
inc(actNumber,prim);
end;
//next prime
repeat
inc(prim);
until (DivSumField[prim] = 1);
end;
result := prim;
end;
var
T2,T1,T0: TDatetime; APcnt: tValue;
begin
T0:= time;
Init;
Sieve(2);
T1:= time;
APCnt := Check;
T2:= time;
//AmPairOutput(APCnt);
writeln(Max:10,' upper limit');
writeln(DpaCnt[0]:10,' deficient');
writeln(DpaCnt[1]:10,' perfect');
writeln(DpaCnt[2]:10,' abundant');
writeln(DpaCnt[2]/Max:14:10,' ratio abundant/upper Limit ');
writeln(DpaCnt[0]/Max:14:10,' ratio abundant/upper Limit ');
writeln(DpaCnt[2]/DpaCnt[0]:14:10,' ratio abundant/deficient ');
writeln('Time to calc sum of divs ',FormatDateTime('HH:NN:SS.ZZZ' ,T1-T0));
writeln('Time to find amicable pairs ',FormatDateTime('HH:NN:SS.ZZZ' ,T2-T1));
{$IFNDEF UNIX}
readln;
{$ENDIF}
end. </lang> output
20000 upper limit
15043 deficient
4 perfect
4953 abundant
0.2476500000 ratio abundant/upper Limit
0.7521500000 ratio abundant/upper Limit
0.3292561324 ratio abundant/deficient
Time to calc sum of divs 00:00:00.000
Time to find amicable pairs 00:00:00.000
...
524000000 upper limit
394250308 deficient
5 perfect
129749687 abundant
0.2476139065 ratio abundant/upper Limit
0.7523860840 ratio abundant/upper Limit
0.3291048463 ratio abundant/deficient
Time to calc sum of divs 00:00:12.597
Time to find amicable pairs 00:00:04.064
Perl
Using a module
We can use the <=> operator to return a comparison of -1, 0, or 1, which classifies the results. Let's look at the values from 1 to 30: <lang perl>use ntheory qw/divisor_sum/; say join " ", map { divisor_sum($_)-$_ <=> $_ } 1..30;</lang>
- Output:
-1 -1 -1 -1 -1 0 -1 -1 -1 -1 -1 1 -1 -1 -1 -1 -1 1 -1 1 -1 -1 -1 1 -1 -1 -1 0 -1 1
We can see 6 is the first perfect number, 12 is the first abundant number, and 1 is classified as a deficient number.
Showing the totals for the first 20k numbers: <lang perl>use ntheory qw/divisor_sum/; my %h; $h{divisor_sum($_)-$_ <=> $_}++ for 1..20000; say "Perfect: $h{0} Deficient: $h{-1} Abundant: $h{1}";</lang>
- Output:
Perfect: 4 Deficient: 15043 Abundant: 4953
Perl 6
<lang perl6>sub propdivsum (\x) {
[+] (1 if x > 1), gather for 2 .. x.sqrt.floor -> \d {
my \y = x div d;
if y * d == x { take d; take y unless y == d }
}
}
say bag map { propdivsum($_) <=> $_ }, 1..20000</lang>
- Output:
bag(Less(15043), Same(4), More(4953))
PicoLisp
<lang PicoLisp>(de accud (Var Key)
(if (assoc Key (val Var))
(con @ (inc (cdr @)))
(push Var (cons Key 1)) )
Key )
(de factor-sum (N)
(if (=1 N)
0
(let
(R NIL
D 2
L (1 2 2 . (4 2 4 2 4 6 2 6 .))
M (sqrt N)
N1 N
S 1 )
(while (>= M D)
(if (=0 (% N1 D))
(setq M
(sqrt (setq N1 (/ N1 (accud 'R D)))) )
(inc 'D (pop 'L)) ) )
(accud 'R N1)
(for I R
(one D)
(one M)
(for J (cdr I)
(setq M (* M (car I)))
(inc 'D M) )
(setq S (* S D)) )
(- S N) ) ) )
(bench
(let
(A 0
D 0
P 0 )
(for I 20000
(setq @@ (factor-sum I))
(cond
((< @@ I) (inc 'D))
((= @@ I) (inc 'P))
((> @@ I) (inc 'A)) ) )
(println D P A) ) )
(bye)</lang>
- Output:
15043 4 4953 0.593 sec
PL/I
<lang pli>*process source xref;
apd: Proc Options(main);
p9a=time();
Dcl (p9a,p9b) Pic'(9)9';
Dcl cnt(3) Bin Fixed(31) Init((3)0);
Dcl x Bin Fixed(31);
Dcl pd(300) Bin Fixed(31);
Dcl sumpd Bin Fixed(31);
Dcl npd Bin Fixed(31);
Do x=1 To 20000;
Call proper_divisors(x,pd,npd);
sumpd=sum(pd,npd);
Select;
When(x<sumpd) cnt(1)+=1; /* abundant */
When(x=sumpd) cnt(2)+=1; /* perfect */
Otherwise cnt(3)+=1; /* deficient */
End;
End;
Put Edit('In the range 1 - 20000')(Skip,a);
Put Edit(cnt(1),' numbers are abundant ')(Skip,f(5),a);
Put Edit(cnt(2),' numbers are perfect ')(Skip,f(5),a);
Put Edit(cnt(3),' numbers are deficient')(Skip,f(5),a);
p9b=time();
Put Edit((p9b-p9a)/1000,' seconds elapsed')(Skip,f(6,3),a);
Return;
proper_divisors: Proc(n,pd,npd);
Dcl (n,pd(300),npd) Bin Fixed(31);
Dcl (d,delta) Bin Fixed(31);
npd=0;
If n>1 Then Do;
If mod(n,2)=1 Then /* odd number */
delta=2;
Else /* even number */
delta=1;
Do d=1 To n/2 By delta;
If mod(n,d)=0 Then Do;
npd+=1;
pd(npd)=d;
End;
End;
End;
End;
sum: Proc(pd,npd) Returns(Bin Fixed(31)); Dcl (pd(300),npd) Bin Fixed(31); Dcl sum Bin Fixed(31) Init(0); Dcl i Bin Fixed(31); Do i=1 To npd; sum+=pd(i); End; Return(sum); End;
End;</lang>
- Output:
In the range 1 - 20000
4953 numbers are abundant
4 numbers are perfect
15043 numbers are deficient
0.560 seconds elapsed
PowerShell
<lang powershell>new-variable deficient -value 0 new-variable perfect -value 0 new-variable abundant -value 0 new-variable sum
for($i=1;$i -le 20000;$i++){ $sum=0 for($n=1;$n -le [System.Math]::Floor([System.Math]::Sqrt($i));$n++){ if($i%$n -eq 0){ $sum+=($i/$n) if($i/$n -ne $n) {$sum+=$n} } } $sum-=$i if($sum -lt $i){ $deficient++ } elseif($sum -eq $i){ $perfect++ } else { $abundant++ } }
Write-Host "Deficient = $deficient" Write-Host "Perfect = $perfect" Write-Host "Abundant = $abundant"</lang>
- Output:
Deficient = 15043 Perfect = 4 Abundant = 4953
Python
Importing Proper divisors from prime factors: <lang python>>>> from proper_divisors import proper_divs >>> from collections import Counter >>> >>> rangemax = 20000 >>> >>> def pdsum(n): ... return sum(proper_divs(n)) ... >>> def classify(n, p): ... return 'perfect' if n == p else 'abundant' if p > n else 'deficient' ... >>> classes = Counter(classify(n, pdsum(n)) for n in range(1, 1 + rangemax)) >>> classes.most_common() [('deficient', 15043), ('abundant', 4953), ('perfect', 4)] >>> </lang>
- Output:
Between 1 and 20000: 4953 abundant numbers 15043 deficient numbers 4 perfect numbers
Racket
<lang racket>#lang racket (require math) (define (proper-divisors n) (drop-right (divisors n) 1)) (define classes '(deficient perfect abundant)) (define (classify n)
(list-ref classes (add1 (sgn (- (apply + (proper-divisors n)) n)))))
(let ([N 20000])
(define t (make-hasheq)) (for ([i (in-range 1 (add1 N))]) (define c (classify i)) (hash-set! t c (add1 (hash-ref t c 0)))) (printf "The range between 1 and ~a has:\n" N) (for ([c classes]) (printf " ~a ~a numbers\n" (hash-ref t c 0) c)))</lang>
- Output:
The range between 1 and 20000 has: 15043 deficient numbers 4 perfect numbers 4953 abundant numbers
REXX
version 1
<lang rexx>/*REXX pgm counts the # of abundant/deficient/perfect numbers in a range*/ parse arg low high . /*get optional arguments*/ high=word(high low 20000,1); low=word(low 1,1) /*get the LOW and HIGH. */ say center('integers from ' low " to " high, 45, "═") a=0; d=0; p=0 /*set all types of sums to bupkis*/
do j=low to high; $=sigma(j) /*find the sigma for an int range*/
if $<j then d=d+1 /*it's a deficient number. */
else if $>j then a=a+1 /* " " abundant " */
else p=p+1 /* " " perfect " */
end /*j*/
say ' the number of perfect numbers: ' right(p, length(high)) say ' the number of abundant numbers: ' right(a, length(high)) say ' the number of deficient numbers: ' right(d, length(high)) exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────SIGMA subroutine────────────────────*/ sigma: procedure; parse arg x; if x<2 then return 0; odd=x//2 s=1 /* [↓] use only EVEN|ODD integers*/
do j=2+odd by 1+odd while j*j<x /*divide by all integers up to √x*/
if x//j==0 then s=s+j+ x%j /*add the two divisors to the sum*/
end /*j*/ /* [↑] % is REXX integer divide*/
/* [↓] adjust for square. _ */
if j*j==x then s=s+j /*Was X a square? If so, add √x.*/ return s /*return the sum of the divisors.*/</lang> output when using the default inputs:
═════════integers from 1 to 20000═════════ the number of perfect numbers: 4 the number of abundant numbers: 4953 the number of deficient numbers: 15043
version 1.5
This version is pretty much the same as the 1st version but uses an integer square root function to calculate the limit of the do loop in the sigma function. <lang rexx>/*REXX pgm counts the # of abundant/deficient/perfect numbers in a range*/ parse arg low high . /*get optional arguments*/ high=word(high low 20000,1); low=word(low 1,1) /*get the LOW and HIGH. */ say center('integers from ' low " to " high, 45, "═") !.=0 /*set all types of sums to zero. */
do j=low to high; $=sigma(j) /*find the sigma for an int range*/
if $<j then !.d=!.d+1 /*it's a deficient number*/
else if $>j then !.a=!.a+1 /* " " abundant " */
else !.p=!.p+1 /* " " perfect " */
end /*j*/
say ' the number of perfect numbers: ' right(!.p, length(high)) say ' the number of abundant numbers: ' right(!.a, length(high)) say ' the number of deficient numbers: ' right(!.d, length(high)) exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────ISQRT subroutine────────────────────*/ iSqrt: procedure; parse arg x; q=1; r=0; do while q<=x; q=q*4; end
do while q>1; q=q%4; _=x-r-q; r=r%2; if _>=0 then do; x=_; r=r+q; end end /*while q>1*/
return r /*──────────────────────────────────SIGMA subroutine────────────────────*/ sigma: procedure; parse arg x; odd=x//2 /* [↓] some special cases.*/ if x<5 then do; if x==0 then return 0; return x-1; end sqX=iSqrt(x) /*calculate the integer square rt*/ s=1 /* [↓] use only EVEN|ODD integers*/
do j=2+odd by 1+odd to sqX /*divide by all integers up to √x*/
if x//j==0 then s=s+j+ x%j /*add the two divisors to the sum*/
end /*j*/ /* [↑] % is REXX integer divide*/
/* [↓] adjust for square. _ */
if sqX*sqX==x then s=s-j /*Is X a square? If so, sub √x.*/ return s /*return the sum of the divisors.*/</lang> output is the same as the 1st version.
version 2
<lang rexx>Call time 'R' cnt.=0 Do x=1 To 20000
pd=proper_divisors(x)
sumpd=sum(pd)
Select
When x<sumpd Then cnt.abundant =cnt.abundant +1
When x=sumpd Then cnt.perfect =cnt.perfect +1
Otherwise cnt.deficient=cnt.deficient+1
End
Select
When npd>hi Then Do
list.npd=x
hi=npd
End
When npd=hi Then
list.hi=list.hi x
Otherwise
Nop
End
End
Say 'In the range 1 - 20000' Say format(cnt.abundant ,5) 'numbers are abundant ' Say format(cnt.perfect ,5) 'numbers are perfect ' Say format(cnt.deficient,5) 'numbers are deficient ' Say time('E') 'seconds elapsed' Exit
proper_divisors: Procedure Parse Arg n Pd= If n=1 Then Return If n//2=1 Then /* odd number */
delta=2
Else /* even number */
delta=1
Do d=1 To n%2 By delta
If n//d=0 Then pd=pd d End
Return space(pd)
sum: Procedure Parse Arg list sum=0 Do i=1 To words(list)
sum=sum+word(list,i) End
Return sum</lang>
- Output:
In the range 1 - 20000
4953 numbers are abundant
4 numbers are perfect
15043 numbers are deficient
28.392000 seconds elapsed
Ruby
With proper_divisors#Ruby in place: <lang ruby>res = Hash.new(0) (1 .. 20_000).each{|n| res[n.proper_divisors.inject(0, :+) <=> n] += 1} puts "Deficient: #{res[-1]} Perfect: #{res[0]} Abundant: #{res[1]}" </lang>
- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
Scala
<lang Scala>def properDivisors(n: Int) = (1 to n/2).filter(i => n % i == 0) def classifier(i: Int) = properDivisors(i).sum compare i val groups = (1 to 20000).groupBy( classifier ) println("Deficient: " + groups(-1).length) println("Abundant: " + groups(1).length) println("Perfect: " + groups(0).length + " (" + groups(0).mkString(",") + ")")</lang>
- Output:
Deficient: 15043 Abundant: 4953 Perfect: 4 (6,28,496,8128)
Scheme
<lang scheme> (define (classify n)
(define (sum_of_factors x)
(cond ((= x 1) 1)
((= (remainder n x) 0) (+ x (sum_of_factors (- x 1))))
(else (sum_of_factors (- x 1)))))
(cond ((or (= n 1) (< (sum_of_factors (floor (/ n 2))) n)) -1)
((= (sum_of_factors (floor (/ n 2))) n) 0)
(else 1)))
(define n_perfect 0) (define n_abundant 0) (define n_deficient 0) (define (count n)
(cond ((= n 1) (begin (display "perfect ")
(display n_perfect)
(newline)
(display "abundant")
(display n_abundant)
(newline)
(display "deficinet")
(display n_perfect)
(newline)))
((equal? (classify n) 0) (begin (set! n_perfect (+ 1 n_perfect)) (display n) (newline) (count (- n 1))))
((equal? (classify n) 1) (begin (set! n_abundant (+ 1 n_abundant)) (count (- n 1))))
((equal? (classify n) -1) (begin (set! n_deficient (+ 1 n_deficient)) (count (- n 1))))))
</lang>
Swift
<lang swift>var deficients = 0 // sumPd < n var perfects = 0 // sumPd = n var abundants = 0 // sumPd > n
// 1 is deficient (no proper divisor) deficients++
for i in 2...20000 {
var sumPd = 1 // 1 is a proper divisor of all integer above 1 var maxPdToTest = i/2 // the max divisor to test
for var j = 2; j < maxPdToTest; j++ {
if (i%j) == 0 {
// j is a proper divisor
sumPd += j
// New maximum for divisibility check
maxPdToTest = i / j
// To add to sum of proper divisors unless already done
if maxPdToTest != j {
sumPd += maxPdToTest
}
}
}
// Select type according to sum of Proper divisors
if sumPd < i {
deficients++
} else if sumPd > i {
abundants++
} else {
perfects++
}
}
println("There are \(deficients) deficient, \(perfects) perfect and \(abundants) abundant integers from 1 to 20000.")</lang>
- Output:
There are 15043 deficient, 4 perfect and 4953 abundant integers from 1 to 20000.
Tcl
<lang Tcl>proc ProperDivisors {n} {
if {$n == 1} {return 0}
set divs 1
set sum 1
for {set i 2} {$i*$i <= $n} {incr i} {
if {! ($n % $i)} {
lappend divs $i
incr sum $i
if {$i*$i<$n} {
lappend divs [set d [expr {$n / $i}]]
incr sum $d
}
}
}
list $sum $divs
}
proc cmp {i j} { ;# analogous to [string compare], but for numbers
if {$i == $j} {return 0}
if {$i > $j} {return 1}
return -1
}
proc classify {k} {
lassign [ProperDivisors $k] p ;# we only care about the first part of the result
dict get {
1 abundant
0 perfect
-1 deficient
} [cmp $k $p]
}
puts "Classifying the integers in \[1, 20_000\]:" set classes {} ;# this will be a dict
for {set i 1} {$i <= 20000} {incr i} {
set class [classify $i] dict incr classes $class
}
- using [lsort] to order the dictionary by value:
foreach {kind count} [lsort -stride 2 -index 1 -integer $classes] {
puts "$kind: $count"
}</lang>
- Output:
Classifying the integers in [1, 20_000]: perfect: 4 deficient: 4953 abundant: 15043
VBScript
<lang VBScript>Deficient = 0 Perfect = 0 Abundant = 0 For i = 1 To 20000 sum = 0 For n = 1 To 20000 If n < i Then If i Mod n = 0 Then sum = sum + n End If End If Next If sum < i Then Deficient = Deficient + 1 ElseIf sum = i Then Perfect = Perfect + 1 ElseIf sum > i Then Abundant = Abundant + 1 End If Next WScript.Echo "Deficient = " & Deficient & vbCrLf &_ "Perfect = " & Perfect & vbCrLf &_ "Abundant = " & Abundant</lang>
- Output:
Deficient = 15043 Perfect = 4 Abundant = 4953
zkl
<lang zkl>fcn properDivs(n){ [1.. (n + 1)/2 + 1].filter('wrap(x){ n%x==0 and n!=x }) }
fcn classify(n){
p:=properDivs(n).sum(); return(if(p<n) -1 else if(p==n) 0 else 1);
}
const rangeMax=20_000; classified:=[1..rangeMax].apply(classify); perfect :=classified.filter('==(0)).len(); abundant :=classified.filter('==(1)).len(); println("Deficient=%d, perfect=%d, abundant=%d".fmt(
classified.len()-perfect-abundant, perfect, abundant));</lang>
- Output:
Deficient=15043, perfect=4, abundant=4953