tests/testthat/test-plot-limits.R

In interflex: Estimation, Diagnostics and Visualization of Conditional Marginal Effects

# Regression tests for BOOK-003 plot limit fixes:
#   - .pad_xlim helper contract (also covered by Check 3 smoke test)
#   - User-supplied xlim is padded by ~2% via coord_cartesian
#   - Default behavior (no xlim) leaves coord_cartesian xlim NULL / unpadded
#   - User-supplied ylim is applied via coord_cartesian (NOT ylim()/scale_*),
#     so CI ribbon layer data retains rows outside the ylim window
#
# These tests must NOT depend on rendering output, on quarto, or on snapshots.
# They construct interflex objects from the bundled toy datasets, call
# plot.interflex(..., show.all = TRUE) to obtain raw ggplot objects, and
# inspect the coord and layer data directly.

skip_if_not_installed("ggplot2")

library(interflex)
library(ggplot2)

# The bundled datasets ship in data/interflex.RData rather than as one .rda
# per dataset. data() works after library(interflex); fall back to load() if
# not visible (defensive — this is a known wrinkle from BOOK-003 audit).
load_toy <- function(name) {
    e <- new.env()
    ok <- tryCatch({ data(list = name, envir = e); TRUE },
                   error = function(e) FALSE,
                   warning = function(w) FALSE)
    if (!ok || !exists(name, envir = e)) {
        rdata <- system.file("data", "interflex.RData", package = "interflex")
        if (!nzchar(rdata)) rdata <- file.path("..", "..", "data", "interflex.RData")
        if (file.exists(rdata)) load(rdata, envir = e)
    }
    if (!exists(name, envir = e)) skip(paste("toy dataset", name, "not available"))
    get(name, envir = e)
}

# Extract the inner ggplot(s) from a plot.interflex(show.all = TRUE) return
# value. For discrete treatment, p.group is a named list of ggplots keyed by
# `other.treat`; for continuous, by `label.name`. Returns a non-empty list of
# ggplot objects.
get_inner_ggplots <- function(out, ...) {
    pg <- plot.interflex(out, show.all = TRUE, ...)
    if (inherits(pg, "ggplot")) return(list(pg))
    stopifnot(is.list(pg), length(pg) >= 1L)
    for (g in pg) stopifnot(inherits(g, "ggplot"))
    pg
}

# Pull the coord_cartesian limits off a ggplot. ggplot stores the active coord
# in p$coordinates; for CoordCartesian the user limits live in $limits$x and
# $limits$y (each NULL or length-2 numeric). Returns list(x = ..., y = ...).
coord_limits <- function(p) {
    co <- p$coordinates
    stopifnot(inherits(co, "CoordCartesian"))
    list(x = co$limits$x, y = co$limits$y)
}

test_that("default plot has no user-imposed coord_cartesian xlim", {
  skip_on_cran()
    s1 <- load_toy("s1")
    out <- interflex(estimator = "linear", data = s1,
                     Y = "Y", D = "D", X = "X", na.rm = TRUE)
    inner <- get_inner_ggplots(out)
    for (g in inner) {
        lims <- coord_limits(g)
        # No user xlim was supplied, so the merged group-equalization coord
        # call sets xlim = NULL (see R/plot.R post-BOOK-003).
        expect_null(lims$x)
    }
})

test_that("user-supplied xlim is padded by ~4% via .pad_xlim", {
  skip_on_cran()
    s1 <- load_toy("s1")
    user_xlim <- c(-2, 2)
    span <- user_xlim[2] - user_xlim[1]            # 4
    expected_pad <- 0.04 * span                    # 0.16
    expected_lo <- user_xlim[1] - expected_pad     # -2.16
    expected_hi <- user_xlim[2] + expected_pad     #  2.16

    out <- interflex(estimator = "linear", data = s1,
                     Y = "Y", D = "D", X = "X", na.rm = TRUE,
                     xlim = user_xlim)
    inner <- get_inner_ggplots(out)
    expect_true(length(inner) >= 1L)
    for (g in inner) {
        lims <- coord_limits(g)
        expect_false(is.null(lims$x))
        expect_length(lims$x, 2L)
        expect_equal(lims$x[1], expected_lo, tolerance = 1e-9)
        expect_equal(lims$x[2], expected_hi, tolerance = 1e-9)
        # Sanity: padded range strictly contains the user range
        expect_lt(lims$x[1], user_xlim[1])
        expect_gt(lims$x[2], user_xlim[2])
        # And the pad is small (< 10% of span on each side)
        expect_lt(user_xlim[1] - lims$x[1], 0.1 * span)
        expect_lt(lims$x[2] - user_xlim[2], 0.1 * span)
    }
})

test_that("user-supplied ylim is set on coord_cartesian, not via ylim()", {
  skip_on_cran()
    s1 <- load_toy("s1")
    user_ylim <- c(-0.5, 0.5)
    out <- interflex(estimator = "linear", data = s1,
                     Y = "Y", D = "D", X = "X", na.rm = TRUE,
                     ylim = user_ylim)
    inner <- get_inner_ggplots(out)
    for (g in inner) {
        lims <- coord_limits(g)
        expect_false(is.null(lims$y))
        expect_equal(as.numeric(lims$y), user_ylim, tolerance = 1e-9)
        # NO scale_y_continuous(limits = ...) should be active. The y scale
        # must remain a default continuous scale with NULL user limits, so
        # the data are not filtered before being passed to geoms.
        ys <- g$scales$get_scales("y")
        if (!is.null(ys)) {
            # ggplot stores user-set scale limits in $limits; coord limits are
            # not propagated here. Either NULL or length-0 is acceptable.
            expect_true(is.null(ys$limits) || length(ys$limits) == 0L)
        }
    }
})

test_that("CI ribbon retains data outside narrow user ylim", {
  skip_on_cran()
    pick_outside_ylim <- function() {
        candidates <- list(
            list(name = "s1", est = "linear",  args = list()),
            list(name = "s2", est = "linear",  args = list()),
            list(name = "s3", est = "linear",  args = list())
        )
        for (cand in candidates) {
            d <- tryCatch(load_toy(cand$name), error = function(e) NULL)
            if (is.null(d)) next
            args <- c(list(estimator = cand$est, data = d,
                           Y = "Y", D = "D", X = "X", na.rm = TRUE,
                           ylim = c(-0.5, 0.5)),
                      cand$args)
            out <- tryCatch(do.call(interflex, args), error = function(e) NULL)
            if (is.null(out)) next
            inner <- tryCatch(get_inner_ggplots(out), error = function(e) NULL)
            if (is.null(inner)) next
            for (g in inner) {
                ribbon_idx <- which(vapply(g$layers,
                    function(l) inherits(l$geom, "GeomRibbon"),
                    logical(1)))
                if (length(ribbon_idx) == 0L) next
                b <- ggplot_build(g)
                for (i in ribbon_idx) {
                    df <- b$data[[i]]
                    if (is.null(df) || !all(c("ymin", "ymax") %in% names(df))) next
                    has_ymin <- !all(is.na(df$ymin))
                    has_ymax <- !all(is.na(df$ymax))
                    outside <- any(df$ymin < -0.5, na.rm = TRUE) ||
                               any(df$ymax >  0.5, na.rm = TRUE)
                    if (has_ymin && has_ymax && outside) {
                        return(list(g = g, df = df, dataset = cand$name))
                    }
                }
            }
        }
        NULL
    }

    hit <- pick_outside_ylim()
    if (is.null(hit)) {
        skip("no bundled dataset produced a CI ribbon extending outside [-0.5, 0.5]; ribbon-preservation invariant cannot be exercised on this build")
    }
    df <- hit$df
    expect_true(any(df$ymin < -0.5, na.rm = TRUE) ||
                any(df$ymax >  0.5, na.rm = TRUE))
    expect_false(all(is.na(df$ymin)))
    expect_false(all(is.na(df$ymax)))
    lims <- coord_limits(hit$g)
    expect_equal(as.numeric(lims$y), c(-0.5, 0.5), tolerance = 1e-9)
})