> For the complete documentation index, see [llms.txt](https://trizen.gitbook.io/perl6-rosettacode/llms.txt). Markdown versions of documentation pages are available by appending `.md` to page URLs; this page is available as [Markdown](https://trizen.gitbook.io/perl6-rosettacode/programming_tasks/p/poker_hand_analyser.md).

# Poker hand analyser

This solution handles jokers. It has been written to use a Raku grammar.

```perl
use v6;
 
grammar PokerHand {
 
    # Raku Grammar to parse and rank 5-card poker hands
    # E.g. PokerHand.parse("2♥ 3♥ 2♦ 3♣ 3♦");
    # 2013-12-21: handle 'joker' wildcards; maximum of two
 
    rule TOP {
         :my %*PLAYED;
         { %*PLAYED = () }
         [ <face-card> | <joker> ]**5
    }
 
    token face-card {<face><suit> <?{
            my $card = ~$/.lc;
            # disallow duplicates
            ++%*PLAYED{$card} <= 1;
       }>
    }
 
    token joker {:i 'joker' <?{
            my $card = ~$/.lc;
            # allow two jokers in a hand
            ++%*PLAYED{$card} <= 2;
        }>
    }
 
    token face {:i <[2..9 jqka]> | 10 }
    token suit {<[♥ ♦ ♣ ♠]>}
}

class PokerHand::Actions {
    method TOP($/) {
        my UInt @n    = n-of-a-kind($/);
        my $flush     = 'flush' if flush($/);
        my $straight  = 'straight' if straight($/);
        make rank(@n[0], @n[1], $flush, $straight);
    }
    multi sub rank(5,*@)                    { 'five-of-a-kind' }
    multi sub rank($,$,'flush','straight')  { 'straight-flush' }
    multi sub rank(4,*@)                    { 'four-of-a-kind' }
    multi sub rank($,$,'flush',$)           { 'flush' }
    multi sub rank($,$,$,'straight')        { 'straight' }
    multi sub rank(3,2,*@)                  { 'full-house' }
    multi sub rank(3,*@)                    { 'three-of-a-kind' }
    multi sub rank(2,2,*@)                  { 'two-pair' }
    multi sub rank(2,*@)                    { 'one-pair' }
    multi sub rank(*@)                      { 'high-card' }
  
    sub n-of-a-kind($/) {
        my %faces := bag @<face-card>.map: -> $/ {~$<face>.lc};
        my @counts = %faces.values.sort.reverse;
        @counts[0] += @<joker>;
        return @counts;
    }
 
    sub flush($/) {
        my @suits = unique @<face-card>.map: -> $/ {~$<suit>};
        return +@suits == 1;
    }
 
    sub straight($/) {
        # allow both ace-low and ace-high straights
        constant @Faces = [ "a 2 3 4 5 6 7 8 9 10 j q k a".split: ' ' ];
        constant @Possible-Straights = [ (4 ..^ @Faces).map: { set @Faces[$_-4 .. $_] } ];

        my $faces = set @<face-card>.map: -> $/ {~$<face>.lc};
        my $jokers = +@<joker>;
 
        return ?( @Possible-Straights.first: { +($faces ∩ $_) + $jokers == 5 } );
    }
}

my PokerHand::Actions $actions .= new;

for ("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
     "4♥ 4♠ k♠ 5♦ 10♠",  # one-pair
     "q♣ 10♣ 7♣ 6♣ 4♣",  # flush
     "a♥ a♥ 3♣ 4♣ 5♦",   # invalid
     ## EXTRA CREDIT ##
     "joker  2♦  2♠  k♠  q♦",  # three-of-a-kind
     "joker  5♥  7♦  8♠  9♦",  # straight
     "joker  2♦  3♠  4♠  5♠",  # straight
     "joker  3♥  2♦  3♠  3♦",  # four-of-a-kind
     "joker  7♥  2♦  3♠  3♦",  # three-of-a-kind
     "joker  7♥  7♦  7♠  7♣",  # five-of-a-kind
     "joker  j♥  q♥  k♥  A♥",  # straight-flush
     "joker  4♣  k♣  5♦ 10♠",  # one-pair
     "joker  k♣  7♣  6♣  4♣",  # flush
     "joker  2♦ joker  4♠  5♠",  # straight
     "joker  Q♦ joker  A♠ 10♠",  # straight
     "joker  Q♦ joker  A♦ 10♦",  # straight-flush
     "joker  2♦ 2♠  joker  q♦",  # four of a kind
    ) {
    my $rank = do with PokerHand.parse($_, :$actions) {
        .ast;
    }
    else {
        'invalid';
    }
    say "$_: $rank";
}
```

#### Output:

```
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
4♥ 4♠ k♠ 5♦ 10♠: one-pair
q♣ 10♣ 7♣ 6♣ 4♣: flush
a♥ a♥ 3♣ 4♣ 5♦: invalid
joker  2♦  2♠  k♠  q♦: three-of-a-kind
joker  5♠  7♦  8♠  9♦: straight
joker  2♦  3♠  4♠  5♠: straight
joker  3♥  2♦  3♠  3♦: four-of-a-kind
joker  7♥  2♦  3♠  3♦: three-of-a-kind
joker  7♥  7♦  7♠  7♣: five-of-a-kind
joker  j♠  q♠  k♠  A♠: straight-flush
joker  4♣  k♣  5♦ 10♠: one-pair
joker  k♣  7♣  6♣  4♣: flush
joker  2♦ joker  4♠  5♠: straight
joker  Q♦ joker  A♠ 10♠: straight
joker  Q♦ joker  A♦ 10♦: straight-flush
joker  2♦ 2♠  joker  q♦: four-of-a-kind
```


---

# Agent Instructions
This documentation is published with GitBook. GitBook is the documentation platform designed so that both humans and AI agents can read, navigate, and reason over technical content effectively. Learn more at gitbook.com.

## Querying This Documentation
If you need additional information that is not directly available in this page, you can query the documentation dynamically by asking a question.

Perform an HTTP GET request on the current page URL with the `ask` query parameter:

```
GET https://trizen.gitbook.io/perl6-rosettacode/programming_tasks/p/poker_hand_analyser.md?ask=<question>
```

The question should be specific, self-contained, and written in natural language.
The response will contain a direct answer to the question and relevant excerpts and sources from the documentation.

Use this mechanism when the answer is not explicitly present in the current page, you need clarification or additional context, or you want to retrieve related documentation sections.
