Binary Search Trees

As usual, Wikipedia is useful for providing the background to this topic. Programs using pointers can be difficult to understand, so we advise you to study the Linked List section of our tutorial Lists, Stacks and Queues before attempting to master the code for binary search trees.

Program DrawBST shows letters being sorted as they enter the tree. Going down the tree a level at a time, each displacement in the x direction of a node from its parent is halved. This means that the order of the sorted letters is the same as the order of their x co-ordinates.

A 6-letter version of program DrawBST outputted the following diagram.

Output from program DrawBST

Output from program DrawBST

program DrawBST;
  {$mode objfpc}{$H+}
uses
  SysUtils, CRT;
type
  NodePtr = ^TNode;
  TNode = record
    Letter: char;
    Left, Right: NodePtr;
  end;
const
  DELTA_Y = 4;
  LETTERS = 'MKLEAQTIBXPHVOJZS';
  SLEEP_TIME = 1000;
var
  RootPtr, NextNode: NodePtr;
  x, y, i, DeltaX: integer;
  MovingLeft : Boolean = True;

procedure AddToTree(var Root: NodePtr; NewNode: NodePtr);
begin
  if Root = nil then
    begin
      //Enter leaf node in tree
      Root := NewNode;
      Root^.Left := nil;
      Root^.Right := nil;
      //Output the node value in its calculated position
      goToXY(x, y);
      write(NewNode^.Letter);
      //Calculate position of linking dot
      y := y - DELTA_Y DIV 2;
      if MovingLeft then
        x := x + DeltaX DIV 2
      else
        x := x - DeltaX DIV 2;
      goToXY(x, y);
      //Output linking dot if not the root
      if i > 1 then
        write('.');
      end
  else
    if NewNode^.Letter < Root^.Letter then
      begin
        //Calculate co-ordinates of next node to left
        y := y + DELTA_Y;
        DeltaX := DeltaX DIV 2;
        x := x - DeltaX;
        MovingLeft := True;
        //Recursive call
        AddToTree(Root^.Left, NewNode);
      end
    else
      begin
        //Calculate co-ordinates of next node to right
        y := y + DELTA_Y;
        DeltaX := DeltaX DIV 2;
        x := x + DeltaX;
        MovingLeft := False;
        //Recursive call
        AddToTree(Root^.Right, NewNode);
      end;
end;

procedure InOrderTraversal(Root: NodePtr);
begin
  if root <> nil then
    begin
      InOrderTraversal(Root^.Left);
      write(Root^.Letter);
      InOrderTraversal(Root^.Right);
    end;
end;

begin
  write('Unsorted Letters: ', LETTERS);
  RootPtr := nil;
  cursorOff;
  for i := 1 to length(LETTERS) do
    begin
      new(NextNode);
      NextNode^.Letter:= LETTERS[i];
      DeltaX := 32;
      x := 40;
      y := 3;
      AddToTree(RootPtr, NextNode);
      sleep(SLEEP_TIME);
    end;
  //Output sorted letters
  gotoXY(1, 22);
  write('Sorted letters: ');
  InOrderTraversal(RootPtr);
  cursorOn;
  readln;
end.

In both of our programs demonstrating binary search trees, we define a type NodePtr = ^TNode. This means that a variable of type NodePtr, such as RootPtr is a pointer to a record of type TNode. (The pointer is a variable that contains the address of the record). The record contains data and pointers to its left and right child nodes. These pointers are set to nil if there is not a node to point to. The instruction new(NextNode) creates a new pointer named NextNode of type NodePtr and also the new record of type TNode that it points to. Records created in this way use an area of memory called the heap. The programmer should free up this memory when the record is no longer required with a statement such as dispose(NextNode). In our programs we omit the process of deleting a node from a tree, which requires different code depending on the type of node to be deleted.

In order to access the data pointed to by a pointer, you must dereference the pointer by appending a caret to its name as in the instruction

NextNode^.Letter:= LETTERS[i];. 

It is a useful exercise to perform a dry run for the operation of procedure InOrderTraversal on a small binary search tree constructed from the letters MKLEFQ.

procedure InOrderTraversal(Root: NodePtr);
begin
  if Root <> nil then
    begin
      InOrderTraversal(Root^.Left);
      writeln(Root^.Str);
      InOrderTraversal(Root^.Right);
    end;
end;         

The writeln statement cannot be executed until all the Left pointers have been followed recursively, so the first output must be the first in alphabetical order (E). (An action such as writeln at a node is termed visiting the node). After this first visit, the recursive call InOrderTraversal(Root^.Right) is executed for the same node. Since the leftmost node has a right leaf child (a child without a child of its own), then this will contain the next letter in alphabetical order (F).

Try to continue this dry run for more letters. You can check your trace against the following. We produced it by adding write statements to procedure InOrderTraversal to output a commentary to a text file.

Left from M, Left from K, Left from E,
Root = nil, Output "E", Right from E, Left from F,
Root = nil, Output "F", Right from F,
Root = nil, F completed, E completed, Output "K", Right from K, Left from L,
Root = nil, Output "L", Right from L,
Root = nil, L completed, K completed, Output "M", Right from M, Left from Q,
Root = nil, Output "Q", Right from Q,
Root = nil, Q completed, M completed

Before running procedure BuildTree of program BinarySearchTree, you need a text file named 'UnsortedWords.txt' in the program folder. We suggest that you write the name of a different colour on each line of the text file.

program BinarySearchTree;
  {$APPTYPE CONSOLE}
uses
  SysUtils, StrUtils;
type
  NodePtr = ^TNode;
  TNode = record
    Str: string;
    Left, Right: NodePtr;
  end;
var
  RootPtr, NextNode: NodePtr;
  iChoice, ErrorCode: integer;
  strChoice, CurrentStr, SearchItem: string;
  Found: Boolean;

procedure InitTree(var Root: NodePtr);
begin
  Root := nil;
  writeln('The tree has been initialised.');
end;

procedure AddToTree(var Root: NodePtr; NewNode: NodePtr);
begin
  if Root = nil then
    begin
      Root := NewNode;
      Root^.Left := nil;
      Root^.Right := nil;
    end
  else
    if NewNode^.Str < Root^.Str then
      AddToTree(Root^.Left, NewNode)
    else
      AddToTree(Root^.Right, NewNode);
end;

procedure BuildTree;
var
  TFile: TextFile;
begin
  assignFile(TFile, 'UnsortedWords.txt');
  reset(TFile);
  while not eof(TFile) do
    begin
      new(NextNode);
      readln(TFile, NextNode^.Str);
      NextNode^.Str := LowerCase(NextNode^.Str);
      AddToTree(RootPtr, NextNode);
    end;
  closeFile(TFile);
end;

procedure PreOrderTraversal(Root: NodePtr);
begin
  if Root <> nil then
    begin
      writeln(Root^.Str);
      PreOrderTraversal(Root^.Left);
      PreOrderTraversal(Root^.Right);
    end;
end;

procedure InOrderTraversal(Root: NodePtr);
begin
  if Root <> nil then
    begin
      InOrderTraversal(Root^.Left);
      writeln(Root^.Str);
      InOrderTraversal(Root^.Right);
    end;
end;

procedure PostOrderTraversal(Root: NodePtr);
begin
  if Root <> nil then
    begin
      PostOrderTraversal(Root^.Left);
      PostOrderTraversal(Root^.Right);
      writeln(Root^.Str);
    end;
end;

procedure SearchTree(Root: NodePtr; Target: string);
begin
  if Root <> nil then
    begin
      if Root^.Str = Target then
        begin
          writeln('Found');
          Found := True;
        end
      else
        if Target < Root^.Str then
          SearchTree(Root^.Left, Target)
        else
          SearchTree(Root^.Right, Target);
    end;
end;

function CountNodes(Root: NodePtr): integer;
begin
  if Root = nil then
    result := 0
  else
    result := 1 + CountNodes(Root^.Left) + CountNodes(Root^.Right);
end;

procedure Menu(var Choice: integer);
begin
  repeat
    writeln;
    writeln('1 - Build tree from words in text file');
    writeln('2 - Add word to tree');
    writeln('3 - Pre-order output of tree');
    writeln('4 - In-order output of tree');
    writeln('5 - Post-order output of tree');
    writeln('6 - Search for a word in the tree');
    writeln('7 - Count nodes in tree');
    writeln('8 - Quit');
    writeln;
    write('Please enter your choice (1 - 8): ');
    readln(strChoice);
    writeln;
    val(strChoice, iChoice, ErrorCode);
  until (ErrorCode = 0) and (iChoice in [1..8]);
end;

begin 
  InitTree(RootPtr);
  repeat
    Menu(iChoice);
    case iChoice of
      1 : BuildTree;
      2 : begin
            repeat
              write('Enter next word or # for menu. ');
              readln(CurrentStr);
              if CurrentStr <> '#' then
                begin
                  new(NextNode);
                  NextNode^.Str:= LowerCase(CurrentStr);
                  AddToTree(RootPtr, NextNode);
                end;
            until CurrentStr = '#';
          end;
      3 : PreOrderTraversal(RootPtr);
      4 : InOrderTraversal(RootPtr);
      5 : PostOrderTraversal(RootPtr);
      6 : begin
            write('Word to search for? ');
            readln(SearchItem);
            Found := False;
            SearchTree(RootPtr, LowerCase(SearchItem));
            if not Found then
              writeln('Not found');
            end;
      7 : writeln('Number of nodes: ', CountNodes(RootPtr));
    end;
  until iChoice = 8;
end. 

Try to follow our dry run including the recursive procedure AddToTree and then see if you can understand how the other procedures work. We will (in our minds) start a new program then select the second menu option twice to add records with Str fields 'green' and 'red' to an empty tree.

At the start of a new program, procedure InitTree sets RootPtr to nil.

We choose option 2 from the menu and our entry 'green' is assigned to CurrentStr.

The following two lines of code are executed.

new(NextNode);
NextNode^.Str:= LowerCase(CurrentStr);

We tabulate values of the variables:

RootPtr Fields of green record NextNode^
nil

Str = 'green'
Left and Right  unassigned

green record

Much of the dry run is of the recursive procedure AddToTree, which we reproduce below.

procedure AddToTree(var Root: NodePtr; NewNode: NodePtr);
begin
  if Root = nil then
    begin
      Root := NewNode;
      Root^.Left := nil;
      Root^.Right := nil;
    end
  else
    if NewNode^.Str < Root^.Str then
      AddToTree(Root^.Left, NewNode)
    else
      AddToTree(Root^.Right, NewNode);
end;

The next instruction in our dry run is AddToTree(RootPtr, NextNode);.

Root = nil, so Root := NewNode and RootPtr points to the green record, the Left and Right fields of which are set to nil.

We select option 2 again to create a new NextNode and enter 'red' to assign to the Str field of the record to which it points. The values of the variables are now:

RootPtr^ Fields of green record Fields of red record NextNode^
green record

Str = 'green'
Left = nil
Right = nil

Str = 'red'
Left and Right  unassigned

red record

Now Root is not nil and so the second if statement is executed. The expression 'red' < 'green' is false, causing the call
AddToTree(Root^.Right, NewNode);.
Root^.Right is green's right pointer and NewNode is a pointer to the red record.

This time Root = nil, so Root := NewNode. This makes green's right pointer now point to the red record. Finally, red's left and right pointers are set to nil. A new 'red' leaf node has been created as the right child of 'green'. We conclude by tabulating the final values of the variables.

RootPtr^ Fields of green record Fields of red record NextNode^
green record

Str = 'green'
Left = nil
Right = pointer to red

Str = 'red'
Left = nil
Right = nil

red record

Experimenting with Binary Search Trees

  1. Write a procedure for program BinarySearchTree to output the strings in reverse alphabetical order.
  2. Write a binary search tree program to sort and search for integers supplied by the user.
  3. Write a procedure to search for then delete a leaf node from a binary search tree.
  4. We challenge you to write code to delete the other types of node.
Programming - a skill for life!

First textbook examples of recursion, binary search trees and fractals