R：如何在facet_grid上使用带自由范围轴的coord_cartesian

Question

考虑一些facet_grid情节

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

想象一下，我只想放大上图中的只是顶行，只显示3到4之间的y轴值。我可以用coord_cartesian()进行此操作没有刻面，或者我想放大所有情节，但在这种情况下没有一个好的解决方案。我想我可以先对数据进行子集化，但这是有充分理由的禁忌（例如，会抛弃任何统计层等）。

（请注意，问题与此相关：R: {ggplot2}: How / Can I independently adjust the x-axis limits on a facet_grid plot?，但答案不适用于此目的。）

Answer 1

所以，这是一个老问题，但我想分享一种我找到的方式。最简单的似乎是为您的数据添加人工点，例如在每个图的数据的左下角和右上角。将此信息放入单独的数据框中，然后使用参数alpha = 0将其添加到使用geom_point的图中，以使点不可见。根据您的需要，将facet_wrap中轴的缩放设置为“free_x”或“free_y”。

现在ggplot分别对每个方面进行缩放以适应您添加的不可见点。有点hacky，但工作得很好。

Answer 2

旧帖但我正在寻找相同的东西而且无法找到任何东西 - [也许这是一种方法使用facet_grid（）

为两个因变量设置y轴的限制

解决方案不是非常优雅/高效但我认为它有效 - 基本上创建了两个具有不同coord_cartesian调用的图并交换了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

我提出的解决方案基于@user20650提供的答案。 区别在于使用半自动过程查找grob g1元素的索引，而该索引需要用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

现在，我们修改顶面行的y轴限制。我们生成两个g1和g2的grob，并将g1中的面板和y轴替换为g2中的相应元素。

下面的代码根据元素的名称找到要替换的grob元素的索引。

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

现在已经找到了要替换的面板的索引idx_panels_to_replace_from_g2以及y轴元素idx_axesTicks_to_replace的索引。我们可以在下面替换它们。

# 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)

如果成功修改了图，则现在可以删除我们应用于p2的主题修改和文本颜色，以使更改更清晰可见。

未来TODO：现在缺乏的是增加y轴的宽度以遵守修改后的轴标签