SRL Archive - Research & Development Lounge

Hi all,

I put together these binary tree functions and would appreciate any feedback or fixes. I think everything is working but there may still be some gotchas in there.

If you don't know about things like pointers, linked lists, and trees, the web will explain things better than I can. I found a set of videos on data structures here.

I didn't write the rebalancer yet, saving that one for another day :)

LAPE experts: Please note the writeln at line 442. If I remove this the function does not work properly!! Why?

The code will download and run a small example.

Headers:

type  
   TComparator = function(a, b: Pointer): integer;
   TPointerArray = array of Pointer;
   
   TTreeNode = record
      data:  Pointer;
      left:  Pointer;
      right: Pointer;
   end;

   TTNodePtr = ^TTreeNode;
   TTNodePtrArray = array of TTNodePtr;
   
   TBinaryTree = record
      head:      TTNodePtr;
      fcompare:  TComparator;
   end;
   
procedure TBinaryTree.init(node: TTNodePtr; comp: TComparator);
procedure TBinaryTree.init(); overload;
procedure TBinaryTree.init(comp: TComparator); overload; 
function TBinaryTree.setComparator(comp: TComparator): boolean; 

procedure TBinaryTree.insert(item: Pointer);
function TBinaryTree.remove(item: Pointer; freeData: boolean = false): boolean;
function TBinaryTree.removeAll(item: Pointer; freeData: boolean = false): integer;
function TBinaryTree.find(item: Pointer): Pointer;
function TBinaryTree.contains(item: Pointer): Boolean;
function TBinaryTree.occurrencesOf(item: Pointer): integer;
function TBinaryTree.clone(): TBinaryTree;
function TBinaryTree.min(): Pointer;
function TBinaryTree.max(): Pointer;
function TBinaryTree.height(): integer;
function TBinaryTree.nodes(): TTNodePtrArray;
function TBinaryTree.elements(): TPointerArray;
function TBinaryTree.equals(cmpTo: TBinaryTree): boolean;
function TBinaryTree.size(): integer;
function TBinaryTree.isValid(): boolean;
procedure TBinaryTree.clear(freeData: boolean = false);
procedure TBinaryTree.balance();  // not written yet
procedure TBinaryTree.debug(printData: procedure(p: pointer) = nil);

function TBinaryTree.cloneFrom(node: TTNodePtr): TTNodePtr;
function TBinaryTree.minFrom(node: TTNodePtr): Pointer;
function TBinaryTree.maxFrom(node: TTNodePtr): Pointer;
function TBinaryTree.heightFrom(node: TTNodePtr): integer;
function TBinaryTree.insertFrom(var node: TTNodePtr; 
function TBinaryTree.nodesFrom(node: TTNodePtr): TTNodePtrArray;
function TBinaryTree.elementsFrom(node: TTNodePtr): TPointerArray;
function TBinaryTree.equalsFrom(cmpFrom, cmpTo: TTNodePtr): boolean;
function TBinaryTree.occurrencesOfFrom(node: TTNodePtr; 
function TBinaryTree.removeFrom(node, parent: TTNodePtr; item: Pointer; freeData: boolean = false): boolean;
function TBinaryTree.sizeFrom(node: TTNodePtr): integer;
function TBinaryTree.isValidFrom(node: TTNodePtr): boolean;
procedure TBinaryTree.clearFrom(var node: TTNodePtr; freeData: boolean = false);
procedure TBinaryTree.debugFrom(node: TTNodePtr; printData: procedure(p: pointer) = nil);

Code:
[ATTACH]24046[/ATTACH]

{$DEFINE TESTMAIN}

{_____________________________________________________________________}
{=====================================================================}
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  blStructs.simba                                                    }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/09                                        }
{_____________________________________________________________________}
{=====================================================================}
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{$IFDEF TESTMAIN}
program blStructsTest;
{$ENDIF}
{$include_once srl-6/srl.simba}
{$IFNDEF TESTMAIN}
{$include_once bonsai/blUpdater.simba}
{$ENDIF}
{$f-}
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
const
   blStructsVersion = '1.0';
   blStructsVerUrl  = 'http://pastebin.com/raw.php?i=xxxxx';
   blStructsCodeUrl = 'http://pastebin.com/raw.php?i=xxxxx';

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
// var

{_____________________________________________________________________}

type
   TComparator = function(a, b: Pointer): integer;

{=====================================================================}
{                      Binary Tree                                    }
{                                                                     }
{  Ideas taken from numerous cslibrary.stanford.edu doc, roguewave,   }
{  http://webdocs.cs.ualberta.ca/,                                    }
{  http://www.algolist.net/Data_structures/Binary_search_tree         }
{=====================================================================}

type 
   TPointerArray = array of Pointer;
   
   TTreeNode = record
      data:  Pointer;
      left:  Pointer;
      right: Pointer;
//      left:  ^TTreeNode;
//      right: ^TTreeNode;
   end;

   TTNodePtr = ^TTreeNode;
   TTNodePtrArray = array of TTNodePtr;
   
   TBinaryTree = record
      head:      TTNodePtr;
      fcompare:  TComparator;
   end;

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  init()                                                             }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
procedure TBinaryTree.init(node: TTNodePtr; comp: TComparator);
begin
   if (head = nil) then
   begin
      self.head := node;
      self.fcompare := comp;
   end
   else
      writeln('TBinaryTree.init: Error - cannot initialize, list is not empty');
end;

procedure TBinaryTree.init(); overload;
begin
   self.init(nil, nil);
end;

procedure TBinaryTree.init(comp: TComparator); overload;
begin
   self.init(nil, comp);
end;

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  _newNode()                                                         }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree._newNode(item: Pointer): TTNodePtr;
var
   p: TTNodePtr;
   
begin
   new(p);
   p^.data := item;
   p^.left := p^.right := nil;
   result := p;
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  clear()                                                            }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
procedure TBinaryTree.clearFrom(var node: TTNodePtr; freeData: boolean = false);
begin
   if (node = nil) then exit;
   clearFrom(node^.left);
   clearFrom(node^.right);
   if (freeData) then
      dispose(node^.data);
   dispose(node);
   node := nil;
end;

procedure TBinaryTree.clear(freeData: boolean = false);
begin
   self.clearFrom(self.head, freeData);
end; 
 
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  clone()                                                            }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.cloneFrom(node: TTNodePtr): TTNodePtr;
begin
   if (node = nil) then
   begin
      result := nil;
      exit;
   end;
   new(result);
   result^.data := node^.data;
   result^.left := cloneFrom(node^.left);
   result^.right := cloneFrom(node^.right);
end; 

function TBinaryTree.clone(): TBinaryTree;
var
   p: ^TBinaryTree;
begin
   new(p);
   p^.fcompare := self.fcompare;
   p^.head := cloneFrom(self.head);
   result := p^;
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  find()                                                             }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.find(item: Pointer): Pointer;
var
   p: TTNodePtr;
   tst: integer;
begin
   result := nil;
   p := self.head;
   while (p <> nil) do
   begin
      tst := self.fcompare(p^.data, item);
      if (tst = 0) then
      begin
         result := p^.data;
         break;
      end
      else
      begin      
         if (tst > 0) then
            p := p^.left
         else
            p := p^.right;
      end;
   end;
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  contains()                                                         }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.contains(item: Pointer): Boolean;
begin
   result := (self.find(item) <> nil);
end;

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  min()                                                              }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.minFrom(node: TTNodePtr): Pointer;
var
   p: TTNodePtr;
begin
   p := node;
   
   while (p^.left <> nil) do
      p := p^.left;
      
   result := p^.data;
end; 

function TBinaryTree.min(): Pointer;
begin      
   result := self.minFrom(self.head);
end;

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  max()                                                              }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.maxFrom(node: TTNodePtr): Pointer;
var
   p: TTNodePtr;
begin
   p := node;
   
   while (p^.right <> nil) do
      p := p^.right;
      
   result := p^.data;
end; 

function TBinaryTree.max(): Pointer;
var
   p: TTNodePtr;
begin
   result := self.maxFrom(self.head);
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  height()                                                           }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.heightFrom(node: TTNodePtr): integer;

var
   l, r: integer;
   
begin
   if (node = nil) then
      exit(0);
      
   l := self.heightFrom(node^.left);
   r := self.heightFrom(node^.right);
   
   result := system.max(l, r) + 1 {for node};
end; 

function TBinaryTree.height(): integer;
begin
   result := self.heightFrom(self.head);
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  insert()                                                           }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.insertFrom(var node: TTNodePtr; 
   item: Pointer): TTNodePtr;
begin
   if (node = nil) then
   begin
      result := _newNode(item);
      exit
   end;
   
   if (self.fcompare(item, node^.data) <= 0) then
      node^.left := self.insertFrom(node^.left, item)
   else
      node^.right := self.insertFrom(node^.right, item);
   
   result := node;
end; 

procedure TBinaryTree.insert(item: Pointer);
begin
   self.head := self.insertFrom(self.head, item);
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  nodes()                                                            }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
procedure TTNodePtrArray.append(p: TTNodePtr);
begin
   setLength(self, length(self)+1);
   self[high(self)] := p;   
end;

function TBinaryTree.nodesFrom(node: TTNodePtr): TTNodePtrArray;
var
   l, r: TTNodePtrArray;
   i, j: integer;
begin
   if (node = nil) then exit;
   
   l := nodesFrom(node^.left);
   r := nodesFrom(node^.right);
   
   for i := 0 to high(l) do
      result.append(l[i]);
      
   result.append(node);
   
   for i := 0 to high(r) do
      result.append(r[i]);  
end; 

function TBinaryTree.nodes(): TTNodePtrArray;
begin
   result := self.nodesFrom(self.head);
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  elements()                                                         }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
procedure TPointerArray.append(p: Pointer);
begin
   setLength(self, length(self)+1);
   self[high(self)] := p;
end;

function TBinaryTree.elementsFrom(node: TTNodePtr): TPointerArray;
var
   l, r: TPointerArray;
   i, j: integer;
begin
   if (node = nil) then exit;

   l := elementsFrom(node^.left);
   r := elementsFrom(node^.right);

   for i := 0 to high(l) do
      result.append(l[i]);
      
   result.append(node^.data);
   
   for i := 0 to high(r) do
      result.append(r[i]);  
end;

function TBinaryTree.elements(): TPointerArray;
begin
   result := self.elementsFrom(self.head);
end;

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  equals()                                                           }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.equalsFrom(cmpFrom, cmpTo: TTNodePtr): boolean;
begin
   if (cmpFrom = nil) and (cmpTo = nil) then
   begin
      result := true;
      exit;
   end;
   if (cmpFrom <> nil) and (cmpTo <> nil) then
   begin
      result := (self.fcompare(cmpFrom^.data, cmpTo^.data) = 0) and
         self.equalsFrom(cmpFrom^.left, cmpTo^.left) and
         self.equalsFrom(cmpFrom^.left, cmpTo^.left);
      exit;
   end;
   result := false;
end;

function TBinaryTree.equals(cmpTo: TBinaryTree): boolean;
begin
   result := self.equalsFrom(self.head, cmpTo.head);
end; 


{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  occurrencesOf()                                                    }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.occurrencesOfFrom(node: TTNodePtr; 
   item: Pointer): integer;
   
begin
   if (node = nil) then exit(0);
   
   case self.fcompare(node^.data, item) of
      -1:   result := self.occurrencesOfFrom(node^.right, item);
       0:   result := 1 + self.occurrencesOfFrom(node^.left, item);
       1:   result := self.occurrencesOfFrom(node^.left, item);
   end;

end; 

function TBinaryTree.occurrencesOf(item: Pointer): integer;
begin
   result := self.occurrencesOfFrom(self.head, item);
end;

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  remove()                                                           }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.removeFrom(node, parent: TTNodePtr; item: Pointer; freeData: boolean = false): boolean;
begin
   if (node = nil) then
      exit;

   case self.fcompare(node^.data, item) of
      -1:
         begin
            if node^.right <> nil then
               result := self.removeFrom(node^.right, node, item)
            else
               result := false;
         end;
       1:
         begin
            if node^.left <> nil then
               result := self.removeFrom(node^.left, node, item)
            else
               result := false;
         end;
      0:
         begin
            if (node^.left <> nil) and (node^.right <> nil) then
            begin
               node^.data := self.minFrom(node^.right);
writeln('minfrom returned ', extended(node^.data^));
     
               self.removeFrom(node^.right, node, node^.data);
            end
            else 
            begin
               if (parent^.left = node) then
               begin
                  if (node^.left <> nil) then
                     parent^.left := node^.left
                  else
                     parent^.left := node^.right;
               end
               else if (parent^.right = node) then
               begin
                  if (node^.left <> nil) then
                     parent^.right := node^.left
                  else
                     parent^.right := node^.right;
               end;
               // we removed node from the structure, free it
               if (freeData) then
                  dispose(node^.data);
               dispose(node);
            end;
            result := true;
         end;
   end;   
end; 

function TBinaryTree.remove(item: Pointer; freeData: boolean = false): boolean;
var
   node: TTreeNode;
   
begin
   if (self.head = nil) then exit;
   
   if self.fcompare(self.head^.data, item) = 0 then
   begin
      node.left := self.head;
      result := self.removeFrom(self.head, @node, item, freeData);
      self.head := node.left;
   end
   else
      result := self.removeFrom(self.head, nil, item, freeData);
end;  

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  size()                                                             }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.sizeFrom(node: TTNodePtr): integer;
begin
   if (node = nil) then
      exit(0);

   result := self.sizeFrom(node^.left) + 
      self.sizeFrom(node^.right) + 1 {for node};
end;

function TBinaryTree.size(): integer;
begin
   result := self.sizeFrom(self.head);
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  removeAll()                                                        }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.removeAll(item: Pointer; freeData: boolean = false): integer;
begin
   while self.remove(item, freeData) do
   begin
      inc(result);
   end;
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  setComparator()                                                    }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.setComparator(comp: TComparator): boolean;
begin
   if (self.head = nil) then
   begin
      self.fcompare := comp;
      result := true;
   end;
end; 
 
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  balance()                                                          }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
procedure TBinaryTree.balance();
begin
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  isValid()                                                          }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
function TBinaryTree.isValidFrom(node: TTNodePtr): boolean;
begin
   if (node = nil) then 
   begin
      result := true;
      exit;
   end;
   
   if (node^.left <> nil) and
      (self.fcompare(self.minFrom(node^.left), node^.data) = 1) then
   begin
      result := false;
      exit;
   end;

   if (node^.right <> nil) and
      (self.fcompare(self.minFrom(node^.right), node^.data) <= 0) then
   begin
      result := false;
      exit;
   end;
   
   if (not self.isValidFrom(node^.left)) or 
      (not self.isValidFrom(node^.left)) then
   begin
      result := false;
      exit;
   end;
   
   result := true;
end; 

function TBinaryTree.isValid(): boolean;
begin
   result := self.isValidFrom(self.head);
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  debug()                                                            }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
procedure TBinaryTree.debugFrom(node: TTNodePtr; 
   printData: procedure(p: pointer) = nil);
begin
   if (node = nil) then exit;
   
   writeln('.. Node: ', node);
   if (printData <> nil) then
      printData(node^.data);
   
   self.debugFrom(node^.left, printData);
   self.debugFrom(node^.right, printData);
end; 

procedure TBinaryTree.debug(printData: procedure(p: pointer) = nil);
begin
   writeln('--------------------------------------------');
   writeln('Tree head=', head, ' fcompare=', fcompare);
   self.debugFrom(self.head, printData);
end; 

{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  __blStructsTerminate()                                             }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
procedure __blStructsTerminate();
begin
end;


{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  main() for test mode                                               }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{$IFDEF TESTMAIN}
function cmpE(a, b: ^extended): integer;
begin
   if (a^ = b^) then
      exit(0)
   else if (a^ < b^) then
      exit(-1)
   else
      exit(1);
end;

procedure printE(e: ^extended);
begin
   writeln('[', e, '] = ', e^);
end;

var
   tree1, tree2: TBinaryTree;
   p: ^extended;
   e: extended;
   i: integer;
   t: TTimeMarker;
   arr: array[0..14999] of extended;
   elem: array of ^extended;
   
begin
   t.reset();
   t.start();    
   setLength(elem, 0);
   for i := 0 to 14999 do
   begin
      setLength(elem, length(elem)+1);
      elem[high(elem)] := @arr[i];
   end;
   writeln('For comparison, adding 15000 UNSORTED entries to an array took ', t.getTime());
   
   for i := 0 to 14999 do
   begin
      arr[i] := random(5000) + (random(9)+1)/10;
   end;
   tree1.init(cmpE);
   t.reset();
   t.start();
   for i := 0 to 14999 do
   begin
      p := @arr[random(5000)];
      tree1.insert(p);
   end;
   writeln('Inserted 15000 entries, time=', t.getTime(), 
      ' size=', tree1.size(), ' height=', tree1.height());

   if tree1.contains(p) then
      writeln('Successfully found last item inserted ', p^)
   else
      writeln('ERROR: tree did not contain value we inserted');

   writeln('Maximum value in tree: ', extended(tree1.max()^));
   writeln('Minimum value in tree: ', extended(tree1.min()^));
   
   t.reset();
   t.start();   
   for i := 0 to 2999 do
      tree1.remove(tree1.max());
      
   writeln('Removed 3000 biggest entries, time=', t.getTime(), ' size=', tree1.size());
   writeln('Count of node list: ', length(tree1.nodes()));
   
   writeln('Maximum value in tree: ', extended(tree1.max()^));
   writeln('Minimum value in tree: ', extended(tree1.min()^));

   elem := tree1.elements();
   for i := 0 to 10 do
      writeln('element ', i, ' is ', elem[i]^);
   
   writeln('Checking if tree is valid: ', tree1.isValid());
      
   p := tree1.find(elem[6]);
   writeln('Performed a find on ', elem[6]^, ' got back ', p^);
   writeln(elem[6]^, ' is in the list ', tree1.occurrencesOf(elem[6]), ' times.');

   
   tree1.removeAll(elem[6]);
   writeln('Deleted all ', elem[6]^);
   writeln(elem[6]^, ' is in the list ', tree1.occurrencesOf(elem[6]), ' times.');

   t.reset();
   t.start();   
   tree2 := tree1.clone();
   writeln('Cloned tree, time=', t.gettime(), ' equality test reports: ', tree1.equals(tree2));

   t.reset();
   t.start(); 
   tree1.clear();
   tree2.clear();
   writeln('Emptied both trees.  time=', t.getTime(), ' len1=', tree1.size(), ' len2=', tree2.size());
   writeln(tree1, tree2);
end.

{$ELSE}
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
{  initializer                                                        }
{  Written by: bonsai                                                 }
{  Date Last Modified: 2014/08                                        }
{¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯}
begin
   updater.check4update('blStructs.simba', blStructsVersion,
      blStructsVerUrl, blStructsCodeUrl, true);

   addOnTerminate('__blStructsTerminate');
end;
{$ENDIF}

Wow, I can't believe I haven't looked at this until now. :o
Nice work here! Lots of useful functions! I'll be sure to play with it for some hours later on ;)

Gotta love lape, eh? About the bug you mentioned, I did not get any errors from removing that line completely.
What exactly goes wrong on your side?

E: Why is this commented out?

//      left:  ^TTreeNode;
//      right: ^TTreeNode;

From: Zyt3x
Wow, I can't believe I haven't looked at this until now. :o
Nice work here! Lots of useful functions! I'll be sure to play with it for some hours later on ;)

Gotta love lape, eh? About the bug you mentioned, I did not get any errors from removing that line completely.
What exactly goes wrong on your side?

E: Why is this commented out?

//      left:  ^TTreeNode;
//      right: ^TTreeNode;

Thanks.

IIRC the bug I was hitting was that node^.data was not getting set properly. When I started printing node^.data^, it worked. Maybe I fixed something else that took care of it.

The comments are because lape wouldn't let me refer to the record I was defining like you might in C. So I just made left & right regular Pointer.

what exactly does this do?

From: Robert
what exactly does this do?

Google Binary Trees?

From: NKN
Google Binary Trees?

Ok. So what is it good for?

From: bonsai
Thanks.

IIRC the bug I was hitting was that node^.data was not getting set properly. When I started printing node^.data^, it worked. Maybe I fixed something else that took care of it.

The comments are because lape wouldn't let me refer to the record I was defining like you might in C. So I just made left & right regular Pointer.

Forward declare them..

Type
  PNode = ^TNode; //Forward declaration of the TNode Structure..

  TNode = Record
    Next: PNode; //now we can have pointers to TNode because you can't do  ^TNode here.
    Prev: PNode;
    Data: Pointer;
  End;

  TLinkedList = Record
    Head: PNode; //PNode or ^TNode.. both will work here.
  End;

Would be just like in C:

struct Node
{
    Node* left;
    Node* right;
    void* data;
};

typedef struct Node Node;

typedef struct
{
    Node* head;
} LinkedList;

But you already wrote the code so I guess there's no sense changing it now.. but if you do decide to change it, the above should help. I hope.

From: Robert
Ok. So what is it good for?

It can be used for ordering objects. Btw this is not 'just'a binary tree, it is a binary search tree: http://en.wikipedia.org/wiki/Binary_search_tree

Imagine you have TMonster objects, with all kind of properties, including an ID. Adding them to a binary tree will give you very fast search results if you use the id for the comperator.

From: Robert
Ok. So what is it good for?

Touche

Like an array, it's good for storing collections of things. But it stores the 'index' and the data separately. The index part is a collection of pointers that keep track of everything.

Keeping the metadata and the items separate like that allows it to do some things a lot faster than the array can.

If you had a big array with 10,000 things in it and you needed to put a new one in slot 5, you're going to move a whole bunch of data down the array to make room. In a tree, it just changes a couple of pointers and the insert is done.

But you do pay. They're more of a pain to use.

Here's part of a chart I found here. It compares the general performance of tasks.

O(1) means the price is constant.
O(n) means the cost is directly related to the number of items.
O(log n) means it's related to the log(n). In this case the cost usually rises quick but as n gets bigger it stays more constant. Which is a good thing.

So in the average case the btree is better, worst case they are about the same. Indexing doesn't really count since an array only has 0,1,2.

Data Structure	Time Complexity	Space Complexity
                                  Average	                           Worst
                    Index     Search	Insert	   Delete	Ind   Srch  Ins	  Del	
Basic Array	    O(1)      O(n)	-	   -	        O(1)  O(n)  -	  -
Dynamic Array	    O(1)      O(n)	O(n)	   O(n)	        O(1)  O(n)  O(n)  O(n)
Binary Search Tree  O(log(n)) O(log(n))	O(log(n))  O(log(n))	O(n)  O(n)  O(n)  O(n)

Cool :-)
Regarding line 442, I have not looked in yo your code: but I think I recall having some similar issue (I think) with a quadtree I wrote some time ago. Tho, I never looked in to it, just started working on something else instead.. You could try writing a iterative version of the function, and see if it has the same issue.

Oh, and by the way.

if (cmpFrom = nil) and (cmpTo = nil) then
begin
   result := true;
   exit;
end;

Can be written on one line, like so:

if (cmpFrom = nil) and (cmpTo = nil) then exit(True);

E: Which means:

function TBinaryTree.equalsFrom(cmpFrom, cmpTo: TTNodePtr): boolean;
begin
   if (cmpFrom = nil) and (cmpTo = nil) then
   begin
      result := true;
      exit;
   end;
   if (cmpFrom <> nil) and (cmpTo <> nil) then
   begin
      result := (self.fcompare(cmpFrom^.data, cmpTo^.data) = 0) and
         self.equalsFrom(cmpFrom^.left, cmpTo^.left) and
         self.equalsFrom(cmpFrom^.left, cmpTo^.left);
      exit;
   end;
   result := false;
end;

becomes

function TBinaryTree.equalsFrom(cmpFrom, cmpTo: TTNodePtr): boolean;
begin
   if (cmpFrom = nil) and (cmpTo = nil) then exit(true);
   if (cmpFrom <> nil) and (cmpTo <> nil) then
      exit(self.fcompare(cmpFrom^.data, cmpTo^.data) = 0) and
         self.equalsFrom(cmpFrom^.left, cmpTo^.left) and
         self.equalsFrom(cmpFrom^.left, cmpTo^.left));
   result := false;
end;

From: Zyt3x
Oh, and by the way.

good stuff

I do end up with some extra begin/ends from stubbing out the structure or putting writelns in and out.

I always hated pascal if syntax. c was so glorious with those curly brace blocks. Poetry.

Pascal was always my first love, though. It was the first decent language I got my hands on. I had to deal with some horrible stuff like dibol and fortran.

A year or so back when I started srl'ing I had some problems with exit (don't recall specifics) and I typically avoid it. Probably a good habit for me to break.

You'll also notice I over use parenthesis. I had too many random issues and just started being as explicit as possible.

I have nothing but admiration for the lape guys. Orders of magnitude above what I could do. But it is tough programming in a language you don't even really have a spec for.

Then I look inside the source code and see all the stuff Olly's been sneaking in there that we don't even know about yet. Endless supply of things to figure out :)

very nice, looks good