One Module, all included.
Source: Powerbasic Forum (https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/825649-string-trie-tree-data-structure)
' TrieC.inc
' Trie Tree : https://en.wikipedia.org/wiki/Trie
' Public domain, use at own risk. SDurham
' find 1,000,000 keys = 0.031 seconds
' get 1,000,000 payloads = 0.11 seconds
' find 10,000,000 keys = 0.383 seconds
' get 10,000,000 keys = 1.338 seconds
' if %MessageOnError defined before including file, message box on lib error
' if %HaltOnError defined before including file, app will halt on lib error
' ----------------------------------------------------------------------------------
'
' Key/Payload container. Payload stored/retrieved using unique Key.
'
' The Bad:
' Can get heavy.
' Stored in ASCII order, may not be in order for some languages.
' The Good:
' Extremely Fast:
' Fast as hash, Keys always in Key order.
' Tree:
' Faster than a tree and doesn't need to rebalance.
' Like a tree, the Keys are in order.
' Prefix Tree:
' Can be used for IntelliSense like lookup.
' Nothing faster.
' Use prefix cursor to find prefixes.
' Everything below a position in the tree has the same prefix.
' Suffix Tree:
' Store refers key before storing, use Prefix cursor.
' Unique Ordered Set:
' Aa set is a group of members that share a common attribute.
' Store/Restore tree To/From String/File:
'
' Implementation: "Range" Triee Tree
' Each node represents a character in a Key.
' The character's ASCII value in the node array is a pointer to the next character.
' This gets heavy very fast.
' In this implementation, the array only holds the range between low and high character.
' At some point, there will only be one character in the node.
'
' Keys:
' case sensitive, no nulls
' Payload:
' any kind of data packed into a string
'
' WString:
' There is a second set of procedures to support WStrings.
' WStrings converted to UTF8.
'
' Keys aren't stored in Tree
' The Key is the structure of the Tree
' ----------------------------------------------------------------------------------
' Keys lay on top of each other until a difference is encountered
' Keys = (cat, cats, catastrophe, catastrophes, cattle, cattleman, cattlemen, catch, catches, caught)
'
' c
' a
' t*--------------u
' a--c--s*--t g
' s h* l h
' t e e* t*
' r s* m
' o a--e
' p n* n*
' h
' e*
' s*
' ----------------------------------------------------------------------------------
#If Not %Def(%StrTrieTree230807)
%StrTrieTree230807 = 1
%TrieGoDown = 1
%TrieGoRight = 2
%TrieGoUp = 3
%TriePointerSize = 4
'error exit macro, errors logged to app folder
Macro TrieExit(test, message, exitWhat)
If test Then
Error 151
Me.Log(message )
Exit exitWhat
End If
End Macro
Type StrBldT 'forward reference
mem As Long
count As Long
max As Long
End Type
Type StrTrieStringT
count As Long
mem As Long
End Type
Type StrTrieNodeT
prnt As StrTrieNodeT Ptr
char As Byte
low As Byte
high As Byte
count As Byte
arr As Long Ptr
payload As StrTrieStringT Ptr
End Type
Class TrieC
Instance count_ As Long
Instance root_ As StrTrieNodeT Ptr
Instance cursor_ As StrTrieNodeT Ptr
Instance index_ As Long
Instance way_ As Byte
Instance prefix_ As StrTrieNodeT Ptr
Class Method Destroy()
Me.ClearMe()
End Method
' ------------------------------------------------------------------------------
' String Trie Tree
' ------------------------------------------------------------------------------
Interface StrTrieI : Inherit IUnknown
Property Get Count() As Long
' get item count
Property = count_
End Property
Method Clear()
' empty container
Me.ClearMe()
End Method
Method Add(key As String, payload As String, Opt ByVal update As Long)
' add key/payload to tree : key ignored if already in tree
' if 'update' specified then payload replaced if key in tree
Register x As Long
Local n As StrTrieNodeT Ptr
Local k As Byte Ptr
Err = 0
If Len(key) Then
If root_ = 0 Then root_ = Me.NodeAllocate(0, 0)
If Err Then Exit Method
n = root_
k = StrPtr(key)
While @k
x = Me.NodeAddToRange(n, @k)
If @n.@arr[x] = 0 Then @n.@arr[x] = Me.NodeAllocate(n, @k)
n = @n.@arr[x]
Incr k
Wend
'all of key's characters are now in tree
If @n.payload = 0 Then
@n.payload = Me.StringAllocate()
Me.StringSet(@n.@payload, payload)
Incr count_
ElseIf IsTrue update Then
Me.StringSet(@n.@payload, payload)
End If
End If
End Method
Method Set(key As String, payload As String)
' replace key's payload
Local n As StrTrieNodeT Ptr
n = Me.Contains(key)
If n And @n.payload Then Me.StringSet(@n.@payload, payload)
End Method
Method Get(key As String) As String
' get key's payload
Local n As StrTrieNodeT Ptr
n = Me.Contains(key)
If n And @n.payload Then Method = Peek$(@n.@payload.mem, @n.@payload.count)
End Method
Method Contains(key As String) As Long
' return zero if key not in tree
Register c As Long
Local n As StrTrieNodeT Ptr
Local k As Byte Ptr
If Len(key) Then
k = StrPtr(key)
c = @k
n = root_
While n And c
If c < @n.low Or c > @n.high Then Exit Method
n = @n.@arr[c - @n.low]
Incr k : c = @k
Wend
End If
If n And @n.payload Then Method = n
End Method
Method Remove(key As String)
' delete key and payload
Local n, prnt As StrTrieNodeT Ptr
n = Me.Contains(key)
If n And @n.payload Then
@n.payload = Me.StringFree(@n.payload)
Decr count_
While n
prnt = @n.prnt
If @n.count Or @n.payload Then Exit Method
Me.NodeDisconnect(n)
Me.NodeFree(n)
n = prnt
Wend
If count_ = 0 Then Me.ClearMe()
End If
End Method
' ------------------------------------------------------------------------------
' Key Cursor : move through every key in tree
' ------------------------------------------------------------------------------
Method FirstKey() As Long
' move to first Key in tree : true/false success
cursor_ = 0
prefix_ = 0
If root_ Then
cursor_ = root_
index_ = -1 'incr by %TrieGoRight
way_ = %TrieGoRight
Method = Me.NextKey()
End If
End Method
Method NextKey() As Long
' move to next Key in tree : true/false success
If count_ Then
While cursor_
Select Case As Const way_
Case %TrieGoDown
If @cursor_.count = 0 Or index_ >= @cursor_.count Then
way_ = %TrieGoUp 'can't go down or right - go up
ElseIf @cursor_.@arr[index_] = 0 Then
way_ = %TrieGoRight 'no child - can't go down - go right
Else 'go down
cursor_ = @cursor_.@arr[index_]
index_ = 0
way_ = %TrieGoDown
If @cursor_.payload Then
Method = 1 : Exit Method
End If
End If
Case %TrieGoRight
Incr index_ 'go right
If index_ >= @cursor_.count Then
way_ = %TrieGoUp 'can't go right or down
Else
way_ = %TrieGoDown
End If
Case %TrieGoUp
If @cursor_.prnt Then index_ = @cursor_.char - @cursor_.@prnt.low
cursor_ = @cursor_.prnt 'will exit loop if cursor on root node
way_ = %TrieGoRight
End Select
Wend
End If
End Method
' ------------------------------------------------------------------------------
' Prefix Cursor : move through every key starting with "prefix"
' ------------------------------------------------------------------------------
Method FirstPrefix(keyPrefix As String) As Long
' move cursor to first matching prefix : true/false success
Local c, x As Long
Local k As Byte Ptr
Local n As StrTrieNodeT Ptr
cursor_ = 0
prefix_ = 0
n = root_
If Len(keyPrefix) Then
k = StrPtr(keyPrefix)
While @k And n
c = @k
If c < @n.low Or c > @n.high Then Exit Method
x = c - @n.low
Incr k
n = @n.@arr[x]
Wend
If n Then
prefix_ = @n.prnt
cursor_ = n
index_ = -1
way_ = %TrieGoRight
If @n.payload Then
Method = 1
Else
Method = Me.NextPrefix()
End If
End If
End If
End Method
Method NextPrefix() As Long
' move to next Key in tree : true/false success
If count_ Then
While cursor_
Select Case As Const way_
Case %TrieGoDown
If @cursor_.count = 0 Or index_ >= @cursor_.count Then
way_ = %TrieGoUp 'can't go down or right - go up
ElseIf @cursor_.@arr[index_] = 0 Then
way_ = %TrieGoRight 'no child - can't go down - go right
Else 'go down
cursor_ = @cursor_.@arr[index_]
index_ = 0
way_ = %TrieGoDown
If @cursor_.payload Then
Method = 1 : Exit Method
End If
End If
Case %TrieGoRight
Incr index_ 'go right
If index_ >= @cursor_.count Then
way_ = %TrieGoUp 'can't go right or down
Else
way_ = %TrieGoDown
End If
Case %TrieGoUp
If @cursor_.prnt = prefix_ Then Exit Method
If @cursor_.prnt Then index_ = @cursor_.char - @cursor_.@prnt.low
cursor_ = @cursor_.prnt 'will exit loop if cursor on root node
way_ = %TrieGoRight
End Select
Wend
End If
End Method
' ------------------------------------------------------------------------------
' Get values at cursor position
' ------------------------------------------------------------------------------
Property Get Key() As String
'get Key at current cursor position
Local s As String
Local n As StrTrieNodeT Ptr
If cursor_ And @cursor_.payload Then
n = cursor_
While n And @n.char
s = Chr$(@n.char) + s
n = @n.prnt
Wend
End If
Property = s
End Property
Property Get Payload() As String
'get Payload at current cursor position
If cursor_ And @cursor_.payload Then Property = Me.StringGet(@cursor_.@payload)
End Property
' ------------------------------------------------------------------------------
' Unique Ordered String Set
' ASCII order.
' Won't be in order for some languages in which case it'd be an unordered unique set.
' ------------------------------------------------------------------------------
Method AddSet(otherSet As StrTrieI) As Long
' add Other Set to This Set, duplicates ignored
Local ok As Long
If IsObject(otherSet) Then
ok = otherSet.FirstKey()
While ok
Me.Add(otherSet.Key, "")
ok = otherSet.NextKey()
Wend
End If
End Method
Method SubtractSet(otherSet As StrTrieI)
' remove all members from This Set that are in Other Set
Local ok As Long
If IsObject(otherSet) Then
ok = otherSet.FirstKey()
While ok
Me.Remove(otherSet.Key)
ok = otherSet.NextKey()
Wend
End If
End Method
Method ContainsSet(otherSet As StrTrieI) As Long
' true if all Keys in Other Set are in This Set
'Set Theory: Subset
Local ok As Long
If IsObject(otherSet) And otherSet.Count Then
ok = otherSet.FirstKey()
While ok
If IsFalse Me.Contains(otherSet.Key) Then Exit Method
ok = otherSet.NextKey()
Wend
Method = 1
End If
End Method
Method EqualSet(otherSet As StrTrieI) As Long
' true if This Set and Other Set contain same members
If IsObject(otherSet) And otherSet.Count And otherSet.Count = Me.Count And Me.ContainsSet(otherSet) Then Method = 1
End Method
Method AdditionSet(otherSet As StrTrieI) As StrTrieI
' return Set = This Set + Other Set, duplicates ignored
' Set Theory: Union
Local unionS As StrTrieI : unionS = Class "TrieC"
unionS.AddSet(Me)
If IsObject(otherSet) Then unionS.AddSet(otherSet)
Method = unionS
End Method
Method SubtractionSet(otherSet As StrTrieI) As StrTrieI
' return Set = This Set - Other Set
' Set Theory: Difference, Complement
Local differenceS As StrTrieI : differenceS = Class "TrieC"
differenceS.AddSet(Me)
If IsObject(otherSet) Then differenceS.SubtractSet(otherSet)
Method = differenceS
End Method
Method CommonSet(otherSet As StrTrieI) As StrTrieI
' return Set = members common to This Set and Other Set, duplicates ignored
' Set Theory: Intersection
Local ok As Long
Local commonS As StrTrieI : commonS = Class "TrieC"
If IsObject(otherSet) Then
ok = Me.FirstKey()
While ok
If otherSet.Contains(Me.Key) Then commonS.Add(Me.Key, "")
ok = Me.NextKey()
Wend
End If
Method = commonS
End Method
Method UncommonSet(otherSet As StrTrieI) As StrTrieI
' return Set = members not common to This Set and Other Set
' Set Theory: Symmetric Difference
Local ok As Long
Local uncommonS As StrTrieI : uncommonS = Class "TrieC"
If IsObject(otherSet) Then
ok = Me.FirstKey()
While ok
If IsFalse otherSet.Contains(Me.Key) Then uncommonS.Add(Me.Key, "")
ok = Me.NextKey()
Wend
ok = otherSet.FirstKey()
While ok
If IsFalse Me.Contains(otherSet.Key) Then uncommonS.Add(otherSet.Key, "")
ok = otherSet.NextKey()
Wend
End If
Method = uncommonS
End Method
' ------------------------------------------------------------------------------
' Store/Restore tree To/From String/File
' ------------------------------------------------------------------------------
Method Store() As String
' store container to String
Register i As Long
Register ok As Long
Local key$, payload$
Local sb As StrBldT
If count_ Then
StrBldAdd sb, Mkl$(count_)
ok = Me.FirstKey()
While ok
Incr i
key$ = Me.Key
payload$ = Me.Payload
StrBldAdd sb, Mkl$(Len(key$))
StrBldAdd sb, key$
StrBldAdd sb, Mkl$(Len(payload$))
StrBldAdd sb, payload$
ok = Me.NextKey()
Wend
Method = StrBldGet(sb)
End If
End Method
Method Restore(ByVal stored As String)
' restore container from String
Register i As Long
Local items, characters As Long
Local key$, payload$
Local p As Long Ptr
Me.ClearMe()
If Len(stored) Then
p = StrPtr(stored)
items = @p : Incr p
For i = 1 To items
characters = @p : Incr p
key$ = Peek$(p, characters) : p += characters
characters = @p : Incr p
payload$ = Peek$(p, characters) : p += characters
Me.Add(key$, payload$)
Next i
End If
End Method
Method FileStore(ByVal file As WString)
' store container to File
StrToFile file, Me.Store()
End Method
Method FileRestore(ByVal file As WString)
' restore container from File
Me.Restore(StrFromFile(file))
End Method
End Interface 'StrTrieI
' ------------------------------------------------------------------------------
' WString Trie Tree
' WStrings stored UTF8
' tree may not be in order
' little slower due to UTF8 conversion
' ------------------------------------------------------------------------------
Interface WStrTrieI : Inherit IUnknown
Property Get Count() As Long
' get item count
Property = count_
End Property
Method Clear()
' empty container
Me.ClearMe()
End Method
Method Add(key As WString, payload As WString, Opt ByVal update As Long)
' add key/payload to tree : key ignored if already in tree
' if 'update' specified then payload replaced if key in tree
Local t As StrTrieI : t = Me
t.Add(ChrToUtf8$(key), ChrToUtf8$(payload))
End Method
Method Set(key As WString, payload As WString)
' replace key's payload
Local t As StrTrieI : t = Me
t.Set(ChrToUtf8$(key), ChrToUtf8$(payload))
End Method
Method Get(key As WString) As WString
' get key's payload
Local t As StrTrieI : t = Me
Method = Utf8ToChr$(t.Get(ChrToUtf8$(key)))
End Method
Method Contains(key As WString) As Long
' true/false if key exist
Local t As StrTrieI : t = Me
Method = t.Contains(ChrToUtf8$(key))
End Method
Method Remove(key As WString)
' delete key and payload
Local t As StrTrieI : t = Me
t.Remove(ChrToUtf8$(key))
End Method
' ------------------------------------------------------------------------------
' Key Cursor : move through every key in tree
' ------------------------------------------------------------------------------
Method FirstKey() As Long
'move to first Key in tree : true/false success
Local t As StrTrieI : t = Me
Method = t.FirstKey()
End Method
Method NextKey() As Long
'move to next Key in tree : true/false success
Local t As StrTrieI : t = Me
Method = t.NextKey()
End Method
' ------------------------------------------------------------------------------
' Prefix Cursor : move through every key starting with a "prefix"
' ------------------------------------------------------------------------------
Method FirstPrefix(keyPrefix As WString) As Long
'move cursor to first Key starting with keyPrefix : true/false success
Local t As StrTrieI : t = Me
Method = t.FirstPrefix(ChrToUtf8$(keyPrefix))
End Method
Method NextPrefix() As Long
'move to next matching prefix in tree : true/false success
Local t As StrTrieI : t = Me
Method = t.NextPrefix()
End Method
' ------------------------------------------------------------------------------
' Get values at cursor position
' ------------------------------------------------------------------------------
Property Get Key() As WString
' get key at current cursor position
Local t As StrTrieI : t = Me
Property = Utf8ToChr$(t.Key)
End Property
Property Get Payload() As WString
' get payload at current cursor position
Local t As StrTrieI : t = Me
Property = Utf8ToChr$(t.Payload)
End Property
' ------------------------------------------------------------------------------
' Unique WString Set
' stored UTF8 so may not be in order in which case it'd be an unordered unique set
' ------------------------------------------------------------------------------
Method AddSet(otherSet As WStrTrieI) As Long
' add Other Set to This Set, duplicates ignored
Local ok As Long
If IsObject(otherSet) Then
ok = otherSet.FirstKey()
While ok
Me.Add(otherSet.Key, "")
ok = otherSet.NextKey()
Wend
End If
End Method
Method SubtractSet(otherSet As WStrTrieI)
' remove all Keys from This Set that are in Other Set
Local ok As Long
If IsObject(otherSet) Then
ok = otherSet.FirstKey()
While ok
Me.Remove(otherSet.Key)
ok = otherSet.NextKey()
Wend
End If
End Method
Method ContainsSet(otherSet As WStrTrieI) As Long
' true if all members in Other Set are in This Set
' Set Theory: Subset
Local ok As Long
If IsObject(otherSet) And otherSet.Count Then
ok = otherSet.FirstKey()
While ok
If IsFalse Me.Contains(otherSet.Key) Then Exit Method
ok = otherSet.NextKey()
Wend
Method = 1
End If
End Method
Method EqualSet(otherSet As WStrTrieI) As Long
' true if This Set and Other Set contain same members
If IsObject(otherSet) And otherSet.Count And otherSet.Count = Me.Count And Me.ContainsSet(otherSet) Then Method = 1
End Method
Method AdditionSet(otherSet As WStrTrieI) As WStrTrieI
' return Set = This Set + Other Set, duplicates ignored
' Set Theory: Union
Local unionS As WStrTrieI : unionS = Class "TrieC"
unionS.AddSet(Me)
If IsObject(otherSet) Then unionS.AddSet(otherSet)
Method = unionS
End Method
Method SubtractionSet(otherSet As WStrTrieI) As WStrTrieI
' return Set = This Set - Other Set
' Set Theory: Difference, Complement
Local differenceS As WStrTrieI : differenceS = Class "TrieC"
differenceS.AddSet(Me)
If IsObject(otherSet) Then differenceS.SubtractSet(otherSet)
Method = differenceS
End Method
Method CommonSet(otherSet As WStrTrieI) As WStrTrieI
' return Set = members common to This Set and Other Set, duplicates ignored
' Set Theory: Intersection
Local ok As Long
Local commonS As WStrTrieI : commonS = Class "TrieC"
If IsObject(otherSet) Then
ok = Me.FirstKey()
While ok
If otherSet.Contains(Me.Key) Then commonS.Add(Me.Key, "")
ok = Me.NextKey()
Wend
End If
Method = commonS
End Method
Method UncommonSet(otherSet As WStrTrieI) As WStrTrieI
' return Set = members not common to This Set and Other Set
' set Theory: Symmetric Difference
Local ok As Long
Local uncommonS As WStrTrieI : uncommonS = Class "TrieC"
If IsObject(otherSet) Then
ok = Me.FirstKey()
While ok
If IsFalse otherSet.Contains(Me.Key) Then uncommonS.Add(Me.Key, "")
ok = Me.NextKey()
Wend
ok = otherSet.FirstKey()
While ok
If IsFalse Me.Contains(otherSet.Key) Then uncommonS.Add(otherSet.Key, "")
ok = otherSet.NextKey()
Wend
End If
Method = uncommonS
End Method
' ------------------------------------------------------------------------------
' Store/Restore tree To/From String/File
' ------------------------------------------------------------------------------
Method Store() As String
' store container to String
Local t As StrTrieI : t = Me
Method = t.Store()
End Method
Method Restore(ByVal stored As String)
' restore container from String
Local t As StrTrieI : t = Me
t.Restore(stored)
End Method
Method FileStore(ByVal file As WString)
' store container to File
Local t As StrTrieI : t = Me
t.FileStore(file)
End Method
Method FileRestore(ByVal file As WString)
' restore container from File
Local t As StrTrieI : t = Me
t.FileRestore(file)
End Method
End Interface 'WStrTrieI
Class Method ClearMe()
root_ = Me.NodeFree(root_)
count_ = 0
cursor_ = 0
index_ = -1
prefix_ = 0
End Method
' ----------------------------------------------------------------------------------
' Node
' ----------------------------------------------------------------------------------
Class Method NodeAllocate(ByVal prnt As StrTrieNodeT Ptr, ByVal char As Byte) As Long
Local node As StrTrieNodeT Ptr
node = MemAllocate(SizeOf(@node))
TrieExit(node = 0, "TrieC: NodeAllocate: node allocate fail", Method)
@node.prnt = prnt
@node.char = char
Method = node
End Method
Class Method NodeFree(ByVal node As StrTrieNodeT Ptr) As Long
Register i As Long
If node Then
For i = 0 To @node.count - 1
If @node.@arr[i] Then @node.@arr[i] = Me.NodeFree(@node.@arr[i])
Next i
Me.NodeArrayClear(node)
If @node.payload Then @node.payload = Me.StringFree(@node.payload)
MemFree(node)
End If
End Method
Class Method NodeAddToRange(ByVal node As StrTrieNodeT Ptr, ByVal char As Byte) As Long
Register i As Long
Register items As Long
If node Then
If @node.count = 0 Then
Me.NodeArrayAdd(node, 0)
@node.low = char
@node.high = char
Method = 0 'first in array
ElseIf char < @node.low Then
items = @node.low - char
For i = 1 To items
Me.NodeArrayInsert(node, 0, 0)
Next i
@node.low = char
Method = 0
ElseIf char > @node.high Then
items = char - @node.high
For i = 1 To items
Me.NodeArrayAdd(node, 0)
Next i
@node.high = char
Method = @node.count - 1
Else
Method = char - @node.low
End If
Else
TrieExit(1, "TrieC: NodeAddToRange: null node", Method)
End If
End Method
Class Method NodeDisconnect(ByVal node As StrTrieNodeT Ptr)
Register x As Long
Local prnt As StrTrieNodeT Ptr
TrieExit(node = 0, "TrieC: NodeDisconnect: null node", Method)
prnt = @node.prnt
If prnt Then
x = @node.char - @prnt.low
TrieExit(x < 0 Or x >= @prnt.count, "TrieC: NodeDisconnect: out of bunds", Method)
@prnt.@arr[x] = 0
'may need to collapse range
While @prnt.count And @prnt.@arr[0] = 0
Me.NodeArrayDelete(prnt, 0)
Incr @prnt.low
Wend
While @prnt.count And @prnt.@arr[@prnt.count - 1] = 0
Me.NodeArrayDelete(prnt, @prnt.count - 1)
Decr @prnt.high
Wend
End If
End Method
' ----------------------------------------------------------------------------------
' Node Array
' ----------------------------------------------------------------------------------
Class Method NodeArrayClear(ByVal node As StrTrieNodeT Ptr)
TrieExit(node = 0, "TrieC: NodeArrayClear: null node ptr", Method)
@node.arr = MemFree(@node.arr)
@node.count = 0
End Method
Class Method NodeArrayReDim(ByVal node As StrTrieNodeT Ptr, ByVal items As Long)
TrieExit(node = 0, "TrieC: NodeArrayReDim: null node ptr", Method)
If items = 0 Then
Me.NodeArrayClear(node)
ElseIf items <> @node.count Then
@node.count = 0
@node.arr = MemReAllocate(@node.arr, items * %TriePointerSize)
TrieExit(@node.arr = 0, "TrieC: NodeArrayReDim: memory reallocation fial", Method)
@node.count = items
End If
End Method
Class Method NodeArrayAdd(ByVal node As StrTrieNodeT Ptr, ByVal payload As Long)
TrieExit(node = 0, "TrieC: NodeArrayAdd: null node ptr", Method)
Me.NodeArrayReDim(node, @node.count + 1)
TrieExit(@node.count = 0, "TrieC: NodeArrayAdd: NodeArrayReDim fail", Method)
@node.@arr[@node.count - 1] = payload
End Method
Class Method NodeArrayInsert(ByVal node As StrTrieNodeT Ptr, ByVal index As Byte, ByVal payload As Long)
TrieExit(node = 0, "TrieC: NodeArrayInsert: null node ptr", Method)
TrieExit(index >= @node.count, "TrieC: NodeArrayInsert: out of bounds", Method)
Me.NodeArrayReDim(node, @node.count + 1)
TrieExit(@node.count = 0, "TrieC: NodeArrayInsert: NodeArrayReDim fail", Method)
Me.NodeArrayMove(node, index, index + 1, @node.count - index - 1)
@node.@arr[index] = payload
End Method
Class Method NodeArrayDelete(ByVal node As StrTrieNodeT Ptr, ByVal index As Byte)
TrieExit(node = 0, "TrieC: NodeArrayDelete: null node ptr", Method)
TrieExit(index >= @node.count, "TrieC: NodeArrayDelete: out of bounds", Method)
If index < @node.count - 1 Then
Me.NodeArrayMove(node, index + 1, index , @node.count - index - 1)
End If
Me.NodeArrayReDim(node, @node.count - 1)
End Method
Class Method NodeArrayMove(ByVal node As StrTrieNodeT Ptr, ByVal fromIndex As Long, ByVal toIndex As Long, ByVal Count As Long)
Memory Copy @node.arr + (fromIndex * %TriePointerSize), @node.arr + (toIndex * %TriePointerSize), Count * %TriePointerSize
End Method
' ----------------------------------------------------------------------------------
' String
' ----------------------------------------------------------------------------------
Class Method StringAllocate() As Long
Local p As StrTrieStringT Ptr
p = MemAllocate(SizeOf(@p))
TrieExit(p = 0, "TrieC: StringAllocate: memory allocation fail", Method)
Method = p
End Method
Class Method StringFree(ByVal p As StrTrieStringT Ptr) As Long
If p Then
Me.StringClear(@p)
MemFree(p)
End If
End Method
Class Method StringClear(str As StrTrieStringT)
str.count = 0
str.mem = MemFree(str.mem)
End Method
Class Method StringSet(str As StrTrieStringT, payload As String)
Register strLen As Long
strLen = Len(payload)
Me.StringClear(str)
If strLen Then
str.mem = MemAllocate(strLen)
TrieExit(str.mem = 0, "TrieC: StringSet: memory allocation fail", Method)
str.count = strLen
Memory Copy StrPtr(payload), str.mem, strLen
End If
End Method
Class Method StringGet(str As StrTrieStringT) As String
If str.count Then Method = Peek$(str.mem, str.count)
End Method
' ----------------------------------------------------------------------------------
' Error Log
' ----------------------------------------------------------------------------------
Class Method Log(message As String)
Local h As Long
h = FreeFile
Try
Open Exe.Path$ + "TrieeTree.log" For Append As h
If Lof(h) < 16000 Then
Print# h, Date$ +": "+ Time$ +": "+ Exe.Full$ +": "+ message
End If
Catch
Finally
Close h
#If %Def(%MessageOnError)
MsgBox message, ,"Error!"
#EndIf
#If %Def(%HaltOnError)
End
#EndIf
End Try
End Method
End Class 'TrieC
#EndIf '%StrTrieTree230807
#If Not %Def(%Memory230424)
%Memory230424 = 1
Declare Function GlobalAlloc Lib "Kernel32.dll" Alias "GlobalAlloc" (ByVal uFlags As Dword, ByVal dwBytes As Dword) As Dword
Declare Function GlobalReAlloc Lib "Kernel32.dll" Alias "GlobalReAlloc" (ByVal hMem As Dword, ByVal dwBytes As Dword, ByVal uFlags As Dword) As Dword
Declare Function GlobalFree Lib "Kernel32.dll" Alias "GlobalFree" (ByVal hMem As Dword) As Dword
%GMEM_FIXED_ = &H0000
%GMEM_MOVEABLE_ = &H0002
%GMEM_NOCOMPACT_ = &H0010
%GMEM_NODISCARD_ = &H0020
%GMEM_ZEROINIT_ = &H0040
%GMEM_MODIFY_ = &H0080
%GMEM_DISCARDABLE_ = &H0100
%GMEM_NOT_BANKED_ = &H1000
%GMEM_SHARE_ = &H2000
%GMEM_DDESHARE_ = &H2000
%GMEM_NOTIFY_ = &H4000
%GMEM_LOWER_ = %GMEM_NOT_BANKED_
%GMEM_VALID_FLAGS_ = &H7F72
%GMEM_INVALID_HANDLE_ = &H08000
%GHND_ = (%GMEM_ZEROINIT_ Or %GMEM_MOVEABLE_)
%GPTR_ = (%GMEM_ZEROINIT_ Or %GMEM_FIXED_)
Function MemAllocate(ByVal bytes As Long) ThreadSafe As Long
If bytes Then Function = GlobalAlloc(ByVal %GPTR_, ByVal bytes)
End Function
Function MemReAllocate(ByVal h As Long, ByVal bytes As Long) ThreadSafe As Long
If h And bytes Then
Function = GlobalReAlloc(ByVal h, ByVal bytes, ByVal %GMEM_MOVEABLE_ Or %GMEM_ZEROINIT_)
ElseIf bytes Then
Function = GlobalAlloc(ByVal %GPTR_, ByVal bytes)
ElseIf h Then
Function = GlobalFree(ByVal h)
End If
End Function
Function MemFree(ByVal h As Long) ThreadSafe As Long
If h Then GlobalFree(ByVal h)
End Function
#EndIf '%Memory230424
#If Not %Def(%StrBld230424)
%StrBld230424 = 1
' String Builder : all memory freed when StrBldGet() called
' add 1,000,000 one-character Strings = 0.094 seconds
' public domain, use at own risk
' SDurham
%StrBldItemsSize = 1
%StrBldBuffer = 100000
Type StrBldT
mem As Long
count As Long
max As Long
End Type
Function StrBldCount(t As StrBldT) ThreadSafe As Long
' get character count
Function = t.count
End Function
Sub StrBldAdd(t As StrBldT, ByRef value As String) ThreadSafe
' append string
Local currentCount, currentMax, newMax As Long
Local lenValue As Long : lenValue = Len(value)
If lenValue Then
If lenValue > t.max - t.count Then
currentCount = t.count
currentMax = t.max
t.count = 0
t.max = 0
newMax = currentCount + lenValue + %StrBldBuffer
t.mem = MemReAllocate(t.mem, newMax * %StrBldItemsSize)
If t.mem = 0 Then Exit Sub
t.count = currentCount
t.max = newMax
End If
Memory Copy StrPtr(value), t.mem + (t.count * %StrBldItemsSize), lenValue * %StrBldItemsSize
t.count += lenValue
End If
End Sub
Function StrBldGet(t As StrBldT) ThreadSafe As String
' get complete string and free all memory
If t.count Then Function = Peek$(t.mem, t.count)
t.mem = MemFree(t.mem)
t.count = 0
t.max = 0
End Function
#EndIf '%StrBld230424
#If Not %Def(%FileUtilities230424)
%FileUtilities230424 = 1
' File Utilities
' public domain, use at own risk
' SDurham
Sub StrToFile(ByVal file As WString, ByVal s As String) ThreadSafe
' store string to File
Local f As Long
If Len(file) = 0 Then Exit Sub
f = FreeFile
Open file For Binary As f
SetEof f
Put$ f, s
Close f
End Sub
Function StrFromFile(ByVal file As WString) ThreadSafe As String
' get file contents as string
Local f As Long
Local s As String
If IsFalse IsFile(file) Then Exit Function
f = FreeFile
Open file For Binary As f
Get$ f, Lof(f), s
Function = s
Close f
End Function
Sub WStrToFile(ByVal file As WString, ByVal s As WString) ThreadSafe
' store string to File
Local f As Long
If Len(file) = 0 Then Exit Sub
f = FreeFile
Open file For Binary As f
SetEof f
Put$$ f, s
Close f
End Sub
Function WStrFromFile(ByVal file As WString) ThreadSafe As WString
' get file contents as string
Local f As Long
Local s As WString
If IsFalse IsFile(file) Then Exit Function
f = FreeFile
Open file For Binary As f
Get$$ f, Lof(f), s
Function = s
Close f
End Function
Sub WStrToTextFile(ByVal file As WString, ByVal s As WString) ThreadSafe
' store string converted to UTF8 to File
StrToFile file, ChrToUtf8$(s)
End Sub
Function WStrFromTextFile(ByVal file As WString) As WString
' get file contents converted from UTF8
Function = Utf8ToChr$(StrFromFile(file))
End Function
Function WStrFromTextFileFixed(ByVal file As WString) ThreadSafe As WString
' get file contents converted from UTF8 fixing Unix line endings if any
Local s As WString
s = Utf8ToChr$(StrFromFile(file))
Replace $CrLf With $Lf In s
Replace $CrLf With $Lf In s
Replace $Cr With $Lf In s
Replace $Cr With $Lf In s
Replace $Lf With $CrLf In s
Function = s
End Function
#EndIf '%FileUtilities230424�
Testcode:
'String Trie Tree.bas
#Option LargeMem32
#Compile Exe
#Dim All
%MessageOnError = 1
%HaltOnError = 1
#Include Once "..\TrieC.inc"
Function PBMain() As Long
Local h&, outFile$, hprocess&
h& = FreeFile
outFile$ = Exe.Path$ + Exe.Name$ + ".txt"
Kill outFile$
Open outFile$ For Append As h&
Local more As Long
Local stored As String
Local tree As StrTrieI : tree = Class "TrieC"
Local ThisSet As StrTrieI : ThisSet = Class "TrieC"
Local OtherSet As StrTrieI : OtherSet = Class "TrieC"
Local AdditionSet As StrTrieI
Local SubtractionSet As StrTrieI
Local CommonSet As StrTrieI
Local UncommonSet As StrTrieI
Print# h&, "Method Add(key As String, payload As String)"
Print# h&, " add key/payload to tree : key ignored if already in tree"
tree.Add("cat", "cat payload")
tree.Add("cats", "cats payload")
tree.Add("catastrophe", "catastrophe payload")
tree.Add("catastrophes", "catastrophes payload")
tree.Add("cattle", "cattle payload")
tree.Add("cattleman", "cattleman paload")
tree.Add("cattlemen", "cattlemen payload")
tree.Add("catches", "catches payload")
tree.Add("caught", "caught payload")
Print# h&, "--- Display Tree ---"
more = tree.FirstKey()
While more
Print# h&, $Dq + tree.Key + $Dq + ", " + $Dq + tree.Payload + $Dq
more = tree.NextKey()
Wend
Print# h&, ""
Print# h&, ""
Print# h&, "Method Set(key As String, payload As String)"
Print# h&, " replace key's payload"
tree.Set("cattleman", "the cattleman paload was changed to new value")
Print# h&, "--- Display Tree ---"
more = tree.FirstKey()
While more
Print# h&, $Dq + tree.Key + $Dq + ", " + $Dq + tree.Payload + $Dq
more = tree.NextKey()
Wend
Print# h&, ""
Print# h&, ""
Print# h&, "Method Get(key As String) As String"
Print# h&, " get key's payload"
Print# h&, "payload for 'catastrophes' = " + $Dq + tree.Get("catastrophes") + $Dq
Print# h&, "payload for 'cattle' = " + $Dq + tree.Get("cattle") + $Dq
Print# h&, "payload for 'cattleman' = " + $Dq + tree.Get("cattleman") + $Dq
Print# h&, "payload for 'cats' = " + $Dq + tree.Get("cats") + $Dq
Print# h&, "payload for 'dogs' = " + $Dq + tree.Get("dogs") + $Dq
Print# h&, ""
Print# h&, ""
Print# h&, "Method Contains(key As String) As Long"
Print# h&, " return zero if key not in tree "
Print# h&, "tree contains 'cat' = " + Format$(tree.Contains("cat"))
Print# h&, "tree contains 'dog' = " + Format$(tree.Contains("dog"))
Print# h&, " add dog"
tree.Add("dog", "dog payload")
Print# h&, "tree contains 'dog' = " + Format$(tree.Contains("dog"))
Print# h&, ""
Print# h&, ""
Print# h&, "Method Remove(key As String)"
Print# h&, " delete key and payload"
Print# h&, "tree contains 'cat' = " + Format$(tree.Contains("cat"))
Print# h&, "tree contains 'dog' = " + Format$(tree.Contains("dog"))
Print# h&, " remove 'dog'"
tree.Remove("dog")
Print# h&, "tree contains 'cat' = " + Format$(tree.Contains("cat"))
Print# h&, "tree contains 'dog' = " + Format$(tree.Contains("dog"))
Print# h&, ""
Print# h&, ""
Print# h&, "Store/Restore tree To/From String/File"
Print# h&, ""
Print# h&, ""
Print# h&, "Method Store() As String"
Print# h&, " store container to String"
Print# h&, "Method Restore(ByVal stored As String)"
Print# h&, " restore container from String"
Print# h&, "Method FileStore(ByVal file As WString)"
Print# h&, " store container to File"
Print# h&, "Method FileRestore(ByVal file As WString)"
Print# h&, " restore container from File"
Print# h&, " store container to String"
stored = tree.Store()
Print# h&, " restore container from String"
tree.Restore(stored)
Print# h&, " store container to File"
tree.FileStore("Stored.Data")
Print# h&, " restore container from Fila"
tree.FileRestore("Stored.Data")
Kill "Stored.Data"
Print# h&, "--- Display Tree After: Store/Restore To/From String/File ---"
more = tree.FirstKey()
While more
Print# h&, $Dq + tree.Key + $Dq + ", " + $Dq + tree.Payload + $Dq
more = tree.NextKey()
Wend
Print# h&, ""
Print# h&, ""
Print# h&, "Prefix Cursor"
Print# h&, ""
Print# h&, ""
Print# h&, "Method FirstPrefix(keyPrefix As String) As Long"
Print# h&, " move cursor to first matching prefix : true/false success"
Print# h&, "Method NextPrefix() As Long"
Print# h&, " move to next Key in tree : true/false success"
Print# h&, ""
Print# h&, "-- Display Records Starting With 'c' "
more = tree.FirstPrefix("c")
While more
Print# h&, $Dq + tree.Key + $Dq + ", " + $Dq + tree.Payload + $Dq
more = tree.NextPrefix()
Wend
Print# h&, ""
Print# h&, "-- Display Records Starting With 'ca' "
more = tree.FirstPrefix("ca")
While more
Print# h&, $Dq + tree.Key + $Dq + ", " + $Dq + tree.Payload + $Dq
more = tree.NextPrefix()
Wend
Print# h&, ""
Print# h&, "-- Display Records Starting With 'cat' "
more = tree.FirstPrefix("cat")
While more
Print# h&, $Dq + tree.Key + $Dq + ", " + $Dq + tree.Payload + $Dq
more = tree.NextPrefix()
Wend
Print# h&, ""
Print# h&, "-- Display Records Starting With 'catt' "
more = tree.FirstPrefix("catt")
While more
Print# h&, $Dq + tree.Key + $Dq + ", " + $Dq + tree.Payload + $Dq
more = tree.NextPrefix()
Wend
Print# h&, ""
Print# h&, ""
Print# h&, "Unique Ordered String Set"
Print# h&, " ASCII order"
Print# h&, " Won't be in order for some languages in which case it'd be an unordered unique set."
Print# h&, ""
Print# h&, ""
Print# h&, "Method AddSet(otherSet As StrTrieI) As Long"
Print# h&, " add Other Set to This Set, duplicates ignored "
ThisSet.Add("A", "")
ThisSet.Add("B", "")
ThisSet.Add("C", "")
OtherSet.Add("C", "")
OtherSet.Add("B", "")
OtherSet.Add("D", "")
Print# h&, ""
Print# h&, "--- Display This Set ---"
more = ThisSet.FirstKey()
While more
Print# h&, $Dq + ThisSet.Key + $Dq
more = ThisSet.NextKey()
Wend
Print# h&, ""
Print# h&, "--- Display Other Set ---"
more = OtherSet.FirstKey()
While more
Print# h&, $Dq + OtherSet.Key + $Dq
more = OtherSet.NextKey()
Wend
Print# h&, ""
Print# h&, "add Other Set to This Set"
ThisSet.AddSet(OtherSet)
Print# h&, ""
Print# h&, "--- Display This Set ---"
more = ThisSet.FirstKey()
While more
Print# h&, $Dq + ThisSet.Key + $Dq
more = ThisSet.NextKey()
Wend
Print# h&, ""
Print# h&, ""
Print# h&, "Method SubtractSet(otherSet As StrTrieI)"
Print# h&, " remove all members from This Set that are in Other Set"
Print# h&, " subtract Other Set from This Set"
ThisSet.SubtractSet(OtherSet)
Print# h&, ""
Print# h&, "--- Display This Set ---"
more = ThisSet.FirstKey()
While more
Print# h&, $Dq + ThisSet.Key + $Dq
more = ThisSet.NextKey()
Wend
Print# h&, ""
Print# h&, "Method ContainsSet(otherSet As StrTrieI) As Long"
Print# h&, " true if all Keys in Other Set are in This Set"
Print# h&, "This Set contains Other Set = " + Format$(ThisSet.ContainsSet(OtherSet))
Print# h&, " add Other Set to This Set"
ThisSet.AddSet(OtherSet)
Print# h&, "This Set contains Other Set = " + Format$(ThisSet.ContainsSet(OtherSet))
Print# h&, ""
Print# h&, "Method EqualSet(otherSet As StrTrieI) As Long"
Print# h&, " true if This Set and Other Set contain same members"
Print# h&, "This Set contain Other Set = " + Format$(ThisSet.ContainsSet(OtherSet))
Print# h&, " subtract Other Set from This Set"
ThisSet.SubtractSet(OtherSet)
Print# h&, "This Set contain Other Set = " + Format$(ThisSet.ContainsSet(OtherSet))
Print# h&, ""
Print# h&, ""
Print# h&, "Method AdditionSet(otherSet As StrTrieI) As StrTrieI"
Print# h&, " return Set = This Set + Other Set, duplicates ignored"
ThisSet.Clear()
ThisSet.Add("A", "")
ThisSet.Add("C", "")
ThisSet.Add("D", "")
ThisSet.Add("E", "")
ThisSet.Add("G", "")
OtherSet.Clear()
OtherSet.Add("B", "")
OtherSet.Add("D", "")
OtherSet.Add("E", "")
OtherSet.Add("F", "")
OtherSet.Add("H", "")
Print# h&, ""
Print# h&, "--- Display This Set ---"
more = ThisSet.FirstKey()
While more
Print# h&, $Dq + ThisSet.Key + $Dq
more = ThisSet.NextKey()
Wend
Print# h&, ""
Print# h&, "--- Display Other Set ---"
more = OtherSet.FirstKey()
While more
Print# h&, $Dq + OtherSet.Key + $Dq
more = OtherSet.NextKey()
Wend
AdditionSet = ThisSet.AdditionSet(OtherSet)
Print# h&, ""
Print# h&, "--- Addition Set ---"
more = AdditionSet.FirstKey()
While more
Print# h&, $Dq + AdditionSet.Key + $Dq
more = AdditionSet.NextKey()
Wend
Print# h&, ""
Print# h&, ""
Print# h&, "Method SubtractionSet(otherSet As StrTrieI) As StrTrieI "
Print# h&, " return Set = This Set - Other Set"
SubtractionSet = ThisSet.SubtractionSet(OtherSet)
Print# h&, ""
Print# h&, "--- Subtraction Set ---"
more = SubtractionSet.FirstKey()
While more
Print# h&, $Dq + SubtractionSet.Key + $Dq
more = SubtractionSet.NextKey()
Wend
Print# h&, ""
Print# h&, ""
Print# h&, "Method CommonSet(otherSet As StrTrieI) As StrTrieI"
Print# h&, " return Set = members common to This Set and Other Set, duplicates ignored"
CommonSet = ThisSet.CommonSet(OtherSet)
Print# h&, ""
Print# h&, "--- Common Set ---"
more = CommonSet.FirstKey()
While more
Print# h&, $Dq + CommonSet.Key + $Dq
more = CommonSet.NextKey()
Wend
Print# h&, ""
Print# h&, ""
Print# h&, "Method UncommonSet(otherSet As StrTrieI) As StrTrieI"
Print# h&, " return Set = members not common to This Set and Other Set"
UncommonSet = ThisSet.UncommonSet(OtherSet)
Print# h&, ""
Print# h&, "--- Uncommon Set ---"
more = UncommonSet.FirstKey()
While more
Print# h&, $Dq + UncommonSet.Key + $Dq
more = UncommonSet.NextKey()
Wend
Print# h&, ""
Print# h&, ""
Close h&
Sleep 1
hprocess& = Shell("notepad.exe " + outFile$, 1)
End Function�