https://github.com/cran/fields
Tip revision: 6769ffc81115fbf0bf7d9c566cf7ac81be0049dc authored by Doug Nychka on 25 July 2005, 00:00:00 UTC
version 3.04
version 3.04
Tip revision: 6769ffc
WD4i.r
"WD4i" <-
function (x)
{
if (!is.matrix(x))
x <- matrix(x, nrow = length(x), ncol = 1)
n <- nrow(x)
m <- ncol(x)
X <- matrix(0, nrow = n, ncol = m)
X[seq(1, n, 2), ] <- x[1:(n/2), ]
X[seq(2, n, 2), ] <- x[(n/2 + 1):n, ]
x <- X
D4 <- c(0.482962913145, 0.836516303738, 0.224143868042, -0.129409522551)
D4.le <- matrix(c(0.6033325119, -0.7965435169, 0.03751746045,
0.01003722456, 0.6908955318, 0.546392714, 0.4573276599,
0.1223510431, -0.3983129977, -0.2587922483, 0.8500881025,
0.2274281117, 0, 0, 0.223820357, -0.8366029212, 0, 0,
-0.1292227434, 0.4830129218), nrow = 4, ncol = 5, byrow = FALSE)
D4.r <- c(-0.129409522551, -0.224143868042, 0.836516303738,
-0.482962913145)
D4.re <- matrix(c(0.4431490496, 0.231557595, 0, 0, 0.7675566693,
0.4010695194, 0, 0, 0.3749553316, -0.7175799994, 0.2303890438,
-0.5398225007, 0.1901514184, -0.3639069596, 0.434896998,
0.801422962, -0.1942334074, 0.3717189665, 0.8705087534,
-0.2575129195), nrow = 4, ncol = 5, byrow = FALSE)
D4tr.L <- matrix(0, nrow = 3, ncol = 4)
D4tr.L[1, ] <- c(D4.le[1, 1], D4.le[2, 1], D4.le[3, 1], D4.le[4,
1])
D4tr.L[2, ] <- c(D4.le[1, 2], D4.le[2, 2], D4.le[3, 2], D4.le[4,
2])
D4tr.L[3, ] <- c(D4.le[1, 3], D4.le[2, 3], D4.le[3, 3], D4.le[4,
3])
D4tr.R <- matrix(0, nrow = 3, ncol = 4)
D4tr.R[1, ] <- c(D4.re[1, 3], D4.re[2, 3], D4.re[3, 3], D4.re[4,
3])
D4tr.R[2, ] <- c(D4.re[1, 4], D4.re[2, 4], D4.re[3, 4], D4.re[4,
4])
D4tr.R[3, ] <- c(D4.re[1, 5], D4.re[2, 5], D4.re[3, 5], D4.re[4,
5])
if (n == 8) {
D4tr.t <- matrix(0, nrow = 2, ncol = 4)
D4tr.t[1, ] <- c(D4.le[3, 4], D4.le[4, 4], D4.re[1, 1],
D4.re[2, 1])
D4tr.t[2, ] <- c(D4.le[3, 5], D4.le[4, 5], D4.re[1, 2],
D4.re[2, 2])
}
else {
D4tr.t <- matrix(0, 4, 4)
D4tr.t[1, ] <- c(D4.le[3, 4], D4.le[4, 4], D4[1], D4.r[1])
D4tr.t[2, ] <- c(D4.le[3, 5], D4.le[4, 5], D4[2], D4.r[2])
D4tr.t[3, ] <- c(D4[3], D4.r[3], D4.re[1, 1], D4.re[2,
1])
D4tr.t[4, ] <- c(D4[4], D4.r[4], D4.re[1, 2], D4.re[2,
2])
}
iD4 <- c(D4[3], D4.r[3], D4[1], D4.r[1])
iD4.r <- c(D4[4], D4.r[4], D4[2], D4.r[2])
tmp <- matrix(NA, nrow = n, ncol = m)
tmp[1:3, ] <- D4tr.L %*% x[1:4, ]
tmp[(n - 2):n, ] <- D4tr.R %*% x[(n - 3):n, ]
if (n == 8) {
tmp[4:5, ] <- D4tr.t %*% x[3:6, ]
}
else {
tmp[4:5, ] <- D4tr.t[1:2, ] %*% x[3:6, ]
tmp[(n - 4):(n - 3), ] <- D4tr.t[3:4, ] %*% x[(n - 5):(n -
2), ]
indx <- seq(6, (n - 6), 2)
tmp[indx, ] <- iD4[1] * x[indx - 1, ] + iD4[2] * x[indx,
] + iD4[3] * x[indx + 1, ] + iD4[4] * x[indx + 2,
]
tmp[indx + 1, ] <- iD4.r[1] * x[indx - 1, ] + iD4.r[2] *
x[indx, ] + iD4.r[3] * x[indx + 1, ] + iD4.r[4] *
x[indx + 2, ]
}
iwt <- tmp
iwt
}