https://github.com/cran/fields
Raw File
Tip revision: c71fb7f6ffa323303affebf0e35a0070faa9c24d authored by Doug Nychka on 10 May 2004, 00:00:00 UTC
version 1.7.2
Tip revision: c71fb7f
image.smooth.r
"image.smooth" <-
function (Y, wght = NULL, dx = 1, dy = 1, Nwidth = nrow(Y), Mwidth = ncol(Y), 
    kernel.function = function(x) {
        exp(-abs(x))
    }, theta = 1, grid = NULL, tol = 1e-08, xwidth = NULL, ywidth = NULL, 
    weights = NULL) 
{
    if (!is.matrix(Y)) {
        stop("Requires a matrix")
    }
    m <- nrow(Y)
    n <- ncol(Y)
    if (!is.null(grid)) {
        dx <- grid$x[2] - grid$x[1]
        dy <- grid$y[2] - grid$y[1]
    }
    if (!is.null(xwidth)) {
        Mwidth <- round(xwidth/dx)
    }
    if (!is.null(ywidth)) {
        Nwidth <- round(ywidth/dy)
    }
    if (is.null(wght)) {
        wght <- image.smooth.setup(nrow = m, ncol = n, Mwidth = Mwidth, 
            Nwidth = Nwidth, dx = dx, dy = dy, kernel.function = kernel.function, 
            theta = theta)
    }
    M <- nrow(wght)
    N <- ncol(wght)
    temp <- matrix(0, nrow = M, ncol = N)
    temp2 <- matrix(0, nrow = M, ncol = N)
    if (!is.null(weights)) {
        temp[1:m, 1:n] <- Y * weights
        temp[is.na(temp)] <- 0
        temp2[1:m, 1:n] <- ifelse(!is.na(Y), weights, 0)
    }
    else {
        temp[1:m, 1:n] <- Y
        temp[is.na(temp)] <- 0
        temp2[1:m, 1:n] <- ifelse(!is.na(Y), 1, 0)
    }
    temp <- Re(fft(fft(temp) * wght, inverse = TRUE))[1:m, 1:n]
    temp2 <- Re(fft(fft(temp2) * wght, inverse = TRUE))[1:m,1:n]
    temp <- ifelse((temp2 > tol), (temp/temp2), NA)
    if (!is.null(grid)) {
        list(x = grid$x, y = grid$y, z = temp)
    }
    else {
        temp
    }
}
back to top