R | объединить графики, которые используют par (mfrow =) внутри

Возьмем для примера plot.acf. И acf, и pacf вызывают эту функцию внутренне. Как я могу расположить их рядом?

Пример:

TS <- ts.union(mdeaths, fdeaths)
acf(TS)
pacf(TS)

Я пытался использовать par(mfrow = c(2,4)) и layout, чтобы объединить их, но stats:::plot.acf перезаписывает это. Ожидаемый результат:

введите описание изображения здесь


person Rentrop    schedule 04.03.2015    source источник
comment
Ответ Батиста по следующей ссылке работает вполне здесь stackoverflow.com/questions/27929452/   -  person user20650    schedule 10.03.2015
comment
Вы также можете взглянуть на пакет gridBase.   -  person Alex A.    schedule 10.03.2015
comment
Вы можете попробовать использовать facet_grid ggplot2, который дает следующий результат: i.stack.imgur.com/MPuwA. png Вы можете разместить 4 метки вверху и расположить ACF и PACF справа от сетки.   -  person Docconcoct    schedule 10.03.2015


Ответы (3)


Другой подход, чем мой другой ответ: Постройте ACF, используя ggplot2.

ggacf <- function(x, ci=0.95, type="correlation", xlab="Lag", ylab=NULL,
                  ylim=NULL, main=NULL, ci.col="blue", lag.max=NULL) {

    x <- as.data.frame(x)

    x.acf <- acf(x, plot=F, lag.max=lag.max, type=type)

    ci.line <- qnorm((1 - ci) / 2) / sqrt(x.acf$n.used)

    d.acf <- data.frame(lag=x.acf$lag, acf=x.acf$acf)

    g <- ggplot(d.acf, aes(x=lag, y=acf)) +
        geom_hline(yintercept=0) +
        geom_segment(aes(xend=lag, yend=0)) +
        geom_hline(yintercept=ci.line, color=ci.col, linetype="dashed") +
        geom_hline(yintercept=-ci.line, color=ci.col, linetype="dashed") +
        theme_bw() +
        xlab("Lag") +
        ggtitle(ifelse(is.null(main), "", main)) +
        if (is.null(ylab))
            ylab(ifelse(type=="partial", "PACF", "ACF"))
        else
            ylab(ylab)

    g
}

Это направлено на создание интерфейса, аналогичного plot.acf(). Затем вы можете использовать все замечательные функции, доступные для ggplot2 графиков из пакета gridExtra.

library(ggplot2)
library(gridExtra)

grid.arrange(ggacf(lh), ggacf(lh, type="partial"), ncol=2)

Тогда получится вот что:

введите описание изображения здесь

К сожалению, grid.arrange() не работает с базовой графикой, отсюда и предложение ggplot2.

person Alex A.    schedule 10.03.2015

Это не идеальное решение, но вы можете переопределить, что означает построение ACF / PACF, определив plot.acf().

Сначала сохраните существующую версию.

old.plot.acf <- plot.acf

Теперь вы можете использовать stats:::plot.acf, чтобы получить исходный код и скопировать / вставить в редактор. Удалите часть, которая сбрасывает mfrow.

plot.acf <- function(x, ci = 0.95, type = "h", xlab = "Lag", ylab = NULL,
                     ylim = NULL, main = NULL, ci.col = "blue",
                     ci.type = c("white", "ma"), max.mfrow = 6,
                     ask = Npgs > 1 && dev.interactive(), 
                     mar = if (nser > 2) c(3, 2, 2, 0.8) else par("mar"),
                     oma = if (nser > 2) c(1, 1.2, 1, 1) else par("oma"),
                     mgp = if (nser > 2) c(1.5, 0.6, 0) else par("mgp"),
                     xpd = par("xpd"), cex.main = if (nser > 2) 1 else
                     par("cex.main"), verbose = getOption("verbose"), ...) 
{
    ci.type <- match.arg(ci.type)
    if ((nser <- ncol(x$lag)) < 1L) 
        stop("x$lag must have at least 1 column")
    if (is.null(ylab)) 
        ylab <- switch(x$type, correlation = "ACF", covariance = "ACF (cov)", 
                       partial = "Partial ACF")
    if (is.null(snames <- x$snames)) 
        snames <- paste("Series ", if (nser == 1L) 
            x$series
            else 1L:nser)
    with.ci <- ci > 0 && x$type != "covariance"
    with.ci.ma <- with.ci && ci.type == "ma" && x$type == "correlation"
    if (with.ci.ma && x$lag[1L, 1L, 1L] != 0L) {
        warning("can use ci.type=\"ma\" only if first lag is 0")
        with.ci.ma <- FALSE
    }
    clim0 <- if (with.ci) 
        qnorm((1 + ci)/2)/sqrt(x$n.used)
    else c(0, 0)
    Npgs <- 1L
    nr <- nser
    if (nser > 1L) {
        sn.abbr <- if (nser > 2L) 
            abbreviate(snames)
        else snames
        if (nser > max.mfrow) {
            Npgs <- ceiling(nser/max.mfrow)
            nr <- ceiling(nser/Npgs)
        }

        ### NOT INCLUDED: mfrow = rep(nr, 2L)

        opar <- par(mar = mar, oma = oma, 
                    mgp = mgp, ask = ask, xpd = xpd, cex.main = cex.main)
        on.exit(par(opar))
        if (verbose) {
            message("par(*) : ", appendLF = FALSE, domain = NA)
            str(par("mfrow", "cex", "cex.main", "cex.axis", "cex.lab", 
                    "cex.sub"))
        }
    }
    if (is.null(ylim)) {
        ylim <- range(x$acf[, 1L:nser, 1L:nser], na.rm = TRUE)
        if (with.ci) 
            ylim <- range(c(-clim0, clim0, ylim))
        if (with.ci.ma) {
            for (i in 1L:nser) {
                clim <- clim0 * sqrt(cumsum(c(1, 2 * x$acf[-1, 
                                                           i, i]^2)))
                ylim <- range(c(-clim, clim, ylim))
            }
        }
    }
    for (I in 1L:Npgs) for (J in 1L:Npgs) {
        dev.hold()
        iind <- (I - 1) * nr + 1L:nr
        jind <- (J - 1) * nr + 1L:nr
        if (verbose) 
            message("Page [", I, ",", J, "]: i =", paste(iind, 
                                                         collapse = ","), "; j =", paste(jind, collapse = ","), 
                    domain = NA)
        for (i in iind) for (j in jind) if (max(i, j) > nser) {
            frame()
            box(col = "light gray")
        }
        else {
            clim <- if (with.ci.ma && i == j) 
                clim0 * sqrt(cumsum(c(1, 2 * x$acf[-1, i, j]^2)))
            else clim0
            plot(x$lag[, i, j], x$acf[, i, j], type = type, xlab = xlab, 
                 ylab = if (j == 1) 
                     ylab
                 else "", ylim = ylim, ...)
            abline(h = 0)
            if (with.ci && ci.type == "white") 
                abline(h = c(clim, -clim), col = ci.col, lty = 2)
            else if (with.ci.ma && i == j) {
                clim <- clim[-length(clim)]
                lines(x$lag[-1, i, j], clim, col = ci.col, lty = 2)
                lines(x$lag[-1, i, j], -clim, col = ci.col, lty = 2)
            }
            title(if (!is.null(main)) 
                main
                else if (i == j) 
                    snames[i]
                else paste(sn.abbr[i], "&", sn.abbr[j]), line = if (nser > 
                                                                        2) 
                    1
                else 2)
        }
        if (Npgs > 1) {
            mtext(paste("[", I, ",", J, "]"), side = 1, line = -0.2, 
                  adj = 1, col = "dark gray", cex = 1, outer = TRUE)
        }
        dev.flush()
    }
    invisible()
}

Теперь, когда это определено локально, вы можете установить mfrow по мере необходимости, выполнить построение графика, затем сбросить функцию или удалить ее из пространства имен.

plot.acf <- old.plot.acf

Чтобы не менять и plot.pacf(), вы можете просто использовать acf(..., type="partial"), который получает PACF.

person Alex A.    schedule 09.03.2015

Вы можете использовать пакет PerformanceAnalytics:

library(PerformanceAnalytics)
chart.ACFplus(TS)
person Jose David Prieto Campo    schedule 27.09.2016
comment
Вам действительно следует добавить некоторые пояснения, почему это должно работать - вы также можете добавить код, а также комментарии в самом коде - в его текущей форме он не предоставляет никаких объяснений, которые могли бы помочь остальной части сообщества понять, что вы сделали, чтобы решить / ответить на вопрос. Это особенно важно для старых вопросов и вопросов, на которые уже есть ответы. - person ishmaelMakitla; 27.09.2016
comment
PerformanceAnalytics::chart.ACFplus() определен только для одномерных рядов. Если вы попытаетесь построить двумерный график из исходного вопроса выше, будет построен только первый столбец. - person Oleg Melnikov; 25.11.2016