PureBasic - форум

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » PureBasic - форум » OpenSource » Radix Tree AI


Radix Tree AI

Сообщений 1 страница 12 из 12

1

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

0

2

AZJIO написал(а):

На счёт скорости, там Mid() у тебя в цикле вызывается с шагом +1 берёт по одному символу, не лучше ли все эти переписать на "посимвольный разбор строки"?

Это же не у меня, а у нейросети) Я навёл марафет, привёл в работоспособное состояние, слегонца, кое-что подправил, создал модуль и изменил названия процедур на те, которые считаю более оптимальными. Протестировал, на своём графическом тестере (специально написал визуальный тестер, когда исследовал этот алгоритм.) Как и отметил, здесь нужна глубокая оптимизация. Считаю этот вариант интересным и достаточно компактным. Он работает. Думаю, что со временем и совместно, оптимизировать было бы неплохо. Свой вариант тоже выложу скоро и под свободной лицензией. Делаю, по мере возможностей, иногда бывает такое, что сразу много дел и отовсюду, из разных областей навалится.

0

3

AZJIO написал(а):

не лучше ли все эти переписать на "посимвольный разбор строки"?

Лучше и быстрее, непосредственно память анализировать, Mid, Left, Right - медленнее работают, но для этого надо многое там менять, оставив при этом основной "каркас", идею. Со временем сделаем, безусловно.

0

4

Webarion
Mid медленная потому что создаёт строковое представление данных, то есть требует манипуляции, в то время как обращение непосредственно к бинарным данным не конвертируя в строку естественно будет быстрее. К примеру "apple" берём первую букву, но не "a" а 97, литеральная 'a' является бинарным числом, вот мы и получаем прямой доступ по указателю используя *c\c и в дереве также должен быть доступ к элементам в бинарном виде, то есть от корня ищем 97 что является "a". Вроде логически понимаю, но как это записать в код пока не ясно.
Посмотри описание "посимвольный разбор"

0

5

Webarion
За основу можно взять этот алгоритм. Это создаёт дерево файлов, то есть структурно это копия дерева "Radix Tree" с разницей, что запрашиваются файлы файловой системы. Если представить "apple" как "a\p\p\l\e", то это и есть дерево. Разделитель нам ставить не нужно, мы проверяем если в дереве есть папка "a" то входим в неё и ищем в ней следующий элемент и продолжаем до тех пор, когда буквы не будет в узле, в этот момент мы добавляем элемент целиком остаток. Это полностью описывает работу функции.

Экспериментируя столкнулся с ситуацией. Например есть 2 слова
аббв
аббг
можно построить легким и неэкономным способом:
а->б->б->в|г
или сложным и быстрым для доступа
а->бб->в|г

Первый способ на каждую букву свой бинарный элемент структуры, даже если он пустой и лишь ссылается на следующую букву. При этом имея в нагрузку два указателя на списки.

Второй способ экономнее, имеет поле строку любой ширины, но при добавлении слова сложнее перестраивать список. Часть слов, которые в узле придётся перестроить, потому что вводимое слово перестраивает узел. Например добавим слово "абв" и нам придется убрать поле "бб"
а->б
->б->в|г
->с
тут надо уметь приатачить узел в|г с "бб" на "б", удалить "бб" добавив "б" и "с". В общем вроде рассуждать понятно, а вот сделать работающий алгоритм голову сломаешь.

Вот мои потуги, просто добавить слово с учётом его разбора там ещё думать и думать

Код:
Structure Tree
	s.s ; строка и снизу привязанные к ней узлы и элементы
	size.i ; размер элемента узла, а нужен ли, разве что для чтение с PeekS(), но s.s нультерминированная, поэтому size не нужен
	List item.s()   ; список остатков строки
	List node.Tree()	 ; узел (папка)
EndStructure


Procedure.q AddWord(*s.Tree, *c.Character) ; передали пустое дерево (изначально пустое) и слово
	Protected *n.Character
	If *s=0 Or *c=0 Or *c\c=0 ; проверка, дерево существует, указатель на слово существует, слово в указателе существует.
    ProcedureReturn
	EndIf
	
	If ListSize(*s\node())
    ForEach *s\node()
    	*n = @*s\node()\s ; получаем указатель на строку элемента списка узла
    	While *c\c And *n\c ; если оба ещё валидны, то делаем шаг дальше
        If *c\c <> *n\c	; если очередной символ не одинаков, то
        	Break
        EndIf
        *n\c + 2
        *c\c + 2
    	Wend
    	If *c\c = 0 And *n\c = 0
        ProcedureReturn ; слово уже есть, выпрыгиваем
    	ElseIf *c\c = 0
        ; если слово короче чем узел, то надо перестроить узел, взяв короткое слово за узел
    	ElseIf *n\c = 0
        ; если узел короче чем	слово, то добавляем остаток в item указанного node
        AddWord(*s\node(), *c.Character)
    	Else
;         Если выход по Break тогда разделяем узел
    	EndIf
    Next
	Else
    If ListSize(*s\item())
;     	Здесь должен быть алгоритм поиска возможности узла, но пока просто добавим слово
    	If AddElement(*s\item())
        *s\item() = PeekS(*c) ; считываем остаток слова
    	EndIf
    	
    	ForEach *s\item()
        *n = @*s\item() ; получаем указатель на строку элемента списка узла
        While *c\c And *n\c ; если оба ещё валидны, то делаем шаг дальше
        	If *c\c <> *n\c	; если очередной символ не одинаков, то
            Break
        	EndIf
        	*n\c + 2
        	*c\c + 2
        Wend
        If *c\c = 0 And *n\c = 0
        	ProcedureReturn ; слово уже есть, выпрыгиваем
        ElseIf *c\c = 0
        	; если слово короче чем узел, то надо перестроить узел, взяв короткое слово за узел
        ElseIf *n\c = 0
        	; если item короче чем слово, то добавляем остаток в item указанного item
        	If AddElement(*s\node())
            *s\node()\s = *s\item()
            If AddElement(*s\item())
            	*s\item() = PeekS(*c) ; считываем остаток слова
            EndIf
        	EndIf
        Else
        	;         Если выход по Break тогда разделяем узел
        EndIf
    	Next
    Else
    	If AddElement(*s\item())
        *s\item() = PeekS(*c) ; считываем остаток слова
    	EndIf
    EndIf
	EndIf
EndProcedure


Procedure View(*s.Tree, Pos) ; Отображение содержимого дерева.
	
	AddGadgetItem(0, -1, *s\s, 0, Pos)
	
	Pos+1
	
	ForEach *s\node() ; Отображение всех подузлов текущего узла
    View(*s\node(), Pos) ; Рекурсивный вызов процедуры
	Next
	
	ForEach *s\item() ; Отображение списка элементов текущего узла
    AddGadgetItem(0, -1, *s\item(), 0, Pos)
	Next
EndProcedure


If OpenWindow(0, 0, 0, 400, 400, "", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
	TreeGadget(0, 0, 0, 400, 400)
	Dictionary.Tree ; Создание пустого дерева как одного экземпляра структуры
	Dictionary\s = "узел"
	AddWord(Dictionary, @"apple")
	AddWord(Dictionary, @"banana")
	View(Dictionary, 0)
	Repeat
    Event = WaitWindowEvent()
	Until Event = #PB_Event_CloseWindow
EndIf

Отредактировано AZJIO (02.03.2025 11:05:51)

0

6

AZJIO написал(а):

можно построить легким и неэкономным способом:
а->б->б->в|г

Это похоже на алгоритм Trie:
а
  \
   б
     \
      б
     /  \
   в     г
В итоге, в этом варианте у дерева, 5 узлов.

AZJIO написал(а):

или сложным и быстрым для доступа
а->бб->в|г

Думаю, что в этом варианте, ты про Radix Tree:
  абб
  /  \
в     г
Твоим способом записи, на сколько тебя понял: абб->в|г
Тут три узла.

AZJIO написал(а):

Второй способ экономнее, имеет поле строку любой ширины, но при добавлении слова сложнее перестраивать список. Часть слов, которые в узле придётся перестроить, потому что вводимое слово перестраивает узел. Например добавим слово "абв" и нам придется убрать поле "бб"
а->б
->б->в|г
->с
тут надо уметь приатачить узел в|г с "бб" на "б", удалить "бб" добавив "б" и "с".

Я это сделал в нескольких вариантах, и протестировал, мне осталось добавить пару процедур. Вот, как пример, процедура добавления ключа, по скорости, почти не уступает варианту IDE, 10мс. на сто тысяч ключей это вообще не разница (учитывая мой проц. i3, 13 года), иногда мой вариант даже более быстрые показатели выдаёт:

Код:
  Procedure Set( *Node.RadixTree, Key$, *Value )
    If Not *Value : ProcedureReturn : EndIf
    Key$ = LCase(Key$)
    Protected *SearchPref.Symbol = @Key$
    While *SearchPref\c 
      Protected *FoundNode.RadixTree = *Node
      
      ; поиск по первому символу
      While *FoundNode
        Protected *ExistingPref.Symbol = @*FoundNode\Pref$
        If *ExistingPref\c = *SearchPref\c Or Not *FoundNode\Next
          Break
        EndIf
        *FoundNode = *FoundNode\Next ; к поиску следующего первого символа
      Wend
      
      If *ExistingPref\c = *SearchPref\c; первые символы совпадают
        Protected i = 1                 ; далее сравниваем со второго символа
        While *SearchPref\c[i] And *ExistingPref\c[i] And *SearchPref\c[i] = *ExistingPref\c[i]
          i + 1
        Wend
        If Not *ExistingPref\c[i] ; существующий префикс закончен, но искомый ключ, может быть не закончен  
          
          If *SearchPref\c[i]     ; искомый ключ не закончен
            
            If *FoundNode\Child   ; дочерний существует, проверяем в дочерних
              *Node = *FoundNode\Child
              *SearchPref = @*SearchPref\c[i]
              Continue
            Else ; дочернего нет, создаём и записываем
              *FoundNode\Child = AllocateStructure(RadixTree)
              *FoundNode\Child\Pref$ = PeekS( @*SearchPref\c[i] ) ; в дочерний, записывается правая часть искомого префикса
              *FoundNode\Child\Value  = *Value
            EndIf
            
          Else ; ключ найден, обновляем данные
            *FoundNode\Value  = *Value 
          EndIf
          
          ProcedureReturn #Null
        Else ; существующий префикс не закончен 
          
          Protected *New.RadixTree = AllocateStructure(RadixTree)
          *New\Pref$ = PeekS( @*ExistingPref\c[i] ) ; записывается правая часть существующего префикса
          *New\Value  = *FoundNode\Value   
          If *FoundNode\Child ; есть дочерний
            *New\Child = *FoundNode\Child
          EndIf
          *FoundNode\Child  = *New
          *FoundNode\Pref$ = PeekS( *ExistingPref, i ) ; записывается левая часть существующего префикса
          *FoundNode\Value  = 0  
          If *SearchPref\c[i] ; искомый префикс не закончен
            *New        = AllocateStructure(RadixTree)
            *New\Pref$ = PeekS( @*SearchPref\c[i] ) ; записывается правая часть искомого префикса
            *New\Value  = *Value
            *New\Next   = *FoundNode\Child
            *FoundNode\Child = *New
          Else ; ключ найден, обновляем данные
            *FoundNode\Value = *Value
          EndIf
          
          ProcedureReturn
        EndIf
      Else ; узел не найден, а *FoundNode указывает на последний узел в текущей Next последовательности узлов
        If *FoundNode\Pref$ ; если у узла есть ключ, то это не корневой узел, в ином случае запись в корень, без создания структуры
          *FoundNode\Next = AllocateStructure(RadixTree)
          *FoundNode = *FoundNode\Next
        EndIf
        *FoundNode\Pref$ = PeekS( *SearchPref )
        *FoundNode\Value  = *Value
        ProcedureReturn
      EndIf
    Wend
  EndProcedure

У меня тут поиск сначала по первому символу в текущей Next последовательности узлов, а потом со второго символа. Но, я подумал, что можно оптимизировать и объединить.
Позже выложу полный код, как доделаю. И у нас будет свой, абсолютно свободный Radix Tree. Потом, довести всё до ума, оптимизировать, и можно как-нибудь попробовать сделать на ассемблере ( интерес на будущее:) )

Отредактировано Webarion (03.03.2025 01:33:09)

0

7

Задача сейчас следующая: стоит или не стоит выстраивать последовательность узлов, в алфавитном порядке, для определения по первому символу. Вроде бы стоит, так как логичнее, что это может ускорить поиск. Потому-что, если существующий первый символ, в текущей *Next последовательности, имеет значение кодировки больше искомого, то можно остановиться и дальше не искать. Но, тесты показывают спорные результаты. Пока-что один тест. Я когда соберу оба эти варианта, буду тестировать на разных ключах, случайных, закономерных, текстовых.

Отредактировано Webarion (02.03.2025 21:20:21)

0

8

AZJIO написал(а):

За основу можно взять этот алгоритм.

Это более похоже на алгоритм простого ветвящегося дерева. Вообще, алгоритм простого дерева поиска, это и есть основа. А всё остальное, более усложнённые алгоритмы, основанные на базовом дереве.

Отредактировано Webarion (03.03.2025 02:10:08)

0

9

Webarion
С сортировкой дольше добавляется, так надо сортировать дерево. Это очевидно. А доступ не угадаешь, запрашиваемый символ может оказаться в начале одноуровнего списка, а может в конце. К примеру z был в начале, отсортировал и стал в конце, запрашиваешь z и он идут до конца списка, так что у тебя не обязательно узлы будут начинаться на "a" поэтому нет приоритета в какой-то сортировке, они там равнозначные. Искать ты всё равно будешь до первого попавшегося.

Webarion написал(а):

AZJIO написал(а):

    можно построить легким и неэкономным способом:
    а->б->б->в|г

Это похоже на алгоритм Trie:
а
  \
   б
     \
      б
     /  \
   в     г
В итоге, в этом варианте у дерева, 5 узлов.
AZJIO написал(а):

    или сложным и быстрым для доступа
    а->бб->в|г

Думаю, что в этом варианте, ты про Radix Tree:
  абб
  /  \
в     г

Так суть то у них одинакова, ты всё равно также добавляешь и также извлекаешь слово, а алгоритм разный. И последний выигрывает по скорости, по меньшему объёму памяти, но по более сложному алгоритму. В первом иди в цикле по одной букве и генерируй очередную стркутуру, а во втором надо перестраивать дерево (в пером нет).

0

10

AZJIO написал(а):

С сортировкой дольше добавляется, так надо сортировать дерево.

Само собой, это будет дольше. Но, дерево не надо прямо полноценно сортировать, это же просто указатели. Встретилось по ходу процесса анализа большее или меньшее значение, просто переставил указатели в узлах. Но, это тоже занимает время. Всегда существует выбор, некоторый баланс, между скоростью добавления и скоростью чтения, и скорость всегда находится в некотором балансе с памятью. Можно очень быстро читать ключи, но при этом затратив неимоверное количество памяти. Я хотел бы найти "золотую середину" в этом. В дефолтном варианте, при этом предоставляя выбор - "а что ты сам хочешь в своей разработке, первое, второе, или третье", благо, язык даёт возможность компилировать код в разных вариантах.

0

11

AZJIO написал(а):

Искать ты всё равно будешь до первого попавшегося.

Допустим, у нас есть ключи, начинающиеся на все буквы алфавита, но почему-то так получилось, что ключи начинающиеся на букву "а", были добавлены в самую последнюю очередь, это означает, что неотсортированный способ добавления ключей, запишет ключи на "а", в самый конец последовательности. Если последовательность первых символов не отсортирована, алгоритму поиска придётся проходить до самого конца. Но, если эта последовательность отсортирована, то, при самой первой проверке, мы встретим например "б", то сразу выходим из поиска, и нам совершенно не надо проходить по всей последовательности и искать, а был ли записан ключ, где-нибудь в конце, начинающийся на "а".  Это как раз и ускоряет поиск. Но это, во многом зависит от самих ключей, от их конъюктуры.

Отредактировано Webarion (05.03.2025 01:05:22)

0

12

Webarion написал(а):

запишет ключи на "а", в самый конец последовательности

Какова вероятность что "а" имеет приоритет? Что если отсортируешь, а у тебя постоянно нужен "z"? Он был первый, а ты его сделал последним и начинаешь при каждом запросе проходить весь список? У тебя "а" котируется только при условии что ты всегда просишь "а", но в реальности "а" не является приоритетом. У тебя ощущение что если ты отсортировал, то будет быстрее, на самом деле нет. Будет быстрее при условии что начальные буквы алфавита будут встречаться чаще, но получается как если бы ты говорил собеседнику "строй свои фразы так чтобы все слова начинались на "а", у меня так мозг быстрее работает". Максимум можешь взять какую нибудь книгу и сделать подсчёт встречаемости букв, и сортировать с этим условием. Хотя я думаю выгадаешь не много, так как гласные чаще во второй букве слова, поэтому если в первом уровне использовать один алгоритм сортировка, то во втором уровне должен уже другой. Получается надо создавать частоту встречаемости буквы в слове учитывая ещё и позицию буквы в слове.

0


Вы здесь » PureBasic - форум » OpenSource » Radix Tree AI