Chapter 18. Empirical Process Theory#
Figure 18.1. Non-UniformConvergence#
x <- seq(.2,1,.001)
b <- -dbeta(x,2,2)
b1 <- b - dbeta(x,15,2)/4
b2 <- b - dbeta(x,30,2)/6.5
b3 <- b - dbeta(x,70,2)/13.5
t1 <- x[which.min(b1)]
t2 <- x[which.min(b2)]
t3 <- x[which.min(b3)]
leg1 <- expression(S[n[1]](theta))
leg2 <- expression(S[n[2]](theta))
leg3 <- expression(S[n[3]](theta))
legb <- expression(S(theta))
plot(x,b3,type="l",lty=4,xaxs="i",yaxs="i",xlim=c(.3,1.01),ylim=c(-2.52,0.01),ylab="",xlab="",xaxt="n",yaxt="n",bty="n")
abline(v=1)
abline(h=-2.5)
lines(x,b3,lty=6)
lines(x,b2,lty=5)
lines(x,b1,lty=2)
lines(x,b,lty=1)
legend("bottomleft",legend=c(legb,leg1,leg2,leg3),lty=c(1,2,5,6),y.intersp=1.3,cex=.75,bty="n")
par(xpd=NA)
Figure 18.2. Uniform Convergence#
x <- seq(-1,1,by=0.01)
S <- (x^2)
ep <- .15
S1 <- S + ep
S2 <- S - ep
Sn <- S + sin(x*10)*ep*.75
plot(x,S,type="l",lty=1,xaxs="i",yaxs="i",xlab="",ylab="",xlim=c(-1,1),ylim=c(-.35,1.3),lwd=2,xaxt="n",yaxt="n",bty="n")
lines(x,S1,lty=2)
lines(x,S2,lty=2)
lines(x,Sn)
leg1 <- expression(S(theta)+epsilon)
leg2 <- expression(S(theta)-epsilon)
leg3 <- expression(S(theta))
leg4 <- expression(S[n](theta))
text(-.6,1,leg1,cex=.8)
text(-.8,0,leg2,cex=.8)
text(.25,.4,leg3,cex=.8)
text(-.2,-.3,leg4,cex=.8)
arrows(-.8,.05,-.7,.32,angle=20,length=.1)
arrows(-.6,.95,-.65,.6,angle=20,length=.1)
arrows(.25,.35,.4,.2,angle=20,length=.1)
arrows(-.2,-.25,-.15,-.1,angle=20,length=.1)
Figure 18.3. Packing Numbers#
suppressPackageStartupMessages(library(spatstat))
plot.new()
plot.window(c(-4,4),c(-4,4))
W1 <- ellipse(a=3.9,b=4.3,centre=c(0,0),phi=0,npoly=1024)
plot(W1,add=TRUE)
points(0,0,pch=19,col="black",cex=1.0)
points(3.77,0,pch=19,col="black",cex=1.0)
points(-3.77,0,pch=19,col="black",cex=1.0)
points(2,3.5,pch=19,col="black",cex=1.0)
points(2,-3.5,pch=19,col="black",cex=1.0)
points(-2,3.5,pch=19,col="black",cex=1.0)
points(-2,-3.5,pch=19,col="black",cex=1.0)
lines(c(0.3,3.55),c(0,0))
lines(c(-0.3,-3.55),c(0,0))
lines(c(0.2,1.85),c(0.3,3.25))
lines(c(-0.2,-1.85),c(0.3,3.25))
lines(c(0.2,1.85),c(-0.3,-3.25))
lines(c(-0.2,-1.85),c(-0.3,-3.25))
lines(c(-3.77,-2.15),c(-.3,-3.25))
lines(c(3.77,2.15),c(-.3,-3.25))
lines(c(-3.77,-2.15),c(.3,3.25))
lines(c(3.77,2.15),c(.3,3.25))
lines(c(-1.7,1.7),c(-3.5,-3.5))
lines(c(-1.7,1.7),c(3.5,3.5))
text(-2,-0.3,expression(epsilon),cex=.8)
text(-2,2.8,expression(theta[1]),cex=.8)
text(2,2.8,expression(theta[2]),cex=.8)
text(-3.3,.5,expression(theta[3]),cex=.8)
text(0,0.7,expression(theta[4]),cex=.8)
text(3.3,.5,expression(theta[5]),cex=.8)
text(-2,-2.8,expression(theta[6]),cex=.8)
text(2,-2.8,expression(theta[7]),cex=.8)
Figure 18.4. Covering Numbers#
plot.new()
plot.window(c(-.05,1.05),c(-.05,1.05))
lines(c(0,0),c(0,1))
lines(c(0,1),c(0,0))
lines(c(0,1),c(1,1))
lines(c(1,1),c(0,1))
points(.17,.17,pch=19,col="black")
points(.50,.17,pch=19,col="black")
points(.83,.17,pch=19,col="black")
points(.17,.50,pch=19,col="black")
points(.50,.50,pch=19,col="black")
points(.83,.50,pch=19,col="black")
points(.17,.83,pch=19,col="black")
points(.50,.83,pch=19,col="black")
points(.83,.83,pch=19,col="black")
ep <- sqrt(2)/6
W1 <- ellipse(a=ep,b=ep,centre=c(.17,.17),phi=0,npoly=1024)
W2 <- ellipse(a=ep,b=ep,centre=c(.50,.17),phi=0,npoly=1024)
W3 <- ellipse(a=ep,b=ep,centre=c(.83,.17),phi=0,npoly=1024)
W4 <- ellipse(a=ep,b=ep,centre=c(.17,.50),phi=0,npoly=1024)
W5 <- ellipse(a=ep,b=ep,centre=c(.50,.50),phi=0,npoly=1024)
W6 <- ellipse(a=ep,b=ep,centre=c(.83,.50),phi=0,npoly=1024)
W7 <- ellipse(a=ep,b=ep,centre=c(.17,.83),phi=0,npoly=1024)
W8 <- ellipse(a=ep,b=ep,centre=c(.50,.83),phi=0,npoly=1024)
W9 <- ellipse(a=ep,b=ep,centre=c(.83,.83),phi=0,npoly=1024)
plot(W1,add=TRUE)
plot(W2,add=TRUE)
plot(W3,add=TRUE)
plot(W4,add=TRUE)
plot(W5,add=TRUE)
plot(W6,add=TRUE)
plot(W7,add=TRUE)
plot(W8,add=TRUE)
plot(W9,add=TRUE)
lines(c(.83,1),c(.17,0))
text(.94,0.12,expression(epsilon),cex=.8)
Figure 18.5. Bracketing Numbers#
x <- seq(0,1,.001)
x1 <- x ^ (1/28)
x2 <- x ^ (1/4.65)
x3 <- x ^ (1/2)
x4 <- x
x5 <- x ^ 2
x6 <- x ^ (9/2)
x7 <- x ^ 14.5
plot(x,x1,type="l",lty=1,xaxs="i",yaxs="i",ylim=c(0,1.01),xlim=c(0,1.01),ylab=expression(g(x,theta)),xlab="x",bty="n",cex.lab=.8,cex.axis=.75)
lines(x,x2)
lines(x,x3)
lines(x,x4)
lines(x,x5)
lines(x,x6)
lines(x,x7)
abline(v=1)
abline(h=1)
Figure 18.6. EDF and Process - Uniform Random Variables#
set.seed(429)
n <- 100
sn <- sqrt(n)
N <- 10000
x <- (0:N)/N
e <- runif(n)
edf <- x
v <- x
for (i in 1:(N+1)) {
xi <- x[i]
edf[i] <- (mean(e <= xi))
v[i] <- (mean(e <= xi) - xi)*sn
}
# Empirical Distribution Function (EDF)
plot.new()
plot.window(c(0.037,1.0),c(0.037,1))
lines(x,edf)
axis(side=1,seq(0,1,.1))
axis(side=2,seq(0,1,.1))
# Normalized EDF
plot.new()
plot.window(c(0.037,1.0),c(-.8,.4))
abline(h=0)
lines(x,v)
axis(side=1,seq(0,1,.1))
axis(side=2,seq(-.8,.4,.4))
Figure 18.7. EDF and Process - Normal Random Variables#
n <- 100
sn <- sqrt(n)
N <- 10000
a <- (0:N)/N
x <- a*8 - 4
e <- rnorm(n)
edf <- x
v <- x
for (i in 1:(N+1)) {
xi <- x[i]
edf[i] <- (mean(e <= xi))
v[i] <- (mean(e <= xi) - pnorm(xi))*sn
}
# Empirical Distribution Function
plot.new()
plot.window(c(-3.7,4),c(0.037,1))
lines(x,edf)
axis(side=1,seq(-4,4,1))
axis(side=2,seq(0,1,.1))
# Normalized EDF
plot.new()
plot.window(c(-3.7,4),c(-.5,.3))
abline(h=0)
lines(x,v)
axis(side=1,seq(-4,4,1))
axis(side=2,seq(-1.1,1,.2))
