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 are all positive divisors of n other than n itself.
ifP(n) < nthen n is classed as deficient (OEIS A005100). ifP(n) == nthen n is classed as perfect (OEIS A000396). ifP(n) > nthen n is classed as abundant (OEIS A005101).
- Example
6 has proper divisors of 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.
Show the results here.
- Related tasks
- Aliquot sequence classifications. (The whole series from which this task is a subset.)
- Proper divisors
- Amicable pairs
11l
F sum_proper_divisors(n)
R I n < 2 {0} E sum((1 .. n I/ 2).filter(it -> (@n % it) == 0))
V deficient = 0
V perfect = 0
V abundant = 0
L(n) 1..20000
V sp = sum_proper_divisors(n)
I sp < n
deficient++
E I sp == n
perfect++
E I sp > n
abundant++
print(‘Deficient = ’deficient)
print(‘Perfect = ’perfect)
print(‘Abundant = ’abundant)- Output:
Deficient = 15043 Perfect = 4 Abundant = 4953
360 Assembly
For maximum compatibility, this program uses only the basic instruction set (S/360) with 2 ASSIST macros (XDECO,XPRNT).
* Abundant, deficient and perfect number 08/05/2016
ABUNDEFI CSECT
USING ABUNDEFI,R13 set base register
SAVEAR B STM-SAVEAR(R15) skip savearea
DC 17F'0' savearea
STM STM R14,R12,12(R13) save registers
ST R13,4(R15) link backward SA
ST R15,8(R13) link forward SA
LR R13,R15 establish addressability
SR R10,R10 deficient=0
SR R11,R11 perfect =0
SR R12,R12 abundant =0
LA R6,1 i=1
LOOPI C R6,NN do i=1 to nn
BH ELOOPI
SR R8,R8 sum=0
LR R9,R6 i
SRA R9,1 i/2
LA R7,1 j=1
LOOPJ CR R7,R9 do j=1 to i/2
BH ELOOPJ
LR R2,R6 i
SRDA R2,32
DR R2,R7 i//j=0
LTR R2,R2 if i//j=0
BNZ NOTMOD
AR R8,R7 sum=sum+j
NOTMOD LA R7,1(R7) j=j+1
B LOOPJ
ELOOPJ CR R8,R6 if sum?i
BL SLI <
BE SEI =
BH SHI >
SLI LA R10,1(R10) deficient+=1
B EIF
SEI LA R11,1(R11) perfect +=1
B EIF
SHI LA R12,1(R12) abundant +=1
EIF LA R6,1(R6) i=i+1
B LOOPI
ELOOPI XDECO R10,XDEC edit deficient
MVC PG+10(5),XDEC+7
XDECO R11,XDEC edit perfect
MVC PG+24(5),XDEC+7
XDECO R12,XDEC edit abundant
MVC PG+39(5),XDEC+7
XPRNT PG,80 print buffer
L R13,4(0,R13) restore savearea pointer
LM R14,R12,12(R13) restore registers
XR R15,R15 return code = 0
BR R14 return to caller
NN DC F'20000'
PG DC CL80'deficient=xxxxx perfect=xxxxx abundant=xxxxx'
XDEC DS CL12
REGEQU
END ABUNDEFI- Output:
deficient=15043 perfect= 4 abundant= 4953
8086 Assembly
LIMIT: equ 20000
cpu 8086
org 100h
mov ax,data ; Set DS and ES to point right after the
mov cl,4 ; program, so we can store the array there
shr ax,cl
mov dx,cs
add ax,dx
inc ax
mov ds,ax
mov es,ax
mov ax,1 ; Set each element to 1 at the beginning
xor di,di
mov cx,LIMIT+1
rep stosw
mov [2],cx ; Except the value for 1, which is 0
mov bp,LIMIT/2 ; BP = limit / 2 - keep values ready in regs
mov di,LIMIT ; DI = limit
oloop: inc ax ; Let AX be the outer loop counter (divisor)
cmp ax,bp ; Are we there yet?
ja clsfy ; If so, stop
mov dx,ax ; Let DX be the inner loop counter (number)
iloop: add dx,ax
cmp dx,di ; Are we there yet?
ja oloop ; Loop
mov bx,dx ; Each entry is 2 bytes wide
shl bx,1
add [bx],ax ; Add divisor to number
jmp iloop
clsfy: xor bp,bp ; BP = deficient number counter
xor dx,dx ; DX = perfect number counter
xor cx,cx ; CX = abundant number counter
xor bx,bx ; BX = current number under consideration
mov si,2 ; SI = pointer to divsum of current number
cloop: inc bx ; Next number
cmp bx,di ; Are we done yet?
ja done ; If so, stop
lodsw ; Otherwise, get divsum of current number
cmp ax,bx ; Compare to current number
jb defic ; If smaller, the number is deficient
je prfct ; If equal, the number is perfect
inc cx ; Otherwise, the number is abundant
jmp cloop
defic: inc bp
jmp cloop
prfct: inc dx
jmp cloop
done: mov ax,cs ; Set DS and ES back to the code segment
mov ds,ax
mov es,ax
mov di,dx ; Move the perfect numbers to DI
mov dx,sdef ; Print "Deficient"
call prstr
mov ax,bp ; Print amount of deficient numbers
call prnum
mov dx,sper ; Print "Perfect"
call prstr
mov ax,di ; Print amount of perfect numbers
call prnum
mov dx,sabn ; Print "Abundant"
call prstr
mov ax,cx ; Print amount of abundant numbers
prnum: mov bx,snum ; Print number in AX
pdgt: xor dx,dx
div word [ten] ; Extract digit
dec bx ; Move pointer
add dl,'0'
mov [bx],dl ; Store digit
test ax,ax ; Any more digits?
jnz pdgt
mov dx,bx ; Print string
prstr: mov ah,9
int 21h
ret
ten: dw 10 ; Divisor for number output routine
sdef: db 'Deficient: $'
sper: db 'Perfect: $'
sabn: db 'Abundant: $'
db '.....'
snum: db 13,10,'$'
data: equ $
- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
AArch64 Assembly
/* ARM assembly AARCH64 Raspberry PI 3B or android 64 bits */
/* program numberClassif64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ NBDIVISORS, 1000
/*******************************************/
/* Initialized data */
/*******************************************/
.data
szMessStartPgm: .asciz "Program 64 bits start \n"
szMessEndPgm: .asciz "Program normal end.\n"
szMessErrorArea: .asciz "\033[31mError : area divisors too small.\n"
szMessError: .asciz "\033[31mError !!!\n"
szMessErrGen: .asciz "Error end program.\n"
szMessNbPrem: .asciz "This number is prime !!!.\n"
szMessOverflow: .asciz "Overflow function isPrime.\n"
szCarriageReturn: .asciz "\n"
/* datas message display */
szMessResult: .asciz "Number déficients : @ perfects : @ abundants : @ \n"
/*******************************************/
/* UnInitialized data */
/*******************************************/
.bss
.align 4
sZoneConv: .skip 24
tbZoneDecom: .skip 8 * NBDIVISORS // facteur 8 octets
/*******************************************/
/* code section */
/*******************************************/
.text
.global main
main: // program start
ldr x0,qAdrszMessStartPgm // display start message
bl affichageMess
mov x4,#1
mov x3,#0
mov x6,#0
mov x7,#0
mov x8,#0
ldr x9,iNBMAX
1:
mov x0,x4 // number
//=================================
ldr x1,qAdrtbZoneDecom
bl decompFact // create area of divisors
cmp x0,#0 // error ?
blt 2f
lsl x5,x4,#1 // number * 2
cmp x5,x1 // compare number and sum
cinc x7,x7,eq // perfect
cinc x6,x6,gt // deficient
cinc x8,x8,lt // abundant
2:
add x4,x4,#1
cmp x4,x9
ble 1b
//================================
mov x0,x6 // deficient
ldr x1,qAdrsZoneConv
bl conversion10 // convert ascii string
ldr x0,qAdrszMessResult
ldr x1,qAdrsZoneConv
bl strInsertAtCharInc // and put in message
mov x5,x0
mov x0,x7 // perfect
ldr x1,qAdrsZoneConv
bl conversion10 // convert ascii string
mov x0,x5
ldr x1,qAdrsZoneConv
bl strInsertAtCharInc // and put in message
mov x5,x0
mov x0,x8 // abundant
ldr x1,qAdrsZoneConv
bl conversion10 // convert ascii string
mov x0,x5
ldr x1,qAdrsZoneConv
bl strInsertAtCharInc // and put in message
bl affichageMess
ldr x0,qAdrszMessEndPgm // display end message
bl affichageMess
b 100f
99: // display error message
ldr x0,qAdrszMessError
bl affichageMess
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc 0 // perform system call
qAdrszMessStartPgm: .quad szMessStartPgm
qAdrszMessEndPgm: .quad szMessEndPgm
qAdrszMessError: .quad szMessError
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrtbZoneDecom: .quad tbZoneDecom
qAdrszMessResult: .quad szMessResult
qAdrsZoneConv: .quad sZoneConv
iNBMAX: .quad 20000
/******************************************************************/
/* decomposition en facteur */
/******************************************************************/
/* x0 contient le nombre à decomposer */
/* x1 contains factor area address */
decompFact:
stp x3,lr,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
stp x6,x7,[sp,-16]! // save registres
stp x8,x9,[sp,-16]! // save registres
stp x10,x11,[sp,-16]! // save registres
mov x5,x1
mov x1,x0
cmp x0,1
beq 100f
mov x8,x0 // save number
bl isPrime // prime ?
cmp x0,#1
beq 98f // yes is prime
mov x1,#1
str x1,[x5] // first factor
mov x12,#1 // divisors sum
mov x4,#1 // indice divisors table
mov x1,#2 // first divisor
mov x6,#0 // previous divisor
mov x7,#0 // number of same divisors
2:
mov x0,x8 // dividende
udiv x2,x0,x1 // x1 divisor x2 quotient x3 remainder
msub x3,x2,x1,x0
cmp x3,#0
bne 5f // if remainder <> zero -> no divisor
mov x8,x2 // else quotient -> new dividende
cmp x1,x6 // same divisor ?
beq 4f // yes
mov x7,x4 // number factors in table
mov x9,#0 // indice
21:
ldr x10,[x5,x9,lsl #3 ] // load one factor
mul x10,x1,x10 // multiply
str x10,[x5,x7,lsl #3] // and store in the table
add x12,x12,x10
add x7,x7,#1 // and increment counter
add x9,x9,#1
cmp x9,x4
blt 21b
mov x4,x7
mov x6,x1 // new divisor
b 7f
4: // same divisor
sub x9,x4,#1
mov x7,x4
41:
ldr x10,[x5,x9,lsl #3 ]
cmp x10,x1
sub x13,x9,1
csel x9,x13,x9,ne
bne 41b
sub x9,x4,x9
42:
ldr x10,[x5,x9,lsl #3 ]
mul x10,x1,x10
str x10,[x5,x7,lsl #3] // and store in the table
add x12,x12,x10
add x7,x7,#1 // and increment counter
add x9,x9,#1
cmp x9,x4
blt 42b
mov x4,x7
b 7f // and loop
/* not divisor -> increment next divisor */
5:
cmp x1,#2 // if divisor = 2 -> add 1
add x13,x1,#1 // add 1
add x14,x1,#2 // else add 2
csel x1,x13,x14,eq
b 2b
/* divisor -> test if new dividende is prime */
7:
mov x3,x1 // save divisor
cmp x8,#1 // dividende = 1 ? -> end
beq 10f
mov x0,x8 // new dividende is prime ?
mov x1,#0
bl isPrime // the new dividende is prime ?
cmp x0,#1
bne 10f // the new dividende is not prime
cmp x8,x6 // else dividende is same divisor ?
beq 9f // yes
mov x7,x4 // number factors in table
mov x9,#0 // indice
71:
ldr x10,[x5,x9,lsl #3 ] // load one factor
mul x10,x8,x10 // multiply
str x10,[x5,x7,lsl #3] // and store in the table
add x12,x12,x10
add x7,x7,#1 // and increment counter
add x9,x9,#1
cmp x9,x4
blt 71b
mov x4,x7
mov x7,#0
b 11f
9:
sub x9,x4,#1
mov x7,x4
91:
ldr x10,[x5,x9,lsl #3 ]
cmp x10,x8
sub x13,x9,#1
csel x9,x13,x9,ne
bne 91b
sub x9,x4,x9
92:
ldr x10,[x5,x9,lsl #3 ]
mul x10,x8,x10
str x10,[x5,x7,lsl #3] // and store in the table
add x12,x12,x10
add x7,x7,#1 // and increment counter
add x9,x9,#1
cmp x9,x4
blt 92b
mov x4,x7
b 11f
10:
mov x1,x3 // current divisor = new divisor
cmp x1,x8 // current divisor > new dividende ?
ble 2b // no -> loop
/* end decomposition */
11:
mov x0,x4 // return number of table items
mov x1,x12 // return sum
mov x3,#0
str x3,[x5,x4,lsl #3] // store zéro in last table item
b 100f
98:
//ldr x0,qAdrszMessNbPrem
//bl affichageMess
add x1,x8,1
mov x0,#0 // return code
b 100f
99:
ldr x0,qAdrszMessError
bl affichageMess
mov x0,#-1 // error code
b 100f
100:
ldp x10,x11,[sp],16 // restaur des 2 registres
ldp x8,x9,[sp],16 // restaur des 2 registres
ldp x6,x7,[sp],16 // restaur des 2 registres
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x3,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
qAdrszMessErrGen: .quad szMessErrGen
qAdrszMessNbPrem: .quad szMessNbPrem
/***************************************************/
/* Verification si un nombre est premier */
/***************************************************/
/* x0 contient le nombre à verifier */
/* x0 retourne 1 si premier 0 sinon */
isPrime:
stp x1,lr,[sp,-16]! // save registres
stp x2,x3,[sp,-16]! // save registres
mov x2,x0
sub x1,x0,#1
cmp x2,0
beq 99f // retourne zéro
cmp x2,2 // pour 1 et 2 retourne 1
ble 2f
mov x0,#2
bl moduloPux64
bcs 100f // erreur overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,3
beq 2f
mov x0,#3
bl moduloPux64
blt 100f // erreur overflow
cmp x0,#1
bne 99f
cmp x2,5
beq 2f
mov x0,#5
bl moduloPux64
bcs 100f // erreur overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,7
beq 2f
mov x0,#7
bl moduloPux64
bcs 100f // erreur overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,11
beq 2f
mov x0,#11
bl moduloPux64
bcs 100f // erreur overflow
cmp x0,#1
bne 99f // Pas premier
cmp x2,13
beq 2f
mov x0,#13
bl moduloPux64
bcs 100f // erreur overflow
cmp x0,#1
bne 99f // Pas premier
2:
cmn x0,0 // carry à zero pas d'erreur
mov x0,1 // premier
b 100f
99:
cmn x0,0 // carry à zero pas d'erreur
mov x0,#0 // Pas premier
100:
ldp x2,x3,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
/**************************************************************/
/********************************************************/
/* Calcul modulo de b puissance e modulo m */
/* Exemple 4 puissance 13 modulo 497 = 445 */
/********************************************************/
/* x0 nombre */
/* x1 exposant */
/* x2 modulo */
moduloPux64:
stp x1,lr,[sp,-16]! // save registres
stp x3,x4,[sp,-16]! // save registres
stp x5,x6,[sp,-16]! // save registres
stp x7,x8,[sp,-16]! // save registres
stp x9,x10,[sp,-16]! // save registres
cbz x0,100f
cbz x1,100f
mov x8,x0
mov x7,x1
mov x6,1 // resultat
udiv x4,x8,x2
msub x9,x4,x2,x8 // contient le reste
1:
tst x7,1
beq 2f
mul x4,x9,x6
umulh x5,x9,x6
//cbnz x5,99f
mov x6,x4
mov x0,x6
mov x1,x5
bl divisionReg128U
cbnz x1,99f // overflow
mov x6,x3
2:
mul x8,x9,x9
umulh x5,x9,x9
mov x0,x8
mov x1,x5
bl divisionReg128U
cbnz x1,99f // overflow
mov x9,x3
lsr x7,x7,1
cbnz x7,1b
mov x0,x6 // result
cmn x0,0 // carry à zero pas d'erreur
b 100f
99:
ldr x0,qAdrszMessOverflow
bl affichageMess
cmp x0,0 // carry à un car erreur
mov x0,-1 // code erreur
100:
ldp x9,x10,[sp],16 // restaur des 2 registres
ldp x7,x8,[sp],16 // restaur des 2 registres
ldp x5,x6,[sp],16 // restaur des 2 registres
ldp x3,x4,[sp],16 // restaur des 2 registres
ldp x1,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
qAdrszMessOverflow: .quad szMessOverflow
/***************************************************/
/* division d un nombre de 128 bits par un nombre de 64 bits */
/***************************************************/
/* x0 contient partie basse dividende */
/* x1 contient partie haute dividente */
/* x2 contient le diviseur */
/* x0 retourne partie basse quotient */
/* x1 retourne partie haute quotient */
/* x3 retourne le reste */
divisionReg128U:
stp x6,lr,[sp,-16]! // save registres
stp x4,x5,[sp,-16]! // save registres
mov x5,#0 // raz du reste R
mov x3,#128 // compteur de boucle
mov x4,#0 // dernier bit
1:
lsl x5,x5,#1 // on decale le reste de 1
tst x1,1<<63 // test du bit le plus à gauche
lsl x1,x1,#1 // on decale la partie haute du quotient de 1
beq 2f
orr x5,x5,#1 // et on le pousse dans le reste R
2:
tst x0,1<<63
lsl x0,x0,#1 // puis on decale la partie basse
beq 3f
orr x1,x1,#1 // et on pousse le bit de gauche dans la partie haute
3:
orr x0,x0,x4 // position du dernier bit du quotient
mov x4,#0 // raz du bit
cmp x5,x2
blt 4f
sub x5,x5,x2 // on enleve le diviseur du reste
mov x4,#1 // dernier bit à 1
4:
// et boucle
subs x3,x3,#1
bgt 1b
lsl x1,x1,#1 // on decale le quotient de 1
tst x0,1<<63
lsl x0,x0,#1 // puis on decale la partie basse
beq 5f
orr x1,x1,#1
5:
orr x0,x0,x4 // position du dernier bit du quotient
mov x3,x5
100:
ldp x4,x5,[sp],16 // restaur des 2 registres
ldp x6,lr,[sp],16 // restaur des 2 registres
ret // retour adresse lr x30
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"- Output:
Program 64 bits start Number déficients : 15043 perfects : 4 abundants : 4953 Program normal end.
ABC
PUT 0 IN deficient
PUT 0 IN perfect
PUT 0 IN abundant
HOW TO FIND PROPER DIVISOR SUMS UP TO limit:
SHARE p
PUT {} IN p
FOR i IN {0..limit}: PUT 0 IN p[i]
FOR i IN {1..floor (limit/2)}:
PUT i+i IN j
WHILE j <= limit:
PUT p[j]+i IN p[j]
PUT j+i IN j
HOW TO CLASSIFY n:
SHARE deficient, perfect, abundant, p
SELECT:
p[n] < n: PUT deficient+1 IN deficient
p[n] = n: PUT perfect+1 IN perfect
p[n] > n: PUT abundant+1 IN abundant
PUT 20000 IN limit
FIND PROPER DIVISOR SUMS UP TO limit
FOR n IN {1..limit}: CLASSIFY n
WRITE deficient, "deficient"/
WRITE perfect, "perfect"/
WRITE abundant, "abundant"/- Output:
15043 deficient 4 perfect 4953 abundant
Action!
Because of the memory limitation on the non-expanded Atari 8-bit computer the array containing Proper Divisor Sums is generated and used twice for the first and the second half of numbers separately.
PROC FillSumOfDivisors(CARD ARRAY pds CARD size,maxNum,offset)
CARD i,j
FOR i=0 TO size-1
DO
pds(i)=1
OD
FOR i=2 TO maxNum DO
FOR j=i+i TO maxNum STEP i
DO
IF j>=offset THEN
pds(j-offset)==+i
FI
OD
OD
RETURN
PROC Main()
DEFINE MAXNUM="20000"
DEFINE HALFNUM="10000"
CARD ARRAY pds(HALFNUM+1)
CARD def,perf,abud,i,sum,offset
BYTE CRSINH=$02F0 ;Controls visibility of cursor
CRSINH=1 ;hide cursor
Put(125) PutE() ;clear the screen
PrintE("Please wait...")
def=1 perf=0 abud=0
FillSumOfDivisors(pds,HALFNUM+1,HALFNUM,0)
FOR i=2 TO HALFNUM
DO
sum=pds(i)
IF sum<i THEN def==+1
ELSEIF sum=i THEN perf==+1
ELSE abud==+1 FI
OD
offset=HALFNUM
FillSumOfDivisors(pds,HALFNUM+1,MAXNUM,offset)
FOR i=HALFNUM+1 TO MAXNUM
DO
sum=pds(i-offset)
IF sum<i THEN def==+1
ELSEIF sum=i THEN perf==+1
ELSE abud==+1 FI
OD
PrintF(" Numbers: %I%E",MAXNUM)
PrintF("Deficient: %I%E",def)
PrintF(" Perfect: %I%E",perf)
PrintF(" Abudant: %I%E",abud)
RETURN- Output:
Screenshot from Atari 8-bit computer
Please wait... Numbers: 20000 Deficient: 15043 Perfect: 4 Abudant: 4953
Ada
This solution uses the package Generic_Divisors from the Proper Divisors task [[1]].
with Ada.Text_IO, Generic_Divisors;
procedure ADB_Classification is
function Same(P: Positive) return Positive is (P);
package Divisor_Sum is new Generic_Divisors
(Result_Type => Natural, None => 0, One => Same, Add => "+");
type Class_Type is (Deficient, Perfect, Abundant);
function Class(D_Sum, N: Natural) return Class_Type is
(if D_Sum < N then Deficient
elsif D_Sum = N then Perfect
else Abundant);
Cls: Class_Type;
Results: array (Class_Type) of Natural := (others => 0);
package NIO is new Ada.Text_IO.Integer_IO(Natural);
package CIO is new Ada.Text_IO.Enumeration_IO(Class_Type);
begin
for N in 1 .. 20_000 loop
Cls := Class(Divisor_Sum.Process(N), N);
Results(Cls) := Results(Cls)+1;
end loop;
for Class in Results'Range loop
CIO.Put(Class, 12);
NIO.Put(Results(Class), 8);
Ada.Text_IO.New_Line;
end loop;
Ada.Text_IO.Put_Line("--------------------");
Ada.Text_IO.Put("Sum ");
NIO.Put(Results(Deficient)+Results(Perfect)+Results(Abundant), 8);
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line("====================");
end ADB_Classification;
- Output:
DEFICIENT 15043 PERFECT 4 ABUNDANT 4953 -------------------- Sum 20000 ====================
ALGOL 68
BEGIN # classify the numbers 1 : 20 000 as abudant, deficient or perfect #
INT abundant count := 0;
INT deficient count := 0;
INT perfect count := 0;
INT max number = 20 000;
# construct a table of the proper divisor sums #
[ 1 : max number ]INT pds;
pds[ 1 ] := 0;
FOR i FROM 2 TO UPB pds DO pds[ i ] := 1 OD;
FOR i FROM 2 TO UPB pds DO
FOR j FROM i + i BY i TO UPB pds DO pds[ j ] +:= i OD
OD;
# classify the numbers #
FOR n TO max number DO
INT pd sum = pds[ n ];
IF pd sum < n THEN
deficient count +:= 1
ELIF pd sum = n THEN
perfect count +:= 1
ELSE # pd sum > n #
abundant count +:= 1
FI
OD;
print( ( "abundant ", whole( abundant count, 0 ), newline ) );
print( ( "deficient ", whole( deficient count, 0 ), newline ) );
print( ( "perfect ", whole( perfect count, 0 ), newline ) )
END- Output:
abundant 4953 deficient 15043 perfect 4
ALGOL W
begin % count abundant, perfect and deficient numbers up to 20 000 %
integer MAX_NUMBER;
MAX_NUMBER := 20000;
begin
integer array pds ( 1 :: MAX_NUMBER );
integer aCount, dCount, pCount, dSum;
% construct a table of proper divisor sums %
pds( 1 ) := 0;
for i := 2 until MAX_NUMBER do pds( i ) := 1;
for i := 2 until MAX_NUMBER do begin
for j := i + i step i until MAX_NUMBER do pds( j ) := pds( j ) + i
end for_i ;
aCount := dCount := pCOunt := 0;
for i := 1 until 20000 do begin
dSum := pds( i );
if dSum > i then aCount := aCount + 1
else if dSum < i then dCount := dCOunt + 1
else % dSum = i % pCount := pCount + 1
end for_i ;
write( "Abundant numbers up to 20 000: ", aCount );
write( "Perfect numbers up to 20 000: ", pCount );
write( "Deficient numbers up to 20 000: ", dCount )
end
end.- Output:
Abundant numbers up to 20 000: 4953 Perfect numbers up to 20 000: 4 Deficient numbers up to 20 000: 15043
AppleScript
on aliquotSum(n)
if (n < 2) then return 0
set sum to 1
set sqrt to n ^ 0.5
set limit to sqrt div 1
if (limit = sqrt) then
set sum to sum + limit
set limit to limit - 1
end if
repeat with i from 2 to limit
if (n mod i is 0) then set sum to sum + i + n div i
end repeat
return sum
end aliquotSum
on task()
set {deficient, perfect, abundant} to {0, 0, 0}
repeat with n from 1 to 20000
set s to aliquotSum(n)
if (s < n) then
set deficient to deficient + 1
else if (s > n) then
set abundant to abundant + 1
else
set perfect to perfect + 1
end if
end repeat
return {deficient:deficient, perfect:perfect, abundant:abundant}
end task
task()
- Output:
{deficient:15043, perfect:4, abundant:4953}
ARM Assembly
/* ARM assembly Raspberry PI */
/* program numberClassif.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
.equ NBDIVISORS, 1000
/*******************************************/
/* Initialized data */
/*******************************************/
.data
szMessStartPgm: .asciz "Program start \n"
szMessEndPgm: .asciz "Program normal end.\n"
szMessErrorArea: .asciz "\033[31mError : area divisors too small.\n"
szMessError: .asciz "\033[31mError !!!\n"
szMessErrGen: .asciz "Error end program.\n"
szMessNbPrem: .asciz "This number is prime !!!.\n"
szMessResultFact: .asciz "@ "
szCarriageReturn: .asciz "\n"
/* datas message display */
szMessResult: .asciz "Number déficients : @ perfects : @ abundants : @ \n"
/*******************************************/
/* UnInitialized data */
/*******************************************/
.bss
.align 4
sZoneConv: .skip 24
tbZoneDecom: .skip 4 * NBDIVISORS // facteur 4 octets
/*******************************************/
/* code section */
/*******************************************/
.text
.global main
main: @ program start
ldr r0,iAdrszMessStartPgm @ display start message
bl affichageMess
mov r4,#1
mov r3,#0
mov r6,#0
mov r7,#0
mov r8,#0
ldr r9,iNBMAX
1:
mov r0,r4 @ number
//=================================
ldr r1,iAdrtbZoneDecom
bl decompFact @ create area of divisors
cmp r0,#0 @ error ?
blt 2f
lsl r5,r4,#1 @ number * 2
cmp r5,r1 @ compare number and sum
addeq r7,r7,#1 @ perfect
addgt r6,r6,#1 @ deficient
addlt r8,r8,#1 @ abundant
2:
add r4,r4,#1
cmp r4,r9
ble 1b
//================================
mov r0,r6 @ deficient
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
ldr r0,iAdrszMessResult
ldr r1,iAdrsZoneConv
bl strInsertAtCharInc @ and put in message
mov r5,r0
mov r0,r7 @ perfect
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r5
ldr r1,iAdrsZoneConv
bl strInsertAtCharInc @ and put in message
mov r5,r0
mov r0,r8 @ abundant
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r5
ldr r1,iAdrsZoneConv
bl strInsertAtCharInc @ and put in message
bl affichageMess
ldr r0,iAdrszMessEndPgm @ display end message
bl affichageMess
b 100f
99: @ display error message
ldr r0,iAdrszMessError
bl affichageMess
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc 0 @ perform system call
iAdrszMessStartPgm: .int szMessStartPgm
iAdrszMessEndPgm: .int szMessEndPgm
iAdrszMessError: .int szMessError
iAdrszCarriageReturn: .int szCarriageReturn
iAdrtbZoneDecom: .int tbZoneDecom
iAdrszMessResult: .int szMessResult
iAdrsZoneConv: .int sZoneConv
iNBMAX: .int 20000
/******************************************************************/
/* factor decomposition */
/******************************************************************/
/* r0 contains number */
/* r1 contains address of divisors area */
/* r0 return divisors items in table */
/* r1 return the sum of divisors */
decompFact:
push {r3-r12,lr} @ save registers
cmp r0,#1
moveq r1,#1
beq 100f
mov r5,r1
mov r8,r0 @ save number
bl isPrime @ prime ?
cmp r0,#1
beq 98f @ yes is prime
mov r1,#1
str r1,[r5] @ first factor
mov r12,#1 @ divisors sum
mov r10,#1 @ indice divisors table
mov r9,#2 @ first divisor
mov r6,#0 @ previous divisor
mov r7,#0 @ number of same divisors
/* division loop */
2:
mov r0,r8 @ dividende
mov r1,r9 @ divisor
bl division @ r2 quotient r3 remainder
cmp r3,#0
beq 3f @ if remainder zero -> divisor
/* not divisor -> increment next divisor */
cmp r9,#2 @ if divisor = 2 -> add 1
addeq r9,#1
addne r9,#2 @ else add 2
b 2b
/* divisor compute the new factors of number */
3:
mov r8,r2 @ else quotient -> new dividende
cmp r9,r6 @ same divisor ?
beq 4f @ yes
mov r0,r5 @ table address
mov r1,r10 @ number factors in table
mov r2,r9 @ divisor
mov r3,r12 @ somme
mov r4,#0
bl computeFactors
mov r10,r1
mov r12,r0
mov r6,r9 @ new divisor
b 7f
4: @ same divisor
sub r7,r10,#1
5: @ search in table the first use of divisor
ldr r3,[r5,r7,lsl #2 ]
cmp r3,r9
subne r7,#1
bne 5b
@ and compute new factors after factors
sub r4,r10,r7 @ start indice
mov r0,r5
mov r1,r10
mov r2,r9 @ divisor
mov r3,r12
bl computeFactors
mov r12,r0
mov r10,r1
/* divisor -> test if new dividende is prime */
7:
cmp r8,#1 @ dividende = 1 ? -> end
beq 10f
mov r0,r8 @ new dividende is prime ?
mov r1,#0
bl isPrime @ the new dividende is prime ?
cmp r0,#1
bne 10f @ the new dividende is not prime
cmp r8,r6 @ else dividende is same divisor ?
beq 8f @ yes
mov r0,r5
mov r1,r10
mov r2,r8
mov r3,r12
mov r4,#0
bl computeFactors
mov r12,r0
mov r10,r1
mov r7,#0
b 11f
8:
sub r7,r10,#1
9:
ldr r3,[r5,r7,lsl #2 ]
cmp r3,r8
subne r7,#1
bne 9b
mov r0,r5
mov r1,r10
sub r4,r10,r7
mov r2,r8
mov r3,r12
bl computeFactors
mov r12,r0
mov r10,r1
b 11f
10:
cmp r9,r8 @ current divisor > new dividende ?
ble 2b @ no -> loop
/* end decomposition */
11:
mov r0,r10 @ return number of table items
mov r1,r12 @ return sum
mov r3,#0
str r3,[r5,r10,lsl #2] @ store zéro in last table item
b 100f
98: @ prime number
//ldr r0,iAdrszMessNbPrem
//bl affichageMess
add r1,r8,#1
mov r0,#0 @ return code
b 100f
99:
ldr r0,iAdrszMessError
bl affichageMess
mov r0,#-1 @ error code
b 100f
100:
pop {r3-r12,lr} @ restaur registers
bx lr
iAdrszMessNbPrem: .int szMessNbPrem
/* r0 table factors address */
/* r1 number factors in table */
/* r2 new divisor */
/* r3 sum */
/* r4 start indice */
/* r0 return sum */
/* r1 return number factors in table */
computeFactors:
push {r2-r6,lr} @ save registers
mov r6,r1 @ number factors in table
1:
ldr r5,[r0,r4,lsl #2 ] @ load one factor
mul r5,r2,r5 @ multiply
str r5,[r0,r1,lsl #2] @ and store in the table
add r3,r5
add r1,r1,#1 @ and increment counter
add r4,r4,#1
cmp r4,r6
blt 1b
mov r0,r3
100: @ fin standard de la fonction
pop {r2-r6,lr} @ restaur des registres
bx lr @ retour de la fonction en utilisant lr
/***************************************************/
/* check if a number is prime */
/***************************************************/
/* r0 contains the number */
/* r0 return 1 if prime 0 else */
@2147483647
@4294967297
@131071
isPrime:
push {r1-r6,lr} @ save registers
cmp r0,#0
beq 90f
cmp r0,#17
bhi 1f
cmp r0,#3
bls 80f @ for 1,2,3 return prime
cmp r0,#5
beq 80f @ for 5 return prime
cmp r0,#7
beq 80f @ for 7 return prime
cmp r0,#11
beq 80f @ for 11 return prime
cmp r0,#13
beq 80f @ for 13 return prime
cmp r0,#17
beq 80f @ for 17 return prime
1:
tst r0,#1 @ even ?
beq 90f @ yes -> not prime
mov r2,r0 @ save number
sub r1,r0,#1 @ exposant n - 1
mov r0,#3 @ base
bl moduloPuR32 @ compute base power n - 1 modulo n
cmp r0,#1
bne 90f @ if <> 1 -> not prime
mov r0,#5
bl moduloPuR32
cmp r0,#1
bne 90f
mov r0,#7
bl moduloPuR32
cmp r0,#1
bne 90f
mov r0,#11
bl moduloPuR32
cmp r0,#1
bne 90f
mov r0,#13
bl moduloPuR32
cmp r0,#1
bne 90f
mov r0,#17
bl moduloPuR32
cmp r0,#1
bne 90f
80:
mov r0,#1 @ is prime
b 100f
90:
mov r0,#0 @ no prime
100: @ fin standard de la fonction
pop {r1-r6,lr} @ restaur des registres
bx lr @ retour de la fonction en utilisant lr
/********************************************************/
/* Calcul modulo de b puissance e modulo m */
/* Exemple 4 puissance 13 modulo 497 = 445 */
/* */
/********************************************************/
/* r0 nombre */
/* r1 exposant */
/* r2 modulo */
/* r0 return result */
moduloPuR32:
push {r1-r7,lr} @ save registers
cmp r0,#0 @ verif <> zero
beq 100f
cmp r2,#0 @ verif <> zero
beq 100f @ TODO: v鲩fier les cas d erreur
1:
mov r4,r2 @ save modulo
mov r5,r1 @ save exposant
mov r6,r0 @ save base
mov r3,#1 @ start result
mov r1,#0 @ division de r0,r1 par r2
bl division32R
mov r6,r2 @ base <- remainder
2:
tst r5,#1 @ exposant even or odd
beq 3f
umull r0,r1,r6,r3
mov r2,r4
bl division32R
mov r3,r2 @ result <- remainder
3:
umull r0,r1,r6,r6
mov r2,r4
bl division32R
mov r6,r2 @ base <- remainder
lsr r5,#1 @ left shift 1 bit
cmp r5,#0 @ end ?
bne 2b
mov r0,r3
100: @ fin standard de la fonction
pop {r1-r7,lr} @ restaur des registres
bx lr @ retour de la fonction en utilisant lr
/***************************************************/
/* division number 64 bits in 2 registers by number 32 bits */
/***************************************************/
/* r0 contains lower part dividende */
/* r1 contains upper part dividende */
/* r2 contains divisor */
/* r0 return lower part quotient */
/* r1 return upper part quotient */
/* r2 return remainder */
division32R:
push {r3-r9,lr} @ save registers
mov r6,#0 @ init upper upper part remainder !!
mov r7,r1 @ init upper part remainder with upper part dividende
mov r8,r0 @ init lower part remainder with lower part dividende
mov r9,#0 @ upper part quotient
mov r4,#0 @ lower part quotient
mov r5,#32 @ bits number
1: @ begin loop
lsl r6,#1 @ shift upper upper part remainder
lsls r7,#1 @ shift upper part remainder
orrcs r6,#1
lsls r8,#1 @ shift lower part remainder
orrcs r7,#1
lsls r4,#1 @ shift lower part quotient
lsl r9,#1 @ shift upper part quotient
orrcs r9,#1
@ divisor sustract upper part remainder
subs r7,r2
sbcs r6,#0 @ and substract carry
bmi 2f @ n駡tive ?
@ positive or equal
orr r4,#1 @ 1 -> right bit quotient
b 3f
2: @ negative
orr r4,#0 @ 0 -> right bit quotient
adds r7,r2 @ and restaur remainder
adc r6,#0
3:
subs r5,#1 @ decrement bit size
bgt 1b @ end ?
mov r0,r4 @ lower part quotient
mov r1,r9 @ upper part quotient
mov r2,r7 @ remainder
100: @ function end
pop {r3-r9,lr} @ restaur registers
bx lr
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"- Output:
Program start Number déficients : 15043 perfects : 4 abundants : 4953 Program normal end.
Arturo
properDivisors: function [n]->
(factors n) -- n
abundant: new 0 deficient: new 0 perfect: new 0
loop 1..20000 'x [
s: sum properDivisors x
case [s]
when? [<x] -> inc 'deficient
when? [>x] -> inc 'abundant
else -> inc 'perfect
]
print ["Found" abundant "abundant,"
deficient "deficient and"
perfect "perfect numbers."]
- Output:
Found 4953 abundant, 15043 deficient and 4 perfect numbers.
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
- 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
#!/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
}
- Output:
For 1 through 20000 Perfect: 4 Abundant: 4953 Deficient: 15043
Batch File
As batch files aren't particularly well-suited to increasingly large arrays of data, this code will chew through processing power.
@echo off
setlocal enabledelayedexpansion
:_main
for /l %%i in (1,1,20000) do (
echo Processing %%i
call:_P %%i
set Pn=!errorlevel!
if !Pn! lss %%i set /a deficient+=1
if !Pn!==%%i set /a perfect+=1
if !Pn! gtr %%i set /a abundant+=1
cls
)
echo Deficient - %deficient% ^| Perfect - %perfect% ^| Abundant - %abundant%
pause>nul
:_P
setlocal enabledelayedexpansion
set sumdivisers=0
set /a upperlimit=%1-1
for /l %%i in (1,1,%upperlimit%) do (
set /a isdiviser=%1 %% %%i
if !isdiviser!==0 set /a sumdivisers+=%%i
)
exit /b %sumdivisers%
BASIC
10 DEFINT A-Z: LM=20000
20 DIM P(LM)
30 FOR I=1 TO LM: P(I)=-32767: NEXT
40 FOR I=1 TO LM/2: FOR J=I+I TO LM STEP I: P(J)=P(J)+I: NEXT: NEXT
50 FOR I=1 TO LM
60 X=I-32767
70 IF P(I)<X THEN D=D+1 ELSE IF P(I)=X THEN P=P+1 ELSE A=A+1
80 NEXT
90 PRINT "DEFICIENT:";D
100 PRINT "PERFECT:";P
110 PRINT "ABUNDANT:";A
- Output:
DEFICIENT: 15043 PERFECT: 4 ABUNDANT: 4953
BASIC256
deficient = 0
perfect = 0
abundant = 0
for n = 1 to 20000
sum = SumProperDivisors(n)
begin case
case sum < n
deficient += 1
case sum = n
perfect += 1
else
abundant += 1
end case
next
print "The classification of the numbers from 1 to 20,000 is as follows :"
print
print "Deficient = "; deficient
print "Perfect = "; perfect
print "Abundant = "; abundant
end
function SumProperDivisors(number)
if number < 2 then return 0
sum = 0
for i = 1 to number \ 2
if number mod i = 0 then sum += i
next i
return sum
end function
- Output:
Same as FreeBASIC entry.
Chipmunk Basic
100 cls
110 defic = 0
120 perfe = 0
130 abund = 0
140 for n = 1 to 20000
150 sump = SumProperDivisors(n)
160 if sump < n then
170 defic = defic+1
180 else
190 if sump = n then
200 perfe = perfe+1
210 else
220 if sump > n then abund = abund+1
230 endif
240 endif
250 next
260 print "The classification of the numbers from 1 to 20,000 is as follows :"
270 print
280 print "Deficient = ";defic
290 print "Perfect = ";perfe
300 print "Abundant = ";abund
310 end
320 function SumProperDivisors(number)
330 if number < 2 then SumProperDivisors = 0
340 sum = 0
350 for i = 1 to number/2
360 if number mod i = 0 then sum = sum+i
370 next i
380 SumProperDivisors = sum
390 end function
- Output:
Same as FreeBASIC entry.
Gambas
Public Sub Main()
Dim sum As Integer, deficient As Integer, perfect As Integer, abundant As Integer
For n As Integer = 1 To 20000
sum = SumProperDivisors(n)
If sum < n Then
deficient += 1
Else If sum = n Then
perfect += 1
Else
abundant += 1
Endif
Next
Print "The classification of the numbers from 1 to 20,000 is as follows : \n"
Print "Deficient = "; deficient
Print "Perfect = "; perfect
Print "Abundant = "; abundant
End
Function SumProperDivisors(number As Integer) As Integer
If number < 2 Then Return 0
Dim sum As Integer = 0
For i As Integer = 1 To number \ 2
If number Mod i = 0 Then sum += i
Next
Return sum
End Function
- Output:
Same as FreeBASIC entry.
GW-BASIC
The BASIC solution works without any changes.
QBasic
The BASIC solution works without any changes.
Run BASIC
function sumProperDivisors(num)
if num > 1 then
sum = 1
root = sqr(num)
for i = 2 to root
if num mod i = 0 then
sum = sum + i
if (i*i) <> num then sum = sum + num / i
end if
next i
end if
sumProperDivisors = sum
end function
deficient = 0
perfect = 0
abundant = 0
print "The classification of the numbers from 1 to 20,000 is as follows :"
for n = 1 to 20000
sump = sumProperDivisors(n)
if sump < n then
deficient = deficient +1
else
if sump = n then
perfect = perfect +1
else
if sump > n then abundant = abundant +1
end if
end if
next n
print "Deficient = "; deficient
print "Perfect = "; perfect
print "Abundant = "; abundant
True BASIC
LET lm = 20000
DIM s(0)
MAT REDIM s(lm)
FOR i = 1 TO lm
LET s(i) = -32767
NEXT i
FOR i = 1 TO lm/2
FOR j = i+i TO lm STEP i
LET s(j) = s(j) +i
NEXT j
NEXT i
FOR i = 1 TO lm
LET x = i - 32767
IF s(i) < x THEN
LET d = d +1
ELSE
IF s(i) = x THEN
LET p = p +1
ELSE
LET a = a +1
END IF
END IF
NEXT i
PRINT "The classification of the numbers from 1 to 20,000 is as follows :"
PRINT
PRINT "Deficient ="; d
PRINT "Perfect ="; p
PRINT "Abundant ="; a
END
- Output:
Similar to FreeBASIC entry.
BCPL
get "libhdr"
manifest $( maximum = 20000 $)
let calcpdivs(p, max) be
$( for i=0 to max do p!i := 0
for i=1 to max/2
$( let j = i+i
while 0 < j <= max
$( p!j := p!j + i
j := j + i
$)
$)
$)
let classify(p, n, def, per, ab) be
$( let z = 0<=p!n<n -> def, p!n=n -> per, ab
!z := !z + 1
$)
let start() be
$( let p = getvec(maximum)
let def, per, ab = 0, 0, 0
calcpdivs(p, maximum)
for i=1 to maximum do classify(p, i, @def, @per, @ab)
writef("Deficient numbers: %N*N", def)
writef("Perfect numbers: %N*N", per)
writef("Abundant numbers: %N*N", ab)
freevec(p)
$)- Output:
Deficient numbers: 15043 Perfect numbers: 4 Abundant numbers: 4953
Befunge
This is not a particularly efficient implementation, so unless you're using a compiler, you can expect it to take a good few minutes to complete. But you can always test with a shorter range of numbers by replacing the 20000 ("2":*8*) near the start of the first line.
p0"2":*8*>::2/\:2/\28*:*:**+>::28*:*:*/\28*:*:*%%#v_\:28*:*:*%v>00p:0`\0\`-1v
++\1-:1`#^_$:28*:*:*/\28*vv_^#<<<!%*:*:*82:-1\-1\<<<\+**:*:*82<+>*:*:**\2-!#+
v"There are "0\g00+1%*:*:<>28*:*:*/\28*:*:*/:0\`28*:*:**+-:!00g^^82!:g01\p01<
>:#,_\." ,tneicifed">:#,_\." dna ,tcefrep">:#,_\.55+".srebmun tnadnuba">:#,_@
- Output:
There are 15043 deficient, 4 perfect, and 4953 abundant numbers.
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.
( 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)
);Output:
deficient 15043 perfect 4 abundant 4953 4,27*10E0 sec deficient 15043 perfect 4 abundant 4953 1,63*10E1 sec
C
#include<stdio.h>
#define de 0
#define pe 1
#define ab 2
int main(){
int sum = 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 = 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 += j;
if (j != try_max)
sum += try_max;
}
//Categorize summation
if (sum < i){
count_list[de]++;
continue;
}
if (sum > i){
count_list[ab]++;
continue;
}
count_list[pe]++;
}
printf("\nThere are %d deficient," ,count_list[de]);
printf(" %d perfect," ,count_list[pe]);
printf(" %d abundant numbers between 1 and 20000.\n" ,count_list[ab]);
return 0;
}
- Output:
There are 15043 deficient, 4 perfect, 4953 abundant numbers between 1 and 20000.
C#
Three algorithms presented, the first is fast, but can be a memory hog when tabulating to larger limits. The second is slower, but doesn't have any memory issue. The third is quite a bit slower, but the code may be easier to follow.
First method:
- Initializes a large queue, uses a double nested loop to populate it, and a third loop to interrogate the queue.
Second method:
- Uses a double nested loop with the inner loop only reaching to sqrt(i), as it adds both divisors at once, later correcting the sum when the divisor is a perfect square.
Third method:
- Uses a loop with a inner Enumerable.Range reaching to i / 2, only adding one divisor at a time.
using System;
using System.Linq;
public class Program
{
public static void Main()
{
int abundant, deficient, perfect;
var sw = System.Diagnostics.Stopwatch.StartNew();
ClassifyNumbers.UsingSieve(20000, out abundant, out deficient, out perfect); sw.Stop();
Console.WriteLine($"Abundant: {abundant}, Deficient: {deficient}, Perfect: {perfect} {sw.Elapsed.TotalMilliseconds} ms");
sw.Restart();
ClassifyNumbers.UsingOptiDivision(20000, out abundant, out deficient, out perfect);
Console.WriteLine($"Abundant: {abundant}, Deficient: {deficient}, Perfect: {perfect} {sw.Elapsed.TotalMilliseconds} ms");
sw.Restart();
ClassifyNumbers.UsingDivision(20000, out abundant, out deficient, out perfect);
Console.WriteLine($"Abundant: {abundant}, Deficient: {deficient}, Perfect: {perfect} {sw.Elapsed.TotalMilliseconds} ms");
}
}
public static class ClassifyNumbers
{
//Fastest way, but uses memory
public static void UsingSieve(int bound, out int abundant, out int deficient, out int perfect) {
abundant = perfect = 0;
//For very large bounds, this array can get big.
int[] sum = new int[bound + 1];
for (int divisor = 1; divisor <= bound >> 1; divisor++)
for (int i = divisor << 1; i <= bound; i += divisor)
sum[i] += divisor;
for (int i = 1; i <= bound; i++) {
if (sum[i] > i) abundant++;
else if (sum[i] == i) perfect++;
}
deficient = bound - abundant - perfect;
}
//Slower, optimized, but doesn't use storage
public static void UsingOptiDivision(int bound, out int abundant, out int deficient, out int perfect) {
abundant = perfect = 0; int sum = 0;
for (int i = 2, d, r = 1; i <= bound; i++) {
if ((d = r * r - i) < 0) r++;
for (int x = 2; x < r; x++) if (i % x == 0) sum += x + i / x;
if (d == 0) sum += r;
switch (sum.CompareTo(i)) { case 0: perfect++; break; case 1: abundant++; break; }
sum = 1;
}
deficient = bound - abundant - perfect;
}
//Much slower, doesn't use storage and is un-optimized
public static void UsingDivision(int bound, out int abundant, out int deficient, out int perfect) {
abundant = perfect = 0;
for (int i = 2; i <= bound; i++) {
int sum = Enumerable.Range(1, (i + 1) / 2)
.Where(div => i % div == 0).Sum();
switch (sum.CompareTo(i)) {
case 0: perfect++; break;
case 1: abundant++; break;
}
}
deficient = bound - abundant - perfect;
}
}
- Output @ Tio.run:
We see the second method is about 10 times slower than the first method, and the third method more than 120 times slower than the second method.
Abundant: 4953, Deficient: 15043, Perfect: 4 0.7277 ms Abundant: 4953, Deficient: 15043, Perfect: 4 7.3458 ms Abundant: 4953, Deficient: 15043, Perfect: 4 1048.9541 ms
C++
#include <iostream>
#include <algorithm>
#include <vector>
std::vector<int> findProperDivisors ( int n ) {
std::vector<int> divisors ;
for ( int i = 1 ; i < n / 2 + 1 ; i++ ) {
if ( n % i == 0 )
divisors.push_back( i ) ;
}
return divisors ;
}
int main( ) {
std::vector<int> deficients , perfects , abundants , divisors ;
for ( int n = 1 ; n < 20001 ; n++ ) {
divisors = findProperDivisors( n ) ;
int sum = std::accumulate( divisors.begin( ) , divisors.end( ) , 0 ) ;
if ( sum < n ) {
deficients.push_back( n ) ;
}
if ( sum == n ) {
perfects.push_back( n ) ;
}
if ( sum > n ) {
abundants.push_back( n ) ;
}
}
std::cout << "Deficient : " << deficients.size( ) << std::endl ;
std::cout << "Perfect : " << perfects.size( ) << std::endl ;
std::cout << "Abundant : " << abundants.size( ) << std::endl ;
return 0 ;
}
- Output:
Deficient : 15043 Perfect : 4 Abundant : 4953
Ceylon
shared void run() {
function divisors(Integer int) =>
if(int <= 1) then {} else (1..int / 2).filter((Integer element) => element.divides(int));
function classify(Integer int) => sum {0, *divisors(int)} <=> int;
value counts = (1..20k).map(classify).frequencies();
print("deficient: ``counts[smaller] else "none"``");
print("perfect: ``counts[equal] else "none"``");
print("abundant: ``counts[larger] else "none"``");
}
- Output:
deficient: 15043 perfect: 4 abundant: 4953
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))}))
Example:
(count-classes 20000)
;=> {:perfect 4,
; :abundant 4953,
; :deficient 15043}
CLU
% Generate proper divisors from 1 to max
proper_divisors = proc (max: int) returns (array[int])
divs: array[int] := array[int]$fill(1, max, 0)
for i: int in int$from_to(1, max/2) do
for j: int in int$from_to_by(i*2, max, i) do
divs[j] := divs[j] + i
end
end
return(divs)
end proper_divisors
% Classify all the numbers for which we have divisors
classify = proc (divs: array[int]) returns (int, int, int)
def, per, ab: int
def, per, ab := 0, 0, 0
for i: int in array[int]$indexes(divs) do
if divs[i]<i then def := def + 1
elseif divs[i]=i then per := per + 1
elseif divs[i]>i then ab := ab + 1
end
end
return(def, per, ab)
end classify
% Find amount of deficient, perfect, and abundant numbers up to 20000
start_up = proc ()
max = 20000
po: stream := stream$primary_output()
def, per, ab: int := classify(proper_divisors(max))
stream$putl(po, "Deficient: " || int$unparse(def))
stream$putl(po, "Perfect: " || int$unparse(per))
stream$putl(po, "Abundant: " || int$unparse(ab))
end start_up- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
Common 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))))
Output:
CL-USER> (classification) 15043 4 4953
Cowgol
include "cowgol.coh";
const MAXIMUM := 20000;
var p: uint16[MAXIMUM+1];
var i: uint16;
var j: uint16;
MemZero(&p as [uint8], @bytesof p);
i := 1;
while i <= MAXIMUM/2 loop
j := i+i;
while j <= MAXIMUM loop
p[j] := p[j]+i;
j := j+i;
end loop;
i := i+1;
end loop;
var def: uint16 := 0;
var per: uint16 := 0;
var ab: uint16 := 0;
i := 1;
while i <= MAXIMUM loop
if p[i]<i then
def := def + 1;
elseif p[i]==i then
per := per + 1;
else
ab := ab + 1;
end if;
i := i + 1;
end loop;
print_i16(def); print(" deficient numbers.\n");
print_i16(per); print(" perfect numbers.\n");
print_i16(ab); print(" abundant numbers.\n");- Output:
15043 deficient numbers. 4 perfect numbers. 4953 abundant numbers.
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;
}
- Output:
[Tuple!(Class, uint)(deficient, 15043), Tuple!(Class, uint)(perfect, 4), Tuple!(Class, uint)(abundant, 4953)]
Delphi
See #Pascal.
Draco
/* Fill a given array such that for each N,
* P[n] is the sum of proper divisors of N */
proc nonrec propdivs([*] word p) void:
word i, j, max;
max := dim(p,1)-1;
for i from 0 upto max do p[i] := 0 od;
for i from 1 upto max/2 do
for j from i*2 by i upto max do
p[j] := p[j] + i
od
od
corp
proc nonrec main() void:
word MAX = 20000;
word def, per, ab, i;
/* Find all required proper divisor sums */
[MAX+1] word p;
propdivs(p);
def := 0;
per := 0;
ab := 0;
/* Check each number */
for i from 1 upto MAX do
if p[i]<i then def := def + 1
elif p[i]=i then per := per + 1
elif p[i]>i then ab := ab + 1
fi
od;
writeln("Deficient: ", def:5);
writeln("Perfect: ", per:5);
writeln("Abundant: ", ab:5)
corp- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
Dyalect
func sieve(bound) {
var (a, d, p) = (0, 0, 0)
var sum = Array.Empty(bound + 1, 0)
for divisor in 1..(bound / 2) {
var i = divisor + divisor
while i <= bound {
sum[i] += divisor
i += divisor
}
}
for i in 1..bound {
if sum[i] < i {
d += 1
} else if sum[i] > i {
a += 1
} else {
p += 1
}
}
(abundant: a, deficient: d, perfect: p)
}
func Iterator.Where(fn) {
for x in this {
if fn(x) {
yield x
}
}
}
func Iterator.Sum() {
var sum = 0
for x in this {
sum += x
}
sum
}
func division(bound) {
var (a, d, p) = (0, 0, 0)
for i in 1..20000 {
var sum = ( 1 .. ((i + 1) / 2) )
.Where(div => div != i && i % div == 0)
.Sum()
if sum < i {
d += 1
} else if sum > i {
a += 1
} else {
p += 1
}
}
(abundant: a, deficient: d, perfect: p)
}
func out(res) {
print("Abundant: \(res.abundant), Deficient: \(res.deficient), Perfect: \(res.perfect)");
}
out( sieve(20000) )
out( division(20000) )- Output:
Abundant: 4953, Deficient: 15043, Perfect: 4 Abundant: 4953, Deficient: 15043, Perfect: 4
EasyLang
func sumprop num .
if num < 2
return 0
.
i = 2
sum = 1
root = sqrt num
while i < root
if num mod i = 0
sum += i + num / i
.
i += 1
.
if num mod root = 0
sum += root
.
return sum
.
for j = 1 to 20000
sump = sumprop j
if sump < j
deficient += 1
elif sump = j
perfect += 1
else
abundant += 1
.
.
print "Perfect: " & perfect
print "Abundant: " & abundant
print "Deficient: " & deficientEchoLisp
(lib 'math) ;; sum-divisors function
(define-syntax-rule (++ a) (set! a (1+ a)))
(define (abondance (N 20000))
(define-values (delta abondant deficient perfect) '(0 0 0 0))
(for ((n (in-range 1 (1+ N))))
(set! delta (- (sum-divisors n) n))
(cond
((< delta 0) (++ deficient))
((> delta 0) (++ abondant))
(else (writeln 'perfect→ n) (++ perfect))))
(printf "In range 1.. %d" N)
(for-each (lambda(x) (writeln x (eval x))) '(abondant deficient perfect)))
(abondance)
perfect→ 6
perfect→ 28
perfect→ 496
perfect→ 8128
In range 1.. 20000
abondant 4953
deficient 15043
perfect 4
Ela
open monad io number list
divisors n = filter ((0 ==) << (n `mod`)) [1 .. (n `div` 2)]
classOf n = compare (sum $ divisors n) n
do
let classes = map classOf [1 .. 20000]
let printRes w c = putStrLn $ w ++ (show << length $ filter (== c) classes)
printRes "deficient: " LT
printRes "perfect: " EQ
printRes "abundant: " GT- Output:
deficient: 15043 perfect: 4 abundant: 4953
Elena
ELENA 6.x :
import extensions;
classifyNumbers(int bound, ref int abundant, ref int deficient, ref int perfect)
{
int a := 0;
int d := 0;
int p := 0;
int[] sum := new int[](bound + 1);
for(int divisor := 1; divisor <= bound / 2; divisor += 1)
{
for(int i := divisor + divisor; i <= bound; i += divisor)
{
sum[i] := sum[i] + divisor
}
};
for(int i := 1; i <= bound; i += 1)
{
int t := sum[i];
if (sum[i]<i)
{
d += 1
}
else
{
if (sum[i]>i)
{
a += 1
}
else
{
p += 1
}
}
};
abundant := a;
deficient := d;
perfect := p
}
public program()
{
int abundant := 0;
int deficient := 0;
int perfect := 0;
classifyNumbers(20000, ref abundant, ref deficient, ref perfect);
console.printLine("Abundant: ",abundant,", Deficient: ",deficient,", Perfect: ",perfect)
}- Output:
Abundant: 4953, Deficient: 15043, Perfect: 4
Elixir
defmodule Proper do
def divisors(1), do: []
def divisors(n), do: [1 | divisors(2,n,:math.sqrt(n))] |> Enum.sort
defp divisors(k,_n,q) when k>q, do: []
defp divisors(k,n,q) when rem(n,k)>0, do: divisors(k+1,n,q)
defp divisors(k,n,q) when k * k == n, do: [k | divisors(k+1,n,q)]
defp divisors(k,n,q) , do: [k,div(n,k) | divisors(k+1,n,q)]
end
{abundant, deficient, perfect} = Enum.reduce(1..20000, {0,0,0}, fn n,{a, d, p} ->
sum = Proper.divisors(n) |> Enum.sum
cond do
n < sum -> {a+1, d, p}
n > sum -> {a, d+1, p}
true -> {a, d, p+1}
end
end)
IO.puts "Deficient: #{deficient} Perfect: #{perfect} Abundant: #{abundant}"
- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
Erlang
-module(properdivs).
-export([divs/1,sumdivs/1,class/1]).
divs(0) -> [];
divs(1) -> [];
divs(N) -> lists:sort(divisors(1,N)).
divisors(1,N) ->
divisors(2,N,math:sqrt(N),[1]).
divisors(K,_N,Q,L) when K > Q -> L;
divisors(K,N,_Q,L) when N rem K =/= 0 ->
divisors(K+1,N,_Q,L);
divisors(K,N,_Q,L) when K * K =:= N ->
divisors(K+1,N,_Q,[K|L]);
divisors(K,N,_Q,L) ->
divisors(K+1,N,_Q,[N div K, K|L]).
sumdivs(N) -> lists:sum(divs(N)).
class(Limit) -> class(0,0,0,sumdivs(2),2,Limit).
class(D,P,A,_Sum,Acc,L) when Acc > L +1->
io:format("Deficient: ~w, Perfect: ~w, Abundant: ~w~n", [D,P,A]);
class(D,P,A,Sum,Acc,L) when Acc < Sum ->
class(D,P,A+1,sumdivs(Acc+1),Acc+1,L);
class(D,P,A,Sum,Acc,L) when Acc == Sum ->
class(D,P+1,A,sumdivs(Acc+1),Acc+1,L);
class(D,P,A,Sum,Acc,L) when Acc > Sum ->
class(D+1,P,A,sumdivs(Acc+1),Acc+1,L).
- Output:
24> c(properdivs).
{ok,properdivs}
25> properdivs:class(20000).
Deficient: 15043, Perfect: 4, Abundant: 4953
ok
The above divisors method was slightly rewritten to satisfy the observation below but preserve the different programming style. Now has comparable performance.
Erlang 2
The version above is not tail-call recursive, and so cannot classify large ranges. Here is a more optimal solution.
-module(proper_divisors).
-export([classify_range/2]).
classify_range(Start, Stop) ->
lists:foldl(fun (X, A) ->
Class = classify(X),
A#{Class => maps:get(Class, A, 0)+1} end,
#{},
lists:seq(Start, Stop)).
classify(N) ->
SumPD = lists:sum(proper_divisors(N)),
if
SumPD < N -> deficient;
SumPD =:= N -> perfect;
SumPD > N -> abundant
end.
proper_divisors(1) -> [];
proper_divisors(N) when N > 1, is_integer(N) ->
proper_divisors(2, math:sqrt(N), N, [1]).
proper_divisors(I, L, _, A) when I > L -> lists:sort(A);
proper_divisors(I, L, N, A) when N rem I =/= 0 ->
proper_divisors(I+1, L, N, A);
proper_divisors(I, L, N, A) when I * I =:= N ->
proper_divisors(I+1, L, N, [I|A]);
proper_divisors(I, L, N, A) ->
proper_divisors(I+1, L, N, [N div I, I|A]).
- Output:
8>proper_divisors:classify_range(1,20000).
#{abundant => 4953,deficient => 15043,perfect => 4}
F#
let mutable a=0
let mutable b=0
let mutable c=0
let mutable d=0
let mutable e=0
let mutable f=0
for i=1 to 20000 do
b <- 0
f <- i/2
for j=1 to f do
if i%j=0 then
b <- b+i
if b<i then
c <- c+1
if b=i then
d <- d+1
if b>i then
e <- e+1
printfn " deficient %i"c
printfn "perfect %i"d
printfn "abundant %i"e
An immutable solution.
let deficient, perfect, abundant = 0,1,2
let classify n = ([1..n/2] |> List.filter (fun x->n % x = 0) |> List.sum) |> function
| x when x<n -> deficient | x when x>n -> abundant | _ -> perfect
let incClass xs n =
let cn = n |> classify
xs |> List.mapi (fun i x->if i=cn then x + 1 else x)
[1..20000]
|> List.fold incClass [0;0;0]
|> List.zip [ "deficient"; "perfect"; "abundant" ]
|> List.iter (fun (label, count) -> printfn "%s: %d" label count)
Factor
USING: fry math.primes.factors math.ranges ;
: psum ( n -- m ) divisors but-last sum ;
: pcompare ( n -- <=> ) dup psum swap <=> ;
: classify ( -- seq ) 20,000 [1,b] [ pcompare ] map ;
: pcount ( <=> -- n ) '[ _ = ] count ;
classify [ +lt+ pcount "Deficient: " write . ]
[ +eq+ pcount "Perfect: " write . ]
[ +gt+ pcount "Abundant: " write . ] tri
- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
Forth
CREATE A 0 ,
: SLOT ( x y -- 0|1|2) OVER OVER < -ROT > - 1+ ;
: CLASSIFY ( n -- n') \ 0 == deficient, 1 == perfect, 2 == abundant
DUP A ! \ we'll be accessing this often, so save somewhere convenient
2 / >R \ upper bound
1 \ starting sum, 1 is always a divisor
2 \ current check
BEGIN DUP R@ < WHILE
A @ OVER /MOD SWAP ( s c d m)
IF DROP ELSE
R> DROP DUP >R ( R: d n)
OVER TUCK OVER <> * - ( s c c+?d)
ROT + SWAP ( s' c)
THEN 1+
REPEAT DROP R> DROP A @ ( sum n) SLOT ;
CREATE COUNTS 0 , 0 , 0 ,
: INIT COUNTS 3 CELLS ERASE 1 COUNTS ! ;
: CLASSIFY-NUMBERS ( n --) INIT
BEGIN DUP WHILE
1 OVER CLASSIFY CELLS COUNTS + +! 1-
REPEAT DROP ;
: .COUNTS
." Deficient : " [ COUNTS ]L @ . CR
." Perfect : " [ COUNTS 1 CELLS + ]L @ . CR
." Abundant : " [ COUNTS 2 CELLS + ]L @ . CR ;
20000 CLASSIFY-NUMBERS .COUNTS BYE
- Output:
Deficient : 15043 Perfect : 5 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 further 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
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.
FreeBASIC
' FreeBASIC v1.05.0 win64
Function SumProperDivisors(number As Integer) As Integer
If number < 2 Then Return 0
Dim sum As Integer = 0
For i As Integer = 1 To number \ 2
If number Mod i = 0 Then sum += i
Next
Return sum
End Function
Dim As Integer sum, deficient, perfect, abundant
For n As Integer = 1 To 20000
sum = SumProperDivisors(n)
If sum < n Then
deficient += 1
ElseIf sum = n Then
perfect += 1
Else
abundant += 1
EndIf
Next
Print "The classification of the numbers from 1 to 20,000 is as follows : "
Print
Print "Deficient = "; deficient
Print "Perfect = "; perfect
Print "Abundant = "; abundant
Print
Print "Press any key to exit the program"
Sleep
End
- Output:
The classification of the numbers from 1 to 20,000 is as follows : Deficient = 15043 Perfect = 4 Abundant = 4953
Frink
d = new dict
for n = 1 to 20000
{
s = sum[allFactors[n, true, false, true], 0]
rel = s <=> n
d.increment[rel, 1]
}
println["Deficient: " + d@(-1)]
println["Perfect: " + d@0]
println["Abundant: " + d@1]- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
FutureBasic
local fn SumProperDivisors( number as long ) as long
long i, result, sum = 0
if number < 2 then exit fn = 0
for i = 1 to number / 2
if number mod i == 0 then sum += i
next
result = sum
end fn = result
void local fn NumberCategories( limit as long )
long i, sum, deficient = 0, perfect = 0, abundant = 0
for i = 1 to limit
sum = fn SumProperDivisors(i)
if sum < i then deficient++ : continue
if sum == i then perfect++ : continue
abundant++
next
printf @"\nClassification of integers from 1 to %ld is:\n", limit
printf @"Deficient = %ld\nPerfect = %ld\nAbundant = %ld", deficient, perfect, abundant
printf @"-----------------\nTotal = %ld\n", deficient + perfect + abundant
end fn
CFTimeInterval t
t = fn CACurrentMediaTime
fn NumberCategories( 20000 )
printf @"Compute time: %.3f ms",(fn CACurrentMediaTime-t)*1000
HandleEvents- Output:
Classification of integers from 1 to 20000 is: Deficient = 15043 Perfect = 4 Abundant = 4953 ----------------- Total = 20000 Compute time: 1761.443 ms
GFA Basic
num_deficient%=0
num_perfect%=0
num_abundant%=0
'
FOR current%=1 TO 20000
sum_divisors%=@sum_proper_divisors(current%)
IF sum_divisors%<current%
num_deficient%=num_deficient%+1
ELSE IF sum_divisors%=current%
num_perfect%=num_perfect%+1
ELSE ! sum_divisors%>current%
num_abundant%=num_abundant%+1
ENDIF
NEXT current%
'
' Display results on a window
'
OPENW 1
CLEARW 1
PRINT "Number deficient ";num_deficient%
PRINT "Number perfect ";num_perfect%
PRINT "Number abundant ";num_abundant%
~INP(2)
CLOSEW 1
'
' Compute the sum of proper divisors of given number
'
FUNCTION sum_proper_divisors(n%)
LOCAL i%,sum%,root%
'
IF n%>1 ! n% must be 2 or higher
sum%=1 ! start with 1
root%=SQR(n%) ! note that root% is an integer
' check possible factors, up to sqrt
FOR i%=2 TO root%
IF n% MOD i%=0
sum%=sum%+i% ! i% is a factor
IF i%*i%<>n% ! check i% is not actual square root of n%
sum%=sum%+n%/i% ! so n%/i% will also be a factor
ENDIF
ENDIF
NEXT i%
ENDIF
RETURN sum%
ENDFUNC
Output is:
Number deficient 15043 Number perfect 4 Number abundant 4953
Go
package main
import "fmt"
func pfacSum(i int) int {
sum := 0
for p := 1; p <= i/2; p++ {
if i%p == 0 {
sum += p
}
}
return sum
}
func main() {
var d, a, p = 0, 0, 0
for i := 1; i <= 20000; i++ {
j := pfacSum(i)
if j < i {
d++
} else if j == i {
p++
} else {
a++
}
}
fmt.Printf("There are %d deficient numbers between 1 and 20000\n", d)
fmt.Printf("There are %d abundant numbers between 1 and 20000\n", a)
fmt.Printf("There are %d perfect numbers between 1 and 20000\n", p)
}
- Output:
There are 15043 deficient numbers between 1 and 20000 There are 4953 abundant numbers between 1 and 20000 There are 4 perfect numbers between 1 and 20000
Groovy
Solution:
Uses the "factorize" closure from Factors of an integer
def dpaCalc = { factors ->
def n = factors.pop()
def fSum = factors.sum()
fSum < n
? 'deficient'
: fSum > n
? 'abundant'
: 'perfect'
}
(1..20000).inject([deficient:0, perfect:0, abundant:0]) { map, n ->
map[dpaCalc(factorize(n))]++
map
}
.each { e -> println e }
- Output:
deficient=15043 perfect=4 abundant=4953
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
- Output:
deficient: 15043 perfect: 4 abundant: 4953
Or, a little faster and more directly, as a single fold:
import Data.Numbers.Primes (primeFactors)
import Data.List (group, sort)
deficientPerfectAbundantCountsUpTo :: Int -> (Int, Int, Int)
deficientPerfectAbundantCountsUpTo = foldr go (0, 0, 0) . enumFromTo 1
where
go x (deficient, perfect, abundant)
| divisorSum < x = (succ deficient, perfect, abundant)
| divisorSum > x = (deficient, perfect, succ abundant)
| otherwise = (deficient, succ perfect, abundant)
where
divisorSum = sum $ properDivisors x
properDivisors :: Int -> [Int]
properDivisors = init . sort . foldr go [1] . group . primeFactors
where
go = flip ((<*>) . fmap (*)) . scanl (*) 1
main :: IO ()
main = print $ deficientPerfectAbundantCountsUpTo 20000
- Output:
(15043,4,4953)
J
factors=: [: /:~@, */&>@{@((^ i.@>:)&.>/)@q:~&__
properDivisors=: factors -. ]
We can subtract the sum of a number's proper divisors from itself to classify the number:
(- +/@properDivisors&>) 1+i.10
1 1 2 1 4 0 6 1 5 2
Except, we are only concerned with the sign of this difference:
*(- +/@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
Also, we do not care about the individual classification but only about how many numbers fall in each category:
#/.~ *(- +/@properDivisors&>) 1+i.20000
15043 4 4953
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):
~. *(- +/@properDivisors&>) 1+i.20000
1 0 _1
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).
Java
import java.util.stream.LongStream;
public class NumberClassifications {
public static void main(String[] args) {
int deficient = 0;
int perfect = 0;
int abundant = 0;
for (long i = 1; i <= 20_000; i++) {
long sum = properDivsSum(i);
if (sum < i)
deficient++;
else if (sum == i)
perfect++;
else
abundant++;
}
System.out.println("Deficient: " + deficient);
System.out.println("Perfect: " + perfect);
System.out.println("Abundant: " + abundant);
}
public static long properDivsSum(long n) {
return LongStream.rangeClosed(1, (n + 1) / 2).filter(i -> n != i && n % i == 0).sum();
}
}
Deficient: 15043 Perfect: 4 Abundant: 4953
JavaScript
ES5
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], '<br>' )
Or:
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], '<br>' )
Or:
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 ) fs = cs[n] = factors(n)
for ( var e in fs ) ts[e] = fs[e] + (e==p)
}
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], '<br>' )
- Output:
Deficient:15043, Perfect:4, Abundant:4953
ES6
(() => {
'use strict';
const
// divisors :: (Integral a) => a -> [a]
divisors = n => range(1, Math.floor(n / 2))
.filter(x => n % x === 0),
// classOf :: (Integral a) => a -> Ordering
classOf = n => compare(divisors(n)
.reduce((a, b) => a + b, 0), n),
classTypes = {
deficient: -1,
perfect: 0,
abundant: 1
};
// GENERIC FUNCTIONS
const
// compare :: Ord a => a -> a -> Ordering
compare = (a, b) =>
a < b ? -1 : (a > b ? 1 : 0),
// range :: Int -> Int -> [Int]
range = (m, n) =>
Array.from({
length: Math.floor(n - m) + 1
}, (_, i) => m + i);
// TEST
// classes :: [Ordering]
const classes = range(1, 20000)
.map(classOf);
return Object.keys(classTypes)
.map(k => k + ": " + classes
.filter(x => x === classTypes[k])
.length.toString())
.join('\n');
})();
- Output:
deficient: 15043 perfect: 4 abundant: 4953
// classify the numbers 1 : 20 000 as abudant, deficient or perfect
"use strict"
let abundantCount = 0
let deficientCount = 0
let perfectCount = 0
const maxNumber = 20000
// construct a table of the proper divisor sums
let pds = []
pds[ 1 ] = 0
for( let i = 2; i <= maxNumber; i ++ ){ pds[ i ] = 1 }
for( let i = 2; i <= maxNumber; i ++ )
{
for( let j = i + i; j <= maxNumber; j += i ){ pds[ j ] += i }
}
// classify the numbers
for( let n = 1; n <= maxNumber; n ++ )
{
if( pds[ n ] < n )
{
deficientCount ++
}
else if( pds[ n ] == n )
{
perfectCount ++
}
else // pds[ n ] > n
{
abundantCount ++
}
}
console.log( "abundant " + abundantCount.toString() )
console.log( "deficient " + deficientCount.toString() )
console.log( "perfect " + perfectCount.toString() )
- Output:
abundant 4953 deficient 15043 perfect 4
jq
The definition of proper_divisors is taken from Proper_divisors#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;The task:
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 )- Output:
$ jq -n -c -f AbundantDeficientPerfect.jq
{"deficient":15043,"perfect":4,"abundant":4953}
Jsish
From Javascript ES5 entry.
/* Classify Deficient, Perfect and Abdundant integers */
function classifyDPA(stop:number, start:number=0, step:number=1):array {
var dpa = [1, 0, 0];
for (var n=start; n<=stop; n+=step) {
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;
}
return dpa;
}
var dpa = classifyDPA(20000, 2);
printf('Deficient: %d, Perfect: %d, Abundant: %d\n', dpa[0], dpa[1], dpa[2]);
- Output:
prompt$ jsish classifyDPA.jsi 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.
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
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.
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
- Output:
Classification of integers from 1 to 20000
Deficient, 15043
Perfect, 4
Abundant, 4953
Using Primes versions >= 0.5.4
Recent revisions of the Primes package include a divisors() which returns divisors of n including 1 and n.
using Primes
""" Return tuple of (perfect, abundant, deficient) counts from 1 up to nmax """
function per_abu_def_classify(nmax::Int)
results = [0, 0, 0]
for n in 1:nmax
results[sign(sum(divisors(n)) - 2 * n) + 2] += 1
end
return (perfect, abundant, deficient) = results
end
let MAX = 20_000
NPE, NAB, NDE = per_abu_def_classify(MAX)
println("$NPE perfect, $NAB abundant, and $NDE deficient numbers in 1:$MAX.")
end- Output:
4 perfect, 4953 abundant, and 15043 deficient numbers in 1:20000.
K
/Classification of numbers into abundant, perfect and deficient
/ numclass.k
/return 0,1 or -1 if perfect or abundant or deficient respectively
numclass: {s:(+/&~x!'!1+x)-x; :[s>x;:1;:[s<x;:-1;:0]]}
/classify numbers from 1 to 20000 into respective groups
c: =numclass' 1+!20000
/print statistics
`0: ,"Deficient = ", $(#c[0])
`0: ,"Perfect = ", $(#c[1])
`0: ,"Abundant = ", $(#c[2])
/Classification of numbers into abundant, perfect and deficient
/ numclass.k
/return 0,1 or -1 if perfect or abundant or deficient respectively
numclass: {s:(+/&~(!1+x)!\:x)-x; $[s>x;:1;$[s<x;:-1;:0]]}
/classify numbers from 1 to 20000 into respective groups
c: =numclass' 1+!20000
/print statistics
`0: ,"Deficient = ", $(#c[-1])
`0: ,"Perfect = ", $(#c[0])
`0: ,"Abundant = ", $(#c[1])
(indentation optional, used to emphasize lines which are not comment lines)
- Output:
Deficient = 15043 Perfect = 4 Abundant = 4953
Kotlin
// version 1.1
fun sumProperDivisors(n: Int) =
if (n < 2) 0 else (1..n / 2).filter { (n % it) == 0 }.sum()
fun main(args: Array<String>) {
var sum: Int
var deficient = 0
var perfect = 0
var abundant = 0
for (n in 1..20000) {
sum = sumProperDivisors(n)
when {
sum < n -> deficient++
sum == n -> perfect++
sum > n -> abundant++
}
}
println("The classification of the numbers from 1 to 20,000 is as follows:\n")
println("Deficient = $deficient")
println("Perfect = $perfect")
println("Abundant = $abundant")
}
- Output:
The classification of the numbers from 1 to 20,000 is as follows: Deficient = 15043 Perfect = 4 Abundant = 4953
Liberty BASIC
print "ROSETTA CODE - Abundant, deficient and perfect number classifications"
print
for x=1 to 20000
x$=NumberClassification$(x)
select case x$
case "deficient": de=de+1
case "perfect": pe=pe+1: print x; " is a perfect number"
case "abundant": ab=ab+1
end select
select case x
case 2000: print "Checking the number classifications of 20,000 integers..."
case 4000: print "Please be patient."
case 7000: print "7,000"
case 10000: print "10,000"
case 12000: print "12,000"
case 14000: print "14,000"
case 16000: print "16,000"
case 18000: print "18,000"
case 19000: print "Almost done..."
end select
next x
print "Deficient numbers = "; de
print "Perfect numbers = "; pe
print "Abundant numbers = "; ab
print "TOTAL = "; pe+de+ab
[Quit]
print "Program complete."
end
function NumberClassification$(n)
x=ProperDivisorCount(n)
for y=1 to x
PDtotal=PDtotal+ProperDivisor(y)
next y
if PDtotal=n then NumberClassification$="perfect": exit function
if PDtotal<n then NumberClassification$="deficient": exit function
if PDtotal>n then NumberClassification$="abundant": exit function
end function
function ProperDivisorCount(n)
n=abs(int(n)): if n=0 or n>20000 then exit function
dim ProperDivisor(100)
for y=2 to n
if (n mod y)=0 then
ProperDivisorCount=ProperDivisorCount+1
ProperDivisor(ProperDivisorCount)=n/y
end if
next y
end function- Output:
ROSETTA CODE - Abundant, deficient and perfect number classifications 6 is a perfect number 28 is a perfect number 496 is a perfect number Checking the number classifications of 20,000 integers... Please be patient. 7,000 8128 is a perfect number 10,000 12,000 14,000 16,000 18,000 Almost done... Deficient numbers = 15043 Perfect numbers = 4 Abundant numbers = 4953 TOTAL = 20000 Program complete.
Lua
Summing the factors using modulo/division
function sumDivs (n)
if n < 2 then return 0 end
local sum, sr = 1, math.sqrt(n)
for d = 2, sr do
if n % d == 0 then
sum = sum + d
if d ~= sr then sum = sum + n / d end
end
end
return sum
end
local a, d, p, Pn = 0, 0, 0
for n = 1, 20000 do
Pn = sumDivs(n)
if Pn > n then a = a + 1 end
if Pn < n then d = d + 1 end
if Pn == n then p = p + 1 end
end
print("Abundant:", a)
print("Deficient:", d)
print("Perfect:", p)
- Output:
Abundant: 4953 Deficient: 15043 Perfect: 4
Summing the factors using a table
do -- classify the numbers 1 : 20 000 as abudant, deficient or perfect
local abundantCount = 0
local deficientCount = 0
local perfectCount = 0
local maxNumber = 20000
-- construct a table of the proper divisor sums
local pds = {}
pds[ 1 ] = 0
for i = 2, maxNumber do pds[ i ] = 1 end
for i = 2, maxNumber do
for j = i + i, maxNumber, i do pds[ j ] = pds[ j ] + i end
end
-- classify the numbers
for n = 1, maxNumber do
local pdSum = pds[ n ]
if pdSum < n then
deficientCount = deficientCount + 1
elseif pdSum == n then
perfectCount = perfectCount + 1
else -- pdSum > n
abundantCount = abundantCount + 1
end
end
io.write( "abundant ", abundantCount, "\n" )
io.write( "deficient ", deficientCount, "\n" )
io.write( "perfect ", perfectCount, "\n" )
end
- Output:
abundant 4953 deficient 15043 perfect 4
MAD
NORMAL MODE IS INTEGER
DIMENSION P(20000)
MAX = 20000
THROUGH INIT, FOR I=1, 1, I.G.MAX
INIT P(I) = 0
THROUGH CALC, FOR I=1, 1, I.G.MAX/2
THROUGH CALC, FOR J=I+I, I, J.G.MAX
CALC P(J) = P(J)+I
DEF = 0
PER = 0
AB = 0
THROUGH CLSFY, FOR N=1, 1, N.G.MAX
WHENEVER P(N).L.N, DEF = DEF+1
WHENEVER P(N).E.N, PER = PER+1
CLSFY WHENEVER P(N).G.N, AB = AB+1
PRINT FORMAT FDEF,DEF
PRINT FORMAT FPER,PER
PRINT FORMAT FAB,AB
VECTOR VALUES FDEF = $I5,S1,9HDEFICIENT*$
VECTOR VALUES FPER = $I5,S1,7HPERFECT*$
VECTOR VALUES FAB = $I5,S1,8HABUNDANT*$
END OF PROGRAM- Output:
15043 DEFICIENT
4 PERFECT
4953 ABUNDANT
Maple
classify_number := proc(n::posint);
if evalb(NumberTheory:-SumOfDivisors(n) < 2*n) then
return "Deficient";
elif evalb(NumberTheory:-SumOfDivisors(n) = 2*n) then
return "Perfect";
else
return "Abundant";
end if;
end proc:
classify_sequence := proc(k::posint)
local num_list;
num_list := map(classify_number, [seq(1..k)]);
return Statistics:-Tally(num_list)
end proc:- Output:
["Perfect" = 4, "Abundant" = 4953, "Deficient" = 15043]
Mathematica / Wolfram Language
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]]
- Output:
deficient: 15043 perfect: 4 abundant: 4953
MatLab
abundant=0; deficient=0; perfect=0; p=[];
for N=2:20000
K=1:ceil(N/2);
D=K(~(rem(N, K)));
sD=sum(D);
if sD<N
deficient=deficient+1;
elseif sD==N
perfect=perfect+1;
else
abundant=abundant+1;
end
end
disp(table([deficient;perfect;abundant],'RowNames',{'Deficient','Perfect','Abundant'},'VariableNames',{'Quantities'}))
- Output:
Quantities
__________
Deficient 15042
Perfect 4
Abundant 4953
Maxima
/* Given a number it returns wether it is perfect, deficient or abundant */
number_class(n):=if divsum(n)-n=n then "perfect" else if divsum(n)-n<n then "deficient" else if divsum(n)-n>n then "abundant"$
/* Function that displays the number of each kind below n */
classification_count(n):=block(makelist(number_class(i),i,1,n),
[[length(sublist(%%,lambda([x],x="deficient")))," deficient"],[length(sublist(%%,lambda([x],x="perfect")))," perfect"],[length(sublist(%%,lambda([x],x="abundant")))," abundant"]])$
/* Test case */
classification_count(20000);
- Output:
[[15043," deficient"],[4," perfect"],[4953," abundant"]]
MiniScript
// classify the numbers 1 : 20 000 as abudant, deficient or perfect
abundantCount = 0
deficientCount = 0
perfectCount = 0
maxNumber = 20000
// construct a table of the proper divisor sums
pds = [0] * ( maxNumber + 1 )
pds[ 1 ] = 0
for i in range( 2, maxNumber )
pds[ i ] = 1
end for
for i in range( 2, maxNumber )
for j in range( i + i, maxNumber, i )
pds[ j ] = pds[ j ] + i
end for
end for
// classify the numbers
for n in range( 1, maxNumber )
pdSum = pds[ n ]
if pdSum < n then
deficientCount = deficientCount + 1
else if pdSum == n then
perfectCount = perfectCount + 1
else // pdSum > n
abundantCount = abundantCount + 1
end if
end for
print "abundant " + abundantCount
print "deficient " + deficientCount
print "perfect " + perfectCount
- Output:
abundant 4953 deficient 15043 perfect 4
ML
mLite
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;
Output
Abundant numbers between 1 and 20000: 4953 Deficient numbers between 1 and 20000: 15043 Perfect numbers between 1 and 20000: 4
Modula-2
MODULE ADP;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;
PROCEDURE ProperDivisorSum(n : INTEGER) : INTEGER;
VAR i,sum : INTEGER;
BEGIN
sum := 0;
IF n<2 THEN
RETURN 0
END;
FOR i:=1 TO (n DIV 2) DO
IF n MOD i = 0 THEN
INC(sum,i)
END
END;
RETURN sum
END ProperDivisorSum;
VAR
buf : ARRAY[0..63] OF CHAR;
n : INTEGER;
d,p,a : INTEGER = 0;
sum : INTEGER;
BEGIN
FOR n:=1 TO 20000 DO
sum := ProperDivisorSum(n);
IF sum<n THEN
INC(d)
ELSIF sum=n THEN
INC(p)
ELSIF sum>n THEN
INC(a)
END
END;
WriteString("The classification of the numbers from 1 to 20,000 is as follows:");
WriteLn;
FormatString("Deficient = %i\n", buf, d);
WriteString(buf);
FormatString("Perfect = %i\n", buf, p);
WriteString(buf);
FormatString("Abundant = %i\n", buf, a);
WriteString(buf);
ReadChar
END ADP.
NewLisp
;;; The list (1 .. n-1) of integers is generated
;;; then each non-divisor of n is replaced by 0
;;; finally all these numbers are summed.
;;; fn defines an anonymous function inline.
(define (sum-divisors n)
(apply + (map (fn (x) (if (> (% n x) 0) 0 x)) (sequence 1 (- n 1)))))
;
;;; Returns the symbols -, p or + for deficient, perfect or abundant numbers respectively.
(define (number-type n)
(let (sum (sum-divisors n))
(if
(< sum n) '-
(= sum n) 'p
true '+)))
;
;;; Tallies the types from 2 to n.
(define (count-types n)
(count '(- p +) (map number-type (sequence 2 n))))
;
;;; Running:
(println (count-types 20000))
- Output:
(15042 4 4953)
Nim
proc sumProperDivisors(number: int) : int =
if number < 2 : return 0
for i in 1 .. number div 2 :
if number mod i == 0 : result += i
var
sum : int
deficient = 0
perfect = 0
abundant = 0
for n in 1 .. 20000 :
sum = sumProperDivisors(n)
if sum < n :
inc(deficient)
elif sum == n :
inc(perfect)
else :
inc(abundant)
echo "The classification of the numbers between 1 and 20,000 is as follows :\n"
echo " Deficient = " , deficient
echo " Perfect = " , perfect
echo " Abundant = " , abundant
- Output:
The classification of the numbers between 1 and 20,000 is as follows : Deficient = 15043 Perfect = 4 Abundant = 4953
Oforth
import: mapping
Integer method: properDivs -- []
self 2 / seq filter( #[ self swap mod 0 == ] ) ;
: numberClasses
| i deficient perfect s |
0 0 ->deficient ->perfect
0 20000 loop: i [
0 #+ i properDivs apply ->s
s i < ifTrue: [ deficient 1+ ->deficient continue ]
s i == ifTrue: [ perfect 1+ ->perfect continue ]
1+
]
"Deficients :" . deficient .cr
"Perfects :" . perfect .cr
"Abundant :" . .cr
;- Output:
numberClasses Deficients : 15043 Perfects : 4 Abundant : 4953
PARI/GP
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)- Output:
%1 = [15043, 4, 4953]
Pascal
Free Pascal
search for "UNIT for prime decomposition".
program KindOfN; //[deficient,perfect,abundant]
{$IFDEF FPC}
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$COPERATORS ON}{$CODEALIGN proc=16}
{$ENDIF}
{$IFDEF WINDOWS} {$APPTYPE CONSOLE}{$ENDIF}
uses
sysutils,PrimeDecomp // limited to 1.2e11
{$IFDEF WINDOWS},Windows{$ENDIF}
;
//alternative copy and paste PrimeDecomp.inc for TIO.RUN
{$I PrimeDecomp.inc}
type
tKindIdx = 0..2;//[deficient,perfect,abundant];
tKind = array[tKindIdx] of Uint64;
procedure GetKind(Limit:Uint64);
var
pPrimeDecomp :tpPrimeFac;
SumOfKind : tKind;
n: NativeUInt;
c: NativeInt;
T0:Int64;
Begin
writeln('Limit: ',LIMIT);
T0 := GetTickCount64;
fillchar(SumOfKind,SizeOf(SumOfKind),#0);
n := 1;
Init_Sieve(n);
repeat
pPrimeDecomp:= GetNextPrimeDecomp;
c := pPrimeDecomp^.pfSumOfDivs-2*n;
c := ORD(c>0)-ORD(c<0)+1;//sgn(c)+1
inc(SumOfKind[c]);
inc(n);
until n > LIMIT;
T0 := GetTickCount64-T0;
writeln('deficient: ',SumOfKind[0]);
writeln('abundant: ',SumOfKind[2]);
writeln('perfect: ',SumOfKind[1]);
writeln('runtime ',T0/1000:0:3,' s');
writeln;
end;
Begin
InitSmallPrimes; //using PrimeDecomp.inc
GetKind(20000);
GetKind(10*1000*1000);
GetKind(524*1000*1000);
end.
- @TIO.RUN:
Limit: 20000 deficient: 15043 abundant: 4953 perfect: 4 runtime 0.003 s Limit: 1000000 deficient: 752451 abundant: 247545 perfect: 4 runtime 0.052 s Limit: 524000000 deficient: 394250308 abundant: 129749687 perfect: 5 runtime 32.987 s Real time: 33.203 s User time: 32.881 s Sys. time: 0.048 s CPU share: 99.17 %
Perl
Using a module
Use the <=> operator to return a comparison of -1, 0, or 1, which classifies the results. 1 is classified as a deficient number, 6 is a perfect number, 12 is an abundant number. As per task spec, also showing the totals for the first 20,000 numbers.
use ntheory qw/divisor_sum/;
my @type = <Perfect Abundant Deficient>;
say join "\n", map { sprintf "%2d %s", $_, $type[divisor_sum($_)-$_ <=> $_] } 1..12;
my %h;
$h{divisor_sum($_)-$_ <=> $_}++ for 1..20000;
say "Perfect: $h{0} Deficient: $h{-1} Abundant: $h{1}";
- Output:
1 Deficient 2 Deficient 3 Deficient 4 Deficient 5 Deficient 6 Perfect 7 Deficient 8 Deficient 9 Deficient 10 Deficient 11 Deficient 12 Abundant Perfect: 4 Deficient: 15043 Abundant: 4953
Not using a module
Everything as above, but done more slowly with div_sum providing sum of proper divisors.
sub div_sum {
my($n) = @_;
my $sum = 0;
map { $sum += $_ unless $n % $_ } 1 .. $n-1;
$sum;
}
my @type = <Perfect Abundant Deficient>;
say join "\n", map { sprintf "%2d %s", $_, $type[div_sum($_) <=> $_] } 1..12;
my %h;
$h{div_sum($_) <=> $_}++ for 1..20000;
say "Perfect: $h{0} Deficient: $h{-1} Abundant: $h{1}";
Phix
integer deficient=0, perfect=0, abundant=0, N for i=1 to 20000 do N = sum(factors(i))+(i!=1) if N=i then perfect += 1 elsif N<i then deficient += 1 else abundant += 1 end if end for printf(1,"deficient:%d, perfect:%d, abundant:%d\n",{deficient, perfect, abundant})
- Output:
deficient:15043, perfect:4, abundant:4953
Picat
go =>
Classes = new_map([deficient=0,perfect=0,abundant=0]),
foreach(N in 1..20_000)
C = classify(N),
Classes.put(C,Classes.get(C)+1)
end,
println(Classes),
nl.
% Classify a number N
classify(N) = Class =>
S = sum_divisors(N),
if S < N then
Class1 = deficient
elseif S = N then
Class1 = perfect
elseif S > N then
Class1 = abundant
end,
Class = Class1.
% Alternative (slightly slower) approach.
classify2(N,S) = C, S < N => C = deficient.
classify2(N,S) = C, S == N => C = perfect.
classify2(N,S) = C, S > N => C = abundant.
% Sum of divisors
sum_divisors(N) = Sum =>
sum_divisors(2,N,cond(N>1,1,0),Sum).
% Part 0: base case
sum_divisors(I,N,Sum0,Sum), I > floor(sqrt(N)) =>
Sum = Sum0.
% Part 1: I is a divisor of N
sum_divisors(I,N,Sum0,Sum), N mod I == 0 =>
Sum1 = Sum0 + I,
(I != N div I ->
Sum2 = Sum1 + N div I
;
Sum2 = Sum1
),
sum_divisors(I+1,N,Sum2,Sum).
% Part 2: I is not a divisor of N.
sum_divisors(I,N,Sum0,Sum) =>
sum_divisors(I+1,N,Sum0,Sum).- Output:
(map)[perfect = 4,deficient = 15043,abundant = 4953]
PicoLisp
(de accud (Var Key)
(if (assoc Key (val Var))
(con @ (inc (cdr @)))
(push Var (cons Key 1)) )
Key )
(de **sum (L)
(let S 1
(for I (cdr L)
(inc 'S (** (car L) I)) )
S ) )
(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
(setq S (* S (**sum I))) )
(- 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)- Output:
15043 4 4953 0.110 sec
PL/I
*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;- Output:
In the range 1 - 20000
4953 numbers are abundant
4 numbers are perfect
15043 numbers are deficient
0.560 seconds elapsed
PL/M
100H:
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;
PRINT$NUMBER: PROCEDURE (N);
DECLARE S (6) BYTE INITIAL ('.....$');
DECLARE (N, P) ADDRESS, C BASED P BYTE;
P = .S(5);
DIGIT:
P = P - 1;
C = N MOD 10 + '0';
N = N / 10;
IF N > 0 THEN GO TO DIGIT;
CALL PRINT(P);
END PRINT$NUMBER;
DECLARE LIMIT LITERALLY '20$000';
DECLARE (PBASE, P BASED PBASE) ADDRESS;
DECLARE (I, J) ADDRESS;
PBASE = .MEMORY;
DO I=0 TO LIMIT; P(I)=0; END;
DO I=1 TO LIMIT/2;
DO J=I+I TO LIMIT BY I;
P(J) = P(J)+I;
END;
END;
DECLARE (DEF, PER, AB) ADDRESS INITIAL (0, 0, 0);
DO I=1 TO LIMIT;
IF P(I)<I THEN DEF = DEF+1;
ELSE IF P(I)=I THEN PER = PER+1;
ELSE IF P(I)>I THEN AB = AB+1;
END;
CALL PRINT$NUMBER(DEF);
CALL PRINT(.(' DEFICIENT',13,10,'$'));
CALL PRINT$NUMBER(PER);
CALL PRINT(.(' PERFECT',13,10,'$'));
CALL PRINT$NUMBER(AB);
CALL PRINT(.(' ABUNDANT',13,10,'$'));
CALL EXIT;
EOF- Output:
15043 DEFICIENT 4 PERFECT 4953 ABUNDANT
PowerShell
function Get-ProperDivisorSum ( [int]$N )
{
If ( $N -lt 2 ) { return 0 }
$Sum = 1
If ( $N -gt 3 )
{
$SqrtN = [math]::Sqrt( $N )
ForEach ( $Divisor in 2..$SqrtN )
{
If ( $N % $Divisor -eq 0 ) { $Sum += $Divisor + $N / $Divisor }
}
If ( $N % $SqrtN -eq 0 ) { $Sum -= $SqrtN }
}
return $Sum
}
$Deficient = $Perfect = $Abundant = 0
ForEach ( $N in 1..20000 )
{
Switch ( [math]::Sign( ( Get-ProperDivisorSum $N ) - $N ) )
{
-1 { $Deficient++ }
0 { $Perfect++ }
1 { $Abundant++ }
}
}
"Deficient: $Deficient"
"Perfect : $Perfect"
"Abundant : $Abundant"
- Output:
Deficient: 15043 Perfect : 4 Abundant : 4953
As a single function
Using the Get-ProperDivisorSum as a helper function in an advanced function:
function Get-NumberClassification
{
[CmdletBinding()]
[OutputType([PSCustomObject])]
Param
(
[Parameter(Mandatory=$true,
ValueFromPipeline=$true,
ValueFromPipelineByPropertyName=$true,
Position=0)]
[int]
$Number
)
Begin
{
function Get-ProperDivisorSum ([int]$Number)
{
if ($Number -lt 2) {return 0}
$sum = 1
if ($Number -gt 3)
{
$sqrtNumber = [Math]::Sqrt($Number)
foreach ($divisor in 2..$sqrtNumber)
{
if ($Number % $divisor -eq 0) {$sum += $divisor + $Number / $divisor}
}
if ($Number % $sqrtNumber -eq 0) {$sum -= $sqrtNumber}
}
$sum
}
[System.Collections.ArrayList]$numbers = @()
}
Process
{
switch ([Math]::Sign((Get-ProperDivisorSum $Number) - $Number))
{
-1 { [void]$numbers.Add([PSCustomObject]@{Class="Deficient"; Number=$Number}) }
0 { [void]$numbers.Add([PSCustomObject]@{Class="Perfect" ; Number=$Number}) }
1 { [void]$numbers.Add([PSCustomObject]@{Class="Abundant" ; Number=$Number}) }
}
}
End
{
$numbers | Group-Object -Property Class |
Select-Object -Property Count,
@{Name='Class' ; Expression={$_.Name}},
@{Name='Number'; Expression={$_.Group.Number}}
}
}
1..20000 | Get-NumberClassification
- Output:
Count Class Number
----- ----- ------
15043 Deficient {1, 2, 3, 4...}
4 Perfect {6, 28, 496, 8128}
4953 Abundant {12, 18, 20, 24...}
Processing
void setup() {
int deficient = 0, perfect = 0, abundant = 0;
for (int i = 1; i <= 20000; i++) {
int sum_divisors = propDivSum(i);
if (sum_divisors < i) {
deficient++;
} else if (sum_divisors == i) {
perfect++;
} else {
abundant++;
}
}
println("Deficient numbers less than 20000: " + deficient);
println("Perfect numbers less than 20000: " + perfect);
println("Abundant numbers less than 20000: " + abundant);
}
int propDivSum(int n) {
int sum = 0;
for (int i = 1; i < n; i++) {
if (n % i == 0) {
sum += i;
}
}
return sum;
}- Output:
Deficient numbers less than 20000: 15043 Perfect numbers less than 20000: 4 Abundant numbers less than 20000: 4953
Prolog
proper_divisors(1, []) :- !.
proper_divisors(N, [1|L]) :-
FSQRTN is floor(sqrt(N)),
proper_divisors(2, FSQRTN, N, L).
proper_divisors(M, FSQRTN, _, []) :-
M > FSQRTN,
!.
proper_divisors(M, FSQRTN, N, L) :-
N mod M =:= 0, !,
MO is N//M, % must be integer
L = [M,MO|L1], % both proper divisors
M1 is M+1,
proper_divisors(M1, FSQRTN, N, L1).
proper_divisors(M, FSQRTN, N, L) :-
M1 is M+1,
proper_divisors(M1, FSQRTN, N, L).
dpa(1, [1], [], []) :-
!.
dpa(N, D, P, A) :-
N > 1,
proper_divisors(N, PN),
sum_list(PN, SPN),
compare(VGL, SPN, N),
dpa(VGL, N, D, P, A).
dpa(<, N, [N|D], P, A) :- N1 is N-1, dpa(N1, D, P, A).
dpa(=, N, D, [N|P], A) :- N1 is N-1, dpa(N1, D, P, A).
dpa(>, N, D, P, [N|A]) :- N1 is N-1, dpa(N1, D, P, A).
dpa(N) :-
T0 is cputime,
dpa(N, D, P, A),
Dur is cputime-T0,
length(D, LD),
length(P, LP),
length(A, LA),
format("deficient: ~d~n abundant: ~d~n perfect: ~d~n",
[LD, LA, LP]),
format("took ~f seconds~n", [Dur]).
- Output:
?- dpa(20000). deficient: 15036 abundant: 4960 perfect: 4 took 0.802559 seconds
PureBasic
EnableExplicit
Procedure.i SumProperDivisors(Number)
If Number < 2 : ProcedureReturn 0 : EndIf
Protected i, sum = 0
For i = 1 To Number / 2
If Number % i = 0
sum + i
EndIf
Next
ProcedureReturn sum
EndProcedure
Define n, sum, deficient, perfect, abundant
If OpenConsole()
For n = 1 To 20000
sum = SumProperDivisors(n)
If sum < n
deficient + 1
ElseIf sum = n
perfect + 1
Else
abundant + 1
EndIf
Next
PrintN("The breakdown for the numbers 1 to 20,000 is as follows : ")
PrintN("")
PrintN("Deficient = " + deficient)
PrintN("Pefect = " + perfect)
PrintN("Abundant = " + abundant)
PrintN("")
PrintN("Press any key to close the console")
Repeat: Delay(10) : Until Inkey() <> ""
CloseConsole()
EndIf
- Output:
The breakdown for the numbers 1 to 20,000 is as follows : Deficient = 15043 Pefect = 4 Abundant = 4953
Python
Python: Counter
Importing Proper divisors from prime factors:
>>> 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)]
>>>
- Output:
Between 1 and 20000: 4953 abundant numbers 15043 deficient numbers 4 perfect numbers
Python: Reduce
In terms of a single fold:
'''Abundant, deficient and perfect number classifications'''
from itertools import accumulate, chain, groupby, product
from functools import reduce
from math import floor, sqrt
from operator import mul
# deficientPerfectAbundantCountsUpTo :: Int -> (Int, Int, Int)
def deficientPerfectAbundantCountsUpTo(n):
'''Counts of deficient, perfect, and abundant
integers in the range [1..n].
'''
def go(dpa, x):
deficient, perfect, abundant = dpa
divisorSum = sum(properDivisors(x))
return (
succ(deficient), perfect, abundant
) if x > divisorSum else (
deficient, perfect, succ(abundant)
) if x < divisorSum else (
deficient, succ(perfect), abundant
)
return reduce(go, range(1, 1 + n), (0, 0, 0))
# --------------------------TEST--------------------------
# main :: IO ()
def main():
'''Size of each sub-class of integers drawn from [1..20000]:'''
print(main.__doc__)
print(
'\n'.join(map(
lambda a, b: a.rjust(10) + ' -> ' + str(b),
['Deficient', 'Perfect', 'Abundant'],
deficientPerfectAbundantCountsUpTo(20000)
))
)
# ------------------------GENERIC-------------------------
# primeFactors :: Int -> [Int]
def primeFactors(n):
'''A list of the prime factors of n.
'''
def f(qr):
r = qr[1]
return step(r), 1 + r
def step(x):
return 1 + (x << 2) - ((x >> 1) << 1)
def go(x):
root = floor(sqrt(x))
def p(qr):
q = qr[0]
return root < q or 0 == (x % q)
q = until(p)(f)(
(2 if 0 == x % 2 else 3, 1)
)[0]
return [x] if q > root else [q] + go(x // q)
return go(n)
# properDivisors :: Int -> [Int]
def properDivisors(n):
'''The ordered divisors of n, excluding n itself.
'''
def go(a, x):
return [a * b for a, b in product(
a,
accumulate(chain([1], x), mul)
)]
return sorted(
reduce(go, [
list(g) for _, g in groupby(primeFactors(n))
], [1])
)[:-1] if 1 < n else []
# succ :: Int -> Int
def succ(x):
'''The successor of a value.
For numeric types, (1 +).
'''
return 1 + x
# until :: (a -> Bool) -> (a -> a) -> a -> a
def until(p):
'''The result of repeatedly applying f until p holds.
The initial seed value is x.
'''
def go(f, x):
v = x
while not p(v):
v = f(v)
return v
return lambda f: lambda x: go(f, x)
# MAIN ---
if __name__ == '__main__':
main()
and the main function could be rewritten in terms of an nthArrow abstraction:
# nthArrow :: (a -> b) -> Tuple -> Int -> Tuple
def nthArrow(f):
'''A simple function lifted to one which applies to a
tuple, transforming only its nth value.
'''
def go(v, n):
m = n - 1
return v if n > len(v) else [
x if m != i else f(x) for i, x in enumerate(v)
]
return lambda tpl: lambda n: tuple(go(tpl, n))
as something like:
# deficientPerfectAbundantCountsUpTo :: Int -> (Int, Int, Int)
def deficientPerfectAbundantCountsUpTo(n):
'''Counts of deficient, perfect, and abundant
integers in the range [1..n].
'''
def go(dpa, x):
divisorSum = sum(properDivisors(x))
return nthArrow(succ)(dpa)(
1 if x > divisorSum else (
3 if x < divisorSum else 2
)
)
return reduce(go, range(1, 1 + n), (0, 0, 0))
- Output:
Size of each sub-class of integers drawn from [1..20000]: Deficient -> 15043 Perfect -> 4 Abundant -> 4953
The Simple Way
pn = 0
an = 0
dn = 0
tt = []
num = 20000
for n in range(1, num+1):
for x in range(1,1+n//2):
if n%x == 0:
tt.append(x)
if sum(tt) == n:
pn += 1
elif sum(tt) > n:
an += 1
elif sum(tt) < n:
dn += 1
tt = []
print(str(pn) + " Perfect Numbers")
print(str(an) + " Abundant Numbers")
print(str(dn) + " Deficient Numbers")
- Output:
4 Perfect Numbers 4953 Abundant Numbers 15043 Deficient Numbers
Simple vs Optimized
A few changes:
- Instead of obtaining the remainder of n divided by every number halfway up to n, stop just short of the square root of n and add both factors to the running sum. And then in the case that n is a perfect square, add the square root of n to the sum.
- Don't compute the square root of each n, increment the square root as each n becomes a perfect square.
- Switch the summed list of factors to a single variable.
- Initialize the sum to 1 and start checking factors from 2 and up, which cuts one iteration from each factor checking loop, (a 19,999 iteration savings).
Resulting optimized code is thirty five times faster than the simplified code, and not nearly as complicated as the Counter or Reduce methods (as this optimized method requires no imports, other than time for the performance comparison to the simple way).
from time import time
st = time()
pn, an, dn = 0, 0, 0
tt = []
num = 20000
for n in range(1, num + 1):
for x in range(1, 1 + n // 2):
if n % x == 0: tt.append(x)
if sum(tt) == n: pn += 1
elif sum(tt) > n: an += 1
elif sum(tt) < n: dn += 1
tt = []
et1 = time() - st
print(str(pn) + " Perfect Numbers")
print(str(an) + " Abundant Numbers")
print(str(dn) + " Deficient Numbers")
print(et1, "sec\n")
st = time()
pn, an, dn = 0, 0, 1
sum = 1
r = 1
num = 20000
for n in range(2, num + 1):
d = r * r - n
if d < 0: r += 1
for x in range(2, r):
if n % x == 0: sum += x + n // x
if d == 0: sum += r
if sum == n: pn += 1
elif sum > n: an += 1
elif sum < n: dn += 1
sum = 1
et2 = time() - st
print(str(pn) + " Perfect Numbers")
print(str(an) + " Abundant Numbers")
print(str(dn) + " Deficient Numbers")
print(et2 * 1000, "ms\n")
print (et1 / et2,"times faster")
- Output @ Tio.run using Python 3 (PyPy):
4 Perfect Numbers 4953 Abundant Numbers 15043 Deficient Numbers 1.312887191772461 sec 4 Perfect Numbers 4953 Abundant Numbers 15043 Deficient Numbers 37.12296485900879 ms 35.365903471307924 times faster
Quackery
factors is defined at Factors of an integer.
dpa returns 0 if n is deficient, 1 if n is perfect and 2 if n is abundant.
[ 0 swap witheach + ] is sum ( [ --> n )
[ factors -1 pluck
dip sum
2dup = iff
[ 2drop 1 ] done
< iff 0 else 2 ] is dpa ( n --> n )
0 0 0
20000 times
[ i 1+ dpa
[ table
[ 1+ ]
[ dip 1+ ]
[ rot 1+ unrot ] ] do ]
say "Deficient = " echo cr
say " Perfect = " echo cr
say " Abundant = " echo cr- Output:
Deficient = 15043 Perfect = 4 Abundant = 4953
R
# Abundant, deficient and perfect number classifications. 12/10/16 aev
require(numbers);
propdivcls <- function(n) {
V <- sapply(1:n, Sigma, proper = TRUE);
c1 <- c2 <- c3 <- 0;
for(i in 1:n){
if(V[i]<i){c1 = c1 +1} else if(V[i]==i){c2 = c2 +1} else{c3 = c3 +1}
}
cat(" *** Between 1 and ", n, ":\n");
cat(" * ", c1, "deficient numbers\n");
cat(" * ", c2, "perfect numbers\n");
cat(" * ", c3, "abundant numbers\n");
}
propdivcls(20000);
- Output:
> require(numbers) Loading required package: numbers > propdivcls(20000); *** Between 1 and 20000 : * 15043 deficient numbers * 4 perfect numbers * 4953 abundant numbers >
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)))
- Output:
The range between 1 and 20000 has: 15043 deficient numbers 4 perfect numbers 4953 abundant numbers
Raku
(formerly Perl 6)
sub propdivsum (\x) {
my @l = 1 if x > 1;
(2 .. x.sqrt.floor).map: -> \d {
unless x % d { @l.push: d; my \y = x div d; @l.push: y if y != d }
}
sum @l
}
say bag (1..20000).map: { propdivsum($_) <=> $_ }
- Output:
Bag(Less(15043), More(4953), Same(4))
REXX
version 1
/*REXX program counts the number of abundant/deficient/perfect numbers within a range.*/
parse arg low high . /*obtain optional arguments from the CL*/
high=word(high low 20000,1); low= word(low 1,1) /*obtain the LOW and HIGH values.*/
say center('integers from ' low " to " high, 45, "═") /*display a header.*/
!.= 0 /*define all types of sums to zero. */
do j=low to high; $= sigma(j) /*get sigma for an integer in a range. */
if $<j then !.d= !.d + 1 /*Less? It's a deficient number.*/
else if $>j then !.a= !.a + 1 /*Greater? " " abundant " */
else !.p= !.p + 1 /*Equal? " " perfect " */
end /*j*/ /* [↑] IFs are coded as per likelihood*/
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 all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
sigma: procedure; parse arg x; if x<2 then return 0; odd=x // 2 /* // ◄──remainder.*/
s= 1 /* [↓] only use EVEN or ODD integers.*/
do k=2+odd by 1+odd while k*k<x /*divide by all integers up to √x. */
if x//k==0 then s= s + k + x % k /*add the two divisors to (sigma) sum. */
end /*k*/ /* [↑] % is the REXX integer division*/
if k*k==x then return s + k /*Was X a square? If so, add √ x */
return s /*return (sigma) sum of the divisors. */
- output when using the default input:
═════════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 identical to the 1st version but uses an integer square root calculation to find the
limit of the do loop in the sigma function.
For 20k integers, it's approximately 15% faster. " 100k " " " 20% " " 1m " " " 30% "
/*REXX program counts the number of abundant/deficient/perfect numbers within a range.*/
parse arg low high . /*obtain optional arguments from the CL*/
high=word(high low 20000,1); low=word(low 1, 1) /*obtain the LOW and HIGH values.*/
say center('integers from ' low " to " high, 45, "═") /*display a header.*/
!.= 0 /*define all types of sums to zero. */
do j=low to high; $= sigma(j) /*get sigma for an integer in a range. */
if $<j then !.d= !.d + 1 /*Less? It's a deficient number.*/
else if $>j then !.a= !.a + 1 /*Greater? " " abundant " */
else !.p= !.p + 1 /*Equal? " " perfect " */
end /*j*/ /* [↑] IFs are coded as per likelihood*/
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 all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
sigma: procedure; parse arg x 1 z; if x<5 then return max(0, x-1) /*sets X&Z to arg1.*/
q=1; do while q<=z; q= q * 4; end /* ◄──↓ compute integer sqrt of Z (=R)*/
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
odd= x//2 /* [↓] only use EVEN | ODD ints. ___*/
s= 1; do k=2+odd by 1+odd to r /*divide by all integers up to √ x */
if x//k==0 then s=s + k + x%k /*add the two divisors to (sigma) sum. */
end /*k*/ /* [↑] % is the REXX integer division*/
if r*r==x then return s - k /*Was X a square? If so, subtract √ x */
return s /*return (sigma) sum of the divisors. */
- output is identical to the 1st REXX version.
It is about 2,800% faster than the REXX version 2.
version 2
/* 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
- Output:
In the range 1 - 20000
4953 numbers are abundant
4 numbers are perfect
15043 numbers are deficient
28.392000 seconds elapsed
Version 3
Libraries: How to use
Library: Numbers
Library: Functions
An other solution is
/* REXX */
Call time 'R'
cnt.=0
Do x=1 to 20000
sumpd=Sigma(x)-x
Select
When x<sumpd Then do
cnt.abundant =cnt.abundant +1
end
When x=sumpd Then do
cnt.perfect =cnt.perfect +1
end
Otherwise do
cnt.deficient=cnt.deficient+1
end
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
include Numbers
include Functions
This version uses from the library Numbers the function Sigma.
- Output:
In the range 1 - 20000
4953 numbers are abundant
4 numbers are perfect
15043 numbers are deficient
0.422000 seconds elapsed
A summary of all the timings (ooRexx)
- Version 1 0.453s
- Version 1.5 0.407s
- Version 2 28.392s
- Version 3 0.422s
Ring
The following classifies the first few numbers of each type.
n = 30
perfect(n)
func perfect n
for i = 1 to n
sum = 0
for j = 1 to i - 1
if i % j = 0 sum = sum + j ok
next
see i
if sum = i see " is a perfect number" + nl
but sum < i see " is a deficient number" + nl
else see " is a abundant number" + nl ok
nextTask using modulo/division
a = 0
d = 0
p = 0
for n = 1 to 20000
Pn = sumDivs(n)
if Pn > n a = a + 1 ok
if Pn < n d = d + 1 ok
if Pn = n p = p + 1 ok
next
see "Abundant : " + a + nl
see "Deficient: " + d + nl
see "Perfect : " + p + nl
func sumDivs (n)
if n < 2 return 0
else
sum = 1
sr = sqrt(n)
for d = 2 to sr
if n % d = 0
sum = sum + d
if d != sr sum = sum + n / d ok
ok
next
return sum
ok- Output:
Abundant : 4953 Deficient: 15043 Perfect : 4
Task using a table
maxNumber = 20000
abundantCount = 0
deficientCount = 0
perfectCount = 0
pds = list( maxNumber )
pds[ 1 ] = 0
for i = 2 to maxNumber pds[ i ] = 1 next
for i = 2 to maxNumber
for j = i + i to maxNumber step i pds[ j ] = pds[ j ] + i next
next
for n = 1 to maxNumber
pdSum = pds[ n ]
if pdSum < n
deficientCount = deficientCount + 1
but pdSum = n
perfectCount = perfectCount + 1
else # pdSum > n
abundantCount = abundantCount + 1
ok
next
see "Abundant : " + abundantCount + nl
see "Deficient: " + deficientCount + nl
see "Perfect : " + perfectCount + nl- Output:
Abundant : 4953 Deficient: 15043 Perfect : 4
RPL
≪ [1 0 0]
2 20000 FOR n
n DIVIS REVLIST TAIL @ get the list of divisors of n excluding n
0. + @ avoid ∑LIST and SIGN errors when n is prime
∑LIST n - SIGN 2 + @ turn P(n)-n into 1, 2 or 3
DUP2 GET 1 + PUT @ increment appropriate array element
NEXT
≫ 'TASK' STO
- Output:
1: [15042 4 4953]
Ruby
With proper_divisors#Ruby in place:
res = (1 .. 20_000).map{|n| n.proper_divisors.sum <=> n }.tally
puts "Deficient: #{res[-1]} Perfect: #{res[0]} Abundant: #{res[1]}"
- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
Rust
With proper_divisors#Rust in place:
fn main() {
// deficient starts at 1 because 1 is deficient but proper_divisors returns
// and empty Vec
let (mut abundant, mut deficient, mut perfect) = (0u32, 1u32, 0u32);
for i in 1..20_001 {
if let Some(divisors) = i.proper_divisors() {
let sum: u64 = divisors.iter().sum();
if sum < i {
deficient += 1
} else if sum > i {
abundant += 1
} else {
perfect += 1
}
}
}
println!("deficient:\t{:5}\nperfect:\t{:5}\nabundant:\t{:5}",
deficient, perfect, abundant);
}
- Output:
deficient: 15043 perfect: 4 abundant: 4953
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(",") + ")")
- Output:
Deficient: 15043 Abundant: 4953 Perfect: 4 (6,28,496,8128)
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))))))
Seed7
$ include "seed7_05.s7i";
const func integer: sumProperDivisors (in integer: number) is func
result
var integer: sum is 0;
local
var integer: num is 0;
begin
if number >= 2 then
for num range 1 to number div 2 do
if number rem num = 0 then
sum +:= num;
end if;
end for;
end if;
end func;
const proc: main is func
local
var integer: sum is 0;
var integer: deficient is 0;
var integer: perfect is 0;
var integer: abundant is 0;
var integer: number is 0;
begin
for number range 1 to 20000 do
sum := sumProperDivisors(number);
if sum < number then
incr(deficient);
elsif sum = number then
incr(perfect);
else
incr(abundant);
end if;
end for;
writeln("Deficient: " <& deficient);
writeln("Perfect: " <& perfect);
writeln("Abundant: " <& abundant);
end func;- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
SETL
program classifications;
P := properdivisorsums(20000);
print("Deficient:", #[n : n in [1..#P] | P(n) < n]);
print(" Perfect:", #[n : n in [1..#P] | P(n) = n]);
print(" Abundant:", #[n : n in [1..#P] | P(n) > n]);
proc properdivisorsums(n);
p := [0];
loop for i in [1..n] do
loop for j in [i*2, i*3..n] do
p(j) +:= i;
end loop;
end loop;
return p;
end proc;
end program;- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
Sidef
func propdivsum(n) { n.sigma - n }
var h = Hash()
{|i| ++(h{propdivsum(i) <=> i} := 0) } << 1..20000
say "Perfect: #{h{0}} Deficient: #{h{-1}} Abundant: #{h{1}}"
- Output:
Perfect: 4 Deficient: 15043 Abundant: 4953
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.")
- Output:
There are 15043 deficient, 4 perfect and 4953 abundant integers from 1 to 20000.
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"
}
- Output:
Classifying the integers in [1, 20_000]: perfect: 4 deficient: 4953 abundant: 15043
TypeScript
function integer_classification(){
var sum:number=0, i:number,j:number;
var try:number=0;
var number_list:number[]={1,0,0};
for(i=2;i<=20000;i++){
try=i/2;
sum=1;
for(j=2;j<try;j++){
if (i%j)
continue;
try=i/j;
sum+=j;
if (j!=try)
sum+=try;
}
if (sum<i){
number_list[d]++;
continue;
}
else if (sum>i){
number_list[a]++;
continue;
}
number_list[p]++;
}
console.log('There are '+number_list[d]+ ' deficient , ' + 'number_list[p] + ' perfect and '+ number_list[a]+ ' abundant numbers
between 1 and 20000');
}
uBasic/4tH
This is about the limit of what is feasible with uBasic/4tH performance wise, since a full run takes over 5 minutes.
P = 0 : D = 0 : A = 0
For n= 1 to 20000
s = FUNC(_SumDivisors(n))-n
If s = n Then P = P + 1
If s < n Then D = D + 1
If s > n Then A = A + 1
Next
Print "Perfect: ";P;" Deficient: ";D;" Abundant: ";A
End
' Return the least power of a@ that does not divide b@
_LeastPower Param(2)
Local(1)
c@ = a@
Do While (b@ % c@) = 0
c@ = c@ * a@
Loop
Return (c@)
' Return the sum of the proper divisors of a@
_SumDivisors Param(1)
Local(4)
b@ = a@
c@ = 1
' Handle two specially
d@ = FUNC(_LeastPower (2,b@))
c@ = c@ * (d@ - 1)
b@ = b@ / (d@ / 2)
' Handle odd factors
For e@ = 3 Step 2 While (e@*e@) < (b@+1)
d@ = FUNC(_LeastPower (e@,b@))
c@ = c@ * ((d@ - 1) / (e@ - 1))
b@ = b@ / (d@ / e@)
Loop
' At this point, t must be one or prime
If (b@ > 1) c@ = c@ * (b@+1)
Return (c@)
- Output:
Perfect: 4 Deficient: 15043 Abundant: 4953 0 OK, 0:210
Vala
enum Classification {
DEFICIENT,
PERFECT,
ABUNDANT
}
void main() {
var i = 0; var j = 0;
var sum = 0; var try_max = 0;
int[] count_list = {1, 0, 0};
for (i = 2; i <= 20000; i++) {
try_max = i / 2;
sum = 1;
for (j = 2; j < try_max; j++) {
if (i % j != 0)
continue;
try_max = i / j;
sum += j;
if (j != try_max)
sum += try_max;
}
if (sum < i) {
count_list[Classification.DEFICIENT]++;
continue;
}
if (sum > i) {
count_list[Classification.ABUNDANT]++;
continue;
}
count_list[Classification.PERFECT]++;
}
print(@"There are $(count_list[Classification.DEFICIENT]) deficient,");
print(@" $(count_list[Classification.PERFECT]) perfect,");
print(@" $(count_list[Classification.ABUNDANT]) abundant numbers between 1 and 20000.\n");
}
- Output:
There are 15043 deficient, 4 perfect, 4953 abundant numbers between 1 and 20000.
VBA
Option Explicit
Public Sub Nb_Classifications()
Dim A As New Collection, D As New Collection, P As New Collection
Dim n As Long, l As Long, s As String, t As Single
t = Timer
'Start
For n = 1 To 20000
l = SumPropers(n): s = CStr(n)
Select Case n
Case Is > l: D.Add s, s
Case Is < l: A.Add s, s
Case l: P.Add s, s
End Select
Next
'End. Return :
Debug.Print "Execution Time : " & Timer - t & " seconds."
Debug.Print "-------------------------------------------"
Debug.Print "Deficient := " & D.Count
Debug.Print "Perfect := " & P.Count
Debug.Print "Abundant := " & A.Count
End Sub
Private Function SumPropers(n As Long) As Long
'returns the sum of the proper divisors of n
Dim j As Long
For j = 1 To n \ 2
If n Mod j = 0 Then SumPropers = j + SumPropers
Next
End Function
- Output:
Execution Time : 2,6875 seconds. ------------------------------------------- Deficient := 15043 Perfect := 4 Abundant := 4953
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
- Output:
Deficient = 15043 Perfect = 4 Abundant = 4953
Visual Basic .NET
Module Module1
Function SumProperDivisors(number As Integer) As Integer
If number < 2 Then Return 0
Dim sum As Integer = 0
For i As Integer = 1 To number \ 2
If number Mod i = 0 Then sum += i
Next
Return sum
End Function
Sub Main()
Dim sum, deficient, perfect, abundant As Integer
For n As Integer = 1 To 20000
sum = SumProperDivisors(n)
If sum < n Then
deficient += 1
ElseIf sum = n Then
perfect += 1
Else
abundant += 1
End If
Next
Console.WriteLine("The classification of the numbers from 1 to 20,000 is as follows : ")
Console.WriteLine()
Console.WriteLine("Deficient = {0}", deficient)
Console.WriteLine("Perfect = {0}", perfect)
Console.WriteLine("Abundant = {0}", abundant)
End Sub
End Module
- Output:
The classification of the numbers from 1 to 20,000 is as follows : Deficient = 15043 Perfect = 4 Abundant = 4953
V (Vlang)
fn p_fac_sum(i int) int {
mut sum := 0
for p := 1; p <= i/2; p++ {
if i%p == 0 {
sum += p
}
}
return sum
}
fn main() {
mut d := 0
mut a := 0
mut p := 0
for i := 1; i <= 20000; i++ {
j := p_fac_sum(i)
if j < i {
d++
} else if j == i {
p++
} else {
a++
}
}
println("There are $d deficient numbers between 1 and 20000")
println("There are $a abundant numbers between 1 and 20000")
println("There are $p perfect numbers between 1 and 20000")
}- Output:
There are 15043 deficient numbers between 1 and 20000 There are 4953 abundant numbers between 1 and 20000 There are 4 perfect numbers between 1 and 20000
VTL-2
10 M=20000
20 I=1
30 :I)=0
40 I=I+1
50 #=M>I*30
60 I=1
70 J=I*2
80 :J)=:J)+I
90 J=J+I
100 #=M>J*80
110 I=I+1
120 #=M/2>I*70
130 D=0
140 P=0
150 A=0
160 I=1
170 #=:I)<I*230
180 #=:I)=I*210
190 A=A+1
200 #=240
210 P=P+1
220 #=240
230 D=D+1
240 I=I+1
250 #=M>I*170
260 ?=D
270 ?=" deficient"
280 ?=P
290 ?=" perfect"
300 ?=A
310 ?=" abundant"- Output:
15043 deficient 4 perfect 4953 abundant
Wren
Using modulo/division
import "./math" for Int, Nums
var d = 0
var a = 0
var p = 0
for (i in 1..20000) {
var j = Nums.sum(Int.properDivisors(i))
if (j < i) {
d = d + 1
} else if (j == i) {
p = p + 1
} else {
a = a + 1
}
}
System.print("There are %(d) deficient numbers between 1 and 20000")
System.print("There are %(a) abundant numbers between 1 and 20000")
System.print("There are %(p) perfect numbers between 1 and 20000")- Output:
There are 15043 deficient numbers between 1 and 20000 There are 4953 abundant numbers between 1 and 20000 There are 4 perfect numbers between 1 and 20000
Using a table
Alternative version, computing a table of divisor sums.
var maxNumber = 20000
var abundantCount = 0
var deficientCount = 0
var perfectCount = 0
var pds = []
pds.add(0) // element 0
pds.add(0) // element 1
for (i in 2..maxNumber) {
pds.add(1)
}
for (i in 2..maxNumber) {
var j = i + i
while (j <= maxNumber) {
pds[j] = pds[j] + i
j = j + i
}
}
for (n in 1..maxNumber) {
var pdSum = pds[n]
if (pdSum < n) {
deficientCount = deficientCount + 1
} else if (pdSum == n) {
perfectCount = perfectCount + 1
} else { // pdSum > n
abundantCount = abundantCount + 1
}
}
System.print("Abundant : %(abundantCount)")
System.print("Deficient: %(deficientCount)")
System.print("Perfect : %(perfectCount)")- Output:
Abundant : 4953 Deficient: 15043 Perfect : 4
XPL0
int CntD, CntP, CntA, Num, Div, Sum;
[CntD:= 0; CntP:= 0; CntA:= 0;
for Num:= 1 to 20000 do
[Sum:= if Num = 1 then 0 else 1;
for Div:= 2 to Num-1 do
if rem(Num/Div) = 0 then
Sum:= Sum + Div;
case of
Sum < Num: CntD:= CntD+1;
Sum > Num: CntA:= CntA+1
other CntP:= CntP+1;
];
Text(0, "Deficient: "); IntOut(0, CntD); CrLf(0);
Text(0, "Perfect: "); IntOut(0, CntP); CrLf(0);
Text(0, "Abundant: "); IntOut(0, CntA); CrLf(0);
]- Output:
Deficient: 15043 Perfect: 4 Abundant: 4953
Yabasic
clear screen
Deficient = 0
Perfect = 0
Abundant = 0
For j=1 to 20000
sump = sumprop(j)
If sump < j Then
Deficient = Deficient + 1
ElseIf sump = j Then
Perfect = Perfect + 1
ElseIf sump > j Then
Abundant = Abundant + 1
End If
Next j
PRINT "Number deficient: ",Deficient
PRINT "Number perfect: ",Perfect
PRINT "Number abundant: ",Abundant
sub sumprop(num)
local i, sum, root
if num>1 then
sum=1
root=sqrt(num)
for i=2 to root
if mod(num,i) = 0 then
sum=sum+i
if (i*i)<>num sum=sum+num/i
end if
next i
end if
return sum
end subzkl
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));- Output:
Deficient=15043, perfect=4, abundant=4953
ZX Spectrum Basic
Solution 1:
10 LET nd=1: LET np=0: LET na=0
20 FOR i=2 TO 20000
30 LET sum=1
40 LET max=i/2
50 LET n=2: LET l=max-1
60 IF n>l THEN GO TO 90
70 IF i/n=INT (i/n) THEN LET sum=sum+n: LET max=i/n: IF max<>n THEN LET sum=sum+max: LET l=max-1
80 LET n=n+1: GO TO 60
90 IF sum<i THEN LET nd=nd+1: GO TO 120
100 IF sum=i THEN LET np=np+1: GO TO 120
110 LET na=na+1
120 NEXT i
130 PRINT "Number deficient: ";nd
140 PRINT "Number perfect: ";np
150 PRINT "Number abundant: ";naSolution 2 (more efficient):
10 LET abundant=0: LET deficient=0: LET perfect=0
20 FOR j=1 TO 20000
30 GO SUB 120
40 IF sump<j THEN LET deficient=deficient+1: GO TO 70
50 IF sump=j THEN LET perfect=perfect+1: GO TO 70
60 LET abundant=abundant+1
70 NEXT j
80 PRINT "Perfect: ";perfect
90 PRINT "Abundant: ";abundant
100 PRINT "Deficient: ";deficient
110 STOP
120 IF j=1 THEN LET sump=0: RETURN
130 LET sum=1
140 LET root=SQR j
150 FOR i=2 TO root
160 IF j/i=INT (j/i) THEN LET sum=sum+i: IF (i*i)<>j THEN LET sum=sum+j/i
170 NEXT i
180 LET sump=sum
190 RETURNCategories:
- Programming Tasks
- Prime Numbers
- 11l
- 360 Assembly
- 8086 Assembly
- AArch64 Assembly
- ABC
- Action!
- Ada
- ALGOL 68
- ALGOL W
- AppleScript
- ARM Assembly
- Arturo
- AutoHotkey
- AWK
- Batch File
- BASIC
- BASIC256
- Chipmunk Basic
- Gambas
- GW-BASIC
- QBasic
- Run BASIC
- True BASIC
- BCPL
- Befunge
- Bracmat
- C
- C sharp
- C++
- Ceylon
- Clojure
- CLU
- Common Lisp
- Cowgol
- D
- Delphi
- Draco
- Dyalect
- EasyLang
- EchoLisp
- Ela
- Elena
- Elixir
- Erlang
- F Sharp
- Factor
- Forth
- Fortran
- FreeBASIC
- Frink
- FutureBasic
- GFA Basic
- Go
- Groovy
- Haskell
- J
- Java
- JavaScript
- Jq
- Jsish
- Julia
- K
- Kotlin
- Liberty BASIC
- Lua
- MAD
- Maple
- Mathematica
- Wolfram Language
- MatLab
- Maxima
- MiniScript
- ML
- MLite
- Modula-2
- NewLisp
- Nim
- Oforth
- PARI/GP
- Pascal
- Free Pascal
- PrimTrial
- Perl
- Ntheory
- Phix
- Picat
- PicoLisp
- PL/I
- PL/M
- PowerShell
- Processing
- Prolog
- PureBasic
- Python
- Quackery
- R
- Racket
- Raku
- REXX
- Ring
- RPL
- Ruby
- Rust
- Scala
- Scheme
- Seed7
- SETL
- Sidef
- Swift
- Tcl
- TypeScript
- UBasic/4tH
- Vala
- VBA
- VBScript
- Visual Basic .NET
- V (Vlang)
- VTL-2
- Wren
- Wren-math
- XPL0
- Yabasic
- Zkl
- ZX Spectrum Basic
- Pages with too many expensive parser function calls