library(ggplot2)library(dplyr)
# the African population dataset# install.packages("remotes") # if not already installed# remotes::install_github("afrimapr/afrilearndata") # if fails, try restarting Rlibrary(afrilearndata)
# packages for data cleanuplibrary(raster) library(sp)Visualize African population with Heatmap Using ggplot2
This article visualizes the African population density. The code is adapted from the work of Georgios Karamanis. The dataset is available via the afrilearndata package.
Major techniques covered in this article include:
- Use Google Fonts.
- Create a heatmap.
- Color scale transformation to address high skewness in data distribution.
- Theme customization.
Packages and data cleanup
Make “Paytone One” font available to use in ggplot2. More fonts can be found in Google Fonts.
library(showtext)font_add_google(name = "Paytone One", family = "Paytone One")showtext.auto() # use 'showtext' to draw textPrepare the dataset into desired structure.
afripop_df <- afripop2020 %>% as.data.frame(xy = TRUE) %>% rename(pop = 3) %>% filter(!is.na(pop)) %>% as_tibble()
head(afripop_df, 4)Output:
# A tibble: 4 × 3
x y pop
<dbl> <dbl> <dbl>
1 9.29 37.3 29.3
2 9.46 37.3 31.7
3 9.62 37.3 37.0
4 9.79 37.3 210.
Visualization
Create a heatmap with geom_raster(). Compared with geom_tile() (as used in this awesome example), geom_raster() is a high-performance alternative, and does not draw cell outlines; given the size of the heatmap (a grid of ~92,000 cells), it is a better option.
p1 <- afripop_df %>% ggplot() + geom_raster(aes(x, y, fill = pop)) + coord_fixed(ratio = 1.1)
p1
Due to the very sparse distribution of high-density values (corresponding to the light blue dots), it is very difficult to discern the population distribution pattern by this step.
Adjust the color scale. Use trans = "pseudo_log" to create a nonlinear color scale to preferentially highlight data with high population density.
fff <- function(x){x^.2}
p2 <- p1 + scale_fill_viridis_c(trans = "pseudo_log", option = "G", breaks = c(0, 100, 1000, 5000, 20000), labels = function(x) {paste(x/1000, "K")} )p2
Such math transformation in aesthetic scales is a very efficient approach to unveil the skewed data distribution. It is also often used in the x-axis transform and y-axis transform.
Position the legend at the plot bottom, and adjust its labels and title. A quick way to add superscript is to copy - paste the unicode.
p3 <- p2 + theme_void() + theme(legend.position = "bottom") + # further customize the colorbar legend guides(fill = guide_colorbar( barwidth = unit(200, "pt"), barheight = unit(5, "pt"), title.position = "top", title = "populatin density / km²", title.theme = element_text(hjust = .5, family = "Paytone One")))p3
Add plot title using the annotate way.
p4 <- p3 + annotate(geom = "text", x = -20, y = -10, label = "Africa", size = 11, family = "Paytone One", hjust = 0) p4
Add a warm background as a final touch.
p5 <- p4 + theme(plot.background = element_rect(fill = "cornsilk", color = NA), # increase the margin around the plot plot.margin = margin(b = 20, l = 10, r = 10, t = 10))
p5
Save the plot.
ggsave("Heatmap of African population.pdf", path = "graphics", width = 4.2, height = 5.6)library(ggplot2)library(dplyr)
# the African population dataset# install.packages("remotes") # if not already installed# remotes::install_github("afrimapr/afrilearndata") # if fails, try restarting Rlibrary(afrilearndata)
# packages for data cleanuplibrary(raster) library(sp)
# Load "Paytone One" font from Google Fonts Repository.library(showtext)font_add_google(name = "Paytone One", family = "Paytone One")showtext.auto() # use 'showtext' to draw text
# Data cleanupafripop_df <- afripop2020 %>% as.data.frame(xy = TRUE) %>% rename(pop = 3) %>% filter(!is.na(pop)) %>% as_tibble()
head(afripop_df, 4)
# Create a heatmap base. p1 <- afripop_df %>% ggplot() + geom_raster(aes(x, y, fill = pop)) + coord_fixed(ratio = 1.1) p1
# Adjust color scalep2 <- p1 + scale_fill_viridis_c(trans = "pseudo_log", option = "G", breaks = c(0, 100, 1000, 5000, 20000), labels = function(x) {paste(x/1000, "K")} )p2
# adjust legend. Use unicode for easy input of superscripts. p3 <- p2 + theme_void() + theme(legend.position = "bottom") + # further customize the colorbar legend guides(fill = guide_colorbar( barwidth = unit(200, "pt"), barheight = unit(5, "pt"), title.position = "top", title = "populatin density / km²", title.theme = element_text(hjust = .5, family = "Paytone One")))p3
# Add plot title.p4 <- p3 + annotate(geom = "text", x = -20, y = -10, label = "Africa", size = 11, family = "Paytone One", hjust = 0) p4
# Add a warm background as a final touch.p5 <- p4 + theme(plot.background = element_rect(fill = "cornsilk", color = NA), # increase the margin around the plot plot.margin = margin(b = 20, l = 10, r = 10, t = 10))
p5
# Save the plot.ggsave("Heatmap of African population.pdf", path = "graphics", device = "pdf", width = 4.2, height = 5.6)Continue Exploring — 🚀 one level up!
Check this single heatmap that highlights how vaccination controlled the wide spread of polio disease in the U.S. history; and check this article using functions to automate heatmap creation for eight infectious diseases in the U.S. history (displayed below).
The above heatmaps are drawn using the generic function geom_tile() or geom_raster(). Alternatively, a heatmap can be created using the geom_bin2d() function – check out the following awesome 2D histogram with a world map overlay that visualizes the hurricane activities in North Atlantic Ocean.
