Getting FunKy
Two weeks ago we created several microscopic worlds and programs that respond to a few user queries. We could continue to expand the repertoire of computer responses, but such an expansion would have a serious side effect–a program that becomes difficult to understand and debug. Our programs so far have essentially one module; a change in one part of the module might affect the operation of a distant part of the module, perhaps disastrously! One way to reduce the chance of such an outcome would be to break the program into smaller, independent modules. We can then test each piece separately to make sure it functions correctly and then assemble the pieces into a single program. Programmers refer to such modules as subroutines, and in this chapter we will begin to use subroutines to add more features to our programs.
Subroutines
Subroutines in Perl are sometimes referred to as functions and this alternative label provides a hint of their usefulness in tracking objects with complex features. Subroutines in Perl are defined in a program block with the label sub and the name of the subroutine, for example
sub print_name {
print “What is your name?\n”;
$name = <>; #get keyboard input
print “Thanks $name!\n”;
} #end sub print_name
We can call (i.e., run) this subroutine from the main program with the statement
&print_name;
Since subroutines lie outside the main program loop, we can put them anywhere in the program. Most programmers find it convenient to collect all of the subroutines in one place, either at the beginning or end of the program. I will put the subroutines at the end of all my example programs. An example of a program with two subroutines appears in Figure 6.1.
Figure 6.1. A program with two subroutines
#!/usr/local/bin/perl
# sub.pl
# This program demonstrates the definition and calls to two subroutines
print “What is your name?\n”;
&print_name;
print “Where were you born?\n”;
&print_state;
print “Thanks!\n”;
exit;
####### Subroutines #############
sub print_name {
$name = <>;
print “Thanks $name!\n”;
} #end sub print_name
sub print_state {
$state = <>;
print “What is it like in $state?\n”;
} #end sub print_state
At first glance, this example seems to take us a step backwards. The program is twice as long as it needs to be to get the job done. First it prints a question in the main section, and then it jumps to a subroutine to process the user’s response. The program then jumps back to the main section where it repeats this cycle one more time. This is simple? Well, looks can be deceiving. If we focus on the main section of the program it is simpler. The main section has just one line that prints a question and one line that calls a subroutine. The subroutine has simplified the structure of the main section by shifting the dirty work to a subsection of the program. This division of labor makes it much easier to follow the program flow in the main section. It will also be much easier to update and debug a program in this form.
As another example of the subroutine architecture, I modified the Clue program in Figure 4.7 so that it calls a subroutine to handle the user’s questions. The modified program appears in Figure 6.2.
Figure 6.2. A Clue program with subroutines
#!/usr/local/bin/perl
# clue2.pl
# This program uses a subroutine to respond to questions
# It ends when the user types "thanks"
# It uses the hashes @weapon and @room to keep track of the objects
%weapon = (); %room = ();
# Block 1. Read in data file
open ITEMS, "< clue.txt" ;
while (chop( $input = <ITEMS> )) {
($name, $weap, $rm) = split /\t/, $input;
$weapon{$name} = $weap; $room{$name} = $rm;
print "$name, $weapon{$name}, $room{$name}.\n";
} ; #end while
# Block 2. Request a prompt from the user
print "Hello Dave. What can I do for you? \n";
chop( $question = <> ); #Get the question from the standard input
$question = lc $question;
# Main program loop
until ( $question eq 'thanks' ) {
if ( question ($question) ) { #Answers the questions
print "$response";
}
else {
print "I don\'t understand that question. Ask a different question.\n";
}
chop( $question = <> ); #Get another question from the standard input
$question = lc $question;
} #End main loop
####################Subroutines##################
sub question {
#Test 1. See if question is 'Where is someone?'
if ( $question =~ m/where is (\w+)/ ) {
$response = "$1 is in the $room{$1}.\n";
} #end Test 1
#Test 2. See if question is 'What does someone have?'
elsif ( $question =~ m/what does (\w+) have/) {
$response = "$1 has the $weapon{$1}.\n";
} #end Test 2
#Test 3. See if question is ‘Is someone in somewhere with something?'
elsif ( $question =~ m/is (\w+) in the (\w+) with (a|the) (\w+)/ ) {
if ($2 eq $room{$1} and $4 eq $weapon{$1}) {
$response = "Yes, $1 is in the $2 with a $4\n";
}
elsif ($2 eq $room{$1}) {
$response = "Well, $1 is in the $2.\n";
}
else {
$response = "No, $1 is not in the $2.\n";
}
} #end Test 3
} # end sub question
This version makes a dramatic improvement from the previous clue program. It still performs the same analyses as the previous version, but the main section of the program is now much easier to understand and modify. New questions can either be added to the question subroutine or to a different subroutine. We can use this new structure to add more complex features to the game without losing track of the program’s essential operations. The program also demonstrates the use of a subroutine call in a conditional context. The statement
if ( question ($question) ) {
calls the subroutine question as the condition for the if statement. If the subroutine succeeds by finding a match for the question, the program prints the response. If the subroutine fails to find a match, control passes to the else statement which prompts the user for a different question.
For the subroutine to function properly, information must pass from the main program to the subroutine. Perl passes this information in the form of an argument to the subroutine. The subroutine call
question ($question)
tells the program to pass the information stored in the variable $question to the subroutine. The subroutine can then search the string $question and take the appropriate action. The subroutine in our program only succeeds because the variable name in the subroutine call happens to match the variable name in the subroutine. There are many times when a programmer would like to use different variables as arguments for the same subroutine, e.g., question ($request) or question ($inquiry). Perl’s special array variable @_ makes this trick possible. Perl uses the variable @_ to store all of the arguments passed to a subroutine. It is then possible to use the shift function to retrieve the first variable in the @_ array. The statement
$question = shift( );
assigns the first variable from the @_ array to the variable $question in our subroutine. Adding this statement to the first line of the question subroutine allows the programmer to use the subroutine with different arguments.
This added flexibility is wonderful, but it can also create some confusion over which variable the program is processing. We might use a variable $question in the main program and require another variable $question in our subroutine. If we had a team of programmers working on the main program and another team working on the subroutines, we would have to ensure that both teams agreed on the names for their variables in their specific parts of the program. Otherwise, a subroutine call could unexpectedly alter the value of a variable in the main program. This mistake would create a problem that could be extremely difficult to track down.
The risk of variable encroachment can be greatly reduced by declaring the extent of the variable’s domain of operation or scope. A variable’s domain corresponds to the level at which the variable is first declared. Subroutines introduce a subdomain of the main program. The keyword my can be used to give a variable lexical or static scope. This limits the variable’s usefulness to the domain in which it was first declared. If we use the statement
my $question = shift( );
in our clue subroutine, we would be telling Perl that that particular $question variable can only be used inside the subroutine. Perl assumes that all variables that are not explicitly declared have a global scope. Globally scoped variables can be “seen” or altered anywhere in a program. Our original clue subroutine used the variable $question with global scope to retrieve its value from the main program. If we declared the variable $question with lexical scope in the main program, the subroutine would not have access to the variable’s contents. You can explicitly declare a variable with global scope by using the keyword our. Lexical scope wins over global scope, so a subroutine processing a variable with lexical scope would not alter the value of a globally scoped variable in the main program with the same name.
Perl allows a third type of variable scope as an alternative to lexical and global scopes. The keyword local can be used to declare a variable with dynamic scope. Dynamically scoped variables can be seen in their own domain as well as from any subroutines called from their domain. This definition gives variables with dynamic scope more flexibility than variables with lexical scope, but it also increases the potential difficulty of an unexpected variable encroachment between subroutines. Thus, it is advantageous to make subroutines as self-contained as possible by giving all variables within them lexical scope. The subroutine in Figure 6.3 illustrates the use of a self-contained subroutine with a lexically scoped variable for the program clue.
Figure 6.3 Subroutine with a lexically scoped variable
sub question {
my $query = shift();
#Test 1. See if question is 'Where is someone?'
if ( $query =~ m/where is (\w+)/ ) {
$response = "$1 is in the $room{$1}.\n";
} #end Test 1
#Test 2. See if question is 'What does someone have?'
elsif ( $query =~ m/what does (\w+) have/) {
$response = "$1 has the $weapon{$1}.\n";
} #end Test 2
#Test 3. See if question is ‘Is someone in somewhere with something?'
elsif ( $query =~ m/is (\w+) in the (\w+) with (a|the) (\w+)/ ) {
if ($2 eq $room{$1} and $4 eq $weapon{$1}) {
$response = "Yes, $1 is in the $2 with a $4\n";
}
elsif ($2 eq $room{$1}) {
$response = "Well, $1 is in the $2.\n";
}
else {
$response = "No, $1 is not in the $2.\n";
}
} #end Test 3
} # end sub question
Everything is in the packaging
Perl has one further trick for limiting the complexity of individual programs. It is possible to divide programs into separate modules or packages. You can think of a Perl package as a subroutine that has been transformed into its own independent program. The main program then makes a call to this independent package rather than to a subroutine. This trick enables programmers to package useful subroutines into independent modules that are easy to recombine into new programs. Reusing program code in this way can speed up the programming process enormously.
Each Perl package has its own symbol table, which contains the names of all the variables and subroutines in the package. The global variables and subroutines in the main program are part of the main package’s symbol table. All of the programs that we have written so far are examples of the main package. The main program can reference variables in another package directly by adding the package’s name and two colons (::) to the name of the package variable. Thus the variable $name in the package Sub could be referenced with the name $Sub::name.
We also need a way to tell our main program which package it should include. Perl has two methods for doing this which use the keywords require and use. For example, the statement
use Sub;
would give the main program access to the package Sub. One of the main differences between these two methods is that the use method gives the main program direct access to the variables and subroutines in a package whereas a program using the require method must still use the full reference with double colons for the variables in the package. I provide an example of our clue program which uses the package Question in Figure 6.4. The package Question is shown in Figure 6.5.
Figure 6.4 A version of clue which uses the package Question
#!/usr/local/bin/perl
# clue3.pl
# This program responds to possession and location queries
# It ends when the user types "thanks"
# It replaces subroutines with the Question package
use Question;
our $response = '';
# Block 2. Request a prompt from the user
print "Hello Dave. What can I do for you? \n";
chop( our $question = <> ); #Get the question from the standard input
$question = lc $question;
# Main program loop
until ( $question eq 'thanks' ) {
if ( question($question) ) { #Answers the questions
print "$response";
}
else {
print "I don\'t understand that question. Ask a different question.\n";
}
chop( $question = <> ); #Get another question from the standard input
$question = lc $question;
} #End main loop
Figure 6.5 The package Question
#!/usr/local/bin/perl
# Question.pm
# Responds to clue3.pl
# It uses the hashes @weapon and @room to keep track of the objects
package Question;
use Exporter;
our @ISA = qw( Exporter );
our @EXPORT = qw( &question $response );
my %weapon = (); my %room = ();
# Block 1. Read in data file
open ITEMS, "< clue.txt" ;
while (chop( $input = <ITEMS> )) {
(my $name, my $weap, my $rm) = split /\t/, $input;
$weapon{$name} = $weap; $room{$name} = $rm;
print "$name, $weapon{$name}, $room{$name}.\n";
} #end while
sub question {
my $query = shift();
#Test 1. See if question is 'Where is someone?'
if ( $query =~ m/where is (\w+)/ ) {
$response = "$1 is in the $room{$1}.\n";
} #end Test 1
#Test 2. See if question is 'What does someone have?'
elsif ( $query =~ m/what does (\w+) have/) {
$response = "$1 has the $weapon{$1}.\n";
} #end Test 2
#Test 3. See if question is ‘Is someone in somewhere with something?'
elsif ( $query =~ m/is (\w+) in the (\w+) with (a|the) (\w+)/ ) {
if ($2 eq $room{$1} and $4 eq $weapon{$1}) {
$response = "Yes, $1 is in the $2 with a $4\n";
}
elsif ($2 eq $room{$1}) {
$response = "Well, $1 is in the $2.\n";
}
else {
$response = "No, $1 is not in the $2.\n";
}
} #end Test 3
} # end sub question
1;
Our new version of the clue program has reduced the main program to a fraction of its original size while encapsulating most of the tests in the package Question. It is even possible to use the subroutine in the package in a conditional context in the main program.
There are several features worth noting about the package. Perl assumes that all packages have the default file extension pm. Thus, even though the full name of the package file is Question.pm, it is possible to use just the filename Question in the use statement. The package file begins with the statement
package Question;
declaring that the program is the package Question. The following statement
use Exporter;
tells Perl to use the package Exporter that comes with the standard set of Perl modules. The Exporter module makes it possible to export the names of variables in the package to the variable list of the main program. The statement
our @ISA = qw( Exporter );
provides our package with the essential attributes of the Exporter package via the method of inheritance. Metaphorically our package inherits the features of the Exporter package, in particular, the ability to export variable names. The qw function adds quotes to any words inside the parentheses. Finally, the statement
our @EXPORT = qw( &question $response );
identifies the variable names we wish to export to the main file, including the names of any subroutines we want to export to the main program. Like other Perl keywords, the keywords
@ISA and @EXPORT are case sensitive so always type them in upper case. Finally, make careful note of the statement
1;
at the end of the package. Since the use method imports packages at the compilation phase, Perl requires a signal that the import was successful. The last executable statement in the package must return a true value. Any arbitrary statement will suffice for this purpose, but the ‘1;’ statement is the accepted Perl convention.
Now that we have a method for turning subroutines into independent files that can be called from other programs it will be much easier to develop complex programs. We just need to be careful that the variables in our packages are fully encapsulated. Note that it was necessary to move the weapon and room hashes to the package Question in order to make their data accessible to the package. Subroutines that use information stored in arrays or hashes cannot be converted directly into packages. This limitation occurs because Perl “flattens” all of the arguments passed to a subroutine or package into the single array variable @_. We can get around this limitation by using references. References provide an indirect method of referring to the data stored in a variable. Variables provide a tie between the variable name its information, but do not care where the computer has stored the information. A reference to a variable refers directly to the location in the computer’s memory where the variable’s data is stored. A reference to the variable $scalar is created with the \ operator, i.e., \$scalar. We can reference an array by \@array and reference a hash by \%hash. The trick to passing arrays and hashes to packages in Perl is to pass references to arrays and hashes to the package. I provide a final version of the clue game in Figure 6.6 to demonstrate how to pass references to hashes to the package Question2 shown in Figure 6.7.
Figure 6.6 A Clue package which passes references to a package
#!/usr/local/bin/perl
# clue4.pl
# This program responds to possession and location queries
# It ends when the user types "thanks"
# It uses the hashes @weapon and @room to keep track of the objects
# It replaces subroutines with the Question2 package
use Question2;
our $response = '';
my %weapon = (); my %room = ();
# Block 1. Read in data file
open ITEMS, "< clue.txt" ;
while (chop( $input = <ITEMS> )) {
(my $name, my $weap, my $rm) = split /\t/, $input;
$weapon{$name} = $weap; $room{$name} = $rm;
print "$name, $weapon{$name}, $room{$name}.\n";
} #end while
# Block 2. Request a prompt from the user
print "Hello Dave. What can I do for you? \n";
chop( our $question = <> ); #Get the question from the standard input
$question = lc $question;
# Main program loop
until ( $question eq 'thanks' ) {
if ( question($question, \%weapon, \%room) ) { #Answers the questions
print "$response";
}
else {
print "I don\'t understand your question.\n";
}
chop( $question = <> ); #Get another question from the standard input
$question = lc $question;
} #End main loop
Figure 6.7 The package Question2.pm
#!/usr/local/bin/perl
#Question2.pm
# for clue4.pl
#no hashes!
package Question2;
use Exporter;
our @ISA = qw( Exporter );
our @EXPORT = qw( &question $response );
sub question {
my $query = $_[0];
my %weapon = %{$_[1]};
my %room = %{$_[2]};
#Test 1. See if question is 'Where is someone?'
if ( $query =~ m/where is (\w+)/ ) {
$response = "$1 is in the $room{$1}.\n";
} #end Test 1
#Test 2. See if question is 'What does someone have?'
elsif ( $query =~ m/what does (\w+) have/) {
$response = "$1 has the $weapon{$1}.\n";
} #end Test 2
#Test 3. See if question is ‘Is someone in somewhere with something?'
elsif ( $query =~ m/is (\w+) in the (\w+) with (a|the) (\w+)/ ) {
if ($2 eq $room{$1} and $4 eq $weapon{$1}) {
$response = "Yes, $1 is in the $2 with a $4\n";
}
elsif ($2 eq $room{$1}) {
$response = "Well, $1 is in the $2.\n";
}
else {
$response = "No, $1 is not in the $2.\n";
}
} #end Test 3
} # end sub question
return 1;
Note how the package accesses the arrays passed from the main program in the statements
my $query = $_[0];
my %weapon = %{$_[1]};
my %room = %{$_[2]};
The indices [0], [1] and [2] point to elements from Perl’s @_ array. The package uses curly braces around the last two array elements to “dereference” them, providing the package access to the original hash structures. These can then be transferred to hashes with lexical scope that are declared in the package. Packaging subroutines calls for careful consideration of the ways in which the data must be distributed across the packages. But building a complex program from packages that run independently will make life a lot better!
Recursion
One of the most powerful features of the subroutine architecture is the ability of a subroutine to call itself. This type of self reference is known as recursion. Many people find recursion counter-intuitive at first. After all, if a subroutine can call itself when will it ever finish? The trick is to equip all recursive subroutines with a way out, so they do not continue to call themselves forever. We can include a test of some sort that will stop the subroutine from calling itself if the conditions of the test are satisfied.
Mathematics contains many examples of recursive functions so I will begin by discussing a couple of recursive functions from mathematics. The easiest recursive mathematical function to understand is the successor function which defines the set of arithmetic numbers. The successor to any number n is simply the number n + 1. If we begin with zero the successor to zero will be one. Thereafter, any number can be defined as the successor to the previous number all the way back to zero. The number 2, for example, is the successor to the number 1, which is the successor to the number 0, which is our starting point. If you understand the successor concept then you have mastered your first example of a recursive function.
The recursive feature of the successor function becomes clear if we generalize our original question. Instead of asking if 2 is a number, we can ask what the general procedure would be to verify that any number n is a number. The simple answer is that a number n is a number if it is a successor of zero via the successor function. More precisely, n is a number if the previous number n - 1 is a number. How can we tell if n - 1 is a number? Simply check if (n - 1) - 1 is a number and so on all the way back to 0.
We can make the recursion in the successor function more explicit by writing a Perl subroutine that tests if any n is a number. I provide an example of the successor subroutine in Figure 6.8. You can use the successor function by calling it with the number you wish to test, e.g., successor ( 5 ). Once the function is called, it passes the argument (5) to the subroutine variable $number. The subroutine then checks to see if this number is equal to zero. If the number is not equal to zero, the subroutine will next check if the preceding number is equal to zero. This is where it becomes necessary to make a recursive call to the successor subroutine within the successor subroutine. At this point the successor subroutine starts over with the new number. Since each call to the successor subroutine subtracts a one from the original number; the subroutine will eventually reach zero and the successor function will report success. The subroutine uses a feature of the return operator to return a prespecified value. We can test for the success of the successor function in the main program by testing if the value of the successor function for any number is ‘Yes!’. The following Perl statement will do this.
if ( successor ($n) eq “Yes!” ) { print “$n is a number!” }
Figure 6.8 The successor subroutine
sub successor {
my $number = shift;
if ( $number == 0 ) { # Did we hit zero yet?
return “Yes!”; } # Return a prespecified value
else { # Test the preceding number
$number = successor ($number - 1); # Recursive call to the successor subroutine
}
} # end sub successor
Admittedly, the successor function is utterly trivial. We already know what is or is not a number, and Perl distinguishes numbers from other entities by means of its pre-defined operations. The point of the example is to illustrate a recursive function and how to implement such a function in Perl. A slightly less trivial function is the factorial function. The factorial of any number n is the product of that number with the factorial of the number’s predecessor n - 1. Mathematicians write the factorial of n as n!. The factorial of 3 (or 3!) is equal to 3 x 2! which is equal to 3 x 2 x 1 or 6. You should be able to spot where the recursion comes in in defining the factorial function. I provide a recursive Perl function for factorials in Figure 6.9.
Figure 6.9 The factorial function
sub factorial {
my $number = shift;
if ( $number == 1 ) { # Test if number equals one
return $number; } # Return the factorial
else { # Find the factorial for the preceding number
$number = $number * factorial ($number - 1); # Recursive call to the factorial subroutine
}
} # end sub factorial
The factorial subroutine first tests to see if the current number is equal to 1. If it is then the subroutine halts and returns the value of the factorial via the variable $number. The factorial is computed in the else branch of the subroutine by multiplying the number by the factorial of the previous number.
The success of the factorial subroutine depends on the lexical scope of the variable $number in the subroutine. I used Perl’s my operator to tell the Perl interpreter that I wanted to confine the value of the $number variable to that particular subroutine. By using the my operator to declare a variable with lexical scope in the subroutine, I can use the same variable name in the main program to refer to a different number as in the following statements
$number = 4;
$result = factorial ( $number );
print “$number! = $result\n”;
The variable $number in the main program has the value 4 whereas the variable $number in the factorial subroutine ends with the value 4!.
The factorial subroutine demonstrates one other feature of lexical scope in Perl. Note that the if block tests if the value of $number is 1 while the else block equates the $number variable to the value of $number multiplied by the factorial of the previous number. How can the factorial subroutine work if the $number variable has two different values? The answer is that since the scope of the $number variable is lexical, it only has one value each time the subroutine is called. If we compute the value of 3! the variable $number in the subroutine will start with the value 3. The subroutine will then multiply the value 3 by the value of the factorial of its predecessor (2!). At this point the subroutine makes a recursive call to itself and passes the value 2 to the new lexically scoped variable $number2 within the new subroutine. This subroutine will in turn call the factorial subroutine and pass the number 1 to its new lexical variable $number1. This third subroutine finds that the number 1 meets its halting test and passes its value back to the 2! subroutine. The end result will be
3! = 3 x ( 2 x ( 1 ) )
The parentheses in this statement indicate the calls to the new subroutines as well as the lexical scope of the $number variable within each subroutine. The $number variable not only has lexical scope, but a lexical lifetime as well. It is only available during the time its own subroutine is operating.
The recursive feature of Perl subroutines will prove useful in parsing recursive language structures. Natural languages contain many examples of recursion such as embedded clauses or prepositional phrases. I will discuss these features after we have looked at parsing less complicated sentences. For now we should return to developing the Clue game.
Back to the game
In the actual board game, a player must move their token to one of the rooms before guessing if a character committed the murder with the weapon in that room. We can add this element to our program by first adding a subroutine that tells us which room the computer is in. We can then add a subroutine to tell the computer to move to another room and finally a routine to guess if a specific character committed the crime in that room. Let’s call these subroutines where_are_you, go_to, and guess respectively. My versions of these subroutines are shown in Figure 6.8. The go_to subroutine not only takes the computer to a new room, it also reports if the computer finds anyone in the room. The guess subroutine holds the answer.
Figure 6.8. The subroutines where_are_you, go_to, and guess
sub where_are_you {
if ( $question =~ m/where are you/ ) {
print "I am in the $computer.\n";
} # end if where are you
} # end sub where_are_you
sub go_to {
if ( $question =~ m/go to the (\w+)/ ) {
$computer = $1;
print "I am now in the $computer.\n";
foreach $person (keys %room) {
if ( $room{$person} eq $computer ) {
print “I found $person here.\n”;
return;
} # end if person is in room
} # end foreach person
print “I don\’t see anyone here.\n”;
} # end if go to
} # end sub go_to
sub guess {
if ( $question =~ m/was it (\w+) in the (\w+) with a (\w+)/ ) {
if ($computer ne $2) {
print “You have to be in the $2 before you can make that guess.\n”;
return;
} # end if not in room
if ($1 eq “green” and $2 eq “conservatory” and $3 eq “wrench”) {
print “Congratulations! You found the perpetrator!\n”;
exit;
} # end congrats
if ($1 eq “green”) {
print “You\’re on the right track! \n”;
return;
} # end hint
print "You still need to eliminate some suspects.\n";
} # end if guess
} # end sub guess
The statements in these subroutines do not do anything very complicated, but they sure add many new lines of code. Fortunately, all of these lines can be added to the collection of subroutines at the end of the program. The only new lines we will need in the main program will be the calls to these subroutines. I added a new scalar variable, $computer, to keep track of which room the computer is currently in. The guess subroutine checks to see if the computer is in a given room before allowing the player to use that room in guessing the culprit. We will have to add a new line to main program to tell the computer where to start. The final form of our Clue program is shown in Figure 6.9. It uses the package shown in Figure 6.10. I added a few new routines to make the game more interesting.
Figure 6.9. The final Clue game
#!/usr/local/bin/perl
# clue5.pl
# This program responds to possession and location queries
# It ends when the user types "thanks"
# It uses packages to simplify the main program section
use Question4;
# Block 1. Initialize settings
my %weapon = (); my %room = ();
my $computer = "hall";
my @perp = ("mustard", "plum", "scarlet", "peacock", "white", "green");
my @weap = ("knife", "candlestick", "revolver", "rope", "lead_pipe", "wrench");
my @rm = ("kitchen", "billiard_room", "conservatory", "library", "lounge", "dining_room", "study", "ballroom");
# Pick the culprit, weapon and room
my $who = $perp[ rand @perp ];
my $what = $weap[ rand @weap ];
my $where = $rm[ rand @rm ];
# Assign characters and weapons to random rooms
fisher_yates_shuffle( \@rm );
fisher_yates_shuffle( \@weap );
foreach $perp ( @perp ) {
$room{$perp} = $rm[$i];
$weapon{$perp} = $weap[$i];
$i = $i + 1;
} # end foreach $perp
# Block 3. Display the initial room setting
print "\nGood evening Chief Inspector.\n";
print "\nI am Jeeves, the head butler. I'm sorry you had to come\n";
print "out on a night like this. I'm afraid someone in the house\n";
print "has committed a murder and we need you to solve the crime.\n";
print "The mansion contains nine rooms.\n";
print "We are presently standing in the hall.\n";
print "To our right are the study, the library, the billiard_room and the lounge.\n";
print "To our left are the ballroom, the conservatory, the dining_room and the kitchen.\n";
print "I will be happy to show you around the house and\n";
print "introduce you to our guests.\n";
print "Which room would you like to inpect first?\n\n";
# Block 4. The main program loop
chop( my $question = <> ); #Get the question from the standard input
$question = lc $question;
# Main program loop
until ( $question eq 'thanks' ) {
question($question, $who, $what, $where, \@perp, \@weap, \@rm, \%weapon, \%room);
chop( $question = <> ); #Get another question from the standard input
$question = lc $question;
} #End main loop
############# Subroutines ###################
# Perl Cookbook (Christiansen & Torkington 1998, p. 121)
sub fisher_yates_shuffle {
my $array = shift;
my $i;
for ( $i = @$array; --$i; ) {
my $j = int rand ($i+1);
next if $i == $j;
@$array[$i,$j] = @$array[$j,$i];
} # end for array
} #end sub shuffle
Figure 6.10 The package Question4.pm
#!/usr/local/bin/perl
# Question4.pm
# Responds to clue5.pl
package Question4;
use Exporter;
our @ISA = qw( Exporter );
our @EXPORT = qw( &question );
@mustard = ("A beastly night for this sort of thing, eh Chief Inspector?\n",
"Who would leave something like this lying about?\n");
@plum = ("Good to see you again old boy.\n",
"Are you making any progress old bean?\n");
@scarlet = ("I would tell you anything you want to know!\n",
"I might have something else for you up in my bedroom.\n");
@peacock = ("The sooner you can clear up this mess the better.\n",
"Haven't you solved this business yet?\n");
@white = ("I'm afraid to stay here a minute longer.\n",
"Can you leave a constable to protect me?\n");
@green = ("I haven't heard a thing all evening.\n",
"I'm afraid I can't help you any further.\n");
sub question {
my $n = $n + 1; #Count the number of steps
my $q = 0; #Flag to see if question is legitimate
my $question = $_[0];
my $who = $_[1];
my $what = $_[2];
my $where = $_[3];
my @perp = @{$_[4]};
my @weap = @{$_[5]};
my @rm = @{$_[6]};
my %weapon = %{$_[7]};
my %room = %{$_[8]};
# where is plum?
if ( $question =~ m/where is (\w+)/ ) {
print "$1 is in the $room{$1}.\n";
$q = $q + 1;
} # end if where
# go to the study
elsif ( $question =~ m/the (\w+)/ ) {
foreach $rm (@rm) {
if ( $1 eq $rm ) {
$computer = $1;
print "\nJeeves: This way Chief Inspector.\n";
print "\nJeeves: We are now in the $computer.\n";
$q = $q + 1;
if ( $computer eq $where ) {
print "\n\Jeeves: There\'s a body stretched out on the floor here!\n";
} # end if where
foreach $person (keys %room) {
if ( $room{$person} eq $computer ) {
print "\nJeeves: Chief Inspector, allow me to introduce you to $person.\n";
print "\n$person: Good evening Chief Inspector.";
print "\n$person: @$person[0]\n";
$ref = $person;
if ($person eq "peacock" or $person eq "scarlet" or $person eq "white" ) {
$pronoun = "her"; }
else {$pronoun = "him"; }
if ( my $time eq '' ) {
print "\nJeeves: You might ask $pronoun to assist you.\n\n";
$time = $time +1;
} #end if time
return;
} # end if room
} # end foreach person
print "\nJeeves: None of our guests are here Chief Inspector.\n";
print "Jeeves: Which room would you like to inspect next?\n\n";
} # end if_room
} # end foreach_room
} # end elsif go to
# can_you help me?
elsif ( $question =~ m/(what )?(can|will|did) you.*/ ) {
$q = $q + 1;
print "$ref: I found this $weapon{$ref} when I entered the $room{$ref}\n";
print "$ref: @$ref[1]\n";
if ( $what eq $weapon{$ref} ) {
print "$ref: The $what has blood stains on it.\n";
print "\nJeeves: You might ask who gave the $what to $pronoun.\n\n";
return;
} # end if what
print "\nJeeves: Which room would you like to inspect now?\n\n";
} # end if can you
# who_gave_it
elsif ( $question =~ m/who gave you the (\w+)/ ) {
$q = $q + 1;
if ( $1 ne $what ) {
print "$ref: It was here all along.\n\n";
} # end if ne what
elsif ( $ref ne $who ) {
print "$ref: $who gave it to me.\n\n";
} # end ne who
else {print "$ref: I found it in the $where.\n\n";}
} #end who gave it
# what_rooms are there?
elsif ( $question =~ m/what rooms/ ) {
print "The mansion contains nine rooms.\n";
print "We are presently standing in the $computer.\n";
print "There are the study, the library, the billiard_room and the lounge.\n";
print "There are also the ballroom, the conservatory, the dining_room and the kitchen.\n";
$q = $q + 1;
} # end what rooms
# what does plum have?
elsif ( $question =~ m/what does (\w+) have/) {
print "Jeeves: $1 has the $weapon{$1}.\n";
$q = $q + 1;
if ( $what eq $weapon{$1} ) {
print "The $what has blood stains on it.\n";
} # end if what weapon
} #end what does x have
# inspect the body
elsif ( $question =~ m/((look at)|inspect) the body/) {
$q = $q + 1;
if ( $computer eq $where ) {
if ( $what eq 'knife' ) {
print "There are stab wounds on the body.\n\n";
} # end if knife
if ( $what eq 'candlestick' ) {
print "The victim was beaten with a blunt instrument.\n\n";
} # end if candlestick
if ( $what eq 'lead_pipe' ) {
print "The victim was beaten with a blunt instrument.\n\n";
} # end if lead pipe
if ( $what eq 'wrench' ) {
print "The victim was beaten with a blunt instrument.\n\n";
} # end if wrench
if ( $what eq 'revolver' ) {
print "There are bullet wounds in the body.\n\n";
} # end if revolver
if ( $what eq 'rope' ) {
print "There are rope burns around the neck.\n\n";
} # end if rope
} #end if where
else { print "What body?\n"; }
} #end inspect
# was it plum in the study with the wrench?
elsif ( $question =~ m/was it (\w+) in the (\w+) with (a|the) (\w+)/ ) {
$q = $q + 1;
if ($1 eq $who and $2 eq $where and $4 eq $what) {
print "Jeeves: Congratulations! You found the perpetrator!\n";
print "Jeeves: It only took you $n turns to catch the culprit.\n";
exit;
} # end congrats
elsif ($1 eq $who and $4 eq $what) {
print "Jeeves: Now you need to find the right room.\n\n";
} # end hint who and what
elsif ($2 eq $where and $4 eq $what) {
print "Jeeves: Now you need to find the culprit.\n\n";
} # end hint where and what
elsif ($1 eq $who) {
print "Jeeves: You\'re on the right track! \n\n";
} # end hint who
elsif ($4 eq $what) {
print "Jeeves: You\'ve discovered the weapon!\n\n";
} # end hint what
else {print "Jeeves: You still need to eliminate some suspects.\n\n";}
} # end guess
if ( $q == 0 ) {
print "I don\'t understand. Please rephrase that.\n";
} # end if $q
} # end sub question
return 1;
This is a good time to evaluate the approach to language that our game uses. Basically, the program has a set of phrases that it matches against the input. If it finds a match the program produces a preset output. As long as the user stays within the game’s stock of phrases the program runs smoothly, but if the user uses a different expression, or an unplanned word order, or even mistypes a word, the program will be lost. We have added a response to tell users to rephrase their command, but we do not have a satisfactory way to suggest how the users should rephrase their command. We can continue to add more and more responses to the program, which will respond to a wider range of inputs, but we will not be able to anticipate every possible command. Although the program may appear to respond intelligently to the user’s input, we would not want to say that the program is using any intelligent capacity to make its responses. We will also be committing a grave linguistic sin in that our program will not make use of any generalizations about language structure that could help it interpret the user’s input. We tackle this problem in the next chapter where we ask if the analysis of language structure would be of any use to a computer program.