Arithmetic numbers: Difference between revisions
Add Modula-2
Drkameleon (talk | contribs) (added Arturo) |
Not a robot (talk | contribs) (Add Modula-2) |
||
| (18 intermediate revisions by 10 users not shown) | |||
Line 252:
The 100000th arithmetic number is: 125587
There are 88219 composite arithmetic numbers up to 125587
</pre>
=={{header|APL}}==
{{works with|Dyalog APL}}
<syntaxhighlight lang="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
}</syntaxhighlight>
{{out}}
<pre>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.</pre>
=={{header|AppleScript}}==
<syntaxhighlight lang="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()</syntaxhighlight>
{{output}}
<syntaxhighlight lang="applescript">"
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)"</syntaxhighlight>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi <br> or android 32 bits with application Termux}}
<syntaxhighlight lang 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"
</syntaxhighlight>
{{Out}}
<pre>
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
</pre>
Line 580 ⟶ 1,149:
Number of composite arithmetic numbers <= 1228663: 905043
</pre>
=={{header|C#}}==
{{trans|Java}}
<syntaxhighlight lang="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;
}
}
</syntaxhighlight>
{{out}}
<pre>
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
</pre>
=={{header|C++}}==
Line 667 ⟶ 1,323:
sys 0m0.003s</pre>
=={{header|Cowgol}}==
<syntaxhighlight lang="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;</syntaxhighlight>
{{out}}
<pre>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</pre>
=={{header|Delphi}}==
<syntaxhighlight lang="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.
</syntaxhighlight>
{{out}}
<pre>
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
</pre>
=={{header|Draco}}==
<syntaxhighlight lang="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</syntaxhighlight>
{{out}}
<pre>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.</pre>
=={{header|EasyLang}}==
{{Trans|FreeBASIC}}
<syntaxhighlight lang="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
.
</syntaxhighlight>
=={{header|Factor}}==
{{works with|Factor|0.99 2022-04-03}}
Line 778 ⟶ 1,717:
Took 38.42344779999985 seconds on i5 @3.20 GHz</pre>
=={{header|FutureBasic}}==
Line 1,036 ⟶ 1,897:
+/0=1 p: (1e6 {. examples) -. 1
905043</syntaxhighlight>
=={{header|Java}}==
<syntaxhighlight lang="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;
}
}
</syntaxhighlight>
{{ out }}
<pre>
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
</pre>
=={{header|jq}}==
Line 1,353 ⟶ 2,293:
10000 12953 8458
100000 125587 88219</pre>
=={{header|Maxima}}==
<syntaxhighlight lang="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(%%));
</syntaxhighlight>
{{out}}
<pre>
[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
</pre>
=={{header|Modula-2}}==
<syntaxhighlight lang="modula2">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.</syntaxhighlight>
{{out}}
<pre>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</pre>
=={{header|Nim}}==
<syntaxhighlight lang="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
</syntaxhighlight>
{{out}}
<pre>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
</pre>
=={{header|Pascal}}==
Line 2,124 ⟶ 3,252:
Number of composite arithmetic numbers <= 12953: 8458
done...
</pre>
=={{header|RPL}}==
{{works with|HP|49g}}
≪
DIVIS ∑LIST LASTARG SIZE DUP UNROT MOD NOT
SWAP 2 > R→C
≫ '<span style="color:blue">ARITHM</span>' STO <span style="color:grey">@ ( n → (arithmetic?,composite?) ) </span>
≪ { 1 } 1
'''DO'''
1 +
'''IF''' DUP <span style="color:blue">ARITHM</span> RE '''THEN''' SWAP OVER + SWAP '''END'''
'''UNTIL''' OVER SIZE 100 ≥ '''END''' DROP
≫ '<span style="color:blue">TASK1</span>' STO
≪ → x
≪ (1,0) 1
'''DO'''
1 +
DUP <span style="color:blue">ARITHM</span>
'''IF''' DUP RE '''THEN''' ROT + SWAP '''ELSE''' DROP '''END'''
'''UNTIL''' OVER RE x ≥ '''END'''
" o/w comp.= " + SWAP IM +
≫ ≫ '<span style="color:blue">TASK23</span>' STO
1000 <span style="color:blue">TASK1</span> 1000 <span style="color:blue">TASK23</span>
{{out}}
<pre>
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."
</pre>
Line 2,220 ⟶ 3,380:
Number of composite arithmetic numbers <= 1228663: 905043
</pre>
=={{header|Scala}}==
{{trans|Java}}
<syntaxhighlight lang="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
}
}
</syntaxhighlight>
{{out}}
<pre>
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
</pre>
=={{header|SETL}}==
<syntaxhighlight lang="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;</syntaxhighlight>
{{out}}
<pre>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.</pre>
=={{header|VBScript}}==
Line 2,293 ⟶ 3,564:
</pre>
</small>
=={{header|Wren}}==
Line 2,299 ⟶ 3,569:
{{libheader|Wren-fmt}}
{{libheader|Wren-sort}}
<syntaxhighlight lang="
import "./fmt" for Fmt
import "./sort" for Find
| |||