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)
}