R/cv.alfacomprf.R

In CompositionalRF: Multivariate Random Forest with Compositional Responses

cv.alfacomprf <- function(y, x, a = seq(-1, 1, by = 0.1), ntrees = c(100, 500, 1000), nfeatures,
                          minleaf, folds = NULL, nfolds = 10, seed = NULL, ncores = 1) {

  if ( min(y) == 0 )  a <- a[a > 0]
  la <- length(a)
  n <- dim(y)[1]

  kla <- jsa <- list()
  names <- paste("alpha", a)
  kla <- jsa <- sapply(names, function(x) NULL)

  if ( is.null(folds) )
    folds <- Compositional::makefolds(1:n, nfolds = nfolds, stratified = FALSE, seed = seed)
  nfolds <- length(folds)
  config <- as.matrix( expand.grid(ntrees = ntrees, nfeatures = nfeatures, minleaf = minleaf) )
  p <- dim(config)[1]
  kl <- js <- matrix(nrow = nfolds, ncol = p)

  for ( k in 1:nfolds ) {
    ytrain <- y[ -folds[[ k ]], ]
    ytest <- y[ folds[[ k ]],  ]
    xtrain <- x[-folds[[ k ]], ]
    xtest <- x[folds[[ k ]], ]
    est <- CompositionalRF::alfa.comp.rf(xtest, ytrain, xtrain, a = a, ntrees = ntrees, 
                                         nfeatures = nfeatures, minleaf = minleaf, ncores = ncores)
    for (i in 1:la) {
      for (j in 1:p) {
        ela <- abs( ytest * log( ytest / est[[ i ]][[ j ]] ) )
        ela[ is.infinite(ela) ] <- NA
        kl[k, j] <- 2 * mean(ela, na.rm = TRUE)
        M <- 0.5 * (ytest + est[[ i ]][[ j ]])
        ela2 <- ytest * log( ytest / M ) + est[[ i ]][[ j ]] * log( est[[ i ]][[ j ]] / M )
        ela2[ is.infinite(ela2) ] <- NA
        js[k, j] <- mean(ela2, na.rm = TRUE)
      }
      kla[[ i ]] <- kl
      jsa[[ i ]] <- js
    }
  }  ##  end  for ( k in 1:nfolds ) {

  kla2 <- matrix(nrow = la, ncol = p)
  rownames(kla2) <- paste("alpha=", a, sep = "")
  jsa2 <- kla2
  for ( i in 1:la ) {
    kla2[i, ] <- Rfast::colmeans(kla[[ i ]])
    jsa2[i, ] <- Rfast::colmeans(jsa[[ i ]])
  }

  list(config = config, kl = kla2, js = jsa2)
}