|
dracos has asked for the wisdom of the Perl Monks concerning the following question:
I have been playing around with a script to figure out the point values of cribbage hands. This is the sub that I have come up with to count the number of fifteens (actually the points 2/15) I also have subs for pairs, and runs (I'll Tackle them later)
#!/usr/bin/perl -w
use strict;
use warnings;
sub fifteens
{
my $hand = shift;
$hand =~ s/[SCHD]//g;
$hand =~ s/[JQK]/10/g;
$hand =~ s/A/1/g;
my ( $c1, $c2, $c3, $c4, $c5 ) = split /,/, $hand;
my $total = 0;
# count the 2 card combinations that add up to 15
$total += 2 if ( ( $c1 + $c2 ) == 15 );
$total += 2 if ( ( $c1 + $c3 ) == 15 );
$total += 2 if ( ( $c1 + $c4 ) == 15 );
$total += 2 if ( ( $c1 + $c5 ) == 15 );
$total += 2 if ( ( $c2 + $c3 ) == 15 );
$total += 2 if ( ( $c2 + $c4 ) == 15 );
$total += 2 if ( ( $c2 + $c5 ) == 15 );
$total += 2 if ( ( $c3 + $c4 ) == 15 );
$total += 2 if ( ( $c3 + $c5 ) == 15 );
$total += 2 if ( ( $c4 + $c5 ) == 15 );
# count the 3 card combinations that add up to 15
$total += 2 if ( $c1 + $c2 + $c3 == 15 );
$total += 2 if ( $c1 + $c2 + $c4 == 15 );
$total += 2 if ( $c1 + $c2 + $c5 == 15 );
$total += 2 if ( $c1 + $c3 + $c4 == 15 );
$total += 2 if ( $c1 + $c3 + $c5 == 15 );
$total += 2 if ( $c1 + $c4 + $c5 == 15 );
$total += 2 if ( $c2 + $c3 + $c4 == 15 );
$total += 2 if ( $c2 + $c3 + $c5 == 15 );
$total += 2 if ( $c2 + $c4 + $c5 == 15 );
$total += 2 if ( $c3 + $c4 + $c5 == 15 );
# count the 4 card combinations that add up to 15
$total += 2 if ( $c1 + $c2 + $c3 + $c4 == 15 );
$total += 2 if ( $c1 + $c2 + $c3 + $c5 == 15 );
$total += 2 if ( $c1 + $c2 + $c4 + $c5 == 15 );
$total += 2 if ( $c1 + $c3 + $c4 + $c5 == 15 );
$total += 2 if ( $c2 + $c3 + $c4 + $c5 == 15 );
# See if all the cards add up to 15
$total += 2 if ( $c1 + $c2 + $c3 + $c4 + $c5 == 15 );
return $total;
} ## end sub fifteens
print "hand = A,2,3,4,5 \tTotal =", fifteens ( "A,2,3,4,5"), "\n";
print "hand = 5,5,5,J,5 \tTotal =", fifteens ( "5,5,5,J,5"), "\n";
print "hand = 6,7,8,9,5 \tTotal =", fifteens ( "6,7,8,9,5"), "\n";
There must be a neater way... or is this the cleanest (which I doubt). 2006-03-31 Retitled by planetscape, as per Monastery guidelines
Original title: 'there has to be a better way' |
Re: calculating cribbage points
by ikegami (Patriarch) on Mar 30, 2006 at 18:25 UTC
|
my @c = split /,/, $hand;
my $total = 0;
# 2 cards
for my $i1 (0..4) {
for my $i2 ($i1+1..4) {
$total += 2 if $c[$i1] + $c[$i2] == 15;
}
}
# 3 cards
for my $i1 (0..4) {
for my $i2 ($i1+1..4) {
for my $i3 ($i2+1..4) {
$total += 2 if $c[$i1] + $c[$i2] + $c[$i3] == 15;
}
}
}
...
But we can do better.
my @c = split /,/, $hand;
my $total = 0;
for my $i1 (0..4) {
for my $i2 ($i1+1..4) {
$total += 2 if $c[$i1] + $c[$i2] == 15;
for my $i3 ($i2+1..4) {
$total += 2 if $c[$i1] + $c[$i2] + $c[$i3] == 15;
for my $i4 ($i3+1..4) {
$total += 2 if $c[$i1] + $c[$i2] + $c[$i3] + $c[$i
+4] == 15;
for my $i5 ($i4+1..4) {
$total += 2 if $c[$i1] + $c[$i2] + $c[$i3] + $
+c[$i4] + $c[$i5] == 15;
}
}
}
}
}
Let's go further:
my @c = split /,/, $hand;
my $total = 0;
our $sum;
for my $i1 (0..4) {
local $sum = $i1;
for my $i2 ($i1+1..4) {
local $sum = $sum + $c[$i2]];
$total += 2 if $sum == 15;
for my $i3 ($i2+1..4) {
local $sum = $sum + $c[$i3];
$total += 2 if $sum == 15;
for my $i4 ($i3+1..4) {
local $sum = $sum + $c[$i4];
$total += 2 if $sum == 15;
for my $i5 ($i4+1..4) {
local $sum = $sum + $c[$i5];
$total += 2 if $sum == 15;
}
}
}
}
}
Let's add optimizations:
my @c = split /,/, $hand;
my $total = 0;
our $sum;
for my $i1 (0..4) {
local $sum = $i1;
for my $i2 ($i1+1..4) {
local $sum = $sum + $c[$i2]];
$total += 2 if $sum == 15;
next if $sum >= 15;
for my $i3 ($i2+1..4) {
local $sum = $sum + $c[$i3];
$total += 2 if $sum == 15;
next if $sum >= 15;
for my $i4 ($i3+1..4) {
local $sum = $sum + $c[$i4];
$total += 2 if $sum == 15;
next if $sum >= 15;
for my $i5 ($i4+1..4) {
local $sum = $sum + $c[$i5];
$total += 2 if $sum == 15;
}
}
}
}
}
While I eliminated a lot of redundancy both visually and in the number of checks, I'm sure there's still a better *algorithm*.
| [reply]
[d/l]
[select] |
|
|
If you want to abstract it a little step farther you can get rid of 5 levels of nested looping. All you're doing is looking at all subsets of cards. So using the power-set iterator from (tye)Re: Finding all Combinations, the code becomes much more high-level and reads more naturally: "For each subset of cards, check if their sum is 15" ... Whether it's overkill for cribbage, the OP must decide. I know cribbage is not usually generalized to >5 card hands ;)
use List::Util 'sum';
sub combinations { ... } ## from [id://128293]
my @c = split /,/, $hand;
my $total = 0;
my $iter = combinations(@c);
while (my @subset = $iter->()) {
$total += 2 if 15 == sum @subset;
}
You could also check for pairs inside that while loop, although runs would have to be calculated somewhere else.
| [reply]
[d/l] |
|
|
Cool I knew there had to be a better way than brute force enthusiasm...
| [reply] |
Re: calculating cribbage points
by Limbic~Region (Chancellor) on Mar 30, 2006 at 18:27 UTC
|
dracos,
This thread addresses a semi-related problem of scoring cribbage hands. You may draw some inspiration from it.
Update: See RFC: Cribbage::Hand for a fast pure-perl way to calculate all the points for a cribbage hand - not just the 15s.
| [reply] |
Re: calculating cribbage points
by ikegami (Patriarch) on Mar 30, 2006 at 19:49 UTC
|
my %count;
++$count{$_} foreach @c;
my @pairs = grep { $count{$_} >= 2 } sort { $b <=> $a } @c;
my @kind3 = grep { $count{$_} >= 3 } @pairs;
my @kind4 = grep { $count{$_} >= 4 } @kind3;
Longest run:
@c = sort { $b <=> $a } @c;
my $lr_len = 0;
my $lr_idx;
my $s = 0;
while ($s <= 4) {
my $e = $s+1;
++$e while $e <= 4 && $c[$e] == $c[$e-1] - 1;
if ($e-$s > $lr_len) {
$lr_len = $e-$s;
$lr_idx = $s;
}
$s = $e;
}
All runs:
@c = sort { $b <=> $a } @c;
my @runs;
my $s = 0;
while ($s <= 4) {
my $e = $s+1;
++$e while $e <= 4 && $c[$e] == $c[$e-1] - 1;
if ($e-$s > 1) {
push(@runs, [ map { $c[$_] } $s..$e-1 ]);
$lr_idx = $s;
}
$s = $e;
}
# Sort by length, then by highest.
@runs = sort { @$b <=> @$a || $b->[0] <=> $a->[0] } @runs;
| [reply]
[d/l]
[select] |
|
|
my %count;
++$count{$_} foreach @c;
my @pairs = grep { $count{$_} >= 2 } sort { $b <=> $a } @c;
my @kind3 = grep { $count{$_} >= 3 } @pairs;
my @kind4 = grep { $count{$_} >= 4 } @kind3;
Can be simplified to:
my ($points, %count);
++$count{$_} for @c;
$points += $_ * ($_ - 1) for values %count;
I used this trick and several others in RFC: Cribbage::Hand.
| [reply]
[d/l]
[select] |
|
|
I don't know cribbage. I didn't even know we were dealing with cribbage. I didn't count the points, just list the pairs. Your code is not so much a simplification as something different.
| [reply] |
|
|
I'm sorry could some one explain what is up with the code for runs. I can't get it to work and I am having troubles figuring out how it is suspose to work.
| [reply] |
|
|
You can't get them to run? Wierd, I've tested them. You shouldn't have any problems.
$s is the index of the card at the start of a run.
$e is the index of the card one beyond the end of a run.
"lr" stands for "longest run".
$lr_idx is the index of the card which starts the longest run.
$c[$lr_idx] is the face value of the card which starts the longest run.
$lr_len is the length of the run, as a number of cards.
@runs is an array of runs, where a run is a reference to an array of card face values.
| [reply] |
|
|
The thing about scoring mutiples (pairs, 3-of-a-kind, 4-of-a-kind) in cribbage is that it all just breaks down to scoring pairs. 3-of-a-kind is worth 6 points because there are 3-choose-2 pairs (which is 3) in a 3-of-a-kind. Each pair being worth 2 points yields 6 points total. So, using similar techniques as stated already in this thread, one can generate the set of all pairs and if the two elements in the pair are the same, increment the count of pairs.
thor
The only easy day was yesterday
| [reply] |
Re: calculating cribbage points
by jdporter (Paladin) on Mar 30, 2006 at 22:46 UTC
|
Well, other people have talked about how to do loops, or use modules to assist in the problem. I'm going to take an approach which is more customized to the specific application. Even so, it wouldn't be hard to extend if, for example, you started playing 7-card cribbage. :-)
sub sum
{
my $sum;
$sum += $_ for @_;
$sum
}
my @combos = map
{
my @v = reverse split //, sprintf "%05b", $_;
my @w = grep { $v[$_] } 0 .. $#v;
@w > 1 ? \@w : ()
}
0 .. 31;
sub fifteens
{
my $hand = shift;
$hand =~ s/[SCHD]//g;
$hand =~ s/[JQK]/10/g;
$hand =~ s/A/1/g;
my @hand = split /,/, $hand;
( grep { sum(@hand[@$_]) == 15 } @combos ) * 2
}
The key is the @combos array.
It contains a set of "combination keys", such as
[ 1,2 ],
[ 1,2,3 ],
[ 1,2,4 ],
. . .
for all the valid subsets of cards in a hand.
It turns out there's only 26 of them.
(It does not include any keys of length 1, since there's no
way to get 15 from a single card.)
We rely on grep returning the number of matches — that's
the number of fifteens found.
We're building the house of the future together.
| [reply]
[d/l]
[select] |
Re: calculating cribbage points
by Roy Johnson (Monsignor) on Mar 31, 2006 at 17:18 UTC
|
Just for variety, a recursive solution suggests itself.
use strict;
use warnings;
sub add_to {
my ($target, $first_card, @others) = @_;
# Base cases
return [$first_card] if $first_card == $target;
return () if @others == 0;
# The set of cards adding up to target is
# the set of cards adding up to target that include first_card, AND
# the set of cards adding up to target that don't include first_card
return (map([$first_card, @$_], add_to($target-$first_card, @others)
+)
, add_to($target, @others));
}
my @hand = map 1+int(rand(10)), 1..7;
print "Hand is @hand\n";
print "@$_\n" for add_to(15, @hand);
Caution: Contents may have been coded under pressure.
| [reply]
[d/l] |
Re: calculating cribbage points
by zer (Deacon) on Mar 30, 2006 at 19:06 UTC
|
#!/usr/bin/perl -w
use strict;
use warnings;
sub fifteens
{
my $card = shift;
$card =~ tr/SCHD//;
$card =~ s/[JQK]/10/g;
$card =~ s/A/1/g;
my ($i,$o,$p,$k,$l);
my ( @cards) = split /,/, $card;
$_ = 0;
# count the 2 card combinations that add up to 15
for ($i = 0; $i<=$#cards;$i++){
for ($o = $i+1; $o<=$#cards;$o++){
$_ += 2 if (( $cards[$i] + $cards[$o])== 15 );
for ($p=$o+1; $p<=$#cards;$p++){
$_ += 2 if ($cards[$i] + $cards[$o]+ $cards[$p]==15);
for ($k=$p+1;$k<=$#cards;$k++){
$_ += 2 if ($cards[$i] + $cards[$o]+ $cards[$p] +
+$cards[$k] ==15);
$_ += 2 if ($cards[$i] + $cards[$o]+ $cards[$p] +
+$cards[$k] + $cards[4] ==15);
}
}
}
}
# count the 3 card combinations that add up to 15
$_;
} ## end sub fifteens
print "hand = A,2,3,4,5 \tTotal =", fifteens ( "A,2,3,4,5"), "\n";
print "hand = 5,5,5,J,5 \tTotal =", fifteens ( "5,5,5,J,5"), "\n";
print "hand = 6,7,8,9,5 \tTotal =", fifteens ( "6,7,8,9,5"), "\n";
| [reply]
[d/l] |
|
|
