Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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 rifling through the Monastery: (3)
As of 2019-06-17 00:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Is there a future for codeless software?



    Results (76 votes). Check out past polls.

    Notices?
    • (Sep 10, 2018 at 22:53 UTC) Welcome new users!