问题
I'd like to break the legend into categories rather than having a continuous range of colours. Could someone kindly help me for the specific example I am using here? Below is my current trial with colour breaks at 40, 60 and 80. Thank you very much!
library(raster)
library(ggplot2)
library(maptools)
data("wrld_simpl")
#sample raster
r <- raster(ncol=10, nrow=20)
r[] <- 1:ncell(r)
extent(r) <- extent(c(-180, 180, -70, 70))
#plotting
var_df <- as.data.frame(rasterToPoints(r))
p <- ggplot() +
geom_polygon(data = wrld_simpl[wrld_simpl@data$UN!="10",],
aes(x = long, y = lat, group = group),
colour = "black", fill = "grey")
p <- p + geom_raster(data = var_df, aes(x = x, y = y, fill = layer))
p <- p + coord_equal() + theme_bw() +labs(x="", y="")
p <- p + theme(legend.key=element_blank(),
axis.text.y =element_text(size=16),
axis.text.x =element_text(size=16),
legend.text =element_text(size=12),
legend.title=element_text(size=12))
# p <- p + scale_fill_gradientn(colours = rev(terrain.colors(10)))
p <- p + scale_colour_manual(values = c("red", "blue", "green","yellow"),
breaks = c("40", "60", "80", max(var_df$layer)),
labels = c("1-40", "40-60", "60-80", "80+"))
p <- p + geom_polygon(data = wrld_simpl[wrld_simpl@data$UN!="10",],
aes(x = long, y = lat, group = group),
colour = "black", fill = NA)
p
Current continuous legend:
Example of legend with breaks:
回答1:
Here you go. I took the plot_discrete_cbar() function written by @AF7 from here
library(raster)
library(ggplot2)
library(maptools)
# Plot discrete colorbar function
plot_discrete_cbar = function (
# Vector of breaks. If +-Inf are used, triangles will be added to the sides of the color bar
breaks,
palette = "Greys", # RColorBrewer palette to use
# Alternatively, manually set colors
colors = RColorBrewer::brewer.pal(length(breaks) - 1, palette),
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 = NULL,
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)
if(is.null(font_size)) {
print("Legend key font_size not set. Use default value = 5")
font_size <- 5
} else {
print(paste0("font_size = ", font_size))
font_size <- font_size
}
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 = color)) +
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)
}
return(cbar_plot)
}
Cut data into bins for the discrete colorbar
myvalues <- c(seq(0, 200, 40), Inf)
var_df$cuts <- cut(var_df$layer, myvalues, include.lowest = TRUE)
levels(var_df$cuts)
#> [1] "[0,40]" "(40,80]" "(80,120]" "(120,160]" "(160,200]" "(200,Inf]"
Plot the raster
p <- ggplot() +
geom_polygon(data = wrld_simpl[wrld_simpl@data$UN != "10", ],
aes(x = long, y = lat, group = group),
colour = "black", fill = "grey")
p <- p + geom_raster(data = var_df, aes(x = x, y = y, fill = cuts)) # matching cuts & fill
p <- p + coord_equal() + theme_minimal() + labs(x="", y="")
p <- p + theme(legend.key =element_blank(),
axis.text.y =element_text(size=16),
axis.text.x =element_text(size=16),
legend.text =element_text(size=12),
legend.title=element_text(size=12))
p <- p + scale_fill_brewer("Layer", palette = "YlGnBu", drop = FALSE)
p <- p + geom_polygon(data = wrld_simpl[wrld_simpl@data$UN != "10", ],
aes(x = long, y = lat, group = group),
colour = "black", fill = NA)
p <- p + theme(legend.position = "none")
Plot the discrete colorbar
dbar <- plot_discrete_cbar(myvalues,
palette = "YlGnBu",
legend_title = NULL,
spacing = "natural")
# reduce top and bottom margins
p1 <- p + theme(plot.margin = unit(c(10, 10, -35, 10), "pt"))
dbar <- dbar + theme(plot.margin = unit(c(-35, 10, -30, 10), "pt"))
Combine two plots together
# devtools::install_github('baptiste/egg')
library(egg)
ggarrange(p1, dbar, nrow = 2, ncol = 1, heights = c(1, 0.4))
Created on 2018-10-18 by the reprex package (v0.2.1.9000)
来源：https://stackoverflow.com/questions/52885673/discrete-legend-breaks-in-ggplot2