R/layout-chain-stack-composer.R

Defines functions stack_composer_add.list stack_composer_add.QuadLayout stack_composer_add.CraftBox stack_composer_add stack_composer_align_plot stack_composer_add_plot stack_composer

#' @keywords internal
stack_composer <- function(direction) {
    structure(
        list(
            t = integer(), l = integer(),
            b = integer(), r = integer(),
            plots = list(), sizes = list(),
            direction = direction,
            align = 1L,
            # attributes used by `stack_layout()`
            left_or_top = FALSE, right_or_bottom = FALSE
        ),
        class = "stack_composer"
    )
}

stack_composer_add_plot <- function(composer, plot, t, l, b = t, r = l) {
    composer$t <- c(.subset2(composer, "t"), t)
    composer$l <- c(.subset2(composer, "l"), l)
    composer$b <- c(.subset2(composer, "b"), b)
    composer$r <- c(.subset2(composer, "r"), r)
    composer$plots <- c(.subset2(composer, "plots"), list(plot))
    composer
}

#' @importFrom rlang is_empty
stack_composer_align_plot <- function(composer, plot, size) {
    if (is.null(plot)) {
        return(composer)
    }
    if (is_horizontal(.subset2(composer, "direction"))) {
        r_border <- .subset2(composer, "r")
        if (is_empty(r_border)) {
            l <- 1L
        } else {
            l <- max(r_border) + 1L
        }
        t <- .subset2(composer, "align")
    } else {
        b_border <- .subset2(composer, "b")
        if (is_empty(b_border)) {
            t <- 1L
        } else {
            t <- max(b_border) + 1L
        }
        l <- .subset2(composer, "align")
    }
    composer$sizes <- c(.subset2(composer, "sizes"), list(size))
    stack_composer_add_plot(composer, plot, t, l)
}

stack_composer_add <- function(plot, composer, ...) {
    UseMethod("stack_composer_add")
}

#' @importFrom utils packageVersion
#' @export
stack_composer_add.CraftBox <- function(plot, composer, design, ...,
                                        schemes, theme,
                                        released_spaces,
                                        direction, position) {
    size <- plot@size

    # for `released_spaces`, release the `free_spaces` in a single plot
    plot_schemes <- inherit_schemes(plot@schemes, schemes)
    if (!is.null(released_spaces)) {
        plot_spaces <- .subset2(
            .subset2(plot_schemes, "scheme_align"), "free_spaces"
        )
        if (is_string(plot_spaces)) {
            plot_spaces <- setdiff_position(plot_spaces, released_spaces)
            if (!nzchar(plot_spaces)) plot_spaces <- NULL
            plot_schemes$scheme_align["free_spaces"] <- list(plot_spaces)
        }
    }

    # let `Align` to determine how to build the plot
    craftsman <- plot@craftsman # `Craftsman` object
    plot <- plot@plot
    if (!craftsman$free_facet && is_discrete_design(design)) {
        if (nlevels(.subset2(design, "panel")) > 1L) {
            facet <- switch_direction(
                direction,
                ggplot2::facet_grid(
                    rows = ggplot2::vars(.data$.panel),
                    scales = "free_y", space = "free",
                    drop = FALSE, as.table = FALSE
                ),
                ggplot2::facet_grid(
                    cols = ggplot2::vars(.data$.panel),
                    scales = "free_x", space = "free",
                    drop = FALSE, as.table = FALSE
                )
            )
        } else {
            facet <- facet_stack(direction, craftsman$layout_name)
        }
        plot <- gguse_facet(plot, facet)
    }
    if (!craftsman$free_coord) {
        plot <- gguse_linear_coord(plot, layout_name = craftsman$layout_name)
    }

    # set limits and default scales
    if (!craftsman$free_limits) {
        if (is_horizontal(direction)) {
            plot <- plot + ggalign_design(
                y = design,
                ylabels = .subset(craftsman$labels, .subset2(design, "index"))
            )
        } else {
            plot <- plot + ggalign_design(
                x = design,
                xlabels = .subset(craftsman$labels, .subset2(design, "index"))
            )
        }
    }

    # let `Craftsman` add other components
    plot <- craftsman$build_plot(plot, design = design, ...)
    plot <- craftsman$finish_plot(plot, plot_schemes, theme)
    stack_composer_align_plot(composer, plot, size)
}

#' @importFrom grid unit.c unit
stack_composer_add.QuadLayout <- function(plot, composer, schemes, theme,
                                          direction, ...) {
    patches <- quad_build(plot, schemes, theme, direction)
    plots <- .subset2(patches, "plots")
    sizes <- .subset2(patches, "sizes")

    if (is_horizontal(.subset2(composer, "direction"))) {
        composer$left_or_top <- .subset2(composer, "left_or_top") ||
            !is.null(.subset2(plots, "top"))
        composer$right_or_bottom <- .subset2(composer, "right_or_bottom") ||
            !is.null(.subset2(plots, "bottom"))
        composer <- stack_composer_align_plot(
            composer,
            .subset2(plots, "left"),
            .subset2(sizes, "left")
        )
        composer <- stack_composer_align_plot(
            composer,
            .subset2(plots, "main"),
            .subset2(.subset2(sizes, "main"), "width")
        )
        l <- max(.subset2(composer, "r"))
        if (!is.null(top <- .subset2(plots, "top"))) {
            if (.subset2(composer, "align") == 1L) {
                composer$t <- .subset2(composer, "t") + 1L
                composer$b <- .subset2(composer, "b") + 1L
                composer$align <- .subset2(composer, "align") + 1L
            }
            if (!is_null_unit(size <- .subset2(sizes, "top"))) {
                attr(top, "vp")$height <- size
            }
            composer <- stack_composer_add_plot(composer, top, t = 1L, l = l)
        }
        if (!is.null(bottom <- .subset2(plots, "bottom"))) {
            if (!is_null_unit(size <- .subset2(sizes, "bottom"))) {
                attr(bottom, "vp")$height <- size
            }
            composer <- stack_composer_add_plot(composer, bottom,
                t = .subset2(composer, "align") + 1L, l = l
            )
        }
        composer <- stack_composer_align_plot(
            composer,
            .subset2(plots, "right"),
            .subset2(sizes, "right")
        )
    } else {
        composer$left_or_top <- .subset2(composer, "left_or_top") ||
            !is.null(.subset2(plots, "left"))
        composer$right_or_bottom <- .subset2(composer, "right_or_bottom") ||
            !is.null(.subset2(plots, "right"))
        composer <- stack_composer_align_plot(
            composer,
            .subset2(plots, "top"),
            .subset2(sizes, "top")
        )
        composer <- stack_composer_align_plot(
            composer,
            .subset2(plots, "main"),
            .subset2(.subset2(sizes, "main"), "height")
        )
        t <- max(.subset2(composer, "b"))
        if (!is.null(left <- .subset2(plots, "left"))) {
            if (.subset2(composer, "align") == 1L) {
                composer$l <- .subset2(composer, "l") + 1L
                composer$r <- .subset2(composer, "r") + 1L
                composer$align <- .subset2(composer, "align") + 1L
            }
            if (!is_null_unit(size <- .subset2(sizes, "left"))) {
                attr(left, "vp")$width <- size
            }
            composer <- stack_composer_add_plot(composer, left, t = t, l = 1L)
        }
        if (!is.null(right <- .subset2(plots, "right"))) {
            if (!is_null_unit(size <- .subset2(sizes, "right"))) {
                attr(right, "vp")$width <- size
            }
            composer <- stack_composer_add_plot(composer, right,
                t = t, l = .subset2(composer, "align") + 1L
            )
        }
        composer <- stack_composer_align_plot(
            composer,
            .subset2(plots, "bottom"),
            .subset2(sizes, "bottom")
        )
    }
    composer
}

#' @export
stack_composer_add.list <- function(plot, composer, ...) {
    for (p in plot) {
        composer <- stack_composer_add(plot = p, composer = composer, ...)
    }
    composer
}

Try the ggalign package in your browser

Any scripts or data that you put into this service are public.

ggalign documentation built on June 8, 2025, 11:25 a.m.