September 2017 Update

Task/Sorting-algorithms-Permutation-sort/FreeBASIC/sorting-algorithms-permutation-sort.freebasic

@@ -0,0 +1,59 @@
+' 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