Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Animals

by turnstep (Parson)
on May 05, 2000 at 16:57 UTC ( #10356=perlcraft: print w/replies, xml ) Need Help??

   1: #!perl -w
   2: 
   3: ## Animals
   4: ## Attempts to guess an animal by yes/no questions, 
   5: ## Learns new animals as it goes.
   6: ## Based on a game I remember playing on an Apple II
   7: 
   8: use strict;
   9: 
  10: my $animalfile = "animals.dat";
  11: 
  12: ## Open and read in the animal file, or our default data
  13: unless (open(ANIMALS, "$animalfile")) {
  14:   *ANIMALS = *DATA;
  15:   print qq[**WARNING**\nThe file "$animalfile" was not found. ];
  16:   print "Using the default list instead.\n";
  17: }
  18: 
  19: my $yesno="ASK";
  20: my @q;
  21: my $total=0;
  22: my $new=0;
  23: my ($ark, $answer);
  24: my ($animal, $Animal, $beast, $Beast);
  25: 
  26: ## Read in all the animals
  27: while(<ANIMALS>) {
  28:   next if /^#/;    ## Allow comments - why not?
  29:   last if /^END!/; ## Allow a graceful end if needed
  30:   chop;
  31:   if ($yesno eq "ASK") {
  32:     $q[++$total]->{$yesno}=$_;
  33:     $yesno="YES"; next;
  34:   }
  35:   if (m/^>(\d*)/) { $q[$total]->{$yesno}=\$q[$1]; }
  36:   else { $q[$total]->{$yesno}=$_; }
  37:   $yesno = $yesno eq "YES" ? "NO" : "ASK";
  38: }
  39: close(ANIMALS);
  40: 
  41: ## Begin the game
  42: print qq[
  43: Welcome to the game of Animals! Just think of an animal, 
  44: and I will try and guess what it is.
  45: 
  46: (I know $total animals!)
  47: 
  48: --Please answer <Y>es, <N>o, or <Q>uit for each question.--
  49: 
  50: ];
  51: 
  52: $ark=\$q[1];
  53: while($ark) {
  54:   print "\n$$ark->{ASK}\n\n";
  55:   $yesno = <STDIN>;
  56:   &Quit if $yesno =~ /^Q/i;
  57:   if ($yesno =~ s#^([YN]).*#$1=~/Y/i ? "YES" : "NO"#eis) {
  58:     $animal = $$ark->{$yesno};
  59:     if (ref($animal)) { $ark=$animal; next; }
  60:   }
  61:   else { print "**Please answer Yes, No, or Quit**\n\n"; next; }
  62: 
  63:   ## Did we guess the right animal?
  64:   ($Animal = $animal) =~ s/^([aeiou])?/$1 ? "an $1" : "a "/ei;
  65:   print "\n**It must be $Animal!**\n";
  66:   do {
  67:     print "\nDid I guess your animal?\n\n";
  68:   } while ($answer=<STDIN>) !~ /^[YN]/i;
  69: 
  70:   if ($answer =~ /^Y/i) {
  71:     print "\n**Yay! I win!**\n";
  72:     do {
  73:       print "\nDo you want to <P>lay again or <Q>uit?\n\n";
  74:     } while ($answer=<STDIN>) !~ /^[PQ]/i;
  75:     &Quit if $answer =~ /Q/i;
  76:     $ark=\$q[1]; next;
  77:   }
  78: 
  79:   print "\nWhat animal were you thinking of?\n\n";
  80:   chop($beast=<STDIN>);
  81:   ($Beast = $beast) =~ s/^([aeiou])?/$1 ? "an $1" : "a "/ei;
  82:   $total++; $new++;
  83:   do {
  84:     print "\nWhat could I ask to tell the difference between ",
  85:           "$Animal and $Beast?\n\n";
  86:     chop($q[$total]->{ASK}=<STDIN>);
  87:     print "\n\nIf I asked someone:\n\"$q[$total]->{ASK}\"\n\n";
  88:     print "Would they answer <Y>es or <N>o for $Animal?\n";
  89:     print "(<R> to re-enter your question)\n\n";
  90:   } while ($answer = <STDIN>) !~ /^[YN]/i;
  91: 
  92:   ## Store the animals in the new Yes/No
  93:   $q[$total]->{YES} = $answer=~/^Y/i ? $animal : $beast;
  94:   $q[$total]->{NO}  = $answer=~/^N/i ? $animal : $beast; 
  95: 
  96:   ## Make the current yes/no point to the new entry
  97:   $$ark->{$yesno} = \$q[$total];
  98:       
  99:   print "\n\n**Thank you! Now I know about $total animals, ",
 100:     "including $Beast!**\n";
 101:   do {
 102:     print "\nWould you like to <P>lay again or <Q>uit?\n\n";
 103:   } while ($answer=<STDIN>) !~ /^[PQ]/i;
 104:   &Quit if $answer =~ /^Q/i;
 105: 
 106:   print "I now know $total animals!\n\n";
 107:   $ark=\$q[1]; ## Start over...
 108: }
 109: 
 110: 
 111: sub SaveAnimals {
 112:   ## Write the list to the file
 113:   open(ANIMALS, ">$animalfile") or 
 114:     die "Could not open $animalfile: $!\n";
 115:   my $oldselect = select(ANIMALS);
 116: 
 117:   ## Create a quick lookup table
 118:   my $y=0; my %LU;
 119:   $LU{$q[$y]->{ASK}}=$y while ($q[++$y]);
 120: 
 121:   ## Write each one in order
 122:   $y=1;
 123:   while($ark = $q[$y]) {
 124:     print "$ark->{ASK}\n";
 125:     for $yesno (qw(YES NO)) {
 126:       if (ref($ark->{$yesno})) {
 127:         printf ">%d\n", $LU{${$ark->{$yesno}}->{ASK}};
 128:       }
 129:       else { print "$ark->{$yesno}\n"; }
 130:     }
 131:     $y++;
 132:   }
 133:   select($oldselect);
 134:   close(ANIMALS);
 135:   print "\nSaved information on $total animals.\n";
 136: } ## end of the sub SaveAnimals
 137: 
 138: 
 139: sub Quit {
 140:   if ($new) {
 141:     do {
 142:       printf "\n**I learned about $new new animal%s!**\n",
 143:         $new==1 ? "" : "s";
 144:       print "\nDo you want to <S>ave or just <Q>uit?\n\n";
 145:     } while ($answer = <STDIN>) !~ /^[SQ]/i;
 146:     &SaveAnimals if $answer =~ /^S/i;
 147:   }
 148:   print "\n**Goodbye! Thanks for playing!**\n";
 149:   exit;
 150: }
 151: __END__
 152: ## This is the default list if the data file is not found.
 153: Does it live in the water?
 154: >2
 155: >3
 156: Does it have a tail?
 157: Whale
 158: Starfish
 159: Does it have wings?
 160: >4
 161: >5
 162: Can it fly?
 163: Eagle
 164: Penguin
 165: Does it have fur?
 166: >6
 167: >7
 168: Does it have stripes?
 169: Tiger
 170: Bear
 171: Does it have a trunk?
 172: Elephant
 173: Armadillo
 174: END!
 175: <Homer>mmmm.....typeglobs</Homer>

Replies are listed 'Best First'.
RE: Animals
by merlyn (Sage) on May 05, 2000 at 18:58 UTC
    Here's my version of that, which I wrote for a UnixReview column but never got around to it...
    #!/usr/bin/perl -w use strict; use Data::Dumper; my $info = "dog"; { try($info); redo if (yes("play again?")); } print "Bye!\n"; print Dumper($info); sub try { my $this = $_[0]; if (ref $this) { return try($this->{yes($this->{Question}) ? 'Yes' : 'No' }); } if (yes("Is it a $this")) { print "I got it!\n"; return 1; }; print "no!? What was it then? "; chomp(my $new = <STDIN>); print "And a question that distinguishes a $this from a $new would b +e? "; chomp(my $question = <STDIN>); my $yes = yes("And for a $new, the answer would be..."); $_[0] = { Question => $question, Yes => $yes ? $new : $this, No => $yes ? $this : $new, }; return 0; } sub yes { print "@_ (yes/no)?"; <STDIN> =~ /^y/i; }

    -- Randal L. Schwartz, Perl hacker

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlcraft [id://10356]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (2)
As of 2021-04-11 12:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?