Sorting algorithms/Bead sort: Difference between revisions

 

;Task:

Sort an array of positive integers using the [[wp:Bead_sort|Bead Sort Algorithm]].

 

 

 

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.

<br><br>

 

=={{header|360 Assembly}}==

For maximum compatibility, this program uses only the basic instruction set (S/360)

and two ASSIST macros (XDECO,XPRNT) to keep it as short as possible.

BEADSORT CSECT

USING BEADSORT,R13 base register

BEADS DC 4096X'00' beads

YREGS

{{out}}

<pre>

sorted: -2010 -12 -1 0 1 3 4 5 7 9 17 2001

</pre>

 

=={{header|AutoHotkey}}==

Pole:=[] , TempObj:=[], Result:=[]

for, i, v in data {

}

return Result

res := val (res?",":"") res

{{out}}

<pre>12,36,54,56,87</pre>

 

=={{header|C}}==

Requires (max * length) bytes for beads; if memory is of concern, bytes can be replaced by bits.

 

#include <stdlib.h>

 

 

return 0;

 

=={{header|C++}}==

//O(2n) time complexity where n is the summation of the whole list to be sorted.

//O(3n) space complexity.

for(unsigned int i=0; i<sorted.size(); i++)

cout << sorted[i] << ' ';

 

=={{header|Clojure}}==

{{trans|Haskell}}

(loop [ret [], remain xs]

(if (empty? remain)

(defn bead-sort [xs]

(->> xs

transpose

transpose

(map #(reduce + %))))

(-> [5 2 4 1 3 3 9] bead-sort println)

 

{{out}}

=={{header|COBOL}}==

{{works with|GnuCOBOL}}

*> This code is dedicated to the public domain

*> This is GNUCOBOL 2.0

end-perform

.

 

{{out}}

=={{header|Common Lisp}}==

{{trans|Clojure}}

(defun transpose (remain &optional (ret '()))

(if (null remain)

 

(bead-sort '(5 2 4 1 3 3 9))

{{out}}

<pre>(9 5 4 3 3 2 1)</pre>

 

=={{header|Delphi}}==

{{trans|C}}

 

{$APPTYPE CONSOLE}

 

readln;

--[[User:Davidizadar|DavidIzadaR]] 18:12, 7 August 2011 (UTC)

 

=={{header|Eiffel}}==

class

BEAD_SORT

 

end

Test:

 

class

end

 

{{out}}

<pre>

=={{header|Elixir}}==

{{trans|Erlang}}

def bead_sort(list) when is_list(list), do: dist(dist(list))

defp dist([], n, acc), do: dist([], n-1, [1 |acc])

defp dist([h|t], n, acc), do: dist(t, n-1, [h+1|acc])

 

Example:

 

=={{header|Erlang}}==

 

-export([sort/1]).

dist(T, 0, [H | Acc]);

dist([], 0, Acc) ->

Example;

 

=={{header|F_Sharp|F#}}==

{{trans|Haskell}}

 

let removeEmptyLists lists = lists |> List.filter (not << List.isEmpty)

 

// Using the forward composition operator ">>" ...

Usage: beadSort [2;4;1;3;3] or beadSort2 [2;4;1;3;3]

 

 

=={{header|Factor}}==

: fill ( seq len -- newseq ) [ dup length ] dip swap - 0 <repetition> append ;

 

[ ] [ v+ ] map-reduce ;

 

 

=={{header|Fortran}}==

very same code would run fine even with large integers.

 

use iso_fortran_env

! for ERROR_UNIT; to make this a F95 code,

end subroutine beadsort

 

 

=={{header|Go}}==

Sorts non-negative integers only. The extension to negative values seemed a distraction from this fun task.

 

import (

a[len(a)-1-row] = x

}

 

=={{header|Groovy}}==

Solution:

final nPoles = list.max()

list.collect {

beadTally.findAll{ it }.size()

}

 

Annotated Solution (same solution really):

final nPoles = list.max()

// each row is a number tally-arrayed across the abacus

def beadTalliesDrop = abacusPolesDrop.transpose()

beadTalliesDrop.collect{ beadTally -> beadTally.findAll{ it }.size() }

 

Test:

 

{{out}}

 

=={{header|Haskell}}==

 

beadSort :: [Int] -> [Int]

Example;

 

=={{header|Icon}} and {{header|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.

 

write("Sorting Demo using ",image(beadsort))

writes(" on list : ")

}

return X

 

Note: This example relies on [[Sorting_algorithms/Bubble_sort#Icon| the supporting procedures 'writex' in Bubble Sort]].

{{eff note|J|\:~}}

 

 

Example use:

 

4 3 3 2 1

bead bead 5 3 1 7 4 1 1

 

Extending to deal with sequences of arbitrary integers:

 

 

Example use:

 

 

=={{header|Java}}==

 

 

public class BeadSort

int[] beadSort(int[] arr)

{

if(arr[i]>max)

max=arr[i];

}

}

{{out}}

<pre>

 

'''Part 2: Gravity'''

def column_sums(ncols):

. as $abacus

([];

. + [reduce $abacus[] as $row

'''Part 3: read the answer in order of largest-to-smallest'''

def count(stream): reduce stream as $i (0; .+1);

 

| .[0] as $n

| reduce range(0;$n) as $i

'''"Bead Sort":'''

 

'''Example:'''

{{out}}

 

=={{header|Julia}}==

Implement <code>beadsort</code> on a <code>BitArray</code> ''abacus''. The function should work for any integer type. It throws a <code>DomainError</code> if the input array contains a non-positive integer.

len = length(a)

abacus = falses(len, hi)

for (i, v) in enumerate(a)

end

for i in 1:hi

if v < len

end

end

end

 

 

{{out}}

 

 

 

</pre>

 

=={{header|Lua}}==

function show (msg, t)

io.write(msg .. ":\t")

-- Main procedure

math.randomseed(os.time())

{{out}}

<pre>Before sort: 9 5 3 9 4 1 3 8 1 2

After sort: 9 9 8 5 4 3 3 2 1 1</pre>

 

sorted = a; m = Max[a]; t=ConstantArray[0, {m,m} ];

If[ Min[a] < 0, Print["can't sort"]];

For[ i = 1, i < Length[a], i++, t[[i,1;;a[[i]]]]=1 ]

For[ i = 1 ,i <= m, i++, s = Total[t[[;;,i]]];

t[[ ;; , i]] = 0; t[[1 ;; s , i]] = 1; ]

For[ i=1,i<=Length[a],i++, sorted[[i]] = Total[t[[i,;;]]]; ]

Print[sorted];

 

=={{header|NetRexx}}==

options replace format comments java crossref symbols nobinary

 

end vv

return '['list.space(1, ',')']'

{{out}}

<pre>

 

=={{header|Nim}}==

var max = low(T)

var sum = 0

var beads = newSeq[int](max * a.len)

 

beads[i * max + j] = 1

 

sum = 0

sum += beads[i * max + j]

beads[i * max + j] = 0

 

beads[i * max + j] = 1

 

var j = 0

while j < max and beads[i * max + j] > 0: inc j

var a = @[5, 3, 1, 7, 4, 1, 1, 20]

beadSort a

{{out}}

<pre>@[1, 1, 1, 3, 4, 5, 7, 20]</pre>

=={{header|OCaml}}==

{{trans|Haskell}}

match List.filter ((<>) []) l with

[] -> []

 

let bead_sort l =

usage

<pre>

=={{header|Octave}}==

{{trans|Fortran}}

sorted = a;

m = max(a);

endfunction

 

 

=={{header|ooRexx}}==

===version 1===

Do i=1 To words(in)

z.i=word(in,i)

End

Say ol

{{out}}

<pre> Input: 10 -12 1 0 999 8 2 2 4 4

{{trans|REXX}}

'''Note:''' The only changes needed were to substitute '''<tt>_</tt>''', '''<tt>!</tt>''' and '''<tt>?</tt>''' characters for the &quot;deprecated&quot; <tt>'''$'''</tt>, <tt>'''#'''</tt> and '''<tt>@</tt>''' characters within variable names; as per <cite>The REXX Language, Second Edition</cite> by M. F. Cowlishaw. (See a description [http://www.rexxla.org/rexxlang/mfc/trl.html here]).

 

/*get some grassHopper numbers. */

say copies('─',80) /*show a separator line. */

return

 

{{out}}

=={{header|OpenEdge/Progress}}==

Sorting algorithms are not the kind of thing you need / want to do in OpenEdge. If you want to sort simply define a temp-table with one field, populate it and get sorted results with FOR EACH temp-table DESCENDING.

i_c AS CHAR

):

"5,3,1,7,4,1,1 -> " beadSort( "5,3,1,7,4,1,1" ) SKIP(1)

beadSort( "88,18,31,44,4,0,8,81,14,78,20,76,84,33,73,75,82,5,62,70,12,7,1" )

{{out}}

<pre>---------------------------

=={{header|PARI/GP}}==

This implementation uses the counting sort to order the beads in a given row.

my(sz=vecmax(v),M=matrix(#v,sz,i,j,v[i]>=j)); \\ Set up beads

for(i=1,sz,M[,i]=countingSort(M[,i],0,1)~); \\ Let them fall

);

left

 

=={{header|Pascal}}==

 

=={{header|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.

 

my @data = @_;

 

 

beadsort 5, 7, 1, 3, 1, 1, 20;

 

=={{header|Phix}}==

{{out}}

<pre>

=={{header|PHP}}==

{{trans|Haskell}}

function columns($arr) {

if (count($arr) == 0)

 

print_r(beadsort(array(5,3,1,7,4,1,1)));

 

{{out}}

The following implements a direct model of the bead sort algorithm.

Each pole is a list of 'T' symbols for the beads.

(let Abacus (cons NIL)

(for N Lst # Thread beads on poles

(make

(while (gt0 (cnt pop (cdr Abacus))) # Drop and count beads

{{out}}

<pre>: (beadSort (5 3 1 7 4 1 1 20))

=={{header|PL/I}}==

===version 1===

/* Handles both negative and positive values. */

 

if offset < 0 then z = a + offset; else z = a;

 

 

===version 2===

{{trans|ooRexx}}

PL/I supports negative array indices!

/* Handles both negative and positive values. */

Beadsort: Proc Options(main);

End;

 

{{out}}

<pre> Input: 10 -12 1 0 999 8 2 2 4 4

 

=={{header|PowerShell}}==

{

if( $indata.length -gt 1 )

}

 

 

=={{header|PureBasic}}==

 

Dim MyData(Random(15)+5)

Next

PrintN(#CRLF$+"And its sum= "+Str(sum))

<pre>

The array is;

 

=={{header|Python}}==

 

def beadsort(l):

 

 

# Demonstration code:

 

{{out}}

<pre>[7, 5, 4, 3, 1, 1, 1]</pre>

 

=={{header|Racket}}==

{{trans|Haskell}}

#lang racket

(require rackunit)

(bead-sort '(5 3 1 7 4 1 1))

'(7 5 4 3 1 1 1))

 

 

 

 

 

 

 

</pre>

 

=={{header|Ruby}}==

{{trans|Haskell}}

def beadsort

map {|e| [1] * e}.columns.columns.map(&:length)

 

# Demonstration code:

 

{{out}}

 

=={{header|Seed7}}==

 

const proc: beadSort (inout array integer: a) is func

for i range 1 to length(a) do

sum +:= ord(j in beads[i]);

end for;

end for;

end for;

end func;

local

var array integer: a is [] (5, 3, 1, 7, 4, 1, 1, 20);

begin

beadSort(a);

end for;

writeln;

 

{{out}}

=={{header|Sidef}}==

{{trans|Perl}}

 

 

}

}

 

}

 

 

{{out}}

=={{header|Standard ML}}==

{{trans|Haskell}}

case List.filter (not o null) l of

[] => []

 

fun bead_sort l =

usage

<pre>

 

=={{header|Tcl}}==

 

proc beadsort numList {

 

# Demonstration code

{{out}}

<pre>7 5 4 3 1 1 1</pre>

 

=={{header|XPL0}}==

 

proc BeadSort(Array, Length); \Sort Array into increasing order

BeadSort(A, 10);

for I:= 0 to 10-1 do [IntOut(0, A(I)); ChOut(0, ^ )];

 

{{out}}

=={{header|zkl}}==

{{trans|D}}

m

.apply("len") // (0,0,0)-->3

fcn beadSort(data){

data.apply("pump",List,0):columns(_):columns(_).apply("len");

{{out}}

<pre>