SCM

SCM Repository

[latticeextra] View of /pkg/R/mergeTrellisLegends.R
ViewVC logotype

View of /pkg/R/mergeTrellisLegends.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 194 - (download) (annotate)
Fri Jan 1 11:17:13 2016 UTC (3 years, 1 month ago) by deepayan
File size: 1677 byte(s)
cleanup based on feedback from R CMD check
## not exported; for use in c.trellis and doubleYScale
mergeTrellisLegends <- function(legend, legend2, vertical = NULL)
{
    legend <- as.list(legend)
    legend2 <- as.list(legend2)
    for (space in c("top", "bottom", "left", "right")) {
        if (!is.null(legend2[[space]])) {
            if (is.null(legend[[space]])) {
                ## no conflict
                legend[[space]] <- legend2[[space]]
            } else {
                v <- vertical
                if (is.null(v))
                    v <- space %in% c("left", "right")
                legend[[space]] <-
                    list(fun = "mergedTrellisLegendGrob",
                         args = list(a = legend[[space]], b = legend2[[space]],
                         vertical = v))
            }
        }
    }
    legend <- c(legend, legend2[names(legend2) == "inside"])
    legend
}

## exported, to be called at plot time from 'legend'
mergedTrellisLegendGrob <-
    function(a, b, vertical = FALSE, border = NULL)
{
    if (is.null(a))
        return(b)
    if (is.null(b))
        return(a)
    if (!inherits(a$fun, "grob")) {
        ## fun <- a$fun
        if (is.character(a$fun)) a$fun <- as.symbol(a$fun)
        a$fun <- eval(as.call(c(a$fun, a$args)), getNamespace("lattice"))
    }
    if (!inherits(b$fun, "grob")) {
        if (is.character(b$fun)) b$fun <- as.symbol(b$fun)
        b$fun <- eval(as.call(c(b$fun, b$args)), getNamespace("lattice"))
    }
    g <- frameGrob(name = "mergedLegend")
    g <- packGrob(g, a$fun, side = if (vertical) "top" else "left", border = border)
    g <- packGrob(g, b$fun, side = if (vertical) "bottom" else "right", border = border)
    g
}


R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge