Sorting algorithms/Permutation sort

Sorting algorithms/Permutation sort
You are encouraged to solve this task according to the task description, using any language you may know.

Sorting Algorithm
This is a sorting algorithm.   It may be applied to a set of data in order to sort it.     For comparing various sorts, see compare sorts.   For other sorting algorithms,   see sorting algorithms,   or:

O(n logn) sorts

Heap sort | Merge sort | Patience sort | Quick sort

O(n log²n) sorts
Shell Sort

O(n²) sorts
Bubble sort | Cocktail sort | Cocktail sort with shifting bounds | Comb sort | Cycle sort | Gnome sort | Insertion sort | Selection sort | Strand sort

other sorts
Bead sort | Bogo sort | Common sorted list | Composite structures sort | Custom comparator sort | Counting sort | Disjoint sublist sort | External sort | Jort sort | Lexicographical sort | Natural sorting | Order by pair comparisons | Order disjoint list items | Order two numerical lists | Object identifier (OID) sort | Pancake sort | Quickselect | Permutation sort | Radix sort | Ranking methods | Remove duplicate elements | Sleep sort | Stooge sort | [Sort letters of a string] | Three variable sort | Topological sort | Tree sort

Permutation sort, which proceeds by generating the possible permutations of the input array/list until discovering the sorted one.

Pseudocode:

while not InOrder(list) do
    nextPermutation(list)
done

AutoHotkey

ahk forum: discussion <lang AutoHotkey>MsgBox % PermSort("") MsgBox % PermSort("xxx") MsgBox % PermSort("3,2,1") MsgBox % PermSort("dog,000000,xx,cat,pile,abcde,1,cat")

PermSort(var) {  ; SORT COMMA SEPARATED LIST

  Local i, sorted
  StringSplit a, var, `,                ; make array, size = a0

  v0 := a0                              ; auxiliary array for permutations
  Loop %v0%
     v%A_Index% := A_Index

  While unSorted("a","v")               ; until sorted
     NextPerm("v")                      ; try new permutations

  Loop % a0                             ; construct string from sorted array
     i := v%A_Index%, sorted .= "," . a%i%
  Return SubStr(sorted,2)               ; drop leading comma

}

unSorted(a,v) {

  Loop % %a%0-1 {
     i := %v%%A_Index%, j := A_Index+1, j := %v%%j%
     If (%a%%i% > %a%%j%)
        Return 1
  }

}

NextPerm(v) { ; the lexicographically next LARGER permutation of v1..v%v0%

  Local i, i1, j, t
  i := %v%0, i1 := i-1
  While %v%%i1% >= %v%%i% {
     --i, --i1
     IfLess i1,1, Return 1 ; Signal the end
  }
  j := %v%0
  While %v%%j% <= %v%%i1%
     --j
  t := %v%%i1%, %v%%i1% := %v%%j%, %v%%j% := t,  j := %v%0
  While i < j
     t := %v%%i%, %v%%i% := %v%%j%, %v%%j% := t, ++i, --j

}</lang>

C++

Since next_permutation already returns whether the resulting sequence is sorted, the code is quite simple:

<lang cpp>#include <algorithm>

template<typename ForwardIterator>

void permutation_sort(ForwardIterator begin, ForwardIterator end)

{

 while (std::next_permutation(begin, end))
 {
   // -- this block intentionally left empty --
 }

} </lang>

D

<lang d>module permsort ; import std.stdio ;

bool isSorted(T)(inout T[] a) { // test if a is already sorted

 if(a.length <= 1) return true ; // 1-elemented/empty array is defined as sorted
 for(int i = 1 ; i < a.length ; i++) if(a[i] < a[i-1]) return false ;
 return true ;

}

Permutator!(T) Perm(T)(T[] x) { return Permutator!(T)(x) ; } struct Permutator(T) { // permutation iterator

 T[] s ;
 alias int delegate(inout T[]) DG ;
 void swap(int i, int j) { T tmp = s[i] ; s[i] = s[j] ; s[j] = tmp ; }   
 int opApply(DG dg) { return perm(0, s.length, dg) ; }
 int perm(int breaked, int n, DG dg) {   
   if(breaked) return breaked ;
   else if(n <= 1) breaked = dg(s) ;
   else {
     for(int i = 0 ; i < n ; i++) {
       if((breaked = perm(breaked, n - 1, dg)) != 0) break ;
       if(0 == (n % 2)) swap(i, n-1) ; else swap(0, n-1) ;
     }
   }
   return breaked ;
 }

}

T[] permsort(T)(T[] s) {

 foreach( p ; Perm(s))
   if(isSorted(p)) 
     return p.dup ;
 assert(false, "Should not be here") ;

}

void main() {

 auto p = [2,7,4,3,5,1,0,9,8,6] ;
 
 writefln("%s", permsort(p)) ;
 writefln("%s", p) ;                       // sort is in place
 writefln("%s", permsort(["rosetta"])) ;   // test with one element
 writefln("%s", permsort(cast(int[])[])) ; // test empty array

}</lang>

E

Translation of: C++

<lang e>def swap(container, ixA, ixB) {

   def temp := container[ixA]
   container[ixA] := container[ixB]
   container[ixB] := temp

}

/** Reverse order of elements of 'sequence' whose indexes are in the interval [ixLow, ixHigh] */ def reverseRange(sequence, var ixLow, var ixHigh) {

   while (ixLow < ixHigh) {
       swap(sequence, ixLow, ixHigh)
       ixLow += 1
       ixHigh -= 1
   }

}

/** Algorithm from <http://marknelson.us/2002/03/01/next-permutation>, allegedly from a version of the C++ STL */ def nextPermutation(sequence) {

   def last := sequence.size() - 1
   var i := last
   while (true) {
       var ii := i
       i -= 1
       if (sequence[i] < sequence[ii]) {
           var j := last + 1
           while (!(sequence[i] < sequence[j -= 1])) {} # buried side effect
           swap(sequence, i, j)
           reverseRange(sequence, ii, last)
           return true
       }
       if (i == 0) {
           reverseRange(sequence, 0, last)
           return false
       }
   }

}

/** Note: Worst case on sorted list */ def permutationSort(flexList) {

   while (nextPermutation(flexList)) {}

}</lang>

Haskell

<lang Haskell>import Control.Monad

permutationSort l = head [p | p <- permute l, sorted p]

sorted (e1 : e2 : r) = e1 <= e2 && sorted (e2 : r) sorted _ = True

permute = foldM (flip insert) []

insert e [] = return [e] insert e l@(h : t) = return (e : l) `mplus`

                      do { t' <- insert e t ; return (h : t') }</lang>

Icon

Partly from here <lang icon>procedure do_permute(l, i, n)

   if i >= n then
       return l
   else
       suspend l[i to n] <-> l[i] & do_permute(l, i+1, n)
end

procedure permute(l)
   suspend do_permute(l, 1, *l)
end

procedure sorted(l)
   local i
   if (i := 2 to *l & l[i] >= l[i-1]) then return &fail else return 1
end

procedure main()
   local l
   l := [6,3,4,5,1]
   |( l := permute(l) & sorted(l)) \1 & every writes(" ",!l)
end</lang>

OCaml

Like the Haskell version, except not evaluated lazily. So it always computes all the permutations, before searching through them for a sorted one; which is more expensive than necessary; unlike the Haskell version, which stops generating at the first sorted permutation. <lang ocaml>let rec sorted = function

| e1 :: e2 :: r -> e1 <= e2 && sorted (e2 :: r)
| _             -> true

let rec insert e = function

| []          -> e
| h :: t as l -> (e :: l) :: List.map (fun t' -> h :: t') (insert e t)

let permute xs = List.fold_right (fun h z -> List.concat (List.map (insert h) z))

                                xs [[]]

let permutation_sort l = List.find sorted (permute l)</lang>

Prolog

<lang prolog>permutation_sort(L,S) :- permutation(L,S), sorted(S).

sorted([]). sorted([_]). sorted([X,Y|ZS]) :- X =< Y, sorted([Y|ZS]).

permutation([],[]). permutation([X|XS],YS) :- permutation(XS,ZS), select(X,YS,ZS).</lang>

Python

Works with: Python version 2.6

<lang python>from itertools import permutations

in_order = lambda s: all(x <= s[i+1] for i,x in enumerate(s[:-1])) perm_sort = lambda s: (p for p in permutations(s) if in_order(p)).next()</lang>

Ruby

Works with: Ruby version 1.8.7+

The Array class has a permutation method that, with no arguments, returns an enumerable object. <lang ruby>class Array

 def permutationsort
   permutations = permutation
   begin
     perm = permutations.next
   end until perm.sorted?
   perm
 end
 
 def sorted?
   each_cons(2).all? {|a, b| a <= b}
 end

end</lang>

Scheme

<lang scheme>(define (insertions e list)

 (if (null? list)
     (cons (cons e list) list)
     (cons (cons e list)
           (map (lambda (tail) (cons (car list) tail))
                (insertions e (cdr list))))))

(define (permutations list)

 (if (null? list)
     (cons list list)
     (apply append (map (lambda (permutation)
                          (insertions (car list) permutation))
                        (permutations (cdr list))))))

(define (sorted? list)

 (cond ((null? list) #t)
       ((null? (cdr list)) #t)
       ((<= (car list) (cadr list)) (sorted? (cdr list)))
       (else #f)))

(define (permutation-sort list)

 (let loop ((permutations (permutations list)))
   (if (sorted? (car permutations))
       (car permutations)
       (loop (cdr permutations)))))</lang>

Tcl

using package struct::list from

Library: tcllib

. The firstperm procedure returns the lexicographically first permutation of the input list. However, to meet the letter of the problem, let's loop:

<lang tcl>package require Tcl 8.5 package require struct::list

proc inorder {list} {::tcl::mathop::<= {*}$list}

proc permutationsort {list} {

   while { ! [inorder $list]} {
       set list [struct::list nextperm $list]
   }
   return $list

}</lang>