Sorting algorithms/Counting sort
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
This page uses content from Wikipedia. The original article was at Counting sort. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance) |
Implement the Counting sort. This is a way of sorting integers when the minimum and maximum value are known.
Pseudocode:
function countingSort(array, min, max): count: array of (max - min + 1) elements initialize count with 0 for each number in array do count[number - min] := count[number - min] + 1 done z := 0 for i from min to max do while ( count[i - min] > 0 ) do array[z] := i z := z+1 count[i - min] := count[i - min] - 1 done done
The min and max can be computed apart, or be known a priori.
Note: we know that, given an array of integers, its maximum and minimum values can be always found; but if we imagine the worst case for an array of 32 bit integers, we see that in order to hold the counts, we need an array of 232 elements, i.e., we need, to hold a count value up to 232-1, more or less 4 Gbytes. So the counting sort is more practical when the range is (very) limited and minimum and maximum values are known a priori. (Anyway sparse arrays may limit the impact of the memory usage)
ActionScript
<lang ActionScript>function countingSort(array:Array, min:int, max:int) { var count:Array = new Array(array.length); for(var i:int = 0; i < count.length;i++)count[i]=0; for(i = 0; i < array.length; i++) { count[array[i]-min] ++; } var j:uint = 0; for(i = min; i <= max; i++) { for(; count[i-min] > 0; count[i-min]--) array[j++] = i; } return array; }</lang>
Ada
Given that we know the range of data, the problem really reduces to initializing the array to the ordered range of values. The input order is irrelevant. <lang Ada>with Ada.Text_Io; use Ada.Text_Io;
procedure Counting_Sort is
type Data is array (Integer range <>) of Natural; procedure Sort(Item : out Data) is begin for I in Item'range loop Item(I) := I; end loop; end Sort; Stuff : Data(1..140);
begin
Sort(Stuff); for I in Stuff'range loop Put(Natural'Image(Stuff(I))); end loop; New_Line;
end Counting_Sort;</lang>
Output
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
ALGOL 68
<lang algol68>PROC counting sort mm = (REF[]INT array, INT min, max)VOID: (
INT z := LWB array - 1; [min:max]INT count;
FOR i FROM LWB count TO UPB count DO count[i] := 0 OD; FOR i TO UPB array DO count[ array[i] ]+:=1 OD;
FOR i FROM LWB count TO UPB count DO FOR j TO count[i] DO array[z+:=1] := i OD OD
);
PROC counting sort = (REF[]INT array)VOID: (
INT min, max; min := max := array[LWB array];
FOR i FROM LWB array + 1 TO UPB array DO IF array[i] < min THEN min := array[i] ELIF array[i] > max THEN max := array[i] FI OD
);
- Testing (we suppose the oldest human being is less than 140 years old). #
INT n = 100; INT min age = 0, max age = 140; main: (
[n]INT ages;
FOR i TO UPB ages DO ages[i] := ENTIER (random * ( max age + 1 ) ) OD; counting sort mm(ages, min age, max age); FOR i TO UPB ages DO print((" ", whole(ages[i],0))) OD; print(new line)
)</lang> Sample output:
0 1 2 3 3 4 4 5 6 7 8 9 9 10 11 12 15 18 18 19 21 21 22 27 33 35 36 38 38 38 38 39 40 40 41 43 44 53 54 55 57 57 58 59 59 60 60 60 60 61 62 64 65 66 67 68 70 71 78 79 82 83 84 84 87 87 88 88 88 89 89 92 93 93 97 98 99 99 100 107 109 114 115 115 118 122 126 127 127 129 129 130 131 133 134 136 136 137 139 139
AutoHotkey
contributed by Laszlo on the ahk forum <lang AutoHotkey>MsgBox % CountingSort("-1,1,1,0,-1",-1,1)
CountingSort(ints,min,max) {
Loop % max-min+1 i := A_Index-1, a%i% := 0 Loop Parse, ints, `, %A_Space%%A_Tab% i := A_LoopField-min, a%i%++ Loop % max-min+1 { i := A_Index-1, v := i+min Loop % a%i% t .= "," v } Return SubStr(t,2)
}</lang>
C
<lang c>#include <stdio.h>
- include <stdlib.h>
void counting_sort_mm(int *array, int n, int min, int max) {
int i, j, z;
int range = max - min + 1; int *count = malloc(range * sizeof(*array));
for(i = 0; i < range; i++) count[i] = 0; for(i = 0; i < n; i++) count[ array[i] - min ]++;
for(i = min, z = 0; i <= max; i++) { for(j = 0; j < count[i - min]; j++) { array[z++] = i; } }
free(count);
}
void counting_sort(int *array, int n) {
int i, min, max; min = max = array[0]; for(i=1; i < n; i++) { if ( array[i] < min ) { min = array[i]; } else if ( array[i] > max ) { max = array[i]; } }
}</lang>
Testing (we suppose the oldest human being is less than 140 years old).
<lang c>#define N 100
- define MAX_AGE 140
int main() {
int ages[N], i;
for(i=0; i < N; i++) ages[i] = rand()%MAX_AGE; counting_sort_mm(ages, N, 0, MAX_AGE); for(i=0; i < N; i++) printf("%d\n", ages[i]); return EXIT_SUCCESS;
}</lang>
C#
<lang csharp>using System; using System.Linq;
namespace CountingSort {
class Program { static void Main(string[] args) { Random rand = new Random(); // Just for creating a test array int[] arr = new int[100]; // of random numbers for (int i = 0; i < 100; i++) { arr[i] = rand.Next(0, 100); } // ...
int[] newarr = countingSort(arr, arr.Min(), arr.Max()); }
private static int[] countingSort(int[] arr, int min, int max) { int[] count = new int[max - min + 1]; int z = 0;
for (int i = 0; i < count.Length; i++) { count[i] = 0; } for (int i = 0; i < arr.Length; i++) { count[arr[i] - min]++; }
for (int i = min; i <= max; i++) { while (count[i - min]-- > 0) { arr[z] = i; z++; } } return arr; } }
}</lang>
Common Lisp
Straightforward implementation of counting sort. By using map
and map-into
, counting sort can work efficiently on both lists and vectors. The closure given as the second argument to map-into
returns the sorted elements of sequence. Because map-into
will only call the function as many times as necessary to re-populate sequence, there is no need for bounds checking. counts
is declared to have dynamic-extent and so a compiler might stack allocate it.
<lang lisp>(defun counting-sort (sequence &optional (min (reduce #'min sequence))
(max (reduce #'max sequence))) (let ((i 0) (counts (make-array (1+ (- max min)) :initial-element 0 :element-type `(integer 0 ,(length sequence))))) (declare (dynamic-extent counts)) (map nil (lambda (n) (incf (aref counts (- n min)))) sequence) (map-into sequence (lambda () (do () ((plusp (aref counts i))) (incf i)) (decf (aref counts i)) (+ i min)))))</lang>
D
<lang d>import std.stdio, std.algorithm;
void countingSort(int[] array, in size_t min, in size_t max) {
auto count = new int[max - min + 1]; foreach (number; array) count[number - min]++;
size_t z = 0; foreach (i; min .. max + 1) while (count[i - min] > 0) { array[z] = i; z++; count[i - min]--; }
}
void main() {
auto data = [9, 7, 10, 2, 9, 7, 4, 3, 10, 2, 7, 10, 2, 1, 3, 8, 7, 3, 9, 5, 8, 5, 1, 6, 3, 7, 5, 4, 6, 9, 9, 6, 6, 10, 2, 4, 5, 2, 8, 2, 2, 5, 2, 9, 3, 3, 5, 7, 8, 4];
int dataMin = reduce!min(data); int dataMax = reduce!max(data); countingSort(data, dataMin, dataMax); assert(isSorted(data));
}</lang>
E
Straightforward implementation, no particularly interesting characteristics.
<lang e>def countingSort(array, min, max) {
def counts := ([0] * (max - min + 1)).diverge() for elem in array { counts[elem - min] += 1 } var i := -1 for offset => count in counts { def elem := min + offset for _ in 1..count { array[i += 1] := elem } }
}</lang>
? def arr := [34,6,8,7,4,3,56,7,8,4,3,5,7,8,6,4,4,67,9,0,0,76,467,453,34,435,37,4,34,234,435,3,2,7,4,634,534,735,5,4,6,78,4].diverge() # value: [34, 6, 8, 7, 4, 3, 56, 7, 8, 4, 3, 5, 7, 8, 6, 4, 4, 67, 9, 0, 0, 76, 467, 453, 34, 435, 37, 4, 34, 234, 435, 3, 2, 7, 4, 634, 534, 735, 5, 4, 6, 78, 4].diverge() ? countingSort(arr, 0, 735) ? arr # value: [0, 0, 2, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 9, 34, 34, 34, 37, 56, 67, 76, 78, 234, 435, 435, 453, 467, 534, 634, 735].diverge()
Fortran
<lang fortran>module CountingSort
implicit none
interface counting_sort module procedure counting_sort_mm, counting_sort_a end interface
contains
subroutine counting_sort_a(array) integer, dimension(:), intent(inout) :: array
call counting_sort_mm(array, minval(array), maxval(array))
end subroutine counting_sort_a
subroutine counting_sort_mm(array, tmin, tmax) integer, dimension(:), intent(inout) :: array integer, intent(in) :: tmin, tmax
integer, dimension(tmin:tmax) :: cnt integer :: i, z
forall(i=tmin:tmax) cnt(i) = count(array == i) end forall
z = 1 do i = tmin, tmax do while ( cnt(i) > 0 ) array(z) = i z = z + 1 cnt(i) = cnt(i) - 1 end do end do
end subroutine counting_sort_mm
end module CountingSort</lang>
Testing:
<lang fortran>program test
use CountingSort implicit none
integer, parameter :: n = 100, max_age = 140
real, dimension(n) :: t integer, dimension(n) :: ages
call random_number(t) ages = floor(t * max_age)
call counting_sort(ages, 0, max_age)
write(*,'(I4)') ages
end program test</lang>
Go
<lang go>package main
import (
"fmt" "runtime" "strings"
)
var a = []int{170, 45, 75, -90, -802, 24, 2, 66} var aMin, aMax = -1000, 1000
func main() {
defer func() { if x := recover(); x != nil { // one error we'll handle and print a little nicer message if r, ok := x.(runtime.Error); ok && strings.HasSuffix(r.String(), "index out of range") { fmt.Printf("data value out of range (%d..%d)\n", aMin, aMax) return } // anything else, we re-panic panic(x) } }()
fmt.Println("before:", a) countingSort() fmt.Println("after: ", a)
}
func countingSort() {
count := make([]int, aMax-aMin+1) for _, x := range a { count[x-aMin]++ } z := 0 for i, c := range count { for ; c > 0; c-- { a[z] = i + aMin z++ } }
}</lang>
Groovy
Solution: <lang groovy>def countingSort = { array ->
def max = array.max() def min = array.min() // this list size allows use of Groovy's natural negative indexing def count = [0] * (max + 1 + [0, -min].max()) array.each { count[it] ++ } (min..max).findAll{ count[it] }.collect{ [it]*count[it] }.flatten()
}</lang>
Test: <lang groovy>println countingSort([23,76,99,58,97,57,35,89,51,38,95,92,24,46,31,24,14,12,57,78,4]) println countingSort([88,18,31,44,4,0,8,81,14,78,20,76,84,33,73,75,82,5,62,70,12,7,1])
println countingSort([15,-3,0,-1,5,4,5,20,-8]) println countingSort([34,6,8,7,4,3,56,7,8,4,3,5,7,8,6,4,4,67,9,0,0,76,467,453,34,435,37,4,34,234,435,3,2,7,4,634,534,-735,5,4,6,78,4]) // slo-o-o-o-ow due to unnecessarily large counting array println countingSort([10000033,10000006,10000008,10000009,10000013,10000031,10000013,10000032,10000023,10000023,10000011,10000012,10000021])</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] [-8, -3, -1, 0, 4, 5, 5, 15, 20] [-735, 0, 0, 2, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 9, 34, 34, 34, 37, 56, 67, 76, 78, 234, 435, 435, 453, 467, 534, 634] [10000006, 10000008, 10000009, 10000011, 10000012, 10000013, 10000013, 10000021, 10000023, 10000023, 10000031, 10000032, 10000033]
Haskell
We use lists for input and output rather than arrays, since lists are used more often in Haskell.
<lang haskell>import Control.Monad.ST import Data.Array.ST
countingSort :: (Enum n, Ix n) => [n] -> n -> n -> [n] countingSort l lo hi = concatMap (uncurry $ flip replicate) count
where count = runST $ do a <- myNewArray (lo, hi) 0 let increment i = readArray a i >>= writeArray a i . (+1) mapM_ increment l getAssocs a myNewArray :: (Ix n) => (n,n) -> Int -> ST s (STArray s n Int) myNewArray = newArray</lang>
Io
<lang io>List do(
countingSort := method(min, max, count := list() setSize(max - min + 1) mapInPlace(0) foreach(x, count atPut(x - min, count at(x - min) + 1) )
j := 0 for(i, min, max, while(count at(i - min) > 0, atPut(j, i) count atPut(i - min, at(i - min) - 1) j = j + 1 ) ) self)
countingSortInPlace := method( countingSort(min, max) )
)
l := list(2, 3, -4, 5, 1) l countingSortInPlace println # ==> list(-4, 1, 2, 3, 5)</lang>
A more functional-like version: <lang io>List do(
fill := method(x, size, /* Resizes list to a given size and fills it with a given value. */ setSize(size) mapInPlace(x) )
countingSort := method(min, max, count := list() fill(0, max - min + 1) foreach(x, count atPut(x - min, count at(x - min) + 1) )
return count map(i, x, list() fill(i + min, x)) \ prepend(list()) reduce(xs, x, xs appendSeq(x)) )
countingSortInPlace := method( copy(countingSort(min, max)) )
)
l := list(2, 3, -4, 5, 1) l countingSortInPlace println # ==> list(-4, 1, 2, 3, 5)</lang>
Icon and Unicon
The following example is hopefully in the spirit of a counting sort using a hash table as a substituted for a sparse array. Simply translating the pseudo-code would be very un-Iconish (as opposed to Uniconish).
<lang Icon>procedure main() #: demonstrate various ways to sort a list and string
write("Sorting Demo using ",image(countingsort)) writes(" on list : ") writex(UL) displaysort(countingsort,copy(UL))
end
procedure countingsort(X) #: return sorted list (integers only) local T,lower,upper
T := table(0) # hash table as sparse array lower := upper := X[1]
every x := !X do { if not ( integer(x) = x ) then runerr(x,101) # must be integer lower >:= x # minimum upper <:= x # maximum T[x] +:= 1 # record x's and duplicates }
every put(X := [],( 1 to T[i := lower to upper], i) ) # reconstitute with correct order and count return X
end</lang>
Note: This example relies on the supporting procedures 'display sort', and 'writex' from Bubble Sort.
Sample output:
Sorting Demo using procedure countingsort 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>csort =: monad define
min =. <./y cnt =. 0 $~ 1+(>./y)-min for_a. y do. cnt =. cnt >:@{`[`]}~ a-min end. cnt # min+i.#cnt
)</lang> Example: <lang j> ] a =. _3 + 20 ?@$ 10 _2 _2 6 _1 1 6 _1 4 4 1 4 4 5 _3 5 3 0 _1 3 4
csort a
_3 _2 _2 _1 _1 _1 0 1 1 3 3 4 4 4 4 4 5 5 6 6</lang>
Java
<lang java5>public static void countingSort(int[] array, int min, int max){ int[] count= new int[max - min + 1]; for(int number : array){ count[number - min]++; } int z= 0; for(int i= min;i <= max;i++){ while(count[i - min] > 0){ array[z]= i; z++; count[i - min]--; } } }</lang>
JavaScript
<lang javascript>var countSort = function(arr, min, max) {
var i, z = 0, count = []; for (i = min; i <= max; i++) { count[i] = 0; } for (i=0; i < arr.length; i++) { count[arr[i]]++; } for (i = min; i <= max; i++) { while (count[i]-- > 0) { arr[z++] = i; } }
}</lang>
Testing:
<lang javascript>// Line breaks are in HTML
var i, ages = [];
for (i = 0; i < 100; i++) {
ages.push(Math.floor(Math.random() * (141)));
}
countSort(ages, 0, 140);
for (i = 0; i < 100; i++) {
document.write(ages[i] + "
");
}</lang>
Lua
<lang lua>function CountingSort( f )
local min, max = math.min( unpack(f) ), math.max( unpack(f) ) local count = {} for i = min, max do count[i] = 0 end for i = 1, #f do count[ f[i] ] = count[ f[i] ] + 1 end local z = 1 for i = min, max do while count[i] > 0 do f[z] = i z = z + 1 count[i] = count[i] - 1 end end
end
f = { 15, -3, 0, -1, 5, 4, 5, 20, -8 }
CountingSort( f )
for i in next, f do
print( f[i] )
end</lang>
M4
<lang M4>divert(-1)
define(`randSeed',141592653) define(`setRand',
`define(`randSeed',ifelse(eval($1<10000),1,`eval(20000-$1)',`$1'))')
define(`rand_t',`eval(randSeed^(randSeed>>13))') define(`random',
`define(`randSeed',eval((rand_t^(rand_t<<18))&0x7fffffff))randSeed')
define(`set',`define(`$1[$2]',`$3')') define(`get',`defn(`$1[$2]')') define(`new',`set($1,size,0)') define(`append',
`set($1,size,incr(get($1,size)))`'set($1,get($1,size),$2)')
define(`deck',
`new($1)for(`x',1,$2, `append(`$1',eval(random%$3))')')
define(`for',
`ifelse($#,0,``$0, `ifelse(eval($2<=$3),1, `pushdef(`$1',$2)$4`'popdef(`$1')$0(`$1',incr($2),$3,`$4')')')')
define(`show',
`for(`x',1,get($1,size),`get($1,x) ')')
define(`countingsort',
`for(`x',$2,$3,`set(count,x,0)')`'for(`x',1,get($1,size), `set(count,get($1,x),incr(get(count,get($1,x))))')`'define(`z', 1)`'for(`x',$2,$3, `for(`y',1,get(count,x), `set($1,z,x)`'define(`z',incr(z))')')')
divert deck(`a',10,100) show(`a') countingsort(`a',0,99) show(`a')</lang>
MATLAB
This is a direct translation of the pseudo-code, except to compensate for MATLAB using 1 based arrays.
<lang MATLAB>function list = countingSort(list)
minElem = min(list); maxElem = max(list); count = zeros((maxElem-minElem+1),1); for number = list count(number - minElem + 1) = count(number - minElem + 1) + 1; end z = 1; for i = (minElem:maxElem) while( count(i-minElem +1) > 0) list(z) = i; z = z+1; count(i - minElem + 1) = count(i - minElem + 1) - 1; end end
end %countingSort</lang>
Sample Usage: <lang MATLAB>>> countingSort([4 3 1 5 6 2])
ans =
1 2 3 4 5 6</lang>
Modula-3
<lang modula3>MODULE Counting EXPORTS Main;
IMPORT IO, Fmt;
VAR test := ARRAY [1..8] OF INTEGER {80, 10, 40, 60, 50, 30, 20, 70};
PROCEDURE Sort(VAR a: ARRAY OF INTEGER; min, max: INTEGER) =
VAR range := max - min + 1; count := NEW(REF ARRAY OF INTEGER, range); z := 0; BEGIN FOR i := FIRST(count^) TO LAST(count^) DO count[i] := 0; END;
FOR i := FIRST(a) TO LAST(a) DO INC(count[a[i] - min]); END;
FOR i := min TO max DO WHILE (count[i - min] > 0) DO a[z] := i; INC(z); DEC(count[i - min]); END; END; END Sort;
BEGIN
IO.Put("Unsorted: "); FOR i := FIRST(test) TO LAST(test) DO IO.Put(Fmt.Int(test[i]) & " "); END; IO.Put("\n"); Sort(test, 10, 80); IO.Put("Sorted: "); FOR i := FIRST(test) TO LAST(test) DO IO.Put(Fmt.Int(test[i]) & " "); END; IO.Put("\n");
END Counting.</lang> Output:
Unsorted: 80 10 40 60 50 30 20 70 Sorted: 10 20 30 40 50 60 70 80
Objeck
<lang objeck> bundle Default {
class Cocktail { function : Main(args : String[]) ~ Nil { values := [9, 7, 10, 2, 9, 7, 4, 3, 10, 2, 7, 10]; CountingSort(values, 2, 10); each(i : values) { values[i]->PrintLine(); }; } function : CountingSort(array : Int[], min : Int, max : Int) ~ Nil { count := Int->New[max - min + 1]; each(i : array) { number := array[i]; v := count[number - min]; count[number - min] := v + 1; }; z := 0; for(i := min; i <= max; i += 1;) { while(count[i - min] > 0) { array[z] := i; z += 1; v := count[i - min] count[i - min] := v - 1; }; }; } }
} </lang>
OCaml
For arrays: <lang ocaml>let counting_sort_array arr lo hi =
let count = Array.make (hi-lo+1) 0 in Array.iter (fun i -> count.(i-lo) <- count.(i-lo) + 1) arr; Array.concat (Array.to_list (Array.mapi (fun i x -> Array.make x (lo+i)) count))</lang>
Octave
This implements the same algorithm but in a more compact way (using the same loop to count and to update the sorted vector). This implementation is elegant (and possible since the sort is not done "in place"), but not so efficient on machines that can't parallelize some operations (the vector arr is scanned for every value between minval and maxval) <lang octave>function r = counting_sort(arr, minval, maxval)
r = arr; z = 1; for i = minval:maxval cnt = sum(arr == i); while( cnt-- > 0 ) r(z++) = i; endwhile endfor
endfunction</lang>
Testing:
<lang octave>ages = unidrnd(140, 100, 1); sorted = counting_sort(ages, 0, 140); disp(sorted);</lang>
Oz
Using arrays as in the original algorithm. The implementation is slightly simpler because arrays can start with an arbitrary index in Oz. <lang oz>declare
proc {CountingSort Arr Min Max} Count = {Array.new Min Max 0} Z = {NewCell {Array.low Arr}} in %% fill frequency array for J in {Array.low Arr}..{Array.high Arr} do Number = Arr.J in Count.Number := Count.Number + 1 end %% recreate array from frequencies for I in Min..Max do for C in 1..Count.I do Arr.(@Z) := I Z := @Z + 1 end end end
A = {Tuple.toArray unit(3 1 4 1 5 9 2 6 5)}
in
{CountingSort A 1 9} {Show {Array.toRecord unit A}}</lang>
Using lists for input and output and a dictionary as a sparse array: <lang oz>declare
fun {CountingSort Xs} Count = {Dictionary.new} in for X in Xs do Count.X := {CondSelect Count X 0} + 1 end {Concat {Map {Dictionary.entries Count} Repeat}} end
fun {Repeat Val#Count} if Count == 0 then nil else Val|{Repeat Val#Count-1} end end
fun {Concat Xs} {FoldR Xs Append nil} end
in
{Show {CountingSort [3 1 4 1 5 9 2 6 5]}}</lang>
PARI/GP
<lang parigp>countingSort(v,mn,mx)={
my(u=vector(#v),i=0); for(n=mn,mx, for(j=1,#v,if(v[j]==n,u[i++]=n)) ); u
};</lang>
Pascal
<lang pascal>program CountingSort;
procedure counting_sort(var arr : Array of Integer; n, min, max : Integer); var
count : Array of Integer; i, j, z : Integer;
begin
SetLength(count, max-min); for i := 0 to (max-min) do count[i] := 0; for i := 0 to (n-1) do count[ arr[i] - min ] := count[ arr[i] - min ] + 1; z := 0; for i := min to max do for j := 0 to (count[i - min] - 1) do begin
arr[z] := i; z := z + 1
end
end;
var
ages : Array[0..99] of Integer; i : Integer;
begin
{ testing } for i := 0 to 99 do ages[i] := 139 - i; counting_sort(ages, 100, 0, 140); for i := 0 to 99 do writeln(ages[i]);
end.</lang>
Perl
<lang perl>#! /usr/bin/perl use strict;
sub counting_sort {
my ($a, $min, $max) = @_; my @cnt = (0) x ($max - $min + 1); $cnt[$_ - $min]++ foreach @$a; my $i = $min; @$a = map {($i++) x $_} @cnt;
}</lang>
Testing:
<lang perl>my @ages = map {int(rand(140))} 1 .. 100;
counting_sort(\@ages, 0, 140); print join("\n", @ages), "\n";</lang>
Perl 6
<lang perl6>sub counting_sort ( @a ) {
my ( $min, $max ) = .min, .max given @a.minmax;
my @counts; @counts[ $_ - $min ]++ for @a;
return @counts.kv.map: { $^k + $min xx $^v if $^v };
}
my @all_ages = 2 .. 102; my @ages = (^50).map: { @all_ages.pick }; say @ages.sort.Str eq @ages.&counting_sort.Str ?? 'ok' !! 'not ok'; </lang>
PHP
<lang php><?php
function counting_sort($arr, $min, $max) {
$count = array(); for($i = $min; $i <= $max; $i++) { $count[$i] = 0; }
foreach($arr as $number) { $count[$number]++; } $z = 0; for($i = $min; $i <= $max; $i++) { while( $count[$i]-- > 0 ) { $arr[$z++] = $i; } }
}</lang>
Testing:
<lang php>$ages = array(); for($i=0; $i < 100; $i++) {
array_push($ages, rand(0, 140));
} counting_sort(&$ages, 0, 140);
for($i=0; $i < 100; $i++) {
echo $ages[$i] . "\n";
} ?></lang>
PicoLisp
<lang PicoLisp>(de countingSort (Lst Min Max)
(let Count (need (- Max Min -1) 0) (for N Lst (inc (nth Count (- N Min -1))) ) (make (map '((C I) (do (car C) (link (car I))) ) Count (range Min Max) ) ) ) )</lang>
Output:
: (countingSort (5 3 1 7 4 1 1 20) 1 20) -> (1 1 1 3 4 5 7 20)
PL/I
<lang PL/I>count_sort: procedure (A);
declare A(*) fixed; declare (min, max) fixed; declare i fixed binary;
max, min = A(lbound(A,1)); do i = 1 to hbound(A,1); if max < A(i) then max = A(i); if min > A(i) then min = A(i); end;
begin; declare t(min:max) fixed; declare (i, j, k) fixed binary (31); t = 0; do i = 1 to hbound(A,1); j = A(i); t(j) = t(j) + 1; end; k = lbound(A,1); do i = min to max; if t(i) ^= 0 then do j = 1 to t(i); A(k) = i; k = k + 1; end; end; end;
end count_sort;</lang>
PureBasic
<lang PureBasic>Procedure Counting_sort(Array data_array(1), min, max)
Define i, j Dim c(max - min)
For i = 0 To ArraySize(data_array()) c(data_array(i) - min) + 1 Next
For i = 0 To ArraySize(c()) While c(i) data_array(j) = i + min j + 1 c(i) - 1 Wend Next
EndProcedure</lang>
Python
Follows the spirit of the counting sort but uses Pythons defaultdict(int) to initialize array accesses to zero, and list concatenation: <lang python>>>> from collections import defaultdict >>> def countingSort(array, mn, mx): count = defaultdict(int) for i in array: count[i] += 1 result = [] for j in range(mn,mx+1): result += [j]* count[j] return result
>>> data = [9, 7, 10, 2, 9, 7, 4, 3, 10, 2, 7, 10, 2, 1, 3, 8, 7, 3, 9, 5, 8, 5, 1, 6, 3, 7, 5, 4, 6, 9, 9, 6, 6, 10, 2, 4, 5, 2, 8, 2, 2, 5, 2, 9, 3, 3, 5, 7, 8, 4] >>> mini,maxi = 1,10 >>> countingSort(data, mini, maxi) == sorted(data) True</lang>
Using a list:
<lang python>def countingSort(a, min, max):
cnt = [0] * (max - min + 1) for x in a: cnt[x - min] += 1 return [x for x, n in enumerate(cnt, start=min) for i in xrange(n)]</lang>
R
<lang R>counting_sort <- function(arr, minval, maxval) {
r <- arr z <- 1 for(i in minval:maxval) { cnt = sum(arr == i) while(cnt > 0) { r[z] = i z <- z + 1 cnt <- cnt - 1 } } r
}
- 140+1 instead of 140, since random numbers generated
- by runif are always less than the given maximum;
- floor(a number at most 140.9999...) is 140
ages <- floor(runif(100, 0, 140+1)) sorted <- counting_sort(ages, 0, 140) print(sorted)</lang>
REXX
<lang rexx> /*REXX program sorts an array using the count-sort method. */
call gen@ /*generate array elements. */ call show@ 'before sort' /*show before array elements*/ call countSort highItem /*invoke the count sort. */ call show@ ' after sort' /*show after array elements*/ exit
/*─────────────────────────────────────countSORT subroutine────────*/
countSort: procedure expose @.; parse arg n
h=@.1
L=h
do m=2 to n L=min(L,@.m) h=max(h,@.m) end
_.=0
do j=1 for n k=@.j _.k=_.k+1 end
- =1
do j=L to h if _.j\==0 then do #=# for _.j @.#=j end end
return
/*─────────────────────────────────────GEN@ subroutine─────────────*/
gen@: @.= /*assign default value. */
/* get the first 40 Recaman numbers: subtract if you can, */ /* otherwise add. Another way: Recaman(1) = 1, */ /* Recaman(n) = Recaman(n-1)-n if positive and new, else */ /* Recaman(n) = Recaman(n-1)+n */
@.1 = 1 @.2 = 3 @.3 = 6 @.4 = 2 @.5 = 7 @.6 = 13 @.7 = 20 @.8 = 12 @.9 = 21 @.10= 11 @.11= 22 @.12= 10 @.13= 23 @.14= 9 @.15= 24 @.16= 8 @.17= 25 @.18= 43 @.19= 62 @.20= 42 @.21= 63 @.22= 41 @.23= 18 @.24= 42 @.25= 17 @.26= 43 @.27= 16 @.28= 44 @.29= 15 @.30= 45 @.31= 14 @.32= 46 @.33= 79 @.34= 113 @.35= 78 @.36= 114 @.37= 77 @.38= 39 @.39= 78 @.40= 38
do highItem=1 while @.highItem\== /*find how many entries. */ end
highItem=highItem-1 /*adjust highItem slightly. */ return
/*─────────────────────────────────────SHOW@ subroutine────────────*/
show@: widthH=length(highItem) /*maximum width of any line.*/
do j=1 for highItem say 'element' right(j,widthH) arg(1)":" @.j end
say copies('─',80) /*show a seperator line. */ return </lang> Output:
element 1 before sort: 1 element 2 before sort: 3 element 3 before sort: 6 element 4 before sort: 2 element 5 before sort: 7 element 6 before sort: 13 element 7 before sort: 20 element 8 before sort: 12 element 9 before sort: 21 element 10 before sort: 11 element 11 before sort: 22 element 12 before sort: 10 element 13 before sort: 23 element 14 before sort: 9 element 15 before sort: 24 element 16 before sort: 8 element 17 before sort: 25 element 18 before sort: 43 element 19 before sort: 62 element 20 before sort: 42 element 21 before sort: 63 element 22 before sort: 41 element 23 before sort: 18 element 24 before sort: 42 element 25 before sort: 17 element 26 before sort: 43 element 27 before sort: 16 element 28 before sort: 44 element 29 before sort: 15 element 30 before sort: 45 element 31 before sort: 14 element 32 before sort: 46 element 33 before sort: 79 element 34 before sort: 113 element 35 before sort: 78 element 36 before sort: 114 element 37 before sort: 77 element 38 before sort: 39 element 39 before sort: 78 element 40 before sort: 38 ──────────────────────────────────────────────────────────────────────────────── element 1 after sort: 1 element 2 after sort: 2 element 3 after sort: 3 element 4 after sort: 6 element 5 after sort: 7 element 6 after sort: 8 element 7 after sort: 9 element 8 after sort: 10 element 9 after sort: 11 element 10 after sort: 12 element 11 after sort: 13 element 12 after sort: 14 element 13 after sort: 15 element 14 after sort: 16 element 15 after sort: 17 element 16 after sort: 18 element 17 after sort: 20 element 18 after sort: 21 element 19 after sort: 22 element 20 after sort: 23 element 21 after sort: 24 element 22 after sort: 25 element 23 after sort: 38 element 24 after sort: 39 element 25 after sort: 41 element 26 after sort: 42 element 27 after sort: 42 element 28 after sort: 43 element 29 after sort: 43 element 30 after sort: 44 element 31 after sort: 45 element 32 after sort: 46 element 33 after sort: 62 element 34 after sort: 63 element 35 after sort: 77 element 36 after sort: 78 element 37 after sort: 78 element 38 after sort: 79 element 39 after sort: 113 element 40 after sort: 114 ────────────────────────────────────────────────────────────────────────────────
Ruby
<lang ruby>class Array
def countingsort! do_countingsort!(min, max) end protected def do_countingsort!(min, max) count = Array.new(max - min + 1, 0) each {|number| count[number - min] += 1} z = 0 min.upto(max) do |i| while count[i - min] > 0 self[z] = i z += 1 count[i - min] -= 1 end end self end
end
ary = [9,7,10,2,9,7,4,3,10,2,7,10,2,1,3,8,7,3,9,5,8,5,1,6,3,7,5,4,6,9,9,6,6,10,2,4,5,2,8,2,2,5,2,9,3,3,5,7,8,4] ary.countingsort!.join(",")
- => "1,1,2,2,2,2,2,2,2,2,3,3,3,3,3,3,4,4,4,4,5,5,5,5,5,5,6,6,6,6,7,7,7,7,7,7,8,8,8,8,9,9,9,9,9,9,10,10,10,10"</lang>
Scala
<lang scala>def countSort(input: List[Int], min: Int, max: Int): List[Int] =
input.foldLeft(Array.fill(max - min + 1)(0)) { (arr, n) => arr(n - min) += 1 arr }.zipWithIndex.foldLeft(List[Int]()) { case (lst, (cnt, ndx)) => List.fill(cnt)(ndx + min) ::: lst }.reverse</lang>
Slate
<lang slate>s@(Sequence traits) countingSort &min: min &max: max [| counts index |
min `defaultsTo: (s reduce: #min: `er). max `defaultsTo: (s reduce: #max: `er). counts: ((0 to: max - min) project: [| :_ | 0]). s do: [| :value | counts at: value - min infect: [| :count | count + 1]]. index: 0. min to: max do: [| :value | [(counts at: value - min) isPositive] whileTrue: [s at: index put: value. index: index + 1. counts at: value - min infect: [| :val | val - 1]] ]. s
].</lang>
Smalltalk
<lang smalltalk>OrderedCollection extend [
countingSortWithMin: min andMax: max [
|oc z| oc := OrderedCollection new. 1 to: (max - min + 1) do: [ :n| oc add: 0 ]. self do: [ :v | oc at: (v - min + 1) put: ( (oc at: (v - min + 1)) + 1) ]. z := 1. min to: max do: [ :i | 1 to: (oc at: (i - min + 1)) do: [ :k | self at: z put: i. z := z + 1. ] ]
]
].</lang>
Testing:
<lang smalltalk>|ages|
ages := OrderedCollection new.
1 to: 100 do: [ :n |
ages add: (Random between: 0 and: 140)
].
ages countingSortWithMin: 0 andMax: 140. ages printNl.</lang>
Tcl
<lang tcl>proc countingsort {a {min ""} {max ""}} {
# If either of min or max weren't given, compute them now if {$min eq ""} { set min [::tcl::mathfunc::min $a] } if {$max eq ""} { set max [::tcl::mathfunc::max $a] }
# Make the "array" of counters set count [lrepeat [expr {$max - $min + 1}] 0]
# Count the values in the input list foreach n $a { set idx [expr {$n - $min}] lincr count $idx }
# Build the output list set z 0 for {set i $min} {$i <= $max} {incr i} { set idx [expr {$i - $min}] while {[lindex $count $idx] > 0} { lset a $z $i incr z lincr count $idx -1 } } return $a
}
- Helper that will increment an existing element of a list
proc lincr {listname idx {value 1}} {
upvar 1 $listname list lset list $idx [expr {[lindex $list $idx] + $value}]
}
- Demo code
for {set i 0} {$i < 50} {incr i} {lappend a [expr {1+ int(rand()*10)}]} puts $a puts [countingsort $a]</lang>
9 7 10 2 9 7 4 3 10 2 7 10 2 1 3 8 7 3 9 5 8 5 1 6 3 7 5 4 6 9 9 6 6 10 2 4 5 2 8 2 2 5 2 9 3 3 5 7 8 4 1 1 2 2 2 2 2 2 2 2 3 3 3 3 3 3 4 4 4 4 5 5 5 5 5 5 6 6 6 6 7 7 7 7 7 7 8 8 8 8 9 9 9 9 9 9 10 10 10 10
VBScript
All my other sort demos just pass in the array, thus the findMax and findMin
Implementation
<lang vb>function findMax( a ) dim num dim max max = 0 for each num in a if num > max then max = num next findMax = max end function
function findMin( a ) dim num dim min min = 0 for each num in a if num < min then min = num next findMin = min end function
'the function returns the sorted array, but the fact is that VBScript passes the array by reference anyway function countingSort( a ) dim count() dim min, max min = findMin(a) max = findMax(a) redim count( max - min + 1 ) dim i dim z for i = 0 to ubound( a ) count( a(i) - min ) = count( a( i ) - min ) + 1 next z = 0 for i = min to max while count( i - min) > 0 a(z) = i z = z + 1 count( i - min ) = count( i - min ) - 1 wend next countingSort = a end function</lang>
Invocation
<lang vb>dim a a = array(300, 1, -2, 3, -4, 5, -6, 7, -8, 100, 11 ) wscript.echo join( a, ", " ) countingSort a wscript.echo join( a, ", " )</lang>
Output
300, 1, -2, 3, -4, 5, -6, 7, -8, 100, 11 -8, -6, -4, -2, 1, 3, 5, 7, 11, 100, 300