Sorting algorithms/Permutation sort: Difference between revisions
| Line 433: | Line 433: | ||
=={{header|Groovy}}== |
=={{header|Groovy}}== |
||
Permutation sort is an astonishingly inefficient sort algorithm. To even begin to make it tractable, we need to be able to create enumerated permutations on the fly, rather than relying on [[Groovy]]'s ''List.permutations()'' method. For a list of length ''N'' there are ''N!'' permutations. In this solution, ''makePermutation'' creates the ''I<sup>th</sup>'' permutation to order based on a recursive construction of a unique |
Permutation sort is an astonishingly inefficient sort algorithm. To even begin to make it tractable, we need to be able to create enumerated permutations on the fly, rather than relying on [[Groovy]]'s ''List.permutations()'' method. For a list of length ''N'' there are ''N!'' permutations. In this solution, ''makePermutation'' creates the ''I<sup>th</sup>'' permutation to order based on a recursive construction of a unique indexed permutation. The sort method then checks to see if that permutation is sorted, and stops when it is. |
||
I believe that this method of constructing permutations results in a stable sort, but I have not actually proven that assertion. |
I believe that this method of constructing permutations results in a stable sort, but I have not actually proven that assertion. |
||
Revision as of 14:25, 24 March 2011
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
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
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>
Go
Not following the pseudocode, it seemed simpler to just test sorted at the bottom of a recursive permutation generator. <lang go>package main
import "fmt"
var a = []int{170, 45, 75, -90, -802, 24, 2, 66}
// in place permutation sort of slice a func main() {
fmt.Println("before:", a)
if len(a) > 1 && !recurse(len(a) - 1) {
// recurse should never return false from the top level.
// if it does, it means some code somewhere is busted,
// either the the permutation generation code or the
// sortedness testing code.
panic("sorted permutation not found!")
}
fmt.Println("after: ", a)
}
// recursive permutation generator func recurse(last int) bool {
if last <= 0 {
// bottom of recursion. test if sorted.
for i := len(a) - 1; a[i] >= a[i-1]; i-- {
if i == 1 {
return true
}
}
return false
}
for i := 0; i <= last; i++ {
a[i], a[last] = a[last], a[i]
if recurse(last - 1) {
return true
}
a[i], a[last] = a[last], a[i]
}
return false
}</lang>
Groovy
Permutation sort is an astonishingly inefficient sort algorithm. To even begin to make it tractable, we need to be able to create enumerated permutations on the fly, rather than relying on Groovy's List.permutations() method. For a list of length N there are N! permutations. In this solution, makePermutation creates the Ith permutation to order based on a recursive construction of a unique indexed permutation. The sort method then checks to see if that permutation is sorted, and stops when it is.
I believe that this method of constructing permutations results in a stable sort, but I have not actually proven that assertion. <lang groovy>def factorial = { (it > 1) ? (2..it).inject(1) { i, j -> i*j } : 1 }
def makePermutation; makePermutation = { list, i ->
def n = list.size() if (n < 2) return list def fact = factorial(n-1) assert i < fact*n def index = i.intdiv(fact) [list[index]] + makePermutation(list[0..<index] + list[(index+1)..<n], i % fact)
}
def sorted = { a -> (1..<(a.size())).every { a[it-1] <= a[it] } }
def permutationSort = { a ->
def n = a.size()
def fact = factorial(n)
def permuteA = makePermutation.curry(a)
def pIndex = (0..<fact).find { print "."; sorted(permuteA(it)) }
permuteA(pIndex)
}</lang>
Test: <lang groovy>println permutationSort([7,0,12,-45,-1]) println () println permutationSort([10, 10.0, 10.00, 1]) println permutationSort([10, 10.00, 10.0, 1]) println permutationSort([10.0, 10, 10.00, 1]) println permutationSort([10.0, 10.00, 10, 1]) println permutationSort([10.00, 10, 10.0, 1]) println permutationSort([10.00, 10.0, 10, 1])</lang> The examples with distinct integer and decimal values that compare as equal are there to demonstrate, but not to prove, that the sort is stable.
Output:
.............................................................................................[-45, -1, 0, 7, 12] ...................[1, 10, 10.0, 10.00] ...................[1, 10, 10.00, 10.0] ...................[1, 10.0, 10, 10.00] ...................[1, 10.0, 10.00, 10] ...................[1, 10.00, 10, 10.0] ...................[1, 10.00, 10.0, 10]
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'>