Related
I am using the ndodge function explained by #jan-glx here;
https://stackoverflow.com/a/60650595/13399047
However I could not figure out how to align the axis ticks aligned as for example;
I should probably use theme(axis.ticks.length=) but I am not sure how to do it in an even/odd way.
Please help!
As far as I am aware there is no build in way to do this in ggplot, though that might change when they rewrite the guide system.
It is neither pretty nor easy, but here is an example how you could do it by messing around in the gtable / grid.
library(ggplot2)
library(grid)
data(diamonds)
diamonds$cut <- paste("Super Dee-Duper",as.character(diamonds$cut))
g <- ggplot(diamonds, aes(cut, carat)) +
geom_boxplot() +
scale_x_discrete(guide = guide_axis(n.dodge = 2))
# Convert to gtable
gt <- ggplotGrob(g)
# Grab bottom axis
is_axis <- grep("axis-b", gt$layout$name)
axisgrob <- gt$grobs[is_axis][[1]]
axis <- axisgrob$children$axis
# Grab tickmarks
is_ticks <- which(vapply(axis$grobs, inherits, logical(1), "polyline"))
ticks <- axis$grobs[[is_ticks]]
# Modify tickmarks
labelheight <- axis$heights[[2]] # First row of labels
modify <- which(seq_along(ticks$y) %% 4 == 0) - 1 # Change every the 3rd item in every quadruplet
ticks$y[modify] <- ticks$y[modify] - labelheight
# Insert ticks back into axis back into table
axis$grobs[[is_ticks]] <- ticks
axisgrob$children$axis <- axis
gt$grobs[[is_axis]] <- axisgrob
# Plot
grid.newpage()
grid.draw(gt)
Created on 2020-05-18 by the reprex package (v0.3.0)
Here is a solution using just ggplot2 stuff and not modifying any grobs. It requires ggplot2 3.0.0 and is based off https://stackoverflow.com/a/51312611/6615512
library(ggplot2)
data(diamonds)
diamonds$cut <- paste("Super Dee-Duper",as.character(diamonds$cut))
tick_min_pos_odd = -0.6
tick_min_pos_even = -0.4
custom_ticks = data.frame(cut = sort(unique(diamonds$cut)))
n_discrete_x_values = nrow(custom_ticks)
# Alternate tick lengths
custom_ticks$tick_min_pos = ifelse(1:n_discrete_x_values %% 2 == 0, tick_min_pos_odd, tick_min_pos_even)
ggplot(diamonds, aes(cut, carat)) +
geom_boxplot() +
scale_x_discrete(guide = guide_axis(n.dodge = 2)) +
geom_linerange(data = custom_ticks, # The custom tickmarks
aes(x=cut, ymax=-0.25, ymin=tick_min_pos),
size=0.5, color='black',
inherit.aes = F) +
coord_cartesian(clip='off', ylim=c(0,NA)) + # Clip off makes it so the geoms can be drawn outside the plot
# ylim sets the y-axis from 0 to the max.
theme(plot.margin = margin(0,0,20,0), # Add some whitespace to the bottom of the plot
axis.title.x = element_text(vjust=-1.5), # nudge the x-axis title and text down a tad
axis.text.x = element_text(vjust=-1.5))
For the sake of simplicity, let's assume I have four graphs:
data("midwest", package = "ggplot2")
p1<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p2<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p3<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p4<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
grid.arrange(p1,p2,p3,p4,ncol=2)
Now, I want to create a title (TITLE 1, TITLE 2) between each two titles,, as presented below:
Any ideas how to do it?
Here is a gtable solution to your problem. There might be easier solutions out there, but this should work.
First we'll bake in some titles in the leftmost plots
library(grid) # needed later for plotting
data("midwest", package = "ggplot2")
p1<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + ggtitle("Title 1")
p2<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p3<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + ggtitle("Title 2")
p4<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
Then we can cbind and rbind the plots together as we see fit.
p12 <- cbind(ggplotGrob(p1), ggplotGrob(p2), size = "first")
p34 <- cbind(ggplotGrob(p3), ggplotGrob(p4), size = "first")
all <- rbind(p12, p34, size = "first")
grid.newpage(); grid.draw(all)
Note that we'd have to work with grid.newpage() and grid.draw() to get our plots, since we've left the ggplot sphere and are now in the realm of gtables and grid. Anyway, resulting plot looks like the following:
From your example I expect that you want these titles to be centered. This will be a bit more finicky:
# Decide what is a title
is_title <- grep("^title$", all$layout$name)
# Grab all titles
titles <- all$grobs[is_title]
# Exclude empty titles
is_title <- is_title[!sapply(titles, inherits, "zeroGrob")]
# Center title
all$grobs[is_title] <- lapply(all$grobs[is_title], function(title) {
title$children[[1]]$hjust <- 0.5
title$children[[1]]$x <- unit(0.5, "npc")
title
})
# Spread title over all panels
# You can see the number you'd need from the l/r coordinates of the 'panel' grobs
# which you can find by printing `all` or `all$layout`.
all$layout[is_title, "r"] <- 14
grid.newpage(); grid.draw(all)
EDIT: added example for adding extra titles
You can add extra titles, but you would need the gtable package for this.
library(gtable)
# First make extra titles
left <- textGrob("Left Title", gp = gpar(fontsize = 13.2, col = "black",
lineheight = 0.9, font = 1))
right <- textGrob("Right Title", gp = gpar(fontsize = 13.2, col = "black",
lineheight = 0.9, font = 1))
# Find a height that was 0, assign new height based on extra title
all$heights[[2]] <- unit(1, "grobheight", left)
# Add the titles (t = top position, l = left position)
all <- gtable_add_grob(all, left, t = 2, l = 5, clip = "off")
all <- gtable_add_grob(all, right, t = 2, l = 14, clip = "off")
grid.newpage(); grid.draw(all)
Consider the following plot:
library(ggplot2)
p <- ggplot(diamonds,
aes(x = carat, fill = cut)) +
geom_density(position = "stack") +
facet_wrap(~ color)
The facet_wrap function wraps a sequence of faceted panels into a roughly rectangular display of nrow rows and ncol columns. However, depending on the data, the actual number of panels is often a few panels short of nrow * ncol, which leaves a chunk of wasted space in the plot.
If the plot includes legend(s), the situation is exacerbated, because now we have even more wasted space due to the legend, whether it's on the right (default legend position), or one of the other three directions.
To save space, I would like to shift the legend(s) into the space created by unfilled facets.
The following works as a space-saving measure, but the legend is anchored to a corner of the plot area, with potentially a lot of space left on one side, creating an imbalanced look:
p +
theme(legend.position = c(1, 0),
legend.justification = c(1, 0))
Shifting a legend towards the centre of the blank space area by manually adjusting the legend.position/legend.justification values is a matter of trial and error, and difficult to scale if one has many faceted plots to work on.
In summary, I want a method that:
Shifts the legend(s) of a faceted plot into the space created due to empty facets.
Results in a reasonably nice-looking plot.
Is easily automated to handle many plots.
This is a recurring use case for me, and I've decided to post it along with my working solution here in case anyone else finds it useful. I haven't seen this scenario asked/answered elsewhere on Stack Overflow. If anyone has, please leave a comment and I'll be happy to answer there instead or have this marked as a duplicate, as the case may be.
The following is an extension to an answer I wrote for a previous question about utilising the space from empty facet panels, but I think it's sufficiently different to warrant its own space.
Essentially, I wrote a function that takes a ggplot/grob object converted by ggplotGrob(), converts it to grob if it isn't one, and digs into the underlying grobs to move the legend grob into the cells that correspond to the empty space.
Function:
library(gtable)
library(cowplot)
shift_legend <- function(p){
# check if p is a valid object
if(!"gtable" %in% class(p)){
if("ggplot" %in% class(p)){
gp <- ggplotGrob(p) # convert to grob
} else {
message("This is neither a ggplot object nor a grob generated from ggplotGrob. Returning original plot.")
return(p)
}
} else {
gp <- p
}
# check for unfilled facet panels
facet.panels <- grep("^panel", gp[["layout"]][["name"]])
empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]))
empty.facet.panels <- facet.panels[empty.facet.panels]
if(length(empty.facet.panels) == 0){
message("There are no unfilled facet panels to shift legend into. Returning original plot.")
return(p)
}
# establish extent of unfilled facet panels (including any axis cells in between)
empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
empty.facet.panels <- list(min(empty.facet.panels[["t"]]), min(empty.facet.panels[["l"]]),
max(empty.facet.panels[["b"]]), max(empty.facet.panels[["r"]]))
names(empty.facet.panels) <- c("t", "l", "b", "r")
# extract legend & copy over to location of unfilled facet panels
guide.grob <- which(gp[["layout"]][["name"]] == "guide-box")
if(length(guide.grob) == 0){
message("There is no legend present. Returning original plot.")
return(p)
}
gp <- gtable_add_grob(x = gp,
grobs = gp[["grobs"]][[guide.grob]],
t = empty.facet.panels[["t"]],
l = empty.facet.panels[["l"]],
b = empty.facet.panels[["b"]],
r = empty.facet.panels[["r"]],
name = "new-guide-box")
# squash the original guide box's row / column (whichever applicable)
# & empty its cell
guide.grob <- gp[["layout"]][guide.grob, ]
if(guide.grob[["l"]] == guide.grob[["r"]]){
gp <- gtable_squash_cols(gp, cols = guide.grob[["l"]])
}
if(guide.grob[["t"]] == guide.grob[["b"]]){
gp <- gtable_squash_rows(gp, rows = guide.grob[["t"]])
}
gp <- gtable_remove_grobs(gp, "guide-box")
return(gp)
}
Result:
library(grid)
grid.draw(shift_legend(p))
Nicer looking result if we take advantage of the empty space's direction to arrange the legend horizontally:
p.new <- p +
guides(fill = guide_legend(title.position = "top",
label.position = "bottom",
nrow = 1)) +
theme(legend.direction = "horizontal")
grid.draw(shift_legend(p.new))
Some other examples:
# example 1: 1 empty panel, 1 vertical legend
p1 <- ggplot(economics_long,
aes(date, value, color = variable)) +
geom_line() +
facet_wrap(~ variable,
scales = "free_y", nrow = 2,
strip.position = "bottom") +
theme(strip.background = element_blank(),
strip.placement = "outside")
grid.draw(shift_legend(p1))
# example 2: 2 empty panels (vertically aligned) & 2 vertical legends side by side
p2 <- ggplot(mpg,
aes(x = displ, y = hwy, color = fl, shape = factor(cyl))) +
geom_point(size = 3) +
facet_wrap(~ class, dir = "v") +
theme(legend.box = "horizontal")
grid.draw(shift_legend(p2))
# example 3: facets in polar coordinates
p3 <- ggplot(mtcars,
aes(x = factor(1), fill = factor(cyl))) +
geom_bar(width = 1, position = "fill") +
facet_wrap(~ gear, nrow = 2) +
coord_polar(theta = "y") +
theme_void()
grid.draw(shift_legend(p3))
Nice Q&A!
I found something similar at this link. So, I thought that it would have been a nice addition to your function.
More precisely the function reposition_legend() from lemon seems to be quite what you needed, except that it doesn't look for the empty spaces.
I took inspiration from your function to find the names of the empty panels that are passed to reposition_legend() with the panel arg.
Example data and libraries:
library(ggplot2)
library(gtable)
library(lemon)
p <- ggplot(diamonds,
aes(x = carat, fill = cut)) +
geom_density(position = "stack") +
facet_wrap(~ color) +
theme(legend.direction = "horizontal")
Of course, I removed all the checks (if cases, which should be the same) just to concentrate on the important stuff.
shift_legend2 <- function(p) {
# ...
# to grob
gp <- ggplotGrob(p)
facet.panels <- grep("^panel", gp[["layout"]][["name"]])
empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]))
empty.facet.panels <- facet.panels[empty.facet.panels]
# establish name of empty panels
empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
names <- empty.facet.panels$name
# example of names:
#[1] "panel-3-2" "panel-3-3"
# now we just need a simple call to reposition the legend
reposition_legend(p, 'center', panel=names)
}
shift_legend2(p)
Note that this might still need some tweaking, I just thought it was something worth to be shared.
At the moment the behaviour seems OK, and the function is a few lines shorter.
Other cases.
First example:
p1 <- ggplot(economics_long,
aes(date, value, color = variable)) +
geom_line() +
facet_wrap(~ variable,
scales = "free_y", nrow = 2,
strip.position = "bottom") +
theme(strip.background = element_blank(),
strip.placement = "outside")
shift_legend2(p1)
Second example:
p2 <- ggplot(mpg,
aes(x = displ, y = hwy, color = fl, shape = factor(cyl))) +
geom_point(size = 3) +
facet_wrap(~ class, dir = "v") +
theme(legend.box = "horizontal")
#[1] "panel-2-3" "panel-3-3" are the names of empty panels in this case
shift_legend2(p2)
Third example:
p3 <- ggplot(mtcars,
aes(x = factor(1), fill = factor(cyl))) +
geom_bar(width = 1, position = "fill") +
facet_wrap(~ gear, nrow = 2) +
coord_polar(theta = "y") +
theme_void()
shift_legend2(p3)
Complete function:
shift_legend2 <- function(p) {
# check if p is a valid object
if(!(inherits(p, "gtable"))){
if(inherits(p, "ggplot")){
gp <- ggplotGrob(p) # convert to grob
} else {
message("This is neither a ggplot object nor a grob generated from ggplotGrob. Returning original plot.")
return(p)
}
} else {
gp <- p
}
# check for unfilled facet panels
facet.panels <- grep("^panel", gp[["layout"]][["name"]])
empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]),
USE.NAMES = F)
empty.facet.panels <- facet.panels[empty.facet.panels]
if(length(empty.facet.panels) == 0){
message("There are no unfilled facet panels to shift legend into. Returning original plot.")
return(p)
}
# establish name of empty panels
empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
names <- empty.facet.panels$name
# return repositioned legend
reposition_legend(p, 'center', panel=names)
}
I think lemon::reposition_legend() identified by #RLave is the most elegant solution. However, it does hinge on knowing the names of empty facets. I wanted to share a succinct way of finding these, thus proposing yet another version of shift_legend():
shift_legend3 <- function(p) {
pnls <- cowplot::plot_to_gtable(p) %>% gtable::gtable_filter("panel") %>%
with(setNames(grobs, layout$name)) %>% purrr::keep(~identical(.x,zeroGrob()))
if( length(pnls) == 0 ) stop( "No empty facets in the plot" )
lemon::reposition_legend( p, "center", panel=names(pnls) )
}
The R package patchwork offers an elegant solution when combining multiple plots (slightly different than a single facetted ggplot). If one has three ggplot objects, p1, p2, p3, then the syntax is very straightforward:
using the + operator, "add" the plots together in facets
using the guide_area() command, specify which facet should contain the guide
if all three plots have the same legend, save space by telling patchwork to "collect" the legends with the command plot_layout(guides = 'collect').
See the code below for the essential syntax and the link below for a fully reproducible example.
library(patchwork)
# guide_area() puts legend in empty fourth facet
p1 + p2 + p3 + guide_area() +
plot_layout(guides = 'collect')
https://patchwork.data-imaginist.com/articles/guides/layout.html#controlling-guides
I am creating a graphic using facet_grid to facet a categorical variable on the y-axis. I decided not to use facet_wrap because I need space = 'free' and labeller = label_parsed. My labels are long and I have a legend on the right so I would like to move the labels from the right of the panel to the top of the panel.
Here is an example to show where I'm getting stuck.
library(ggplot2)
library(gtable)
mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
facet_grid(manufacturer ~ ., scales = 'free', space = 'free') +
theme_minimal() +
theme(panel.margin = unit(0.5, 'lines'), strip.text.y = element_text(angle = 0))
Now I would like to move the strip text from the right of each panel to the top of each panel. I can store the grobs for the strip labels and remove them from the plot:
grob <- ggplotGrob(mt)
strips.y <- gtable_filter(grob, 'strip-right')
grob2 <- grob[,-5]
But now I'm stuck when it comes to rbind-ing the grobs back so the labels go to the top of the panels.
Another possible solution would be to use facet_wrap and then re-size the panels as discussed in another question, but in that case I would have to manually change the labels on the facets because there is no labeller = label_parsed for facet_wrap.
I'd appreciate suggestions on either approach!
Thanks for reading,
Tom
This takes your first approach. It inserts a row above each of the panels, grabs the strip grobs (on the right), and inserts them into the new rows.
library(ggplot2)
library(gtable)
library(grid)
mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
facet_grid(manufacturer ~ ., scales = 'free', space = 'free') +
theme(panel.spacing = unit(0.5, 'lines'),
strip.text.y = element_text(angle = 0))
# Get the gtable
gt <- ggplotGrob(mt)
# Get the position of the panels in the layout
panels <-c(subset(gt$layout, grepl("panel", gt$layout$name), se=t:r))
# Add a row above each panel
for(i in rev(panels$t-1)) gt = gtable_add_rows(gt, unit(.5, "lines"), i)
# Get the positions of the panels and the strips in the revised layout
panels <-c(subset(gt$layout, grepl("panel", gt$layout$name), se=t:r))
strips <- c(subset(gt$layout, grepl("strip-r", gt$layout$name), se=t:r))
# Get the strip grobs
stripText = gtable_filter(gt, "strip-r")
# Insert the strip grobs into the new rows
for(i in 1:length(strips$t)) gt = gtable_add_grob(gt, stripText$grobs[[i]]$grobs[[1]], t=panels$t[i]-1, l=4)
# Remove the old strips
gt = gt[,-5]
# For this plot - adjust the heights of the strips and the empty row above the strips
for(i in panels$t) {
gt$heights[i-1] = unit(0.8, "lines")
gt$heights[i-2] = unit(0.2, "lines")
}
# Draw it
grid.newpage()
grid.draw(gt)
OR, you can achieve the second approach using a facet_wrap_labeller function available from here.
library(ggplot2)
library(gtable)
mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
facet_wrap(~ manufacturer, scales = "free_y", ncol = 1) +
theme(panel.margin = unit(0.2, 'lines'))
facet_wrap_labeller <- function(gg.plot, labels=NULL) {
require(gridExtra)
g <- ggplotGrob(gg.plot)
gg <- g$grobs
strips <- grep("strip_t", names(gg))
for(ii in seq_along(labels)) {
modgrob <- getGrob(gg[[strips[ii]]], "strip.text",
grep=TRUE, global=TRUE)
gg[[strips[ii]]]$children[[modgrob$name]] <- editGrob(modgrob,label=labels[ii])
}
g$grobs <- gg
class(g) = c("arrange", "ggplot",class(g))
return(g)
}
## Number of y breaks in each panel
g <- ggplot_build(mt)
N <- sapply(lapply(g$panel$ranges, "[[", "y.major"), length)
# Some arbitrary strip texts
StripTexts = expression(gamma[1], sqrt(gamma[2]), C, `A really incredibly very very very long label`, gamma[5], alpha[1], alpha[2], `Land Rover`, alpha[1], beta[2], gamma^2, delta^2, epsilon[2], zeta[3], eta[4] )
# Apply the facet_wrap_labeller function
gt = facet_wrap_labeller(mt, StripTexts)
# Get the position of the panels in the layout
panels <- gt$layout$t[grepl("panel", gt$layout$name)]
# Replace the default panel heights with relative heights
gt$heights[panels] <- lapply(N, unit, "null")
# Draw it
gt
I was struggling with a similar problem but putting the labels on the bottom. I've used a code adaptation of this answer. And recently found that
ggplot2 ver.2.2.1.0 (http://docs.ggplot2.org/current/facet_grid.html)
~facet_grid(.~variable,switch='x')
option which has worked beautifully for me.
In base graphics we can easily add tick-marks at different sides of the plot by using axis and the side argument:
par(tck = 0.025)
plot(1:10)
axis(side = 3, labels = FALSE)
axis(side = 4, labels = FALSE)
How can I mirror x and y axis ticks on the top and right in ggplot2? There is annotation_logticks which can do this, but only seems to work well for logarithmic scales (as the name of the function applies). For linear scales, is there a similarly easy way?
From ggplot2 2.2.0 you may use the sec.axis argument in scale_.
dup_axis is a shorthand for creating a secondary axis that is a duplication of the primary axis, effectively mirroring the primary axis.
ggplot(data = mpg, aes(x = displ, y = hwy)) +
geom_point() +
scale_x_continuous(sec.axis = dup_axis()) +
scale_y_continuous(sec.axis = dup_axis())
This mirrors the axis tick marks (using gtable functions), and puts the tick marks inside the plot panel.
EDIT 18 April 2016 axis.ticks.margin is deprecated. Use text margins instead.
EDIT 19 Mrch 2015: Better positioning of the tick marks
library(ggplot2) # v2.1.0
library(gtable) # v0.2.0
library(grid)
# Get a plot
p = ggplot(data.frame(x = 1:10, y = 1:10), aes(x,y)) +
geom_point() +
theme_bw() +
theme(panel.grid = element_blank(),
axis.ticks.length=unit(-0.25, "cm"),
axis.text.x = element_text(margin = margin(t = .5, unit = "cm")),
axis.text.y = element_text(margin = margin(r = .5, unit = "cm")))
# Convert the plot to a grob
gt <- ggplotGrob(p)
# Get the position of the panel in the layout
panel <-c(subset(gt$layout, name=="panel", se=t:r))
## For the bottom axis
# Get the row number of the bottom axis in the layout
rn <- which(gt$layout$name == "axis-b")
# Extract the axis (tick marks only)
axis.grob <- gt$grobs[[rn]]
axisb <- axis.grob$children[[2]] # Two children - get the second
axisb # Note: two grobs - tick marks and text
# Get the tick marks
xaxis = axisb$grobs[[1]] # NOTE: tick marks first
xaxis$y = xaxis$y - unit(0.25, "cm") # Position them inside the panel
# Add a new row to gt, and insert the revised xaxis grob into the new row.
gt <- gtable_add_rows(gt, unit(0, "lines"), panel$t-1)
gt <- gtable_add_grob(gt, xaxis, l = panel$l, t = panel$t, r = panel$r, name = "ticks")
## Repeat for the left axis
# Get the row number of the left axis in the layout
panel <-c(subset(gt$layout, name=="panel", se=t:r))
rn <- which(gt$layout$name == "axis-l")
# Extract the axis (tick marks and axis text)
axis.grob <- gt$grobs[[rn]]
axisl <- axis.grob$children[[2]] # Two children - get the second
axisl # Note: two grobs - text and tick marks
# Get the tick marks
yaxis = axisl$grobs[[2]] # NOTE: tick marks second
yaxis$x = yaxis$x - unit(0.25, "cm") # Position them inside the panel
# Add a new column to gt, and insert the revised yaxis grob into the new column.
gt <- gtable_add_cols(gt, unit(0, "lines"), panel$r)
gt <- gtable_add_grob(gt, yaxis, t = panel$t, l = panel$r+1, name = "ticks")
# Turn clipping off
gt$layout[gt$layout$name == "ticks", ]$clip = "off"
# Draw it
grid.draw(gt)
This doesn't solve the discrete issue, but the secondary axis need not be a duplication of the primary axis. So on "side=4" I can put a transformation of the "side=2" axis.
See more here:
https://ggplot2.tidyverse.org/reference/sec_axis.html
e.g., scale_y_continuous(sec.axis = sec_axis(~ . + 10))