Префиксное дерево, бор или trie

Алгоритмы, связанные с реализацией поиска информации.
pronto
Постоялец
Постоялец
 
Сообщения: 582
Зарегистрирован: 04.12.2005 (Вс) 6:20
Откуда: Владивосток

Префиксное дерево, бор или trie

Сообщение pronto » 11.08.2012 (Сб) 17:14

Доброго времени суток, уважаемые жители форума!

Если кратко, то бор — это один из самых эффективных способов хранения пар «ключ-значение». Чаще всего ключами выступают строки, но в качестве этих ключей можно использовать совершенно любую последовательность байт. Кроме как ассоциативного массива эту структуру можно использовать для установления факта присутствия/отсутствия заданного слова в словаре.

Представляю на суд публике свою реализацию бор'а на чистом 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, что сподвигло к написанию вышеизложенного кода...
O, sancta simplicitas!

pronto
Постоялец
Постоялец
 
Сообщения: 582
Зарегистрирован: 04.12.2005 (Вс) 6:20
Откуда: Владивосток

Re: Префиксное дерево, бор или trie

Сообщение pronto » 16.11.2012 (Пт) 17:46

Собрал бор из 137000 слов русского языка и примерчик работы с ним
Вложения
Corrector.rar
(1.36 МиБ) Скачиваний: 159
O, sancta simplicitas!

pronto
Постоялец
Постоялец
 
Сообщения: 582
Зарегистрирован: 04.12.2005 (Вс) 6:20
Откуда: Владивосток

Re: Префиксное дерево, бор или trie

Сообщение pronto » 09.01.2013 (Ср) 19:24

Недавно был обнаружен непозволительный баг, из-за которого некоторые слова не добавляются в бор. После некоторого напряга он был найден и устранён. Исправление не затронуло алгоритм поиска. Объявления остались прежними.
Инициализация бор'а
Код: Выделить всё
ut = 1024: nt = 1
ReDim TRIE(ut)

TRIE(0).fChild = 1

TRIE(1).Char = 192 ' А
TRIE(1).Last = 1


Добавление
Код: Выделить всё
Private Sub BuildTrie_v2(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
   
   inLen = Len(FindWord)
   inWord = StrConv(FindWord, vbFromUnicode)
   
   FC = 1
   WordPresent = 1
   
   Do
      If TRIE(FC).Char = inWord(Level) Then
         ' дочерний или соседний символ равен входному символу
         prevFC = FC
         
         Path(Level) = FC
         Level = Level + 1
         
         FC = TRIE(FC).fChild
         
      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
      GoTo 10
   End If
     
Else

   ' добавить в БОР
10 WordCount = WordCount + 1
   
   If nt + inLen > ut Then
      ut = ut * 2
      ReDim Preserve TRIE(ut)
   End If
   
   If Level Then
      '
      FC = TRIE(Path(Level - 1)).fChild
      If FC Then
         ' у последней совпавшей буквы есть потомок
         
         If Level = inLen Then
            ' самый простой случай - FULL_PREFIX
            TRIE(Path(Level - 1)).Last = 1
            Exit Sub
         End If
         
         ' случай SOME_PREFIX
         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
         ' случай APPEND_PREFIX
         FC = Path(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
         TRIE(nt).Char = inWord(i)
         TRIE(nt).Last = 1
         
      End If
     
   Else
      ' случай, аналогичный SOME_PREFIX
      ' 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
End If


Самое приятное — это то, что удалось ускорить процесс добавления более чем в 3(!) раза...
O, sancta simplicitas!

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16116
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: Префиксное дерево, бор или trie

Сообщение Хакер » 11.01.2013 (Пт) 8:38

Надо как-нибудь нам соревнования устроить :)
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Qwertiy
Доктор VB наук
Доктор VB наук
 
Сообщения: 2751
Зарегистрирован: 26.06.2011 (Вс) 21:26

Сообщение Qwertiy » 11.01.2013 (Пт) 10:52

Хакер писал(а):Надо как-нибудь нам соревнования устроить :)

Какие?

pronto
Постоялец
Постоялец
 
Сообщения: 582
Зарегистрирован: 04.12.2005 (Вс) 6:20
Откуда: Владивосток

Re: Префиксное дерево, бор или trie

Сообщение pronto » 11.01.2013 (Пт) 13:29

Было бы интересно, конечно, но я пас. Так как помню, как Хакер говорил про своё изобретение: «Принцип, который заложен в алогоритм, оптимален, т.е. быстрее уже некуда». Поэтому, можно провести сравнительное тестирование, но не соревнование... :)
O, sancta simplicitas!


Вернуться в Поиск

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1

    TopList