Sorting algorithms/Bead sort: Difference between revisions
No edit summary |
|||
| Line 322: | Line 322: | ||
let rec transpose = function |
let rec transpose = function |
||
| [] -> [] |
| [] -> [] |
||
| lists -> (List.map List.head lists) :: transpose(removeEmptyLists (List.map List.tail lists)) |
| lists -> (List.map List.head lists) :: transpose(removeEmptyLists (List.map List.tail lists)) |
||
// Using the backward composition operator "<<" (equivalent to Haskells ".") ... |
// Using the backward composition operator "<<" (equivalent to Haskells ".") ... |
||
let |
let beadSort = |
||
List.map List.sum << transpose << transpose << List.map (flip List.replicate 1) |
List.map List.sum << transpose << transpose << List.map (flip List.replicate 1) |
||
| Line 332: | Line 332: | ||
let beadSort2 = |
let beadSort2 = |
||
List.map (flip List.replicate 1) >> transpose >> transpose >> List.map List.sum</lang> |
List.map (flip List.replicate 1) >> transpose >> transpose >> List.map List.sum</lang> |
||
Usage: |
Usage: beadSort [2;4;1;3;3] or beadSort2 [2;4;1;3;3] |
||
Output: |
Output: |
||
Revision as of 06:02, 26 March 2011
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
In this task, the goal is to sort an array of positive integers using the Bead Sort Algorithm.
Algorithm has O(S), where S is the sum of the integers in the input set: Each bead is moved individually. This is the case when bead sort is implemented without a mechanism to assist in finding empty spaces below the beads, such as in software implementations.
C
A rather straightforward implementation; since we do not use dynamic matrix, we have to know the maximum value in the array in advance. Using no sparse matrix means the matrix needs MAX*MAX times the size of an integer bytes to be stored.
<lang c>#include <stdio.h>
- include <stdlib.h>
- include <stdbool.h>
- include <string.h>
int *bead_sort(int *a, size_t len) {
size_t i, j, k; bool fallen; int *t, *r = NULL; int max = a[0];
for(i = 1; i < len; i++)
{
if ( a[i] < 0 ) return NULL; // we can't sort nums < 0
if ( max < a[i] ) max = a[i];
}
t = malloc(max*max*sizeof(int));
if ( t == NULL ) return NULL;
memset(t, 0, max*max*sizeof(int));
r = malloc(len*sizeof(int));
memset(r, 0, len*sizeof(int));
if (r != NULL)
{
// "split" numbers into "beads" (units)
for(i = 0; i < len; i++)
{
for(j = 0; j < a[i]; j++) t[i*max + j]++;
}
// make them fall down
do
{
fallen = false;
for(i = 0; i < max-1; i++)
{
for(j = 0; j < max; j++) { if ( t[i*max + j] == 1 && t[(i+1)*max + j] == 0 ) { fallen = true; t[i*max + j] = 0; t[(i+1)*max + j] = 1; } }
} } while(fallen);
- if defined(SHOW_BEADS)
for(i = 0; i < max; i++)
{
for(j = 0; j < max; j++)
{
printf("%d ", t[i*max + j]);
}
printf("\n");
}
- endif
// count beads
k = 0;
for(i = 0; i < max; i++)
{
if ( t[(max - i - 1)*max + 0] == 0 ) break;
for(j = 0; j < max; j++)
{
int v = t[(max - i - 1)*max + j]; if ( v == 0 ) break; r[k] += v;
}
k++;
}
}
free(t);
return r;
}
int main() {
int values[] = {5, 3, 1, 7, 4, 1, 1, 20};
size_t i, len = sizeof(values)/sizeof(int);
int *r = bead_sort(values, len); if ( r == NULL ) return EXIT_FAILURE;
for(i = 0; i < len; i++)
{
printf("%d ", r[i]);
}
putchar('\n');
free(r); return EXIT_SUCCESS;
}</lang>
C++
<lang cpp>//this algorithm only works with positive, whole numbers. //O(2n) time complexity where n is the summation of the whole list to be sorted. //O(3n) space complexity.
- include<iostream>
- include<vector>
using namespace std;
void distribute( int dist, vector<int> &List)//*beads* go down into different buckets using gravity (addition). {
if (dist > List.size() )
List.resize(dist,0); //resize if too big for current vector
for (int i=0; i < dist; i++)
List[i] = List[i]+1;
}
int main() {
vector<int> list;
vector<int> list2;
int myints[] = {5,3,1,7,4,1,1};
vector<int> fifth (myints, myints + sizeof(myints) / sizeof(int) );
cout << "#1 Beads falling down: ";
for (int i=0; i < fifth.size(); i++)
distribute (fifth[i], list);
cout << endl;
cout <<endl<< "Beads on their sides: ";
for (int i=0; i < list.size(); i++)
cout << " " << list[i];
cout << endl;
//second part
cout << "#2 Beads right side up: ";
for (int i=0; i < list.size(); i++)
distribute (list[i], list2);
cout << endl;
cout <<endl<< "Sorted list/array";
for (int i=0; i < list2.size(); i++)
cout << " " << list2[i];
cout << endl;
return 0;
}</lang>
Output:
Beads falling down:
Beads on their sides: 7 4 4 3 2 1 1 Beads right side up:
Sorted list/array 7 5 4 3 1 1 1
Positive, Negative, and Zeros (all integers)
<lang Cpp>
- include<iostream>
- include<vector>
using namespace std;
void distribute_neg( int dist, vector<int> &List) { dist=-dist; //resets to positive number for implamentation
if (dist > List.size() ) List.resize(dist,0);//can be done differently but *meh*
for (int i=0; i < dist; i++) List[i]=List[i]-1; } //end of distribute negative
void distribute_pos( int dist, vector<int> &List) if (dist > List.size() ) List.resize(dist,0);
for (int i=0; i < dist; i++) List[i]=List[i]+1; } //end of distribute positive
void sort(vector<int> &List){ int i; int zeros=0; vector<int> list; vector<int> list_pos; vector<int> sorted; vector<int> sorted_pos; cout << "#1 Beads falling down: "; for (i=0; i < List.size(); i++) if (List[i] < 0) distribute_neg (List[i], list); else if (List[i] > 0) distribute_pos(List[i], list_pos); else zeros++;
cout << endl;
cout <<endl<< "Beads on their sides neg: "; for (i=0; i < list.size(); i++) cout << " " << list[i]; cout << endl;
cout <<endl<< "Beads on their sides positive: "; for (i=0; i < list_pos.size(); i++) cout << " " << list_pos[i]; cout << endl; //second part
cout << "#2 Beads right side up: "; for (i=0; i < list.size(); i++) distribute_neg (list[i], sorted);
for (i=0; i < list_pos.size(); i++) distribute_pos(list_pos[i], sorted_pos); cout << endl;
cout << endl;
cout <<endl<< "Sorted list/array neg"; for (i=0; i < sorted.size(); i++) cout << " " << sorted[i]; cout << endl;
cout <<endl<< "Sorted list/array pos"; for (i=0; i < sorted_pos.size(); i++) cout << " " << sorted_pos[i]; cout << endl;
//combine two at end.
while (zeros > 0) { sorted_pos.push_back(0); zeros--; }
i=sorted.size()-1; while (i >= 0) { sorted_pos.push_back(sorted[i]); i--; }
cout <<endl<< "Sorted list/array"; for (i=0; i < sorted_pos.size(); i++) cout << " " << sorted_pos[i]; cout << endl; }
int main(){ int myints[] = {-1, -4, -3, 1, 4, 3, 0}; vector<int> arr (myints, myints + sizeof(myints) / sizeof(int) ); sort(arr); return 0;
}</lang>
Clojure
<lang Clojure>(defn transpose [xs]
(loop [transposed [], remaining xs]
(if (empty? remaining)
transposed
(recur
(conj transposed (map #(first %) remaining))
(filter #(not-empty %) (map #(rest %) remaining)))) ))
(defn bead-sort [xs]
(map #(reduce + %)
(transpose
(transpose (map #(replicate % 1) xs)))))
(println (bead-sort [5 2 4 1 3 3 9])) </lang>
Output:
(9 5 4 3 3 2 1)
D
<lang d>import std.stdio, std.algorithm, std.range;
auto beadSort(int[] l) {
auto columns(R)(R m) {
int[][] r;
foreach (i; 0 .. reduce!max(map!walkLength(m))) {
r.length += 1;
foreach (sub; m)
if (sub.length > i)
r[$-1] ~= 0;
}
return r;
}
auto m = map!"new int[a]"(l);
return map!walkLength(columns(columns(m)));
}
void main() {
writeln(beadSort([5, 3, 1, 7, 4, 1, 1]));
}</lang> Output (D V.2.048):
[7, 5, 4, 3, 1, 1, 1]
F#
<lang fsharp>open System
let removeEmptyLists lists = lists |> List.filter (not << List.isEmpty) let flip f x y = f y x
let rec transpose = function
| [] -> [] | lists -> (List.map List.head lists) :: transpose(removeEmptyLists (List.map List.tail lists))
// Using the backward composition operator "<<" (equivalent to Haskells ".") ... let beadSort =
List.map List.sum << transpose << transpose << List.map (flip List.replicate 1)
// Using the forward composition operator ">>" ... let beadSort2 =
List.map (flip List.replicate 1) >> transpose >> transpose >> List.map List.sum</lang>
Usage: beadSort [2;4;1;3;3] or beadSort2 [2;4;1;3;3]
Output:
val it : int list = [4; 3; 3; 2; 1]
Fortran
removing the iso_fortran_env as explained in code
This implementation suffers the same problems of the C implementation: if the maximum value in the array to be sorted is very huge, likely there will be not enough free memory to complete the task. Nonetheless, if the Fortran implementation would use "silently" sparse arrays and a compact representation for "sequences" of equal values in an array, then this very same code would run fine even with large integers.
<lang fortran>program BeadSortTest
use iso_fortran_env ! for ERROR_UNIT; to make this a F95 code, ! remove prev. line and declare ERROR_UNIT as an ! integer parameter matching the unit associated with ! standard error
integer, dimension(7) :: a = (/ 7, 3, 5, 1, 2, 1, 20 /)
call beadsort(a) print *, a
contains
subroutine beadsort(a) integer, dimension(:), intent(inout) :: a
integer, dimension(maxval(a), maxval(a)) :: t integer, dimension(maxval(a)) :: s integer :: i, m
m = maxval(a)
if ( any(a < 0) ) then
write(ERROR_UNIT,*) "can't sort"
return
end if
t = 0
forall(i=1:size(a)) t(i, 1:a(i)) = 1 ! set up abacus
forall(i=1:m) ! let beads "fall"; instead of
s(i) = sum(t(:, i)) ! moving them one by one, we just
t(:, i) = 0 ! count how many should be at bottom,
t(1:s(i), i) = 1 ! and then "reset" and set only those
end forall
forall(i=1:size(a)) a(i) = sum(t(i,:))
end subroutine beadsort
end program BeadSortTest</lang>
Go
Sorts non-negative integers only. The extension to negative values seemed a distraction from this fun task. <lang go>package main
import (
"fmt" "sync"
)
var a = []int{170, 45, 75, 90, 802, 24, 2, 66} var aMax = 1000
func main() {
fmt.Println("before:", a)
beadSort()
fmt.Println("after: ", a)
}
func beadSort() {
// Poles modeled with a channel for each pole.
abacus := make([]chan byte, aMax)
for iPole := range abacus {
abacus[iPole] = make(chan byte, len(a))
}
const bead = 'o'
// Values to be sorted are modeled as concurrent
// goroutines that place of beads on poles.
// Sending a bead on a channel corresponds to
// letting it fall. The WaitGroup falling tracks
// the number of rows of beads that are falling.
var falling sync.WaitGroup
falling.Add(len(a))
for _, x := range a {
go func(x int) {
for iPole := 0; iPole < x; iPole++ {
abacus[iPole] <- bead
}
falling.Done()
}(x)
}
// Beads fall concurrently as CPU cores are available.
// When all beads are done falling, the numbers can
// read out from highest to lowest.
falling.Wait()
for i := len(a) - 1; i >= 0; i-- {
x := 0
for _, pole := range abacus {
select {
case <-pole:
x++
continue
default:
}
break
}
a[i] = x
}
}</lang>
Groovy
Solution: <lang groovy>def beadSort = { list ->
final nPoles = list.max()
list.collect {
print "."
([true] * it) + ([false] * (nPoles - it))
}.transpose().collect { pole ->
print "."
pole.findAll { ! it } + pole.findAll { it }
}.transpose().collect{ beadTally ->
beadTally.findAll{ it }.size()
}
}</lang>
Annotated Solution (same solution really): <lang groovy>def beadSortVerbose = { list ->
final nPoles = list.max()
// each row is a number tally-arrayed across the abacus
def beadTallies = list.collect { number ->
print "."
// true == bead, false == no bead
([true] * number) + ([false] * (nPoles - number))
}
// each row is an abacus pole
def abacusPoles = beadTallies.transpose()
def abacusPolesDrop = abacusPoles.collect { pole ->
print "."
// beads drop to the BOTTOM of the pole
pole.findAll { ! it } + pole.findAll { it }
}
// each row is a number again
def beadTalliesDrop = abacusPolesDrop.transpose()
beadTalliesDrop.collect{ beadTally -> beadTally.findAll{ it }.size() }
}</lang>
Test: <lang groovy>println beadSort([23,76,99,58,97,57,35,89,51,38,95,92,24,46,31,24,14,12,57,78,4]) println beadSort([88,18,31,44,4,0,8,81,14,78,20,76,84,33,73,75,82,5,62,70,12,7,1])</lang>
Output:
........................................................................................................................[4, 12, 14, 23, 24, 24, 31, 35, 38, 46, 51, 57, 57, 58, 76, 78, 89, 92, 95, 97, 99] ...............................................................................................................[0, 1, 4, 5, 7, 8, 12, 14, 18, 20, 31, 33, 44, 62, 70, 73, 75, 76, 78, 81, 82, 84, 88]
Individual dots shown here are "retallying dots". They are not equivalent to the "swap dots" shown in other Groovy sorting examples. Like the swap dots the retallying dots represent atomic operations that visually indicate the overall sorting effort. However, they are not equivalent to swaps, or even equivalent in actual effort between bead sorts.
The cost of transposition is not accounted for here because with clever indexing it can easily be optimized away. In fact, one could write a list class for Groovy that performs the transpose operation merely by setting a single boolean value that controls indexing calculations.
Haskell
<lang haskell>import Data.List
beadSort :: [Int] -> [Int] beadSort = map sum. transpose. transpose. map (flip replicate 1)</lang> Example; <lang haskell>*Main> beadSort [2,4,1,3,3] [4,3,3,2,1]</lang>
Icon and Unicon
The program below handles integers and not just whole numbers. As are so many others, the solution is limited by the lack of sparse array or list compression.
<lang Icon>procedure main() #: demonstrate various ways to sort a list and string
write("Sorting Demo using ",image(beadsort))
writes(" on list : ")
writex(UL := [3, 14, 1, 5, 9, 2, 6, 3])
displaysort(beadsort,copy(UL))
end
procedure beadsort(X) #: return sorted list ascending(or descending) local base,i,j,x # handles negatives and zeros, may also reduce storage
poles := list(max!X-(base := min!X -1),0) # set up poles, we will track sums not individual beads
every x := !X do { # each item in the list
if integer(x) ~= x then runerr(101,x) # ... must be an integer
every poles[1 to x - base] +:= 1 # ... beads "fall" into the sum for that pole
}
every (X[j := *X to 1 by -1] := base) & (i := 1 to *poles) do # read from the bottom of the poles
if poles[i] > 0 then { # if there's a bead on the pole ...
poles[i] -:= 1 # ... remove it
X[j] +:= 1 # ... and add it in place
} return X
end</lang>
Note: This example relies on the supporting procedures 'writex' in Bubble Sort.
Abbreviated sample output:
Sorting Demo using procedure beadsort
on list : [ 3 14 1 5 9 2 6 3 ]
with op = &null: [ 1 2 3 3 5 6 9 14 ] (0 ms)
J
<lang j>bead=: [: +/ #"0&1</lang>
Example use:
<lang> bead bead 2 4 1 3 3 4 3 3 2 1
bead bead 5 3 1 7 4 1 1
7 5 4 3 1 1 1</lang>
Extending to deal with sequences of arbitrary integers:
<lang j>bball=: ] (] + [: bead^:2 -) <./ - 1:</lang>
Example use:
<lang> bball 2 0 _1 3 1 _2 _3 0 3 2 1 0 0 _1 _2 _3</lang>
Octave
<lang octave>function sorted = beadsort(a)
sorted = a;
m = max(a);
if ( any(a < 0) )
error("can't sort");
endif
t = zeros(m, m);
for i = 1:numel(a)
t(i, 1:a(i)) = 1;
endfor
for i = 1:m
s = sum(t(:, i));
t(:, i) = 0;
t(1:s, i) = 1;
endfor
for i = 1:numel(a)
sorted(i) = sum(t(i, :));
endfor
endfunction
beadsort([5, 7, 1, 3, 1, 1, 20])</lang>
Perl
Instead of storing the bead matrix explicitly, I choose to store just the number of beads in each row and column, compacting on the fly. At all times, the sum of the row widths is equal to the sum column heights.
<lang perl>sub beadsort {
my @data = @_;
my @columns; my @rows;
for my $datum (@data) {
for my $column ( 0 .. $datum-1 ) {
++ $rows[ $columns[$column]++ ];
}
}
return reverse @rows;
}
beadsort 5, 7, 1, 3, 1, 1, 20; </lang>
Perl 6
<lang perl6>use List::Utils;
sub beadsort(@l) {
(transpose(transpose(map {[1 xx $_]}, @l))).map(*.elems);
}
my @list = 2,1,3,5; say beadsort(@list).perl;</lang>
Output:
(5, 3, 2, 1)
PicoLisp
The following implements a direct model of the bead sort algorithm. Each pole is a list of 'T' symbols for the beads. <lang PicoLisp>(de beadSort (Lst)
(let Abacus (cons NIL)
(for N Lst # Thread beads on poles
(for (L Abacus (ge0 (dec 'N)) (cdr L))
(or (cdr L) (queue 'L (cons)))
(push (cadr L) T) ) )
(make
(while (gt0 (cnt pop (cdr Abacus))) # Drop and count beads
(link @) ) ) ) )</lang>
Output:
: (beadSort (5 3 1 7 4 1 1 20)) -> (20 7 5 4 3 1 1 1)
PL/I
<lang PL/I> /* Handles both negative and positive values. */
maxval: procedure (z) returns (fixed binary);
declare z(*) fixed binary;
declare (maxv initial (0), i) fixed binary;
do i = lbound(z,1) to hbound(z,1);
maxv = max(z(i), maxv);
end;
put skip data (maxv); put skip;
return (maxv);
end maxval; minval: procedure (z) returns (fixed binary);
declare z(*) fixed binary; declare (minv initial (0), i) fixed binary;
do i = lbound(z,1) to hbound(z,1);
if z(i) < 0 then minv = min(z(i), minv);
end;
put skip data (minv); put skip;
return (minv);
end minval;
/* To deal with negative values, array elements are incremented */ /* by the greatest (in magnitude) negative value, thus making */ /* them positive. The resultant values are stored in an */ /* unsigned array (PL/I provides both signed and unsigned data */ /* types). At procedure end, the array values are restored to */ /* original values. */
(subrg, fofl, size, stringrange, stringsize): beadsort: procedure (z); /* 8-1-2010 */
declare (z(*)) fixed binary; declare b(maxval(z)-minval(z)+1) bit (maxval(z)-minval(z)+1) aligned; declare (i, j, k, m, n) fixed binary; declare a(hbound(z,1)) fixed binary unsigned; declare offset fixed binary initial (minval(z));
PUT SKIP LIST('CHECKPOINT A'); PUT SKIP;
n = hbound(z,1);
m = hbound(b,1);
if offset < 0 then
a = z - offset;
else
a = z;
b = '0'b;
do i = 1 to n;
substr(b(i), 1, a(i)) = copy('1'b, a(i));
end;
do j = 1 to m; put skip list (b(j)); end;
do j = 1 to m;
k = 0;
do i =1 to n;
if substr(b(i), j, 1) then k = k + 1;
end;
do i = 1 to n;
substr(b(i), j, 1) = (i <= k);
end;
end;
put skip;
do j = 1 to m; put skip list (b(j)); end;
do i = 1 to n;
k = 0;
do j = 1 to m; k = k + substr(b(i), j, 1); end;
a(i) = k;
end;
if offset < 0 then z = a + offset; else z = a;
end beadsort;</lang>
PowerShell
<lang PowerShell>Function BeadSort ( [Int64[]] $indata ) { if( $indata.length -gt 1 ) { $min = $indata[ 0 ] $max = $indata[ 0 ] for( $i = 1; $i -lt $indata.length; $i++ ) { if( $indata[ $i ] -lt $min ) { $min = $indata[ $i ] } if( $indata[ $i ] -gt $max ) { $max = $indata[ $i ] } } #Find the min & max $poles = New-Object 'UInt64[]' ( $max - $min + 1 ) $indata | ForEach-Object { $min..$_ | ForEach-Object { $poles[ $_ - $min ] += 1 } } #Add Beads to the poles, already moved to the bottom $min..( $max - 1 ) | ForEach-Object { $i = $_ - $min if( $poles[ $i ] -gt $poles[ $i + 1 ] ) { #No special case needed for min, since there will always be at least 1 = min ( $poles[ $i ] )..( $poles[ $i + 1 ] + 1 ) | ForEach-Object { Write-Output ( $i + $min ) } } } #Output the results in pipeline fashion 1..( $poles[ $max - $min ] ) | ForEach-Object { Write-Output $max #No special case needed for max, since there will always be at least 1 = max } } else { Write-Output $indata } }
$l = 100; BeadSort ( 1..$l | ForEach-Object { $Rand = New-Object Random }{ $Rand.Next( -( $l - 1 ), $l - 1 ) } )</lang>
PureBasic
<lang PureBasic>#MAXNUM=100
Dim MyData(Random(15)+5) Global Dim Abacus(0,0)
Declare BeadSort(Array InData(1)) Declare PresentData(Array InData(1))
If OpenConsole()
Define i
;- Generate a random array
For i=0 To ArraySize(MyData())
MyData(i)=Random(#MAXNUM)
Next i
PresentData(MyData())
;
;- Sort the array
BeadSort(MyData())
PresentData(MyData())
;
Print("Press ENTER to exit"): Input()
EndIf
Procedure LetFallDown(x)
Protected y=ArraySize(Abacus(),2)-1
Protected ylim=y
While y>=0
If Abacus(x,y) And Not Abacus(x,y+1)
Swap Abacus(x,y), Abacus(x,y+1)
If y<ylim: y+1: Continue: EndIf
Else
y-1
EndIf
Wend
EndProcedure
Procedure BeadSort(Array n(1))
Protected i, j, k
NewList T()
Dim Abacus(#MAXNUM,ArraySize(N()))
;- Set up the abacus
For i=0 To ArraySize(Abacus(),2)
For j=1 To N(i)
Abacus(j,i)=#True
Next
Next
;- sort it in threads to simulate free beads falling down
For i=0 To #MAXNUM
AddElement(T()): T()=CreateThread(@LetFallDown(),i)
Next
ForEach T()
WaitThread(T())
Next
;- send it back to a normal array
For j=0 To ArraySize(Abacus(),2)
k=0
For i=0 To ArraySize(Abacus())
k+Abacus(i,j)
Next
N(j)=k
Next
EndProcedure
Procedure PresentData(Array InData(1))
Protected n, m, sum PrintN(#CRLF$+"The array is;") For n=0 To ArraySize(InData()) m=InData(n): sum+m Print(Str(m)+" ") Next PrintN(#CRLF$+"And its sum= "+Str(sum))
EndProcedure</lang>
The array is; 4 38 100 25 69 69 16 8 59 71 53 33 And its sum= 545 The array is; 4 8 16 25 33 38 53 59 69 69 71 100 And its sum= 545
Python
<lang python>def beadsort(l):
return map(len, columns(columns([[1] * e for e in l])))
def columns(l):
try: from itertools import zip_longest except: zip_longest = lambda *args: map(None, *args) return [filter(None, x) for x in zip_longest(*l)]
- Demonstration code:
beadsort([5,3,1,7,4,1,1])</lang>
Output:
=> [7, 5, 4, 3, 1, 1, 1]
REXX
The REXX language has the advantage of implenting (true) sparse arrays and with that feature,
implementing a bead sort is trivial, the major drawback is if the spread (difference between
the lowest and highest values) is quite large.
Negative and duplicate numbers (values) are no problem.
<lang rexx>
/*REXX program sorts a list of integers using a bead sort. */
/*get some grassHopper numbers. */
grasshopper=, 1 4 10 12 22 26 30 46 54 62 66 78 94 110 126 134 138 158 162 186 190 222 254 270
/*GreeenGrocer numbers are also called hexagonal pyramidal */
/* numbers. */
greengrocer=, 0 4 16 40 80 140 224 336 480 660 880 1144 1456 1820 2240 2720 3264 3876 4560
/*get some Bernoulli numerator numbers. */
bernN='1 -1 1 0 -1 0 1 0 -1 0 5 0 -691 0 7 0 -3617 0 43867 0 -174611 0 854513'
/*Psi is also called the Reduced Totient function, and */
/* is also called Carmichale lambda, or LAMBDA function.*/
psi=, 1 1 2 2 4 2 6 2 6 4 10 2 12 6 4 4 16 6 18 4 6 10 22 2 20 12 18 6 28 4 30 8 10 16
list=grasshopper greengrocer bernN psi /*combine the four lists into one*/
call showL 'before sort',list /*show list before sorting. */
$=beadSort(list) /*invoke the bead sort. */
call showL ' after sort',$ /*show after array elements*/
exit
/*─────────────────────────────────────SHOW@ subroutine────────────*/
beadSort: procedure expose @.; parse arg z
$= /*this'll be the sorted list*/
low=999999999; high=-low /*define the low and high #s*/
@.=0 /*define all beads to zero. */
do j=1 until z== /*pick the meat off the bone*/
parse var z x z
if \datatype(x,'Whole') then do
say; say '*** error! ***'; say
say 'element' j "in list isn't numeric:" x
say
exit 13
end
x=x/1 /*normalize number, it could*/
/*be: +4 007 5. 2e3 etc.*/
@.x=@.x+1 /*indicate this bead has a #*/
low=min(low,x) /*keep track of the lowest #*/
high=max(high,x) /* " " " " highest#*/
end /*j*/
/*now, collect the beads and*/ do m=low to high /*let them fall (to zero). */ if @.m==0 then iterate /*No bead here? Keep looking*/ do n=1 for @.m /*let the beads fall to 0. */ $=$ m /*add it to the sorted list.*/ end end
return $
/*─────────────────────────────────────SHOW@ subroutine────────────*/
showL: widthH=length(words(arg(2))) /*maximum width of the index*/
do j=1 for words(arg(2)) say 'element' right(j,widthH) arg(1)":" right(word(arg(2),j),10) end
say copies('─',80) /*show a seperator line. */ return </lang> Output:
element 1 before sort: 1 element 2 before sort: 4 element 3 before sort: 10 element 4 before sort: 12 element 5 before sort: 22 element 6 before sort: 26 element 7 before sort: 30 element 8 before sort: 46 element 9 before sort: 54 element 10 before sort: 62 element 11 before sort: 66 element 12 before sort: 78 element 13 before sort: 94 element 14 before sort: 110 element 15 before sort: 126 element 16 before sort: 134 element 17 before sort: 138 element 18 before sort: 158 element 19 before sort: 162 element 20 before sort: 186 element 21 before sort: 190 element 22 before sort: 222 element 23 before sort: 254 element 24 before sort: 270 element 25 before sort: 0 element 26 before sort: 4 element 27 before sort: 16 element 28 before sort: 40 element 29 before sort: 80 element 30 before sort: 140 element 31 before sort: 224 element 32 before sort: 336 element 33 before sort: 480 element 34 before sort: 660 element 35 before sort: 880 element 36 before sort: 1144 element 37 before sort: 1456 element 38 before sort: 1820 element 39 before sort: 2240 element 40 before sort: 2720 element 41 before sort: 3264 element 42 before sort: 3876 element 43 before sort: 4560 element 44 before sort: 1 element 45 before sort: -1 element 46 before sort: 1 element 47 before sort: 0 element 48 before sort: -1 element 49 before sort: 0 element 50 before sort: 1 element 51 before sort: 0 element 52 before sort: -1 element 53 before sort: 0 element 54 before sort: 5 element 55 before sort: 0 element 56 before sort: -691 element 57 before sort: 0 element 58 before sort: 7 element 59 before sort: 0 element 60 before sort: -3617 element 61 before sort: 0 element 62 before sort: 43867 element 63 before sort: 0 element 64 before sort: -174611 element 65 before sort: 0 element 66 before sort: 854513 element 67 before sort: 1 element 68 before sort: 1 element 69 before sort: 2 element 70 before sort: 2 element 71 before sort: 4 element 72 before sort: 2 element 73 before sort: 6 element 74 before sort: 2 element 75 before sort: 6 element 76 before sort: 4 element 77 before sort: 10 element 78 before sort: 2 element 79 before sort: 12 element 80 before sort: 6 element 81 before sort: 4 element 82 before sort: 4 element 83 before sort: 16 element 84 before sort: 6 element 85 before sort: 18 element 86 before sort: 4 element 87 before sort: 6 element 88 before sort: 10 element 89 before sort: 22 element 90 before sort: 2 element 91 before sort: 20 element 92 before sort: 12 element 93 before sort: 18 element 94 before sort: 6 element 95 before sort: 28 element 96 before sort: 4 element 97 before sort: 30 element 98 before sort: 8 element 99 before sort: 10 element 100 before sort: 16 ──────────────────────────────────────────────────────────────────────────────── element 1 after sort: -174611 element 2 after sort: -3617 element 3 after sort: -691 element 4 after sort: -1 element 5 after sort: -1 element 6 after sort: -1 element 7 after sort: 0 element 8 after sort: 0 element 9 after sort: 0 element 10 after sort: 0 element 11 after sort: 0 element 12 after sort: 0 element 13 after sort: 0 element 14 after sort: 0 element 15 after sort: 0 element 16 after sort: 0 element 17 after sort: 0 element 18 after sort: 1 element 19 after sort: 1 element 20 after sort: 1 element 21 after sort: 1 element 22 after sort: 1 element 23 after sort: 1 element 24 after sort: 2 element 25 after sort: 2 element 26 after sort: 2 element 27 after sort: 2 element 28 after sort: 2 element 29 after sort: 2 element 30 after sort: 4 element 31 after sort: 4 element 32 after sort: 4 element 33 after sort: 4 element 34 after sort: 4 element 35 after sort: 4 element 36 after sort: 4 element 37 after sort: 4 element 38 after sort: 5 element 39 after sort: 6 element 40 after sort: 6 element 41 after sort: 6 element 42 after sort: 6 element 43 after sort: 6 element 44 after sort: 6 element 45 after sort: 7 element 46 after sort: 8 element 47 after sort: 10 element 48 after sort: 10 element 49 after sort: 10 element 50 after sort: 10 element 51 after sort: 12 element 52 after sort: 12 element 53 after sort: 12 element 54 after sort: 16 element 55 after sort: 16 element 56 after sort: 16 element 57 after sort: 18 element 58 after sort: 18 element 59 after sort: 20 element 60 after sort: 22 element 61 after sort: 22 element 62 after sort: 26 element 63 after sort: 28 element 64 after sort: 30 element 65 after sort: 30 element 66 after sort: 40 element 67 after sort: 46 element 68 after sort: 54 element 69 after sort: 62 element 70 after sort: 66 element 71 after sort: 78 element 72 after sort: 80 element 73 after sort: 94 element 74 after sort: 110 element 75 after sort: 126 element 76 after sort: 134 element 77 after sort: 138 element 78 after sort: 140 element 79 after sort: 158 element 80 after sort: 162 element 81 after sort: 186 element 82 after sort: 190 element 83 after sort: 222 element 84 after sort: 224 element 85 after sort: 254 element 86 after sort: 270 element 87 after sort: 336 element 88 after sort: 480 element 89 after sort: 660 element 90 after sort: 880 element 91 after sort: 1144 element 92 after sort: 1456 element 93 after sort: 1820 element 94 after sort: 2240 element 95 after sort: 2720 element 96 after sort: 3264 element 97 after sort: 3876 element 98 after sort: 4560 element 99 after sort: 43867 element 100 after sort: 854513 ────────────────────────────────────────────────────────────────────────────────
Ruby
<lang ruby>class Array def beadsort self.map {|e| [1] * e}.columns.columns.map {|e| e.length} end
def columns y = self.length x = self.map {|l| l.length}.max
Array.new(x) do |row| Array.new(y) { |column| self[column][row] }.compact # Remove nulls. end end end
- Demonstration code:
[5,3,1,7,4,1,1].beadsort</lang>
Output:
=> [7, 5, 4, 3, 1, 1, 1]
Tcl
<lang tcl>package require Tcl 8.5
proc beadsort numList {
# Special case: empty list is empty when sorted.
if {![llength $numList]} return
# Set up the abacus...
foreach n $numList {
for {set i 0} {$i<$n} {incr i} { dict incr vals $i }
}
# Make the beads fall...
foreach n [dict values $vals] {
for {set i 0} {$i<$n} {incr i} { dict incr result $i }
} # And the result is... dict values $result
}
- Demonstration code
puts [beadsort {5 3 1 7 4 1 1}]</lang> Output:
7 5 4 3 1 1 1