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 = \"fr         


        

Answer 1

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