Friday, November 24, 2017

#1 2015-06-24 09:26:06 am

McUsrII
Member
Registered: 2012-11-21
Posts: 3046
Website

Counting Sort a linear time sorting algorithm

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. 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.

Applescript:

(* 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

Last edited by McUsrII (2015-06-24 01:04:59 pm)


Filed under: countingsort

Offline

 

#2 2015-06-24 12:42:53 pm

McUsrII
Member
Registered: 2012-11-21
Posts: 3046
Website

Re: Counting Sort a linear time sorting algorithm

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.

Applescript:

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
*)

Last edited by McUsrII (2015-06-24 01:05:40 pm)

Offline

 

Board footer

Powered by FluxBB

RSS (new topics) RSS (active topics)