How can I build partial dependence plots with brt shapes? - r

Question

I am not practice in R and I need some help. I am an ecologist, I have a sites by variables matrix, where "TD0", "TD1", "TD2" are the response variables and "Chao", "age", "slope" the explanatory variables.
ID.plot TD0 TD1 TD2 Chao age slope
1 GS_Ci01N 20 8.898 6.488 0.6521390 26 2
2 GS_Ci03N 26 7.788 4.883 0.2335441 26 2
3 GS_Ci04N 31 10.482 7.282 0.5234748 26 0
4 GS_Ci05N 47 18.108 11.989 0.3110385 26 3
5 GS_Ci06N 47 16.332 10.107 0.4529010 26 0
6 GS_Ci07N 31 9.478 5.725 0.5524426 26 1
db.chao <- read.table(text=db.chao, header = TRUE)
I built boosted regression trees (BRT) to define the thresholds from explanatory-response shapes. I used "dismo" and "gbm" packages.
mod0 <- gbm.step(data=db.chao, gbm.x = 5:7, gbm.y = 2, family = "poisson", tree.complexity = 5, learning.rate = 0.0025, bag.fraction = 0.5)
mod1 <- gbm.step(data=db.chao, gbm.x = 5:7, gbm.y = 3, family = "gaussian", tree.complexity = 5, learning.rate = 0.0025, bag.fraction = 0.5)
mod2 <- gbm.step(data=db.chao, gbm.x = 5:7, gbm.y = 4, family = "gaussian", tree.complexity = 5, learning.rate = 0.0025, bag.fraction = 0.5)
I obtained three models:
"mod0" which describes the relation between TD0 and the explanatory variables
"mod1" which describes the relation between TD1 and the explanatory variables
"mod2" which describes the relation between TD2 and the explanatory variables
For each of them I built the panel graphs as below (these are just examples):
enter image description here
enter image description here
enter image description here
For each response variable I have three graphs, one for each explanatory variable.
I obtained them with this script:
gbm.plot(mod.TD0, n.plots = 3, write.title= FALSE, main = "TD0", rug = T, smooth = TRUE, plot.layout=c(1,3), common.scale = T)
gbm.plot(mod.TD1, n.plots = 3, write.title= FALSE, main = "TD1", rug = T, smooth = TRUE, plot.layout=c(1,3), common.scale = T)
gbm.plot(mod.TD2, n.plots = 3, write.title= FALSE, main = "TD2", rug = T, smooth = TRUE, plot.layout=c(1,3), common.scale = T)
Actually I would like to have three graphs, one for each explanatory variable and, after that if possible, in each of them I would like to overlap the three response variables shapes (with three different lines or colors).
I suppose I should use the "pdp" package for constructing partial dependence plots, but I'm not able to do this.
If someone could help me I would be grateful.
Thank you very much!

Answer 1

I'm not really sure how a gbm works and why it needs the number of trees to predict the output but here is a working example using the pdp and gridExtra packages:
library(pdp)
ntrees <- 250 # Number of trees to use to predict data
pred <- function(object, newdata) {
pred <- predict(object, newdata, n.trees = ntrees)
mean(pred)
}
pdps1 <- pdps2 <- pdps3 <- list()
for (i in 1:3) {
pdps1[[i]] <- partial(mod0, pred.var = names(db.chao)[i+4],
train = db.chao, plot = TRUE,
pred.fun = pred, recursive = F)
pdps2[[i]] <- partial(mod1, pred.var = names(db.chao)[i+4],
train = db.chao, plot = TRUE,
pred.fun = pred, recursive = F)
pdps3[[i]] <- partial(mod2, pred.var = names(db.chao)[i+4],
train = db.chao, plot = TRUE,
pred.fun = pred, recursive = F)
}
gridExtra::grid.arrange(grobs = pdps1, nrow = 1) # For the first model
gridExtra::grid.arrange(grobs = pdps2, nrow = 1) # For the second model
gridExtra::grid.arrange(grobs = pdps3, nrow = 1) # For the third model
Hope this helps!
EDIT
Following with the request of OP to obtain all pdps in only three plots and with different number of trees to predict the values:
library(pdp)
ntrees1 <- 150 # Number of trees to use to predict data with model1
ntrees2 <- 250 # Number of trees to use to predict data with model2
ntrees3 <- 50 # Number of trees to use to predict data with model3
pred1 <- function(object, newdata) {
pred <- predict(object, newdata, n.trees = ntrees1)
mean(pred)
}
pred2 <- function(object, newdata) {
pred <- predict(object, newdata, n.trees = ntrees2)
mean(pred)
}
pred3 <- function(object, newdata) {
pred <- predict(object, newdata, n.trees = ntrees3)
mean(pred)
}
# Function to obtain legend to plot later in grid.arrange
get_legend<-function(myggplot){
tmp <- ggplot_gtable(ggplot_build(myggplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
# Obtain partial dependence data instead of plot
pdps1 <- pdps2 <- pdps3 <- list()
plotlist <- list()
for (i in 1:3) {
# Create local environment to prevent ggplot to overwrite the plots with the iterator
local({
i <- i
pdps1[[i]] <<- partial(mod0, pred.var = names(db.chao)[i+4],
train = db.chao, plot = FALSE,
pred.fun = pred1, recursive = F)
pdps2[[i]] <<- partial(mod1, pred.var = names(db.chao)[i+4],
train = db.chao, plot = FALSE,
pred.fun = pred2, recursive = F)
pdps3[[i]] <<- partial(mod2, pred.var = names(db.chao)[i+4],
train = db.chao, plot = FALSE,
pred.fun = pred3, recursive = F)
pdp <- rbind(pdps1[[i]],pdps2[[i]],pdps3[[i]])
pdp <- cbind(pdp,rep(c("y1","y2","y3"), each = nrow(pdps1[[i]])))
names(pdp)[3] <- "#output"
plotlist[[i]] <<- ggplot(pdp) +
geom_line(aes(x = pdp[,1], y = pdp[,2],
group = pdp[,3], color = pdp[,3])) +
xlab(names(pdp)[1]) + ylab("yhat") +
ggtitle(paste0("PDP of ",names(pdp)[1])) +
labs(color = "#output")
})
legend <- get_legend(plotlist[[i]])
plotlist[[i]] <- plotlist[[i]] + theme(legend.position = "none")
}
plotlist[[4]] <- legend
gridExtra::grid.arrange(grobs = plotlist, nrow = 1, widths=c(2.3, 2.3, 2.3, 0.8))