dreadpiratepeter has asked for the wisdom of the Perl Monks concerning the following question:

I had a thought about figuring out poker hands on the subway this morning and I gave it a whirl. I'm happy with my solution, but I don't know how elegant it is, so I thought I would see if the monks want to give a crack at it.
Also, I thought it might be nice to substitute short for elegant and see how low it can be golfed.
Here is the problem definition:
Given a 5 element array of cards, each a string of the form 'RS', where 'R' is the rank (2..10,J,Q,K,A) and where 'S' is the suit ('H','D','S','C'), determine what is the best poker hand that can be made with them. It is not necessary to determine striations with in a hand type (i.e. straight is acceptable, rather than 10-high straight). An example hand would be ('2H','9C','8H','JD','9S')


I have attached a scaffolding for the problem (I left use strict and warnings off for the golfers). The scaffolding allows you to enter a hand on the command-line for easy testing: 

use strict;
use warnings;
use List::Util qw(shuffle min max);
use Data::Dumper;

my @cards;

foreach my $r (2..10,'J','Q','K','A') {
    foreach my $s (qw(H S D C)) {
    push @cards,"$r$s";
    }
}

my @deck = shuffle @cards;

my @hand = sort @deck[0..4];

@hand = @ARGV if @ARGV;

print join(", ",@hand) . ":  ";

# your solution here, put answer in $hand

# end

print $hand;

[download]


-pete
"Worry is like a rocking chair. It gives you something to do, but it doesn't get you anywhere."

Replies are listed 'Best First'.
Re: Golf/Elegance: Poker Hands
by ikegami (Patriarch) on Jun 09, 2008 at 23:02 UTC
    Something different...
    Read more... (263 Bytes)
    {
   my %val; @val{2..10,qw(J Q K A)} = (2..14);

   my @hand_names = (
      [ 'Straight Flush'  => qr/^<(.)xxxx((?>x*))><\1\2xxx><\1\2xx><\1
+\2x><\1\2>/          ],
      [ 'Straight Flush'  => qr/^<(.)x{14}><\1x{5}><\1x{4}><\1x{3}><\1
+x{2}>/               ],
      [ 'Four of a Kind'  => qr/<.((?>x*))>(?:.*<.\1>){3}/            
+                     ],
      [ 'Full House'      => qr/^<.((?>x*))>(?>(?:<.\1>){1,2})<.((?>x*
+))>(?>(?:<.\2>)*)\z/ ],
      [ 'Flush'           => qr/^<(.)(?>x*)>(?:<\1(?>x*)>){4}\z/      
+                     ],
      [ 'Straight'        => qr/^<.xxxx((?>x*))><.\1xxx><.\1xx><.\1x><
+.\1>/                ],
      [ 'Straight'        => qr/^<.x{14}><.x{5}><.x{4}><.x{3}><.x{2}>/
+                     ],
      [ 'Three of a Kind' => qr/<.((?>x*))>(?:.*<.\1>){2}/            
+                     ],
      [ 'Two Pair'        => qr/<.((?>x*))><.\1>.*<.((?>x*))><.\2>/   
+                     ],
      [ 'One Pair'        => qr/<.((?>x*))><.\1>/                     
+                     ],
   );

   sub hand_name {
      my $hand = join '',
                 sort { length($b) <=> length($a) }
                 map { /^(.+)(.)/; "<$2".("x" x $val{$1}).">" }
                 @_;

      for (@hand_names) {
         my ($hn, $re) = @$_;
         return $hn if $hand =~ $re;
      }

      return 'High Card';
   }
}

    [download]
    Read more... (530 Bytes)
[reply]
[d/l]
[select]
Re: Golf/Elegance: Poker Hands
by pc88mxer (Vicar) on Jun 10, 2008 at 04:46 UTC
    This is not perl, and not exactly the same problem, but people interested in this might have a look at Cactus Kev's Poker Hand Evaluator.

    As for myself, I had some fun developing this solution: 

    use strict;
use warnings;

sub rank { $_[0] % 13 }
sub suit { int($_[0] / 13) }

sub evaluate1 {
  my @cards = @_;

  my @rank_count = (0) x 13;
  my @suit_count = (0) x 4;
  my $max_rank = 0;
  my $rank_sum = 0;

  for my $c (@cards) {
    my $r = rank($c);
    $rank_count[$r]++;
    $rank_sum += $r;
    $max_rank = $r if ($r > $max_rank);
    $suit_count[suit($c)]++;
  }

  my ($r1, $r2) = reverse sort @rank_count;
  my ($s1) = reverse sort @suit_count;

  my $is_straight = 0;
  if ($r1 == 1) {
    if (($rank_sum == $max_rank*5 - 10) ||
        ($max_rank == 12 && ($rank_sum == 12*4 - 6) && $rank_count[0])
       ) {
      $is_straight = 1;
    }
  }

  my $n = 2*$r1**3 + 2*$r2 + 53*$is_straight + 56*($s1 == 5);

  if    ($n >= 130) { "4 of a kind" }
  elsif ($n >= 113) { "straight flush" }
  elsif ($n >= 60)  { "flush" }
  elsif ($n >= 58)  { "full house" }
  elsif ($n >= 57)  { "straight" }
  elsif ($n >= 56)  { "3 of a kind" }
  elsif ($n >= 20)  { "2 pair" }
  elsif ($n >= 18)  { "1 pair" }
  else              { "high card" }
}

    [download]
[reply]
[d/l]
Re: Golf/Elegance: Poker Hands
by dreadpiratepeter (Priest) on Jun 09, 2008 at 21:03 UTC
    Oh, and here is my attempt (not golfed): 
    sub is_straight {
    my ($low,$high,$high_no_ace) = @_;
    return $low==2 ? 
      ($high == 14 ? ($high_no_ace==5) : ($high == 6) ) :
      ($high-$low) == 4;
}
    
my %tr = (J => 11,Q => 12, K => 13, A => 14); 
@hand = map {s/^([JQKA])/$tr{$1}/;$_} @hand;


my %suits;
my %ranks;

my $num_suits;
my $num_ranks;
my $low_rank = 100;
my $high_rank = 0;
my $high_rank_no_ace = 0;

foreach my $card (@hand) {
    my ($r,$s) = $card =~ /(\d+)(.)/;
    if ($suits{$s}++ == 0) {$num_suits++}
    if ($ranks{$r}++ == 0) {$num_ranks++}
    $low_rank = min($r,$low_rank);
    $high_rank = max($r,$high_rank);
    $high_rank_no_ace = max($r,$high_rank_no_ace) unless $r == 14;
}
my @nranks = sort map {$ranks{$_}} keys %ranks;

my $hand = 'high card';
{
    ($hand = 'straight flush',last) 
       if $num_suits==1 && is_straight($low_rank,$high_rank,$high_rank
+_no_ace);
    ($hand = 'four of a kind',last) if $nranks[1]==4;
    ($hand = 'full house',last) if $nranks[1]==3;
    ($hand = 'flush',last) if $num_suits==1;
    ($hand = 'straight',last) 
      if $num_ranks == 5 && is_straight $low_rank,$high_rank,$high_ran
+k_no_ace);
    ($hand = 'three of a kind',last) if $nranks[2]==3;
    ($hand = 'two pair',last) if $nranks[2]==2;
    ($hand = 'pair',last) if $nranks[3]==2;
}

    [download]


    -pete
    "Worry is like a rocking chair. It gives you something to do, but it doesn't get you anywhere."
[reply]
[d/l]

Back to Seekers of Perl Wisdom