' 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