Line Point Picking

Author

Eric W. Weisstein
April 13, 2008

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

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

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

Distribution

Monte Carlo

data=Table[{#,1-#}&[Random[]],{10^6}];//Timing

Minimum

Integrate[DiracDelta[t-Min[x,1-x]],{x,0,1},Assumptions->0<x<1]

pw=PiecewiseExpand[DiracDelta[t-Min[x,1-x]],0≤x≤1]

Integrate[Evaluate[pw],{x,0,1},Assumptions->0<x<1]

Simplify[Integrate[DiracDelta[t-x],{x,0,1/2}]+Integrate[DiracDelta[-1+t+x],{x,1/2,1}]]

Plot[2 UnitStep[(1/2)-t] UnitStep[t],{t,0,1}]

small=Min/@data;

Through[{Min,Max}[small]]

Through[{Mean,Variance}[small]]

<<BarCharts`

With[{bin=100},BarChart[Length/@Split[Ceiling[bin Sort[small]]],Ticks->None,BarEdges->None,BarSpacing->-.2,PlotRange->{{0,bin/2},All},AxesLabel->TraditionalForm/@{d,P[d]}]]

Maximum

V5

Integrate[DiracDelta[t-x]Max[x,1-x],{t,0,1},Assumptions->0<x<1]

V7

Integrate[DiracDelta[t-x]Max[x,1-x],{t,0,1},Assumptions->0<x<1]

Integrate[Max[1-x,x],{x,0,1}]

Plot[Max[1-x,x],{x,0,1}]

PiecewiseExpand[Max[1-x,x],0≤x≤1]

large=Max/@data;

Through[{Min,Max}[large]]

Through[{Mean,Variance}[large]]

1/48.

With[{bin=100},BarChart[Length/@Split[Ceiling[bin Sort[large]]],Ticks->None,BarEdges->None,BarSpacing->-.2,PlotRange->{{0,bin/2},All},AxesLabel->TraditionalForm/@{d,P[d]}]]

Mean

Integrate[x,{x,0,1}]

Mean[Table[Random[],{10^6}]]

all=Flatten[data];

Through[{Min,Max}[all]]

Through[{Mean,Variance}[all]]

1/12.

With[{bin=100},BarChart[Length/@Split[Ceiling[bin Sort[all]]],Ticks->None,BarEdges->None,BarSpacing->-.2,PlotRange->{{0,bin},All},AxesLabel->TraditionalForm/@{d,P[d]}]]

Mean of Smallest

Integrate[Min[x,1-x],{x,0,1}]

Mean of Largest

Integrate[Max[x,1-x],{x,0,1}]

Mean of Both

Integrate[(1/2)(Min[x,1-x]+Max[x,1-x]),{x,0,1}]

Small/Large Ratio

Mean

<<Utilities`Simplify`

2Integrate[(x/(1-x)),{x,0,1/2}]//Simplify//LogExpand

Integrate[((Min[x,1-x])/(Max[x,1-x])),{x,0,1}]

With Cutoff

2Integrate[(x/(1-x)),{x,ϵ,1/2},Assumptions->0<ϵ<1/2]//Simplify

Distribution

Integrate[DiracDelta[t-((Min[x,1-x])/(Max[x,1-x]))],{x,0,1}]

PiecewiseExpand[((Min[x,1-x])/(Max[x,1-x])),0<x<1]

2Integrate[DiracDelta[t-(x/(1-x))],{x,0,1},Assumptions->0<t<1]

2Integrate[DiracDelta[t-(-(x/(-1+x)))],{x,0,1},Assumptions->0<t<1]

Integrate[(2/(((1+t))^2)),{t,0,x},Assumptions->0<x<1]

((2x)/(1+x))/.x->1

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
{
Plot[(2/(((1+x))^2)),{x,0,1},PlotStyle->Red,PlotRange->{0,2},AxesLabel->TraditionalForm/@{x,PDF[x]}],
Plot[((2 x)/(1+x)),{x,0,1},PlotStyle->Red,AxesLabel->TraditionalForm/@{x,CDF[x]}]
}]],ImageSize->500]

Raw Moments

Integrate[(2/(((1+x))^2))(x^n),{x,0,1},Assumptions->n≥0]

Limit[%,n->0]

<<Utilities`Simplify`

(raw=Table[-1-n PolyGamma[0,(n/2)]+n PolyGamma[0,((1+n)/2)],{n,10}]//FunctionExpand//Simplify//LogExpand)//ColumnForm

Central Moments

Integrate[(2/(((1+x))^2))(((x-(-1+2 Log[2])))^2),{x,0,1}]//LogExpand//Factor

Integrate[(2/(((1+x))^2))(((x-(-1+2 Log[2])))^n),{x,0,1},Assumptions->n≥0&&n∈Integers]

FunctionExpand[%]

Table[(1/(-1+n))(-2 (1-n+n Hypergeometric2F1[1,1,2-n,Log[4]]) (((1-Log[4]))^n)+(1-n+n Hypergeometric2F1[1,1,2-n,Log[2]]) (((2-Log[4]))^n)),{n,4}]

Table[Integrate[(2/(((1+x))^2))(((x-(-1+2 Log[2])))^n),{x,0,1}],{n,4}]//LogExpand

(central=Integrate[(2/(((1+x))^2))(((x-(-1+2 Log[2])))^n),{x,0,1},Assumptions->n≥0&&n∈Integers])//Timing

(central=Integrate[(2/(((1+x))^2))(((x-(-1+2 Log[2])))^n),{x,0,1},Assumptions->n≥0])

FunctionExpand[int]

FullSimplify[Subtract@@{(1/(-1+n))((2^n) Hypergeometric2F1[1-n,-n,2-n,Log[2]]-2 Hypergeometric2F1[1-n,-n,2-n,Log[4]]),(((-Beta[Log[2],1-n,1+n]+Beta[Log[4],1-n,1+n]) ((Log[4])^n))/(Log[2]))}]

int=(1/(-1+n))((2^n) Hypergeometric2F1[1-n,-n,2-n,Log[2]]-2 Hypergeometric2F1[1-n,-n,2-n,Log[4]]);

With[{n=2.44+1.2I},NIntegrate[(2/(((1+x))^2))(((x-(-1+2 Log[2])))^n),{x,0,1}]]

int/.n->2.44+1.2I

Plot[Evaluate[Through[{Re,Im}[(1/(-1+n))((2^n) Hypergeometric2F1[1-n,-n,2-n,Log[2]]-2 Hypergeometric2F1[1-n,-n,2-n,Log[4]])]]],{n,1,5},PlotStyle->List/@{Red,Blue},PlotRange->All]

g[n_]:=(-1)^(n-1)*((2^n*(n-1))/(Gamma[n+1]*Gamma[n]))*Log[2]^n*Pochhammer[1-n,n-1]*Pochhammer[-n,n-1]+Sum[((2^n-2^(k+1))/(n-1))*Log[2]^k*((Pochhammer[1-n,k]*Pochhammer[-n,k])/(Pochhammer[2-n,k]*k!)),{k,0,n-2}]

FullSimplify[g[n],n∈Integers]

FullSimplify[g[n],n∈Integers&&n>0]

g[n]//TraditionalForm

g/@Range[5]

(Subscript[μ, n_]):=g[n]

((Subscript[μ, 3])/((Subscript[μ, 2])^(3/2)))//FullSimplify

Together[Expand[((Subscript[μ, 4])/((Subscript[μ, 2])^2))-3]]//FullSimplify

Monte Carlo

sl=(Divide@@Sort[#])&/@data;//Timing

Through[{Min,Max}[sl]]

Through[{Mean,Variance}[sl]]

{2Log[2]-1,2-4 ((Log[2])^2)}//N

With[{bin=100},BarChart[Length/@Split[Ceiling[bin Sort[sl]]],Ticks->None,BarEdges->None,BarSpacing->-.2,PlotRange->{{0,bin},All},AxesLabel->TraditionalForm/@{d,P[d]}]]

Large/Small Ratio

Mean

2Integrate[((1-x)/x),{x,0,1/2}]

Integrate[((Max[x,1-x])/(Min[x,1-x])),{x,0,1}]

With Cutoff

2Integrate[((1-x)/x),{x,ϵ,1/2},Assumptions->0<ϵ<1/2]//FullSimplify

Integrate[((Max[x,1-x])/(Min[x,1-x])),{x,ϵ,1-ϵ},Assumptions->0<ϵ<1/2]//FullSimplify

Distribution

Integrate[DiracDelta[t-((Max[x,1-x])/(Min[x,1-x]))],{x,0,1}]

PiecewiseExpand[((Max[x,1-x])/(Min[x,1-x])),0<x<1]

2Integrate[DiracDelta[t-((1-x)/x)],{x,0,1},Assumptions->0<t<1]

Integrate[(2/(((1+t))^2)),{t,1,x},Assumptions->x>1]

Limit[((-1+x)/(1+x)),x->∞]

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
{
Plot[(2/(((1+x))^2)),{x,1,100},PlotStyle->Red,AxesLabel->TraditionalForm/@{x,PDF[x]}],
Plot[((-1+x)/(1+x)),{x,1,100},PlotStyle->Red,AxesLabel->TraditionalForm/@{x,CDF[x]}]
}]],ImageSize->500]

Central Moments

Integrate[(2/(((1+x))^2))(x^n),{x,1,∞},Assumptions->n≥1]

Table[Integrate[(2/(((1+x))^2))(x^n),{x,1,∞}],{n,0,3}]

Monte Carlo

ls=1/sl;

Through[{Min,Max}[ls]]

Through[{Mean,Variance}[ls]]

With[{bin=100},BarChart[Length/@Split[Ceiling[bin Sort[ls]]],Ticks->None,BarEdges->None,BarSpacing->-.2,PlotRange->{{0,20bin},All},AxesLabel->TraditionalForm/@{d,P[d]}]]

Two Random Cuts give lines segments that form a triangle

ineq[x1_,x2_]:=TriangleQ[{Min[x1,x2],Abs[x2-x1],1-Max[x1,x2]}]

Integrate[1,{x1,0,1},{x2,0,1}]

Integrate[Boole[ineq[x1,x2]],{x1,0,1},{x2,0,1}]

With[{n=10^5},Count[ineq@@@RandomReal[{0,1},{n,2}],True]/n]//N//Timing