Несколько изменений X-Label на одном графике AV - PullRequest
0 голосов
/ 17 октября 2019

Я создаю AvPlot для просмотра только что созданной модели, я включил приведенный ниже код, но мне нужно изменить метки x для каждого подмножества всего AvPlot.

Фотография текущего AvPLot с xlabels мне нужно изменить:

img

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 для каждого графика. Как я могу написать это?

1 Ответ

1 голос
/ 17 октября 2019

Вот дешевая модификация 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'))

sample plots: left unchanged, right multiple labels


Для любопытных, вот разница с текущей версии :

@@ -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)
 }
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...