Permutations/Derangements: Difference between revisions

=={{header|FreeBASIC}}==

<lang freebasic>' 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</lang>

{{out}}

<pre>permutations derangements for n = 4

1302 3012 1032 2031 2301 3201 3210 2310 1230

count returned = 9 , !4 calculated = 9

count counted subfactorial

---------------------------

0: 1 1

1: 0 0

2: 1 1

3: 2 2

4: 9 9

5: 44 44

6: 265 265

7: 1854 1854

8: 14833 14833

9: 133496 133496

10: 1334961

11: 14684570

12: 176214841

13: 2290792932

14: 32071101049

15: 481066515734

16: 7697064251745

17: 130850092279664

18: 2355301661033953

19: 44750731559645106

20: 895014631192902121</pre>