[SPOILER] Perl Quiz-of-the-Week #10

----- Original Message -----
From: "Mark Jason Dominus" <mjd-ZxR0713JXSrQT0dZR+AlfA@xxxxxxxxxxxxxxxx>
To: <perl-qotw-ZxR0713JXSrQT0dZR+AlfA@xxxxxxxxxxxxxxxx>
>
> Here's an old chestnut of a computer entertainment: The
> 'guess-the-animal' program.  The human thinks of an animal.  The
> computer tries to guess what the animal is by asking yes-or-no
> questions.
>

Here is my version.
After I wrote mine I had a look at the solutions that have been sent in so
far.
I realize that mine does not have the level of sophistication that I
observed in the others.
I hope you enjoy it anyway - I did, writing it.
Thanks,
Leon

#---------------------------------------------------------------------------
----------------------------
use warnings;
use strict;
use Data::Dumper;

my %negate = ( yes => "no", no => "yes" );
#---------------------------------------------------------------------
sub get_answer {
   while (1) {
      chomp(my $answer = <STDIN>);
      if ($answer =~ /yes|y/i) { return "yes"; }
      if ($answer =~ /no|n/i) { return "no"; }
      print "Please enter yes or no\n";
      }
   }
#----------------------------------------------------------------------
sub article_ending {
   my $subject = shift;
   if ($subject =~ /^\s*(a|e|i|o|u)/) {
      return 'n';
      }
   return '';
   }
#----------------------------------------------------------------------
sub extend_tree {

   my $current_leaf_ref = shift; # The animal name in this leaf was
                                 # the wrong guess

   print "What animal did you think of?\n";
   chomp(my $animal = <STDIN>);

   my $n = article_ending($animal);
   my $cn = article_ending($current_leaf_ref->{animal});

   print "What is the question that would distinguish a$n $animal from a$cn
",
         $current_leaf_ref->{animal}, "\n";
   my $question = <STDIN>;

   print "For a$n $animal the answer would be?\n";
   my $answer = get_answer;

   print "Thank you for teaching me!\n";

   # Make a leaf for the new animal
   my %new_leaf;
   $new_leaf{leaf} = "yes";
   $new_leaf{question} = "Is it a$n $animal?\n";
   $new_leaf{animal} = $animal;

   # Make a new node and link in the current and new leaf
   my %new_node;
   $new_node{leaf} = "no";
   $new_node{question} = $question;
   $new_node{$answer} = \%new_leaf;
   $new_node{$negate{$answer}} = $current_leaf_ref;

   return \%new_node;

   }
#-----------------------------------------------------------------
# main program
# Interact with human to build tree of knowledge about animals
#
my $tree_ref;
my $tree;

$/ = undef;
open STORAGE, "persistent.dat"
   and $tree = <STORAGE>
   and eval $tree
   and close STORAGE
 or do {
   print "I found no existing knowledge, you'll need to teach me a lot.\n";
   $tree_ref->{leaf} = "yes";
   $tree_ref->{question} = "Is it an elephant?\n";
   $tree_ref->{animal} = "elephant";
   };
$/ = "\n";

my $node_ref = $tree_ref;
my $parent_ref = 0;

my $match_answer = '';
my $previous_match_answer = '';

print "Think of an animal, then answer the following questions:\n";

WALK:
while (1) {

   print $node_ref->{question};
   my $previous_match_answer = $match_answer;
   $match_answer = get_answer;

   if ($node_ref->{leaf} eq "yes") {

      if ($match_answer eq "no") {
         # program guessed wrong, ask human for input
         # and extend tree of knowledge
         if ($parent_ref == 0) {
            $tree_ref = extend_tree($node_ref);
            } else {
            $parent_ref->{$previous_match_answer} = extend_tree($node_ref);
            }
         }

      print "Would you like to play again?\n";
      if (get_answer eq "yes") {
         # start from beginning
         $node_ref = $tree_ref;
         $parent_ref = 0;
         } else {
         # end game, save tree
         last WALK;
         }

      } else {
      # go down tree nodes, based on answer from human
      $parent_ref = $node_ref;
      $node_ref = $node_ref->{$match_answer};
      }
   }

# Store the learnings in the file "persistent.dat"
my $encoding = Data::Dumper->Dump([$tree_ref],["tree_ref"]);
open STORAGE, ">persistent.dat"
   and print STORAGE $encoding
   and close STORAGE
 or die "cannot save knowledge tree: $!";

print "Bye\n";