Rosetta Code is being used as source material in a research project! Preview the paper and leave comments. --Michael Mol (talk) 12:03, 23 September 2014 (UTC)

Go Fish/Perl 6

From Rosetta Code
Jump to: navigation, search
Go Fish/Perl 6 is part of Go Fish. You may find other members of Go Fish at Category:Go Fish.
Works with: Rakudo version #23 "Lisbon"
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 {
# The computer player has an instance of this class for each pip.
# Each instance tracks whether the computer thinks the user has at
# 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 }
Personal tools
Namespaces

Variants
Actions
Community
Explore
Misc
Toolbox