Data commit

Task/Chowla-numbers/PowerBASIC/chowla-numbers.basic

@@ -0,0 +1,98 @@
+#COMPILE EXE
+#DIM ALL
+#COMPILER PBCC 6
+
+FUNCTION chowla(BYVAL n AS LONG) AS LONG
+REGISTER i AS LONG, j AS LONG
+LOCAL r AS LONG
+    i = 2
+    DO WHILE i * i <= n
+        j = n \ i
+        IF n MOD i = 0 THEN
+            r += i
+            IF i <> j THEN
+                r += j
+            END IF
+        END IF
+        INCR i
+    LOOP
+    FUNCTION = r
+END FUNCTION
+
+FUNCTION chowla1(BYVAL n AS QUAD) AS QUAD
+LOCAL i, j, r AS QUAD
+    i = 2
+    DO WHILE i * i <= n
+        j = n \ i
+        IF n MOD i = 0 THEN
+            r += i
+            IF i <> j THEN
+                r += j
+            END IF
+        END IF
+        INCR i
+    LOOP
+    FUNCTION = r
+END FUNCTION
+
+SUB sieve(BYVAL limit AS LONG, BYREF c() AS INTEGER)
+LOCAL i, j AS LONG
+REDIM c(limit - 1)
+    i = 3
+    DO WHILE i * 3 < limit
+        IF NOT c(i) THEN
+            IF chowla(i) = 0 THEN
+                j = 3 * i
+                DO WHILE j < limit
+                    c(j) = -1
+                    j += 2 * i
+                LOOP
+            END IF
+        END IF
+        i += 2
+    LOOP
+END SUB
+
+FUNCTION PBMAIN () AS LONG
+LOCAL i, count, limit, power AS LONG
+LOCAL c() AS INTEGER
+LOCAL s AS STRING
+LOCAL s30 AS STRING * 30
+LOCAL p, k, kk, r, ql AS QUAD
+    FOR i = 1 TO 37
+        s = "chowla(" & TRIM$(STR$(i)) & ") = " & TRIM$(STR$(chowla(i)))
+        CON.PRINT s
+    NEXT i
+    count = 1
+    limit = 10000000
+    power = 100
+    CALL sieve(limit, c())
+    FOR i = 3 TO limit - 1 STEP 2
+        IF ISFALSE c(i) THEN count += 1
+        IF i = power - 1 THEN
+            RSET s30 = FORMAT$(power, "#,##0")
+            s = "Count of primes up to " & s30 & " =" & STR$(count)
+            CON.PRINT s
+            power *= 10
+        END IF
+    NEXT i
+
+    ql = 2 ^ 61
+    k = 2: kk = 3
+    RESET count
+    DO
+        p = k * kk : IF p > ql THEN EXIT DO
+        IF chowla1(p) = p - 1 THEN
+            RSET s30 = FORMAT$(p, "#,##0")
+            s = s30 & " is a number that is perfect"
+            CON.PRINT s
+            count += 1
+        END IF
+        k = kk + 1 : kk += k
+    LOOP
+    s = "There are" & STR$(count) & " perfect numbers <= " & FORMAT$(ql, "#,##0")
+    CON.PRINT s
+
+    CON.PRINT "press any key to exit program"
+    CON.WAITKEY$
+END FUNCTION