Perl Weekly Challenge 291: Poker Hand Rankings
These are some answers to the Week 291, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on October 20, 2024, at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
Task 2: Poker Hand Rankings
A draw poker hand consists of 5 cards, drawn from a pack of 52: no jokers, no wild cards. An ace can rank either high or low.
Write a script to determine the following three things:
1. How many different 5-card hands can be dealt?
2. How many different hands of each of the 10 ranks can be dealt? See here for descriptions of the 10 ranks of Poker hands: https://en.wikipedia.org/wiki/List_of_poker_hands#Hand-ranking_categories
3. Check then the numbers you get in step 2 by adding them together and showing that they're equal to the number you get in step 1.
We need a subroutine (com
) for computing the binomial coefficient formula for: n choose k. The simplest formula is: n! / k! (n - k)!
But this leads to compute very large numbers that we then divide by other very large numbers. For example, 52!
has 68 digits:
52! = 80658175170943878571660636856403766975289505440883277824000000000000. So I prefer to use a formula that considerably simplifies the fraction: n * (n - 1) * ... * (n - k + 1) / k!
.
This ought to be faster, but that's not the point, since it is quite fast anyway; the point is that we avoid the risk of integer overflow during intermediate computations. There is no such risk in Raku, and probably also not in Perl, but there are many languages or programming environments that can't handle integers with 68 digits.
Poker Hand Rankings in Raku
See the previous section above for explanations on the com
auxiliary subroutine, which really does the bulk of the work.
The poker-hands
does only one thing: it populates a hash with the various hand types and their frequencies. This Wikipedia page provides a table with the mathematical expression of the absolute frequency of each hand type. The code did not really need a separate subroutine and could have been inserted in the main code, but I find it clearer this way, in a separate subroutine.
The rest of the program basically displays the hash in a form hopefully readable to the human eye.
sub com ($n, $k) {
# Binomial coefficient formula for: n choose k
my $nr_of_com = ([*] ($n - $k + 1)..$n)/([*] 1..$k);
return $nr_of_com;
}
sub poker-hands (){
my %hands =
"0. RF" => com(4, 1), # Royal flush
"1. SF" => com(10, 1) * com(4, 1) - com(4, 1),
# Straight flush
"2. FK" => com(13, 1) * com(12, 1) * com(4, 1),
# Four of a kind
"3. FH" => com(13, 1) * com(4, 3) * com(12, 1)
* com(4, 2), # Full house
"4. Fl" => com(13, 5) * com(4, 1) - com(10, 1)
* com(4, 1), # Flush (excl. RF and SF)
"5. St" => com(10, 1) * com(4, 1)**5 - com(10, 1)
* com(4, 1), # Straight (excl. RF and SF)
"6. TK" => com(13, 1) * com(4, 3) * com(12, 2)
* com(4, 1) ** 2, # Three of a kind
"7. TP" => com(13, 2) * com(4, 2)**2 *com(11, 1)
* com(4, 1), # Two pairs
"8. OP" => com(13, 1) * com(4, 2) * com(12, 3)
* com(4, 1)**3, # One pair
"9. NP" => (com(13, 5) - com(10,1)) * (com(4, 1)**5
- com(4, 1)), # No pair (or High card)
;
return %hands;
}
my %hand-count = poker-hands;
my $num-hands = com 52, 5;
say "Total number of hands (direct count) => $num-hands";
for %hand-count.keys.sort -> $key {
say " - $key => ", %hand-count{$key};
}
say "Sum of the hands by type => ", [+] %hand-count.values;
This program displays the following output:
$ raku ./poker-hands.raku
Total number of hands (direct count) => 2598960
- 0. RF => 4
- 1. SF => 36
- 2. FK => 624
- 3. FH => 3744
- 4. Fl => 5108
- 5. St => 10200
- 6. TK => 54912
- 7. TP => 123552
- 8. OP => 1098240
- 9. NP => 1302540
Sum of the hands by type => 2598960
Poker Hand Rankings in Perl
This program is essentially a port to Perl of the above Raku program. Please refer to the previous sections if you need explanations.
There is one important change, though: rather than using hand abbreviations (RF, SF, FK, etc.) for the hash keys, it uses hand full name (Royal flush, Straight flush, Four of a kind, etc.), leading to more explicit output.
use strict;
use warnings;
use feature 'say';
sub com {
# Binomial coefficient formula for: n choose k
my ($n, $k) = @_;
my $fact_k = 1;
$fact_k *= $_ for 1..$k;
my $nr_of_com_numerator = 1;
$nr_of_com_numerator *= $_ for ($n -$k + 1)..$n;
return $nr_of_com_numerator/ $fact_k;
}
sub poker_hands {
my %hands =
("0. Royal flush" => com(4, 1),
"1. Straight flush" => com(10, 1) * com(4, 1)
- com(4, 1),
"2. Four of a kind" => com(13, 1) * com(12, 1)
* com(4, 1),
"3. Full house" => com(13, 1) * com(4, 3)
* com(12, 1) * com(4, 2),
"4. Flush" => com(13, 5) * com(4, 1) - com(10, 1)
* com(4, 1), # Flush (excl. RF and SF)
"5. Straight" => com(10, 1) * com(4, 1)**5 - com(10, 1)
* com(4, 1), # Straight (excl. RF and SF)
"6. Three of a kind" => com(13, 1) * com(4, 3)
* com(12, 2) * com(4, 1) ** 2,
"7. Two pairs" => com(13, 2) * com(4, 2)**2
* com(11, 1) * com(4, 1),
"8. One pair" => com(13, 1) * com(4, 2) * com(12, 3)
* com(4, 1)**3, #
"9. No pair" => (com(13, 5) - com(10,1))
* (com(4, 1)**5 - com(4, 1)),
# No pair or High card
);
return %hands;
}
my %hand_count = poker_hands;
my $num_hands = com 52, 5;
say "Total number of hands (direct count) => $num_hands";
for my $key (sort keys %hand_count) {
printf " - %-20s => %-10i \n", $key, $hand_count{$key};
}
my $sum = 0;
$sum += $_ for values %hand_count;
say "Sum of the hands by type => ", $sum
This program displays the following output:
$ perl ./poker-hands.pl
Total number of hands (direct count) => 2598960
- 0. Royal flush => 4
- 1. Straight flush => 36
- 2. Four of a kind => 624
- 3. Full house => 3744
- 4. Flush => 5108
- 5. Straight => 10200
- 6. Three of a kind => 54912
- 7. Two pairs => 123552
- 8. One pair => 1098240
- 9. No pair => 1302540
Sum of the hands by type => 2598960
Wrapping up
The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on October 27, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
Leave a comment