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}：如何/我可以獨立調整facet_grid圖上的x軸限制嗎？但是那里的答案不適用於此目的。）

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提供的答案。 它的不同之處在於使用半自動程序來查找需要用g2的元素替換的grob g1元素的索引。

# 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軸限制。 我們生成兩個grobs g1和g2和更換面板和y軸在g1與來自相應的元件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軸的寬度以尊重修改后的軸標簽