all tasks

This commit is contained in:
Ingy döt Net 2013-04-11 01:07:29 -07:00
parent b83f433714
commit 68f8f3e56b
14735 changed files with 178959 additions and 0 deletions

View file

@ -0,0 +1,6 @@
{{Sorting Algorithm}}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'''

View file

@ -0,0 +1,2 @@
---
note: Sorting Algorithms

View file

@ -0,0 +1,31 @@
//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);
}

View file

@ -0,0 +1,43 @@
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
}

View file

@ -0,0 +1,45 @@
DIM test(9)
test() = 4, 65, 2, 31, 0, 99, 2, 83, 782, 1
perms% = 0
WHILE NOT FNsorted(test())
perms% += 1
PROCnextperm(test())
ENDWHILE
PRINT ;perms% " permutations required to sort "; DIM(test(),1)+1 " items."
END
DEF PROCnextperm(a())
LOCAL last%, maxindex%, p%
maxindex% = DIM(a(),1)
IF maxindex% < 1 THEN ENDPROC
p% = maxindex%-1
WHILE a(p%) >= a(p%+1)
p% -= 1
IF p% < 0 THEN
PROCreverse(a(), 0, maxindex%)
ENDPROC
ENDIF
ENDWHILE
last% = maxindex%
WHILE a(last%) <= a(p%)
last% -= 1
ENDWHILE
SWAP a(p%), a(last%)
PROCreverse(a(), p%+1, maxindex%)
ENDPROC
DEF PROCreverse(a(), first%, last%)
WHILE first% < last%
SWAP a(first%), a(last%)
first% += 1
last% -= 1
ENDWHILE
ENDPROC
DEF FNsorted(d())
LOCAL I%
FOR I% = 1 TO DIM(d(),1)
IF d(I%) < d(I%-1) THEN = FALSE
NEXT
= TRUE

View file

@ -0,0 +1,10 @@
#include <algorithm>
template<typename ForwardIterator>
void permutation_sort(ForwardIterator begin, ForwardIterator end)
{
while (std::next_permutation(begin, end))
{
// -- this block intentionally left empty --
}
}

View file

@ -0,0 +1,46 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
typedef int(*cmp_func)(const void*, const void*);
void perm_sort(void *a, int n, size_t msize, cmp_func _cmp)
{
char *p, *q, *tmp = malloc(msize);
# define A(i) ((char *)a + msize * (i))
# define swap(a, b) {\
memcpy(tmp, a, msize);\
memcpy(a, b, msize);\
memcpy(b, tmp, msize); }
while (1) {
/* find largest k such that a[k - 1] < a[k] */
for (p = A(n - 1); (void*)p > a; p = q)
if (_cmp(q = p - msize, p) > 0)
break;
if ((void*)p <= a) break;
/* find largest l such that a[l] > a[k - 1] */
for (p = A(n - 1); p > q; p-= msize)
if (_cmp(q, p) > 0) break;
swap(p, q); /* swap a[k - 1], a[l] */
/* flip a[k] through a[end] */
for (q += msize, p = A(n - 1); q < p; q += msize, p -= msize)
swap(p, q);
}
free(tmp);
}
int scmp(const void *a, const void *b) { return strcmp(*(const char *const *)a, *(const char *const *)b); }
int main()
{
int i;
const char *strs[] = { "spqr", "abc", "giant squid", "stuff", "def" };
perm_sort(strs, 5, sizeof(*strs), scmp);
for (i = 0; i < 5; i++)
printf("%s\n", strs[i]);
return 0;
}

View file

@ -0,0 +1,6 @@
(use '[clojure.contrib.combinatorics :only (permutations)])
(defn permutation-sort [s]
(first (filter (partial apply <=) (permutations s))))
(permutation-sort [2 3 5 3 5])

View file

@ -0,0 +1,60 @@
# This code takes a ridiculously inefficient algorithm and rather futilely
# optimizes one part of it. Permutations are computed lazily.
sorted_copy = (a) ->
# This returns a sorted copy of an array by lazily generating
# permutations of indexes and stopping when the indexes yield
# a sorted array.
indexes = [0...a.length]
ans = find_matching_permutation indexes, (permuted_indexes) ->
new_array = (a[i] for i in permuted_indexes)
console.log permuted_indexes, new_array
in_order(new_array)
(a[i] for i in ans)
in_order = (a) ->
# return true iff array a is in increasing order.
return true if a.length <= 1
for i in [0...a.length-1]
return false if a[i] > a[i+1]
true
get_factorials = (n) ->
# return an array of the first n+1 factorials, starting with 0!
ans = [1]
f = 1
for i in [1..n]
f *= i
ans.push f
ans
permutation = (a, i, factorials) ->
# Return the i-th permutation of an array by
# using remainders of factorials to determine
# elements.
while a.length > 0
f = factorials[a.length-1]
n = Math.floor(i / f)
i = i % f
elem = a[n]
a = a[0...n].concat(a[n+1...])
elem
# The above loop gets treated like
# an array expression, so it returns
# all the elements.
find_matching_permutation = (a, f_match) ->
factorials = get_factorials(a.length)
for i in [0...factorials[a.length]]
permuted_array = permutation(a, i, factorials)
if f_match permuted_array
return permuted_array
null
do ->
a = ['c', 'b', 'a', 'd']
console.log 'input:', a
ans = sorted_copy a
console.log 'DONE!'
console.log 'sorted copy:', ans

View file

@ -0,0 +1,19 @@
> coffee permute_sort.coffee
input: [ 'c', 'b', 'a', 'd' ]
[ 0, 1, 2, 3 ] [ 'c', 'b', 'a', 'd' ]
[ 0, 1, 3, 2 ] [ 'c', 'b', 'd', 'a' ]
[ 0, 2, 1, 3 ] [ 'c', 'a', 'b', 'd' ]
[ 0, 2, 3, 1 ] [ 'c', 'a', 'd', 'b' ]
[ 0, 3, 1, 2 ] [ 'c', 'd', 'b', 'a' ]
[ 0, 3, 2, 1 ] [ 'c', 'd', 'a', 'b' ]
[ 1, 0, 2, 3 ] [ 'b', 'c', 'a', 'd' ]
[ 1, 0, 3, 2 ] [ 'b', 'c', 'd', 'a' ]
[ 1, 2, 0, 3 ] [ 'b', 'a', 'c', 'd' ]
[ 1, 2, 3, 0 ] [ 'b', 'a', 'd', 'c' ]
[ 1, 3, 0, 2 ] [ 'b', 'd', 'c', 'a' ]
[ 1, 3, 2, 0 ] [ 'b', 'd', 'a', 'c' ]
[ 2, 0, 1, 3 ] [ 'a', 'c', 'b', 'd' ]
[ 2, 0, 3, 1 ] [ 'a', 'c', 'd', 'b' ]
[ 2, 1, 0, 3 ] [ 'a', 'b', 'c', 'd' ]
DONE!
sorted copy: [ 'a', 'b', 'c', 'd' ]

View file

@ -0,0 +1,34 @@
(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)))

View file

@ -0,0 +1,10 @@
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)

View file

@ -0,0 +1,15 @@
import std.stdio, std.algorithm, permutations2;
void permutationSort(T)(T[] items) /*pure nothrow*/ {
foreach (perm; permutations!false(items))
if (isSorted(perm)) {
items[] = perm;
break;
}
}
void main() {
auto data = [2, 7, 4, 3, 5, 1, 0, 9, 8, 6, -1];
permutationSort(data);
writeln(data);
}

View file

@ -0,0 +1,11 @@
import std.stdio, std.algorithm;
void permutationSort(T)(T[] items) /*pure nothrow*/ {
while (nextPermutation(items)) {}
}
void main() {
auto data = [2, 7, 4, 3, 5, 1, 0, 9, 8, 6, -1];
permutationSort(data);
writeln(data);
}

View file

@ -0,0 +1,40 @@
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)) {}
}

View file

@ -0,0 +1,39 @@
package main
import "fmt"
var a = []int{170, 45, 75, -90, -802, 24, 2, 66}
// in place permutation sort of slice a
func main() {
fmt.Println("before:", a)
if len(a) > 1 && !recurse(len(a) - 1) {
// recurse should never return false from the top level.
// if it does, it means some code somewhere is busted,
// either the the permutation generation code or the
// sortedness testing code.
panic("sorted permutation not found!")
}
fmt.Println("after: ", a)
}
// recursive permutation generator
func recurse(last int) bool {
if last <= 0 {
// bottom of recursion. test if sorted.
for i := len(a) - 1; a[i] >= a[i-1]; i-- {
if i == 1 {
return true
}
}
return false
}
for i := 0; i <= last; i++ {
a[i], a[last] = a[last], a[i]
if recurse(last - 1) {
return true
}
a[i], a[last] = a[last], a[i]
}
return false
}

View file

@ -0,0 +1,22 @@
def factorial = { (it > 1) ? (2..it).inject(1) { i, j -> i*j } : 1 }
def makePermutation;
makePermutation = { list, i ->
def n = list.size()
if (n < 2) return list
def fact = factorial(n-1)
assert i < fact*n
def index = i.intdiv(fact)
[list[index]] + makePermutation(list[0..<index] + list[(index+1)..<n], i % fact)
}
def sorted = { a -> (1..<(a.size())).every { a[it-1] <= a[it] } }
def permutationSort = { a ->
def n = a.size()
def fact = factorial(n)
def permuteA = makePermutation.curry(a)
def pIndex = (0..<fact).find { print "."; sorted(permuteA(it)) }
permuteA(pIndex)
}

View file

@ -0,0 +1,8 @@
println permutationSort([7,0,12,-45,-1])
println ()
println permutationSort([10, 10.0, 10.00, 1])
println permutationSort([10, 10.00, 10.0, 1])
println permutationSort([10.0, 10, 10.00, 1])
println permutationSort([10.0, 10.00, 10, 1])
println permutationSort([10.00, 10, 10.0, 1])
println permutationSort([10.00, 10.0, 10, 1])

View file

@ -0,0 +1,12 @@
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') }

View file

@ -0,0 +1,6 @@
import Data.List (permutations)
permutationSort l = head [p | p <- permutations l, sorted p]
sorted (e1 : e2 : r) = e1 <= e2 && sorted (e2 : r)
sorted _ = True

View file

@ -0,0 +1,21 @@
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

View file

@ -0,0 +1 @@
ps =:(1+])^:((-.@-:/:~)@A.~)^:_ 0:

View file

@ -0,0 +1,10 @@
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

View file

@ -0,0 +1,13 @@
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

View file

@ -0,0 +1,5 @@
>> permutationSort([4 3 1 5 6 2])
ans =
1 2 3 4 5 6

View file

@ -0,0 +1 @@
PermutationSort[x_List] := NestWhile[RandomSample, x, Not[OrderedQ[#]] &]

View file

@ -0,0 +1,12 @@
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)

View file

@ -0,0 +1,10 @@
permutationSort(v)={
my(u);
for(k=1,(#v)!,
u=vecextract(v, numtoperm(#v,k));
for(i=2,#u,
if(u[i]<u[i-1], next(2))
);
return(u)
)
};

View file

@ -0,0 +1,33 @@
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);

View file

@ -0,0 +1,33 @@
# 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;

View file

@ -0,0 +1,19 @@
sub psort {
my ($x, $d) = @_;
unless ($d //= $#$x) {
$x->[$_] < $x->[$_ - 1] and return for 1 .. $#$x;
return 1
}
for (0 .. $d) {
unshift @$x, splice @$x, $d, 1;
next if $x->[$d] < $x->[$d - 1];
return 1 if psort($x, $d - 1);
}
}
my @a = map+(int rand 100), 0 .. 10;
print "Before:\t@a\n";
psort(\@a);
print "After:\t@a\n"

View file

@ -0,0 +1,9 @@
(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) ) ) ) )

View file

@ -0,0 +1,40 @@
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 ) } )

View file

@ -0,0 +1,8 @@
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).

View file

@ -0,0 +1,58 @@
Macro reverse(firstIndex, lastIndex)
first = firstIndex
last = lastIndex
While first < last
Swap cur(first), cur(last)
first + 1
last - 1
Wend
EndMacro
Procedure nextPermutation(Array cur(1))
Protected first, last, elementCount = ArraySize(cur())
If elementCount < 2
ProcedureReturn #False ;nothing to permute
EndIf
;Find the lowest position pos such that [pos] < [pos+1]
Protected pos = elementCount - 1
While cur(pos) >= cur(pos + 1)
pos - 1
If pos < 0
reverse(0, elementCount)
ProcedureReturn #False ;no higher lexicographic permutations left, return lowest one instead
EndIf
Wend
;Swap [pos] with the highest positional value that is larger than [pos]
last = elementCount
While cur(last) <= cur(pos)
last - 1
Wend
Swap cur(pos), cur(last)
;Reverse the order of the elements in the higher positions
reverse(pos + 1, elementCount)
ProcedureReturn #True ;next lexicographic permutation found
EndProcedure
Procedure display(Array a(1))
Protected i, fin = ArraySize(a())
For i = 0 To fin
Print(Str(a(i)))
If i = fin: Continue: EndIf
Print(", ")
Next
PrintN("")
EndProcedure
If OpenConsole()
Dim a(9)
a(0) = 8: a(1) = 3: a(2) = 10: a(3) = 6: a(4) = 1: a(5) = 9: a(6) = 7: a(7) = -4: a(8) = 5: a(9) = 3
display(a())
While nextPermutation(a()): Wend
display(a())
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf

View file

@ -0,0 +1,4 @@
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()

View file

@ -0,0 +1,15 @@
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))

View file

@ -0,0 +1,52 @@
/*REXX program sorts an array using the permutation-sort method. */
call gen@ /*generate the array elements. */
call show@ 'before sort' /*show the before array elements.*/
call permsets items /*generate items! permutations.*/
call permSort items /*invoke the permutation sort. */
call show@ ' after sort' /*show after array elements*/
say; say 'Permutation sort took' ? "permutations to find the sorted list."
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────GEN@ subroutine─────────────────────*/
gen@: @.= /*assign default value. */
@.1 = '---Four_horsemen_of_the_Apocalypse---'
@.2 = '====================================='
@.3 = 'Famineblack_horse'
@.4 = 'Deathpale_horse'
@.5 = 'Pestilence_[Slaughter]red_horse'
@.6 = 'Conquest_[War]white_horse'
list= /*[↓] find # of entries in array.*/
do items=1 while @.items\==''; @@.items=@.items; end /*items*/
items=items-1 /*adjust items slightly. */
return
/*──────────────────────────────────INORDER subroutine──────────────────*/
inOrder: parse arg q /*see if list Q is in order. */
_=word(q,1); do j=2 to words(q); x=word(q,j)
if x<_ then return 0 /*Out of order? Then not sorted.*/
_=x
end /*j*/
do k=1 for items; _=word(#.?,k); @.k=@@._; end /*k*/ /*here it is*/
return 1 /*they're all in order finally. */
/*──────────────────────────────────PERMSETS subroutine─────────────────*/
permsets: procedure expose !. # #.; parse arg n,#.; #=0
do f=1 for n; !.f=f; end /*f*/; call .permAdd /*populate 1st perm*/
do while .permNext(n,0); call .permAdd; end /*while ···*/
return #
.permNext: procedure expose !.; parse arg n,i; nm=n-1
do k=nm by -1 for nm; kp=k+1
if !.k<!.kp then do; i=k; leave; end
end /*k*/
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
.permAdd: #=#+1; do j=1 for N; #.#=#.# !.j; end /*j*/; return
/*──────────────────────────────────PERMSORT subroutine─────────────────*/
permSort: do ?=1 until inOrder(aList) /*look for the sorted permutation*/
aList=; do m=1 for items; _=word(#.?,m); aList=aList @._; end /*m*/
end /*?*/
return
/*──────────────────────────────────SHOW@ subroutine────────────────────*/
show@: widthH=length(items) /*maximum width of any line. */
do j=1 for items; say 'element' right(j,widthH) arg(1)":" @.j; end /*j*/
say copies('', 79) /*show a nice separator line. */
return

View file

@ -0,0 +1,13 @@
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

View file

@ -0,0 +1,25 @@
(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)))))

View file

@ -0,0 +1,11 @@
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
}

View file

@ -0,0 +1,7 @@
#import std
permsort "p" = ~&ihB+ ordered"p"*~+ permutations
#cast %sL
example = permsort(lleq) <'pmf','oao','ejw','hhp','oqh','ock','dwj'>