一个AV绘图上有多个X-Label更改

Question

我正在创建一个AvPlot来查看我刚刚创建的模型，我包括下面的代码，但是需要更改整个AvPlot的每个子集的x标签。

带有我需要更改的xlabel的当前AvPLot的照片：

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")

如果不将xlabel应用于每个图中的绘图，我不知道如何编码，我需要为每个绘图使用不同的x标签。我该如何编码？

Answer 1

这是对car::avPlots（自car-3.0.2起）的廉价修改，允许向量化xlab=。它可以很容易地扩展以允许将其他参数向量化到car::avPlot。 （更改很小，几乎全部结束，并在右侧的注释中进行了标记。）

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'))

---

出于好奇，以下是与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)
 }