Go Fish/Raku: Difference between revisions

From Rosetta Code
Content added Content deleted
m (remove unneeded parens and 'do')
 
(4 intermediate revisions by 2 users not shown)
Line 1: Line 1:
{{collection|Go Fish}}
{{collection|Go Fish}}
=={{example|task=Go Fish|language=Raku}}==


{{works with|Rakudo|#23 "Lisbon"}}
{{works with|Rakudo|2019.03.1}}


<lang perl6>constant BOOKSIZE = 4;
<syntaxhighlight lang="raku" line>constant BOOKSIZE = 4;
constant HANDSIZE = 9;
constant HANDSIZE = 9;
constant Str @pips = <two three four five six seven eight nine ten jack queen king ace>;
constant @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
# The elements of @pips are only names. Pips are represented internally
# as indices of this array.
# as indices of this array.
constant Str @piparticles = <a a a a a a an a a a a a an>;
constant @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 @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 @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>;
constant $foe_nominative_pronoun = pick 1, <he she it e xe>;


Line 21: Line 22:
sub find ($x, *@a) {
sub find ($x, *@a) {
for @a.kv -> $k, $v {
for @a.kv -> $k, $v {
$v eqv $x and return $k;
$v eq $x and return $k;
}
}
fail 'Not found';
fail 'Not found';
Line 27: Line 28:


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


Line 43: Line 44:
loop {
loop {
print 'For what do you ask? (', join(', ', @shortpips[@choices]), '): ';
print 'For what do you ask? (', join(', ', @shortpips[@choices]), '): ';
my $in = substr uc($*IN.get or next), 0, 1;
my $in = substr ($*IN.get.uc or next), 0, 1;

my $pip = find $in, @shortpips;
my $pip = find $in, @shortpips;
if defined $pip {
if defined $pip {
Line 75: Line 77:


class Player {
class Player {
has Int @.h;
has @.h;
# @h[$n] is number of cards of pip $n in this player's hand.
# @h[$n] is number of cards of pip $n in this player's hand.
has $.deck;
has $.deck;
Line 83: Line 85:
has Knowledge @.know;
has Knowledge @.know;


method new ($cpu, @deck is rw) {
method new ( $cpu, @deck ) {
my Int @h = 0 xx @pips;
my @h = 0 xx @pips;
++@h[$_] for @deck[^HANDSIZE];
++@h[$_] for @deck[^HANDSIZE];
@deck = @deck[HANDSIZE ..^ @deck];
@deck = @deck[HANDSIZE ..^ @deck];
Player.bless(*,
Player.bless(
h => @h, cpu => $cpu,
h => @h, cpu => $cpu,
deck => \@deck,
deck => @deck,
know => ($cpu ?? map { Knowledge.new() }, @pips !! ())
know => ($cpu ?? map { Knowledge.new() }, @pips !! ())
);
);
Line 111: Line 113:
}
}


method getcards (Int $quantity, Int $pip) {
method getcards (Int $quantity, $pip) {
@!h[$pip] += $quantity;
@!h[$pip] += $quantity;
@.h[$pip] == BOOKSIZE or return;
@.h[$pip] == BOOKSIZE or return;
Line 123: Line 125:
}
}


method losecards (Int $pip) {
method losecards ($pip) {
@.h[$pip] = 0;
@.h[$pip] = 0;
while none @.h and $.deck.elems {
while none @.h and $.deck.elems {
Line 133: Line 135:
}
}


method learn (Int $pip, Maybe $m) { @.know[$pip].set($m) }
method learn ($pip, Maybe $m) { @.know[$pip].set($m) }


method notice_draw () { .incr for @.know }
method notice_draw () { .incr for @.know }


method choose_request () returns Int {
method choose_request () {
#self.showhand;
#self.showhand;
#say 'Know: ', join ', ', map
#say 'Know: ', join ', ', map
Line 143: Line 145:
# @.know;
# @.know;
my @ps = map { .key }, grep { .value }, pairs @.h;
my @ps = map { .key }, grep { .value }, pairs @.h;

return pick 1, maxes { @.h[$^p] }, do
return ( maxes { @.h[$^p] },
# Most of all we should ask for cards we know the
# Most of all we should ask for cards we know the
# user has.
# user has.
grep { @.know[$^p].maybe ~~ Yes }, @ps or
@ps.grep({ @.know[$^p].maybe ~~ Yes }).flat ||
# Then try asking for one we haven't requested
# Then try asking for one we haven't requested
# before.
# before.
grep { @.know[$^p].maybe ~~ Dunno }, @ps or
@ps.grep({ @.know[$^p].maybe ~~ Dunno }).flat ||
# Then try asking for one we least recently
# Then try asking for one we least recently
# asked about.
# asked about.
maxes { @.know[$^p].n }, @ps;
maxes { @.know[$^p].n }, @ps ).roll;
}
}
}
}
Line 158: Line 161:
sub play () {
sub play () {


my Int @deck;
my @deck;
# Shuffle the deck until the first two hands contain no books.
# Shuffle the deck until the first two hands contain no books.
# (If BOOKSIZE is greater than 2 and HANDSIZE is reasonably
# (If BOOKSIZE is greater than 2 and HANDSIZE is reasonably
# small, this'll probably take only one shuffle.)
# small, this'll probably take only one shuffle.)
repeat { @deck = pick *, ^@pips xx BOOKSIZE }
repeat { @deck = (flat ^@pips xx BOOKSIZE).pick(*) }
until none(map { count $^x, @deck[^HANDSIZE] }, ^@pips) >= BOOKSIZE and
until none(map { count $^x, @deck[^HANDSIZE] }, ^@pips) >= BOOKSIZE and
none(map { count $^x, @deck[HANDSIZE ..^ 2*HANDSIZE] }, ^@pips) >= BOOKSIZE;
none(map { count $^x, @deck[HANDSIZE ..^ 2*HANDSIZE] }, ^@pips) >= BOOKSIZE;
Line 168: Line 171:
my Player $user .= new(False, @deck);
my Player $user .= new(False, @deck);
my Player $foe .= new(True, @deck);
my Player $foe .= new(True, @deck);

while any |$user.h or any |$foe.h {
while any |$user.h or any |$foe.h {

# The user goes first.
# The user goes first.
while any |$user.h {
while any |$user.h {
Line 223: Line 226:
}
}


sub MAIN () { play }</lang>
sub MAIN () { play }</syntaxhighlight>

Latest revision as of 21:56, 28 August 2022

Go Fish/Raku is part of Go Fish. You may find other members of Go Fish at Category:Go Fish.

Raku

Works with: Rakudo version 2019.03.1
constant BOOKSIZE = 4;
constant HANDSIZE = 9;
constant @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 @piparticles = <a a a a a a an a a a a a an>;
constant @ppips = <deuces threes fours fives sixes sevens eights nines tens jacks queens kings aces>;
constant @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 eq $x and return $k;
    }
    fail 'Not found';
}

sub maxes (&f, *@a) {
    my $x = max map &f, @a;
    return @a.grep: { f($^e) eqv $x };
}

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 ($*IN.get.uc 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 @.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 ) {
        my @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, $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 ($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 ($pip, Maybe $m) { @.know[$pip].set($m) }

    method notice_draw () { .incr for @.know }

    method choose_request ()  {
        #self.showhand;
        #say 'Know: ', join ', ', map
        #   { .maybe ~~ Yes ?? 'Yes' !! .maybe ~~ Dunno ?? 'Dunno' !! .n },
        #   @.know;
        my @ps = map { .key }, grep { .value }, pairs @.h;

        return ( maxes { @.h[$^p] },
            # Most of all we should ask for cards we know the
            # user has.
            @ps.grep({ @.know[$^p].maybe ~~ Yes }).flat ||
            # Then try asking for one we haven't requested
            # before.
            @ps.grep({ @.know[$^p].maybe ~~ Dunno }).flat ||
            # Then try asking for one we least recently
            # asked about.
            maxes { @.know[$^p].n }, @ps ).roll;
    }
}

sub play () {

    my @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 = (flat ^@pips xx BOOKSIZE).pick(*) }
    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 }