.NET Conversions - Sorting Algorithms
C# to VB.NET, VB6 to VB.NET
Synopsis:
The code listed below is a VB.NET static class of different sort types converted from C# from csharp-home.com. The mergesort algorithm listed below though is converted from a vb6 mergesort example located at Xtremevbtalk.com
The types of sorting algorithms listed below are:
QuickSort
BubbleSort
ShellSort
SelectionSort
InsertionSort
MergeSort
For more information on sorting algorithms see wikipedia.org.
Code:
Public Class Sorting
Public Shared Sub QuickSort(ByVal numbers() As Integer, ByVal array_size As Integer)
q_sort(numbers, 0, array_size - 1)
End Sub 'QuickSort
Private Shared Sub q_sort(ByVal numbers() As Integer, ByVal left As Integer, _
ByVal right As Integer)
Dim pivot, l_hold, r_hold As Integer
l_hold = left
r_hold = right
pivot = numbers(left)
While left < right
While numbers(right) >= pivot AndAlso left < right
right -= 1
End While
If left <> right Then
numbers(left) = numbers(right)
left += 1
End If
While numbers(left) <= pivot AndAlso left < right
left += 1
End While
If left <> right Then
numbers(right) = numbers(left)
right -= 1
End If
End While
numbers(left) = pivot
pivot = left
left = l_hold
right = r_hold
If left < pivot Then
q_sort(numbers, left, pivot - 1)
End If
If right > pivot Then
q_sort(numbers, pivot + 1, right)
End If
End Sub 'q_sort
Public Shared Sub BubbleSort(ByVal numbers() As Integer, ByVal array_size As Integer)
Dim i, j, temp As Integer
For i = array_size - 1 To 0 Step -1
For j = 1 To i
If numbers((j - 1)) > numbers(j) Then
temp = numbers((j - 1))
numbers((j - 1)) = numbers(j)
numbers(j) = temp
End If
Next j
Next i
End Sub 'BubbleSort
Public Shared Sub ShellSort(ByVal numbers() As Integer, ByVal array_size As Integer)
Dim i, j, increment, temp As Integer
increment = 3
While increment > 0
For i = 0 To array_size
j = i
temp = numbers(i)
While j >= increment AndAlso numbers((j - increment)) > temp
numbers(j) = numbers((j - increment))
j = j - increment
End While
numbers(j) = temp
Next i
If increment / 2 <> 0 Then
increment = increment / 2
ElseIf increment = 1 Then
increment = 0
Else
increment = 1
End If
End While
End Sub 'ShellSort
Public Shared Sub SelectionSort(ByVal numbers() As Integer, ByVal array_size As Integer)
Dim i, j As Integer
Dim min, temp As Integer
For i = 0 To (array_size - 1)
min = i
For j = i + 1 To array_size
If numbers(j) < numbers(min) Then
min = j
End If
Next j
temp = numbers(i)
numbers(i) = numbers(min)
numbers(min) = temp
Next i
End Sub 'SelectionSort
Public Shared Sub InsertionSort(ByVal numbers() As Integer, ByVal array_size As Integer)
Dim i, j, index As Integer
For i = 1 To array_size
index = numbers(i)
j = i
While j > 0 AndAlso numbers((j - 1)) > index
numbers(j) = numbers((j - 1))
j = j - 1
End While
numbers(j) = index
Next i
End Sub 'InsertionSort
Public Shared Sub MergeSort(ByVal numbers() As Int32, ByVal arraysize As Int32)
Dim arrTemp() As Int32
Dim iSegSize As Int32
ReDim arrTemp(0 To arraysize)
iSegSize = 1
Do While iSegSize < arraysize
'Merge from A to B
InnerMergePass(numbers, arrTemp, 0, arraysize, iSegSize)
iSegSize = iSegSize + iSegSize
'Merge from B to A
InnerMergePass(arrTemp, numbers, 0, arraysize, iSegSize)
iSegSize = iSegSize + iSegSize
Loop
End Sub
Private Shared Sub InnerMergePass(ByVal Src() As Int32, ByRef Dest() As Int32, _
ByVal iLBound As Int32, ByVal iUBound As Int32, ByVal iSegSize As Int32)
Dim iSegNext As Long
iSegNext = iLBound
Do While iSegNext <= iUBound - (2 * iSegSize)
'Merge 2 segments from src to dest
InnerMerge(Src, Dest, iSegNext, iSegNext + iSegSize - 1, _
iSegNext + iSegSize + iSegSize - 1)
iSegNext = iSegNext + iSegSize + iSegSize
Loop
'Fewer than 2 full segments remain
If iSegNext + iSegSize <= iUBound Then
'2 segs remain
InnerMerge(Src, Dest, iSegNext, iSegNext + iSegSize - 1, iUBound)
Else
'1 seg remains, just copy it
For iSegNext = iSegNext To iUBound
Dest(iSegNext) = Src(iSegNext)
Next iSegNext
End If
End Sub
Private Shared Sub InnerMerge(ByRef Src() As Int32, ByRef Dest() As Int32, _
ByVal iStartFirst As Int32, ByVal iEndFirst As Int32, ByVal iEndSecond As Int32)
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)
'Select the smaller value and place in the output
'Since the subarrays are already sorted, only one comparison is needed
If Src(iFirst) <= Src(iSecond) Then
Dest(iResult) = Src(iFirst)
iFirst = iFirst + 1
Else
Dest(iResult) = Src(iSecond)
iSecond = iSecond + 1
End If
iResult = iResult + 1
Loop
'Take care of any leftover values
If iFirst > iEndFirst Then
'Got some leftover seconds
For iOuter = iSecond To iEndSecond
Dest(iResult) = Src(iOuter)
iResult = iResult + 1
Next iOuter
Else
'Got some leftover firsts
For iOuter = iFirst To iEndFirst
Dest(iResult) = Src(iOuter)
iResult = iResult + 1
Next iOuter
End If
End Sub
End Class 'Sorting
Usage Example:
Dim x() As Int32 = {5, 3, 2, 1, 0, 4, 8, 7, 6, 9}
Dim i As Int32
'Sorting.BubbleSort(x, x.GetUpperBound(0) + 1)
'Sorting.InsertionSort(x, x.GetUpperBound(0))
'Sorting.MergeSort(x, x.GetUpperBound(0))
'Sorting.QuickSort(x, x.GetUpperBound(0) + 1)
'Sorting.SelectionSort(x, x.GetUpperBound(0))
Sorting.ShellSort(x, x.GetUpperBound(0))
For Each i In x
Debug.Print(i)
Next