.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
About this page: