Counting Sort a linear time sorting algorithm

Scripting Forums Code Exchange
,
#1

Hello.

Sometimes, you only want to sort some integers, lesser than or equal to the number of elements in a list. Then pretty much everything is overkill really, but here is a little clever algorithm I stumbled upon. :slight_smile: It does the sorting in linear time, which is fast.

Edit

It was probably Herman Hollerith that implemented it in 1890’s maybe for the U.S Census. Herman Hollerith also invented the radix sort, where this algorithm might be used.

If you want one that works for k>n, then look at the post below, it is really meant for elements in the range 100, but it should be easy to modify. NB! it will perform worser than n log n, so when there are many elements in the list, or k is disproportionally large, then you are better off using Nigel Garvey’s quicksort.

Not that it matters much here, when sorting single digits, but counting sort is stable. It performs it’s work by counting up occurences of the digits in the original list, using the current digit in L as index of the element of C that shall be incremented. Then we accumulate the occurences in C into Cp, so, that we know the last position to put the element with that index, in the sorted array. then we work from the end, copying elements over to the new array, and decrementing the position in the “accumulation of frequencies array” (Cp), until we are done.

My intended usage is to use it on lists with 2 to 20 elements, and k not being much larger than say 26.

(* Counting Sort:

 Sorts positive integers larger than 0 in linear time O( k + n ) (if K=O(n) ).
 That is if the largest integer in the list, k, is supposed to be less than the number of elements. 
 Otherwise, this algorithm won't work.
 
 
*)
set thel to {4, 1, 3, 4, 3}
countingsort(thel, 4)
on countingsort(|L|, k)
	--	countingsort: origin unknown. found it in an algorithms lecture from MIT
	-- 	Implemented in AppleScript by McUsr 2015/6/24
	script o
		property L : |L|
		property C : missing value
		property Cp : missing value
		property B : missing value
	end script
	set ll to length of o's L
	copy |L| to o's C
	repeat with i from 1 to ll
		set item i of o's C to 0
	end repeat
	
	repeat with i from 1 to ll
		set item (item i of o's L) of o's C to (item (item i of o's L) of o's C) + 1
	end repeat
	copy o's C to o's Cp
	
	repeat with i from 2 to k
		set item i of o's Cp to (item (i - 1) of o's Cp) + (item i of o's C)
	end repeat
	copy o's C to o's B
	
	repeat with j from ll to 1 by -1
		tell item j of o's L
			set item (item it of o's Cp) of o's B to it
			set item it of o's Cp to (item it of o's Cp) - 1
		end tell
	end repeat
	return o's B
end countingsort
#2

Hello.

See post 1 for the general description.

Here is a general version, where you don’t have to keep track of the max int (k), it should now run in something larger than n log n, but it still run pretty fast for small lists at least.

on countingsort(|L|, k)
	--	countingsort: origin unknown. found it in an algorithms lecture from MIT
	-- Sorts positive integers larger than 0 in linear time O( k + n ) (if K<=O(n) )
	-- uses n log n if k >n.
	-- 	Implemented in AppleScript by McUsr 2015/6/24
	-- if you set k to 0, it figures out the max int by itself. still fast.
	script o
		property L : |L|
		property zeroArray : {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
		-- 100 items 
		property C : missing value
		property Cp : missing value
		property B : missing value
	end script
	
	set ll to length of o's L
	
	if k > 0 and k ≤ ll then
		copy |L| to o's C
		repeat with i from 1 to ll
			set item i of o's C to 0
		end repeat
		
	else
		set max to item 1 of o's L
		repeat with i from 1 to ll
			if item i of o's L > max then set max to item i of o's L
		end repeat
		set k to max
		copy items of o's zeroArray to o's C
		if k > 100 then repeat while max > 100
			copy o's zeroArray to tmp
			set o's C to o's C & tmp
			set max to max - 100
		end repeat
	end if
	
	repeat with i from 1 to ll
		set item (item i of o's L) of o's C to (item (item i of o's L) of o's C) + 1
	end repeat
	copy o's C to o's Cp
	
	repeat with i from 2 to k
		set item i of o's Cp to (item (i - 1) of o's Cp) + (item i of o's C)
	end repeat
	copy o's L to o's B
	repeat with j from ll to 1 by -1
		tell item j of o's L
			set item (item it of o's Cp) of o's B to it
			set item it of o's Cp to (item it of o's Cp) - 1
		end tell
	end repeat
	return o's B
end countingsort

(* 
-- Test
set thel to {4, 1, 3, 4, 3, 2, 3, 4, 100}
-- countingsort(thel, 0)
set t0 to (current date)
repeat 10000 times
	--	sortlist thel
	countingsort(thel, 0)
end repeat
return (current date) - t0
*)