R/grnn.x_imp.R

In yager: Yet Another General Regression Neural Network

#' Derive the importance of a predictor used in the GRNN 
#'
#' The function \code{grnn.x_imp} derives the importance of a predictor used in the GRNN
#' by using the loss of predictability after eliminating the impact of the predictor in interest.
#'
#' @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
#'
#' @return A vector with the variable name and two values of importance measurements, namely "imp1" and "imp2".
#'         The "imp1" measures the loss of predictability after replacing all values of the predictor with its mean.
#'         The "imp2" measures the loss of predictability after dropping the predictor from the GRNN.
#'
#' @seealso \code{\link{grnn.x_pfi}}
#'
#' @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_imp(net = gnet, 1)

grnn.x_imp <- function(net, i, class = FALSE) {
  if (class(net) != "General Regression Neural Net") stop("net needs to be a GRNN.", call. = F)
  if (i > ncol(net$x)) stop("the selected variable is out of bound.", call. = F)
  if (!(class %in% c(TRUE, FALSE))) stop("the class input is not correct.", call. = F)

  xname <- colnames(net$x)[i]
  x <- net$x
  x[, i] <-  rep(mean(net$x[, i]), length(net$y))
  if (class == TRUE) {
    auc0 <- MLmetrics::AUC(grnn.predict(net, net$x), net$y)
    auc1 <- MLmetrics::AUC(grnn.predict(net, x), net$y)
    auc2 <- MLmetrics::AUC(grnn.predict(grnn.fit(x = x[, -i], y = net$y, sigma = net$sigma), x[, -i]), net$y)
    imp1 <- round(max(0, 1 - auc1 / auc0), 8)
    imp2 <- round(max(0, 1 - auc2 / auc0), 8)
  } else {
    rsq0 <- MLmetrics::R2_Score(grnn.predict(net, net$x), net$y)
    rsq1 <- MLmetrics::R2_Score(grnn.predict(net, x), net$y)
    rsq2 <- MLmetrics::R2_Score(grnn.predict(grnn.fit(x = x[, -i], y = net$y, sigma = net$sigma), x[, -i]), net$y)
    imp1 <- round(max(0, 1 - rsq1 / rsq0), 8)
    imp2 <- round(max(0, 1 - rsq2 / rsq0), 8)
  }
  return(data.frame(var = xname, imp1 = imp1, imp2 = imp2))
}