Cribbage

Author

Eric W. Weisstein
July 26, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Games/Cribbage.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Cribbage.html.

©2008 Wolfram Research, Inc. except for portions noted otherwise

Initialization

<<Combinatorica`

Hands

cards=Flatten[Outer[List,Range[13],Range[4]],1]

Timing[hands4=KSubsets[Range[52],4];]

{Binomial[52,4],Length[hands4]}

hands=Flatten[Function[h,Flatten[{h,#}]&/@Complement[Range[52],h]]/@hands4,1];//Timing

{Binomial[52,4]48,Length[hands]}

Code

CribbageScore[{{1,2},{5,3},{11,2},{12,2},{1,1}}]

ones=Flatten[Outer[List,Sequence@@Table[{0,1},{5}]],4];

CribbageScore[hand_]:=Module[{v,ofakind,tens,four},
values=Sort[First/@hand];
tens=If[#>10,10,#]&/@values;
ofakind=Length/@Split[values];
12Count[ofakind,4]+6Count[ofakind,3]+2Count[ofakind,2]+2Count[ones,_?(#.tens==15&)]+Consec[values]+If[MemberQ[Drop[hand,-1],{11,hand[[-1,-1]]}],1,0]
]

CribbageScoreIndexed[s_]:=CribbageScore[hands[[s]]]

Consec[l_]:=Module[{dif=-Subtract@@@Partition[l,2,1]},
Switch[dif,
{1,1,1,1},5,
{1,0,1,0}|{0,1,0,1}|{0,1,1,0},12,
_?(Count[#,0]==1&&Count[#,1]==3&),8,
{1,1,1,_}|{_,1,1,1},4,
_?(Count[#,0]==2&&Count[#,1]==2&),9,
{___,0,1,1,___}|{___,1,1,0,___}|{___,1,0,1,___},6,
{___,1,1,___},3,
_,0]
]

CribbageCheck:={Through[{Drop[#,-1]&,Last[#]&}[Function[StringJoin[First[#]/.Thread[Range[2,10]->ToString/@Range[2,10]]/.{1->"A",11->"J",12->"Q",13->"K"},Last[#]/.Thread[Range[4]->{"♡","♣","♢","♠"}]]]/@#]],CribbageScore[#]}&[RandomKSubset[cards,5]]

Check

Table[CribbageCheck,{10}]//ColumnForm

Maximum Score

CribbageScore[{{11,4},{5,1},{5,2},{5,3},{5,4}}]

Enumeration

All at once

scores=CribbageScore[cards[[#]]]&/@hands;//Timing

Length/@{scores,hands}

mean=Plus@@scores/Length[scores]

N[%]

Position[scores,29]

Timing[u=Union[scores]]

Complement[Range[0,29],u]

scoretable={#,c=Count[scores,#],c/Length[hands]//N}&/@u

scoretable={{0,1025024,0.0788795518207283`},{1,101376,0.007801274355896204`},{2,2843456,0.21881491057961647`},{3,510528,0.03928709945516668`},{4,2874672,0.22121710222550559`},{5,704208,0.05419152276295133`},{6,1787376,0.1375454797303537`},{7,754144,0.05803429063933266`},{8,1118048,0.08603810755071259`},{9,353352,0.027191799796841814`},{10,375208,0.02887370332748484`},{11,42112,0.0032406808877397113`},{12,308480,0.023738726259734663`},{13,15232,0.0011721611721611722`},{14,87436,0.006728537568873703`},{15,8576,0.000659956290208391`},{16,57272,0.0044073013820912985`},{17,11192,0.0008612675839566596`},{18,2248,0.00017299227383260998`},{20,7828,0.0006023948040754764`},{21,2472,0.0001902299381290978`},{22,444,0.000034167513159109796`},{23,356,0.00002739557361406101`},{24,3680,0.0002831901991565857`},{28,76,5.8484932434512265`*^-6},{29,4,3.0781543386585404`*^-7}};

{Length[hands],Plus@@(#[[2]]&/@scoretable)}

GCD@@(#[[2]]&/@scoretable)

TableForm[scoretable]

equallyspaced=Table[{n,(Select[scoretable,#[[1]]==n&]/.{}->{{0,0}})[[1,2]]},{n,0,29}]

BarChart[{#[[2]]/Length[hands],#[[1]]}&/@equallyspaced,Frame->True,
FrameTicks->{Transpose[{Range[1,30,2],Range[0,29,2]}],Automatic},FrameLabel->{"\!\(\*
StyleBox[\"points\",\nFontSlant->\"Italic\"]\)","\!\(\*
StyleBox[\"probability\",\nFontSlant->\"Italic\"]\)"},
(*Epilog->{Dashing[{.02}],Blue,Thickness[.01],Line[{{#,-2},{#,1}}&[mean]]},*)
BarGroupSpacing->0]