Sorting algorithms/Permutation sort
From Rosetta Code
(Redirected from Permutation Sort)
Sorting algorithms/Permutation sort is a programming task. Visitors like you are encouraged to solve it according to the task description, using any language they may happen to know.
Sorting Algorithm
This is a sorting algorithm. It may be applied to a set of data in order to sort it.
Pseudocode:
while not InOrder(list) do
nextPermutation(list)
done
Contents |
[edit] ActionScript
//recursively builds the permutations of permutable, appended to front, and returns the first sorted permutation it encounters
function permutations(front:Array, permutable:Array):Array {
//If permutable has length 1, there is only one possible permutation. Check whether it's sorted
if (permutable.length==1)
return isSorted(front.concat(permutable));
else
//There are multiple possible permutations. Generate them.
var i:uint=0,tmp:Array=null;
do
{
tmp=permutations(front.concat([permutable[i]]),remove(permutable,i));
i++;
}while (i< permutable.length && tmp == null);
//If tmp != null, it contains the sorted permutation. If it does not contain the sorted permutation, return null. Either way, return tmp.
return tmp;
}
//returns the array if it's sorted, or null otherwise
function isSorted(data:Array):Array {
for (var i:uint = 1; i < data.length; i++)
if (data[i]<data[i-1])
return null;
return data;
}
//returns a copy of array with the i'th element removed
function remove(array:Array, i:uint):Array {
return array.filter(function(item,index,array){return(index !=i)}) ;
}
//wrapper around the permutation function to provide a more logical interface
function permutationSort(array:Array):Array {
return permutations([],array);
}
[edit] AutoHotkey
ahk forum: discussion
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
}
[edit] C
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
typedef struct pi *Permutations;
/* Type of element on list to be sorted */
typedef const char *ElementType;
struct pi {
short list_size;
short *counts;
ElementType *crntperm;
};
Permutations PermutationIterator( ElementType *list, short listSize)
{
int ix;
Permutations p = (Permutations)malloc(sizeof(struct pi));
p->list_size = listSize;
p->counts = (short *)malloc( p->list_size * sizeof(short));
p->crntperm = (ElementType *)malloc( p->list_size * sizeof(ElementType));
for (ix=0; ix<p->list_size; ix++) {
p->counts[ix] = ix;
p->crntperm[ix] = list[ix];
}
return p;
}
void FreePermutations( Permutations p)
{
if (NULL == p) return;
if (p->crntperm) free(p->crntperm);
if (p->counts) free(p->counts);
free(p);
}
#define FREE_Permutations(pi) do {\
FreePermutations(pi); pi=NULL; } while(0)
ElementType *FirstPermutation(Permutations p)
{
return p->crntperm;
}
ElementType *NextPermutation( Permutations p)
{
int ix, j;
ElementType *crntp, t;
crntp = p->crntperm;
ix = 1;
do {
t = crntp[0];
for(j=0; j<ix; j++) crntp[j] = crntp[j+1];
crntp[ix] = t;
if (p->counts[ix] > 0) break;
ix += 1;
} while (ix < p->list_size);
if (ix == p->list_size) return NULL;
p->counts[ix] -= 1;
while(--ix) {
p->counts[ix] = ix;
}
return crntp;
}
/* Checks to see if list is ordered */
int isInOrder(ElementType *letrList, int size )
{
int j;
ElementType *p0 = letrList, *p1 = letrList+1;
for (j= 1; j<size; j++) {
if ( strcmp( *p0, *p1) > 0) break; /* compare strings */
// if ( *p0 > *p1) break; /* compare numeric values */
p0++, p1++;
}
return ( j == size );
}
int main( )
{
short size =5;
ElementType *prm;
ElementType mx[] = {"another", "sorted", "to_be", "list", "here's" };
Permutations pi = PermutationIterator(mx, size);
for ( prm = FirstPermutation(pi); prm; prm = NextPermutation(pi))
if (isInOrder( prm, size) ) break;
if (prm) {
int j;
printf("Sorted: ");
for (j=0; j<size; j++)
printf("%s ",prm[j]);
printf("\n");
}
FreePermutations( pi);
return 0;
}
[edit] Clojure
(use '[clojure.contrib.combinatorics :only (permutations)])
(defn permutation-sort [s]
(first (filter (partial apply <=) (permutations s))))
(permutation-sort [2 3 5 3 5])
[edit] 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.
(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)))
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)
[edit] C++
Since next_permutation already returns whether the resulting sequence is sorted, the code is quite simple:
#include <algorithm>
template<typename ForwardIterator>
void permutation_sort(ForwardIterator begin, ForwardIterator end)
{
while (std::next_permutation(begin, end))
{
// -- this block intentionally left empty --
}
}
[edit] 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
}
[edit] E
Translation of: C++
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)) {}
}
[edit] 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') }
Works with: GHC version 6.10
import Data.List (permutations)
permutationSort l = head [p | p <- permutations l, sorted p]
sorted (e1 : e2 : r) = e1 <= e2 && sorted (e2 : r)
sorted _ = True
[edit] Icon
Partly from here
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
[edit] 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.
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)
[edit] 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
[edit] 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).
[edit] Python
Works with: Python version 2.6
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()
[edit] R
Library: e1071 Warning: This function keeps all the possible permutations in memory at once, which becomes silly when x has 10 or more elements.
permutationsort <- function(x)
{
if(!require(e1071) stop("the package e1071 is required")
is.sorted <- function(x) all(diff(x) >= 0)
perms <- permutations(length(x))
i <- 1
while(!is.sorted(x))
{
x <- x[perms[i,]]
i <- i + 1
}
x
}
permutationsort(c(1, 10, 9, 7, 3, 0))
[edit] Ruby
Works with: Ruby version 1.8.7+ The Array class has a permutation method that, with no arguments, returns an enumerable object.
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
[edit] 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)))))
[edit] 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:
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
}
[edit] Ursala
Standard library functions to generate permutations and test for ordering by a given predicate are used.
#import std
permsort "p" = ~&ihB+ ordered"p"*~+ permutations
#cast %sL
example = permsort(lleq) <'pmf','oao','ejw','hhp','oqh','ock','dwj'>
output:
<'dwj','ejw','hhp','oao','ock','oqh','pmf'>
Categories: Programming Tasks | Sorting Algorithms | ActionScript | AutoHotkey | C | Clojure | Common Lisp | C++ | D | E | Haskell | Icon | OCaml | J | Prolog | Python | R | E1071 | Ruby | Scheme | Tcl | Tcllib | Ursala
