RosettaCodeData/Task/Permutations-Derangements/BBC-BASIC/permutations-derangements.b...

76 lines
2.1 KiB
Plaintext

PRINT"Derangements for the numbers 0,1,2,3 are:"
Count% = FN_Derangement_Generate(4,TRUE)
PRINT'"Table of n, counted derangements, calculated derangements :"
FOR I% = 0 TO 9
PRINT I%, FN_Derangement_Generate(I%,FALSE), FN_SubFactorial(I%)
NEXT
PRINT'"There is no long int in BBC BASIC!"
PRINT"!20 = ";FN_SubFactorial(20)
END
DEF FN_Derangement_Generate(N%, fPrintOut)
LOCAL A%(), O%(), C%, D%, I%, J%
IF N% = 0 THEN = 1
DIM A%(N%-1), O%(N%-1)
FOR I% = 0 TO N%-1 : A%(I%) = I% : NEXT
O%() = A%()
FOR I% = 0 TO FN_Factorial(DIM(A%(),1)+1)-1
PROC_NextPermutation(A%())
D% = TRUE
FOR J%=0 TO N%-1
IF A%(J%) = O%(J%) THEN D% = FALSE
NEXT
IF D% THEN
C% += 1
IF fPrintOut THEN
FOR K% = 0 TO N%-1
PRINT ;A%(K%);" ";
NEXT
PRINT
ENDIF
ENDIF
NEXT
= C%
DEF PROC_NextPermutation(A%())
LOCAL first, last, elementcount, pos
elementcount = DIM(A%(),1)
IF elementcount < 1 THEN ENDPROC
pos = elementcount-1
WHILE A%(pos) >= A%(pos+1)
pos -= 1
IF pos < 0 THEN
PROC_Permutation_Reverse(A%(), 0, elementcount)
ENDPROC
ENDIF
ENDWHILE
last = elementcount
WHILE A%(last) <= A%(pos)
last -= 1
ENDWHILE
SWAP A%(pos), A%(last)
PROC_Permutation_Reverse(A%(), pos+1, elementcount)
ENDPROC
DEF PROC_Permutation_Reverse(A%(), firstindex, lastindex)
LOCAL first, last
first = firstindex
last = lastindex
WHILE first < last
SWAP A%(first), A%(last)
first += 1
last -= 1
ENDWHILE
ENDPROC
DEF FN_Factorial(N) : IF (N = 1) OR (N = 0) THEN =1 ELSE = N * FN_Factorial(N-1)
DEF FN_SubFactorial(N) : IF N=0 THEN =1 ELSE =N*FN_SubFactorial(N-1)+-1^N
REM Or you could use:
REM DEF FN_SubFactorial(N) : IF N<1 THEN =1 ELSE =(N-1)*(FN_SubFactorial(N-1)+FN_SubFactorial(N-2))