RosettaCodeData/Task/Permutations-Derangements/QBasic/permutations-derangements.b...

71 lines
1.6 KiB
Plaintext

' 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