Data commit

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