Consistent hexagon sizes and legend for manually a

This is a continuation of a question I recently asked (Manually assigning colors with scale_fill_manual only works for certain hexagon sizes).

I was unable to plot geom_hex() so that all hexagons were the same size. Someone solved the problem. However, their solution removed the legend key. Now, I am unable to keep all the hexagons the same size while also retaining the legend.

To be specific, I really want to keep the legend labels sensical. In the example below, the legend has values (0,2,4,6,8,20), rather than hexadecimal labels (#08306B, #08519C, etc).

Below is MWE illustrating the problem. At the end, as per the 3 comments, you can see that I am able to 1) Create a plot with consistent hexagon sizes but no legend, 2) Create a plot with legend, but inconsistent hexagon sizes, 3) Attempt to create a plot with consistent hexagon sizes and legend but fail:

library(ggplot2)
library(hexbin)
library(RColorBrewer)
library(reshape)

set.seed(1)
xbins <- 10

x <- abs(rnorm(10000))
y <- abs(rnorm(10000))
minVal <- min(x, y)
maxVal <- max(x, y)
maxRange <- c(minVal, maxVal)
buffer <- (maxRange[2] - maxRange[1]) / (xbins / 2)
bindata = data.frame(x=x,y=y,factor=as.factor(1))

h <- hexbin(bindata, xbins = xbins, IDs = TRUE, xbnds = maxRange, ybnds = maxRange)

counts <- hexTapply (h, bindata$factor, table)
counts <- t (simplify2array (counts))
counts <- melt (counts)
colnames (counts)  <- c ("factor", "ID", "counts")
counts$factor =as.factor(counts$factor)

hexdf <- data.frame (hcell2xy (h),  ID = h@cell)
hexdf <- merge (counts, hexdf)

my_breaks <- c(2, 4, 6, 8, 20, 1000)
clrs <- brewer.pal(length(my_breaks) + 3, "Blues")
clrs <- clrs[3:length(clrs)]
hexdf$countColor <- cut(hexdf$counts, breaks = c(0, my_breaks, Inf), labels = rev(clrs))

# Has consistent hexagon sizes, but no legend
ggplot(hexdf, aes(x=x, y=y, hexID=ID, counts=counts, fill=countColor)) + geom_hex(stat="identity", fill=hexdf$countColor) + scale_fill_manual(labels = as.character(c(0, my_breaks)), values = rev(clrs), name = "Count") + geom_abline(intercept = 0, color = "red", size = 0.25) + labs(x = "A", y = "C") + coord_fixed(xlim = c(-0.5, (maxRange[2]+buffer)), ylim = c(-0.5, (maxRange[2]+buffer))) + theme(aspect.ratio=1)

# Has legend, but inconsistent hexagon sizes
ggplot(hexdf, aes(x=x, y=y, hexID=ID, counts=counts, fill=countColor)) + geom_hex(data=hexdf, stat="identity", aes(fill=countColor)) + scale_fill_manual(labels = as.character(c(0, my_breaks)), values = rev(clrs), name = "Count") + geom_abline(intercept = 0, color = "red", size = 0.25) + labs(x = "A", y = "C") + coord_fixed(xlim = c(-0.5, (maxRange[2]+buffer)), ylim = c(-0.5, (maxRange[2]+buffer))) + theme(aspect.ratio=1)

# One attempt to create consistent hexagon sizes and retain legend
ggplot(hexdf, aes(x=x, y=y, hexID=ID, counts=counts, fill=countColor)) + geom_hex(data=hexdf, aes(fill=countColor)) + geom_hex(stat="identity", fill=hexdf$countColor) +  scale_fill_manual(labels = as.character(c(0, my_breaks)), values = rev(clrs), name = "Count") + geom_abline(intercept = 0, color = "red", size = 0.25) + labs(x = "A", y = "C") + coord_fixed(xlim = c(-0.5, (maxRange[2]+buffer)), ylim = c(-0.5, (maxRange[2]+buffer))) + theme(aspect.ratio=1)

Any suggestions on how to keep the hexagon sizes consistent while retaining the legend would be very helpful!

Wow, this is an interesting one -- geom_hex seems to really dislike mapping color/fill onto categorical variables. I assume that's because it is designed to be a two-dimensional histogram and visualize continuous summary statistics, but if anyone has any insight into what's going on behind the scenes, I would love to know.

For your specific problem, that really throws a wrench in the works, because you're attempting to have categorical colorization that assigns non-linear groups to the individual hexagons. Conceptually, you might consider why you're doing that. There may be a good reason, but you're essentially taking a linear color gradient and mapping it non-linearly onto your data, which can end up being visually misleading.

However, if that is what you want to do, the best approach I could come up with was to create a new continuous variable that mapped linearly onto your chosen colors and then use those to create a color gradient. Let me try to walk you through my thought process.

You essentially have a continuous variable (counts) that you want to map onto colors. That's easy enough with a simple color gradient, which is the default in ggplot2 for continuous variables. Using your data:

ggplot(hexdf, aes(x=x, y=y)) +
  geom_hex(stat="identity", aes(fill=counts))

yields something close.

However, the bins with really high counts wash out the gradient for points with much lower counts, so we need to change the way the gradient maps colors onto values. You've already declared the colors you want to use in the clrs variable; we just need to add a column to your data frame to use in conjunction with these colors to create a smooth gradient. I did that as follows:

all_breaks <- c(0, my_breaks)
breaks_n <- 1:length(all_breaks)
get_break_n <- function(n) {
  break_idx <- max(which((all_breaks - n) < 0))
  breaks_n[break_idx]
}
hexdf$bin <- sapply(hexdf$counts, get_break_n)

We create the bin variable as the index of the break that is nearest the count variable without exceeding it. Now, you'll notice that:

ggplot(hexdf, aes(x=x, y=y)) +
  geom_hex(stat="identity", aes(fill=bin))

is getting much closer to the goal.

The next step is to change how the color gradient maps onto that bin variable, which we can do by adding a call to scale_fill_gradientn:

ggplot(hexdf, aes(x=x, y=y)) +
  geom_hex(stat="identity", aes(fill=bin)) +
  scale_fill_gradientn(colors=rev(clrs[-1])) # odd color reversal to
                                             # match OP's color mapping

This takes a vector of colors between which you want to interpolate a gradient. The way we've set it up, the points along the interpolation will perfectly match up with the unique values of the bin variable, meaning each value will get one of the colors specified.

Now we're cooking with gas, and the only thing left to do is add the various bells and whistles from the original graph. Most importantly, we need to make the legend look the way we want. This requires three things: (1) changing it from the default color bar to a discretized legend, (2) specifying our own custom labels, and (3) giving it an informative title.

# create the custom labels for the legend
all_break_labs <- as.character(all_breaks[1:(length(allb)-1)])

ggplot(hexdf, aes(x=x, y=y)) +
  geom_hex(stat="identity", aes(fill=bin)) +
  scale_fill_gradientn(colors=rev(clrs[-1]),
                       guide="legend",        # (1) make legend discrete
                       labels=all_break_labs, # (2) specify labels
                       name="Count") +        # (3) legend title
  # All the other prettification from the OP
  geom_abline(intercept = 0, color = "red", size = 0.25) +
  labs(x = "A", y = "C") +
  coord_fixed(xlim = c(-0.5, (maxRange[2]+buffer)),
              ylim = c(-0.5, (maxRange[2]+buffer))) +
  theme(aspect.ratio=1)

All of this leaves us with the following graph:

Hopefully that helps you out. For completeness, here's the new code in full:

# ... the rest of your code before the plots
clrs <- clrs[3:length(clrs)]
hexdf$countColor <- cut(hexdf$counts,
                        breaks = c(0, my_breaks, Inf),
                        labels = rev(clrs))

### START OF NEW CODE ###

# create new bin variable
all_breaks <- c(0, my_breaks)
breaks_n <- 1:length(all_breaks)
get_break_n <- function(n) {
  break_idx <- max(which((all_breaks - n) < 0))
  breaks_n[break_idx]
}
hexdf$bin <- sapply(hexdf$counts, get_break_n)

# create legend labels
all_break_labs <- as.character(all_breaks[1:(length(all_breaks)-1)])

# create final plot
ggplot(hexdf, aes(x=x, y=y)) +
  geom_hex(stat="identity", aes(fill=bin)) +
  scale_fill_gradientn(colors=rev(clrs[-1]),
                       guide="legend",
                       labels=all_break_labs,
                       name="Count") +
  geom_abline(intercept = 0, color = "red", size = 0.25) +
  labs(x = "A", y = "C") +
  coord_fixed(xlim = c(-0.5, (maxRange[2]+buffer)),
              ylim = c(-0.5, (maxRange[2]+buffer))) +
  theme(aspect.ratio=1)