53 lines
966 B
Plaintext
53 lines
966 B
Plaintext
' version 07-04-2017
|
|
' compile with: fbc -s console
|
|
|
|
' Heap's algorithm non-recursive
|
|
Sub perms(n As Long)
|
|
|
|
Dim As ULong i, j, count = 1
|
|
Dim As ULong a(0 To n -1), c(0 To n -1)
|
|
|
|
For j = 0 To n -1
|
|
a(j) = j +1
|
|
Print a(j);
|
|
Next
|
|
Print " ";
|
|
|
|
i = 0
|
|
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
|
|
Print a(j);
|
|
Next
|
|
count += 1
|
|
If count = 12 Then
|
|
Print
|
|
count = 0
|
|
Else
|
|
Print " ";
|
|
End If
|
|
c(i) += 1
|
|
i = 0
|
|
Else
|
|
c(i) = 0
|
|
i += 1
|
|
End If
|
|
Wend
|
|
|
|
End Sub
|
|
|
|
' ------=< MAIN >=------
|
|
|
|
perms(4)
|
|
|
|
' empty keyboard buffer
|
|
While Inkey <> "" : Wend
|
|
Print : Print "hit any key to end program"
|
|
Sleep
|
|
End
|