R/pnn.x_pfi.R

In yap: Yet Another Probabilistic Neural Network

#' Derive the permutation feature importance of a predictor used in the PNN 
#'
#' The function \code{pnn.x_pfi} derives the permutation feature importance (PFI) of a predictor used in the PNN, 
#' where the "importance" is deined by the increase in cross entropy after the predictor is randomly permutated.
#'
#' @param net  A PNN object generated by pnn.fit() 
#' @param i    The ith predictor in the PNN
#' @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{pnn.x_imp}}
#'
#' @examples
#' data(iris, package = "datasets")
#' Y <- iris[, 5]
#' X <- scale(iris[, 1:4])
#' pnet <- pnn.fit(x = X, y = Y)
#' pnn.x_pfi(pnet, 1)

pnn.x_pfi <- function(net, i, ntry = 1e3, seed = 1) {
  if (class(net) != "Probabilistic Neural Net") stop("net needs to be a PNN.", call. = F)
  if (i > ncol(net$x)) stop("the selected variable is out of bound.", call. = F)

  xname <- colnames(net$x)[i]
  seeds <- with(set.seed(seed), 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]
  ll0 <- logl(y_pred = pnn.predict(net, net$x), y_true = net$y.ind)
  ll1 <- logl(y_pred = pnn.predict(net, x), y_true = net$y.ind)
  pfi <- round(max(0, ll1 / ll0 - 1), 8)
  return(data.frame(var = xname, pfi = pfi))
}