Если кратко, то бор — это один из самых эффективных способов хранения пар «ключ-значение». Чаще всего ключами выступают строки, но в качестве этих ключей можно использовать совершенно любую последовательность байт. Кроме как ассоциативного массива эту структуру можно использовать для установления факта присутствия/отсутствия заданного слова в словаре.
Представляю на суд публике свою реализацию бор'а на чистом Basic'е
Объявления
- Код: Выделить всё
Private Type WORD_NODE
nSibling As Long
fChild As Long
Char As Byte
Last As Byte ' выполняет роль флага о последней букве в слове
' Value as long ' для построения ассоциативного массива
End Type
Private TRIE() As WORD_NODE, ut As Long, nt As Long
Инициализация бор'a
- Код: Выделить всё
ut = 64: nt = 1
ReDim TRIE(ut)
TRIE(0).fChild = 1
TRIE(1).Char = 192 ' А
TRIE(1).Last = 1
Поиск
- Код: Выделить всё
Dim Level As Long
Dim prevFC As Long, FC As Long, WordPresent As Long
Dim inWord() As Byte, inLen As Long, i As Long
Text1.Text = UCase$(Text1.Text)
inLen = Len(Text1.Text)
inWord = StrConv(Text1.Text, vbFromUnicode)
FC = 1
WordPresent = 1
Do
If TRIE(FC).Char = inWord(Level) Then
' дочерний или соседний символ равен входному символу
prevFC = FC
VocPath(Level) = FC
FC = TRIE(FC).fChild
Level = Level + 1
Else
' поиск по соседям
If TRIE(FC).nSibling Then
' у этого уровня есть соседи
FC = TRIE(FC).nSibling
Else
WordPresent = 0
Exit Do
End If
End If
Loop Until Level = inLen
If WordPresent Then
If TRIE(prevFC).Last Then
MsgBox "Слово «" + Text1.Text + "» есть в словаре!", vbExclamation
Else
WordPresent = 0
GoTo 10
End If
Else
10 MsgBox "Слово «" + Text1.Text + "» отсутствует в словаре!", vbCritical
End If
Добавление
- Код: Выделить всё
Private Sub BuildTrie(FindWord As String)
Dim Level As Long
Dim prevFC As Long, FC As Long, fc2 As Long, WordPresent As Long
Dim inWord() As Byte, inLen As Long, i As Long
'Text1.Text = UCase$(Text1.Text)
inLen = Len(FindWord) 'Len(Text1.Text)
inWord = StrConv(FindWord, vbFromUnicode)
FC = 1
WordPresent = 1
Do
If TRIE(FC).Char = inWord(Level) Then
' дочерний или соседний символ равен входному символу
prevFC = FC
VocPath(Level) = FC
FC = TRIE(FC).fChild
Level = Level + 1
Else
' поиск по соседям
If TRIE(FC).nSibling Then
' у этого уровня есть соседи
FC = TRIE(FC).nSibling
Else
WordPresent = 0
Exit Do
End If
End If
Loop Until Level = inLen
fc2 = FC
If WordPresent Then
If TRIE(prevFC).Last Then
Else
WordPresent = 0
GoTo 10
End If
Else
10 ut = ut + (inLen - Level)
ReDim Preserve TRIE(ut)
If Level Then
FC = TRIE(VocPath(Level - 1)).fChild
If FC Then
' у последней совпадающей буквы есть потомок
' проверить на полное совпадение префикса с входным словом
i = 0
Do
If inWord(i) = TRIE(VocPath(i)).Char Then
i = i + 1
Else
Exit Do
End If
Loop Until i = inLen
If i = inLen Then
' самый простой случай добавления -
' префикс полностью существует
FC = VocPath(i - 1)
TRIE(FC).Last = 1
Exit Sub
'GoTo 20
End If
' первый отсутствующий символ префикса является чьим-то соседом
nt = nt + 1
TRIE(fc2).nSibling = nt
For i = Level To inLen - 2
TRIE(nt).Char = inWord(i)
TRIE(nt).fChild = nt + 1
nt = nt + 1
Next
TRIE(nt).Char = inWord(i)
TRIE(nt).Last = 1
Else
' нет потомков
FC = VocPath(Level - 1)
nt = nt + 1
TRIE(FC).fChild = nt
For i = Level To inLen - 2
TRIE(nt).Char = inWord(i)
TRIE(nt).fChild = nt + 1
nt = nt + 1
Next i
TRIE(nt).Char = inWord(i)
TRIE(nt).Last = 1
End If
Else
' нет префикса
' FC - результат основной проверки
nt = nt + 1
TRIE(FC).nSibling = nt
For i = 0 To inLen - 2
TRIE(nt).Char = inWord(i)
nt = nt + 1
TRIE(nt - 1).fChild = nt
Next
' описать последний символ
TRIE(nt).Char = inWord(i)
TRIE(nt).Last = 1
End If
' ' распечатка Бора после добавления
'20 Debug.Print "Last FC =" + Str$(FC)
'
' For i = 1 To nt
' Debug.Print i, _
' Chr$(TRIE(i).Char), _
' Chr$(TRIE(TRIE(i).fChild).Char) + " -" + Str$(TRIE(i).fChild), _
' Chr$(TRIE(TRIE(i).nSibling).Char) + " -" + Str$(TRIE(i).nSibling)
' Next
' Debug.Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
End If
Да, процедура добавления выглядит громоздко, но лучше я пока не придумал...
Кстати, по смыслу это очень похоже на Хакерское abandonware. Собственно с этого и появился живой интерес к этой проблеме. А недавно для моей программулины понадобился простенький spell checker, что сподвигло к написанию вышеизложенного кода...
