I was asked to work out the number of ways to get specific hands in
Deuces Wilds, so I wrote a simulation.
#! /usr/bin/perl -w
use strict;
use Time::HiRes qw(gettimeofday);
my %count;
my @type_checks = (
[\&royal_flush, "Royal Flush"],
[\&four_wilds, "Four Wilds"],
[\&wild_royal_flush, "Wild Royal Flush"],
[\&five_of_a_kind, "Five of a Kind"],
[\&straight_flush, "Straight Flush"],
[\&four_of_a_kind, "Four of a Kind"],
[\&full_house, "Full House"],
[\&flush, "Flush"],
[\&straight, "Straight"],
[\&three_of_a_kind, "Three of a Kind"],
);
my @card_ranks = qw(A 2 3 4 5 6 7 8 9 T J Q K);
my @all_cards;
for my $s (qw(S H D C)) {
for my $r (@card_ranks) {
push @all_cards, "$r$s";
}
}
my @ind = (0, 1, 2, 3, 4);
my $iter = 0;
my $start_time = gettimeofday();
CARD_COMB: {
my @hand = @all_cards[@ind];
unless (++$iter%10000) {
my $elapsed = gettimeofday() - $start_time;
my $rate = $elapsed/$iter;
my $finish = localtime($start_time + $rate*2598960);
printf "%7d: @hand in %2.3f s, ETA %s\n", $iter, $elapsed, $finish
+;
}
my ($deuces, @rest) = canonicalize(@hand);
for my $type_check (@type_checks) {
if ($type_check->[0]->($deuces, @rest)) {
$count{$type_check->[1]}++;
last;
}
}
# Advance the index
my $popped = 0;
while (@ind) {
if ($ind[-1] + $popped < $#all_cards) {
$ind[-1]++;
while ($popped) {
push @ind, $ind[-1] + 1;
$popped--;
}
redo CARD_COMB;
}
else {
pop @ind;
$popped++;
}
}
}
for my $type_check (@type_checks) {
my $type = $type_check->[1];
printf "%20s: %6d\n", $type, $count{$type};
}
# Each of these may assume that all better hands have been checked.
sub royal_flush {
my ($deuces, @rest) = @_;
return if $deuces;
return if grep /^\d/, @rest;
flush($deuces, @rest);
}
sub four_wilds {
my ($deuces, @rest) = @_;
4 == $deuces;
}
sub wild_royal_flush {
my ($deuces, @rest) = @_;
return if grep /\d/, @rest;
flush(@_);
}
sub five_of_a_kind {
my ($deuces, @rest) = @_;
$rest[0] =~ /(.)/;
my $kind = $1;
not grep $kind ne substr($_, 0, 1), @rest;
}
sub straight_flush {
return unless flush(@_);
straight(@_);
}
sub four_of_a_kind {
my ($deuces, @rest) = @_;
my @rank_counts = rank_counts(@rest);
4 == $deuces + $rank_counts[-1];
}
sub full_house {
my ($deuces, @rest) = @_;
if (0 == $deuces) {
my @rank_counts = rank_counts(@rest);
return 1 if 2 == $rank_counts[0] and 3 == $rank_counts[1];
}
elsif (1 == $deuces) {
my @rank_counts = rank_counts(@rest);
return 1 if 2 == $rank_counts[0] and 2 == $rank_counts[1];
}
return;
}
sub flush {
my ($deuces, @rest) = @_;
$rest[0] =~ /.(.)/;
my $suit = $1;
not grep $suit ne substr($_, 1, 1), @rest;
}
{
my %card_rank;
sub straight {
my ($deuces, @rest) = @_;
if (not %card_rank) {
for my $i (0..$#card_ranks) {
$card_rank{$card_ranks[$i]} = $i;
}
}
my @ranks;
for my $card (@rest) {
$card =~ /(.)/;
push @ranks, $card_rank{$1};
}
@ranks = sort {$a <=> $b} @ranks;
# Check for pairs.
my $last_rank = -1;
for my $rank (@ranks) {
return if $rank == $last_rank;
$last_rank = $rank;
}
return 1 if 5 > $ranks[-1] - $ranks[0];
# Check for ace high straight.
if (0 == $ranks[0]) {
if (1 == @ranks) {
return 1;
}
elsif (8 < $ranks[1]) {
return 1;
}
}
return;
}
}
sub three_of_a_kind {
my ($deuces, @rest) = @_;
my @rank_counts = rank_counts(@rest);
3 == $deuces + $rank_counts[-1];
}
# Helper functions
sub rank_counts {
my %h;
for my $card (@_) {
$card =~ /(.)/;
$h{$1}++;
}
return sort values %h;
}
sub canonicalize {
my $deuces = 0;
my @rest;
for my $card (@_) {
if ('2' eq substr($card, 0, 1)) {
$deuces++;
}
else {
push @rest, $card;
}
}
return $deuces, @rest;
}