Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Visual Basic (Classic) FAQ

Add-in and tools

Extended DataTable Class by benlinkknilneb
Posted: 9 Jan 04

Hi all,

I seem to use the DataTable more than any other object, and I've been frustrated in the past by the lack of Search and Sort methods associated with it.  So, I finally got brave and started working on it.  My Sort and Search algorithms come from Data Structures in C++: Including Breadth & Laboratories by Angela Shiflet (Amazon page listed below).  The statistical methods I wrote with the help of another Tek-Tips member, foundryqa.  Hope this helps!



Public Class SuperDataTable
    Inherits System.Data.DataTable

    'This class adds some Sort and Search Routines to the DataTable class, as
    'well as some statistical methods.

#Region " Search & Sort Interface Functions "
    Public Sub BubbleSort(ByVal KeyField As String)
        Dim Done As Boolean
        Dim i As Integer
        Dim Max As Integer = Rows.Count - 2
        Done = False
        While Done = False
            Done = True
            For i = 0 To Max
                If (Rows(i)(KeyField) > Rows(i + 1)(KeyField)) Then
                    Swap(i, i + 1)
                    Done = False
                End If
            Next i
            Max -= 1
        End While
    End Sub
    Public Sub SelectionSort(ByVal KeyField As String)
        Dim i As Integer
        Dim Index As Integer
        For i = 0 To Rows.Count - 2
            Index = GetMinAfter(KeyField, i)
            Swap(i, Index)
    End Sub
    Public Sub QuickSort(ByVal KeyField As String)
        QSort(0, Rows.Count - 1, KeyField)
    End Sub

    Public Function BinarySearch(ByVal FieldName As String, ByVal SearchFor As Object) As Integer
        'Be sure that the datatable is sorted by FieldName
        Dim First As Integer = 0
        Dim Last As Integer = Rows.Count - 1
        Dim Key As Integer
        While (True)
            If First > Last Then Return -1
            Key = First + ((Last - First) / 2)
            If Rows(Key)(FieldName) = SearchFor Then Return Key
            If Rows(Key)(FieldName) > SearchFor Then
                Last = Key - 1
                First = Key + 1
            End If
        End While
    End Function
    Public Function SequentialSearch(ByVal FieldName As String, ByVal SearchFor As Object) As Integer
        Dim i As Integer = 0
        While i < Rows.Count
            If Rows(i)(FieldName) = SearchFor Then Return i
        End While
        Return -1
    End Function
#End Region

#Region " DataTable Statistical Methods "
    Public Function StandardDeviation(ByRef ColumnName As String) As Double
        Dim M As Double = 0
        Dim Ct As Integer
        Dim A As Double = 0
        For Ct = 0 To Rows.Count - 1
            M = M + Rows(Ct)(ColumnName)
        M = M / (Ct + 1)
        For Ct = 0 To Rows.Count - 1
            A = A + (Rows(Ct)(ColumnName) - M) ^ 2
        Return System.Math.Sqrt(A / (Ct + 1))
    End Function
    Public Function R_Squared(ByRef Xaxis As String, ByRef Yaxis As String) As Double
        Dim n As Integer = Rows.Count
        Dim a As Double = 0
        Dim b As Double = 0
        Dim c As Double = 0
        Dim d As Double = 0
        Dim e As Double = 0
        Dim r As Data.DataRow
        Dim r2 As Double = 0
        For Each r In Rows
            If (Not (r(Xaxis).GetType Is GetType(DBNull)) And (Not (r(Yaxis).GetType Is GetType(DBNull)))) Then
                a = a + r(Yaxis)
                b = b + r(Xaxis)
                c = c + (r(Xaxis) * r(Yaxis))
                d = d + (r(Yaxis) ^ 2)
                e = e + (r(Xaxis) ^ 2)
            End If

        r2 = (((n * c) - (a * b)) / ((((n * d) - (a ^ 2)) * ((n * e) - (b ^ 2))) ^ (0.5))) ^ 2
        If Rows.Count > 1 Then
            Return r2
            Return 0
        End If
    End Function
    Public Function ArithmeticMean(ByRef ColumnName As String) As Double
        Dim Sum As Double
        Dim count As Integer
        Sum = 0
        For count = 0 To Rows.Count - 1
            Sum = Sum + Rows(count)(ColumnName)
        ArithmeticMean = Sum / (count + 1)
    End Function
    Public Function Sum(ByVal Field As String) As Double
        Dim S As Double
        Dim x As Integer = 0
        While x < Rows.Count
            S += Rows(S)(Field)
            x += 1
        End While
        Return S
    End Function
#End Region

#Region " Helper Functions "
    Private Sub QSort(ByVal first As Integer, ByVal last As Integer, ByVal Keyfield As String)
        Dim loc As Integer
        If first < last Then
            loc = QPartition(first, last, Keyfield)
            QSort(first, loc - 1, Keyfield)
            QSort(loc + 1, last, Keyfield)
        End If
    End Sub
    Private Function QPartition(ByRef first As Integer, ByRef last As Integer, ByVal KeyField As String) As Integer
        Dim i As Integer = first
        Dim loc As Integer = last + 1
        Dim pivot As Object = Rows(first)(KeyField)
        While i < loc
                i += 1
            Loop While (Rows(i)(KeyField) < pivot) And i < last
                loc -= 1
            Loop While Rows(loc)(KeyField) > pivot
            If i < loc Then
                Swap(i, loc)
            End If
        End While
        Swap(first, loc)
        Return loc
    End Function
    Private Function GetMinAfter(ByVal KeyField As String, ByVal i As Integer) As Integer
        Dim M As Integer = i
        Dim j As Integer
        For j = i + 1 To Rows.Count - 1
            If Rows(j)(KeyField) < Rows(M)(KeyField) Then
                M = j
            End If
        Return M
    End Function
    Private Sub Swap(ByRef j As Integer, ByRef k As Integer)
        Dim x As Data.DataRow = NewRow()
        Dim FieldNumber As Integer
        For FieldNumber = 0 To Columns.Count - 1
            x(FieldNumber) = Rows(j).Item(FieldNumber)
            Rows(j)(FieldNumber) = Rows(k)(FieldNumber)
            Rows(k)(FieldNumber) = x(FieldNumber)
    End Sub
#End Region
End Class

Back to Visual Basic (Classic) FAQ Index
Back to Visual Basic (Classic) Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close