File Coverage

blib/lib/Poker/Eval/Wild.pm
Criterion Covered Total %
statement 6 52 11.5
branch 0 22 0.0
condition 0 5 0.0
subroutine 2 3 66.6
pod 1 1 100.0
total 9 83 10.8


line stmt bran cond sub pod time code
1             package Poker::Eval::Wild;
2 1     1   595 use Algorithm::Combinatorics qw(combinations combinations_with_repetition);
  1         1  
  1         40  
3 1     1   3 use Moo;
  1         1  
  1         4  
4              
5             =head1 NAME
6              
7             Poker::Eval::Wild - Evaluate and score wildcard poker hands.
8              
9             =head1 VERSION
10              
11             Version 0.02
12              
13             =cut
14              
15             our $VERSION = '0.02';
16              
17             =head1 SYNOPSIS
18              
19             See Poker::Eval for code example.
20              
21             =head1 INTRODUCTION
22              
23             Evaluate highball wildcard hands. The lowball wildcard evaluator doesn't quite work yet. To mark a card as wild, set the wild_flag of the Poker::Card object to true.
24              
25             =cut
26              
27             extends 'Poker::Eval::Community';
28              
29             sub best_hand {
30 0     0 1   my ( $self, $hole ) = @_;
31 0           my $best = Poker::Hand->new(cards => $hole);
32             return $best
33             if $self->card_count >
34 0 0         ( scalar @$hole + scalar @{ $self->community_cards } );
  0            
35 0           my ( @wild, @normal );
36 0           for my $card ( @$hole, @{ $self->community_cards } ) {
  0            
37 0 0         if ( $card->is_wild ) {
38 0           push @wild, $card;
39             }
40             else {
41 0           push @normal, $card;
42             }
43             }
44 0           my $wild_count = scalar @wild;
45 0 0         $wild_count = $wild_count > 5 ? 5 : $wild_count;
46 0 0         my $norm_used = 5 > $wild_count ? 5 - $wild_count : 0;
47 0           my @wild_combos;
48 0 0         if ( $wild_count > 4 ) {
    0          
49 0           my $flat_hand = '1414141414';
50             #$best->best_combo($flat_hand);
51 0           $best->score($self->scorer->hand_score($flat_hand));
52             }
53             elsif ( $wild_count == 4 ) {
54 0           my @ranks = sort { $a <=> $b }
55 0           map { $self->scorer->rank_val( $_->rank ) } @normal;
  0            
56 0           my $high_rank = sprintf( "%02d", pop @ranks);
57 0           my $flat_hand = join '', ($high_rank) x 5;
58             #$best->best_combo($flat_hand);
59 0           $best->score($self->scorer->hand_score($flat_hand));
60             }
61             else {
62             @wild_combos =
63 0           combinations_with_repetition( [ map { sprintf( "%02d", $_ ) } 2 .. 14 ],
  0            
64             $wild_count );
65 0           my $norm_iter = combinations( [@normal], $norm_used );
66 0           while ( my $norm_combo = $norm_iter->next ) {
67              
68 0           my %suit;
69 0           my $max = 0;
70 0           my @norm_ranks = map { $self->scorer->rank_val( $_->rank ) } @$norm_combo;
  0            
71 0           for my $card (@$norm_combo) {
72 0           $suit{ $card->suit }++;
73 0 0         $max = $suit{ $card->suit } if $suit{ $card->suit } >= $max;
74             }
75 0 0         my $flush_possible = $max + $wild_count > 4 ? 1 : 0;
76              
77 0           for my $wild_combo (@wild_combos) {
78             my $flat_combo =
79 0           join( '', sort { $b <=> $a } ( @$wild_combo, @norm_ranks ) );
  0            
80 0           my $score = $self->scorer->hand_score($flat_combo);
81 0 0         if ($flush_possible) {
82 0   0       my $flush_score = $self->scorer->hand_score( $flat_combo . 's' ) || 0;
83 0 0         $score = $flush_score if $flush_score > $score;
84             }
85 0 0 0       if ( defined $score && $score >= $best->score ) {
86             #$best->best_combo($flat_combo),
87 0           $best->score($score);
88             }
89             }
90             }
91             }
92 0           $best->name($self->scorer->hand_name( $best->score ));
93 0           return $best;
94             }
95              
96             =head1 AUTHOR
97              
98             Nathaniel Graham, C<< >>
99              
100             =head1 LICENSE AND COPYRIGHT
101              
102             Copyright 2016 Nathaniel Graham.
103              
104             This program is free software; you can redistribute it and/or modify it
105             under the terms of the the Artistic License (2.0). You may obtain a
106             copy of the full license at:
107              
108             L
109              
110             =cut
111              
112             1;