You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

扩展ggplot2:如何按分组而非全局应用缩放函数?

自定义ggplot2 geom的分组缩放问题

我正在为ggplot2开发一个自定义geom,允许用户通过映射到tintshade美学来调整颜色的明暗。(如果有人知道已有实现,请告知以节省精力!)我已完成该geom的基础功能,但不确定缩放应用是否正确,因为我必须在draw_panel内按colour分组重新缩放数据,而非由系统自动处理。

library(ggplot2)
library(rlang)
library(colorspace)
library(grid)
source("https://raw.githubusercontent.com/tidyverse/ggplot2/7fb4c382/R/utilities-grid.R")

geom_point_tintshade <- function(mapping = NULL, data = NULL,
                                 stat = "identity", position = "identity",
                                 ..., na.rm = FALSE, show.legend = NA,
                                 inherit.aes = TRUE) {
  layer(data = data, mapping = mapping, stat = stat, geom = GeomPointTintshade,
        position = position, show.legend = show.legend, inherit.aes = inherit.aes,
        params = list2(na.rm = na.rm, ...))
}
GeomPointTintshade <- ggproto("GeomPointTintshade", GeomPoint,
                              required_aes = c("x", "y"),
                              non_missing_aes = c("size", "shape", "colour", "tintshade"),
                              default_aes = aes(
                                shape = 19, colour = "black", size = 1.5, fill = NA,
                                alpha = NA, tintshade=0.5
                              ),
                              setup_data = function(data, params){
                                assign("data", data, envir = .GlobalEnv)
                                data$tintshade_group <- data$colour
                                data
                              },
                              draw_panel = function(self, data, panel_params, coord, na.rm = FALSE) {
                                coords <- coord$transform(data, panel_params)
                      # 我觉得不该在这里重新缩放tintshade...
                                full_range <- range(coords$tintshade)
                                coords_rescaled <- tapply(
                                  X = coords$tintshade, INDEX = coords$tintshade_group,
                                  FUN = function(x) scales::rescale(rank(x), full_range)
                                  )
                                coords$tintshade <- unsplit(coords_rescaled, coords$tintshade_group)
                      # 但如果不这么做,缩放会全局应用而非按分组
                                coords$colour <- lighten(coords$colour, amount = (coords$tintshade*2)-1)
                                ggname("geom_point_tintshade",
                                       pointsGrob(
                                         coords$x, coords$y,
                                         pch = coords$shape,
                                         gp = gg_par(
                                           col = alpha(coords$colour, coords$alpha),
                                           fill = fill_alpha(coords$fill, coords$alpha),
                                           pointsize = coords$size
                                         )
                                       )
                                )
                              },
                              draw_key = function(self, ...) draw_key_point(...)
)
scale_tintshade_discrete <- function(name = waiver(), ..., range = c(0.2, 0.8)) {
  discrete_scale(
    aesthetics="tintshade", name = name, ...,
    palette = function(n) seq(range[1], range[2], length.out = n)
  )
}
metab_data <- data.frame(
  metab=rep(c("Alanine", "Threonine", "Glycine", "GBT", "Proline betaine",
              "Carnitine", "DMSP", "DMS-Ac", "Isethionate"), 3),
  metab_group=rep(rep(c("Amino acid", "Betaine", "Sulfur"), each=3), 3),
  tripl=rep(c("A", "B", "C"), each=9),
  area=runif(27)
)
ggplot(metab_data) +
  aes(x = tripl, y = area, color = metab_group, tintshade = metab) +
  geom_point_tintshade(size=4)

展示颜色分组及组内明暗调整的散点图

理想情况下,我希望省去setup_data中添加tintshade_group列的步骤,让非位置缩放系统自动完成分组缩放(因为tintshade_group只是colour列的重命名,用于避免全局缩放),而非在draw_panel内手动计算。但我无法找到让ggplot识别需按分组缩放而非全局映射的方法。

当前coords数据(重缩放前)如下:

colour tintshade      x         y PANEL group tintshade_group shape size fill alpha
1 #F8766D     0.200 0.1875 0.5387449     1     1      Amino acid    19    4   NA    NA
2 #F8766D     0.800 0.1875 0.6519035     1     3      Amino acid    19    4   NA    NA
3 #F8766D     0.575 0.1875 0.9545455     1     2      Amino acid    19    4   NA    NA
4 #00BA38     0.500 0.1875 0.6811014     1     5         Betaine    19    4   NA    NA
5 #00BA38     0.725 0.1875 0.2865486     1     6         Betaine    19    4   NA    NA
6 #00BA38     0.275 0.1875 0.3901051     1     4         Betaine    19    4   NA    NA

我期望coords的初始输出为(注意tintshade列的数值变化):

colour tintshade      x         y PANEL group tintshade_group shape size fill alpha
1 #F8766D     0.200 0.1875 0.5387449     1     1      Amino acid    19    4   NA    NA
2 #F8766D     0.800 0.1875 0.6519035     1     3      Amino acid    19    4   NA    NA
3 #F8766D     0.500 0.1875 0.9545455     1     2      Amino acid    19    4   NA    NA
4 #00BA38     0.500 0.1875 0.6811014     1     5         Betaine    19    4   NA    NA
5 #00BA38     0.800 0.1875 0.2865486     1     6         Betaine    19    4   NA    NA
6 #00BA38     0.200 0.1875 0.3901051     1     4         Betaine    19    4   NA    NA

是否可通过现有函数实现该需求?或者当前的实现方式是否正确?部分动机在于手动处理会导致图例构建的下游问题(这可能是后续问题)。

内容的提问来源于stack exchange,提问作者Dubukay

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.06.20 14:37:04