Go Fish: Difference between revisions

From Rosetta Code
Content added Content deleted
(→‎Tcl: Added implementation)
m (→‎{{header|Tcl}}: Added a few notes)
Line 545: Line 545:
puts "The computer won!"
puts "The computer won!"
}</lang>
}</lang>
===Notes on the Mechanical Player===
The computer player (implemented as a subclass of the generic player class) has four states for ''each'' rank (aside from basic overall state like what cards it is holding, which every player has to have):
;unknown
: Don't know if the opponent has any cards in that rank.
;none
: Opponent has no cards there; I took them away.
;some
: Opponent has cards there; they tried to get them off me and haven't booked them yet.
;booked
: Someone has booked the rank.
It prefers to take cards away from the opponent if it can and tries hard to avoid moves it knows will fail. It never makes illegal moves. It does not bother to look at the number of booked suits, though as that is global state it ''could''. No player or the deck has any method to reveal (within the game world, not the display) what hand of cards it actually has.

Revision as of 02:03, 30 November 2009

Task
Go Fish
You are encouraged to solve this task according to the task description, using any language you may know.

Write a program to let the user play Go Fish against a computer opponent. Use the following rules:

  • Each player is dealt nine cards to start with.
  • On their turn, a player asks their opponent for a given rank (like threes or kings). A player must already have at least one card of a given rank to ask for more.
    • If the opponent has any cards of the named rank, they must hand over all such cards, and the requester can ask again.
    • If the opponent has no cards of the named rank, the requester draws a card and ends their turn.
  • A book is a collection of every card of a given rank. Whenever a player completes a book, they may remove it from their hand.
  • If at any time a player's hand is empty, they may immediately draw a new card, so long as any new cards remain in the deck.
  • The game ends when every book is complete. The player with more books wins.

The game's AI need not be terribly smart, but it should use at least some strategy. That is, it shouldn't choose legal moves entirely at random.

You may want to use code from Playing Cards.

Perl 6

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 do $.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>

Tcl

Works with: Tcl version 8.6

<lang tcl>package require Tcl 8.6

  1. How to sort ranks

proc suitorder {a b} {

   set a1 [lsearch -exact {2 3 4 5 6 7 8 9 10 J Q K A} $a]
   set b1 [lsearch -exact {2 3 4 5 6 7 8 9 10 J Q K A} $b]
   expr {$a1 - $b1}

}

  1. Class to manage the deck of cards

oo::class create Deck {

   variable deck
   constructor Template:Packs 1 {

set deck [list] for {set p 0} {$p < $packs} {incr p} { foreach suit {C D H S} { foreach pip {2 3 4 5 6 7 8 9 10 J Q K A} { lappend deck [list $pip $suit] } } }

   }
   method shuffle {} {

# Shuffle in-place for {set i [llength $deck]} {[incr i -1] > 0} {} { set n [expr {int($i * rand())}] set card [lindex $deck $n] lset deck $n [lindex $deck $i] lset deck $i $card }

   }
   method deal {num} {

incr num -1 set hand [lrange $deck 0 $num] set deck [lreplace $deck 0 $num] return $hand

   }
   method renderCard {card} {

string map {C \u2663 D \u2662 H \u2661 S \u2660 " " {}} $card

   }
   method print {hand} {

set prev {} foreach card [my sortHand $hand] { if {[lindex $card 0] ne $prev} { if {$prev ne ""} {puts ""} puts -nonewline \t[my renderCard $card] } else { puts -nonewline " [my renderCard $card]" } set prev [lindex $card 0] } puts ""

   }
   method sortHand {hand} {

lsort -index 0 -command suitorder [lsort -index 1 $hand]

   }
   proc empty {} {

return [expr {[llength $deck] == 0}]

   }

}

  1. "Abstract" class of all players; implements core game mechanics
  2. from a player's perspective

oo::class create GoFishPlayer {

   variable theDeck hand opponent
   constructor {deck otherPlayer} {

set theDeck $deck set hand [$deck deal 9] set opponent $otherPlayer

   }
   method ask {rank} {

set response {} set new {} foreach card $hand { if {[lindex $card 0] eq $rank} { lappend response $card } else { lappend new $card } } set hand [expr {[llength $new] ? $new : [$theDeck deal 1]}] return $response

   }
   method AskFor {rank} {

set withoutOne 1 foreach card $hand { if {[lindex $card 0] eq $rank} { set withoutOne 0 break } } if {$withoutOne} { error "do not have any $rank cards" }

set response [$opponent ask $rank] if {[llength $response]} { lappend hand {*}$response } else { my GoFish lappend hand {*}[$theDeck deal 1] }

return [llength $response]

   }
   method MakeBooks {} {

foreach rank {2 3 4 5 6 7 8 9 10 J Q K A} { set n {} set idx -1 foreach card $hand { incr idx if {[lindex $card 0] eq $rank} { lappend n $idx } } if {[llength $n] == 4} { announceBook $rank [self] foreach idx [lreverse $n] { set hand [lreplace $hand $idx $idx] } } } if {[llength $hand] == 0} { set hand [$theDeck deal 1] }

   }
   method makeAPlay {} {

set msg "" while {$::books(total) < 13} { set rank [my SelectRank $msg] try { if {![my AskFor $rank]} { my YieldToOpponent break } } on error msg { # Back round the loop with an error message } on ok {} { my MakeBooks set msg "" } } my MakeBooks

   }
   method GoFish {} {

# Do nothing with this notification by default

   }
   method madeBook {rank who} {

# Do nothing with this notification by default

   }
   method YieldToOpponent {} {

# Do nothing with this notification by default

   }
   method SelectRank {msg} {

error "not implemented"

   }

}

  1. A player that works by communicating with a human

oo::class create HumanPlayer {

   superclass GoFishPlayer
   variable theDeck hand opponent
   method madeBook {rank who} {

if {$who eq [self]} {set who "You"} puts "$who made a book of $rank"

   }
   method YieldToOpponent {} {

puts "Now your opponent's turn"

   }
   method AskFor {rank} {

set count [next $rank] puts "You asked for ${rank}s and received $count cards" if {$count > 0} { puts "You may ask again!" } return $count

   }
   method ask {rank} {

set cards [next $rank] puts "[namespace tail $opponent] asked for $rank cards, and got [llength $cards] of them" return $cards

   }
   method GoFish {} {

puts "You were told to \"Go Fish!\""

   }
   method SelectRank {msg} {

if {$msg ne ""} { puts "ERROR: $msg" } set I [namespace tail [self]] puts "You are ${I}: Your cards are:" $theDeck print $hand while 1 { puts -nonewline "What rank to ask for? " flush stdout set rank [string toupper [gets stdin]] if {$rank in {2 3 4 5 6 7 8 9 10 J Q K A}} { return $rank } puts "Rank must be 2, 3, 4, 5, 6, 7, 8, 9, 10, J, Q, K, or A" puts "You must also have at least one of them already" }

   }

}

  1. A computer player that tracks what it's opponent must have

oo::class create ThinkingPlayer {

   superclass GoFishPlayer
   variable state hand
   constructor args {

next {*}$args foreach rank {2 3 4 5 6 7 8 9 10 J Q K A} { set state($rank) unknown }

   }
   method madeBook {rank who} {

set state($rank) booked

   }
   method AskFor {rank} {

set count [next $rank] set state($rank) none if {$count == 0} { foreach rank {2 3 4 5 6 7 8 9 10 J Q K A} { if {$state($rank) eq "none"} { set state($rank) unknown } } } return $count

   }
   method ask {rank} {

set cards [next $rank] set state($rank) some return $cards

   }
   method GoFish {} {

puts "You told your opponent to \"Go Fish!\""

   }
   method SelectRank {ignored} {

# If we know they have the cards and we can grab them, do so! # It's a safe move since we get to go again. foreach {rank s} [array get state] { if {$s eq "some" && [lsearch -exact -index 0 $hand $rank] >= 0} { return $rank } } # Only unsafe moves remain; pick a random non-stupid one foreach c $hand { set rank [lindex $c 0] if {$state($rank) ne "none"} { set r([lindex $c 0]) . } } if {[array size r]} { return [lindex [array names r] [expr {int([array size r]*rand())}]] } # No good choices; oh well... return [lindex $hand [expr {int([llength $hand]*rand())}] 0]

   }

}

  1. How announcements of a book being made are done

proc announceBook {rank who} {

   global books
   A madeBook $rank $who
   B madeBook $rank $who
   lappend books($who) $rank
   incr books(total)

}

  1. Stitch things together to make a whole game.

Deck create deck deck shuffle array set books {total 0 ::A {} ::B {}} HumanPlayer create A deck B ThinkingPlayer create B deck A while {$books(total) < 13} {

   A makeAPlay
   if {$books(total) < 13} {

B makeAPlay

   }

} puts "You have [llength $books(::A)]: [lsort -command suitorder $books(::A)]" puts "The computer has [llength $books(::B)]: [lsort -command suitorder $books(::B)]" if {[llength $books(::A)] > [llength $books(::B)]} {

   puts "You win!"

} else {

   puts "The computer won!"

}</lang>

Notes on the Mechanical Player

The computer player (implemented as a subclass of the generic player class) has four states for each rank (aside from basic overall state like what cards it is holding, which every player has to have):

unknown
Don't know if the opponent has any cards in that rank.
none
Opponent has no cards there; I took them away.
some
Opponent has cards there; they tried to get them off me and haven't booked them yet.
booked
Someone has booked the rank.

It prefers to take cards away from the opponent if it can and tries hard to avoid moves it knows will fail. It never makes illegal moves. It does not bother to look at the number of booked suits, though as that is global state it could. No player or the deck has any method to reveal (within the game world, not the display) what hand of cards it actually has.