Index <- 1

# Libraries
library(gbm)

# Construct formula
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

# Required
# Unrestricted GBM model
load("GBM_final") # object: gbmFitFinal
# Restricted GBM model
load("GBM_NoInteract_final") # object: gbmFitNoInteractFinal
# Data set
datFrame <- read.csv(file="CombinedNRSA0809.csv")
datFrame <- datFrame[, which(names(datFrame) %in% all.vars(formulaInput))]
datFrame$BENT_MMI_COND <- relevel(datFrame$BENT_MMI_COND, "Poor")

#########################################################################
# 1. Simulation of artificial data set based on model without interactions

# Predict null distribution conditional on all covariates
predsNull <- predict(gbmFitNoInteractFinal, newdata=datFrame, type="response",
                     n.trees=gbmFitNoInteractFinal$n.trees)[, , 1]

# Simulate artifical data set
datFrameNull <- datFrame
levelsBENT_MMI_COND <- levels(datFrame$BENT_MMI_COND)
nrowDat <- dim(datFrame)[1]
for(i in 1:dim(datFrame)[1]){
  set.seed(i + (Index-1) * nrowDat)
  datFrameNull$BENT_MMI_COND[i] <- levelsBENT_MMI_COND[as.logical(
    rmultinom(n=1, size=1, prob=predsNull [i, ]))]
}
cat("Data set generation", "\n")

########################################################################
# 2. Calculation of all test statistics to approximate null distribution

# 2.1. Construct final results matrix
noCovariates <- dim(datFrame)[2] - 1
varNames <- names(datFrame)[-1]
noTwoWayIntact <- choose(noCovariates, 2)
threeWayIntact <- choose(noCovariates, 3)
RES <- matrix(NA, nrow=noTwoWayIntact + threeWayIntact, ncol=5 + 3*2)
dimnames(RES)[[2]] <- c("boot", "interaction_order", "variable_i", "variable_j", 
                        "variable_k", paste("F_x_ij", levelsBENT_MMI_COND, sep="_"), 
                        paste("F_x_ijk", levelsBENT_MMI_COND, sep="_"))
RES <- as.data.frame(RES)
RES$boot <- Index
RES$interaction_order <- rep(2:3, c(noTwoWayIntact, threeWayIntact))
RES[RES$interaction_order==2, 
    c("variable_i", "variable_j", "variable_k")] <- cbind(t(combn(varNames, 2)), NA)
RES[RES$interaction_order==3, 
    c("variable_i", "variable_j", "variable_k")] <- t(combn(varNames, 3))

# 2.2. Two way interactions

# 2.2.2. Estimate prediction model with same tuning parameters as original model
gbmBoot <- gbm(formula=formulaInput, distribution="multinomial",
               data=datFrameNull, n.minobsinnode=1, 
               n.trees=gbmFitFinal$n.trees,
               interaction.depth=gbmFitFinal$interaction.depth,
               n.cores=1)
cat("GBM estimation", "\n")

# 2.2.3. Compute interaction combinations
relInd <- which(RES$interaction_order==2)
for(k in relInd){
  RES[k, paste("F_x_ij", levelsBENT_MMI_COND, sep="_")] <- interact.gbm(x=gbmBoot, data=datFrameNull, 
                                                                        i.var = unname(unlist(RES[k, c("variable_i", "variable_j")])))
}
cat("Two way interactions", "\n")

# 2.3. Three way interactions
relInd <- which(RES$interaction_order==3)
for(k in relInd){
  RES[k, paste("F_x_ijk", levelsBENT_MMI_COND, sep="_")] <- interact.gbm(x=gbmBoot, data=datFrameNull, 
                                                                         i.var = unname(unlist(RES[k, c("variable_i", "variable_j", 
                                                                                                        "variable_k")])))
}
cat("Three way interactions", "\n")

# Save results
save(RES, file=paste("InteractionResults/RES_simInteract_boot_", Index,sep=""), compress="xz")