Nothing
#' Derive the permutation feature importance of a predictor used in the GRNN
#'
#' The function \code{grnn.x_pfi} derives the permutation feature importance (PFI) of a predictor used in the GRNN
#'
#' @param net The GRNN object generated by grnn.fit()
#' @param i The ith predictor in the GRNN
#' @param class TRUE or FALSE, whether it is for the classification or not
#' @param ntry The number of random permutations to try, 1e3 times by default
#' @param seed The seed value for the random permutation
#'
#' @return A vector with the variable name and the PFI value.
#'
#' @seealso \code{\link{grnn.x_imp}}
#'
#' @examples
#' data(iris, package = "datasets")
#' Y <- ifelse(iris[, 5] == "setosa", 1, 0)
#' X <- scale(iris[, 1:4])
#' gnet <- grnn.fit(x = X, y = Y)
#' grnn.x_pfi(net = gnet, 1)
grnn.x_pfi <- function(net, i, class = FALSE, ntry = 1e3, seed = 1) {
if (class(net) != "General Regression Neural Net") stop("net needs to be a GRNN.", call. = F)
if (!(class %in% c(TRUE, FALSE))) stop("the class input is not correct.", call. = F)
xname <- colnames(net$x)[i]
set.seed(seed)
seeds <- floor(runif(ntry) * 1e8)
ol <- lapply(seeds, function(s) with(set.seed(s), sample(seq(nrow(net$x)), nrow(net$x), replace = F)))
cl <- Reduce(c, lapply(ol, function(o) abs(cor(seq(nrow(net$x)), o))))
x <- net$x
x[, i] <- net$x[ol[[which(cl == min(cl))]], i]
if (class == TRUE) {
auc0 <- MLmetrics::AUC(grnn.predict(net, net$x), net$y)
auc1 <- MLmetrics::AUC(grnn.predict(net, x), net$y)
pfi <- round(max(0, 1 - auc1 / auc0), 8)
} else {
rsq0 <- MLmetrics::R2_Score(grnn.predict(net, net$x), net$y)
rsq1 <- MLmetrics::R2_Score(grnn.predict(net, x), net$y)
pfi <- round(max(0, 1 - rsq1 / rsq0), 8)
}
return(data.frame(var = xname, pfi = pfi))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.