Radix Sort Example in PlayBasic
This is example include two versions of the Radix sorting algorithm for PlayBasic. The code was original written for DB some 6 years ago, and the DB version almost runs (a few small changes are required), this version just takes greater advantage of PlayBasic's built in array functions. Which make the functions about 25% faster than trying to do everything manually.
The demo isn't pretty to look at (screen full of sorted numbers), but if you need a sorting method, it's option to consider.
Other Sorting Examples
QuickSort Typed Array (http://www.underwaredesign.com/forums/index.php?topic=3444.0)
Better Bubble Sorting (http://www.underwaredesign.com/forums/index.php?topic=159.0)
Bubble Sort Typed (Character) Array (http://www.underwaredesign.com/forums/index.php?topic=2244.0)
Radix Sort Examples in PlayBASIC
Here's a couple more Raddix sort variations, these can order the array in four passes. The quickest variation takes about 175 ish milliseconds to sort 100,000 integer values.. The only down side is that it eats up more memory than the one above.
[pbcode]
` *=---------------------------------------------------------------------=*
`
` >> RADIX sort For PlayBASIC (Four pass) V0.02 <<
`
` By Kevin Picone
`
` Date: 19th, June, 2013 (PB Version)
`
` (c) copyright 2003/2012 Kevin Picone, All rights reserved
`
` *=---------------------------------------------------------------------=*
` URLS: www.playbasic.com www.underwaredesign.com
` *=---------------------------------------------------------------------=*
`
` So What does this do ?:
` =======================
`
` This example shows a four pass opt'd RADIX sort routine for PlayBASIC.
`
`
` *=-------------------------------------------------------------------=*
Size=100000
Dim MyArray(Size)
Dim BackupArray(Size)
// This buffer holds the caches in the third version of the function
Dim GlobalRadixBanks(255)
` *=-------------------------------------------------------------------=*
` >> MAIN LOOP <<
` *=-------------------------------------------------------------------=*
do
cls
frames++
For lp =0 to Size
BackupArray(lp)=Rnd($ffffff)
next
CopyArray BackupArray(),MyArray()
t=timer()
Raddix_Sort_4Pass(MyArray(),$ffffff)
tt1#+=timer()-t
print "Raddix #1 Sorted Time:"+Str$(tt1#/frames)
CopyArray BackupArray(),MyArray()
t=timer()
Raddix_Sort_4Pass_Split(MyArray(),$ffffff)
tt2#+=timer()-t
print "Raddix #2 Sorted Time:"+Str$(tt2#/frames)
CopyArray BackupArray(),MyArray()
t=timer()
Raddix_Sort_4Pass_Split_Cached(MyArray(),$ffffff)
tt3#+=timer()-t
print "Raddix #3 Sorted Time:"+Str$(tt3#/frames)
print "Values Being Sorted:"+Str$(Size)
Sync
loop
` *=---------------------------------------------------------------------=*
` *=---------------------------------------------------------------------=*
` *=-------------------->> RAddix Sort 4 pass <<-------------------------=*
` *=---------------------------------------------------------------------=*
` *=---------------------------------------------------------------------=*
Function Raddix_Sort_4Pass(IntegerArray(),SortMask=-1)
Count=GetArrayElements(IntegerArray())
Dim RadixBanks(255)
Dim RadixBanksPtrs(255)
For lp =0 to 255
RadixBanks(lp)=NewBank((Count+16)*4)
next
DestArrayBasePtr=GetArrayPtr(IntegerArray(),true)
; -----------------------------------------
; Byte Based Radix Sort
; -----------------------------------------
For Pass=0 to 3
if lsr32(SortMask,BitShift) and $ff
// ------------------------------------------------------
// Reset cache pointers
// ------------------------------------------------------
For lp =0 to 255
RadixBanksPtrs(lp)=GetBankPtr(RadixBanks(lp))
next
// ------------------------------------------------------
// Copy to the Radix buffers
// ------------------------------------------------------
For lp =0 to Count-1
; get the size of this file
ThisRGB =IntegerArray(lp)
RadixIndex =lsr32(ThisRGB,BitShift) and $ff
Address=RadixBanksPtrs(RAdixIndex)
pokeint address,ThisRGB
RadixBanksPtrs(RAdixIndex)=Address+4
next
// ------------------------------------------------------
// Copy the radix buffer back to the order array
// ------------------------------------------------------
DestPtr=DestArrayBasePtr
For BufferIndex =0 to 255
SrcPtr=GetBankPtr(RadixBanks(BufferIndex))
Tally = RadixBanksPtrs(BufferIndex)-SrcPtr
if tally
CopyMemory SrcPtr,DestPtr,Tally
DestPtr+=Tally
endif
next
endif
BitShift+=8
next
// Clean up the temp caches
For lp =0 to 255
deletebank RadixBanks(lp)
next
EndFunction
` *=---------------------------------------------------------------------=*
` *=---------------------------------------------------------------------=*
` *=-------------------->> RAddix Sort 4 pass <<-------------------------=*
` *=---------------------------------------------------------------------=*
` *=---------------------------------------------------------------------=*
` This version unrolls the four passes, so each export pass is custom to
` the bit range.
Function Raddix_Sort_4Pass_Split(IntegerArray(),SortMask=-1)
Count=GetArrayElements(IntegerArray())
Dim RadixBanks(255)
Dim RadixBanksPtrs(255)
For lp =0 to 255
RadixBanks(lp)=NewBank((Count+16)*4)
next
DestArrayBasePtr=GetArrayPtr(IntegerArray(),true)
; -----------------------------------------
; Byte Based Radix Sort
; -----------------------------------------
For Pass=0 to 3
if lsr32(SortMask,BitShift) and $ff
// ------------------------------------------------------
// Reset cache pointers
// ------------------------------------------------------
For lp =0 to 255
RadixBanksPtrs(lp)=GetBankPtr(RadixBanks(lp))
next
// ------------------------------------------------------
// Copy to the Radix buffers
// ------------------------------------------------------
select Pass
; -------------------------------
case 0
; -------------------------------
For lp =0 to Count-1
; get the size of this file
ThisRGB =IntegerArray(lp)
RadixIndex =ThisRGB and 255
Address=RadixBanksPtrs(RAdixIndex)
pokeint address,ThisRGB
RadixBanksPtrs(RAdixIndex)=Address+4
next
; -------------------------------
case 1
; -------------------------------
For lp =0 to Count-1
; get the size of this file
ThisRGB =IntegerArray(lp)
RadixIndex =(ThisRGB / 256) and 255
Address=RadixBanksPtrs(RAdixIndex)
pokeint address,ThisRGB
RadixBanksPtrs(RAdixIndex)=Address+4
next
; -------------------------------
case 2
; -------------------------------
For lp =0 to Count-1
; get the size of this file
ThisRGB =IntegerArray(lp)
RadixIndex =(ThisRGB / $10000) and 255
Address=RadixBanksPtrs(RAdixIndex)
pokeint address,ThisRGB
RadixBanksPtrs(RAdixIndex)=Address+4
next
; -------------------------------
case 3
; -------------------------------
For lp =0 to Count-1
; get the size of this file
ThisRGB =IntegerArray(lp)
;RadixIndex =rgba(ThisRGB)
RadixIndex =(ThisRGB / $1000000) and 255
Address=RadixBanksPtrs(RAdixIndex)
pokeint address,ThisRGB
RadixBanksPtrs(RAdixIndex)=Address+4
next
endselect
// ------------------------------------------------------
// Copy the radix buffer back to the order array
// ------------------------------------------------------
DestPtr=DestArrayBasePtr
For BufferIndex =0 to 255
SrcPtr=GetBankPtr(RadixBanks(BufferIndex))
Tally = RadixBanksPtrs(BufferIndex)-SrcPtr
if tally
CopyMemory SrcPtr,DestPtr,Tally
DestPtr+=Tally
endif
next
endif
BitShift+=8
next
// Clean up the temp caches
For lp =0 to 255
deletebank RadixBanks(lp)
next
EndFunction
` *=---------------------------------------------------------------------=*
` *=---------------------------------------------------------------------=*
` *=-------------------->> RAddix Sort 4 pass <<-------------------------=*
` *=---------------------------------------------------------------------=*
` *=---------------------------------------------------------------------=*
`
` This version extends the previous version, but this one uses a set of
` globally allocated banks for the caches. Avoidning the alloc/dealloc
` overhead.
Function Raddix_Sort_4Pass_Split_Cached(IntegerArray(),SortMask=-1,CleanUp=false)
Count=GetArrayElements(IntegerArray())
; Dim RadixBanks(255)
Dim RadixBanksPtrs(255)
RequiredSize=(Count+16)*4
For lp =0 to 255
ThisBank=GlobalRadixBanks(lp)
if ThisBank=0
GlobalRadixBanks(lp)=NewBank(RequiredSize)
else
if GetBankSize(ThisBank)<RequiredSize
ResizeBank ThisBank,RequiredSize
endif
endif
next
DestArrayBasePtr=GetArrayPtr(IntegerArray(),true)
; -----------------------------------------
; Byte Based Radix Sort
; -----------------------------------------
For Pass=0 to 3
if lsr32(SortMask,BitShift) and $ff
// ------------------------------------------------------
// Reset cache pointers
// ------------------------------------------------------
For lp =0 to 255
RadixBanksPtrs(lp)=GetBankPtr(GlobalRadixBanks(lp))
next
// ------------------------------------------------------
// Copy to the Radix buffers
// ------------------------------------------------------
select Pass
; -------------------------------
case 0
; -------------------------------
For lp =0 to Count-1
; get the size of this file
ThisRGB =IntegerArray(lp)
RadixIndex =ThisRGB and 255
Address=RadixBanksPtrs(RAdixIndex)
pokeint address,ThisRGB
RadixBanksPtrs(RAdixIndex)=Address+4
next
; -------------------------------
case 1
; -------------------------------
For lp =0 to Count-1
; get the size of this file
ThisRGB =IntegerArray(lp)
RadixIndex =(ThisRGB / 256) and 255
Address=RadixBanksPtrs(RAdixIndex)
pokeint address,ThisRGB
RadixBanksPtrs(RAdixIndex)=Address+4
next
; -------------------------------
case 2
; -------------------------------
For lp =0 to Count-1
; get the size of this file
ThisRGB =IntegerArray(lp)
RadixIndex =(ThisRGB / $10000) and 255
Address=RadixBanksPtrs(RAdixIndex)
pokeint address,ThisRGB
RadixBanksPtrs(RAdixIndex)=Address+4
next
; -------------------------------
case 3
; -------------------------------
For lp =0 to Count-1
; get the size of this file
ThisRGB =IntegerArray(lp)
; RadixIndex =rgba(ThisRGB)
RadixIndex =(ThisRGB / $1000000) and 255
Address=RadixBanksPtrs(RAdixIndex)
pokeint address,ThisRGB
RadixBanksPtrs(RAdixIndex)=Address+4
next
endselect
// ------------------------------------------------------
// Copy the radix buffer back to the order array
// ------------------------------------------------------
DestPtr=DestArrayBasePtr
For BufferIndex =0 to 255
SrcPtr=GetBankPtr(GlobalRadixBanks(BufferIndex))
Tally = RadixBanksPtrs(BufferIndex)-SrcPtr
if tally
CopyMemory SrcPtr,DestPtr,Tally
DestPtr+=Tally
endif
next
endif
BitShift+=8
next
// Clean up the temp caches
if CleanUp=true
For lp =0 to 255
thisbank=GlobalRadixBanks(lp)
if Thisbank
deletebank ThisBank
GlobalRadixBanks(lp)=0
endif
next
endif
EndFunction
[/pbcode]