46 lines
1.3 KiB
R
46 lines
1.3 KiB
R
|
#' @rdname predict.dim.cve
|
||
|
|
#' @method predict.dim cve
|
||
|
|
#' @alias predict.dim.cve
|
||
|
|
#' @export
|
||
|
|
predict.dim <- function(object, ...) {
|
||
|
|
UseMethod("predict.dim")
|
||
|
|
}
|
||
|
|
|
||
|
|
#' Predicts SDR dimension using \code{\link[mda]{mars}} via a Cross-Validation.
|
||
|
|
#'
|
||
|
|
#' @param object instance of class \code{cve} (result of \code{cve},
|
||
|
|
#' \code{cve.call}).
|
||
|
|
#' @param ... ignored.
|
||
|
|
#' @method predict.dim cve
|
||
|
|
#' @export
|
||
|
|
predict.dim.cve <- function(object, ...) {
|
||
|
|
# Get centered training data and dimensions
|
||
|
|
X <- scale(object$X, center = TRUE, scale = FALSE)
|
||
|
|
n <- nrow(object$X) # umber of training data samples
|
||
|
|
Sigma <- (1 / n) * crossprod(X, X)
|
||
|
|
eig <- eigen(Sigma)
|
||
|
|
Sigma_root <- eig$vectors %*% tcrossprod(diag(sqrt(eig$values)), eig$vectors)
|
||
|
|
X <- X %*% solve(Sigma_root)
|
||
|
|
|
||
|
|
pred <- matrix(0, n, length(object$res))
|
||
|
|
colnames(pred) <- names(object$res)
|
||
|
|
for (dr.k in object$res) {
|
||
|
|
# get "name" of current dimension
|
||
|
|
k <- as.character(dr.k$k)
|
||
|
|
# Project dataset with current SDR basis
|
||
|
|
X.proj <- X %*% dr.k$B
|
||
|
|
|
||
|
|
for (i in 1:n) {
|
||
|
|
model <- mda::mars(X.proj[-i, ], object$Y[-i])
|
||
|
|
pred[i, k] <- predict(model, X.proj[i, , drop = F])
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
MSE <- colMeans((pred - object$Y)^2)
|
||
|
|
|
||
|
|
return(list(
|
||
|
|
MSE = MSE,
|
||
|
|
k = as.integer(names(which.min(MSE)))
|
||
|
|
))
|
||
|
|
}
|