Sorting algorithms/Permutation sort

From Rosetta Code

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

Contents 1 ActionScript 2 AutoHotkey 3 C 4 Clojure 5 Common Lisp 6 C++ 7 D 8 E 9 Haskell 10 Icon and Unicon 10.1 Icon 10.2 Unicon 11 OCaml 12 J 13 MATLAB 14 PHP 15 PicoLisp 16 Prolog 17 Python 18 R 19 Ruby 20 Scheme 21 Tcl 22 Ursala

[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 = 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;
}

[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 and Unicon

[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] Unicon

This Icon solution works in Unicon.

[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] 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

Sample Usage:

>> permutationSort([4 3 1 5 6 2])
 
ans =
 
     1     2     3     4     5     6

[edit] 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);

1,2,3,4,5,6,7,8,9,10

[edit] 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) ) ) ) )

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)

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