R 一致的六边形尺寸和图例，用于手动分配颜色

这是我最近问的一个问题的延续（）

我无法绘制geom_hex（），因此所有六边形的大小都相同。有人解决了这个问题。但是，他们的解决方案删除了图例键。现在，我无法在保留图例的同时保持所有六边形的大小相同

具体地说，我真的想让图例标签保持感性。在下面的示例中，图例具有值（0,2,4,6,8,20），而不是十六进制标签（08306B、08519C等）

下面是MWE对问题的说明。最后，根据3条注释，您可以看到我能够1）创建具有一致六边形大小但没有图例的绘图，2）创建具有图例但六边形大小不一致的绘图，3）尝试创建具有一致六边形大小和图例的绘图，但失败：

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)

库（ggplot2）
图书馆（合宾）
图书馆（RColorBrewer）
图书馆（重塑）
种子（1）
xbinsWow，这是一个有趣的例子--
geom_hex
似乎真的不喜欢将颜色/填充映射到分类变量上。我想这是因为它被设计成一个二维柱状图，并将连续摘要统计数据可视化，但是如果有人对幕后发生的事情有任何见解，我很想知道

对于您的特定问题，这确实是一个难题，因为您正在尝试使用分类着色，将非线性组分配给各个六边形。从概念上讲，你可能会考虑为什么要这么做。这可能有一个很好的理由，但实际上你是在采用线性的颜色渐变，并将其非线性地映射到你的数据上，这可能会导致视觉上的误导

然而，如果这就是你想要做的，我能想到的最好的方法是创建一个新的连续变量，它线性映射到你选择的颜色上，然后使用这些来创建颜色渐变。让我试着让你了解我的思考过程

基本上，您有一个连续变量（
计数
），要映射到颜色上。使用简单的颜色渐变非常简单，这是ggplot2中连续变量的默认设置。使用您的数据：

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

结果很接近


但是，计数非常高的容器会清除计数非常低的点的渐变，因此我们需要更改渐变将颜色映射到值的方式。您已经在
clrs
变量中声明了要使用的颜色；我们只需要在数据框中添加一列，与这些颜色一起使用，以创建平滑的渐变。我是这样做的：

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)

离目标越来越近了


下一步是更改颜色渐变如何映射到该
bin
变量，我们可以通过添加以下调用来实现：

这将获取一个要在其之间插值渐变的颜色向量。按照我们的设置方式，沿插值的点将与
bin
变量的唯一值完美匹配，这意味着每个值将获得一种指定的颜色


现在我们正在用煤气做饭，唯一要做的就是添加原始图表中的各种铃声和口哨声。最重要的是，我们需要让传奇看起来像我们想要的那样。这需要三件事：（1）将其从默认颜色栏更改为离散化图例，（2）指定我们自己的自定义标签，以及（3）为其提供信息标题

# 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)

#为图例创建自定义标签
所有实验室感谢您提供的精彩而详细的解决方案！是的，你说得对。实际上，我正在更改图例的标签以显示连续性。在这种情况下，所有的实验室都将是：“0-2”、“2-4”、“4-6”、“6-8”、“8-20”、“20+”，鉴于您非常详细的解决方案只获得了3票赞成票，我想在这里补充我的感谢。非常感谢。
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

# 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)

# ... 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)