Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

(Golf) The Animal Game

by Masem (Monsignor)
on Jan 23, 2002 at 00:58 UTC ( #140734=perlmeditation: print w/ replies, xml ) Need Help??

One of the earlier games that came out of the first computers was the so-called Animal game. The game would be to have the computer try to guess what animal the person was thinking of by asking a series of yes or no questions. If the animal was not identified, then the computer would ask the user to type in some question that would identify the user's animal from any other animal that would be classified in the current line of questioning. For example, a run of the program might go like (C == computer, U == user):
C> Is your animal smaller than a breadbox? U> n C> Is your animal a cat? U> n C> What is your animal? U> sparrow C> Please enter a question that would be true for a bird, but false fo +r a cat: U> Does your animal have wings? # Next iter # C> Is your animal smaller than a breadbox? U> n C> Does your animal have wings? U> Y C> Is your animal a sparrow? U> n C> What is your animal? U> chicken C> Please enter a question that would be true for a chicken, but false + for a sparrow: U> Can your animal fly? # ETC... #
In other words, the computer would become more intelligent as more replies were added. Of course, this assumes that the user was faithful in entering replies and had a sufficiently good set of distinguising questions to separate out one type of animal from another.

Now, for the golf: Write an engine that does the above in as few characters as possible. Of course, to help, you've got 4 'free' functions that you can use:

  • a($question) asks the user the passed $question, and returns either true if the user replied yes to it, or false otherwise.
  • g($animal) asks the user if their animal is $animal. Returns true if so, false otherwise. THIS IS NEW IN UPDATE
  • t() asks the user what their animal is, and returns the answer the user gives
  • i($guessed, $user) asks the user to identify a question that is true for $user but false for $guessed (where $guesses should be what the computer guessed).
  • w() asks the user if they want to continue; true if so, false otherwise (and should end the program).
You may also preinitialize any data structure for 'free' with a single question and the y/n answers for it. (Such as "Is your animal larger than a breadbox?" with 'giraffe' for true, 'housecat' for false).

Everything else inside the code block that does this will count as strokes to the golf score. You can use any data structure that you like. No extra modules, however, but the program need not be strict or -w compliant.

Update As tilly's solution indicates, I missed one 'free' function, the g() function which does the final guess (as described in the problem statement). Also, indirectly replying to tilly, assume the free functions return 0 or 1 for false or thuth, respectively. (I'm figuring the 0 value is more useful for further golfing). Also, don't worry about 'a' vs 'an'. Assume that you can decide which is appropriate in the free functions, and doesn't need to be handled by your golf sub.

-----------------------------------------------------
Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
"I can see my house from here!"
It's not what you know, but knowing how to find it if you don't know that's important

Comment on (Golf) The Animal Game
Download Code
Re: (Golf) The Animal Game
by dragonchild (Archbishop) on Jan 23, 2002 at 02:18 UTC
    I'll come in at 153 characters. I'm sure it has to be better than that ... I'm using too many temp vars.

    Updated: Forgot to change my datastructure from a hash of hashes to a hash of arrays. That caused the bug jarich noticed. ++!

    #!/usr/local/bin/perl my %tree = ( 'larger than a breadbox' => [ 'cat', 'giraffe', ], ); sub a { print 'Is your animal ', shift, "?\n"; my $answer = <STDIN>; chomp $answer; return 1 if $answer =~ /y/i; return 0; } sub t { print "What is your animal?\n"; my $answer = <STDIN>; chomp $answer; return $answer; } sub i { my ($g, $u) = @_; print "What is a question that is true for $u, but false for $g?\n +"; my $answer = <STDIN>; chomp $answer; $answer =~ s/Is your animal //; return $answer; } sub w { print "Do you want to continue?\n"; my $answer = <STDIN>; chomp $answer; return 1 if $answer =~ /y/i; return 0; } #234567890#234567890#234567890#234567890#234567890#234567890#234567890 +#234567890 sub f { ($s,%t)=@_;$q=$s;do{{$v=a($q);$a=$t{$q}[$v];$q=$a,redo if$t{$a};$q=$s, +next if a( $a);$n=&t;$o=i($a,$n);$t{$o}=[$t{$q}[$v],$n];$t{$q}[$v]=$o;$q=$s}}whil +e&w } f( 'larger than a breadbox',%tree); __END__

    ------
    We are the carpenters and bricklayers of the Information Age.

    Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

      I can't golf it better, but I can fix a bug I've spotted. If you say your animal isn't bigger than a bread box, it guesses your animal to be "1", which isn't much fun. These are my changes:
      my %tree = ( 'Is your animal larger than a breadbox' => { '1' => 'giraffe', '0' => 'cat', }, ); # anon hashref rather than array ref #234567890#234567890#234567890#234567890#234567890 sub f{ ($s,%t)=@_;$q=$s;do{{$v=a($q);$a=$t{$q}->{$v};$q= $a,redo if$t{$a};$q=$s,next if a($a);$n=&t;$o=i($a ,$n);$t{$o}={0=>$t{$q}->{$v},1=>$n};$t{$q}->{$v}= $o;$q=$s;}}while&w }
      Sorry about the extra 13 characters. ;) It's a cool program though, I've got to admit that the idea had me stumped 'til I saw yours and Tilly's answers.

      jarich

      update: I can't count (or rather I forgot the indexing), 13 extra characters, not 6.

        It's supposed to be anon listref. I had it as anon hashref, then switched it to anon listref. Updated my original node.

        ------
        We are the carpenters and bricklayers of the Information Age.

        Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

      Heh. I found an interesting bug in mine. If you use the same question for two branches, it overwrites. This is due to the 1-D flattening of the N-D structure. *grins* I don't feel like fixing it. :-)

      ------
      We are the carpenters and bricklayers of the Information Age.

      Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

Re (tilly) 1: (Golf) The Animal Game
by tilly (Archbishop) on Jan 23, 2002 at 02:21 UTC
    117 116 117. But with caveats.

    The main caveat is that I can add or lose characters depending on exact behaviour of these additional functions. (Particularly important is the behaviour of "a". I assumed that it returned 0,1 and added returns on prints but not a ?.) Here are the exact functions as I used them for my solution:

    sub a { print @_, "\n"; my $r = <STDIN>; if ($r =~ /y/i) { return 1; } elsif ($r =~ /n/i) { return 0; } else { print "Sorry, I don't understand that. Please answer Y/N.\n"; a(@_); } } sub t { print "What is your animal?\n"; my $ans = <STDIN>; chomp($ans); return $ans; } sub i { my ($guessed, $user_answer) = @_; chomp($guessed, $user_answer); print "Please enter a question that would be true for a " . "$user_answer, but false for a $guessed:\n"; my $ans = <STDIN>; chomp($ans); return $ans; } sub w { if (a("\nDo you want to continue?")) { print "\nStarting a new game.\n"; } else { print "BYE!\n"; exit(); } }
    Add to that my one free initialization:
    $Q{a}="golfer";
    And then my solution:
    # 1 2 3 4 5 6 +7 8 9 10 11 #123456789_123456789_123456789_123456789_123456789_123456789_123456789 +_123456789_123456789_123456789_123456789_1234567 {*q=\%Q;*q=$q{a$q{q}}while$q{q};$q{0}{a}=$q{a},$q{1}{a}=t,$q{q}=i($q{a +},$q{1}{a})if!a"Is your animal a $q{a}?";w,redo} # Was #{*q=*Q;*q=$q{a$q{q}}while$q{q};$q{0}{a}=$q{a},$q{1}{a}=t,$q{q}=i($q{a +},$q{1}{a})if!a"Is your animal a $q{a}?";w&&redo}
    UPDATE
    jarich is right, I forgot to test something. My first typeglob assignment was wrong
      Nice solution, but it really gets thrown out if you pick the same two animals in alternation.
      Starting a new game. does your animal have feathers? y Is your animal a chicken? n What is your animal? sparrow Please enter a question that would be true for a sparrow, but false fo +r a chicken: is your animal smaller than your fist? Do you want to continue? y Starting a new game. is your animal smaller than your fist? n Is your animal a chicken? y Do you want to continue? y Starting a new game. Is your animal a chicken? n What is your animal? sparrow Please enter a question that would be true for a sparrow, but false fo +r a chicken: is your animal smaller than your fist? Do you want to continue? y
      In fact I can never get it to filter down beyond one quesiton. Surely it's trying to do a sort and should look like:
      does your animal have fur? y is your animal smaller than your fist? y is your animal a mouse? y Do you want to continue?
      but I can't get beyond:
      the last question you answered: true -> your last animal false -> computer's previous guess.
Re: (Golf) The Animal Game
by redsquirrel (Hermit) on Jan 23, 2002 at 21:42 UTC
    This is my second attempt at Perl Golf. Although my score (281) sucks, I wanted to post my code because I had a hard enough time just getting it to work at all. :-) I know I could make my code more concise, but I've run out of time! I've got to actually get some work done today!

    My free subs:

    sub a { print shift; my $answer = <STDIN>; chomp $answer; return 1 if $answer =~ /y/i; return 0; } sub t { print "What is your animal?\n"; my $answer = <STDIN>; chomp $answer; return $answer; } sub i { my ($g, $u) = @_; print "What is a question that is true for $u, but false for $g?\n +"; my $answer = <STDIN>; return $answer; } sub w { print "Do you want to continue?\n"; my $answer = <STDIN>; chomp $answer; return 1 if $answer =~ /y/i; return 0; } sub g { my $animal = shift; print "Is your animal a"; print "n" if $animal =~ /^[aeiou]/; print " $animal?\n"; my $answer = <STDIN>; chomp $answer; return 1 if $answer =~ /y/i; return 0; }

    My free initialization:

    my @t = ( [ undef,undef, ['cat','giraffe',"Is your animal larger than a breadbox?\n"] ] );

    And my long-winded (281) solution:

    sub r{my$t=shift;my$x=a($t->[2][2]);$t->[$x]?r($t->[$x]):return $t->[2 +][$x]}sub n{my$t=shift;for(0,1){if($t->[2][$_]eq$b&&!$t->[$_]){$t->[$_]=[undef,u +ndef,[$b,$ a,$q]];return 1}last if$t->[$_]&&n($t->[$_])}}while(1){$b=r($t[0]);if( +!g($b)){$a =t();$q=i($b,$a);n($t[0])}last if!w()}
Re: (Golf) The Animal Game
by Anonymous Monk on Jan 23, 2002 at 22:56 UTC
    I still can' t figure out what kind of sparrow is bigger than a breadbox. Either I have large loaves of bread around here, or very small sparrows.
Re: (Golf) The Animal Game
by particle (Vicar) on Jan 24, 2002 at 03:29 UTC
    i'm with redsquirrel; it's my second golf outing. i'm in with 183. obviously i'm not on the pro tour.

    here's the full code:

    #!/usr/local/bin/perl -w use strict; $|=1; # www.PerlMonks.org 140734|(Golf) The Animal Game # ask the question passed, return true or false sub a($) { my ($qu, $ans) = (shift); while(!$ans) { print "\n$qu?\n"; chomp ($ans = <STDIN>) } $ans =~ m/y/io ? 1 : 0; }; # ask if animal is passed value, return true or false sub g($) { my ($ani, $ans) = (shift); while(!$ans) { print "\nis animal $ani?\n"; chomp ($ans = <STDIN>) + } $ans =~ m/^y/io ? 1 : 0; }; # ask what animal, return user input sub t() { my $ans; while(!$ans) { print "\nwhat animal?\n"; chomp ($ans = <STDIN>) } $ans; }; # get question to identify animal: # true for new, false for old; return question sub i($$) { my ($old, $new, $qu) = (shift, shift); while(!$qu) { print "\nenter a question false for $old but true for $new:\n" +; chomp ($qu = <STDIN>); } $qu; }; # ask to continue, return true or false sub w() { a('play') ? 1 : exit 0 }; # question/answer data structure: hash of arrays my %q = ( "larger than a breadbox" => ['cat', 'giraffe'], ); no strict; while(w){($k,$v)=each%q;$k||redo;$u=$$v[a($k)];next if(g($u));while(($ +l,$x)=each%q){next unless$$x[0] eq $u;a($l)?$y=$$x[1]:goto N;goto E i +f(g($y))}N:$b=i($u,$c=t);$q{$b}=[$u,$c];E:}
    i have a commented version, with slightly better variable names...

    no strict; { while(w){ # select a question ($k,$v)=each%q; # try again if no more questions (end of hash) $k||redo; # ask question, get proper animal from question hash $t2=$$v[a($k)]; # guess animal, end loop if found answer next if(g($t2)); # lookup keys with value[0] matching $t2 while(($k2,$v2)=each%q){ next unless$$v2[0] eq $t2; # if key exists, ask question # if answer negative, ask new animal a($k2)?$t5=$$v2[1]:goto NEW; goto END if(g($t5)); } # else, ask new animal NEW: # ask new animal $t4=i($t2,$t3=t); # add to question hash $q{$t4}=[$t2,$t3]; END: } }
    thanks for the fun.

    ~Particle

Re: (Golf) The Animal Game
by trs80 (Priest) on Jan 28, 2002 at 03:42 UTC
    Here is my entry in the Golf game, but with some additions that may throw me off the tour. I made two data structures @a for animals and @q for questions. I then update these inside of the allowed subs that are/were outlined in the rules. With that said I am at ~111 characters in my do_it sub.
    my @q = ( 'Is your animal larger then a bread box', 'Is your animal taller then a car' ); my @a = ( 'dog' ); sub a { print shift, "?\n"; my $a = <>; return 1 if $a =~ /y/i; } sub g { print 'I think your animal is a ', shift , ", am I right?\n"; my $a = <>; return 1 if $a =~ /y/i; } sub t { my $q = shift; print "What was your animal?\n"; my $a = <>; chomp $a; push @a , $a; return $a; } sub i { my ($u,$g) = @_; print "What is a question that is true for $u, but false for $g?\n +"; my $answer = <STDIN>; chomp $answer; push @q , $answer; return $answer; } sub w { print "Do you want to conitue?\n"; my $a = <>; if ($a =~ /n/i) { die "Thanks for playing\n"; }; do_it(); } sub do_it{ for$s(@a){$g=$s;for$q(@q){if(a($q)){$g=$r{$q}||$s}} if(g($g)){w()}else{$t=t();$i=i($t,$g);$r{$i}=$t;do_it()}}} &do_it(); 1;

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (6)
As of 2014-09-15 02:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (145 votes), past polls