Binary Search Tree and AVL tree

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
L_O_J
Posts: 181
Joined: Aug 20, 2005 9:05

Binary Search Tree and AVL tree

Post by L_O_J »

just made this yesterday...

Code: Select all

type Node
    value as integer
    left  as Node ptr
    right as Node ptr
end type

function createNode( byval v as integer, byval l as Node ptr, byval r as Node ptr ) as Node ptr
    dim new as Node ptr = 0
    new = callocate( len(Node) )
    new->value = v
    new->left  = l
    new->right = r
    return new
end function

function insert( byval v as integer, n as Node ptr ) as Node ptr
    if (n = 0) then
        n = createNode( v, 0, 0 )
    elseif (v < n->value) then
        n->left  = insert( v, n->left )
    elseif (v > n->value) then
        n->right = insert( v, n->right )
    end if
    return n
end function

function findMin( byval n as Node ptr ) as Node ptr
    if (n = 0) then return 0
    
    while (n->left <> 0)
        n = n->left
    wend
    return n
end function

function findMax( byval n as Node ptr ) as Node ptr
    if (n = 0) then return 0
    
    while (n->right <> 0)
        n = n->right
    wend
    return n
end function

function preOrder( byval n as Node ptr )
    if (n = 0) then return
    
    print (n->value);
    preOrder(n->left)
    preOrder(n->right)
    
    return
end function

function postOrder( byval n as Node ptr )
    if (n = 0) then return
    
    postOrder(n->left)
    postOrder(n->right)
    print (n->value);
    
    return
end function

function inOrder( byval n as Node ptr )
    if (n = 0) then return
    
    inOrder(n->left)
    print  (n->value);
    inOrder(n->right)
    
    return
end function

function removeMin( n as Node ptr ) as Node ptr
    if n = 0 then return
    
    dim old as Node ptr = 0
    if (n->left <> 0) then
        n->left = removeMin( n->left )
    else
        old = n
        n = n->right
        deallocate n
    end if
    return n
end function

function removeMax( n as Node ptr ) as Node ptr
    if n = 0 then return
    
    dim old as Node ptr = 0
    if (n->right <> 0) then
        n->right = removeMax( n->right )
    else
        old = n
        n = n->left
        deallocate n
    end if
    return n
end function

function remove( byval v as integer, n as Node ptr ) as Node ptr
    if n = 0 then return
    
    dim old as Node ptr = 0
    if v < n->value then
        n->left = remove( v, n->left )
    elseif v > n->value then
        n->right = remove( v, n->right )
    elseif (n->left <> 0) and (n->right <> 0) then
        n->value = findMax( n->left )->value
        removeMax( n->left )
    else
        old = n
        n = iif(n->left = 0, n->right, n->left )
        deallocate old
    end if
    return n
end function

function main()
    dim root as Node ptr = 0
    
    insert( 10, root )
    insert( 11, root )
    insert( 5 , root )
    insert( 8 , root )
    insert( 2 , root )
    insert( 7 , root )
    
    print "preOrder  : ";
    preOrder( root ) : print
    print "postOrder : ";
    postOrder( root ): print
    print "inOrder   : ";
    inOrder( root )  : print
    
    print
    print "removing 5 from tree"
    print
    remove( 5, root )
    
    print "preOrder  : ";
    preOrder( root ) : print
    print "postOrder : ";
    postOrder( root ): print
    print "inOrder   : ";
    inOrder( root )  : print
    
    sleep
end function

end( main() )
improved to AVL tree ( BTW the above code have some error in the deallocation, i'll let you guys search it for your self :D )

Code: Select all

type Node
    value as integer
    left  as Node ptr
    right as Node ptr
end type

function singleRightRotation( n as Node ptr ) as Node ptr
    dim temp as Node ptr = 0
    temp = n->left
    n->left = temp->right
    temp->right = n
    return temp
end function

function singleLeftRotation( n as Node ptr ) as Node ptr
    dim temp as Node ptr = 0
    temp = n->right
    n->right = temp->left
    temp->left = n
    return temp
end function

function doubleRightRotation( n as Node ptr ) as Node ptr
    dim t1 as Node ptr = 0
    dim t2 as Node ptr = 0

    t1 = n->left
    t2 = t1->right
    
    n->left = t2->right
    t1->right = t2->left
    
    t2->right = n
    t2->left  = t1
    return t2
end function

function doubleLeftRotation( n as Node ptr ) as Node ptr
    dim t1 as Node ptr = 0
    dim t2 as Node ptr = 0

    t1 = n->right
    t2 = t1->left
    
    n->right = t2->left
    t1->left = t2->right
    
    t2->left = n
    t2->right  = t1
    return t2
end function

function max( v1 as integer, v2 as integer ) as integer
    return iif( v1 < v2, v2, v1 )
end function

function height( n as Node ptr ) as integer
    if n = 0 then return 0
    
    return 1 + max( height( n->left ), height( n->right ) )
end function

function ballanceFactor( n as Node ptr ) as integer
    return height( n->right ) - height( n->left )
end function

function reballanceNode( n as Node ptr ) as Node ptr
    if n = 0 then return
    
    if ballanceFactor( n ) = -2 then
        if ballanceFactor( n->left ) = -1 or ballanceFactor( n->left ) = 0 then
            '
            ' single right rotation
            '
            n = singleRightRotation( n )
        elseif ballanceFactor( n->left ) = 1 then
            '
            ' double right rotation
            '
            n = doubleRightRotation( n )
        end if
    elseif ballanceFactor( n ) = 2  then
        if ballanceFactor( n->right ) = -1 then
            '
            ' double left rotation
            '
            n = doubleLeftRotation( n )
        elseif ballanceFactor( n->right ) = 1 or ballanceFactor( n ) = 0 then
            '
            ' single left rotation
            '
            n = singleLeftRotation( n )
        end if
    end if
    
    return n
end function

function createNode( byval v as integer, byval l as Node ptr, byval r as Node ptr ) as Node ptr
    dim new as Node ptr = 0
    new = callocate( len(Node) )
    new->value = v
    new->left  = l
    new->right = r
    return new
end function

function insert( byval v as integer, n as Node ptr ) as Node ptr
    if (n = 0) then
        n = createNode( v, 0, 0 )
    elseif (v < n->value) then
        n->left  = insert( v, n->left )
    elseif (v > n->value) then
        n->right = insert( v, n->right )
    end if

    n = reballanceNode( n )

    return n
end function


function findMin( byval n as Node ptr ) as Node ptr
    if (n = 0) then return 0
    
    while (n->left <> 0)
        n = n->left
    wend
    return n
end function

function findMax( byval n as Node ptr ) as Node ptr
    if (n = 0) then return 0
    
    while (n->right <> 0)
        n = n->right
    wend
    return n
end function

function preOrder( byval n as Node ptr )
    if (n = 0) then return 0

    print (n->value);
    preOrder(n->left)
    preOrder(n->right)

    return
end function

function postOrder( byval n as Node ptr )
    if (n = 0) then return 0
    
    postOrder(n->left)
    postOrder(n->right)
    print (n->value);
    
    return
end function

function inOrder( byval n as Node ptr )
    if (n = 0) then return 0
    
    inOrder(n->left)
    print  (n->value);
    inOrder(n->right)
    
    return
end function

function removeMin( n as Node ptr ) as Node ptr
    if n = 0 then return
    
    dim old as Node ptr = 0
    if (n->left <> 0) then
        n->left = removeMin( n->left )
    else
        old = n
        n = n->right
        deallocate old
    end if
    
    reballanceNode( n )

    return n
end function

function removeMax( n as Node ptr ) as Node ptr
    if n = 0 then return
    
    dim old as Node ptr = 0
    if (n->right <> 0) then
        n->right = removeMax( n->right )
    else
        old = n
        n = n->left
        deallocate old
    end if

    reballanceNode( n )

    return n
end function

function remove( byval v as integer, n as Node ptr ) as Node ptr
    if n = 0 then return

    dim old as Node ptr = 0
    if v < n->value then
        n->left = remove( v, n->left )
    elseif v > n->value then
        n->right = remove( v, n->right )
    elseif (n->left <> 0) and (n->right <> 0) then
        n->value = findMax( n->left )->value
        removeMax( n->left )
    else
        old = n
        n = iif(n->left = 0, n->right, n->left )
        deallocate old
    end if

    reballanceNode( n )

    return n
end function

function main()
    dim root as Node ptr = 0

    insert( 10, root )
    insert( 85, root )
    insert( 15, root )
    insert( 70, root )
    insert( 20, root )
    insert( 60, root )
    insert( 30, root )
    insert( 50, root )
    insert( 65, root )
    insert( 80, root )
    insert( 90, root )
    insert( 40, root )
    insert(  5, root )
    insert( 55, root )

    print "preOrder : "; : preOrder( root ) : print
    print "delete 60" : remove( 60, root )
    print "preOrder : "; : preOrder( root ) : print

    print "delete 55" : remove( 55, root )
    print "preOrder : "; : preOrder( root ) : print

    print "delete 50" : remove( 50, root )
    print "preOrder : "; : preOrder( root ) : print

    print "delete 40" : remove( 40, root )
    print "preOrder : "; : preOrder( root ) : print

    sleep
end function

end( main() )
Last edited by L_O_J on Jan 18, 2006 22:55, edited 2 times in total.
Top
rdc
Posts: 1741
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:
Contact rdc

Post by rdc »

Very cool.
Top
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

Post by D.J.Peters »

good job

Joshy
Top
VirusScanner
Posts: 775
Joined: Jul 01, 2005 18:45

Post by VirusScanner »

Cool, it took me forever to learn about those.
Top
Fabrizio_00000
Posts: 21
Joined: Mar 31, 2011 17:30
Location: Rome, Italy

Re:

Post by Fabrizio_00000 »

D.J.Peters wrote: ↑Jan 18, 2006 22:40 good job

Joshy
it would be a good job if it worked... :D

Code: Select all

inOrder :  5 10 15 20 30 40 50 55 60 65 70 80 85 90
delete 60
inOrder :  5 10 15 20 30 40 50 55 65 70 80 85 90
delete 55
inOrder :  5 10 15 20 30 40 50 65 70 80 85 90
delete 50
inOrder :  5 10 15 20 30 40 65 70 80 85 90
delete 40
inOrder :  15 20 30 65 70 80 85 90
Top
fxm
Moderator
Posts: 12107
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Binary Search Tree and AVL tree

Post by fxm »

Maybe the above codes compile with fbc 0.15b, but no longer now with a more recent fbc.
I will not correct the codes of a user who has not been on the forum for 15 years !
Top
Fabrizio_00000
Posts: 21
Joined: Mar 31, 2011 17:30
Location: Rome, Italy

Re: Binary Search Tree and AVL tree

Post by Fabrizio_00000 »

fxm wrote: ↑Dec 16, 2022 16:20 Maybe the above codes compile with fbc 0.15b, but no longer now with a more recent fbc.
I will not correct the codes of a user who has not been on the forum for 15 years !
Neither would I. Nonetheless the intersting fact is that the code compiles fine and the logic seems correct.

Ah, well...
Top
fxm
Moderator
Posts: 12107
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Binary Search Tree and AVL tree

Post by fxm »

With which version of fbc can you compile this code ?
Top
hhr
Posts: 208
Joined: Nov 29, 2019 10:41

Re: Binary Search Tree and AVL tree

Post by hhr »

I had some time and tried it out.

FreeBASIC-v0.15b-win32.exe: fbc compiles without errors.
FreeBASIC-v0.16b-win32.exe: fbc compiles with warnings.
FreeBASIC-v0.17b-win32.exe: Too many errors, exiting.

fbc-v0.15b is fast with calculations:
fbc-v0.15b: 2.97 sec
fbc-v0.16b: 4.03 sec
fbc-v0.17b: 4.03 sec
fbc-1.09.0-win32: 4.07 sec
But fbc-1.09.0-win32 with #cmdline "-gen gcc": 0.91 sec

I tested with

Code: Select all

dim as double a,s,t
t=timer
for a=1 to 100000000
   s+=a
   s-=a
   s*=a
   s/=a
   s=sin(2*atn(1))
next a
t=timer-t
print s,t
sleep
Top
Fabrizio_00000
Posts: 21
Joined: Mar 31, 2011 17:30
Location: Rome, Italy

Re: Binary Search Tree and AVL tree

Post by Fabrizio_00000 »

fxm wrote: ↑Dec 16, 2022 19:43 With which version of fbc can you compile this code ?
Sorry, fxm. I didn't see your reply... :(

I compiled with no errors with FreeBASIC Version 1.09.0, win-64
Top
fxm
Moderator
Posts: 12107
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Binary Search Tree and AVL tree

Post by fxm »

Fabrizio_00000 wrote: ↑Mar 01, 2023 13:00
fxm wrote: ↑Dec 16, 2022 19:43 With which version of fbc can you compile this code ?
Sorry, fxm. I didn't see your reply... :(

I compiled with no errors with FreeBASIC Version 1.09.0, win-64
My question was about the two codes in the first post !

For example for the first code, I get:
Command executed:
"C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\fbc.exe" "C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas" -exx -w pedantic -w constness -gen gcc

Compiler output:
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(8) error 4: Duplicated definition, found 'new' in 'dim new as Node ptr = 0'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(9) error 14: Expected identifier, found '=' in 'new = callocate( len(Node) )'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(10) error 14: Expected identifier, found '->' in 'new->value = v'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(11) error 14: Expected identifier, found '->' in 'new->left = l'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(12) error 14: Expected identifier, found '->' in 'new->right = r'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(13) error 14: Expected identifier in 'return new'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(13) warning 4(2): Suspicious pointer assignment
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(16) warning 15(1): No explicit BYREF or BYVAL, at parameter 2 (n) of insert()
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(45) error 147: Default types or suffixes are only valid in -lang deprecated or fblite or qb in 'function preOrder( byval n as Node ptr )'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(46) error 9: Expected expression in 'if (n = 0) then return'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(52) error 9: Expected expression in 'return'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(53) warning 13(1): Function result was not explicitly set
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(55) error 147: Default types or suffixes are only valid in -lang deprecated or fblite or qb in 'function postOrder( byval n as Node ptr )'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(55) error 133: Too many errors, exiting

Results:
Compilation failed

System:
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 1.09.0 (2021-12-31), built for win64 (64bit)
OS: Windows NT 6.2 (build 9200)
Top
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: Binary Search Tree and AVL tree

Post by srvaldez »

I am able to compile and run the second code on first post with FBC-16b, for reference the result is

Code: Select all

preOrder :  60 20 10 5 15 40 30 50 55 70 65 85 80 90
delete 60
preOrder :  55 20 10 5 15 40 30 50 70 65 85 80 90
delete 55
preOrder :  50 20 10 5 15 40 30 70 65 85 80 90
delete 50
preOrder :  40 20 10 5 15 30 70 65 85 80 90
delete 40
preOrder :  30 10 5 20 15 70 65 85 80 90
in case you want to download the older version of FB go to https://sourceforge.net/projects/fbc/fi ... 0versions/
Top
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: Binary Search Tree and AVL tree

Post by srvaldez »

I played with the code a bit and got it to work with the latest FB version, I don't claim to understand the code or that it's kosher

Code: Select all

type Node
    value as integer
    left  as Node ptr
    right as Node ptr
end type

function singleRightRotation( n as Node ptr ) as Node ptr
    dim temp as Node ptr = 0
    temp = n->left
    n->left = temp->right
    temp->right = n
    return temp
end function

function singleLeftRotation( n as Node ptr ) as Node ptr
    dim temp as Node ptr = 0
    temp = n->right
    n->right = temp->left
    temp->left = n
    return temp
end function

function doubleRightRotation( n as Node ptr ) as Node ptr
    dim t1 as Node ptr = 0
    dim t2 as Node ptr = 0

    t1 = n->left
    t2 = t1->right
    
    n->left = t2->right
    t1->right = t2->left
    
    t2->right = n
    t2->left  = t1
    return t2
end function

function doubleLeftRotation( n as Node ptr ) as Node ptr
    dim t1 as Node ptr = 0
    dim t2 as Node ptr = 0

    t1 = n->right
    t2 = t1->left
    
    n->right = t2->left
    t1->left = t2->right
    
    t2->left = n
    t2->right  = t1
    return t2
end function

function max( v1 as integer, v2 as integer ) as integer
    return iif( v1 < v2, v2, v1 )
end function

function height( n as Node ptr ) as integer
    if n = 0 then return 0
    
    return 1 + max( height( n->left ), height( n->right ) )
end function

function ballanceFactor( n as Node ptr ) as integer
    return height( n->right ) - height( n->left )
end function

function reballanceNode( n as Node ptr ) as Node ptr
    if n = 0 then return 0
    
    if ballanceFactor( n ) = -2 then
        if ballanceFactor( n->left ) = -1 or ballanceFactor( n->left ) = 0 then
            '
            ' single right rotation
            '
            n = singleRightRotation( n )
        elseif ballanceFactor( n->left ) = 1 then
            '
            ' double right rotation
            '
            n = doubleRightRotation( n )
        end if
    elseif ballanceFactor( n ) = 2  then
        if ballanceFactor( n->right ) = -1 then
            '
            ' double left rotation
            '
            n = doubleLeftRotation( n )
        elseif ballanceFactor( n->right ) = 1 or ballanceFactor( n ) = 0 then
            '
            ' single left rotation
            '
            n = singleLeftRotation( n )
        end if
    end if
    
    return n
end function

sub createNode( byval v as integer, byval l as Node ptr, byval r as Node ptr, byref new_ as Node ptr = 0 )
    new_ = callocate( len(Node) )
    new_->value = v
    new_->left  = l
    new_->right = r
end sub

sub insert( byval v as integer, byref n as Node ptr )
    if (n = 0) then
        createNode( v, 0, 0, n )
    elseif (v < n->value) then
        insert( v, n->left )
    elseif (v > n->value) then
        insert( v, n->right )
    end if

    n = reballanceNode( n )
end sub


sub findMin( byref n as Node ptr )
    if (n = 0) then exit sub
    
    while (n->left <> 0)
        n = n->left
    wend

end sub

function findMax( byval n as Node ptr ) as Node ptr
    if (n = 0) then return 0
    
    while (n->right <> 0)
        n = n->right
    wend
    return n
end function

function preOrder( byval n as Node ptr ) as long
    if (n = 0) then return 0

    print (n->value);
    preOrder(n->left)
    preOrder(n->right)

    return 0
end function

function postOrder( byval n as Node ptr ) as long
    if (n = 0) then return 0
    
    postOrder(n->left)
    postOrder(n->right)
    print (n->value);
    
    return 0
end function

function inOrder( byval n as Node ptr ) as long
    if (n = 0) then return 0
    
    inOrder(n->left)
    print  (n->value);
    inOrder(n->right)
    
    return 0
end function

function removeMin( n as Node ptr ) as Node ptr
    if n = 0 then return 0
    
    dim old as Node ptr = 0
    if (n->left <> 0) then
        n->left = removeMin( n->left )
    else
        old = n
        n = n->right
        deallocate old
    end if
    
    reballanceNode( n )

    return n
end function

function removeMax( n as Node ptr ) as Node ptr
    if n = 0 then return 0
    
    dim old as Node ptr = 0
    if (n->right <> 0) then
        n->right = removeMax( n->right )
    else
        old = n
        n = n->left
        deallocate old
    end if

    reballanceNode( n )

    return n
end function

function remove( byval v as integer, n as Node ptr ) as Node ptr
    if n = 0 then return 0

    dim old as Node ptr = 0
    if v < n->value then
        n->left = remove( v, n->left )
    elseif v > n->value then
        n->right = remove( v, n->right )
    elseif (n->left <> 0) and (n->right <> 0) then
        n->value = findMax( n->left )->value
        removeMax( n->left )
    else
        old = n
        n = iif(n->left = 0, n->right, n->left )
        deallocate old
    end if

    reballanceNode( n )

    return n
end function

function main() as long
    dim root as Node ptr = 0

    insert( 10, root )
    insert( 85, root )
    insert( 15, root )
    insert( 70, root )
    insert( 20, root )
    insert( 60, root )
    insert( 30, root )
    insert( 50, root )
    insert( 65, root )
    insert( 80, root )
    insert( 90, root )
    insert( 40, root )
    insert(  5, root )
    insert( 55, root )

    print "preOrder : "; : preOrder( root ) : print
    print "delete 60" : remove( 60, root )
    print "preOrder : "; : preOrder( root ) : print

    print "delete 55" : remove( 55, root )
    print "preOrder : "; : preOrder( root ) : print

    print "delete 50" : remove( 50, root )
    print "preOrder : "; : preOrder( root ) : print

    print "delete 40" : remove( 40, root )
    print "preOrder : "; : preOrder( root ) : print
	return 0
    sleep
end function

end( main() )
Top
Fabrizio_00000
Posts: 21
Joined: Mar 31, 2011 17:30
Location: Rome, Italy

Re: Binary Search Tree and AVL tree

Post by Fabrizio_00000 »

fxm wrote: ↑Mar 01, 2023 14:12
Fabrizio_00000 wrote: ↑Mar 01, 2023 13:00
fxm wrote: ↑Dec 16, 2022 19:43 With which version of fbc can you compile this code ?
Sorry, fxm. I didn't see your reply... :(

I compiled with no errors with FreeBASIC Version 1.09.0, win-64
My question was about the two codes in the first post !

For example for the first code, I get:
Command executed:
"C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\fbc.exe" "C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas" -exx -w pedantic -w constness -gen gcc

Compiler output:
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(8) error 4: Duplicated definition, found 'new' in 'dim new as Node ptr = 0'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(9) error 14: Expected identifier, found '=' in 'new = callocate( len(Node) )'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(10) error 14: Expected identifier, found '->' in 'new->value = v'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(11) error 14: Expected identifier, found '->' in 'new->left = l'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(12) error 14: Expected identifier, found '->' in 'new->right = r'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(13) error 14: Expected identifier in 'return new'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(13) warning 4(2): Suspicious pointer assignment
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(16) warning 15(1): No explicit BYREF or BYVAL, at parameter 2 (n) of insert()
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(45) error 147: Default types or suffixes are only valid in -lang deprecated or fblite or qb in 'function preOrder( byval n as Node ptr )'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(46) error 9: Expected expression in 'if (n = 0) then return'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(52) error 9: Expected expression in 'return'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(53) warning 13(1): Function result was not explicitly set
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(55) error 147: Default types or suffixes are only valid in -lang deprecated or fblite or qb in 'function postOrder( byval n as Node ptr )'
C:\.....\FBIde0.4.6r4-FreeBASIC1.09.0.win64\FBIDETEMP.bas(55) error 133: Too many errors, exiting

Results:
Compilation failed

System:
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 1.09.0 (2021-12-31), built for win64 (64bit)
OS: Windows NT 6.2 (build 9200)
Well, I did not try to compile the first snippet: L_O_J clearly stated that there were problems in deallocating nodes so I went stright for the 2nd code. Frankly I do not remember whether I modified it or not...
Top
Fabrizio_00000
Posts: 21
Joined: Mar 31, 2011 17:30
Location: Rome, Italy

Re: Binary Search Tree and AVL tree

Post by Fabrizio_00000 »

srvaldez wrote: ↑Mar 01, 2023 20:37 I played with the code a bit and got it to work with the latest FB version, I don't claim to understand the code or that it's kosher
instead of hunting for errors in the original code, I decided to rewrite it from scratch:

Code: Select all

#define maxitem 1000
type Node
	key as integer
	left as ulong
	right as ulong
	height as integer
	cnt as integer
end type

dim shared as node tree(1 to maxitem)
dim shared as ubyte tplc(1 to maxitem)
dim shared as ulong maxreach

' Calculate height
function height(N as ulong) as integer
	if N = 0 then return 0
	return tree(N).height
end function

function max(a as integer, b as integer) as integer
	return iif(a > b, a, b)
end function

function malloc() as ulong
	for i as integer = 1 to maxreach
		if tplc(i) = 0 then
			tplc(i) = 1
			return i
		endif
	next
	if maxreach < maxitem then
		maxreach += 1
		tplc(maxreach) = 1
		return maxreach
	endif
	return 0
end function

sub free(x as ulong)
	tplc(x) = 0
	if x = maxreach then maxreach -= 1
end sub

' Right rotate
function rightRotate(y as ulong) as ulong
	dim as ulong x = tree(y).left
	dim as ulong T2 = tree(x).right
	tree(x).right = y
	tree(y).left = T2
	tree(y).height = max(height(tree(y).left), height(tree(y).right)) + 1
	tree(x).height = max(height(tree(x).left), height(tree(x).right)) + 1
	return x
end function

' Left rotate
function leftRotate(x as ulong) as ulong
	dim as ulong y = tree(x).right
	dim as ulong T2 = tree(y).left
	tree(y).left = x
	tree(x).right = T2
	tree(x).height = max(height(tree(x).left), height(tree(x).right)) + 1
	tree(y).height = max(height(tree(y).left), height(tree(y).right)) + 1
	return y
end function

' Get the balance factor
function getBalance(N as ulong) as integer
	if N = 0 then return 0
	return height(tree(N).left) - height(tree(N).right)
end function

' Insert node
function insert(node as ulong, key as integer) as ulong
	if node = 0 then 
		dim as ulong tmp = malloc()
		tree(tmp).key = key
		tree(tmp).left = 0
		tree(tmp).right = 0
		tree(tmp).height = 1
		tree(tmp).cnt = 1
		return tmp
	endif
	if key < tree(node).key then
		tree(node).left = insert(tree(node).left, key)
	elseif key > tree(node).key then
		tree(node).right = insert(tree(node).right, key)
	else
		tree(node).cnt += 1
		return node
	endif
	' Update the balance factor of each node and Balance the tree
	tree(node).height = 1 + max(height(tree(node).left), height(tree(node).right))
	dim as integer balance = getBalance(node)
	if balance > 1 and key < tree(tree(node).left).key then return rightRotate(node)
	if balance < -1 and key > tree(tree(node).right).key then return leftRotate(node)
	if balance > 1 and key > tree(tree(node).left).key then
		tree(node).left = leftRotate(tree(node).left)
		return rightRotate(node)
	endif
	if balance < -1 and key < tree(tree(node).right).key then
		tree(node).right = rightRotate(tree(node).right)
		return leftRotate(node)
	endif
	return node
end function

' Delete a node
function remove(root as ulong, key as integer) as ulong
	if root = 0 then return root
	if key < tree(root).key then
		tree(root).left = remove(tree(root).left, key)
	elseif key > tree(root).key then
		tree(root).right = remove(tree(root).right, key)
	else
		if tree(root).cnt = 1 then
			if tree(root).left = 0 or tree(root).right = 0 then
				dim as ulong temp = iif(tree(root).left, tree(root).left, tree(root).right)
				if temp = 0 then
					temp = root
					root = 0
				else
					root = temp
				endif
				free(temp)
			else
				dim as ulong temp = tree(root).right
				do while tree(temp).left
					temp = tree(temp).left
				loop
				tree(root).key = tree(temp).key
				tree(root).cnt = tree(temp).cnt
				tree(root).right = remove(tree(root).right, tree(temp).key)
			endif
		else
			tree(root).cnt -= 1
		endif
	endif
	if root = 0 then return root
	tree(root).height = 1 + max(height(tree(root).left), height(tree(root).right))
	dim as integer balance = getBalance(root)
	if balance > 1 and getBalance(tree(root).left) >= 0 then return rightRotate(root)
	if balance > 1 and getBalance(tree(root).left) < 0 then
		tree(root).left = leftRotate(tree(root).left)
		return rightRotate(root)
	endif
	if balance < -1 and getBalance(tree(root).right) <= 0 then return leftRotate(root)
	if balance < -1 and getBalance(tree(root).right) > 0 then
		tree(root).right = rightRotate(tree(root).right)
		return leftRotate(root)
	endif
	return root
end function

' search a node
function search(root as ulong, v as integer) as ulong
	if root = 0 then return 0
	if (tree(root).key = v) then return root
	return search(iif(v > tree(root).key, tree(root).right, tree(root).left), v)
end function

' find first key
function findfirst(t as ulong) as ulong
	if t = 0 then return 0
	return iif(tree(t).left, findfirst(tree(t).left), t)
end function

' find last key
function findlast(t as ulong) as ulong
	if t = 0 then return 0
	return iif(tree(t).right, findlast(tree(t).right), t)
end function

' Find next key
function findnext(t as ulong, x as integer) as ulong
	if t = 0 then return 0
	if tree(t).key > x then
		dim as ulong tmp = findnext(tree(t).left, x)
		return iif(tmp, tmp, t)
	elseif tree(t).key < x then
      		return findnext(tree(t).right, x)
	else
		return iif(tree(t).right, findnext(tree(t).right, x), 0)
	endif
end function

' find previous key
function findprev(t as ulong, x as integer) as ulong
	if t = 0 then return 0
	if tree(t).key < x then
		dim as ulong tmp = findprev(tree(t).right, x)
		return iif(tmp, tmp, t)
	elseif tree(t).key > x then
      		return findprev(tree(t).left, x)
	else
		return iif(tree(t).left, findprev(tree(t).left, x), 0)
	endif
end function

' Preorder traversal of the tree
sub preorder(root as ulong) 
	if root then
		print trim(str(tree(root).key)); " ";
		PreOrder tree(root).left
		PreOrder tree(root).right
	endif
end sub

' inorder traversal of the tree
sub inorder(root as ulong)
	if root = 0 then return
	inorder tree(root).left
	print trim(str(tree(root).key));" ";
	inorder tree(root).right
end sub

' postorder traversal of the tree
sub postorder(root as ulong)
	if root = 0 then return
	postorder tree(root).left
	postorder tree(root).right
	print trim(str(tree(root).key));" ";
end sub

' show internal structure of the tree
sub showraw(root as ulong)
	for i as ulong = 1 to maxreach
		print right(" " + str(i), 2); " "; _
			iif(tplc(i) = 0, "E", " "); " "; _
			iif(i = root, "*", " "); " "; _
			"Lt:"; right(" " + str(tree(i).left), 2); " "; _
			"Rt:"; right(" " + str(tree(i).right), 2); " "; _
			"Ht:"; right(" " + str(tree(i).height), 2); "  "; _
			"Cnt:"; right(" " + str(tree(i).cnt), 2); " "; _
			"Key:"; trim(str(tree(i).key))
	next
end sub

dim as integer tmp
dim as ulong result, root
for i as ulong = 1 to 20
	tmp = int(rnd() * 100) - 50
	if search(root, tmp) <> 0 then
		i -= 1
	else
		root = insert(root, tmp)
	endif
next
for i as ulong = 1 to 7
	root = remove(root, tree(i * 2).key)
next
do
	print
	print "Node: [I] Insert [R] Remove                    [Esc] Exit"
	print "Find: [N] Next [P] Previous [F] First [L] Last [S] Search"
	print "Show: [1] Inorder [2] Preorder [3] Postorder [4] Internal"
	print
	do
		select case ucase(input(1))
		case "I"
			print "Insert. Enter key: ";
			input "", tmp
			root = insert(root, tmp)
			showraw root
			exit do
		case "R"
			print "Remove. Enter key: ";
			input "", tmp
			root = remove(root, tmp)
			showraw root
			exit do
		case "S"
			print "Search. Enter key: ";
			input "", tmp
			result = search(root, tmp)
			print "Key "; trim(str(tmp)); iif(result, " found @" & str(result), _
				" not found.")
			exit do
		case "F"
			result = findfirst(root)
			print iif(result, "First key is " & trim(str(tree(result).key)) & _
				" @" & trim(str(result)), "No tree defined.")
			exit do
		case "L"
			result = findlast(root)
			print iif(result, "Last key is " & trim(str(tree(result).key)) & _
				" @" & trim(str(result)), "No tree defined.")
			exit do
		case "1"
			print "Inorder traversal:"
			inorder root
			print
			exit do
		case "2"
			print "Preorder traversal:"
			preorder root
			print
			exit do
		case "3"
			print "Postorder traversal:"
			postorder root
			print
			exit do
		case "N"
			showraw root
			print "Go to Next. Enter node #";
			input "", tmp
			result = findnext(root, tree(tmp).key) 	     			
			print iif(result, "Next key @" & trim(str(result)), _
				"No next key found.")
			exit do
		case "P"
			showraw root
			print "Go to Previous. Enter node #";
			input "", tmp
			result = findprev(root, tree(tmp).key) 	
			print iif(result, "Previous key @" & trim(str(result)), _
				"No previous key found.")
			exit do
		case "4"
			showraw root
			exit do
		case chr(27)
			exit do, do
		end select
	loop
loop
A couple of clarifications:
  • the code seems to work well but has not been tested extensively
  • in this implementation I have used an array instead of pointers: since the final use should be as an index of a file, it is faster and easier to save an array to disk rather than a series of pointers. However, modifying the snippet to use pointers should be relatively easy
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”