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;
}
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.