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.
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.
Cheers - L~R
Update: I found 1 minor bug when writing the explanation to the code WRT flushes.
Back to
Meditations