You can do this by defining your own class of legends. This is of course more verbose than a simple option in the theme and it can be handy to know some gtable/grid, but it gets the job done.
library(ggplot2)
library(grid)
#create the dataframe
df <- data.frame(year = as.integer(c(1, 1, 1, 1, 1, 2, 2, 2, 2, 2)),
class = c('A', 'B', 'C', 'D', 'E'),
value = c(50, 50))
labs <- c('This is an
extremely
long label
name', 'short label1',
'Another
long
label
name', 'short label3', 'short label4')
guide_squarekey <- function(...) {
# Constructor just prepends a different class
x <- guide_legend(...)
class(x) <- c("squarekey", class(x))
x
}
guide_gengrob.squarekey <- function(guide, theme) {
# Make default legend
legend <- NextMethod()
# Find the key grobs
is_key <- startsWith(legend$layout$name, "key-")
is_key <- is_key & !endsWith(legend$layout$name, "-bg")
# Extract the width of the key column
key_col <- unique(legend$layout$l[is_key])
keywidth <- convertUnit(legend$widths[2], "mm", valueOnly = TRUE)
# Set the height of every key to the key width
legend$grobs[is_key] <- lapply(legend$grobs[is_key], function(key) {
key$height <- unit(keywidth - 0.5, "mm") # I think 0.5mm is default offset
key
})
legend
}
ggplot(df, aes(x = year, y = value, fill = class)) +
geom_col(position = 'stack') +
scale_fill_discrete(labels = labs,
guide = "squarekey")
Created on 2021-01-20 by the reprex package (v0.3.0)
EDIT: If you want to edit the key background too:
guide_gengrob.squarekey <- function(guide, theme) {
legend <- NextMethod()
is_key <- startsWith(legend$layout$name, "key-")
is_key_bg <- is_key & endsWith(legend$layout$name, "-bg")
is_key <- is_key & !endsWith(legend$layout$name, "-bg")
key_col <- unique(legend$layout$l[is_key])
keywidth <- convertUnit(legend$widths[2], "mm", valueOnly = TRUE)
legend$grobs[is_key] <- lapply(legend$grobs[is_key], function(key) {
key$height <- unit(keywidth - 0.5, "mm")
key
})
legend$grobs[is_key_bg] <- lapply(legend$grobs[is_key_bg], function(bg) {
bg$height <- unit(keywidth, "mm")
bg
})
legend
}