Poker hand analyser

Poker hand analyser is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Create a program to parse a single 5 card poker hand and rank it according to the List of poker hands [1].

Each input card should be specified as a two characters indicating face and suit. For example 2d (two of diamonds).

Faces are: a, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, j, q, k

Suits are: h (hearts), d (diamonds), c (clubs), and s (spades). Or you can use the unicode suit characters: ♥ ♦ ♣ ♠

Duplicate cards are illegal.

The program should analyse a single hand and produce one of the following outputs:

 straight-flush
 four-of-a-kind
 full-house
 flush
 straight
 three-of-a-kind
 two-pair
 one-pair
 high-card
 invalid

Examples

   2♥ 2♦ 2♣ k♣ q♦: three-of-a-kind
   2♥ 5♥ 7♦ 8♣ 9♠: high-card
   a♥ 2♦ 3♣ 4♣ 5♦: straight
   2♥ 3♥ 2♦ 3♣ 3♦: full-house
   2♥ 7♥ 2♦ 3♣ 3♦: two-pair
   2♥ 7♥ 7♦ 7♣ 7♠: four-of-a-kind 
   10♥ j♥ q♥ k♥ a♥: straight-flush

Perl 6

This solution is written entirely as a Perl 6 grammar. <lang perl6> use v6;

grammar PokerHand {

   # Perl6 Grammar to parse and rank 5-card poker hands
   # E.g. PokerHand.parse("2♥ 3♥ 2♦ 3♣ 3♦");

   rule TOP {
       <hand>

       :my ($n, $flush, $straight);
       {
           $n        = n-of-a-kind($<hand>);
           $flush    = flush($<hand>);
           $straight = straight($<hand>);
       }
       <rank($n, $flush, $straight)>
   }

   proto token suit {*}
   token suit:sym<♥>  {<sym>}
   token suit:sym<♦>  {<sym>}
   token suit:sym<♠>  {<sym>}
   token suit:sym<♣>  {<sym>}

   token face { <[2..9]> | 10 | j | q | k | a }

  token card {<face><suit> <?{
   my $card = ~$/;
   note "Hey, were'd that extra $card come from?"
       if %*PLAYED{$card};

   ! %*PLAYED{$card}++;
   }> }

   rule hand {
       :my %*PLAYED;
       { %*PLAYED = () }

       [ <card> ]**5
    }

  sub played($card) {
       note "Hey, were'd that extra $card come from?"
           if %*PLAYED{$card};
       return %*PLAYED{$card}++;
   }

   token rank($n, $flush, $straight) {
           $<straight-flush>  = <?{$straight && $flush}>
        || $<four-of-a-kind>  = <?{$n[0] == 4}>
        || $<full-house>      = <?{$n[0] == 3 && $n[1] == 2}>
        || $<flush>           = <?{$flush}>
        || $<straight>        = <?{$straight}>
        || $<three-of-a-kind> = <?{$n[0] == 3}>
        || $<two-pair>        = <?{$n[0] == 2 && $n[1] == 2}>
        || $<one-pair>        = <?{$n[0] == 2}>
        || $<high-card>       = <?>
   }

   sub n-of-a-kind($/) {
       my %n;

       for @<card> -> $/ {
           %n{ ~$<face> }++
       }
       return %n.values.sort: {$^b <=> $^a};
   }

   sub flush($/) {
       my %m;

       for @<card> -> $/ {
           %m{ ~$<suit> }++
       }
       return +%m.keys == 1;
   }

   sub straight($/) {
       # allow both ace-low and ace-high straights
       my @seq = 'a', 2 .. 10, < j q k a >;
       my %got;

       for @<card> -> $/ {
           %got{ ~$<face> }++
       }

       my $run = 0;
       for @seq {
           if %got{ $_ } {
               return True
                   if ++$run >= 5;
           }
           else {
               $run = 0;
           }
       }
       return False;
   }

}

for ("2♥ 2♦ 2♣ k♣ q♦",

    "2♥ 5♥ 7♦ 8♣ 9♠",
    "a♥ 2♦ 3♣ 4♣ 5♦",
    "2♥ 3♥ 2♦ 3♣ 3♦",
    "2♥ 7♥ 2♦ 3♣ 3♦",
    "2♥ 7♥ 7♦ 7♣ 7♠",
    "10♥ j♥ q♥ k♥ a♥",
  ) {
  PokerHand.parse($_);
  my $rank = $<rank>
     ?? $<rank>.caps
     !! 'invalid';
  say "$_: $rank";

}