Sorting algorithms/Permutation sort: Difference between revisions
added FreeBASIC
m (added whitespace before the TOC (table of contents), added a ;Task: (bold) header as well as a task requirement (the directive).) |
(added FreeBASIC) |
||
Line 524:
[2, 3, 8, 10, 10, 14, 17, 18, 19]
</pre>
=={{header|FreeBASIC}}==
<lang freebasic>' version 07-04-2017
' compile with: fbc -s console
' Heap's algorithm non-recursive
Function permutation_sort(a() As ULong) As ULong
Dim As ULong i, j, count
Dim As ULong lb = LBound(a), ub = UBound(a)
Dim As ULong n = ub - lb +1
Dim As ULong c(lb To ub)
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
count += 1
For j = lb To ub -1
If a(j) > a(j +1) Then j = 99
Next
If j < 99 Then Return count
c(i) += 1
i = 0
Else
c(i) = 0
i += 1
End If
Wend
End Function
' ------=< MAIN >=------
Dim As ULong k, p, arr(0 To 9)
Randomize Timer
Print "unsorted array"
For k = LBound(arr) To UBound(arr)
arr(k) = Rnd * 1000
Print arr(k) & IIf(k = UBound(arr), "", ", ");
Next
Print : Print
p = permutation_sort(arr())
Print "sorted array"
For k = LBound(arr) To UBound(arr)
Print arr(k) & IIf(k = UBound(arr), "", ", ");
Next
Print : Print
Print "sorted array in "; p; " permutations"
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</lang>
{{out}}
<pre>unsorted array
81, 476, 915, 357, 934, 683, 413, 450, 2, 407
sorted array
2, 81, 357, 407, 413, 450, 476, 683, 915, 934
sorted array in 1939104 permutations</pre>
=={{header|Go}}==
| |||