Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Extended DataTable Class

Add-in and tools

Extended DataTable Class

by  benlinkknilneb  Posted    (Edited  )
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!

Ben

http://www.amazon.com/exec/obidos/ASIN/0314067442/qid%3D1073674952/sr%3D11-1/ref%3Dsr%5F11%5F1/103-7583402-8680617
Code:
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)
        Next
    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
            Else
                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)
        Next
        M = M / (Ct + 1)
        For Ct = 0 To Rows.Count - 1
            A = A + (Rows(Ct)(ColumnName) - M) ^ 2
        Next
        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
        Next

        r2 = (((n * c) - (a * b)) / ((((n * d) - (a ^ 2)) * ((n * e) - (b ^ 2))) ^ (0.5))) ^ 2
        If Rows.Count > 1 Then
            Return r2
        Else
            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)
        Next
        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
            Do
                i += 1
            Loop While (Rows(i)(KeyField) < pivot) And i < last
            Do
                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
        Next
        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)
        Next
    End Sub
#End Region
End Class
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top