There have been a [id://540231|couple] of [id://458233|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.
Code used to generate some pre-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
my $check_flush = $score ? 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_flush ? 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 () {
chomp;
my $temp = 'A8' x (length($_) / 8);
for (unpack($temp, $_)) {
my $hand = join ' ', map $_ eq 'T' ? 10 : $_, unpack('AAAAA', $_);
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__
11112012111130121111401211115012111160121111701211118012111190121111T30011122008
111230151112400611125006111260061112700611128006111290061112T3021113300811134006
11135006111360061113700611138006111390081113T30611144008111450061114600611147006
11148008111490121114T30611155008111560061115700811158012111590121115T30211166010
1116701211168012111690081116T3001117701411178008111790061117T3001118800811189006
1118T300111990081119T300111TT300112220081122301611224004112250041122600411227004
11228004112290061122T30411233016112340101123500811236008112370081123801011239012
1123T3041124400411245002112460021124700411248006112490061124T3041125500411256004
1125700611258006112590061125T302112660081126700611268006112690041126T30011277008
11278004112790021127T30011288004112890021128T300112990041129T300112TT30011333008
1133400411335004113360041133700611338008113390061133T304113440041134500511346004
1134700611348004113490041134T30611355006113560061135700411358004113590061135T304
113660061136700411368006113690041136T3021137700811378004113790021137T30211388004
113890021138T302113990041139T302113TT3041144400811445006114460081144700611448004
114490081144T30811455008114560071145700211458004114590081145T3061146600411467004
11468006114690061146T3041147700811478004114790041147T30411488004114890041148T304
114990081149T306114TT30811555010115560041155700411558008115590121155T30411566004
1156700711568008115690081156T3021157700811578006115790061157T3021158800811589008
1158T304115990121159T306115TT304116660081166700811668012116690081166T30011677012
11678013116790061167T30211688012116890081168T304116990081169T302116TT30011777020
11778012117790081177T30411788008117890071178T302117990041179T300117TT30011888008
118890041188T300118990041189T300118TT300119990081199T300119TT30011TTT30012222012
122230151222400612225006122260061222700612228008122290081222T3061223301612234010
12235008122360081223701012238010122390121223T30612244004122450021224600412247004
12248006122490061224T30412255006122560041225700612258006122590041225T30412266008
1226700612268004122690041226T3021227700612278004122790021227T3021228800412289002
1228T302122990041229T302122TT304123330151233401012335008123360101233701012338010
123390141233T3041234401012345207123462061234720612348208123492081234T30412355007
123562051235720712358205123592071235T304123660091236720512368205123692071236T302
1237700712378205123792051237T30212388005123892051238T302123990091239T304123TT304
1244400812445004124460041244700412448006124490061244T304124550041245620512457202
12458204124592041245T304124660041246720212468204124692041246T3021247700412478204
124792021247T30212488006124892041248T304124990061249T304124TT3041255500812556002
1255700612558006125590061255T304125660041256720712568204125692041256T30212577008
12578206125792041257T30412588006125892041258T304125990061259T304125TT30412666012
1266700812668008126690081266T3021267700812678209126792041267T3021268800612689204
1268T302126990061269T302126TT3001277701212778008127790041277T3021278800612789205
1278T302127990021279T300127TT30012888006128890021288T300128990021289T300128TT300
129990061299T300129TT30012TTT300133330121333400613335008133360081333700613338012
133390121333T3001334400613345010133460021334700613348008133490041334T30213355004
133560061335700613358004133590061335T302133660081336700213368006133690061336T300
1337700613378006133790041337T30013388008133890061338T302133990081339T302133TT300
1344400813445008134460041344700813448006134490021344T304134550101345620813457207
13458205134592051345T304134660041346720213468204134692021346T3021347700813478206
134792021347T30413488006134892021348T304134990021349T302134TT3041355500813556006
1355700613558002135590061355T304135660081356720713568204135692061356T30413577008
13578204135792041357T30413588002135892021358T302135990061359T304135TT30413666012
1366700413668008136690081366T3021367700413678207136792021367T3001368800613689204
1368T302136990061369T302136TT3001377701213778008137790041377T3021378800613789205
1378T302137990021379T300137TT30013888006138890021388T300138990021389T300138TT300
139990061399T300139TT30013TTT300144440121444500614446012144470121444800614449006
1444T30614455008144560141445700414458002144590041445T306144660081446700614468006
144690061446T3061447701014478006144790041447T30614488004144890021448T30414499004
1449T304144TT30814555014145560141455700414558004145590081455T3081456601214567206
14568207145692091456T3061457700414578202145792021457T30414588002145892021458T304
145990061459T306145TT308146660061466700214668006146690061466T3021467700414678207
146792021467T30214688006146892041468T304146990061469T304146TT3041477701214778008
147790041477T30414788006147892051478T304147990021479T302147TT3041488800614889002
1488T302148990021489T302148TT304149990061499T302149TT30414TTT3061555502015556008
1555700815558008155590141555T308155660041556700815568004155690081556T30415577006
15578004155790061557T30415588004155890061558T304155990121559T308155TT30815666006
1566700815668006156690081566T3021567701015678208156792071567T3021568800615689206
1568T304156990101569T306156TT3041577701215778008157790061577T3041578800615789207
1578T304157990061579T304157TT30415888006158890041588T302158990061589T304158TT304
159990121599T306159TT30615TTT306166660121666700616668012166690121666T30016677006
16678014166790061667T30016688012166890101668T304166990121669T304166TT30016777012
16778016167790061677T30216788016167892101678T304167990061679T302167TT30016888012
168890081688T304168990081689T304168TT302169990121699T304169TT30216TTT30017777024
17778018177790121777T30617788014177890141778T306177990061779T302177TT30217888012
178890121788T304178990101789T302178TT302179990061799T300179TT30017TTT30018888012
188890061888T300188990041889T300188TT300189990061899T300189TT30018TTT30019999012
1999T300199TT30019TTT3001TTTT300222230122222401222225012222260122222701422228012
222290202222T300222330082223401522235006222360082223700622238012222390082223T306
2224400822245008222460062224701222248006222490142224T300222550082225601222257006
22258012222590082225T302222660082226701222268006222690102226T3002227700822278008
222790082227T30022288008222890082228T300222990122229T302222TT3002233300822334016
22335006223360042233700822338008223390062233T30822344018223450102234601222347010
22348012223490122234T30422355008223560042235700422358008223590022235T30622366006
2236700622368004223690042236T3042237700422378006223790022237T3042238800822389004
2238T306223990042239T304223TT308224440082244500822446004224470102244800422449012
2244T30022455004224560092245700422458006224590062245T302224660042246700822468002
224690082246T3002247700822478006224790082247T30222488004224890062248T30022499012
2249T304224TT30022555010225560082255700422558012225590042255T3042256600822567011
22568008225690062256T3042257700422578008225790022257T30222588012225890062258T306
225990042259T302225TT304226660082266701222668004226690082266T3002267701222678011
226790082267T30422688004226890042268T300226990082269T302226TT3002277700822778008
227790042277T30022788008227890072278T302227990042279T300227TT3002288800822889004
2288T300228990042289T300228TT300229990082299T300229TT30022TTT3002333301223334017
23335006233360082333701223338006233390122333T30623344016233450122334601223347010
23348012233490122334T30423355008233560022335700823358004233590042335T30623366008
2336700623368002233690062336T3042337700823378006233790062337T3062338800423389004
2338T304233990082339T306233TT308234440172344501223446012234470102344801223449012
2344T30223455012234562092345720623458208234592062345T304234660112346720723468207
234692092346T3042347700523478207234792052347T30223488009234892072348T30423499009
2349T304234TT30423555014235560042355700823558008235590042355T3082356600423567207
23568202235692022356T3042357700623578206235792022357T30623588006235892022358T306
235990022359T304235TT308236660122366700823668004236690082366T3042367700623678207
236792042367T30423688002236892022368T302236990062369T304236TT3042377700623778006
237790022377T30223788006237892052378T304237990022379T302237TT3042388800623889002
2388T302238990022389T302238TT304239990062399T302239TT30423TTT3062444401224445012
244460062444701224448006244490122444T3002445500824456014244570062445800624459008
2445T304244660042446700624468002244690082446T3002447700824478006244790082447T302
24488004244890062448T300244990122449T304244TT30024555008245560122455700224558006
245590042455T304245660122456720824568207245692092456T304245770022457820424579202
2457T30224588006245892042458T304245990062459T304245TT304246660062466700624668002
246690082466T3002467700624678207246792062467T30224688002246892042468T30024699010
2469T304246TT3002477700624778006247790042477T30024788006247892072478T30224799006
2479T302247TT30024888006248890042488T300248990062489T302248TT300249990122499T304
249TT30224TTT30025555020255560082555700825558014255590082555T3082556600425567010
25568006255690042556T3042557700425578008255790022557T30425588012255890062558T308
255990042559T304255TT308256660062566701225668004256690062566T3022567701225678210
256792072567T30425688006256892042568T304256990062569T304256TT3042577700625778008
257790022577T30225788010257892072578T306257990022579T302257TT3042588801225889006
2588T306258990042589T304258TT306259990062599T302259TT30425TTT3062666601226667012
26668006266690122666T3002667701226678014266790102667T30426688004266890062668T300
266990122669T304266TT3002677701226778016267790082677T30426788014267892102678T304
267990082679T304267TT30226888006268890042688T300268990062689T302268TT30026999012
2699T304269TT30226TTT3002777701227778012277790062777T30027788012277890122778T304
277990042779T300277TT30027888012278890122788T304278990102789T302278TT30227999006
2799T300279TT30027TTT30028888012288890062888T300288990042889T300288TT30028999006
2899T300289TT30028TTT300299990122999T300299TT30029TTT3002TTTT3003333401233335012
333360203333701233338012333390243333T3003334400833345021333460083334700633348012
333490123334T30033355008333560083335701233358006333590123335T3023336601833367008
33368008333690163336T3023337700833378008333790123337T30033388008333890123338T300
333990203339T306333TT3003344401233445020334460043344700633448012334490063344T300
33455020334560143345701433458014334590123345T30433466008334670023346800633469006
3346T3003347700433478008334790043347T30033488012334890083348T304334990083349T302
334TT30033555010335560043355701233558004335590063355T304335660083356700933568002
335690063356T3023357701233578008335790083357T30633588004335890043358T30233599008
3359T304335TT304336660203366700833668008336690143366T304336770043367800733679006
3367T30033688004336890063368T300336990123369T304336TT300337770083377800833779006
3377T30033788008337890093378T302337990083379T302337TT30033888008338890063388T300
338990083389T302338TT300339990143399T304339TT30233TTT300344440203444501734446008
3444701434448014344490083444T30234455016344560143445701234458012344590083445T302
344660063446700434468006344690043446T3003447700834478010344790043447T30234488012
344890063448T304344990043449T300344TT3003455501734556014345570123455801034559008
3455T304345660163456720934568208345692083456T3043457700934578209345792053457T304
34588009345892053458T304345990053459T302345TT30434666012346670043466800634669008
3466T3023467700234678207346792023467T30034688006346892043468T302346990063469T302
346TT3003477700634778008347790023477T30034788010347892073478T304347990023479T300
347TT30034888012348890063488T304348990043489T302348TT302349990063499T300349TT300
34TTT30035555020355560083555701435558008355590083555T308355660063556701235568002
355690043556T3043557701235578008355790063557T30835588004355890023558T30435599004
3559T304355TT308356660123566701235668004356690083566T304356770123567820835679207
3567T30435688002356892023568T302356990063569T304356TT304357770123577801035779006
3577T30635788008357892073578T306357990043579T304357TT30635888006358890023588T302
358990023589T302358TT304359990063599T302359TT30435TTT306366660243666701236668012
366690183666T3063667700636678012366790083667T30236688006366890083668T30236699014
3669T306366TT3023677700636778012367790043677T30036788012367892083678T30236799006
3679T302367TT30036888006368890043688T300368990063689T302368TT300369990123699T304
369TT30236TTT3003777701237778012377790063777T30037788012377890123778T30437799004
3779T300377TT30037888012378890123788T304378990103789T302378TT302379990063799T300
379TT30037TTT30038888012388890063888T300388990043889T300388TT300389990063899T300
389TT30038TTT300399990123999T300399TT30039TTT3003TTTT300444450124444601244447024
44448012444490124444T30044455008444560214445701244458006444590064445T30244466008
4446701244468006444690084446T3004447702044478014444790124447T3064448800844489006
4448T300444990084449T300444TT30044555010445560244455700644558004445590044455T304
445660244456701644568012445690144456T3064457700844578006445790044457T30444588004
445890024458T302445990044459T302445TT304446660084466700644668004446690084466T300
4467700844678009446790064467T30244688004446890044468T300446990084469T302446TT300
4477701444778012447790084477T30444788010447890094478T304447990064479T302447TT302
44888008448890044488T300448990044489T300448TT300449990084499T300449TT30044TTT300
45555020455560234555700845558008455590084555T30845566024455670144556801245569014
4556T3084557700445578004455790024557T30445588004455890024558T304455990044559T304
455TT308456660214566701445668012456690164566T3064567701245678209456792084567T304
45688007456892074568T304456990114569T306456TT3064577700645778006457790024577T302
45788006457892054578T304457990024579T302457TT30445888006458890024588T30245899002
4589T302458TT304459990064599T302459TT30445TTT30646666012466670064666800646669012
4666T3004667700446678010466790064667T30046688004466890064668T300466990124669T304
466TT3004677700646778012467790044677T30046788012467892084678T302467990064679T302
467TT30046888006468890044688T300468990064689T302468TT300469990124699T304469TT302
46TTT3004777701247778012477790064777T30047788012477890124778T304477990044779T300
477TT30047888012478890124788T304478990104789T302478TT302479990064799T300479TT300
47TTT30048888012488890064888T300488990044889T300488TT300489990064899T300489TT300
48TTT300499990124999T300499TT30049TTT3004TTTT30055556020555570205555802055559020
5555T316555660105556701755568008555690105556T3085557701055578010555790085557T308
55588010555890085558T308555990105559T308555TT31455666008556670165566800455669008
5566T3045567701655678012556790105567T30455688004556890045568T304556990085569T306
556TT3085577700855778008557790045577T30455788008557890075578T306557990045579T304
557TT30855888008558890045588T304558990045589T304558TT308559990085599T304559TT308
55TTT312566660125666701556668006566690125666T3025667701656678012566790125667T302
56688004566890065668T302566990125669T306566TT3045677701556778014567790105677T302
56788014567892095678T304567990095679T304567TT30456888006568890045688T30256899006
5689T304568TT304569990125699T306569TT30656TTT3065777701257778012577790065777T302
57788012577890125778T306577990045779T302577TT30457888012578890125788T30657899010
5789T304578TT306579990065799T302579TT30457TTT30658888012588890065888T30258899004
5889T302588TT304589990065899T302589TT30458TTT306599990125999T302599TT30459TTT306
5TTTT3086666701266668012666690206666T3006667700866678017666790126667T30066688008
666890126668T300666990206669T306666TT3006677700866778020667790086677T30066788020
667890166678T302667990126679T304667TT30066888008668890086688T300668990126689T304
668TT300669990206699T308669TT30466TTT3006777701267778021677790086777T30067788024
677890166778T304677990086779T302677TT30067888021678890166788T304678990166789T304
678TT302679990126799T304679TT30267TTT30068888012688890086888T300688990086889T302
688TT300689990126899T304689TT30268TTT300699990206999T306699TT30469TTT3026TTTT300
77778020777790127777T30077788020777890217778T306777990087779T300777TT30077888020
778890247788T308778990207789T304778TT304779990087799T300779TT30077TTT30078888020
788890217888T306788990207889T304788TT304789990177899T302789TT30278TTT30279999012
7999T300799TT30079TTT3007TTTT300888890128888T300888990088889T300888TT30088999008
8899T300889TT30088TTT300899990128999T300899TT30089TTT3008TTTT3009999T300999TT300
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 [http://en.wikipedia.org/wiki/Cribbage|Cribbage], the position of the 5th card matters for scoring so there are really more possible scoring hands then this. It did serve as a good benchmark though as you can see the results from this 256MB 1.8 GHZ Windows XP box:
sh-2.04$ time ./example.pl real 4m0.887s user 3m10.999s sys 0m0.155s
The primary purpose of this meditation is to ask if people think there is a need for this on the [http://www.cpan.org|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 [cpan://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.
Cheers - [Limbic~Region|L~R]
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
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
When calculating points for sums of 15 you do not need to consider the suit of the card. You can also consider 10, Jack, Queen, and King as the same since they all have the value of 10. This means that there are only 1993 unique hands necessary to calculate any cribbage hand for 15s. I used a brute-force approach of summing all combinations of cards in group sizes of 2-5.
I then realized that if there was no card present that had a value of 10 (T/J/Q/K), I could also safely determine the points resulting from 2/3/4 of a kind. The reason the code works may not be obvious so I have included comments.
my %card;
++$card{$_} for @hand;
$score += $_ * ($_ - 1) for values %card;
# 1 * 0 = 0 (0 points for 1 of a kind)
# 2 * 1 = 2 (2 points for 2 of a kind)
# 3 * 2 = 6 (6 points for 3 of a kind)
# 4 * 3 = 12 (12 points for 4 of a kind)
If you have 2/3/4 of a kind then you can't possibly have a flush. I added a flag if I knew it was safe not to check. You also can't possibly have right-jack if no card has a value of 10 - another flag.
I could also determine the value of any straights if no card had a value of 10. Since there are only 10 possible sequences of cards that can score points for a run, I avoided using loops. I am just going to explain the algorithm and hope that the code is clear as a result.
- To be a run, each card must have a difference of 1 with its adjacent card
- Sort the unique values in your hand
- Determine the number of unique values
- Check for possible runs of that size in descending order - end if none
- Multiply the length of the run by the product of the count of cards at each position in the run
The hand, the flags, and the score are outputed in 8 bytes. 5 for the hand, 1 for the flags, and 2 for the score.
Calculate Total Score
The first step in calculating the total score is to convert the argument into the same format used to precalulate. We then lookup that hand and get back a 3 element array.
0 = calculated score so far 1 = flag indicating if any card has a value of 10 2 = flag indicating if it is necessary to check for flush
We know that we only have to check for 2/3/4 of a kind, straights, and right-jack if a card with the value of 10 is present. The method for determining 2/3/4 of a kind and straights has already been covered. To determine if we have right-jack:
# Find suits of any jack in the first 4 cards
my %jack = map { $_ => 1 } substr($str, 0, 8) =~ /(?<=J)(.)/g;
# Determine if the suit of the 5th card matches
++$score if $jack{ substr($str, -1, 1) };
Finally, we address potential flushes if necessary.
# Get the unique list of suits in the first 4 cards
my %suit = map {$_ => undef} unpack('xAxAxAxA', $str);
# If all the same, count 1 per card
if (keys %suit == 1) {
$score += 4;
# If cut-card matches, add 1 for that too
$score += 1 if substr($str, 1, 1) eq substr($str, -1, 1);
}
Cheers - [Limbic~Region|L~R]