PureBasic Forums - English

http://www.purebasic.com
http://forums.purebasic.com/english/

BinaryTree - Module

http://forums.purebasic.com/english/viewtopic.php?t=66424

Page 1 of 1

BinaryTree - Module

Posted: Sat Aug 20, 2016 9:02 pm
by StarBootics
Hello everyone,

A BinaryTree Module example based on Guimauve's code here

Best regards
StarBootics

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : BinaryTree - Module
; File Name : BinaryTree - Module.pb
; File version : 1.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : 20-08-2016
; Last Update : 20-08-2016
; PureBasic code : V5.50
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; This code was originally created by Guimauve to create a BinaryTree 
; Data Structure.
;
; See : http://www.purebasic.fr/english/viewtopic.php?f=12&t=24578
;
; I deserve credit only to convert the original code into a Module.
;
; This code is free to be use where ever you like but you use it at 
; your own risk.
;
; The author can in no way be held responsible for data loss, damage or 
; other annoying situations that may occur.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule BinaryTree
  
  Declare Reset()
  Declare AddNode(P_Word.s)
  
  CompilerIf #PB_Compiler_Debugger
    Declare Debugging()
  CompilerEndIf
  
EndDeclareModule

Module BinaryTree
  
  Structure Node
    
    Word.s
    WordCounter.l
    Child.i[2]
    
  EndStructure
  
  Structure Instance
    
    NodeCount.l
    RootNode.Node
    
  EndStructure
  
  Global Instance.Instance
  
  Procedure Private_ResetNode(*NodeA.Node)
    
    If *NodeA <> #Null
      
      For ChildID = 0 To 1
        Private_ResetNode(*NodeA\Child[ChildID])
      Next
      
      Debug "ResetNode called for : " + *NodeA\Word
      
      *NodeA\Word = ""
      *NodeA\WordCounter = 0
      
      For ChildID = 0 To 1
        If *NodeA\Child[ChildID] <> #Null
          FreeMemory(*NodeA\Child[ChildID])
          *NodeA\Child[ChildID] = 0
        EndIf
      Next
      
    EndIf
    
  EndProcedure
  
  Procedure Reset()
    
    Instance\NodeCount = 0
    Private_ResetNode(Instance\RootNode)
    
  EndProcedure
 
  Procedure Private_AddNode(*NodeA.Node, P_Word.s)
    
    If Instance\NodeCount = 0
      Instance\NodeCount = Instance\NodeCount + 1
      *NodeA\Word = P_Word
      *NodeA\WordCounter = 1
      *NodeA\Child[0] = #Null
      *NodeA\Child[1] = #Null
    Else
      
      If *NodeA = #Null
        
        *NodeA.Node = AllocateMemory(SizeOf(Node))
        
        If *NodeA <> #Null 
          Instance\NodeCount = Instance\NodeCount + 1
          *NodeA\Word = P_Word
          *NodeA\WordCounter = 1
          *NodeA\Child[0] = #Null
          *NodeA\Child[1] = #Null
        Else
          MessageRequester("BinaryTree fatal error", "Impossible to allocate node !")
          End
        EndIf
        
      ElseIf UCase(*NodeA\Word) = UCase(P_Word)
        
        *NodeA\WordCounter = *NodeA\WordCounter + 1
        
      ElseIf UCase(P_Word) < UCase(*NodeA\Word)
        
        *NodeA\Child[0] = Private_AddNode(*NodeA\Child[0], P_Word)
        
      ElseIf UCase(P_Word) > UCase(*NodeA\Word)
        
        *NodeA\Child[1] = Private_AddNode(*NodeA\Child[1], P_Word)
        
      EndIf
      
    EndIf
    
    ProcedureReturn *NodeA
  EndProcedure
  
  Procedure AddNode(P_Word.s)
    
    Private_AddNode(Instance\RootNode, P_Word)
    
  EndProcedure
  
  CompilerIf #PB_Compiler_Debugger
    
    Procedure Private_DebuggingNode(*NodeA.Node)
      
      If *NodeA <> #Null
        
        Private_DebuggingNode(*NodeA\Child[0])
        
        If *NodeA\WordCounter = 1
          Debug *NodeA\Word + " =---> " + Str(*NodeA\WordCounter) + " time"
        Else
          Debug *NodeA\Word + " =---> " + Str(*NodeA\WordCounter) + " times"
        EndIf
        
        Private_DebuggingNode(*NodeA\Child[1])
        
      EndIf
      
    EndProcedure
    
    Procedure Debugging()
      
      Private_DebuggingNode(Instance\RootNode)
      
    EndProcedure
    
  CompilerEndIf
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  
  Dim MyHeros.s(14)
  
  MyHeros(00) = "Zoro"
  MyHeros(01) = "Fred"
  MyHeros(02) = "Yoda"
  MyHeros(03) = "Freak"
  MyHeros(04) = "Morpheus"
  MyHeros(05) = "Fred"
  MyHeros(06) = "Freak"
  MyHeros(07) = "Zoro"
  MyHeros(08) = "Hercule"
  MyHeros(09) = "Yoda"
  MyHeros(10) = "Luke"
  MyHeros(11) = "Anakin"
  MyHeros(12) = "Mace Windu"
  MyHeros(13) = "Yoda"
  MyHeros(14) = "Obiwan"
  
  For Index = 0 To 14
    BinaryTree::AddNode(MyHeros(Index))
  Next
  
  CompilerIf #PB_Compiler_Debugger
    BinaryTree::Debugging()
  CompilerEndIf
  
  Debug ""
  Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
  Debug ""
  
  BinaryTree::Reset()
  
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Re: BinaryTree - Module

Posted: Sun Apr 12, 2020 9:41 pm
by StarBootics
Hello everyone

Sorry to re-open an old post but have re-worked this BinaryTree Module too see if it's possible to do it OOP style. There is the result :

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : BinaryTree - OOP
; File Name : BinaryTree - OOP.pb
; File version: 1.0.1
; Programming : OK
; Programmed by : StarBootics
; Date : 12-04-2020
; Last Update : 29-10-2020
; PureBasic code : V5.72
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule BinaryTreeNode
  
  Interface BinaryTreeNode
    
    GetWord.s()
    GetWordCounter.l()
    GetChild.i(ChildID.l)
    SetWord(P_Word.s)
    SetWordCounter(P_WordCounter.l)
    SetChild(ChildID.l, P_Child.i)
    Free()
    
  EndInterface
  
  Declare.i New()
  
EndDeclareModule

Module BinaryTreeNode
  
  Structure Private_Members
    
    VirtualTable.i
    Word.s
    WordCounter.l
    Child.i[2]
    
  EndStructure
  
  Procedure.s GetWord(*This.Private_Members)
    
    ProcedureReturn *This\Word
  EndProcedure
  
  Procedure.l GetWordCounter(*This.Private_Members)
    
    ProcedureReturn *This\WordCounter
  EndProcedure
  
  Procedure.i GetChild(*This.Private_Members, ChildID.l)
    
    ProcedureReturn *This\Child[ChildID]
  EndProcedure
  
  Procedure SetWord(*This.Private_Members, P_Word.s)
    
    *This\Word = P_Word
    
  EndProcedure
  
  Procedure SetWordCounter(*This.Private_Members, P_WordCounter.l)
    
    *This\WordCounter = P_WordCounter
    
  EndProcedure
  
  Procedure SetChild(*This.Private_Members, ChildID.l, P_Child.i)
    
    *This\Child[ChildID] = P_Child
    
  EndProcedure

  Procedure Free(*This.Private_Members)
 
    For ChildID = 0 To 1
      If *This\Child[ChildID] <> #Null
        Free(*This\Child[ChildID])
      EndIf
    Next
    
    Debug "Free called for : " + *This\Word
    
    FreeStructure(*This)
    
  EndProcedure
  
  Procedure.i New()
    
    *This.Private_Members = AllocateStructure(Private_Members)
    *This\VirtualTable = ?START_METHODS
    
    ProcedureReturn *This
  EndProcedure
  
  DataSection
    START_METHODS:
    Data.i @GetWord()
    Data.i @GetWordCounter()
    Data.i @GetChild()
    Data.i @SetWord()
    Data.i @SetWordCounter()
    Data.i @SetChild()
    Data.i @Free()
    END_METHODS:
  EndDataSection
  
EndModule

DeclareModule BinaryTree
  
  Interface BinaryTree
    
    AddNode(Word.s)
    Debugging()
    Free()
    
  EndInterface
  
  Declare.i New()
  
EndDeclareModule

Module BinaryTree
  
  Structure Private_Members
    
    VirtualTable.i
    NodeCount.l
    Root.BinaryTreeNode::BinaryTreeNode
    
  EndStructure
 
  Procedure Private_AddNode(*This.Private_Members, *Node.BinaryTreeNode::BinaryTreeNode, Word.s)
    
    If *This\NodeCount = 0
      *This\NodeCount = *This\NodeCount + 1
      *Node\SetWord(Word)
      *Node\SetWordCounter(1)
      *Node\SetChild(0, #Null)
      *Node\SetChild(1, #Null)
    Else
      
      If *Node = #Null
        
        *Node = BinaryTreeNode::New()
        *This\NodeCount = *This\NodeCount + 1
        *Node\SetWord(Word)
        *Node\SetWordCounter(1)
        *Node\SetChild(0, #Null)
        *Node\SetChild(1, #Null)
        
      ElseIf UCase(*Node\GetWord()) = UCase(Word)
        
        *Node\SetWordCounter(*Node\GetWordCounter() + 1)

      ElseIf UCase(Word) < UCase(*Node\GetWord())
        
        *Node\SetChild(0, Private_AddNode(*This, *Node\GetChild(0), Word))
        
      ElseIf UCase(Word) > UCase(*Node\GetWord())
        
       *Node\SetChild(1, Private_AddNode(*This, *Node\GetChild(1), Word))
        
      EndIf
      
    EndIf
    
    ProcedureReturn *Node
  EndProcedure

  Procedure AddNode(*This.Private_Members, Word.s)
    
    Private_AddNode(*This, *This\Root, Word)
    
  EndProcedure
  
  Procedure Private_DebuggingNode(*Node.BinaryTreeNode::BinaryTreeNode)
    
    If *Node <> #Null
      
      Private_DebuggingNode(*Node\GetChild(0))
      
      If *Node\GetWordCounter() = 1
        Debug *Node\GetWord() + " =---> " + Str(*Node\GetWordCounter()) + " time"
      Else
        Debug *Node\GetWord() + " =---> " + Str(*Node\GetWordCounter()) + " times"
      EndIf
      
      Private_DebuggingNode(*Node\GetChild(1))
      
    EndIf
    
  EndProcedure
  
  Procedure Debugging(*This.Private_Members)
    
    Private_DebuggingNode(*This\Root)
    
  EndProcedure
  
  Procedure Free(*This.Private_Members)
    
    If *This\Root <> #Null
      *This\Root\Free()
    EndIf
    
    FreeStructure(*This)
    
  EndProcedure

  Procedure.i New()
    
    *This.Private_Members = AllocateStructure(Private_Members)
    *This\VirtualTable = ?START_METHODS
    
    *This\Root = BinaryTreeNode::New()
    
    ProcedureReturn *This
  EndProcedure
  
  DataSection
    START_METHODS:
    Data.i @AddNode()
    Data.i @Debugging()
    Data.i @Free()
    END_METHODS:
  EndDataSection
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  
  MyTree.BinaryTree::BinaryTree = BinaryTree::New()
  
  MyTree\AddNode("Zoro")
  MyTree\AddNode("Fred")
  MyTree\AddNode("Yoda")
  MyTree\AddNode("Freak")
  MyTree\AddNode("Morpheus")
  MyTree\AddNode("Fred")
  MyTree\AddNode("Freak")
  MyTree\AddNode("Zoro")
  MyTree\AddNode("Hercule")
  MyTree\AddNode("Yoda")
  MyTree\AddNode("Luke")
  MyTree\AddNode("Anakin")
  MyTree\AddNode("Mace Windu")
  MyTree\AddNode("Yoda")
  MyTree\AddNode("Obiwan")
  
  MyTree\Debugging()
  
  Debug ""
  
  MyTree\Free()
  
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
From what I have learned, I can go now with an Octree for space partitioning for my game project.

Best regards.
StarBootics
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited