Binary quick sorting

I am looking for the full algorithm for binary quick sorting in VB.
The algorithm should sort a array of strings in binary order.
Help appreciated...

Martin Schmalz
LVL 1
Who is Participating?

Commented:
Hi.
You mean creating a binary tree, ect?
0

Commented:
0

Commented:
0

Commented:
[vbcode]
'
' test QSORT on a vector of strings
'
Private Sub cmdSort3_Click()
Dim thelist(10) As String
Dim ix As Integer
For ix = 0 To 9
thelist(ix) = Chr(70 + ((ix + 5) Mod 9)) + "aB"
Next ix
Debug.Print "-----------"
For ix = 0 To 9
Debug.Print thelist(ix)
Next ix
Call QuickSort(thelist, 0, 9)
Debug.Print ""
For ix = 0 To 9
Debug.Print thelist(ix)
Next ix
End Sub
'
' QSORT modified to handle public MyType indexes as elements
'
' The SortList passed in (and recursed) is an index on a vector
' of MyType structures.  The COMPARISON is done on the actual
' internal MyType element which is the sort key (S2 in this case)
' thus when the QSORT is finished, the SortList is a vector of
' indexes which can then be used to get at the MyType vector
' in sorted order.
'
Public Sub QuickSort2(SortList As Variant, ByVal First As Integer, ByVal Last As Integer)
Dim Low As Integer, High As Integer         'Use Integer for lists up to 32,767 entries.
Dim temp1 As Variant, TestElement As Variant 'Variant can handle any type of list.
Low = First
High = Last
TestElement = lst(SortList((First + Last) / 2)).S2  'Select an element from the middle.
Do
Do While lst(SortList(Low)).S2 < TestElement    'Find lowest element that is >= TestElement.
Low = Low + 1
Loop
Do While lst(SortList(High)).S2 > TestElement   'Find highest element that is <= TestElement.
High = High - 1
Loop
If (Low <= High) Then                   'If not done,
temp1 = SortList(Low)                ' Swap the elements.
SortList(Low) = SortList(High)
SortList(High) = temp1
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then QuickSort2 SortList, First, High
If (Low < Last) Then QuickSort2 SortList, Low, Last
End Sub
[/vbcode]
0

Commented:
Hi again.
By the way, If you need just a FAST algorythm, and NOT ONLY a binary tree, I have one method handy.

It makes approximately:
Log(2)X comparitions
to find the place of an element in an array of X elements.
Say It's an array of 1024 elements, it will do 10 comparitions; or 20 comparitions for an array of 2^20 elements.

So, to sort ALL elements in an array, it takes:
Sum(1 to x) of Log2(I) comparitions
to sort X elements (where I is from 1 to X)

0

Commented:
Hello again. I had forgoten this question, sorry...
Here is the method I often use to sort arrays.
I have moved the comparition to a procedure, so you could change it according to your needs - you may be comparing more than just one value.
"Command1_Click" - just to test it.
I'm sure this method could be improved, but I don't have time to think of it now.

Private Sub Command1_Click()
SortArray (Array(1, 9, 17, 5, 2, 7, 4, 3, 6, 8, 10, 15, 16, 14, 12, 13, 18, 11))
End Sub

Private Sub SortArray(ByRef vntArr As Variant)

Dim lngLLimit As Long     'lower array limit
Dim lngTotalItems As Long 'upper array limit

Dim lngULimit As Long   'upper limit of sorted items

Dim lngCurrent As Long  'current item being sorted
Dim lngChecked As Long  'item being checked with the current

Dim lngLSeekLimit As Long   'last smaller detected item
Dim lngUSeekLimit As Long   'last bigger detected item

Dim I As Long, vntItem As Variant   'used to move items

Dim lngCounter As Long  'just to count comparition operations, you can remove it.

lngTotalItems = UBound(vntArr)  'get upper bound of the array
lngLLimit = LBound(vntArr)      'get lower bound of the array
lngULimit = lngLLimit + 1       'sorted items in the array (=2)

'sort first and second items in the array
If IsBigger(vntArr(lngLLimit), vntArr(lngULimit)) Then
vntItem = vntArr(lngLLimit)
vntArr(lngLLimit) = vntArr(lngULimit)
vntArr(lngULimit) = vntItem
End If

'repeat until the last item is sorted
Do Until lngULimit = lngTotalItems

lngCurrent = lngULimit + 1  'this item will be sorted
lngLSeekLimit = lngLLimit   'this is the smaller known item
lngUSeekLimit = lngULimit   'this is the biggest known item

lngCounter = 0  'reset comparitions counter

'find place where then new item will be moved to
Do
'get middle item of the sorted items list
lngChecked = (lngUSeekLimit - lngLSeekLimit) \ 2 + lngLSeekLimit

lngCounter = lngCounter + 1

'if the new item is bigger than the middle element, change boundaries
If IsBigger(vntArr(lngCurrent), vntArr(lngChecked)) Then
lngLSeekLimit = lngChecked + 1
Else
lngUSeekLimit = lngChecked - 1
End If
Loop Until lngLSeekLimit > lngUSeekLimit

'move the new item to its proper place
vntItem = vntArr(lngCurrent)
For I = lngULimit To lngLSeekLimit Step -1
vntArr(I + 1) = vntArr(I)
Next I
vntArr(lngLSeekLimit) = vntItem

'display operation on the screen. This code is for demo only - remove it.
For I = lngLLimit To lngTotalItems
Debug.Print vntArr(I) & "  ";
If I = lngCurrent Then Debug.Print "/ ";
Next I
Debug.Print " -> [" & lngCounter & " comparitions]"

'increase the sorted items counter
lngULimit = lngULimit + 1
Loop

End Sub

Private Function IsBigger(ByVal vntFirst As Variant, ByVal vntSecond As Variant) As Boolean
IsBigger = (vntFirst > vntSecond)
End Function
0

Commented:
You can speed it up, if you use second array to store results into - this way it won't be neccesary to move the elements to allocate space for each new sorted item.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.