在ggplot2中制作的stat_summary_hex图之间的操作

Question

我有两个种群A和B在空间上分布有一个字符Z，我希望能够使一个hexbin减去每个hexbin中字符的比例。在这里，我有两个理论群体A和B的代码

library(hexbin)
library(ggplot2)

set.seed(2)
xA <- rnorm(1000)
set.seed(3)
yA <- rnorm(1000)
set.seed(4)
zA <- sample(c(1, 0), 20, replace = TRUE, prob = c(0.2, 0.8))
hbinA <- hexbin(xA, yA, xbins = 40, IDs = TRUE)

A <- data.frame(x = xA, y = yA, z = zA)

set.seed(5)
xB <- rnorm(1000)
set.seed(6)
yB <- rnorm(1000)
set.seed(7)
zB <- sample(c(1, 0), 20, replace = TRUE, prob = c(0.4, 0.6))
hbinB <- hexbin(xB, yB, xbins = 40, IDs = TRUE)

B <- data.frame(x = xB, y = yB, z = zB)


ggplot(A, aes(x, y, z = z)) + stat_summary_hex(fun = function(z) sum(z)/length(z), alpha = 0.8) +
scale_fill_gradientn(colours = c("blue","red")) +
guides(alpha = FALSE, size = FALSE)

ggplot(B, aes(x, y, z = z)) + stat_summary_hex(fun = function(z) sum(z)/length(z), alpha = 0.8) +
scale_fill_gradientn (colours = c("blue","red")) +
guides(alpha = FALSE, size = FALSE)

这是两个结果图

我的目标是使用hexbins创建第三个图形，并且在同一坐标处使用hexbins之间的差值，但我甚至不知道如何开始这样做，我在光栅包中做了类似的事情，但是我需要它作为hexbins

非常感谢

Answer 1

您需要确保两个图使用完全相同的分箱。为了实现这一点，我认为最好事先进行分箱，然后使用stat_identity / geom_hex绘制结果。使用代码示例中的变量，您可以：

## find the bounds for the complete data 
xbnds <- range(c(A$x, B$x))
ybnds <- range(c(A$y, B$y))
nbins <- 30

#  function to make a data.frame for geom_hex that can be used with stat_identity
makeHexData <- function(df) {
 h <- hexbin(df$x, df$y, nbins, xbnds = xbnds, ybnds = ybnds, IDs = TRUE)
 data.frame(hcell2xy(h),
            z = tapply(df$z, h@cID, FUN = function(z) sum(z)/length(z)),
            cid = h@cell)
}

Ahex <- makeHexData(A)
Bhex <- makeHexData(B)

##  not all cells are present in each binning, we need to merge by cellID
byCell <- merge(Ahex, Bhex, by = "cid", all = T)

##  when calculating the difference empty cells should count as 0
byCell$z.x[is.na(byCell$z.x)] <- 0
byCell$z.y[is.na(byCell$z.y)] <- 0

##  make a "difference" data.frame
Diff <- data.frame(x = ifelse(is.na(byCell$x.x), byCell$x.y, byCell$x.x),
                   y = ifelse(is.na(byCell$y.x), byCell$y.y, byCell$y.x),
                   z = byCell$z.x - byCell$z.y)

##  plot the results

ggplot(Ahex) +
    geom_hex(aes(x = x, y = y, fill = z),
             stat = "identity", alpha = 0.8) +
    scale_fill_gradientn (colours = c("blue","red")) +
    guides(alpha = FALSE, size = FALSE)

ggplot(Bhex) +
    geom_hex(aes(x = x, y = y, fill = z),
             stat = "identity", alpha = 0.8) +
    scale_fill_gradientn (colours = c("blue","red")) +
    guides(alpha = FALSE, size = FALSE)

ggplot(Diff) +
    geom_hex(aes(x = x, y = y, fill = z),
             stat = "identity", alpha = 0.8) +
    scale_fill_gradientn (colours = c("blue","red")) +
    guides(alpha = FALSE, size = FALSE)