Six Variable Line Graph Without a Legend - r

I'm looking to replicate the design of the first plot seen in this post:
http://stats.blogoverflow.com/2011/12/andyw-says-small-multiples-are-the-most-underused-data-visualization/
This was taken from [1], but in that book there is no code shown for the figure.
This figure in the link has no legend, and instead shows the labels 'IN', 'MO', ect. in a staggered fashion positioned at the height of the respective line they represent. I know how to make plots using ggplot2, but the specific issue I'm having is writing code to make the labels on the right side of the figure like that. Could someone demonstrate how to do this?
1: Carr, Daniel & Linda Pickle. 2009. Visualizing Data Patterns with Micromaps. Boca Rotan, FL. CRC Press.

This is no easy task, especially to do programmatically. It involves working with grobs, nothing hard, but usually done manually on finished products, rather than generated procedurally.
Data
df <- read.table(text = 'Samples Day.1 Day.2 Day.3 Day.4
Seradigma335 1.2875 1.350 1.850 1.6125
Seradigma322 0.9375 2.400 1.487 1.8125
Sigma 1.1250 1.962 1.237 2.0500
Shapiro_red 0.7750 1.575 1.362 1.0125
Shapiro_w/red 0.7750 1.837 0.975 0.8250', header = T)
(taken from another question here on SO)
Code
library(tidyr)
library(ggplot2)
tidy_df <- df %>%
gather('Day','Value', -Samples)
Simple plot
g <- ggplot(tidy_df) +
geom_line(aes(Day, Value, group = Samples), show.legend = F) +
scale_x_discrete(expand = c(.02,0)) +
scale_y_continuous(limits = c(0,3)) +
theme_grey() +
theme(plot.margin = unit(c(0,.2,0,0), 'npc'),
panel.border = element_rect(color = 'black', fill = NA),
axis.ticks = element_blank()
)
Note the right margin (set with plot.margin = unit(c(0,.2,0,0), 'npc'))
Labels
library(cowplot)
g <- g +
draw_label(label = df$Samples[1], x = 4.1, y = df$Day.4[1], hjust = 0) +
draw_label(label = df$Samples[2], x = 4.1, y = df$Day.4[2], hjust = 0) +
draw_label(label = df$Samples[3], x = 4.1, y = df$Day.4[3], hjust = 0) +
draw_label(label = df$Samples[4], x = 4.1, y = df$Day.4[4], hjust = 0) +
draw_label(label = df$Samples[5], x = 4.1, y = df$Day.4[5], hjust = 0)
We added the labels directly to the plot (as opposed to a grob, see documentation), with an x of 4.1, so it's actually just outside the panel (Day.4 has an x of 4) and covered by the margin (it's called clipping).
Remove clipping
# transform to grob
gt <- ggplotGrob(g)
# set panel's clipping to off
gt$layout$clip[gt$layout$name == "panel"] <- "off"
# draw the grob
ggdraw(gt)
Notes
We can kind of speed up the label creation with a for loop:
for (i in 1:nrow(df)) {
g <- g + draw_label(label = df$Samples[i], x = 4.1, y = df$Day.4[i], hjust = 0)
}
But we can't really map to vars as we are used to with aesthetics.
As I said at the beginning these methods require quite a bit of work to find the right balance and positioning, that can't certainly be expected for a quick plot, but if something has to be published it may be worth.

You can use geom_label with the nudge_x argument like this:
library(data.table) # I always use data.table but not required
library(ggplot2)
a <- c(1:10)
b <- c(seq(1,20,2))
c <- c(seq(1,30,3))
d <- c(1:10)
aa <- data.table(a,b,c,d)
ggplot(aa)+
geom_line(aes(a,b))+
geom_line(aes(a,c))+
geom_line(aes(a,d))+
geom_label(aes(10,10), label = "line 1", nudge_x = 1)+
geom_label(aes(10,19), label = "line 2", nudge_x = 1)+
geom_label(aes(10,29), label = "line 3", nudge_x = 1)
You can directly input the ordered pair that corresponds to the desired location of your label. The plot looks like this:

Related

How to align multiple legends and avoid overlapping in ggplot?

The bounty expires in 7 days. Answers to this question are eligible for a +50 reputation bounty.
Electrino wants to draw more attention to this question.
I am trying to create a plot that combines 2 separate legends and a grid of multiple plots. The issue I'm having is I'm finding it difficult to align the legends so they are visible and not overlapping. hopefully the example below will explain what I mean.
To begin I am going to create 2 plots. In these two plots I am only interested in the legends, and I am discarding the actual plot (so please ignore the actual plots in these two plots). To get just the legend I am using the cowplot package.
library(ggplot2)
library(cowplot)
# -------------------------------------------------------------------------
# plot 1 ------------------------------------------------------------------
# create fake data
dfLegend_1 <- data.frame(x = LETTERS[1:10], y = c(1:10))
# set colours
pointColours <- c(A = "#F5736A", B = "#D58D00", C = "#A0A300",
D = "#36B300", E = "#00BC7B", F = "#00BCC2",
G = "#00ADF4", H = "#928DFF", I = "#E568F0",
J = "#808080")
# plot
ggLegend_1 <- ggplot(dfLegend_1, aes(x=x, y=y))+
geom_point(aes(fill = pointColours), shape = 22, size = 10) +
scale_fill_manual(values = unname(pointColours),
label = names(pointColours),
name = 'Variable') +
theme(legend.key.size = unit(0.5, "cm")) +
theme_void()
# get legend
legend_1 <- get_legend(ggLegend_1)
# -------------------------------------------------------------------------
# plot 2 ------------------------------------------------------------------
# Create fake data
dflegend_2 <- data.frame(
x = runif(100),
y = runif(100),
z2 = abs(rnorm(100))
)
# plot
ggLegend_2 <- ggplot(dflegend_2, aes(x=x, y = y))+
geom_point(aes(color = z2), shape = 22, size = 10) +
scale_color_gradientn(
colours = rev(colorRampPalette(c('steelblue', '#f7fcfd', 'orange'))(5)),
limits = c(0,10),
name = 'Gradient',
guide = guide_colorbar(
frame.colour = "black",
ticks.colour = "black"
))
# get legend
legend_2 <- get_legend(ggLegend_2)
Then I am creating many plots (in this example, I am creating 20 individual plots) and plotting them on a grid:
# create data
dfGrid <- data.frame(x = rnorm(10), y = rnorm(10))
# make a list of plots
plotList <- list()
for(i in 1:20){
plotList[[i]] <- ggplot(dfGrid) +
geom_ribbon(aes(x = x, ymin = min(y), ymax = 0), fill = "red", alpha = .5) +
geom_ribbon(aes(x = x, ymin = min(0), ymax = max(y)), fill = "blue", alpha = .5) +
theme_void()
}
# plot them on a grid
gridFinal <- cowplot::plot_grid(plotlist = plotList)
Finally, I am joining the two legends together and adding them to the grid of many plots:
# add legends together into on single plot
legendFinal <- plot_grid(legend_2, legend_1, ncol = 1)
# plot everything on the same plot
plot_grid(gridFinal, legendFinal, rel_widths = c(3, 1))
This results in something that looks like this:
As you can see, the legends overlap and are not very well spaced. I was wondering if there is any way to fit everything in whilst having the legends appropriately spaced and readable?
I should also note, that, in general, there can be any number of variables and any number of gridded plots.
One option to fix your issue would be to switch to patchwork to glue your plots and the legends together. Especially I make use of the design argument to assign more space to the Variable legend. However, you should be aware that legends are much less flexible compared to plots, i.e. the size of legends is in absolute units and will not adjust to the available space. Hence, I'm not sure whether my solution will fit your desire for a "one-size-fits-all" approach.
library(patchwork)
design <-
"
ABCDEU
FGHIJV
KLMNOV
PQRSTV
"
plotList2 <- c(plotList, list(legend_2, legend_1))
wrap_plots(plotList2) +
plot_layout(design = design)

multiple columns of information ggplot y axis

I want to write multiple pieces of information in each y-axis label of a ggplot bar chart (or any similar kind of plot). The problem is having everything aligned nicely.
It's probably best explained with an example for what I want to have:
My primary issue is the formatting on the left side of the figure.
What I've tried so far includes using monospace fonts to write the labels. This basically works but I want to try and avoid the use of monospace fonts for aesthetic purposes.
I've also tried making several ggplots where the idea was to remove everything in two initial plots, except for the y-axis labels (so these "plots" would only be the y-axis labels). Then align the plots next to each other using grid.align. The problem I have here is that there doesn't seem to be a way to remove the plot part of a ggplot (or is there?). It also requires some tweaking since removing x-axis labels in one of the "empty" plots would result in the labels moving down (since no space is occupied by the x-axis labels/title anymore).
I've also tried an approach using geom_text and setting the appropriate distances using the hjust parameter. However, for some reason, the spacing does not seem to be equal for the different size labels (for example distances for the "Red" and "Turquoise" labels are different for the same hjust). As the real data has many more variations in label sizes this variation makes the table look very messy...
I'm not too concerned about the headers since they are easy to add to the figure manually. The values on the right are also not too much of a problem since they have a fixed width and I can use geom_text to set them. So my main problem is with the y-axis (left) labels.
Here's an example data set:
dt = data.frame(shirt = c('Red','Turquoise','Red','Turquoise','Red','Turquoise','Red','Turquoise'),
group = c('Group alpha','Group alpha','Group beta','Group beta','Group delta','Group delta','Group gamma','Group gamma'),
n = c(22,21,15,18,33,34,20,19),
mean = c(1, 4, 9, 2, 4, 5 , 1, 2),
p = c(0.1, 0.09, 0.2, 0.03, 0.05, 0.99, 0.81, 0.75))
The closest I could come to is to use guide_axis_nested() from ggh4x for formatting the left part. (Disclaimer: I'm the author of ggh4x). With this axis, you can't align spanning categories (e.g group) to the top, nor have titles for the different levels.
library(ggplot2)
library(ggh4x)
# Create some dummy data
df <- expand.grid(
group = paste("Group", c("alpha", "beta", "delta", "gamma")),
shirt = c("Red", "Turquoise")
)
df$N <- sample(1:100, nrow(df))
df$mean <- rlnorm(nrow(df), meanlog = 1)
df$pvalue <- runif(nrow(df))
ggplot(df, aes(x = mean, y = interaction(N, shirt, group, sep = "&"))) +
geom_col() +
guides(
y = guide_axis_nested(delim = "&"),
y.sec = guide_axis_manual(
breaks = interaction(df$N, df$shirt, df$group, sep = "&"),
labels = scales::number(df$pvalue, 0.001)
)
) +
theme(
axis.text.y.left = element_text(margin = margin(r = 5, l = 5)),
ggh4x.axis.nesttext.y = element_text(margin = margin(r = 5, l = 5)),
ggh4x.axis.nestline = element_blank()
)
Created on 2021-11-16 by the reprex package (v1.0.0)
I think #teunbrand provided a very neat solution and code-wise a lot cleaner than mine. However, I also tried another approach using annotation_custom() (based on this answer in another question). The result is quite nice and it should be fairly easy to customize.
dt = data.frame(shirt = c('Red','Turquoise','Red','Turquoise','Red','Turquoise','Red','Turquoise'),
group = c('Group alpha','Group alpha','Group beta','Group beta','Group delta','Group delta','Group gamma','Group gamma'),
n = c(22,21,15,18,33,34,20,19),
lvls = c(1,2,3,4,5,6,7,8),
mean = c(1, 4, 9, 2, 4, 5 , 1, 2),
p = c(0.1, 0.09, 0.2, 0.03, 0.05, 0.99, 0.81, 0.75))
dt$groups = paste(dt$group, dt$shirt)
dt$groups = factor(dt$groups, levels=rev(dt$groups))
p2 = ggplot(dt) +
geom_col(aes(x=groups, y=mean)) +
coord_flip(clip='off') +
theme_bw() +
theme(axis.text.y = element_blank(),
axis.title.y = element_blank(),
plot.margin = unit(c(0.5,1,0,3.5), "in") # top, right, bottom, left
)
# Compute the position on the X axis for each information column
# I wanted fixed widths for the margins, so I basically compute what the X value
# would be on a specific location of the figure.
x_size = ggplot_build(p2)$layout$panel_params[[1]]$x.range[2] - ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] # length of x-axis
p_width = par()$din[1] - 4.5 # width of plot minus the margins as defined above in: plot.margin = unit(c(0.5,1,0,3.5), "in")
rel_x_size = p_width / x_size # size of one unit X in inch
col1_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] - (3 / rel_x_size) # the Group column, 3 inch left of the start of the plot
col2_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] - (1.5 / rel_x_size) # the Shirt column, 1.5 inches left of the start of the plot
col3_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[1] - (0.25 / rel_x_size) # the N column, 0.25 inches left of the start of the plot
col4_x = ggplot_build(p2)$layout$panel_params[[1]]$x.range[2] + (0.2 / rel_x_size) # the P-val column, 0.2 inches right of the end of the plot
# Set the values for each "row"
i_range = 1:nrow(dt)
i_range_rev = rev(i_range) # Because we reversed the order of the groups
for (i in i_range) {
if(i %% 2 == 0) {
# Group
p2 = p2 + annotation_custom(grob = textGrob(label = dt$group[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col1_x, ymax=col1_x,
xmin=i,xmax=i)
}
# Shirt
p2 = p2 + annotation_custom(grob = textGrob(label = dt$shirt[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col2_x, ymax=col2_x,
xmin=i,xmax=i)
# N
p2 = p2 + annotation_custom(grob = textGrob(label = dt$n[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col3_x, ymax=col3_x,
xmin=i,xmax=i)
# P-val
p2 = p2 + annotation_custom(grob = textGrob(label = dt$p[i_range_rev[i]], hjust = 0, gp = gpar()),
ymin=col4_x, ymax=col4_x,
xmin=i,xmax=i)
}
# Add the headers
i = i+1
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('Group')), hjust = 0, gp = gpar()),
ymin=col1_x, ymax=col1_x,
xmin=i,xmax=i)
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('Shirt')), hjust = 0, gp = gpar()),
ymin=col2_x, ymax=col2_x,
xmin=i,xmax=i)
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('N')), hjust = 0, gp = gpar()),
ymin=col3_x, ymax=col3_x,
xmin=i,xmax=i)
p2 = p2 + annotation_custom(grob = textGrob(label = expression(bold('P-val')), hjust = 0, gp = gpar()),
ymin=col4_x, ymax=col4_x,
xmin=i,xmax=i)
p2
Output:
What is basically done, is that margins for the figure are set in plot.margin in the initial plot. Some computation is then performed to determine the correct location for each column of information. Subsequently we loop through the data set and set the values in each column using annotation_custom(). Finally, we can add the headers in a similar manner.
Note: if you resize the plot window (in RStudio for example), you need to re-run the code otherwise the layout will be messed up.

Fix legend title when using superscript in more than two lines - R ggplot2

I am plotting a map of my study area and I am having problems to edit the legend title.
I need it to be "Projected fruit productivity in fallows in 40 yrs (fruits ha^-1) written in four lines. I could use bquote() to plot the -1 as a superscript. But it created an extra space that I cannot figure it out how to take it off. The extra space only appears when the title is divided into multiple lines.
Also, expression(atop()) creates the superscript but once I tried to divide it into more than two lines it does not show lines three and four.
This is the Map with the extra space using bquote()
This is the Map with the four line title using expression(atop())
I did try different solutions found on the internet, including this post. But they all plot the fourth line with the extra space or only plot the first or second line.
Bellow is the code I am using. Any help is welcomed.
The comments are different tries.
Data = spatial_dist_fallows.csv
library(sf) #sf = simple feature
library(ggplot2)
library(dplyr)
PAECM_fallows <-read.csv("spatial_dist_fallows.csv")
PAECM_fallows_sp <- st_as_sf(PAECM_fallows,coords = c("X", "Y"),crs = "+proj=longlat +datum=WGS84 +no_defs")
custom_bins_fruit = c(0,60,120,180,240,1400)
PAECM_fallows_fruit <- PAECM_fallows_sp %>%
mutate(prod_cat_fallow = cut(prod_40, breaks= custom_bins_fruit),
age_cat_fallow = cut(age, breaks = c(11,17,22,29,60)))
prod_map_PAECM_fruit<-ggplot()+
geom_sf(data = PAECM_fallows_fruit,aes(size = prod_cat_fallow), shape = 18, show.legend = "point")+
scale_size_manual(values= c(2,3,4,5,6),
# name = "Projected fruit\nproductivity in\nfallows in 40 yrs \n(fruits ha^-1)",
name = bquote("Projected fruit\nproductivity in\nfallows in 40 yrs \n( fruits"*ha^-1*")"),
# name = expression(paste("Projected fruit productivity\nin fallows in 40 yrs\n"),bquote(paste("("*fruits~ha^-1*")"))),#(Fruits/ha)
name = expression(atop("Projected fruit",
"productivity in",
"fallows in 40 yrs",
"( fruits ha"^-1,")")),
breaks= c(NA,"(0,60]","(60,120]","(120,180]","(180,240]","(240,1.4e+03]"),
labels= c("NA","\u2264 60","60 - 120","120 - 180","180 - 240","> 240"),
guide = guide_legend(override.aes = list(linetype = "blank", shape = 18, fill = NA)))+
# labs(size = expression(atop("Projected fruit\nproductivity in\nfallows in 40 yrs\n(fruits"*ha^-1*")", sep="")))+ #comment name line at the scale_size_manual
# labs(size = bquote("Projected fruit productivity \nin fallows in 40 yrs \n( fruits"*ha^-1*")"))+ #comment name line at the scale_size_manual
ggplot2::theme_minimal()+
ggplot2::theme(legend.text.align=0.5,
legend.title.align = 0.5,
plot.background = element_blank(),
panel.grid = element_line(colour = "white"),
panel.background = element_rect(fill = "grey87", color = "white"))+#,
coord_sf(xlim = c(-68.45,-68.2), ylim = c(-11.05,-10.8))
prod_map_PAECM_fruit
Extra question. Once I started to use the bquote I could not align the title text using theme(legend.title.align = 0.5), any other ideas?
After some other tries, I did come up with the following solution for the legend title.
name = expression(atop("",
atop(textstyle("Projected fruit"),
atop(textstyle("productivity in"),
atop(textstyle("fallows in 40 yrs"),
atop(textstyle("(fruits ha"^-1*")"))))))),
I used textstyle() to plot all text with the same size, otherwise it would be plotted smaller every time atop() was called. Atop() creates a space between the first and second line, that is why the first line of the code is atop("", so the first line will be a blank.
This is the final code with the map below.
library(sf) #sf = simple feature
library(ggplot2)
library(dplyr)
PAECM_fallows <-read.csv("spatial_dist_fallows.csv")
PAECM_fallows_sp <- st_as_sf(PAECM_fallows,coords = c("X", "Y"),crs = "+proj=longlat +datum=WGS84 +no_defs")
custom_bins_fruit = c(0,60,120,180,240,1400)
PAECM_fallows_fruit <- PAECM_fallows_sp %>%
mutate(prod_cat_fallow = cut(prod_40, breaks= custom_bins_fruit),
age_cat_fallow = cut(age, breaks = c(11,17,22,29,60)))
prod_map_PAECM_fruit_legend_test<-ggplot()+
geom_sf(data = PAECM_fallows_fruit,aes(size = prod_cat_fallow), shape = 18, show.legend = "point")+
scale_size_manual(values= c(2,3,4,5,6),
name = expression(atop("",
atop(textstyle("Projected fruit"),
atop(textstyle("productivity in"),
atop(textstyle("fallows in 40 yrs"),
atop(textstyle("(fruits ha"^-1*")"))))))),
breaks= c(NA,"(0,60]","(60,120]","(120,180]","(180,240]","(240,1.4e+03]"),
labels= c("NA","\u2264 60","60 - 120","120 - 180","180 - 240","> 240"),
guide = guide_legend(override.aes = list(linetype = "blank", shape = 18, fill = NA)))+
ggplot2::theme_minimal()+
ggplot2::theme(legend.text.align=0.5,
legend.title.align = 0.5,
plot.background = element_blank(),
panel.grid = element_line(colour = "white"),
panel.background = element_rect(fill = "grey87", color = "white"))+#,
coord_sf(xlim = c(-68.45,-68.2), ylim = c(-11.05,-10.8))
prod_map_PAECM_fruit_legend_test
Alternatively, you could use the annotation functions cowplot::draw_label() or ggplot2::annotation_custom(). I think that the explanations about these approaches given in ggplot2 two-line label with expression are helpful here as well.
1) Solution with cowplot::draw_label()
library(ggplot2)
library(cowplot)
#> Warning: package 'cowplot' was built under R version 3.5.2
#>
#> Attaching package: 'cowplot'
#> The following object is masked from 'package:ggplot2':
#>
#> ggsave
# If needed, revert to default theme (cowplot modifies the theme);
theme_set(theme_grey())
# Build a simple plot as example
p <- ggplot(mtcars, aes(x = wt, y = mpg, size = factor(gear))) +
geom_point() +
labs(size = element_blank()) + # remove default legend title
# Make enough space for the custom legend title by tweaking the right margin
theme(legend.margin = margin(t = 0, r = 26, b = 0, l = 0, unit = "mm"))
# Adjust further theme elements if needed, like text size, font, etc
# The lines of text and expression that constitute your custom legend title
lines <- list(
"Projected fruit",
"productivity in",
"fallows in 40 yrs",
expression("(fruits ha" ^-1 ~ ")")
)
# Using relative coordinates ranging from 0 to 1 (relative to the entire canvas).
# There is some guesswork with the coordinates until we get them right.
min_y <- 0.6
step <- 0.04 # dictates the line spacing; need to play with it until you get it right
ys <- seq(from = min_y + step * 4, to = min_y, by = -step)
x <- 0.87
# Add the annotations that will actually constitute the legend title.
gg <- ggdraw(p)
#> Warning: Using size for a discrete variable is not advised.
# Neglect the warning in this example.
for (i in 1:4){
gg <- gg + draw_label(lines[[i]], x = x, y = ys[i])
}
gg
Note that, cowplot::draw_label() can also be used in combination with setting the clipping off, coord_cartesian(clip = "off"), which allows plotting anywhere on the canvas (see next example with ggplot2::annotation_custom()). In such a case, we do not use the relative coordinates anymore, but the ones from the plot/data (the absolute coordinates).
2) Solution with ggplot2::annotation_custom()
Note that, cowplot::draw_label() uses ggplot2::annotation_custom() under the hood, so it is more or less the same annotation technique, but bit more verbose. We need to set clipping off. This time we do not use the relative coordinates anymore, but the ones from the plot/data (the absolute coordinates).
Building upon the p plot example from above:
min_y <- 24
step <- 1 # dictates the line spacing; need to play with it until you get it right
ys <- seq(from = min_y + step * 4, to = min_y, by = -step)
x <- 6.2
# set clipping off - allows plotting anywhere on the canvas
pp <- p + coord_cartesian(clip = "off")
for (i in 1:4){
pp <- pp + annotation_custom(grid::textGrob(lines[[i]]),
xmin = x, xmax = x, ymin = ys[i], ymax = ys[i])
}
pp
#> Warning: Using size for a discrete variable is not advised.
Created on 2019-01-15 by the reprex package (v0.2.1)

Center-align legend title and legend keys in ggplot2 for long legend titles

I am having a hard time making the title of a legend center-aligned relative to the legend keys when the legend title is long. There is a question from a year ago that works for short titles, but it doesn't seem to work for long ones.
Example, first with a short legend title:
library(ggplot2)
ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width, color=Petal.Width)) + geom_point(size = 3) +
scale_color_distiller(palette = "YlGn", type = "seq", direction = -1,
name = "A") +
theme(legend.title.align = 0.5)
Everything is as expected, the legend title is centered above the legend key.
Now the same with a long legend title:
ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width, color=Petal.Width)) + geom_point(size = 3) +
scale_color_distiller(palette = "YlGn", type = "seq", direction = -1,
name = "Long legend heading\nShould be centered") +
theme(legend.title.align = 0.5)
We can see that the text is center aligned to itself but not relative to the legend key. I have tried modifying other theme options, such as legend.justification = "center", but none seem to move the key from its left-most position in the legend box.
A couple of comments:
I'm running the development version of ggplot2, v2.2.1.9000 from a few days ago.
I specifically need a solution for a continuous colorscale palette.
I hacked the source code similar to the way described by baptiste in one of the above comments: put the colour bar / label / ticks grobs into a child gtable, & position it to have the same row span / column span (depending on the legend's direction) as the title.
It's still a hack, but I'd like to think of it as a 'hack once for the whole session' approach, without having to repeat the steps manually for every plot.
Demonstration with different title widths / title positions / legend directions:
plot.demo <- function(title.width = 20,
title.position = "top",
legend.direction = "vertical"){
ggplot(iris,
aes(x=Sepal.Length, y=Sepal.Width, color=Petal.Width)) +
geom_point(size = 3) +
scale_color_distiller(palette = "YlGn",
name = stringr::str_wrap("Long legend heading should be centered",
width = title.width),
guide = guide_colourbar(title.position = title.position),
direction = -1) +
theme(legend.title.align = 0.5,
legend.direction = legend.direction)
}
cowplot::plot_grid(plot.demo(),
plot.demo(title.position = "left"),
plot.demo(title.position = "bottom"),
plot.demo(title.width = 10, title.position = "right"),
plot.demo(title.width = 50, legend.direction = "horizontal"),
plot.demo(title.width = 10, legend.direction = "horizontal"),
ncol = 2)
This works with multiple colourbar legends as well:
ggplot(iris,
aes(x=Sepal.Length, y=Sepal.Width,
color=Petal.Width, fill = Petal.Width)) +
geom_point(size = 3, shape = 21) +
scale_color_distiller(palette = "YlGn",
name = stringr::str_wrap("Long legend heading should be centered",
width = 20),
guide = guide_colourbar(title.position = "top"),
direction = -1) +
scale_fill_distiller(palette = "RdYlBu",
name = stringr::str_wrap("A different heading of different length",
width = 40),
direction = 1) +
theme(legend.title.align = 0.5,
legend.direction = "vertical",
legend.box.just = "center")
(Side note: legend.box.just = "center" is required to align the two legends properly. I was worried for a while since only "top", "bottom", "left", and "right" are currently listed as acceptable parameter values, but it turns out both "center" / "centre" are accepted as well, by the underlying grid::valid.just. I'm not sure why this isn't mentioned explicitly in the ?theme help file; nonetheless, it does work.)
To change the source code, run:
trace(ggplot2:::guide_gengrob.colorbar, edit = TRUE)
And change the last section of code from this:
gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights,
"cm"))
... # omitted
gt
}
To this:
# create legend gtable & add background / legend title grobs as before (this part is unchanged)
gt <- gtable(widths = unit(widths, "cm"), heights = unit(heights, "cm"))
gt <- gtable_add_grob(gt, grob.background, name = "background",
clip = "off", t = 1, r = -1, b = -1, l = 1)
gt <- gtable_add_grob(gt, justify_grobs(grob.title, hjust = title.hjust,
vjust = title.vjust, int_angle = title.theme$angle,
debug = title.theme$debug), name = "title", clip = "off",
t = 1 + min(vps$title.row), r = 1 + max(vps$title.col),
b = 1 + max(vps$title.row), l = 1 + min(vps$title.col))
# create child gtable, using the same widths / heights as the original legend gtable
gt2 <- gtable(widths = unit(widths[1 + seq.int(min(range(vps$bar.col, vps$label.col)),
max(range(vps$bar.col, vps$label.col)))], "cm"),
heights = unit(heights[1 + seq.int(min(range(vps$bar.row, vps$label.row)),
max(range(vps$bar.row, vps$label.row)))], "cm"))
# shift cell positions to start from 1
vps2 <- vps[c("bar.row", "bar.col", "label.row", "label.col")]
vps2[c("bar.row", "label.row")] <- lapply(vps2[c("bar.row", "label.row")],
function(x) x - min(unlist(vps2[c("bar.row", "label.row")])) + 1)
vps2[c("bar.col", "label.col")] <- lapply(vps2[c("bar.col", "label.col")],
function(x) x - min(unlist(vps2[c("bar.col", "label.col")])) + 1)
# add bar / ticks / labels grobs to child gtable
gt2 <- gtable_add_grob(gt2, grob.bar, name = "bar", clip = "off",
t = min(vps2$bar.row), r = max(vps2$bar.col),
b = max(vps2$bar.row), l = min(vps2$bar.col))
gt2 <- gtable_add_grob(gt2, grob.ticks, name = "ticks", clip = "off",
t = min(vps2$bar.row), r = max(vps2$bar.col),
b = max(vps2$bar.row), l = min(vps2$bar.col))
gt2 <- gtable_add_grob(gt2, grob.label, name = "label", clip = "off",
t = min(vps2$label.row), r = max(vps2$label.col),
b = max(vps2$label.row), l = min(vps2$label.col))
# add child gtable back to original legend gtable, taking tlrb reference from the
# rowspan / colspan of the title grob if title grob spans multiple rows / columns.
gt <- gtable_add_grob(gt, justify_grobs(gt2, hjust = title.hjust,
vjust = title.vjust),
name = "bar.ticks.label", clip = "off",
t = 1 + ifelse(length(vps$title.row) == 1,
min(vps$bar.row, vps$label.row),
min(vps$title.row)),
b = 1 + ifelse(length(vps$title.row) == 1,
max(vps$bar.row, vps$label.row),
max(vps$title.row)),
r = 1 + ifelse(length(vps$title.col) == 1,
min(vps$bar.col, vps$label.col),
max(vps$title.col)),
l = 1 + ifelse(length(vps$title.col) == 1,
max(vps$bar.col, vps$label.col),
min(vps$title.col)))
gt
}
To reverse the change, run:
untrace(ggplot2:::guide_gengrob.colorbar)
Package version used: ggplot2 3.2.1.
Update Oct. 4, 2019:
A while back I wrote a fairly general function based on the original idea I posted here almost two years ago. The function is on github here but it's not part of any officially published package. It is defined as follows:
align_legend <- function(p, hjust = 0.5)
{
# extract legend
g <- cowplot::plot_to_gtable(p)
grobs <- g$grobs
legend_index <- which(sapply(grobs, function(x) x$name) == "guide-box")
legend <- grobs[[legend_index]]
# extract guides table
guides_index <- which(sapply(legend$grobs, function(x) x$name) == "layout")
# there can be multiple guides within one legend box
for (gi in guides_index) {
guides <- legend$grobs[[gi]]
# add extra column for spacing
# guides$width[5] is the extra spacing from the end of the legend text
# to the end of the legend title. If we instead distribute it by `hjust:(1-hjust)` on
# both sides, we get an aligned legend
spacing <- guides$width[5]
guides <- gtable::gtable_add_cols(guides, hjust*spacing, 1)
guides$widths[6] <- (1-hjust)*spacing
title_index <- guides$layout$name == "title"
guides$layout$l[title_index] <- 2
# reconstruct guides and write back
legend$grobs[[gi]] <- guides
}
# reconstruct legend and write back
g$grobs[[legend_index]] <- legend
g
}
The function is quite flexible and general. Here are a few examples of how it can be used:
library(ggplot2)
library(cowplot)
#>
#> ********************************************************
#> Note: As of version 1.0.0, cowplot does not change the
#> default ggplot2 theme anymore. To recover the previous
#> behavior, execute:
#> theme_set(theme_cowplot())
#> ********************************************************
library(colorspace)
# single legend
p <- ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Petal.Width)) + geom_point()
ggdraw(align_legend(p)) # centered
ggdraw(align_legend(p, hjust = 1)) # right aligned
# multiple legends
p2 <- ggplot(mtcars, aes(disp, mpg, fill = hp, shape = factor(cyl), size = wt)) +
geom_point(color = "white") +
scale_shape_manual(values = c(23, 24, 21), name = "cylinders") +
scale_fill_continuous_sequential(palette = "Emrld", name = "power (hp)", breaks = c(100, 200, 300)) +
xlab("displacement (cu. in.)") +
ylab("fuel efficiency (mpg)") +
guides(
shape = guide_legend(override.aes = list(size = 4, fill = "#329D84")),
size = guide_legend(
override.aes = list(shape = 21, fill = "#329D84"),
title = "weight (1000 lbs)")
) +
theme_half_open() + background_grid()
# works but maybe not the expected result
ggdraw(align_legend(p2))
# more sensible layout
ggdraw(align_legend(p2 + theme(legend.position = "top", legend.direction = "vertical")))
Created on 2019-10-04 by the reprex package (v0.3.0)
Original answer:
I found a solution. It requires some digging into the grob tree, and it may not work if there are multiple legends, but otherwise this seems a reasonable solution until something better comes along.
library(ggplot2)
library(gtable)
library(grid)
p <- ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width, color=Petal.Width)) +
geom_point(size = 3) +
scale_color_distiller(palette = "YlGn", type = "seq", direction = -1,
name = "Long legend heading\nShould be centered") +
theme(legend.title.align = 0.5)
# extract legend
g <- ggplotGrob(p)
grobs <- g$grobs
legend_index <- which(sapply(grobs, function(x) x$name) == "guide-box")
legend <- grobs[[legend_index]]
# extract guides table
guides_index <- which(sapply(legend$grobs, function(x) x$name) == "layout")
guides <- legend$grobs[[guides_index]]
# add extra column for spacing
# guides$width[5] is the extra spacing from the end of the legend text
# to the end of the legend title. If we instead distribute it 50:50 on
# both sides, we get a centered legend
guides <- gtable_add_cols(guides, 0.5*guides$width[5], 1)
guides$widths[6] <- guides$widths[2]
title_index <- guides$layout$name == "title"
guides$layout$l[title_index] <- 2
# reconstruct legend and write back
legend$grobs[[guides_index]] <- guides
g$grobs[[legend_index]] <- legend
grid.newpage()
grid.draw(g)
you'd have to change the source code. Currently it computes the widths for the title grob and the bar+labels, and left-justifies the bar+labels in the viewport (gtable). This is hard-coded.

Using ggplot to plot occupied parking spaces in a parking lot

I’d like to use ggplot to draw a grid plot of the following scenario which I’ve attempted to depict in the picture below... I could use some guidance on how to logically think about the approach. Thank you for the guidance.
--
Each aisle in the example picture below has an odd number side—and an even number side
The spaces on the odd-side are listed ascending from 1… K where K is odd
The spaces on the even-side are listed ascending from 2…N where N is even
This pattern exists for each aisle in the parking lot
If a car is parked in a space—we track that spot in a database.
How can I reproduce a grid-level ggplot to indicate with a symbol on the plot all spaces where a car is parked?
The listing of occupied spaces would be “fed” into the ggplot logic via a .csv file: the format of the .csv would look something like this:
A01
A04
A05
A08
A09
A15
A20
A33
B07
B31
B44
C01
C04
C36
...
Image credit: Michael Layefsky, 2010, Google Images
My experience with direct use of grid is limited, so I can't say how hard this would be with grid functions, but it seems reasonably straightforward in ggplot2. Here's a simple example that is (I hope) not too far off from what you're looking for:
library(ggplot2)
# Set up grid of space identifiers
df = data.frame(y=1:10, x=rep(c(0:1, 3:4, 6:7), each=10),
space=paste0(rep(c("A","B","C"), each=20),
rep(c(seq(2,20,2),seq(1,20,2)), 3)),
stringsAsFactors=FALSE)
# Assume we have a vector of occupied spaces
set.seed(194)
occupied = sample(df$space, 30)
# Mark occupied spaces in data frame
df$status = ifelse(df$space %in% occupied, "Occupied", "Available")
ggplot(df) +
geom_segment(aes(x=x - 0.5, xend=x + 0.5, y=y, yend=y - 1)) +
geom_label(aes(label=space, x=x, y=y, fill=status), colour="blue", label.size=0) +
annotate(geom="segment", x=seq(0.5,6.5,3), xend=seq(0.5,6.5,3),
y=rep(0,3), yend=rep(10,3), lty="11") +
theme_bw(base_size=14) +
scale_fill_manual(values=c(hcl(c(105,15),100,65))) +
#scale_fill_manual(values=c(NA, hcl(15,100,65))) + # Color only occupied spaces
theme(axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank()) +
labs(x="",y="",fill="")
If you are taking a list of only the occupied spots as input in the form that you showed, and then you want to produce a visualization of occupied spots using ggplot2, this approach will work. First, I process the input, turning it into something that I can give ggplot easily.
# the provided example data
d <- read.table(text="
A01
A04
A05
A08
A09
A15
A20
A33
B07
B31
B44
C01
C04
C36", stringsAsFactors=FALSE)
Split the "spaces" into meaningful coordinates. I kept the original space names around for later labeling. What follows is all manipulation used to get the plot set up correctly.
cars <- strsplit(d[,1], "(?<=[A-Z])", perl=TRUE) # split the raw data
# turn resulting list into data.frame and give it names
cars <- setNames(do.call(rbind.data.frame, cars), c("aisle","spot.num"))
# convert the from factors to numeric,
# and turn the aisle letter into numeric data for plotting
# retain the original spot id for labeling the plot
cars <- with(cars, data.frame(
spot.num = as.numeric(as.character(spot.num)),
aisle = aisle, # keep this around for faceting
aisle.coord = 2 * (utf8ToInt(paste(as.character(aisle), collapse="")) - utf8ToInt("A")),
spot.id = d[,1]))
I multiplied the aisle by 2 after converting A to 1, B to 2, and so on, to make a new variable called aisle.coord. The reason for multiplying by 2 is to set up a variable where each aisle can be composed of two lines:
# if the spot number is even, increment aisle by 1 (put it on the right).
# This is possible because I multiplied by 2 earlier
cars$aisle.coord[cars$spot.num %% 2 == 0] <- cars$aisle.coord[cars$spot.num %% 2 == 0] + 1
# We need to adjust the spot numbers to real row numbers
# i.e. A02 is in row 1, not row 2, A10 is in row 5, etc.
cars$spot <- ceiling(cars$spot.num / 2)
Now, the plotting:
library(ggplot2)
library(grid) # for unit()
ggplot(cars, aes(x = aisle.coord %% 2, y = spot)) +
geom_tile(width = 0.5, height = 0.8) +
facet_grid(~aisle) +
geom_text( aes(x = aisle.coord %% 2, y = spot, label = spot.id), color = "white")
That is a bare-bones attempt at the graph. Lots of room for you to improve and adjust it. Here is another attempt with a little more effort. Still, plenty of room for adjustment (e.g. you could adjust the plot so that a the full lot appears, not just the part of the lot up to the maximum spot: B44):
ggplot(cars, aes(x = aisle.coord %% 2, y = spot)) +
geom_tile(width = 0.5, height = 0.8, fill = "orange") +
facet_grid(~aisle) +
geom_text( aes(x = aisle.coord %% 2, y = spot, label = spot.id), color = "white", size = 4) +
annotate("rect", ymin = 0, ymax = max(cars$spot)+0.5, xmin = 0.3, xmax = 0.7, fill = "grey40") +
theme(panel.margin.x = unit(0.05, "lines"),
plot.background = element_rect("grey40"),
panel.background = element_rect("grey40"),
panel.grid.minor = element_blank(),
axis.title = element_blank(),
axis.text = element_blank(),
strip.text = element_blank(),
strip.background = element_blank()) +
scale_y_continuous(breaks = seq(0.5, (max(cars$spot) + 0.5), 1)) +
scale_x_continuous(breaks = c(-0.3, 1.3)) +
geom_text(data=data.frame(x = 0.5, y = 10, aisle = LETTERS[1:length(unique(cars$aisle))]),
aes(x = x, y = y, label = aisle), inherit.aes = FALSE, color = "white")

Resources