Abundant, deficient and perfect number classifications

From Rosetta Code
Revision as of 09:01, 20 February 2015 by Peak (talk | contribs) (jq)
Task
Abundant, deficient and perfect number classifications
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.

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.

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

C

<lang c>

  1. include<stdio.h>
  2. define d 0
  3. define p 1
  4. 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.

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

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

Supporting implementation:

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

jq

Works with: jq version 1.4

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

Pascal

using the http://rosettacode.org/wiki/Amicable_pairs#Alternative. the program there is now extended by an array and a line to count. <lang pascal> type

 tdpa   = array[0..2] of LongWord; // 0 = deficient,1= perfect,2 = abundant

var

..
 DpaCnt       : tdpa;

.. in function Check

   // SumOfProperDivs
   s := DivSumField[i]-i;
   //in Pascal boolean true == 1/false == 0 
   inc(DpaCnt[Ord(s>=i)-Ord(s<=i)+1]);

</lang> output

Max= 20000
     15043 deficient
         4 perfect
      4953 abundant
  0.3292561324 ratio abundant/deficient

MAX = 499*1000*1000
 375440837 deficient
         5 perfect
 123559158 abundant
  0.3291042045 ratio abundant/deficient

Perl

Using a module

Library: ntheory

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

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


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>

<lang racket>#lang racket (require "proper-divisors.rkt") (define SCOPE 20000)

(define P

 (let ((P-v (vector)))
   (λ (n)
     (set! P-v (fold-divisors P-v n 0 +))
     (vector-ref P-v n))))

(define-values

 (a d p)
 (for/fold ((a 0) (d 0) (p 0))
           ((n (in-range SCOPE 0 -1))) ; doing this backwards initialises the memo
   (match (- (P n) n)
     [0             (values a d (add1 p))]    ; perfect
     [(? negative?) (values a (add1 d) p)]    ; deficient
     [(? positive?) (values (add1 a) d p)]))) ; abundant

(printf #<<EOS Between 1 and ~s:

 ~a abundant numbers
 ~a deficient numbers
 ~a perfect numbers

EOS

       SCOPE a d p)</lang>
Output:
Between 1 and 20000:
  4953 abundant numbers
  15043 deficient numbers
  4 perfect numbers

Racket

We use use fold-divisors from Proper_divisors#Racket.


<lang racket>#lang racket (require "proper-divisors.rkt") (define SCOPE 20000)

(define P

 (let ((P-v (vector)))
   (λ (n)
     (set! P-v (fold-divisors P-v n 0 +))
     (vector-ref P-v n))))

(define-values

 (a d p)
 (for/fold ((a 0) (d 0) (p 0))
           ((n (in-range SCOPE 0 -1))) ; doing this backwards initialises the memo
   (match (- (P n) n)
     [0             (values a d (add1 p))]    ; perfect
     [(? negative?) (values a (add1 d) p)]    ; deficient
     [(? positive?) (values (add1 a) d p)]))) ; abundant

(printf #<<EOS Between 1 and ~s:

 ~a abundant numbers
 ~a deficient numbers
 ~a perfect numbers

EOS

       SCOPE a d p)</lang>
Output:
Between 1 and 20000:
  4953 abundant numbers
  15043 deficient numbers
  4 perfect numbers

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)

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

Translation of: D

<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