【问题标题】：Can I access results of "setup_data" from "map_data"? (works fine for "compute_layout" but not "map_data") in ggplot2 ggproto我可以从“map_data”访问“setup_data”的结果吗？（适用于“compute_layout”，但不适用于 ggplot2 ggproto 中的“map_data”）
【发布时间】：2021-06-03 21:10:54
【问题描述】：

我可以从 ggpplot2 ggproto 中的“map_data”访问“setup_data”的结果吗？

（适用于“compute_layout”但不适用于“map_data”）

大家好。我正在开发一个 ggplot2 扩展，它将实现一种新的分面方法。

我不想深入了解算法的本质，但我只想说我需要首先为输入data 的每一行计算一些新列，然后才能执行@ 987654323@和map_data。

当然，一种选择是计算我的新列两次，一次在 compute_layout 内，另一次在 map_data 内，但这将是计算成本的两倍，而且不太优雅。

setup_params 和 setup_data 似乎适用于这个确切的用例。

什么不起作用❌

我正在根据 great vignette 创建一个可重复的小示例。

我刚刚做了一个小修改，尝试使用setup_data 函数将hello 列添加到数据中。

library(ggplot2)
facet_bootstrap <- function(n = 9, prop = 0.2, nrow = NULL, ncol = NULL, 
                            scales = "fixed", shrink = TRUE, strip.position = "top") {
  facet <- facet_wrap(~.bootstrap, nrow = nrow, ncol = ncol, scales = scales, 
                      shrink = shrink, strip.position = strip.position)
  facet$params$n <- n
  facet$params$prop <- prop
  ggproto(NULL, FacetBootstrap,
          shrink = shrink,
          params = facet$params
  )
}
FacetBootstrap <- ggproto("FacetBootstrap", FacetWrap,
                          setup_data = function(data, params){
                            data[[1]]$hello <- 'world'
                            print("In SETUP_DATA:")
                            print("   names(data):")
                            print(names(data[[1]]))
                            print("")
                            data
                          },
                          compute_layout = function(data, params) {
                            id <- seq_len(params$n)
                            print("In COMPUTE_LAYOUT:")
                            print("   names(data):")
                            print(names(data[[1]]))
                            print("")
                            dims <- wrap_dims(params$n, params$nrow, params$ncol)
                            layout <- data.frame(PANEL = factor(id))
                            if (params$as.table) {
                              layout$ROW <- 1+as.integer((id - 1L) %/% dims[2] + 1L)
                            } else {
                              layout$ROW <- 1+as.integer(dims[1] - (id - 1L) %/% dims[2])
                            }
                            layout$COL <- 2+as.integer((id - 1L) %% dims[2] + 1L)
                            layout <- layout[order(layout$PANEL), , drop = FALSE]
                            rownames(layout) <- NULL
                            # Add scale identification
                            layout$SCALE_X <- if (params$free$x) id else 1L
                            layout$SCALE_Y <- if (params$free$y) id else 1L
                            cbind(layout, .bootstrap = id)
                          },
                          map_data = function(data, layout, params) {
                            print("In MAP_DATA:")
                            print("   names(data):")
                            print(names(data))
                            print("")
                            if (is.null(data) || nrow(data) == 0) {
                              return(cbind(data, PANEL = integer(0)))
                            }
                            n_samples <- round(nrow(data) * params$prop)
                            new_data <- lapply(seq_len(params$n), function(i) {
                              cbind(data[sample(nrow(data), n_samples), , drop = FALSE], PANEL = i)
                            })
                            do.call(rbind, new_data)
                          }
)
ggplot(diamonds, aes(carat, price)) + 
  geom_point(alpha = 0.1) + 
  facet_bootstrap(n = 9, prop = 0.05)

有输出：

[1] "In SETUP_DATA:"
[1] "   names(data):"
 [1] "carat"   "cut"     "color"   "clarity" "depth"   "table"  
 [7] "price"   "x"       "y"       "z"       "hello"  
[1] ""
[1] "In COMPUTE_LAYOUT:"
[1] "   names(data):"
 [1] "carat"   "cut"     "color"   "clarity" "depth"   "table"  
 [7] "price"   "x"       "y"       "z"       "hello"  
[1] ""
[1] "In MAP_DATA:"
[1] "   names(data):"
 [1] "carat"   "cut"     "color"   "clarity" "depth"   "table"  
 [7] "price"   "x"       "y"       "z"      
[1] ""

注意我的hello 列是如何在compute_layout 中可用，但在map_data 中不可用

什么工作✅

作为一种解决方法，我可以创建一些列，并使用setup_params 将它们作为parameters 传递。这有点粗俗，因为它们在概念上不是“参数”，它们是数据。但如果一切都失败了——我会采取这种方法

library(ggplot2)
facet_bootstrap <- function(n = 9, prop = 0.2, nrow = NULL, ncol = NULL, 
                            scales = "fixed", shrink = TRUE, strip.position = "top") {
  facet <- facet_wrap(~.bootstrap, nrow = nrow, ncol = ncol, scales = scales, 
                      shrink = shrink, strip.position = strip.position)
  facet$params$n <- n
  facet$params$prop <- prop
  ggproto(NULL, FacetBootstrap,
          shrink = shrink,
          params = facet$params
  )
}
FacetBootstrap <- ggproto("FacetBootstrap", FacetWrap,
                          setup_params = function(data, params){
                            params$hello <- 'world'
                            print("In SETUP_DATA:")
                            print("   params$hello:")
                            print(params$hello)
                            print("")
                            params
                          },
                          compute_layout = function(data, params) {
                            id <- seq_len(params$n)
                            print("In COMPUTE_LAYOUT:")
                            print("   params$hello:")
                            print(params$hello)
                            print("")
                            dims <- wrap_dims(params$n, params$nrow, params$ncol)
                            layout <- data.frame(PANEL = factor(id))
                            if (params$as.table) {
                              layout$ROW <- 1+as.integer((id - 1L) %/% dims[2] + 1L)
                            } else {
                              layout$ROW <- 1+as.integer(dims[1] - (id - 1L) %/% dims[2])
                            }
                            layout$COL <- 2+as.integer((id - 1L) %% dims[2] + 1L)
                            layout <- layout[order(layout$PANEL), , drop = FALSE]
                            rownames(layout) <- NULL
                            # Add scale identification
                            layout$SCALE_X <- if (params$free$x) id else 1L
                            layout$SCALE_Y <- if (params$free$y) id else 1L
                            cbind(layout, .bootstrap = id)
                          },
                          map_data = function(data, layout, params) {
                            print("In MAP_DATA:")
                            print("   params$hello:")
                            print(params$hello)
                            print("")
                            if (is.null(data) || nrow(data) == 0) {
                              return(cbind(data, PANEL = integer(0)))
                            }
                            n_samples <- round(nrow(data) * params$prop)
                            new_data <- lapply(seq_len(params$n), function(i) {
                              cbind(data[sample(nrow(data), n_samples), , drop = FALSE], PANEL = i)
                            })
                            do.call(rbind, new_data)
                          }
)
ggplot(diamonds, aes(carat, price)) + 
  geom_point(alpha = 0.1) + 
  facet_bootstrap(n = 9, prop = 0.05)

输出如下

[1] "In SETUP_DATA:"
[1] "   params$hello:"
[1] "world"
[1] ""
[1] "In COMPUTE_LAYOUT:"
[1] "   params$hello:"
[1] "world"
[1] ""
[1] "In MAP_DATA:"
[1] "   params$hello:"
[1] "world"
[1] ""

结果总结

当我从“setup_data”修改数据时，我可以在“compute_layout”中访问它✅
当我从“setup_data”修改数据时，我无法在“map_data”中访问它❌
当我从“setup_params”修改数据时，我可以在“compute_layout”中访问它✅
当我从“setup_params”修改数据时，我可以在“map_data”中访问它✅

最后的问题

上述结果是预期的，还是我只是想错了？
为data ONCE 计算新列，然后为Facet ggproto 提供map_data 和compute_layout 的理想方法是什么？

提前致谢！

【问题讨论】：

标签： r ggplot2 facet-wrap ggproto

【解决方案1】：

TL;DR：在setup_data 函数中的data 的每个列表元素中设置一个新列。

似乎 setup_params 和 setup_data 是针对这个确切的用例的。

没错，但我从您的问题中得到的印象是，数据摄取的操作顺序存在一些混淆。刻面和坐标是绘图“布局”的一部分。在设置布局之前，图层会设置它们的数据（有时会复制全局数据）。然后，布局可以检查数据并进行调整（通常附加一个 PANEL 列）。如果我们检查/打印到控制台 ggplot2:::Layout$setup，我们会看到以下内容（我的 cmets）：

<ggproto method>
  <Wrapper function>
    function (...) 
f(..., self = self)

  <Inner function (f)>
    function (self, data, plot_data = new_data_frame(), plot_env = emptyenv()) 
{
    data <- c(list(plot_data), data)

    # First `setup_params` is used
    self$facet_params <- self$facet$setup_params(data, self$facet$params)
    self$facet_params$plot_env <- plot_env

    # Second, `setup_data` is used
    data <- self$facet$setup_data(data, self$facet_params)
    self$coord_params <- self$coord$setup_params(data)
    data <- self$coord$setup_data(data, self$coord_params)
    
    # Third, `compute_layout` is used.
    self$layout <- self$facet$compute_layout(data, self$facet_params)
    self$layout <- self$coord$setup_layout(self$layout, self$coord_params)
    check_layout(self$layout)
    
    # Lastly, `map_data` is used for every data *except* the global data!
    lapply(data[-1], self$facet$map_data, layout = self$layout, 
        params = self$facet_params)
}

所以从这里我们得知操作的顺序是setup_params --> setup_data --> compute_layout --> map_data。请注意，map_data 以lapply(data[-1], ...) 开头，其中data 是一个列表，其中包含data.frames，位置1 为全局数据，其后为图层数据。

您的setup_data 方法仅将data[[1]]$hello <- 'world' 应用于全局数据，而不应用于图层数据。将该行替换为 data <- lapply(data, cbind, hello = "world") 会将其应用于全局数据和层数据。在这一点上，每一层都已经有它自己的（全局的副本）数据，所以从效率的角度来看，没有很多方面可以有效地将列附加到层可以“继承”的全局数据。

更明确地说，这就是我的提议：

FacetBootstrap <- ggproto(
  "FacetBootstrap", FacetWrap,
  setup_data = function(data, params){
    data <- lapply(data, cbind, hello = "world")
    print("In SETUP_DATA:")
    print("   names(data):")
    print(names(data[[1]]))
    print("")
    data
  },
  ...other code...
)

【讨论】：

这太棒了，谢谢！你是对的，因为我误解了data 是如何被传递的底层管道。所以感谢您不仅回答了我的问题，还帮助我理解了它！
这是一个很好的 SO 答案的绝对模型