Derek Corcoran - 2 years ago 145
R Question

# operation between stat_summary_hex plots made in ggplot2

I have two populations A and B distributed spatially with one character Z, I want to be able to make an hexbin substracting the proportion of the character in each hexbin. Here I have the code for two theoretical populations A and 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) +
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) +
guides(alpha = FALSE, size = FALSE)
``````

here is the two resulting graphs

My goal is to make a third graph with hexbins with the values of the difference between hexbins at the same coordinates but I don't even know how to start to do it, I have done something similar in the raster Package, but I need it as hexbins

Thanks a lot

You need to make sure that both plots use the exact same binning. In order to achieve this, I think it is best to do the binning beforehand and then plot the results with stat_identity / geom_hex. With the variables from your code sample you ca do:

``````## 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, [email protected], FUN = function(z) sum(z)/length(z)),
cid = [email protected])
}

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) +
guides(alpha = FALSE, size = FALSE)

ggplot(Bhex) +
geom_hex(aes(x = x, y = y, fill = z),
stat = "identity", alpha = 0.8) +