R: How do I use coord_cartesian on facet_grid with free-ranging axis

Question

Consider some facet_grid plot

mt <- ggplot(mtcars, aes(mpg, wt, colour = factor(cyl))) + geom_point() 
mt + facet_grid(vs ~ am, scales = "free") 

Imagine I just want to zoom on just the top row in the plots above to only show the y-axes values between 3 and 4. I could do this with coord_cartesian() if they weren't faceted or if I wanted to zoom on all plots, but don't have a good solution in this case. I suppose I could subset the data first, but that is taboo for good reason (e.g. would throw off any statistical layer, etc).

(Note that the question is related to this: R: {ggplot2}: How / Can I independently adjust the x-axis limits on a facet_grid plot? but the answer there will not work for this purpose.)

Answer 1

So, this is an old question, but I wanted to share a way that I found. The simplest seems to be to add artificial points to your data, e.g. at the lower left and top right of your data for each plot. Put this information into a separate data frame, then add it to the plot with geom_point using the parameter alpha=0 to make the points invisible. Set the scaling of the axis in facet_wrap to "free_x" or "free_y", depending on what you need.

Now ggplot scales every facet separately to accommodate the invisible points that you added. A bit hacky, but works nicely.

Answer 2

Old post but i was looking for the same thing and couldn't really find anything - [perhaps this is a way Set limits on y axis for two dependent variables using facet_grid()

The solution is not very elegant/efficient but i think it works - basically create two plots with different coord_cartesian calls and swap over the grobs.

# library(ggplot2)
# library(gtable)

# Plot
mt <- ggplot(mtcars, aes(mpg, wt, colour = factor(cyl))) + geom_point() 

# --------------------------------------------------------------------------------


p1 <- mt + facet_grid(vs ~ am, scales = "free") + coord_cartesian(ylim = c(1,6))
g1 <- ggplotGrob(p1)

p2 <- mt + facet_grid(vs ~ am, scales = "free") + coord_cartesian(ylim = c(3,5))
g2 <- ggplotGrob(p2)

# ----------------------------------------------------------
# Replace the upper panels and upper axis of p1 with that of p2
# Tweak panels of second plot - the upper panels
g1[["grobs"]][[6]] <- g2[["grobs"]][[6]]
g1[["grobs"]][[8]] <- g2[["grobs"]][[8]]

#Tweak axis
g1[["grobs"]][[4]] <- g2[["grobs"]][[4]]

grid.newpage()
grid.draw(g1)

Answer 3

My proposed solution is based on the answer provided by @user20650. It differs by using a semi-automatic procedure to find the indices of the elements of the grob g1 that need to be replaced with the elements from g2.

# library(ggplot2)
# library(grid)

p1 <- ggplot(mtcars, aes(mpg, wt, colour = factor(cyl))) + 
  geom_point() +
  facet_grid(vs ~ am)

# modify p1 by zooming as desired
p2 <- p1 + coord_cartesian(ylim = c(3,4)) + 
  theme_bw() + 
  theme(axis.text  = element_text(color="blue"),
        strip.text = element_text(color="blue"))

p1
p2

Now we modify y-axis limits of top facet row. We generate two grobs g1 and g2 and replace the panels and y-axis in g1 with the corresponding elements from g2.

The code below finds the indices of the grob elements to be replaced based on the names of the elements.

g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)

# Replace the upper panels and upper axis of p1 with that of p2
# i.e. replace the corresponding grobs in g1 with the versions of g2
# Panel numbering goes row-wise from top left to bottom right
panels_to_replace_with_g2 <- c(1,2)

# To get names of grobs run: lapply(g1[["grobs"]],function(x) x$name)
# Use names of grobs to find out indices of g1[["grobs"]] of the panels we want to replace
# as well as for the axis ticks.
pattern_for_specific_panels <- 
  paste0("^panel-((",paste0(panels_to_replace_with_g2, collapse = ")|("),"))")
pattern_for_axes_ticks <- 
  "^GRID.absoluteGrob"

idx_panels_to_replace_from_g2 <- which(unlist(
  lapply(g1[["grobs"]], function(x) grepl(pattern_for_specific_panels, x$name))))
# > idx_panels_to_replace_from_g2
# [1] 2 4

idx_axesTicks <- which(unlist(
  lapply(g1[["grobs"]], function(x) grepl(pattern_for_axes_ticks, x$name))))

# Find out manually which of the defined axesTicks it is:
g_test <- g1
for (itr in idx_axesTicks) {
  g_test[["grobs"]][[itr]] <- g2[["grobs"]][[itr]]
  grid.newpage();grid.draw(g_test); grid.draw(textGrob(itr, just = "top"))
  Sys.sleep(1)
}
# We found out it is itr=10
idx_axesTicks_to_replace <- 10

Having now found out indices of the panels to be replaced idx_panels_to_replace_from_g2 as well as the index of the y-axis element idx_axesTicks_to_replace. We can replace them in the following.

# Replace panels
grid.newpage();grid.draw(g1)
for (iter in idx_panels_to_replace_from_g2) {
  g1[["grobs"]][[iter]] <- g2[["grobs"]][[iter]]
  grid.newpage();grid.draw(g1)
  Sys.sleep(1)
}

# Replace y-axis
g1[["grobs"]][[idx_axesTicks_to_replace]] <- g2[["grobs"]][[idx_axesTicks_to_replace]]

# Render plot
grid.newpage()
grid.draw(g1)

If the plot is successfully modified, you can now remove the theme modifications and text color that we applied to p2 in order to make the changes better visible.

Future TODO: What now lack is to increase the width of the y-axis to respect the modified axis labels