R/pnn.search_logl.R

In yap: Yet Another Probabilistic Neural Network

#' Search for the optimal value of PNN smoothing parameter based on the cross entropy
#'
#' The function \code{pnn.search_logl} searches for the optimal value of PNN smoothing parameter by cross-validation.
#'
#' @param net    A PNN object generated by pnn.fit()
#' @param sigmas A numeric vector to search for the best smoothing parameter
#' @param nfolds A scalar for the number of n-fold, 4 by default
#' @param seed   The seed value for the n-fold cross-validation, 1 by default
#'
#' @return The list of all searching outcomes and the best outcome
#'
#' @examples
#' data(iris, package = "datasets")
#' Y <- iris[, 5]
#' X <- scale(iris[, 1:4])
#' pnet <- pnn.fit(x = X, y = Y)
#' pnn.search_logl(pnet, c(0.5, 1), nfolds = 2)

pnn.search_logl <- function(net, sigmas, nfolds = 4, seed = 1) {

  if (class(net) != "Probabilistic Neural Net") stop("net needs to be a PNN object.", call. = F)
  if (is.vector(sigmas) != T) stop("sigmas needs to be a vector.", call. = F)

  fd <- folds(seq(nrow(net$x)), n = nfolds, seed = seed)
  cv <- function(s) {
    rs <- Reduce(rbind,
            lapply(fd,
              function(f) data.frame(ya = net$y.ind[f, ],
                                     yp = pnn.predict(pnn.fit(net$x[-f, ], net$y.raw[-f], sigma = s),
                                                      net$x[f, ]))))
    return(data.frame(sigma = s, 
                      logl = logl(y_pred = as.matrix(rs[, grep("^yp", names(rs))]),
                                  y_true = as.matrix(rs[, grep("^ya", names(rs))]))))
  }

  cls <- parallel::makeCluster(min(nfolds, parallel::detectCores() - 1), type = "PSOCK")
  obj <- c("fd", "net", "dummies", "pnn.fit", "pnn.predone", "pnn.predict", "logl")
  parallel::clusterExport(cls, obj, envir = environment())
  rst <- Reduce(rbind, parallel::parLapply(cls, sort(sigmas), cv))
  parallel::stopCluster(cls)
  return(list(test = rst, best = rst[rst$logl == min(rst$logl), ]))
}