Sorting algorithms/Cycle sort
For more information on cycle sorting, see the Wikipedia entry.
D
This version doesn't use Phobos algorithms beside 'swap'. Algorithms can be used to find where to put the item1 and elsewhere.
<lang d>import std.stdio, std.algorithm;
/// Sort an array in place and return the number of writes. uint cycleSort(T)(T[] data) pure nothrow @safe @nogc {
typeof(return) nWrites = 0;
// Loop through the data to find cycles to rotate. foreach (immutable cycleStart, item1; data) { // Find where to put the item1. size_t pos = cycleStart; foreach (item2; data[cycleStart + 1 .. $]) if (item2 < item1) pos++;
// If the item1 is already there, this is not a cycle. if (pos == cycleStart) continue;
// Otherwise, put the item1 there or right after any duplicates. while (item1 == data[pos]) pos++; data[pos].swap(item1); nWrites++;
// Rotate the rest of the cycle. while (pos != cycleStart) { // Find where to put the item1. pos = cycleStart; foreach (item2; data[cycleStart + 1 .. $]) if (item2 < item1) pos++;
// Put the item1 there or right after any duplicates. while (item1 == data[pos]) pos++; data[pos].swap(item1); nWrites++; } }
return nWrites;
}
void main() {
immutable x = [0, 1, 2, 2, 2, 2, 1, 9, 3.5, 5, 8, 4, 7, 0, 6]; auto xs = x.dup; immutable nWrites = xs.cycleSort;
if (!xs.isSorted) { "Wrong order!".writeln; } else { writeln(x, "\nIs correctly sorted using cycleSort to:"); writefln("%s\nusing %d writes.", xs, nWrites); }
}</lang>
- Output:
[0, 1, 2, 2, 2, 2, 1, 9, 3.5, 5, 8, 4, 7, 0, 6] Is correctly sorted using cycleSort to: [0, 0, 1, 1, 2, 2, 2, 2, 3.5, 4, 5, 6, 7, 8, 9] using 10 writes.
Go
This implementation was translated from the example code on Wikipedia.
<lang go>package main
import ( "fmt" "math/rand" "time" )
func cyclesort(ints []int) int { writes := 0
for cyclestart := 0; cyclestart < len(ints)-1; cyclestart++ { item := ints[cyclestart]
pos := cyclestart
for i := cyclestart + 1; i < len(ints); i++ { if ints[i] < item { pos++ } }
if pos == cyclestart { continue }
for item == ints[pos] { pos++ }
ints[pos], item = item, ints[pos]
writes++
for pos != cyclestart { pos = cyclestart for i := cyclestart + 1; i < len(ints); i++ { if ints[i] < item { pos++ } }
for item == ints[pos] { pos++ }
ints[pos], item = item, ints[pos] writes++ } }
return writes }
func main() { rand.Seed(time.Now().Unix())
ints := rand.Perm(10)
fmt.Println(ints) fmt.Printf("writes %d\n", cyclesort(ints)) fmt.Println(ints) }</lang>
- Output:
[1 9 3 5 8 4 7 0 6 2] writes 10 [0 1 2 3 4 5 6 7 8 9]
Note: output may be different due to the random numbers used.
ooRexx
<lang oorexx>/*REXX program demonstrates a cycle sort on a list of numbers**********
- 13.06.2014 Walter Pachl
- Modified from Rexx Version 2
- ooRexx allows to pass a stemmed variable by reference
- swapping variables uses a temporary instead of the parse.
- /
a.1='George Washington Virginia' a.2='John Adams Massachusetts' a.3='Thomas Jefferson Virginia' a.4='James Madison Virginia' a.5='James Monroe Virginia' n=5 Call show 'Unsorted list: ' w=sortcycle(a.,n) Say 'sorted' Call show 'Sorted list' Say ' ' Say 'This took' w 'writes.' Exit
sortcycle: Procedure
Use Arg a.,n writes=0 Do c=1 For n x=a.c p=c x=a.c Do j=c+1 To n If a.j<x Then p=p+1 End If p==c Then Iterate Do While x==a.p p=p+1 End t=x x=a.p a.p=t writes=writes+1 Do While p\==c p=c Do k=c+1 To n If a.k<x Then p=p+1 End Do While x==a.p p=p+1 End t=x x=a.p a.p=t writes=writes+1 End End Return writes
show:
Parse Arg hdr Say ' ' Say hdr Do i=1 To n Say format(i,2) a.i End Return</lang>
- Output:
Unsorted list: 1 George Washington Virginia 2 John Adams Massachusetts 3 Thomas Jefferson Virginia 4 James Madison Virginia 5 James Monroe Virginia sorted Sorted list 1 George Washington Virginia 2 James Madison Virginia 3 James Monroe Virginia 4 John Adams Massachusetts 5 Thomas Jefferson Virginia This took 4 writes.
Perl 6
<lang perl6>sub cycle_sort ( @nums is rw ) {
my $writes = 0;
# Loop through the array to find cycles to rotate. for @nums.kv -> $cycle_start, $item is copy {
# Find where to put the item. my $pos = $cycle_start + @nums[ $cycle_start ^.. * ].grep: * < $item;
# If the item is already there, this is not a cycle. next if $pos == $cycle_start;
# Otherwise, put the item there or right after any duplicates. $pos++ while $item == @nums[$pos]; ( @nums[$pos], $item ) .= reverse; $writes++;
# Rotate the rest of the cycle. while $pos != $cycle_start {
# Find where to put the item. $pos = $cycle_start + @nums[ $cycle_start ^.. * ].grep: * < $item;
# Put the item there or right after any duplicates. $pos++ while $item == @nums[$pos]; ( @nums[$pos], $item ) .= reverse; $writes++; } }
return $writes;
}
my @a = <0 1 2 2 2 2 1 9 3.5 5 8 4 7 0 6>;
say @a; say 'writes ', cycle_sort(@a); say @a; </lang>
- Output:
0 1 2 2 2 2 1 9 3.5 5 8 4 7 0 6 writes 10 0 0 1 1 2 2 2 2 3.5 4 5 6 7 8 9
Python
The Wikipedia algorithm pseudocode is very nearly Python. The main changes needed were to change the name array to vector to stop it obscuring a built-in name, and iterating over an enumerated collection rather than using explicit indices.
<lang python>def cycleSort(vector):
"Sort a vector in place and return the number of writes." writes = 0 # Loop through the vector to find cycles to rotate. for cycleStart, item in enumerate(vector): # Find where to put the item. pos = cycleStart for item2 in vector[cycleStart + 1:]: if item2 < item: pos += 1 # If the item is already there, this is not a cycle. if pos == cycleStart: continue # Otherwise, put the item there or right after any duplicates. while item == vector[pos]: pos += 1 vector[pos], item = item, vector[pos] writes += 1 # Rotate the rest of the cycle. while pos != cycleStart: # Find where to put the item. pos = cycleStart for item2 in vector[cycleStart + 1:]: if item2 < item: pos += 1 # Put the item there or right after any duplicates. while item == vector[pos]: pos += 1 vector[pos], item = item, vector[pos] writes += 1 return writes
if __name__ == '__main__':
x = [0, 1, 2, 2, 2, 2, 1, 9, 3.5, 5, 8, 4, 7, 0, 6] xcopy = x[::] writes = cycleSort(xcopy) if xcopy != sorted(x): print('Wrong order!') else: print('%r\nIs correctly sorted using cycleSort to' '\n%r\nUsing %i writes.' % (x, xcopy, writes))</lang>
- Output:
[0, 1, 2, 2, 2, 2, 1, 9, 3.5, 5, 8, 4, 7, 0, 6] Is correctly sorted using cycleSort to [0, 0, 1, 1, 2, 2, 2, 2, 3.5, 4, 5, 6, 7, 8, 9] Using 10 writes.
REXX
version 1
<lang rexx>/* REXX ***************************************************************
- 12.06.2014 Walter Pachl translated from Wikipedia's code
- /
list='1 9 3 5 8 4 7 0 6 2' n=words(list) Do i=0 To n-1
array.i=word(list,i+1) End
Say list Call cyclesort ol= Do i=0 To n-1
ol=ol array.i End
Say strip(ol) Exit
cycleSort:
writes = 0 do cycleStart=0 to n-1 item = array.cycleStart pos = cycleStart Do i=cycleStart to n+1 if array.i < item Then pos += 1 End if pos == cycleStart Then Iterate Do while item == array.pos pos += 1 End Parse Value array.pos item With item array.pos writes += 1 Do while pos <> cycleStart pos = cycleStart Do i=cycleStart + 1 to n if array.i < item Then pos += 1 End Do while item == array.pos pos += 1 End Parse Value array.pos item With item array.pos writes += 1 End End Say 'writes='writes return</lang>
- Output:
1 9 3 5 8 4 7 0 6 2 writes=10 0 1 2 3 4 5 6 7 8 9
version 2
This REXX version demonstrates the use of negative numbers and non-integer values in the list.
As a default, the program uses (for the input list) some digits of pi, which for practical purposes, appear random. <lang rexx>/*REXX program demonstrates a cycle sort on a list of items. */ parse arg z /* [↓] not specified? Use π digs*/ if z= then z=-3.14 3 1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7 9 5 0 2 8 8 4 say 'unsorted list: ' z /*show the original unsorted #s. */ w=sortCycle(z) /*W: the # of writes done in sort*/ say 'and took' w 'writes.' /*show # of writes done in sort. */ exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────SORTCYCLE subroutine────────────────*/ sortCycle: procedure expose @.; parse arg y; #=words(y); writes=0
do i=1 for #; @.i=word(y,i); end /*i*/ /*put items ───► @.*/ /* [↓] find cycles to rotate. */ do c=1 for #; x=@.c; p=c /*X is the item being sorted. */ do j=c+1 to #; if @.j<x then p=p+1; end /*where to put X.*/ if p==c then iterate /*Is it there? This ain't a cycle*/ do while x==@.p; p=p+1; end /*put X right after any duplicate*/ parse value @.p x with x @.p /*swap the two values: @.p and X.*/ writes=writes+1 /*bump counter for # of writes.*/ do while p\==c; p=c /*rotate the rest of the cycle. */ do k=c+1 to #; if @.k<x then p=p+1; end /*k*/ do while x==@.p; p=p+1; end /*put X here or right after dups.*/ parse value @.p x with x @.p /*swap the two values: @.p and X.*/ writes=writes+1 /*bump counter for # of writes.*/ end /*while p\==c*/ end /*c*/ /* [↓] display the sorted list. */
_=@.1; do j=2 to #; _=_ @.j; end; say ' sorted list: ' _ return writes</lang> output using the default input:
unsorted list: -3.14 3 1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7 9 5 0 2 8 8 4 sorted list: -3.14 0 1 1 2 2 2 2 2 3 3 3 3 3 3 3 4 4 4 4 5 5 5 5 6 6 6 7 7 8 8 8 8 8 9 9 9 9 and took 34 writes.
output using the input of: FM Stereo has been around since 1961.
unsorted list: FM Stereo has been around since 1961. sorted list: 1961. FM Stereo around been has since and took 7 writes.
Note (for the above output). This REXX program was executed on an ASCII machine.
On an ASCII machine, the order of sorting is numbers, uppercase letters, lowercase letters.
On an EBCDIC machine, the order of sorting is lowercase letters, uppercase letters, numbers.
Other (special) characters are also in a different order.
version 3
This version uses a faster (but a more cryptic) version of incrementing 1 (one) to P within two do loops. <lang rexx>/*REXX program demonstrates a cycle sort on a list of items. */ parse arg z /* [↓] not specified? Use π digs*/ if z= then z=-3.14 3 1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7 9 5 0 2 8 8 4 say 'unsorted list: ' z /*show the original unsorted #s. */ w=sortCycle(z) /*W: the # of writes done in sort*/ say 'and took' w 'writes.' /*show # of writes done in sort. */ exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────SORTCYCLE subroutine────────────────*/ sortCycle: procedure expose @.; parse arg y; #=words(y); writes=0
do i=1 for #; @.i=word(y,i); end /*i*/ /*put items ───► @.*/ /* [↓] find cycles to rotate. */ do c=1 for #; x=@.c; p=c /*X is the item being sorted. */ do j=c+1 to #; if @.j<x then p=p+1; end /*where to put X.*/ if p==c then iterate /*Is it there? This ain't a cycle*/ do p=p while x==@.p; end /*put X right after any duplicate*/ parse value @.p x with x @.p /*swap the two values: @.p and X.*/ writes=writes+1 /*bump counter for # of writes. */ do while p\==c; p=c /*rotate the rest of the cycle. */ do k=c+1 to #; if @.k<x then p=p+1; end /*k*/ do p=p while x==@.p; end /*put X here or right after dups.*/ parse value @.p x with x @.p /*swap the two values: @.p and X.*/ writes=writes+1 /*bump counter for # of writes.*/ end /*while p\==c*/ end /*c*/ /* [↓] display the sorted list. */
_=@.1; do j=2 to #; _=_ @.j; end; say ' sorted list: ' _ return writes</lang> output is identical to the 2nd version.
version 4
This version uses a subroutine to perform the task of handling an (sorted) item placement (possibly after duplicates). <lang rexx>/*REXX program demonstrates a cycle sort on a list of items. */ parse arg z /* [↓] not specified? Use π digs*/ if z= then z=-3.14 3 1 4 1 5 9 2 6 5 3 5 8 9 7 9 3 2 3 8 4 6 2 6 4 3 3 8 3 2 7 9 5 0 2 8 8 4 say 'unsorted list: ' z /*show the original unsorted #s. */ w=sortCycle(z) /*W: the # of writes done in sort*/ say 'and took' w 'writes.' /*show # of writes done in sort. */ exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────SORTCYCLE subroutine────────────────*/ sortCycle: procedure expose @.; parse arg y; #=words(y); w=0
do i=1 for #; @.i=word(y,i); end /*i*/ /*put items ──► @*/
do c=1 for #; x=@.c; p=c /*X is the item being sorted. */ do j=c+1 to #; if @.j<x then p=p+1; end /*j*/ /*where to put X*/ if p==c then iterate /*Is it there? This ain't a cycle*/ call .Pdup /*put X here or right after dups.*/ do while p\==c; p=c /*rotate the rest of the cycle. */ do k=c+1 to #; if @.k<x then p=p+1; end /*k*/ call .Pdup /*put X here or right after dups.*/ end /*while p\==c*/ end /*c*/ /* [↓] display the sorted list. */
_=@.1; do j=2 to #; _=_ @.j; end; say ' sorted list: ' _ return w /* [↓] find where to put X into @*/ .pDup: do p=p while x==@.p; end; parse value @.p x with x @.p;w=w+1;return</lang> output is identical to the 2nd version.