Coin flip partitions

On 0 (head) step right, on 1 (tail) step up. For each tail record the number of heads so far as a new part in the partition. In current draft always start with a step right, creating the top-right box in a French style Young diagram

RandomCoinFlips[M_]:=Table[Random[Integer,1],{i,1,M}]

CoinFlipsToPartitionFrom[{},h_]:={}

CoinFlipsToPartitionFrom[{f_, fs___}, h_]/;f==0 := CoinFlipsToPartitionFrom[List[fs],h+1]

CoinFlipsToPartitionFrom[{f_,fs___},h_]/;f==1:={h}~Join~CoinFlipsToPartitionFrom[List[fs],h]

CoinFlipsToPartition[hts_]:=CoinFlipsToPartitionFrom[hts,1]//Reverse

RandomPartition[M_]:=CoinFlipsToPartition[RandomCoinFlips[M]]

RandomPartitions[M_,T_]:=Table[RandomPartition[M],{i,1,T}]

Example

CoinFlipsToPartition[{1,0,1,1,0,0,1,0,1,1,0,1}]

RandomPartitions[10,20]

Distribution of sizes

RandomSizes[M_,T_]:=Table[Plus@@p,{p,RandomPartitions[M,T]}]

MeanSize[M_,T_]:=Mean[RandomSizes[M,T]]

ExpectedSize[M_]:=M*(M+3)/8

{RandomSizes[16,200000]//Histogram,MeanSize[16,200000]//N,ExpectedSize[16]//N}

{V[16],V[16]//N,Sqrt[V[16]],Sqrt[V[16]]//N}

{RandomSizes[32,200000]//Histogram,MeanSize[32,200000]//N,ExpectedSize[32]}

{V[32],V[32]//N,Sqrt[V[32]],Sqrt[V[32]]//N}

{RandomSizes[80,200000]//Histogram,MeanSize[80,200000]//N,ExpectedSize[80]}

{V[80],V[80]//N,Sqrt[V[80]],Sqrt[V[80]]//N}

Big example for write-up: this will take a while to evaluate, and won’t give exactly the same results as shown below

rs80=RandomSizes[80,1000000]

{{rs80//Min,rs80//Max},{rs80//Mean//N,StandardDeviation[rs80]//N},{V[80],V[80]//N,Sqrt[V[80]],Sqrt[V[80]]//N},Select[rs80,(#≥530)~And~(#≤1130)&]//Length,Select[rs80,(#>530)~And~(#<1130)&]//Length,Select[rs80,(#≥518)~And~(#≤1142)&]//Length}

{fs80=RandomCoinFlips[80];fs80/.{0->H,1->T},CoinFlipsToPartition[fs80]}

Histogram[rs80,{350,1320,25},ChartStyle->Directive[White,EdgeForm[{Black,Thickness[0.0025]}]]]

Variance calculation for fat tails

Sum[t^2,{t,1,m}]//Expand

Sum[(t^2-1)/16,{t,1,m}]//Factor

Sum[(t^2-1)/16,{t,1,m}]//Expand

m/4 + Sum[(t^2-1)/16,{t,1,m}]//Simplify//Factor

m/4 + Sum[(t^2-1)/16,{t,1,m}]//Simplify//Factor//Expand

V[m_]:=((19 m)/96)+((m^2)/32)+((m^3)/48)

Lower bound

Plot[1/d*(1-1/d^2),{d,1,3}]

Solve[D[1/d*(1-1/d^2),d]==0,d]

4/(3Sqrt[3]*m^(3/2))/.{m->Sqrt[8n/(1+ϵ)]}//Simplify

Explicit lower bound: take ϵ = 1/8 and choose d = 3 so 1/9 < 1/8. We then need m sufficiently large that 3m^(3/2)/4 + 3m/8 < m^2/64

Log[2^Sqrt[8]]//N

Sqrt[8]*Log[2]//N

(8Sqrt[n]/3)^2/8*(1+1/8)

Log[2^(8/3)]//N

2*Sqrt[Pi^2/6]//N

4/(3Sqrt[3]*m^(3/2))/.{m->8*Sqrt[n]/3}//Simplify

Plot[{Sqrt[3]*m^(3/2)/4+3m/8,m^2/64},{m,0,10000},PlotStyle->{Red,Black}]

m/.Solve[Sqrt[3]*m^(3/2)/4+3m/8==m^2/64,m]

m/.Solve[Sqrt[3]*m^(3/2)/4+3m/8==m^2/64,m]//N

Since n = (3m/8)^2, we have

(815.2935059634515*3/8)^2

L[nMax_]:=ListPlot[TemporalData[{Table[Log[PartitionsP[n]],{n,1,nMax}],Table[8*Log[2]*Sqrt[n]/3-Log[2^(5/2)*n^(3/4)],{n,1,nMax}]},
{Range[1,nMax]}]]

L[1000]

L[100]

L[10]