Poker hand analyser: Difference between revisions

← Older editNewer edit →
Content deleted Content added
SqrtNegInf (talk | contribs)
2,392 edits
m →‎{{header|Perl 6}}: added </lang> as band-aid for problems with recent edit, notified author
→‎{{header|Perl 6}}: use a grammar actions class
Line 2,076:
 
=={{header|Perl 6}}==
This solution handles jokers. It has been written asto use a Perl 6 grammar.
<lang perl6>use v6;
 
Line 2,088:
rule TOP {
<hand>▼
:my ($n, $flush, $straight);▼
{▼
$n = n-of-a-kind($<hand>);▼
$flush = flush($<hand>);▼
$straight = straight($<hand>);
}▼
<rank($n[0], $n[1], $flush, $straight)>
}▼
rule hand {
:my %*PLAYED;
{ %*PLAYED = () }
Line 2,121 ⟶ 2,109:
token face {:i <[2..9 jqka]> | 10 }
token suit {<[♥ ♦ ♣ ♠]>}
}
 
multi token rank(5,$,$,$) { $<five-of-a-kind>=<?> }▼
class PokerHand::Actions {
multi token rank($,$,$f,$s where {$f && $s}) { $<straight-flush>=<?> }▼
method TOP($/) {
multi token rank(4,$,$,$) { $<four-of-a-kind>=<?> }▼
▲ my UInt $@n = n-of-a-kind($<hand>/);
multi token rank($,$,$f,$ where {$f}) { $<flush>=<?> }▼
multi token rank($,$,$,$s where {my $s})flush = { flush($<straight>=<?> }/);
▲ my $flush straight = flushstraight($<hand>/);
multi token rank(3,2,$,$) { $<full-house>=<?> }▼
▲ :mymake rank($@n[0], @n[1], $flush, $straight);
multi token rank(3,$,$,$) { $<three-of-a-kind>=<?> }▼
▲ }
multi token rank(2,2,$,$) { $<two-pair>=<?> }▼
multi tokensub rank(25,$,$,$) { $<one'five-of-a-pair>=<?>kind' }
multi tokensub rank($,$,$f,$) is default s where {$f && $s}) { $<high'straight-card>=<?>flush' }
▲ multi tokensub rank(54,$,$,$) { $<five'four-of-a-kind>=<?>' }
▲ multi tokensub rank($,$,$f,$ where {$f}) { $<'flush>=<?>' }
▲ multi tokensub rank($,$,$f,$s where {$f && $s}) { $<'straight-flush>=<?>' }
▲ multi tokensub rank(3,2,$,$) { $<'full-house>=<?>' }
▲ multi tokensub rank(43,$,$,$) { $<four'three-of-a-kind>=<?>' }
▲ multi tokensub rank(2,2,$,$) { $<'two-pair>=<?>' }
▲ multi tokensub rank(32,$,$,$) { $<three-of-a'one-kind>=<?>pair' }
multi sub rank($,$,$,$) is default { 'high-card' }
sub n-of-a-kind($/) {
my %faces := bag @<face-card>.map: -> $/ {~$<face>.lc};
Line 2,156 ⟶ 2,152:
}
}
 
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
## 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) {
▲ <hand>.ast;
▲ }
else {
'invalid';
}
say "$_: $rank";
}
 
for ("2♥ 2♦ 2♣ k♣ q♦", # three-of-a-kind
"2♥ 5♥ 7♦ 8♣ 9♠", # high-card
Retrieved from "https://rosettacode.org/wiki/Poker_hand_analyser"