Data commit

Task/Permutations-Derangements/BBC-BASIC/permutations-derangements.basic

@@ -0,0 +1,75 @@
+      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))