Binomial Gaps for Finite Sequences

CTJ Dodson

Inter-A gaps

Probability Function

P[r_,p_,n_]:=p^2 (1-p)^r  (n-r-2)/(-((-1+(((1-p))^n)-n (-1+p) p+(p^2))/(-1+p)))

P[r,p,n]//FullSimplify

(∑_(r=0)^(n-2)) P[r,p,n]//Simplify

(∑_(r=0)^(n-2))r P[r,p,n]//FullSimplify

P[0,p,n]//FullSimplify

BarChart[Table[P[r,0.01,102],{r,0,100}],Table[P[r,0.09,102],{r,0,100}], 
	PlotStyle->{RGBColor[0.5,0.5,0.5],RGBColor[0.1,0.1,0.1]}, BarLabels->None,PlotRange->{0,.102}]

BarChart[Table[P[r,0.01,1000],{r,0,60}],Table[P[r,0.1,1000],{r,0,60}],Table[P[r,0.05,1000],{r,0,60}],BarSpacing->-.3,BarGroupSpacing->.3,BarStyle->{GrayLevel[.8],Hue[0]},BarLabels->None]

Pbar[p_,n_]:= (∑_(r=0)^(n-2)) r P[r,p,n]
Pvar[p_,n_]:=( (∑_(r=0)^(n-2))r^2  P[r,p,n])-Pbar[p,n]^2

{Pbar[0.1,1000],Pvar[0.1,102]}

{Pbar[0.05,1000],Pvar[0.05,5002]}

{Pbar[0.01,1000],Pvar[0.01,102]}

BarChart[Table[P[r,0.05,5002],{r,0,5000}],
	PlotStyle->RGBColor[0,1,0], BarLabels->None,PlotRange->{{0,100},{0,.05200}}]

Limit[{Pbar[0.05,n],Pvar[0.05,n]},n->∞]

Limit[{Pbar[0.01,n],Pvar[0.01,n]},n->∞]

Limit[{Pbar[0.1,n],Pvar[0.1,n]},n->∞]

Gamma Parameter

FullSimplify[Pbar[p,n]^2]

FullSimplify[Pvar[p,n]]

ContourPlot[((((((((1-p))^n) (2+(-3+n) p)+(((-1+p))^2) (-2+(-1+n) p)))^2)/((p^2) (((-1+(((1-p))^n)+p (n+p-n p)))^2))))/(((-1+p) (-2 (((1-p))^(2 n))-(((1-p))^n) (-4+4 n p+(6+(-7+n) n) (p^2)+(((-2+n))^2) (-1+n) (p^3))-(((-1+p))^2) (2+(-1+n) p (-4+n p))))/((p^2) (((-1+(((1-p))^n)+p (n+p-n p)))^2))),{p,0.01,0.1},{n,1000,6000}]

Plot3D[((((((((1-p))^n) (2+(-3+n) p)+(((-1+p))^2) (-2+(-1+n) p)))^2)/((p^2) (((-1+(((1-p))^n)+p (n+p-n p)))^2))))/(((-1+p) (-2 (((1-p))^(2 n))-(((1-p))^n) (-4+4 n p+(6+(-7+n) n) (p^2)+(((-2+n))^2) (-1+n) (p^3))-(((-1+p))^2) (2+(-1+n) p (-4+n p))))/((p^2) (((-1+(((1-p))^n)+p (n+p-n p)))^2))),{p,0.01,0.1},{n,500,6000},PlotRange->{0.88,1.1}]

{Pbar[0.01,1000]^2/Pvar[0.01,1000],Pbar[0.1,1000]^2/Pvar[0.1,1000]}

{Pbar[0.01,2000]^2/Pvar[0.01,2000],Pbar[0.1,2000]^2/Pvar[0.1,2000]}

{Pbar[0.01,6000]^2/Pvar[0.01,6000],Pbar[0.1,6000]^2/Pvar[0.1,6000]}

Limit[Pbar[0.1,n]^2/Pvar[0.1,n],n->∞]//N

Limit[Pbar[0.05,n]^2/Pvar[0.05,n],n->∞]

Limit[Pbar[0.01,n]^2/Pvar[0.01,n],n->∞]

Plot[{Pbar[0.01,n]^2,Pvar[0.01,n]},{n,10000,10100},
PlotStyle->{Hue[1],Hue[0.6]}];

Plot[{Pbar[p,100]^2,Pvar[p,100]},{p,0.001,0.5},PlotRange->All,
PlotStyle->{Hue[1],Hue[0.6]}];

Plot[{Pbar[0.05,n]^2/Pvar[0.05,n],Pbar[0.01,n]^2/Pvar[0.01,n],Pbar[0.1,n]^2/Pvar[0.1,n],1},{n,10,1000},GridLines->Automatic,
Frame->True, PlotStyle->Thickness[0.008],PlotRange->{{0,1000},{0.78,1.8}}];

((Sqrt[( (∑_(r=0)^(n-2))r^2  P[r,p,n])-Pbar[p,n]^2])/(Pbar[p,n]))//FullSimplify

FullSimplify[((Pbar[p,n]^2)/(Pvar[p,n]))]

pnu=Plot3D[-((((((1-p))^n) (2+(-3+n) p)+(((-1+p))^2) (-2+(-1+n) p)))^2)/((-1+p) (2 (((1-p))^(2 n))+(((1-p))^n) (-4+4 n p+(-6+n) (-1+n) (p^2)+(((-2+n))^2) (-1+n) (p^3))+(((-1+p))^2) (2+(-1+n) p (-4+n p)))), {p,0.00035,0.101},{n,9,500}, 
PlotPoints->50, PlotRange->{0,2},Mesh->False];

pnu1=Plot3D[1, {p,0,0.1},{n,5,500}, 
PlotPoints->5, PlotRange->{0,2},Mesh->True,Lighting->True,LightSources->{{{1.`,0.`,1.`},RGBColor[1,0,0]}, {{1.`,1.`,1.`},RGBColor[1,0,0]},{{1.`,0.`,0.`},RGBColor[1,0,0]}}];

Show[pnu,pnu1];

Plot[((Pbar[0.05,n]^2)/(Pvar[0.05,n]))//Evaluate,{n,50,1000}, PlotRange->{0.55,1.25}];

Show[enu,pnu1];

Table[{N[Pbar[0.01,n]],(((N[Pbar[0.01,n]])^2)/(N[Pvar[0.01,n]]))},{n,50,500, 50}]

ListPlot[Table[{N[Pbar[0.01,n]],(((N[Pbar[0.01,n]])^2)/(N[Pvar[0.01,n]]))},{n,10,4000, 10}],Frame->True,GridLines->Automatic,
	PlotStyle->{PointSize[0.03], RGBColor[1,0,0]}, PlotRange->{{0,100},{0.78,1.82}}];

ListPlot[Table[{N[Pbar[0.05,n]],(((N[Pbar[0.05,n]])^2)/(N[Pvar[0.05,n]]))},{n,10,4000, 10}],Frame->True,GridLines->Automatic,
	PlotStyle->{PointSize[0.03], RGBColor[0,0,1]}, PlotRange->{{0,100},{0.78,1.82}}];

ListPlot[Table[{N[Pbar[0.1,n]],(((N[Pbar[0.1,n]])^2)/(N[Pvar[0.1,n]]))},{n,10,1000, 10}],
	PlotStyle->{PointSize[0.03], RGBColor[0,1,0]}, Frame->True,GridLines->Automatic,PlotRange->{{0,100},{0.78,1.82}}];

Show[%,%%,%%%];

n10to4000p01=ListPlot[Table[{N[Pbar[0.01,n]],N[(Sqrt[Pvar[0.01,n]])]},{n,10,4000, 10}], Frame->True,GridLines->Automatic,
	PlotStyle->{PointSize[0.03], RGBColor[1,0,0]}, PlotRange->{{0,100},{0,100}},AspectRatio->Automatic]

n10to4000p05=ListPlot[Table[{N[Pbar[0.05,n]],N[(Sqrt[Pvar[0.05,n]])]},{n,10,4000, 10}], Frame->True,GridLines->Automatic,
	PlotStyle->{PointSize[0.03], RGBColor[0,0,1]}, PlotRange->{{0,100},{0,100}},AspectRatio->Automatic]

n10to4000p10=ListPlot[Table[{N[Pbar[0.1,n]],N[(Sqrt[Pvar[0.1,n]])]},{n,10,4000, 10}],
	PlotStyle->{PointSize[0.03], RGBColor[0,1,0]},  Frame->True,GridLines->Automatic,PlotRange->{{0,100},{0,100}},AspectRatio->Automatic]

Show[n10to4000p01,n10to4000p05,n10to4000p10]

p01to1=ListPlot[Table[{N[Pbar[p,1000]],N[(Sqrt[Pvar[p,1000]])]},{p,0.01,0.1,0.01}],  Frame->True,GridLines->Automatic,
	PlotStyle->{PointSize[0.03], RGBColor[0,0,0]}, PlotRange->{{0,50},{0,50}},AspectRatio->Automatic]

ListPlot[Table[{N[Pbar[p,100]],N[(Sqrt[Pvar[p,100]])]},{p,0.01,0.1,0.01}], Frame->True,GridLines->Automatic,
	PlotStyle->{PointSize[0.02], RGBColor[0.6,0.7,.5]}, PlotRange->{{0,50},{0,50}},AspectRatio->Automatic]

Show[%,%%]

p3=ListPlot[Table[N[{Pbar[p,20],(Sqrt[Pvar[p,20]])}],{p,0.1,.9,.1}],
	PlotStyle->{PointSize[0.02], RGBColor[1,0,0]}, PlotRange->{{0,4},{0,4}}];

Display["~/GEOMETRY/intsdmp.eps",%,"EPS"];

ListPlot[Table[N[{p,Pbar[p,20]}],{p,0.1,.9,.1}],
	PlotStyle->{PointSize[0.02], RGBColor[1,0,0]}, PlotRange->{{0,1},{0,5}}];

Table[N[{Pbar[0.2,n],(Sqrt[Pvar[0.2,n]])}],{n,0,20}]

ListPlot[Table[N[{Pbar[0.2,n],(Sqrt[Pvar[0.2,n]])}],{n,0,20}],
	PlotStyle->PointSize[0.02], PlotRange->{{0,3.5},{0,3.5}}];

(Sqrt[Pvar[p,n]])/Pbar[p,n]//Simplify

R[p_,n_]:=Pvar[p,n]/Pbar[p,n]^2//Simplify

Plot3D[R[p,n]//Evaluate, {p,0,1},{n,5,20}];

R[0.3,20]^(1/2)

R[0.3,5]^(1/2)

Random Simulations

MSG1=(({{21.814410480349345`, 20.565273404957054`, 1.1251695919589921`}, {18.34011090573013`, 18.248765538835244`, 1.0100361840090206`}, {19.872255489021956`, 20.15241049360088`, 0.9723896380846054`}, {18.94876660341556`, 18.10382061110822`, 1.095522793229974`}, {19.822`, 19.129196750953067`, 1.07374579354625`}, {19.64566929133858`, 20.203219052998307`, 0.9455674475654587`}, {20.87029288702929`, 20.657126939995443`, 1.020744976146723`}, {21.70152505446623`, 22.002387173605797`, 0.9728388458601751`}, {20.1046277665996`, 18.16082718003723`, 1.2255211817702756`}, {18.754253308128543`, 17.348044434484972`, 1.168687781264709`}, {20.196356275303643`, 20.235026439636048`, 0.9961815504296393`}, {19.892215568862277`, 19.47378646492349`, 1.0434352562341607`}, {20.724425887265134`, 19.379907218598962`, 1.1435670407259115`}, {21.723311546840957`, 22.13041242442661`, 0.9635473167243888`}, {18.990458015267176`, 18.359536119418227`, 1.0699105517624174`}, {19.843058350100602`, 19.67865628563805`, 1.0167784626077003`}, {19.170825335892513`, 18.40797259054983`, 1.084600256396369`}, {19.978`, 18.41444268499043`, 1.1770281747021003`}, {19.701581027667984`, 17.788634636977537`, 1.2266394500605764`}, {19.82634730538922`, 19.18092240824559`, 1.0684309060807302`}}))

dist[τ_,ν_]:=Abs[PolyGamma[1,ν]-PolyGamma[1,1]]+Abs[Log[20/τ] 1];
Data=Table[{MSG1[[k,1]],MSG1[[k,3]],dist[MSG1[[k,1]],MSG1[[k,3]]]+0.01},
{k,1,20}];
scatt=ListPointPlot3D[Data,BoxRatios->{1,1,1},PlotRange->All,
ViewPoint->{15,3,15},BoxRatios->{1,1,1},PlotStyle->PointSize[Large] ];
s4=Plot3D[Abs[PolyGamma[1,ν]-PolyGamma[1,1]]+Abs[Log[20/τ] 1], 
{τ,18,22},{ν,0.9,1.3}, PlotPoints->50,Mesh->{9,5},
ViewPoint->{15,3,15},BoxRatios->{1,1,1},PlotRange->All,FaceGrids->All,
Boxed->True, Axes->True];
c=ParametricPlot3D[{20,ν,Abs[PolyGamma[1,ν]-PolyGamma[1,1]]+0.01},{ν,0.9,1.3},
ViewPoint->{15,3,15},BoxRatios->{1,1,1},PlotRange->All,
Boxed->True, Axes->True];
s=ParametricPlot3D[{m,1,Abs[Log[20/m]]},{m,18,22},
ViewPoint->{15,3,15},BoxRatios->{1,1,1},PlotRange->All,
Boxed->True, Axes->True];
Show[s4,scatt,c,s]

BMS Data Plot

TauNu={ {17.45,.8136}, {55.01,0.5929}, {16.31,0.7686} ,{14.58,.7271},{20.75,.7776},{18.96,0.7384},{39.14,0.7866},{14.55,0.9524},{13.26,0.7316},{10.18,0.8478},{45.60,0.8462},
{15.53,0.8695},{21.24,0.7689},{23.62,0.8077},{20.96,0.7767},{10.75,0.8467},{16.19,0.8540},{17.13,0.9325},{61.82,0.5796},
{26.70,0.7943}}

bmsdata[τ_,ν_]:=Abs[PolyGamma[1,ν]-PolyGamma[1,1]]+Abs[Log[20/τ] 1]

BMS=Table[{TauNu[[k,1]],TauNu[[k,2]],bmsdata[TauNu[[k,1]],TauNu[[k,2]]]+0.3},
{k,1,20}];

scatt=ListPointPlot3D[BMS,BoxRatios->{1,1,1},PlotRange->{{1,70},{0.49,1.1},{0,6.2} },
ViewPoint->{15,-3,15},BoxRatios->{1,1,1},PlotStyle->PointSize[Large] ]

s4=Plot3D[Abs[PolyGamma[1,ν]-PolyGamma[1,1]]+Abs[Log[20/τ] 1], 
{τ,1,70},{ν,0.49,1.1}, PlotPoints->50,Mesh->{9,5},
ViewPoint->{15,-3,15},BoxRatios->{1,1,1},PlotRange->All,
Boxed->True, Axes->True]

s5=Show[scatt,s4]

Inter-AA gaps

(∑_(r=0)^(n-4))p^4 (1-p)^r  (n-r-4)//Simplify

Q[r_,p_,n_]:=p^4 (1-p)^r  (n-r-4)/((((p^2) (1-(((1-p))^n)+n (((-1+p))^3) p-6 (p^2)+8 (p^3)-3 (p^4)))/(((-1+p))^3)))

Q[r,p,n]//FullSimplify

(∑_(r=0)^(n-4)) Q[r,p,n]//Simplify

(∑_(r=0)^(n-4))r Q[r,p,n]//FullSimplify

Qbar[p_,n_]:= (∑_(r=0)^(n-4)) r Q[r,p,n]

Qvar[p_,n_]:=( (∑_(r=0)^(n-4))r^2  Q[r,p,n])-Qbar[p,n]^2

FullSimplify[((Qbar[p,n]^2)/(Qvar[p,n]))]

Plot3D[-((((((1-p))^n) (2+(-5+n) p)+(((-1+p))^4) (-2+(-3+n) p)))^2)/(-2 (((1-p))^(1+2 n))-(((1-p))^(3+n)) (-4+4 (-2+n) p+(-8+n) (-3+n) (p^2)+(((-4+n))^2) (-3+n) (p^3))+(((-1+p))^7) (2+(-3+n) p (-4+(-2+n) p))), {p,0.001,0.102},{n,50,500}, 
PlotPoints->30, PlotRange->{0,2},Mesh->False];

Plot3D[1, {p,0,0.1},{n,50,500}, 
PlotPoints->20, PlotRange->{0,2},Mesh->False,Lighting->True,LightSources->{{{1.`,0.`,1.`},RGBColor[1,0,0]},{{1.`,1.`,1.`},RGBColor[1,0,0]},{{1.`,0.`,0.`},RGBColor[1,0,0]}}];

Show[%,%% ];

BarChart[Table[Q[r,0.02,500],{r,0,50}],Table[Q[r,0.01,500],{r,0,50}], 
	PlotStyle->{RGBColor[0.5,0.5,0.5],RGBColor[0.1,0.1,0.1]}, BarLabels->None,PlotRange->{0,.025}];

ListPlot[Table[{N[Qbar[0.01,n]],N[(Sqrt[Qvar[0.01,n]])]},{n,50,500, 50}],
	PlotStyle->{PointSize[0.03], RGBColor[1,0,0]}, PlotRange->{{0,80},{0,80}},AspectRatio->Automatic];

ListPlot[Table[{N[Qbar[0.02,n]],N[(Sqrt[Qvar[0.02,n]])]},{n,50,500, 50}],
	PlotStyle->{PointSize[0.03], RGBColor[0,0,1]}, PlotRange->{{0,80},{0,80}},AspectRatio->Automatic];

Show[%,%%];