Binary Tree example

demosthenesk · Post by **demosthenesk** » Sep 06, 2022 6:49

so in examples in main is better to use pointer trees.

should i remove the static dim T lines?

Post by **fxm** » Sep 06, 2022 7:05

main.bas:

#Include "btree.bi"

MakeTree(Double, T1)               'make a double tree structure, with name T1
Dim b As Boolean                   'b as boolean
Dim height As Integer              'height as integer
Dim size As Integer                'size of tree as integer
Dim pT As TreeT1 Ptr = New TreeT1  'initialize a dynamic tree referenced by pointer pT


pT->value = 8                      'root value


'insert values into tree
pT->Insert(4)
pT->Insert(12)
pT->Insert(2)
pT->Insert(6)
pT->Insert(10)
pT->Insert(14)
pT->Insert(1)
pT->Insert(3)
pT->Insert(5)
pT->Insert(7)
pT->Insert(9)
pT->Insert(11)
pT->Insert(13)
pT->Insert(15)
pT->Insert(15.4)


/'
'insert values into tree
pT->Insert(7)
pT->Insert(6)
pT->Insert(5)
pT->Insert(4)
pT->Insert(3)
pT->Insert(2)
pT->Insert(1)
pT->Insert(0)
'/

'pT->printPreorder()
pT->printInorder()
'pT->printPostorder()

'search for 6
b=pT->doesNodeExistInBST(6)
Print "6 is found in tree ? " & b

'search for 5.4
b=pT->doesNodeExistInBST(5.4)
Print "5.4 is found in tree ? " & b

'get tree height
height = pT->getBinaryTreeHeight()
Print "Binary Tree height=" & height

'get tree size
size = pT->getBinaryTreeSize()
Print "Binary Tree size = " & size

'delete node
Print
b=pT->deleteValue(6)
Print "6 is deleted in tree ? " & b
Print
pT->printInorder()

'get tree size
size = pT->getBinaryTreeSize()
Print "Binary Tree size = " & size

Print
pT->printPath()

Delete pT  'delete the full tree

Sleep

demosthenesk · Post by **demosthenesk** » Sep 06, 2022 8:38

i fix it.
i think now is complete.

Post by **fxm** » Sep 06, 2022 11:43

Maybe homogenize the names of public procedures

btree.bi:

Code: Select all

/'
Developers fxm, demosthenesk
'/
#Macro MakeTree(datatype, nameTree)
Type Tree##nameTree
    Public:
        value As datatype
        Declare Sub printPreorderValues()
        Declare Sub printPostorderValues()
        Declare Sub printInorderValues()
        Declare Function existValue(searchValue As datatype) As Boolean
        Declare Function getTreeHeight() As Integer
        Declare Function getTreeSize() As Integer
        Declare Sub InsertValue(value As datatype)
        Declare Function deleteValue(value As datatype) As Boolean
        Declare Sub printValuesPaths(path As String = "seed node")
        Declare Destructor()
    Private:
        nodeLeft As Tree##nameTree Ptr
        nodeRight As Tree##nameTree Ptr
        Declare Function getSize() As Integer
        Declare Function addNodeLeft(value As datatype) As Integer
        Declare Function addNodeRight(value As datatype) As Integer
        Declare Function searchParentNode(value As datatype) Byref As Tree##nameTree
        Declare Sub insertNode(node AS Tree##nameTree)
        Declare Function insertNodeLeft(node AS Tree##nameTree) As Integer
        Declare Function insertNodeRight(node AS Tree##nameTree) As Integer
End Type

Sub Tree##nameTree.printValuesPaths(path As String = "seed node")
    If @This = 0 Then
        Return
    Else
        Print This.value & " ", path
        This.nodeLeft->printValuesPaths(path & " + L")
        This.nodeRight->printValuesPaths(path & " + R")
    End if	
End Sub

Destructor Tree##nameTree()
	If this.nodeLeft <> 0 Then
		this.value = 0
		Delete this.nodeLeft
	EndIf
	If this.nodeRight <> 0 Then
		this.value = 0
		Delete this.nodeRight
	EndIf
End Destructor


Function Tree##nameTree.insertNodeLeft(node AS Tree##nameTree) As Integer
	If this.nodeLeft = 0 Then
		this.nodeLeft = @node
		Return 0
	EndIf
	Return -1
End Function

Function Tree##nameTree.insertNodeRight(node AS Tree##nameTree) As Integer
	If this.nodeRight = 0 Then
		this.nodeRight = @node
		Return 0
	EndIf
	Return -1
End Function

Function Tree##nameTree.searchParentNode(value As datatype) Byref As Tree##nameTree
    Static as Tree##nameTree Ptr p
    if this.value = value then
        Return *p
    else
        p = @this
        if value > this.value then
            Return this.nodeRight->searchParentNode(value)
        else
            Return this.nodeLeft->searchParentNode(value)
        end if
    end if
End Function

Sub Tree##nameTree.insertNode(node AS Tree##nameTree)
    If (node.value < this.value) Then
        If this.insertNodeLeft(node) = 0 Then
            Return
        Else
            this.nodeLeft->insertNode(node)
        End If
    Else
        If this.insertNodeRight(node) = 0 Then
            Return
        Else
            this.nodeRight->insertNode(node)
        End If
    End If    
End Sub

Function Tree##nameTree.deleteValue(value As datatype) As Boolean
    If (this.value = value) Or (this.existValue(value) = False) Then
        Return False
    End If
    
    Dim Byref As Tree##nameTree parentNode = this.searchParentNode(value)
    if (parentNode.nodeLeft <> 0) Andalso (parentNode.nodeLeft->value = value) then  '' <------  correction
        dim as Tree##nameTree ptr p = parentNode.nodeLeft
        parentNode.nodeLeft = p->nodeLeft
        p->nodeLeft = 0
        if p->nodeRight <> 0 then
            this.insertNode(*p->nodeRight)
            p->nodeRight = 0
        end if
        Delete p
    else
        dim as Tree##nameTree ptr p = parentNode.nodeRight
        parentNode.nodeRight = p->nodeRight
        p->nodeRight = 0
        if p->nodeLeft <> 0 then
            this.insertNode(*p->nodeLeft)
            p->nodeLeft = 0
        end if
        Delete p
    end if
    return True
End Function

Function Tree##nameTree.addNodeLeft(value As datatype) As Integer
	If this.nodeLeft = 0 Then
		this.nodeLeft = New Tree##nameTree
		this.nodeLeft->value = value
		Return 0
	EndIf
	Return -1
End Function

Function Tree##nameTree.addNodeRight(value As datatype) As Integer
	If this.nodeRight = 0 Then
		this.nodeRight = New Tree##nameTree
		this.nodeRight->value = value
		Return 0
	EndIf
	Return -1
End Function


Sub Tree##nameTree.printPreorderValues()
	If @this = 0 Then
		Return
	Endif
	Print this.value & " " 'process node
	this.nodeLeft->printPreorderValues() 'recurse on left
	this.nodeRight->printPreorderValues() 'recurse on right
End Sub

Sub Tree##nameTree.printPostorderValues()
	If @this = 0 Then
		Return
	Endif
	this.nodeLeft->printPreorderValues() 'recurse on left
	this.nodeRight->printPreorderValues() 'recurse on right
	Print this.value & " " 'process node
End Sub

Sub Tree##nameTree.printInorderValues()
	If @this = 0 Then
		Return
	Endif
	this.nodeLeft->printPreorderValues() 'recurse on left
	Print this.value & " " 'process node
	this.nodeRight->printPreorderValues() 'recurse on right	
End Sub

Function Tree##nameTree.existValue(searchValue As datatype) As Boolean
    if @this = 0 Then
        Return False
    elseif this.value = searchValue Then
        Return True
    else
        ' if the node we're at is smaller than the value we're looking for, traverse on the right side
        if searchValue > this.value Then
            Return this.nodeRight->existValue(searchValue)
        else
            ' if the node we're at is bigger than the value we're looking for, traverse the left side
            Return this.nodeLeft->existValue(searchValue)
        Endif
    Endif	
End Function

Function Tree##nameTree.getTreeHeight() As Integer
	If @this = 0 Then
		Return -1
	EndIf

    Dim leftHeight As Integer = this.nodeLeft->getTreeHeight()
    Dim rightHeight As Integer = this.nodeRight->getTreeHeight()

    if leftHeight > rightHeight Then
        Return leftHeight + 1
    else
        return rightHeight + 1
    Endif	
End Function

Function Tree##nameTree.getTreeSize() As Integer
	If @this = 0 Then
		Return -1
	EndIf
	
	Dim size As Integer = this.getSize()
	Return size-1
End Function

Function Tree##nameTree.getSize() As Integer
	If @this = 0 Then
		Return 1
	Endif
	
	Dim a As Integer = this.nodeLeft->getSize() 'recurse on left
	Dim b As Integer = this.nodeRight->getSize() 'recurse on right	
	Return a + b
End Function

Sub Tree##nameTree.InsertValue(value As datatype)
    If (value < this.value) Then
        If this.addNodeLeft(value) = 0 Then
            Return
        Else
            this.nodeLeft->InsertValue(value)
        End If
    Else
        If this.addNodeRight(value) = 0 Then
            Return
        Else
            this.nodeRight->InsertValue(value)
        End If
    End If    
End Sub
#Endmacro

main.bas:

Code: Select all

#Include "btree.bi"

MakeTree(Double, T1)               'make a double tree structure, with name T1
Dim b As Boolean                   'b as boolean
Dim height As Integer              'height as integer
Dim size As Integer                'size of tree as integer
Dim pT As TreeT1 Ptr = New TreeT1  'initialize a dynamic tree referenced by pointer pT


pT->value = 8                      'root value


'insert values into tree
pT->InsertValue(4)
pT->InsertValue(12)
pT->InsertValue(2)
pT->InsertValue(6)
pT->InsertValue(10)
pT->InsertValue(14)
pT->InsertValue(1)
pT->InsertValue(3)
pT->InsertValue(5)
pT->InsertValue(7)
pT->InsertValue(9)
pT->InsertValue(11)
pT->InsertValue(13)
pT->InsertValue(15)
pT->InsertValue(15.4)


/'
'insert values into tree
pT->InsertValue(7)
pT->InsertValue(6)
pT->InsertValue(5)
pT->InsertValue(4)
pT->InsertValue(3)
pT->InsertValue(2)
pT->InsertValue(1)
pT->InsertValue(0)
'/

'pT->printPreorderValues()
pT->printInorderValues()
'pT->printPostorderValues()

'search for 6
b=pT->existValue(6)
Print "6 is found in tree ? " & b

'search for 5.4
b=pT->existValue(5.4)
Print "5.4 is found in tree ? " & b

'get tree height
height = pT->getTreeHeight()
Print "Binary Tree height=" & height

'get tree size
size = pT->getTreeSize()
Print "Binary Tree size = " & size

'delete node
Print
b=pT->deleteValue(6)
Print "6 is deleted in tree ? " & b
Print
pT->printInorderValues()

'get tree size
size = pT->getTreeSize()
Print "Binary Tree size = " & size

Print
pT->printValuesPaths()

Delete pT  'delete the full tree

Sleep

Post by **fxm** » Sep 06, 2022 14:05

I propose to add another public procedure to remove the seed value if possible (if the seed has a child at least):
Declare Function removeSeedValue() As Boolean
This procedure must be seed-specific since the seed value plays a special role because it is not created by the insert procedure.

The principle consists in replacing the value of the seed with the smallest value among all those on the right of the seed (seed node + R + L + L + L ...) or otherwise by the largest value among all those on the left of the seed (seed node + L + R + R + R ...).
The branch previously connected to this replacement value (one branch at most if it exists) must then be reinserted into the tree.

Full code proposed (tree.bi + main.bas) with added test removing the seed value and then reinserting that old seed value into the tree:

Code: Select all

/'
Developers fxm, demosthenesk
'/
#Macro MakeTree(datatype, nameTree)
Type Tree##nameTree
    Public:
        value As datatype
        Declare Sub printPreorderValues()
        Declare Sub printPostorderValues()
        Declare Sub printInorderValues()
        Declare Function existValue(searchValue As datatype) As Boolean
        Declare Function getTreeHeight() As Integer
        Declare Function getTreeSize() As Integer
        Declare Sub InsertValue(value As datatype)
        Declare Function deleteValue(value As datatype) As Boolean
        Declare Function removeSeedValue() As Boolean
        Declare Sub printValuesPaths(path As String = "seed node")
        Declare Destructor()
    Private:
        nodeLeft As Tree##nameTree Ptr
        nodeRight As Tree##nameTree Ptr
        Declare Function getSize() As Integer
        Declare Function addNodeLeft(value As datatype) As Integer
        Declare Function addNodeRight(value As datatype) As Integer
        Declare Function searchParentNode(value As datatype) Byref As Tree##nameTree
        Declare Sub insertNode(node AS Tree##nameTree)
        Declare Function insertNodeLeft(node AS Tree##nameTree) As Integer
        Declare Function insertNodeRight(node AS Tree##nameTree) As Integer
End Type

Sub Tree##nameTree.printValuesPaths(path As String = "seed node")
    If @This = 0 Then
        Return
    Else
        Print This.value & " ", path
        This.nodeLeft->printValuesPaths(path & " + L")
        This.nodeRight->printValuesPaths(path & " + R")
    End if	
End Sub

Destructor Tree##nameTree()
	If this.nodeLeft <> 0 Then
		this.value = 0
		Delete this.nodeLeft
	EndIf
	If this.nodeRight <> 0 Then
		this.value = 0
		Delete this.nodeRight
	EndIf
End Destructor


Function Tree##nameTree.insertNodeLeft(node AS Tree##nameTree) As Integer
	If this.nodeLeft = 0 Then
		this.nodeLeft = @node
		Return 0
	EndIf
	Return -1
End Function

Function Tree##nameTree.insertNodeRight(node AS Tree##nameTree) As Integer
	If this.nodeRight = 0 Then
		this.nodeRight = @node
		Return 0
	EndIf
	Return -1
End Function

Function Tree##nameTree.searchParentNode(value As datatype) Byref As Tree##nameTree
    Static as Tree##nameTree Ptr p
    if this.value = value then
        Return *p
    else
        p = @this
        if value > this.value then
            Return this.nodeRight->searchParentNode(value)
        else
            Return this.nodeLeft->searchParentNode(value)
        end if
    end if
End Function

Sub Tree##nameTree.insertNode(node AS Tree##nameTree)
    If (node.value < this.value) Then
        If this.insertNodeLeft(node) = 0 Then
            Return
        Else
            this.nodeLeft->insertNode(node)
        End If
    Else
        If this.insertNodeRight(node) = 0 Then
            Return
        Else
            this.nodeRight->insertNode(node)
        End If
    End If    
End Sub

Function Tree##nameTree.deleteValue(value As datatype) As Boolean
    If (this.value = value) Or (this.existValue(value) = False) Then
        Return False
    End If
    
    Dim Byref As Tree##nameTree parentNode = this.searchParentNode(value)
    if (parentNode.nodeLeft <> 0) Andalso (parentNode.nodeLeft->value = value) then
        dim as Tree##nameTree ptr p = parentNode.nodeLeft
        parentNode.nodeLeft = p->nodeLeft
        p->nodeLeft = 0
        if p->nodeRight <> 0 then
            this.insertNode(*p->nodeRight)
            p->nodeRight = 0
        end if
        Delete p
    else
        dim as Tree##nameTree ptr p = parentNode.nodeRight
        parentNode.nodeRight = p->nodeRight
        p->nodeRight = 0
        if p->nodeLeft <> 0 then
            this.insertNode(*p->nodeLeft)
            p->nodeLeft = 0
        end if
        Delete p
    end if
    return True
End Function

Function Tree##nameTree.removeSeedValue() As Boolean
    if (this.nodeLeft = 0) And (this.nodeRight = 0) then
        return False
    end if
    
    dim as Tree##nameTree ptr p
    if this.nodeRight <> 0 then
        p = this.nodeRight
        while p->nodeLeft <> 0
            p = p->nodeLeft
        wend
    else
        p = this.nodeLeft
        while p->nodeRight <> 0
            p = p->nodeRight
        wend
    end if
    
    dim byref as Tree##nameTree parentNode = this.searchParentNode(p->value)
    if parentNode.nodeLeft->value = p->value then
        parentNode.nodeLeft = 0
    else
        parentNode.nodeRight = 0
    end if
    
    this.value = p->value
    if p->nodeLeft <> 0 then
        this.insertNode(*p->nodeLeft)
        p->nodeLeft = 0
    end if
    if p->nodeRight <> 0 then
        this.insertNode(*p->nodeRight)
        p->nodeRight = 0
    end if
    delete p
    return True
End Function

Function Tree##nameTree.addNodeLeft(value As datatype) As Integer
	If this.nodeLeft = 0 Then
		this.nodeLeft = New Tree##nameTree
		this.nodeLeft->value = value
		Return 0
	EndIf
	Return -1
End Function

Function Tree##nameTree.addNodeRight(value As datatype) As Integer
	If this.nodeRight = 0 Then
		this.nodeRight = New Tree##nameTree
		this.nodeRight->value = value
		Return 0
	EndIf
	Return -1
End Function


Sub Tree##nameTree.printPreorderValues()
	If @this = 0 Then
		Return
	Endif
	Print this.value & " " 'process node
	this.nodeLeft->printPreorderValues() 'recurse on left
	this.nodeRight->printPreorderValues() 'recurse on right
End Sub

Sub Tree##nameTree.printPostorderValues()
	If @this = 0 Then
		Return
	Endif
	this.nodeLeft->printPreorderValues() 'recurse on left
	this.nodeRight->printPreorderValues() 'recurse on right
	Print this.value & " " 'process node
End Sub

Sub Tree##nameTree.printInorderValues()
	If @this = 0 Then
		Return
	Endif
	this.nodeLeft->printPreorderValues() 'recurse on left
	Print this.value & " " 'process node
	this.nodeRight->printPreorderValues() 'recurse on right	
End Sub

Function Tree##nameTree.existValue(searchValue As datatype) As Boolean
    if @this = 0 Then
        Return False
    elseif this.value = searchValue Then
        Return True
    else
        ' if the node we're at is smaller than the value we're looking for, traverse on the right side
        if searchValue > this.value Then
            Return this.nodeRight->existValue(searchValue)
        else
            ' if the node we're at is bigger than the value we're looking for, traverse the left side
            Return this.nodeLeft->existValue(searchValue)
        Endif
    Endif	
End Function

Function Tree##nameTree.getTreeHeight() As Integer
	If @this = 0 Then
		Return -1
	EndIf

    Dim leftHeight As Integer = this.nodeLeft->getTreeHeight()
    Dim rightHeight As Integer = this.nodeRight->getTreeHeight()

    if leftHeight > rightHeight Then
        Return leftHeight + 1
    else
        return rightHeight + 1
    Endif	
End Function

Function Tree##nameTree.getTreeSize() As Integer
	If @this = 0 Then
		Return -1
	EndIf
	
	Dim size As Integer = this.getSize()
	Return size-1
End Function

Function Tree##nameTree.getSize() As Integer
	If @this = 0 Then
		Return 1
	Endif
	
	Dim a As Integer = this.nodeLeft->getSize() 'recurse on left
	Dim b As Integer = this.nodeRight->getSize() 'recurse on right	
	Return a + b
End Function

Sub Tree##nameTree.InsertValue(value As datatype)
    If (value < this.value) Then
        If this.addNodeLeft(value) = 0 Then
            Return
        Else
            this.nodeLeft->InsertValue(value)
        End If
    Else
        If this.addNodeRight(value) = 0 Then
            Return
        Else
            this.nodeRight->InsertValue(value)
        End If
    End If    
End Sub
#Endmacro



'#Include "btree.bi"

MakeTree(Double, T1)               'make a double tree structure, with name T1
Dim b As Boolean                   'b as boolean
Dim height As Integer              'height as integer
Dim size As Integer                'size of tree as integer
Dim pT As TreeT1 Ptr = New TreeT1  'initialize a dynamic tree referenced by pointer pT


pT->value = 8                      'root value


'insert values into tree
pT->InsertValue(4)
pT->InsertValue(12)
pT->InsertValue(2)
pT->InsertValue(6)
pT->InsertValue(10)
pT->InsertValue(14)
pT->InsertValue(1)
pT->InsertValue(3)
pT->InsertValue(5)
pT->InsertValue(7)
pT->InsertValue(9)
pT->InsertValue(11)
pT->InsertValue(13)
pT->InsertValue(15)
pT->InsertValue(15.4)


/'
'insert values into tree
pT->InsertValue(7)
pT->InsertValue(6)
pT->InsertValue(5)
pT->InsertValue(4)
pT->InsertValue(3)
pT->InsertValue(2)
pT->InsertValue(1)
pT->InsertValue(0)
'/

'pT->printPreorderValues()
pT->printInorderValues()
'pT->printPostorderValues()

'search for 6
b=pT->existValue(6)
Print "6 is found in tree ? " & b

'search for 5.4
b=pT->existValue(5.4)
Print "5.4 is found in tree ? " & b

'get tree height
height = pT->getTreeHeight()
Print "Binary Tree height=" & height

'get tree size
size = pT->getTreeSize()
Print "Binary Tree size = " & size

'delete node
Print
b=pT->deleteValue(6)
Print "6 is deleted in tree ? " & b
Print
pT->printInorderValues()

'get tree size
size = pT->getTreeSize()
Print "Binary Tree size = " & size

Print
pT->printValuesPaths()

Print
b=pT->removeSeedValue()
Print "seed value is removed from tree ? " & b

Print
pT->printValuesPaths()

Print
pT->InsertValue(8)
Print "old seed value is reinserted into tree"

Print
pT->printValuesPaths()

Delete pT  'delete the full tree

Sleep

Code: Select all

4
2
1
3
6
5
7
8
12
10
9
11
14
13
15
15.4
6 is found in tree ? true
5.4 is found in tree ? false
Binary Tree height=4
Binary Tree size = 16

6 is deleted in tree ? true

4
2
1
3
7
5
8
12
10
9
11
14
13
15
15.4
Binary Tree size = 15

8             seed node
4             seed node + L
2             seed node + L + L
1             seed node + L + L + L
3             seed node + L + L + R
7             seed node + L + R
5             seed node + L + R + L
12            seed node + R
10            seed node + R + L
9             seed node + R + L + L
11            seed node + R + L + R
14            seed node + R + R
13            seed node + R + R + L
15            seed node + R + R + R
15.4          seed node + R + R + R + R

seed value is removed from tree ? true

9             seed node
4             seed node + L
2             seed node + L + L
1             seed node + L + L + L
3             seed node + L + L + R
7             seed node + L + R
5             seed node + L + R + L
12            seed node + R
10            seed node + R + L
11            seed node + R + L + R
14            seed node + R + R
13            seed node + R + R + L
15            seed node + R + R + R
15.4          seed node + R + R + R + R

old seed value is reinserted into tree

9             seed node
4             seed node + L
2             seed node + L + L
1             seed node + L + L + L
3             seed node + L + L + R
7             seed node + L + R
5             seed node + L + R + L
8             seed node + L + R + R
12            seed node + R
10            seed node + R + L
11            seed node + R + L + R
14            seed node + R + R
13            seed node + R + R + L
15            seed node + R + R + R
15.4          seed node + R + R + R + R

demosthenesk · Post by **demosthenesk** » Sep 06, 2022 18:27

ok fixed!
https://github.com/demosthenesk/FreeBAS ... SearchTree

Post by **fxm** » Sep 06, 2022 21:08

To make feel safe the code

The copy-constructor and the let-assignment operator are not defined because at first sight they are of no interest.
But the implicit copy-construct and the implicit copy-assign operator, if called by the user, are inappropriate for this complex UDT (with dynamic allocations by user), and can even induce crash.
To disallow the user to do an eventual copy-construct and a copy-assign, the copy-constructor and the let-assignment operator must be only declared (without code body) but as private members.
Consecutively, a default constructor must also be declared and defined (even with an empty body) but as for it as public member.

Begin of tree.bi to be modified:

Code: Select all

/'
Developers fxm, demosthenesk
'/
#Macro MakeTree(datatype, nameTree)
Type Tree##nameTree
    Public:
        value As datatype
        Declare Sub printPreorderValues()
        Declare Sub printPostorderValues()
        Declare Sub printInorderValues()
        Declare Function existValue(searchValue As datatype) As Boolean
        Declare Function getTreeHeight() As Integer
        Declare Function getTreeSize() As Integer
        Declare Sub InsertValue(value As datatype)
        Declare Function deleteValue(value As datatype) As Boolean
        Declare Function removeSeedValue() As Boolean
        Declare Sub printValuesPaths(path As String = "seed node")
        Declare Constructor()
        Declare Destructor()
    Private:
        nodeLeft As Tree##nameTree Ptr
        nodeRight As Tree##nameTree Ptr
        Declare Function getSize() As Integer
        Declare Function addNodeLeft(value As datatype) As Integer
        Declare Function addNodeRight(value As datatype) As Integer
        Declare Function searchParentNode(value As datatype) Byref As Tree##nameTree
        Declare Sub insertNode(node AS Tree##nameTree)
        Declare Function insertNodeLeft(node AS Tree##nameTree) As Integer
        Declare Function insertNodeRight(node AS Tree##nameTree) As Integer
        Declare Constructor(node AS Tree##nameTree)
        Declare Operator Let(node AS Tree##nameTree)
End Type

Constructor Tree##nameTree()
End Constructor

.....

demosthenesk · Post by **demosthenesk** » Sep 07, 2022 0:17

ok fixed !

Post by **fxm** » Sep 07, 2022 5:09

fxm wrote: ↑Sep 06, 2022 21:08 To make feel safe the code

The copy-constructor and the let-assignment operator are not defined because at first sight they are of no interest.
But the implicit copy-construct and the implicit copy-assign operator, if called by the user, are inappropriate for this complex UDT (with dynamic allocations by user), and can even induce crash.
To disallow the user to do an eventual copy-construct and a copy-assign, the copy-constructor and the let-assignment operator must be only declared (without code body) but as private members.
Consecutively, a default constructor must also be declared and defined (even with an empty body) but as for it as public member.

The features to be prohibited to the user are the following (in red):

Dim As TreeT1 t1 Dim As TreeT1 t2 = t1 Dim As TreeT1 t3 t3 = t1 Dim As TreeT1 Ptr pt1 = New TreeT1 Dim As TreeT1 Ptr pt2 = New TreeT1(*pt1) Dim As TreeT1 Ptr pt3 = New TreeT1 *pt3 = *pt1 .....
(and all similar to the red ones but mixing instances and dereferenced pointers)

Post by **fxm** » Sep 09, 2022 6:44

Version with private 'value' member and mandatory seed value initialization via the initialize-constructor (default-constructor, copy-constructor and copy-assignment operator, all prohibited from use).

btree.bi:

Code: Select all

/'
Developers fxm, demosthenesk
'/
#Macro MakeTree(datatype, nameTree)
Type Tree##nameTree
    Public:
        Declare Sub printPreorderValues()
        Declare Sub printPostorderValues()
        Declare Sub printInorderValues()
        Declare Function existValue(value As datatype) As Boolean
        Declare Function getTreeHeight() As Integer
        Declare Function getTreeSize() As Integer
        Declare Sub insertValue(value As datatype)
        Declare Function deleteValue(value As datatype) As Boolean
        Declare Function removeSeedValue() As Boolean
        Declare Sub printValuesPaths(path As String = "seed node")
        Declare Constructor(value As datatype)
        Declare Destructor()
    Private:
        value As datatype
        nodeLeft As Tree##nameTree Ptr
        nodeRight As Tree##nameTree Ptr
        Declare Function getSize() As Integer
        Declare Function addNodeLeft(value As datatype) As Integer
        Declare Function addNodeRight(value As datatype) As Integer
        Declare Function searchParentNode(value As datatype) Byref As Tree##nameTree
        Declare Sub insertNode(node AS Tree##nameTree)
        Declare Function insertNodeLeft(node AS Tree##nameTree) As Integer
        Declare Function insertNodeRight(node AS Tree##nameTree) As Integer
        Declare Constructor()
        Declare Constructor(node AS Tree##nameTree)
        Declare Operator Let(node AS Tree##nameTree)
End Type

Constructor Tree##nameTree(value As datatype)
    This.value = value
End Constructor

Sub Tree##nameTree.printValuesPaths(path As String = "seed node")
    If @This = 0 Then
        Return
    Else
        Print This.value & " ", path
        This.nodeLeft->printValuesPaths(path & " + L")
        This.nodeRight->printValuesPaths(path & " + R")
    End If	
End Sub

Destructor Tree##nameTree()
    If This.nodeLeft <> 0 Then
        This.value = 0
        Delete This.nodeLeft
    End If
    If This.nodeRight <> 0 Then
        This.value = 0
        Delete This.nodeRight
    End If
End Destructor


Function Tree##nameTree.insertNodeLeft(node AS Tree##nameTree) As Integer
    If This.nodeLeft = 0 Then
        This.nodeLeft = @node
        Return 0
    End If
    Return -1
End Function

Function Tree##nameTree.insertNodeRight(node AS Tree##nameTree) As Integer
    If This.nodeRight = 0 Then
        This.nodeRight = @node
        Return 0
    End If
    Return -1
End Function

Function Tree##nameTree.searchParentNode(value As datatype) Byref As Tree##nameTree
    Static as Tree##nameTree Ptr p
    If This.value = value Then
        Return *p
    Else
        p = @This
        If value > this.value Then
            Return This.nodeRight->searchParentNode(value)
        Else
            Return This.nodeLeft->searchParentNode(value)
        End If
    End If
End Function

Sub Tree##nameTree.insertNode(node AS Tree##nameTree)
    If (node.value < This.value) Then
        If This.insertNodeLeft(node) = 0 Then
            Return
        Else
            This.nodeLeft->insertNode(node)
        End If
    Else
        If This.insertNodeRight(node) = 0 Then
            Return
        Else
            This.nodeRight->insertNode(node)
        End If
    End If    
End Sub

Function Tree##nameTree.deleteValue(value As datatype) As Boolean
    If (This.value = value) Or (This.existValue(value) = False) Then
        Return False
    End If
    
    Dim Byref As Tree##nameTree parentNode = This.searchParentNode(value)
    If (parentNode.nodeLeft <> 0) Andalso (parentNode.nodeLeft->value = value) Then
        Dim As Tree##nameTree Ptr p = parentNode.nodeLeft
        parentNode.nodeLeft = p->nodeLeft
        p->nodeLeft = 0
        If p->nodeRight <> 0 Then
            This.insertNode(*p->nodeRight)
            p->nodeRight = 0
        End If
        Delete p
    Else
        Dim As Tree##nameTree Ptr p = parentNode.nodeRight
        parentNode.nodeRight = p->nodeRight
        p->nodeRight = 0
        If p->nodeLeft <> 0 Then
            This.insertNode(*p->nodeLeft)
            p->nodeLeft = 0
        End If
        Delete p
    End If
    Return True
End Function

Function Tree##nameTree.removeSeedValue() As Boolean
    If (This.nodeLeft = 0) And (This.nodeRight = 0) Then
        Return False
    End If
    
    Dim As Tree##nameTree Ptr p
    If This.nodeRight <> 0 Then
        p = This.nodeRight
        While p->nodeLeft <> 0
            p = p->nodeLeft
        Wend
    Else
        p = This.nodeLeft
        While p->nodeRight <> 0
            p = p->nodeRight
        Wend
    End If
    
    Dim Byref As Tree##nameTree parentNode = This.searchParentNode(p->value)
    If parentNode.nodeLeft->value = p->value Then
        parentNode.nodeLeft = 0
    Else
        parentNode.nodeRight = 0
    End If
    
    This.value = p->value
    If p->nodeLeft <> 0 Then
        This.insertNode(*p->nodeLeft)
        p->nodeLeft = 0
    End If
    If p->nodeRight <> 0 Then
        This.insertNode(*p->nodeRight)
        p->nodeRight = 0
    End If
    Delete p
    Return True
End Function

Function Tree##nameTree.addNodeLeft(value As datatype) As Integer
    If This.nodeLeft = 0 Then
        This.nodeLeft = New Tree##nameTree(value)
        Return 0
    End If
    Return -1
End Function

Function Tree##nameTree.addNodeRight(value As datatype) As Integer
    If This.nodeRight = 0 Then
        This.nodeRight = New Tree##nameTree(value)
        Return 0
    End If
    Return -1
End Function

Sub Tree##nameTree.printPreorderValues()
    If @This = 0 Then
        Return
        End If
    Print This.value & " " 'process node
    This.nodeLeft->printPreorderValues() 'recurse on left
    This.nodeRight->printPreorderValues() 'recurse on right
End Sub

Sub Tree##nameTree.printPostorderValues()
    If @This = 0 Then
        Return
    End If
    This.nodeLeft->printPreorderValues() 'recurse on left
    This.nodeRight->printPreorderValues() 'recurse on right
    Print This.value & " " 'process node
End Sub

Sub Tree##nameTree.printInorderValues()
    If @This = 0 Then
        Return
    End If
    This.nodeLeft->printPreorderValues() 'recurse on left
    Print This.value & " " 'process node
    This.nodeRight->printPreorderValues() 'recurse on right	
End Sub

Function Tree##nameTree.existValue(value As datatype) As Boolean
    If @This = 0 Then
        Return False
    Elseif This.value = value Then
        Return True
    Else
        ' if the node we're at is smaller than the value we're looking for, traverse on the right side
        If value > This.value Then
            Return This.nodeRight->existValue(value)
        Else
            ' if the node we're at is bigger than the value we're looking for, traverse the left side
            Return This.nodeLeft->existValue(value)
        End If
    End If	
End Function

Function Tree##nameTree.getTreeHeight() As Integer
    If @This = 0 Then
        Return -1
    End If

    Dim leftHeight As Integer = This.nodeLeft->getTreeHeight()
    Dim rightHeight As Integer = This.nodeRight->getTreeHeight()

    If leftHeight > rightHeight Then
        Return leftHeight + 1
    Else
        Return rightHeight + 1
    End If	
End Function

Function Tree##nameTree.getTreeSize() As Integer
    If @This = 0 Then
        Return -1
    End If
	
    Dim size As Integer = This.getSize()
    Return size-1
End Function

Function Tree##nameTree.getSize() As Integer
    If @This = 0 Then
        Return 1
    End If
	
    Dim a As Integer = This.nodeLeft->getSize() 'recurse on left
    Dim b As Integer = This.nodeRight->getSize() 'recurse on right	
    Return a + b
End Function

Sub Tree##nameTree.insertValue(value As datatype)
    If (value < This.value) Then
        If This.addNodeLeft(value) = 0 Then
            Return
        Else
            This.nodeLeft->insertValue(value)
        End If
    Else
        If This.addNodeRight(value) = 0 Then
            Return
        Else
            This.nodeRight->insertValue(value)
        End If
    End If    
End Sub
#Endmacro

main.bas:

Code: Select all

#Include "btree.bi"

MakeTree(Double, T1)                  'make a double tree structure, with name T1
Dim b As Boolean                      'b as boolean
Dim height As Integer                 'height as integer
Dim size As Integer                   'size of tree as integer
Dim pT As TreeT1 Ptr = New TreeT1(8)  'initialize with 8 a dynamic tree referenced by pointer pT

'insert values into tree
pT->insertValue(4)
pT->insertValue(12)
pT->insertValue(2)
pT->insertValue(6)
pT->insertValue(10)
pT->insertValue(14)
pT->insertValue(1)
pT->insertValue(3)
pT->insertValue(5)
pT->insertValue(7)
pT->insertValue(9)
pT->insertValue(11)
pT->insertValue(13)
pT->insertValue(15)
pT->insertValue(15.4)


/'
'insert values into tree
pT->insertValue(7)
pT->insertValue(6)
pT->insertValue(5)
pT->insertValue(4)
pT->insertValue(3)
pT->insertValue(2)
pT->insertValue(1)
pT->insertValue(0)
'/

'pT->printPreorderValues()
pT->printInorderValues()
'pT->printPostorderValues()

'search for 6
b = pT->existValue(6)
Print "6 is found in tree ? " & b

'search for 5.4
b = pT->existValue(5.4)
Print "5.4 is found in tree ? " & b

'get tree height
height = pT->getTreeHeight()
Print "Binary Tree height=" & height

'get tree size
size = pT->getTreeSize()
Print "Binary Tree size = " & size

'delete node
Print
b = pT->deleteValue(6)
Print "6 is deleted in tree ? " & b
Print
pT->printInorderValues()

'get tree size
size = pT->getTreeSize()
Print "Binary Tree size = " & size

Print
pT->printValuesPaths()

Print
b = pT->removeSeedValue()
Print "seed value is removed from tree ? " & b

Print
pT->printValuesPaths()

Print
pT->insertValue(8)
Print "old seed value is reinserted into tree"

Print
pT->printValuesPaths()

Delete pT  'delete the full tree

Sleep

demosthenesk · Post by **demosthenesk** » Sep 09, 2022 11:25

ok fixed !

Post by **fxm** » Sep 10, 2022 12:32

I added a public member procedure to get for a node value (if it exists) the path from the seed's node, path expressed by a sequence of 'L' (left branch) and 'R' (right branch) from the seed's node:
+ Function getValuePath(value As datatype, rootTitle As String = "seed node") As String

I renamed the 'path' parameter (of 'printValuesPaths()') to 'rootTitle'.

btree.bi:

Code: Select all

/'
Developers fxm, demosthenesk
'/
#Macro MakeTree(datatype, nameTree)
Type Tree##nameTree
    Public:
        Declare Sub printPreorderValues()
        Declare Sub printPostorderValues()
        Declare Sub printInorderValues()
        Declare Function existValue(value As datatype) As Boolean
        Declare Function getTreeHeight() As Integer
        Declare Function getTreeSize() As Integer
        Declare Function getValuePath(value As datatype, rootTitle As String = "seed node") As String
        Declare Sub insertValue(value As datatype)
        Declare Function deleteValue(value As datatype) As Boolean
        Declare Function removeSeedValue() As Boolean
        Declare Sub printValuesPaths(rootTitle As String = "seed node")
        Declare Constructor(value As datatype)
        Declare Destructor()
    Private:
        value As datatype
        nodeLeft As Tree##nameTree Ptr
        nodeRight As Tree##nameTree Ptr
        Declare Function getSize() As Integer
        Declare Function addNodeLeft(value As datatype) As Integer
        Declare Function addNodeRight(value As datatype) As Integer
        Declare Function searchParentNode(value As datatype) Byref As Tree##nameTree
        Declare Sub insertNode(node AS Tree##nameTree)
        Declare Function insertNodeLeft(node AS Tree##nameTree) As Integer
        Declare Function insertNodeRight(node AS Tree##nameTree) As Integer
        Declare Constructor()
        Declare Constructor(node AS Tree##nameTree)
        Declare Operator Let(node AS Tree##nameTree)
End Type

Constructor Tree##nameTree(value As datatype)
    This.value = value
End Constructor

Sub Tree##nameTree.printValuesPaths(rootTitle As String = "seed node")
    If @This = 0 Then
        Return
    Else
        Print This.value & " ", rootTitle
        This.nodeLeft->printValuesPaths(rootTitle & " + L")
        This.nodeRight->printValuesPaths(rootTitle & " + R")
    End If	
End Sub

Destructor Tree##nameTree()
    If This.nodeLeft <> 0 Then
        This.value = 0
        Delete This.nodeLeft
    End If
    If This.nodeRight <> 0 Then
        This.value = 0
        Delete This.nodeRight
    End If
End Destructor


Function Tree##nameTree.insertNodeLeft(node AS Tree##nameTree) As Integer
    If This.nodeLeft = 0 Then
        This.nodeLeft = @node
        Return 0
    End If
    Return -1
End Function

Function Tree##nameTree.insertNodeRight(node AS Tree##nameTree) As Integer
    If This.nodeRight = 0 Then
        This.nodeRight = @node
        Return 0
    End If
    Return -1
End Function

Function Tree##nameTree.searchParentNode(value As datatype) Byref As Tree##nameTree
    Static as Tree##nameTree Ptr p
    If This.value = value Then
        Return *p
    Else
        p = @This
        If value > this.value Then
            Return This.nodeRight->searchParentNode(value)
        Else
            Return This.nodeLeft->searchParentNode(value)
        End If
    End If
End Function

Sub Tree##nameTree.insertNode(node AS Tree##nameTree)
    If (node.value < This.value) Then
        If This.insertNodeLeft(node) = 0 Then
            Return
        Else
            This.nodeLeft->insertNode(node)
        End If
    Else
        If This.insertNodeRight(node) = 0 Then
            Return
        Else
            This.nodeRight->insertNode(node)
        End If
    End If    
End Sub

Function Tree##nameTree.deleteValue(value As datatype) As Boolean
    If (This.value = value) Or (This.existValue(value) = False) Then
        Return False
    End If
    
    Dim Byref As Tree##nameTree parentNode = This.searchParentNode(value)
    If (parentNode.nodeLeft <> 0) Andalso (parentNode.nodeLeft->value = value) Then
        Dim As Tree##nameTree Ptr p = parentNode.nodeLeft
        parentNode.nodeLeft = p->nodeLeft
        p->nodeLeft = 0
        If p->nodeRight <> 0 Then
            This.insertNode(*p->nodeRight)
            p->nodeRight = 0
        End If
        Delete p
    Else
        Dim As Tree##nameTree Ptr p = parentNode.nodeRight
        parentNode.nodeRight = p->nodeRight
        p->nodeRight = 0
        If p->nodeLeft <> 0 Then
            This.insertNode(*p->nodeLeft)
            p->nodeLeft = 0
        End If
        Delete p
    End If
    Return True
End Function

Function Tree##nameTree.removeSeedValue() As Boolean
    If (This.nodeLeft = 0) And (This.nodeRight = 0) Then
        Return False
    End If
    
    Dim As Tree##nameTree Ptr p
    If This.nodeRight <> 0 Then
        p = This.nodeRight
        While p->nodeLeft <> 0
            p = p->nodeLeft
        Wend
    Else
        p = This.nodeLeft
        While p->nodeRight <> 0
            p = p->nodeRight
        Wend
    End If
    
    Dim Byref As Tree##nameTree parentNode = This.searchParentNode(p->value)
    If parentNode.nodeLeft->value = p->value Then
        parentNode.nodeLeft = 0
    Else
        parentNode.nodeRight = 0
    End If
    
    This.value = p->value
    If p->nodeLeft <> 0 Then
        This.insertNode(*p->nodeLeft)
        p->nodeLeft = 0
    End If
    If p->nodeRight <> 0 Then
        This.insertNode(*p->nodeRight)
        p->nodeRight = 0
    End If
    Delete p
    Return True
End Function

Function Tree##nameTree.addNodeLeft(value As datatype) As Integer
    If This.nodeLeft = 0 Then
        This.nodeLeft = New Tree##nameTree(value)
        Return 0
    End If
    Return -1
End Function

Function Tree##nameTree.addNodeRight(value As datatype) As Integer
    If This.nodeRight = 0 Then
        This.nodeRight = New Tree##nameTree(value)
        Return 0
    End If
    Return -1
End Function

Sub Tree##nameTree.printPreorderValues()
    If @This = 0 Then
        Return
        End If
    Print This.value & " " 'process node
    This.nodeLeft->printPreorderValues() 'recurse on left
    This.nodeRight->printPreorderValues() 'recurse on right
End Sub

Sub Tree##nameTree.printPostorderValues()
    If @This = 0 Then
        Return
    End If
    This.nodeLeft->printPreorderValues() 'recurse on left
    This.nodeRight->printPreorderValues() 'recurse on right
    Print This.value & " " 'process node
End Sub

Sub Tree##nameTree.printInorderValues()
    If @This = 0 Then
        Return
    End If
    This.nodeLeft->printPreorderValues() 'recurse on left
    Print This.value & " " 'process node
    This.nodeRight->printPreorderValues() 'recurse on right	
End Sub

Function Tree##nameTree.existValue(value As datatype) As Boolean
    If @This = 0 Then
        Return False
    Elseif This.value = value Then
        Return True
    Else
        ' if the node we're at is smaller than the value we're looking for, traverse on the right side
        If value > This.value Then
            Return This.nodeRight->existValue(value)
        Else
            ' if the node we're at is bigger than the value we're looking for, traverse the left side
            Return This.nodeLeft->existValue(value)
        End If
    End If	
End Function

Function Tree##nameTree.getTreeHeight() As Integer
    If @This = 0 Then
        Return -1
    End If

    Dim leftHeight As Integer = This.nodeLeft->getTreeHeight()
    Dim rightHeight As Integer = This.nodeRight->getTreeHeight()

    If leftHeight > rightHeight Then
        Return leftHeight + 1
    Else
        Return rightHeight + 1
    End If	
End Function

Function Tree##nameTree.getTreeSize() As Integer
    If @This = 0 Then
        Return -1
    End If
	
    Dim size As Integer = This.getSize()
    Return size-1
End Function

Function Tree##nameTree.getSize() As Integer
    If @This = 0 Then
        Return 1
    End If
	
    Dim a As Integer = This.nodeLeft->getSize() 'recurse on left
    Dim b As Integer = This.nodeRight->getSize() 'recurse on right	
    Return a + b
End Function

Function Tree##nameTree.getValuePath(value As datatype, rootTitle As String = "seed node") As String
    If @This = 0 Then
        Return "no path"
    Elseif This.value = value Then
        Return rootTitle
    Else
        ' if the node we're at is smaller than the value we're looking for, traverse on the right side
        If value > This.value Then
            Return This.nodeRight->getValuePath(value, rootTitle & " + R")
        Else
            ' if the node we're at is bigger than the value we're looking for, traverse the left side
            Return This.nodeLeft->getValuePath(value, rootTitle & " + L")
        End If
    End If	
End Function

Sub Tree##nameTree.insertValue(value As datatype)
    If (value < This.value) Then
        If This.addNodeLeft(value) = 0 Then
            Return
        Else
            This.nodeLeft->insertValue(value)
        End If
    Else
        If This.addNodeRight(value) = 0 Then
            Return
        Else
            This.nodeRight->insertValue(value)
        End If
    End If    
End Sub
#Endmacro

main.bas:

Code: Select all

#Include "btree.bi"

MakeTree(Double, T1)                  'make a double tree structure, with name T1
Dim b As Boolean                      'b as boolean
Dim height As Integer                 'height as integer
Dim size As Integer                   'size of tree as integer
Dim pT As TreeT1 Ptr = New TreeT1(8)  'initialize with 8 a dynamic tree referenced by pointer pT

'insert values into tree
pT->insertValue(4)
pT->insertValue(12)
pT->insertValue(2)
pT->insertValue(6)
pT->insertValue(10)
pT->insertValue(14)
pT->insertValue(1)
pT->insertValue(3)
pT->insertValue(5)
pT->insertValue(7)
pT->insertValue(9)
pT->insertValue(11)
pT->insertValue(13)
pT->insertValue(15)
pT->insertValue(15.4)


/'
'insert values into tree
pT->insertValue(7)
pT->insertValue(6)
pT->insertValue(5)
pT->insertValue(4)
pT->insertValue(3)
pT->insertValue(2)
pT->insertValue(1)
pT->insertValue(0)
'/

'pT->printPreorderValues()
pT->printInorderValues()
'pT->printPostorderValues()

'search for 6
b = pT->existValue(6)
Print "6 is found in tree ? " & b

'search for 5.4
b = pT->existValue(5.4)
Print "5.4 is found in tree ? " & b

'get tree height
height = pT->getTreeHeight()
Print "Binary Tree height=" & height

'get tree size
size = pT->getTreeSize()
Print "Binary Tree size = " & size

'delete node
Print
b = pT->deleteValue(6)
Print "6 is deleted in tree ? " & b
Print
pT->printInorderValues()

'get tree size
size = pT->getTreeSize()
Print "Binary Tree size = " & size

Print
pT->printValuesPaths()

Print
b = pT->removeSeedValue()
Print "seed value is removed from tree ? " & b

Print
pT->printValuesPaths()

Print
pT->insertValue(8)
Print "old seed value is reinserted into tree"

Print
pT->printValuesPaths()

Print
Print "11 is found in path = " & pT->getValuePath(11)

Print
Print "5.4 is found in path = " & pT->getValuePath(5.4)

Delete pT  'delete the full tree

Sleep

demosthenesk · Post by **demosthenesk** » Sep 10, 2022 13:23

ok Fixed !
nice ideas...!

https://github.com/demosthenesk/FreeBAS ... SearchTree

Post by **fxm** » Sep 14, 2022 18:23

Andrew Lindsay wrote: ↑Sep 14, 2022 14:06 Hello,
Does anyone know of a basic KD-Tree algorithm for Freebasic that will allow me to find the nearest spatial point (nearest neighbour) from a dataset of tens of thousands of datapoints?

I want to find the nearest point on a path (given by a list of X,Y coordinates). I've seen an implementation of KD-Trees in Python, but I'd like to add the ability to do this in my program and not have to shell out or try to interface to python.

Any assistance would be appreciated.

Regards

Andrew

Andrew Lindsay's post above about k-d tree gave me the idea to add a new member procedure to find the 'value' ('datatype' instance) in the Binary Tree that is closest to a given 'value' (given 'datatype' instance):
+ Function getNearestNeighbour(value As datatype) As datatype

btree.bi:

Code: Select all

/'
Developers fxm, demosthenesk
'/
#Macro MakeTree(datatype, nameTree)
Type Tree##nameTree
    Public:
        Declare Sub printPreorderValues()
        Declare Sub printPostorderValues()
        Declare Sub printInorderValues()
        Declare Function existValue(value As datatype) As Boolean
        Declare Function getTreeHeight() As Integer
        Declare Function getTreeSize() As Integer
        Declare Function getValuePath(value As datatype, rootTitle As String = "seed node") As String
        Declare Sub insertValue(value As datatype)
        Declare Function deleteValue(value As datatype) As Boolean
        Declare Function removeSeedValue() As Boolean
        Declare Sub printValuesPaths(rootTitle As String = "seed node")
        Declare Function getNearestNeighbour(value As datatype) As datatype
        Declare Constructor(value As datatype)
        Declare Destructor()
    Private:
        value As datatype
        nodeLeft As Tree##nameTree Ptr
        nodeRight As Tree##nameTree Ptr
        Declare Function getSize() As Integer
        Declare Function addNodeLeft(value As datatype) As Integer
        Declare Function addNodeRight(value As datatype) As Integer
        Declare Function searchParentNode(value As datatype) Byref As Tree##nameTree
        Declare Sub insertNode(node AS Tree##nameTree)
        Declare Function insertNodeLeft(node AS Tree##nameTree) As Integer
        Declare Function insertNodeRight(node AS Tree##nameTree) As Integer
        Declare Constructor()
        Declare Constructor(node AS Tree##nameTree)
        Declare Operator Let(node AS Tree##nameTree)
End Type

Constructor Tree##nameTree(value As datatype)
    This.value = value
End Constructor

Sub Tree##nameTree.printValuesPaths(rootTitle As String = "seed node")
    If @This = 0 Then
        Return
    Else
        Print This.value & " ", rootTitle
        This.nodeLeft->printValuesPaths(rootTitle & " + L")
        This.nodeRight->printValuesPaths(rootTitle & " + R")
    End If	
End Sub

Destructor Tree##nameTree()
    If This.nodeLeft <> 0 Then
        This.value = 0
        Delete This.nodeLeft
    End If
    If This.nodeRight <> 0 Then
        This.value = 0
        Delete This.nodeRight
    End If
End Destructor


Function Tree##nameTree.insertNodeLeft(node AS Tree##nameTree) As Integer
    If This.nodeLeft = 0 Then
        This.nodeLeft = @node
        Return 0
    End If
    Return -1
End Function

Function Tree##nameTree.insertNodeRight(node AS Tree##nameTree) As Integer
    If This.nodeRight = 0 Then
        This.nodeRight = @node
        Return 0
    End If
    Return -1
End Function

Function Tree##nameTree.searchParentNode(value As datatype) Byref As Tree##nameTree
    Static as Tree##nameTree Ptr p
    If This.value = value Then
        Return *p
    Else
        p = @This
        If value > this.value Then
            Return This.nodeRight->searchParentNode(value)
        Else
            Return This.nodeLeft->searchParentNode(value)
        End If
    End If
End Function

Sub Tree##nameTree.insertNode(node AS Tree##nameTree)
    If (node.value < This.value) Then
        If This.insertNodeLeft(node) = 0 Then
            Return
        Else
            This.nodeLeft->insertNode(node)
        End If
    Else
        If This.insertNodeRight(node) = 0 Then
            Return
        Else
            This.nodeRight->insertNode(node)
        End If
    End If    
End Sub

Function Tree##nameTree.deleteValue(value As datatype) As Boolean
    If (This.value = value) Or (This.existValue(value) = False) Then
        Return False
    End If
    
    Dim Byref As Tree##nameTree parentNode = This.searchParentNode(value)
    If (parentNode.nodeLeft <> 0) Andalso (parentNode.nodeLeft->value = value) Then
        Dim As Tree##nameTree Ptr p = parentNode.nodeLeft
        parentNode.nodeLeft = p->nodeLeft
        p->nodeLeft = 0
        If p->nodeRight <> 0 Then
            This.insertNode(*p->nodeRight)
            p->nodeRight = 0
        End If
        Delete p
    Else
        Dim As Tree##nameTree Ptr p = parentNode.nodeRight
        parentNode.nodeRight = p->nodeRight
        p->nodeRight = 0
        If p->nodeLeft <> 0 Then
            This.insertNode(*p->nodeLeft)
            p->nodeLeft = 0
        End If
        Delete p
    End If
    Return True
End Function

Function Tree##nameTree.removeSeedValue() As Boolean
    If (This.nodeLeft = 0) And (This.nodeRight = 0) Then
        Return False
    End If
    
    Dim As Tree##nameTree Ptr p
    If This.nodeRight <> 0 Then
        p = This.nodeRight
        While p->nodeLeft <> 0
            p = p->nodeLeft
        Wend
    Else
        p = This.nodeLeft
        While p->nodeRight <> 0
            p = p->nodeRight
        Wend
    End If
    
    Dim Byref As Tree##nameTree parentNode = This.searchParentNode(p->value)
    If parentNode.nodeLeft->value = p->value Then
        parentNode.nodeLeft = 0
    Else
        parentNode.nodeRight = 0
    End If
    
    This.value = p->value
    If p->nodeLeft <> 0 Then
        This.insertNode(*p->nodeLeft)
        p->nodeLeft = 0
    End If
    If p->nodeRight <> 0 Then
        This.insertNode(*p->nodeRight)
        p->nodeRight = 0
    End If
    Delete p
    Return True
End Function

Function Tree##nameTree.addNodeLeft(value As datatype) As Integer
    If This.nodeLeft = 0 Then
        This.nodeLeft = New Tree##nameTree(value)
        Return 0
    End If
    Return -1
End Function

Function Tree##nameTree.addNodeRight(value As datatype) As Integer
    If This.nodeRight = 0 Then
        This.nodeRight = New Tree##nameTree(value)
        Return 0
    End If
    Return -1
End Function

Sub Tree##nameTree.printPreorderValues()
    If @This = 0 Then
        Return
        End If
    Print This.value & " " 'process node
    This.nodeLeft->printPreorderValues() 'recurse on left
    This.nodeRight->printPreorderValues() 'recurse on right
End Sub

Sub Tree##nameTree.printPostorderValues()
    If @This = 0 Then
        Return
    End If
    This.nodeLeft->printPreorderValues() 'recurse on left
    This.nodeRight->printPreorderValues() 'recurse on right
    Print This.value & " " 'process node
End Sub

Sub Tree##nameTree.printInorderValues()
    If @This = 0 Then
        Return
    End If
    This.nodeLeft->printPreorderValues() 'recurse on left
    Print This.value & " " 'process node
    This.nodeRight->printPreorderValues() 'recurse on right	
End Sub

Function Tree##nameTree.existValue(value As datatype) As Boolean
    If @This = 0 Then
        Return False
    Elseif This.value = value Then
        Return True
    Else
        ' if the node we're at is smaller than the value we're looking for, traverse on the right side
        If value > This.value Then
            Return This.nodeRight->existValue(value)
        Else
            ' if the node we're at is bigger than the value we're looking for, traverse the left side
            Return This.nodeLeft->existValue(value)
        End If
    End If	
End Function

Function Tree##nameTree.getTreeHeight() As Integer
    If @This = 0 Then
        Return -1
    End If

    Dim leftHeight As Integer = This.nodeLeft->getTreeHeight()
    Dim rightHeight As Integer = This.nodeRight->getTreeHeight()

    If leftHeight > rightHeight Then
        Return leftHeight + 1
    Else
        Return rightHeight + 1
    End If	
End Function

Function Tree##nameTree.getTreeSize() As Integer
    If @This = 0 Then
        Return -1
    End If
	
    Dim size As Integer = This.getSize()
    Return size-1
End Function

Function Tree##nameTree.getSize() As Integer
    If @This = 0 Then
        Return 1
    End If
	
    Dim a As Integer = This.nodeLeft->getSize() 'recurse on left
    Dim b As Integer = This.nodeRight->getSize() 'recurse on right	
    Return a + b
End Function

Function Tree##nameTree.getValuePath(value As datatype, rootTitle As String = "seed node") As String
    If @This = 0 Then
        Return "no path"
    Elseif This.value = value Then
        Return rootTitle
    Else
        ' if the node we're at is smaller than the value we're looking for, traverse on the right side
        If value > This.value Then
            Return This.nodeRight->getValuePath(value, rootTitle & " + R")
        Else
            ' if the node we're at is bigger than the value we're looking for, traverse the left side
            Return This.nodeLeft->getValuePath(value, rootTitle & " + L")
        End If
    End If	
End Function

Sub Tree##nameTree.insertValue(value As datatype)
    If (value < This.value) Then
        If This.addNodeLeft(value) = 0 Then
            Return
        Else
            This.nodeLeft->insertValue(value)
        End If
    Else
        If This.addNodeRight(value) = 0 Then
            Return
        Else
            This.nodeRight->insertValue(value)
        End If
    End If    
End Sub

Function Tree##nameTree.getNearestNeighbour(value As datatype) As datatype
    Static As Integer n
    Static As Tree##nameTree Ptr p
    If p <> 0 Then
        If Abs(value - This.value) < Abs(value - p->value) Then
            p = @This
        End If
    Else
        p = @This
    End If
    
    If (value < This.value) Then
        If This.nodeLeft <> 0 Then
            n+= 1
            This.nodeLeft->getNearestNeighbour(value)
        End If
    Else
        If This.nodeRight <> 0 Then
            n += 1
            This.nodeRight->getNearestNeighbour(value)
        End If
    End If
    
    Dim As datatype d
    If n = 0 Then
        d = p->value
        p = 0
    Else
        n -= 1
    End If
    Return d
End Function
#Endmacro

main.bas:

Code: Select all

#Include "btree.bi"

MakeTree(Double, T1)                  'make a double tree structure, with name T1
Dim b As Boolean                      'b as boolean
Dim height As Integer                 'height as integer
Dim size As Integer                   'size of tree as integer
Dim pT As TreeT1 Ptr = New TreeT1(8)  'initialize with 8 a dynamic tree referenced by pointer pT

'insert values into tree
pT->insertValue(4)
pT->insertValue(12)
pT->insertValue(2)
pT->insertValue(6)
pT->insertValue(10)
pT->insertValue(14)
pT->insertValue(1)
pT->insertValue(3)
pT->insertValue(5)
pT->insertValue(7)
pT->insertValue(9)
pT->insertValue(11)
pT->insertValue(13)
pT->insertValue(15)
pT->insertValue(15.4)


/'
'insert values into tree
pT->insertValue(7)
pT->insertValue(6)
pT->insertValue(5)
pT->insertValue(4)
pT->insertValue(3)
pT->insertValue(2)
pT->insertValue(1)
pT->insertValue(0)
'/

'pT->printPreorderValues()
pT->printInorderValues()
'pT->printPostorderValues()

'search for 6
b = pT->existValue(6)
Print "6 is found in tree ? " & b

'search for 5.4
b = pT->existValue(5.4)
Print "5.4 is found in tree ? " & b

'get tree height
height = pT->getTreeHeight()
Print "Binary Tree height=" & height

'get tree size
size = pT->getTreeSize()
Print "Binary Tree size = " & size

'delete node
Print
b = pT->deleteValue(6)
Print "6 is deleted in tree ? " & b
Print
pT->printInorderValues()

'get tree size
size = pT->getTreeSize()
Print "Binary Tree size = " & size

Print
pT->printValuesPaths()

Print
b = pT->removeSeedValue()
Print "seed value is removed from tree ? " & b

Print
pT->printValuesPaths()

Print
pT->insertValue(8)
Print "old seed value is reinserted into tree"

Print
pT->printValuesPaths()

Print
Print "11 is found in path = " & pT->getValuePath(11)

Print
Print "5.4 is found in path = " & pT->getValuePath(5.4)

Print
Print "11 has nearest neighbor = " & pT->getNearestNeighbour(11)

Print
Print "5.4 has nearest neighbor = " & pT->getNearestNeighbour(5.4)

Delete pT  'delete the full tree

Sleep

demosthenesk · Post by **demosthenesk** » Sep 14, 2022 20:01

Added !
https://github.com/demosthenesk/FreeBAS ... SearchTree

Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example

Re: Binary Tree example