Sylvester's Four-Point Problem

Author

Eric W. Weisstein
April 15, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/ComputationalGeometry/SylvestersFour-PointProblem.nb.

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

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

Figure

line[l_List]:=Line[Append[l,l[[1]]]]

pts1=Table[{Sqrt[#[[1]]]Cos[2Pi#[[2]]],Sqrt[#[[1]]]Sin[2Pi#[[2]]]}&[Table[Random[],{2}]],{4}];

pts2=Table[{Sqrt[#[[1]]]Cos[2Pi#[[2]]],Sqrt[#[[1]]]Sin[2Pi#[[2]]]}&[Table[Random[],{2}]],{4}];

line[pts1[[ConvexHull[pts1]]]]

Show[GraphicsArray[{
Graphics[{{Dashing[{.02,.02}],Circle[{0,0},1]},PointSize[.04],Point/@pts1,line[pts1[[ConvexHull[pts1]]]]},AspectRatio->Automatic],
Graphics[{{Dashing[{.02,.02}],Circle[{0,0},1]},PointSize[.04],Point/@pts2,line[pts2[[ConvexHull[pts2]]]]},AspectRatio->Automatic]
}]]

Exact

Alikoski[n_]:=Module[{ω=2Pi/n},
(9Cos[ω]^2+52Cos[ω]+44)/(36n^2Sin[ω]^2)
]

Table[1-4Alikoski[n],{n,3,7}]//FullSimplify

N[%]

Triangle

N[2/3,10]

Square

N[25/36,10]

Pentagon

N[1-4((1/180)(9+2(Sqrt[5]))),10]

Hexagon

N[683/972,10]

Disk

N[1-35/(12Pi^2),10]

Monte Carlo

<<DiscreteMath`ComputationalGeometry`

Triangle

quads=Map[Sort,Table[Random[],{10^6},{4},{2}],{2}];//Timing

Show[Graphics[Point/@Flatten[Take[quads,1000],1]],AspectRatio->Automatic]

N[Count[Length/@ConvexHull/@quads,4]/Length[quads],10]//Timing

Square

quads=Table[Random[],{10^6},{4},{2}];//Timing

N[Count[Length/@ConvexHull/@quads,4]/Length[quads],10]//Timing

Pentagon

pent[{x_,y_}]:=Inequalities[RegularPolygon[5],{x,y}]

Show[Graphics[Point/@Select[2Table[Random[],{5000},{2}]-1,pent]],AspectRatio->Automatic]

Length[quads=Partition[Select[2Table[Random[],{10^5},{2}]-1,pent],4]]//Timing

N[Count[Length/@ConvexHull/@quads,4]/Length[quads],10]//Timing

Hexagon

hex[{x_,y_}]:=Inequalities[RegularPolygon[6],{x,y}]

Show[Graphics[Point/@Select[2Table[Random[],{5000},{2}]-1,hex]],AspectRatio->Automatic]

Length[quads=Partition[Select[2Table[Random[],{10^5},{2}]-1,hex],4]]//Timing

N[Count[Length/@ConvexHull/@quads,4]/Length[quads],10]//Timing

Disk

quads=Partition[Sqrt[#1]Through[{Cos,Sin}[2Pi#2]]&@@@Table[Random[],{10^6},{2}],4];//Timing

N[Count[Length/@ConvexHull/@quads,4]/Length[quads],10]//Timing