'Heap sorting
Option explicit
Dim result, I
Dim testdata (100)
Const n= 100
Randomize
For I = 0 to n-1
Testdata (I) = round (RND () * 32768)
Next
'Heap sorting
Sub hsort (byref array, low, hi)
Dim I, T, J, P, L, R
For I = Hi to low + 1 step-1
J = I
P = int (J-low + 1)/2) + low-1
T = array (j)
Do
If P = low-1 then
Exit do
End if
If T> array (p) then
Array (j) = array (P)
J = P
P = int (J-low + 1)/2) + low-1
Else
Exit do
End if
Loop
Array (j) = T
Next
For I = Hi to low + 1 step-1
T = array (I)
Array (I) = array (low)
J = low
Do
L = (J-low + 1) * 2 + low-1
If l <I then
R = (J-low + 1) * 2 + low
If r <I then
If array (l) <array (r) then
L = r
End if
End if
If T <array (l) then
Array (j) = array (l)
J = L
Else
Exit do
End if
Else
Exit do
End if
Loop
Array (j) = T
Next
End sub
Hsort testdata, 0, n-1
For I = 0 to n-1
Result = Result & testdata (I) & vbtab
Next
Msgbox (result)
'Quick sorting
Option explicit
Dim result, I
Dim testdata (100)
Const n= 100
Randomize
For I = 0 to n-1
Testdata (I) = round (RND () * 32768)
Next
Sub swap (byref array, first, second)
Dim t
T = array (first)
Array (first) = array (second)
Array (second) = T
End sub
'Quick sorting
Sub qsort (byref array, low, hi)
Dim I, j, P
While low P = array (HI)
I = low-1
For J = low to hi-1
If array (j) <= p then
I = I + 1
Swap array, I, j
End if
Next
Swap array, I + 1, J
Qsort array, low, I
Low = I + 2
Wend
End sub
Qsort testdata, 0, n-1
For I = 0 to n-1
Result = Result & testdata (I) & vbtab
Next
Msgbox (result)