R/pnn.pfi.R

In yap: Yet Another Probabilistic Neural Network

#' Derive the PFI rank of all predictors used in the PNN 
#'
#' The function \code{pnn.pfi} derives the PFI rank of all predictors used in the PNN
#' It essentially is a wrapper around the function \code{pnn.x_pfi}.
#'
#' @param net  A PNN object generated by pnn.fit() 
#' @param ntry The number of random permutations to try, 1e3 times by default
#' @param seed The seed value for the random permutation
#'
#' @return A dataframe with PFI values of all predictors in the PNN
#'
#' @seealso \code{\link{pnn.x_pfi}}
#'
#' @examples
#' data(iris, package = "datasets")
#' Y <- iris[, 5]
#' X <- scale(iris[, 1:4])
#' pnet <- pnn.fit(x = X, y = Y)
#' \donttest{
#' pnn.pfi(pnet)
#' }

pnn.pfi <- function(net, ntry = 1e3, seed = 1) {
  if (class(net) != "Probabilistic Neural Net") stop("net needs to be a PNN.", call. = F)

  cls <- parallel::makeCluster(min(ncol(net$x), parallel::detectCores() - 1), type = "PSOCK")
  obj <- c("logl", "net", "dummies", "pnn.fit", "pnn.predone", "pnn.predict", "pnn.x_pfi", "ntry", "seed")
  parallel::clusterExport(cls, obj,  envir = environment())
  rst1 <- data.frame(idx = seq(ncol(net$x)),
                     Reduce(rbind, 
                       parallel::parLapply(cls, seq(ncol(net$x)),
                         function(i) pnn.x_pfi(net, i, ntry = ntry, seed = seed))))
  parallel::stopCluster(cls)
  rst2 <- rst1[with(rst1, order(-pfi)), ]
  row.names(rst2) <- NULL
  return(rst2)
}