AA-Tree (self balancing binary tree)

Share your advanced PureBasic knowledge/code with the community.
User avatar
luis
Addict
Addict
Posts: 3876
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

AA-Tree (self balancing binary tree)

Post by luis »

A self-balancing binary tree based on the AA-Tree data structure as defined by Arne Andersson.

Readme
https://github.com/spettroscopio/SBBT#readme

Download

For a similar algorithm by DarkDragon based on an AVL trees see this one instead
http://www.purebasic.fr/english/viewtop ... 12&t=40116
Last edited by luis on Mon Aug 21, 2023 11:06 pm, edited 15 times in total.
"Have you tried turning it off and on again ?"
A little PureBasic review
User avatar
luis
Addict
Addict
Posts: 3876
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: AA-Tree (self balancing binary tree)

Post by luis »

[superseded]
Last edited by luis on Mon May 08, 2023 1:11 pm, edited 2 times in total.
"Have you tried turning it off and on again ?"
A little PureBasic review
User avatar
luis
Addict
Addict
Posts: 3876
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: AA-Tree (self balancing binary tree)

Post by luis »

[superseded]
Last edited by luis on Mon May 08, 2023 1:11 pm, edited 3 times in total.
"Have you tried turning it off and on again ?"
A little PureBasic review
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8425
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: AA-Tree (self balancing binary tree)

Post by netmaestro »

Looks very good, thanks for sharing. I can definitely find a use for this. I can probably use your Archimede computer too, if you wouldn`t mind packing it up and shipping it to me, in exchange I can teach you how to understand women or perhaps show you how to build your own orbiting spacecraft out of an old Volkswagen Beetle. It`s either the women or the Beetle though, if you try to use both at once you`re going to end up getting a cramp somewhere.

Image
(Not exactly to scale)
BERESHEIT
Little John
Addict
Addict
Posts: 4519
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: AA-Tree (self balancing binary tree)

Post by Little John »

Luis, many thanks for sharing!
User avatar
luis
Addict
Addict
Posts: 3876
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: AA-Tree (self balancing binary tree)

Post by luis »

You are both welcome

@NM
Whoa ! What's just happened ? And the composition with the Beetle, myself and the Earth.... (not saying isn't nice!) are you sure you are not meeting with KCC outside from the forum activities ?
I would love to have my personal orbiting spacecraft tough, as long as I still can communicate with the world from a safe distance.
OK, even if I can't.
(Not exactly to scale)
Nice touch :D
"Have you tried turning it off and on again ?"
A little PureBasic review
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: AA-Tree (self balancing binary tree)

Post by IdeasVacuum »

I would love to have my personal orbiting spacecraft
As per your well considered/built hardware set-up, this is a wise choice, given that we can be confident that Netmaestro could deliver on this wish. As for his other claim, that is clearly dubious.........
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
Demivec
Addict
Addict
Posts: 4086
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: AA-Tree (self balancing binary tree)

Post by Demivec »

luis: Nice contribution!

netmaestro wrote:(Not exactly to scale)
@netmaestro: you are too modest, it is to scale if you are near the beetle with the earth in the background. :) But that's really not up to me to decide, luis will know soon enough when he test drives the beetle.
User avatar
idle
Always Here
Always Here
Posts: 5042
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: AA-Tree (self balancing binary tree)

Post by idle »

Thanks Luis, now we just need to wait for Kcc to post his animated orbiting beetle!
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
skywalk
Addict
Addict
Posts: 3972
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: AA-Tree (self balancing binary tree)

Post by skywalk »

netmaestro wrote:I can teach you how to understand women or perhaps show you how to build your own orbiting spacecraft out of an old Volkswagen Beetle.
Go for the spacecraft! There will be men on Mars before anyone here understands women! :lol:
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
Little John
Addict
Addict
Posts: 4519
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: AA-Tree (self balancing binary tree)

Post by Little John »

For convenience, here is a small comparison chart.

Comparison of AA trees and their main competitor, built-in maps

Code: Select all

                    | PB's built-in map | AA tree
                    | (= hash table)    |
--------------------+-------------------+------------------
ordered enumeration | not               | time
of all items        | provided          | O(n)
--------------------+-------------------+------------------
                    | worst-case time   | worst-case time
lookup,             | O(n)              | O(log n)
insertion           +-------------------+------------------
or removal          | average-case time | average-case time
of an item          | under reasonable  |
                    | conditions        |
                    | O(1)              | O(log n)
User avatar
luis
Addict
Addict
Posts: 3876
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Re: AA-Tree (self balancing binary tree) 1.10

Post by luis »

Updated to 1.10

I've changed the way enumeration works, now you can enumerate ascending/descending not only from the root (all the items) but from any subtree (and you still get that subtree's items ordered).

Also I've added the ability to manually navigate the tree, introduced the concept of current node and the ability to retrieve key and value for the current node. Added a new demo TEST6 to show how these new commands works.

See the remarks in the procs to see how the current node value is set and / or try the demos.

The previous demos were also updated since the syntax used to enumerate the nodes changed.

For my uses I think it's enough for now :wink:
"Have you tried turning it off and on again ?"
A little PureBasic review
kinglestat
Enthusiast
Enthusiast
Posts: 732
Joined: Fri Jul 14, 2006 8:53 pm
Location: Malta
Contact:

Re: AA-Tree (self balancing binary tree) 1.10

Post by kinglestat »

Ah nice done in PB
I have written somehting simnilar - an AVL tree which also is self balancing but in C,
I posted the lib called cieve I think.
Well done
I may not help with your coding
Just ask about mental issues!

http://www.lulu.com/spotlight/kingwolf
http://www.sen3.net
Little John
Addict
Addict
Posts: 4519
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: AA-Tree (self balancing binary tree) 1.10

Post by Little John »

Hi Luis,

thanks again for your AA Tree code!

I took the liberty to wrap it in a module. This was easy, since your code is well organized, and it is well documented what needs to be public. All your tests seem to run fine here with PB 5.70 beta 1 on Windows 10 x64.
I documented all my changes at the beginning of each file.

AA-Tree.pbi

Code: Select all

; AA-Tree (self-balancing binary tree) 1.10m
; PB 5.11 (& PB 5.70 beta 1)
; Luis, April 2013 (& Little John, July 2018)
;
; http://en.wikipedia.org/wiki/Self-balancing_binary_search_tree
; http://en.wikipedia.org/wiki/AA_tree
;
; This implementation supports:
; insert, search, delete, automatic enumeration in ascending and descending order for the whole tree or a single subtree, manual navigation of the tree.

; You can use it with just the key (a string), or you can associate optional external data to each stored key through a user value.
; See the examples for more info.

; 1.00 (april 2013)
; first version

; 1.01 (april 2013)
; minor modifications to examples and added one assert

; 1.10 (may 2013)
; modified the enumeration API and added manual navigation
; changed EnumStart(), EnumNext() and added EnumStartFromCurrent() 
; added : GetNodeValue(), GetNodeKey(), IsCurrentNode()
; added : IsLeft(), IsRight(), GoRoot(), GoLeft(), GoRight()
; examples updated and added a new example (TEST6)

; 1.10m (July 2018) -- by Little John
; - wrapped in a module, and changed names of public procedures and constants
; - Instead of Luis' "Assert.pb" this version just uses PB's built in Assert() macro
;   (file "PureUnit.res" must be located in the "Residents\" subfolder).


DeclareModule AAT
   #EnumAscending = 0
   #EnumDescending = 1
   
   Structure T_AAT_NODE
      *left.T_AAT_NODE
      *right.T_AAT_NODE
      key$
      value.i
      level.i
   EndStructure
   
   Structure T_AAT
      *root.T_AAT_NODE
      *EnumCurrentNode.T_AAT_NODE
      *CurrentNode.T_AAT_NODE
      *fpFreeItem
      EnumDirection.i
      EnumInProgress.i
      TotalNodes.i
      LastPathLength.i   
      Modified.i 
   EndStructure
   
   ; create new tree with optional callback to free user-allocated elements
   Declare.i New (*fpFreeItem = 0)
   
   ; destroy the tree
   Declare Destroy (*tree.T_AAT)
   
   ; clear the tree
   Declare.i Clear (*tree.T_AAT)
   
   ; return the num of nodes
   Declare.i CountNodes (*tree.T_AAT)
   
   ; the len of the last path followed to access an item
   Declare.i GetLastPathLength (*tree.T_AAT)
   
   ; start enumeration (tree become temporart read-only)
   Declare.i EnumStart (*tree.T_AAT, direction = #EnumAscending)
   
   ; start enumeration from the current node (tree become temporart read-only)
   Declare.i EnumStartFromCurrent (*tree.T_AAT, direction = #EnumAscending)
   
   ; stop enumeration
   Declare.i EnumEnd (*tree.T_AAT)
   
   ; get the key of the next node and optionally the user data value if any
   Declare.i EnumNext (*tree.T_AAT) 
   
   ; insert a new key in the tree and optionally associate the user data value if any
   Declare.i Insert (*tree.T_AAT, key$, value = 0)
   
   ; search for a key in the tree and optionally return the associated user data value if any
   Declare.i Search (*tree.T_AAT, key$, *value.Integer = 0)
   
   ; delete a key from the tree and optionally return the associated user data value if any
   Declare.i Delete (*tree.T_AAT, key$, *value.Integer = 0)
   
   ; check if there is a current node or not
   Declare.i IsCurrentNode (*tree.T_AAT)
   
   ; get the key of the current node
   Declare.s GetNodeKey (*tree.T_AAT)
   
   ; get the value (if any) associated with the current node
   Declare.i GetNodeValue (*tree.T_AAT)
   
   ; check if there is a node to the left of the current node
   Declare.i IsLeft (*tree.T_AAT)
   
   ; check if there is a node to the right of the current node
   Declare.i IsRight (*tree.T_AAT)
   
   ; set the current node to the root
   Declare.i GoRoot (*tree.T_AAT)
   
   ; set the current node to the node at the left of the current node
   Declare.i GoLeft (*tree.T_AAT)
   
   ; set the current node to the node at the right of the current node
   Declare.i GoRight (*tree.T_AAT)
EndDeclareModule


Module AAT
   EnableExplicit
   
   ;********************************************************************
   ;- PRIVATE
   ;********************************************************************
   
   Procedure.i _AAT_Min (iVal1, iVal2)
      If iVal1 < iVal2
         ProcedureReturn iVal1
      EndIf 
      ProcedureReturn iVal2 
   EndProcedure
   
   Procedure.i _AAT_Split (*node.T_AAT_NODE)
      Protected *Right.T_AAT_NODE
      
      If *node = #Null
         ProcedureReturn #Null
      EndIf
      
      If *node\right = #Null Or *node\right\right = #Null
         ProcedureReturn *node
      EndIf
      
      If *node\level = *node\right\right\level
         *Right = *node\right
         *node\right = *Right\left
         *Right\left = *node
         *Right\level + 1
         ProcedureReturn *Right
      EndIf
      
      ProcedureReturn *node
   EndProcedure
   
   Procedure.i _AAT_Skew (*node.T_AAT_NODE)
      Protected *Left.T_AAT_NODE
      
      If *node = #Null
         ProcedureReturn #Null
      EndIf
      
      If *node\left = #Null
         ProcedureReturn *node
      EndIf
      
      If *node\left\level = *node\level
         *Left = *node\left
         *node\left = *Left\right
         *Left\right = *node
         ProcedureReturn *Left
      Else
         ProcedureReturn *node
      EndIf
   EndProcedure
   
   Procedure.i _AAT_DecreaseLevel (*node.T_AAT_NODE)
      Protected target, ll = 0, lr = 0
      
      ASSERT(*node <> #Null)
      
      If *node\left
         ll = *node\left\level
      EndIf
      
      If *node\right
         lr = *node\right\level
      EndIf
      
      target = _AAT_Min(ll, lr) + 1
      
      If target < *node\level
         *node\level = target
         If *node\right
            If target < *node\right\level
               *node\right\level = target
            EndIf
         EndIf
      EndIf
      ProcedureReturn *node
   EndProcedure
   
   Procedure.i _AAT_Predecessor (*node.T_AAT_NODE)
      If *node\right
         ProcedureReturn _AAT_Predecessor(*node\right)
      EndIf
      ProcedureReturn *node
   EndProcedure
   
   Procedure.i _AAT_Successor (*node.T_AAT_NODE)
      If *node\left
         ProcedureReturn _AAT_Successor(*node\left)
      EndIf
      ProcedureReturn *node
   EndProcedure
   
   Procedure _AAT_Free (*tree.T_AAT, *node.T_AAT_NODE)
      If *node
         _AAT_Free (*tree, *node\left)
         _AAT_Free (*tree, *node\right)
         
         If *tree\fpFreeItem         
            CallFunctionFast(*tree\fpFreeItem, *node\value)
         EndIf
         
         *tree\TotalNodes - 1   
         ClearStructure(*node, T_AAT_NODE)
         FreeMemory(*node)   
      EndIf
   EndProcedure
   
   Procedure.i _AAT_Delete (*tree.T_AAT, *node.T_AAT_NODE, *key, *value.Integer = 0)
      Protected *Left.T_AAT_NODE
      
      *tree\LastPathLength + 1
      
      If *node = #Null
         ProcedureReturn *node
      EndIf
      
      If PeekS(*key) > *node\key$
         *node\right = _AAT_Delete(*tree, *node\right, *key, *value)
         
      ElseIf PeekS(*key) < *node\key$
         *node\left = _AAT_Delete(*tree, *node\left, *key, *value)   
         
      Else
         
         *tree\Modified = #True
         
         If *node\left = #Null And *node\right = #Null ; leaf
            If *value
               *value\i = *node\value
            EndIf
            ProcedureReturn #Null
         EndIf
         
         If *node\left = #Null
            *Left = _AAT_Successor(*node\right)
            *node\right = _AAT_Delete(*tree, *node\right, @*Left\key$, *value)
         Else
            *Left = _AAT_Predecessor(*node\left)
            *node\left = _AAT_Delete(*tree, *node\left, @*Left\key$, *value)
         EndIf       
         
         If *value
            *value\i = *node\value
         EndIf   
         
         *node\key$ = *Left\key$   
         *node\value = *Left\value
      EndIf
      
      *node = _AAT_DecreaseLevel(*node)
      
      *node = _AAT_Skew(*node)
      
      *node\right = _AAT_Skew(*node\right)
      
      If *node\right
         *node\right\right = _AAT_Skew(*node\right\right)
      EndIf
      
      *node = _AAT_Split(*node)
      
      *node\right = _AAT_Split(*node\right)   
      
      ProcedureReturn *node
   EndProcedure
   
   Procedure.i _AAT_Insert (*tree.T_AAT, *node.T_AAT_NODE, *key, value) 
      *tree\LastPathLength + 1
      
      If *node = #Null
         *node = AllocateMemory(SizeOf(T_AAT_NODE))   
         ASSERT(*node, "Out of memory.")
         
         *node\key$ = PeekS(*key)
         *node\value = value
         *node\level = 1
         *tree\CurrentNode = *node
         *tree\Modified = #True           
         ProcedureReturn *node
         
      ElseIf PeekS(*key) < *node\key$
         *node\left = _AAT_Insert (*tree, *node\left, *key, value)   
      ElseIf PeekS(*key) > *node\key$
         *node\right = _AAT_Insert (*tree, *node\right, *key, value)     
      EndIf       
      
      *node = _AAT_Skew(*node)
      
      *node = _AAT_Split(*node)
      
      ProcedureReturn *node
   EndProcedure
   
   Procedure.i _AAT_Search (*tree.T_AAT, *node.T_AAT_NODE, *key)   
      *tree\LastPathLength + 1
      
      If *node
         If PeekS(*key) < *node\key$   
            ProcedureReturn _AAT_Search (*tree, *node\left, *key)       
         ElseIf PeekS(*key) > *node\key$   
            ProcedureReturn _AAT_Search (*tree, *node\right, *key)       
         Else   
            ProcedureReturn *node       
         EndIf
      EndIf
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i _AAT_EnumNextAscending (*tree.T_AAT)
      Protected *pre.T_AAT_NODE
      
      While *tree\EnumCurrentNode
         If *tree\EnumCurrentNode\left = 0
            
            *tree\CurrentNode = *tree\EnumCurrentNode
            
            *tree\EnumCurrentNode = *tree\EnumCurrentNode\right
            
            ProcedureReturn 1
         Else
            *pre = *tree\EnumCurrentNode\left
            
            While *pre\right And *pre\right <> *tree\EnumCurrentNode
               *pre = *pre\right
            Wend
            
            If *pre\right = 0
               *pre\right = *tree\EnumCurrentNode
               *tree\EnumCurrentNode = *tree\EnumCurrentNode\left
            Else
               *pre\right = #Null
               
               *tree\CurrentNode = *tree\EnumCurrentNode
               
               *tree\EnumCurrentNode = *tree\EnumCurrentNode\right
               
               ProcedureReturn 1
            EndIf               
         EndIf
      Wend
      
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i _AAT_EnumNextDescending (*tree.T_AAT)
      Protected *pre.T_AAT_NODE
      
      While *tree\EnumCurrentNode
         If *tree\EnumCurrentNode\right = 0
            
            *tree\CurrentNode = *tree\EnumCurrentNode
            
            *tree\EnumCurrentNode = *tree\EnumCurrentNode\left
            
            ProcedureReturn 1
         Else
            *pre = *tree\EnumCurrentNode\right
            
            While *pre\left And *pre\left <> *tree\EnumCurrentNode
               *pre = *pre\left
            Wend
            
            If *pre\left = 0
               *pre\left = *tree\EnumCurrentNode
               *tree\EnumCurrentNode = *tree\EnumCurrentNode\right
            Else
               *pre\left = #Null
               
               *tree\CurrentNode = *tree\EnumCurrentNode
               
               *tree\EnumCurrentNode = *tree\EnumCurrentNode\left
               
               ProcedureReturn 1
            EndIf               
         EndIf
      Wend
      
      ProcedureReturn 0
   EndProcedure
   
   
   
   ;********************************************************************
   ;- PUBLIC
   ;********************************************************************
   
   Procedure.i New (*fpFreeItem = 0)
      ; *fpFreeItem is to call an optional callback if you used external data and you want to remove that data too automatically.
      ; Please note sometimes this is not what you want, because the same data can be associated to different datastructures for example,
      ; or because the data must continue to live on even if a tree has been cleared/destroyed.
      ; But some other times when the data and the tree are really one and the same you can find the callback useful.
      
      Protected *tree.T_AAT
      
      *tree = AllocateMemory(SizeOf(T_AAT))
      
      ASSERT(*tree, "Out of memory.")
      
      ClearStructure(*tree, T_AAT)
      
      *tree\fpFreeItem = *fpFreeItem
      
      ProcedureReturn *tree
   EndProcedure
   
   Procedure Destroy (*tree.T_AAT)
      ; Release the tree
      
      ASSERT(*tree)
      
      If *tree\root
         _AAT_Free(*tree, *tree\root)
         ClearStructure(*tree, T_AAT)
         FreeMemory(*tree)
      EndIf
   EndProcedure
   
   Procedure.i Clear (*tree.T_AAT)
      ; Clear the tree
      
      ASSERT(*tree)
      
      If *tree\root
         _AAT_Free(*tree, *tree\root)
         ClearStructure(*tree, T_AAT)
      EndIf
   EndProcedure
   
   Procedure.i CountNodes (*tree.T_AAT)
      ; Return the number of nodes in the tree
      
      ASSERT(*tree)
      
      ProcedureReturn *tree\TotalNodes
   EndProcedure
   
   Procedure.i GetLastPathLength (*tree.T_AAT)
      ; Return the length of the last path walked for the last search/insert/delete operation.
      
      ASSERT(*tree)
      
      ProcedureReturn *tree\LastPathLength
   EndProcedure
   
   Procedure.i EnumEnd (*tree.T_AAT)
      ; End the current enumeration sequence and unlock the tree to allow modifications.
      ; The current node is undefined after calling this.
      
      ASSERT(*tree)
      ASSERT(*tree\EnumInProgress = 1, "Enumeration is not in progress.")
      
      *tree\CurrentNode = 0
      *tree\EnumCurrentNode = 0
      *tree\EnumInProgress = 0
   EndProcedure
   
   Procedure.i EnumStart (*tree.T_AAT, direction = #EnumAscending)
      ; Prepare the tree to be enumerated with AAT_EnumNext() in ascending or descending order.
      ; Return 1 if ready to enumerate, 0 in case of error (tree empty)
      ; The current node is undefined after calling this.
      
      ASSERT(*tree)
      ASSERT(*tree\EnumInProgress = 0, "Enumeration is already in progress.")
      ASSERT(direction = #EnumAscending Or direction = #EnumDescending)
      
      *tree\EnumCurrentNode = *tree\root
      *tree\CurrentNode = 0
      *tree\EnumInProgress = 1
      *tree\EnumDirection = direction
      
      If *tree\TotalNodes 
         ProcedureReturn 1
      EndIf
      
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i EnumStartFromCurrent (*tree.T_AAT, direction = #EnumAscending)
      ; Like EnumStart, but from the current node instead of the root.
      ; The current node is undefined after calling this.
      
      ASSERT(*tree)
      ASSERT(*tree\EnumInProgress = 0, "Enumeration is already in progress.")
      ASSERT(direction = #EnumAscending Or direction = #EnumDescending)
      
      *tree\EnumCurrentNode = *tree\CurrentNode
      *tree\CurrentNode = 0
      *tree\EnumInProgress = 1
      *tree\EnumDirection = direction
      
      If *tree\TotalNodes 
         ProcedureReturn 1
      EndIf
      
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i EnumNext (*tree.T_AAT)
      ; Enumerate the next node from the tree, setting the current node to it.
      ; Return 0 if there are not more items to enumerate.
      ; NOTE: You cannot alter the tree structure while an enumeration is in progress (no insert / no delete).
      
      ASSERT(*tree)
      ASSERT(*tree\EnumInProgress = 1)
      
      If *tree\EnumDirection = #EnumAscending
         ProcedureReturn _AAT_EnumNextAscending (*tree)
      Else
         ProcedureReturn _AAT_EnumNextDescending (*tree)
      EndIf
   EndProcedure
   
   Procedure.i Insert (*tree.T_AAT, key$, value = 0)   
      ; Insert a new item in the tree using key$, with an optional value.
      ; At least you need to specify the key, value is optional and it's usually a pointer.
      ; Return 1 if the item is inserted, else 0 (an item with that key was already present or the tree is being enumerated).
      ; The current node is set to the one just inserted.
      
      Protected *node.T_AAT_NODE
      
      ASSERT(*tree)
      ASSERT(Len(key$))
      ASSERT(*tree\EnumInProgress = 0, "Tree is locked for enumeration.")
      
      If *tree\EnumInProgress = 0
         *tree\LastPathLength = 0
         
         *node = _AAT_Insert(*tree, *tree\root, @key$, value)
         
         ASSERT(*node)
         
         *tree\root = *node
         
         If *tree\Modified
            *tree\Modified = #False
            *tree\TotalNodes + 1       
            ProcedureReturn 1
         EndIf
      EndIf
      
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i Search (*tree.T_AAT, key$, *value.Integer = 0)   
      ; Search for an item in the tree using key$.
      ; If *value is not null, copy the associated value there.
      ; Return 1 if the item is found, else 0.
      ; The current node is set to the one found.
      
      Protected *node.T_AAT_NODE
      
      ASSERT(*tree)
      ASSERT(Len(key$))
      
      *tree\LastPathLength = 0
      
      *node = _AAT_Search(*tree, *tree\root, @key$) 
      
      If *node
         If *value 
            *value\i = *node\value
         EndIf
         *tree\CurrentNode = *node
         ProcedureReturn 1
      EndIf   
      
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i Delete (*tree.T_AAT, key$, *value.Integer = 0)   
      ; Delete the item indexed by key$ from the tree.
      ; If *value is not null, copy the associated value there.
      ; Return 1 if the item has been deleted, else 0 (item not found or the tree is being enumerated).
      ; The current node is undefined after calling this.
      
      Protected *node.T_AAT_NODE
      Protected local_value
      
      ASSERT(*tree)
      ASSERT(Len(key$))
      ASSERT(*tree\EnumInProgress = 0, "Tree is locked for enumeration.")
      
      If *tree\EnumInProgress = 0
         *tree\LastPathLength = 0
         
         *node = _AAT_Delete (*tree, *tree\root, @key$, @local_value)
         
         ASSERT((*node > 0) Or (*node = 0 And *tree\TotalNodes = 1))
         
         *tree\root = *node
         
         If *tree\Modified
            If *tree\fpFreeItem         
               CallFunctionFast(*tree\fpFreeItem, local_value)
            EndIf           
            
            If *value
               *value\i = local_value
            EndIf
            
            *tree\Modified = #False
            *tree\TotalNodes - 1       
            ProcedureReturn 1
         EndIf
      EndIf
      
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i IsCurrentNode (*tree.T_AAT)
      ; Return 1 if there is a current node, else 0 (current node is undefined: do a search or an insertion)
      ; If AAT_Search() is successful changes the current node to the one just found.
      ; If AAT_Insert() is successful changes the current node to the one just inserted.
      ; If AAT_Delete() is successful changes the current node to undefined.
      
      ASSERT(*tree)
      
      If *tree\CurrentNode
         ProcedureReturn 1
      EndIf
      ProcedureReturn 0
   EndProcedure
   
   Procedure.s GetNodeKey (*tree.T_AAT)
      ; Get the key of the current node
      
      ASSERT(*tree)
      ASSERT(*tree\CurrentNode)
      
      If *tree\CurrentNode
         ProcedureReturn *tree\CurrentNode\key$
      EndIf
      ProcedureReturn ""
   EndProcedure
   
   Procedure.i GetNodeValue (*tree.T_AAT)
      ; Get the value (if any) associated with the current node.
      
      ASSERT(*tree)
      ASSERT(*tree\CurrentNode)
      
      If *tree\CurrentNode
         ProcedureReturn *tree\CurrentNode\value
      EndIf
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i IsLeft (*tree.T_AAT)
      ; Check if there is a node to the left of the current node
      
      ASSERT(*tree)
      ASSERT(*tree\CurrentNode)
      
      If *tree\CurrentNode\left
         ProcedureReturn 1
      EndIf
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i IsRight (*tree.T_AAT)
      ; Check if there is a node to the right of the current node
      
      ASSERT(*tree)
      ASSERT(*tree\CurrentNode)
      
      If *tree\CurrentNode\right
         ProcedureReturn 1
      EndIf
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i GoRoot (*tree.T_AAT)
      ; Set the current node to the root node.
      ; Return 1 if successful, else 0 (this means the tree is empty).
      
      ASSERT(*tree)
      ASSERT(*tree\root)
      
      If *tree\root
         *tree\CurrentNode = *tree\root
         ProcedureReturn 1
      EndIf
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i GoLeft (*tree.T_AAT)
      ; Set the current node to the node at the left of the current node.
      ; Return 1 if successful, else 0 (in this case the current node dosnt't change).
      
      ASSERT(*tree)
      ASSERT(*tree\CurrentNode)
      
      If *tree\CurrentNode\left
         *tree\CurrentNode = *tree\CurrentNode\left
         ProcedureReturn 1
      EndIf
      ProcedureReturn 0
   EndProcedure
   
   Procedure.i GoRight (*tree.T_AAT)
      ; Set the current node to the node at the right of the current node.
      ; Return 1 if successful, else 0 (in this case the current node dosnt't change).
      
      ASSERT(*tree)
      ASSERT(*tree\CurrentNode)
      
      If *tree\CurrentNode\right
         *tree\CurrentNode = *tree\CurrentNode\right
         ProcedureReturn 1
      EndIf
      ProcedureReturn 0
   EndProcedure
EndModule
Little John
Addict
Addict
Posts: 4519
Joined: Thu Jun 07, 2007 3:25 pm
Location: Berlin, Germany

Re: AA-Tree (self balancing binary tree) 1.10

Post by Little John »

TreeView.pb

Code: Select all

; Changes in version 1.10m:
; - Prepended structure names with "AAT::"

; This is a simple tree viewer I used while debugging.
; Should be only used with a small amount of nodes (less then 100) since the screen space required to
; show a larger tree with the text from the keys displayed would be too much.
; But to verify if the code is working is more than enough.

#aat_draw_offset_y = 50

Procedure DrawNode (*node.AAT::T_AAT_NODE, w, *x.Integer, *y.Integer, level) 
   ; draw a single node
   
   Protected kw, kh, lw, offx, key$, lvl$
   
   If *node
      key$ = *node\key$
      lvl$ = "(" + Str(*node\level) + ")"
      
      kw = TextWidth(key$)
      kh = TextHeight(key$) + 1
      
      lw = TextWidth(lvl$)
      
      offx = w  / 1 << (level+1)
      
      DrawText(*x\i - kw/2, *y\i, key$, #Blue, #White)
      
      Circle(*x\i, *y\i + kh, 2, #Black)
      
      DrawText(*x\i - lw/2, *y\i + kh + 3, lvl$, #Red, #White)
      
      If *node\right
         Line(*x\i, *y\i + kh, offx, #aat_draw_offset_y - kh - 5, #Black)
      EndIf
      
      If *node\left
         Line(*x\i, *y\i + kh, - offx, #aat_draw_offset_y - kh - 5, #Black)
      EndIf   
   EndIf
EndProcedure


Procedure DrawTree (*node.AAT::T_AAT_NODE, w, *x.Integer, *y.Integer, level)
   ; navigate the tree
   
   Protected offx
   
   If *node       
      level + 1   
      offx = w  / 1 << level     
      *y\i + #aat_draw_offset_y   
      
      *x\i - offx
      DrawTree (*node\left, w, *x, *y, level)
      *x\i + offx
      
      level - 1       
      DrawNode (*node, w, *x, *y, level)
      level + 1
      
      *x\i + offx
      DrawTree (*node\right, w, *x, *y, level)     
      *x\i - offx
      
      *y\i - #aat_draw_offset_y       
   EndIf
EndProcedure


Procedure TreeView (*tree.AAT::T_AAT, w = 1280, h = 768, title$ = "")
   Protected iEvent, flgExit, x, y
   Protected iImageTree
   Protected nWin, nBtnClose, nImageTree, nFont
   
   flgExit = #False
   
   iImageTree = CreateImage(#PB_Any, w, h)
   
   If iImageTree 
      nFont = LoadFont(#PB_Any, "Arial", 7)
      
      x = w/2 : y = 10 - #aat_draw_offset_y
      
      StartDrawing(ImageOutput(iImageTree))
      DrawingFont(FontID(nFont))
      Box(0,0,w,h,#White)
      DrawTree (*tree\root, w, @x, @y, 1)
      StopDrawing()
      
      If Len(title$) = 0
         title$ = "Tree Viewer"
      EndIf
      
      nWin = OpenWindow(#PB_Any, 10, 10, w, h + 70, title$, #PB_Window_SystemMenu) 
      
      If nWin
         nBtnClose = ButtonGadget(#PB_Any, w/2 - 50, h + 35, 100, 30, "Close")               
         
         nImageTree = ImageGadget(#PB_Any, 0, 0, w, h, ImageID(iImageTree))
         
         Repeat
            iEvent = WaitWindowEvent()
            
            Select iEvent
               Case #PB_Event_Gadget
                  Select EventGadget()
                     Case nBtnClose
                        flgExit = #True
                  EndSelect
            EndSelect       
         Until iEvent = #PB_Event_CloseWindow Or flgExit     
         
         FreeImage(iImageTree)
         FreeFont(nFont)
         CloseWindow(nWin)   
      EndIf
   EndIf 
EndProcedure
Post Reply