https://github.com/cran/fields
Tip revision: ca1b621280412ef00fbb00b121ae8782c730a345 authored by Douglas Nychka on 30 October 2021, 12:40:02 UTC
version 13.3
version 13.3
Tip revision: ca1b621
rad.image.cov.R
#
# fields is a package for analysis of spatial data written for
# the R software environment.
# Copyright (C) 2021 Colorado School of Mines
# 1500 Illinois St., Golden, CO 80401
# Contact: Douglas Nychka, douglasnychka@gmail.edu,
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with the R software environment if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
# or see http://www.r-project.org/Licenses/GPL-2
##END HEADER
"Rad.image.cov" <- function(ind1, ind2, Y, cov.obj = NULL,
setup = FALSE, grid, ...) {
if (is.null(cov.obj)) {
dx <- grid$x[2] - grid$x[1]
dy <- grid$y[2] - grid$y[1]
m <- length(grid$x)
n <- length(grid$y)
M <- ceiling2(2 * m)
N <- ceiling2(2 * n)
xg <- make.surface.grid(list((1:M) * dx, (1:N) * dy))
center <- matrix(c((dx * M)/2, (dy * N)/2), nrow = 1,
ncol = 2)
out <- Rad.cov(xg, center, ...)
out <- as.surface(xg, c(out))$z
temp <- matrix(0, nrow = M, ncol = N)
temp[M/2, N/2] <- 1
wght <- fft(out)/(fft(temp) * M * N)
cov.obj <- list(m = m, n = n, grid = grid, N = N, M = M,
wght = wght, call = match.call())
if (setup) {
return(cov.obj)
}
}
temp <- matrix(0, nrow = cov.obj$M, ncol = cov.obj$N)
if (missing(ind1)) {
temp[1:cov.obj$m, 1:cov.obj$n] <- Y
Re(fft(fft(temp) * cov.obj$wght, inverse = TRUE)[1:cov.obj$m,
1:cov.obj$n])
}
else {
if (missing(ind2)) {
temp[ind1] <- Y
}
else {
temp[ind2] <- Y
}
Re(fft(fft(temp) * cov.obj$wght, inverse = TRUE)[ind1])
}
}