Code: Select all
; --------------------------------------------------------------------------------------------
; Copyright (c) Fantaisie Software. All rights reserved.
; Dual licensed under the GPL and Fantaisie Software licenses.
; See LICENSE and LICENSE-FANTAISIE in the project root for license information.
; --------------------------------------------------------------------------------------------
;
; Simple implementation of a compact prefix tree (radix tree) to store values ordered by a key
; with fast lookup of all values matching a specific key prefix.
;
; Only "insert" and "free" are implemented because that is all we need for our purposes.
; Deleting individual keys is not implemented for now.
;
; All keys are handled Case insensitive.
;
; проверить, что структура определена, для случая если код используется не как часть исходников IDE
; CompilerIf Not Defined(RadixNode, #PB_Structure) ; For local testing. Defined in Common.pb too
Structure RadixNode
Chars$ ; Incoming prefix for this node (stored in uppercase)
*Child.RadixNode ; First child node (if any)
*Next.RadixNode ; Next sibling node in same parent (single linked list, sorted by prefix)
*Value ; Stored value or null
EndStructure
Structure RadixTree
*Node ; First child of the root node (other children are under Child\Next). Null for an empty tree
EndStructure
#CharSize = 2
; CompilerEndIf
; Освободить узел
Procedure Radix_FreeNode(*Node.RadixNode)
While *Node
*Next = *Node\Next
Radix_FreeNode(*Node\Child)
FreeStructure(*Node)
*Node = *Next
Wend
EndProcedure
; Удалить дерево
Procedure RadixFree(*Tree.RadixTree)
Radix_FreeNode(*Tree\Node)
*Tree\Node = #Null
EndProcedure
; Возвращает RadixNode или null
;
Procedure RadixFindPrefix(*Tree.RadixTree, Prefix$, ExactMatchOnly = #False)
; Приведенный ниже алгоритм предполагает поиск хотя бы одного символа.
If Prefix$ = ""
ProcedureReturn #Null
EndIf
; Используйте LCase() вместо UCase(), чтобы обеспечить совместимость с внутренним сравнением без учета регистра PB. (https://www.purebasic.fr/english/viewtopic.php?p=615646)
PrefixL$ = LCase(Prefix$)
*PrefixCursor.Character = @PrefixL$
*Node.RadixNode = *Tree\Node
While *Node
*NodeCursor.Character = @*Node\Chars$
; Trie-инвариант: каждый дочерний элемент начинается с уникального персонажа, поэтому нам нужно только посмотреть на него.
;
If *PrefixCursor\c = *NodeCursor\c
; Узел соответствует первому символу. Сопоставьте дальнейшие символы в узле
*NodeCursor + #CharSize
*PrefixCursor + #CharSize
While *NodeCursor\c And *PrefixCursor\c And *NodeCursor\c = *PrefixCursor\c
*NodeCursor + #CharSize
*PrefixCursor + #CharSize
Wend
If *PrefixCursor\c = 0
; префикс полностью соответствует узлу
If ExactMatchOnly And *NodeCursor\c <> 0
ProcedureReturn #Null
Else
ProcedureReturn *Node
EndIf
ElseIf *NodeCursor\c = 0
; все символы съедены. продолжить поиск дочерних узлов
*Node = *Node\Child
Else
; разница в части узла. не совпадает
ProcedureReturn #Null
EndIf
ElseIf *NodeCursor\c < *PrefixCursor\c
; Посмотрите на следующий узел на том же уровне
*Node = *Node\Next
Else
; Совпадения больше невозможны, поскольку узлы отсортированы.
ProcedureReturn #Null
EndIf
Wend
; Достигнут конец списка дочерних узлов без совпадений, но несовпадающие символы префикса остаются.
ProcedureReturn #Null
EndProcedure
; Посмотреть значение
Procedure RadixLookupValue(*Tree.RadixTree, Name$)
*Result.RadixNode = RadixFindPrefix(*Tree, Name$, #True)
If *Result
ProcedureReturn *Result\Value
Else
ProcedureReturn #Null
EndIf
EndProcedure
; Заполняет значения первого и последнего совпадения префикса.
; Это полезно, если базовые данные также отсортированы и дерево хранит индексы, а не указатели.
;
Procedure RadixFindRange(*Tree.RadixTree, Prefix$, *First.INTEGER, *Last.INTEGER)
*First\i = #Null
*Last\i = #Null
*Result.RadixNode = RadixFindPrefix(*Tree, Prefix$, #False)
If *Result
; Все листовые узлы имеют непустые значения, но узлы в дереве тоже могут (если они соответствуют полному слову)
; Таким образом, первый непустой узел должен находиться на пути каждого первого дочернего узла *Result или самого *Result.
*FirstNode.RadixNode = *Result
While *FirstNode
If *FirstNode\Value
*First\i = *FirstNode\Value
Break
EndIf
*FirstNode = *FirstNode\Child
Wend
*Last\i = *First\i ; только в этом случае *Result совпадает
; Аналогично, последний непустой узел, который соответствует, должен находиться на пути каждого последнего дочернего узла.
; Однако не на первом уровне, поскольку указатели *Result\Next здесь указывают на узлы, не связанные с совпадением.
*LastNode.RadixNode = *Result\Child
While *LastNode
; skip to last child
While *LastNode\Next <> #Null
*LastNode = *LastNode\Next
Wend
If *LastNode\Value
*Last\i = *LastNode\Value
; без остановки. Любые дочерние элементы сортируются ПОСЛЕ этого узла, поэтому продолжайте искать.
EndIf
*LastNode = *LastNode\Child
Wend
If *First\i
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
; Вспомогательная функция
Procedure Radix_EnumerateNodes(*Node.RadixNode, List *Values())
While *Node
If *Node\Value
AddElement(*Values())
*Values() = *Node\Value
EndIf
Radix_EnumerateNodes(*Node\Child, *Values())
*Node = *Node\Next
Wend
EndProcedure
; найти все
Procedure RadixEnumerateAll(*Tree.RadixTree, List *Values())
ClearList(*Values())
Radix_EnumerateNodes(*Tree\Node, *Values())
EndProcedure
; найти по префиксу, то есть по началу слова
Procedure RadixEnumeratePrefix(*Tree.RadixTree, Name$, List *Values())
ClearList(*Values())
*Result.RadixNode = RadixFindPrefix(*Tree, Name$, #False)
If *Result
; Не смотрите на узлы \Next текущего узла, поскольку нам нужен только текущий узел и все, что ниже него.
If *Result\Value
AddElement(*Values())
*Values() = *Result\Value
EndIf
Radix_EnumerateNodes(*Result\Child, *Values())
EndIf
EndProcedure
; Вспомогательная функция
Procedure Radix_AllocNode(*PrefixCursor.Character, *Value)
*Node.RadixNode = AllocateStructure(RadixNode)
*Node\Chars$ = PeekS(*PrefixCursor, 0)
*Node\Value = *Value
ProcedureReturn *Node
EndProcedure
Procedure RadixInsert(*Tree.RadixTree, Name$, *Value)
If *Value = 0
ProcedureReturn
EndIf
; Используйте LCase() вместо UCase(), чтобы обеспечить совместимость с внутренним сравнением без учета регистра PB. (https://www.purebasic.fr/english/viewtopic.php?p=615646)
PrefixL$ = LCase(Name$)
*PrefixCursor.Character = @PrefixL$
If *Tree\Node = #Null
; Дерево пока пусто
*Tree\Node = Radix_AllocNode(*PrefixCursor, *Value)
Else
; Аналогично алгоритму в RadixFindPrefix().
*Node.RadixNode = *Tree\Node
*Parent.RadixNode = #Null
*Previous.RadixNode = #Null
While *Node
*NodeCursor.Character = @*Node\Chars$
If *PrefixCursor\c = *NodeCursor\c
*NodeCursor + #CharSize
*PrefixCursor + #CharSize
While *NodeCursor\c And *PrefixCursor\c And *NodeCursor\c = *PrefixCursor\c
*NodeCursor + #CharSize
*PrefixCursor + #CharSize
Wend
If *PrefixCursor\c = 0 And *NodeCursor\c = 0
; полное совпадение. не добавляйте дубликаты
If *Node\Value = 0
*Node\Value = *Value
EndIf
ProcedureReturn
ElseIf *NodeCursor\c = 0
; все символы съедены.
If *Node\Child
; продолжить поиск дочерних узлов
*Parent = *Node
*Previous = #Null
*Node = *Node\Child
Else
; Добавить дочерний узел
*Node\Child = Radix_AllocNode(*PrefixCursor, *Value)
ProcedureReturn
EndIf
ElseIf *PrefixCursor\c = 0
; Необходимо разделить узел, чтобы добавить значение (тот же префикс, что и у существующего узла)
*SplitNode.RadixNode = Radix_AllocNode(*NodeCursor, *Node\Value)
*SplitNode\Child = *Node\Child
*Node\Chars$ = Left(*Node\Chars$, Len(*Node\Chars$) - Len(*SplitNode\Chars$))
*Node\Value = *Value
*Node\Child = *SplitNode
ProcedureReturn
Else
; Необходимо разделить узел и добавить отдельный подузел, поскольку символы префикса и узла различаются.
NodeChar.c = *NodeCursor\c ; сохраните это, когда мы перераспределим строку
*SplitNode.RadixNode = Radix_AllocNode(*NodeCursor, *Node\Value)
*SplitNode\Child = *Node\Child
*NewNode.RadixNode = Radix_AllocNode(*PrefixCursor, *Value)
*Node\Chars$ = Left(*Node\Chars$, Len(*Node\Chars$) - Len(*SplitNode\Chars$)) ; делает недействительным *NodeCursor !
*Node\Value = #Null
If NodeChar < *PrefixCursor\c
*Node\Child = *SplitNode
*SplitNode\Next = *NewNode
Else
*Node\Child = *NewNode
*NewNode\Next = *SplitNode
EndIf
ProcedureReturn
EndIf
ElseIf *NodeCursor\c < *PrefixCursor\c
; Посмотрите на следующий узел на том же уровне
*Previous = *Node
*Node = *Node\Next
Else
; Совпадения больше невозможны, поскольку узлы отсортированы. Добавьте новый узел перед этим
*NewNode.RadixNode = Radix_AllocNode(*PrefixCursor, *Value)
*NewNode\Next = *Node
If *Previous
*Previous\Next = *NewNode
ElseIf *Parent
*Parent\Child = *NewNode
Else
*Tree\Node = *NewNode
EndIf
ProcedureReturn
EndIf
Wend
; Достигнут конец списка узлов. Добавьте сюда новый
; Должен быть узел *Previous, поскольку случай отсутствия дочерних элементов уже обработан выше.
*NewNode = Radix_AllocNode(*PrefixCursor, *Value)
*Previous\Next = *NewNode
EndIf
EndProcedure
;- ------ Отладка и тестирование ------
; CompilerIf #True
CompilerIf #False
Procedure DebugRadixGraph_Recursive(*Node.RadixNode, Spaces$, Parent$, *Selected.RadixNode, InSelection)
While *Node
NodeName$ = "n" + Hex(*Node)
If *Node\Value
Label$ = PeekS(*Node\Value, 0)
Else
Label$ = ""
EndIf
If *Node = *Selected
Debug Spaces$ + NodeName$ + ~" [label=\"" + Label$ + ~"\", color=\"red\"]"
ElseIf InSelection
Debug Spaces$ + NodeName$ + ~" [label=\"" + Label$ + ~"\", color=\"green\"]"
Else
Debug Spaces$ + NodeName$ + ~" [label=\"" + Label$ + ~"\"]"
EndIf
Debug Spaces$ + Parent$ + " -> " + NodeName$ + ~" [label=\"" + *Node\Chars$ + ~"\"]"
If *Node = *Selected
DebugRadixGraph_Recursive(*Node\Child, Spaces$ + " ", NodeName$, *Selected, #True)
Else
DebugRadixGraph_Recursive(*Node\Child, Spaces$ + " ", NodeName$, *Selected, InSelection)
EndIf
*Node = *Node\Next
Wend
EndProcedure
; Перейдите сюда, чтобы визуализировать график: https://dreampuf.github.io/GraphvizOnline
Procedure DebugRadixGraph(*Tree.RadixTree, *Selected.RadixNode = #Null)
Debug "digraph G {"
Debug ~" root [label=\"\"]"
DebugRadixGraph_Recursive(*Tree\Node, " ", "root", *Selected, #False)
Debug "}"
EndProcedure
XIncludeFile "ConstantsData.pbi"
NewList Names.s()
Restore BasicFunctionConstants
Repeat
Read$ x$
If x$ = ""
Break
EndIf
AddElement(Names())
Names() = StringField(x$, 1, ",")
ForEver
; Тестирование случайных вставок
RandomSeed(123)
RandomizeList(Names())
Define Tree.RadixTree
; Вставьте все имена функций
; ForEach Names()
; RadixInsert(Tree, Names(), PeekL(@Names(), 0)) ; сохранить фактическое имя как значение узла
; Next Names()
; Вставьте всего несколько имен
ResetList(Names())
For i = 1 To 25
NextElement(Names())
RadixInsert(Tree, Names(), PeekL(@Names(), 0))
Next i
; Тестовый просмотр/перечисление
NewList *Found()
;RadixEnumerateAll(Tree, *Found())
RadixEnumeratePrefix(Tree, "de", *Found())
ForEach *Found()
Debug PeekS(*Found(), 0)
Next
RadixFindRange(Tree, "de", @*First, @*Last)
Debug "First: " + PeekS(*First, 0) + " Last: " + PeekS(*Last, 0)
; Визуализируйте график
;DebugRadixGraph(Tree, RadixFindPrefix(Tree, "de"))
CompilerEndIf
#Window = 0
Enumeration
#Str
#Editor
EndEnumeration
Global Tree.RadixTree
Global NewList Dictionary.s()
; function is executed when the search input field changes
Procedure StrChange()
Protected Prefix$, i
Protected NewList *Found()
Debug 1234567890
Prefix$ = GetGadgetText(#Str)
; ClearList(*Found())
ClearGadgetItems(#Editor)
RadixEnumeratePrefix(Tree, Prefix$, *Found()) ; find by prefix, by the beginning of the entered text
i = 0
Debug i
ForEach *Found()
i + 1
Debug i
; Debug PeekS(*Found(), 0)
AddGadgetItem(#Editor , i , PeekS(*Found(), 0))
Next
EndProcedure
