###################################################
# Requirements

# Libraries
library(gbm)
library(ICEbox)
library(iml)
library(colorRamps)
library(pals)
library(gridExtra)
library(ggExtra)
library(ggplot2)

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

# Load final gradient boosted tree model
load("GBM_final")

# Create response in dummy encoding of responses
dummyResp <- model.matrix(~BENT_MMI_COND-1, datFrame)

###################################################
# Log relative bed stability ice curves
# Manuscript Figure 2, Supplemental material Figure S6

# LRBS_USE
# Poor
ICEplot_Poor_LRBS_USE <- ice(object = gbmFitFinal, X = datFrame,
                             y = dummyResp[, 1], predictor = "LRBS_USE",
                             frac_to_build = 0.25, verbose=FALSE,
                             predictfcn=function(object, newdata) 
                               predict(object, newdata=newdata, type="response",
                                       n.trees=gbmFitFinal$n.trees)[, , 1] [, "Poor"])
save(object=ICEplot_Poor_LRBS_USE, file="ICEplot_Poor_LRBS_USE", compress="xz")

# Fair
ICEplot_Fair_LRBS_USE <- ice(object = gbmFitFinal, X = datFrame,
                             y = dummyResp[, 2], predictor = "LRBS_USE",
                             frac_to_build = 0.25, verbose=FALSE,
                             predictfcn=function(object, newdata) 
                               predict(object, newdata=newdata, type="response",
                                       n.trees=gbmFitFinal$n.trees)[, , 1] [, "Fair"])
save(object=ICEplot_Fair_LRBS_USE, file="ICEplot_Fair_LRBS_USE", compress="xz")

# Good
ICEplot_Good_LRBS_USE <- ice(object = gbmFitFinal, X = datFrame,
                             y = dummyResp[, 3], predictor = "LRBS_USE",
                             frac_to_build = 0.25, verbose=FALSE,
                             predictfcn=function(object, newdata) 
                               predict(object, newdata=newdata, type="response",
                                       n.trees=gbmFitFinal$n.trees)[, , 1] [, "Good"])
save(object=ICEplot_Good_LRBS_USE, file="ICEplot_Good_LRBS_USE", compress="xz")

# Restructuring graphics
load("ICEplot_Poor_LRBS_USE")
load("ICEplot_Fair_LRBS_USE")
load("ICEplot_Good_LRBS_USE")
# Calculate range to compare curves
part1 <- sapply(1:ncol(ICEplot_Poor_LRBS_USE$ice_curves), 
                function(j) ICEplot_Poor_LRBS_USE$ice_curves[, j] - 
                  ICEplot_Poor_LRBS_USE$ice_curves[, 1])
part2 <- sapply(1:ncol(ICEplot_Fair_LRBS_USE$ice_curves), 
                function(j) ICEplot_Fair_LRBS_USE$ice_curves[, j] - 
                  ICEplot_Fair_LRBS_USE$ice_curves[, 1])
part3 <- sapply(1:ncol(ICEplot_Good_LRBS_USE$ice_curves), 
                function(j) ICEplot_Good_LRBS_USE$ice_curves[, j] - 
                  ICEplot_Good_LRBS_USE$ice_curves[, 1])
commonRange <- range(cbind(part1, part2, part3))

# Legend coloring by ecoregion
# Poor
legend_ICEplot_Poor_LRBS_USE_ecoRegion <- vector("character", nrow(ICEplot_Poor_LRBS_USE$Xice))
for( i in 1:nrow(ICEplot_Poor_LRBS_USE$Xice) ){
  
  legend_ICEplot_Poor_LRBS_USE_ecoRegion[i] <- glasbey()[
    which(levels(ICEplot_Poor_LRBS_USE$Xice$AGGR_ECO9_2015)==
            ICEplot_Poor_LRBS_USE$Xice$AGGR_ECO9_2015[i])]
  
}
# Fair
legend_ICEplot_Fair_LRBS_USE_ecoRegion <- vector("character", nrow(ICEplot_Fair_LRBS_USE$Xice))
for( i in 1:nrow(ICEplot_Fair_LRBS_USE$Xice) ){
  
  legend_ICEplot_Fair_LRBS_USE_ecoRegion[i] <- glasbey()[
    which(levels(ICEplot_Fair_LRBS_USE$Xice$AGGR_ECO9_2015)==
            ICEplot_Fair_LRBS_USE$Xice$AGGR_ECO9_2015[i])]
  
}
# Good
legend_ICEplot_Good_LRBS_USE_ecoRegion <- vector("character", nrow(ICEplot_Good_LRBS_USE$Xice))
for( i in 1:nrow(ICEplot_Good_LRBS_USE$Xice) ){
  
  legend_ICEplot_Good_LRBS_USE_ecoRegion[i] <- glasbey()[
    which(levels(ICEplot_Good_LRBS_USE$Xice$AGGR_ECO9_2015)==
            ICEplot_Good_LRBS_USE$Xice$AGGR_ECO9_2015[i])]
  
}

# Log relative bed stability by ecoregion coloring
pdf("LRBS_USE_gbmFitFinal_coloring_ecoRegion.pdf", width=7)
par(mfrow=c(1, 3), mar=c(5+10, 4, 4, 2) + 0.1)
plot(ICEplot_Poor_LRBS_USE, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="Log relative bed stability",
     ylab="Probability of response Poor class", colorvec=legend_ICEplot_Poor_LRBS_USE_ecoRegion)
plot(ICEplot_Fair_LRBS_USE, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="Log relative bed stability",
     ylab="Probability of response Fair class", colorvec=legend_ICEplot_Fair_LRBS_USE_ecoRegion)
legend(x=-5, y=-1, legend=c("Coastal Plains", "Northern Appalachians", "Northern Plains",
                            "Southern Appalachians", "Southern Plains", "Temperate Plains",
                            "Upper Midwest", "Western Mountains", "Xeric West"), 
       lty=1, lwd=2, col=glasbey()[1:9], xpd=TRUE)
plot(ICEplot_Good_LRBS_USE, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="Log relative bed stability",
     ylab="Probability of response Good class", colorvec=legend_ICEplot_Good_LRBS_USE_ecoRegion)
dev.off()
par(mfrow=c(1, 1), mar=c(5, 4, 4, 2) + 0.1)

# Coloring by eco region
pdf("LRBS_USE_gbmFitFinal_coloring_ecoRegion_PIT.pdf", width=7)
par(mfrow=c(1, 3), mar=c(5+10, 4, 4, 2) + 0.1)
plot(ICEplot_Poor_LRBS_USE, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="PIT log relative bed stability",
     ylab="Probability of response Poor class", colorvec=legend_ICEplot_Poor_LRBS_USE_ecoRegion,
     x_quantile=TRUE)
plot(ICEplot_Fair_LRBS_USE, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="PIT log relative bed stability",
     ylab="Probability of response Fair class", colorvec=legend_ICEplot_Fair_LRBS_USE_ecoRegion,
     x_quantile=TRUE)
legend(x=0, y=-1, legend=c("Coastal Plains", "Northern Appalachians", "Northern Plains",
                           "Southern Appalachians", "Southern Plains", "Temperate Plains",
                           "Upper Midwest", "Western Mountains", "Xeric West"), 
       lty=1, lwd=2, col=glasbey()[1:9], xpd=TRUE)
plot(ICEplot_Good_LRBS_USE, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="PIT log relative bed stability",
     ylab="Probability of response Good class", colorvec=legend_ICEplot_Good_LRBS_USE_ecoRegion, 
     x_quantile=TRUE)
dev.off()
par(mfrow=c(1, 1), mar=c(5, 4, 4, 2) + 0.1)

#####################################################################
# ICE curves impervious surface
# Manuscript Figure 3, Supplemental material Figure S7

# Poor
ICEplot_Poor_NHDWAT_PCT_IMPERV <- ice(object = gbmFitFinal, X = datFrame[datFrame$NHDWAT_PCT_IMPERV <= 10, ],
                                      y = dummyResp[, 1], predictor = "NHDWAT_PCT_IMPERV",
                                      frac_to_build = 0.25, verbose=FALSE,
                                      predictfcn=function(object, newdata) predict(object, newdata=newdata, type="response",
                                                                                   n.trees=gbmFitFinal$n.trees)[, , 1] [, "Poor"])
save(object=ICEplot_Poor_NHDWAT_PCT_IMPERV, file="ICEplot_Poor_NHDWAT_PCT_IMPERV", compress="xz")

# Fair
ICEplot_Fair_NHDWAT_PCT_IMPERV <- ice(object = gbmFitFinal, X = datFrame[datFrame$NHDWAT_PCT_IMPERV <= 10, ],
                                      y = dummyResp[, 2], predictor = "NHDWAT_PCT_IMPERV",
                                      frac_to_build = 0.25, verbose=FALSE,
                                      predictfcn=function(object, newdata) predict(object, newdata=newdata, type="response",
                                                                                   n.trees=gbmFitFinal$n.trees)[, , 1] [, "Fair"])
save(object=ICEplot_Fair_NHDWAT_PCT_IMPERV, file="ICEplot_Fair_NHDWAT_PCT_IMPERV", compress="xz")

# Good
ICEplot_Good_NHDWAT_PCT_IMPERV <- ice(object = gbmFitFinal, X = datFrame[datFrame$NHDWAT_PCT_IMPERV <= 10, ],
                                      y = dummyResp[, 3], predictor = "NHDWAT_PCT_IMPERV",
                                      frac_to_build = 0.25, verbose=FALSE,
                                      predictfcn=function(object, newdata) predict(object, newdata=newdata, type="response",
                                                                                   n.trees=gbmFitFinal$n.trees)[, , 1] [, "Good"])
save(object=ICEplot_Good_NHDWAT_PCT_IMPERV, file="ICEplot_Good_NHDWAT_PCT_IMPERV", compress="xz")

# Load ice curves per response
load("ICEplot_Poor_NHDWAT_PCT_IMPERV")
load("ICEplot_Fair_NHDWAT_PCT_IMPERV")
load("ICEplot_Good_NHDWAT_PCT_IMPERV")

# Calculate range to compare curves
part1 <- sapply(1:ncol(ICEplot_Poor_NHDWAT_PCT_IMPERV$ice_curves), function(j) ICEplot_Poor_NHDWAT_PCT_IMPERV$ice_curves[, j] - ICEplot_Poor_NHDWAT_PCT_IMPERV$ice_curves[, 1])
part2 <- sapply(1:ncol(ICEplot_Fair_NHDWAT_PCT_IMPERV$ice_curves), function(j) ICEplot_Fair_NHDWAT_PCT_IMPERV$ice_curves[, j] - ICEplot_Fair_NHDWAT_PCT_IMPERV$ice_curves[, 1])
part3 <- sapply(1:ncol(ICEplot_Good_NHDWAT_PCT_IMPERV$ice_curves), function(j) ICEplot_Good_NHDWAT_PCT_IMPERV$ice_curves[, j] - ICEplot_Good_NHDWAT_PCT_IMPERV$ice_curves[, 1])
commonRange <- range(cbind(part1, part2, part3))

# Legend coloring by ecoregion
# Poor
legend_ICEplot_Poor_NHDWAT_PCT_IMPERV_ecoRegion <- vector("character", nrow(ICEplot_Poor_NHDWAT_PCT_IMPERV$Xice))
for( i in 1:nrow(ICEplot_Poor_NHDWAT_PCT_IMPERV$Xice) ){
  
  legend_ICEplot_Poor_NHDWAT_PCT_IMPERV_ecoRegion[i] <- glasbey()[which(levels(ICEplot_Poor_NHDWAT_PCT_IMPERV$Xice$AGGR_ECO9_2015)==
                                                                          ICEplot_Poor_NHDWAT_PCT_IMPERV$Xice$AGGR_ECO9_2015[i])]
  
}
# Fair
legend_ICEplot_Fair_NHDWAT_PCT_IMPERV_ecoRegion <- vector("character", nrow(ICEplot_Fair_NHDWAT_PCT_IMPERV$Xice))
for( i in 1:nrow(ICEplot_Fair_NHDWAT_PCT_IMPERV$Xice) ){
  
  legend_ICEplot_Fair_NHDWAT_PCT_IMPERV_ecoRegion[i] <- glasbey()[which(levels(ICEplot_Fair_NHDWAT_PCT_IMPERV$Xice$AGGR_ECO9_2015)==
                                                                          ICEplot_Fair_NHDWAT_PCT_IMPERV$Xice$AGGR_ECO9_2015[i])]
  
}
# Good
legend_ICEplot_Good_NHDWAT_PCT_IMPERV_ecoRegion <- vector("character", nrow(ICEplot_Good_NHDWAT_PCT_IMPERV$Xice))
for( i in 1:nrow(ICEplot_Good_NHDWAT_PCT_IMPERV$Xice) ){
  
  legend_ICEplot_Good_NHDWAT_PCT_IMPERV_ecoRegion[i] <- glasbey()[which(levels(ICEplot_Good_NHDWAT_PCT_IMPERV$Xice$AGGR_ECO9_2015)==
                                                                          ICEplot_Good_NHDWAT_PCT_IMPERV$Xice$AGGR_ECO9_2015[i])]
  
}

# Coloring by ecoregion
pdf("NHDWAT_PCT_IMPERV_gbmFitFinal_ecoRegion.pdf", width=7)
par(mfrow=c(1, 3), mar=c(5+10, 4, 4, 2) + 0.1)
plot(ICEplot_Poor_NHDWAT_PCT_IMPERV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="Impervious surface [%]",
     ylab="Probability of response Poor class", colorvec=legend_ICEplot_Poor_NHDWAT_PCT_IMPERV_ecoRegion)
plot(ICEplot_Fair_NHDWAT_PCT_IMPERV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="Impervious surface [%]",
     ylab="Probability of response Fair class", colorvec=legend_ICEplot_Fair_NHDWAT_PCT_IMPERV_ecoRegion)
legend(x=-0.5, y=-0.55, legend=c("Coastal Plains", "Northern Appalachians", "Northern Plains",
                                 "Southern Appalachians", "Southern Plains", "Temperate Plains",
                                 "Upper Midwest", "Western Mountains", "Xeric West"), 
       lty=1, lwd=2, col=glasbey()[1:9], xpd=TRUE)
plot(ICEplot_Good_NHDWAT_PCT_IMPERV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="Impervious surface [%]",
     ylab="Probability of response Good class", colorvec=legend_ICEplot_Good_NHDWAT_PCT_IMPERV_ecoRegion)
dev.off()
par(mfrow=c(1, 1), mar=c(5, 4, 4, 2) + 0.1)

# Coloring by eco region
pdf("NHDWAT_PCT_IMPERV_gbmFitFinal_ecoRegion_PIT.pdf", width=7)
par(mfrow=c(1, 3), mar=c(5+10, 4, 4, 2) + 0.1)
plot(ICEplot_Poor_NHDWAT_PCT_IMPERV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="PIT impervious surface",
     ylab="Probability of response Poor class", colorvec=legend_ICEplot_Poor_NHDWAT_PCT_IMPERV_ecoRegion,
     x_quantile=TRUE)
plot(ICEplot_Fair_NHDWAT_PCT_IMPERV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="PIT impervious surface",
     ylab="Probability of response Fair class", colorvec=legend_ICEplot_Fair_NHDWAT_PCT_IMPERV_ecoRegion,
     x_quantile=TRUE)
legend(x=-0.1, y=-0.55, legend=c("Coastal Plains", "Northern Appalachians", "Northern Plains",
                                 "Southern Appalachians", "Southern Plains", "Temperate Plains",
                                 "Upper Midwest", "Western Mountains", "Xeric West"), 
       lty=1, lwd=2, col=glasbey()[1:9], xpd=TRUE)
plot(ICEplot_Good_NHDWAT_PCT_IMPERV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="PIT impervious surface",
     ylab="Probability of response Good class", colorvec=legend_ICEplot_Good_NHDWAT_PCT_IMPERV_ecoRegion,
     x_quantile=TRUE)
dev.off()
par(mfrow=c(1, 1), mar=c(5, 4, 4, 2) + 0.1)

#############################
# ALE dependence on grid size
# Manuscript Figure 4

library(ggplot2)
library(iml)
library(grid)
featureName <- "Log rel. bed stability"
designGrid <- expand.grid(bootIter=1:100, gridSize=c(100, 200, 400, 800, 1600))
designGridDim <- dim(designGrid)[1]
for(i in 1:designGridDim){
  load(paste("ALE_Good_plot_gridSize", designGrid[i, "gridSize"], "_bootIter", 
             designGrid[i, "bootIter"]))
  
  if(i %% 100 == 1){
    if(exists(x="ALE_Good_plot")){
      rm(ALE_Good_plot)
    }
    ALE_Good_plot <-  plot(ALE_Good_grid, ylim= c(-0.4, 0.2)) + 
      xlab(label=featureName) + ggtitle(paste("Intervals", designGrid[i, "gridSize"])) + 
      scale_x_continuous(limits = c(-5, 5)) + theme(plot.title = element_text(hjust = 0.5))
  } else{
    ALE_Good_plot <- ALE_Good_plot + geom_line(mapping=aes(x=LRBS_USE, y=.value), 
                                               data=ALE_Good_grid$results)
  }
  
  if(i %% 100 == 0){
    assign(x=paste("ALE_Good_plot_gridSize", designGrid[i, "gridSize"], sep=""), value=ALE_Good_plot)
  }
  cat("Progress", i/designGridDim*100, "%", "\n")
}

# Export graphics to PDF format
pdf("ALE_gridSize.pdf")
grid.arrange(get(paste("ALE_Good_plot_gridSize", 100, sep="")),
             get(paste("ALE_Good_plot_gridSize", 200, sep="")),
             get(paste("ALE_Good_plot_gridSize", 400, sep="")),
             get(paste("ALE_Good_plot_gridSize", 800, sep="")),
             get(paste("ALE_Good_plot_gridSize", 1600, sep="")),
             ncol=3)
dev.off()

############################################
# Comparison of ALE and PDP curves
# Manuscript Figure 5

# Specification of data structure
predModel_Poor <- Predictor$new(model = gbmFitFinal, 
                               data=datFrame, 
                               class="Poor",
                               predict.fun = function(model, newdata) {
                                 predict.gbm(object=model, newdata=newdata, 
                                             n.trees=model$n.trees, type="response")[, , 1]}, 
                               type = NULL)
predModel_Fair <- Predictor$new(model = gbmFitFinal, 
                               data=datFrame, 
                               class="Fair",
                               predict.fun = function(model, newdata) {
                                 predict.gbm(object=model, newdata=newdata, 
                                             n.trees=model$n.trees, type="response")[, , 1]}, 
                               type = NULL)
predModel_Good <- Predictor$new(model = gbmFitFinal, 
                               data=datFrame, 
                               class="Good",
                               predict.fun = function(model, newdata) {
                                 predict.gbm(object=model, newdata=newdata, 
                                             n.trees=model$n.trees, type="response")[, , 1]}, 
                               type = NULL)

# Calculate ALE for numerical features
# Use variables log relative bed stability and impervious surface
gridSize <- 100
ALE_Poor <- vector("list", 2)
ALE_Fair <- vector("list", 2)
ALE_Good <- vector("list", 2)
Index <- 1
for( featureName in c("LRBS_USE", "NHDWAT_PCT_IMPERV") ){
  ALE_Poor[[Index]] <- FeatureEffect$new(predictor=predModel_Poor, 
                                         feature=featureName, 
                                         method = "ale", grid.size = gridSize,  
                                         center.at = NULL)
  ALE_Fair[[Index]] <- FeatureEffect$new(predictor=predModel_Fair, 
                                         feature=featureName, 
                                         method = "ale", grid.size = gridSize,  
                                         center.at = NULL)
  ALE_Good[[Index]] <- FeatureEffect$new(predictor=predModel_Good, 
                                         feature=featureName, 
                                         method = "ale", grid.size = gridSize,  
                                         center.at = NULL)
  Index <- Index + 1
}
save(ALE_Poor, file="ALE_Poor_LRBS_USE_NHDWAT_PCT_IMPERV")
save(ALE_Fair, file="ALE_Fair_LRBS_USE_NHDWAT_PCT_IMPERV")
save(ALE_Good, file="ALE_Good_LRBS_USE_NHDWAT_PCT_IMPERV")

# Load previous ALE and ICE plots
load("ALE_Poor_LRBS_USE_NHDWAT_PCT_IMPERV")
load("ALE_Fair_LRBS_USE_NHDWAT_PCT_IMPERV")
load("ALE_Good_LRBS_USE_NHDWAT_PCT_IMPERV")
load("ICEplot_Poor_NHDWAT_PCT_IMPERV")
load("ICEplot_Fair_NHDWAT_PCT_IMPERV")
load("ICEplot_Good_NHDWAT_PCT_IMPERV")

# Unequal length of predictions: Use linear interpolation
linApprox_ALE_Poor <- approxfun(x=ALE_Poor[[2]]$results$NHDWAT_PCT_IMPERV,
                                y=ALE_Poor[[2]]$results$.value)
linApprox_ALE_Fair <- approxfun(x=ALE_Fair[[2]]$results$NHDWAT_PCT_IMPERV,
                                y=ALE_Fair[[2]]$results$.value)
linApprox_ALE_Good <- approxfun(x=ALE_Good[[2]]$results$NHDWAT_PCT_IMPERV,
                                y=ALE_Good[[2]]$results$.value)

# ALE vs PDP graphics
# Both are centered to have a valid comparison

# Poor
yLimits <- c(-0.1, 0.2)
pdf("Comparison_PDPvsALE.pdf")
par(mfrow=c(1, 3), oma=c(0, 2, 0, 0))
plot(x=ICEplot_Poor_NHDWAT_PCT_IMPERV$gridpts, 
     y=ICEplot_Poor_NHDWAT_PCT_IMPERV$pdp-
       mean(ICEplot_Poor_NHDWAT_PCT_IMPERV$pdp), type="l",
     ylim=yLimits, 
     main=paste("RMSE", round(sqrt(mean(((
       ICEplot_Poor_NHDWAT_PCT_IMPERV$pdp-
         mean(ICEplot_Poor_NHDWAT_PCT_IMPERV$pdp))-
         linApprox_ALE_Poor(ICEplot_Poor_NHDWAT_PCT_IMPERV$gridpts))^2)), 4), sep=":"), 
     las=1, cex.axis=1.5, cex.lab=1.5, lwd=2, ylab="",
     xlab="Impervious surface [%]")
mtext(side = 2, text = "Probability of response Poor class", line = 4)

lines(x=ICEplot_Poor_NHDWAT_PCT_IMPERV$gridpts, 
      y=linApprox_ALE_Poor(ICEplot_Poor_NHDWAT_PCT_IMPERV$gridpts), type="l", col="red",
      cex.axis=1.5, cex.lab=1.5, lwd=2, lty=2)

# Fair
plot(x=ICEplot_Fair_NHDWAT_PCT_IMPERV$gridpts, 
     y=ICEplot_Fair_NHDWAT_PCT_IMPERV$pdp-
       mean(ICEplot_Fair_NHDWAT_PCT_IMPERV$pdp), type="l",
     ylim=yLimits, 
     main=paste("RMSE", round(sqrt(mean(((
       ICEplot_Fair_NHDWAT_PCT_IMPERV$pdp-
         mean(ICEplot_Fair_NHDWAT_PCT_IMPERV$pdp))-
         linApprox_ALE_Fair(ICEplot_Fair_NHDWAT_PCT_IMPERV$gridpts))^2)), 4), sep=":"),
     las=1, cex.axis=1.5, cex.lab=1.5, lwd=2, ylab="",
     xlab="Impervious surface [%]")
mtext(side = 2, text = "Probability of response Fair class", line = 4)

lines(x=ICEplot_Fair_NHDWAT_PCT_IMPERV$gridpts, 
      y=linApprox_ALE_Fair(ICEplot_Fair_NHDWAT_PCT_IMPERV$gridpts), type="l", col="red",
      cex.axis=1.5, cex.lab=1.5, lwd=2, lty=2)

# Good
plot(x=ICEplot_Good_NHDWAT_PCT_IMPERV$gridpts, 
     y=ICEplot_Good_NHDWAT_PCT_IMPERV$pdp-
       mean(ICEplot_Good_NHDWAT_PCT_IMPERV$pdp), type="l",
     ylim=yLimits, 
     main=paste("RMSE", round(sqrt(mean(((
       ICEplot_Good_NHDWAT_PCT_IMPERV$pdp-
         mean(ICEplot_Good_NHDWAT_PCT_IMPERV$pdp))-
         linApprox_ALE_Good(ICEplot_Good_NHDWAT_PCT_IMPERV$gridpts))^2)), 4), sep=":"),
     las=1, cex.axis=1.5, cex.lab=1.5, lwd=2, ylab="",
     xlab="Impervious surface [%]")
mtext(side = 2, text = "Probability of response Good class", line = 4)

lines(x=ICEplot_Good_NHDWAT_PCT_IMPERV$gridpts, 
      y=linApprox_ALE_Good(ICEplot_Good_NHDWAT_PCT_IMPERV$gridpts), type="l", col="red",
      cex.axis=1.5, cex.lab=1.5, lwd=2, lty=2)
par(mfrow=c(1, 1))
dev.off()

####################################################################################
#  ICE plots visualizing the three strongest significant two-way interaction effects
# Manuscript Figure 6, Supplemental material Figure S8

# Estimate ICE plots
ICEplotFair_NHDWAT_NADP2009_MEAN_NO3 <- ice(object = gbmFitFinal, X = datFrame,
                                            y = dummyResp[, 2], 
                                            predictor = "NHDWAT_NADP2009_MEAN_NO3",
                                            frac_to_build = 0.25, verbose=FALSE,
                                            predictfcn=function(object, newdata) 
                                              predict(object, newdata=newdata, type="response",
                                                      n.trees=gbmFitFinal$n.trees)[, , 1] [, "Fair"])
save(object=ICEplotFair_NHDWAT_NADP2009_MEAN_NO3, file="ICEplotFair_NHDWAT_NADP2009_MEAN_NO3", 
     compress="xz")

ICEplotFair_NHDWAT_ELEV <- ice(object = gbmFitFinal, X = datFrame,
                               y = dummyResp[, 2], predictor = "NHDWAT_ELEV",
                               frac_to_build = 0.25, verbose=FALSE,
                               predictfcn=function(object, newdata) 
                                 predict(object, newdata=newdata, type="response",
                                         n.trees=gbmFitFinal$n.trees)[, , 1] [, "Fair"])
save(object=ICEplotFair_NHDWAT_ELEV, file="ICEplotFair_NHDWAT_ELEV", compress="xz")

ICEplotFair_PCT_AG <- ice(object = gbmFitFinal, X = datFrame,
                          y = dummyResp[, 2], predictor = "PCT_AG",
                          frac_to_build = 0.25, verbose=FALSE,
                          predictfcn=function(object, newdata) 
                            predict(object, newdata=newdata, type="response",
                                    n.trees=gbmFitFinal$n.trees)[, , 1] [, "Fair"])
save(object=ICEplotFair_PCT_AG, file="ICEplotFair_PCT_AG", compress="xz")


load("ICEplotFair_NHDWAT_NADP2009_MEAN_NO3")
load("ICEplotFair_NHDWAT_ELEV")
load("ICEplotFair_PCT_AG")
# Calculate range to compare curves
part1 <- sapply(1:ncol(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$ice_curves), function(j) ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$ice_curves[, j] - ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$ice_curves[, 1])
part2 <- sapply(1:ncol(ICEplotFair_NHDWAT_ELEV$ice_curves), function(j) ICEplotFair_NHDWAT_ELEV$ice_curves[, j] - ICEplotFair_NHDWAT_ELEV$ice_curves[, 1])
part3 <- sapply(1:ncol(ICEplotFair_PCT_AG$ice_curves), function(j) ICEplotFair_PCT_AG$ice_curves[, j] - ICEplotFair_PCT_AG$ice_curves[, 1])
commonRange <- range(cbind(part1, part2, part3))

# NHDWAT_NADP2009_MEAN_NO3 + NHDWAT_NADP2009_MEAN_SO4
legend_ICEplotFair_NHDWAT_NADP2009_MEAN_NO3 <- 
  matlab.like(449)
legend_ICEplotFair_NHDWAT_ELEV <- 
  matlab.like(449)
legend_ICEplotFair_PCT_AG <- 
  matlab.like(449)

# Various ICE plots with highlighting interactions by colors
legend_image_NO3 <- as.raster(matrix(legend_ICEplotFair_NHDWAT_NADP2009_MEAN_NO3, ncol=1))
legend_image_ELEV <- as.raster(matrix(legend_ICEplotFair_NHDWAT_ELEV, ncol=1))
legend_image_AG <- as.raster(matrix(legend_ICEplotFair_PCT_AG, ncol=1))
#
pdf("mostImp_twoWayInter_gbmFitFinal.pdf", width=7)
par(mfrow=c(1, 3))
plot(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, #color_by = "NHDWAT_NADP2009_MEAN_SO4",
     main="", xlab=paste("NO3", "by", "SO4 deposition"),
     ylim=commonRange, colorvec=legend_ICEplotFair_NHDWAT_NADP2009_MEAN_NO3,
     ylab="Probability of response Fair class", rug_quantile=NULL)
# Legend
text(x=min(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$gridpts)+3.25, y=0.2, labels="SO4 desposition")
rasterImage(legend_image_NO3, xleft=min(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$gridpts)+0.25, 
            ybottom=0.16, xright=min(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$gridpts)+1, 
            ytop=0.19)
text(x=min(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$gridpts)+3, y=0.185, labels="low")
text(x=min(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$gridpts)+3, y=0.175, labels="medium")
text(x=min(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$gridpts)+3, y=0.165, labels="high")
rect(xleft=min(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$gridpts)-1, 
     ybottom=0.155, 
     xright=min(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$gridpts)+7, 
     ytop=0.3)
#
plot(ICEplotFair_NHDWAT_ELEV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, #color_by = "TMAX_ANN",
     main="", xlab=paste("Elevation", "by", "maximum temperature"),
     ylim=commonRange, colorvec=legend_ICEplotFair_NHDWAT_ELEV,
     ylab="Probability of response Fair class", rug_quantile=NULL)
# Legend
text(x=(min(ICEplotFair_NHDWAT_ELEV$gridpts)+3.25)*110, y=0.2, labels="Max temperature")
rasterImage(legend_image_ELEV, xleft=(min(ICEplotFair_NHDWAT_ELEV$gridpts)+0.25)*20, 
            ybottom=0.16, xright=(min(ICEplotFair_NHDWAT_ELEV$gridpts)+1)*60, 
            ytop=0.19)
text(x=(min(ICEplotFair_NHDWAT_ELEV$gridpts)+3)*125, y=0.185, labels="low")
text(x=(min(ICEplotFair_NHDWAT_ELEV$gridpts)+3)*125, y=0.175, labels="medium")
text(x=(min(ICEplotFair_NHDWAT_ELEV$gridpts)+3)*125, y=0.165, labels="high")
rect(xleft=min(ICEplotFair_NHDWAT_ELEV$gridpts)-200, 
     ybottom=0.155, 
     xright=(min(ICEplotFair_NHDWAT_ELEV$gridpts)+7)*170, 
     ytop=0.3)
#
plot(ICEplotFair_PCT_AG, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, #color_by = "NHDWAT_SLOPE",
     main="", xlab=paste("Agriculture", "by", "catchment slope"),
     ylim=commonRange, colorvec=legend_ICEplotFair_PCT_AG,
     ylab="Probability of response Fair class", rug_quantile=NULL)
# Legend
text(x=(min(ICEplotFair_PCT_AG$gridpts)+3.25)*10, y=0.2, labels="Catchment slope")
rasterImage(legend_image_AG, xleft=(min(ICEplotFair_PCT_AG$gridpts)+0.25)*10, 
            ybottom=0.16, xright=(min(ICEplotFair_PCT_AG$gridpts)+1)*10, 
            ytop=0.19)
text(x=(min(ICEplotFair_PCT_AG$gridpts)+3)*10, y=0.185, labels="low")
text(x=(min(ICEplotFair_PCT_AG$gridpts)+3)*10, y=0.175, labels="medium")
text(x=(min(ICEplotFair_PCT_AG$gridpts)+3)*10, y=0.165, labels="high")
rect(xleft=min(ICEplotFair_PCT_AG$gridpts)-10, 
     ybottom=0.155, 
     xright=(min(ICEplotFair_PCT_AG$gridpts)+7)*10, 
     ytop=0.3)
#
dev.off()
par(mfrow=c(1, 1))


pdf("mostImp_twoWayInter_gbmFitFinal_PIT.pdf", width=7)
par(mfrow=c(1, 3))
plot(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, #color_by = "NHDWAT_NADP2009_MEAN_SO4",
     main="", xlab=paste("PIT NO3", "by", "SO4 deposition"),
     ylim=commonRange, colorvec=legend_ICEplotFair_NHDWAT_NADP2009_MEAN_NO3,
     ylab="Probability of response Fair class", rug_quantile=NULL, x_quantile=TRUE)
# Legend
text(x=0.3, y=0.2, labels="SO4 desposition")
rasterImage(legend_image_NO3, xleft=0, 
            ybottom=0.16, xright=0.2, 
            ytop=0.19)
text(x=0.375, y=0.185, labels="low")
text(x=0.375, y=0.175, labels="medium")
text(x=0.375, y=0.165, labels="high")
rect(xleft=min(ICEplotFair_NHDWAT_NADP2009_MEAN_NO3$gridpts)-1, 
     ybottom=0.155, 
     xright=0.65, 
     ytop=0.3)
# 
plot(ICEplotFair_NHDWAT_ELEV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, #color_by = "TMAX_ANN",
     main="", xlab=paste("PIT elevation", "by", "maximum temperature"),
     ylim=commonRange, colorvec=legend_ICEplotFair_NHDWAT_ELEV,
     ylab="Probability of response Fair class", rug_quantile=NULL, x_quantile=TRUE)
# Legend
text(x=0.3, y=0.2, labels="Max temperature")
rasterImage(legend_image_ELEV, xleft=0, 
            ybottom=0.16, xright=0.2, 
            ytop=0.19)
text(x=0.375, y=0.185, labels="low")
text(x=0.375, y=0.175, labels="medium")
text(x=0.375, y=0.165, labels="high")
rect(xleft=min(ICEplotFair_NHDWAT_ELEV$gridpts)-200, 
     ybottom=0.155, 
     xright=0.65, 
     ytop=0.3)
plot(ICEplotFair_PCT_AG, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, #color_by = "NHDWAT_SLOPE",
     main="", xlab=paste("PIT agriculture", "by", "catchment slope"),
     ylim=commonRange, colorvec=legend_ICEplotFair_PCT_AG,
     ylab="Probability of response Fair class", rug_quantile=NULL, x_quantile=TRUE)
# Legend
text(x=0.3, y=0.2, labels="Catchment slope")
rasterImage(legend_image_AG, xleft=0, 
            ybottom=0.16, xright=0.2, 
            ytop=0.19)
text(x=0.375, y=0.185, labels="low")
text(x=0.375, y=0.175, labels="medium")
text(x=0.375, y=0.165, labels="high")
rect(xleft=min(ICEplotFair_PCT_AG$gridpts)-10, 
     ybottom=0.155, 
     xright=0.65, 
     ytop=0.3)
dev.off()
par(mfrow=c(1, 1))

##########################################################
# Two-dimensional ALE plot showing interactions between catchment slope and
# percentage of agriculture on the fair benthic condition
# Manuscript Figure 7

# Two dimensional ALE plot
gridSize <- 100
ALE_Fair_interaction <- vector("list", 3)
featureNames <- list(c("NHDWAT_NADP2009_MEAN_NO3", "NHDWAT_NADP2009_MEAN_SO4"),
                     c("NHDWAT_ELEV", "TMAX_ANN"),
                     c("PCT_AG", "NHDWAT_SLOPE"))
for( Index in 1:3 ){
  ALE_Fair_interaction[[Index]] <- FeatureEffect$new(predictor=predModel_Fair, 
                                                     feature=featureNames[[Index]], 
                                                     method = "ale", 
                                                     grid.size = c(gridSize, gridSize),  
                                                     center.at = NULL)
}
save(ALE_Fair_interaction, file="ALE_Fair_interaction")

# Create plots of all marginal predictors
load("ALE_Fair_interaction")
library(ggplot2)
library(iml)
library(gridExtra)
library(ggExtra)
plotNames <- c("NO3_SO4", "ELEV_TMAX", "AG_SLOPE", "LRBS_USE_WSAREA_NARS")
for( j in 1:3 ){
  
  # Construct plots
  ALE_Fair_plot <- plot(ALE_Fair_interaction[[j]], rug = TRUE)
  ALE_Fair_plot$layers[[1]] <- NULL
  
  if(plotNames[j]=="AG_SLOPE"){

    ALE_Fair_plot <- ALE_Fair_plot +
      geom_rect(aes(xmin=.left, xmax=.right, ymin=.bottom, ymax=.top,
                    color=.ale, fill=.ale),
                data=ALE_Fair_interaction[[j]]$results) +
      guides(color=FALSE) +
      theme(axis.title = element_text(),
            axis.line = element_line(colour = "black"),
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank(),
            panel.border = element_blank(),
            panel.background = element_blank(),
            panel.spacing=element_blank(),
            strip.background=element_blank(),
            strip.switch.pad.grid=element_blank(),
            strip.switch.pad.wrap=element_blank()
      ) +
      scale_y_continuous(name="Catchment slope [%]") +
      scale_x_continuous(name="Agriculture [%]")
    
  } else{
    ALE_Fair_plot <- ALE_Fair_plot +
      geom_rect(aes(xmin=.left, xmax=.right, ymin=.bottom, ymax=.top,
                    color=.ale, fill=.ale),
                data=ALE_Fair_interaction[[j]]$results) +
      guides(color=FALSE) +
      theme(axis.line = element_line(colour = "black"),
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank(),
            panel.border = element_blank(),
            panel.background = element_blank(),
            panel.spacing=element_blank(),
            strip.background=element_blank(),
            strip.switch.pad.grid=element_blank(),
            strip.switch.pad.wrap=element_blank()
      ) 
  }
  
  # Graphics
  pdf(file=paste("ALE_Fair_interaction_", plotNames[j], ".pdf", sep=""))
  grid.arrange(ALE_Fair_plot, ncol=1)
  dev.off()
}

###############################################################
# Human Disturbance Index ICE curves
# Supplemental material Figure S1

# W1_HALL
ICEplot_Poor_W1_HALL <- ice(object = gbmFitFinal, X = datFrame,
                            y = dummyResp[, 1], predictor = "W1_HALL",
                            frac_to_build = 0.25, verbose=FALSE,
                            predictfcn=function(object, newdata) 
                              predict(object, newdata=newdata, type="response",
                                      n.trees=gbmFitFinal$n.trees)[, , 1] [, "Poor"])
save(object=ICEplot_Poor_W1_HALL, file="ICEplot_Poor_W1_HALL", compress="xz")

# Fair
ICEplot_Fair_W1_HALL <- ice(object = gbmFitFinal, X = datFrame,
                            y = dummyResp[, 2], predictor = "W1_HALL",
                            frac_to_build = 0.25, verbose=FALSE,
                            predictfcn=function(object, newdata) 
                              predict(object, newdata=newdata, type="response",
                                      n.trees=gbmFitFinal$n.trees)[, , 1] [, "Fair"])
save(object=ICEplot_Fair_W1_HALL, file="ICEplot_Fair_W1_HALL", compress="xz")

# Good
ICEplot_Good_W1_HALL <- ice(object = gbmFitFinal, X = datFrame,
                            y = dummyResp[, 3], predictor = "W1_HALL",
                            frac_to_build = 0.25, verbose=FALSE,
                            predictfcn=function(object, newdata) 
                              predict(object, newdata=newdata, type="response",
                                      n.trees=gbmFitFinal$n.trees)[, , 1] [, "Good"])
save(object=ICEplot_Good_W1_HALL, file="ICEplot_Good_W1_HALL", compress="xz")

# Calculate range of x-axis to compare curves
load("ICEplot_Poor_W1_HALL")
load("ICEplot_Fair_W1_HALL")
load("ICEplot_Good_W1_HALL")
part1 <- sapply(1:ncol(ICEplot_Poor_W1_HALL$ice_curves), 
                function(j) ICEplot_Poor_W1_HALL$ice_curves[, j] - 
                  ICEplot_Poor_W1_HALL$ice_curves[, 1])
part2 <- sapply(1:ncol(ICEplot_Fair_W1_HALL$ice_curves), 
                function(j) ICEplot_Fair_W1_HALL$ice_curves[, j] - 
                  ICEplot_Fair_W1_HALL$ice_curves[, 1])
part3 <- sapply(1:ncol(ICEplot_Good_W1_HALL$ice_curves), 
                function(j) ICEplot_Good_W1_HALL$ice_curves[, j] - 
                  ICEplot_Good_W1_HALL$ice_curves[, 1])
commonRange <- range(cbind(part1, part2, part3))

# Export to PDF
pdf("W1_HALL_gbmFitFinal.pdf", width=7*1.5)
par(mfrow=c(1, 3))
plot(ICEplot_Poor_W1_HALL, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="Human Disturbance Index",
     ylab="Probability of response Poor class")
plot(ICEplot_Fair_W1_HALL, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="",
     ylim=commonRange, xlab="Human Disturbance Index",
     ylab="Probability of response Fair class")
plot(ICEplot_Good_W1_HALL, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="",
     ylim=commonRange, xlab="Human Disturbance Index",
     ylab="Probability of response Good class")
dev.off()
par(mfrow=c(1, 1))

##############################################################################
# Riparian vegetation condition ICE plots
# Supplemental material Figures S2, S9

# L_XCMGW
ICEplot_Poor_L_XCMGW <- ice(object = gbmFitFinal, X = datFrame,
                            y = dummyResp[, 1], predictor = "L_XCMGW",
                            frac_to_build = 0.25, verbose=FALSE,
                            predictfcn=function(object, newdata) 
                              predict(object, newdata=newdata, type="response",
                                      n.trees=gbmFitFinal$n.trees)[, , 1] [, "Poor"])
save(object=ICEplot_Poor_L_XCMGW, file="ICEplot_Poor_L_XCMGW", compress="xz")

# Fair
ICEplot_Fair_L_XCMGW <- ice(object = gbmFitFinal, X = datFrame,
                            y = dummyResp[, 2], predictor = "L_XCMGW",
                            frac_to_build = 0.25, verbose=FALSE,
                            predictfcn=function(object, newdata) 
                              predict(object, newdata=newdata, type="response",
                                      n.trees=gbmFitFinal$n.trees)[, , 1] [, "Fair"])
save(object=ICEplot_Fair_L_XCMGW, file="ICEplot_Fair_L_XCMGW", compress="xz")

# Good
ICEplot_Good_L_XCMGW <- ice(object = gbmFitFinal, X = datFrame,
                            y = dummyResp[, 3], predictor = "L_XCMGW",
                            frac_to_build = 0.25, verbose=FALSE,
                            predictfcn=function(object, newdata) 
                              predict(object, newdata=newdata, type="response",
                                      n.trees=gbmFitFinal$n.trees)[, , 1] [, "Good"])
save(object=ICEplot_Good_L_XCMGW, file="ICEplot_Good_L_XCMGW", compress="xz")

# Calculate range to compare curves
load("ICEplot_Poor_L_XCMGW")
load("ICEplot_Fair_L_XCMGW")
load("ICEplot_Good_L_XCMGW")
part1 <- sapply(1:ncol(ICEplot_Poor_L_XCMGW$ice_curves), 
                function(j) ICEplot_Poor_L_XCMGW$ice_curves[, j] - 
                  ICEplot_Poor_L_XCMGW$ice_curves[, 1])
part2 <- sapply(1:ncol(ICEplot_Fair_L_XCMGW$ice_curves), 
                function(j) ICEplot_Fair_L_XCMGW$ice_curves[, j] - 
                  ICEplot_Fair_L_XCMGW$ice_curves[, 1])
part3 <- sapply(1:ncol(ICEplot_Good_L_XCMGW$ice_curves), 
                function(j) ICEplot_Good_L_XCMGW$ice_curves[, j] - 
                  ICEplot_Good_L_XCMGW$ice_curves[, 1])
commonRange <- range(cbind(part1, part2, part3))

pdf("L_XCMGW_gbmFitFinal.pdf", width=7*1.5)
par(mfrow=c(1, 3))
plot(ICEplot_Poor_L_XCMGW, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="Riparian vegetation condition",
     ylab="Probability of response Poor class")
plot(ICEplot_Fair_L_XCMGW, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="",
     ylim=commonRange, xlab="Riparian vegetation condition",
     ylab="Probability of response Fair class")
plot(ICEplot_Good_L_XCMGW, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="",
     ylim=commonRange, xlab="Riparian vegetation condition",
     ylab="Probability of response Good class")
dev.off()
par(mfrow=c(1, 1))

# Different scaling of x-axis
pdf("L_XCMGW_gbmFitFinal_PIT.pdf", width=7*1.5)
par(mfrow=c(1, 3))
plot(ICEplot_Poor_L_XCMGW, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="PIT riparian vegetation condition",
     ylab="Probability of response Poor class", x_quantile=TRUE)
plot(ICEplot_Fair_L_XCMGW, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="",
     ylim=commonRange, xlab="PIT riparian vegetation condition",
     ylab="Probability of response Fair class", x_quantile=TRUE)
plot(ICEplot_Good_L_XCMGW, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="",
     ylim=commonRange, xlab="PIT riparian vegetation condition",
     ylab="Probability of response Good class", x_quantile=TRUE)
dev.off()
par(mfrow=c(1, 1))

##############################################################################
# Watershed area ICE plots
# Supplemental material Figures S3, S10

# WSAREA_NARS
# Poor
dataFrameRed <- datFrame[datFrame$WSAREA_NARS <= quantile(datFrame$WSAREA_NARS, probs=0.9), ]
dummyRespRed <- dummyResp[datFrame$WSAREA_NARS <= quantile(datFrame$WSAREA_NARS, probs=0.9), ]
ICEplot_Poor_WSAREA_NARS <- ice(object = gbmFitFinal, X = dataFrameRed,
                                y = dummyRespRed[, 1], predictor = "WSAREA_NARS",
                                frac_to_build = 0.25, verbose=FALSE,
                                predictfcn=function(object, newdata) 
                                  predict(object, newdata=newdata, type="response",
                                          n.trees=gbmFitFinal$n.trees)[, , 1] [, "Poor"])
save(object=ICEplot_Poor_WSAREA_NARS, file="ICEplot_Poor_WSAREA_NARS", compress="xz")

# Fair
ICEplot_Fair_WSAREA_NARS <- ice(object = gbmFitFinal, X = dataFrameRed,
                                y = dummyRespRed[, 2], predictor = "WSAREA_NARS",
                                frac_to_build = 0.25, verbose=FALSE,
                                predictfcn=function(object, newdata) 
                                  predict(object, newdata=newdata, type="response",
                                          n.trees=gbmFitFinal$n.trees)[, , 1] [, "Fair"])
save(object=ICEplot_Fair_WSAREA_NARS, file="ICEplot_Fair_WSAREA_NARS", compress="xz")

# Good
ICEplot_Good_WSAREA_NARS <- ice(object = gbmFitFinal, X = dataFrameRed,
                                y = dummyRespRed[, 3], predictor = "WSAREA_NARS",
                                frac_to_build = 0.25, verbose=FALSE,
                                predictfcn=function(object, newdata) 
                                  predict(object, newdata=newdata, type="response",
                                          n.trees=gbmFitFinal$n.trees)[, , 1] [, "Good"])
save(object=ICEplot_Good_WSAREA_NARS, file="ICEplot_Good_WSAREA_NARS", compress="xz")

# Calculate range to compare curves
load("ICEplot_Poor_WSAREA_NARS")
load("ICEplot_Fair_WSAREA_NARS")
load("ICEplot_Good_WSAREA_NARS")
part1 <- sapply(1:ncol(ICEplot_Poor_WSAREA_NARS$ice_curves), 
                function(j) ICEplot_Poor_WSAREA_NARS$ice_curves[, j] - 
                  ICEplot_Poor_WSAREA_NARS$ice_curves[, 1])
part2 <- sapply(1:ncol(ICEplot_Fair_WSAREA_NARS$ice_curves), 
                function(j) ICEplot_Fair_WSAREA_NARS$ice_curves[, j] - 
                  ICEplot_Fair_WSAREA_NARS$ice_curves[, 1])
part3 <- sapply(1:ncol(ICEplot_Good_WSAREA_NARS$ice_curves), 
                function(j) ICEplot_Good_WSAREA_NARS$ice_curves[, j] - 
                  ICEplot_Good_WSAREA_NARS$ice_curves[, 1])
commonRange <- range(cbind(part1, part2, part3))

pdf("WSAREA_NARS_gbmFitFinal.pdf", width=7*1.5)
par(mfrow=c(1, 3))
plot(ICEplot_Poor_WSAREA_NARS, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="Watershed area",
     ylab="Probability of response Poor class")
plot(ICEplot_Fair_WSAREA_NARS, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="Watershed area",
     ylab="Probability of response Fair class")
plot(ICEplot_Good_WSAREA_NARS, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="",
     ylim=commonRange, xlab="Watershed area",
     ylab="Probability of response Good class")
dev.off()
par(mfrow=c(1, 1))

# Different scaling of x-axis
pdf("WSAREA_NARS_gbmFitFinal_PIT.pdf", width=7*1.5)
par(mfrow=c(1, 3))
plot(ICEplot_Poor_WSAREA_NARS, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="PIT watershed area",
     ylab="Probability of response Poor class", x_quantile=TRUE)
plot(ICEplot_Fair_WSAREA_NARS, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="", ylim=commonRange, xlab="PIT watershed area",
     ylab="Probability of response Fair class", x_quantile=TRUE)
plot(ICEplot_Good_WSAREA_NARS, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE,
     main="",
     ylim=commonRange, xlab="PIT watershed area",
     ylab="Probability of response Good class", x_quantile=TRUE)
dev.off()
par(mfrow=c(1, 1))

#####################################################################
# Marginal effect of impervious surface on estimated 
# benthic MMI condition distribution colored by catchment slope
# Supplemental material Figures S4, S11

# NHDWAT_NADP2009_MEAN_SO4 vs. NHDWAT_SLOPE
# NHDWAT_PCT_IMPERV vs. NHDWAT_SLOPE
ICEplotGood_NHDWAT_NADP2009_MEAN_SO4 <- ice(object = gbmFitFinal, X = datFrame,
                                            y = dummyResp[, 2], 
                                            predictor = "NHDWAT_NADP2009_MEAN_SO4",
                                            frac_to_build = 0.25, verbose=FALSE,
                                            predictfcn=function(object, newdata) 
                                              predict(object, newdata=newdata, type="response",
                                                      n.trees=gbmFitFinal$n.trees)[, , 1] [, "Good"])
save(object=ICEplotGood_NHDWAT_NADP2009_MEAN_SO4, 
     file="ICEplotGood_NHDWAT_NADP2009_MEAN_SO4", compress="xz")

ICEplotGood_NHDWAT_PCT_IMPERV <- ice(object = gbmFitFinal, X = datFrame,
                                     y = dummyResp[, 2], predictor = "NHDWAT_PCT_IMPERV",
                                     frac_to_build = 0.25, verbose=FALSE,
                                     predictfcn=function(object, newdata) 
                                       predict(object, newdata=newdata, type="response",
                                               n.trees=gbmFitFinal$n.trees)[, , 1] [, "Good"])
save(object=ICEplotGood_NHDWAT_PCT_IMPERV, 
     file="ICEplotGood_NHDWAT_PCT_IMPERV", compress="xz")

# Calculate range to compare curves
load("ICEplotGood_NHDWAT_NADP2009_MEAN_SO4")
load("ICEplotGood_NHDWAT_PCT_IMPERV")
part1 <- sapply(1:ncol(ICEplotGood_NHDWAT_NADP2009_MEAN_SO4$ice_curves), 
                function(j) ICEplotGood_NHDWAT_NADP2009_MEAN_SO4$ice_curves[, j] - 
                  ICEplotGood_NHDWAT_NADP2009_MEAN_SO4$ice_curves[, 1])
part2 <- sapply(1:ncol(ICEplotGood_NHDWAT_PCT_IMPERV$ice_curves), 
                function(j) ICEplotGood_NHDWAT_PCT_IMPERV$ice_curves[, j] - 
                  ICEplotGood_NHDWAT_PCT_IMPERV$ice_curves[, 1])
commonRange <- range(cbind(part1, part2))
legend_ICEplotGood_NHDWAT_NADP2009_MEAN_SO4 <- 
  matlab.like(449)
legend_ICEplotGood_NHDWAT_PCT_IMPERV <- 
  matlab.like(449)

legend_image_SO4 <- as.raster(matrix(legend_ICEplotGood_NHDWAT_NADP2009_MEAN_SO4, ncol=1))
legend_image_IMPERV <- as.raster(matrix(legend_ICEplotGood_NHDWAT_PCT_IMPERV, ncol=1))
pdf("ExampleGood_twoWayInter_gbmFitFinal.pdf", width=7*1.5)
par(mfrow=c(1, 2))
plot(ICEplotGood_NHDWAT_NADP2009_MEAN_SO4, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, #color_by = "NHDWAT_SLOPE",
     main="", xlab=paste("SO4 deposition", "by", "catchment slope"),
     ylim=commonRange, colorvec=legend_ICEplotGood_NHDWAT_NADP2009_MEAN_SO4,
     ylab="Probability of response Good class")
# Legend
text(x=0.15+3, y=0.45-0.75, labels="Catchment slope")
rasterImage(legend_image_SO4, xleft=0, 
            ybottom=0.36-0.75, xright=2, 
            ytop=0.425-0.75)
text(x=0.19+3.5, y=0.2+0.2175-0.75, labels="low")
text(x=0.19+3.5, y=0.175+0.2175-0.75, labels="medium")
text(x=0.19+3.5, y=0.15+0.2175-0.75, labels="high")
rect(xleft=min(ICEplotGood_NHDWAT_NADP2009_MEAN_SO4$gridpts)-1, 
     ybottom=0.35-0.75, 
     xright=0.35+6, 
     ytop=0.475-0.75)
plot(ICEplotGood_NHDWAT_PCT_IMPERV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, #color_by = "NHDWAT_SLOPE",
     main="", xlab=paste("Impervious surface", "by", "catchment slope"),
     ylim=commonRange, colorvec=legend_ICEplotGood_NHDWAT_PCT_IMPERV,
     ylab="Probability of response Good class")
# Legend
text(x=0.15+7.5, y=0.45-0.75+0.49, labels="Catchment slope")
rasterImage(legend_image_IMPERV, xleft=0, 
            ybottom=0.36-0.75+0.5, xright=0.1+5, 
            ytop=0.425-0.75+0.5)
text(x=0.19+9.5, y=0.2+0.2175-0.75+0.5, labels="low")
text(x=0.19+9.5, y=0.175+0.2175-0.75+0.5, labels="medium")
text(x=0.19+9.5, y=0.15+0.2175-0.75+0.5, labels="high")
rect(xleft=min(ICEplotGood_NHDWAT_PCT_IMPERV$gridpts)-10, 
     ybottom=0.35-0.75+0.5, 
     xright=0.35+15, 
     ytop=0.475-0.75+0.5)
dev.off()
par(mfrow=c(1, 1))

# Different scaling of x-axis
legend_image_SO4 <- as.raster(matrix(legend_ICEplotGood_NHDWAT_NADP2009_MEAN_SO4, ncol=1))
legend_image_IMPERV <- as.raster(matrix(legend_ICEplotGood_NHDWAT_PCT_IMPERV, ncol=1))
pdf("ExampleGood_twoWayInter_gbmFitFinal_PIT.pdf", width=7*1.5)
par(mfrow=c(1, 2))
plot(ICEplotGood_NHDWAT_NADP2009_MEAN_SO4, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, #color_by = "NHDWAT_SLOPE",
     main="", xlab=paste("PIT SO4 deposition", "by", "catchment slope"),
     ylim=commonRange, colorvec=legend_ICEplotGood_NHDWAT_NADP2009_MEAN_SO4,
     ylab="Probability of response Good class", x_quantile=TRUE)
# Legend
text(x=0.15, y=0.45-0.75, labels="Catchment slope")
rasterImage(legend_image_SO4, xleft=0, 
            ybottom=0.36-0.75, xright=0.1, 
            ytop=0.425-0.75)
text(x=0.19, y=0.2+0.2175-0.75, labels="low")
text(x=0.19, y=0.175+0.2175-0.75, labels="medium")
text(x=0.19, y=0.15+0.2175-0.75, labels="high")
rect(xleft=min(ICEplotGood_NHDWAT_NADP2009_MEAN_SO4$gridpts)-1, 
     ybottom=0.35-0.75, 
     xright=0.35, 
     ytop=0.475-0.75)
plot(ICEplotGood_NHDWAT_PCT_IMPERV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, #color_by = "NHDWAT_SLOPE",
     main="", xlab=paste("PIT impervious surface", "by", "catchment slope"),
     ylim=commonRange, colorvec=legend_ICEplotGood_NHDWAT_PCT_IMPERV,
     ylab="Probability of response Good class", x_quantile=TRUE)
# Legend
text(x=0.15, y=0.45-0.75, labels="Catchment slope")
rasterImage(legend_image_IMPERV, xleft=0, 
            ybottom=0.36-0.75, xright=0.1, 
            ytop=0.425-0.75)
text(x=0.19, y=0.2+0.2175-0.75, labels="low")
text(x=0.19, y=0.175+0.2175-0.75, labels="medium")
text(x=0.19, y=0.15+0.2175-0.75, labels="high")
rect(xleft=min(ICEplotGood_NHDWAT_PCT_IMPERV$gridpts)-1, 
     ybottom=0.35-0.75, 
     xright=0.35, 
     ytop=0.475-0.75)
dev.off()
par(mfrow=c(1, 1))

#####################################################################
# Marginal effect of impervious surface on estimated benthic 
# MMI condition distribution colored by Shrub/Gras
# Supplemental material Figures S5, S12

ICEplotPoor_NHDWAT_PCT_IMPERV <- ice(object = gbmFitFinal, X = datFrame,
                                     y = dummyResp[, 1], predictor = "NHDWAT_PCT_IMPERV",
                                     frac_to_build = 0.25, verbose=FALSE,
                                     predictfcn=function(object, newdata) 
                                       predict(object, newdata=newdata, type="response",
                                               n.trees=gbmFitFinal$n.trees)[, , 1] [, "Poor"])
save(object=ICEplotPoor_NHDWAT_PCT_IMPERV, file="ICEplotPoor_NHDWAT_PCT_IMPERV", compress="xz")


load("ICEplotPoor_NHDWAT_PCT_IMPERV")
noIceCurves <- dim(ICEplotPoor_NHDWAT_PCT_IMPERV$ice_curves)[1]
legend_ICEplotPoor_NHDWAT_PCT_IMPERV <- 
  matlab.like(noIceCurves)

# Graphics
legend_image_IMPERV <- as.raster(matrix(legend_ICEplotPoor_NHDWAT_PCT_IMPERV, ncol=1))
pdf("lowH2_twoWayInter_gbmFitFinal.pdf", width=7*1.5)
plot(ICEplotPoor_NHDWAT_PCT_IMPERV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, 
     # color_by = "NHDWAT_PCT_IMPERV",
     colorvec=legend_ICEplotPoor_NHDWAT_PCT_IMPERV,
     main="", xlab=paste("Impervious surface", "by", "Shrub/Grass"),
     ylab="Probability of response Poor class")
# Legend
text(x=0.05+0.9, y=0.45, labels="Shrub/Grass")
rasterImage(legend_image_IMPERV, xleft=-1.2, 
            ybottom=0.36, xright=-0.2, 
            ytop=0.425)
text(x=0.15+1.4, y=0.2+0.2175, labels="low")
text(x=0.15+1.4, y=0.175+0.2175, labels="medium")
text(x=0.15+1.4, y=0.15+0.2175, labels="high")
rect(xleft=min(ICEplotPoor_NHDWAT_PCT_IMPERV$gridpts)-10, 
     ybottom=0.35, 
     xright=3.4, 
     ytop=0.5)
dev.off()

# Different scaling of x-axis
legend_image_IMPERV <- as.raster(matrix(legend_ICEplotPoor_NHDWAT_PCT_IMPERV, ncol=1))
pdf("lowH2_twoWayInter_gbmFitFinal_PIT.pdf", width=7*1.5)
plot(ICEplotPoor_NHDWAT_PCT_IMPERV, las=1, centered=TRUE, 
     plot_orig_pts_preds = FALSE, prop_range_y = FALSE, 
     # color_by = "NHDWAT_PCT_IMPERV",
     colorvec=legend_ICEplotPoor_NHDWAT_PCT_IMPERV,
     main="", xlab=paste("PIT impervious surface", "by", "Shrub/Grass"),
     ylab="Probability of response Poor class", x_quantile=TRUE)
# Legend
text(x=0.05, y=0.45, labels="Shrub/Grass")
rasterImage(legend_image_IMPERV, xleft=0, 
            ybottom=0.36, xright=0.1, 
            ytop=0.425)
text(x=0.15, y=0.2+0.2175, labels="low")
text(x=0.15, y=0.175+0.2175, labels="medium")
text(x=0.15, y=0.15+0.2175, labels="high")
rect(xleft=min(ICEplotPoor_NHDWAT_PCT_IMPERV$gridpts)-1, 
     ybottom=0.35, 
     xright=0.2, 
     ytop=0.5)
dev.off()