如何基于参数化geom_polygon创建自定义ggplot2 ggproto对象？

要将你现有的参数化形状生成函数转换为可复用的自定义geom，核心思路是基于ggplot的ggproto系统，继承已有几何对象（比如GeomPolygon）的绘制逻辑，同时嵌入你的形状生成逻辑。以下是具体实现方案：

1. 确认现有形状生成函数的结构 #

假设你已有的函数是类似这样的（如果你的函数参数不同，后续代码只需对应调整）：

# 生成圆形数据框的函数
create_circle <- function(x0, y0, r, n = 30) {
  theta <- seq(0, 2*pi, length.out = n)
  data.frame(
    x = x0 + r*cos(theta),
    y = y0 + r*sin(theta)
  )
}

# 生成正方形数据框的函数
create_square <- function(x0, y0, side, n = 4) {
  half_side <- side/2
  data.frame(
    x = c(x0 - half_side, x0 + half_side, x0 + half_side, x0 - half_side),
    y = c(y0 - half_side, y0 - half_side, y0 + half_side, y0 + half_side)
  )
}

2. 自定义圆形Geom #

2.1 定义对外调用的geom_circle函数 #

这个函数是用户调用的入口，负责构建ggplot图层：

geom_circle <- function(mapping = NULL, data = NULL,
                        stat = "identity", position = "identity",
                        ...,
                        x0 = NULL, y0 = NULL, r = NULL,
                        n = 30,
                        na.rm = FALSE,
                        show.legend = NA,
                        inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomCircle,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      x0 = x0,
      y0 = y0,
      r = r,
      n = n,
      na.rm = na.rm,
      ...
    )
  )
}

2.2 实现核心GeomCircle ggproto对象 #

继承GeomPolygon复用其绘制逻辑，重写数据处理逻辑来生成圆形点：

# 辅助函数：处理NULL参数的默认值
`%||%` <- function(a, b) if (!is.null(a)) a else b

GeomCircle <- ggproto("GeomCircle", GeomPolygon,
  # 不需要强制美学映射（可通过参数直接传值）
  required_aes = c(),
  # 设置默认美学样式
  default_aes = aes(colour = "black", fill = NA, size = 0.5, linetype = 1, alpha = NA),
  
  # 预处理数据：生成圆形的多边形点
  setup_data = function(data, params) {
    # 情况1：用户传入了数据框（支持映射多个圆形）
    if (!is.null(data$x0) && !is.null(data$y0) && !is.null(data$r)) {
      data_list <- lapply(split(data, data$group), function(d) {
        circle <- create_circle(
          x0 = d$x0[1],
          y0 = d$y0[1],
          r = d$r[1],
          n = params$n %||% 30
        )
        # 继承原数据的美学属性
        circle$colour <- d$colour[1]
        circle$fill <- d$fill[1]
        circle$size <- d$size[1]
        circle$linetype <- d$linetype[1]
        circle$alpha <- d$alpha[1]
        circle$group <- d$group[1]
        circle
      })
      data <- do.call(rbind, data_list)
    } else {
      # 情况2：用户未传入数据，直接用参数生成单个圆形
      data <- create_circle(
        x0 = params$x0 %||% 0,
        y0 = params$y0 %||% 0,
        r = params$r %||% 1,
        n = params$n %||% 30
      )
      data$group <- 1
    }
    data
  },
  
  # 调用父类的绘制方法完成图形渲染
  draw_panel = function(data, panel_params, coord, na.rm = FALSE) {
    coords <- coord$transform(data, panel_params)
    GeomPolygon$draw_panel(coords, panel_params, coord, na.rm = na.rm)
  }
)

3. 自定义正方形Geom #

按照同样的逻辑实现geom_square：

geom_square <- function(mapping = NULL, data = NULL,
                        stat = "identity", position = "identity",
                        ...,
                        x0 = NULL, y0 = NULL, side = NULL,
                        n = 4,
                        na.rm = FALSE,
                        show.legend = NA,
                        inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomSquare,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      x0 = x0,
      y0 = y0,
      side = side,
      n = n,
      na.rm = na.rm,
      ...
    )
  )
}

GeomSquare <- ggproto("GeomSquare", GeomPolygon,
  required_aes = c(),
  default_aes = aes(colour = "black", fill = NA, size = 0.5, linetype = 1, alpha = NA),
  
  setup_data = function(data, params) {
    if (!is.null(data$x0) && !is.null(data$y0) && !is.null(data$side)) {
      data_list <- lapply(split(data, data$group), function(d) {
        square <- create_square(
          x0 = d$x0[1],
          y0 = d$y0[1],
          side = d$side[1],
          n = params$n %||% 4
        )
        square$colour <- d$colour[1]
        square$fill <- d$fill[1]
        square$size <- d$size[1]
        square$linetype <- d$linetype[1]
        square$alpha <- d$alpha[1]
        square$group <- d$group[1]
        square
      })
      data <- do.call(rbind, data_list)
    } else {
      data <- create_square(
        x0 = params$x0 %||% 0,
        y0 = params$y0 %||% 0,
        side = params$side %||% 2,
        n = params$n %||% 4
      )
      data$group <- 1
    }
    data
  },
  
  draw_panel = function(data, panel_params, coord, na.rm = FALSE) {
    coords <- coord$transform(data, panel_params)
    GeomPolygon$draw_panel(coords, panel_params, coord, na.rm = na.rm)
  }
)

4. 使用示例 #

4.1 直接绘制单个形状 #

ggplot() +
  geom_circle(x0 = 0, y0 = 0, r = 1, fill = "lightblue", alpha = 0.6) +
  geom_square(x0 = 0, y0 = 0, side = 2, colour = "red", linetype = "dashed") +
  coord_fixed() # 保持比例，避免形状变形

4.2 作为背景与其他图层组合 #

ggplot(mtcars, aes(wt, mpg)) +
  geom_point(size = 2) +
  # 添加背景圆形
  geom_circle(x0 = 3, y0 = 20, r = 3, fill = "#ffeb3b", alpha = 0.2) +
  # 添加背景正方形
  geom_square(x0 = 4, y0 = 15, side = 4, fill = "#8bc34a", alpha = 0.1) +
  coord_fixed(ratio = 0.5)

4.3 映射数据生成多个形状 #

circle_data <- data.frame(
  x0 = c(1, 3, 5),
  y0 = c(2, 4, 6),
  r = c(0.5, 0.8, 1),
  fill = c("#f44336", "#2196f3", "#4caf50")
)

ggplot(circle_data) +
  geom_circle(aes(x0 = x0, y0 = y0, r = r, fill = fill), alpha = 0.5) +
  coord_fixed()

内容的提问来源于stack exchange，提问作者rossdrucker9