Code Snippets

VB.NET Source Code

Welcome to Dream.In.Code
	Become a VB.NET Expert! Join 244,068 VB.NET Programmers for FREE! Get instant access to thousands of VB.NET experts, tutorials, code snippets, and more! There are 1,378 people online right now. Registration is fast and FREE... Join Now! Chat LIVE With a VB.NET Expert

BIRST Sort (Improved)

Sorts string using the BIRST Method. Bytewise Indexing Radix SorT Devised my AdamSpeight2008

Submitted By: AdamSpeight2008

Actions:

Rating:

Views: 573

Language: VB.NET

Last Modified: July 14, 2008

Instructions: VB2005 or higher
Modded 14Jul2008: Added 2 missing Structures

Snippet

Private Sub BIRST2_Strings(ByRef WordList As List(Of String))
' BIRST2
' Bytewise Indexing Radix SorT
' Swaps the strings only once
Dim Nxt As Integer
Dim Curr As Integer
Dim m As Integer = 0
Dim List_Pos(WordList.Count) As Integer
Dim byteindex(255) As ByteIndice
Dim TmpNP(WordList.Count) As PtrNextPtr
Dim Ptr_Pos As Integer
Dim b As Integer
Dim k As Integer
For i As Integer = 0 To WordList.Count - 1
List_Pos(i) = i
If WordList(i).Length > m Then
m = WordList(i).Length
End If
Next i
For r As Integer = m - 1 To 0 Step -1
For i As Integer = 0 To 255
' Clear Index
byteindex(i).First = -1 : byteindex(i).Last = -1
Next i
For i As Integer = 0 To WordList.Count - 1
' Get Pointer to string's position
Ptr_Pos = List_Pos(i)
' Check to see if radix within the bounds of string length
If r >= WordList(Ptr_Pos).Length Then
' Radix Position is beyind the lenght of the string
' So give it a default value
b = 0
Else
' Otherwise get value of character at current radix position
b = Asc(WordList(Ptr_Pos).Substring(r, 1))
End If
TmpNP(i).NextPtr = -1 ' end of node list
TmpNP(i).Ptr = Ptr_Pos
If byteindex(b).First > -1 Then
' Radix value has node chain attached to it
' so add a link to it by change Last node's next to point to this one
TmpNP(byteindex(b).Last).NextPtr = i
Else
' Pointer to first node of this radix value
byteindex(b).First = i
End If
' Pointer to last node of the radix value
byteindex(b).Last = i
Next i
k = -1
For j As Integer = 0 To 255 Step 1
' Check to see if radix value has a node chain attached to it
If byteindex(j).First > -1 Then
' Get first link in Node chain
Nxt = byteindex(j).First
Do
Curr = Nxt
k = k + 1
List_Pos(k) = TmpNP(Curr).Ptr
Nxt = TmpNP(Curr).NextPtr
Loop Until Nxt = -1
End If
Next j
Next r
' Copy string into temp array
Dim Temp_List(WordList.Count) As String
For i As Integer = 0 To WordList.Count - 1
' Set the TempList(i) to the word list at the indicate list position
Temp_List(i) = WordList(List_Pos(i))
Next i
' Move back into Wordlist
WordList.Clear()
WordList.AddRange(Temp_List)
End Sub
Private Structure ByteIndice
Dim First As Long
Dim Last As Long
End Structure
Private Structure PtrNextPtr
Dim Ptr As Long
Dim NextPtr As Long
End Structure

Copy & Paste

Private Sub BIRST2_Strings(ByRef WordList As List(Of String))
        ' BIRST2
        ' Bytewise Indexing Radix SorT
        ' Swaps the strings only once
        Dim Nxt As Integer
        Dim Curr As Integer
        Dim m As Integer = 0
        Dim List_Pos(WordList.Count) As Integer
        Dim byteindex(255) As ByteIndice
        Dim TmpNP(WordList.Count) As PtrNextPtr
        Dim Ptr_Pos As Integer
        Dim b As Integer
        Dim k As Integer
        For i As Integer = 0 To WordList.Count - 1
            List_Pos(i) = i
            If WordList(i).Length > m Then
                m = WordList(i).Length
            End If
        Next i
        For r As Integer = m - 1 To 0 Step -1
            For i As Integer = 0 To 255
                ' Clear Index
                byteindex(i).First = -1 : byteindex(i).Last = -1
            Next i
            For i As Integer = 0 To WordList.Count - 1
                ' Get Pointer to string's position
                Ptr_Pos = List_Pos(i)
                ' Check to see if radix within the bounds of string length
                If r >= WordList(Ptr_Pos).Length Then
                    ' Radix Position is beyind the lenght of the string
                    ' So give it a default value
                    b = 0
                Else
                    ' Otherwise get value of character at current radix position
                    b = Asc(WordList(Ptr_Pos).Substring(r, 1))
                End If
                TmpNP(i).NextPtr = -1 ' end of node list
                TmpNP(i).Ptr = Ptr_Pos
                If byteindex(b).First > -1 Then
                    ' Radix value has node chain attached to it
                    ' so add a link to it by change Last node's next to point to this one
                    TmpNP(byteindex(b).Last).NextPtr = i
                Else
                    ' Pointer to first node of this radix value
                    byteindex(b).First = i
                End If
                ' Pointer to last node of the radix value
                byteindex(b).Last = i
            Next i
            k = -1
            For j As Integer = 0 To 255 Step 1
                ' Check to see if radix value has a node chain attached to it
                If byteindex(j).First > -1 Then
                    ' Get first link in Node chain
                    Nxt = byteindex(j).First
                    Do
                        Curr = Nxt
                        k = k + 1
                        List_Pos(k) = TmpNP(Curr).Ptr
                        Nxt = TmpNP(Curr).NextPtr
                    Loop Until Nxt = -1
                End If
            Next j
        Next r
        ' Copy string into temp array
        Dim Temp_List(WordList.Count) As String
        For i As Integer = 0 To WordList.Count - 1
            ' Set the TempList(i) to the word list at the indicate list position
            Temp_List(i) = WordList(List_Pos(i))
        Next i
        ' Move back into Wordlist
        WordList.Clear()
        WordList.AddRange(Temp_List)
    End Sub

Private Structure ByteIndice
        Dim First As Long
        Dim Last As Long
    End Structure
    Private Structure PtrNextPtr
        Dim Ptr As Long
        Dim NextPtr As Long
    End Structure