Change X-Axis Label in ggtsdisplay() or tsdisplay()Function to Follow Its Series

Question

I have a montly time series data produced below which I want to check its residual performance but the x-axis label on the first plot which is the error plot is awkward.

## simulate ARIMA(1,0, 0)
set.seed(1)
ar1 <- arima.sim(n = 12, model = list(ar = 0.8, order = c(1, 0, 0)), sd = 1)
ts <- ts(ar1, start = c(2022, 1), end = c(2022, 12), frequency = 12)
fit_ts<- forecast(auto.arima(ts))
forecast::ggtsdisplay(residuals(fit_ts), plot.type = c("partial", "histogram", "scatter", "spectrum"), theme = theme_bw())

I want the x-axis of the first plot to be rebel 2022 Jan, 2022 Mar, 2022 May, 2022 Jul, 2022 Sep, 2022 Nov and not 2020`

Edit

I tried ggtsdisplay(residuals(fit_bs), plot.type = c("partial", "histogram", "scatter", "spectrum"), theme = theme_bw(), scale_x_discrete(limit = c("2022 Jan", "2022 Feb", "2022 Mar", "2022 Apr", "2022 May", "2022 Jun", "2022 Jul", "2022 Aug", "2022 Sep", "2022 Oct", "2022 Nov", 2022 Dec"))) but it is not working

Answer 1

the forecast::ggtsdisplay function under the hood is building 3 diferent plots and combining them for the output in one plot object. This unfortunately implies/means it is rather complex to alter the final object to get what you need, as it has already been build by multiple function calls.

To work arround this we can see how the function is build calling just the function name and see if we can customize it to your needs:

forecast::ggtsdisplay

This gets the entire body of the function (luckily nothing OO) and can thus be copied and modified for a custom function definition (modified parts are commented).. the customizing could be done by just calling zoo::scale_x_yearmon on the build ggplot2::autoplot though it does not behave quite as needed therefore I opted to build the timeline plot from scratch incluiding the setup df:

my_ggtsdisplay <- function (x, plot.type = c("partial", "histogram", "scatter", "spectrum"), points = TRUE, smooth = FALSE,  lag.max, na.action = na.contiguous, theme = NULL, ...) 
{
    if (!requireNamespace("ggplot2", quietly = TRUE)) {
        stop("ggplot2 is needed for this function to work. Install it via install.packages(\"ggplot2\")", call. = FALSE)
    }
    else if (!requireNamespace("grid", quietly = TRUE)) {
        stop("grid is needed for this function to work. Install it via install.packages(\"grid\")", call. = FALSE)
    }
    else {
        if (NCOL(x) > 1) {
            stop("ggtsdisplay is only for univariate time series")
        }
        plot.type <- match.arg(plot.type)
        main <- deparse(substitute(x))
        if (!is.ts(x)) {
            x <- ts(x)
        }
        if (missing(lag.max)) {
            lag.max <- round(min(max(10 * log10(length(x)), 3 * frequency(x)), length(x)/3))
        }
        dots <- list(...)
        if (is.null(dots$xlab)) {
            dots$xlab <- ""
        }
        if (is.null(dots$ylab)) {
            dots$ylab <- ""
        }
        labs <- match(c("xlab", "ylab", "main"), names(dots), nomatch = 0)
        gridlayout <- matrix(c(1, 2, 1, 3), nrow = 2)
        grid::grid.newpage()
        grid::pushViewport(grid::viewport(layout = grid::grid.layout(nrow(gridlayout), ncol(gridlayout))))
        matchidx <- as.data.frame(which(gridlayout == 1, arr.ind = TRUE))
        # removed from original function as this is the part beeing subsituted
        # tsplot <<- do.call(ggplot2::autoplot, c(object = quote(x), dots[labs]))
        # convert ts object to data frame to be able to build plot from scratch
        mydf <- data.frame(date = zoo::as.Date.ts(ts),
                           vale = unclass(ts))
        # build the ggplot2 plot incluidng geom_line call (should be equivalent to ggplot2::autoplot from what I understand
        tsplot  <- ggplot2::ggplot(mydf, aes(x = date, y = vale)) + 
            ggplot2::geom_line()

        if (points) {
            tsplot <- tsplot  +
                ggplot2::geom_point(size = .5) + 
                # included the scales call with date abreviation you can use "%Y %b" to show year before month abreviation
                ggplot2::scale_x_date(date_labels = "%b %Y", date_breaks = "1 month")
        }
        if (smooth) {
            tsplot <- tsplot + ggplot2::geom_smooth(method = "loess", se = FALSE)
        }
        if (is.null(tsplot$labels$title)) {
            tsplot <- tsplot + ggplot2::ggtitle(main)
        }
        if (!is.null(theme)) {
            tsplot <- tsplot + theme
        }
        print(tsplot, vp = grid::viewport(layout.pos.row = matchidx$row, layout.pos.col = matchidx$col))
        acfplot <- do.call(ggAcf, c(x = quote(x), lag.max = lag.max, na.action = na.action, dots[-labs])) + ggplot2::ggtitle(NULL)
        if (!is.null(theme)) {
            acfplot <- acfplot + theme
        }
        if (plot.type == "partial") {
            lastplot <- ggPacf(x, lag.max = lag.max, na.action = na.action) + 
                ggplot2::ggtitle(NULL)
            acfplotrange <- ggplot2::layer_scales(acfplot)$y$range$range
            pacfplotrange <- ggplot2::layer_scales(lastplot)$y$range$range
            yrange <- range(c(acfplotrange, pacfplotrange))
            acfplot <- acfplot + ggplot2::ylim(yrange)
            lastplot <- lastplot + ggplot2::ylim(yrange)
        }
        else if (plot.type == "histogram") {
            lastplot <- gghistogram(x, add.normal = TRUE, add.rug = TRUE) + 
                ggplot2::xlab(main)
        }
        else if (plot.type == "scatter") {
            scatterData <- data.frame(y = x[2:NROW(x)], x = x[1:NROW(x) - 1])
            lastplot <- ggplot2::ggplot(ggplot2::aes_(y = ~y,  x = ~x), data = scatterData) + 
                ggplot2::geom_point() + 
                ggplot2::labs(x = expression(Y[t - 1]), y = expression(Y[t]))
        }
        else if (plot.type == "spectrum") {
            specData <- spec.ar(x, plot = FALSE)
            specData <- data.frame(spectrum = specData$spec, frequency = specData$freq)
            lastplot <- ggplot2::ggplot(ggplot2::aes_(y = ~spectrum, x = ~frequency), data = specData) + 
                ggplot2::geom_line() + 
                ggplot2::scale_y_log10()
        }
        if (!is.null(theme)) {
            lastplot <- lastplot + theme
        }
        matchidx <- as.data.frame(which(gridlayout == 2, arr.ind = TRUE))
        print(acfplot, vp = grid::viewport(layout.pos.row = matchidx$row, layout.pos.col = matchidx$col))
        matchidx <- as.data.frame(which(gridlayout == 3, arr.ind = TRUE))
        print(lastplot, vp = grid::viewport(layout.pos.row = matchidx$row, layout.pos.col = matchidx$col))
    }
}

# lets call the customized function just as you would to with the uncustomized
my_ggtsdisplay (residuals(fit_ts), plot.type = c("partial", "histogram", "scatter", "spectrum"), theme = theme_bw())

EDIT:

one simple way to make the plot layout adjustable is to take the date_labels and date_breaks arguments from the ggplot2::scale_x_date call as function inputs to your custom function:

# include two adicional parameters "dl" and "db"
my_ggtsdisplay <- function (x, plot.type = c("partial", "histogram", "scatter", "spectrum"), points = TRUE, smooth = FALSE,  lag.max, na.action = na.contiguous, theme = NULL, dl = "%Y %b", db = "1 month", ...) 
{
    if (!requireNamespace("ggplot2", quietly = TRUE)) {
        stop("ggplot2 is needed for this function to work. Install it via install.packages(\"ggplot2\")", call. = FALSE)
    }
    else if (!requireNamespace("grid", quietly = TRUE)) {
        stop("grid is needed for this function to work. Install it via install.packages(\"grid\")", call. = FALSE)
    }
    else {
        if (NCOL(x) > 1) {
            stop("ggtsdisplay is only for univariate time series")
        }
        plot.type <- match.arg(plot.type)
        main <- deparse(substitute(x))
        if (!is.ts(x)) {
            x <- ts(x)
        }
        if (missing(lag.max)) {
            lag.max <- round(min(max(10 * log10(length(x)), 3 * frequency(x)), length(x)/3))
        }
        dots <- list(...)
        if (is.null(dots$xlab)) {
            dots$xlab <- ""
        }
        if (is.null(dots$ylab)) {
            dots$ylab <- ""
        }
        labs <- match(c("xlab", "ylab", "main"), names(dots), nomatch = 0)
        gridlayout <- matrix(c(1, 2, 1, 3), nrow = 2)
        grid::grid.newpage()
        grid::pushViewport(grid::viewport(layout = grid::grid.layout(nrow(gridlayout), ncol(gridlayout))))
        matchidx <- as.data.frame(which(gridlayout == 1, arr.ind = TRUE))
        # removed from original function as this is the part beeing subsituted
        # tsplot <<- do.call(ggplot2::autoplot, c(object = quote(x), dots[labs]))
        # convert ts object to data frame to be able to build plot from scratch
        mydf <- data.frame(date = zoo::as.Date.ts(ts),
                           vale = unclass(ts))
        # build the ggplot2 plot incluidng geom_line call (should be equivalent to ggplot2::autoplot from what I understand
        tsplot  <- ggplot2::ggplot(mydf, aes(x = date, y = vale)) + 
            ggplot2::geom_line()

        if (points) {
            tsplot <- tsplot  +
                ggplot2::geom_point(size = .5) + 
                # included the scales fed with function inputs dl and db
                ggplot2::scale_x_date(date_labels = dl, date_breaks = db) +
                # set plot title, in this case empty string
                ggplot2::ggtitle("")
        }
        if (smooth) {
            tsplot <- tsplot + ggplot2::geom_smooth(method = "loess", se = FALSE)
        }
        if (is.null(tsplot$labels$title)) {
            tsplot <- tsplot + ggplot2::ggtitle(main)
        }
        if (!is.null(theme)) {
            tsplot <- tsplot + theme
        }
        print(tsplot, vp = grid::viewport(layout.pos.row = matchidx$row, layout.pos.col = matchidx$col))
        acfplot <- do.call(ggAcf, c(x = quote(x), lag.max = lag.max, na.action = na.action, dots[-labs])) + ggplot2::ggtitle(NULL)
        if (!is.null(theme)) {
            acfplot <- acfplot + theme
        }
        if (plot.type == "partial") {
            lastplot <- ggPacf(x, lag.max = lag.max, na.action = na.action) + 
                ggplot2::ggtitle(NULL)
            acfplotrange <- ggplot2::layer_scales(acfplot)$y$range$range
            pacfplotrange <- ggplot2::layer_scales(lastplot)$y$range$range
            yrange <- range(c(acfplotrange, pacfplotrange))
            acfplot <- acfplot + ggplot2::ylim(yrange)
            lastplot <- lastplot + ggplot2::ylim(yrange)
        }
        else if (plot.type == "histogram") {
            lastplot <- gghistogram(x, add.normal = TRUE, add.rug = TRUE) + 
                ggplot2::xlab(main)
        }
        else if (plot.type == "scatter") {
            scatterData <- data.frame(y = x[2:NROW(x)], x = x[1:NROW(x) - 1])
            lastplot <- ggplot2::ggplot(ggplot2::aes_(y = ~y,  x = ~x), data = scatterData) + 
                ggplot2::geom_point() + 
                ggplot2::labs(x = expression(Y[t - 1]), y = expression(Y[t]))
        }
        else if (plot.type == "spectrum") {
            specData <- spec.ar(x, plot = FALSE)
            specData <- data.frame(spectrum = specData$spec, frequency = specData$freq)
            lastplot <- ggplot2::ggplot(ggplot2::aes_(y = ~spectrum, x = ~frequency), data = specData) + 
                ggplot2::geom_line() + 
                ggplot2::scale_y_log10()
        }
        if (!is.null(theme)) {
            lastplot <- lastplot + theme
        }
        matchidx <- as.data.frame(which(gridlayout == 2, arr.ind = TRUE))
        print(acfplot, vp = grid::viewport(layout.pos.row = matchidx$row, layout.pos.col = matchidx$col))
        matchidx <- as.data.frame(which(gridlayout == 3, arr.ind = TRUE))
        print(lastplot, vp = grid::viewport(layout.pos.row = matchidx$row, layout.pos.col = matchidx$col))
    }
}

# lets call the customized function just as you would to with the uncustomized 
# now we can inform dl and db just as we would date_labels and _breaks
my_ggtsdisplay (residuals(fit_ts), plot.type = c("partial", "histogram", "scatter", "spectrum"), theme = theme_bw(), dl = "%b", db = "3 months")

to see which/how inputs can be used for date_labels (dl) and date_breaks (db), have a look at the ggplot2::scale_x_date() documentation