All,
There have been a couple of posts that have come up on scoring cribbage hands. I decided to see if I could come up with a fast pure-perl way to score hands. You can see the result below.
Throw away code used to pre-generate some score calculations
#!/usr/bin/perl
use strict;
use warnings;
use List::Util 'sum';
my %straight = (3 => \&straight_3, 4 => \&straight_4, 5 => \&straight_
+5);
my @deck = map { ($_) x 4 } 1 .. 9;
push @deck, (10) x 16;
my $iter = combo(5, @deck);
my %seen;
open(my $fh, '>', 'crib.dat') or die $!;
my $n;
while (my @hand = $iter->()) {
next if $seen{"@hand"}++;
my %card;
++$card{$_} for @hand;
my $score = 0;
# Determine if last card is 10
my $is_10 = $hand[-1] == 10 ? 1 : 0;
# if every card is < 10, calculate 2/3/4 of a kind
if (! $is_10) {
$score += $_ * ($_ - 1) for values %card;
}
# Can't possibly be a flush if 2/3/4 of a kind exceeds 1 pair
my $check_flush = $score > 2 ? 0 : 1;
# if every card is < 10, calculate straights
if (! $is_10) {
my @val = sort {$a <=> $b} keys %card;
my ($len, $beg, $end) = $straight{@val}->(@val) if @val > 2; #
+ my and if together
if ($len) { $len *= $card{$_} for @val[$beg .. $end] }
$score += $len || 0;
}
# Calculate 15s
my $fifteen = 0;
for (2 .. 5) {
my $next = combo($_, @hand);
while (my $sum = sum($next->())) {
++$fifteen if $sum == 15;
}
}
$score += 2 * $fifteen;
$_ = $_ == 10 ? 'T' : $_ for @hand;
my $flags = ! $is_10 && ! $check_flush ? 0 : $is_10 && $check_flus
+h ? 3 : $is_10 ? 1 : 2;
$score = sprintf("%.2d", $score);
print $fh join "", @hand, $flags, $score;
print $fh "\n" if not ++$n % 10;
}
sub straight_3 {
return (3, 0, 2) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1;
}
sub straight_4 {
return (4, 0, 3) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1 && $_
+[3] - $_[2] == 1;
return (3, 0, 2) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1;
return (3, 1, 3) if $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1;
}
sub straight_5 {
return (5, 0, 4) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1 && $_
+[3] - $_[2] == 1 && $_[4] - $_[3] == 1;
return (4, 0, 3) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1 && $_
+[3] - $_[2] == 1;
return (4, 1, 4) if $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1 && $_
+[4] - $_[3] == 1;
return (3, 0, 2) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1;
return (3, 1, 3) if $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1;
return (3, 2, 4) if $_[3] - $_[2] == 1 && $_[4] - $_[3] == 1;
}
sub combo {
my $by = shift;
return sub { () } if ! $by || $by =~ /\D/ || @_ < $by;
my @list = @_;
my @position = (0 .. $by - 2, $by - 2);
my @stop = @list - $by .. $#list;
my $end_pos = $#position;
my $done = undef;
return sub {
return () if $done;
my $cur = $end_pos;
{
if ( ++$position[ $cur ] > $stop[ $cur ] ) {
$position[ --$cur ]++;
redo if $position[ $cur ] > $stop[ $cur ];
my $new_pos = $position[ $cur ];
@position[ $cur .. $end_pos ] = $new_pos .. $new_pos +
+ $by;
}
}
$done = 1 if $position[0] == $stop[0];
return @list[ @position ];
}
}
Module used to calculate score
package Cribbage::Hand;
use strict;
use warnings;
use constant SCORE => 0;
use constant HAS_10 => 1;
use constant CHK_FLSH => 2;
my %prescore;
{
while (<DATA>) {
chomp;
my $temp = 'A8' x (length($_) / 8);
for (unpack($temp, $_)) {
my $hand = join ' ', map $_ eq 'T' ? 10 : $_, unpack('AAAA
+A', $_);
my $flag = substr($_, 5, 1);
my ($has_10, $chk_flsh) = $flag == 0 ? (0, 0) : $flag == 1
+ ? (1, 0) : $flag == 2 ? (0, 1) : (1, 1);
my $score = sprintf("%d", substr($_, -2));
$prescore{$hand} = [$score, $has_10, $chk_flsh];
}
}
}
my %val = (
A => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7,
8 => 8, 9 => 9, T => 10, J => 10, Q => 10, K => 10,
);
my %ord = (
A => 1, 2 => 2, 3 => 3, 4 => 4, 5 => 5, 6 => 6, 7 => 7,
8 => 8, 9 => 9, T => 10, J => 11, Q => 12, K => 13,
);
my %rev = reverse %ord;
my %straight = (3 => \&straight_3, 4 => \&straight_4, 5 => \&straight_
+5);
sub straight_3 {
return (3, 0, 2) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1;
}
sub straight_4 {
return (4, 0, 3) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1 && $_
+[3] - $_[2] == 1;
return (3, 0, 2) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1;
return (3, 1, 3) if $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1;
}
sub straight_5 {
return (5, 0, 4) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1 && $_
+[3] - $_[2] == 1 && $_[4] - $_[3] == 1;
return (4, 0, 3) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1 && $_
+[3] - $_[2] == 1;
return (4, 1, 4) if $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1 && $_
+[4] - $_[3] == 1;
return (3, 0, 2) if $_[1] - $_[0] == 1 && $_[2] - $_[1] == 1;
return (3, 1, 3) if $_[2] - $_[1] == 1 && $_[3] - $_[2] == 1;
return (3, 2, 4) if $_[3] - $_[2] == 1 && $_[4] - $_[3] == 1;
}
sub score {
my $str = shift;
my %card;
++$card{$_} for unpack('AxAxAxAxAx', $str);
my @by_val = sort {$a <=> $b} map { ($val{$_}) x $card{$_} } keys
+%card;
my $info = $prescore{"@by_val"};
my $score = $info->[SCORE];
# If T/J/Q/K need to ...
if ($info->[HAS_10]) {
# Check for 2/3/4 of a kind
$score += $_ * ($_ - 1) for values %card;
# Check for straights
my @val = sort {$a <=> $b} @ord{keys %card};
my ($len, $beg, $end) = $straight{@val}->(@val) if @val > 2; #
+ my and if together
if ($len) { $len *= $card{$rev{$_}} for @val[$beg .. $end] }
$score += $len || 0;
# Check for right jack
my %jack = map { $_ => 1 } substr($str, 0, 8) =~ /(?<=J)(.)/g;
++$score if $jack{ substr($str, -1, 1) };
}
# Check for flush
if ($info->[CHK_FLSH]) {
my %suit = map {$_ => undef} unpack('xAxAxAxA', $str);
if (keys %suit == 1) {
$score += 4;
$score += 1 if substr($str, 1, 1) eq substr($str, -1, 1);
}
}
return $score;
}
__DATA__
11112012111130121111401211115012111160121111701211118012111190121111T3
+0011122008
111230151112400611125006111260061112700611128006111290061112T302111330
+0811134006
11135006111360061113700611138006111390081113T3061114400811145006111460
+0611147006
11148008111490121114T30611155008111560061115700811158012111590121115T3
+0211166010
1116701211168012111690081116T3001117701411178008111790061117T300111880
+0811189006
1118T300111990081119T300111TT30011222008112230161122400411225004112260
+0411227004
11228004112290061122T3041123301611234210112352081123620811237208112382
+1011239212
1123T3041124400411245202112462021124720411248206112492061124T304112550
+0411256204
1125720611258206112592061125T302112660081126720611268206112692041126T3
+0011277008
11278204112792021127T30011288004112892021128T300112990041129T300112TT3
+0011333008
1133400411335004113360041133700611338008113390061133T30411344004113452
+0511346204
1134720611348204113492041134T30611355006113562061135720411358204113592
+061135T304
113660061136720411368206113692041136T3021137700811378204113792021137T3
+0211388004
113892021138T302113990041139T302113TT304114440081144500611446008114470
+0611448004
114490081144T30811455008114562071145720211458204114592081145T306114660
+0411467204
11468206114692061146T3041147700811478204114792041147T30411488004114892
+041148T304
114990081149T306114TT30811555010115560041155700411558008115590121155T3
+0411566004
1156720711568208115692081156T3021157700811578206115792061157T302115880
+0811589208
1158T304115990121159T306115TT304116660081166700811668012116690081166T3
+0011677012
11678213116792061167T30211688012116892081168T304116990081169T302116TT3
+0011777020
11778012117790081177T30411788008117892071178T302117990041179T300117TT3
+0011888008
118890041188T300118990041189T300118TT300119990081199T300119TT30011TTT3
+0012222012
122230151222400612225006122260061222700612228008122290081222T306122330
+1612234210
12235208122362081223721012238210122392121223T3061224400412245202122462
+0412247204
12248206122492061224T30412255006122562041225720612258206122592041225T3
+0412266008
1226720612268204122692041226T3021227700612278204122792021227T302122880
+0412289202
1228T302122990041229T302122TT30412333015123342101233520812336210123372
+1012338210
123392141233T3041234421012345207123462061234720612348208123492081234T3
+0412355207
123562051235720712358205123592071235T304123662091236720512368205123692
+071236T302
1237720712378205123792051237T30212388205123892051238T302123992091239T3
+04123TT304
1244400812445204124462041244720412448206124492061244T30412455204124562
+0512457202
12458204124592041245T304124662041246720212468204124692041246T302124772
+0412478204
124792021247T30212488206124892041248T304124992061249T304124TT304125550
+0812556202
1255720612558206125592061255T304125662041256720712568204125692041256T3
+0212577208
12578206125792041257T30412588206125892041258T304125992061259T304125TT3
+0412666012
1266720812668208126692081266T3021267720812678209126792041267T302126882
+0612689204
1268T302126992061269T302126TT3001277701212778208127792041277T302127882
+0612789205
1278T302127992021279T300127TT30012888006128892021288T300128992021289T3
+00128TT300
129990061299T300129TT30012TTT30013333012133340061333500813336008133370
+0613338012
133390121333T3001334400613345210133462021334720613348208133492041334T3
+0213355004
133562061335720613358204133592061335T302133660081336720213368206133692
+061336T300
1337700613378206133792041337T30013388008133892061338T302133990081339T3
+02133TT300
1344400813445208134462041344720813448206134492021344T30413455210134562
+0813457207
13458205134592051345T304134662041346720213468204134692021346T302134772
+0813478206
134792021347T30413488206134892021348T304134992021349T302134TT304135550
+0813556206
1355720613558202135592061355T304135662081356720713568204135692061356T3
+0413577208
13578204135792041357T30413588202135892021358T302135992061359T304135TT3
+0413666012
1366720413668208136692081366T3021367720413678207136792021367T300136882
+0613689204
1368T302136992061369T302136TT3001377701213778208137792041377T302137882
+0613789205
1378T302137992021379T300137TT30013888006138892021388T300138992021389T3
+00138TT300
139990061399T300139TT30013TTT30014444012144450061444601214447012144480
+0614449006
1444T30614455008144562141445720414458202144592041445T30614466008144672
+0614468206
144692061446T3061447701014478206144792041447T30614488004144892021448T3
+0414499004
1449T304144TT30814555014145562141455720414558204145592081455T308145662
+1214567206
14568207145692091456T3061457720414578202145792021457T30414588202145892
+021458T304
145992061459T306145TT308146660061466720214668206146692061466T302146772
+0414678207
146792021467T30214688206146892041468T304146992061469T304146TT304147770
+1214778208
147792041477T30414788206147892051478T304147992021479T302147TT304148880
+0614889202
1488T302148992021489T302148TT304149990061499T302149TT30414TTT306155550
+2015556008
1555700815558008155590141555T308155660041556720815568204155692081556T3
+0415577006
15578204155792061557T30415588004155892061558T304155990121559T308155TT3
+0815666006
1566720815668206156692081566T3021567721015678208156792071567T302156882
+0615689206
1568T304156992101569T306156TT3041577701215778208157792061577T304157882
+0615789207
1578T304157992061579T304157TT30415888006158892041588T302158992061589T3
+04158TT304
159990121599T306159TT30615TTT306166660121666700616668012166690121666T3
+0016677006
16678214166792061667T30016688012166892101668T304166990121669T304166TT3
+0016777012
16778216167792061677T30216788216167892101678T304167992061679T302167TT3
+0016888012
168892081688T304168992081689T304168TT302169990121699T304169TT30216TTT3
+0017777024
17778018177790121777T30617788014177892141778T306177990061779T302177TT3
+0217888012
178892121788T304178992101789T302178TT302179990061799T300179TT30017TTT3
+0018888012
188890061888T300188990041889T300188TT300189990061899T300189TT30018TTT3
+0019999012
1999T300199TT30019TTT3001TTTT30022223012222240122222501222226012222270
+1422228012
222290202222T300222330082223401522235006222360082223700622238012222390
+082223T306
2224400822245008222460062224701222248006222490142224T30022255008222560
+1222257006
22258012222590082225T302222660082226701222268006222690102226T300222770
+0822278008
222790082227T30022288008222890082228T300222990122229T302222TT300223330
+0822334016
22335006223360042233700822338008223390062233T3082234401822345210223462
+1222347210
22348212223492122234T30422355008223562042235720422358208223592022235T3
+0622366006
2236720622368204223692042236T3042237700422378206223792022237T304223880
+0822389204
2238T306223990042239T304223TT30822444008224450082244600422447010224480
+0422449012
2244T30022455004224562092245720422458206224592062245T30222466004224672
+0822468202
224692082246T3002247700822478206224792082247T30222488004224892062248T3
+0022499012
2249T304224TT30022555010225560082255700422558012225590042255T304225660
+0822567211
22568208225692062256T3042257700422578208225792022257T30222588012225892
+062258T306
225990042259T302225TT304226660082266701222668004226690082266T300226770
+1222678211
226792082267T30422688004226892042268T300226990082269T302226TT300227770
+0822778008
227790042277T30022788008227892072278T302227990042279T300227TT300228880
+0822889004
2288T300228990042289T300228TT300229990082299T300229TT30022TTT300233330
+1223334017
23335006233360082333701223338006233390122333T3062334401623345212233462
+1223347210
23348212233492122334T30423355008233562022335720823358204233592042335T3
+0623366008
2336720623368202233692062336T3042337700823378206233792062337T306233880
+0423389204
2338T304233990082339T306233TT30823444017234452122344621223447210234482
+1223449212
2344T30223455212234562092345720623458208234592062345T30423466211234672
+0723468207
234692092346T3042347720523478207234792052347T30223488209234892072348T3
+0423499209
2349T304234TT30423555014235562042355720823558208235592042355T308235662
+0423567207
23568202235692022356T3042357720623578206235792022357T30623588206235892
+022358T306
235992022359T304235TT308236660122366720823668204236692082366T304236772
+0623678207
236792042367T30423688202236892022368T302236992062369T304236TT304237770
+0623778206
237792022377T30223788206237892052378T304237992022379T302237TT304238880
+0623889202
2388T302238992022389T302238TT304239990062399T302239TT30423TTT306244440
+1224445012
244460062444701224448006244490122444T300244550082445621424457206244582
+0624459208
2445T304244660042446720624468202244692082446T3002447700824478206244792
+082447T302
24488004244892062448T300244990122449T304244TT3002455500824556212245572
+0224558206
245592042455T304245662122456720824568207245692092456T30424577202245782
+0424579202
2457T30224588206245892042458T304245992062459T304245TT30424666006246672
+0624668202
246692082466T3002467720624678207246792062467T30224688202246892042468T3
+0024699210
2469T304246TT3002477700624778206247792042477T30024788206247892072478T3
+0224799206
2479T302247TT30024888006248892042488T300248992062489T302248TT300249990
+122499T304
249TT30224TTT30025555020255560082555700825558014255590082555T308255660
+0425567210
25568206255692042556T3042557700425578208255792022557T30425588012255892
+062558T308
255990042559T304255TT308256660062566721225668204256692062566T302256772
+1225678210
256792072567T30425688206256892042568T304256992062569T304256TT304257770
+0625778208
257792022577T30225788210257892072578T306257992022579T302257TT304258880
+1225889206
2588T306258992042589T304258TT306259990062599T302259TT30425TTT306266660
+1226667012
26668006266690122666T3002667701226678214266792102667T30426688004266892
+062668T300
266990122669T304266TT3002677701226778216267792082677T30426788214267892
+102678T304
267992082679T304267TT30226888006268892042688T300268992062689T302268TT3
+0026999012
2699T304269TT30226TTT3002777701227778012277790062777T30027788012277892
+122778T304
277990042779T300277TT30027888012278892122788T304278992102789T302278TT3
+0227999006
2799T300279TT30027TTT30028888012288890062888T300288990042889T300288TT3
+0028999006
2899T300289TT30028TTT300299990122999T300299TT30029TTT3002TTTT300333340
+1233335012
333360203333701233338012333390243333T300333440083334502133346008333470
+0633348012
333490123334T30033355008333560083335701233358006333590123335T302333660
+1833367008
33368008333690163336T3023337700833378008333790123337T30033388008333890
+123338T300
333990203339T306333TT3003344401233445020334460043344700633448012334490
+063344T300
33455020334562143345721433458214334592123345T3043346600833467202334682
+0633469206
3346T3003347700433478208334792043347T30033488012334892083348T304334990
+083349T302
334TT30033555010335560043355701233558004335590063355T30433566008335672
+0933568202
335692063356T3023357701233578208335792083357T30633588004335892043358T3
+0233599008
3359T304335TT304336660203366700833668008336690143366T30433677004336782
+0733679206
3367T30033688004336892063368T300336990123369T304336TT30033777008337780
+0833779006
3377T30033788008337892093378T302337990083379T302337TT30033888008338890
+063388T300
338990083389T302338TT300339990143399T304339TT30233TTT30034444020344450
+1734446008
3444701434448014344490083444T30234455016344562143445721234458212344592
+083445T302
344660063446720434468206344692043446T3003447700834478210344792043447T3
+0234488012
344892063448T304344990043449T300344TT300345550173455621434557212345582
+1034559208
3455T304345662163456720934568208345692083456T3043457720934578209345792
+053457T304
34588209345892053458T304345992053459T302345TT3043466601234667204346682
+0634669208
3466T3023467720234678207346792023467T30034688206346892043468T302346992
+063469T302
346TT3003477700634778208347792023477T30034788210347892073478T304347992
+023479T300
347TT30034888012348892063488T304348992043489T302348TT302349990063499T3
+00349TT300
34TTT30035555020355560083555701435558008355590083555T30835566006355672
+1235568202
355692043556T3043557701235578208355792063557T30835588004355892023558T3
+0435599004
3559T304355TT308356660123566721235668204356692083566T30435677212356782
+0835679207
3567T30435688202356892023568T302356992063569T304356TT30435777012357782
+1035779206
3577T30635788208357892073578T306357992043579T304357TT30635888006358892
+023588T302
358992023589T302358TT304359990063599T302359TT30435TTT30636666024366670
+1236668012
366690183666T3063667700636678212366792083667T30236688006366892083668T3
+0236699014
3669T306366TT3023677700636778212367792043677T30036788212367892083678T3
+0236799206
3679T302367TT30036888006368892043688T300368992063689T302368TT300369990
+123699T304
369TT30236TTT3003777701237778012377790063777T30037788012377892123778T3
+0437799004
3779T300377TT30037888012378892123788T304378992103789T302378TT302379990
+063799T300
379TT30037TTT30038888012388890063888T300388990043889T300388TT300389990
+063899T300
389TT30038TTT300399990123999T300399TT30039TTT3003TTTT30044445012444460
+1244447024
44448012444490124444T30044455008444560214445701244458006444590064445T3
+0244466008
4446701244468006444690084446T3004447702044478014444790124447T306444880
+0844489006
4448T300444990084449T300444TT30044555010445560244455700644558004445590
+044455T304
445660244456721644568212445692144456T3064457700844578206445792044457T3
+0444588004
445892024458T302445990044459T302445TT304446660084466700644668004446690
+084466T300
4467700844678209446792064467T30244688004446892044468T300446990084469T3
+02446TT300
4477701444778012447790084477T30444788010447892094478T304447990064479T3
+02447TT302
44888008448890044488T300448990044489T300448TT300449990084499T300449TT3
+0044TTT300
45555020455560234555700845558008455590084555T3084556602445567214455682
+1245569214
4556T3084557700445578204455792024557T30445588004455892024558T304455990
+044559T304
455TT308456660214566721445668212456692164566T3064567721245678209456792
+084567T304
45688207456892074568T304456992114569T306456TT3064577700645778206457792
+024577T302
45788206457892054578T304457992024579T302457TT30445888006458892024588T3
+0245899202
4589T302458TT304459990064599T302459TT30445TTT3064666601246667006466680
+0646669012
4666T3004667700446678210466792064667T30046688004466892064668T300466990
+124669T304
466TT3004677700646778212467792044677T30046788212467892084678T302467992
+064679T302
467TT30046888006468892044688T300468992064689T302468TT300469990124699T3
+04469TT302
46TTT3004777701247778012477790064777T30047788012477892124778T304477990
+044779T300
477TT30047888012478892124788T304478992104789T302478TT302479990064799T3
+00479TT300
47TTT30048888012488890064888T300488990044889T300488TT300489990064899T3
+00489TT300
48TTT300499990124999T300499TT30049TTT3004TTTT3005555602055557020555580
+2055559020
5555T316555660105556701755568008555690105556T3085557701055578010555790
+085557T308
55588010555890085558T308555990105559T308555TT3145566600855667016556680
+0455669008
5566T3045567701655678212556792105567T30455688004556892045568T304556990
+085569T306
556TT3085577700855778008557790045577T30455788008557892075578T306557990
+045579T304
557TT30855888008558890045588T304558990045589T304558TT308559990085599T3
+04559TT308
55TTT312566660125666701556668006566690125666T3025667701656678212566792
+125667T302
56688004566892065668T302566990125669T306566TT3045677701556778214567792
+105677T302
56788214567892095678T304567992095679T304567TT30456888006568892045688T3
+0256899206
5689T304568TT304569990125699T306569TT30656TTT3065777701257778012577790
+065777T302
57788012577892125778T306577990045779T302577TT30457888012578892125788T3
+0657899210
5789T304578TT306579990065799T302579TT30457TTT30658888012588890065888T3
+0258899004
5889T302588TT304589990065899T302589TT30458TTT306599990125999T302599TT3
+0459TTT306
5TTTT3086666701266668012666690206666T3006667700866678017666790126667T3
+0066688008
666890126668T300666990206669T306666TT3006677700866778020667790086677T3
+0066788020
667892166678T302667990126679T304667TT30066888008668890086688T300668990
+126689T304
668TT300669990206699T308669TT30466TTT3006777701267778021677790086777T3
+0067788024
677892166778T304677990086779T302677TT30067888021678892166788T304678992
+166789T304
678TT302679990126799T304679TT30267TTT30068888012688890086888T300688990
+086889T302
688TT300689990126899T304689TT30268TTT300699990206999T306699TT30469TTT3
+026TTTT300
77778020777790127777T30077788020777890217778T306777990087779T300777TT3
+0077888020
778890247788T308778990207789T304778TT304779990087799T300779TT30077TTT3
+0078888020
788890217888T306788990207889T304788TT304789990177899T302789TT30278TTT3
+0279999012
7999T300799TT30079TTT3007TTTT300888890128888T300888990088889T300888TT3
+0088999008
8899T300889TT30088TTT300899990128999T300899TT30089TTT3008TTTT3009999T3
+00999TT300
99TTT3009TTTT300TTTTT300
Example code to score all 2,598,960 5-card hands
#!/usr/bin/perl
use strict;
use warnings;
require Cribbage::Hand;
my @deck = map {$_ . 'H', $_ . 'S', $_ . 'C', $_ . 'D'} 2..9, qw/T J Q
+ K A/;
my $next = combo(5, @deck);
while (my $hand = join '', $next->()) {
my $score = Cribbage::Hand::score($hand);
print "$hand\t$score\n";
}
sub combo {
my $by = shift;
return sub { () } if ! $by || $by =~ /\D/ || @_ < $by;
my @list = @_;
my @position = (0 .. $by - 2, $by - 2);
my @stop = @list - $by .. $#list;
my $end_pos = $#position;
my $done = undef;
return sub {
return () if $done;
my $cur = $end_pos;
{
if ( ++$position[ $cur ] > $stop[ $cur ] ) {
$position[ --$cur ]++;
redo if $position[ $cur ] > $stop[ $cur ];
my $new_pos = $position[ $cur ];
@position[ $cur .. $end_pos ] = $new_pos .. $new_pos +
+ $by;
}
}
$done = 1 if $position[0] == $stop[0];
return @list[ @position ];
}
}
It should be noted that in Cribbage, the position of the 5th card matters for scoring so there are really 12,994,800 scoring hands. The same code can handle all of them in 15 minutes. Here are the results of generating and scoring 2.6 million hands on a 256MB 1.8 GHZ Windows XP box.
sh-2.04$ time ./example.pl
real 3m43.859s
user 3m12.483s
sys 0m0.062s
The primary purpose of this meditation is to ask if people think there is a need for this on the CPAN. In its current state, the code is not fit for the CPAN and may not even be free of bugs. It only has 1 non-exported sub but should probably be made to fit into Games::Cards::Cribbage. I am not really interested in this myself but would be happy to offer my code and ideas to someone who is.
Additionally, I am interested in hearing how people think the code may be improved from a performance perspective. I tried to precalculate as much as possible without consuming too much memory. It currently uses a hash with 1993 keys - each with a 3 element array.
Update: I found 1 minor bug when writing the explanation to the code WRT flushes.
Re: RFC: Cribbage::Hand
by hv (Prior) on Mar 31, 2006 at 17:12 UTC
|
The primary purpose of this meditation is to ask if people think there is a need for this on the CPAN.
Need? Probably not, but that's no reason not to release it.
I suspect the majority of people that might come across it are people who'd really rather be writing their own, but there'll be the occasional one that is happy to grab someone else's version so they can concentrate on making the cards look pretty.
It would help the former group, though, if the code was clear, and showed a clear link between the various aspects of hand-scoring and the code that handled each. Most potential users will not care about the speed as long as scoring 4 or 5 hands doesn't involve a noticeable (0.5s or so) delay.
Hugo
| [reply] |
|
hv,
You have good points. I just find it odd that with everything under the sun, there isn't already one out there. With regards to your point on clarity and explanation - let me take this opportunity now to do so.
Precalculating Scores
Calculate Total Score
I am not sure how fast this is compared to other approaches but I think it is a great start for someone interested in working on a Games::Cards::Cribbage.
| [reply] [d/l] [select] |
Re: RFC: Cribbage::Hand
by Anonymous Monk on Apr 25, 2007 at 03:54 UTC
|
I would totally love to see it added. I have a website where I could use it right now: http://dailycribbagehand.org I'm already using perl there to generate a random hand. Nice work! | [reply] |
|
Anonymous Monk,
My life is pretty busy at the moment. I would be happy to assist you in getting the module on CPAN provided you are willing to take maintenance responsibility for it. Otherwise, you are welcome to use the code as is. You can contact me here privately by /msg Limbic~Region once you sign up for an account.
| [reply] |
|
|