Square Point Picking

Author

Eric W. Weisstein
February 14, 2006

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

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

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

Random

Show[Graphics[{Line[{{0,0},{1,0},{1,1},{0,1},{0,0}}],Red,PointSize[.02],Point/@Table[Random[Real],{250},{2}]}],AspectRatio->Automatic]

Average Distance to a Corner

Integrate[(Sqrt[(x^2)+(y^2)]),{x,0,1},{y,0,1}]//Timing

Moments

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

Table[(1/(4 (((1+n))^2)))(-I (1+n) Beta[-1,(1/2),1+n]+(((-1))^n) (-I (1+n) Beta[-1,-(1/2)-n,1+n]+((π^(3/2))/(Gamma[-1-n] Gamma[(3/2)+n])))),{n,3}]//FullSimplify

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

Distance to the Center

Monte Carlo

pts=Table[Random[Real],{10^6},{2}];
l=Sqrt[Plus@@((#-1/2)^2)]&/@pts;//Timing

Through[{Mean,Variance}[l]]

Distribution

<<Graphics`Graphics`

BarChart[Length/@Split[Ceiling[200Sort[l]]],Ticks->None,BarEdges->None,BarSpacing->-.2,AxesLabel->TraditionalForm/@{d,P[d]}]

Average

Integrate[(Sqrt[(((x-(1/2)))^2)+(((y-(1/2)))^2)]),{x,0,1},{y,0,1}]//Timing

N[%]

Integrate[Boole[0<x<1&&0<y<1](Sqrt[(((x-(1/2)))^2)+(((y-(1/2)))^2)]),{x,-∞,∞},{y,-∞,∞}]//Timing

Distribution

v5.2

Integrate[DiracDelta[(d^2)-((((x-(1/2)))^2)+(((y-(1/2)))^2))],{x,0,1},{y,0,1}]//Timing

v6

Integrate[DiracDelta[d-(Sqrt[((((x-(1/2)))^2)+(((y-(1/2)))^2))])],{x,0,1},{y,0,1}]//Timing

Integrate[DiracDelta[(d^2)-((((x-(1/2)))^2)+(((y-(1/2)))^2))],{x,0,1},{y,0,1}]//Timing

FullSimplify[((1/2)+(I/2)) (π-(1-I) ArcTan[((((-1+4 (d^2)) (-1+4 ((Conjugate[d])^2))))^(1/4))]+(1-I) ArcTanh[((((-1+4 (d^2)) (-1+4 ((Conjugate[d])^2))))^(1/4))]),d>0]

...wrong...

Distance to Corner

Monte Carlo

pts=Table[Random[Real],{10^6},{2}];
l=Norm/@pts;//Timing

Through[{Min,Max}[l]]

Through[{Mean,Variance}[l]]

Count[l,_?(.75<#<.77&)]/10^6/.02

Count[l,_?(.98<#<1.02&)]/10^6/.04

Distribution

<<Graphics`Graphics`

BarChart[Length/@Split[Ceiling[200Sort[l]]],Ticks->None,BarEdges->None,BarSpacing->-.2,AxesLabel->TraditionalForm/@{d,P[d]}]

Average

Integrate[(Sqrt[(x^2)+(y^2)]),{x,0,1},{y,0,1}]

N[%]

Integrate[Boole[0<x<1&&0<y<1](Sqrt[(x^2)+(y^2)]),{x,-∞,∞},{y,-∞,∞}]

Distribution

v5.2

Integrate[DiracDelta[d-(Sqrt[(x^2)+(y^2)])],{x,0,1},{y,0,1}]//Timing

Integrate[DiracDelta[(d^2)-((x^2)+(y^2))],{x,0,1},{y,0,1}]//Timing

Integrate[DiracDelta[d-(Sqrt[(x^2)+(y^2)])],{y,0,1}]

v6

Integrate[DiracDelta[d-(Sqrt[(x^2)+(y^2)])],{x,0,1},{y,0,1}]//Timing

By Hand

red=Reduce[d==(Sqrt[x^2+y^2])&&0<x<1&&0<y<1&&d>0,{x,y},Reals]

Integrate[DiracDelta[y-(Sqrt[(d^2)-(x^2)])]Boole[
Or[
0<d≤1&&0<x<d,
1<d<(Sqrt[2])&&(Sqrt[-1+(d^2)])<x<1
]],{x,0,1},{y,0,1}]

Integrate[DiracDelta[y-(Sqrt[(d^2)-(x^2)])],{x,0,1},{y,0,1},Assumptions->d>0]

Integrate[Boole[
Or[
0<d≤1&&0<x<d,
1<d<(Sqrt[2])&&(Sqrt[-1+(d^2)])<x<1
]],{x,0,1},{y,0,1}]

prob[d_]:=Piecewise[{{d,0<d≤1},{1-Sqrt[-1+d^2],1<d<(Sqrt[2])}}]

Integrate[prob[d],{d,0,(Sqrt[2])}]

Integrate[d prob[d],{d,0,(Sqrt[2])}]//N

Plot[prob[d],{d,0,(Sqrt[2])},PlotStyle->Red]

Plot[%,{x,0,(Sqrt[2])},PlotStyle->Red]

%205/.x->Sqrt[2]//FullSimplify

1/%

Integrate[prob[d],{d,0,(Sqrt[2])}]

(1/6) ((Sqrt[2])+ArcSinh[1])//N

N[%173 /(Sqrt[2])]

NIntegrate[((d  prob[d])/((1/6) ((Sqrt[2])+ArcSinh[1]))),{d,0,(Sqrt[2])}]

From Nearest Corner

RegularPolygon[4,(1/2)]

mind=Min[Sqrt[(x-#[[1]])^2+(y-#[[2]])^2]&/@RegularPolygon[4,(1/2)][[1]]]

NIntegrate[Boole[Inequalities[RegularPolygon[4,(1/2)],{x,y}]]mind,{x,-∞,∞},{y,-∞,∞}]

Timing[d=Integrate[Boole[Inequalities[RegularPolygon[4,(1/2)],{x,y}]]mind,{x,-∞,∞},{y,-∞,∞}]]

N[d]

From Farthest Corner

maxd=Max[Sqrt[(x-#[[1]])^2+(y-#[[2]])^2]&/@RegularPolygon[4,(1/2)][[1]]]

NIntegrate[Boole[Inequalities[RegularPolygon[4,(1/2)],{x,y}]]maxd,{x,-∞,∞},{y,-∞,∞}]

Timing[d=Integrate[Boole[Inequalities[RegularPolygon[4,(1/2)],{x,y}]]maxd,{x,-∞,∞},{y,-∞,∞}]]

N[d]

<<Utilities`Simplify`

FullSimplify[LogExpand[d]]

Table[(((1+(Sqrt[2])))^n),{n,9}]//Expand

(1/24) (18-4 (Sqrt[10])-8 (Sqrt[2]) ArcCsch[2]-(Sqrt[2]) ArcSinh[2]+9(Sqrt[2]) Log[1+(Sqrt[2])])//FullSimplify

N[%]

Convex Hull

<<DiscreteMath`ComputationalGeometry`

p=Table[Random[Real],{its=500},{n=5000},{2}];
hulls=ConvexHull/@p;//Timing

polys=#1[[#2]]&@@@Transpose[{p,hulls}];

Show[Graphics[{
ClosedLine[poly],
Point/@p,
{Red,PointSize[.02],Point/@poly}
}
],AspectRatio->Automatic]

Area

n(1-Mean[Area[Evaluate[Polygon[#]]]&/@polys])/Log[n]

8/3.

Perimeter

Mean

(4-Mean[Plus@@(Norm/@(Subtract@@@Partition[#,2,1,1]))&/@polys])(Sqrt[n])

g=(1/(2Pi))^(3/2)Gamma[1/4]^2;
m=1/G;
2(Sqrt[π])m

N[%]

Variance

n Variance[Plus@@(Norm/@(Subtract@@@Partition[#,2,1,1]))&/@polys]

N[i=Sqrt[π]m/2]

φ[s_]:=(1/(2(((s+1))^2)))-(1/(4s(s+1)))+(1/(4s))((ArcTan[(Sqrt[s])])/(Sqrt[s]))
ψ[s_]:=(15/(s^3))+(1/(s^2))-((15/(s^3))+(6/(s^2))-(1/s))((ArcTan[(Sqrt[s])])/(Sqrt[s]))

ints={2,
-4int[((Sqrt[1+(s^2)])-s)φ[s-1],{s,1,∞}],
(4/5)int[((((Sqrt[1+(s^2)])-s))^2)(s^(-2)),{s,1,∞}],
(1/4)int[((Sqrt[1+(s^2)])-s)((Sqrt[1+(t^2)])-t)ψ[(t/s)-1](s^(-3)),{t,1,∞},{s,1,t}],
(1/8)int[((Sqrt[1+(s^2)])-s)((Sqrt[1+(t^2)])-t)ψ[s t-1],{t,1,∞},{s,1,∞}]
};

{ints[[4]]/.int[x__]:>NIntegrate[x,Method->QuasiMonteCarlo],Drop[ints,{4}]/.int->NIntegrate}//Flatten

Plus@@%

Take[ints,3]/.int:>Integrate

FullSimplify[ints[[2]],s>1]

soln=Expand[4(2+i1+(4/5) (-1+2 (Sqrt[2])-2 Log[1+(Sqrt[2])])+i2+i3-((((Sqrt[π])m/2))^2))]

soln/.{
i1->-4NIntegrate[((Sqrt[1+(s^2)])-s)φ[s-1],{s,1,∞}],
i2->(1/4)NIntegrate[((Sqrt[1+(s^2)])-s)((Sqrt[1+(t^2)])-t)ψ[(t/s)-1](s^(-3)),{t,1,∞},{s,1,t},Method->QuasiMonteCarlo],
i3->(1/8)NIntegrate[((Sqrt[1+(s^2)])-s)((Sqrt[1+(t^2)])-t)ψ[s t-1],{t,1,∞},{s,1,∞}]
}

(Subscript[I, 1])

((Sqrt[1+(s^2)])-s)φ[s-1]

-4int[((Sqrt[1+(s^2)])-s)φ[s-1],{s,1,∞}]

-4NIntegrate[(((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(s^2) ArcTan[(Sqrt[-1+s])]))/(4 (((-1+s))^(3/2)) (s^2))),{s,1,∞}]

-4NIntegrate[(((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(s^2) ArcTan[(Sqrt[-1+s])]))/(4 (((-1+s))^(3/2)) (s^2))),{s,1,∞}]

Apart[(-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(s^2) ArcTan[(Sqrt[-1+s])])]

Integrate[((2 (Sqrt[-1+s]) s-(Sqrt[-1+s]) (s^2))/(4 (((-1+s))^(3/2)) (s^2))),{s,1,∞}]

<<Graphics`Colors`

Serie

Plot[(((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(s^2) ArcTan[(Sqrt[-1+s])]))/(4 (((-1+s))^(3/2)) (s^2))),{s,1,10},PlotStyle->Red]

Plot[(((-s+(Sqrt[1+(s^2)])) ((s^2) ArcTan[(Sqrt[-1+s])]))/(4 (((-1+s))^(3/2)) (s^2))),{s,1,10},PlotStyle->Red]

Series[(((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(s^2) ArcTan[(Sqrt[-1+s])]))/(4 (((-1+s))^(3/2)) (s^2))),{s,Infinity,6}]

v4.0

Integrate[(((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(s^2) ArcTan[(Sqrt[-1+s])]))/(4 (((-1+s))^(3/2)) (s^2))),{s,1,∞}]

v4.2.1

Integrate[(((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(s^2) ArcTan[(Sqrt[-1+s])]))/(4 (((-1+s))^(3/2)) (s^2))),{s,1,∞}]

v5

Integrate[(((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(s^2) ArcTan[(Sqrt[-1+s])]))/(4 (((-1+s))^(3/2)) (s^2))),{s,1,∞}]//Timing

v6

Integrate[TrigToExp[(((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(s^2) ArcTan[(Sqrt[-1+s])]))/(4 (((-1+s))^(3/2)) (s^2)))],{s,1,∞}]//Timing

TrigToExp[(((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(s^2) ArcTan[(Sqrt[-1+s])]))/(4 (((-1+s))^(3/2)) (s^2)))]

-4NIntegrate[(1/(4 (((-1+s))^(3/2)) (s^2)))((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(1/2) I (s^2) (Log[((1-I (Sqrt[-1+s]))/(1+I (Sqrt[-1+s])))]))),{s,1,∞}]

-4Integrate[(1/(4 (((-1+s))^(3/2)) (s^2)))((-s+(Sqrt[1+(s^2)])) ((-2+s) (Sqrt[-1+s])+(1/2) I (s^2) Log[((1-I (Sqrt[-1+s]))/(1+I (Sqrt[-1+s])))])),{s,1,∞}]//Timing

(Subscript[I, 2])

(1/4)NIntegrate[((Sqrt[1+(s^2)])-s)((Sqrt[1+(t^2)])-t)ψ[(t/s)-1](s^(-3)),{t,1,∞},{s,1,t},Method->QuasiMonteCarlo]

(1/4)NIntegrate[((Sqrt[1+(s^2)])-s)((Sqrt[1+(t^2)])-t)ψ[(t/s)-1](s^(-3)),{t,1,∞},{s,1,t},WorkingPrecision->20,MaxRecursion->15]

Integrate[((Sqrt[1+(s^2)])-s)((Sqrt[1+(t^2)])-t)ψ[(t/s)-1](s^(-3)),{s,1,t},Assumptions->t>1]

(Subscript[I, 3])

(1/8)NIntegrate[((Sqrt[1+(s^2)])-s)((Sqrt[1+(t^2)])-t)ψ[s t-1],{t,1,∞},{s,1,∞}]

v4.2.1

Integrate[((Sqrt[1+(s^2)])-s)ψ[s t-1],{s,1,∞}]//Timing

Integrate[((Sqrt[1+(t^2)])-t)ψ[s t-1],{t,1,∞}]//Timing

v5

Integrate[((Sqrt[1+(s^2)])-s)ψ[s t-1],{s,1,∞}]//Timing

Integrate[((Sqrt[1+(t^2)])-t)ψ[s t-1],{t,1,∞}]//Timing

v6

Integrate[((Sqrt[1+(s^2)])-s)ψ[s t-1],{s,1,∞}]//Timing

Integrate[((Sqrt[1+(t^2)])-t)ψ[s t-1],{t,1,∞}]//Timing

Vertices

Mean[Length/@hulls]-(8/3)Log[n]//N

8/3(EulerGamma-Log[2])//N