Sorting algorithms/Permutation sort: Difference between revisions
No edit summary |
|||
Line 555: | Line 555: | ||
: (permutationSort (make (do 9 (link (rand 1 999))))) |
: (permutationSort (make (do 9 (link (rand 1 999))))) |
||
-> (118 253 355 395 429 548 890 900 983)</pre> |
-> (118 253 355 395 429 548 890 900 983)</pre> |
||
=={{header|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> |
|||
=={{header|Prolog}}== |
=={{header|Prolog}}== |
Revision as of 19:22, 5 November 2010
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:
Heap sort | Merge sort | Patience sort | Quick sort
O(n log2n) sorts
Shell Sort
O(n2) 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, 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
<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>
<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
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>
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>
Python
<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
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>
Ruby
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
. 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>#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'>