Sorting algorithms/Permutation sort

Sorting algorithms/Permutation sort
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:

O(n logn) sorts

Heap sort | Merge sort | Patience sort | Quick sort

O(n log²n) sorts
Shell Sort

O(n²) 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.

Pseudocode:

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

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

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

Scheme

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

</scheme>