Sorting algorithms/Permutation sort

From Rosetta Code
Task
Sorting algorithms/Permutation sort
You are encouraged to solve this task according to the task description, using any language you may know.

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

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>

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

}</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>

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>

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:

   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

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>

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>

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

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:

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

  1. import std

permsort "p" = ~&ihB+ ordered"p"*~+ permutations

  1. cast %sL

example = permsort(lleq) <'pmf','oao','ejw','hhp','oqh','ock','dwj'></lang>

output:

<'dwj','ejw','hhp','oao','ock','oqh','pmf'>