Run

Author

Eric W. Weisstein
January 3, 2007

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Statistics/Run.nb.

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

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

Code

Runs[l_]:=Length[Split[l]]

Arrangements with n Runs

Arrangements[m_,n_,u_]:=Module[{k=Floor[u/2]},
If[OddQ[u],
Binomial[m-1,k]Binomial[n-1,k-1]+Binomial[m-1,k-1]Binomial[n-1,k],
2Binomial[m-1,k-1]Binomial[n-1,k-1]]
]

(2,2)

Arrangements[2,2,#]&/@Range[10]

{First[#],Length[#]}&/@Split[Sort[Runs/@Permutations[{0,0,1,1}]]]

(3,5)

Arrangements[3,5,#]&/@Range[10]

{First[#],Length[#]}&/@Split[Sort[Runs/@Permutations[{0,0,0,1,1,1,1,1}]]]

Runs with Replacement

Generating Function

F[r_,s_,p_:1/2]:=(((p^r)(s^r)(1-p s))/(1-s+(1-p)(p^r)(s^(r+1))))
R[r_,n_,p_:1/2]:=Module[{s},Normal[Series[F[r,s],{s,0,n}]]/.s->1]

Check

With[{tosses=10^6,n=4},
maxrunlengths=Max/@Map[Length,DeleteCases[Map[Select[#,First[#]==1&]&,
Split/@Table[Random[Integer],{tosses},{n}],
{1}],{}],
{2}];
Table[Count[maxrunlengths,_?(#>=k&)],{k,n}]/tosses
]//N//Timing

Table[R[r,4],{r,4}]//N

Table

TableForm[Table[R[r,n],{n,8},{r,8}],TableAlignments->Center]

TableForm[Table[2^n R[r,n],{n,8},{r,8}],TableAlignments->Right]

Constants

α=RootReduce[((136+24Sqrt[33])^(1/3)-8(136+24Sqrt[33])^(-1/3)-2)/3]

Select[Last/@List@@Roots[-8+4 #1+2 ((#1)^2)+((#1)^3)&[x]==0,x,Cubics->False],Positive]

N[α,20]

β=RootReduce[(2-α)/(4-3α)]

Select[Last/@List@@Roots[-2+12 #1-22 ((#1)^2)+11 ((#1)^3)&[x]==0,x,Cubics->False],Positive]

N[β,20]

Runs without Replacement

Bloom's Recurrence

n[r_,m_?Negative,k_]:=0
n[r_,m_,k_?Negative]:=0
n[r_,m_,k_]:=n[r,m,k]=e[r,m,k]+Plus@@Table[n[r,m-1,k-i],{i,0,r-1}]-Plus@@Table[n[r,m-r,k-i],{i,r-1}]

e[r_,m_,k_]:=Which[
m==0&&0≤k<r,1,
m==r&&0≤k<r,-1,
True,0]

P[r_,m_,k_]:=1-n[r,m,k]/Binomial[m+k,k]

Jackson's Recurrence

n2[r_,m_?Negative,k_]:=0
n2[r_,m_,k_?Negative]:=0
n2[r_,m_,k_]:=n2[r,m,k]=e2[r,m,k]+n2[r,m-1,k]+n2[r,m,k-1]-n2[r,m-r,k-1]-n2[r,m-1,k-r]+n2[r,m-r,k-r]

e2[r_,m_,k_]:=Which[
{m,k}=={0,0}||{m,k}=={r,r},1,
{m,k}=={0,r}||{m,k}=={r,0},-1,
True,0]

P2[r_,m_,k_]:=1-n2[r,m,k]/Binomial[m+k,k]

Check

{P[2,2,2],P2[2,2,2]}

Count[p=Permutations[{0,0,1,1}],{_ ...,a_,a_,_ ...}]/Length[p]

Cases[p=Permutations[{0,0,1,1}],{_ ...,a_,a_,_ ...}]

p

Counts of runs of length 3

TableForm[Table[n[3,m,k],{k,0,12},{m,0,12}],TableAlignments->Right]

Runs of colors in a deck of cards

P2[6,26,26]

{#,N[#,20]}&@P[6,26,26]

TableForm[Table[R[r,n,n],{n,8},{r,8}],TableAlignments->Center]

R[6,26,26]//N

Binomial[52,26]P[#,26,26]&/@Range[26]

N[%]/Binomial[52,26]

Number of Runs

ExpectedRuns[n_,m_,r_]:=((m+1)FallingFactorial[n,r]+(n+1)FallingFactorial[m,r])/FallingFactorial[m+n,r]

Simplify[ExpectedRuns[n,m,r]]

ExpectedRuns[26,26,6]//N

<<Statistics`DiscreteDistributions`

dist=RandomArray[BernoulliDistribution[.6],10^7];

Count[dist,#]&/@{0,1}

s=Sort[Length/@Split[dist]];

l=Length/@Split[s];

Plus@@@NestList[Rest,l,5]

With[{p=.6`10,n=10^7},Table[ExpectedRuns[p n,(1-p)n,k],{k,6}]]//Round