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
ActionScript
<lang 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); }</lang>
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
<lang 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 = malloc(sizeof(struct pi)); p->list_size = listSize; p->counts = malloc( p->list_size * sizeof(short)); p->crntperm = 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;
}</lang>
C#
<lang C sharp|C#> public static class PermutationSorter {
public static void Sort<T>(List<T> list) where T : IComparable
{
PermutationSort(list, 0);
}
public static bool PermutationSort<T>(List<T> list, int i) where T : IComparable
{
int j;
if (issorted(list, i))
{
return true;
}
for (j = i + 1; j < list.Count; j++)
{
T temp = list[i];
list[i] = list[j];
list[j] = temp;
if (PermutationSort(list, i + 1))
{
return true;
}
temp = list[i];
list[i] = list[j];
list[j] = temp;
}
return false;
}
public static bool issorted<T>(List<T> list, int i) where T : IComparable
{
for (int j = list.Count-1; j > 0; j--)
{
if(list[j].CompareTo(list[j-1])<0)
{
return false; } } return true;
}
} </lang>
Clojure
<lang lisp> (use '[clojure.contrib.combinatorics :only (permutations)])
(defn permutation-sort [s]
(first (filter (partial apply <=) (permutations s))))
(permutation-sort [2 3 5 3 5]) </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>import std.stdio, std.algorithm;
struct Permutations(T) {
T[] items;
int opApply(int delegate(ref T[]) dg) {
int result;
if (items.length <= 1) {
result = dg(items);
if (result) return result;
} else {
foreach (perm; Permutations(items[1 .. $]))
foreach (i; 0 .. perm.length + 1) {
T[] tmp = perm[0 .. i] ~ items[0] ~ perm[i .. $];
result = dg(tmp);
if (result) return result;
}
}
return result; }
}
void permutationSort(T)(T[] items) {
foreach (perm; Permutations!T(items))
if (isSorted(perm)) {
items[] = perm;
return;
}
}
void main() {
auto data = [2, 7, 4, 3, 5, 1, 0, 9, 8, 6, -1]; permutationSort(data); writeln(data);
}</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 and Unicon
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: <lang j>ps =:(1+])^:((-.@-:/:~)@A.~)^:_ 0:</lang> Of course, this can be calculated much more directly (and efficiently): <lang j>ps =: A.@:/:</lang> Either way: <lang j> 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</lang>
Mathematica
Here is a one-line solution. A custom order relation can be defined for the OrderedQ[] function.
<lang Mathematica>PermutationSort[x_List] := NestWhile[RandomSample, x, Not[OrderedQ[#]] &]</lang>
MATLAB
<lang MATLAB>function list = permutationSort(list)
permutations = perms(1:numel(list)); %Generate all permutations of the item indicies
%Test every permutation of the indicies of the original list
for i = (1:size(permutations,1))
if issorted( list(permutations(i,:)) )
list = list(permutations(i,:));
return %Once the correct permutation of the original list is found break out of the program
end
end
end</lang>
Sample Usage: <lang MATLAB>>> permutationSort([4 3 1 5 6 2])
ans =
1 2 3 4 5 6</lang>
Perl 6
<lang perl6># Lexicographic permuter from "Permutations" task. sub next_perm ( @a ) {
my $j = @a.end - 1; $j-- while $j >= 1 and [>] @a[ $j, $j+1 ];
my $aj = @a[$j]; my $k = @a.end; $k-- while [>] $aj, @a[$k];
@a[ $j, $k ] .= reverse;
my Int $r = @a.end;
my Int $s = $j + 1;
while $r > $s {
@a[ $r, $s ] .= reverse;
$r--;
$s++;
}
}
sub permutation_sort ( @a ) {
my @n = @a.keys;
my $perm_count = [*] 1 .. +@n; # Factorial
for ^$perm_count {
my @permuted_a = @a[ @n ];
return @permuted_a if [le] @permuted_a;
next_perm(@n);
}
}
my @data = < c b e d a >; # Halfway between abcde and edcba say 'Input = ' ~ @data; say 'Output = ' ~ @data.&permutation_sort; </lang>
Output:
Input = c b e d a Output = a b c d e
PHP
<lang php>function inOrder($arr){ for($i=0;$i<count($arr);$i++){ if(isset($arr[$i+1])){ if($arr[$i] > $arr[$i+1]){ return false; } } } return true; }
function permute($items, $perms = array( )) {
if (empty($items)) {
if(inOrder($perms)){ return $perms; }
} else {
for ($i = count($items) - 1; $i >= 0; --$i) {
$newitems = $items;
$newperms = $perms;
list($foo) = array_splice($newitems, $i, 1);
array_unshift($newperms, $foo);
$res = permute($newitems, $newperms);
if($res){ return $res; }
} }
}
$arr = array( 8, 3, 10, 6, 1, 9, 7, 2, 5, 4); $arr = permute($arr); echo implode(',',$arr);</lang>
1,2,3,4,5,6,7,8,9,10
PicoLisp
<lang PicoLisp>(de permutationSort (Lst)
(let L Lst
(recur (L) # Permute
(if (cdr L)
(do (length L)
(T (recurse (cdr L)) Lst)
(rot L)
NIL )
(apply <= Lst) ) ) ) )</lang>
Output:
: (permutationSort (make (do 9 (link (rand 1 999))))) -> (82 120 160 168 205 226 408 708 719) : (permutationSort (make (do 9 (link (rand 1 999))))) -> (108 212 330 471 667 716 739 769 938) : (permutationSort (make (do 9 (link (rand 1 999))))) -> (118 253 355 395 429 548 890 900 983)
PowerShell
<lang PowerShell>Function PermutationSort( [Object[]] $indata, $index = 0, $k = 0 ) { $data = $indata.Clone() $datal = $data.length - 1 if( $datal -gt 0 ) { for( $j = $index; $j -lt $datal; $j++ ) { $sorted = ( PermutationSort $data ( $index + 1 ) $j )[0] if( -not $sorted ) { $temp = $data[ $index ] $data[ $index ] = $data[ $j + 1 ] $data[ $j + 1 ] = $temp } } if( $index -lt ( $datal - 1 ) ) { PermutationSort $data ( $index + 1 ) $j } else { $sorted = $true for( $i = 0; ( $i -lt $datal ) -and $sorted; $i++ ) { $sorted = ( $data[ $i ] -le $data[ $i + 1 ] ) } $sorted $data } } }
0..4 | ForEach-Object { $a = $_; 0..4 | Where-Object { -not ( $_ -match "$a" ) } | ForEach-Object { $b = $_; 0..4 | Where-Object { -not ( $_ -match "$a|$b" ) } | ForEach-Object { $c = $_; 0..4 | Where-Object { -not ( $_ -match "$a|$b|$c" ) } | ForEach-Object { $d = $_; 0..4 | Where-Object { -not ( $_ -match "$a|$b|$c|$d" ) } | ForEach-Object { $e=$_; "$( PermutationSort ( $a, $b, $c, $d, $e ) )" } } } } } $l = 8; PermutationSort ( 1..$l | ForEach-Object { $Rand = New-Object Random }{ $Rand.Next( 0, $l - 1 ) } )</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>
PureBasic
<lang PureBasic>Macro reverse(firstIndex, lastIndex)
first = firstIndex last = lastIndex While first < last Swap cur(first), cur(last) first + 1 last - 1 Wend
EndMacro
Procedure nextPermutation(Array cur(1))
Protected first, last, elementCount = ArraySize(cur())
If elementCount < 2
ProcedureReturn #False ;nothing to permute
EndIf
;Find the lowest position pos such that [pos] < [pos+1]
Protected pos = elementCount - 1
While cur(pos) >= cur(pos + 1)
pos - 1
If pos < 0
reverse(0, elementCount)
ProcedureReturn #False ;no higher lexicographic permutations left, return lowest one instead
EndIf
Wend
;Swap [pos] with the highest positional value that is larger than [pos] last = elementCount While cur(last) <= cur(pos) last - 1 Wend Swap cur(pos), cur(last)
;Reverse the order of the elements in the higher positions reverse(pos + 1, elementCount) ProcedureReturn #True ;next lexicographic permutation found
EndProcedure
Procedure display(Array a(1))
Protected i, fin = ArraySize(a())
For i = 0 To fin
Print(Str(a(i)))
If i = fin: Continue: EndIf
Print(", ")
Next
PrintN("")
EndProcedure
If OpenConsole()
Dim a(9) a(0) = 8: a(1) = 3: a(2) = 10: a(3) = 6: a(4) = 1: a(5) = 9: a(6) = 7: a(7) = -4: a(8) = 5: a(9) = 3 display(a()) While nextPermutation(a()): Wend display(a())
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input() CloseConsole()
EndIf</lang> Sample output:
8, 3, 10, 6, 1, 9, 7, -4, 5, 3 -4, 1, 3, 3, 5, 6, 7, 8, 9, 10
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>
R
Warning: This function keeps all the possible permutations in memory at once, which becomes silly when x has 10 or more elements. <lang r>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))</lang>
REXX
<lang rexx> /*REXX program sorts an array using the permutation-sort method. */
call gen@ /*generate array elements. */ call show@ 'before sort' /*show before array elements*/ permList=permutationSort(list) /*invoke permutation "sort".*/
do Psorts=1 until inOrder(aList) /*look for the sorted list. */ aList=word(permList,Psorts) aList=translate(aList,,',') end
do k=1 for highItem
@.k=word(Alist,k)
end
call show@ ' after sort' /*show after array elements*/ say say 'Permuation sort took' Psorts '"sorts".' exit
/*─────────────────────────────────────PERMUTATIONSORT subroutine──*/
permutationSort: procedure; parse arg x; n=words(x)
return permSets(n,n,',',x)
/*─────────────────────────────────────INORDER subroutine─--------─*/
inOrder: procedure; parse arg q /*see if list Q is in order*/
_=word(q,1)
do j=2 to words(q) x=word(q,j) if x<_ then return 0 /*Out of order? Not sorted.*/ _=x end
return 1 /*they're all in order now. */
/*─────────────────────────────────────GEN@ subroutine─────────────*/
gen@: @.= /*assign default value. */
@.1='---Four_horsemen_of_the_Apocalypse---' @.2='=====================================' @.3='Famine───black_horse' @.4='Death───pale_horse' @.5='Pestilence_[Slaughter]───red_horse' @.6='Conquest_[War]───white_horse'
list=
do highItem=1 while @.highItem\== /*find how many entries. */ list=list @.highItem end
highItem=highItem-1 /*adjust highItem slightly. */ return
/*─────────────────────────────────────SHOW@ subroutine────────────*/
show@: widthH=length(highItem) /*maximum width of any line.*/
do j=1 for highItem say 'element' right(j,widthH) arg(1)":" @.j end
say copies('─',80) /*show a seperator line. */ return
/*──────────────────────────────────────────────────────────────────────*/
permSets: procedure; parse arg x,y,between,usyms /*X things Y at a time.*/
/*X can't be > length(@0abcs). */
@abc='abcdefghijklmnopqrstuvwxyz' @abcu=@abc; upper @abcu @abcs=@abcu||@abc @0abcs=123456789||@abcs @.= sep= !=
do k=1 for x /*build list of symbols. */ _=p(word(usyms,k) p(substr(@0abcs,k,1) k)) /*get or generate a symbol. */ if length(_)\==1 then sep='_' /*if not 1char, then use sep*/ $.k=_ /*append to the sumbol list.*/ end
if between== then between=sep /*use appropriate seperator.*/ list='$. @. ! between x y' return permset(1)
/*────────────────────────────────PERMSET subroutine────────────────────*/
permset: procedure expose (list); parse arg ?
if ?>y then do
_=@.1
do j=2 to y
_=_||between||@.j
end
!=! _
end
else do q=1 for x /*construction permutation recursively*/
do k=1 for ?-1
if @.k==$.q then iterate q
end
@.?=$.q
call permset(?+1)
end
return !
/*────────────────────────────────P subroutine (Pick one)───────────────*/
p: return word(arg(1),1)
</lang>
Output:
element 1 before sort: ---Four_horsemen_of_the_Apocalypse--- element 2 before sort: ===================================== element 3 before sort: Famine───black_horse element 4 before sort: Death───pale_horse element 5 before sort: Pestilence_[Slaughter]───red_horse element 6 before sort: Conquest_[War]───white_horse ──────────────────────────────────────────────────────────────────────────────── element 1 after sort: ---Four_horsemen_of_the_Apocalypse--- element 2 after sort: ===================================== element 3 after sort: Conquest_[War]───white_horse element 4 after sort: Death───pale_horse element 5 after sort: Famine───black_horse element 6 after sort: Pestilence_[Slaughter]───red_horse ──────────────────────────────────────────────────────────────────────────────── Permuation sort took 21 "sorts".
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
The firstperm procedure actually 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'>