GGPLOT 可以对数据进行 2D 汇总吗？

Question

我希望将反应时间的平均值（或其他函数）绘制为 x y 平面中目标位置的函数。 作为测试数据：

library(ggplot2)
xs <- runif(100,-1,1)
ys <- runif(100,-1,1)
rts <- rnorm(100)
testDF <- data.frame("x"=xs,"y"=ys,"rt"=rts)

我知道我能做到：

p <- ggplot(data = testDF,aes(x=x,y=y))+geom_bin2d(bins=10)

我希望能够做的是同样的事情，但绘制每个 bin 中数据的函数而不是计数。我可以这样做吗？

或者我是否需要先在 R 中生成条件均值（例如 drt <- tapply(testDF$rt,list(cut(testDF$x,10),cut(testDF$y,10)),mean)）然后再绘制？

谢谢。

Answer 1

更新随着 ggplot2 0.9.0 的发布，stat_summary2d 和 stat_summary_bin 的新增功能涵盖了大部分功能。

这里是这个答案的要点：https://gist.github.com/1341218

这里对 stat_bin2d 稍作修改，以便接受任意函数：

StatAggr2d <- proto(Stat, {
  objname <- "aggr2d" 
  default_aes <- function(.) aes(fill = ..value..)
  required_aes <- c("x", "y", "z")
  default_geom <- function(.) GeomRect

  calculate <- function(., data, scales, binwidth = NULL, bins = 30, breaks = NULL, origin = NULL, drop = TRUE, fun = mean, ...) {

    range <- list(
      x = scales$x$output_set(),
      y = scales$y$output_set()
    )

    # Determine binwidth, if omitted
    if (is.null(binwidth)) {
      binwidth <- c(NA, NA)
      if (is.integer(data$x)) {
        binwidth[1] <- 1
      } else {
        binwidth[1] <- diff(range$x) / bins
      }
      if (is.integer(data$y)) {
        binwidth[2] <- 1
      } else {
        binwidth[2] <- diff(range$y) / bins
      }      
    }
    stopifnot(is.numeric(binwidth))
    stopifnot(length(binwidth) == 2)

    # Determine breaks, if omitted
    if (is.null(breaks)) {
      if (is.null(origin)) {
        breaks <- list(
          fullseq(range$x, binwidth[1]),
          fullseq(range$y, binwidth[2])
        )
      } else {
        breaks <- list(
          seq(origin[1], max(range$x) + binwidth[1], binwidth[1]),
          seq(origin[2], max(range$y) + binwidth[2], binwidth[2])
        )
      }
    }
    stopifnot(is.list(breaks))
    stopifnot(length(breaks) == 2)
    stopifnot(all(sapply(breaks, is.numeric)))
    names(breaks) <- c("x", "y")

    xbin <- cut(data$x, sort(breaks$x), include.lowest=TRUE)
    ybin <- cut(data$y, sort(breaks$y), include.lowest=TRUE)

    if (is.null(data$weight)) data$weight <- 1
    ans <- ddply(data.frame(data, xbin, ybin), .(xbin, ybin), function(d) data.frame(value = fun(d$z)))

    within(ans,{
      xint <- as.numeric(xbin)
      xmin <- breaks$x[xint]
      xmax <- breaks$x[xint + 1]

      yint <- as.numeric(ybin)
      ymin <- breaks$y[yint]
      ymax <- breaks$y[yint + 1]
    })
  }
})

stat_aggr2d <- StatAggr2d$build_accessor()

及用法：

ggplot(data = testDF,aes(x=x,y=y, z=rts))+stat_aggr2d(bins=3)
ggplot(data = testDF,aes(x=x,y=y, z=rts))+
  stat_aggr2d(bins=3, fun = function(x) sum(x^2))

同样，这里对 stat_binhex 稍作修改：

StatAggrhex <- proto(Stat, {
  objname <- "aggrhex"

  default_aes <- function(.) aes(fill = ..value..)
  required_aes <- c("x", "y", "z")
  default_geom <- function(.) GeomHex

  calculate <- function(., data, scales, binwidth = NULL, bins = 30, na.rm = FALSE, fun = mean, ...) {
    try_require("hexbin")
    data <- remove_missing(data, na.rm, c("x", "y"), name="stat_hexbin")

    if (is.null(binwidth)) {
      binwidth <- c( 
        diff(scales$x$input_set()) / bins,
        diff(scales$y$input_set() ) / bins
      )
    }

    try_require("hexbin")

    x <- data$x
    y <- data$y

    # Convert binwidths into bounds + nbins
    xbnds <- c(
      round_any(min(x), binwidth[1], floor) - 1e-6, 
      round_any(max(x), binwidth[1], ceiling) + 1e-6
    )
    xbins <- diff(xbnds) / binwidth[1]

    ybnds <- c(
      round_any(min(y), binwidth[1], floor) - 1e-6, 
      round_any(max(y), binwidth[2], ceiling) + 1e-6
    )
    ybins <- diff(ybnds) / binwidth[2]

    # Call hexbin
    hb <- hexbin(
      x, xbnds = xbnds, xbins = xbins,  
      y, ybnds = ybnds, shape = ybins / xbins,
      IDs = TRUE
    )
    value <- tapply(data$z, hb@cID, fun)

    # Convert to data frame
    data.frame(hcell2xy(hb), value)
  }


})

stat_aggrhex <- StatAggrhex$build_accessor()

及用法：

ggplot(data = testDF,aes(x=x,y=y, z=rts))+stat_aggrhex(bins=3)
ggplot(data = testDF,aes(x=x,y=y, z=rts))+
  stat_aggrhex(bins=3, fun = function(x) sum(x^2))

Answer 2

事实证明这比我预期的要难。

您可以几乎通过提供weights 美学来欺骗 ggplot 这样做，但这只会为您提供 bin 中权重的总和，而不是平均值（并且您必须指定drop=FALSE 保留负 bin 值）。您还可以检索箱内的计数或密度，但这些都不能真正解决问题。

这就是我最终得到的结果：

## breaks vector (slightly coarser than the 10x10 spec above;
##   even 64 bins is a lot for binning only 100 points)
bvec <- seq(-1,1,by=0.25)  

## helper function
tmpf <- function(x,y,z,FUN=mean,breaks) {
  midfun <- function(x) (head(x,-1)+tail(x,-1))/2
  mids <- list(x=midfun(breaks$x),y=midfun(breaks$y))
  tt <- tapply(z,list(cut(x,breaks$x),cut(y,breaks$y)),FUN)
  mt <- melt(tt)
  ## factor order gets scrambled (argh), reset it
  mt$X1  <- factor(mt$X1,levels=rownames(tt))
  mt$X2  <- factor(mt$X2,levels=colnames(tt))  
  transform(X,
            x=mids$x[mt$X1],
            y=mids$y[mt$X2])
}

ggplot(data=with(testDF,tmpf(x,y,rt,breaks=list(x=bvec,y=bvec))),
       aes(x=x,y=y,fill=value))+
  geom_tile()+
  scale_x_continuous(expand=c(0,0))+   ## expand to fill plot region
  scale_y_continuous(expand=c(0,0))

这假设相等的 bin 宽度等，可以扩展......（据我所知）stat_bin2d 不接受用户指定的函数真的太糟糕了。