It is currently Mon Jan 18, 2021 2:11 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 2 posts ] 
Author Message
 Post subject: BinaryTree - Module
PostPosted: Sat Aug 20, 2016 9:02 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jul 07, 2013 11:35 am
Posts: 587
Location: Canada
Hello everyone,

A BinaryTree Module example based on Guimauve's code here

Best regards
StarBootics
Code:
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

_________________
The Stone Age did not end due to a shortage of stones !


Top
 Profile  
Reply with quote  
 Post subject: Re: BinaryTree - Module
PostPosted: Sun Apr 12, 2020 9:41 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jul 07, 2013 11:35 am
Posts: 587
Location: Canada
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:
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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

_________________
The Stone Age did not end due to a shortage of stones !


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 2 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 26 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye