Disk Line Picking

Author

Eric W. Weisstein
July 31, 2010

This notebook downloaded from http://mathworld.wolfram.com/notebooks/ComputationalGeometry/DiskLinePicking.nb.

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

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

Whole-Disk Analytic Distribution

p[r_,t_]:=Sqrt[r]{Cos[t],Sin[t]}

{p[(Subscript[r, 1]),0],p[(Subscript[r, 2]),(Subscript[θ, 2])]}

Simplify[Sqrt[#.#]&[p[(Subscript[r, 1]),0]-p[(Subscript[r, 2]),(Subscript[θ, 2])]]]

d=(Sqrt[(Subscript[r, 1])-2 Cos[(Subscript[θ, 2])] (Sqrt[(Subscript[r, 1])(Subscript[r, 2])])+(Subscript[r, 2])])

Integrate[1,{(Subscript[r, 1]),0,1},{(Subscript[r, 2]),0,1},{(Subscript[θ, 2]),0,2Pi}]

(Subscript[μ, -1]^′)

(1/(2π))NIntegrate[1/(Sqrt[(Subscript[r, 1])+(Subscript[r, 2])-2 Cos[(Subscript[θ, 2])] (Sqrt[(Subscript[r, 1]) (Subscript[r, 2])])]),{(Subscript[θ, 2]),0,2Pi},{(Subscript[r, 1]),0,1},{(Subscript[r, 2]),0,1},Method->QuasiMonteCarlo,PrecisionGoal->3,MaxPoints->10^7]//Timing

(16/(3π))//N

(1/(2π))Integrate[1/(Sqrt[(Subscript[r, 1])+(Subscript[r, 2])-2 Cos[(Subscript[θ, 2])] (Sqrt[(Subscript[r, 1]) (Subscript[r, 2])])]),{(Subscript[θ, 2]),0,2Pi},{(Subscript[r, 1]),0,1},{(Subscript[r, 2]),0,1}]//Timing

(Subscript[μ, 1]^′)

Numerical

(1/(2π))NIntegrate[(Sqrt[(Subscript[r, 1])+(Subscript[r, 2])-2 Cos[(Subscript[θ, 2])] (Sqrt[(Subscript[r, 1]) (Subscript[r, 2])])]),{(Subscript[θ, 2]),0,2Pi},{(Subscript[r, 1]),0,1},{(Subscript[r, 2]),0,1}]

(1/π)NIntegrate[(Sqrt[(Subscript[r, 1])+(Subscript[r, 2])-2 Cos[(Subscript[θ, 2])] (Sqrt[(Subscript[r, 1]) (Subscript[r, 2])])]),{(Subscript[θ, 2]),0,Pi},{(Subscript[r, 1]),0,1},{(Subscript[r, 2]),0,1},PrecisionGoal->6]//Timing

Exact

128/45/Pi//N

RealDigits[128/45/Pi,10,20]

v4.2

Timing[i=(1/(2π))Integrate[(Sqrt[r1+r2-2 Cos[θ] (Sqrt[r1 r2])]),{θ,0,2π},{r1,0,1},{r2,0,1}]]

v5

Timing[i=(1/(2π))Integrate[(Sqrt[r1+r2-2 Cos[θ] (Sqrt[r1 r2])]),{θ,0,2π},{r1,0,1},{r2,0,1}]]

v6

Timing[i=(1/(2π))Integrate[(Sqrt[r1+r2-2 Cos[θ] (Sqrt[r1 r2])]),{θ,0,2π},{r1,0,1},{r2,0,1}]]

Timing[i=(1/π)Integrate[(Sqrt[r1+r2-2 Cos[θ] (Sqrt[r1 r2])]),{θ,0,π},{r1,0,1},{r2,0,1}]]

(Subscript[μ, 2]^′)

(1/(2π))Integrate[r1+r2-2 Cos[θ] (Sqrt[r1 r2]),{θ,0,2π},{r1,0,1},{r2,0,1}]

(Subscript[μ, n]^′)

v5

(1/(2π))Integrate[(((r1+r2-2 Cos[θ] (Sqrt[r1 r2])))^(n/2)),{θ,0,2π},{r1,0,1},{r2,0,1}]//Timing

v6

(1/(2π))Integrate[(((r1+r2-2 Cos[θ] (Sqrt[r1 r2])))^(n/2)),{θ,0,2π},{r1,0,1},{r2,0,1},Assumptions->n>0]//Timing

(1/(2π))Integrate[(((r1+r2-2 Cos[θ] (Sqrt[r1 r2])))^(n/2)),{θ,0,2π},{r1,0,1},{r2,0,1}]//Timing

Whole-Disk Distribution

PDF

P[s_,R_:1]:=-((2 (s^2) (Sqrt[1-((s^2)/(4 (R^2)))]))/(π (R^3)))+((4 s ArcSec[((2 R)/s)])/(π (R^2)))

Moments

FullSimplify[Integrate[s^n P[s,1],{s,0,2},Assumptions->n>-2]]

((2 Gamma[3+n])/((2+n) Gamma[2+(n/2)] Gamma[3+(n/2)]))/.n->-1

Table[Integrate[s^n P[s,1],{s,0,2}],{n,0,20}]

m=Table[((2 Gamma[3+n])/((2+n) Gamma[2+(n/2)] Gamma[3+(n/2)])),{n,0,30}]

eo=Transpose[Partition[m,2]]

Through[{Numerator,Denominator}[eo[[1]]]]

Through[{Numerator,Denominator}[π eo[[2]]]]

Moments that are Integers

Position[Table[((2 Gamma[3+n])/((2+n) Gamma[2+(n/2)] Gamma[3+(n/2)])),{n,0,1000,2}],_?IntegerQ]//Flatten

p=Position[Table[CatalanNumber[n]/n,{n,500}],_?IntegerQ]//Flatten

2p-2

Probability Curve

Plot[P[s],{s,0,2},AxesLabel->TraditionalForm/@{s,(Subscript[P, 2])[s]},PlotStyle->Red]

CDF

Integrate[-((2 (s^2) (Sqrt[1-((s^2)/(4 (R^2)))]))/(π (R^3)))+((4 s ArcSec[((2 R)/s)])/(π (R^2))),{s,0,s},Assumptions->R>0&&0<s<2R]

Integrate[-(((s^2) (Sqrt[4-((s^2)/(R^2))]))/(π (R^3)))+((4 s ArcSec[((2 R)/s)])/(π (R^2))),{s,0,s},Assumptions->2 R>s&&s>0&&R>0&&2 R s>1]

FullSimplify[(1/(4 π (R^4)))(2 (R^2) s (Sqrt[4 (R^2)-(s^2)])-(s^3) (Sqrt[4 (R^2)-(s^2)])-2 R s (Sqrt[1-4 (R^2) (s^2)])+8 (R^2) (s^2) ArcCos[2 R s]-8 (R^4) ArcCsc[((2 R)/s)]+ArcSin[2 R s]),0<s<2R]

FullSimplify[(1/(8 π (R^4)))(π+4 (R^2) s (Sqrt[4 (R^2)-(s^2)])-2 (s^3) (Sqrt[4 (R^2)-(s^2)])-4 I R s (Sqrt[-1+4 (R^2) (s^2)])-16 (R^4) ArcCsc[((2 R)/s)]+2 I (-1+8 (R^2) (s^2)) Log[2 R s+(Sqrt[-1+4 (R^2) (s^2)])]),0<s<2R]

(1/(8 π (R^4)))(π+4 (R^2) s (Sqrt[4 (R^2)-(s^2)])-2 (s^3) (Sqrt[4 (R^2)-(s^2)])-4 I R s (Sqrt[-1+4 (R^2) (s^2)])-16 (R^4) ArcCsc[((2 R)/s)]+2 I (-1+8 (R^2) (s^2)) Log[2 R s+(Sqrt[-1+4 (R^2) (s^2)])])/.{R->1,s->2}

N[%]

With[{R=1},Plot[(1/(4 π (R^4)))(2 (R^2) s (Sqrt[4 (R^2)-(s^2)])-(s^3) (Sqrt[4 (R^2)-(s^2)])-2 R s (Sqrt[1-4 (R^2) (s^2)])+8 (R^2) (s^2) ArcCos[2 R s]-8 (R^4) ArcCsc[((2 R)/s)]+ArcSin[2 R s]),{s,0,2}]]

Plot

RandomLines[n_]:=Table[{Hue[i/n],
Line[Table[Sqrt[#1]{Cos[#2],Sin[#2]}&[Random[],Random[Real,{0,2Pi}]],{2}]]},{i,n}]

l=RandomLines[50];
movie=Table[Graphics[
{Circle[{0,0},1],Thickness[.015],Take[l,n]},
AspectRatio->Automatic],{n,0,Length[l]}];

Export[gifs<>"dislinpk.gif",Show[#,PlotRange->Table[{-1,1},{2}]]&/@movie]//Timing

Show[Graphics[{Circle[{0,0},1],Thickness[.015],l},AspectRatio->Automatic]]