##################################################################### # R code to the manuscript # "Right on track? Performance of satellite telemetry in terrestrial wildlife research" # by M.P.G. Hofman, M.W. Hayward, N. Balkenhol, et al. # # March 2019 # # For more details, contact mpghofman@gmail.com # # This script runs a beta gamboostLSS model for the Overall fix Success Rate (OSR), # calculates the empirical point-wise confidence intervals, # and plots the variables with their confidence intervals. ##################################################################### library(dplyr) library(stringr) library(ggplot2) library(mboost) library(gamboostLSS) library(lubridate) ### load overall dataframe and subset for OSR calculation #### overallFrame<- as.data.frame(read.csv("S10 Data.csv")) ### set filter, weighting and predictor variables for the OSR model ## OSRfilters <- c("oneBrand") OSRweights <- "numTag" OSRpredictors <- c("qualCovLab","forDen2","terRug", "wmTTF", "forTyp","wmYop", "quanCov", "speBurHib", "speHeight", "mquanTri", "mainRet2") # add "mainRet2" for the Overall Fix Succcess Rate OSRresponse <- "adjOSR" OSRrandomeffect <- c("mainBrand5") ### subset the overall dataframe for OSR analysis and further preparations OSRframe <- overallFrame[,c(OSRfilters, OSRweights, OSRpredictors, OSRresponse,OSRrandomeffect)] OSRframe <- OSRframe[-(which(is.na(OSRframe$adjOSR))),] OSRframe <- OSRframe[(which(!is.na(OSRframe$numTag))),] ### other adjustments OSRframe$logspeHeight <- log(OSRframe$speHeight) # log-transform species heigth OSRframe$mainBrand5 <- as.factor(OSRframe$mainBrand5) OSRframe$speBurHib <- as.factor(OSRframe$speBurHib) OSRframe$forTyp <- as.factor(OSRframe$forTyp) OSRframe$forDen2 <- as.factor(OSRframe$forDen2) OSRframe$qualCovLab <- as.factor(OSRframe$qualCovLab) OSRframe$terRug <- as.factor(OSRframe$terRug) OSRframe$wmYop <- as.numeric(OSRframe$wmYop) OSRframe$mquanTri <- as.numeric(OSRframe$mquanTri) ### FUNCTION: Run a gambooslss model and cut it off at the optimised mstop determined by cross-validation #### full.beta.gamboostLSS <- function(data,formula,weights,control) { ## run model # weights <- OSR.weights; formula <- OSR.mA; control <- OSR.boostControl; data <- OSR.dat mod <- gamboostLSS(formula, weights = weights, control = control, families = BetaLSS(stabilization = "MAD"), data = data) ## find the optimal mstop value ## set up the cross validation runs densegrid <- make.grid(max = c(mu = 100, phi = 100), min = 10, length.out = 10, dense_mu_grid = TRUE) cores <- ifelse(grepl("linux|apple", R.Version()$platform), 2, 1) folds <- cv(model.weights(mod), type = "subsampling", prob = .75) ## run cross validation cvr <- cvrisk(mod, grid = densegrid, folds = folds, mc.cores = cores) ## extract mstop and set the model results to it mstop(mod) <- mstop(cvr) return(mod) } ### model preparation #### ### (manually mean-center continuous variables when using bols() without intercept)!! theSeed <- 3 set.seed(theSeed) ### the model ## change OSR to OSR when running analysis for OSR, and ## add "mainRet2" OSR.incl <- c("forTyp", "qualCovLab","forDen2","terRug", "mainRet2", "speBurHib", "wmTTF","wmYop", "logspeHeight", "mainBrand5", "quanCov", "mquanTri","numTag","adjOSR") OSR.dat <- na.omit(OSRframe[,OSR.incl]) OSR.weights <- OSR.dat$numTag OSR.mA <- as.formula(adjOSR ~ bols(forTyp) + bols(qualCovLab) + bols(forDen2) + bols(mainRet2) + # Change OSR to OSR when running analysis for OSR bols(terRug) + bols(speBurHib) + brandom(mainBrand5) + mquanTri + quanCov + logspeHeight + wmTTF + wmYop) OSR.boostControl <- boost_control(mstop = c(100,100), risk = "inbag", trace = T) OSR.mod <- full.beta.gamboostLSS(OSR.dat,OSR.mA,OSR.weights,OSR.boostControl) summary(OSR.mod) emp_risk <- risk(OSR.mod, merge = TRUE) tail(emp_risk, n = 1) ### store final model results: # final.OSR.model.fit <- OSR.mod # final.OSR.model <- OSR.mA ### FUNCTION: randomly subsample a data frame (without replacement)#### ## (source: https://gist.github.com/ramhiser/1421185 ) boot_subsample <- function(x, subsample_size) { x[sample(x = seq_len(nrow(x)), size = subsample_size), ] } ### calculation of confidence bands #### ## create an empty list to store the bootstrap models set.seed(theSeed) boot.out <- list() ## set global model parameters (should be the same as the full test model) ## we keep the mstop values the same to avoid the subsampling needed for the cross validation tboostControl <- boost_control(mstop = mstop(OSR.mod), risk = "inbag", trace = T) ## run the bootraps. ## change OSR for OSR when Running the OSR analysis fileConnc <- sink(paste0("OSR_Log_",str_replace_all(today(),"\\D", ""), "_", theSeed,".txt")) # start a basic log file print(paste0("The seed was set to ", theSeed));print(OSR.mA);print(summary(OSR.mod)) boot.n <- 999; print(paste0("Number of bootstraps = ",boot.n)) sub_size <- floor(nrow(OSR.dat)*.75) for (i in 1:boot.n) { strt <- Sys.time(); print(paste0("bootstrap ",i," started at ", strt)) ## subsample dataset (75% of the data) without replacement idat <- boot_subsample(OSR.dat,sub_size) ## set local weights iweights <- idat$numTag boot.out[[i]] <- gamboostLSS(OSR.mA, weights = iweights, control = tboostControl, families = BetaLSS(stabilization = "MAD"), data = idat) bend <- Sys.time(); print(paste0("bootstrap ",i," took")); print(bend-strt); print("") } sink(fileConnc) ## Create a list of dataframes for each covariate in the models for both distribution parameters) ## the first column being the fitted values of the original model (OSR.mod) ## the other columns will contain the predicted values using the bootstrap models ## first: get covariate names used in the model cov.names <- names(OSR.dat)[-c(match("adjOSR",names(OSR.dat)),match("numTag",names(OSR.dat)))] ## create lists for mu and phi data frames mu.list <- list() phi.list <- list() ## populate lists with single column data frames (fitted OSR.mod values) for each variable for (i in 1:length(cov.names)) { name=cov.names[i]; muname <- paste0(name,".mu"); phiname <- paste0(name,".phi") mu.list[[i]] <- assign(muname, as.data.frame(fitted(OSR.mod$mu, which = name))) names(mu.list)[i] <- muname phi.list[[i]] <- assign(phiname, as.data.frame(fitted(OSR.mod$phi, which = name))) names(phi.list)[i] <- phiname } ## predict partial effects for the original data using the bootstrap models ## and attach predictions for each bootstrap model to the dataframes for (i in 1:length(boot.out)) { for (j in 1:length(cov.names)) { ijpred <- predict(boot.out[[i]], newdata = OSR.dat, which = cov.names[j]) mu.list[[paste0(cov.names[j],".mu")]] <- cbind(mu.list[[paste0(cov.names[j],".mu")]], ijpred$mu) names(mu.list[[paste0(cov.names[j],".mu")]])[ncol(mu.list[[paste0(cov.names[j],".mu")]])] <- paste0("run",i) phi.list[[paste0(cov.names[j],".phi")]] <- cbind(phi.list[[paste0(cov.names[j],".phi")]], ijpred$phi) names(phi.list[[paste0(cov.names[j],".phi")]])[ncol(phi.list[[paste0(cov.names[j],".phi")]])] <- paste0("run",i) } } ### FUNCTION: Calculate the percentiles per row in each data frame and add to data frames #### addQuants <- function(x) { newCols <- data.frame("lower" = numeric(), "upper" = numeric()) for (j in 1:nrow(x)) { quant <- quantile(x[j,], c(.025, .975)) newCols <- rbind(newCols,quant) } result <- cbind(x,newCols) return(result) } ### apply addQuants function #### mu.list <- lapply(mu.list, function(x) addQuants(x)) # for phi we had to exclude phi.list[[5]] (=speBurHib) from the operation as it did not have any predictions for (i in 1:length(phi.list)) { if (i == 6) {next} else {phi.list[[i]] <- addQuants(phi.list[[i]])} } ### FUNCTION: Multiple plots #### # # source: http://www.cookbook-r.com/Graphs/Multiple_graphs_on_one_page_(ggplot2)/ # # ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects) # - cols: Number of columns in layout # - layout: A matrix specifying the layout. If present, 'cols' is ignored. # # If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE), # then plot 1 will go in the upper left, 2 will go in the upper right, and # 3 will go all the way across the bottom. # multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) { library(grid) # Make a list from the ... arguments and plotlist plots <- c(list(...), plotlist) numPlots = length(plots) # If layout is NULL, then use 'cols' to determine layout if (is.null(layout)) { # Make the panel # ncol: Number of columns of plots # nrow: Number of rows needed, calculated from # of cols layout <- matrix(seq(1, cols * ceiling(numPlots/cols)), ncol = cols, nrow = ceiling(numPlots/cols), byrow = T) } if (numPlots==1) { print(plots[[1]]) } else { # Set up the page grid.newpage() pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout)))) # Make each plot, in the correct location for (i in 1:numPlots) { # Get the i,j matrix positions of the regions that contain this subplot matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE)) print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row, layout.pos.col = matchidx$col)) } } } ### create list of mu.plots #### mu.plots <- list() for (i in 1:length(mu.list)) { x <- mu.list[[i]] xname <- str_replace(names(mu.list[i]),".mu","") if (is.factor(OSR.dat[,xname])) { ## for categoricals pldf.x <- data.frame(var = OSR.dat[,xname], fpartial = x[,1], low = x[,ncol(x)-1], high = x[,ncol(x)]) mu.plots[[i]] <- ggplot(data=pldf.x) + xlab(paste0(xname, ".mu")) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "darkgrey") + geom_boxplot(aes(x = var, y = high), colour = "darkgrey") + # theme(panel.grid.minor = element_blank(), panel.background = element_blank()) theme_classic() } else { ## for continuous pldf.x <- data.frame(var = OSR.dat[,xname], fpartial = x[,1], low = x[,ncol(x)-1], high = x[,ncol(x)]) mu.plots[[i]] <- ggplot(data=pldf.x) + xlab(paste0(xname, ".mu")) + geom_ribbon(aes(x = var, ymin=low, ymax = high), fill = "grey") + geom_line(aes(x = var, y = fpartial))# + #geom_point(aes(x = var, y = fpartial)) #geom_line(aes(x = var, y = low), colour = "grey") + #geom_line(aes(x = var, y = high), colour = "grey") + } } png(filename=paste0("OSR_mu",str_replace_all(today(),"\\D", ""), "_", theSeed,".png"), width = 900, height = 900) multiplot(plotlist = mu.plots, cols = ifelse(length(mu.list)<7, 2,3)) dev.off() ### create list of phi.plots #### phi.plots <- list() for (i in 1:length(phi.list)) { if (i == 6) {next} else { # exclude plotting phi.list[[5]] (speBurHib) as it did not produce any perdictions x <- phi.list[[i]] xname <- str_replace(names(phi.list[i]),".phi","") if (is.factor(OSR.dat[,xname])) { ## for categoricals pldf.x <- data.frame(var = OSR.dat[,xname], fpartial = x[,1], low = x[,ncol(x)-1], high = x[,ncol(x)]) phi.plots[[i]] <- ggplot(data=pldf.x) + xlab(paste0(xname, ".phi")) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") } else { ## for continuous pldf.x <- data.frame(var = OSR.dat[,xname], fpartial = x[,1], low = x[,ncol(x)-1], high = x[,ncol(x)]) phi.plots[[i]] <- ggplot(data=pldf.x) + xlab(paste0(xname, ".phi")) + geom_ribbon(aes(x = var, ymin=low, ymax = high), fill = "grey") + geom_line(aes(x = var, y = fpartial))# + #geom_point(aes(x = var, y = fpartial)) #geom_line(aes(x = var, y = low), colour = "grey") + #geom_line(aes(x = var, y = high), colour = "grey") + } } } png(filename=paste0("OSR_phi",str_replace_all(today(),"\\D", ""), "_", theSeed,".png"), width = 900, height = 900) multiplot(plotlist = phi.plots, cols = ifelse(length(mu.list)<7, 2,3)) dev.off() ### Code to produce the plots as in PlosONE publication #### ### mu graphs ### names(mu.list) # mainBrand - mu.list[9] xplots <- list() varNamList <- c("Main brand", "Time to fix (sec)", "Forest density", "Burrowing/Hibernating", "Species height (mm)","Forest type", "Forest cover (%)") forDenLabs <- c("No forest","","","Medium","","","Dense") forTypLabs <- c("NF","TE","TD","TM", "SE", "SD", "SM") qualCovLabs <- c("0-25", "25-50","50-75","75-100") speBurHibLabs <- c("No","Yes") terRugLabs <- c("Rugged", "","", "Flat" ) mainBrand5Labs <- c(LETTERS[1:8]) for (i in c(10,7,3,6,9,1,2)) { x <- mu.list[[i]] xname <- str_replace(names(mu.list[i]),".mu","") seqIndex <- as.numeric(match(i,c(10,7,3,6,9,1,2))) if (is.factor(OSR.dat[,xname])) { pldf.x <- data.frame(var = OSR.dat[,xname], fpartial = x[,1], low = x[,ncol(x)-.5], high = x[,ncol(x)]) if(i == 3) { xplots[[seqIndex]] <- ggplot(data=pldf.x) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") + ylim(-.6,.6) + labs(x=varNamList[seqIndex]) + scale_x_discrete(labels = forDenLabs) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { if(i == 1) { xplots[[seqIndex]] <-ggplot(data=pldf.x) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") + ylim(-.6,.6) + labs(x=varNamList[seqIndex]) + scale_x_discrete(labels = forTypLabs) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { if(i == 6) { xplots[[seqIndex]] <-ggplot(data=pldf.x) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") + ylim(-.6,.6) + labs(x=varNamList[seqIndex], y="Partial effect") + scale_x_discrete(labels = speBurHibLabs) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_text(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { if(i == 2) { xplots[[seqIndex]] <-ggplot(data=pldf.x) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") + ylim(-.6,.6) + labs(x=varNamList[seqIndex], y="Partial effect") + scale_x_discrete(labels = qualCovLabs) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_text(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { xplots[[seqIndex]] <- ggplot(data=pldf.x) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") + ylim(-.6,.6) + labs(x=varNamList[seqIndex], y="Partial effect") + scale_x_discrete(labels = mainBrand5Labs) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_text(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) }}}} } else { ## for continuous pldf.x <- data.frame(var = OSR.dat[,xname], fpartial = x[,1], low = x[,ncol(x)-.5], high = x[,ncol(x)]) if (i == 9) { xplots[[seqIndex]] <- ggplot(data=pldf.x) + labs(x=varNamList[seqIndex]) + geom_ribbon(aes(x = exp(var), ymin=low, ymax = high), fill = "grey") + geom_line(aes(x = exp(var), y = fpartial)) + ylim(-.6,.6) + # coord_trans(xtrans = "exp") + # scale_x_exp() + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { if(i == 7) { xplots[[seqIndex]] <- ggplot(data=pldf.x) + labs(x=varNamList[seqIndex]) + geom_ribbon(aes(x = var, ymin=low, ymax = high), fill = "grey") + geom_line(aes(x = var, y = fpartial)) + ylim(-.6,.6) + # coord_trans(xtrans = "exp") + # scale_x_exp() + theme(axis.text.x = element_text(colour = "black", hjust = .75), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { xplots[[seqIndex]] <- ggplot(data=pldf.x) + labs(x=varNamList[seqIndex], y="Partial effect") + geom_ribbon(aes(x = var, ymin=low, ymax = high), fill = "grey") + geom_line(aes(x = var, y = fpartial)) + ylim(-.6,.6) + #geom_text(aes(x=min(var), y=max(high)), label=plotLabs[seqIndex]) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_text(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } } } } tiff(filename=paste0("OSRmuplots_", str_replace_all(today(),"\\D", ""), "_s", theSeed,".tiff"), width = 2250, height = 2250, res = 300, compression = "lzw") multiplot(plotlist = xplots, cols = ifelse(length(xplots)<7, 2,3)) dev.off() #### Graphs for publication (phi) ##### ### phi graphs ### names(phi.list) # mainBrand - phi.list[9] yplots <- list() varNamList <- c("Main brand","Forest type", "Forest cover (%)", "Forest density", "Terrain Ruggedness Index", "Time to fix (sec)", "Year of Purchase") forDenLabs <- c("No forest","","","Medium","","","Dense") forTypLabs <- c("NF","TE","TD","TM", "SE", "SD", "SM") speBurHibLabs <- c("No","Yes") terRugLabs <- c("Rugged", "","", "Flat" ) mainBrand5Labs <- c(LETTERS[1:8]) for (i in c(10,1,11,3,12,7,8)) { y <- phi.list[[i]] yname <- str_replace(names(phi.list[i]),".phi","") seqIndex <- as.numeric(match(i,c(10,1,11,3,12,7,8))) if (is.factor(OSR.dat[,yname])) { pldf.y <- data.frame(var = OSR.dat[,yname], fpartial = y[,1], low = y[,ncol(y)-.5], high = y[,ncol(y)]) if(i == 3) { yplots[[seqIndex]] <- ggplot(data=pldf.y) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") + ylim(-1,.9) + labs(x=varNamList[seqIndex], y="Partial effect") + scale_x_discrete(labels = forDenLabs) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_text(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { if(i == 1) { yplots[[seqIndex]] <-ggplot(data=pldf.y) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") + ylim(-1,.9) + labs(x=varNamList[seqIndex]) + scale_x_discrete(labels = forTypLabs) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { if(i == 6) { yplots[[seqIndex]] <-ggplot(data=pldf.y) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") + ylim(-1,.9) + labs(x=varNamList[seqIndex]) + scale_x_discrete(labels = speBurHibLabs) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { if(i == 4) { yplots[[seqIndex]] <-ggplot(data=pldf.y) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") + ylim(-1,.9) + labs(x=varNamList[seqIndex]) + scale_x_discrete(labels = terRugLabs) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { yplots[[seqIndex]] <- ggplot(data=pldf.y) + geom_boxplot(aes(x = var, y = fpartial)) + geom_boxplot(aes(x = var, y = low), colour = "grey") + geom_boxplot(aes(x = var, y = high), colour = "grey") + ylim(-1,.9) + labs(x=varNamList[seqIndex], y="Partial effect") + scale_x_discrete(labels = mainBrand5Labs) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_text(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) }}}} } else { ## for continuous pldf.y <- data.frame(var = OSR.dat[,yname], fpartial = y[,1], low = y[,ncol(y)-.5], high = y[,ncol(y)]) if (i == 7) { yplots[[seqIndex]] <- ggplot(data=pldf.y) + labs(x=varNamList[seqIndex]) + geom_ribbon(aes(x = var, ymin=low, ymax = high), fill = "grey") + geom_line(aes(x = var, y = fpartial)) + ylim(-1,.9) + theme(axis.text.x = element_text(colour = "black", hjust = .75), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { if(i == 12) { yplots[[seqIndex]] <- ggplot(data=pldf.y) + labs(x=varNamList[seqIndex]) + geom_ribbon(aes(x = var, ymin=low, ymax = high), fill = "grey") + geom_line(aes(x = var, y = fpartial)) + ylim(-1,.9) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { if(i == 11) { yplots[[seqIndex]] <- ggplot(data=pldf.y) + labs(x=varNamList[seqIndex]) + geom_ribbon(aes(x = var*100, ymin=low, ymax = high), fill = "grey") + geom_line(aes(x = var*100, y = fpartial)) + ylim(-1,.9) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_blank(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) } else { yplots[[seqIndex]] <- ggplot(data=pldf.y) + labs(x=varNamList[seqIndex], y="Partial effect") + geom_ribbon(aes(x = var, ymin=low, ymax = high), fill = "grey") + geom_line(aes(x = var, y = fpartial)) + ylim(-1,.9) + #geom_text(aes(y=min(var), y=max(high)), label=plotLabs[seqIndex]) + theme(axis.text.x = element_text(colour = "black"), axis.title.x=element_text(face="bold", vjust = -.5), axis.text.y = element_text(colour = "black"), axis.title.y=element_text(), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "grey")) }} } } } tiff(filename=paste0("OSRphiplots_", str_replace_all(today(),"\\D", ""), "_s", theSeed,".tiff"), width = 2250, height = 2250, res = 300, compression = "lzw") multiplot(plotlist = yplots, cols = ifelse(length(yplots)<7, 2,3)) dev.off()