Bowling

Author

Eric W. Weisstein
February 14, 2008

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

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

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

Figure

Pin[pos_,n_]:={Circle[pos,.3],Circle[pos,.12],Text[n,pos]}

Show[Graphics[Table[Pin[{x-y/2,y-1},y(y-1)/2+x],{y,4},{x,y}],
AspectRatio->Automatic]]

Number of Bowling Games

Lower Limit

(11^10)//N

Actual Number

games=(66^9) 241

N[%]

Possible Games with a Given Score

𝒜={x,y}/.{ToRules[Reduce[x+y≤9&&0≤x≤10&&0≤y≤10,{x,y},Integers]]};
ℬ=Flatten[{Append[#,0]&/@𝒜,
Flatten[Outer[{#1,10-#1,#2}&,Range[0,9],Range[0,10]],1],
{10,y,z}/.{ToRules[Reduce[y+z≤10&&0≤y≤9&&0≤z≤10,{y,z},Integers]]},
{10,10,#}&/@Range[0,10]
},1];
𝒯=(({{Plus@@((t^(#1+#2))&@@@𝒜), 10(t^10), (t^10), 0}, {Plus@@((t^(2#1+#2))&@@@𝒜), Plus@@((t^(#+10))&/@Range[0,9]), (t^20), 0}, {Plus@@((t^(2#1+2#2))&@@@𝒜), 10(t^20), 0, (t^20)}, {Plus@@((t^(3#1+2#2))&@@@𝒜), Plus@@((t^(#+20))&/@Range[0,9]), 0, (t^30)}}));
𝒞=(({{Plus@@((t^(#1+#2+#3))&@@@ℬ)}, {Plus@@((t^(2#1+#2+#3))&@@@ℬ)}, {Plus@@((t^(2#1+2#2+#3))&@@@ℬ)}, {Plus@@((t^(3#1+2#2+#3))&@@@ℬ)}}));
ℛ=(({{1, 0, 0, 0}}));

expr=Expand[ℛ.MatrixPower[𝒯,9].𝒞][[1,1]];

scores=CoefficientList[expr,t]

Check Total Number of Games

Plus@@scores

games==%

Plot

ListPlot[scores,Joined->True,PlotStyle->Red,PlotRange->All,
AxesLabel->{n,(Subscript[s, n])}]

fit=FindFit[MapIndexed[{#2[[1]]-1,#1}&,scores],a Exp[-(s-mu)^2/var],{{a,1.7*^17},{mu,77},{var,500}},s,EvaluationMonitor:>Print[{a,mu,var}]]

Show[
{
ListPlot[scores,Joined->True,PlotStyle->Red,PlotRange->All,
AxesLabel->TraditionalForm/@{n,(Subscript[s, n])}],
Plot[a Exp[-(s-mu)^2/var]/.fit,{s,0,300},PlotStyle->{Blue,Dashing[{.02,.02}]}]
}
]

Ranks

order=Reverse[Sort[MapIndexed[{#1,#2[[1]]-1}&,scores]]]

ranked={#[[1,1]],Sort[Last/@#]}&/@Split[order,#1[[1]]==#2[[1]]&]

Mode

ranked[[1]]

Mean

Length[scores]

mean=((scores.Range[0,300])/games)

N[%]

Raw Moments

Table[Plus@@MapIndexed[((#1)/games)(((#2[[1]]-1))^n)&,scores],{n,10}]

N[%]

Central Moments

Table[Plus@@MapIndexed[((#1)/games)(((#2[[1]]-1-mean))^n)&,scores],{n,10}]

N[%]

Can be Bowled in the Same Number of Ways

Sort[Select[ranked,Length[Last[#]]>1&]]

First/@%