I'm working on modernizing Rosetta Code's infrastructure. Starting with communications. Please accept this time-limited open invite to RC's Slack.. --Michael Mol (talk) 20:59, 30 May 2020 (UTC)

# Arithmetic numbers

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.

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

## 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 OVER 2 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    ODEND`
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
```

## BASIC

### True BASIC

Translation of: FreeBASIC
`LET n = 1DO   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+1LOOP UNTIL arithcnt >= 1000000END`
Output:
`Same as FreeBASIC entry.`

### XBasic

Works with: Windows XBasic
Translation of: FreeBASIC
`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 NLOOP UNTIL ArithCnt >= 1e6 END FUNCTIONEND PROGRAM`
Output:
`Same as FreeBASIC entry.`

### Yabasic

Translation of: FreeBASIC
`// 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 + 1until 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++

`#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```

## Factor

Works with: Factor version 0.99 2022-04-03
`USING: combinators formatting grouping io kernel listslists.lazy math math.functions math.primes math.primes.factorsmath.statistics math.text.english prettyprint sequencestools.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:" print100 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

Translation of: Delphi
`' Rosetta Code problem: https://rosettacode.org/wiki/Arithmetic_numbers' by Jjuanhdez, 06/2022 Dim As Double t0 = TimerDim As Integer N = 1, ArithCnt = 0, CompCnt = 0Dim 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 += 1Loop Until ArithCnt >= 1e6Print !"\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```

## 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;beginN:= 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;        enduntil   ArithCnt >= 1000000;WriteLn;end; beginArithmeticNumbers;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
```

## Go

Translation of: Wren
`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`

`   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 105107 109 110 111 113 114 115 116 118 119123 125 126 127 129 131 132 133 134 135137 138 139 140 141 142 143 145 147 149   (1e3-1){examples NB. 0 is first1361   (1e4-1){examples12953   +/0=1 p: (1e3 {. examples) -. 1782   +/0=1 p: (1e4 {. examples) -. 18458   +/0=1 p: (1e5 {. examples) -. 188219   +/0=1 p: (1e6 {. examples) -. 1905043`

## 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)) == 0end function arithmetic(n)    i, arr = 1, Int[]    while length(arr) < n        isarithmetic(i) && push!(arr, i)        i += 1    end    return arrend 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
```

## Pascal

Works with: GNU Pascal
and Free Pascal too.
` program ArithmeiticNumbers; procedure ArithmeticNumbers;var N, ArithCnt, CompCnt, DDiv: longint;var DivCnt, Sum, Quot, Rem: longint;beginN:= 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;        enduntil   ArithCnt >= 1000000;WriteLn;end; beginArithmeticNumbers;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

Translation of: Raku
Library: ntheory
`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 loop, however the formal language specification does not actually guarantee that the value of composite won't be output as it was before the function call is made. 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, 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.
```

## 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 = 0composite_count = 0n = 1while 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```

## Raku

`use Prime::Factor;use Lingua::EN::Numbers; my @arithmetic = lazy (1..∞).hyper.grep: { my @div = .&divisors; (@div.sum / [email protected]div).narrow ~~ Int } 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 [email protected][^\$_].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```

## Rust

Translation of: C
`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
```

## Wren

Library: Wren-math
Library: Wren-fmt
Library: Wren-sort
`import "./math" for Int, Numsimport "./fmt" for Fmtimport "./sort" for Find var arithmetic = [1]var primes = []var limit = 1e6var n = 3while (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
```