commit cefbde1de89e694abed78d2346c0fc9a2a5ebc78 (patch)
parent 32ca25cdf7882605df861859bfa2c5fc80a1f687
Author: Alex Karle <alex@karle.co>
Date: Tue, 14 Apr 2020 22:41:17 -0400
Euchre::Game: [refactor] Teach card_value about trump/led
This commit splits up card_value into card_value and raw_card_value. The
latter does what the original intended (i.e. give a number 0-23) and the
former now gives a number 0-98 based on trump/led.
This refactor simplifies trick_winner a lot, but that's not the main
motivation. The real reasoning here is the Dealer will, in a future
commit, take on the job of sorting hands. To sort easily, it needs to
know what's valuable. Why not use the same sub Game does!
Diffstat:
2 files changed, 42 insertions(+), 34 deletions(-)
diff --git a/lib/Euchre/Game.pm b/lib/Euchre/Game.pm
@@ -12,6 +12,7 @@ our @EXPORT = qw(
deal
trick_winner
score_round
+ card_value
);
use List::Util qw(shuffle);
@@ -27,7 +28,7 @@ our @FULL_DECK = qw(
NC TC JC QC KC AC
);
-sub card_value {
+sub raw_card_value {
my ($c) = @_;
if ($c eq 'X') {
return -1;
@@ -36,6 +37,43 @@ sub card_value {
return (6 * $SUIT_VALS{$suit} + $CARD_VALS{$val});
}
+sub card_value {
+ my ($c, $trump, $led) = @_;
+
+ # Lower to numeric value
+ $trump = $SUIT_VALS{$trump};
+ my $cval = raw_card_value($c);
+
+ return $cval if $cval < 0;
+
+ # Gather more data on it
+ my $suit = int($cval / 6);
+ my $is_jack = ($cval % 6 == 2);
+ my $is_trump = ($suit == $trump);
+ my $is_tcolor = (int($suit / 2) == int($trump / 2));
+ my $is_bower = ($is_jack && $is_tcolor);
+
+ # To create a absolute ordering we give
+ # +50 -- all bowers
+ # +25 -- all trump (not incl. J of color)
+ # +0 -- all others (use raw value)
+ $cval += 50 if $is_bower;
+ $cval += 25 if $is_trump;
+
+ # If we are ranking based on suit led, all throwoffs are
+ # considered value 0
+ # NOTE: not always defined, i.e. when sorting hand
+ if (defined $led) {
+ $led = $SUIT_VALS{$led};
+ if ($suit != $led && !($is_trump || $is_bower)) {
+ # throwoff -> set value to zero
+ $cval = 0;
+ }
+ }
+
+ return $cval;
+}
+
sub deal {
my @cards = shuffle @FULL_DECK;
@@ -62,38 +100,7 @@ sub deal {
sub trick_winner {
my ($trump, $led, @cards) = @_;
- $trump = $SUIT_VALS{$trump};
- $led = $SUIT_VALS{$led};
- my @values = map { card_value($_) } @cards;
-
- # Assign each card a value based on trump + led, either
- # Bower: card + 50
- # Trump: card + 25 (including Bower)
- # Suit Led: card
- # Other: 0
- for (my $i = 0; $i < @values; $i++) {
- next if $values[$i] < 0; # indicates loner
-
- # Identify the card
- my $c = $values[$i];
- my $suit = int($c / 6);
- my $is_jack = ($c % 6 == 2);
- my $is_tcolor = (int($suit / 2) == int($trump / 2));
- my $is_bower = ($is_jack && $is_tcolor);
-
- # Assign it a value
- if ($is_bower) {
- $values[$i] += 50;
- }
- if ($suit == $trump) {
- $values[$i] += 25;
- } elsif ($suit != $led && !$is_bower) {
- # throwoff -> set value to zero
- $values[$i] = 0;
- } else {
- # non-trump led card -> use regular value
- }
- }
+ my @values = map { card_value($_, $trump, $led) } @cards;
my $winning_ind = -1;
my $winning_val = -1;
diff --git a/t/Game.t b/t/Game.t
@@ -35,11 +35,12 @@ sub test_deal {
sub test_trick_winner {
my @tests = (
- # [Trump, Cards], Winner Idx, Desc
+ # [Trump, Led, Cards], Winner Idx, Desc
[['H', 'H', 'NH', 'TS', 'AS', 'QS'], 0, 'Trump suit led'],
[['D', 'H', 'JH', 'TS', 'JD', 'QD'], 2, 'Jack trump beats all'],
[['D', 'C', 'NC', 'JH', 'AD', 'AC'], 1, 'Jack color beats all others'],
[['S', 'S', 'NS', 'JH', 'AD', 'JC'], 3, 'Jack color beats all others (2)'],
+ [['S', 'H', 'NS', 'JH', 'AD', 'AH'], 0, 'Trump beats ace'],
[['C', 'H', 'NH', 'JH', 'QH', 'AH'], 3, 'No trump, highest of led'],
[['C', 'H', 'NH', 'JH', 'AH'], 2, 'No trump, highest of led, 3 cards'],
[['C', 'S', 'NH', 'JH', 'AH', 'NS'], 3, 'No trump, suit led wins'],
