Fig2.5 <- function(n = 32, npoints = 150) { # postscript(file = "Fig2.5.ps", horiz = F, height = 4.5, width = 3.5) par(mfrow = c(3, 1), mar = c(1.5, 1.5, 1.5, 0.5), mgp = c(5, 0.4, 0)) rs <- c(57, 14, 55, 51, 30, 0, 53, 44, 34, 53, 49, 2) .Random.seed <- rs x <- (1:n)/n y <- 5 * sin(x * 2 * pi) ynoise <- y + rnorm(n) uvals <- (0:(npoints - 1))/(npoints - 1) plot(x, ynoise, ylim = c(min(ynoise), max(ynoise))) mtext("Bandwidth = 0.2", side = 3, line = 0.1) lam <- 0.2 lines(uvals, convkern(ynoise, npoints, lam)) ustar <- 0.75 uval2 <- seq(ustar - lam, ustar + lam, 0.01) kvals <- (0.75 * (1 - ((ustar - uval2)/lam)^2))/lam lines(c(0, uval2, 1), (5 * c(0, kvals, 0))/max(kvals), lty = 2) plot(x, ynoise, ylim = c(min(ynoise), max(ynoise))) mtext("Bandwidth = 0.1", side = 3, line = 0.1) lam <- 0.1 lines(uvals, convkern(ynoise, npoints, lam)) ustar <- 0.75 uval2 <- seq(ustar - lam, ustar + lam, 0.01) kvals <- (0.75 * (1 - ((ustar - uval2)/lam)^2))/lam lines(c(0, uval2, 1), (5 * c(0, kvals, 0))/max(kvals), lty = 2) plot(x, ynoise, ylim = c(min(ynoise), max(ynoise))) mtext("Bandwidth = 0.05", side = 3, line = 0.1) lam <- 0.05 lines(uvals, convkern(ynoise, npoints, lam)) ustar <- 0.75 uval2 <- seq(ustar - lam, ustar + lam, 0.01) kvals <- (0.75 * (1 - ((ustar - uval2)/lam)^2))/lam lines(c(0, uval2, 1), (5 * c(0, kvals, 0))/max(kvals), lty = 2) # graphics.off() NULL } convkern <- function(y, npoints, lam) { n <- length(y) est <- rep(0, npoints) uvals <- (0:(npoints - 1))/(npoints - 1) for(ipoints in 1:npoints) est[ipoints] <- sum(y * compweights(n, uvals[ipoints], lam)) est } giveweight <- function(n, i, lam, u) { if((u - (i - 1)/n)/lam <= -1 || (u - i/n)/lam >= 1) weight <- 0 else if((u - (i/n))/lam <= -1) weight <- epint((u - (i - 1)/n)/lam) - epint(-1) else if((u - (i - 1)/n)/lam >= 1) weight <- epint(1) - epint((u - i/n)/lam) else weight <- epint((u - (i - 1)/n)/lam) - epint((u - i/n)/lam) weight } compweights <- function(n, u, lam) { weights <- rep(0, n) for(i in 1:n) weights[i] <- giveweight(n, i, lam, u) weights } epint <- function(x) { .75*(x-x^3/3) }