Discrepancy Theorem

Author

Eric W. Weisstein
April 16, 2004

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

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

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

Notes

Code could be cleaned up

Figure

S[{u_,v_},r_]:=Length[Select[r,#[[1]]<u && #[[2]] <v&]]

Roth[r_List,dx_]:=Module[{n=Length[r],x,y},
		dx^2 Sum[(S[{x,y},r]-n x y)^2 ,{x,0,1,dx},{y,0,1,dx}]/Log[n]
]

Roth[n_Integer,dx_]:=Module[{r=Table[{Random[],Random[]},{n}],x,y},
		dx^2 Sum[(S[{x,y},r]-n x y)^2 ,{x,0,1,dx},{y,0,1,dx}]/Log[n]
]

r1=Table[{Random[],Random[]},{200}];
r2=Table[{Random[],Random[]},{200}];

PointsPlot[r_,opts___]:=Show[Graphics[{Line[{{0,0},{0,1},{1,1},{1,0},{0,0}}],
			{PointSize[.01],Point/@r}}],opts,AspectRatio->Automatic]

Show[GraphicsArray[{PointsPlot[r1,DisplayFunction->Identity],
			PointsPlot[r2,DisplayFunction->Identity]}],
	DisplayFunction->$DisplayFunction]

{Roth[r1,.005],Roth[r2,.005]}

Roth[r,.005]

Roth[r,.01]

Roth[r,.02]

Roth[r,.03]

Roth[10,.01]

Table[Roth[10,.01],{10}]

Table[Roth[10,.01],{10}]

Table[Roth[20,.01],{10}]

l={};
Do[
	roth=Roth[100,.01];
	Print[i,". ",roth];
	l=Append[l,roth],
	{i,10}
];
l

l={};
Do[
	roth=Roth[1000,.01];
	Print[i,". ",roth];
	l=Append[l,roth],
	{i,10}
];
l