.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