An hash array dictonary step by step

[TempodiBasic]

Hi MadSciJr

I'm going on with the project of a dictionary with hashing by string.

I have adapted to the Luke's UDT  my routines of managing a dictionary with string key (in this example with one char as key) with this final code...

Code: (Select All)

Rem  further implementation  of dictionary using Luke Ceddia structuredata (UDT)
Rem adapting the code posted by MadSciJr in the following thread
' An hash array dictonary step by step
' by TempodiBasic, 3/14/2023, 11:04 AM
' https://qb64phoenix.com/forum/showthread.php?tid=1547

Dim Shared m_sTitle As String: m_sTitle = "dictionary step 3"
_Title m_sTitle ' display in the Window's title bar

Option _Explicit

Const FALSE = 0
Const TRUE = Not FALSE
Const cIntDictSize = 1000
Const cIntLookupSize = 32767

' For dictionary by Luke
' Object to store in the symbol table
Type DictionaryType
    key As String
    intValue As Integer
    lngValue As Long
    strValue As String
    IsDeleted As Integer
End Type ' DictionaryType


Dim Shared ProgramPath$: ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared ProgramName$: ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)

' For dictionary by Luke
ReDim Shared m_arrDict(cIntDictSize) As DictionaryType ' Actual stored obejcts
ReDim Shared m_arrLookup(cIntLookupSize) As Long ' Mapping between hash and index
Dim Shared m_iLastIndex As Long

' For dictionary by TempodiBasic
' https://qb64phoenix.com/forum/showthread.php?tid=1547
' renamed HashString to TempodiIndex
Dim Shared TempodiIndex(0 To 1000) As DictionaryType, InData As DictionaryType ' TempodiData '<--- instance of hashtable

' Local vars
Dim in$

' Run the tests
DictionaryTest2

End

' /////////////////////////////////////////////////////////////////////////////

Sub DictionaryTest2
    Dim RoutineName As String: RoutineName = "DictionaryTest2"
    Dim entry As DictionaryType
    Dim lngID As Long
    Dim intID As Integer
    Dim bResult As Integer
    Dim bFinished As Integer
    Dim key$
    Dim iLoop As Long
    Dim in$
    Dim in2$
    Dim sValue$
    Dim strValue$
    Dim intValue%
    Dim lngValue&
    Dim t#
    Dim iCount1 As _Integer64
    Dim iCount2 As _Integer64
    Dim iCount3 As _Integer64
    ReDim arrData(-1) As DictionaryType

    ' =============================================================================
    ' GENERATE TEST DATA
    For iLoop = 48 To 57 ' 0-9
        ReDim _Preserve arrData(UBound(arrData) + 1) As DictionaryType
        entry.key = Chr$(iLoop)
        entry.intValue = iLoop
        entry.lngValue = iLoop * 1000
        entry.strValue = Chr$(iLoop) + Chr$(iLoop) + _Trim$(Str$(iLoop))
        entry.IsDeleted = FALSE
        arrData(UBound(arrData)) = entry
    Next iLoop
    For iLoop = 65 To 90 ' A-Z
        ReDim _Preserve arrData(UBound(arrData) + 1) As DictionaryType
        entry.key = Chr$(iLoop)
        entry.intValue = iLoop
        entry.lngValue = iLoop * 1000
        entry.strValue = Chr$(iLoop) + Chr$(iLoop) + _Trim$(Str$(iLoop))
        entry.IsDeleted = FALSE
        arrData(UBound(arrData)) = entry
    Next iLoop
    For iLoop = 97 To 122 ' a-z
        ReDim _Preserve arrData(UBound(arrData) + 1) As DictionaryType
        entry.key = Chr$(iLoop)
        entry.intValue = iLoop
        entry.lngValue = iLoop * 1000
        entry.strValue = Chr$(iLoop) + Chr$(iLoop) + _Trim$(Str$(iLoop))
        entry.IsDeleted = FALSE
        arrData(UBound(arrData)) = entry
    Next iLoop

    ' =============================================================================
    ' TEST "TempodiBasic" DICTIONARY WITH ID CHECK - RUN FOR 3 SECONDS
    Print "Testing " + Chr$(34) + "TempodiBasic" + Chr$(34) + " dictionary for 3 seconds..."
    iCount2 = 0
    t# = ExtendedTimer + 3
    Do
        ' WRITE VALUES
        For iLoop = LBound(arrData) To UBound(arrData)
            StoreValue arrData(iLoop).key, arrData(iLoop)
            iCount2 = iCount2 + 1
        Next iLoop

        ' FIND VALUES
        For iLoop = LBound(arrData) To UBound(arrData)
            intID = GetIndex%(arrData(iLoop).key)
            If intID > -1 Then
                InData.key = GetValue$(arrData(iLoop).key, InData)
            End If
            iCount2 = iCount2 + 1
        Next iLoop
    Loop Until ExtendedTimer > t#

    ' =============================================================================
    ' TEST "TempodiBasic" DICTIONARY WITHOUT ID CHECK - RUN FOR 3 SECONDS
    Print "Testing " + Chr$(34) + "TempodiBasic" + Chr$(34) + " dictionary (no ID check) for 3 seconds..."
    iCount3 = 0
    t# = ExtendedTimer + 3
    Do
        ' WRITE VALUES
        For iLoop = LBound(arrData) To UBound(arrData)
            StoreValue arrData(iLoop).key, arrData(iLoop)
            iCount3 = iCount3 + 1
        Next iLoop

        ' FIND VALUES
        For iLoop = LBound(arrData) To UBound(arrData)
            InData.strValue = GetValue$(arrData(iLoop).key, InData)
            iCount3 = iCount3 + 1
        Next iLoop
    Loop Until ExtendedTimer > t#

    ' =============================================================================
    ' SHOW RESULTS
    Print "In 3 seconds:"
    '    Print "Luke    algorithm                    counted to " + _Trim$(Str$(iCount1))
    Print "Tempodi algorithm with ID check      counted to " + _Trim$(Str$(iCount2))
    Print "Tempodi algorithm (without ID check) counted to " + _Trim$(Str$(iCount3))
    Print
    Print "PRESS ANY KEY TO CONTINUE"
    Sleep
    While _DeviceInput(1): Wend ' clear and update the keyboard buffer
    Screen 0
End Sub ' DictionaryTest2


' ****************************************************************************************************************************************************************
' BEGIN ASSOCIATIVE ARRAY FUNCTIONS For dictionary by TempodiBasic
' https://qb64phoenix.com/forum/showthread.php?tid=1547
' ****************************************************************************************************************************************************************

' this function returns the value linked to the index IND
' in the table TempodiIndex
Function GetValue$ (ind As String, Inda As DictionaryType)
    Dim inx
    inx = GetIndex(ind)
    Inda.intValue = TempodiIndex(inx).intValue
    Inda.lngValue = TempodiIndex(inx).lngValue
    Inda.strValue = TempodiIndex(inx).strValue
    Inda.IsDeleted = TempodiIndex(inx).IsDeleted
    GetValue$ = TempodiIndex(inx).strValue
End Function ' GetValue$

' this subroutine stores a value VALU linked to the index IND
' in the hashtable HASH
' In this implementation the SUB overwrites the previouse value
' stored into the hashtable if it happens a collision
' but this behaviour can be easily changed for storing the new value
' or in OPEN (searching the next cell with no value into it)
' or in list adding the value to the string already staying in hashtable
Sub StoreValue (ind As String, valu As DictionaryType)
    Dim inx
    inx = GetIndex(ind)
    TempodiIndex(inx).key = ind
    TempodiIndex(inx).strValue = valu.strValue
    TempodiIndex(inx).intValue = valu.intValue
    TempodiIndex(inx).lngValue = valu.lngValue
    TempodiIndex(inx).IsDeleted = FALSE
End Sub ' StoreValue

' this function calculates the Hash value for storing
' the linked value in the hashtable
Function GetIndex% (ind As String)
    Dim a As Integer
    Dim k As _Integer64
    Dim hash As _Integer64
    k = 1
    For a = 1 To Len(ind)
        hash = hash + ((Asc(ind, a)) * k)
        'k = k * 10
        k = k * 1000
    Next a
    'GetIndex% = hash Mod 10
    GetIndex% = hash Mod 1000
End Function ' GetIndex%


Function DeleteItem (key$)
    DeleteItem = FALSE
    Dim Inx
    Inx = GetIndex%(key$)
    If Inx > -1 Then TempodiIndex(Inx).IsDeleted = TRUE Else Exit Function
    DeleteItem = TRUE
End Function

' ****************************************************************************************************************************************************************
' END ASSOCIATIVE ARRAY FUNCTIONS For dictionary by TempodiBasic
' ****************************************************************************************************************************************************************
$If EXTENDEDTIMER = UNDEFINED Then
    $Let EXTENDEDTIMER = TRUE

    Function ExtendedTimer##
        'modified extendedtimer to store the old day's count, and not have to recalculate it every time the routine is called.

        Static olds As _Float, old_day As _Float, oldt As _Float
        Dim m As Integer, d As Integer, y As Integer
        Dim s As _Float, day As String
        If olds = 0 Then 'calculate the day the first time the extended timer runs
            day = Date$
            m = Val(Left$(day, 2))
            d = Val(Mid$(day, 4, 2))
            y = Val(Right$(day, 4)) - 1970
            Select Case m 'Add the number of days for each previous month passed
                Case 2: d = d + 31
                Case 3: d = d + 59
                Case 4: d = d + 90
                Case 5: d = d + 120
                Case 6: d = d + 151
                Case 7: d = d + 181
                Case 8: d = d + 212
                Case 9: d = d + 243
                Case 10: d = d + 273
                Case 11: d = d + 304
                Case 12: d = d + 334
            End Select
            If (y Mod 4) = 2 And m > 2 Then d = d + 1 'add a day if this is leap year and we're past february
            d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
            d = d + (y + 2) \ 4 'add in days for leap years passed
            s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
            old_day = s
        End If
        If Timer < oldt Then 'we went from 23:59:59 (a second before midnight) to 0:0:0 (midnight)
            old_day = s + 83400 'add another worth of seconds to our counter
        End If
        oldt = Timer
        olds = old_day + oldt
        ExtendedTimer## = olds
    End Function ' ExtendedTimer##
$End If

as you run the code, you will notice that the IDCheck function makes very slower the code from the usage without IDCheck as this screenshot shows.








now it lasts to code FUNCTIONs for overwriting an item (hash key is duplicated: overwrite or discharge data?), appending an item to the same  hash key or shifting data to the next unused hash key.
Following the APPEND way we need the Join and Split string functions and the conversion Int2Str, Str2Int, Lng2Str, Str2Lng functions.
Following the SHIFTING way we need a SearchUnusedItem and the FindShiftedData functions.

If it is almost interesting, I will post the other 2 ways with  correlate functions the next time.
Thank you for feedbacks