|
Essential Wavelets for Statistical Applications and Data Analysis R.T. Ogden, University of South Carolina 0-8176-3864-4 * 1996 * $40.00 * Hardcover * 285 pages * 40 Illustrations |
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)
}