RosettaCodeData/Task/Permutations-by-swapping/FreeBASIC/permutations-by-swapping.basic

60 lines
1.1 KiB
Plaintext

' version 31-03-2017
' compile with: fbc -s console
Sub perms(n As ULong)
Dim As Long p(n), i, k, s = 1
For i = 1 To n
p(i) = -i
Next
Do
Print "Perm: [ ";
For i = 1 To n
Print Abs(p(i)); " ";
Next
Print "] Sign: "; s
k = 0
For i = 2 To n
If p(i) < 0 Then
If Abs(p(i)) > Abs(p(i -1)) Then
If Abs(p(i)) > Abs(p(k)) Then k = i
End If
End If
Next
For i = 1 To n -1
If p(i) > 0 Then
If Abs(p(i)) > Abs(p(i +1)) Then
If Abs(p(i)) > Abs(p(k)) Then k = i
End If
End If
Next
If k Then
For i = 1 To n
If Abs(p(i)) > Abs(p(k)) Then p(i) = -p(i)
Next
i = k + Sgn(p(k))
Swap p(k), p(i)
s = -s
End If
Loop Until k = 0
End Sub
' ------=< MAIN >=------
perms(3)
print
perms(4)
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End