Хеш таблица (словарь)
Это что-то похожее на хеш таблицу. На самом деле , в реальной хеш таблице хешируется и ячейка где располагаются данные и ключ. Так же в хеш таблице учитывается безопасность , путем например случайной функции хеширования. Так же в основном хеш таблицы хранят только указатели на данные. А сами данные (их размещение и очистка) контролируются отдельными механизмами. Хеш функция выполняет только механизм индексации.
В моем варианте:
1) хешируется только ячейка , где содержатся данные
для более быстрого доступа.
2) ключ хранится в хеш таблице как он
есть и идет строковое сравнение ключей при доступе. Это конечно увеличивает
время доступа к ячейке , но надежно.
3) данные так же хранятся в таблице ,
хотя есть возможность хранить только указатели.
4) функция
хеширования на данный момент не меняется и не думаю , что это мне
нужно. Ведь я создавал эту релизацию не для серверов и не для защиты информации.
Мне нужен был просто более быстрый механизм хранения данных , чем например
дерево или связанный список.
5) есть несколько оберток для более удобного
использования , но методы add и get лучше
выполнять напрямую и в примерах ниже я покажу как это делать.
6) Ключ
соотвествует типу HASHTYPEKEY и может может иметь тип Zstring или
Wstring (указывается в самой реализации хеш таблицы в самом
начале)
7) Данные соответствуют типу HASHTYPEVALUE и могут быть
любого типа. Тип по умолчанию - Zstring. Если HASHTYPEVALUE имеет тип ANY, то в
таблице хранится только указатель. Если HASHTYPEVALUE другого типа, то
сохраняются данные по указателю. В таблице без проблем сохраняются данные для
встроенных типов FreeBasic, кроме STRING. Вместо типа STRING используйте Zstring
Ptr. В таблице также могут храниться данные пользовательских типов,
но корректность данных будет только в том случае, если их
размер вычисляется во время компиляции.
Сам код моей реализации:
'-------- set type for key and value ----- Type HASHTYPEKEY As Zstring Type HASHTYPEVALUE As Zstring '----------------------------------------- Extern "C" Declare Function crt_memcpy Alias "memcpy"(As Any Ptr,As Any Ptr, As Integer) As Any Ptr End Extern Type THASHDATA pszKey As HASHTYPEKEY Ptr = 0 pszValue As HASHTYPEVALUE Ptr = 0 End Type Type TLIST Extends THASHDATA As TList Ptr p = 0 End Type Type TGLLIST As TList Ptr pFirst = 0 As TList Ptr pEnd = 0 Declare Sub add_last (pszKey As HASHTYPEKEY Ptr , pszValue As HASHTYPEVALUE Ptr) Declare Sub delete_element (pszKey As HASHTYPEKEY Ptr) Declare Function get_element ( pszKey As HASHTYPEKEY Ptr) As TList Ptr End Type Sub TGLLIST.add_last (pszKey As HASHTYPEKEY Ptr , pszValue As HASHTYPEVALUE Ptr) Dim As TList Ptr nw = Allocate(Sizeof(TList)) If nw = 0 Then Exit Sub nw->pszKey = pszKey nw->pszValue = pszValue nw->p = 0 If pFirst = 0 Then pFirst = nw pEnd = pFirst Else pEnd->p = nw pEnd = nw Endif End Sub Sub TGLLIST.delete_element (pszKey As HASHTYPEKEY Ptr) Dim As TList Ptr pTemp = pFirst, pTempOld pTempOld = pTemp While pTemp If *(pTemp->pszKey) = *pszKey Then If pTemp->p <> 0 Then If pTemp = pFirst Then pFirst = pTemp->p Else pTempOld->p = pTemp->p Endif Else If pTemp = pFirst Then pFirst = 0 pEnd = 0 Else pTempOld->p = 0 pEnd = pTempOld Endif Endif Deallocate(pTemp->pszKey) #IF Typeof(HASHTYPEVALUE) = Typeof(Any) #ELSE Deallocate(pTemp->pszValue) #ENDIF Deallocate(pTemp) Exit While Endif pTempOld = pTemp pTemp = pTemp->p Wend End Sub Function TGLLIST.get_element ( pszKey As HASHTYPEKEY Ptr) As TList Ptr Dim As TList Ptr pTemp = pFirst Dim As Long iLen = Len(*pszKey) While pTemp If Len(*(pTemp->pszKey)) = iLen Andalso *(pTemp->pszKey) = *pszKey Then Return pTemp Endif pTemp = pTemp->p Wend End Function Type THASHITEM Extends THASHDATA pList As TGLLIST Ptr iFdelete As Long End Type Type THASHTABLE pArray As THASHITEM Ptr iCountItem As Ulong iSize As Ulong Declare Sub delete_item(pszKey As HASHTYPEKEY Ptr) Declare Sub clear_table() Declare Sub free_table() Declare Sub Add(pszKey As HASHTYPEKEY Ptr , pszValue As HASHTYPEVALUE Ptr) Declare Sub add_rehash(pNew As THASHITEM Ptr , pszKey As HASHTYPEKEY Ptr , pszValue As HASHTYPEVALUE Ptr) Declare Function get_value(pszKey As HASHTYPEKEY Ptr) As HASHTYPEVALUE Ptr Declare Function hash_horner(psz As HASHTYPEKEY Ptr) As Long Declare Sub rehash() End Type Sub THASHTABLE.delete_item(pszKey As HASHTYPEKEY Ptr) Dim As Long iIndex = hash_horner(pszKey) If pArray[iIndex].pszKey Then If pArray[iIndex].iFdelete = 0 Andalso *(pArray[iIndex].pszKey) = *pszKey Then Deallocate(pArray[iIndex].pszKey) #IF Typeof(HASHTYPEVALUE) = Typeof(Any) #ELSE Deallocate(pArray[iIndex].pszValue) #ENDIF pArray[iIndex].iFdelete = 1 Else If pArray[iIndex].pList Then pArray[iIndex].pList->delete_element(pszKey) Endif Endif iCountItem-=1 If iCountItem*4 < iSize Then rehash() Endif Endif End Sub Sub THASHTABLE.clear_table() For i As Long = 0 To iSize If pArray[i].pszKey Then If pArray[i].iFdelete = 0 Then Deallocate(pArray[i].pszKey) #IF Typeof(HASHTYPEVALUE) = Typeof(Any) #ELSE Deallocate(pArray[i].pszValue) #ENDIF pArray[i].pszKey = 0 pArray[i].pszValue = 0 Endif If pArray[i].pList Then Dim As TList Ptr pTemp , pTemp2 pTemp = pArray[i].pList->pFirst pTemp2 = pArray[i].pList->pFirst While pTemp pTemp2 = pTemp->P Deallocate(pTemp->pszKey) #IF Typeof(HASHTYPEVALUE) = Typeof(Any) #ELSE Deallocate(pTemp->pszValue) #ENDIF Deallocate(pTemp) pTemp = pTemp2 Wend Deallocate(pArray[i].pList) pArray[i].pList = 0 Endif Endif Next iCountItem = 0 rehash() End Sub Sub THASHTABLE.free_table() Deallocate(pArray) End Sub Sub THASHTABLE.Add(pszKey As HASHTYPEKEY Ptr , pszValue As HASHTYPEVALUE Ptr) If pszKey = 0 Orelse pszValue = 0 Then ? "Invalidate value!" Exit Sub Endif If iCountItem > (iSize Shr 1) Andalso iCountItem < 32770 Then reHash() Endif Dim As Long iIndex = hash_horner(pszKey) If pArray[iIndex].pszKey = 0 Orelse pArray[iIndex].iFdelete Then pArray[iIndex].pszKey = Allocate((Len(*pszKey)+1)*Sizeof(HASHTYPEKEY)) *(pArray[iIndex].pszKey) = *pszKey #IF Typeof(HASHTYPEVALUE) = Typeof(Any) pArray[iIndex].pszValue = pszValue #ELSEIF Typeof(HASHTYPEVALUE) = Typeof(Wstring) pArray[iIndex].pszValue = Allocate((Len(*pszValue)+1)*Sizeof(HASHTYPEVALUE)) *(pArray[iIndex].pszValue) = *pszValue #ELSEIF Typeof(HASHTYPEVALUE) = Typeof(Zstring) pArray[iIndex].pszValue = Allocate((Len(*pszValue)+1)*Sizeof(HASHTYPEVALUE)) *(pArray[iIndex].pszValue) = *pszValue #ELSE pArray[iIndex].pszValue = Allocate(Sizeof(HASHTYPEVALUE)) crt_memcpy(pArray[iIndex].pszValue , pszValue , Sizeof(HASHTYPEVALUE)) #ENDIF If pArray[iIndex].iFdelete Then pArray[iIndex].iFdelete = 0 Else If *(pArray[iIndex].pszKey) = *pszKey Then #IF Typeof(HASHTYPEVALUE) = Typeof(Zstring) *(pArray[iIndex].pszValue) = *pszValue #ELSEIF Typeof(HASHTYPEVALUE) = Typeof(Wstring) *(pArray[iIndex].pszValue) = *pszValue #ELSEIF Typeof(HASHTYPEVALUE) = Typeof(Any) pArray[iIndex].pszValue = pszValue #ELSE crt_memcpy(pArray[iIndex].pszValue , pszValue , Sizeof(HASHTYPEVALUE)) #ENDIF Exit Sub Endif If pArray[iIndex].pList = 0 Then pArray[iIndex].pList = Callocate(Sizeof(TGLLIST)) Endif Dim As HASHTYPEKEY Ptr pTempKey = Allocate((Len(*pszKey)+1)*Sizeof(HASHTYPEKEY)) *pTempKey = *pszKey #IF Typeof(HASHTYPEVALUE) = Typeof(Any) pArray[iIndex].pList->add_last(pTempKey , pszValue) #ELSEIF Typeof(HASHTYPEVALUE) = Typeof(Wstring) Dim As HASHTYPEVALUE Ptr pTempValue = Allocate((Len(*pszValue)+1)*Sizeof(HASHTYPEVALUE)) *pTempValue = *pszValue pArray[iIndex].pList->add_last(pTempKey , pTempValue) #ELSEIF Typeof(HASHTYPEVALUE) = Typeof(Zstring) Dim As HASHTYPEVALUE Ptr pTempValue = Allocate((Len(*pszValue)+1)*Sizeof(HASHTYPEVALUE)) *pTempValue = *pszValue pArray[iIndex].pList->add_last(pTempKey , pTempValue) #ELSE Dim As HASHTYPEVALUE Ptr pTempValue = Allocate(Sizeof(HASHTYPEVALUE)) crt_memcpy(pTempValue , pszValue , Sizeof(HASHTYPEVALUE)) pArray[iIndex].pList->add_last(pTempKey , pTempValue) #ENDIF Endif iCountItem+=1 End Sub Sub THASHTABLE.add_rehash(pNew As THASHITEM Ptr , pszKey As HASHTYPEKEY Ptr , pszValue As HASHTYPEVALUE Ptr) Dim As Long iIndex = hash_horner(pszKey) If pNew[iIndex].pszKey = 0 Then pNew[iIndex].pszKey = pszKey pNew[iIndex].pszValue = pszValue Else If pNew[iIndex].pList = 0 Then pNew[iIndex].pList = Callocate(Sizeof(TGLLIST)) Endif pNew[iIndex].pList->add_last(pszKey , pszValue) Endif End Sub Function THASHTABLE.get_value(pszKey As HASHTYPEKEY Ptr) As HASHTYPEVALUE Ptr If pszKey = 0 Then ? "Invalidate value!" Return 0 Endif Dim As Long iIndex = hash_horner(pszKey) If (pArray[iIndex].pszKey Andalso pArray[iIndex].iFdelete = 0) Andalso *(pArray[iIndex].pszKey) = *pszKey Then Return pArray[iIndex].pszValue Else If pArray[iIndex].pList Then Dim As TList Ptr p = pArray[iIndex].pList->get_element(pszKey) If p Then Return p->pszValue Else Return 0 Endif Endif Endif End Function Function THASHTABLE.hash_horner(psz As HASHTYPEKEY Ptr) As Long Dim As Ulong iResult For i As Long = 0 To Len(*psz)-1 iResult = (11 * iResult + (*psz)[i]) Next Return iResult Mod iSize End Function Sub THASHTABLE.rehash() Dim As Long iOldSize = iSize If iCountItem > 32768 Then iSize = 131072 Elseif iCountItem > 16384 Then iSize = 65536 Elseif iCountItem > 8192 Then iSize = 32768 Elseif iCountItem > 4096 Then iSize = 16384 Elseif iCountItem > 2048 Then iSize = 8192 Elseif iCountItem > 1024 Then iSize = 4096 Elseif iCountItem > 512 Then iSize = 2048 Elseif iCountItem > 256 Then iSize = 1024 Elseif iCountItem > 128 Then iSize = 512 Elseif iCountItem > 64 Then iSize = 256 Elseif iCountItem > 32 Then iSize = 128 Elseif iCountItem > 16 Then iSize = 64 Endif Dim As THASHITEM Ptr pNew = Callocate(Sizeof(THASHITEM)*(iSize+4)) For i As Long = 0 To iOldSize If pArray[i].pszKey Then If pArray[i].iFdelete = 0 Then add_rehash(pNew , pArray[i].pszKey , pArray[i].pszValue) Endif If pArray[i].pList Then Dim As TLIST Ptr pTemp = pArray[i].pList->pFirst , pTemp2 While pTemp add_rehash(pNew , pTemp->pszKey , pTemp->pszValue) pTemp2 = pTemp->P Deallocate(pTemp) pTemp = pTemp2 Wend Deallocate(pArray[i].pList) Endif Endif Next Deallocate(pArray) pArray = pNew End Sub Function HashTableCreate() As Any Ptr Dim p As THASHTABLE Ptr = Allocate(Sizeof(THASHTABLE)) p->iCountItem = 0 p->iSize = 64 p->pArray = Callocate(Sizeof(THASHITEM)*(p->iSize+4)) Return p End Function Sub HashTableAdd(pTable As Any Ptr, pKey As HASHTYPEKEY Ptr , pValue As HASHTYPEVALUE Ptr) Cast(THASHTABLE Ptr , pTable)->Add(pKey , pValue) End Sub Function HashTableGet(pTable As Any Ptr, pKey As HASHTYPEKEY Ptr) As HASHTYPEVALUE Ptr Return Cast(THASHTABLE Ptr , pTable)->get_value(pKey) End Function Sub HashTableDeleteItem(pTable As Any Ptr, pKey As HASHTYPEKEY Ptr) Cast(THASHTABLE Ptr , pTable)->delete_item(pKey) End Sub Sub HashTableClear(pTable As Any Ptr) Cast(THASHTABLE Ptr , pTable)->clear_table() End Sub Sub HashTableFree(pTable As Any Ptr) Cast(THASHTABLE Ptr , pTable)->free_table() End Sub Function HashTableSize(pTable As Any Ptr) As Long Return Cast(THASHTABLE Ptr , pTable)->iSize End Function Function HashTableCount(pTable As Any Ptr) As Long Return Cast(THASHTABLE Ptr , pTable)->iCountItem End Function
Теперь примеры:
Пример 1 (полностью с обертками)
По умолчанию
тип для ключа и данных zstring. Если в самом верху реализации , вы замените
строки:
Type HASHTYPEKEY As Zstring
Type HASHTYPEVALUE As
Zstring
так:
Type HASHTYPEKEY As Wstring
Type HASHTYPEVALUE As
Wstring
тогда можно будет использовать строки UNICODE. Причем вы можете
для ключа оставить тип ZSTRING , а для данных WSTRING или
наоборот.
Dim As Any Ptr pTable = HashTableCreate() For i As Long = 0 To 10 HashTableAdd(pTable , "Key" & i , "Value" & i) Next ? ? "Items count="; HashTableCount(pTable) ? For i As Long = 0 To 10 ? *HashTableGet(pTable , "Key" & i) Next ? ? "delete Key5" HashTableDeleteItem(pTable , "Key5") ? ? "Items count="; HashTableCount(pTable) ? For i As Long = 0 To 10 ? *HashTableGet(pTable , "Key" & i) Next HashTableClear(pTable) HashTableFree(pTable) Sleep
пример 2 (тоже самое , но методы add и get вызываются напрямую ;
чуточку , но работает быстрее):
Dim As THASHTABLE Ptr pTable = HashTableCreate() For i As Long = 0 To 10 pTable->Add("Key" & i , "Value" & i) Next ? ? "Items count="; HashTableCount(pTable) ? For i As Long = 0 To 10 ? *pTable->get_value("Key" & i) Next ? ? "delete Key5" pTable->delete_item("Key5") ? ? "Items count="; pTable->iCountItem ? For i As Long = 0 To 10 ? *pTable->get_value("Key" & i) Next HashTableClear(pTable) HashTableFree(pTable) Sleep
Пример 3
В самом верху реализации таблицы пропишите это:
'-------- set type for key and value ----- Type MYTYPE As zstring*10 zs As Long i End Type Type HASHTYPEKEY As Zstring Type HASHTYPEVALUE As MYTYPE '-----------------------------------------И далее сам пример:
Dim As THASHTABLE Ptr pTable = HashTableCreate() Scope Dim As MYTYPE mp mp.zs = "one" mp.i = 10 pTable->Add("Key1" , @mp ) mp.zs = "two" mp.i = 20 pTable->Add("Key2" , @mp ) End Scope For i As Long = 1 To 2 Dim As MYTYPE Ptr p = pTable->get_value("Key" & i) ? p->zs ? p->i Next HashTableClear(pTable) HashTableFree(pTable) Sleep
Пример 4
В самом верху реализации таблицы пропишите это:
'-------- set type for key and value ----- Type HASHTYPEKEY As Zstring Type HASHTYPEVALUE As Any '-----------------------------------------
И далее сам пример (данные не копируются в таблицу , только указатели на данные):
Dim As THASHTABLE Ptr pTable = HashTableCreate() Dim As Long m(3) = {1,2,3,4} For i As Long = 0 To 3 pTable->Add("Key" & i , @m(i)) Next For i As Long = 0 To 3 Dim As Long Ptr p = pTable->get_value("Key" & i) ? *p Next HashTableClear(pTable) HashTableFree(pTable) Sleep
