【问题标题】：ggplot2::coord_cartesian on facetsggplot2::coord_cartesian 在方面
【发布时间】：2020-12-12 11:26:47
【问题描述】：

coord_cartesian 不允许设置每个方面的坐标，并且使用其他范围限制往往会在特定极端处产生一条直线。由于我们有广泛变化的 y 范围，我们不能对所有方面都设置相同的限制；在绘图之前限制数据对geom_line/geom_path (https://stackoverflow.com/a/27319786/3358272) 不太友好，因为插入数据以到达边缘然后插入NAs 以分解需要更多的努力线。（最终，获得所需结果的唯一方法就是这样做，这对于其他数据可能有点繁琐。）

https://gist.github.com/burchill/d780d3e8663ad15bcbda7869394a348a 中建议了一种解决方法，它的开头是

test_data %>%
  ggplot(aes(x=Nsubjects, y = Odds, color=EffectSize)) +
  facet_wrap(DataType ~ ExpType, labeller = label_both, scales="free") +
  geom_line(size=2) +
  geom_ribbon(aes(ymax=Upper, ymin=Lower, fill=EffectSize, color=NULL), alpha=0.2)

在ggplot2 的早期版本中，该要点定义了coord_panel_ranges 并且能够控制每个方面的坐标。右侧的两个方面应缩小到 1-6（ish）的 y 轴，以便爆炸置信区间脱离屏幕并允许方面主要关注数据的“正常范围”。（注意：test_data 和这个 vis 不是我的，它取自要点。虽然我的需求有些相似，但我认为最好留在要点的数据和代码的范围内。）

不幸的是，ggplot2-3.3.0 现在对我来说失败了。与最近丢失 ggplot2::scale_range 相关的初始错误，我试图通过调整 burchill 的代码（使用其他 ggplot2::: 内部函数）来缓解这些错误：

UniquePanelCoords <- ggplot2::ggproto(
  "UniquePanelCoords", ggplot2::CoordCartesian,
  
  num_of_panels = 1,
  panel_counter = 1,
  panel_ranges = NULL,
  
  setup_layout = function(self, layout, params) {
    self$num_of_panels <- length(unique(layout$PANEL))
    self$panel_counter <- 1
    layout
  },
  
  setup_panel_params =  function(self, scale_x, scale_y, params = list()) {
    if (!is.null(self$panel_ranges) & length(self$panel_ranges) != self$num_of_panels)
      stop("Number of panel ranges does not equal the number supplied")
    
    train_cartesian <- function(scale, limits, name, given_range = NULL) {
      if (is.null(given_range)) {
        expansion <- ggplot2:::default_expansion(scale, expand = self$expand)
        range <- ggplot2:::expand_limits_scale(scale, expansion,
                                               coord_limits = self$limits[[name]])
      } else {
        range <- given_range
      }
      
      out <- scale$break_info(range)
      out$arrange <- scale$axis_order()
      names(out) <- paste(name, names(out), sep = ".")
      out
    }
    
    cur_panel_ranges <- self$panel_ranges[[self$panel_counter]]
    if (self$panel_counter < self$num_of_panels)
      self$panel_counter <- self$panel_counter + 1
    else
      self$panel_counter <- 1
    
    c(train_cartesian(scale_x, self$limits$x, "x", cur_panel_ranges$x),
      train_cartesian(scale_y, self$limits$y, "y", cur_panel_ranges$y))
  }
)

coord_panel_ranges <- function(panel_ranges, expand = TRUE, default = FALSE, clip = "on") {
  ggplot2::ggproto(NULL, UniquePanelCoords, panel_ranges = panel_ranges, 
          expand = expand, default = default, clip = clip)
}

但这仍然失败

test_data %>%
  ggplot(aes(x=Nsubjects, y = Odds, color=EffectSize)) +
  facet_wrap(DataType ~ ExpType, labeller = label_both, scales="free") +
  geom_line(size=2) +
  geom_ribbon(aes(ymax=Upper, ymin=Lower, fill=EffectSize, color=NULL), alpha=0.2) +
  coord_panel_ranges(panel_ranges = list(
    list(x=c(8,64), y=c(1,4)), # Panel 1
    list(x=c(8,64), y=c(1,6)), # Panel 2
    list(NULL),                # Panel 3, an empty list falls back on the default values
    list(x=c(8,64), y=c(1,7))  # Panel 4
  ))
# Error in panel_params$x$break_positions_minor() : 
#   attempt to apply non-function

我对扩展 ggplot2 不是很熟悉，我怀疑 ggproto 中缺少一些东西。 proto 的返回值如下所示：

str(c(train_cartesian(scale_x, self$limits$x, "x", cur_panel_ranges$x),
      train_cartesian(scale_y, self$limits$y, "y", cur_panel_ranges$y)))
# List of 14
#  $ x.range       : num [1:2] 8 64
#  $ x.labels      : chr [1:3] "20" "40" "60"
#  $ x.major       : num [1:3] 0.214 0.571 0.929
#  $ x.minor       : num [1:6] 0.0357 0.2143 0.3929 0.5714 0.75 ...
#  $ x.major_source: num [1:3] 20 40 60
#  $ x.minor_source: num [1:6] 10 20 30 40 50 60
#  $ x.arrange     : chr [1:2] "secondary" "primary"
#  $ y.range       : num [1:2] 1 4
#  $ y.labels      : chr [1:4] "1" "2" "3" "4"
#  $ y.major       : num [1:4] 0 0.333 0.667 1
#  $ y.minor       : num [1:7] 0 0.167 0.333 0.5 0.667 ...
#  $ y.major_source: num [1:4] 1 2 3 4
#  $ y.minor_source: num [1:7] 1 1.5 2 2.5 3 3.5 4
#  $ y.arrange     : chr [1:2] "primary" "secondary"

我是否需要有一个 x 元素，它是一个至少具有 break_positions_minor 函数的列表，还是需要继承其他东西以确保 panel_params$x$break_positions_minor 存在或使用合理的默认值？

数据：

test_data <- structure(list(DataType = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("A", "B"), class = "factor"), 
    ExpType = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
    2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("X", "Y"), class = "factor"), 
    EffectSize = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
    1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 
    2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L), .Label = c("15", "35"
    ), class = "factor"), Nsubjects = c(8, 16, 32, 64, 8, 16, 
    32, 64, 8, 16, 32, 64, 8, 16, 32, 64, 8, 16, 32, 64, 8, 16, 
    32, 64, 8, 16, 32, 64, 8, 16, 32, 64), Odds = c(1.06248116259846, 
    1.09482076720863, 1.23086993413208, 1.76749340505612, 1.06641831731573, 
    1.12616954196688, 1.48351814320987, 3.50755080416964, 1.11601399761081, 
    1.18352602009495, 1.45705466646283, 2.53384744810515, 1.13847061762186, 
    1.24983742407086, 1.97075900741022, 6.01497152563726, 1.02798821372378, 
    1.06297006279249, 1.19432835697453, 1.7320754674107, 1.02813271730924, 
    1.09355953747203, 1.44830680332583, 3.4732692664923, 1.06295915758305, 
    1.12008443626365, 1.3887632112682, 2.46321037334, 1.06722652223114, 
    1.1874936754725, 1.89870184372054, 5.943747409114), Upper = c(1.72895843644471, 
    2.09878774769559, 2.59771794965346, 5.08513435549015, 1.72999898901071, 
    1.8702196882561, 3.85385388850167, 5.92564404180303, 1.99113042576373, 
    2.61074135841984, 3.45852331828636, 4.83900142207583, 1.57897154221764, 
    1.8957409107653, 10, 75, 2.3763918424135, 2.50181951057562, 
    3.45037180395673, 3.99515276392065, 2.04584535265976, 2.39317394040066, 
    2.832526733659, 5.38414183471915, 1.40569501856836, 2.6778044191832, 
    2.98023068052396, 4.75934650422069, 1.54116883311054, 2.50647989271592, 
    3.48517589981551, 100), Lower = c(0.396003888752214, 0.0908537867216577, 
    -0.135978081389309, -1.55014754537791, 0.40283764562075, 
    0.382119395677663, -0.88681760208193, 1.08945756653624, 0.240897569457892, 
    -0.243689318229938, -0.544413985360706, 0.228693474134466, 
    0.69796969302609, 0.603933937376415, 0.183548809738402, 3.57236968943798, 
    -0.320415414965949, -0.375879384990643, -1.06171509000767, 
    -0.531001829099242, 0.010420081958713, -0.206054865456611, 
    0.0640868729926525, 1.56239669826544, 0.720223296597732, 
    -0.437635546655903, -0.202704257987574, 0.167074242459314, 
    0.593284211351745, -0.131492541770921, 0.312227787625573, 
    3.76692741957876)), .Names = c("DataType", "ExpType", "EffectSize", 
"Nsubjects", "Odds", "Upper", "Lower"), class = c("tbl_df", "tbl", 
"data.frame"), row.names = c(NA, -32L))

【问题讨论】：

在打开这个蠕虫罐之前，我认为您已经考虑并拒绝了其他选项，例如将面板拼接在一起或重新缩放数据和欺骗轴标签？
此外，顶部的示例添加了coord_cartesian(ylim = c(0, 6))，效果非常好。大概最终结果是能够在每个面板的基础上进行调整？
是的，基于每个面板。示例代码将面板设置为不同的 y 限制；在我的其他用途中（除此之外），y 范围的差异是数量级的，因此没有合理的折衷方案。对于您的第一个问题，我过去曾考虑过（并驳回）它，部分原因是遗留代码是在cowplot/patchwork 熟练度之前开始的，部分原因是还有其他几种情节美学，合并传说似乎过于复杂我认为原本易于使用的刻面是与生俱来的。

标签： r ggplot2 facet ggproto

【解决方案1】：

在某些时候，我遇到了类似的问题。结果是一个稍微冗长但也更灵活的选项，可以在每个方面自定义位置比例的许多方面。由于某些技术性，它使用 scales::oob_keep() 的等效项作为标尺上的 oob 参数，从而就好像坐标确定了限制一样。

library(ggh4x)
library(tidyverse)

p <- test_data %>%
  ggplot(aes(x=Nsubjects, y = Odds, color=EffectSize)) +
  facet_wrap(DataType ~ ExpType, labeller = label_both, scales="free") +
  geom_line(size=2) +
  geom_ribbon(aes(ymax=Upper, ymin=Lower, fill=EffectSize, color=NULL), alpha=0.2) +
  facetted_pos_scales(
    x = list(
      scale_x_continuous(limits = c(8, 64)),
      scale_x_continuous(limits = c(64, 8), trans = "reverse"),
      NULL,
      scale_x_continuous(limits = c(8, 64), labels = scales::dollar_format())
    ),
    y = list(
      scale_y_continuous(limits = c(1, 4), guide = "none"),
      scale_y_continuous(limits = c(1, 6), breaks = 1:3),
      NULL,
      scale_y_continuous(limits = c(1, 7), position = "right")
    )
  )

【讨论】：

非常有趣的方法，我看到了它的优点。这是否可以很好地处理 oob 然后返回边界的路径？也就是说，它是在剪裁边界吗？
我为使其工作而做出的牺牲之一是 scales 的 oob 参数不起作用，并求助于 scales::oob_keep() 行为。也就是说，它保持超出边界值并让网格系统剪切面板外的任何内容。
嗯，从某种意义上说，这很好，可以这么说，线条/路径/功能区只是继续离开页面。实际上，我之前已经看过您的包裹（并且直到现在才丢失链接）。我不确定的一件事是处理列表元素顺序的相对不确定性，因此我尝试使限制基于框架且与顺序无关。鉴于此，您的包看起来很稳定这一事实令人鼓舞，尽管我承认我仍然有点犹豫......我的大部分情节都是以编程方式构建的。话虽如此，我真的很喜欢scales-agnostic 方法！
是的，在语法上使用它只能像您可以先验地预测哪些数据最终会出现在哪个面板中一样有效。第 i^th x 比例适用于 layout$SCALE_X == i 的任何部分，因此这主要受刻面系统的控制，但应该适用于网格和环绕变体。
是的，我认为提供一种替代方法来根据订单以外的其他内容指定比例是个好主意。我提出了一个问题here 来提醒我将来探索可用的选项。（顺便说一句，data.frames 可以将比例列表存储在列中作为环境列表。data.frame() 构造函数不允许这样做，但您可以在构造后分配它。）

【解决方案2】：

非常感谢 Z.Lin 开始修复我的问题，这个答案确实帮助我克服了错误并学习了一种更合适的处理 ggproto 对象的方法。

发布此答案是作为一种更灵活的方法来解决多面图中每个面板限制的潜在问题。我的第一批代码的主要问题是它依赖于方面的顺序，在我的一些其他（私人）用例中并不总是知道的（嗯，不是受控 ) 先验的。因此，我希望明确确定每个面板的限制。

我已更改函数名称（和 args）以表示两点：（1）这似乎是模仿/替换 coord_cartesian，以及（2）我不知道它会转化为其他 @ 987654326@ 功能无需调整。欢迎在我的gist 发表评论/补丁。

在前面，可以完美复制 Z.Lin 的结果：

p <- test_data %>%
  ggplot(aes(x = Nsubjects, y = Odds, color=EffectSize)) +
  facet_wrap(DataType ~ ExpType, labeller = label_both, scales = "free") +
  geom_line(size = 2) +
  geom_ribbon(aes(ymax = Upper, ymin = Lower, fill = EffectSize, color = NULL), alpha = 0.2)

p + coord_cartesian_panels(
  panel_limits = tibble::tribble(
    ~DataType, ~ExpType, ~ymin, ~ymax
  , "A"      , "X"     ,     1,     4
  , "A"      , "Y"     ,     1,     6
  , "B"      , "Y"     ,     1,     7
  )
)

which 面板是列表中的 which 参数的歧义（原始代码引入的）已经消失了。由于它使用data.frame 与绘图的layout 匹配（通常为merge），因此行的顺序无关紧要。

注意事项：

引用的 panel_limits 字段是：xmin、xmax、ymin 和 ymax，在所需的任何构面变量之上；
特定字段（或缺失字段）中的NA 表示使用先前定义的限制；
当所有 faceting-variables 匹配时（在panel_limits 和facet_* 定义的布局之间），在各个面板上设置限制；这种一对一的映射是关于这个函数的假设；
当一些（但不是全部）变量匹配时，将在面板子集上设置限制（例如，在面板的一个轴上，取决于分面方法）；
当没有变量匹配且panel_limits为单行时，则任意设置所有面板的限制；和
panel_limits 中与 layout 中不匹配的刻面行将被静默忽略。

错误：

panel_limits 中不存在于布局中的任何构面变量（即，未在 facet_* 中指定）；或
panel_limits 中有不止一行与特定面板匹配。

作为一个扩展，它也处理了 faceting 变量的一个子集，所以如果我们只想通过ExpType 限制所有 facet，那么

# set the limits on panels based on one faceting variable only
p + coord_cartesian_panels(
  panel_limits = tibble::tribble(
    ~ExpType, ~ymin, ~ymax
  , "X"     ,    NA,     4
  , "Y"     ,     1,     5
  )
) + labs(title = "panel_limits, one variable")

# set the limits on all panels
p + coord_cartesian_panels(
  panel_limits = tibble::tribble(
    ~ymin, ~ymax
  , NA,     5
  )
) + labs(title = "panel_limits, no variables")

（最后一个例子看起来很傻，但是如果面/图是以编程方式构建的，并且不能先验地保证存在单个面，那么这将导致合理的默认行为，假设一切都是明确的。 )

进一步的扩展可能允许构面变量中的NA 匹配所有变量，例如

# does not work
p + coord_cartesian_panels(
  panel_limits = tibble::tribble(
    ~DataType, ~ExpType, ~ymin, ~ymax
  , "A"      , NA      ,     1,     4
  , NA       , "Y"     ,     1,     6
  )
)

这需要merge 理解NA 的意思是“所有/任何”，而不是文字NA。我现在不打算扩展merge 来处理这个问题，所以我不打算让这个函数复杂化来尝试这样做。如果有一个合理的 merge 替代品可以进行这种微积分，请告诉我:-)

非常感谢 ...

burchill 为最初的努力和gist；和
Z.Lin，帮助将功能升级到ggplot2-3.3.0。

UniquePanelCoords <- ggplot2::ggproto(
  "UniquePanelCoords", ggplot2::CoordCartesian,
  
  num_of_panels = 1,
  panel_counter = 1,
  layout = NULL,
  
  setup_layout = function(self, layout, params) {
    self$num_of_panels <- length(unique(layout$PANEL))
    self$panel_counter <- 1
    self$layout <- layout # store for later
    layout
  },
  
  setup_panel_params =  function(self, scale_x, scale_y, params = list()) {
    train_cartesian <- function(scale, limits, name, given_range = c(NA, NA)) {
      if (anyNA(given_range)) {
        expansion <- ggplot2:::default_expansion(scale, expand = self$expand)
        range <- ggplot2:::expand_limits_scale(scale, expansion, coord_limits = limits)
        isna <- is.na(given_range)
        given_range[isna] <- range[isna]
      }
      out <- list(
        ggplot2:::view_scale_primary(scale, limits, given_range),
        sec = ggplot2:::view_scale_secondary(scale, limits, given_range),
        arrange = scale$axis_order(),
        range = given_range
      )
      names(out) <- c(name, paste0(name, ".", names(out)[-1]))
      out
    }

    this_layout <- self$layout[ self$panel_counter,, drop = FALSE ]
    self$panel_counter <- 
      if (self$panel_counter < self$num_of_panels) {
        self$panel_counter + 1
      } else 1

    # determine merge column names by removing all "standard" names
    layout_names <- setdiff(names(this_layout),
                            c("PANEL", "ROW", "COL", "SCALE_X", "SCALE_Y"))
    limits_names <- setdiff(names(self$panel_limits),
                            c("xmin", "xmax", "ymin", "ymax"))

    limit_extras <- setdiff(limits_names, layout_names)
    if (length(limit_extras) > 0) {
      stop("facet names in 'panel_limits' not found in 'layout': ",
           paste(sQuote(limit_extras), collapse = ","))
    } else if (length(limits_names) == 0 && NROW(self$panel_limits) == 1) {
      # no panels in 'panel_limits'
      this_panel_limits <- cbind(this_layout, self$panel_limits)
    } else {
      this_panel_limits <- merge(this_layout, self$panel_limits, all.x = TRUE, by = limits_names)
    }

    if (isTRUE(NROW(this_panel_limits) > 1)) {
      stop("multiple matches for current panel in 'panel_limits'")
    }

    # add missing min/max columns, default to "no override" (NA)
    this_panel_limits[, setdiff(c("xmin", "xmax", "ymin", "ymax"),
                                names(this_panel_limits)) ] <- NA

    c(train_cartesian(scale_x, self$limits$x, "x",
                      unlist(this_panel_limits[, c("xmin", "xmax"), drop = TRUE])),
      train_cartesian(scale_y, self$limits$y, "y",
                      unlist(this_panel_limits[, c("ymin", "ymax"), drop = TRUE])))
  }
)

coord_cartesian_panels <- function(panel_limits, expand = TRUE, default = FALSE, clip = "on") {
  ggplot2::ggproto(NULL, UniquePanelCoords,
                   panel_limits = panel_limits,
                   expand = expand, default = default, clip = clip)
}

【讨论】：

好问题，好答案。我要保留这个书签。感谢您提出这个话题。
这个函数应该加在facet_wrap()的参数中！还是我错过了与其他人 ggplot func' 的一些冲突？无论如何，感谢您提供的出色解决方案，这是我在这里读到的最佳解决方案之一！
@ClémentLVD 之前有人建议过。毫不奇怪（我不能不同意），反对添加它的最大理由是：维护。如果当前的维护者认为它不够通用并且在他们当前的方法中不易于维护，那么他们就不想将它添加到那个包中。请记住，一旦它在那里，每个人都可以 ping Hadley & Company 来维护这个功能，即使他们与起草它无关。简单的回答：“这就是扩展包的用途”.

【解决方案3】：

我修改了函数train_cartesian 来匹配view_scales_from_scale 的输出格式（定义here），这似乎可行：

train_cartesian <- function(scale, limits, name, given_range = NULL) {
    if (is.null(given_range)) {
        expansion <- ggplot2:::default_expansion(scale, expand = self$expand)
        range <- ggplot2:::expand_limits_scale(scale, expansion,
                                               coord_limits = self$limits[[name]])
    } else {
        range <- given_range
    }
    
    out <- list(
        ggplot2:::view_scale_primary(scale, limits, range),
        sec = ggplot2:::view_scale_secondary(scale, limits, range),
        arrange = scale$axis_order(),
        range = range
    )
    names(out) <- c(name, paste0(name, ".", names(out)[-1]))
    out
}

p <- test_data %>%
  ggplot(aes(x=Nsubjects, y = Odds, color=EffectSize)) +
  facet_wrap(DataType ~ ExpType, labeller = label_both, scales="free") +
  geom_line(size=2) +
  geom_ribbon(aes(ymax=Upper, ymin=Lower, fill=EffectSize, color=NULL), alpha=0.2)

p + 
  coord_panel_ranges(panel_ranges = list(
    list(x=c(8,64), y=c(1,4)), # Panel 1
    list(x=c(8,64), y=c(1,6)), # Panel 2
    list(NULL),                # Panel 3, an empty list falls back on the default values
    list(x=c(8,64), y=c(1,7))  # Panel 4
  ))

原答案

我以前从similar problem 中作弊。

# alternate version of plot with data truncated to desired range for each facet
p.alt <- p %+% {test_data %>%
    mutate(facet = as.integer(interaction(DataType, ExpType, lex.order = TRUE))) %>%
    left_join(data.frame(facet = 1:4,
                         ymin = c(1, 1, -Inf, 1),  # change values here to enforce
                         ymax = c(4, 6, Inf, 7)),  # different axis limits
              by = "facet") %>%
    mutate_at(vars(Odds, Upper, Lower), list(~ ifelse(. < ymin, ymin, .))) %>%
    mutate_at(vars(Odds, Upper, Lower), list(~ ifelse(. > ymax, ymax, .))) }

# copy alternate version's panel parameters to original plot & plot the result
p1 <- ggplot_build(p)
p1.alt <- ggplot_build(p.alt)
p1$layout$panel_params <- p1.alt$layout$panel_params
p2 <- ggplot_gtable(p1)
grid::grid.draw(p2)

【讨论】：

Z.Lin，谢谢你的回答！我添加了一个带有扩展的答案，该扩展完全由您修复该错误启用。