Tailles hexagonales cohérentes et légende pour l'attribution manuelle des couleurs

Question

Ceci est la suite d'une question que j'ai récemment posée (Manually assigning colors with scale_fill_manual only works for certain hexagon sizes).

Je ne pouvais pas tracer geom_hex() de sorte que tous les hexagones avaient la même taille. Quelqu'un a résolu le problème. Cependant, leur solution a supprimé la clé de légende. Maintenant, je suis incapable de garder tous les hexagones de la même taille tout en conservant la légende.

Pour être précis, je veux vraiment garder les étiquettes légendaires. Dans l'exemple ci-dessous, la légende a des valeurs (0,2,4,6,8,20), plutôt que des étiquettes hexadécimales (# 08306B, # 08519C, etc.). Ci-dessous figure MWE illustrant le problème. À la fin, selon les 3 commentaires, vous pouvez voir que je suis capable de 1) Créer un complot avec des tailles hexagonales cohérentes, mais pas de légende, 2) Créer un complot avec la légende, mais les tailles hexagonales incohérentes, 3) Tentative de créer un parcelle avec des tailles hexagonaux cohérentes et légende, mais ne parviennent:

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) 

Toutes les suggestions sur la façon de garder l'hexagone tailles cohérentes tout en conservant la légende serait très utile!

Answer 1

Wow, c'est intéressant - geom_hex semble ne pas aimer vraiment la couleur de la cartographie/remplissage sur les variables qualitatives. Je suppose que c'est parce qu'il est conçu pour être un histogramme bidimensionnel et visualiser des statistiques récapitulatives continues, mais si quelqu'un a un aperçu de ce qui se passe dans les coulisses, j'aimerais bien le savoir.

Pour votre problème spécifique, cela met vraiment une clé en main, parce que vous essayez d'avoir une colorisation catégorique qui assigne des groupes non-linéaires aux hexagones individuels. Conceptuellement, vous pourriez considérer pourquoi vous faites cela. Il peut y avoir une bonne raison, mais vous utilisez essentiellement un dégradé de couleurs linéaire et vous le mappez de manière non linéaire sur vos données, ce qui peut s'avérer trompeur visuellement. Cependant, si c'est ce que vous voulez faire, la meilleure approche que j'ai pu proposer était de créer une nouvelle variable continue qui correspond linéairement à vos couleurs choisies, puis les utiliser pour créer un dégradé de couleurs. Laissez-moi essayer de vous guider à travers mon processus de pensée.

Vous avez essentiellement une variable continue (counts) que vous souhaitez mapper sur les couleurs. C'est assez facile avec un simple dégradé de couleurs, qui est la valeur par défaut dans ggplot2 pour les variables continues. L'utilisation de vos données:

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

donne quelque chose de proche.

Cependant, les bacs avec des comptes très élevés se lavent le gradient pour les points avec un nombre beaucoup plus bas, donc nous devons changer la façon dont les cartes de gradient couleurs sur les valeurs. Vous avez déjà déclaré les couleurs que vous souhaitez utiliser dans la variable clrs; nous avons juste besoin d'ajouter une colonne à votre trame de données à utiliser en conjonction avec ces couleurs pour créer un dégradé lisse. Je l'ai fait comme suit:

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) 

Nous créons la variable bin comme l'indice de la rupture qui est le plus proche de la variable de comptage sans le dépasser.Maintenant, vous remarquerez que:

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

est de plus en plus proche de l'objectif.

L'étape suivante consiste à changer la façon dont les cartes de gradient de couleur sur cette variable bin, que nous pouvons le faire en ajoutant un appel à 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 

Cela prend un vecteur de couleurs entre que vous voulez interpoler un gradient. De la façon dont nous l'avons configuré, les points le long de l'interpolation correspondront parfaitement aux valeurs uniques de la variable bin, ce qui signifie que chaque valeur recevra l'une des couleurs spécifiées.

Maintenant, nous cuisinons avec du gaz, et la seule chose à faire est d'ajouter les différentes cloches et de sifflets à partir du graphique d'origine. Plus important encore, nous devons faire en sorte que la légende ressemble à ce que nous voulons. Cela nécessite trois choses: (1) passer de la barre de couleur par défaut à une légende discrétisée, (2) spécifier nos propres étiquettes personnalisées, et (3) lui donner un titre informatif.

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

Tout cela nous laisse le graphique suivant:

Espérons que vous aide. Pour être complet, voici le nouveau code dans son intégralité:

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