Data commit

Task/Permutations-Derangements/QBasic/permutations-derangements.basic

@@ -0,0 +1,70 @@
+' Heap's algorithm non-recursive
+FUNCTION permsderange (n!, flag!)
+    IF n = 0 THEN permsderange = 1
+
+    DIM a!(0 TO n), c!(0 TO n)
+
+    FOR j = 0 TO n - 1: a(j) = j: NEXT j
+
+    WHILE i < n
+        IF c(i) < i THEN
+            IF (i AND 1) = 0 THEN
+                SWAP a(0), a(i)
+            ELSE
+                SWAP a(c(i)), a(i)
+            END IF
+            FOR j = 0 TO n - 1
+                IF a(j) = j THEN j = 99
+            NEXT j
+            IF j < 99 THEN
+                count = count + 1
+                IF flag = 0 THEN
+                    c1 = c1 + 1
+                    FOR j = 0 TO n - 1
+                        PRINT a(j);
+                    NEXT j
+                    IF c1 > 12 THEN
+                        PRINT : c1 = 0
+                    ELSE
+                        PRINT
+                    END IF
+                END IF
+            END IF
+            c(i) = c(i) + 1
+            i = 0
+        ELSE
+            c(i) = 0
+            i = i + 1
+        END IF
+    WEND
+    IF flag = 0 AND c1 <> 0 THEN PRINT
+    permsderange = count
+END FUNCTION
+
+SUB Subfactorial (a!())
+    FOR i = 0 TO UBOUND(a)
+        num = num * i
+        IF (i AND 1) = 1 THEN
+            num = num - 1
+        ELSE
+            num = num + 1
+        END IF
+        a(i) = num
+    NEXT i
+END SUB
+
+n! = 4
+DIM subfac!(7)
+
+CALL Subfactorial(subfac())
+
+PRINT "permutations derangements for n = "; n
+i! = permsderange(n, 0)
+PRINT "count returned ="; i; " , !"; n; " calculated ="; subfac(n)
+
+PRINT
+PRINT "count  counted subfactorial"
+PRINT "---------------------------"
+FOR i = 0 TO 7
+    PRINT USING " ###: ########     ########"; i; permsderange(i, 1); subfac(i)
+NEXT i