Sorting algorithms/Permutation sort: Difference between revisions

Content added Content deleted

Inline

Revision as of 18:44, 28 November 2010

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

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>

Works with: GHC version 6.10

<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

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>

Unicon

This Icon solution works in Unicon.

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

Generally, this task should be accomplished in J using /:~. Here we take an approach that's more comparable with the other examples on this page.

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

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>

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. <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

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

Library: Tcllib (Package: struct::list)

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'>