Sorting algorithms/Bead sort: Difference between revisions

{{task|Sorting Algorithms}}

{{Sorting 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)

;; This algorithm does not work if collection has zero

(-> [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|D}}==

A functional-style solution.

 

alias repeat0 = curry!(repeat, 0);

void main() {

[5, 3, 1, 7, 4, 1, 1].beadSort.writeln;

{{out}}

<pre>[7, 5, 4, 3, 1, 1, 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

}

}

{{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}}==

{{works with|Julia|0.6}}

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.

lo, hi = extrema(a)

if lo < 1 throw(DomainError()) end

println("# unsorted bytes: $v\n -> sorted bytes: $(beadsort(v))")

v = rand(1:2 ^ 10, 20)

 

{{out}}

=={{header|Kotlin}}==

{{trans|C}}

 

fun beadSort(a: IntArray) {

beadSort(a)

println("After sorting : ${a.contentToString()}")

 

{{out}}

 

=={{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}}==

#!/bin/python3

from itertools import zip_longest

 

def beadsort(l):

return list(map(sum, zip_longest(*[[1] * e for e in l], fillvalue=0)))

# Demonstration code:

print(beadsort([5,3,1,7,4,1,1]))

 

{{out}}

 

=={{header|QB64}}==

#lang QB64

'***************************************************

END IF

END SUB

 

=={{header|Racket}}==

{{trans|Haskell}}

#lang racket

(require rackunit)

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

'(7 5 4 3 1 1 1))

 

=={{header|Raku}}==

{{Works with|rakudo|2016-05}}

{{trans|Haskell}}

sub transpose(@list is copy) {

gather {

 

my @list = 2,1,3,5;

 

{{out}}

<pre>(5, 3, 2, 1)</pre>

Here we simulate the dropping beads by using the <tt>push</tt> method.

my @rods;

for words ^«@list -> $x { @rods[$x].push(1) }

}

 

The <tt>^</tt> is the "upto" operator that gives a range of 0 up to (but not including) its endpoint. We use it as a hyperoperator (<tt>^«</tt>) to generate all the ranges of rod numbers we should drop a bead on, with the result that <tt>$x</tt> tells us which rod to drop each bead on. Then we use <tt>^</tt> again on the first rod to see how deep the beads are stacked, since they are guaranteed to be the deepest there. The <tt>[+]</tt> adds up all the beads that are found at level <tt>$y</tt>. The <tt>last</tt> short circuits the map so we don't have to look for all the missing beads at a given level, since the missing beads are all guaranteed to come after the existing beads at that level (because we always dropped left to right starting at rod 0).

 

 

Zero, negative, and duplicate integers (values) can be handled.

{{out|output|text=&nbsp; when using the default input:}}

(Shown at three-quarter size.)

<pre style="font-size:75%;height:90ex">

=={{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}}

 

var rows = []

}

 

 

{{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|VBA}}==

 

Private Function sq_add(arr As Variant, x As Double) As Variant

Public Sub main()

Debug.Print Join(beadsort([{5, 3, 1, 7, 4, 1, 1, 20}]), ", ")

<pre>20, 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>