Sorting algorithms/Counting sort: Difference between revisions
(added ocaml version for arrays; maybe someone else can add one for lists) |
|||
Line 224: | Line 224: | ||
countingSort :: (Enum n, Ix n) => [n] -> n -> n -> [n] |
countingSort :: (Enum n, Ix n) => [n] -> n -> n -> [n] |
||
countingSort l lo hi = |
countingSort l lo hi = concatMap (uncurry $ flip replicate) count |
||
where count = runST $ do |
where count = runST $ do |
||
a <- myNewArray (lo, hi) 0 |
a <- myNewArray (lo, hi) 0 |
||
let increment i = readArray a i >>= writeArray a i . (+1) |
let increment i = readArray a i >>= writeArray a i . (+1) |
||
mapM_ increment l |
mapM_ increment l |
||
getAssocs a |
|||
myNewArray :: (Ix n) => (n,n) -> Int -> ST s (STArray s n Int) |
myNewArray :: (Ix n) => (n,n) -> Int -> ST s (STArray s n Int) |
||
myNewArray = newArray</lang> |
myNewArray = newArray</lang> |
Revision as of 18:57, 1 June 2009
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 Sorting algorithms/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:
countingSort(array, min, max): count: array of (max - min + 1) elements initialize count with 0s foreach number in array: count[number - min] := count[number - min] + 1 end foreach z := 0 for i from min to max: while ( count[i - min] > 0 ) array[z] := i z := z + 1 count[i - min] := count[i - min] - 1 end while end for end countingSort
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 16 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)
ALGOL 68
<lang algol>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
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>
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>
<lang e>? 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()</lang>
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>
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>
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>
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
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>
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>
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>
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>
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