Go Fish/Raku

From Rosetta Code
Revision as of 07:11, 17 September 2010 by rosettacode>TimToady (remove unneeded parens and 'do')
Go Fish/Raku is part of Go Fish. You may find other members of Go Fish at Category:Go Fish.
Works with: Rakudo version #23 "Lisbon"

<lang perl6>constant BOOKSIZE = 4; constant HANDSIZE = 9; constant Str @pips = <two three four five six seven eight nine ten jack queen king ace>;

 # The elements of @pips are only names. Pips are represented internally
 # as indices of this array.

constant Str @piparticles = <a a a a a a an a a a a a an>; constant Str @ppips = <deuces threes fours fives sixes sevens eights nines tens jacks queens kings aces>; constant Str @shortpips = <2 3 4 5 6 7 8 9 T J Q K A>; constant $foe_nominative_pronoun = pick 1, <he she it e xe>;

sub count ($x, *@a) {

   my $n = 0;
   $_ eqv $x and ++$n for @a;
   return $n;

}

sub find ($x, *@a) {

   for @a.kv -> $k, $v {
       $v eqv $x and return $k;
   }
   fail 'Not found';

}

sub maxes (&f, *@a) {

   my $x = [max] map &f, @a;
   return grep { f($^e) eqv $x }, @a;

}

sub ncard ($n, $pip) {

   $n > 1 ?? "$n {@ppips[$pip]}" !! "{@piparticles[$pip]} {@pips[$pip]}"

}

sub readpip (@user_hand) {

   my @choices = grep { @user_hand[$^p] }, ^@pips;
   if @choices == 1 {
       say "You're obliged to ask for { @ppips[@choices[0]] }.";
       return @choices[0];
   }
   loop {
       print 'For what do you ask? (', join(', ', @shortpips[@choices]), '): ';
       my $in = substr uc($*IN.get or next), 0, 1;
       my $pip = find $in, @shortpips;
       if defined $pip {
           @user_hand[$pip] and return $pip;
           say "You don't have any { @ppips[$pip] }.";
       }
       else {
           say 'No such rank.';
       }
   }

}

enum Maybe <No Yes Dunno>;

class Knowledge {

  1. The computer player has an instance of this class for each pip.
  2. Each instance tracks whether the computer thinks the user has at
  3. least one card of the corresponding pip.
   has Maybe $.maybe = Dunno;
     # Yes if the user definitely has this pip, No if they didn't
     # have it the last time we checked, Dunno if we haven't yet
     # checked.
   has Int $.n = 0;
     # If $.maybe is No, $.n counts how many cards the user
     # has drawn since we last checked.
   method set (Maybe $!maybe) { $!n = 0 }
   method incr { $.maybe == No and ++$!n }

}

class Player {

   has Int @.h;
     # @h[$n] is number of cards of pip $n in this player's hand.
   has $.deck;
     # A reference to whatever deck the player's playing with.
   has Int $.books = 0;
   has Bool $.cpu;
   has Knowledge @.know;
   method new ($cpu, @deck is rw) {
       my Int @h = 0 xx @pips;
       ++@h[$_] for @deck[^HANDSIZE];
       @deck = @deck[HANDSIZE ..^ @deck];
       Player.bless(*,
           h => @h, cpu => $cpu,
           deck => \@deck,
           know => ($cpu ?? map { Knowledge.new() }, @pips !! ())
       );
   }
   method showhand {
       say
           ($.cpu ?? 'The dealer has   ' !! 'You have   '),
           join('   ',
               map { join ' ', @shortpips[.key] xx .value },
               grep { .value },
               pairs @.h),
           '.';
   }
   method draw () {
       my $new = shift $.deck;
       $.cpu or print "You got { ncard 1, $new }. ";
       say "({ $.deck.elems or 'No' } card{ $.deck.elems == 1 ??  !! 's' } left.)";
       self.getcards(1, $new);
   }
   method getcards (Int $quantity, Int $pip) {
       @!h[$pip] += $quantity;
       @.h[$pip] == BOOKSIZE or return;
       ++$!books;
       say
           ($.cpu
             ?? "The dealer puts down a book of { @ppips[$pip] }"
             !! "That's a book"),
           " (for a total of $.books book{ $.books == 1 ??  !! 's' }).";
       self.losecards($pip);
   }
   method losecards (Int $pip) {
      @.h[$pip] = 0;
      while none @.h and $.deck.elems {
          say $.cpu
           ?? "The dealer's hand is empty, so $foe_nominative_pronoun draws a new card."
           !! "Your hand's empty, so you draw a new card.";
          self.draw;
      }
   }
   method learn (Int $pip, Maybe $m) { @.know[$pip].set($m) }
   method notice_draw () { .incr for @.know }
   method choose_request () returns Int {
       #self.showhand;
       #say 'Know: ', join ', ', map
       #   { .maybe ~~ Yes ?? 'Yes' !! .maybe ~~ Dunno ?? 'Dunno' !! .n },
       #   @.know;
       my @ps = map { .key }, grep { .value }, pairs @.h;
       return pick 1, maxes { @.h[$^p] }, do
           # Most of all we should ask for cards we know the
           # user has.
           grep { @.know[$^p].maybe ~~ Yes }, @ps or
           # Then try asking for one we haven't requested
           # before.
           grep { @.know[$^p].maybe ~~ Dunno }, @ps or
           # Then try asking for one we least recently
           # asked about.
           maxes { @.know[$^p].n }, @ps;
   }

}

sub play () {

   my Int @deck;
   # Shuffle the deck until the first two hands contain no books.
   # (If BOOKSIZE is greater than 2 and HANDSIZE is reasonably
   # small, this'll probably take only one shuffle.)
   repeat { @deck = pick *, ^@pips xx BOOKSIZE }
   until none(map { count $^x, @deck[^HANDSIZE] }, ^@pips) >= BOOKSIZE and
         none(map { count $^x, @deck[HANDSIZE ..^ 2*HANDSIZE] }, ^@pips) >= BOOKSIZE;
   my Player $user .= new(False, @deck);
   my Player $foe .= new(True, @deck);
   
   while any |$user.h or any |$foe.h {
       
       # The user goes first.
       while any |$user.h {
           say ;
           $user.showhand;
           my $request = readpip $user.h;
           $foe.learn($request, Yes);
           if $foe.h[$request] -> $quantity is copy {
               say 'The dealer reluctantly hands over ',
                   ncard($quantity, $request),
                   '.';
               $foe.losecards($request);
               $user.getcards($quantity, $request);
           }
           else {
               say '"Go fish!"';
               $user.draw;
               $foe.notice_draw;
               last;
           }
       }
       while any |$foe.h {
           my $request = $foe.choose_request;
           say "\n\"Got any ", @ppips[$request], '?"';
           $foe.learn($request, No);
           if $user.h[$request] -> $quantity is copy {
               say '"Thanks!"';
               $foe.getcards($quantity, $request);
               $user.losecards($request);
           }
           else {
               say 'The dealer goes fishing.';
               $foe.draw;
               last;
           }
       }
   }
   say "\nGame over!";
   say 'Your books: ', $user.books;
   say "The dealer's books: ", $foe.books;
   say do
       $user.books > $foe.books
    ?? 'A winner is you!'
    !! $user.books < $foe.books
    ?? 'Alas, you have lost.'
    # A draw is possible if @pips !% 2.
    !! "It's a draw.";

}

sub MAIN () { play }</lang>