Tweet
Implements a bag that contains unique strings.
Discussion is here.
To use, compile Test.bas.
If you want to use as an SLL
Compile StringBag.bas
Comment out %INCLUDE in Test.bas
Compile Test.bas
BagEntry.inc - Internal class used to store hash table entries
StringBag.bas - The bag class. Compile this to create an SLL. Alternately you can define %INCLUDE in your program and compile this with it.
Test.bas - Sample use code.
Discussion is here.
To use, compile Test.bas.
If you want to use as an SLL
Compile StringBag.bas
Comment out %INCLUDE in Test.bas
Compile Test.bas
BagEntry.inc - Internal class used to store hash table entries
Code:
Class cBagEntry Common
Instance vHashCode As Long
Instance vValue As String
Instance vNext As Long
Interface iBagEntry
Inherit IUnknown
Property Get HashCode () As Long
Property = vHashCode
End Property
Property Set HashCode ( ByVal pHashCode As Long)
vHashCode = pHashCode
End Property
Property Get Value () As String
Property = vValue
End Property
Property Set Value ( ByVal pValue As String)
vValue = pValue
End Property
Property Get Next () As Long
Property = vNext
End Property
Property Set Next ( ByVal pNext As Long)
vNext = pNext
End Property
End Interface
End Class
Code:
#If Not %Def(%INCLUDE)
#Compile SLL
#Dim All
#EndIf
' This should probabbly be it's own class
Global vPrimes() As Long
Global vInit As Long
#Include "BagEntry.inc"
Function StringHashCode( ByRef pVal As String ) As Long
Local i As Long
Local p As Byte Pointer
Local vLen As Long
Local vHash As Long
vHash = 1
p = StrPtr( pVal )
vLen = Len(pVal)-1
For i = vLen To 0 Step -1
vHash = 1610612741 * vHash + @p
Incr p
Next
vHash And= &H7FFFFFFF
Function = vHash
End Function
Class cStringBag Guid$("{B63899CE-36CF-4F33-A9E4-BA2557E77DD0}") Common
Instance vBagEntries() As iBagEntry
Instance vBuckets() As Long
Instance vCount As Long
Instance vCapacity As Long
Class Method Create()
If Not vInit Then
ReDim vPrimes(25)
' Used for capacity growth and to provide a nice shape to the hashset.
Array Assign vPrimes() = _
53, 97, 193, 389, 769, 1543, 3079, 6151, 12289 _
, 24593, 49157, 98317, 196613, 393241, 786433 _
, 1572869, 3145739, 6291469, 12582917, 25165843 _
, 50331653, 100663319, 201326611, 402653189 _
, 805306457, 1610612741
vInit = -1
End If
Me.Expand( 0 )
End Method
' Adds a new string if it doesn't exist, either way returns the index of the item
Class Method AddIfMissing( pItem As String ) As Long
Local vHashCode As Long
Local vBucketIndex As Long
Local i As Long
vHashCode = StringHashCode( pItem )
vBucketIndex = vHashCode Mod vCapacity
i = vBuckets( vBucketIndex ) - 1
While i >= 0
If vBagEntries( i ).HashCode = vHashCode And vBagEntries( i ).Value = pItem Then
Method = i
Exit Method
End If
i = vBagEntries( i ).Next
Wend
If vCount >= UBound( vBagEntries() ) Then
Call Me.Expand( vCount+1 )
vBucketIndex = vHashCode Mod vCapacity
End If
vBagEntries( vCount ).HashCode = vHashCode
vBagEntries( vCount ).Value = pItem
vBagEntries( vCount ).Next = vBuckets( vBucketIndex ) - 1
Incr vCount
vBuckets( vBucketIndex ) = vCount
Method = vCount - 1
End Method
' Expands the bag as needed
Class Method Expand( capacity As Long )
Local i As Long
Local vHashCode As Long
Local vBucketIndex As Long
For i=0 To 25
If vPrimes(i)>capacity Then
capacity = vPrimes(i)
Exit For
End If
Next
ReDim vBuckets( capacity-1 )
ReDim Preserve vBagEntries( capacity )
For i=vCapacity To capacity
vBagEntries(i) = Class "cBagEntry"
Next
For i = 0 To vCount - 1
vHashCode = vBagEntries( i ).HashCode
vBucketIndex = vHashCode Mod capacity
vBagEntries( i ).Next = vBuckets( vBucketIndex ) - 1
vBuckets( vBucketIndex ) = i + 1
Next
vCapacity = capacity
End Method
Interface iStringBag Guid$("{DE5F2295-C83D-42A7-BB0C-48E44E99D360}")
Inherit IUnknown
' Returns index of added item
Method Add( pItem As String ) As Long
Method = Me.AddIfMissing( pItem )
End Method
' Empty the bag
Method Clear()
Local i As Long
For i = vCount To 0 Step -1
vBagEntries(i) = Class "cBagEntry"
Next
For i = UBound( vBuckets ) To 0 Step -1
vBuckets(i) = 0
Next
vCount = 0
End Method
' -1 if found, 0 if not found
Property Get Contains( pItem As String ) As Long
Property = Me.IndexOf( pItem ) <> -1
End Property
' Number of items in the bag
Property Get Count() As Long
Property = vCount
End Property
' Index of item if found, -1 if not found
Method IndexOf( pItem As String ) As Long
Local vHashCode As Long
Local vBucketIndex As Long
Local i As Long
vHashCode = StringHashCode( pItem )
vBucketIndex = vHashCode Mod vCapacity
i = vBuckets( vBucketIndex ) - 1
While i >= 0
If vBagEntries( i ).HashCode = vHashCode And vBagEntries( i ).Value = pItem Then
Method = i
Exit Method
End If
i = vBagEntries( i ).Next
Wend
Method = -1
Exit Method
End Method
' Get an item by index, returns empty string if out of bounds
Property Get Item( index As Long ) As String
Local v As String
If index<0 Or index>=vCount Then
v=""
Else
v = vBagEntries( index ).Value
End If
Property = v
End Property
End Interface
End Class
Code:
#Compile Exe
#Dim All
%INCLUDE = 1
#If %Def(%INCLUDE)
#Include "StringBag.bas"
#Else
#Link "StringBag.sll"
#EndIf
%MX = 1000000
Function PBMain () As Long
Dim tst As iStringBag
Local hWin As Dword
Local words() As String
Local wc As Long
Local vTxt As String
Local i As Long
Txt.Window("Test", 0, 0, 50, 80) To hWin
tst = Class "cStringBag"
vTxt = "the relational model specifies that the tuples of a relation have no specific order and that the tuples in turn impose no order on the attributes applications access data by specifying queries which use operations such as select"
wc = ParseCount( vTxt, " ")
ReDim words(wc-1)
Parse vTxt, words(), " "
For i=0 To UBound( words() )
tst.Add( words(i) )
Next
For i=0 To tst.Count-1
Txt.Print tst.Item(i)
Next
Txt.Print
Txt.Print "Done"
Txt.WaitKey$
End Function
Comment