Sorting algorithms/Permutation sort: Difference between revisions

m
(→‎{{header|Kotlin}}: Updated example see https://github.com/dkandalov/rosettacode-kotlin for details)
m (→‎{{header|Wren}}: Minor tidy)
 
(31 intermediate revisions by 20 users not shown)
Line 1:
{{task|Sorting Algorithms}}
{{Sorting Algorithm}}
[[Category:Sorting]]
{{omit from|GUISS}}
 
Line 12 ⟶ 13:
'''done'''
<br><br>
=={{header|11l}}==
<syntaxhighlight lang="11l">F is_sorted(arr)
L(i) 1..arr.len-1
I arr[i-1] > arr[i]
R 0B
R 1B
 
F permutation_sort(&arr)
L !is_sorted(arr)
arr.next_permutation()
 
V arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
permutation_sort(&arr)
print(arr)</syntaxhighlight>
 
{{out}}
<pre>
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
</pre>
 
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang="aarch64 assembly">
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program permutationSort64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeConstantesARM64.inc"
 
/*******************************************/
/* Structures */
/********************************************/
/* structure permutations */
.struct 0
perm_adrtable: // table value address
.struct perm_adrtable + 8
perm_size: // elements number
.struct perm_size + 8
perm_adrheap: // Init to zéro at the first call
.struct perm_adrheap + 8
perm_end:
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessSortOk: .asciz "Table sorted.\n"
szMessSortNok: .asciz "Table not sorted !!!!!.\n"
sMessCounter: .asciz "sorted in @ permutations \n"
sMessResult: .asciz "Value : @ \n"
 
szCarriageReturn: .asciz "\n"
.align 4
#TableNumber: .quad 1,3,6,2,5,9,10,8,4,7,11
TableNumber: .quad 10,9,8,7,6,-5,4,3,2,1
.equ NBELEMENTS, (. - TableNumber) / 8
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
stPermutation: .skip perm_end
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
ldr x0,qAdrstPermutation // address structure permutation
ldr x1,qAdrTableNumber // address number table
str x1,[x0,perm_adrtable]
mov x1,NBELEMENTS // elements number
str x1,[x0,perm_size]
mov x1,0 // first call
str x1,[x0,perm_adrheap]
mov x20,0 // counter
1:
ldr x0,qAdrstPermutation // address structure permutation
bl newPermutation // call for each permutation
cmp x0,0 // end ?
blt 99f // yes -> error
//bl displayTable // for display after each permutation
add x20,x20,1 // increment counter
ldr x0,qAdrTableNumber // address number table
mov x1,NBELEMENTS // number of élements
bl isSorted // control sort
cmp x0,1 // sorted ?
bne 1b // no -> loop
 
ldr x0,qAdrTableNumber // address number table
bl displayTable
ldr x0,qAdrszMessSortOk // address OK message
bl affichageMess
mov x0,x20 // display counter
ldr x1,qAdrsZoneConv
bl conversion10S // décimal conversion
ldr x0,qAdrsMessCounter
ldr x1,qAdrsZoneConv // insert conversion
bl strInsertAtCharInc
bl affichageMess // display message
b 100f
99:
ldr x0,qAdrTableNumber // address number table
bl displayTable
ldr x0,qAdrszMessSortNok // address not OK message
bl affichageMess
100: // standard end of the program
mov x0,0 // return code
mov x8,EXIT // request to exit program
svc 0 // perform the system call
qAdrsZoneConv: .quad sZoneConv
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrsMessResult: .quad sMessResult
qAdrTableNumber: .quad TableNumber
qAdrstPermutation: .quad stPermutation
qAdrszMessSortOk: .quad szMessSortOk
qAdrszMessSortNok: .quad szMessSortNok
qAdrsMessCounter: .quad sMessCounter
/******************************************************************/
/* control sorted table */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of elements > 0 */
/* x0 return 0 if not sorted 1 if sorted */
isSorted:
stp x2,lr,[sp,-16]! // save registers
stp x3,x4,[sp,-16]! // save registers
mov x2,0
ldr x4,[x0,x2,lsl 3]
1:
add x2,x2,1
cmp x2,x1
bge 99f
ldr x3,[x0,x2, lsl 3]
cmp x3,x4
blt 98f
mov x4,x3
b 1b
98:
mov x0,0 // not sorted
b 100f
99:
mov x0,1 // sorted
100:
ldp x3,x4,[sp],16 // restaur 2 registers
ldp x2,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/***************************************************/
/* return permutation one by one */
/* sur une idée de vincent Moresmau */
/* use algorytm heap iteratif see wikipedia */
/***************************************************/
/* x0 contains the address of structure permutations */
/* x0 return address of value table or zéro if end */
newPermutation:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
ldr x2,[x0,perm_adrheap]
cmp x2,0
bne 2f
// first call -> init area on heap
mov x7,x0
ldr x1,[x7,perm_size]
lsl x3,x1,3 // 8 bytes by count table
add x3,x3,8 // 8 bytes for current index
mov x0,0 // allocation place heap
mov x8,BRK // call system 'brk'
svc 0
mov x2,x0 // save address heap
add x0,x0,x3 // reservation place
mov x8,BRK // call system 'brk'
svc #0
cmp x0,-1 // allocation error
beq 100f
add x8,x2,8 // address begin area counters
mov x3,0
1: // loop init
str xzr,[x8,x3,lsl 3] // init to zéro area heap
add x3,x3,1
cmp x3,x1
blt 1b
str xzr,[x2] // store zero to index
str x2,[x7,perm_adrheap] // store heap address on structure permutation
ldr x0,[x7,perm_adrtable] // return first permutation
b 100f
2: // other calls x2 contains heap address
mov x7,x0 // structure address
ldr x1,[x7,perm_size] // elements number
ldr x0,[x7,perm_adrtable]
add x8,x2,8 // begin address area count
ldr x3,[x2] // load current index
3:
ldr x4,[x8,x3,lsl 3] // load count [i]
cmp x4,x3 // compare with i
bge 6f
tst x3,#1 // even ?
bne 4f
ldr x5,[x0] // yes load value A[0]
ldr x6,[x0,x3,lsl 3] // and swap with value A[i]
str x6,[x0]
str x5,[x0,x3,lsl 3]
b 5f
4:
ldr x5,[x0,x4,lsl 3] // no load value A[count[i]]
ldr x6,[x0,x3,lsl 3] // and swap with value A[i]
str x6,[x0,x4,lsl 3]
str x5,[x0,x3,lsl 3]
5:
add x4,x4,1
str x4,[x8,x3,lsl 3] // store new count [i]
str xzr,[x2] // store new index
b 100f // and return new permutation in x0
6:
str xzr,[x8,x3,lsl 3] // store zero in count [i]
add x3,x3,1 // increment index
cmp x3,x1 // end
blt 3b // loop
mov x0,0 // if end -> return zero
100: // end function
ldp x6,x7,[sp],16 // restaur 1 register
ldp x4,x5,[sp],16 // restaur 1 register
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* Display table elements */
/******************************************************************/
/* x0 contains the address of table */
displayTable:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
mov x2,x0 // table address
mov x3,0
1: // loop display table
ldr x0,[x2,x3,lsl 3]
ldr x1,qAdrsZoneConv
bl conversion10S // décimal conversion
ldr x0,qAdrsMessResult
ldr x1,qAdrsZoneConv
bl strInsertAtCharInc // insert result at // character
bl affichageMess // display message
add x3,x3,1
cmp x3,NBELEMENTS - 1
ble 1b
ldr x0,qAdrszCarriageReturn
bl affichageMess
mov x0,x2
100:
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
 
</syntaxhighlight>
<pre>
Value : -5
Value : +1
Value : +2
Value : +3
Value : +4
Value : +6
Value : +7
Value : +8
Value : +9
Value : +10
 
Table sorted.
sorted in +3467024 permutations
</pre>
 
=={{header|ActionScript}}==
<langsyntaxhighlight ActionScriptlang="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
Line 44 ⟶ 327:
function permutationSort(array:Array):Array {
return permutations([],array);
}</langsyntaxhighlight>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
/* ARM assembly Raspberry PI */
/* program permutationSort.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
 
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessSortOk: .asciz "Table sorted.\n"
szMessSortNok: .asciz "Table not sorted !!!!!.\n"
sMessResult: .asciz "Value : @ \n"
szCarriageReturn: .asciz "\n"
.align 4
#TableNumber: .int 1,3,6,2,5,9,10,8,5,7 @ for test 2 sames values
TableNumber: .int 10,9,8,7,6,5,4,3,2,1
#TableNumber: .int 1,2,3
.equ NBELEMENTS, (. - TableNumber) / 4
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrTableNumber @ address number table
mov r1,#NBELEMENTS @ number of élements
bl heapIteratif
ldr r0,iAdrTableNumber @ address number table
bl displayTable
ldr r0,iAdrTableNumber @ address number table
mov r1,#NBELEMENTS @ number of élements
bl isSorted @ control sort
cmp r0,#1 @ sorted ?
beq 2f
ldr r0,iAdrszMessSortNok @ no !! error sort
bl affichageMess
b 100f
2: @ yes
ldr r0,iAdrszMessSortOk
bl affichageMess
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsMessResult: .int sMessResult
iAdrTableNumber: .int TableNumber
iAdrszMessSortOk: .int szMessSortOk
iAdrszMessSortNok: .int szMessSortNok
/******************************************************************/
/* permutation by heap iteratif (wikipedia) */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the eléments number */
heapIteratif:
push {r3-r9,lr} @ save registers
mov r8,r0 @ save table address
lsl r9,r1,#2 @ four bytes by count
sub sp,sp,r9
mov fp,sp
mov r3,#0
mov r4,#0 @ index
1: @ init area counter
str r4,[fp,r3,lsl #2]
add r3,r3,#1
cmp r3,r1
blt 1b
//bl displayTable
bl isSorted @ control sort
cmp r0,#1 @ sorted ?
beq 99f
mov r0,r8 @ restaur table address
mov r3,#0 @ index
2:
ldr r4,[fp,r3,lsl #2] @ load count [i]
cmp r4,r3 @ compare with i
bge 5f
tst r3,#1 @ even ?
bne 3f
ldr r5,[r0] @ yes load value A[0]
ldr r6,[r0,r3,lsl #2] @ ans swap with value A[i]
str r6,[r0]
str r5,[r0,r3,lsl #2]
b 4f
3:
ldr r5,[r0,r4,lsl #2] @ load value A[count[i]]
ldr r6,[r0,r3,lsl #2] @ and swap with value A[i]
str r6,[r0,r4,lsl #2]
str r5,[r0,r3,lsl #2]
4:
//bl displayTable
bl isSorted @ control sort
cmp r0,#1 @ sorted ?
beq 99f @ yes
mov r0,r8 @ restaur table address
add r4,r4,#1 @ increment count i
str r4,[fp,r3,lsl #2] @ and store on stack
mov r3,#0 @ raz index
b 2b @ and loop
5:
mov r4,#0 @ raz count [i]
str r4,[fp,r3,lsl #2]
add r3,r3,#1 @ increment index
cmp r3,r1 @ end ?
blt 2b @ no -> loop
99:
add sp,sp,r9 @ stack alignement
100:
pop {r3-r9,lr}
bx lr @ return
/******************************************************************/
/* control sorted table */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the number of elements > 0 */
/* r0 return 0 if not sorted 1 if sorted */
isSorted:
push {r2-r4,lr} @ save registers
mov r2,#0
ldr r4,[r0,r2,lsl #2]
1:
add r2,#1
cmp r2,r1
movge r0,#1
bge 100f
ldr r3,[r0,r2, lsl #2]
cmp r3,r4
movlt r0,#0
blt 100f
mov r4,r3
b 1b
100:
pop {r2-r4,lr}
bx lr @ return
 
/******************************************************************/
/* Display table elements */
/******************************************************************/
/* r0 contains the address of table */
displayTable:
push {r0-r3,lr} @ save registers
mov r2,r0 @ table address
mov r3,#0
1: @ loop display table
ldr r0,[r2,r3,lsl #2]
ldr r1,iAdrsZoneConv @
bl conversion10S @ décimal conversion
ldr r0,iAdrsMessResult
ldr r1,iAdrsZoneConv @ insert conversion
bl strInsertAtCharInc
bl affichageMess @ display message
add r3,#1
cmp r3,#NBELEMENTS - 1
ble 1b
ldr r0,iAdrszCarriageReturn
bl affichageMess
mov r0,r2
100:
pop {r0-r3,lr}
bx lr
iAdrsZoneConv: .int sZoneConv
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
 
=={{header|Arturo}}==
 
<syntaxhighlight lang="rebol">sorted?: function [arr][
previous: first arr
 
loop slice arr 1 (size arr)-1 'item [
if not? item > previous -> return false
previous: item
]
return true
]
 
permutationSort: function [items][
loop permutate items 'perm [
if sorted? perm -> return perm
]
]
 
print permutationSort [3 1 2 8 5 7 9 4 6]</syntaxhighlight>
 
{{out}}
 
<pre>1 2 3 4 5 6 7 8 9</pre>
 
=={{header|AutoHotkey}}==
ahk forum: [http://www.autohotkey.com/forum/post-276680.html#276680 discussion]
<langsyntaxhighlight AutoHotkeylang="autohotkey">MsgBox % PermSort("")
MsgBox % PermSort("xxx")
MsgBox % PermSort("3,2,1")
Line 90 ⟶ 586:
While i < j
t := %v%%i%, %v%%i% := %v%%j%, %v%%j% := t, ++i, --j
}</syntaxhighlight>
}</lang>
 
=={{header|BBC BASIC}}==
<langsyntaxhighlight lang="bbcbasic"> DIM test(9)
test() = 4, 65, 2, 31, 0, 99, 2, 83, 782, 1
Line 137 ⟶ 633:
IF d(I%) < d(I%-1) THEN = FALSE
NEXT
= TRUE</langsyntaxhighlight>
{{out}}
<pre>
Line 145 ⟶ 641:
=={{header|C}}==
Just keep generating [[wp:Permutation#Systematic_generation_of_all_permutations|next lexicographic permutation]] until the last one; it's sorted by definition.
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
#include <string.h>
Line 190 ⟶ 686:
printf("%s\n", strs[i]);
return 0;
}</langsyntaxhighlight>
 
=={{header|C sharp|C#}}==
<langsyntaxhighlight Clang="c sharp|Cc#">
public static class PermutationSorter
{
Line 234 ⟶ 730:
}
}
</syntaxhighlight>
</lang>
 
=={{header|C++}}==
Since <tt>next_permutation</tt> already returns whether the resulting sequence is sorted, the code is quite simple:
 
<langsyntaxhighlight lang="cpp">#include <algorithm>
 
template<typename ForwardIterator>
Line 248 ⟶ 744:
// -- this block intentionally left empty --
}
}</langsyntaxhighlight>
 
=={{header|Clojure}}==
 
<langsyntaxhighlight lang="lisp">
(use '[clojure.contrib.combinatorics :only (permutations)])
 
Line 259 ⟶ 755:
 
(permutation-sort [2 3 5 3 5])
</syntaxhighlight>
</lang>
 
=={{header|CoffeeScript}}==
<langsyntaxhighlight lang="coffeescript"># This code takes a ridiculously inefficient algorithm and rather futilely
# optimizes one part of it. Permutations are computed lazily.
 
Line 322 ⟶ 818:
console.log 'DONE!'
console.log 'sorted copy:', ans
</syntaxhighlight>
</lang>
{{out}}
<syntaxhighlight lang="text">
> coffee permute_sort.coffee
input: [ 'c', 'b', 'a', 'd' ]
Line 344 ⟶ 840:
DONE!
sorted copy: [ 'a', 'b', 'c', 'd' ]
</syntaxhighlight>
</lang>
 
=={{header|Common Lisp}}==
Line 352 ⟶ 848:
The <code>nth-permutation</code> function is some classic algorithm from Wikipedia.
 
<langsyntaxhighlight lang="lisp">(defun factorial (n)
(loop for result = 1 then (* i result)
for i from 2 to n
Line 385 ⟶ 881:
for permutation = (nth-permutation i sequence)
when (sortedp fn permutation)
do (return permutation)))</langsyntaxhighlight>
 
<langsyntaxhighlight 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
Line 396 ⟶ 892:
611,094,240 bytes consed
(1 2 3 4 5 6 7 8 9 10)</langsyntaxhighlight>
 
=={{header|Crystal}}==
<syntaxhighlight lang="crystal">def sorted?(items : Array)
prev = items[0]
items.each do |item|
if item < prev
return false
end
prev = item
end
return true
end
 
def permutation_sort(items : Array)
items.each_permutation do |permutation|
if sorted?(permutation)
return permutation
end
end
end</syntaxhighlight>
 
=={{header|D}}==
===Basic Version===
This uses the second (lazy) permutations from the Permutations Task.
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, permutations2;
 
void permutationSort(T)(T[] items) pure nothrow @safe @nogc {
Line 413 ⟶ 929:
data.permutationSort;
data.writeln;
}</langsyntaxhighlight>
{{out}}
<pre>[-1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9]</pre>
Line 420 ⟶ 936:
===Alternative Version===
{{trans|C++}}
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm;
 
void permutationSort(T)(T[] items) pure nothrow @safe @nogc {
Line 430 ⟶ 946:
data.permutationSort;
data.writeln;
}</langsyntaxhighlight>
The output is the same.
Run-time about 1.04 seconds with ldc2 (the C++ entry with G++ takes about 0.4 seconds).
Line 437 ⟶ 953:
{{trans|C++}}
 
<langsyntaxhighlight lang="e">def swap(container, ixA, ixB) {
def temp := container[ixA]
container[ixA] := container[ixB]
Line 476 ⟶ 992:
def permutationSort(flexList) {
while (nextPermutation(flexList)) {}
}</langsyntaxhighlight>
 
=={{header|EchoLisp}}==
<langsyntaxhighlight lang="scheme">
;; This efficient sort method uses the list library for permutations
 
Line 497 ⟶ 1,013:
 
→ (0 1 2 3 4 5)
</syntaxhighlight>
</lang>
 
=={{header|Elixir}}==
<langsyntaxhighlight lang="elixir">defmodule Sort do
def permutation_sort([]), do: []
def permutation_sort(list) do
Line 517 ⟶ 1,033:
 
IO.inspect list = for _ <- 1..9, do: :rand.uniform(20)
IO.inspect Sort.permutation_sort(list)</langsyntaxhighlight>
 
{{out}}
Line 524 ⟶ 1,040:
[2, 3, 8, 10, 10, 14, 17, 18, 19]
</pre>
 
=={{header|EMal}}==
{{trans|Java}}
<syntaxhighlight lang="emal">
type PermutationSort
fun isSorted = logic by List a
for int i = 1; i < a.length; ++i
if a[i - 1] > a[i] do return false end
end
return true
end
fun permute = void by List a, int n, List lists
if n == 1
List b = int[]
for int i = 0; i < a.length; ++i
b.append(a[i])
end
lists.append(b)
return
end
int i = 0
while i < n
a.swap(i, n - 1)
permute(a, n - 1, lists)
a.swap(i, n - 1)
i = i + 1
end
end
fun sort = List by List a
List lists = List[]
permute(a, a.length, lists)
for each List list in lists
if isSorted(list) do return list end
end
return a
end
type Main
List a = int[3,2,1,8,9,4,6]
writeLine("Unsorted: " + a)
a = PermutationSort.sort(a)
writeLine(" Sorted: " + a)
</syntaxhighlight>
{{out}}
<pre>
Unsorted: [3,2,1,8,9,4,6]
Sorted: [1,2,3,4,6,8,9]
</pre>
 
=={{header|Factor}}==
<syntaxhighlight lang="factor">USING: grouping io math.combinatorics math.order prettyprint ;
IN: rosetta-code.permutation-sort
 
: permutation-sort ( seq -- seq' )
[ [ before=? ] monotonic? ] find-permutation ;
{ 10 2 6 8 1 4 3 } permutation-sort .
"apple" permutation-sort print</syntaxhighlight>
{{out}}
<pre>
{ 1 2 3 4 6 8 10 }
aelpp
</pre>
 
=={{header|FreeBASIC}}==
<langsyntaxhighlight lang="freebasic">' version 07-04-2017
' compile with: fbc -s console
 
Line 583 ⟶ 1,162:
Print : Print "hit any key to end program"
Sleep
End</langsyntaxhighlight>
{{out}}
<pre>unsorted array
Line 595 ⟶ 1,174:
=={{header|Go}}==
Not following the pseudocode, it seemed simpler to just test sorted at the bottom of a recursive permutation generator.
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 633 ⟶ 1,212:
}
return false
}</langsyntaxhighlight>
 
=={{header|Groovy}}==
Line 639 ⟶ 1,218:
 
I believe that this method of constructing permutations results in a stable sort, but I have not actually proven that assertion.
<langsyntaxhighlight lang="groovy">def factorial = { (it > 1) ? (2..it).inject(1) { i, j -> i*j } : 1 }
 
def makePermutation;
Line 660 ⟶ 1,239:
def pIndex = (0..<fact).find { print "."; sorted(permuteA(it)) }
permuteA(pIndex)
}</langsyntaxhighlight>
 
Test:
<langsyntaxhighlight lang="groovy">println permutationSort([7,0,12,-45,-1])
println ()
println permutationSort([10, 10.0, 10.00, 1])
Line 670 ⟶ 1,249:
println permutationSort([10.0, 10.00, 10, 1])
println permutationSort([10.00, 10, 10.0, 1])
println permutationSort([10.00, 10.0, 10, 1])</langsyntaxhighlight>
The examples with distinct integer and decimal values that compare as equal are there to demonstrate, but not to prove, that the sort is stable.
 
Line 684 ⟶ 1,263:
 
=={{header|Haskell}}==
<langsyntaxhighlight Haskelllang="haskell">import Control.Monad
 
permutationSort l = head [p | p <- permute l, sorted p]
Line 695 ⟶ 1,274:
insert e [] = return [e]
insert e l@(h : t) = return (e : l) `mplus`
do { t' <- insert e t ; return (h : t') }</langsyntaxhighlight>
{{works with|GHC|6.10}}
<langsyntaxhighlight 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</langsyntaxhighlight>
 
=={{header|Icon}} and {{header|Unicon}}==
Partly from [http://infohost.nmt.edu/tcc/help/lang/icon/backtrack.html here]
<langsyntaxhighlight lang="icon">procedure do_permute(l, i, n)
if i >= n then
return l
Line 726 ⟶ 1,305:
l := [6,3,4,5,1]
|( l := permute(l) & sorted(l)) \1 & every writes(" ",!l)
end</langsyntaxhighlight>
 
=={{header|J}}==
{{eff note|J|/:~}}
A function to locate the permuation index, in the naive manner prescribed by the task:
<langsyntaxhighlight lang="j">ps =:(1+])^:((-.@-:/:~)@A.~)^:_ 0:</langsyntaxhighlight>
Of course, this can be calculated much more directly (and efficiently):
<langsyntaxhighlight lang="j">ps =: A.@:/:</langsyntaxhighlight>
Either way:
<langsyntaxhighlight lang="j"> list =: 2 7 4 3 5 1 0 9 8 6
ps list
Line 744 ⟶ 1,323:
(A.~ps) list
0 1 2 3 4 5 6 7 8 9</langsyntaxhighlight>
 
=={{header|Java}}==
<langsyntaxhighlight lang="java5">import java.util.List;
import java.util.ArrayList;
import java.util.Arrays;
Line 798 ⟶ 1,377:
arr[j]=temp;
}
}</langsyntaxhighlight>
 
{{out}}
Line 809 ⟶ 1,388:
'''Infrastructure''':
The following function generates a stream of permutations of an arbitrary JSON array:
<langsyntaxhighlight lang="jq">def permutations:
if length == 0 then []
else
. as $in | range(0;length) | . as $i
| range(0;length) as $i
| ($in|del(.[$i])|permutations)
| [$in[$i]] + .
end ;</langsyntaxhighlight>
 
Next is a generic function for checking whether the input array is non-decreasing.
If your jq has until/2 then its definition here can be removed.
<langsyntaxhighlight lang="jq">def sorted:
def until(cond; next):
def _until: if cond then . else (next|_until) end;
Line 828 ⟶ 1,408:
else . as $in
| 1 | until( . == $length or $in[.-1] > $in[.] ; .+1) == $length
end;</langsyntaxhighlight>
 
'''Permutation-sort''':
Line 837 ⟶ 1,417:
 
{{works with|jq|1.4}}
<langsyntaxhighlight lang="jq">def permutation_sort_slow:
reduce permutations as $p (null; if . then . elif ($p | sorted) then $p else . end);</langsyntaxhighlight>
 
{{works with|jq|with foreach}}
<langsyntaxhighlight lang="jq">def permutation_sort:
# emit the first item in stream that satisfies the condition
def first(stream; cond):
Line 849 ⟶ 1,429:
if .[0] then break $out else [($item | cond), $item] end;
if .[0] then .[1] else empty end );
first(permutations; sorted);</langsyntaxhighlight>
 
'''Example''':
<langsyntaxhighlight lang="jq">["too", true, 1, 0, {"a":1}, {"a":0} ] | permutation_sort</langsyntaxhighlight>
{{out}}
<langsyntaxhighlight lang="sh">$ jq -c -n -f Permutation_sort.jq
[true,0,1,"too",{"a":0},{"a":1}]</langsyntaxhighlight>
 
=={{header|Julia}}==
<syntaxhighlight lang="julia"># v0.6
 
using Combinatorics
 
function permsort(x::Array)
for perm in permutations(x)
if issorted(perm)
return perm
end
end
end
 
x = randn(10)
@show x permsort(x)</syntaxhighlight>
 
{{out}}
<pre>x = [-0.799206, -2.52542, 0.677947, -1.85139, 0.744764, 1.5327, 0.808935, -0.876105, -0.234308, 0.874579]
permsort(x) = [-2.52542, -1.85139, -0.876105, -0.799206, -0.234308, 0.677947, 0.744764, 0.808935, 0.874579, 1.5327]</pre>
 
=={{header|Kotlin}}==
<langsyntaxhighlight lang="scala">// version 1.1.2
 
fun <T : Comparable<T>> isSorted(list: List<T>): Boolean {
Line 906 ⟶ 1,506:
val output2 = permutationSort(input2)
println("After sorting : $output2")
}</langsyntaxhighlight>
 
{{out}}
Line 917 ⟶ 1,517:
</pre>
 
=={{header|MathematicaLua}}==
<syntaxhighlight lang="lua">-- Return an iterator to produce every permutation of list
function permute (list)
local function perm (list, n)
if n == 0 then coroutine.yield(list) end
for i = 1, n do
list[i], list[n] = list[n], list[i]
perm(list, n - 1)
list[i], list[n] = list[n], list[i]
end
end
return coroutine.wrap(function() perm(list, #list) end)
end
 
-- Return true if table t is in ascending order or false if not
function inOrder (t)
for pos = 2, #t do
if t[pos] < t[pos - 1] then
return false
end
end
return true
end
 
-- Main procedure
local list = {2,3,1} --\ Written to match task pseudocode,
local nextPermutation = permute(list) --\ more idiomatic would be:
while not inOrder(list) do --\
list = nextPermutation() --/ for p in permute(list) do
end --/ stuffWith(p)
print(unpack(list)) --/ end</syntaxhighlight>
{{out}}
<pre>1 2 3</pre>
 
=={{header|Maple}}==
<syntaxhighlight lang="maple">arr := Array([17,0,-1,72,0]):
len := numelems(arr):
P := Iterator:-Permute(len):
for p in P do
lst:= convert(arr[sort(convert(p,list),output=permutation)],list):
if (ListTools:-Sorted(lst)) then
print(lst):
break:
end if:
end do:</syntaxhighlight>
{{Out|Output}}
<pre>[-1,0,0,17,72]</pre>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
Here is a one-line solution.
A custom order relation can be defined for the OrderedQ[] function.
<syntaxhighlight lang="mathematica">PermutationSort[x_List] := NestWhile[RandomSample, x, Not[OrderedQ[#]] &]</syntaxhighlight>
 
<lang Mathematica>PermutationSort[x_List] := NestWhile[RandomSample, x, Not[OrderedQ[#]] &]</lang>
 
=={{header|MATLAB}} / {{header|Octave}}==
 
<langsyntaxhighlight MATLABlang="matlab">function list = permutationSort(list)
 
permutations = perms(1:numel(list)); %Generate all permutations of the item indicies
Line 937 ⟶ 1,584:
end
 
end</langsyntaxhighlight>
 
Sample Usage:
<langsyntaxhighlight MATLABlang="matlab">>> permutationSort([4 3 1 5 6 2])
 
ans =
 
1 2 3 4 5 6</langsyntaxhighlight>
 
=={{header|MAXScript}}==
<langsyntaxhighlight MAXScriptlang="maxscript">fn inOrder arr =
(
if arr.count < 2 then return true
Line 975 ⟶ 1,622:
)
)
)</langsyntaxhighlight>
Output:
<syntaxhighlight lang="maxscript">
<lang MAXScript>
a = for i in 1 to 9 collect random 1 20
#(10, 20, 17, 15, 17, 15, 3, 11, 15)
permutations a
#(3, 10, 11, 15, 15, 15, 17, 17, 20)
</syntaxhighlight>
</lang>
Warning: This algorithm is very inefficient and Max will crash very quickly with bigger arrays.
 
=={{header|NetRexx}}==
Uses the permutation iterator '''<tt>RPermutationIterator</tt>''' at [[Permutations#NetRexx|Permutations]] to generate the permutations.
<langsyntaxhighlight NetRexxlang="netrexx">/* NetRexx */
options replace format comments java crossref symbols nobinary
 
Line 1,071 ⟶ 1,718:
method isFalse() public static returns boolean
return (1 == 0)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,092 ⟶ 1,739:
 
=={{header|Nim}}==
<langsyntaxhighlight lang="nim">iterator permutations[T](ys: openarray[T]): seq[T] =
var
d = 1
Line 1,129 ⟶ 1,776:
 
var a = @[4, 65, 2, -31, 0, 99, 2, 83, 782]
echo a.permSort</langsyntaxhighlight>
{{out}}
<pre>@[-31, 0, 2, 2, 4, 65, 83, 99, 782]</pre>
Line 1,135 ⟶ 1,782:
=={{header|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.
<langsyntaxhighlight lang="ocaml">let rec sorted = function
| e1 :: e2 :: r -> e1 <= e2 && sorted (e2 :: r)
| _ -> true
Line 1,146 ⟶ 1,793:
xs [[]]
 
let permutation_sort l = List.find sorted (permute l)</langsyntaxhighlight>
 
=={{header|PARI/GP}}==
<langsyntaxhighlight lang="parigp">permutationSort(v)={
my(u);
for(k=1,(#v)!,
Line 1,158 ⟶ 1,805:
return(u)
)
};</langsyntaxhighlight>
 
=={{header|Perl}}==
Pass a list in by reference, and sort in situ.
<langsyntaxhighlight lang="perl">sub psort {
my ($x, $d) = @_;
 
Line 1,180 ⟶ 1,827:
print "Before:\t@a\n";
psort(\@a);
print "After:\t@a\n"</langsyntaxhighlight>
 
{{out}}
<pre>Before: 94 15 42 35 55 24 96 14 61 94 43
After: 14 15 24 35 42 43 55 61 94 94 96</pre>
 
=={{header|Perl 6}}==
<lang perl6># Lexicographic permuter from "Permutations" task.
sub next_perm ( @a ) {
my $j = @a.end - 1;
$j-- while $j >= 1 and [>] @a[ $j, $j+1 ];
 
my $aj = @a[$j];
my $k = @a.end;
$k-- while [>] $aj, @a[$k];
 
@a[ $j, $k ] .= reverse;
 
my Int $r = @a.end;
my Int $s = $j + 1;
while $r > $s {
@a[ $r, $s ] .= reverse;
$r--;
$s++;
}
}
 
sub permutation_sort ( @a ) {
my @n = @a.keys;
my $perm_count = [*] 1 .. +@n; # Factorial
for ^$perm_count {
my @permuted_a = @a[ @n ];
return @permuted_a if [le] @permuted_a;
next_perm(@n);
}
}
 
my @data = < c b e d a >; # Halfway between abcde and edcba
say 'Input = ' ~ @data;
say 'Output = ' ~ @data.&permutation_sort;
</lang>
 
{{out}}
<pre>Input = c b e d a
Output = a b c d e</pre>
 
=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>function inOrder(sequence s)
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
for i=2 to length(s) do
if s[i]<s[i-1] then return 0 end if
<span style="color: #008080;">function</span> <span style="color: #000000;">inOrder</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
end for
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
return 1
<span style="color: #008080;">if</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]<</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #004600;">false</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end function
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
 
<span style="color: #008080;">return</span> <span style="color: #004600;">true</span>
function permutationSort(sequence s)
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
for n=1 to factorial(length(s)) do
sequence perm = permute(n,s)
<span style="color: #008080;">function</span> <span style="color: #000000;">permutationSort</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
if inOrder(perm) then return perm end if
<span style="color: #008080;">for</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">factorial</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">))</span> <span style="color: #008080;">do</span>
end for
<span style="color: #004080;">sequence</span> <span style="color: #000000;">perm</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">permute</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
?9/0 -- should never happen
<span style="color: #008080;">if</span> <span style="color: #000000;">inOrder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">perm</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">perm</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end function
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
 
<span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #000080;font-style:italic;">-- should never happen</span>
?permutationSort({"dog",0,15.545,{"cat","pile","abcde",1},"cat"})</lang>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #0000FF;">?</span><span style="color: #000000;">permutationSort</span><span style="color: #0000FF;">({</span><span style="color: #008000;">"dog"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">15.545</span><span style="color: #0000FF;">,{</span><span style="color: #008000;">"cat"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"pile"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"abcde"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span><span style="color: #008000;">"cat"</span><span style="color: #0000FF;">})</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 1,249 ⟶ 1,860:
 
=={{header|PHP}}==
<langsyntaxhighlight lang="php">function inOrder($arr){
for($i=0;$i<count($arr);$i++){
if(isset($arr[$i+1])){
Line 1,281 ⟶ 1,892:
$arr = array( 8, 3, 10, 6, 1, 9, 7, 2, 5, 4);
$arr = permute($arr);
echo implode(',',$arr);</langsyntaxhighlight>
<pre>1,2,3,4,5,6,7,8,9,10</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(de permutationSort (Lst)
(let L Lst
(recur (L) # Permute
Line 1,293 ⟶ 1,904:
(rot L)
NIL )
(apply <= Lst) ) ) ) )</langsyntaxhighlight>
{{out}}
<pre>: (permutationSort (make (do 9 (link (rand 1 999)))))
Line 1,305 ⟶ 1,916:
 
=={{header|PowerShell}}==
<langsyntaxhighlight PowerShelllang="powershell">Function PermutationSort( [Object[]] $indata, $index = 0, $k = 0 )
{
$data = $indata.Clone()
Line 1,344 ⟶ 1,955:
}
}
$l = 8; PermutationSort ( 1..$l | ForEach-Object { $Rand = New-Object Random }{ $Rand.Next( 0, $l - 1 ) } )</langsyntaxhighlight>
 
=={{header|Prolog}}==
<langsyntaxhighlight lang="prolog">permutation_sort(L,S) :- permutation(L,S), sorted(S).
 
sorted([]).
Line 1,354 ⟶ 1,965:
 
permutation([],[]).
permutation([X|XS],YS) :- permutation(XS,ZS), select(X,YS,ZS).</langsyntaxhighlight>
 
=={{header|PureBasic}}==
<langsyntaxhighlight PureBasiclang="purebasic">Macro reverse(firstIndex, lastIndex)
first = firstIndex
last = lastIndex
Line 1,414 ⟶ 2,025:
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</langsyntaxhighlight>
{{out}}
<pre>8, 3, 10, 6, 1, 9, 7, -4, 5, 3
Line 1,421 ⟶ 2,032:
=={{header|Python}}==
{{works with|Python|2.6}}
<langsyntaxhighlight 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()</langsyntaxhighlight>
 
<br/>
The <code>more_itertools</code> package contains many useful functions, such as <code>windowed</code>. This function gives us a sliding window of chosen size over an iterable. We can use this window, among other things, to check if the iterable is sorted.
 
{{works with|Python|3.7}}
<syntaxhighlight lang="python">from itertools import permutations
from more_itertools import windowed
 
def is_sorted(seq):
return all(
v1 <= v2
for v1, v2 in windowed(seq, 2)
)
 
def permutation_sort(seq):
return next(
permutation
for permutation in permutations(seq)
if is_sorted(permutation)
)
</syntaxhighlight>
 
=={{header|Quackery}}==
 
<syntaxhighlight lang="quackery"> [ 1 swap times [ i 1+ * ] ] is ! ( n --> n )
 
[ [] unrot 1 - times
[ i 1+ ! /mod
dip join ] drop ] is factoradic ( n n --> [ )
 
[ [] unrot witheach
[ pluck
rot swap nested join
swap ]
join ] is inversion ( [ [ --> [ )
 
[ over size
factoradic inversion ] is nperm ( [ n --> [ )
 
[ true swap
behead swap
witheach
[ tuck > if
[ dip not conclude ] ]
drop ] is sorted ( [ --> b )
 
[ 0
[ 2dup nperm
dup sorted not while
drop 1+ again ]
unrot 2drop ] is sort ( [ --> [ )
 
$ "beings" sort echo$</syntaxhighlight>
 
{{out}}
 
<pre>begins</pre>
 
=={{header|R}}==
===e1071===
{{libheader|e1071}}
Warning: This function keeps all the possible permutations in memory at once, which becomes silly when x has 10 or more elements.
<langsyntaxhighlight rlang="rsplus">permutationsort <- function(x)
{
if(!require(e1071) stop("the package e1071 is required")
Line 1,443 ⟶ 2,112:
x
}
permutationsort(c(1, 10, 9, 7, 3, 0))</langsyntaxhighlight>
 
===RcppAlgos===
{{libheader|RcppAlgos}}
RcppAlgos lets us do this at the speed of C++ and with some very short code. The while loop with no body strikes me as poor taste, but I know of no better way.
<syntaxhighlight lang="rsplus">library(RcppAlgos)
permuSort <- function(list)
{
iter <- permuteIter(list)
while(is.unsorted(iter$nextIter())){}#iter$nextIter advances iter to the next iteration and returns it.
iter$currIter()
}
test <- sample(10)
print(test)
permuSort(test)</syntaxhighlight>
{{out}}
<pre>#Output
> test <- sample(10)
> print(test)
[1] 8 10 6 2 9 4 7 5 3 1
> permuSort(test)
[1] 1 2 3 4 5 6 7 8 9 10</pre>
 
An alternative solution would be to replace the while loop with the following:
<syntaxhighlight lang="rsplus">repeat
{
if(!is.unsorted(iter$nextIter())) break
}</syntaxhighlight>
This seems more explicit than the empty while loop, but also more complex.
 
=={{header|Racket}}==
 
<syntaxhighlight lang="racket">
<lang Racket>
#lang racket
(define (sort l)
(for/first ([p (in-permutations l)] #:when (apply <= p)) p))
(sort '(6 1 5 2 4 3)) ; => '(1 2 3 4 5 6)
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
(formerly Perl 6)
<syntaxhighlight lang="raku" line># Lexicographic permuter from "Permutations" task.
sub next_perm ( @a ) {
my $j = @a.end - 1;
$j-- while $j >= 1 and [>] @a[ $j, $j+1 ];
 
my $aj = @a[$j];
my $k = @a.end;
$k-- while [>] $aj, @a[$k];
 
@a[ $j, $k ] .= reverse;
 
my Int $r = @a.end;
my Int $s = $j + 1;
while $r > $s {
@a[ $r, $s ] .= reverse;
$r--;
$s++;
}
}
 
sub permutation_sort ( @a ) {
my @n = @a.keys;
my $perm_count = [*] 1 .. +@n; # Factorial
for ^$perm_count {
my @permuted_a = @a[ @n ];
return @permuted_a if [le] @permuted_a;
next_perm(@n);
}
}
 
my @data = < c b e d a >; # Halfway between abcde and edcba
say 'Input = ' ~ @data;
say 'Output = ' ~ @data.&permutation_sort;
</syntaxhighlight>
 
{{out}}
<pre>Input = c b e d a
Output = a b c d e</pre>
 
=={{header|REXX}}==
<langsyntaxhighlight lang="rexx">/*REXX program sorts and displays an array using the permutation-sort method. */
call gen /*generate the array elements. */
call show 'before sort' /*show the before array elements. */
say copies('░', 75) say copies('░', 75) /*show separator line between displays.*/
call psetspSort L L /*generateinvoke the permutation sort. items (!) permutations. */
call pSort L /*invoke the permutation sort. */
call show ' after sort' /*show the after array elements. */
say; say 'Permutation sort took ' ? " permutations to find the sorted list."
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
.pAdd: #=#+1; do j=1 for N; #.#=#.# !.j; end; return /*add a end; returnpermutation.*/
show: do j=1 for L; say ele@e right(j, wL) arg(1)":" translate(@.j, , '_'); end; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
gen: @.=; @.1 = '---Four_horsemen_of_the_Apocalypse---'
@.2 = '====================================='
@.3 = 'Famine───black_horse'
@.4 = 'Death───pale_horse'
@.5 = 'Pestilence_[Slaughter]───red_horse'
@.6 = 'Conquest_[War]───white_horse'
ele=right('element', 15) /*literal used for the display.*/
do L=1 while @.L\==''; @@.L=@.L; end; L=L-1; wL=length(L); return
/*──────────────────────────────────────────────────────────────────────────────────────*/
isOKgen: parse@.=; arg q @.1 = /*see if Q list is in order. */'---Four_horsemen_of_the_Apocalypse---'
_=word(q, 1); do j=2 to words(q); x=word(q, j); if x<_ then return 0 @.2 = '====================================='
_=x @.3 = /*Out of order? [↑] ¬ sorted*/'Famine───black_horse'
end /*j*/ @.4 = 'Death───pale_horse'
do k=1 for #; _=word(#.?, k); @.k=@@._; end /*k*/ @.5 = 'Pestilence_[Slaughter]───red_horse'
return 1 @.6 = /*they're all in order finally.*/Conquest_[War]───white_horse'
@e= right('element', 15) /*literal used for the display.*/
do L=1 while @.L\==''; @@.L=@.L; end; L= L-1; wL=length(L); return
/*──────────────────────────────────────────────────────────────────────────────────────*/
isOrd: parse arg q /*see if Q list is in order. */
.pNext: procedure expose !.; parse arg n,i; nm=n-1
_= word(q, 1); do j=2 to words(q); x= word(q, j); if x<_ then return 0; do k_=nm by -1 for nm; kp=k+1x
end /*j*/ if !.k<!.kp then do; i=k; leave; end /* [↑] Out of order? ¬sorted*/
do k=1 for #; _= word(#.?, k); @.k= @@._; end /*k*/; return 1 /*in [↓] swap two array elementsorder*/
do j=i+1 while j<n; parse value !.j !.n with !.n !.j; n=n-1; end
if i==0 then return 0; do j=i+1 while !.j<!.i; end /*j*/
parse value !.j !.i with !.i !.j
return 1
/*──────────────────────────────────────────────────────────────────────────────────────*/
psets.pNxt: procedure expose !.; # #.; parse arg n,#.i; #=0; do f=1 for n; !.fnm=f; n end- /*f*/1
call .pAdd; do while .pNext(n,0); call .pAdd; end do k=nm by -1 for nm; kp= k + /*while*/1
if !.k<!.kp then do; i= k; leave; end
return #
end /*k*/ /* [↓] swap two array elements*/
do j=i+1 while j<n; parse value !.j !.n with !.n !.j; n= n-1; end /*j*/
if i==0 then return 0 /*0: indicates no more perms. */
do j=i+1 while !.j<!.i; end /*j*/ /*search perm for a lower value*/
parse value !.j !.i with !.i !.j; return 1 /*swap two values in !. array.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
pSort: parse arg n,#.; #= 0 do ?=1 until isOK($); $= /*generate L items (!) /*find sorted permutationpermutations.*/
do f=1 for n; do m=1 for!.f= #f; _=word(#.? ,m); end $=$/*f*/; @._; end /*m*/ call .pAdd
do while .pNxt(n, 0); call .pAdd; end end /*?while*/
do ?=1 until isOrd($); $= /*find permutation.*/
return</lang>
do m=1 for #; _= word(#.?, m); $= $ @._; end /*m*/ /*build the $ list.*/
'''output''' &nbsp; using the default (internal) inputs:
end /*?*/; return</syntaxhighlight>
{{out|output|text=&nbsp; when using the default (internal) inputs:}}
<pre>
element 1 before sort: ---Four horsemen of the Apocalypse---
Line 1,517 ⟶ 2,250:
element 6 after sort: Pestilence [Slaughter]───red horse
 
Permutation sort took 21 permutations to find the sorted list.
</pre>
 
=={{header|Ring}}==
<syntaxhighlight lang="ring">
# Project : Sorting algorithms/Permutation sort
 
a = [4, 65, 2, 31, 0, 99, 2, 83, 782]
result = []
permute(a,1)
 
for n = 1 to len(result)
num = 0
for m = 1 to len(result[n]) - 1
if result[n][m] <= result[n][m+1]
num = num + 1
ok
next
if num = len(result[n]) - 1
nr = n
exit
ok
next
see "" + nr + " permutations required to sort " + len(a) + " items." + nl
 
func permute(a,k)
if k = len(a)
add(result,a)
else
for i = k to len(a)
temp=a[k]
a[k]=a[i]
a[i]=temp
permute(a,k+1)
temp=a[k]
a[k]=a[i]
a[i]=temp
next
ok
return a
</syntaxhighlight>
Output:
<pre>
169329 permutations required to sort 9 items.
</pre>
 
Line 1,523 ⟶ 2,299:
{{works with|Ruby|1.8.7+}}
The Array class has a permutation method that, with no arguments, returns an enumerable object.
<langsyntaxhighlight lang="ruby">class Array
def permutationsort
permutation.each{|perm| return perm if perm.sorted?}
Line 1,531 ⟶ 2,307:
each_cons(2).all? {|a, b| a <= b}
end
end</langsyntaxhighlight>
 
=={{header|Scheme}}==
<langsyntaxhighlight lang="scheme">(define (insertions e list)
(if (null? list)
(cons (cons e list) list)
Line 1,558 ⟶ 2,334:
(if (sorted? (car permutations))
(car permutations)
(loop (cdr permutations)))))</langsyntaxhighlight>
 
=={{header|Sidef}}==
{{trans|Perl}}
<langsyntaxhighlight lang="ruby">func psort(x, d=x.end) {
 
if (d.is_zero) {
Line 1,583 ⟶ 2,359:
say "Before:\t#{a}";
psort(a);
say "After:\t#{a}";</langsyntaxhighlight>
{{out}}
<pre>
Line 1,593 ⟶ 2,369:
{{tcllib|struct::list}}
The <code>firstperm</code> procedure actually returns the lexicographically first permutation of the input list. However, to meet the letter of the problem, let's loop:
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
package require struct::list
 
Line 1,603 ⟶ 2,379:
}
return $list
}</langsyntaxhighlight>
 
=={{header|Ursala}}==
Standard library functions to generate permutations and test for ordering by a
given predicate are used.
<langsyntaxhighlight Ursalalang="ursala">#import std
 
permsort "p" = ~&ihB+ ordered"p"*~+ permutations
Line 1,614 ⟶ 2,390:
#cast %sL
 
example = permsort(lleq) <'pmf','oao','ejw','hhp','oqh','ock','dwj'></langsyntaxhighlight>
 
{{out}}
<pre><'dwj','ejw','hhp','oao','ock','oqh','pmf'></pre>
 
=={{header|Wren}}==
{{trans|Go}}
{{libheader|Wren-sort}}
<syntaxhighlight lang="wren">import "./sort" for Sort
 
var a = [170, 45, 75, -90, -802, 24, 2, 66]
 
// recursive permutation generator
var recurse
recurse = Fn.new { |last|
if (last <= 0) return Sort.isSorted(a)
for (i in 0..last) {
var t = a[i]
a[i] = a[last]
a[last] = t
if (recurse.call(last - 1)) return true
t = a[i]
a[i] = a[last]
a[last] = t
}
return false
}
 
System.print("Unsorted: %(a)")
var count = a.count
if (count > 1 && !recurse.call(count-1)) Fiber.abort("Sorted permutation not found!")
System.print("Sorted : %(a)")</syntaxhighlight>
 
{{out}}
<pre>
Unsorted: [170, 45, 75, -90, -802, 24, 2, 66]
Sorted : [-802, -90, 2, 24, 45, 66, 75, 170]
</pre>
 
=={{header|zkl}}==
Performance is horrid
<langsyntaxhighlight lang="zkl">rns:=T(4, 65, 2, 31, 0, 99, 2, 83, 782, 1);
fcn psort(list){ len:=list.len(); cnt:=Ref(0);
foreach ns in (Utils.Helpers.permuteW(list)){ // lasy permutations
Line 1,628 ⟶ 2,438:
if(cnt.value==len) return(ns);
}
}(rns).println();</langsyntaxhighlight>
{{out}}
<pre>L(0,1,2,2,4,31,65,83,99,782)</pre>
9,476

edits