It fails on Windows, Linux x86 and x64.
Here's one of the modules that fail
Code: Select all
DeclareModule AVLTree
Prototype fnClearNodeData(*NodeData, DataSize)
Prototype fnInitNodeData(*NodeData, DataSize)
Prototype fnIteratorCallback(*userdata, Key.q, *Data, *Node)
Structure avl_node
*left.avl_node
*right.avl_node
*nPrev.avl_node
*nNext.avl_node
height.u
Key.q
*NodeData
EndStructure
Structure avl_tree
VT.i
elementSize.i
fnClearNodeData.fnClearNodeData
fnInitNodeData.fnInitNodeData
depth.i
nodeCount.i
*root.avl_node ; tree root
*First.avl_node ; linked list first node
*Last.avl_node ; linked list last node
*pNewData
EndStructure
Declare.i AVL_NewTree(ElementSize, fnClearNodeData, fnInitNodeData)
Declare.i AVL_NewNode(*AVL.AVL_Tree, Key.q) ; returns a pointer to data structure
Declare.i AVL_NodeExist(*AVL.AVL_Tree, Key.q) ; returns a pointer to data structure or zero
Declare.i AVL_DeleteNode(*AVL.AVL_Tree, Key.q)
Declare.i AVL_Iterate(*AVL.AVL_Tree, fnIteratorCallback, userdata)
Declare.i AVL_FreeTree(*AVL.AVL_Tree)
Declare.q AVL_GetPreviousKey(*AVL.AVL_Tree, Key.q)
Declare.q AVL_GetNextKey(*AVL.AVL_Tree, Key.q)
Declare.q AVL_GetFirstKey(*AVL.AVL_TREE); Key or #Null - if you have a 0 or #Null key, check for it with AVL_NodeExists
Declare.q AVL_GetLastKey(*AVL.AVL_TREE) ; Key or #Null
Declare.q AVL_GetClosestKey(*AVL.AVL_Tree, Key.q)
Declare.i AVL_GetClosestNode(*AVL.AVL_Tree, Key.q)
Declare.i AVL_GetNodeCount(*AVL.AVL_TREE)
Declare.i AVL_GetNode(*AVL.AVL_TREE, Key.q)
Declare.i AVL_NodeHeight(*NODE.AVL_NODE)
Declare.q AVL_NodeKey(*NODE.AVL_NODE)
Declare.q AVL_NodeData(*NODE.AVL_NODE)
Declare.i AVL_FirstNode(*NODE.AVL_NODE)
Declare.i AVL_LastNode(*NODE.AVL_NODE)
Declare.i AVL_NextNode(*NODE.AVL_NODE)
Declare.i AVL_PreviousNode(*NODE.AVL_NODE)
EndDeclareModule
Module AVLTree
; internal procedures, ported & adapted from C code
Procedure _max(a, b)
If a > b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure.i _new_tree(StructSize, fnClearNodeData, fnInitNodeData)
Protected *NEW.AVL_TREE
Debug #PB_Compiler_Procedure
If StructSize < 1
ProcedureReturn #Null
EndIf
*NEW = AllocateMemory(SizeOf(AVL_TREE))
If *NEW
Debug "*NEW:" + *NEW
*NEW\fnClearNodeData = fnClearNodeData
*NEW\fnInitNodeData = fnInitNodeData
*NEW\elementSize = StructSize
*NEW\root = #Null
*NEW\First = #Null
*NEW\Last = #Null
;Debug "*NEW\ROOT:"+*NEW\root
;*NEW\VT = ?VT_AVL_TREE
EndIf
ProcedureReturn *NEW
EndProcedure
Procedure.i _new_node(*AVL.AVL_TREE, Key.q)
Protected *NEW.AVL_Node, *NodeData
; Debug #PB_Compiler_Procedure + " " +*AVL+" "+Key
*NEW = AllocateMemory(SizeOf(avl_node))
If *NEW
*NEW\height = 1
*NEW\Key = Key
*NodeData = AllocateMemory(*AVL\elementSize)
*NEW\NodeData = *NodeData
*AVL\nodeCount = *AVL\nodeCount + 1
*AVL\pNewData = *NodeData
If *AVL\fnInitNodeData
*AVL\fnInitNodeData(*NodeData, *AVL\elementSize)
EndIf
EndIf
;Debug "New node *NEW #" + Str(Key) + " 0x" + RSet(Hex(*NEW), SizeOf(Integer) * 2, "0")
Protected *P.AVL_NODE, *N.AVL_NODE
Protected *NN.AVL_NODE = AVL_GetClosestNode(*AVL, Key)
If *NN
;Debug "Next Neighbor lookup for LL"
;Debug "Update neighbor nodes..."
If *NN\Key > Key
*N = *NN
*P = *NN\nPrev
Else
*P = *NN
*N = *NN\nNext
EndIf
*NEW\nNext = *N
*NEW\nPrev = *P
If *P
*P\nNext = *NEW
;Debug "PREV: " + *P\Key
Else
*AVL\First = *NEW
;Debug "New first"
EndIf
If *N
*N\nPrev = *NEW
;Debug "NEXT: " + *P\Key
Else
*AVL\Last = *NEW
;Debug "New last!"
EndIf
Else
*AVL\First = *NEW
*AVL\Last = *NEW
EndIf
ProcedureReturn *NEW
EndProcedure
Procedure.i _free_all_nodes(*AVL.AVL_Tree, *Node.AVL_NODE)
If *Node
Protected ND = (*Node\NodeData)
; Debug "Free "+ *Node\Key
If *Node\left
; Debug "Free Left " +*node\Key +" --->"
_free_all_nodes(*AVL, *node\left)
EndIf
If *Node\right
;Debug "Free Right " +*node\Key +" --->"
_free_all_nodes(*AVL, *node\right)
EndIf
; Debug "Free SELF: "+*node\Key+" XXXXX"
If ND
If *AVL\fnClearNodeData
*AVL\fnClearNodeData(ND, *AVL\elementSize)
EndIf
FreeMemory(ND)
*Node\NodeData = #Null
EndIf
*Node\key = #Null
*AVL\nodeCount = *AVL\nodeCount - 1
FreeMemory(*Node) ;
EndIf
EndProcedure
Procedure.i _free_node(*AVL.AVL_Tree, *Node.AVL_NODE)
Protected ND = *Node\NodeData
Protected *P.AVL_NODE = *Node\nPrev
Protected *N.AVL_NODE = *Node\nNext
If *Node
If ND
If *P
*P\nNext = *N
Else
*AVL\First = *N
EndIf
If *N
*N\nPrev = *P
Else
*AVL\Last = *P
EndIf
If *AVL\fnClearNodeData
*AVL\fnClearNodeData(ND, *AVL\elementSize)
EndIf
FreeMemory(ND)
*Node\NodeData = #Null
EndIf
*Node\key = #Null
*AVL\nodeCount = *AVL\nodeCount - 1
FreeMemory(*Node) ;
EndIf
EndProcedure
Procedure.i _height(*Node.AVL_Node)
If *NODE
ProcedureReturn *Node\height
EndIf
ProcedureReturn 0
EndProcedure
Procedure.i _rightRotate( *y.AVL_NODE)
Protected *X.AVL_NODE = *y\left
Protected *T2.AVL_NODE = *x\right
*X\right = *y
*y\left = *T2
*y\height = _max(_height(*y\left), _height(*y\right)) + 1
*x\height = _max(_height(*x\left), _height(*x\right)) + 1
ProcedureReturn *x
EndProcedure
Procedure.i _leftRotate(*x.AVL_NODE)
Protected *Y.AVL_NODE = *X\right
Protected *T2.AVL_NODE = *y\left
*Y\left = *X
*X\right = *T2
*X\height = _max(_height(*x\left), _height(*x\right)) + 1
*Y\height = _max(_height(*y\left), _height(*y\right)) + 1
ProcedureReturn *Y
EndProcedure
Procedure.i _getBalance(*Node.AVL_Node)
Protected hl, hr
If Not *Node
ProcedureReturn 0
Else
If *Node\left
hl = *Node\left\height
EndIf
If *Node\right
hr = *node\right\height
EndIf
ProcedureReturn hl - hr
EndIf
EndProcedure
Procedure.i _insert_node(*AVL.AVL_Tree, *Node.AVL_Node, Key.q)
Protected nKey.q, lKey.q, rKey.q
If *NODE = #Null
; Debug "New root"
; *AVL\pNewData = #Null
ProcedureReturn _new_node(*AVL, Key)
EndIf
nKey = *Node\Key
; Debug "Nkey -> "+Str(nkey)+" dive to "+Str(key)
If Key < nKey
; Debug "*Node\Left = _InsertNode()"
*Node\left = _insert_node(*AVL, *node\left, key)
ElseIf key > nkey
; Debug "*Node\right = _InsertNode()"
*Node\right = _insert_node(*AVL, *node\right, key)
ElseIf nKey = Key
; Debug "This node!"
ProcedureReturn #Null
EndIf
Protected lh, rh
If *Node\left
lh = *Node\left\height
lKey = *Node\Left\Key
EndIf
If *node\right
rh = *node\right\height
rKey = *node\right\Key
EndIf
If lh > rh
*Node\height = lh + 1
Else
*Node\height = rh + 1
EndIf
Protected balance = _getBalance(*node)
; left left
If balance > 1
If Key < lkey
; Debug "left left"
ProcedureReturn _rightRotate(*Node)
EndIf
EndIf
; right right
If balance < -1
If key > rkey
; Debug "right right"
ProcedureReturn _leftRotate(*Node)
EndIf
EndIf
; left right
If balance > 1
If key > lkey
; Debug "left right"
*Node\left = _leftRotate(*Node\left)
ProcedureReturn _rightRotate(*Node)
EndIf
EndIf
; right left
If balance < -1
If key < rkey
; Debug "right left"
*node\right = _rightRotate(*Node\right)
ProcedureReturn _leftRotate(*Node)
EndIf
EndIf
; Debug "return *Node"
ProcedureReturn *Node
EndProcedure
Procedure _update_height(*Root.AVL_Node)
If *Root
*root\height = 1 + _max(_height(*root\left), _height(*root\right))
EndIf
EndProcedure
Procedure.i _delete_node(*AVL.AVL_Tree, *root.AVL_Node, Key.q, *parent.AVL_Node)
; ....
If *root
Protected rk.q = *root\Key
Protected *temp.AVL_Node
If key < rk
*root\left = _delete_node(*AVL, *root\left, key, *root)
ElseIf key > rk
*root\right = _delete_node(*AVL, *root\right, key, *root)
Else
; Check for leaf node
If *root\left = #Null And *root\right = #Null
; Debug "Free LEAF"
_free_node(*AVL, *root)
ProcedureReturn #Null ;*parent
ElseIf (*Root\left <> #Null) XOr (*root\right <> #Null)
; Debug "free XOR"
If *root\right
*temp = *root\right
Else
*temp = *root\left
EndIf
_free_node(*AVL, *root)
*root = *temp
Else
*temp = *root\right
While *temp\left
*temp = *temp\left
Wend
Swap *root\Key, *temp\Key
Swap *root\NodeData , *temp\NodeData
*root\right = _delete_node(*AVL, *root\right, *temp\Key, *root)
EndIf
EndIf
_update_height(*root)
Protected balance = _getBalance(*root)
If balance > 1
If _getBalance(*root\left) < 0
*root\left = _leftRotate(*root\left)
EndIf
*root = _rightRotate(*root)
ElseIf balance < -1
If _getBalance(*root\right) > 0
*root\right = _rightRotate(*root\right)
EndIf
*root = _leftRotate(*root)
EndIf
EndIf
ProcedureReturn *root
EndProcedure
; ------------------------------------------------------------------------------------------------------
; --- Public procedures
; --- =================
; ------------------------------------------------------------------------------------------------------
Procedure.i AVL_NewTree(ElementSize, fnClearNodeData, fnInitNodeData)
ProcedureReturn _new_tree(ElementSize, fnClearNodeData, fnInitNodeData)
EndProcedure
Procedure.i AVL_NewNode(*AVL.AVL_Tree, Key.q)
Protected *X.AVL_Node
*X = *AVL\root
While *X
If *X\Key > Key
*X = *X\left
ElseIf *X\Key = Key
;Debug "Node already exists"
ProcedureReturn #Null
Else
*X = *X\right
EndIf
Wend
*X = _insert_node(*AVL, *AVL\root, Key)
Protected result = #Null
If *X
*AVL\root = *X
result = *AVL\pNewData
*AVL\pNewData = #Null
EndIf
ProcedureReturn result
EndProcedure
Procedure.i AVL_NodeExist(*AVL.AVL_Tree, Key.q)
Protected *N.AVL_Node = *AVL\root
While *N
If *N\Key > Key
*N = *N\left
ElseIf *N\Key < Key
*N = *N\right
Else
ProcedureReturn *N\NodeData
EndIf
Wend
ProcedureReturn #Null
EndProcedure
Procedure.i AVL_FirstNode(*AVL.AVL_TREE)
ProcedureReturn *AVL\First
EndProcedure
Procedure.i AVL_LastNode(*AVL.AVL_TREE)
ProcedureReturn *AVL\Last
EndProcedure
Procedure.i AVL_NextNode(*NODE.AVL_NODE)
ProcedureReturn *NODE\nNext
EndProcedure
Procedure.i AVL_PreviousNode(*NODE.AVL_NODE)
ProcedureReturn *NODE\nPrev
EndProcedure
Procedure.q AVL_NodeKey(*NODE.AVL_NODE)
ProcedureReturn *NODE\Key
EndProcedure
Procedure.q AVL_NodeData(*NODE.AVL_NODE)
ProcedureReturn *NODE\NodeData
EndProcedure
Procedure.i AVL_NodeHeight(*NODE.AVL_NODE)
If *NODE
ProcedureReturn *NODE\height
EndIf
EndProcedure
Procedure.i AVL_GetNode(*AVL.AVL_Tree, Key.q)
Protected *X.AVL_NODE = *AVL\root
While *X
If Key < *X\Key
*X = *X\left
ElseIf Key > *X\Key
*X = *X\right
Else
ProcedureReturn *X
EndIf
Wend
ProcedureReturn #Null
EndProcedure
Procedure.q AVL_GetFirstKey(*AVL.AVL_Tree)
Protected *N.AVL_Node = *AVL\First
If *N
ProcedureReturn *N\Key
EndIf
ProcedureReturn #Null
EndProcedure
Procedure.q AVL_GetLastKey(*AVL.AVL_Tree)
Protected *N.AVL_Node = *AVL\Last
If *N
ProcedureReturn *N\Key
EndIf
ProcedureReturn #Null
EndProcedure
Procedure.i AVL_GetClosestNode(*AVL.AVL_Tree, Key.q)
;Debug #PB_Compiler_Procedure + " "+*AVL+" "+Key
Protected *N.AVL_NODE = *AVL\root
If *N = *AVL
*N = 0
EndIf
; Debug "AVL: "+*N
;Debug "Root: "+*N
While *N
; Debug "...."+ *N
If Key < *N\Key
If *N\left
*N = *N\left
Else
ProcedureReturn *N
EndIf
ElseIf Key > *N\Key
If *N\right
*N = *N\right
Else
ProcedureReturn *N
EndIf
Else
ProcedureReturn *N
EndIf
Wend
ProcedureReturn #Null
EndProcedure
Procedure.q AVL_GetClosestKey(*AVL.AVL_Tree, Key.q)
Protected *N.AVL_NODE = AVL_GetClosestNode(*AVL, Key)
If *N
ProcedureReturn *N\Key
EndIf
ProcedureReturn #Null
EndProcedure
Procedure.q AVL_GetPreviousKey(*AVL.AVL_Tree, Key.q)
Protected *X.AVL_NODE = AVL_GetClosestNode(*AVL, Key)
If *X
If *X\Key < Key
ProcedureReturn *X\Key
ElseIf *X\Key = Key
*X = *X\nPrev
If *X
ProcedureReturn *X\Key
EndIf
Else
*X = *X\nPrev
If *X
ProcedureReturn *X\Key
EndIf
EndIf
EndIf
ProcedureReturn #Null
EndProcedure
Procedure.q AVL_GetNextKey(*AVL.AVL_Tree, Key.q)
Protected *X.AVL_NODE = AVL_GetClosestNode(*AVL, Key)
If *X
If *X\Key > Key
ProcedureReturn *X\Key
ElseIf *X\Key = Key
*X = *X\nNext
If *X
ProcedureReturn *X\Key
EndIf
Else
*X = *X\nNext
If *X
ProcedureReturn *X\Key
EndIf
EndIf
EndIf
ProcedureReturn #Null
EndProcedure
Procedure.i AVL_GetNodeCount(*AVL.AVL_Tree)
If *AVL
ProcedureReturn *AVL\nodeCount
EndIf
EndProcedure
Procedure.i AVL_DeleteNode(*AVL.AVL_Tree, Key.q)
If *AVL\root
; Debug "Delete Node #" + key
*AVL\root = _delete_node(*AVL, *AVL\root, key, #Null)
EndIf
EndProcedure
Procedure.i AVL_FreeTree(*AVL.AVL_Tree)
_free_all_nodes(*AVL, *AVL\root)
FreeMemory(*AVL)
EndProcedure
Procedure.i AVL_Iterate(*AVL.AVL_Tree, fnIteratorCallback.fnIteratorCallback, userdata)
Protected result , *N.AVL_NODE = *AVL\First
If fnIteratorCallback
;Debug "*N=" + *N
While *N And Not result
result = fnIteratorCallback(userdata, *N\Key, *N\NodeData, *N)
*N = *N\nNext
Wend
Else
ProcedureReturn #True
;Debug "NO CALLBACK!"
EndIf
ProcedureReturn result
EndProcedure
Procedure.i AVL_IterateRange(*AVL.AVL_Tree, FromKey.q, ToKey.q, fnIteratorCallback.fnIteratorCallback, userdata)
Protected result , *N.AVL_NODE
If fnIteratorCallback
If FromKey <= ToKey
; Forward iteration
*N = AVL_GetClosestNode(*AVL, FromKey)
If *N
If *N\Key > FromKey
*N = *N\nPrev
EndIf
If *N\Key < FromKey
*N = *N\nNext
EndIf
EndIf
While *N And Not result
If *N\Key > ToKey
Break
EndIf
result = fnIteratorCallback(userdata, *N\Key, *N\NodeData, *N)
*N = *N\nNext
Wend
Else
*N = AVL_GetClosestNode(*AVL, ToKey)
If *N
If *N\Key < ToKey
*N = *N\nNext
EndIf
If *N\Key > ToKey
*N = *N\nPrev
EndIf
EndIf
While *N And Not result
If *N\Key < FromKey
Break
EndIf
result = fnIteratorCallback(userdata, *N\Key, *N\NodeData, *N)
*N = *N\nPrev
Wend
EndIf
Else
;Debug "NO CALLBACK!"
EndIf
ProcedureReturn result
EndProcedure
EndModule
Test the module
Code: Select all
CompilerIf #PB_Compiler_IsMainFile
CompilerIf #PB_Compiler_Debugger
CompilerError "Switch Debugger OFF please"
CompilerEndIf
UseModule AVLTree
Procedure onClearString(*NodeData)
ClearStructure(*NodeData, STRING)
EndProcedure
Procedure onInitString(*NodeData)
InitializeStructure(*NodeData, STRING)
EndProcedure
Define NodeNumber
Procedure DebugNodes(*Node.AVL_Node)
Shared NodeNumber
If *Node
DebugNodes(*NODE\left)
Protected *tString.STRING = *NODE\NodeData
NodeNumber + 1
Debug RSet(Str(NodeNumber), 8) + ". Key:" + RSet(Str(*Node\Key), 16, "0") + " Height:" + Str(*Node\height) + " " + *tString\s
DebugNodes(*NODE\right)
EndIf
EndProcedure
Procedure DebugAVLTree(*AVL.AVL_TREE)
Shared NodeNumber
NodeNumber = 0
DebugNodes(*AVL\root)
EndProcedure
DisableExplicit
;
Procedure Main()
UseModule AVLTREE
AVLTREE = AVLTree::AVL_NewTree(SizeOf(String), @onClearString(), @onInitString())
Debug "adding regular nodes 1-100"
Protected *NSTRING.STRING, inval.s, qval.q , msg.s, i, k.q
For i = 1 To 150
*NSTRING = AVL_NewNode(AVLTREE, i)
If *NSTRING
*NSTRING\s = "Node #" + Str(i) + " /regular @" + Str(*NSTRING)
Else
Debug "ERROR, could not create REGULAR node #" + Str(i)
EndIf
Next
Debug "adding random nodes"
#MAXRANDOM = 1024 * 1024 * 2
Protected ms = ElapsedMilliseconds()
Protected ti
For i = 1 To #MAXRANDOM
k = 1000 + i ; Random(#MAXRANDOM * 3, 100) - Random(#MAXRANDOM * 3, 100)
*NSTRING = AVL_NewNode(AVLTREE, k)
;Debug k
If *NSTRING
*NSTRING\s = "Node #" + Str(k) + " /random (pass " + Str(i) + ") @" + Str(*NSTRING)
ti + 1
Else
Debug "ERROR, could not create RANDOM node #" + Str(k)
EndIf
Next
ms = ElapsedMilliseconds() - ms
For i = 20 To 30
Debug "remove key " + i
AVL_DeleteNode(AVLTREE, i)
Next
Debug "debugging tree"
CompilerIf #PB_Compiler_Debugger
DebugAVLTree(AVLTREE)
CompilerEndIf
Debug "Node count: " + AVL_GetNodeCount(AVLTREE)
Debug "Min Key:" + AVL_GetFirstKey(AVLTREE)
Debug "Max Key:" + AVL_GetLastKey(AVLTREE)
InVal = InputRequester("Enter number", "Enter key number to search for -INFINTE to +INFINITE", "10")
If InVal <> #Empty$
qVal = Val(InVal)
Msg = "Input value: " + InVal + #CRLF$
Msg + "Quad value:" + Str(qVal) + #CRLF$
Msg + "Random values: " + FormatNumber(ti, 0) + #CRLF$
Msg + "Random gen time: " + FormatNumber(ms, 0) + #CRLF$
Msg + "Item count: " + FormatNumber(AVL_GetNodeCount(AVLTREE), 0) + #CRLF$
Msg + "-----------------" + #CRLF$
msg + "Exists: "
*NSTRING = AVL_NodeExist(AVLTREE, qVal)
If *NSTRING = #Null
Msg + "No" + #CRLF$
Else
Msg + "Yes" + #CRLF$
Msg + *NSTRING\s + #CRLF$
EndIf
Msg + #CRLF$
MessageRequester("AVLTree", Msg)
EndIf
Delay(1)
AVL_FreeTree(AVLTREE)
UnuseModule AVLTree
EndProcedure
main()
CompilerEndIf


