Data commit

Task/Arithmetic-numbers/00-META.yaml

@@ -0,0 +1,2 @@
+---
+from: http://rosettacode.org/wiki/Arithmetic_numbers

Task/Arithmetic-numbers/00-TASK.txt

@@ -0,0 +1,29 @@
+;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 '''x'''th 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
+
+* [[wp:Arithmetic_number|Wikipedia: Arithmetic number]]
+* [[oeis:A003601|OEIS:A003601 - Numbers n such that the average of the divisors of n is an integer]]
+<br><br>
+
+

Task/Arithmetic-numbers/11l/arithmetic-numbers.11l

@@ -0,0 +1,30 @@
+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++

Task/Arithmetic-numbers/ALGOL-68/arithmetic-numbers.alg

@@ -0,0 +1,49 @@
+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

Task/Arithmetic-numbers/Ada/arithmetic-numbers.ada

@@ -0,0 +1,64 @@
+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;

Task/Arithmetic-numbers/Arturo/arithmetic-numbers.arturo

@@ -0,0 +1,28 @@
+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

Task/Arithmetic-numbers/AutoHotkey/arithmetic-numbers-1.ahk

@@ -0,0 +1,25 @@
+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, ",")
+}

Task/Arithmetic-numbers/AutoHotkey/arithmetic-numbers-2.ahk

@@ -0,0 +1,10 @@
+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

Task/Arithmetic-numbers/C++/arithmetic-numbers.cpp

@@ -0,0 +1,57 @@
+#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;
+}

Task/Arithmetic-numbers/C/arithmetic-numbers.c

@@ -0,0 +1,55 @@
+#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;
+}

Task/Arithmetic-numbers/Delphi/arithmetic-numbers.delphi

@@ -0,0 +1,59 @@
+{{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.

Task/Arithmetic-numbers/EasyLang/arithmetic-numbers.easy

@@ -0,0 +1,38 @@
+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
+.

Task/Arithmetic-numbers/Factor/arithmetic-numbers.factor

@@ -0,0 +1,23 @@
+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

Task/Arithmetic-numbers/Free-Pascal/arithmetic-numbers-1.pas

@@ -0,0 +1,144 @@
+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.

Task/Arithmetic-numbers/Free-Pascal/arithmetic-numbers-2.pas

@@ -0,0 +1,41 @@
+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.

Task/Arithmetic-numbers/FreeBASIC/arithmetic-numbers.basic

@@ -0,0 +1,43 @@
+' 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

Task/Arithmetic-numbers/FutureBasic/arithmetic-numbers.basic

@@ -0,0 +1,77 @@
+' 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

Task/Arithmetic-numbers/Go/arithmetic-numbers.go

@@ -0,0 +1,41 @@
+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)
+    }
+}

Task/Arithmetic-numbers/J/arithmetic-numbers-1.j

@@ -0,0 +1,2 @@
+factors=: {{ */@>,{(^ [:i.1+])&.>/__ q:y}}
+isArith=: {{ (= <.) (+/%#) factors|y}}"0

Task/Arithmetic-numbers/J/arithmetic-numbers-2.j

@@ -0,0 +1,24 @@
+   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

Task/Arithmetic-numbers/Java/arithmetic-numbers.java

@@ -0,0 +1,49 @@
+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;
+	}
+
+}

Task/Arithmetic-numbers/Jq/arithmetic-numbers-1.jq

@@ -0,0 +1,6 @@
+# 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] + .;

Task/Arithmetic-numbers/Jq/arithmetic-numbers-2.jq

@@ -0,0 +1,21 @@
+# 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)));

Task/Arithmetic-numbers/Jq/arithmetic-numbers-3.jq

@@ -0,0 +1,18 @@
+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")

Task/Arithmetic-numbers/Julia/arithmetic-numbers.julia

@@ -0,0 +1,29 @@
+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

Task/Arithmetic-numbers/Lua/arithmetic-numbers.lua

@@ -0,0 +1,58 @@
+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

Task/Arithmetic-numbers/M2000-Interpreter/arithmetic-numbers.m2000

@@ -0,0 +1,24 @@
+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"

Task/Arithmetic-numbers/Mathematica/arithmetic-numbers.math

@@ -0,0 +1,50 @@
+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"}}]

Task/Arithmetic-numbers/Nim/arithmetic-numbers.nim

@@ -0,0 +1,39 @@
+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

Task/Arithmetic-numbers/PL-M/arithmetic-numbers.plm

@@ -0,0 +1,84 @@
+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

Task/Arithmetic-numbers/Pascal/arithmetic-numbers.pas

@@ -0,0 +1,56 @@
+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.

Task/Arithmetic-numbers/Perl/arithmetic-numbers.pl

@@ -0,0 +1,24 @@
+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];
+}

Task/Arithmetic-numbers/Phix/arithmetic-numbers.phix

@@ -0,0 +1,27 @@
+(phixonline)-->
+ <span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
+ <span style="color: #004080;">sequence</span> <span style="color: #000000;">arithmetic</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}</span>
+ <span style="color: #004080;">integer</span> <span style="color: #000000;">composite</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">get_arithmetic</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">nth</span><span style="color: #0000FF;">)</span>
+     <span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">arithmetic</span><span style="color: #0000FF;">[$]+</span><span style="color: #000000;">1</span>
+     <span style="color: #008080;">while</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">arithmetic</span><span style="color: #0000FF;">)<</span><span style="color: #000000;">nth</span> <span style="color: #008080;">do</span>
+         <span style="color: #004080;">sequence</span> <span style="color: #000000;">divs</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">factors</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
+         <span style="color: #008080;">if</span> <span style="color: #7060A8;">remainder</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #000000;">divs</span><span style="color: #0000FF;">),</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">divs</span><span style="color: #0000FF;">))=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
+             <span style="color: #000000;">composite</span> <span style="color: #0000FF;">+=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">divs</span><span style="color: #0000FF;">)></span><span style="color: #000000;">2</span>
+             <span style="color: #000000;">arithmetic</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">n</span>
+         <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+         <span style="color: #000000;">n</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">arithmetic</span><span style="color: #0000FF;">[</span><span style="color: #000000;">nth</span><span style="color: #0000FF;">]</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">get_arithmetic</span><span style="color: #0000FF;">(</span><span style="color: #000000;">100</span><span style="color: #0000FF;">)</span>
+ <span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"The first 100 arithmetic numbers are:\n%s\n"</span><span style="color: #0000FF;">,</span>
+          <span style="color: #0000FF;">{</span><span style="color: #7060A8;">join_by</span><span style="color: #0000FF;">(</span><span style="color: #000000;">arithmetic</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" "</span><span style="color: #0000FF;">,</span><span style="color: #000000;">fmt</span><span style="color: #0000FF;">:=</span><span style="color: #008000;">"%3d"</span><span style="color: #0000FF;">)})</span>
+ <span style="color: #008080;">constant</span> <span style="color: #000000;">fmt</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"The %,dth arithmetic number is %,d up to which %,d are composite.\n"</span>
+ <span style="color: #008080;">for</span> <span style="color: #000000;">n</span> <span style="color: #008080;">in</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">1e3</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1e4</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1e5</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1e6</span><span style="color: #0000FF;">}</span> <span style="color: #008080;">do</span>
+     <span style="color: #004080;">integer</span> <span style="color: #000000;">nth</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">get_arithmetic</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
+     <span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">fmt</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">nth</span><span style="color: #0000FF;">,</span><span style="color: #000000;">composite</span><span style="color: #0000FF;">})</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+<!--

Task/Arithmetic-numbers/Python/arithmetic-numbers.py

@@ -0,0 +1,30 @@
+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

Task/Arithmetic-numbers/Quackery/arithmetic-numbers.quackery

@@ -0,0 +1,37 @@
+ [ 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

Task/Arithmetic-numbers/Raku/arithmetic-numbers.raku

@@ -0,0 +1,11 @@
+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 }";
+}

Task/Arithmetic-numbers/Ring/arithmetic-numbers.ring

@@ -0,0 +1,70 @@
+// 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

Task/Arithmetic-numbers/Rust/arithmetic-numbers.rust

@@ -0,0 +1,66 @@
+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;
+    }
+}

Task/Arithmetic-numbers/True-BASIC/arithmetic-numbers.basic

@@ -0,0 +1,41 @@
+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

Task/Arithmetic-numbers/VBScript/arithmetic-numbers.vb

@@ -0,0 +1,46 @@
+'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

Task/Arithmetic-numbers/Wren/arithmetic-numbers.wren

@@ -0,0 +1,30 @@
+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)
+}

Task/Arithmetic-numbers/XBasic/arithmetic-numbers.basic

@@ -0,0 +1,45 @@
+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

Task/Arithmetic-numbers/XPL0/arithmetic-numbers.xpl0

@@ -0,0 +1,31 @@
+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;
+]

Task/Arithmetic-numbers/Yabasic/arithmetic-numbers.basic

@@ -0,0 +1,40 @@
+// 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