Day 7 introduces a card game with hand values loosely based on poker: 5 of a kind, 4 of a kind, full house, 3 of a kind, 2 pair, 2 of a kind, nuffin’. A tie on the type of hand is resolved by the rank of the cards in order dealt (not in order of rank), with ordering AKQJT98765432. Given these rules, rank your hands, then multiply the ordinal value of the resulting list by a unique coefficient for that hand.
32T3K 765
T55J5 684
KK677 28
KTJJT 220
QQQJA 483
This sort is going to require a fair number of comparisons, each involving rank of types of hands and each potentially involving rank of cards. These comparisons are computationally-intensive enough that I’m leery about executing them during each comparison of the sort, so I calculated and cached them up front.
sub cardval {
my $c = shift;
my $cardlist = "AKQJT98765432";
return length($cardlist) - index($cardlist, $c);
}
The card’s rank can be represented as its (here 0-based) ordinal position in an ascending-order list of ranks. I had a descending-order list and subtracted the position in the string from the length of the string; but doing this again, I’d use Perl’s reverse operator to reverse the string.
$cardlist is constant and it would be more efficient to declare it once outside the subroutine than each time the subroutine is called. I’d love to define it immediately before the subroutine definition, but that code won’t have been executed yet when the subroutine is called. I could have defined it at the top of the program but I don’t like separating it so far from its sole use in the code. I don’t know whether Perl has developed a better way to handle this situation.
while (<>) {
my ($cards, $bid) = /(\w+)/g;
my @cards = split(//, $cards);
my @values = map { cardval($_) } @cards;
Reading in the hands, I grab the two chunks of “word” characters, split the card string into a list, and use Perl’s map operator to translate the list of cards into a list of their values/ranks.
my %tally;
++ $tally{$_} foreach @cards;
my @ofakind = sort { $b <=> $a } values %tally;
my $type = $ofakind[0] == 5 ? 6 # 5 of kind -- 6
: $ofakind[0] == 4 ? 5 # 4 of kind -- 5
: $ofakind[0] == 3 && $ofakind[1] == 2 ? 4 # full house -- 4
: $ofakind[0] == 3 ? 3 # 3 of kind -- 3
: $ofakind[0] == 2 && $ofakind[1] == 2 ? 2 # 2 pair -- 2
: $ofakind[0] == 2 ? 1 # 1 pair -- 1
: 0; # nothing -- 0
Then I count how many of each rank of card I have in this hand and sort that list of counts into descending order. From the number of cards that I have the most of, and sometimes the second-most of, I can determine the type of the hand; and I assign a numerical score to each type.
When we have three or two of the most-frequent card, there are two possible types of hands depending on whether the remaining cards contain a pair. I could have written those four cases as two outer ternaries each with an inner ternary; but for ease of reading (and I assure you my code is nicely tabbed and aligned when you’re not looking at it in WordPress), I didn’t mind the expense of rechecking the count of the most-frequent card in order to write the code for every type of hand the same way.
push(@hands, { CARDS => [ @cards ], BID => $bid, VALUES => [ @values ],
TYPE => $type });
}
I’ve now precalculated everything that I wanted to cache before the sort and I hang onto it in a list of references to anonymous hashes, which function like a C struct, with the hash key being the struct member.
I don’t actually need the cards any more, but cached them in case I wanted them later for debugging.
my @sortedhands = sort { ${$a}{TYPE} <=> ${$b}{TYPE}
|| ${$a}{VALUES}[0] <=> ${$b}{VALUES}[0]
|| ${$a}{VALUES}[1] <=> ${$b}{VALUES}[1]
|| ${$a}{VALUES}[2] <=> ${$b}{VALUES}[2]
|| ${$a}{VALUES}[3] <=> ${$b}{VALUES}[3]
|| ${$a}{VALUES}[4] <=> ${$b}{VALUES}[4]
} @hands;
With all that cached, the sort itself is easy. Note that Perl uses the special variables $a and $b for the comparands in each sort comparison; and since we’re sorting a list of hash references, $a and $b do need to be dereferenced.
my $sum;
$sum += ($_ + 1) * $sortedhands[$_]{BID} foreach (0 .. scalar @sortedhands - 1);
print "sum is $sum\n";
With the hands sorted, calculating the requested sum is easy.
Full Program
#!/usr/bin/perl
use warnings;
use strict;
sub cardval;
my @hands;
while (<>) {
my ($cards, $bid) = /(\w+)/g;
my @cards = split(//, $cards);
my @values = map { cardval($_) } @cards;
my %tally;
++ $tally{$_} foreach @cards;
my @ofakind = sort { $b <=> $a } values %tally;
my $type = $ofakind[0] == 5 ? 6 # 5 of kind -- 6
: $ofakind[0] == 4 ? 5 # 4 of kind -- 5
: $ofakind[0] == 3 && $ofakind[1] == 2 ? 4 # full house -- 4
: $ofakind[0] == 3 ? 3 # 3 of kind -- 3
: $ofakind[0] == 2 && $ofakind[1] == 2 ? 2 # 2 pair -- 2
: $ofakind[0] == 2 ? 1 # 1 pair -- 1
: 0; # nothing -- 0
push(@hands, { CARDS => [ @cards ], BID => $bid, VALUES => [ @values ],
TYPE => $type });
}
my @sortedhands = sort { ${$a}{TYPE} <=> ${$b}{TYPE}
|| ${$a}{VALUES}[0] <=> ${$b}{VALUES}[0]
|| ${$a}{VALUES}[1] <=> ${$b}{VALUES}[1]
|| ${$a}{VALUES}[2] <=> ${$b}{VALUES}[2]
|| ${$a}{VALUES}[3] <=> ${$b}{VALUES}[3]
|| ${$a}{VALUES}[4] <=> ${$b}{VALUES}[4]
} @hands;
my $sum;
$sum += ($_ + 1) * $sortedhands[$_]{BID} foreach (0 .. scalar @sortedhands - 1);
print "sum is $sum\n";
sub cardval {
my $c = shift;
my $cardlist = "AKQJT98765432";
return length($cardlist) - index($cardlist, $c);
}