Permutation Sort

From Rosetta Code

Permutation sort.

Pseudocode:

while not InOrder(list) do nextPermutation(list);

Contents 1 C++ 2 D 3 Haskell 4 OCaml 5 Prolog 6 Scheme

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

import Control.Monad

permutationSort l = head $ do p <- permute l
                              if sorted p then return p else mzero

sorted (e1 : e2 : r) = e1 <= e2 && sorted (e2 : r)
sorted _             = True

permute []           = return []
permute (h:t)        = do { t' <- permute t ; insert h t' }

insert e []          = return [e]
insert e l@(h : t)   = return (e : l) `mplus`
                       do { t' <- insert e t ; return (h : t') }

[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 rec permute = function
 | []     -> [[]]
 | h :: t -> List.concat (List.map (fun t' -> insert h t') (permute t))
 
let permutation_sort l = List.find sorted (permute l)

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