Sorting algorithms/Permutation sort
Permutation sort, which proceeds by generating the possible permutations of the input array/list until discovering the sorted one.
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:
Heap sort | Merge sort | Patience sort | Quick sort
O(n log2n) sorts
Shell Sort
O(n2) 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
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>
Common Lisp
Too bad sorted?
vector code has to be copypasta'd. Could use map nil but that would in turn make it into spaghetti code.
The nth-permutation
function is some classic algorithm from Wikipedia.
<lang lisp>(defun factorial (n)
(loop for result = 1 then (* i result) for i from 2 to n finally (return result)))
(defun nth-permutation (k sequence)
(if (zerop (length sequence)) (coerce () (type-of sequence)) (let ((seq (etypecase sequence (vector (copy-seq sequence)) (sequence (coerce sequence 'vector))))) (loop for j from 2 to (length seq) do (setq k (truncate (/ k (1- j)))) do (rotatef (aref seq (mod k j)) (aref seq (1- j))) finally (return (coerce seq (type-of sequence)))))))
(defun sortedp (fn sequence)
(etypecase sequence (list (loop for previous = #1='#:foo then i for i in sequence always (or (eq previous #1#) (funcall fn i previous)))) ;; copypasta (vector (loop for previous = #1# then i for i across sequence always (or (eq previous #1#) (funcall fn i previous))))))
(defun permutation-sort (fn sequence)
(loop for i below (factorial (length sequence)) for permutation = (nth-permutation i sequence) when (sortedp fn permutation) do (return permutation)))</lang>
<lang lisp>CL-USER> (time (permutation-sort #'> '(8 3 10 6 1 9 7 2 5 4))) Evaluation took:
5.292 seconds of real time 5.204325 seconds of total run time (5.176323 user, 0.028002 system) [ Run times consist of 0.160 seconds GC time, and 5.045 seconds non-GC time. ] 98.34% CPU 12,337,938,025 processor cycles 611,094,240 bytes consed
(1 2 3 4 5 6 7 8 9 10)</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
<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>
<lang haskell>import Data.List (permutations)
permutationSort l = head [p | p <- permutations l, sorted p]
sorted (e1 : e2 : r) = e1 <= e2 && sorted (e2 : r) sorted _ = True</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>
J
A function to locate the permuation index, in the naive manner prescribed by the task:
ps =:(1+])^:((-.@-:/:~)@A.~)^:_ 0:
Of course, this can be calculated much more directly (and efficiently):
ps =: A.@:/:
Either way:
list =: 2 7 4 3 5 1 0 9 8 6 ps list 2380483 2380483 A. list 0 1 2 3 4 5 6 7 8 9 (A.~ps) list 0 1 2 3 4 5 6 7 8 9
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
<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
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
. 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>
Ursala
Standard library functions to generate permutations and test for ordering by a given predicate are used. <lang Ursala>
- import std
permsort "p" = ~&ihB+ ordered"p"*~+ permutations
- cast %sL
example = permsort(lleq) <'pmf','oao','ejw','hhp','oqh','ock','dwj'></lang>
output:
<'dwj','ejw','hhp','oao','ock','oqh','pmf'>