开发 stat_contour 的修改版本

Question

我最终试图绘制不规则数据集的等高线图或“光栅图”——这当然是一个相当常见的问题。许多解决方案建议先对数据进行插值，然后绘制它，例如这里：Plotting contours on an irregular grid amongst other - or in fact, the man page at https://ggplot2.tidyverse.org/reference/geom_contour.html

但是，为了方便起见，我试图将其包装到一个新的统计数据中。

我设法获得了适用于 geom_raster 的东西，只需从手册中的示例中提取插值代码即可：

require(akima)
StatInterpRaster <- ggproto("StatInterpRaster", Stat,
                           compute_group = function(data, scales) {
                             
                             ii<-akima::interp(x = data$x,
                                               y = data$y,
                                               z = data$fill)
                             
                             data.out <- tibble(x = rep(ii$x, nrow(ii$z)),
                                           y = rep(ii$y, each = ncol(ii$z)),
                                           fill = as.numeric(ii$z) )
                         
                             return(data.out)
                           },
                           
                           required_aes = c("x", "y", "fill")
)

stat_interp_raster<- function(mapping = NULL, data = NULL, geom = "contour",
                              position = "identity", na.rm = FALSE, show.legend = NA,
                              inherit.aes = TRUE, ...) {
  layer(
    stat = StatInterpRaster, data = data, mapping = mapping, geom = geom,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

按预期工作：

ee <- tibble (x=rnorm(50),y=rnorm(50),z=x*y)
ee %>% ggplot() + geom_raster(aes(x=x,y=y,fill=z),stat=StatInterpRaster)

我现在想用等高线来达到同样的效果。我天真地尝试了

StatInterpContour <- ggproto("StatInterpContour", Stat,
                            compute_group = function(data, scales) {
                              
                              ii<-akima::interp(x = data$x,
                                                y = data$y,
                                                z = data$z)
                              
                              data.out <- tibble(x = rep(ii$x, nrow(ii$z)),
                                                 y = rep(ii$y, each = ncol(ii$z)),
                                                 z = as.numeric(ii$z) )
                              
                              #StatContour(data.out)
                              return(data.out)
                            },
                            
                            required_aes = c("x", "y", "z")
)

stat_interp_contour<- function(mapping = NULL, data = NULL, geom = "contour",
                              position = "identity", na.rm = FALSE, show.legend = NA,
                              inherit.aes = TRUE, ...) {
  layer(
    stat = StatInterpContour, data = data, mapping = mapping, geom = geom,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

与上面基本相同。但是它不会产生预期的结果：

 ee %>% ggplot() + geom_contour(aes(x=x,y=y,z=z),stat=StatInterpContour)

回想起来，这并不奇怪。我的 stat 正在生成一个常规数据数组，在 x 和 y 中具有整齐有序的值，但我没有在任何地方生成实际的行。轮廓线更复杂，似乎是由 stat_contour 中的 xyz_to_isolines 生成的（参见 https://github.com/tidyverse/ggplot2/blob/main/R/stat-contour.r ，截至今天的第 97 行）。

我可以复制stat-contour.r中的相关代码，但在我看来这是浪费精力，最好将我的结果简单地传递给stat_contour，那已经完成了工作：它从该形状的对象生成轮廓线。所以显然我“只是”必须在我的 StatInterpContour 函数 compute_group 的某处调用 StatContour（或朋友）——但是如何呢？

谢谢！

Answer 1

你是对的，你不需要从 StatContour 复制代码。相反，让你的 ggproto class 继承来自 StatContour。准备数据，然后将其连同所有必要的参数一起传递给 StatContour

中的 compute_group 函数

StatInterpContour <- ggproto("StatInterpRaster", StatContour,
  compute_group = function(data, scales, z.range, bins = NULL, binwidth = NULL, 
    breaks = NULL, na.rm = FALSE)  {
                             
    ii<-akima::interp(x = data$x,
                      y = data$y,
                      z = data$z)
    data <-  tibble(x = rep(ii$x, nrow(ii$z)),
             y = rep(ii$y, each = ncol(ii$z)),
             z = as.numeric(ii$z), group = 1) 
    StatContour$compute_group(data, scales, z.range, 
                  bins, binwidth, breaks, na.rm)
    
    },
    required_aes = c("x", "y", "z")
)

这需要对您的 user-facing 函数稍作修改：

stat_interp_contour<- function(mapping = NULL, data = NULL, geom = "contour",
                              position = "identity", na.rm = FALSE, 
                              show.legend = NA,
                              inherit.aes = TRUE, bins = NULL, binwidth = NULL, 
    breaks = NULL,  ...) {
  layer(
    stat = StatInterpContour, data = data, mapping = mapping, geom = geom,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, bins = bins, binwidth = binwidth, 
    breaks = breaks,  ...)
  )
}

但现在应该没有按预期工作。在这里，我将它与根据其 z 值着色的原始点一起绘制，以表明等高线试图接近点的水平：

ee %>% 
  ggplot(aes(x, y)) + 
  geom_point(aes(color = z), size = 3) +
  stat_interp_contour(aes(z = z, color = after_stat(level))) +
  scale_color_viridis_c()

开发 stat_contour 的修改版本

Develop a modified version of stat_contour

r

ggplot2