Data update

Task/Arithmetic-numbers/PascalABC.NET/arithmetic-numbers.pas

@@ -0,0 +1,49 @@
+function Factors(n: integer): set of integer;
+begin
+  Result := SetOf(1, n);
+  var i := 2;
+  while True do
+  begin
+    var j := n div i;
+    if j < i then
+      break;
+    if i * j = n then
+      Result += SetOf(i,j);
+    i += 1;
+  end;
+end;
+
+begin
+  var arithmeticCount := 0;
+  var compositeCount := 0;
+  var n := 1;
+
+  while arithmeticCount <= 1000000 do
+  begin
+    var f := Factors(n);
+    var avg := f.Average;
+
+    if frac(avg) = 0 then
+    begin
+      arithmeticCount += 1;
+
+      if f.Count > 2 then
+        compositeCount += 1;
+
+      if arithmeticCount <= 100 then
+      begin
+        Print($'{n,3} ');
+        if arithmeticCount mod 10 = 0 then
+          Println;
+      end;
+
+      if arithmeticCount in [1000, 10000, 100000, 1000000] then
+      begin
+        Println(NewLine + $'{arithmeticCount}th arithmetic number is {n}');
+        Println($'Number of composite arithmetic numbers <= {n}: {compositeCount}');
+      end;
+    end;
+
+    n += 1;
+  end;
+end.