2

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:

enter image description here

Example of legend with breaks:

example of legend with breaks

Tung
  • 26,371
  • 7
  • 91
  • 115
Cecile
  • 527
  • 5
  • 22

1 Answers1

4

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)

Tung
  • 26,371
  • 7
  • 91
  • 115
  • 1
    Thank you very much for that! Very useful. I was also planning on labeling each of the categories (e.g. call the yellow values "A", the green ones "B", etc.) but it looks quite hard to do so with the code you shared, right? – Cecile Oct 19 '18 at 06:03
  • 1
    I guess you can modify the `plot_discrete_cbar` function and manually add the text labels using `annotate` similar to how @AF added the title for the discrete colorbar – Tung Oct 19 '18 at 12:32