;find
;insert
;free
I'm not sure how your supposed test for the type with compiler directives, so you need to tell it if it's dealing with a string or not, in the case of strings in a structure, haven't tried.
Code: Select all
Macro Template_class_Btree(T,isString=0)
Structure Tree#T
*vt
item.T;
key.i
*left.Tree#T;
*right.Tree#T;
EndStructure
Declare Free_Tree_#T(*this.Tree#T)
Declare Find_Tree_#T(*this.Tree#T,*item,key)
Declare Insert_Tree_#T(*this.Tree#T,*item,key)
Interface Tree_obj_#t
Insert(*item,key)
Find(*item,key)
Free()
EndInterface
Procedure Find_Tree_#T(*this.Tree#T,*item,key)
Protected tt.T
If Not *this
ProcedureReturn #False
EndIf
If *this\key = key
CompilerIf isString
PokeS(*item,*this\item)
CompilerElse
CopyMemory(@*this\item,*item,SizeOf(tt))
CompilerEndIf
ProcedureReturn #True;
ElseIf key < *this\key
ProcedureReturn Find_Tree_#T(*this\left,*item,key);
Else
ProcedureReturn Find_Tree_#T(*this\right,*item,key);
EndIf
EndProcedure
Procedure Insert_Tree_#T(*this.Tree#T,*item,key)
Protected tt.T
If Not *this
*this = AllocateMemory(SizeOf(Tree#T))
*this\key = key
CompilerIf isString
*this\item = PeekS(*item)
CompilerElse
CopyMemory(*item,@*this\item,SizeOf(tt))
CompilerEndIf
Else
If key <= *this\key
*this\left = insert_Tree_#T(*this\left,*item,key)
Else
*this\right = insert_Tree_#T(*this\right,*item,key)
EndIf
EndIf
ProcedureReturn(*this)
EndProcedure
Procedure Del_Nodes_Tree_#T(*this.Tree#T)
Static dct
If *this\key
FreeMemory(*this)
dct+1
EndIf
If *this\left Or *this\right
If *this\left
del_nodes_Tree_#T(*this\left)
EndIf
If *this\right
del_nodes_Tree_#T(*this\right)
EndIf
EndIf
ProcedureReturn dct
EndProcedure
Procedure Free_Tree_#T(*this.Tree#T)
ct = del_nodes_Tree_#T(*this)
ClearStructure(*this,Tree#T)
FreeMemory(*this)
ProcedureReturn ct
EndProcedure
Procedure New_Tree_#T(*obj.Tree#t)
*obj = AllocateMemory(SizeOf(Tree#t))
If *obj
*obj\vt=?vt_tree#t
EndIf
ProcedureReturn *obj
EndProcedure
DataSection: vt_tree#t:
Data.i @Insert_Tree_#T()
Data.i @Find_Tree_#T()
Data.i @Free_Tree_#T()
EndDataSection
EndMacro
;Create BTree templates
Template_class_BTree(i)
Template_class_BTree(point)
Template_class_BTree(s,1)
;the test procedures
Procedure Test_Integer_BTree()
Protected intTree.Tree_obj_i = new_tree_i(@intTree)
;generate a random array of values and insert into tree
Dim aVal.i(100)
For a = 1 To 100
aVal(a) = Random(100)+1
intTree\insert(@aVal(a),aVal(a))
Next
;define an integer and lookup the values from the array
Define b.i
For a = 1 To 100
If intTree\Find(@b,aVal(a))
Debug "item number " + Str((a)) + " Found " + Str(b)
EndIf
Next
Debug intTree\Free()
EndProcedure
Procedure Test_POINT_BTree()
Protected ptTree.Tree_obj_point = new_Tree_point(@ptTree)
Dim aPT.point(100)
Dim aVal.i(100)
For a = 1 To 100
apt(a)\x = Random(100)
apt(a)\y = Random(100)
aVal(a) = apt(a)\x + apt(a)\y
;insert point with the key x * y
ptTree\insert(@apt(a),aVal(a))
Next
Define pt.point
For a = 1 To 100
If ptTree\find(@pt,aval(a))
Debug "item number " + Str(a) + " Found pt x=" + Str(pt\x) + " y=" + Str(pt\y)
EndIf
Next
Debug ptTree\Free()
EndProcedure
Procedure test_String_BTree()
Protected sTree.Tree_obj_s = new_Tree_s(@sTree)
Dim aVal.i(100)
Dim ast.s(100)
For a = 1 To 100
ast(a) = Str(Random(100)+1)
aval(a) = CRC32Fingerprint(@ast(a),Len(ast(a)))
sTree\insert(@ast(a),aval(a))
Next
;
Global sOut.s = ""
For a = 1 To 100
If sTree\find(@sout,aval(a))
Debug "item number " + Str(a) + " Found " + sout
EndIf
Next
Debug sTree\Free()
EndProcedure
;call the procedures
Test_Integer_BTree()
Test_POINT_BTree()
Test_String_BTree()