Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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.

like image 871
Vandenman Avatar asked Aug 21 '17 09:08

Vandenman


1 Answers

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)
like image 144
Vandenman Avatar answered Oct 23 '22 22:10

Vandenman