2008 Winter Scripting Games

Jan Dubois' Solution to Advanced Perl Event 10: Blackjack!

Event 1 Solution

About the Author

Jan Dubois is the tech lead for all Perl technologies at ActiveState. He is a member of the core Perl5-Porters group that maintains the Perl language implementation. Jan wrote the Win32::OLE Automation support for Perl while he was still working in the financial industry. He has a Masters degree in Physics from the University of Hamburg, Germany. Jan now lives in Vancouver in Beautiful British Columbia, home of the 2010 Winter Olympics.

*

Blackjack!

Welcome to Event 10 in the 2008 Winter Scripting Games. In case we didn’t win any of the prizes in the Games themselves, we can at least try to make some money in the casino instead.

The challenge

We need to write a script that deals and plays a single hand of Blackjack.

How we are going to solve it

Each card in Blackjack has both a name, and a numerical score that is used to calculate the value of your hand. Wouldn’t it be nice if we could implement cards as objects that in string context evaluate to their name, but in numeric context evaluate to their values? That way we could calculate the value of a hand with sum(@hand), or print out the hand with “say for @hand”. It turns out that we can do this with overloading:

use 5.010;
use strict;
use warnings;

my @ranks = (2..10, qw(Jack Queen King Ace));
my %value; @value{@ranks} = (2..10, (10)x3, 11);

########################################################################

package Card;

use overload '0+' => sub { shift->{Value} },
             '""' => sub { shift->{Name} };
sub new {
    my $self = {Name => "$_[1] of $_[2]", Value => $value{$_[1]}};
    bless $self => "Card";
}

########################################################################

package main;

use ActiveState::Prompt qw(prompt);
use List::Util qw(shuffle sum);

my @deck;
foreach my $suit (qw(Spades Hearts Diamonds Clubs)) {
    push @deck, map Card->new($_, $suit), @ranks;
}
@deck = shuffle @deck;

my @player = splice @deck, 0, 2;
my @dealer = splice @deck, 0, 2;

say for "Your cards:", @player, "";
say for "Dealer's cards:", $dealer[0], "";

while (sum(@player) < 21) {
    my $action = prompt("Stay (s) or Hit (h)? ",
                        must_match => qr/^(s|h)$/i);
    say "";
    last if $action =~ /^s/i;

    push @player, shift @deck;
    say for "Your cards:", @player, "";

    if (sum(@player) > 21) {
        say "Over 21.  Sorry, you lose.";
        exit;
    }
}
if (sum(@player) == 21) {
    say "Congratulations!  You win!";
    exit;
}

push(@dealer, shift @deck) while sum(@dealer) < sum(@player);

say for "You have @{[ sum(@player) ]}.\n", @player, "";
say for "Dealer's cards:", @dealer, "";

if (sum(@dealer) <= 21 && sum(@dealer) >= sum(@player)) {
    say "The dealer has @{[ sum(@dealer) ]}.  Sorry, you lose!";
}
else {
    say "Congratulations!  You win!";
}

We start off by defining the different ranks of cards, and their corresponding numerical values:

my @ranks = (2..10, qw(Jack Queen King Ace));
my %value; @value{@ranks} = (2..10, (10)x3, 11);

In my commentary to Event 7 (Play Ball!) I explained array slices. The expression @values{@ranks} is very similar: it is a hash slice. The assignment to the hash slice has the same effect as:

%value = (
    2     => 2,
    3     => 3,
    # ...
    10    => 10,
    Jack  => 10,
    Queen => 10,
    King  => 10,
    Ace   => 11,
);

Now we are ready to define a “Card” class:

########################################################################

package Card;

use overload '0+' => sub { shift->{Value} },
             '""' => sub { shift->{Name} };
sub new {
    my $self = {Name => "$_[1] of $_[2]", Value => $value{$_[1]}};
    bless $self => "Card";
}

########################################################################

An object of the “Card” class is implemented as a hash reference. The Name field holds the face name (e.g. “Ace of Spade”) of the card, and the Value field the numerical value (looked up in the constructor in %value by e.g. $value{Ace}).

The “Card” class uses overloading for both numification (turning the object into a number, represented by the 0+ operation) and stringification (turning the object into a string, represented by the "" operation). So if $card represents the ace of spades, then 0+$card will be 11, and "$card" will be "Ace of Spades".

package main;

use ActiveState::Prompt qw(prompt);
use List::Util qw(shuffle sum);

my @deck;
foreach my $suit (qw(Spades Hearts Diamonds Clubs)) {
    push @deck, map Card->new($_, $suit), @ranks;
}
@deck = shuffle @deck;

We create a full deck by adding one card of each rank for all 4 suits. We then need to shuffle the deck to make sure each game is different.

my @player = splice @deck, 0, 2;
my @dealer = splice @deck, 0, 2;

say for "Your cards:", @player, "";
say for "Dealer's cards:", $dealer[0], "";

Both the player and the dealer get 2 cards initially. The splice() function “splice @deck, 0, 2” is removing the first 2 cards from the deck. It has the same effect as “(shift(@deck), shift(@deck))”.

We print both the player’s full hand and the dealer’s first card. By using the card objects in string context they will automatically print their face names. Remember that the say() function automatically appends a newline character to its argument. The trailing empty string will therefore generate a blank line after each hand.

while (sum(@player) < 21) {
    my $action = prompt("Stay (s) or Hit (h)? ",
                        must_match => qr/^(s|h)$/i);
    say "";
    last if $action =~ /^s/i;

    push @player, shift @deck;
    say for "Your cards:", @player, "";

    if (sum(@player) > 21) {
        say "Over 21.  Sorry, you lose.";
        exit;
    }
}
if (sum(@player) == 21) {
    say "Congratulations!  You win!";
    exit;
}

Now it is time to play. As long as the player doesn’t have 21 points we allow her to draw another card with:

push @player, shift @deck;

If the value of the player’s hand exceeds 21 she loses. If it is exactly 21, she wins. Otherwise it is now the dealer’s turn:

push(@dealer, shift @deck) while sum(@dealer) < sum(@player);

say for "You have @{[ sum(@player) ]}.\n", @player, "";
say for "Dealer's cards:", @dealer, "";

if (sum(@dealer) <= 21 && sum(@dealer) >= sum(@player)) {
    say "The dealer has @{[ sum(@dealer) ]}.  Sorry, you lose!";
}
else {
    say "Congratulations!  You win!";
}

The dealer continues to draw cards until his score is greater than or equal to the player’s. Then we display the player’s final score, the dealer’s hand, and declare the winner.

Aces are special

I really liked how the overloading of the Card objects made the script very easy to read, but felt a bit disappointed that this wouldn’t work so well if we wanted to let aces have a value of either 1 or 11. But then I thought: Why can’t we use overloading too to let the Card objects decide how their values should be added:

########################################################################

package Card;

use overload '0+' => sub { shift->{Value} },
             '""' => sub { shift->{Name} },
             '+'  => \&add,
             fallback => 1;

sub new {
    my $self = {Name => "$_[1] of $_[2]", Value => $value{$_[1]}};
    bless $self => "Card";
}

sub add {
    my($left,$right) = @_;
    return $right + 1 if $left == 11 && $right > 10;
    return $right + $left->{Value};
}

########################################################################

This replacement Card class adds overloading of the addition operator. If a Card object is added to something else (either a number, or another card object), then it will first run a special check: In case the object represents an ace (value is 11), and the other value is already greater than 10, then the ace should only be worth 1 point. Otherwise addition works normally.

The script implementing the game itself should not need to change at all, but I did have one suspicion: Since List::Util::sum() is implemented in C code, I wondered if it would correctly use the overloaded addition operator. A quick test confirmed that it does not:

say sum(Card->new("Ace", "Blue"), Card->new("Ace", "Red"));

This still prints 22 even with the new Card class. I was briefly tempted to just go in and fix the List::Util module, but I’m already overdue in handing this commentary over to The Scripting Guys, so now may not be the best time to engage in yak-shaving. It is much quicker to define our own little sum() function and be on our merry way. The List::Util module still provides some support for us in the form of the reduce() function:

use List::Util qw(shuffle reduce);
sub sum { 0 + reduce { $a + $b } @_ }

This definition now implements the addition at the Perl level, thereby using the correct overloaded addition operator. I also added “0 +” at the beginning of the function, which on first thought looks quite useless.

But it actually does make a difference when sum() is being called with just a single Card object: Adding 0 to it forces the whole expression into numeric context and makes sure we return the value of the card. Otherwise the function would just return the Card object itself, and if the return value was interpolated into a string, it would interpolate the name of the card and not its value.

And there is one more issue I initially overlooked in my haste to finish this commentary: The new addition rule will only work correctly if we first tally up all other cards before adding in the aces. Otherwise the overloaded addition operator would still decide to add an ace and a 3 as 14, even though the next card in the hand might be a king. The easiest way to deal with this is to sort the cards in our sum() function:

sub sum { 0 + reduce { $a + $b } sort { $a <=> $b } @_ }

With this additional modification to the main script we now have a Blackjack program that also deals with aces properly.

This concludes my commentaries on the 2008 Winter Scripting Games. I hope you enjoyed reading them and maybe even learned about some idiom or technique that you weren’t familiar with before.

If you still have any questions about how the samples scripts work, please let me know at jand@activestate.com.


Top of pageTop of page