С помощью нейросети создал алгоритм Radix Tree. Понадобилось некоторое количество перезапросов и также некоторая личная оптимизация, но в целом, это рабочий вариант. Вариант работает примерно в два раза медленнее, чем в PB IDE, и требует глубокой оптимизации. Но, это рабочий вариант, применять можно:
Код:
; Название .: Radix Tree
; Авторы ...: AI + Webarion(корректировка, наставление, оптимизация)
; Лицензия .: Абсолютно свободно
DeclareModule RTAI
;- Structures
Structure RadixNode
*Child.RadixNode
*Next.RadixNode
*Value
Pref$
EndStructure
;- Declares
Declare New()
Declare Set( *Root.RadixNode, Key$, *Value )
Declare Get( *Root.RadixNode, Key$ )
Declare FindPrefix( *Root.RadixNode, Prefix$, List Key$() )
Declare CountKeys( *Node.RadixNode )
Declare GetAllKeys( *Root.RadixNode, List Key$() )
Declare DeleteKey( *Root.RadixNode, Key$ )
Declare DeleteAllKeys( *Root.RadixNode )
EndDeclareModule
Module RTAI
;- ПРИВАТНЫЕ ВНУТРЕННИЕ ПРОЦЕДУРЫ
; Функция для нахождения минимального из двух чисел
Procedure _Min(a.i, b.i)
If a < b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
; Создание нового узла, для внутреннего использования
Procedure _New( Key$ = "", *Value = 0 )
Protected *Node.RadixNode = AllocateStructure(RadixNode)
*Node\Pref$ = Key$
*Node\Value = *Value
ProcedureReturn *Node
EndProcedure
; Рекурсивная процедура для сбора всех ключей, начиная с заданного узла
Procedure _CollectKeys(*Node.RadixNode, CurrentPrefix$, List Key$())
If *Node = #Null
ProcedureReturn
EndIf
; Формируем полный префикс для текущего узла
Protected FullPrefix$ = CurrentPrefix$ + *Node\Pref$
; Если текущий узел является концом ключа, добавляем его в список
If *Node\Value <> 0
AddElement(Key$())
Key$() = FullPrefix$
EndIf
; Рекурсивно обходим дочерние узлы
Protected *Child.RadixNode = *Node\Child
While *Child <> #Null
_CollectKeys( *Child, FullPrefix$, Key$() )
*Child = *Child\Next
Wend
EndProcedure
;- ПОЛЬЗОВАТЕЛЬСКИЕ ПРОЦЕДУРЫ
; Создание нового узла
Procedure New()
ProcedureReturn _New()
EndProcedure
; Вставка строки в Radix Tree (оптимизированная)
Procedure Set( *Root.RadixNode, Key$, *Value )
If Not *Root
DebuggerError("Not Root Radix Tree")
ProcedureReturn #Null
EndIf
Protected *Current.RadixNode = *Root
Key$ = LCase(Key$)
Protected i = 1, n = Len(Key$)
While i <= n
; Поиск совпадающего дочернего узла
Protected *Child.RadixNode = *Current\Child
Protected *PrevChild.RadixNode = #Null
Protected Found = #False
While *Child
; Поиск общего префикса
Protected CommonLen = 0
Protected MinLen = _Min(Len(*Child\Pref$), n - i + 1)
While CommonLen < MinLen And Mid(*Child\Pref$, CommonLen + 1, 1) = Mid(Key$, i + CommonLen, 1)
CommonLen + 1
Wend
If CommonLen > 0
Found = #True
; Если общий префикс меньше длины строки в узле, разделяем узел
If CommonLen < Len(*Child\Pref$)
Protected *NewChild.RadixNode = _New( Mid(*Child\Pref$, CommonLen + 1) )
*NewChild\Child = *Child\Child
*NewChild\Value = *Child\Value
*Child\Pref$ = Left(*Child\Pref$, CommonLen)
*Child\Child = *NewChild
*Child\Value = 0
EndIf
; Переходим к следующему символу
i + CommonLen
*Current = *Child
Break
EndIf
*PrevChild = *Child
*Child = *Child\Next
Wend
; Если совпадений не найдено, создаем новый узел
If Not Found
Protected *NewNode.RadixNode = _New( Mid(Key$, i), *Value )
If *PrevChild = #Null
*Current\Child = *NewNode
Else
*PrevChild\Next = *NewNode
EndIf
Break
EndIf
Wend
; Если ключ полностью совпал с текущим узлом, обновляем значение
If i > n
*Current\Value = *Value
EndIf
EndProcedure
; Поиск строки в Radix Tree (оптимизированный)
Procedure Get( *Root.RadixNode, Key$ )
If *Root = #Null
ProcedureReturn 0
EndIf
Protected *Current.RadixNode = *Root
Protected i.i = 1
Protected n.i = Len(Key$)
While i <= n
Protected *Child.RadixNode = *Current\Child
Protected Found.i = #False
While *Child <> #Null
; Поиск общего префикса
Protected CommonLen.i = 0
Protected MinLen.i = _Min(Len(*Child\Pref$), n - i + 1)
While CommonLen < MinLen And Mid(*Child\Pref$, CommonLen + 1, 1) = Mid(Key$, i + CommonLen, 1)
CommonLen + 1
Wend
If CommonLen > 0
Found = #True
i + CommonLen
*Current = *Child
Break
EndIf
*Child = *Child\Next
Wend
If Not Found
ProcedureReturn 0
EndIf
Wend
If *Current\Value <> 0
ProcedureReturn *Current\Value
Else
ProcedureReturn 0
EndIf
EndProcedure
; Поиск всех ключей по префиксу (исправленный)
Procedure FindPrefix( *Root.RadixNode, Prefix$, List Key$() )
If *Root = #Null
ProcedureReturn
EndIf
Protected *Current.RadixNode = *Root
Protected i.i = 1
Protected n.i = Len(Prefix$)
; Поиск узла, соответствующего префиксу
While i <= n
Protected *Child.RadixNode = *Current\Child
Protected Found.i = #False
While *Child <> #Null
; Поиск общего префикса
Protected CommonLen.i = 0
Protected ChildLen.i = Len(*Child\Pref$)
Protected MinLen.i = _Min(ChildLen, n - i + 1)
; Быстрое сравнение символов
While CommonLen < MinLen And Mid(*Child\Pref$, CommonLen + 1, 1) = Mid(Prefix$, i + CommonLen, 1)
CommonLen + 1
Wend
If CommonLen > 0
Found = #True
i + CommonLen
*Current = *Child
Break
EndIf
*Child = *Child\Next
Wend
If Not Found
ProcedureReturn
EndIf
Wend
; Сбор всех ключей, начиная с найденного узла
ClearList( Key$() )
_CollectKeys(*Current, "", Key$())
EndProcedure
; Процедура для получения всех ключей из Radix Tree
Procedure GetAllKeys( *Root.RadixNode, List Key$() )
If *Root = #Null
ProcedureReturn
EndIf
; Начинаем сбор ключей с корневого узла и пустого префикса
ClearList( Key$() )
_CollectKeys( *Root, "", Key$() )
EndProcedure
; Удаление ключа из Radix Tree
Procedure DeleteKey(*Root.RadixNode, Key$)
If *Root = #Null
ProcedureReturn #False
EndIf
Protected *Current.RadixNode = *Root
Protected i.i = 1
Protected n.i = Len(Key$)
; Поиск узла, соответствующего ключу
While i <= n
Protected *Child.RadixNode = *Current\Child
Protected *PrevChild.RadixNode = #Null
Protected Found.i = #False
While *Child <> #Null
; Поиск общего префикса
Protected CommonLen.i = 0
Protected MinLen.i = _Min(Len(*Child\Pref$), n - i + 1)
While CommonLen < MinLen And Mid(*Child\Pref$, CommonLen + 1, 1) = Mid(Key$, i + CommonLen, 1)
CommonLen + 1
Wend
If CommonLen > 0
Found = #True
i + CommonLen
*PrevChild = *Current
*Current = *Child
Break
EndIf
*PrevChild = *Child
*Child = *Child\Next
Wend
If Not Found
ProcedureReturn #False
EndIf
Wend
; Если ключ найден, удаляем его значение
If *Current\Value <> 0
*Current\Value = 0
; Если узел больше не имеет дочерних элементов и не является концом ключа, удаляем его
If *Current\Child = #Null
If *PrevChild <> #Null
If *PrevChild\Child = *Current
*PrevChild\Child = *Current\Next
Else
Protected *Sibling.RadixNode = *PrevChild\Child
While *Sibling\Next <> *Current
*Sibling = *Sibling\Next
Wend
*Sibling\Next = *Current\Next
EndIf
FreeStructure(*Current)
EndIf
EndIf
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
; Удаление всех ключей из Radix Tree
Procedure DeleteAllKeys(*Root.RadixNode)
If *Root = #Null
ProcedureReturn
EndIf
; Рекурсивное удаление всех дочерних узлов
Protected *Child.RadixNode = *Root\Child
While *Child <> #Null
Protected *NextChild.RadixNode = *Child\Next
DeleteAllKeys(*Child)
FreeStructure(*Child)
*Child = *NextChild
Wend
; Очистка текущего узла
*Root\Child = #Null
*Root\Next = #Null
*Root\Value = #Null
EndProcedure
; Подсчёт всех ключей в Radix Tree
Procedure CountKeys(*Node.RadixNode)
If *Node = #Null
ProcedureReturn 0
EndIf
Protected Count.i = 0
; Если текущий узел является концом ключа, увеличиваем счётчик
If *Node\Value <> 0
Count + 1
EndIf
; Рекурсивно обходим дочерние узлы
Protected *Child.RadixNode = *Node\Child
While *Child <> #Null
Count + CountKeys(*Child)
*Child = *Child\Next
Wend
ProcedureReturn Count
EndProcedure
EndModule
;- ПРИМЕР
CompilerIf #PB_Compiler_IsMainFile
Define *Root = RTAI::New()
RTAI::Set(*Root, "apple", 1)
RTAI::Set(*Root, "app", 2)
RTAI::Set(*Root, "application", 3)
RTAI::Set(*Root, "banana", 4)
RTAI::Set(*Root, "band", 5)
; Подсчёт всех ключей
Debug "Количество ключей: " + Str( RTAI::CountKeys(*Root) )
Debug "------------------------------------------------------------------"
Debug "Данные ключа 'application': " + RTAI::Get( *Root, "application" )
Debug "------------------------------------------------------------------"
Define NewList Key$()
Debug "Перебор всех ключей:"
RTAI::GetAllKeys( *Root, Key$() )
ForEach Key$()
Debug " Ключ: " + Key$() + " = " + RTAI::Get( *Root, Key$() )
Next
Debug "------------------------------------------------------------------"
; Поиск ключей по префиксу app
RTAI::FindPrefix( *Root, "app", Key$() )
Debug "Поиск по префиксу app:"
; Вывод найденных ключей
ForEach Key$()
Debug " Найден ключ: " + Key$()
Next
Debug "------------------------------------------------------------------"
; Поиск ключей по префиксу ba
Define NewList Key$()
RTAI::FindPrefix( *Root, "ba", Key$() )
Debug "Поиск по префиксу ba:"
; Вывод найденных ключей
ForEach Key$()
Debug " Найден ключ: " + Key$()
Next
Debug "------------------------------------------------------------------"
; Удаление ключа "app"
If RTAI::DeleteKey(*Root, "app")
Debug "Ключ 'app' удален."
Else
Debug "Ключ 'app' не найден."
EndIf
Debug "Данные ключа 'app': " + RTAI::Get( *Root, "app" )
; Подсчёт всех ключей после удаления
Debug "Количество ключей после удаления: " + Str( RTAI::CountKeys(*Root) )
Debug "------------------------------------------------------------------"
; Удаление всех ключей
RTAI::DeleteAllKeys(*Root)
Debug "Все ключи удалены."
; Подсчёт всех ключей после полной очистки
Debug "Количество ключей после очистки: " + Str( RTAI::CountKeys(*Root) )
Debug "------------------------------------------------------------------"
CompilerEndIf
У меня есть и свой личный вариант, всё времени нет доделать, там пока ещё нет удаления ключа и не всё оптимизировано, но скорость не уступает версии PB IDE. По любому приятнее, создавать алгоритмы своей головой, это ценность творчества.