September 2017 Update

Task/Permutations-Derangements/FreeBASIC/permutations-derangements.freebasic

@@ -0,0 +1,94 @@
+' version 08-04-2017
+' compile with: fbc -s console
+
+Sub Subfactorial(a() As ULongInt)
+
+    Dim As ULong i
+    Dim As ULongInt num
+
+    For i = 0 To UBound(a)
+        num = num * i
+        If (i And 1) = 1 Then
+            num -= 1
+        Else
+            num += 1
+        End If
+        a(i) = num
+    Next
+
+End Sub
+
+' Heap's algorithm non-recursive
+Function perms_derange(n As ULong, flag As Long = 0) As ULongInt
+    ' fast upto n < 12
+    If n = 0 Then Return 1
+
+    Dim As ULong i, j, c1, count
+    Dim As ULong a(0 To n -1), c(0 To n -1)
+
+    For j = 0 To n -1
+        a(j) = j
+    Next
+
+    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
+            If j < 99 Then
+                count += 1
+                If flag = 0 Then
+                    c1 += 1
+                    For j = 0 To n -1
+                        Print a(j);
+                    Next
+                    If c1 > 12 Then
+                        Print : c1 = 0
+                    Else
+                        Print " ";
+                    End If
+                End If
+            End If
+            c(i) += 1
+            i = 0
+        Else
+            c(i) = 0
+            i += 1
+        End If
+    Wend
+    If flag = 0 AndAlso c1 <> 0 Then Print
+    Return count
+
+End Function
+
+' ------=< MAIN >=------
+
+Dim As ULong i, n = 4
+Dim As ULongInt subfac(20)
+
+Subfactorial(subfac())
+
+Print "permutations derangements for n = "; n
+i = perms_derange(n)
+Print "count returned = "; i; " , !"; n; " calculated = "; subfac(n)
+
+Print
+Print "count  counted subfactorial"
+Print "---------------------------"
+For i = 0 To 9
+    Print Using " ###: ########     ########"; i; perms_derange(i, 1); subfac(i)
+Next
+For i = 10 To 20
+    Print Using " ###:   ###################"; i; subfac(i)
+Next
+
+' empty keyboard buffer
+While InKey <> "" : Wend
+Print : Print "hit any key to end program"
+Sleep
+End