Arithmetic numbers
You are encouraged to solve this task according to the task description, using any language you may know.
- Definition
A positive integer n is an arithmetic number if the average of its positive divisors is also an integer.
Clearly all odd primes p must be arithmetic numbers because their only divisors are 1 and p whose sum is even and hence their average must be an integer. However, the prime number 2 is not an arithmetic number because the average of its divisors is 1.5.
- Example
30 is an arithmetic number because its 7 divisors are: [1, 2, 3, 5, 6, 10, 15, 30], their sum is 72 and average 9 which is an integer.
- Task
Calculate and show here:
1. The first 100 arithmetic numbers.
2. The xth arithmetic number where x = 1,000 and x = 10,000.
3. How many of the first x arithmetic numbers are composite.
Note that, technically, the arithmetic number 1 is neither prime nor composite.
- Stretch
Carry out the same exercise in 2. and 3. above for x = 100,000 and x = 1,000,000.
- References
- Wikipedia: Arithmetic number
- OEIS:A003601 - Numbers n such that the average of the divisors of n is an integer
11l
F factors(Int n)
V f = Set([1, n])
V i = 2
L
V j = n I/ i
I j < i
L.break
I i * j == n
f.add(i)
f.add(j)
i++
R f
V arithmetic_count = 0
V composite_count = 0
V n = 1
L arithmetic_count <= 1000000
V f = factors(n)
I sum(f) % f.len == 0
arithmetic_count++
I f.len > 2
composite_count++
I arithmetic_count <= 100
print(f:‘{n:3} ’, end' ‘’)
I arithmetic_count % 10 == 0
print()
I arithmetic_count C (1000, 10000, 100000, 1000000)
print("\n"arithmetic_count‘th arithmetic number is ’n)
print(‘Number of composite arithmetic numbers <= ’n‘: ’composite_count)
n++- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 100000th arithmetic number is 125587 Number of composite arithmetic numbers <= 125587: 88219 1000000th arithmetic number is 1228663 Number of composite arithmetic numbers <= 1228663: 905043
Ada
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
procedure divisor_count_and_sum
(n : Positive; divisor_count : out Natural; divisor_sum : out Natural)
is
I : Positive := 1;
J : Natural;
begin
divisor_count := 0;
divisor_sum := 0;
loop
J := n / I;
exit when J < I;
if I * J = n then
divisor_sum := divisor_sum + I;
divisor_count := divisor_count + 1;
if I /= J then
divisor_sum := divisor_sum + J;
divisor_count := divisor_count + 1;
end if;
end if;
I := I + 1;
end loop;
end divisor_count_and_sum;
arithmetic_count : Natural := 0;
composite_count : Natural := 0;
div_count : Natural;
div_sum : Natural;
mean : Natural;
n : Positive := 1;
begin
while arithmetic_count <= 1_000_000 loop
divisor_count_and_sum (n, div_count, div_sum);
mean := div_sum / div_count;
if mean * div_count = div_sum then
arithmetic_count := arithmetic_count + 1;
if div_count > 2 then
composite_count := composite_count + 1;
end if;
if arithmetic_count <= 100 then
Put (Item => n, Width => 4);
if arithmetic_count mod 10 = 0 then
New_Line;
end if;
end if;
if arithmetic_count = 1_000 or else arithmetic_count = 10_000
or else arithmetic_count = 100_000
or else arithmetic_count = 1_000_000
then
New_Line;
Put (Item => arithmetic_count, Width => 1);
Put_Line ("th arithmetic number is" & n'Image);
Put_Line
("Number of composite arithmetic numbers <=" & n'Image & ":" &
composite_count'Image);
end if;
end if;
n := n + 1;
end loop;
end Main;
- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 100000th arithmetic number is 125587 Number of composite arithmetic numbers <= 125587: 88219 1000000th arithmetic number is 1228663 Number of composite arithmetic numbers <= 1228663: 905043
ALGOL 68
BEGIN # find arithmetic numbers - numbers whose average divisor is an integer #
# i.e. sum of divisors MOD count of divisors = 0 #
INT max number = 500 000; # maximum number we will consider #
[ 1 : max number ]INT d sum;
[ 1 : max number ]INT d count;
# all positive integers are divisible by 1 and so have at least 1 divisor #
FOR i TO max number DO d sum[ i ] := d count[ i ] := 1 OD;
# construct the divisor sums and counts #
FOR i FROM 2 TO max number DO
FOR j FROM i BY i TO max number DO
d count[ j ] +:= 1;
d sum[ j ] +:= i
OD
OD;
# count arithmetic numbers, and show the first 100, the 1 000th, 10 000th #
# and the 100 000th and show how many are composite #
INT max arithmetic = 100 000;
INT a count := 0;
INT c count := 0;
FOR i TO max number WHILE a count < max arithmetic DO
IF d sum[ i ] MOD d count[ i ] = 0 THEN
# have an arithmetic number #
IF d count[ i ] > 2 THEN
# the number is composite #
c count +:= 1
FI;
a count +:= 1;
IF a count <= 100 THEN
print( ( " ", whole( i, -3 ) ) );
IF a count MOD 10 = 0 THEN print( ( newline ) ) FI
ELIF a count = 1 000
OR a count = 10 000
OR a count = 100 000
THEN
print( ( newline ) );
print( ( "The ", whole( a count, 0 )
, "th arithmetic number is: ", whole( i, 0 )
, newline
)
);
print( ( " There are ", whole( c count, 0 )
, " composite arithmetic numbers up to ", whole( i, 0 )
, newline
)
)
FI
FI
OD
END- Output:
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
The 1000th arithmetic number is: 1361
There are 782 composite arithmetic numbers up to 1361
The 10000th arithmetic number is: 12953
There are 8458 composite arithmetic numbers up to 12953
The 100000th arithmetic number is: 125587
There are 88219 composite arithmetic numbers up to 125587
APL
task←{
facs ← ⍸0=⍳|⊢
aritm ← (0=≢|+/)∘facs
comp ← 2<(≢facs)
aritms ← ⍸aritm¨⍳15000
⎕←'First 100 arithmetic numbers:'
⎕←10 10⍴aritms
{
⎕←''
⎕←'The ',(⍕⍵),'th arithmetic number: ',(⍕aritms[⍵])
ncomps ← +/comp¨⍵↑aritms
⎕←'Of the first ',(⍕⍵),' arithmetic numbers, ',(⍕ncomps),' are composite.'
}¨10*3 4
}
- Output:
First 100 arithmetic numbers: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The 1000th arithmetic number: 1361 Of the first 1000 arithmetic numbers, 782 are composite. The 10000th arithmetic number: 12953 Of the first 10000 arithmetic numbers, 8458 are composite.
AppleScript
on isArithmetic(n)
if (n < 4) then
if (n < 0) then return {arithmetic:false, composite:missing value}
return {arithmetic:(n mod 2 = 1), composite:false}
end if
set factorSum to 1 + n
set factorCount to 2
set sqrt to n ^ 0.5
set limit to sqrt div 1
if (limit = sqrt) then
set factorSum to factorSum + limit
set factorCount to 3
set limit to limit - 1
end if
repeat with i from 2 to limit
if (n mod i = 0) then
set factorSum to factorSum + i + n div i
set factorCount to factorCount + 2
end if
end repeat
return {arithmetic:(factorSum mod factorCount = 0), composite:(factorCount > 2)}
end isArithmetic
on task()
set output to {linefeed & "The first 100 arithmetic numbers are:"}
set {n, hitCount, compositeCount, pad} to {0, 0, 0, " "}
repeat 10 times
set row to {}
set targetCount to hitCount + 10
repeat until (hitCount = targetCount)
set n to n + 1
tell isArithmetic(n) to if (its arithmetic) then
set hitCount to hitCount + 1
if (its composite) then set compositeCount to compositeCount + 1
set row's end to text -4 thru -1 of (pad & n)
end if
end repeat
set output's end to join(row, "")
end repeat
repeat with targetCount in {1000, 10000, 100000, 1000000}
repeat while (hitCount < targetCount)
set n to n + 1
tell isArithmetic(n) to if (its arithmetic) then
set hitCount to hitCount + 1
if (its composite) then set compositeCount to compositeCount + 1
end if
end repeat
set output's end to (linefeed & "The " & targetCount & "th arithmetic number is " & n) & ¬
(linefeed & "(" & compositeCount & " composite numbers up to here)")
end repeat
return join(output, linefeed)
end task
on join(lst, delim)
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to delim
set txt to lst as text
set AppleScript's text item delimiters to astid
return txt
end join
task()
- Output:
"
The first 100 arithmetic numbers are:
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
The 1000th arithmetic number is 1361
(782 composite numbers up to here)
The 10000th arithmetic number is 12953
(8458 composite numbers up to here)
The 100000th arithmetic number is 125587
(88219 composite numbers up to here)
The 1000000th arithmetic number is 1228663
(905043 composite numbers up to here)"
ARM Assembly
/* ARM assembly Raspberry PI */
/* program arithnumber.s */
/************************************/
/* Constantes */
/************************************/
/* for this file see task include a file in language ARM assembly*/
.include "../constantes.inc"
.equ NBDIVISORS, 2000
//.include "../../ficmacros32.inc" @ use for developper debugging
/*******************************************/
/* Initialized data */
/*******************************************/
.data
szMessStartPgm: .asciz "Program 32 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"
szMessResultFact: .asciz "@ "
szCarriageReturn: .asciz "\n"
szMessEntete: .asciz "The first 150 arithmetic numbers are:\n"
szMessResult: .asciz " @ "
szMessEntete1: .asciz "The 1000 aritmetic number :"
szMessEntete2: .asciz "The 10000 aritmetic number :"
szMessEntete3: .asciz "The 100000 aritmetic number :"
szMessEntete4: .asciz "The 1000000 aritmetic number :"
szMessComposite: .asciz "Composite number : "
/*******************************************/
/* 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
ldr r0,iAdrszMessEntete @ display result message
bl affichageMess
mov r2,#1 @ start number
mov r3,#0 @ counter result
mov r6,#0 @ counter result by line
1:
mov r0,r2 @ number
ldr r1,iAdrtbZoneDecom
bl testNbArith @ test
cmp r0,#1 @ ok ?
bne 3f
add r3,#1
mov r0,r2 @ number
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
ldr r0,iAdrszMessResult
ldr r1,iAdrsZoneConv
bl strInsertAtCharInc @ and put in message
bl affichageMess
add r6,r6,#1
cmp r6,#6
blt 3f
mov r6,#0
ldr r0,iAdrszCarriageReturn
bl affichageMess
3:
add r2,r2,#1
cmp r3,#100
blt 1b
ldr r0,iAdrszCarriageReturn
bl affichageMess
/* count arithmetic number */
mov r2,#1
mov r3,#0
ldr r5,iN10P4
ldr r6,iN10P5
ldr r7,iN10P6
mov r8,#0 @ counter composite
4:
mov r0,r2 @ number
ldr r1,iAdrtbZoneDecom
bl testNbArith
cmp r0,#1
bne 6f
cmp r1,#1
bne 5f
add r8,r8,#1
5:
add r3,#1
6:
cmp r3,#1000
beq 7f
cmp r3,r5 @ 10000
beq 8f
cmp r3,r6 @ 100000
beq 9f
cmp r3,r7 @ 1000000
beq 10f
b 11f
7:
ldr r0,iAdrszMessEntete1
bl affichageMess
mov r0,r2
mov r4,r1 @ save sum
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszMessComposite
bl affichageMess
mov r0,r8
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
b 11f
8:
ldr r0,iAdrszMessEntete2
bl affichageMess
mov r0,r2
mov r4,r1 @ save sum
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszMessComposite
bl affichageMess
mov r0,r8
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
b 11f
9:
ldr r0,iAdrszMessEntete3
bl affichageMess
mov r0,r2
mov r4,r1 @ save sum
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszMessComposite
bl affichageMess
mov r0,r8
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
b 11f
10:
ldr r0,iAdrszMessEntete4
bl affichageMess
mov r0,r2
mov r4,r1 @ save sum
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszMessComposite
bl affichageMess
mov r0,r8
ldr r1,iAdrsZoneConv
bl conversion10 @ convert ascii string
mov r0,r1
bl affichageMess
ldr r0,iAdrszCarriageReturn
bl affichageMess
b 12f
11:
add r2,r2,#1
b 4b
12:
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
iAdrszMessEntete: .int szMessEntete
iAdrszMessEntete1: .int szMessEntete1
iAdrszMessEntete2: .int szMessEntete2
iAdrszMessEntete3: .int szMessEntete3
iAdrszMessEntete4: .int szMessEntete4
iAdrszMessResult: .int szMessResult
iAdrszMessComposite: .int szMessComposite
iAdrsZoneConv: .int sZoneConv
iN10P4: .int 10000
iN10P5: .int 100000
iN10P6: .int 1000000
/******************************************************************/
/* test if number is aritmetic number */
/******************************************************************/
/* r0 contains number */
/* r1 contains address of divisors area */
/* r0 return 1 if ok else return 0 */
/* r1 return 1 if composite */
testNbArith:
push {r2-r11,lr} @ save registers
cmp r0,#1 @ 1 is arithmetique
moveq r0,#1
moveq r1,#0
beq 100f
cmp r0,#2 @ 2 is not aritmetic
moveq r0,#0
moveq r1,#0
beq 100f
mov r5,r1
mov r8,r0 @ save number
bl isPrime @ prime ?
cmp r0,#1
moveq r0,#1 @ yes is prime and arithmetic
moveq r1,#0 @ but not composite
beq 100f @ end
mov r1,#1
str r1,[r5] @ first factor
mov r11,#1 @ divisors sum
mov r4,#1 @ indice divisors table
mov r1,#2 @ first divisor
mov r6,#0 @ previous divisor
mov r7,#0 @ number of same divisors
1:
mov r0,r8 @ dividende
bl division @ r1 divisor r2 quotient r3 remainder
cmp r3,#0
bne 6f @ if remainder <> zero -> no divisor
mov r8,r2 @ else quotient -> new dividende
cmp r1,r6 @ same divisor ?
beq 3f @ yes
mov r7,r4 @ number factors in table
mov r9,#0 @ indice
2: @ for each new prime factor compute all factors of number
ldr r10,[r5,r9,lsl #2 ] @ load one factor
mul r10,r1,r10 @ multiply
str r10,[r5,r7,lsl #2] @ and store in the table
add r11,r10 @ sum of factors
add r7,r7,#1 @ and increment counter
add r9,r9,#1 @ increment index
cmp r9,r4 @ end array factors ?
blt 2b
mov r4,r7
mov r6,r1 @ new divisor
b 7f
3: @ same divisor
sub r9,r4,#1
mov r7,r4
4: @ for each prime factor compute all factors of number
ldr r10,[r5,r9,lsl #2 ] @ this prime factor is in factor array ?
cmp r10,r1
subne r9,#1
bne 4b
sub r9,r4,r9
5:
ldr r10,[r5,r9,lsl #2 ]
mul r10,r1,r10
str r10,[r5,r7,lsl #2] @ and store in the table
add r11,r10
add r7,r7,#1 @ and increment counter
add r9,r9,#1
cmp r9,r4
blt 5b
mov r4,r7
b 7f @ and loop
/* not divisor -> increment next divisor */
6:
cmp r1,#2 @ if divisor = 2 -> add 1
addeq r1,#1
addne r1,#2 @ else add 2
b 1b @ and loop
/* divisor -> test if new dividende is prime */
7:
mov r3,r1 @ save divisor
cmp r8,#1 @ dividende = 1 ? -> end
beq 13f
mov r0,r8 @ new dividende is prime ?
mov r1,#0
bl isPrime @ the new dividende is prime ?
cmp r0,#1
bne 12f @ the new dividende is not prime
cmp r8,r6 @ else new dividende prime is same divisor ?
beq 9f @ yes
@ no -> compute all factors
mov r7,r4 @ number factors in table
mov r9,#0 @ indice
8:
ldr r10,[r5,r9,lsl #2 ] @ load one factor
mul r10,r8,r10 @ multiply
str r10,[r5,r7,lsl #2] @ and store in the table
add r11,r10
add r7,r7,#1 @ and increment counter
add r9,r9,#1
cmp r9,r4
blt 8b
mov r4,r7
mov r7,#0
b 13f
9:
sub r9,r4,#1
mov r7,r4
10:
ldr r10,[r5,r9,lsl #2 ]
cmp r10,r8
subne r9,#1
bne 10b
sub r9,r4,r9
11:
ldr r10,[r5,r9,lsl #2 ]
mul r10,r8,r10
str r10,[r5,r7,lsl #2] @ and store in the table
add r11,r10
add r7,r7,#1 @ and increment counter
add r9,r9,#1
cmp r9,r4
blt 11b
mov r4,r7
b 13f
12:
mov r1,r3 @ current divisor = new divisor
cmp r1,r8 @ current divisor > new dividende ?
ble 1b @ no -> loop
/* end decomposition */
13:
mov r1,r4 @ control if arithmetic
mov r0,r11 @ compute average
bl division
mov r1,#1
cmp r3,#0 @ no remainder
moveq r0,#1 @ average is integer
beq 100f @ no -> end
mov r0,#0
mov r1,#0
100:
pop {r2-r11,pc} @ restaur registers
//iAdrszMessNbPrem: .int szMessNbPrem
/******************************************************************/
/* test if number is prime trial test */
/******************************************************************/
/* r0 contains the number */
/* r0 return 1 if prime else return 0 */
isPrime:
push {r4,lr} @ save registers
cmp r0,#1 @ <= 1 ?
movls r0,#0 @ not prime
bls 100f
cmp r0,#3 @ 2 and 3 prime
movls r0,#1
bls 100f
tst r0,#1 @ even ?
moveq r0,#0 @ not prime
beq 100f
mov r4,r0 @ save number
mov r1,#3 @ first divisor
1:
mov r0,r4 @ number
bl division
add r1,r1,#2 @ increment divisor
cmp r3,#0 @ remainder = zero ?
moveq r0,#0 @ not prime
beq 100f
cmp r1,r2 @ divisors<=quotient ?
ble 1b @ loop
mov r0,#1 @ return prime
100:
pop {r4,pc} @ restaur registers
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
/* for this file see task include a file in language ARM assembly*/
.include "../affichage.inc"- Output:
Program 32 bits start. The first 150 arithmetic numbers are: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The 1000 aritmetic number :1361 Composite number : 782 The 10000 aritmetic number :12953 Composite number : 8458 The 100000 aritmetic number :125587 Composite number : 88219 The 1000000 aritmetic number :1228663 Composite number : 905043 Program normal end. real 0m44.650s user 0m18.050s sys 0m0.000s
Arturo
arithmetic?: function [n][
avg: average factors n
zero? abs avg - to :integer avg
]
composite?: function [n]->
not? prime? n
arithmeticsUpTo: function [lim][
items: select.first: lim 1..∞ => arithmetic?
print [(to :string lim)++"th" "arithmetic number:" last items]
print ["Number of composite arithmetic numbers <= " last items ":" dec enumerate items => composite?]
print ""
]
first100: select.first:100 1..∞ => arithmetic?
loop split.every: 10 first100 'x ->
print map x 's -> pad to :string s 4
print ""
arithmeticsUpTo 1000
arithmeticsUpTo 10000
; stretch goal
arithmeticsUpTo 100000
arithmeticsUpTo 1000000
- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number: 1361 Number of composite arithmetic numbers <= 1361 : 782 10000th arithmetic number: 12953 Number of composite arithmetic numbers <= 12953 : 8458 100000th arithmetic number: 125587 Number of composite arithmetic numbers <= 125587 : 88219 1000000th arithmetic number: 1228663 Number of composite arithmetic numbers <= 1228663 : 905043
AutoHotkey
ArithmeticNumbers(n, mx:=0){
c := composite := 0
loop
{
num := A_Index, sum := 0
x := Factors(num)
for i, v in x
sum += v
av := sum / x.Count()
if (av = Floor(av))
{
res .= c++ <= 100 ? SubStr(" " num, -2) (mod(c, 25) ? " " : "`n") : ""
composite += x.Count() > 2 ? 1 : 0
}
if (c = n) || (c = mx)
break
}
return [n?num:res, composite]
}
Factors(n){
Loop, % floor(sqrt(n))
v := A_Index = 1 ? 1 "," n : mod(n,A_Index) ? v : v "," A_Index "," n//A_Index
Sort, v, N U D,
Return StrSplit(v, ",")
}
Examples:
MsgBox % Result := "The first 100 arithmetic numbers:`n"
. ArithmeticNumbers(0, 100).1
. "`nThe 1000th arithmetic number: "
. ArithmeticNumbers(1000).1
. "`tcomposites = "
. ArithmeticNumbers(1000).2
. "`nThe 10000th arithmetic number: "
. ArithmeticNumbers(10000).1
. "`tcomposites = "
. ArithmeticNumbers(10000).2
- Output:
The first 100 arithmetic numbers: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The 1000th arithmetic number: 1361 composites = 782 The 10000th arithmetic number: 12953 composites = 8458
BASIC
True BASIC
LET n = 1
DO
LET div = 1
LET divcnt = 0
LET sum = 0
DO
LET quot = n/div
IF quot < div THEN EXIT DO
IF REMAINDER(n, div) = 0 THEN
IF quot = div THEN !n is a square
LET sum = sum+quot
LET divcnt = divcnt+1
EXIT DO
ELSE
LET sum = sum+div+quot
LET divcnt = divcnt+2
END IF
END IF
LET div = div+1
LOOP
IF REMAINDER(sum, divcnt) = 0 THEN !n is arithmetic
LET arithcnt = arithcnt+1
IF arithcnt <= 100 THEN
PRINT USING "####": n;
IF REMAINDER(arithcnt, 20) = 0 THEN PRINT
END IF
IF divcnt > 2 THEN LET compcnt = compcnt+1
SELECT CASE arithcnt
CASE 1000
PRINT
PRINT USING "The #######th arithmetic number is #####,### up to which ###,### are composite.": arithcnt, n, compcnt
CASE 10000, 100000, 1000000
PRINT USING "The #######th arithmetic number is #####,### up to which ###,### are composite.": arithcnt, n, compcnt
CASE ELSE
REM
END SELECT
END IF
LET n = n+1
LOOP UNTIL arithcnt >= 1000000
END
- Output:
Same as FreeBASIC entry.
XBasic
PROGRAM "ArithmeticNum"
DECLARE FUNCTION Entry ()
FUNCTION Entry ()
N = 1 : ArithCnt = 0 : CompCnt = 0
PRINT "The first 100 arithmetic numbers are:"
DO
Div = 1 : DivCnt = 0 : Sum = 0
DO WHILE 1
Quot = N / Div
IF Quot < Div THEN EXIT DO
IF N MOD Div = 0 THEN
IF Quot = Div THEN 'N is a square
Sum = Sum + Quot
INC DivCnt
EXIT DO
ELSE
Sum = Sum + Div + Quot
DivCnt = DivCnt + 2
END IF
END IF
INC Div
LOOP
IF Sum MOD DivCnt = 0 THEN 'N is arithmetic
INC ArithCnt
IF ArithCnt <= 100 THEN
PRINT FORMAT$("####", N);
IF ArithCnt MOD 20 = 0 THEN PRINT
END IF
IF DivCnt > 2 THEN INC CompCnt
SELECT CASE ArithCnt
CASE 1e3
PRINT "\nThe "; FORMAT$("#######", ArithCnt); "th arithmetic number is"; FORMAT$("####,###", N); " up to which"; FORMAT$("###,###", CompCnt); " are composite."
CASE 1e4, 1e5, 1e6
PRINT "The "; FORMAT$("#######", ArithCnt); "th arithmetic number is"; FORMAT$("####,###", N); " up to which"; FORMAT$("###,###", CompCnt); " are composite."
END SELECT
END IF
INC N
LOOP UNTIL ArithCnt >= 1e6
END FUNCTION
END PROGRAM
- Output:
Same as FreeBASIC entry.
Yabasic
// Rosetta Code problem: http://rosettacode.org/wiki/Arithmetic_numbers
// by Jjuanhdez, 06/2022
N = 1 : ArithCnt = 0 : CompCnt = 0
print "The first 100 arithmetic numbers are:"
repeat
Div = 1 : DivCnt = 0 : Sum = 0
while True
Quot = int( N / Div)
if Quot < Div break
if mod(N, Div) = 0 then
if Quot = Div then //N is a square
Sum = Sum + Quot
DivCnt = DivCnt + 1
break
else
Sum = Sum + Div + Quot
DivCnt = DivCnt + 2
end if
end if
Div = Div + 1
end while
if mod(Sum, DivCnt) = 0 then //N is arithmetic
ArithCnt = ArithCnt + 1
if ArithCnt <= 100 then
print N using "####";
if mod(ArithCnt, 20) = 0 print
end if
if DivCnt > 2 CompCnt = CompCnt + 1
switch ArithCnt
case 100
print
case 1000 : case 10000 : case 100000 : case 1e6
print "The ", ArithCnt using "#######", "th arithmetic number is ", N using "####,###", " up to which ", CompCnt using "###,###", " are composite."
end switch
end if
N = N + 1
until ArithCnt >= 1000000- Output:
Similar to FreeBASIC entry.
C
#include <stdio.h>
void divisor_count_and_sum(unsigned int n, unsigned int* pcount,
unsigned int* psum) {
unsigned int divisor_count = 1;
unsigned int divisor_sum = 1;
unsigned int power = 2;
for (; (n & 1) == 0; power <<= 1, n >>= 1) {
++divisor_count;
divisor_sum += power;
}
for (unsigned int p = 3; p * p <= n; p += 2) {
unsigned int count = 1, sum = 1;
for (power = p; n % p == 0; power *= p, n /= p) {
++count;
sum += power;
}
divisor_count *= count;
divisor_sum *= sum;
}
if (n > 1) {
divisor_count *= 2;
divisor_sum *= n + 1;
}
*pcount = divisor_count;
*psum = divisor_sum;
}
int main() {
unsigned int arithmetic_count = 0;
unsigned int composite_count = 0;
for (unsigned int n = 1; arithmetic_count <= 1000000; ++n) {
unsigned int divisor_count;
unsigned int divisor_sum;
divisor_count_and_sum(n, &divisor_count, &divisor_sum);
if (divisor_sum % divisor_count != 0)
continue;
++arithmetic_count;
if (divisor_count > 2)
++composite_count;
if (arithmetic_count <= 100) {
printf("%3u ", n);
if (arithmetic_count % 10 == 0)
printf("\n");
}
if (arithmetic_count == 1000 || arithmetic_count == 10000 ||
arithmetic_count == 100000 || arithmetic_count == 1000000) {
printf("\n%uth arithmetic number is %u\n", arithmetic_count, n);
printf("Number of composite arithmetic numbers <= %u: %u\n", n,
composite_count);
}
}
return 0;
}
- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 100000th arithmetic number is 125587 Number of composite arithmetic numbers <= 125587: 88219 1000000th arithmetic number is 1228663 Number of composite arithmetic numbers <= 1228663: 905043
C#
using System;
using System.Collections.Generic;
using System.Linq;
public class ArithmeticNumbers
{
public static void Main(string[] args)
{
int arithmeticCount = 0;
int compositeCount = 0;
int n = 1;
while (arithmeticCount <= 1_000_000)
{
var factors = Factors(n);
int sum = factors.Sum();
if (sum % factors.Count == 0)
{
arithmeticCount++;
if (factors.Count > 2)
{
compositeCount++;
}
if (arithmeticCount <= 100)
{
Console.Write($"{n,3}{(arithmeticCount % 10 == 0 ? "\n" : " ")}");
}
if (new[] { 1_000, 10_000, 100_000, 1_000_000 }.Contains(arithmeticCount))
{
Console.WriteLine();
Console.WriteLine($"{arithmeticCount}th arithmetic number is {n}");
Console.WriteLine($"Number of composite arithmetic numbers <= {n}: {compositeCount}");
}
}
n++;
}
}
private static HashSet<int> Factors(int number)
{
var result = new HashSet<int> { 1, number };
int i = 2;
int j;
while ((j = number / i) >= i)
{
if (i * j == number)
{
result.Add(i);
result.Add(j);
}
i++;
}
return result;
}
}
- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 100000th arithmetic number is 125587 Number of composite arithmetic numbers <= 125587: 88219 1000000th arithmetic number is 1228663 Number of composite arithmetic numbers <= 1228663: 905043
C++
#include <cstdio>
void divisor_count_and_sum(unsigned int n,
unsigned int& divisor_count,
unsigned int& divisor_sum)
{
divisor_count = 0;
divisor_sum = 0;
for (unsigned int i = 1;; i++)
{
unsigned int j = n / i;
if (j < i)
break;
if (i * j != n)
continue;
divisor_sum += i;
divisor_count += 1;
if (i != j)
{
divisor_sum += j;
divisor_count += 1;
}
}
}
int main()
{
unsigned int arithmetic_count = 0;
unsigned int composite_count = 0;
for (unsigned int n = 1; arithmetic_count <= 1000000; n++)
{
unsigned int divisor_count;
unsigned int divisor_sum;
divisor_count_and_sum(n, divisor_count, divisor_sum);
unsigned int mean = divisor_sum / divisor_count;
if (mean * divisor_count != divisor_sum)
continue;
arithmetic_count++;
if (divisor_count > 2)
composite_count++;
if (arithmetic_count <= 100)
{
// would prefer to use <stream> and <format> in C++20
std::printf("%3u ", n);
if (arithmetic_count % 10 == 0)
std::printf("\n");
}
if ((arithmetic_count == 1000) || (arithmetic_count == 10000) ||
(arithmetic_count == 100000) || (arithmetic_count == 1000000))
{
std::printf("\n%uth arithmetic number is %u\n", arithmetic_count, n);
std::printf("Number of composite arithmetic numbers <= %u: %u\n", n, composite_count);
}
}
return 0;
}
- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 100000th arithmetic number is 125587 Number of composite arithmetic numbers <= 125587: 88219 1000000th arithmetic number is 1228663 Number of composite arithmetic numbers <= 1228663: 905043 real 0m4.146s user 0m4.116s sys 0m0.003s
Cowgol
include "cowgol.coh";
const MAX := 13000;
var divisorSum: uint16[MAX+1];
var divisorCount: uint8[MAX+1];
sub CalculateDivisorSums() is
MemZero(&divisorSum[0] as [uint8], @bytesof divisorSum);
MemZero(&divisorCount[0] as [uint8], @bytesof divisorCount);
var div: @indexof divisorSum := 1;
while div <= MAX loop
var num := div;
while num <= MAX loop
divisorSum[num] := divisorSum[num] + div;
divisorCount[num] := divisorCount[num] + 1;
num := num + div;
end loop;
div := div + 1;
end loop;
end sub;
sub NextArithmetic(n: uint16): (r: uint16) is
r := n + 1;
while divisorSum[r] % divisorCount[r] as uint16 != 0 loop
r := r + 1;
end loop;
end sub;
sub Composite(n: uint16): (r: uint8) is
r := 0;
if n>1 and divisorSum[n] != n+1 then
r := 1;
end if;
end sub;
var current: uint16 := 0;
var nth: uint16 := 0;
var composites: uint16 := 0;
CalculateDivisorSums();
print("First 100 arithmetic numbers:\n");
while nth < 10000 loop
current := NextArithmetic(current);
nth := nth + 1;
composites := composites + Composite(current) as uint16;
if nth <= 100 then
print_i16(current);
if nth % 5 == 0 then
print_nl();
else
print_char('\t');
end if;
end if;
if nth == 1000 or nth == 10000 then
print_nl();
print_i16(nth);
print(": ");
print_i16(current);
print("\t");
print_i16(composites);
print(" composites\n");
end if;
end loop;- Output:
First 100 arithmetic numbers: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000: 1361 782 composites 10000: 12953 8458 composites
Delphi
{{works with| Delphi-6 or better}}
program ArithmeiticNumbers;
{$APPTYPE CONSOLE}
procedure ArithmeticNumbers;
var N, ArithCnt, CompCnt, DDiv: integer;
var DivCnt, Sum, Quot, Rem: integer;
begin
N:= 1; ArithCnt:= 0; CompCnt:= 0;
repeat
begin
DDiv:= 1; DivCnt:= 0; Sum:= 0;
while true do
begin
Quot:= N div DDiv;
Rem:=N mod DDiv;
if Quot < DDiv then break;
if (Quot = DDiv) and (Rem = 0) then //N is a square
begin
Sum:= Sum+Quot;
DivCnt:= DivCnt+1;
break;
end;
if Rem = 0 then
begin
Sum:= Sum + DDiv + Quot;
DivCnt:= DivCnt+2;
end;
DDiv:= DDiv+1;
end;
if (Sum mod DivCnt) = 0 then //N is arithmetic
begin
ArithCnt:= ArithCnt+1;
if ArithCnt <= 100 then
begin
Write(N:4);
if (ArithCnt mod 20) = 0 then WriteLn;
end;
if DivCnt > 2 then CompCnt:= CompCnt+1;
case ArithCnt of 1000, 10000, 100000, 1000000:
begin
Writeln;
Write(N, #9 {tab} );
Write(CompCnt);
end;
end;
end;
N:= N+1;
end
until ArithCnt >= 1000000;
WriteLn;
end;
begin
ArithmeticNumbers;
WriteLn('Hit Any Key');
ReadLn;
end.
- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1361 782 12953 8458 125587 88219 1228663 905043 Hit Any Key
Draco
word MAX = 13000;
[MAX+1]word divisorSum;
[MAX+1]byte divisorCount;
proc calculateDivisorSums() void:
word num, div;
for div from 1 by 1 upto MAX do
for num from div by div upto MAX do
divisorSum[num] := divisorSum[num] + div;
divisorCount[num] := divisorCount[num] + 1
od
od
corp
proc arithmetic(word n) bool:
divisorSum[n] % divisorCount[n] = 0
corp
proc composite(word n) bool:
n > 1 and divisorSum[n] /= n+1
corp
proc main() void:
word num, nthArithm, composites;
calculateDivisorSums();
writeln("First 100 arithmetic numbers:");
num := 0;
composites := 0;
for nthArithm from 1 upto 10000 do
while num := num+1; not arithmetic(num) do od;
if composite(num) then composites := composites + 1 fi;
if nthArithm <= 100 then
write(num:5);
if nthArithm % 10 = 0 then writeln() fi
fi;
if nthArithm = 1000 or nthArithm = 10000 then
writeln();
writeln("The ",nthArithm,"th arithmetic number is ",num,".");
writeln("Of the first ",nthArithm," arithmetic numbers, ",
composites," are composite.")
fi
od
corp- Output:
First 100 arithmetic numbers:
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
The 1000th arithmetic number is 1361.
Of the first 1000 arithmetic numbers, 782 are composite.
The 10000th arithmetic number is 12953.
Of the first 10000 arithmetic numbers, 8458 are composite.
EasyLang
print "The first 100 arithmetic numbers are:"
numfmt 0 3
n = 1
while aricnt <= 1e5
divi = 1 ; divcnt = 0 ; sum = 0
repeat
quot = n div divi
until quot < divi
if quot = divi and n mod divi = 0
sum += quot
divcnt += 1
break 1
.
if n mod divi = 0
sum += divi + quot
divcnt += 2
.
divi += 1
.
if sum mod divcnt = 0
aricnt += 1
if aricnt <= 100
write n & " "
if aricnt mod 10 = 0
print ""
.
.
if divcnt > 2
compcnt += 1
.
if aricnt = 1e3 or aricnt = 1e4 or aricnt = 1e5
print ""
print aricnt & "th arithmetic number: " & n
print "Composite arithmetic numbers: " & compcnt
.
.
n += 1
.Factor
USING: combinators formatting grouping io kernel lists
lists.lazy math math.functions math.primes math.primes.factors
math.statistics math.text.english prettyprint sequences
tools.memory.private ;
: arith? ( n -- ? ) divisors mean integer? ;
: larith ( -- list ) 1 lfrom [ arith? ] lfilter ;
: arith ( m -- seq ) larith ltake list>array ;
: composite? ( n -- ? ) dup 1 > swap prime? not and ;
: ordinal ( n -- str ) [ commas ] keep ordinal-suffix append ;
: info. ( n -- )
{
[ ordinal "%s arithmetic number: " printf ]
[ arith dup last commas print ]
[ commas "Number of composite arithmetic numbers <= %s: " printf ]
[ drop [ composite? ] count commas print nl ]
} cleave ;
"First 100 arithmetic numbers:" print
100 arith 10 group simple-table. nl
{ 3 4 5 6 } [ 10^ info. ] each
- Output:
First 100 arithmetic numbers: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1,000th arithmetic number: 1,361 Number of composite arithmetic numbers <= 1,000: 782 10,000th arithmetic number: 12,953 Number of composite arithmetic numbers <= 10,000: 8,458 100,000th arithmetic number: 125,587 Number of composite arithmetic numbers <= 100,000: 88,219 1,000,000th arithmetic number: 1,228,663 Number of composite arithmetic numbers <= 1,000,000: 905,043
FreeBASIC
' Rosetta Code problem: https://rosettacode.org/wiki/Arithmetic_numbers
' by Jjuanhdez, 06/2022
Dim As Double t0 = Timer
Dim As Integer N = 1, ArithCnt = 0, CompCnt = 0
Dim As Integer Div, DivCnt, Sum, Quot
Print "The first 100 arithmetic numbers are:"
Do
Div = 1 : DivCnt = 0 : Sum = 0
Do
Quot = N / Div
If Quot < Div Then Exit Do
If Quot = Div AndAlso (N Mod Div) = 0 Then 'N is a square
Sum += Quot
DivCnt += 1
Exit Do
End If
If (N Mod Div) = 0 Then
Sum += Div + Quot
DivCnt += 2
End If
Div += 1
Loop
If (Sum Mod DivCnt) = 0 Then 'N is arithmetic
ArithCnt += 1
If ArithCnt <= 100 Then
Print Using "####"; N;
If (ArithCnt Mod 20) = 0 Then Print
End If
If DivCnt > 2 Then CompCnt += 1
Select Case ArithCnt
Case 1e3
Print Using !"\nThe #######th arithmetic number is #####,### up to which ###,### are composite."; ArithCnt; N; CompCnt
Case 1e4, 1e5, 1e6
Print Using "The #######th arithmetic number is #####,### up to which ###,### are composite."; ArithCnt; N; CompCnt
End Select
End If
N += 1
Loop Until ArithCnt >= 1e6
Print !"\nTook"; Timer - t0; " seconds on i5 @3.20 GHz"
Sleep
- Output:
The first 100 arithmetic numbers are: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The 1000th arithmetic number is 1,361 up to which 782 are composite. The 10000th arithmetic number is 12,953 up to which 8,458 are composite. The 100000th arithmetic number is 125,587 up to which 88,219 are composite. The 1000000th arithmetic number is 1,228,663 up to which 905,043 are composite. Took 38.42344779999985 seconds on i5 @3.20 GHz
FutureBasic
' Rosetta Code problem: https://rosettacode.org/wiki/Arithmetic_numbers
' by Rich Love, 9/21/22
' FutureBasic 7.0.14
output file "Arithmetic numbers.app"
Dim As long N = 1, ArithCnt = 0, CompCnt = 0
Dim As long Div, DivCnt, Sum, Quot
toolbox Microseconds( UnsignedWide * microTickCount )
dim as UnsignedWide Time1, Time2
window 1, @"Arithmetic numbers",(0,0,600,200)
Print "The first 100 arithmetic numbers are:"
Microseconds( @Time1 ) //start time
for N = 1 to 2000000)
Div = 1 : DivCnt = 0 : Sum = 0
while 1
Quot = N / Div
If Quot < Div Then Exit while
If Quot = Div And (N Mod Div) = 0 'N is a square
Sum += Quot
DivCnt += 1
Exit while
End If
If (N Mod Div) = 0
Sum += Div + Quot
DivCnt += 2
End If
Div ++
wend
If (Sum Mod DivCnt) = 0 'N is arithmetic
ArithCnt ++
If ArithCnt <= 100
Print Using "####"; N;
If (ArithCnt Mod 20) = 0 Then PRINT
End If
If DivCnt > 2 Then CompCnt ++
Select Case ArithCnt
Case 1e3
PRINT
PRINT USING "The #######th arithmetic number is";ArithCnt;
PRINT USING "#####,### up to which ";N;
PRINT USING "###,### are composite. ";compcnt
Case 1e4, 1e5, 1e6
PRINT USING "The #######th arithmetic number is";ArithCnt;
PRINT USING "#####,### up to which ";N;
PRINT USING "###,### are composite. ";compcnt
End Select
if ArithCnt = 1e6 then exit next
End If
next N
Microseconds( @Time2 ) //end time
float TimeTaken
TimeTaken = (Time2.lo-Time1.lo)/1000/100/10
print
print "It took " + str$(TimeTaken) + " seconds to complete." // Approx 1.2 seconds on a M1 Mac Mini ( Macmini9,1 )
handleevents- Output:
The first 100 arithmetic numbers are: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The 1000th arithmetic number is 1,361 up to which 782 are composite. The 10000th arithmetic number is 12,953 up to which 8,458 are composite. The 100000th arithmetic number is 125,587 up to which 88,219 are composite. The 1000000th arithmetic number is 1,228,663 up to which 905,043 are composite. Took 1.2245190144 seconds on a M1 Mac Mini * Macmini19,1 )
Go
package main
import (
"fmt"
"math"
"rcu"
"sort"
)
func main() {
arithmetic := []int{1}
primes := []int{}
limit := int(1e6)
for n := 3; len(arithmetic) < limit; n++ {
divs := rcu.Divisors(n)
if len(divs) == 2 {
primes = append(primes, n)
arithmetic = append(arithmetic, n)
} else {
mean := float64(rcu.SumInts(divs)) / float64(len(divs))
if mean == math.Trunc(mean) {
arithmetic = append(arithmetic, n)
}
}
}
fmt.Println("The first 100 arithmetic numbers are:")
rcu.PrintTable(arithmetic[0:100], 10, 3, false)
for _, x := range []int{1e3, 1e4, 1e5, 1e6} {
last := arithmetic[x-1]
lastc := rcu.Commatize(last)
fmt.Printf("\nThe %sth arithmetic number is: %s\n", rcu.Commatize(x), lastc)
pcount := sort.SearchInts(primes, last) + 1
if !rcu.IsPrime(last) {
pcount--
}
comp := x - pcount - 1 // 1 is not composite
compc := rcu.Commatize(comp)
fmt.Printf("The count of such numbers <= %s which are composite is %s.\n", lastc, compc)
}
}
- Output:
Same as Wren example.
J
factors=: {{ */@>,{(^ [:i.1+])&.>/__ q:y}}
isArith=: {{ (= <.) (+/%#) factors|y}}"0
Task examples:
examples=: 1+I.isArith 1+i.2e6
10 10$examples
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
(1e3-1){examples NB. 0 is first
1361
(1e4-1){examples
12953
+/0=1 p: (1e3 {. examples) -. 1
782
+/0=1 p: (1e4 {. examples) -. 1
8458
+/0=1 p: (1e5 {. examples) -. 1
88219
+/0=1 p: (1e6 {. examples) -. 1
905043
Java
import java.util.HashSet;
import java.util.List;
import java.util.Set;
import java.util.stream.Collectors;
import java.util.stream.Stream;
public final class ArithmeticNumbers {
public static void main(String[] aArgs) {
int arithmeticCount = 0;
int compositeCount = 0;
int n = 1;
while ( arithmeticCount <= 1_000_000 ) {
Set<Integer> factors = factors(n);
final int sum = factors.stream().mapToInt(Integer::intValue).sum();
if ( sum % factors.size() == 0 ) {
arithmeticCount += 1;
if ( factors.size() > 2 ) {
compositeCount += 1;
}
if ( arithmeticCount <= 100 ) {
System.out.print(String.format("%3d%s", n, ( arithmeticCount % 10 == 0 ) ? "\n" : " "));
}
if ( List.of( 1_000, 10_000, 100_000, 1_000_000 ).contains(arithmeticCount) ) {
System.out.println();
System.out.println(arithmeticCount + "th arithmetic number is " + n);
System.out.println("Number of composite arithmetic numbers <= " + n + ": " + compositeCount);
}
}
n += 1;
}
}
private static Set<Integer> factors(int aNumber) {
Set<Integer> result = Stream.of(1, aNumber).collect(Collectors.toCollection(HashSet::new));
int i = 2;
int j;
while ( ( j = aNumber / i ) >= i ) {
if ( i * j == aNumber ) {
result.add(i);
result.add(j);
}
i += 1;
}
return result;
}
}
- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 100000th arithmetic number is 125587 Number of composite arithmetic numbers <= 125587: 88219 1000000th arithmetic number is 1228663 Number of composite arithmetic numbers <= 1228663: 905043
jq
Also works with gojq, the Go implementation of jq
A point of interest in the following is that the approach is entirely stream-oriented and thus very economical with memory. In particular, `arithmetic_integers` produces an unbounded stream of arithmetic integers.
Generic utilities
# For the sake of gojq
def _nwise($n):
def nw: if length <= $n then . else .[0:$n] , (.[$n:] | nw) end;
nw;
def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;Arithmetic
# proper_divisors returns a stream of unordered proper divisors of the input integer.
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;
def composite:
[limit(2; proper_divisors)] | length == 2;
def arithmetic_numbers:
def average_is_integral(s):
reduce s as $_ ({}; .sum += $_ | .n += 1)
| (.sum % .n) == 0;
1, (range(2; infinite) | select(average_is_integral(., proper_divisors)));The tasks
def task1($limit):
[limit($limit; arithmetic_numbers)] | _nwise(10) | map(lpad(4)) | join(" ");
# $points should be a stream of integers, in order, specifying the reporting points
def task2($points):
last($points) as $last
| label $out
| foreach arithmetic_numbers as $n ({count:0};
.count += 1
| if $n | composite then .composite += 1 else . end;
(select( .count | IN( $points) ) | .n = $n),
if .count == $last then break $out else empty end );
task1(100),
"",
(task2( 1000, 10000, 100000, 1000000 )
| "The \(.count)th arithmetic number is \(.n);",
"there are \(.composite) composite arithmetic numbers up to \(.n).\n")Invocation: jq -ncr -f -arithmetic-numbers.jq
- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The 1000th arithmetic number is 1361; there are 782 composite arithmetic numbers up to 1361. The 10000th arithmetic number is 12953; there are 8458 composite arithmetic numbers up to 12953. The 100000th arithmetic number is 125587; there are 88219 composite arithmetic numbers up to 125587. The 1000000th arithmetic number is 1228663; there are 905043 composite arithmetic numbers up to 1228663.
Julia
using Primes
function isarithmetic(n)
f = [one(n)]
for (p,e) in factor(n)
f = reduce(vcat, [f*p^j for j in 1:e], init=f)
end
return rem(sum(f), length(f)) == 0
end
function arithmetic(n)
i, arr = 1, Int[]
while length(arr) < n
isarithmetic(i) && push!(arr, i)
i += 1
end
return arr
end
a1M = arithmetic(1_000_000)
composites = [!isprime(i) for i in a1M]
println("The first 100 arithmetic numbers are:")
foreach(p -> print(lpad(p[2], 5), p[1] % 20 == 0 ? "\n" : ""), enumerate(a1M[1:100]))
println("\n X Xth in Series Composite")
for n in [1000, 10_000, 100_000, 1_000_000]
println(lpad(n, 9), lpad(a1M[n], 12), lpad(sum(composites[2:n]), 14))
end
- Output:
The first 100 arithmetic numbers are:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149
X Xth in Series Composite
1000 1361 782
10000 12953 8458
100000 125587 88219
1000000 1228663 905043
Lua
Translated from Python
local function factors (n)
local f, i = {1, n}, 2
while true do
local j = n//i -- floor division by Lua 5.3
if j < i then
break
elseif j == i and i * j == n then
table.insert (f, i)
break
elseif i * j == n then
table.insert (f, i)
table.insert (f, j)
end
i = i + 1
end
return f
end
local function sum (f)
local s = 0
for i, value in ipairs (f) do
s = s + value
end
return s
end
local arithmetic_count = 1
local composite_count = 0
local hundr = {1}
for n = 2, 1228663 do
local f = factors (n)
local s = sum (f)
local l = #f
if (s/l)%1 == 0 then
arithmetic_count = arithmetic_count + 1
if l > 2 then
composite_count = composite_count + 1
end
if arithmetic_count <= 100 then
table.insert (hundr, n)
end
if arithmetic_count == 100 then
for i = 0, 9 do
print (table.concat(hundr, ', ', 10*i+1, 10*i+10))
end
elseif arithmetic_count == 1000
or arithmetic_count == 10000
or arithmetic_count == 100000 then
print (arithmetic_count..'th arithmetic number is '..(n))
print ('Number of composite arithmetic numbers <= '..(n)..': '..composite_count)
elseif arithmetic_count == 1000000 then
print (arithmetic_count..'th arithmetic number is '..(n))
print ('Number of composite arithmetic numbers <= '..(n)..': '..composite_count)
return
end
end
end
- Output:
1, 3, 5, 6, 7, 11, 13, 14, 15, 17 19, 20, 21, 22, 23, 27, 29, 30, 31, 33 35, 37, 38, 39, 41, 42, 43, 44, 45, 46 47, 49, 51, 53, 54, 55, 56, 57, 59, 60 61, 62, 65, 66, 67, 68, 69, 70, 71, 73 77, 78, 79, 83, 85, 86, 87, 89, 91, 92 93, 94, 95, 96, 97, 99, 101, 102, 103, 105 107, 109, 110, 111, 113, 114, 115, 116, 118, 119 123, 125, 126, 127, 129, 131, 132, 133, 134, 135 137, 138, 139, 140, 141, 142, 143, 145, 147, 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 100000th arithmetic number is 125587 Number of composite arithmetic numbers <= 125587: 88219 1000000th arithmetic number is 1228663 Number of composite arithmetic numbers <= 1228663: 905043 (Done in 56.17 seconds)
M2000 Interpreter
Write code in a module: From M2000 console: Edit a (press ender, then paste the code, press Esc, write a and press enter).
n=1361 run for 1s
n=12953 run for 10s
n=125587 run for 120.6s
n=1228663 run for 1369.4s
M2000 is an interpreter with no intermediate code generation.
set fast !
profiler
form 80, 50
const msg$="The {0::-7}th arithmetic number is {1:-9} up to which {2:-7} are composite."
const f1$="#####,###"
const f2$="###,###"
print "The first 100 arithmetic numbers are:"
C=0&
D=0&: t=0&
mm=1000&
mm1=1000000&
n=1228663 ' 125587 ' 12953 ' 1361
dim L(2 to n)=1, M(2 to n)=1 : c++: Print 1,
for i=2 to n {for j=i to n step i {L(j)+=i:M(j)++}:if L(i) mod M(i) = 0& then {if M(i)>2 then D++
C++:if C<=100& then print i, else i++: goto exit1
}}
exit1:
refresh
for i=i to n {for j=i to n step i {L(j)+=i:M(j)++}:if L(i) mod M(i) = 0& then {if M(i)>2 then D++
C++:if C=mm then ? format$(msg$, c, str$(i,f1$), str$(d,f2$)):refresh:mm*=10&:if mm>mm1 then goto exit2
}}
exit2:
print
print round(timecount/1000, 1);"s"Mathematica /Wolfram Language
ClearAll[ArithmeticNumberQ]
ArithmeticNumberQ[n_Integer] := IntegerQ[Mean[Divisors[n]]]
ArithmeticNumberQ[30]
an = {};
PrintTemporary[Dynamic[{i, Length[an]}]];
Do[
If[ArithmeticNumberQ[i],
AppendTo[an, i];
If[Length[an] >= 100, Break[]]
]
,
{i, 1, \[Infinity]}
];
an
an = {};
Do[
If[ArithmeticNumberQ[i],
AppendTo[an, i];
If[Length[an] >= 1000, Break[]]
]
,
{i, 1, \[Infinity]}
];
a1 = {Length[an], Last[an], Count[CompositeQ[an], True]};
an = {};
Do[
If[ArithmeticNumberQ[i],
AppendTo[an, i];
If[Length[an] >= 10000, Break[]]
]
,
{i, 1, \[Infinity]}
];
a2 = {Length[an], Last[an], Count[CompositeQ[an], True]};
an = {};
Do[
If[ArithmeticNumberQ[i],
AppendTo[an, i];
If[Length[an] >= 100000, Break[]]
]
,
{i, 1, \[Infinity]}
];
a3 = {Length[an], Last[an], Count[CompositeQ[an], True]};
TableForm[{a1, a2, a3}, TableHeadings -> {None, {"X", "Xth in series", "composite"}}]
- Output:
{1, 3, 5, 6, 7, 11, 13, 14, 15, 17, 19, 20, 21, 22, 23, 27, 29, 30, 31, 33, 35, 37, 38, 39, 41, 42, 43, 44, 45, 46, 47, 49, 51, 53, 54, 55, 56, 57, 59, 60, 61, 62, 65, 66, 67, 68, 69, 70, 71, 73, 77, 78, 79, 83, 85, 86, 87, 89, 91, 92, 93, 94, 95, 96, 97, 99, 101, 102, 103, 105, 107, 109, 110, 111, 113, 114, 115, 116, 118, 119, 123, 125, 126, 127, 129, 131, 132, 133, 134, 135, 137, 138, 139, 140, 141, 142, 143, 145, 147, 149}
X Xth in series composite
1000 1361 782
10000 12953 8458
100000 125587 88219
Maxima
/* Predicate function that checks wether a positive integer is arithmetic or not */
arith_nump(n):=block(listify(divisors(n)),apply("+",%%)/length(%%),if integerp(%%) then true)$
/* Function that returns a list of the first len arithmetic numbers */
arith_num_count(len):=block(
[i:1,count:0,result:[]],
while count<len do (if arith_nump(i) then (result:endcons(i,result),count:count+1),i:i+1),
result)$
/* Test cases */
/* First 100 arithmetic numbers */
arith_num_count(100);
/* The 1000th arithmetic number */
last(arith_num_count(1000));
/* The 10000th arithmetic number */
last(arith_num_count(10000));
/* Number of composites among the first 1000 arithmetic numbers */
block(rest(arith_num_count(1000)),sublist(%%,lambda([x],primep(x)=false)),length(%%));
/* Number of composites among the first 10000 arithmetic numbers */
block(rest(arith_num_count(10000)),sublist(%%,lambda([x],primep(x)=false)),length(%%));
- Output:
[1,3,5,6,7,11,13,14,15,17,19,20,21,22,23,27,29,30,31,33,35,37,38,39,41,42,43,44,45,46,47,49,51,53,54,55,56,57,59,60,61,62,65,66,67,68,69,70,71,73,77,78,79,83,85,86,87,89,91,92,93,94,95,96,97,99,101,102,103,105,107,109,110,111,113,114,115,116,118,119,123,125,126,127,129,131,132,133,134,135,137,138,139,140,141,142,143,145,147,149] 1361 12953 782 8458
Modula-2
MODULE ArithmeticNumbers;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;
CONST
Max = 13000;
VAR
divSum: ARRAY [1..Max] OF CARDINAL;
divCount: ARRAY [1..Max] OF CHAR;
current, count, composites: CARDINAL;
PROCEDURE CalculateDivisorSums;
VAR div, num: CARDINAL;
BEGIN
FOR num := 1 TO Max DO
divSum[num] := 0;
divCount[num] := CHR(0)
END;
FOR div := 1 TO Max DO
num := div;
WHILE num <= Max DO
INC(divSum[num], div);
INC(divCount[num]);
INC(num, div)
END
END
END CalculateDivisorSums;
PROCEDURE Next(n: CARDINAL): CARDINAL;
BEGIN
REPEAT INC(n) UNTIL (divSum[n] MOD ORD(divCount[n])) = 0;
RETURN n
END Next;
PROCEDURE Composite(n: CARDINAL): BOOLEAN;
BEGIN
RETURN (n>1) AND (divSum[n] # n+1)
END Composite;
BEGIN
CalculateDivisorSums;
WriteString("First 100 arithmetic numbers:");
WriteLn;
current := 0;
FOR count := 1 TO 10000 DO
current := Next(current);
IF Composite(current) THEN INC(composites) END;
IF count <= 100 THEN
WriteCard(current, 5);
IF count MOD 10 = 0 THEN WriteLn END
END;
IF (count = 1000) OR (count = 10000) THEN
WriteCard(count, 5);
WriteString(": ");
WriteCard(current, 5);
WriteString(", ");
WriteCard(composites, 5);
WriteString(" composites");
WriteLn
END;
END
END ArithmeticNumbers.
- Output:
First 100 arithmetic numbers:
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
1000: 1361, 782 composites
10000: 12953, 8458 composites
Nim
import std/strformat
func status(n: int): tuple[isArithmetic, isComposite: bool] =
## Return the status of "n", i.e. whether it is an arithmetic number
## and whether it is composite.
var count = 0
var sum = 0
for d in 1..n:
let q = n div d
if q < d: break
if n mod d == 0:
sum += d
inc count
if q != d:
sum += q
inc count
result = (isArithmetic: sum mod count == 0, isComposite: count > 2)
iterator arithmeticNumbers(): tuple[val: int, isComposite: bool] =
## Yield the successive arithmetic numbers with their composite status.
var n = 1
while true:
let status = n.status
if status.isArithmetic:
yield (n, status.isComposite)
inc n
echo "First 100 arithmetic numbers:"
var arithmeticCount, compositeCount = 0
for (n, isComposite) in arithmeticNumbers():
inc arithmeticCount
inc compositeCount, ord(isComposite)
if arithmeticCount <= 100:
stdout.write &"{n:>3}"
stdout.write if arithmeticCount mod 10 == 0: '\n' else: ' '
elif arithmeticCount in [1_000, 10_000, 100_000, 1_000_000]:
echo &"\n{arithmeticCount}th arithmetic number: {n}"
echo &"Number of composite arithmetic numbers ⩽ {n}: {compositeCount}"
if arithmeticCount == 1_000_000: break
- Output:
First 100 arithmetic numbers: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number: 1361 Number of composite arithmetic numbers ⩽ 1361: 782 10000th arithmetic number: 12953 Number of composite arithmetic numbers ⩽ 12953: 8458 100000th arithmetic number: 125587 Number of composite arithmetic numbers ⩽ 125587: 88219 1000000th arithmetic number: 1228663 Number of composite arithmetic numbers ⩽ 1228663: 905043
Oberon-07
MODULE ArithmeticNumbers;
IMPORT Out;
CONST
Max = 130000;
VAR divSum: ARRAY Max + 1 OF INTEGER;
divCount: ARRAY Max + 1 OF CHAR;
current, count, composites: INTEGER;
PROCEDURE CalculateDivisorSums;
VAR div, num: INTEGER;
BEGIN
FOR num := 1 TO Max DO
divSum[num] := 0;
divCount[num] := CHR(0)
END;
FOR div := 1 TO Max DO
num := div;
WHILE num <= Max DO
INC(divSum[num],div);
divCount[num] := CHR(ORD(divCount[num]) + 1);
INC(num,div)
END
END
END CalculateDivisorSums;
PROCEDURE Next(n: INTEGER): INTEGER;
BEGIN
REPEAT INC(n) UNTIL (divSum[n] MOD ORD(divCount[n])) = 0;
RETURN n
END Next;
PROCEDURE Composite(n: INTEGER): BOOLEAN;
BEGIN
RETURN (n>1) & (divSum[n] # n+1)
END Composite;
BEGIN
CalculateDivisorSums;
Out.String("First 100 arithmetic numbers:");
Out.Ln;
current := 0;
FOR count := 1 TO 100000 DO
current := Next(current);
IF Composite(current) THEN INC(composites) END;
IF count <= 100 THEN
Out.Int(current, 5);
IF count MOD 10 = 0 THEN Out.Ln END
END;
IF (count = 1000) OR (count = 10000) OR (count = 100000) THEN
Out.Int(count, 6);
Out.String("th: ");
Out.Int(current, 6);
Out.String(", ");
Out.Int(composites, 6);
Out.String(" composites");
Out.Ln
END;
END
END ArithmeticNumbers.
- Output:
First 100 arithmetic numbers:
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
1000th: 1361, 782 composites
10000th: 12953, 8458 composites
100000th: 125587, 88219 composites
Pascal
and Free Pascal too.
program ArithmeiticNumbers;
procedure ArithmeticNumbers;
var N, ArithCnt, CompCnt, DDiv: longint;
var DivCnt, Sum, Quot, Rem: longint;
begin
N:= 1; ArithCnt:= 0; CompCnt:= 0;
repeat
begin
DDiv:= 1; DivCnt:= 0; Sum:= 0;
while true do
begin
Quot:= N div DDiv;
Rem:=N mod DDiv;
if Quot < DDiv then break;
if (Quot = DDiv) and (Rem = 0) then //N is a square
begin
Sum:= Sum+Quot;
DivCnt:= DivCnt+1;
break;
end;
if Rem = 0 then
begin
Sum:= Sum + DDiv + Quot;
DivCnt:= DivCnt+2;
end;
DDiv:= DDiv+1;
end;
if (Sum mod DivCnt) = 0 then //N is arithmetic
begin
ArithCnt:= ArithCnt+1;
if ArithCnt <= 100 then
begin
Write(N:4);
if (ArithCnt mod 20) = 0 then WriteLn;
end;
if DivCnt > 2 then CompCnt:= CompCnt+1;
case ArithCnt of 1000, 10000, 100000, 1000000:
begin
Writeln;
Write(N, #9 {tab} );
Write(CompCnt);
end;
end;
end;
N:= N+1;
end
until ArithCnt >= 1000000;
WriteLn;
end;
begin
ArithmeticNumbers;
WriteLn('Hit Any Key');
{$IFDEF WINDOWS}ReadLn;{$ENDIF}
end.
- @TIO.RUN:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1361 782 12953 8458 125587 88219 1228663 905043 Hit Any Key Real time: 19.847 s CPU share: 99.36 %
Free Pascal
using prime decomposition is lengthy, but much faster.
Change last lines of Factors_of_an_integer#using_Prime_decomposition even more.
program ArithmeticNumbers;
{$OPTIMIZATION ON,ALL}
type
tPrimeFact = packed record
pfSumOfDivs,
pfRemain : Uint64;
pfDivCnt : Uint32;
pfMaxIdx : Uint32;
pfpotPrimIdx : array[0..9] of word;
pfpotMax : array[0..11] of byte;//11 instead of 9 for alignment
end;
var
SmallPrimes : array[0..6541] of word;
procedure InitSmallPrimes;
var
testPrime,j,p,idx:Uint32;
begin
SmallPrimes[0] := 2;
SmallPrimes[1] := 3;
idx := 1;
testPrime := 5;
repeat
For j := 1 to idx do
begin
p := SmallPrimes[j];
if p*p>testPrime then
BREAK;
if testPrime mod p = 0 then
Begin
p := 0;
BREAK;
end;
end;
if p <> 0 then
begin
inc(idx);
SmallPrimes[idx]:= testPrime;
end;
inc(testPrime,2);
until testPrime >= 65535;
end;
procedure smplPrimeDecomp(var PrimeFact:tPrimeFact;n:Uint32);
var
pr,i,pot,fac,q :NativeUInt;
Begin
with PrimeFact do
Begin
pfDivCnt := 1;
pfSumOfDivs := 1;
pfRemain := n;
pfMaxIdx := 0;
pfpotPrimIdx[0] := 1;
pfpotMax[0] := 0;
i := 0;
while i < High(SmallPrimes) do
begin
pr := SmallPrimes[i];
q := n DIV pr;
//if n < pr*pr
if pr > q then
BREAK;
if n = pr*q then
Begin
pfpotPrimIdx[pfMaxIdx] := i;
pot := 0;
fac := pr;
repeat
n := q;
q := n div pr;
pot+=1;
fac *= pr;
until n <> pr*q;
pfpotMax[pfMaxIdx] := pot;
pfDivCnt *= pot+1;
pfSumOfDivs *= (fac-1)DIV(pr-1);
inc(pfMaxIdx);
end;
inc(i);
end;
pfRemain := n;
if n > 1 then
Begin
pfDivCnt *= 2;
pfSumOfDivs *= n+1
end;
end;
end;
function IsArithmetic(const PrimeFact:tPrimeFact):boolean;inline;
begin
with PrimeFact do
IsArithmetic := pfSumOfDivs mod pfDivCnt = 0;
end;
var
pF :TPrimeFact;
i,cnt,primeCnt,lmt : Uint32;
begin
InitSmallPrimes;
writeln('First 100 arithemetic numbers');
cnt := 0;
i := 1;
repeat
smplPrimeDecomp(pF,i);
if IsArithmetic(pF) then
begin
write(i:4);
inc(cnt);
if cnt MOD 20 =0 then
writeln;
end;
inc(i);
until cnt = 100;
writeln;
writeln(' Arithemetic numbers');
writeln(' Index number composite');
cnt := 0;
primeCnt := 0;
lmt := 10;
i := 1;
repeat
smplPrimeDecomp(pF,i);
if IsArithmetic(pF) then
begin
inc(cnt);
if pF.pfRemain = i then
inc(primeCnt);
end;
if cnt = lmt then
begin
writeln(lmt:8,i:9,lmt-primeCnt:10);
lmt := lmt*10;
end;
inc(i);
until lmt>1000000;
{$IFdef WINDOWS}
WriteLn('Hit <ENTER>');ReadLn;
{$ENDIF}
end.
- @TIO.RUN:
First 100 arithemetic numbers
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149
Arithemetic numbers
Index number composite
10 17 3
100 149 65
1000 1361 782
10000 12953 8458
100000 125587 88219
1000000 1228663 905043
Real time: 0.678 s CPU share: 99.40 %
Factors_of_an_integer#using_Prime_decomposition added function and change main routine.
const
//make size of sieve using 11 MB of 16MB Level III cache
SizePrDeFe = 192*1024;
.....
function IsArithmetic(const PrimeFact:tPrimeFac):boolean;inline;
begin
with PrimeFact do
IsArithmetic := pfSumOfDivs mod pfDivCnt = 0;
end;
var
pPrimeDecomp :tpPrimeFac;
T0:Int64;
n,lmt,cnt,primeCnt : NativeUInt;
Begin
InitSmallPrimes;
T0 := GetTickCount64;
cnt := 1;
primeCnt := 1;
lmt := 10;
n := 2;
Init_Sieve(n);
repeat
pPrimeDecomp:= GetNextPrimeDecomp;
if IsArithmetic(pPrimeDecomp^) then
begin
inc(cnt);
if pPrimeDecomp^.pfDivCnt = 2 then
inc(primeCnt);
end;
if cnt = lmt then
begin
writeln(lmt:14,n:14,lmt-primeCnt:14);
lmt := lmt*10;
end;
inc(n);
until lmt>1000*1000*1000;
T0 := GetTickCount64-T0;
writeln;
end.
- @Home AMD 5600G:
10 17 3
100 149 65
1000 1361 782
10000 12953 8458
100000 125587 88219
1000000 1228663 905043
10000000 12088243 9206547
100000000 119360473 93192812
1000000000 1181451167 940432725
20.78user 0.00 system 0:20.79 elapsed 99%CPU
Perl
use strict;
use warnings;
use feature 'say';
use List::Util <max sum>;
use ntheory <is_prime divisors>;
use Lingua::EN::Numbers qw(num2en num2en_ordinal);
sub comma { reverse ((reverse shift) =~ s/(.{3})/$1,/gr) =~ s/^,//r }
sub table { my $t = 10 * (my $c = 1 + length max @_); ( sprintf( ('%'.$c.'d')x@_, @_) ) =~ s/.{1,$t}\K/\n/gr }
my @A = 0;
for my $n (1..2E6) {
my @div = divisors $n;
push @A, $n if 0 == sum(@div) % @div;
}
say "The first @{[num2en 100]} arithmetic numbers:";
say table @A[1..100];
for my $x (1E3, 1E4, 1E5, 1E6) {
say "\nThe @{[num2en_ordinal $x]}: " . comma($A[$x]) .
"\nComposite arithmetic numbers ≤ @{[comma $A[$x]]}: " . comma -1 + grep { not is_prime($_) } @A[1..$x];
}
- Output:
The first one hundred arithmetic numbers: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The one thousandth: 1,361 Composite arithmetic numbers ≤ 1,361: 782 The ten thousandth: 12,953 Composite arithmetic numbers ≤ 12,953: 8,458 The one hundred thousandth: 125,587 Composite arithmetic numbers ≤ 125,587: 88,219 The one millionth: 1,228,663 Composite arithmetic numbers ≤ 1,228,663: 905,043
Phix
with javascript_semantics sequence arithmetic = {1} integer composite = 0 function get_arithmetic(integer nth) integer n = arithmetic[$]+1 while length(arithmetic)<nth do sequence divs = factors(n,1) if remainder(sum(divs),length(divs))=0 then composite += length(divs)>2 arithmetic &= n end if n += 1 end while return arithmetic[nth] end function {} = get_arithmetic(100) printf(1,"The first 100 arithmetic numbers are:\n%s\n", {join_by(arithmetic,1,10," ",fmt:="%3d")}) constant fmt = "The %,dth arithmetic number is %,d up to which %,d are composite.\n" for n in {1e3,1e4,1e5,1e6} do integer nth = get_arithmetic(n) printf(1,fmt,{n,nth,composite}) end for
Aside: You could inline the get_arithmetic() call inside the printf() call, however the formal language specification does not actually guarantee that the value of composite won't be output as it was before such a function call is made, or in other words, whether parameters are constructed left-to-right or right-to-left is simply unspecified. You certainly would not expect get_arithmetic(n,composite) to do anything other than pass the prior value into the function, so for your own sanity you should in general avoid using the visually rather similar get_arithmetic(n),composite, and suchlike, in order to collect/output the completely different post-invocation value. Or and perhaps even better, just simply avoid writing functions with side-effects, or make it a function that returns everything in a guaranteed consistent manner, and of course were get_arithmetic() a procedure [with side-effects] rather than a function, you would not be tempted to invoke it inline or use any other form of doubtful execution order anyway.
- Output:
The first 100 arithmetic numbers are: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The 1,000th arithmetic number is 1,361 up to which 782 are composite. The 10,000th arithmetic number is 12,953 up to which 8,458 are composite. The 100,000th arithmetic number is 125,587 up to which 88,219 are composite. The 1,000,000th arithmetic number is 1,228,663 up to which 905,043 are composite.
PL/M
The original PL/M compiler only supports unsigned integers up to 65535, so this sample doesn't consider arithmetic numbers above the 10 000th.
As machines running CP/M probably didn't have large memories, the tables of divisor counts and sums are restricted to 4000 elements each and the next 4000 values are calculated when the previous 4000 have been examined.
... under CP/M (or an emulator)
100H: /* FIND SOME ARITHMETIC NUMBERS: NUMBERS WHOSE AVERAGE DIVISOR IS AN */
/* IS AN INTEGER - I.E. DIVISOR SUM MOD DIVISOR COUNT = 0 */
/* CP/M BDOS SYSTEM CALL, IGNORE THE RETURN VALUE */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$STRING( .( 0AH, 0DH, '$' ) ); END;
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
PR$NUMBER4: PROCEDURE( N ); /* PRINT A NUMBER IN AT LEAST 4 CHARACTERS */
DECLARE N ADDRESS;
IF N < 10 THEN CALL PR$CHAR( ' ' );
IF N < 100 THEN CALL PR$CHAR( ' ' );
IF N < 1000 THEN CALL PR$CHAR( ' ' );
CALL PR$NUMBER( N );
END PR$NUMBER4;
DECLARE ( D$COUNT, D$SUM ) ( 4001 )ADDRESS;
DECLARE ( I, J, D$POS, I$POS, J$POS ) ADDRESS;
/* SHOW THE FIRST 100TH ARITHMETIC NUMBER AND THE 1000TH AND THE 10000TH */
/* ALSO SHOW HOW MANY ARE COMPOSITE */
DECLARE ( DIVISOR$START, DIVISOR$END ) ADDRESS;
DECLARE ( A$COUNT, C$COUNT ) ADDRESS;
A$COUNT, C$COUNT, DIVISOR$START, DIVISOR$END = 0;
I, D$POS = 1;
DO WHILE( I <= 60000 AND A$COUNT < 10000 );
IF I > DIVISOR$END THEN DO;
/* PAST THE END OF THE DIGIT SUMS AND COUNTS - GET THE NEXT BATCH */
DIVISOR$START = DIVISOR$END + 1;
DIVISOR$END = DIVISOR$START + ( LAST( D$COUNT ) ) - 1;
DO I$POS = 1 TO LAST( D$COUNT );
D$COUNT( I$POS ), D$SUM( I$POS ) = 1;
END;
DO I = 2 TO DIVISOR$END;
DO J = I TO DIVISOR$END BY I;
IF J >= DIVISOR$START AND J <= DIVISOR$END THEN DO;
J$POS = J - ( DIVISOR$START - 1 );
D$COUNT( J$POS ) = D$COUNT( J$POS ) + 1;
D$SUM( J$POS ) = D$SUM( J$POS ) + I;
END;
END;
END;
I = DIVISOR$START;
D$POS = 1;
END;
IF D$SUM( D$POS ) MOD D$COUNT( D$POS ) = 0 THEN DO; /* I IS ARITHMETIC */
IF D$COUNT( D$POS ) > 2 THEN DO; /* I IS COMPOSITE */
C$COUNT = C$COUNT + 1;
END;
A$COUNT = A$COUNT + 1;
IF A$COUNT <= 100 THEN DO;
CALL PR$NUMBER4( I );
IF A$COUNT MOD 10 = 0 THEN CALL PR$NL;
END;
ELSE IF A$COUNT = 1000 OR A$COUNT = 10000 THEN DO;
CALL PR$NL;
CALL PR$STRING( .'THE $' );
CALL PR$NUMBER( A$COUNT );
CALL PR$STRING( .'TH ARITHMETIC NUMBER IS: $' );
CALL PR$NUMBER( I );
CALL PR$NL;
CALL PR$STRING( .' THERE ARE $' );
CALL PR$NUMBER( C$COUNT );
CALL PR$STRING( .' COMPOSITE NUMBERS UP TO $' );
CALL PR$NUMBER( I );
CALL PR$NL;
END;
END;
I = I + 1;
D$POS = D$POS + 1;
END;
EOF- Output:
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
THE 1000TH ARITHMETIC NUMBER IS: 1361
THERE ARE 782 COMPOSITE NUMBERS UP TO 1361
THE 10000TH ARITHMETIC NUMBER IS: 12953
THERE ARE 8458 COMPOSITE NUMBERS UP TO 12953
Python
def factors(n: int):
f = set([1, n])
i = 2
while True:
j = n // i
if j < i:
break
if i * j == n:
f.add(i)
f.add(j)
i += 1
return f
arithmetic_count = 0
composite_count = 0
n = 1
while arithmetic_count <= 1000000:
f = factors(n)
if (sum(f)/len(f)).is_integer():
arithmetic_count += 1
if len(f) > 2:
composite_count += 1
if arithmetic_count <= 100:
print(f'{n:3d} ', end='')
if arithmetic_count % 10 == 0:
print()
if arithmetic_count in (1000, 10000, 100000, 1000000):
print(f'\n{arithmetic_count}th arithmetic number is {n}')
print(f'Number of composite arithmetic numbers <= {n}: {composite_count}')
n += 1
Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 100000th arithmetic number is 125587 Number of composite arithmetic numbers <= 125587: 88219 1000000th arithmetic number is 1228663 Number of composite arithmetic numbers <= 1228663: 905043 real 1m14.220s user 1m13.952s sys 0m0.005s
Quackery
factors is defined at Factors of an integer#Quackery.
isprime is defined at Primality by trial division#Quackery.
[ factors
0 over witheach +
swap size mod 0 = ] is arithmetic ( n --> b )
[ temp put [] 1
[ over size temp share < while
dup arithmetic if
[ tuck join swap ]
1+
again ]
drop
temp release ] is arithmetics ( n --> [ )
say "First 100 arithmetic numbers:"
cr
100 arithmetics echo
cr cr
say "1000th arithmetic number: "
1000 arithmetics
dup -1 peek
echo cr
say "Composites in first 1000: "
behead drop
0 swap witheach
[ isprime not + ]
echo
cr cr
say "10000th arithmetic number: "
10000 arithmetics
dup -1 peek
echo cr
say "Composites in first 10000: "
behead drop
0 swap witheach
[ isprime not + ]
echo
cr- Output:
First 100 arithmetic numbers: [ 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 ] 1000th arithmetic number: 1361 Composites in first 1000: 782 10000th arithmetic number: 12953 Composites in first 10000: 8458
Raku
use Prime::Factor;
use Lingua::EN::Numbers;
my @arithmetic = lazy (1..∞).hyper.grep: { my @div = .&divisors; @div.sum %% @div }
say "The first { .Int.&cardinal } arithmetic numbers:\n", @arithmetic[^$_].batch(10)».fmt("%{.chars}d").join: "\n" given 1e2;
for 1e3, 1e4, 1e5, 1e6 {
say "\nThe { .Int.&ordinal }: { comma @arithmetic[$_-1] }";
say "Composite arithmetic numbers ≤ { comma @arithmetic[$_-1] }: { comma +@arithmetic[^$_].grep({!.is-prime}) - 1 }";
}
The first one hundred arithmetic numbers: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The one thousandth: 1,361 Composite arithmetic numbers ≤ 1,361: 782 The ten thousandth: 12,953 Composite arithmetic numbers ≤ 12,953: 8,458 The one hundred thousandth: 125,587 Composite arithmetic numbers ≤ 125,587: 88,219 The one millionth: 1,228,663 Composite arithmetic numbers ≤ 1,228,663: 905,043
REXX
Libraries: How to use
Library: Numbers
Library: Functions
Version 1 Brute force
Libraries: How to use
Library: Settings
Library: Abend
Library: Functions
Library: Numbers
Just running over all integers and checking of they are arithmetic and perhaps composite.
include Settings
say version; say 'Arithmetic numbers'; say
numeric digits 9
a = 0; c = 0
do i = 1
/* Is the number arithmetic? */
if Arithmetic(i) then do
a = a+1
/* Is the number composite? */
if divi.0 > 2 then
c = c+1
/* Output control */
if a <= 100 then do
if a = 1 then
say 'First 100 arithmetic numbers are'
call Charout ,Right(i,4)
if a//10 = 0 then
say
if a = 100 then
say
end
if a = 100 | a = 1000 | a = 10000 | a = 100000 | a = 1000000 then do
say 'The' a'th arithmetic number is' i
say 'Of the first' a 'numbers' c 'are composite'
say
end
/* Max 1m, higher takes too long */
if a = 1000000 then
leave
end
end
say Format(Time('e'),,3) 'seconds'
exit
Arithmetic:
/* Is a number arithmetic? function */
procedure expose divi.
arg x
/* Cf definition */
s = Sigma(x)
if Iswhole(s/divi.0) then
return 1
else
return 0
include Numbers
include Functions
include Abend
- Output:
REXX-ooRexx_5.0.0(MT)_64-bit 6.05 23 Dec 2022 Arithmetic numbers First 100 arithmetic numbers are 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The 100th arithmetic number is 149 Of the first 100th numbers 65 are composite The 1000th arithmetic number is 1361 Of the first 1000th numbers 782 are composite The 10000th arithmetic number is 12953 Of the first 10000th numbers 8458 are composite The 100000th arithmetic number is 125587 Of the first 100000th numbers 88219 are composite The 1000000th arithmetic number is 1228663 Of the first 1000000th numbers 905043 are composite 231.412 seconds
Ring
// Author: Gal Zsolt - 2023.02.26.
see "works..." + nl
divisors = []
divSum = 0
limit = 20000
counta = 0
countb = 0
countCompa = 0
countCompb = 0
for n = 1 to limit
num = 0
divSum = 0
for m = 1 to n
if n%m = 0
num++
divSum = divSum + m
ok
next
for x = 1 to n
if divSum/num = x
add(divisors,n)
counta++
countb++
if counta < 1001
if not isPrime(n) and n!=1
countCompa++
ok
ok
if counta = 1000
countNuma = n
ok
if countb < 10001
if not isPrime(n) and n!=1
countCompb++
ok
ok
if countb = 10000
countNumb = n
exit 2
ok
ok
next
next
see "The first 100 arithmetic numbers are:" + nl + nl
row = 0
for n = 1 to 100
row++
see "" + divisors[n] + " "
if row%10=0
see nl
ok
next
see nl
see "1000th arithmetic number is " + countNuma + nl
see "Number of composite arithmetic numbers <= " + countNuma + ":" + countCompa + nl+nl
see "10000th arithmetic number is " + countNumb + nl
see "Number of composite arithmetic numbers <= " + countNumb + ":" + countCompb + nl
see "done..." + nl
func isPrime num
if (num <= 1) return 0 ok
if (num % 2 = 0 and num != 2) return 0 ok
for i = 3 to floor(num / 2) -1 step 2
if (num % i = 0) return 0 ok
next
return 1- Output:
works... The first 100 arithmetic numbers are: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 done...
RPL
≪ DIVIS ∑LIST LASTARG SIZE DUP UNROT MOD NOT SWAP 2 > R→C ≫ 'ARITHM' STO @ ( n → (arithmetic?,composite?) ) ≪ { 1 } 1 DO 1 + IF DUP ARITHM RE THEN SWAP OVER + SWAP END UNTIL OVER SIZE 100 ≥ END DROP ≫ 'TASK1' STO ≪ → x ≪ (1,0) 1 DO 1 + DUP ARITHM IF DUP RE THEN ROT + SWAP ELSE DROP END UNTIL OVER RE x ≥ END " o/w comp.= " + SWAP IM + ≫ ≫ 'TASK23' STO
1000 TASK1 1000 TASK23
- Output:
3: { 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 }
2: "1361 o/w comp.= 782."
1: "12953 o/w comp.= 8458."
Rust
fn divisor_count_and_sum(mut n: u32) -> (u32, u32) {
let mut divisor_count = 1;
let mut divisor_sum = 1;
let mut power = 2;
while (n & 1) == 0 {
divisor_count += 1;
divisor_sum += power;
power <<= 1;
n >>= 1;
}
let mut p = 3;
while p * p <= n {
let mut count = 1;
let mut sum = 1;
power = p;
while n % p == 0 {
count += 1;
sum += power;
power *= p;
n /= p;
}
divisor_count *= count;
divisor_sum *= sum;
p += 2;
}
if n > 1 {
divisor_count *= 2;
divisor_sum *= n + 1;
}
(divisor_count, divisor_sum)
}
fn main() {
let mut arithmetic_count = 0;
let mut composite_count = 0;
let mut n = 1;
while arithmetic_count <= 1000000 {
let (divisor_count, divisor_sum) = divisor_count_and_sum(n);
if divisor_sum % divisor_count != 0 {
n += 1;
continue;
}
arithmetic_count += 1;
if divisor_count > 2 {
composite_count += 1;
}
if arithmetic_count <= 100 {
print!("{:3} ", n);
if arithmetic_count % 10 == 0 {
println!();
}
}
if arithmetic_count == 1000
|| arithmetic_count == 10000
|| arithmetic_count == 100000
|| arithmetic_count == 1000000
{
println!("\n{}th arithmetic number is {}", arithmetic_count, n);
println!(
"Number of composite arithmetic numbers <= {}: {}",
n, composite_count
);
}
n += 1;
}
}
- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 100000th arithmetic number is 125587 Number of composite arithmetic numbers <= 125587: 88219 1000000th arithmetic number is 1228663 Number of composite arithmetic numbers <= 1228663: 905043
Scala
object ArithmeticNumbers extends App {
var arithmeticCount = 0
var compositeCount = 0
var n = 1
while (arithmeticCount <= 1_000_000) {
val factors = findFactors(n)
val sum = factors.sum
if (sum % factors.size == 0) {
arithmeticCount += 1
if (factors.size > 2) compositeCount += 1
if (arithmeticCount <= 100) {
print(f"$n%3d" + (if (arithmeticCount % 10 == 0) "\n" else " "))
}
if (List(1_000, 10_000, 100_000, 1_000_000).contains(arithmeticCount)) {
println()
println(s"${arithmeticCount}th arithmetic number is $n")
println(s"Number of composite arithmetic numbers <= $n: $compositeCount")
}
}
n += 1
}
def findFactors(number: Int): Set[Int] = {
(1 to number).filter(number % _ == 0).toSet
}
}
- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th arithmetic number is 1361 Number of composite arithmetic numbers <= 1361: 782 10000th arithmetic number is 12953 Number of composite arithmetic numbers <= 12953: 8458 100000th arithmetic number is 125587 Number of composite arithmetic numbers <= 125587: 88219 1000000th arithmetic number is 1228663 Number of composite arithmetic numbers <= 1228663: 905043
SETL
program arithmetic_numbers;
[divsum, divcount] := calcdivsums(130000);
print("First 100 arithmetic numbers:");
loop for nth in [1..100000] do
loop until divsum(num) mod divcount(num) = 0 do num +:= 1; end loop;
comp +:= if num>1 and divsum(num) /= num+1 then 1 else 0 end if;
if nth <= 100 then
putchar(rpad(str num, 5));
if nth mod 10 = 0 then print(); end if;
end if;
if nth in [1000, 10000, 100000] then
print("The " + nth + "th arithmetic number is " + num + ".");
print("Of the first " + nth + " arithmetic numbers, " +
comp + " are composite.");
end if;
end loop;
proc calcdivsums(m);
sums := [];
counts := [];
loop for d in [1..m] do
loop for n in [d, d*2..m] do
sums(n) +:= d;
counts(n) +:= 1;
end loop;
end loop;
return [sums, counts];
end proc;
end program;- Output:
First 100 arithmetic numbers: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The 1000th arithmetic number is 1361. Of the first 1000 arithmetic numbers, 782 are composite. The 10000th arithmetic number is 12953. Of the first 10000 arithmetic numbers, 8458 are composite. The 100000th arithmetic number is 125587. Of the first 100000 arithmetic numbers, 88219 are composite.
VBScript
'arithmetic numbers
'run with CScript
function isarit_compo(i)
cnt=0
sum=0
for j=1 to sqr(i)
if (i mod j)=0 then
k=i\j
if k=j then
cnt=cnt+1:sum=sum+j
else
cnt=cnt+2:sum=sum+j+k
end if
end if
next
avg= sum/cnt
isarit_compo= array((fix(avg)=avg),-(cnt>2))
end function
function rpad(a,n) rpad=right(space(n)&a,n) :end function
dim s1
sub print(s)
s1=s1& rpad(s,4)
if len(s1)=40 then wscript.stdout.writeline s1:s1=""
end sub
'main program
cntr=0
cntcompo=0
i=1
wscript.stdout.writeline "the first 100 arithmetic numbers are:"
do
a=isarit_compo(i)
if a(0) then
cntcompo=cntcompo+a(1)
cntr=cntr+1
if cntr<=100 then print i
if cntr=1000 then wscript.stdout.writeline vbcrlf&"1000th : "&rpad(i,6) & " nr composites " &rpad(cntcompo,6)
if cntr=10000 then wscript.stdout.writeline vbcrlf& "10000th : "&rpad(i,6) & " nr composites " &rpad(cntcompo,6)
if cntr=100000 then wscript.stdout.writeline vbcrlf &"100000th : "&rpad(i,6) & " nr composites " &rpad(cntcompo,6):exit do
end if
i=i+1
loop
- Output:
the first 100 arithmetic numbers are: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1000th : 1361 nr composites 782 10000th : 12953 nr composites 8458 100000th : 125587 nr composites 88219
Wren
import "./math" for Int, Nums
import "./fmt" for Fmt
import "./sort" for Find
var arithmetic = [1]
var primes = []
var limit = 1e6
var n = 3
while (arithmetic.count < limit) {
var divs = Int.divisors(n)
if (divs.count == 2) {
primes.add(n)
arithmetic.add(n)
} else {
var mean = Nums.mean(divs)
if (mean.isInteger) arithmetic.add(n)
}
n = n + 1
}
System.print("The first 100 arithmetic numbers are:")
Fmt.tprint("$3d", arithmetic[0..99], 10)
for (x in [1e3, 1e4, 1e5, 1e6]) {
var last = arithmetic[x-1]
Fmt.print("\nThe $,dth arithmetic number is: $,d", x, last)
var pcount = Find.nearest(primes, last) + 1
if (!Int.isPrime(last)) pcount = pcount - 1
var comp = x - pcount - 1 // 1 is not composite
Fmt.print("The count of such numbers <= $,d which are composite is $,d.", last, comp)
}
- Output:
The first 100 arithmetic numbers are: 1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 The 1,000th arithmetic number is: 1,361 The count of such numbers <= 1,361 which are composite is 782. The 10,000th arithmetic number is: 12,953 The count of such numbers <= 12,953 which are composite is 8,458. The 100,000th arithmetic number is: 125,587 The count of such numbers <= 125,587 which are composite is 88,219. The 1,000,000th arithmetic number is: 1,228,663 The count of such numbers <= 1,228,663 which are composite is 905,043.
XPL0
int N, ArithCnt, CompCnt, Div, DivCnt, Sum, Quot;
[Format(4, 0);
N:= 1; ArithCnt:= 0; CompCnt:= 0;
repeat Div:= 1; DivCnt:= 0; Sum:= 0;
loop [Quot:= N/Div;
if Quot < Div then quit;
if Quot = Div and rem(0) = 0 then \N is a square
[Sum:= Sum+Quot; DivCnt:= DivCnt+1; quit];
if rem(0) = 0 then
[Sum:= Sum + Div + Quot;
DivCnt:= DivCnt+2;
];
Div:= Div+1;
];
if rem(Sum/DivCnt) = 0 then \N is arithmetic
[ArithCnt:= ArithCnt+1;
if ArithCnt <= 100 then
[RlOut(0, float(N));
if rem(ArithCnt/20) = 0 then CrLf(0);
];
if DivCnt > 2 then CompCnt:= CompCnt+1;
case ArithCnt of 1000, 10_000, 100_000, 1_000_000:
[CrLf(0);
IntOut(0, N); ChOut(0, 9\tab\);
IntOut(0, CompCnt);
]
other;
];
N:= N+1;
until ArithCnt >= 1_000_000;
]- Output:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33 35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60 61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92 93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119 123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149 1361 782 12953 8458 125587 88219 1228663 905043
Categories:
- Programming Tasks
- Solutions by Programming Task
- 11l
- Ada
- ALGOL 68
- APL
- AppleScript
- ARM Assembly
- Arturo
- AutoHotkey
- BASIC
- True BASIC
- XBasic
- Yabasic
- C
- C sharp
- C++
- Cowgol
- Delphi
- Draco
- EasyLang
- Factor
- FreeBASIC
- FutureBasic
- Go
- J
- Java
- Jq
- Julia
- Lua
- M2000 Interpreter
- Mathematica
- Wolfram Language
- Maxima
- Modula-2
- Nim
- Oberon-07
- Pascal
- Free Pascal
- Perl
- Ntheory
- Phix
- PL/M
- Python
- Quackery
- Raku
- REXX
- Ring
- RPL
- Rust
- Scala
- SETL
- VBScript
- Wren
- Wren-math
- Wren-fmt
- Wren-sort
- XPL0