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