rggplot2bar-chartgradientgeom-col

Different fill color for negative values in circular barplot


I'm trying to figure out how to do this circular bar plot with blue color for the negative values (i.e. for Russia, Poland, Germany, and China) instead of purples/pinkish. I've been trying to change the colors and breaks, but I can't get it to break at zero.

enter image description here

Reproducible example:

uni_data <- structure(list(from = c("Argentina", "Canada", "China", "Germany", 
"Malawi", "Mexico", "Poland", "Russia", "South Africa", "United Republic of Tanzania", 
"United States", "Zambia"), to = c("Zimbabwe", "Zimbabwe", "Zimbabwe", 
"Zimbabwe", "Zimbabwe", "Zimbabwe", "Zimbabwe", "Zimbabwe", "Zimbabwe", 
"Zimbabwe", "Zimbabwe", "Zimbabwe"), fraction_mean = c(-1.16218764988057, 
0.556848791658583, -0.785724007068475, -0.668776616353553, 2.98715326478044, 
0.632802483886891, -0.952039672216194, -0.275904847337713, 1.91885749928563, 
2.18477200782915, -1.22917889731657, 4.4028142502411), d_long = c(0.124, 
0.2794, 0.2466, 0.0785, 2.8646, 0.202, 0.1153, 0.1238, 0.2247, 
1.6428, 0.1664, 2.3044), mean_exposure = c(0.219336124378027, 
0.964248264036473, -0.833368763174394, -0.520689933363188, 1.45247015618433, 
-1.53268987398912, -1.15713981781644, 0.791178790005572, 0.482041972598713, 
2.02018800214932, 1.40628459671399, 2.61998072810955)), row.names = c(1L, 
5L, 6L, 9L, 14L, 15L, 17L, 19L, 22L, 25L, 26L, 27L), class = "data.frame")

Code (from https://r-graph-gallery.com/web-circular-barplot-with-R-and-ggplot2.html):

plot_uni <- uni_data %>%
  group_by(from) %>%
  summarise(
    sum_length = fraction_mean,
    mean_exposure = mean_exposure,
    delta = d_long
  ) %>%
  mutate(mean_exposure = round(mean_exposure, digits = 0))

plt2 <- ggplot(plot_uni) +
  # Make custom panel grid
  # geom_hline(
  #   aes(yintercept = y), 
  #   data.frame(y = c(0:7) * 1),
  #   color = "lightgrey"
  #) + 
  # Add bars to represent the cumulative track lengths
  # str_wrap(region, 5) wraps the text so each line has at most 5 characters
  # (but it doesn't break long words!)
  geom_col(
    aes(
      x = reorder(str_wrap(from, 5), sum_length),
      y = sum_length,
      fill = delta
    ),
    position = "dodge2",
    show.legend = TRUE,
    alpha = .9
  ) +
  
  # Add dots to represent the mean gain
  geom_point(
    aes(
      x = reorder(str_wrap(from, 5),sum_length),
      y = mean_exposure
    ),
    size = 3,
    color = "gray12"
  ) +
  
  # Lollipop shaft for mean gain per region
  geom_segment(
    aes(
      x = reorder(str_wrap(from, 5), sum_length),
      y = 0,
      xend = reorder(str_wrap(from, 5), sum_length),
      yend = 6
    ),
    linetype = "dashed",
    color = "gray12"
  ) + 
  
  # Make it circular!
  coord_polar() + 
  
  labs(x=" ", y=" ")

plt2

plt3 <- plt2 +
  # Scale y axis so bars don't start in the center
  scale_y_continuous(
    limits = c(-1, 6),
    expand = c(0, 0),
    breaks = c(0,2, 3, 4)
  ) + 
  # New fill and legend title for number of tracks per region
  scale_fill_gradientn(
    "Delta in mm of extreme precipitation (%)",
    colours = c("#F8B195","#F67280","#C06C84","#6C5B7B")
  ) +
  # Make the guide for the fill discrete
  guides(
    fill = guide_colorsteps(
      barwidth = 20, barheight = .5, title.position = "top", title.hjust = .5)
  ) +
  theme(
    # Remove axis ticks and text
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    axis.text.y = element_blank(),
    # Use gray text for the region names
    axis.text.x = element_text(color = "gray12", size = 10),
    # Move the legend to the bottom
    legend.position = "bottom",
  )

plt3

Solution

  • The main idea for this has been addressed before in multiple threads (e.g. ggplot2 positive and negative values different color gradient). But here, we need to take a couple of extra steps to achieve that.

    First, since your fill colors are based on column delta and you want to have a different color for bars that have negative y values (i.e. sum_length), we need to modify delta to reflect that. So I changed delta to be equal to abs(d_long) * sign(sum_length).

    Then, we can use the same idea from the link above, and define our colors for negative and positive values. We define our colors (colours = c("#073763", "#0A75AD","white", "#F67280", "#6C5B7B")), and then tell ggplot to use them for our desired range (values=rescale(c(min(plot_uni$delta), 0-.Machine$double.eps, 0, 0+.Machine$double.eps, max(plot_uni$delta)))). Basically we use shades of blue for anything from minimum of our delta to slightly less than 0, white for 0, and shades of pink and purple for positive values up to maximum of delta.

    I have also extended the limits and the segment to show every data point, and adjusted the theme to make the plot look cleaner.

    library(tidyverse)
    library(scales)
    
    uni_data %>%
      group_by(from) %>%
      summarise(sum_length = fraction_mean,
                mean_exposure = mean_exposure,
                delta = abs(d_long) * sign(sum_length)) %>%
      mutate(mean_exposure = round(mean_exposure, digits = 0)) -> plot_uni
    
    ggplot(plot_uni) +
      geom_col(aes(x = reorder(str_wrap(from, 5), sum_length), 
                   y = sum_length,
                   fill = delta),
        position = "dodge2", show.legend = TRUE, alpha = .9) +
      geom_point(aes(x = reorder(str_wrap(from, 5),sum_length),
                     y = mean_exposure),
                 size = 3, color = "gray12") +
      geom_segment(aes(x = reorder(str_wrap(from, 5), sum_length),
                       y = -3,
                       xend = reorder(str_wrap(from, 5), sum_length),
                       yend = 6),
                   linetype = "dashed", color = "gray12") + 
      coord_polar() + 
      labs(x=" ", y=" ") +
    
      scale_y_continuous(limits = c(-4, 6), expand = c(0, 0)) + 
      scale_fill_gradientn("Delta in mm of extreme precipitation (%)",
                           colours = c("#073763", "#0A75AD","white", "#F67280", "#6C5B7B"),
                           values=rescale(c(min(plot_uni$delta), 
                                                    0-.Machine$double.eps, 
                                                    0, 
                                                    0+.Machine$double.eps, 
                                                    max(plot_uni$delta)))) +
      guides(fill = guide_colorsteps(barwidth = 20, barheight = .5, 
                                     title.position = "top", title.hjust = .5)) +
      theme_minimal() +
      theme(axis.title = element_blank(),
            axis.ticks = element_blank(),
            axis.text.y = element_blank(),
            axis.text.x = element_text(color = "gray12", size = 10),
            line = element_blank(),
            legend.position = "bottom")
    

    Created on 2023-11-14 with reprex v2.0.2