Binary Trees and Binary Array Search
#!/usr/bin/perl -w

##############  A Realistic Binary Tree:  A Tree of "Records" #################

while (print ("Enter record: "), ($record = <STDIN>) !~ /^\s*quit\s*$/i)
{
      @person{NAME,SSNum,SALARY} = split /:/, $record;
      print "Duplicate entry attempted!  Rejected!\n" if (!insert($tree,
                                                           \%person));
}

in_order($tree);    #  Dump tree contents.

#  This is an adaptation of Tom Christiansen's binary tree insert code
#  on pp. 392-393 in the Perl Cookbook.  The nodes, however, contain
#  more than just a simple numeric value.
while (print ("Enter SS Number: "), ($SSNum = <STDIN>) !~ /^\s*quit\s*$/i)
{
       chomp $SSNum;
       $found = search($tree, $SSNum);
       if (!$found)
       {
            print "Could not find record for Social Security ID: $SSNum\n";
       }
       else
       {
            print "Name: $found->{NAME}\n";
            print "Social Security: $found->{SSNum}\n";
            printf "%s %-.2f\n\n", "Salary: ", $found->{SALARY};
       }
}



while (print ("Enter SS Number: "), ($SSNum = <STDIN>) !~ /^\s*quit\s*$/i)
{
       chomp $SSNum;
       $found = del($tree, $SSNum);  # Don't use "delete" -- name already used!
       if (!$found)
       {
            print "Could not find record for Social Security ID: $SSNum\n";
       }
       else
       {
            print "Record deleted!\n";
       }
}

in_order($tree);    #  Dump tree contents after deletions.



#  This is an adaptation of Tom Christiansen's binary tree insert code
#  on pp. 392-393 in the Perl Cookbook.  The nodes, however, contain
#  more than just a simple numeric value.
sub insert
{
     my ($tree, $PersonRef) = @_;   #  @_ is changeable -- an important fact!

     if (!$tree)   # We've descended to a NULL reference (undef in Perl).
     {
          $tree = {};   #  Tree is a reference to an anonymous hash.
          $tree->{SSNum}  = $PersonRef->{SSNum};
          $tree->{NAME}   = $PersonRef->{NAME};
          $tree->{SALARY} = $PersonRef->{SALARY};
          $tree->{LEFT}   = undef;
          $tree->{RIGHT}  = undef;
          $_[0] = $tree;   #  Change tree ref. in recursive callers!
          return 1;
     }

     if ($PersonRef->{SSNum} gt $tree->{SSNum}) {insert($tree->{RIGHT}, 
                                                $PersonRef)}
     elsif ($PersonRef->{SSNum} lt $tree->{SSNum}) {insert ($tree->{LEFT},
                                                   $PersonRef)}
     else {return 0}
} 






sub in_order
{
    my ($tree) = @_;

    return if !$tree;   #  I hate "unless", unlike Tom C.
    in_order($tree->{LEFT});
    if ($tree->{SSNum} !~ /\*$/)   #  A "lazily" deleted node.
    {
         print "Social Security Number: $tree->{SSNum}\n";
         print "Name:  $tree->{NAME}\n";
         printf "%s \$%-.2f\n\n", "Salary: ", $tree->{SALARY}; 
    }
    in_order($tree->{RIGHT});
}



sub search
{
     my ($tree, $SSNum) = @_;

     return 0 if !$tree;
     return $tree if $tree->{SSNum} eq $SSNum;
     search($tree->{($SSNum gt $tree->{SSNum}) ? "RIGHT" : "LEFT"}, $SSNum)
}




sub del
{
     my ($tree, $SSNum) = @_;

     return 0 if !$tree;
     if ($tree->{SSNum} eq $SSNum)
     {
            $tree->{SSNum} .= "*";   #  "Lazy" deletion.
            return 1;
     }
     del($tree->{($SSNum gt $tree->{SSNum}) ? "RIGHT" : "LEFT"}, $SSNum)
}
###########################  Session with Program  #############################

$ tree.pl 2> /dev/null   #  Remove warnings from use of comma in while.

Enter record: Smith,Tom:555-55-5555:44444.44
Enter record: Dover,Ben:333-33-3333:2222222.22
Enter record: Discussion,Frank:777-77-7777:55555.55
Enter record: Bunny,Bugs:545-55-5555:1000000.00
Enter record: Doinck,Joe:767-77-7777:60000.00
Enter record: Wilson,Flip:111-11-1111:100000000.00
Enter record: Clinton,Bill:888-88-8888:165000.00
Enter record: Keating,Charles:313-23-9999:200000000.00
Enter record: quit

Social Security Number: 111-11-1111    #  Begin first tree dump.  In SS order.
Name:  Wilson,Flip
Salary:  $100000000.00

Social Security Number: 313-23-9999
Name:  Keating,Charles
Salary:  $200000000.00

Social Security Number: 333-33-3333
Name:  Dover,Ben
Salary:  $2222222.22

Social Security Number: 545-55-5555
Name:  Bunny,Bugs
Salary:  $1000000.00

Social Security Number: 555-55-5555
Name:  Smith,Tom
Salary:  $44444.44

Social Security Number: 767-77-7777
Name:  Doinck,Joe
Salary:  $60000.00

Social Security Number: 777-77-7777
Name:  Discussion,Frank
Salary:  $55555.55

Social Security Number: 888-88-8888
Name:  Clinton,Bill
Salary:  $165000.00




Enter SS Number: 333-33-3333   #  Start searches.
Name: Dover,Ben
Social Security: 333-33-3333
Salary:  2222222.22

Enter SS Number: 980-00-0987
Could not find record for Social Security ID: 980-00-0987

Enter SS Number: 555-55-5555
Name: Smith,Tom
Social Security: 555-55-5555
Salary:  44444.44

Enter SS Number: quit

Enter SS Number: 333-33-3333   #  Start deletions.
Record deleted!

Enter SS Number: 987-09-9876
Could not find record for Social Security ID: 987-09-9876

Enter SS Number: 555-55-5555
Record deleted!

Enter SS Number: quit

Social Security Number: 111-11-1111    #  Dump of tree after deletions.
Name:  Wilson,Flip
Salary:  $100000000.00

Social Security Number: 313-23-9999
Name:  Keating,Charles
Salary:  $200000000.00
##########  When To Use a Binary Tree Versus a Binary Array Search  #########

A binary tree and a binary search on a sorted array give comparable search
times.  However, if your data volume shrinks or grows, a binary tree is
superior because it is a sorted data structure.  Insertions into a sorted
array either mean resorting after each insertion or doing a search for
the proper location to splice in the new element.  

So the rule of thumb is simple, the algorithm for a binary search of a
sorted array is simpler if you have a fixed-sized data collection.  If
your data volume grows, the inconvenience of insertion and/or resorting
call for a tree algorithm.  The binary array search and deletion algorithms
follow on the next three pages. 
#!/usr/bin/perl -w

###################  Binary Array Searching and Deleting  ####################


@people = (
 { "ID" => "123456", "NAME" => "James Thomas", "AGE" => 46, "SALARY" => 54344},
 { "ID" => "789098", "NAME" => "Mister Ed", "AGE" => 24, "SALARY" => 40000},
 { "ID" => "345678", "NAME" => "Buck Naked", "AGE" => 40, "SALARY" => 99000},
 { "ID" => "176543", "NAME" => "Frank Discussion", "AGE" => 9, "SALARY" => 100},
 { "ID" => "745676", "NAME" => "Ben Dover", "AGE" => 28, "SALARY" => 200000},
 { "ID" => "888888", "NAME" => "Carl Dover", "AGE" => 23, "SALARY" => 125000},
 { "ID" => "111111", "NAME" => "Bugs Bunny", "AGE" => 30, "SALARY" => 1000000},
 { "ID" => "011111", "NAME" => "Elmer Fudd", "AGE" => 50, "SALARY" => 100});

@people = sort {$a->{ID} cmp $b->{ID}} @people;


while (print ("Enter ID: "), ($ID = <STDIN>) !~ /^\s*quit\s*$/i)
{
       chomp $ID;
       $index = search(\@people, $ID);
       if ($index < @people && $people[$index]->{ID} eq $ID)
       {
            print "ID:     $people[$index]->{ID}\n";
            print "NAME:   $people[$index]->{NAME}\n";
            print "AGE:    $people[$index]->{AGE}\n";
            print "SALARY: $people[$index]->{SALARY}\n\n";
       }
       else
       {
            print "Person with ID: $ID: Not found!\n";
       }
}


while (print ("Enter ID: "), ($ID = <STDIN>) !~ /^\s*quit\s*$/i)
{
       chomp $ID;
       $index = search(\@people, $ID);
       if ($index < @people && $people[$index]->{ID} eq $ID)
       {
             splice(@people, $index, 1);
       }
       else
       {
             print "Person with ID: $ID: Not found!\n";
       }
}


foreach $person (@people)   #  Array dump after deletions.
{
      print "ID:     $person->{ID}\n";
      print "NAME:   $person->{NAME}\n";
      print "AGE:    $person->{AGE}\n";
      print "SALARY: $person->{SALARY}\n\n";
}
#  Divide-and-Conquer binary array search.  
#  Note:  Orwant's algorithm on p. 163 of the Algorithms book is *wrong*!!
sub search
{
     my ($list, $ID) = @_;
     my ($low, $high) = (0, scalar(@$list)); 

     use integer;
     while ($low < $high)
     {
          my $cur = ($low + $high)/2;

          if ($list->[$cur]{ID} lt $ID) {$low = $cur + 1}
          elsif ($list->[$cur]{ID} gt $ID) {$high = $cur}
          else {return $cur}   #  This is what Orwant is missing.
     }
     return $low; 
}


###############################  Output Below  #############################

$ binsrch.pl
print (...) interpreted as function at ./binsrch.pl line 19.
print (...) interpreted as function at ./binsrch.pl line 37.

Enter ID: 111111
ID:     111111
NAME:   Bugs Bunny
AGE:    30
SALARY: 1000000

Enter ID: 123456
ID:     123456
NAME:   James Thomas
AGE:    46
SALARY: 54344

Enter ID: 880000
Person with ID: 880000: Not found!

Enter ID: 888888
ID:     888888
NAME:   Carl Dover
AGE:    23
SALARY: 125000

Enter ID: quit      #  End searches.
Enter ID: 123456    #  Start deletions.
Enter ID: 888888
Enter ID: 098567
Person with ID: 098567: Not found!
Enter ID: quit
ID:     011111     #  Dump of remaining records.
NAME:   Elmer Fudd
AGE:    50
SALARY: 100

ID:     111111
NAME:   Bugs Bunny
AGE:    30
SALARY: 1000000

ID:     176543
NAME:   Frank Discussion
AGE:    9
SALARY: 100

ID:     345678
NAME:   Buck Naked
AGE:    40
SALARY: 99000

ID:     745676
NAME:   Ben Dover
AGE:    28
SALARY: 200000

ID:     789098
NAME:   Mister Ed
AGE:    24
SALARY: 40000