С помощью нейросети создал алгоритм 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. По любому приятнее, создавать алгоритмы своей головой, это ценность творчества.