Multiple X-Label Changes on one AV Plots

Question

I am creating an AvPlot to look at the model I just created, I included the code below, but need to change the x labels for each subset of the overall AvPlot.

Photo of the current AvPLot with the xlabels I need to change:

modlog3<-lm(log10(PExcretionRate_ug.P.gbiomass.h) ~ log10(DryMass_g) + Temperature_C + BodyP_percent + as.factor(Invert_Vert))
avPlots(modlog3, grid= FALSE, ylab= "Log10 Phosphorus Excretion Rate")

I don't know how to code an xlabel without it applying to each of the plots in this, I need a different x label for each plot. How can I code this?

Answer 1

Here's a cheap modification to car::avPlots (as of car-3.0.2) that allows vectorized xlab=. It could easily be extended to allow vectorization of other arguments to car::avPlot. (The changes are minimal, all near the end, and are marked as such in comments to the right.)

avPlots2 <- function(model, terms=~., intercept=FALSE, layout=NULL, ask, 
                     main, xlab, ...){
    terms <- if(is.character(terms)) paste("~",terms) else terms
    vform <- update(formula(model),terms)
    if(any(is.na(match(all.vars(vform), all.vars(formula(model))))))
        stop("Only predictors in the formula can be plotted.")
    terms.model <- attr(attr(model.frame(model), "terms"), "term.labels")
    terms.vform <- attr(terms(vform), "term.labels")
    terms.used <- match(terms.vform, terms.model)
    mm <- model.matrix(model) 
    model.names <- attributes(mm)$dimnames[[2]]
    model.assign <- attributes(mm)$assign
    good <- model.names[!is.na(match(model.assign, terms.used))]
    if (intercept) good <- c("(Intercept)", good)
    nt <- length(good)
    if (nt == 0) stop("No plots specified")
    if (missing(main)) main <- if (nt == 1) paste("Added-Variable Plot:", good) else "Added-Variable Plots"
    if (nt == 0) stop("No plots specified")
    if (nt > 1 & (is.null(layout) || is.numeric(layout))) {
        if(is.null(layout)){
            layout <- switch(min(nt, 9), c(1, 1), c(1, 2), c(2, 2), c(2, 2), 
                             c(3, 2), c(3, 2), c(3, 3), c(3, 3), c(3, 3))
        }
        ask <- if(missing(ask) || is.null(ask)) prod(layout)<nt else ask
        op <- par(mfrow=layout, ask=ask, no.readonly=TRUE, 
                  oma=c(0, 0, 1.5, 0), mar=c(5, 4, 1, 2) + .1)
        on.exit(par(op))
    }
    if (missing(xlab)) xlab <- paste(good, "| others")
    if (length(xlab) == 1L) xlab <- rep(xlab, length(good))
    if (length(xlab) > length(good))
      warning("'xlab' not length 1 or the number of model names, truncating")
    res <- as.list(NULL)
    for (i in seq_along(good)) {
      term <- good[[i]]
      res[[term]] <- avPlot(model, term, main="", xlab=xlab[[i]], ...)
    }
    mtext(side=3,outer=TRUE,main, cex=1.2)
    invisible(res)
}

library(car)
avPlots2(lm(prestige ~ income + education + type, data=Duncan)) # no different, left
avPlots2(lm(prestige ~ income + education + type, data=Duncan), xlab=c('a','b','c','d'))

---

For the curious, here is the diff from the current version :

@@ -17,8 +17,8 @@
 # 2017-11-30: substitute carPalette() for palette(). J. Fox


-avPlots <- function(model, terms=~., intercept=FALSE, layout=NULL, ask,
-                    main, ...){
+avPlots2 <- function(model, terms=~., intercept=FALSE, layout=NULL, ask,
+                     main, xlab, ...){
     terms <- if(is.character(terms)) paste("~",terms) else terms
     vform <- update(formula(model),terms)
     if(any(is.na(match(all.vars(vform), all.vars(formula(model))))))
@@ -45,8 +45,15 @@
                   oma=c(0, 0, 1.5, 0), mar=c(5, 4, 1, 2) + .1)
         on.exit(par(op))
     }
+    if (missing(xlab)) xlab <- paste(good, "| others")
+    if (length(xlab) == 1L) xlab <- rep(xlab, length(good))
+    if (length(xlab) > length(good))
+      warning("'xlab' not length 1 or the number of model names, truncating")
     res <- as.list(NULL)
-    for (term in good) res[[term]] <- avPlot(model, term, main="", ...)
+    for (i in seq_along(good)) {
+      term <- good[[i]]
+      res[[term]] <- avPlot(model, term, main="", xlab=xlab[[i]], ...)
+    }
     mtext(side=3,outer=TRUE,main, cex=1.2)
     invisible(res)
 }