r - 编写ggplot自定义几何函数

Question

我正在编写一个函数来创建 ggplot 的散点图，其中点的大小表示具有相同 X 和 Y 坐标的点的数量。

我有一个有效的功能：

require(dplyr)
plot_size_bubbles <- function(x,y) {
  dd = data.frame(x,y) %>%
    group_by(x,y) %>%
    summarise(n=n()) %>%
    ungroup()
  ggplot(dd, aes(x,y)) + geom_point(aes(size=n))
}

X = sample(1:3,10,replace = T)
Y = sample(1:3,10,replace = T)
plot_size_bubbles(X,Y)

我想把它做成 ggplot 的风格，作为从 geom_point 继承的自定义几何函数。也许我可以使用一些统计功能，不确定。基本上我想将一个数据框传递给 ggplot，映射 x 和 y，并在不事先计算点大小的情况下创建这个图。像

ggplot(data.frame(X,Y), aes(X,Y)) + geom_sizebubble()

此外，从原始数据框中获得 x 和 y 轴标签会很棒。

希望这是可能的，我只是错过了一些东西。

Answer 1

stat_accum <- function(mapping = NULL, data = NULL,
                         geom = "point", position = "stack",
                         ...,
                         show.legend = NA,
                         inherit.aes = TRUE) {

  layer(
    data = data,
    mapping = mapping,
    stat = StatAccum,
    geom = geom,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      ...
    )
  )
}

StatAccum <- ggproto("StatAccum", Stat,
  compute_layer = function(data, scales, params) {
    odat <- dplyr::distinct(data, x, y, .keep_all=TRUE)
    data <- dplyr::count(data, x, y)
    data <- dplyr::left_join(data, odat, by=c("x", "y"))
    data$size <- data$n
    data$n <- NULL
    data
 }
)

set.seed(12)
dplyr::data_frame(
  X = sample(1:5, 100, replace = TRUE),
  Y = sample(1:5, 100, replace = TRUE)
) -> xdf

ggplot(xdf, aes(X, Y)) + geom_point()

ggplot(xdf, aes(X, Y)) + geom_point(stat="accum")