Implementation of 10 common sorting algorithms

Write with VBAProgramUsually sort, the following will give some common sortingAlgorithmTo facilitate programming reference. IfCodeAn error has occurred. You are welcome to correct it.

Main algorithms include:

1. (Bubble Sorting) bubble sort
2. (select sorting) selection sort
3. (insert sort) insertion sort
4. (quick sorting) Quick Sort
5. (merge sort) Merge sort
6. Heap Sort
7. (combined sorting) comb sort
8. Shell sort
9. (base sorting) Radix sort
10. Shaker sort

First (Bubble Sorting) bubble sort
Public sub bubblesort (byref lngarray () as long)
Dim iouter as long
Dim iinner as long
Dim ilbound as long
Dim iubound as long
Dim itemp as long

Ilbound = lbound (lngarray)
Iubound = ubound (lngarray)

'Bubble sorting
For iouter = ilbound to iubound-1
For iinner = ilbound to iubound-iouter-1

'Compare adjacent items
If lngarray (iinner)> lngarray (iinner + 1) then
'SWAp Value
Itemp = lngarray (iinner)
Lngarray (iinner) = lngarray (iinner + 1)
Lngarray (iinner + 1) = itemp
End if

Next iinner
Next iouter
End sub

2. (select sorting) selection sort
Public sub selectionsort (byref lngarray () as long)
Dim iouter as long
Dim iinner as long
Dim ilbound as long
Dim iubound as long
Dim itemp as long
Dim IMAX as long

Ilbound = lbound (lngarray)
Iubound = ubound (lngarray)

'Select sorting
For iouter = iubound to ilbound + 1 step-1

IMAX = 0

'Obtain the maximum value of the index.
For iinner = ilbound to iouter
If lngarray (iinner)> lngarray (IMAX) Then IMAX = iinner
Next iinner

'Value exchange
Itemp = lngarray (IMAX)
Lngarray (IMAX) = lngarray (iouter)
Lngarray (iouter) = itemp

Next iouter
End sub

Third (insert sort) insertion sort
Public sub insertionsort (byref lngarray () as long)
Dim iouter as long
Dim iinner as long
Dim ilbound as long
Dim iubound as long
Dim itemp as long

Ilbound = lbound (lngarray)
Iubound = ubound (lngarray)

For iouter = ilbound + 1 to iubound

'Get the insert value
Itemp = lngarray (iouter)

'Move sorted values
For iinner = iouter-1 to ilbound step-1
If lngarray (iinner) <= itemp then exit
Lngarray (iinner + 1) = lngarray (iinner)
Next iinner

'Insert Value
Lngarray (iinner + 1) = itemp
Next iouter
End sub

Fourth (quick sorting) Quick Sort
Public sub quicksort (byref lngarray () as long)
Dim ilbound as long
Dim iubound as long
Dim itemp as long
Dim iouter as long
Dim IMAX as long

Ilbound = lbound (lngarray)
Iubound = ubound (lngarray)

'If there is only one value, it is not sorted.
If (iubound-ilbound) then
For iouter = ilbound to iubound
If lngarray (iouter)> lngarray (IMAX) Then IMAX = iouter
Next iouter

Itemp = lngarray (IMAX)
Lngarray (IMAX) = lngarray (iubound)
Lngarray (iubound) = itemp

'Start quick sorting
Innerquicksort lngarray, ilbound, iubound
End if
End sub

Private sub innerquicksort (byref lngarray () as long, byval ileftend as long, byval irightend as long)
Dim ileftcur as long
Dim irightcur as long
Dim ipivot as long
Dim itemp as long

If ileftend> = irightend then exit sub

Ileftcur = ileftend
Irightcur = irightend + 1
Ipivot = lngarray (ileftend)

Do
Do
Ileftcur = ileftcur + 1
Loop while lngarray (ileftcur) <ipivot

Do
Irightcur = irightcur-1
Loop while lngarray (irightcur)> ipivot

If ileftcur> = irightcur then exit do

'SWAp Value
Itemp = lngarray (ileftcur)
Lngarray (ileftcur) = lngarray (irightcur)
Lngarray (irightcur) = itemp
Loop

'Recursive quick sorting
Lngarray (ileftend) = lngarray (irightcur)
Lngarray (irightcur) = ipivot

Innerquicksort lngarray, ileftend, irightcur-1
Innerquicksort lngarray, irightcur + 1, irightend
End sub

Fifth (merge sort) Merge sort
Public sub mergesort (byref lngarray () as long)
Dim arrtemp () as long
Dim isegsize as long
Dim ilbound as long
Dim iubound as long

Ilbound = lbound (lngarray)
Iubound = ubound (lngarray)

Redim arrtemp (ilbound to iubound)

Isegsize = 1
Do While isegsize <iubound-ilbound

'Merge A to B
Innermergepass lngarray, arrtemp, ilbound, iubound, isegsize
Isegsize = isegsize + isegsize

'Merge B to
Innermergepass arrtemp, lngarray, ilbound, iubound, isegsize
Isegsize = isegsize + isegsize

Loop
End sub

Private sub innermergepass (byref lngsrc () as long, byref lngdest () as long, byval ilbound as long, iubound as long, byval isegsize as long)
Dim isegnext as long

Isegnext = ilbound

Do While isegnext <= iubound-(2 * isegsize)
'Merge
Innermerge lngsrc, lngdest, isegnext, isegnext + isegsize-1, isegnext + isegsize-1

Isegnext = isegnext + isegsize
Loop

If isegnext + isegsize <= iubound then
Innermerge lngsrc, lngdest, isegnext, isegnext + isegsize-1, iubound
Else
For isegnext = isegnext to iubound
Lngdest (isegnext) = lngsrc (isegnext)
Next isegnext
End if

End sub

Private sub innermerge (byref lngsrc () as long, byref lngdest () as long, byval istartfirst as long, byval iendfirst as long, byval iendsecond as long)
Dim Ifirst as long
Dim isecond as long
Dim iresult as long
Dim iouter as long

Ifirst = istartfirst
Isecond = iendfirst + 1
Iresult = istartfirst

Do While (Ifirst <= iendfirst) and (isecond <= iendsecond)

If lngsrc (Ifirst) <= lngsrc (isecond) then
Lngdest (iresult) = lngsrc (Ifirst)
Ifirst = Ifirst + 1
Else
Lngdest (iresult) = lngsrc (isecond)
Isecond = isecond + 1
End if

Iresult = iresult + 1
Loop

If Ifirst> iendfirst then
For iouter = isecond to iendsecond
Lngdest (iresult) = lngsrc (iouter)
Iresult = iresult + 1
Next iouter
Else
For iouter = Ifirst to iendfirst
Lngdest (iresult) = lngsrc (iouter)
Iresult = iresult + 1
Next iouter
End if
End sub

Heap Sort
Public sub heapsort (byref lngarray () as long)
Dim ilbound as long
Dim iubound as long
Dim iarrsize as long
Dim iroot as long
Dim ichild as long
Dim ielement as long
Dim icurrent as long
Dim arrout () as long

Ilbound = lbound (lngarray)
Iubound = ubound (lngarray)
Iarrsize = iubound-ilbound

Redim arrout (ilbound to iubound)

'Initialise the heap
'Move up the heap from the bottom
For iroot = iarrsize \ 2 to 0 step-1

Ielement = lngarray (iroot + ilbound)
Ichild = iroot + iroot

'Move down the heap from the current position
Do While ichild <iarrsize

If ichild <iarrsize then
If lngarray (ichild + ilbound) <lngarray (ichild + ilbound + 1) then
'Always want largest child
Ichild = ichild + 1
End if
End if

'Found a slot, stop looking
If ielement> = lngarray (ichild + ilbound) Then exit do

Lngarray (ichild \ 2) + ilbound) = lngarray (ichild + ilbound)
Ichild = ichild + ichild
Loop

'Move the node
Lngarray (ichild \ 2) + ilbound) = ielement
Next iroot

'Read of values one by one (store in array starting at the end)
For iroot = iubound to ilbound step-1

'Read the value
Arrout (iroot) = lngarray (ilbound)
'Get the last element
Ielement = lngarray (iarrsize + ilbound)

Iarrsize = iarrsize-1
Icurrent = 0
Ichild = 1

'Find a place for the last element to go
Do While ichild <= iarrsize

If ichild <iarrsize then
If lngarray (ichild + ilbound) <lngarray (ichild + ilbound + 1) then
'Always want the larger child
Ichild = ichild + 1
End if
End if

'Found a position
If ielement> = lngarray (ichild + ilbound) Then exit do

Lngarray (icurrent + ilbound) = lngarray (ichild + ilbound)
Icurrent = ichild
Ichild = ichild + ichild

Loop

'Move the node
Lngarray (icurrent + ilbound) = ielement
Next iroot

'Copy from temp array to real Array
For iroot = ilbound to iubound
Lngarray (iroot) = arrout (iroot)
Next iroot
End sub

7. Comb sort
Public sub combsort (byref lngarray () as long)
Dim ispacing as long
Dim iouter as long
Dim iinner as long
Dim itemp as long
Dim ilbound as long
Dim iubound as long
Dim iarrsize as long
Dim ifinished as long

Ilbound = lbound (lngarray)
Iubound = ubound (lngarray)

'Initialise comb width
Ispacing = iubound-ilbound

Do
If ispacing> 1 then
Ispacing = int (ispacing/1.3)

If ispacing = 0 then
Ispacing = 1' dont go lower than 1
Elseif ispacing> 8 and ispacing <11 then
Ispacing = 11 'This is a special number, goes faster than 9 and 10
End if
End if

'Always go down to 1 before attempting to exit
If ispacing = 1 then ifinished = 1

'Combing pass
For iouter = ilbound to iubound-ispacing
Iinner = iouter + ispacing

If lngarray (iouter)> lngarray (iinner) then
'SWAp
Itemp = lngarray (iouter)
Lngarray (iouter) = lngarray (iinner)
Lngarray (iinner) = itemp

'Not finished
Ifinished = 0
End if
Next iouter

Loop until ifinished
End sub

Shell sort
Public sub shellsort (byref lngarray () as long)
Dim ispacing as long
Dim iouter as long
Dim iinner as long
Dim itemp as long
Dim ilbound as long
Dim iubound as long
Dim iarrsize as long

Ilbound = lbound (lngarray)
Iubound = ubound (lngarray)

'Calculate initial sort spacing
Iarrsize = (iubound-ilbound) + 1
Ispacing = 1

If iarrsize> 13 then
Do While ispacing <iarrsize
Ispacing = (3 * ispacing) + 1
Loop

Ispacing = ispacing \ 9
End if

'Start sorting
Do While ispacing

For iouter = ilbound + ispacing to iubound

'Get the value to be inserted
Itemp = lngarray (iouter)

'Move along the already sorted values shifting along
For iinner = iouter-ispacing to ilbound step-ispacing
'No more shifting needed, we found the right spot!
If lngarray (iinner) <= itemp then exit

Lngarray (iinner + ispacing) = lngarray (iinner)
Next iinner

'Insert value in the slot
Lngarray (iinner + ispacing) = itemp
Next iouter

'Reduce the sort spacing
Ispacing = ispacing \ 3
Loop

End sub

Ninth (base sorting) Radix sort
Public sub radixsort (byref lngarray () as long)
Dim arrtemp () as long
Dim ilbound as long
Dim iubound as long
Dim IMAX as long
Dim isorts as long
Dim iloop as long

Ilbound = lbound (lngarray)
Iubound = ubound (lngarray)

'Create swap Array
Redim arrtemp (ilbound to iubound)

IMAX = & h80000000
'Find largest
For iloop = ilbound to iubound
If lngarray (iloop)> IMAX then IMAX = lngarray (iloop)
Next iloop

'Calculate how many sorts are needed
Do While IMAX
Isorts = isorts + 1
IMAX = IMAX/256
Loop

IMAX = 1

'Do the sorts
For iloop = 1 to isorts

If iloop and 1 then
'Oss sort-> SRC to dest
Innerradixsort lngarray, arrtemp, ilbound, iubound, IMAX
Else
'Even sort-> DEST to SRC
Innerradixsort arrtemp, lngarray, ilbound, iubound, IMAX
End if

'Next sort factor
IMAX = IMAX * 256
Next iloop

'If odd number of sorts we need to swap the arrays
If (isorts and 1) then
For iloop = ilbound to iubound
Lngarray (iloop) = arrtemp (iloop)
Next iloop
End if
End sub

Private sub innerradixsort (byref lngsrc () as long, byref lngdest () as long, byval ilbound as long, byval iubound as long, byval idivisor as long)
Dim arrcounts (1, 255) as long
Dim arroffsets (255) as long
Dim ibucket as long
Dim iloop as long

'Count the items for each bucket
For iloop = ilbound to iubound
Ibucket = (lngsrc (iloop) \ idivisor) and 255
Arrcounts (ibucket) = arrcounts (ibucket) + 1
Next iloop

'Generate Offsets
For iloop = 1 to 255
Arroffsets (iloop) = arroffsets (iloop-1) + arrcounts (iloop-1) + ilbound
Next iloop

'Fill the buckets
For iloop = ilbound to iubound
Ibucket = (lngsrc (iloop) \ idivisor) and 255
Lngdest (arroffsets (ibucket) = lngsrc (iloop)
Arroffsets (ibucket) = arroffsets (ibucket) + 1
Next iloop
End sub

Shaker sort
Public sub shakersort (byref lngarray () as long)
Dim ilower as long
Dim iupper as long
Dim iinner as long
Dim ilbound as long
Dim iubound as long
Dim itemp as long
Dim IMAX as long
Dim Imin as long

Ilbound = lbound (lngarray)
Iubound = ubound (lngarray)

Ilower = ilbound-1
Iupper = iubound + 1

Do While ilower <iupper

Ilower = ilower + 1
Iupper = iupper-1

IMAX = ilower
Imin = ilower

'Find the largest and smallest values in the subarray
For iinner = ilower to iupper
If lngarray (iinner)> lngarray (IMAX) then
IMAX = iinner
Elseif lngarray (iinner) <lngarray (Imin) then
Imin = iinner
End if
Next iinner

'SWAp the largest with last slot of the subarray
Itemp = lngarray (IMAX)
Lngarray (IMAX) = lngarray (iupper)
Lngarray (iupper) = itemp

'SWAp the smallest with the first slot of the subarray
Itemp = lngarray (Imin)
Lngarray (Imin) = lngarray (ilower)
Lngarray (ilower) = itemp

Loop
End sub