Index <- 1
stepSize <- 1
Indices <- (1 + stepSize*(Index-1)):(stepSize*Index)

# Libraries
library(gbm)
library(caret)
library(mc2d)

# Construct structure of formula based on ecological prior knowledge
formulaInput <- BENT_MMI_COND ~ AGGR_ECO9_2015 + LRBS_USE + L_XFC_NAT + L_XCMGW + W1_HALL +
  NHDWAT_NADP2009_MEAN_NO3 + NHDWAT_NADP2009_MEAN_SO4 +
  NHDWAT_ELEV + NHDWAT_SLOPE + NHDWAT_PCT_CANOPY+ NHDWAT_PCT_IMPERV +
  NHDWAT_PCT_SAND + TMAX_ANN + WSAREA_NARS+PCT_AG + PCT_WET + PCT_SHRUB_GRASS

# Data
# Output from file 1_DataPreparation.R
load("CombinedNRSA0809_datFrame")

# Create tuning grid
maxInterActDepth <- ncol(datFrame) - 1
tuneGrid <- expand.grid(OuterFold=1:10, nTrees=seq(10, 10000, by=10), 
                        intActDepth=1:maxInterActDepth,
                        AvgNegLogLik=NA)

# Prepare fold indices for nested stratified cross validation
set.seed(0)
cvFoldsOuter <- createFolds(y=datFrame[, "BENT_MMI_COND"], 
                       k=10, returnTrain = TRUE)
cvFoldsInner <- vector("list", 10)
for(j in 1:10) {
  set.seed(j)
  cvFoldsInner[[j]] <- createFolds(y=datFrame[cvFoldsOuter[[j]], "BENT_MMI_COND"], 
                         k=10, returnTrain = TRUE)
}

# Prepare training and test sets structure
tempTrain <- vector("list", 10)
tempTrain <- lapply(tempTrain, function(x) vector("list", 10))
tempVal <- vector("list", 10)
tempVal <- lapply(tempVal, function(x) vector("list", 10))
respMultinomVal <- vector("list", 10)
respMultinomVal <- lapply(respMultinomVal, function(x) vector("list", 10))
for(j in 1:10) {
  for(i in 1:10) {
    tempTrain[[j]] [[i]] <- datFrame[cvFoldsOuter[[j]], ] [cvFoldsInner[[j]] [[i]], ]
    tempVal[[j]] [[i]] <- datFrame[cvFoldsOuter[[j]], ] [-cvFoldsInner[[j]] [[i]], ]
    respMultinomVal[[j]] [[i]] <- model.matrix(~BENT_MMI_COND-1, 
                                         data=data.frame(BENT_MMI_COND=
                                         tempVal[[j]][[i]]$BENT_MMI_COND))
  }
}

# Evaluate GBM in nested stratified cross validation
for(k in Indices) {
    tempNegLogLik <- rep(NA, 10)
    for(i in 1:10) {
      
      # Estimate GBM
      gbmFit <- gbm(formula=formulaInput, distribution="multinomial",
                    data=tempTrain[[ tuneGrid[k, "OuterFold"] ]] [[i]], n.minobsinnode=1, 
                    n.trees=tuneGrid[k, "nTrees"],
                    interaction.depth=tuneGrid[k, "intActDepth"],
                    n.cores=1)
      
      # Evaluate prediction on validation data
      preds <- predict(gbmFit, newdata=tempVal[[ tuneGrid[k, "OuterFold"] ]] [[i]], type="response",
                       n.trees=gbmFit$n.trees)[, , 1]
      tempNegLogLik[i] <- -sum(dmultinomial(x=respMultinomVal[[ tuneGrid[k, "OuterFold"] ]] [[i]], 
                                            size=1, prob=preds, log=TRUE))
      
      # Remove large models
      rm(gbmFit, preds)
    }
    
    # Store results per outer Fold
    tuneGrid[k, "AvgNegLogLik"] <- mean(tempNegLogLik)
    cat("Progress", round((k-stepSize*(Index-1)) / stepSize, 4)*100, "%", "\n")
}

# Select subset of tuned indices and save results
tuneGrid <- tuneGrid[Indices, , drop=FALSE]
save(tuneGrid, file=paste("GBT_NestedCVresults/PDP_tuneGrid_nestCV_Index_", Index, sep=""), 
     compress="xz")