如何使用geom_bin2d获取ggplot2中每个单元格的前100个计数

Question

在询问之前，我已经阅读了这个post，但我的更具体。

library(ggplot2)
library(scales)

set.seed(1)
dat <- data.frame(x = rnorm(1000), y = rnorm(1000))

我用dat替换我的真实数据，x和y的域在这个随机种子上是[-4,4]，我将区域划分为256（16 * 16）个单元格，间隔为这是0.5。对于每个单元格，我想得到计数。

是的，这很容易，geom_bin2d可以解决它。

# plot
p <- ggplot(dat, aes(x = x, y = y)) + geom_bin2d() 

# Get data - this includes counts and x,y coordinates 
newdat <- ggplot_build(p)$data[[1]]

# add in text labels
p + geom_text(data=newdat, aes((xmin + xmax)/2, (ymin + ymax)/2, 
                  label=count), col="white")

到目前为止一切顺利，但我只想获得前100名计数并在照片中绘制，如下图所示。

阅读?geom_bin2d后，drop = TRUE仅删除所有0个计数的单元格，而我的关注点是前100个计数。我该怎么办，这是问题1。

请再看一下第二张照片的legend，计数小而关闭，如果它是10,000,20,000,30,000那么。

该方法在trans中使用scale_fill_gradient，build_in函数是exp，log，sqrt等，但我想要除以1,000。然后，我在包trans_new()中找到了scales并试了一下，但却是否定的。

sci_trans <- function(){ trans_new('sci', function(x) x/1000, function(x) x*1000)}
p + scale_fill_gradient(trans='sci')

而且，这是问题2.我搜索了很多，但找不到解决方法，非常感谢帮助我的人，谢谢！

Answer 1

显然，您无法从stat_bin2d或stat_summary_2d获取输出分档或计数;根据一个相关问题：How to use stat_bin2d() to compute counts labels in ggplot2?其中@MrFlick的评论引用了2010年的Hadley：＆＃34;他基本上说你不能使用stat_bin2d，你和＃ 39;我必须自己进行总结＆＃34; 。

所以，解决方法：自己手动创建坐标箱，获取2D计数，然后取上面n。例如，使用dplyr：

dat %>% mutate(x_binned=some_fn(x), y_binned=some_fn(y)) %>%
        group_by(x_binned,y_binned) %>% # maybe can skip this line
        summarize(count = count()) %>% # NOTE: no need to sort() or order()
        top_n(..., 100)

您可能需要戳入stat_bin2d才能复制（或调用）其确切的坐标分箱代码。更新：这里是source for stat-bin2d.r

StatBin2d <- ggproto("StatBin2d", Stat,
  default_aes = aes(fill = ..count..),
  required_aes = c("x", "y"),

  compute_group = function(data, scales, binwidth = NULL, bins = 30,
                           breaks = NULL, origin = NULL, drop = TRUE) {

    origin <- dual_param(origin, list(NULL, NULL))
    binwidth <- dual_param(binwidth, list(NULL, NULL))
    breaks <- dual_param(breaks, list(NULL, NULL))
    bins <- dual_param(bins, list(x = 30, y = 30))

    xbreaks <- bin2d_breaks(scales$x, breaks$x, origin$x, binwidth$x, bins$x)
    ybreaks <- bin2d_breaks(scales$y, breaks$y, origin$y, binwidth$y, bins$y)

    xbin <- cut(data$x, xbreaks, include.lowest = TRUE, labels = FALSE)
    ybin <- cut(data$y, ybreaks, include.lowest = TRUE, labels = FALSE)

    ...

  }

bin2d_breaks <- function(scale, breaks = NULL, origin = NULL, binwidth = NULL,
                      bins = 30, right = TRUE) {
  ...

（但这似乎是对ggplot2的一个有价值的增强请求，如果它还没有提交。）