Search code examples
rggplot2r-gridgrob

Estimate percentage of plot taken up by legend in ggplot2


I have some ggplot functionality, but I want to give users a warning in case they abuse it heavily. The problem is this: if there are many groups and the group names are long, the legend becomes so big it takes up the entire plot:

example of problem

But if I were to change the plot names I would get:

okayish

What I have is:

  • ggplot / ggbuild object
  • dimensions of plot window (480 x 320 default) but can be changed.

I want to use these to estimate the total area taken up by the legend (so I can send out a warning if the ratio legend size / plot size is too big). Here is some example code I used to create the figures:

library(ggplot2)

# stolen from https://ryouready.wordpress.com/2008/12/18/generate-random-string-name/
MHmakeRandomString <- function(n=1, lenght=12) {
    randomString <- c(1:n)                  
    for (i in 1:n)
    {
        randomString[i] <- paste(sample(c(0:9, letters, LETTERS),
                                        lenght, replace=TRUE),
                                 collapse="")
    }
    return(randomString)
}

makeData <- function(k, useLongNames = FALSE) {

    x <- c(1, 100)
    X <- cbind(1, x)
    b <- matrix(rnorm(2*k), k, 2)

    y <- numeric(2*k)
    for (i in seq_len(k))
        y[1:2 + 2*(i-1)] <- X %*% b[i, ]

    df <- data.frame(x = c(1, n), y = y)

    if (useLongNames) {
        df$g <- factor(rep(MHmakeRandomString(k), each = 2))
    } else {
        df$g <- factor(rep(1:k, each = 2))
    }

    return(df)

}

# okayish plot
df <- makeData(50)
g0 <- ggplot(data = df, aes(x = x, y = y, group = g, color = g)) +
    geom_line() + 
    guides(color=guide_legend(nrow=5)) 

# unreadable plot    
df <- makeData(50, useLongNames = TRUE)
g1 <- ggplot(data = df, aes(x = x, y = y, group = g, color = g)) +
    geom_line() + 
    guides(color=guide_legend(nrow=5))

# to plot
# x11(width = 480, height = 320)
# print(g0)
# x11(width = 480, height = 320)
# print(g1)

I have the idea that the answer is somewhere in ggplotGrob(). However, I'm unfamiliar with grobs (and could not find clear documentation) and stranded at

gGrob0 <- ggplotGrob(g0)
gGrob1 <- ggplotGrob(g1)
gGrob0$grobs[[15]]$grobs[[1]]$grobs # all legend elements

convertWidth(grobWidth(gGrob0$grobs[[15]]), unitTo = "inches") # 4.5128 inches
convertWidth(grobWidth(gGrob1$grobs[[15]]), unitTo = "inches") # 12.419 inches
# but this is not correct:
# number of legend columns x legend width <= plot width
# 10 * 12.419 <= 480

which seems to give me a lot of information about the stuff I'm interested in. How do I convert this information into the total width the legend will take up? Many thanks in advance.


Solution

  • Here my solution (inspired by m-dz's comment). The objects g0 and g1 come from the code in the question.

    plotAndPrintRatio <- function(g, width, height) {
    
        gGrob <- ggplotGrob(g)
        tmpfile <- tempfile(pattern = "png")
        png(tmpfile, width = width, height = height) # it is necessary to open a device
        plot(g)
        legendSize <- as.numeric(convertWidth(grobWidth(gGrob$grobs[[15]]), unitTo = "inches"))
        plotSize <-   as.numeric(convertWidth(grobWidth(gGrob$grobs[[7]]), unitTo = "inches"))
        print(legendSize / plotSize) # the ratio of legend size to plot size
        dev.off()
    
        return(tmpfile)
    }
    
    # problem only in the first plot
    f1 <- plotAndPrintRatio(g0, width = 480, height = 320) # 0.6769345
    f2 <- plotAndPrintRatio(g1, width = 480, height = 320) # 1.887872 --> too big!
    
    # larger window size fixes the problem
    f3 <- plotAndPrintRatio(g0, width = 1200, height = 900) # 0.2707738
    f4 <- plotAndPrintRatio(g1, width = 1200, height = 900) # 0.7551488
    filesList <- list(f1, f2, f3, f4)
    
    # to show the saved pngs:
    dev.off() # might be needed to clean up the plotting window
    grid::grid.raster(png::readPNG(f1))
    grid::grid.raster(png::readPNG(f2))
    grid::grid.raster(png::readPNG(f3))
    grid::grid.raster(png::readPNG(f4))
    
    # to remove the tempfiles created:
    # lapply(filesList, file.remove)