从proto移动到ggproto以创建环境

Question

我使用的是ggplot2: Multiple color scales or shift colors systematically on different layers?的GeomBoxplotDark环境

然而，ggplot2从proto转移到了ggproto，所以这不再起作用。

具体代码为：

require(ggplot2)

GeomBoxplotDark <- proto(ggplot2:::GeomBoxplot,
  draw <- function(., data, ..., outlier.colour = "black", outlier.shape = 16, outlier.size = 2) {
defaults <- with(data, {                               # ** OPENING "{" ADDED **
cols_dk <- rgb2hsv(col2rgb(colour)) - c(0, 0, 0.2)     # ** LINE ADDED        **
cols_dk <- hsv(cols_dk[1,], cols_dk[2,], cols_dk[3,])  # ** LINE ADDED        **
data.frame(x = x, xmin = xmin, xmax = xmax,
  colour = cols_dk,                                    # ** EDITED, PASSING IN cols_dk **
  size = size,
  linetype = 1, group = 1, alpha = 1,
  fill = alpha(fill, alpha),
  stringsAsFactors = FALSE
)})                                                    # ** CLOSING "}" ADDED **
defaults2 <- defaults[c(1,1), ]

if (!is.null(data$outliers) && length(data$outliers[[1]] >= 1)) {
  outliers_grob <- with(data,
    GeomPoint$draw(data.frame(
      y = outliers[[1]], x = x[rep(1, length(outliers[[1]]))],
      colour=I(outlier.colour), shape = outlier.shape, alpha = 1,
      size = outlier.size, fill = NA), ...
    )
  )
} else {
  outliers_grob <- NULL
}

with(data, ggname(.$my_name(), grobTree(
  outliers_grob,
  GeomPath$draw(data.frame(y=c(upper, ymax), defaults2), ...),
  GeomPath$draw(data.frame(y=c(lower, ymin), defaults2), ...),
  GeomRect$draw(data.frame(ymax = upper, ymin = lower, defaults), ...),
  GeomRect$draw(data.frame(ymax = middle, ymin = middle, defaults), ...)
)))
  }
) 

它会给出以下错误：_inherit必须是一个ggproto对象。

我的问题是:我如何解决这个错误，以便我可以使用ggproto创建环境？在此之前，非常感谢您。

Answer 1

下面的方法对我很有效。我添加了expr={}包装器。

GeomBoxplotDark <- ggproto(ggplot2:::GeomBoxplot,expr={
                               draw <- function(., data, ..., outlier.colour = "black", outlier.shape = 16, outlier.size = 2) {
                                 defaults <- with(data, {                               # ** OPENING "{" ADDED **
                                   cols_dk <- rgb2hsv(col2rgb(colour)) - c(0, 0, 0.2)     # ** LINE ADDED        **
                                   cols_dk <- hsv(cols_dk[1,], cols_dk[2,], cols_dk[3,])  # ** LINE ADDED        **
                                   data.frame(x = x, xmin = xmin, xmax = xmax,
                                              colour = cols_dk,                                    # ** EDITED, PASSING IN cols_dk **
                                              size = size,
                                              linetype = 1, group = 1, alpha = 1,
                                              fill = alpha(fill, alpha),
                                              stringsAsFactors = FALSE
                                   )})                                                    # ** CLOSING "}" ADDED **
                                 defaults2 <- defaults[c(1,1), ]

                                 if (!is.null(data$outliers) && length(data$outliers[[1]] >= 1)) {
                                   outliers_grob <- with(data,
                                                         GeomPoint$draw(data.frame(
                                                           y = outliers[[1]], x = x[rep(1, length(outliers[[1]]))],
                                                           colour=I(outlier.colour), shape = outlier.shape, alpha = 1,
                                                           size = outlier.size, fill = NA), ...
                                                         )
                                   )
                                 } else {
                                   outliers_grob <- NULL
                                 }

                                 with(data, ggname(.$my_name(), grobTree(
                                   outliers_grob,
                                   GeomPath$draw(data.frame(y=c(upper, ymax), defaults2), ...),
                                   GeomPath$draw(data.frame(y=c(lower, ymin), defaults2), ...),
                                   GeomRect$draw(data.frame(ymax = upper, ymin = lower, defaults), ...),
                                   GeomRect$draw(data.frame(ymax = middle, ymin = middle, defaults), ...)
                                 )))
                               }
    }
    )