Cree barras de color discretas con anchos de intervalo variables y sin espacios entre los niveles de leyenda

ggplot2 colors

Question

Me gustaría reproducir esta escala de colores en ggplot2 : ( Source )

En el pasado, he found que crear escalas de color discretas con etiquetas intermedias en ggplot2 puede ser complicado.

¿Se puede lograr esto en absoluto? Una pregunta similar, pero no completamente idéntica, que he planteado recientemente es this .

Answer 1

Gracias a la respuesta de Tjebo , logré crear una función que traza una buena barra de colores, que se agregará a las parcelas mediante el uso de gráficos de cowplot , cowplot u otros paquetes similares como en su ejemplo.

Aquí está: EDITAR: puedes encontrarlo también en github

plot_discrete_cbar = function(
breaks, # Vector of breaks. If +-Inf are used, triangles will be added to the sides of the color bar
palette = "Greys", # RColorBrewer palette to use
colors = RColorBrewer::brewer.pal(length(breaks) - 1, palette), # Alternatively, manually set colors
direction = 1, # Flip colors? Can be 1 or -1
spacing = "natural", # Spacing between labels. Can be "natural" or "constant"
border_color = NA, # NA = no border color
legend_title = NULL,
legend_direction = "horizontal", # Can be "horizontal" or "vertical"
font_size = 5,
expand_size = 1, # Controls spacing around legend plot
spacing_scaling = 1, # Multiplicative factor for label and legend title spacing
width = 0.1, # Thickness of color bar
triangle_size = 0.1 # Relative width of +-Inf triangles
) {
require(ggplot2)
if (!(spacing %in% c("natural", "constant"))) stop("spacing must be either ''natural'' or ''constant''")
if (!(direction %in% c(1, -1))) stop("direction must be either 1 or -1")
if (!(legend_direction %in% c("horizontal", "vertical"))) stop("legend_direction must be either ''horizontal'' or ''vertical''")
breaks = as.numeric(breaks)
new_breaks = sort(unique(breaks))
if (any(new_breaks != breaks)) warning("Wrong order or duplicated breaks")
breaks = new_breaks
if (class(colors) == "function") colors = colors(length(breaks) - 1)
if (length(colors) != length(breaks) - 1) stop("Number of colors (", length(colors), ") must be equal to number of breaks (", length(breaks), ") minus 1")
if (!missing(colors)) warning("Ignoring RColorBrewer palette ''", palette, "'', since colors were passed manually")
if (direction == -1) colors = rev(colors)
inf_breaks = which(is.infinite(breaks))
if (length(inf_breaks) != 0) breaks = breaks[-inf_breaks]
plotcolors = colors
n_breaks = length(breaks)
labels = breaks
if (spacing == "constant") {
breaks = 1:n_breaks
}
r_breaks = range(breaks)
cbar_df = data.frame(stringsAsFactors = FALSE,
y = breaks,
yend = c(breaks[-1], NA),
color = as.character(1:n_breaks)
)[-n_breaks,]
xmin = 1 - width/2
xmax = 1 + width/2
cbar_plot = ggplot(cbar_df, aes(xmin=xmin, xmax = xmax, ymin = y, ymax = yend, fill = factor(color, levels = 1:length(colors)))) +
geom_rect(show.legend = FALSE,
color=border_color)
if (any(inf_breaks == 1)) { # Add < arrow for -Inf
firstv = breaks[1]
polystart = data.frame(
x = c(xmin, xmax, 1),
y = c(rep(firstv, 2), firstv - diff(r_breaks) * triangle_size)
)
plotcolors = plotcolors[-1]
cbar_plot = cbar_plot +
geom_polygon(data=polystart, aes(x=x, y=y),
show.legend = FALSE,
inherit.aes = FALSE,
fill = colors[1],
color=border_color)
}
if (any(inf_breaks > 1)) { # Add > arrow for +Inf
lastv = breaks[n_breaks]
polyend = data.frame(
x = c(xmin, xmax, 1),
y = c(rep(lastv, 2), lastv + diff(r_breaks) * triangle_size)
)
plotcolors = plotcolors[-length(plotcolors)]
cbar_plot = cbar_plot +
geom_polygon(data=polyend, aes(x=x, y=y),
show.legend = FALSE,
inherit.aes = FALSE,
fill = colors[length(colors)],
color=border_color)
}
if (legend_direction == "horizontal") { #horizontal legend
mul = 1
x = xmin
xend = xmax
cbar_plot = cbar_plot + coord_flip()
angle = 0
legend_position = xmax + 0.1 * spacing_scaling
} else { # vertical legend
mul = -1
x = xmax
xend = xmin
angle = -90
legend_position = xmax + 0.2 * spacing_scaling
}
cbar_plot = cbar_plot +
geom_segment(data=data.frame(y = breaks, yend = breaks),
aes(y=y, yend=yend),
x = x - 0.05 * mul * spacing_scaling, xend = xend,
inherit.aes = FALSE) +
annotate(geom = ''text'', x = x - 0.1 * mul * spacing_scaling, y = breaks,
label = labels,
size = font_size) +
scale_x_continuous(expand = c(expand_size,expand_size)) +
scale_fill_manual(values=plotcolors) +
theme_void()
if (!is.null(legend_title)) { # Add legend title
cbar_plot = cbar_plot +
annotate(geom = ''text'', x = legend_position, y = mean(r_breaks),
label = legend_title,
angle = angle,
size = font_size)
}
cbar_plot
}

Ejemplo de uso:

plot_discrete_cbar(c(1:10))

plot_discrete_cbar(c(0,2,5,10,20, Inf), palette="Reds")

plot_discrete_cbar(c(0,2,5,10,20, Inf), colors=rainbow, legend_direction="vertical", legend_title="A title! WOW!", border_color="red")

plot_discrete_cbar(c(-Inf, -8, -4, -2, -1, 1, 2, 4, 8, Inf), palette="BrBG", legend_title="Precipitation bias (mm/day)")

plot_discrete_cbar(c(-Inf, -8, -4, -2, -1, 1, 2, 4, 8, Inf), palette="BrBG", legend_title="Precipitation bias (mm/day)", spacing="constant")

Answer 2

Inspirado por la respuesta de @Henrik en esta pregunta , una posible solución es hacer un argumento que parezca una leyenda :)

require(ggplot2)
require(cowplot)
values <- c(0,1,2,5,10) # this vector is needed not only for the data frame cbar, but also for plotting
group <- letters[1:5]
diff_values <- c(0, diff(values))
cbar_df <- data.frame(x = 1, y = values, diff_values,group, stringsAsFactors = FALSE)
#that''s for the fake legend
iris2 <- iris #don''t want to mess with your iris data set
#I used iris because you hadn''t provided data
iris2$cuts <- cut(iris2$Petal.Length, values) #the already offered ''cut-approach''
p1 <- ggplot(iris2, aes(Sepal.Length, y = Sepal.Width, color = cuts))+
geom_point() +
scale_color_brewer("", palette = "Reds")
cbar_plot <- ggplot(cbar_df, aes(x, y = diff_values, fill = c(NA, rev(group[2:5])))) +
# I had to do implement this ''fill='' workaround
# in creating a new vector introducing an NA,
# and I had to flip the fills in order to fit to the scale...
geom_col(width = 0.1, show.legend = FALSE) +
geom_segment(y = values, yend = values, x = 0.9, xend = 1.05) +
annotate(geom = ''text'', x = 0.85, y = values, label = values) +
# the numbers are quasi-randomly chosen but define the length of your ticks, obviously
scale_x_continuous(expand = c(1,1)) +
# you might need to play around with the expand argument for the width of your legend
scale_fill_brewer("", palette = "Reds", direction = -1) +
# don''t know why you have to flip this again...
coord_flip() +
theme_void()
plot_grid(p1, cbar_plot, nrow = 2)

Quiero decir, ciertamente hay mucho margen de mejora (hacer que la trama de leyenda sea más pequeña, etc.). Pero ¿qué piensas?

#P.S.
sessionInfo()
cowplot_0.9.2 ggplot2_2.2.1

Answer 3

Puedes probar. Para la primera respuesta ver también here

# data
set.seed(1324)
dat <- data.frame(x=0:100, y=runif(101, 0, 10), z=seq(0, 12, len=101))
# add discrete values
dat$col <- cut(include.lowest = T,
dat$z,
breaks=c(0, 2, 4, 6, 8, max(dat$z)),
labels=c(2, 4, 6, 8, 10)
)
# Discete
ggplot(dat, aes(x,y,fill=col)) +
geom_point(aes(col=col),size=8, show.legend = F) +
geom_col(alpha=0)+
scale_fill_brewer("", palette = "Reds")+
scale_colour_brewer("", palette="Reds")+
scale_alpha_discrete(range=c(0,1))+
guides(fill = guide_legend(nrow=1,override.aes = list(alpha = 1),
label.position="bottom",
label.hjust = -0.05)) +
theme(legend.position="bottom",
legend.key.width = unit(3, "cm"),
legend.key.height = unit(1, "cm"))

# Continuous
ggplot(dat, aes(x,y,color=y)) +
geom_point(size=8) +
scale_colour_continuous("",limits=c(0,10),
breaks=c(0, 2, 4, 6, 8, 10),low = "white", high = "red")+
theme(legend.position="bottom",
legend.key.width = unit(3, "cm"),
legend.key.height = unit(1, "cm"))