One world | Projects, maps and coding

Introducing geobounds

Thu, 12 Feb 2026 00:00:00 +0100

Easy access to administrative boundaries from geoBoundaries

3 min.

If you’ve ever worked with spatial data in R, this may ring a bell…

Search for boundary data
Figure out which version is “official”
Download a shapefile
Unzip it
Load it
Fix projections
Repeat

While searching for new data sources, I found the excellent geoBoundaries database. However, accessing the data can be tedious since it’s provided as zipped shapefiles, and as any GIS professional knows, shapefiles should die!

Previously, the rgeoboundaries package was on CRAN and allowed access to the geoBoundaries API, but it was archived. So I decided to create my own version, and geobounds was born.

Source code: https://github.com/dieghernan/geobounds
pkgdown website: https://dieghernan.github.io/geobounds/

It connects directly to the excellent geoBoundaries database and returns clean, ready-to-use sf objects with a single function call. No manual downloads and no shapefile handling.

This is how it works.

Installation

geobounds was recently accepted on CRAN, so just install it with:

install.packages("geobounds")

Load the package and other complementary packages:

library(geobounds)
library(sf)
library(ggplot2)
library(dplyr)

Getting administrative levels (ADM)

Administrative level 0 (ADM0) corresponds to countries:

# Panama

gb_get_adm0(country = "Panama") |>
  ggplot() +
  geom_sf(fill = "#072357") +
  labs(caption = "Source: www.geoboundaries.org")

You can also retrieve multiple administrative levels at once. For example:

# Simplified files
gb_get(country = "Panama", adm_lvl = "all", simplified = TRUE) |>
  ggplot() +
  geom_sf(aes(fill = shapeType), color = "grey50", linewidth = 0.1) +
  facet_wrap(vars(shapeType)) +
  scale_fill_viridis_d() +
  labs(
    title = "Administrative levels of Panama",
    fill = "level",
    caption = "Source: www.geoboundaries.org"
  )

Global Composite Boundaries (CGAZ)

When you download individual country files, each country reflects its own view of borders. This results in:

Overlapping boundaries
Geographic gaps
Disputed territories

For clean global visualizations, geoBoundaries provides a Composite Global Administrative Zones (CGAZ) dataset that can be accessed with gb_get_world().

Here’s an example with country-level files:

# Using individual (gb_get_adm) shapefiles
gb_get_adm0(country = c("India", "Pakistan")) |>
  # Disputed area: Kashmir
  ggplot() +
  geom_sf(aes(fill = shapeName), alpha = 0.5) +
  scale_fill_manual(values = c("#FF671F", "#00401A")) +
  labs(
    fill = "Country",
    title = "Map of India & Pakistan",
    subtitle = "Note the overlap in the Kashmir region",
    caption = "Source: www.geoboundaries.org"
  )

And here’s the same comparison using CGAZ with gb_get_world():

gb_get_world(c("India", "Pakistan")) |>
  ggplot() +
  geom_sf(aes(fill = shapeName), alpha = 0.5) +
  scale_fill_manual(values = c("#FF671F", "#00401A")) +
  labs(
    fill = "Country",
    title = "Map of India & Pakistan",
    subtitle = "CGAZ does not overlap",
    caption = "Source: www.geoboundaries.org"
  )

Understanding the data

The geoBoundaries database undergoes rigorous quality assurance, including manual review and hand-digitization of physical maps. This ensures the highest level of spatial accuracy for scientific and academic research.

This precision comes at a cost: some files can be large and take longer to download. For visualization and general mapping, we recommend using simplified datasets by setting simplified = TRUE.

# Different resolutions
norway <- gb_get_adm0("NOR") |>
  mutate(res = "Full resolution")
print(object.size(norway), units = "Mb")
#> 26.5 Mb

norway_simp <- gb_get_adm0(country = "NOR", simplified = TRUE) |>
  mutate(res = "Simplified")
print(object.size(norway_simp), units = "Mb")
#> 1.5 Mb

norway_all <- bind_rows(norway, norway_simp)

# Plot with ggplot2
ggplot(norway_all) +
  geom_sf(fill = "#BA0C2F", color = "#00205B") +
  facet_wrap(vars(res)) +
  theme_minimal() +
  labs(caption = "Source: www.geoboundaries.org")

Caching

Downloaded files are cached locally. That means:

You download once
Re-running your script is fast
Your workflow stays reproducible

You can set the cache directory with:

gb_set_cache_dir("a/path/to/a/folder")

When should you use geobounds?

Use geobounds when:

You need reliable global administrative boundaries
You want reproducible workflows
You prefer code over manual downloads
You’re building maps, dashboards or spatial analyses

geobounds is not alone in this space. Depending on your needs, you might also want to look at:

rnaturalearth

A very popular package to access Natural Earth datasets directly from R. It’s lightweight and great for quick global maps, especially at small scales.

If you need physical layers (rivers, coastlines, elevation) alongside political boundaries, this is often a good choice.

giscoR

If your focus is Europe, giscoR provides direct access to Eurostat GISCO data. It’s particularly useful for NUTS regions and European statistical boundaries.

osmdata

When administrative boundaries are not enough and you need OpenStreetMap features (roads, POIs, land use, etc.), osmdata gives you powerful querying capabilities.

Bottom line

I built geobounds to provide direct access to geoBoundaries products. I hope this package will help you in your GIS journey.

Happy mapping!

Mapping Antarctica

Sat, 25 Oct 2025 00:00:00 +0200

Cool maps from the South Pole

6 min.

Creating maps with R is usually straightforward, but representations that cross the International Date Line or that use polar projections can be tricky.

Different spatial-data providers use different conventions: some break geometries at certain longitudes (for example, cutting the Chukchi Peninsula), while others omit portions of the data. These inconsistencies can produce awkward artifacts near the poles.

In this post I fix the GISCO (European Commission) shapefile for Antarctica and produce clean orthographic maps. I walk through the manual corrections and then create a few example maps.

# Libraries
library(tidyverse)
library(sf)
library(giscoR)
library(ggrepel)
library(rmapshaper)

Fixing the geometry

First, we obtain the GISCO Antarctica polygon and transform it to an orthographic projection centered on the South Pole.

antarct <- gisco_get_countries(year = 2024, resolution = 1, country = "ATA") %>%
  select(NAME = NAME_ENGL) |>
  # Orthographic projection centered on the South Pole
  st_transform(crs = "+proj=ortho +lat_0=-90 +lon_0=0")

ggplot(antarct) +
  geom_sf(fill = "lightblue")

The shapefile contains a visible “lollipop” cut that looks unnatural in an orthographic projection. I correct it manually with these steps:

Identify the polygon that represents the main Antarctic landmass.
Convert that polygon to a sequence of coordinates (points).
Remove the small sequence of points that create the artifact.
Rebuild the polygon from the cleaned coordinates and replace the broken geometry with the corrected one.

We convert polygons to point coordinates and inspect them to find the offending sequence:

# Identify the largest polygon
ant_explode <- antarct |>
  st_cast("POLYGON")

nrow(ant_explode)
#> [1] 778

# Largest polygon

ant_max <- ant_explode[which.max(st_area(ant_explode)), ]

coords <- st_coordinates(ant_max) |>
  as_tibble() |>
  # Add an ID for the points
  mutate(np = row_number())


ggplot(coords, aes(X, Y)) +
  geom_point(size = 0.05, color = "darkblue") +
  geom_text(aes(label = np), check_overlap = TRUE) +
  coord_equal()

From the plotted indices, we can see the problematic points fall roughly in the range 8200–9200. We inspect that interval in detail to select the exact indices to remove.

test <- coords |>
  filter(np %in% seq(8200, 9200))

test |>
  ggplot(aes(X, Y)) +
  geom_point(size = 0.05, color = "darkblue") +
  geom_text(aes(label = np), check_overlap = TRUE)

Note: This cleaning is tailored to this specific shapefile and may need to be repeated for other shapefiles. The approach is straightforward but depends on the particular geometry and projection.

# Final solution after some iterations...

test |>
  filter(np %in% seq(8289, 9130)) |>
  ggplot(aes(X, Y)) +
  geom_point(color = "darkblue") +
  labs(title = "To remove")


test |>
  filter(!np %in% seq(8289, 9130)) |>
  ggplot(aes(X, Y)) +
  geom_point(color = "darkblue") +
  labs(title = "To keep")

After removing the offending points, we rebuild the polygon and reconstitute the full Antarctica shape from the corrected piece plus the remaining polygons.

# From coordinates to polygon
newpol <- coords |>
  as.data.frame() |>
  filter(!np %in% seq(8289, 9130)) |> # Removing offending points
  select(X, Y) |>
  as.matrix() |>
  list() |>
  st_polygon() |>
  st_sfc() |>
  st_set_crs(st_crs(ant_max))

ant_max_fixed <- st_sf(st_drop_geometry(ant_max), geometry = newpol)

# Regenerate initial shape
antarctica_fixed <- bind_rows(
  ant_max_fixed,
  ant_explode[-which.max(st_area(ant_explode)), ]
) |>
  group_by(NAME) |>
  summarise(m = 1) |>
  select(-m) |>
  st_make_valid()

antarctica_fixed
#> Simple feature collection with 1 feature and 1 field
#> Geometry type: MULTIPOLYGON
#> Dimension:     XY
#> Bounding box:  xmin: -2583099 ymin: -2458296 xmax: 2690846 ymax: 2233395
#> Projected CRS: +proj=ortho +lat_0=-90 +lon_0=0
#> # A tibble: 1 × 2
#>   NAME                                                                     geometry
#> *                                                           
#> 1 Antarctica (((-2456385 1179033, -2456141 1178965, -2456464 1178341, -2456563 117…

ggplot(antarctica_fixed) +
  geom_sf(fill = "lightblue")

Plotting examples

With the corrected shape we can produce maps. Below are a few examples based on proposed Antarctic flag designs.

Graham Bartram’s proposal (1996)

A simple rendition of Bartram’s original concept:

bbox <- st_bbox(antarctica_fixed) # For limits on the panel

antarctica_fixed |>
  ggplot() +
  geom_sf(fill = "white", color = NA) +
  theme(
    panel.background = element_rect(fill = "#009fdc"),
    panel.grid = element_blank(),
    axis.text = element_blank(),
    axis.ticks = element_blank()
  ) +
  labs(title = "Graham Bartram's proposal") +
  coord_sf(
    xlim = c(bbox[c(1, 3)]) * 1.8,
    ylim = c(bbox[c(2, 4)]) * 1.4
  )

Emblem of the Antarctic Treaty

This example uses graticules to create a concentric “bullseye” pattern around Antarctica. Generating such graticules and merging meridians requires a few extra steps to avoid small gaps near the pole.

# Need graticules
grats <- giscoR::gisco_get_countries() |>
  st_transform(st_crs(antarctica_fixed)) |>
  # Specify the cuts of the graticules
  st_graticule(
    lat = c(-80, -70, -60),
    lon = seq(-180, 180, 30),
    ndiscr = 10000,
    margin = 0.000001
  )


ggplot(grats) +
  geom_sf(color = "darkblue")

We merge meridians so the area around the South Pole is filled. st_graticule() can leave a tiny hole at the pole, and we fix this by joining complementary meridians.

# Merge meridians
merid <- lapply(seq(-180, 0, 30), function(x) {
  df <- grats |>
    filter(type == "E") |>
    filter(degree %in% c(x, x + 180))

  df2 <- df |>
    st_geometry() |>
    st_cast("MULTIPOINT") |>
    st_union() |>
    st_cast("LINESTRING")

  sf_x <- st_sf(
    degree = x,
    type = "E",
    geometry = df2
  )
}) |> bind_rows()


grats_end <- merid |>
  bind_rows(grats |>
    filter(type != "E"))

We then cut and color the resulting graticules so they form the emblem-like pattern.

# Cut since some grats should be colored differently

antarctica_simp <- rmapshaper::ms_simplify(antarctica_fixed, keep = 0.005)
grats_yes <- st_intersection(grats_end, antarctica_simp)
grats_no <- st_difference(grats_end, antarctica_simp)

antarctica_simp |>
  ggplot() +
  geom_sf(fill = "white", color = NA) +
  theme(
    panel.background = element_rect(fill = "#072b5f"),
    panel.grid = element_blank(),
    axis.text = element_blank(),
    axis.ticks = element_blank()
  ) +
  geom_sf(data = grats_yes, color = "#072b5f", linewidth = 1) +
  geom_sf(data = grats_no, color = "white", linewidth = 1) +
  coord_sf(
    xlim = c(bbox[c(1, 3)]) * 1.8,
    ylim = c(bbox[c(2, 4)]) * 1.4
  ) +
  labs(title = "Emblem of the Antarctic Treaty")

Antarctica flag redesigned

In 2024, Graham Bartram revealed a new version of his original flag as part of a global campaign to raise awareness about the growing problem of microplastic pollution. The new design keeps the familiar white outline of Antarctica but swaps the plain blue background for one filled with countless tiny, colorful dots. These dots represent the microscopic bits of plastic that have been discovered even in the planet’s most untouched places, including the Antarctic ice and its surrounding oceans.

Because the design relies on randomness, we approximate it using the following procedure:

Sample random points across the Antarctic polygon.
Build Voronoi polygons from those points, then apply a small negative buffer to create gaps.
Randomly sample the resulting polygons to increase visual noise.
Color polygons so larger areas remain white while smaller polygons use magenta/pink tones.

# Maximum chunk of Antarctica, the one that we fixed

ant_max_fixed
#> Simple feature collection with 1 feature and 1 field
#> Geometry type: POLYGON
#> Dimension:     XY
#> Bounding box:  xmin: -2447764 ymin: -2125910 xmax: 2690846 ymax: 2233395
#> Projected CRS: +proj=ortho +lat_0=-90 +lon_0=0
#>         NAME                       geometry
#> 1 Antarctica POLYGON ((-2423737 1557908,...

set.seed(2024)
# Sample, Voronoi and negative buffer
plastics <- st_sample(ant_max_fixed, 3000) |>
  st_union() |>
  st_voronoi(envelope = st_geometry(ant_max_fixed)) |>
  st_collection_extract() |>
  st_buffer(dist = -10000)


# Keep only those properly included in the outline

toinc <- st_contains_properly(ant_max_fixed, plastics, sparse = FALSE) |>
  as.vector()

# Select random chunks
plastic_end <- plastics[toinc, ] |>
  st_as_sf() |>
  slice_sample(prop = 0.75)

ggplot(plastic_end) +
  geom_sf(fill = "darkblue")

# Random coloring

plastic_end$area <- st_area(plastic_end) |> as.double()

plastic_end$fill <- sample(c("#ff00ec", "#9e00ec"), nrow(plastic_end), replace = TRUE)
plastic_end$fill <- ifelse(plastic_end$area > quantile(plastic_end$area, probs = 0.4),
  "white",
  plastic_end$fill
)

bbox2 <- st_bbox(plastic_end)
ggplot() +
  geom_sf(data = plastic_end, aes(fill = fill), color = NA) +
  scale_fill_identity() +
  theme(
    panel.background = element_rect(fill = "#009fdc"),
    panel.grid = element_blank(),
    axis.text = element_blank(),
    axis.ticks = element_blank()
  ) +
  labs(title = "New redesign") +
  coord_sf(
    xlim = c(bbox2[c(1, 3)] * 1.8),
    ylim = c(bbox2[c(2, 4)]) * 1.4
  )

Implementing group_by count in Liquid

Fri, 28 Feb 2025 00:00:00 +0100

See the magic happening

5 min.

Liquid is an open-source template language created by Shopify back in 2006 and written in Ruby. It is widely used by several frameworks, with Jekyll being one of the most famous.

This website is created using Jekyll, specifically my Jekyll template Chulapa (link).

Some time ago, @cargocultprogramming opened dieghernan/chulapa#29 because one of the components of the theme was broken in Jekyll >=4.1.0. Digging a bit, I saw jekyll/jekyll#8214, exposing the same issue. What seemed to be a feature was indeed a bug that some developers were exploiting.

The change is that when applying the group_by Liquid filter on an array, it used to produce a “grouped” version of the array, while in Jekyll >=4.1.0 it produces a different result that can’t be used in the same way.

 {% assign alldocs = site.exercises %} {% assign grouptag = alldocs |
map: 'tags' | join: ',' | split: ',' | group_by: tag %} {{ grouptag }}


{"name"=>"tag A", "items"=>["tag A"], "size"=>1}{"name"=>"Tag B", "items"=>["Tag
B"], "size"=>1}{"name"=>"Virtualbox", "items"=>["Virtualbox"],
"size"=>1}{"name"=>"netcat", "items"=>["netcat"], "size"=>1}{"name"=>"whois",
"items"=>["whois"], "size"=>1}{"name"=>"dig", "items"=>["dig"], "size"=>1} ...
{"name"=>"Hydra", "items"=>["Hydra"], "size"=>1}


{"name"=>"", "items"=>["tag A", "Tag B", "Virtualbox", "netcat", "whois", "dig",
... , "Hydra"], "size"=>26} 

So basically, counting items was not easy anymore. I developed a solution in pure Liquid (which is quite verbose when working outside the predefined filters) that is compatible with any Jekyll version.

The algorithm is now implemented in Chulapa. You can check the results on my /tags page.

Note that the tables produced in the example are taken from my live site, so they may change as I add more posts. The table results should have the same order and number of tags displayed on the /tags page.

Alternative `group_by` with Liquid

First, we define an array of all the tags included in the documents of my site:

 {% assign alldocs = site.documents %} {% assign alltags = alldocs |
map: 'tags' | join: ',' | split: ',' %} 

Cool! Now we can count the number of unique elements in alltags by counting the occurrences of unique tags in the array:

{% assign single_tags = alltags | uniq %}

{% assign count_tags = '' | split: ',' %}

{% assign n_tags = single_tags | size | minus: 1 %} {% for i in (0..n_tags) %}

{% assign count_this_tag = alltags | where_exp:"item", "item == single_tags[i]"
| size %} {% assign count_tags = count_tags | push: count_this_tag %} {% endfor
%}

  {% for i in (0..n_tags) %}
  
  {% endfor %}

    Display count of tags on this site
  
    Tag
    Count
  
    {{ single_tags[i] }}
    {{ count_tags[i] }}

Display count of tags on this site
Tag	Count
{{ single_tags[i] }}	{{ count_tags[i] }}

See results

Happy Valentine’s Day

Mon, 17 Feb 2025 00:00:00 +0100

Do you know the Bonne projection?

1 min.

Do you know the Bonne Projection? This is a very special one, as it produces this result when used to map the whole world. Happy Valentine’s Day!

library(sf)
library(dplyr)
library(giscoR)
library(ggplot2)
library(showtext)


world <- gisco_get_countries()

# Shaped ocean

h_earth <- world %>%
  # Fine grid
  st_make_grid(n = c(50, 50)) %>%
  # Bonne projection
  st_transform("ESRI:54024") %>%
  # To sf object (data-frame like)
  st_sf(couple = 2, someval = 1, .)


# And finally

font_add_google(name = "Emilys Candy", family = "emilys")

showtext_auto()

ggplot() +
  geom_sf(data = h_earth, fill = "#f9b7bb", color = "#f9b7bb") +
  geom_sf(data = world, fill = "#d24658", color = "#d24658") +
  theme_void() +
  labs(
    title = "Happy Valentine's Day",
    caption = "Bonne Projection (ESRI:54024)"
  ) +
  theme(
    plot.background = element_rect(
      fill = "#faddcf",
      color = "transparent"
    ),
    text = element_text(family = "emilys", colour = "#d24658"),
    plot.title = element_text(hjust = 0.5, size = rel(3)),
    plot.caption = element_text(hjust = 0.5, size = rel(2))
  )

Optimize your images with R and reSmush.it

Mon, 05 Feb 2024 00:00:00 +0100

Introducing the resmush package

5 min.

The resmush package has recently been accepted on CRAN! This small utility package allows for the optimization (i.e., compression) of local and online images using reSmush.it.

You can install resmush from CRAN with:

install.packages("resmush")

What is reSmush.it?

reSmush.it is a free online API that provides image optimization and has been implemented in WordPress, Drupal and Magento. Some features of reSmush.it include:

Free optimization services, no API key required.
Optimization of local and online images.
Supported image file formats: PNG, JPG/JPEG, GIF, BMP, TIFF, WebP.
Maximum image size: 5 MB.
Compression using several algorithms:
- PNGQuant: Strip unneeded chunks from PNGs while preserving full alpha transparency.
- JPEGOptim: Lossless optimization based on optimizing the Huffman tables.
- OptiPNG: png reducer used by several online optimizers.

reSmush.it is free of charge, but its team is planning to offer more services and extend the service to support other types of image files. If you enjoy this API (as I do), you can consider supporting them.

Support reSmush.it on Ko-fi

Why the resmush package?

One of the main reasons I developed resmush is because I usually include precomputed vignettes with my packages (see tidyterra as an example). I found that the plots created on CRAN with the standard configuration (i.e., not precomputed vignettes but built on CRAN itself) were not very satisfying. In some of the packages I developed, especially those related to mapping, they didn’t do justice to the actual results when a user runs them.

Precomputing vignettes has the drawback of producing higher-quality images at the expense of size. To avoid exceeding CRAN’s 5 MB maximum size policy, I developed resmush, which enables me to reduce the size of the images without a significant loss in quality.

Another use case for resmush is optimizing images in the context of web page development and SEO optimization. For example, I optimized all the images on this blog using resmush_dir(), which is a shorthand for optimizing all files in a specific folder.

There are other alternatives that I discuss at the end of this post, but briefly, the reSmush.it API works quickly with minimal configuration for a wide range of formats without needing an API key.

Using the resmush package

With local files

Let’s present an example of how a local file can be optimized. First, we create a large plot with ggplot2.

library(tidyterra)
library(ggplot2)
library(terra)
library(maptiles)

cyl <- vect(system.file("extdata/cyl.gpkg", package = "tidyterra")) %>%
  project("EPSG:3857")
cyl_img <- get_tiles(cyl, "Esri.WorldImagery", zoom = 8, crop = TRUE)
cyl_gg <- autoplot(cyl_img, maxcell = Inf) +
  geom_spatvector(data = cyl, alpha = 0.3)

cyl_gg

Original file

# And we save it for resmushing
ggsave("cyl.png", width = 5, height = 0.7 * 5)

The file has a size of 1.7 MB. We can use resmush_file() to reduce it:

library(resmush)
resmush_file("cyl.png")
#> ══ resmush summary ══════════════════════════════════════════
#> ℹ Input: 1 file with size 1.7 Mb
#> ✔ Success for 1 file: Size now is 762.2 Kb (was 1.7 Mb). Saved 948.9 Kb (55.46%).
#> See result in directory '.'.

# Check
png::readPNG("cyl_resmush.png") %>%
  grid::grid.raster()

Optimized file

By default, resmush_file() and resmush_dir() do not overwrite the original file, although this behavior may be modified with the overwrite = TRUE parameter. Now, the optimized file ("cyl_resmush.png") has a size of 762.2 kB.

Let’s compare the results side-by-side:

Original picture (left/top): 1.7 MB. Optimized picture (right/bottom): 762.2 kB. (55.46% reduction in file size). Click on the images to enlarge.

We can verify that the image has been compressed without reducing its dimensions.

size_src <- file.size("cyl.png") %>%
  `class<-`("object_size") %>%
  format(units = "auto")
size_dest <- file.size("cyl_resmush.png") %>%
  `class<-`("object_size") %>%
  format(units = "auto")

dim_src <- dim(png::readPNG("cyl.png"))[1:2] %>% paste0(collapse = "x")
dim_dest <- dim(png::readPNG("cyl_resmush.png"))[1:2] %>% paste0(collapse = "x")

data.frame(
  source = c("original file", "compressed file"),
  size = c(size_src, size_dest),
  dimensions = c(dim_src, dim_dest)
) %>%
  knitr::kable()

source	size	dimensions
original file	1.7 Mb	1050x1500
compressed file	762.2 Kb	1050x1500

With online files

We can also optimize online files with resmush_url() and download them to disk. In this example, I demonstrate a feature of all the functions in resmush: they return an invisible data frame with a summary of the process.

url <- "https://dieghernan.github.io/assets/img/samples/sample_1.3mb.jpg"

# Invisible data frame
dm <- resmush_url(url, "sample_optimized.jpg", report = FALSE)

knitr::kable(dm)

src_img	dest_img	src_size	dest_size	compress_ratio	notes	src_bytes	dest_bytes
https://dieghernan.github.io/assets/img/samples/sample_1.3mb.jpg	sample_optimized.jpg	1.3 Mb	985 Kb	26.63%	OK	1374693	1008593

Original picture (left/top): 1.3 MB. Optimized picture (right/bottom): 985 kB. (26.63% reduction in file size). Click on the images to enlarge.

Other alternatives

There are other alternatives for optimizing images with R, but first…

Yihui Xie, one of the most prominent figures in the R community, was recently laid off from his position at Posit PBC (formerly RStudio) (more info here).

Yihui is the developer of knitr, markdown, blogdown and bookdown, among others, and he has been one of the key contributors (if not the most) to the reproducible research space with R through his libraries.

If you have ever used and enjoyed his packages, consider sponsoring him on GitHub.

Sponsor Yihui Xie

One of the many packages developed by Yihui is xfun, which includes the following functions for optimizing image files:
- xfun::tinify() is similar to resmush_file() but uses TinyPNG. An API key is required.
- xfun::optipng() compresses local files with OptiPNG (which needs to be installed locally).
tinieR package by jmablog. An R package that provides a full interface with TinyPNG.
optout package by @coolbutuseless. Similar to xfun::optipng() with additional options. Requires additional software to be installed locally.

Table 1: R packages: Comparison of alternatives for optimizing images.
tool	CRAN	Additional software?	Online?	API Key?	Limits?
`xfun::tinify()`	Yes	No	Yes	Yes	500 files/month (Free tier)
`xfun::optipng()`	Yes	Yes	No	No	No
tinieR	No	No	Yes	Yes	500 files/month (Free tier)
optout	No	Yes	No	No	No
resmush	Yes	No	Yes	No	Max size 5Mb

Table 2: R packages: Supported formats.
tool	png	jpg	gif	bmp	tiff	webp	pdf
`xfun::tinify()`	✅	✅	❌	❌	❌	✅	❌
`xfun::optipng()`	✅	❌	❌	❌	❌	❌	❌
tinieR	✅	✅	❌	❌	❌	✅	❌
optout	✅	✅	❌	❌	❌	❌	✅
resmush	✅	✅	✅	✅	✅	✅	❌

Additionally, if you host your projects on GitHub, you can try Imgbot, which is free for open-source projects. Imgbot provides automatic optimization for files in your repositories, and the optimized files will be included in specific pull requests before merging into your work.

Beautiful maps with R (V): Point densities

Sat, 16 Dec 2023 00:00:00 +0100

Bertin’s dot density maps with R and GHSL

8 min.

Recently the R Graph Gallery has incorporated a new post by Benjamin Nowak showing how to create a dot density map based on the work of the French cartographer Jacques Bertin (1918 - 2010):

In this post, I create a similar map for Iberia and also show how to create a variation using a hexagonal grid instead of a rectangular one. This is the fifth issue of the series Beautiful Maps with R.

Libraries

I will use the following libraries for loading, manipulating and plotting spatial data (both raster and vector):

# Base spatial packages
library(terra)
library(sf)
# Spatial data
library(giscoR)
# Wrangling and plotting
library(tidyverse)
library(tidyterra)
library(ggtext)
# Additional for hex grids
# Supporting for units and bridge raster to polygon
library(units)
library(exactextractr)

Get the data

The first step is always to get the data we need. My final map uses a circular layout with Iberia in the middle (that is our observation window), so we can get the corresponding shapes and create a buffer around it.

After that, we extract the population spatial distribution from GHSL - Global Human Settlement Layer. We use the global file with a resolution of 1 km in the Mollweide projection (ESRI:54009).

# Create observation window based on the Iberian Peninsula and surroundings
# We create a buffered circle
owin <- gisco_get_countries(
  country = c("ES", "PT"),
  # We buffer in 3035 since I want my final map on this projection
  epsg = 3035,
  resolution = 60
) %>%
  st_geometry() %>%
  st_union() %>%
  st_centroid(of_largest_polygon = TRUE) %>%
  st_buffer(750000) %>%
  # But for extracting raster data we need this in Mollweide so far
  st_transform(crs = "ESRI:54009")

# Get additional shapes and cut them to the owin
regions <- gisco_get_nuts(resolution = 3, nuts_level = 2) %>%
  st_transform(st_crs(owin)) %>%
  st_intersection(owin)

countries <- gisco_get_countries(resolution = 3) %>%
  st_transform(st_crs(owin)) %>%
  st_intersection(owin)

# Base map
base_gg <- ggplot() +
  geom_sf(data = regions, fill = NA, color = "black", linewidth = 0.1) +
  geom_sf(data = countries, fill = NA, linewidth = 0.5, color = "black") +
  geom_sf(data = owin, fill = NA, linewidth = 0.75, color = "black")

base_gg

That is our base map. Now we download the GHSL data programmatically and check that everything is correct. At this point, it is interesting to use the win argument when reading the raster with terra::rast(), as this allows us to load only the desired area with the subsequent improvement in terms of performance.

# Download data
# We need the following file (download 305Mb)
url <- "https://jeodpp.jrc.ec.europa.eu/ftp/jrc-opendata/GHSL/GHS_POP_GLOBE_R2023A/GHS_POP_E2030_GLOBE_R2023A_54009_1000/V1-0/GHS_POP_E2030_GLOBE_R2023A_54009_1000_V1_0.zip"

# This is where I store the file, you need to modify the folder
fname <- file.path("~/R/mapslib/GHS", basename(url))
if (!file.exists(fname)) {
  download.file(url, fname)
}
zip_content <- unzip(fname, list = TRUE)
zip_content
#>                                                 Name    Length                Date
#> 1     GHS_POP_E2030_GLOBE_R2023A_54009_1000_V1_0.tif 263188307 2023-04-28 21:11:00
#> 2 GHS_POP_E2030_GLOBE_R2023A_54009_1000_V1_0.tif.ovr  88461532 2023-04-28 21:11:00
#> 3                         GHSL_Data_Package_2023.pdf   9761851 2023-10-27 14:30:00
#> 4           GHS_POP_GLOBE_R2023A_input_metadata.xlsx    137963 2023-04-30 10:42:00

# Unzip
unzip(fname, exdir = "~/R/mapslib/GHS", junkpaths = TRUE, overwrite = FALSE)

# Create the path to the file
global_tiff <- zip_content$Name[grepl("tif$", zip_content$Name)]
global_tiff_path <- file.path("~/R/mapslib/GHS", global_tiff)

# And read cropping to our owin
pop_init <- rast(global_tiff_path, win = as_spatvector(owin))

# Consistent naming of the layer
names(pop_init) <- "population"

ncell(pop_init)
#> [1] 2255923

# And check with tidyterra
base_gg +
  geom_spatraster(data = pop_init, maxcell = 50000) +
  scale_fill_viridis_c(na.value = "transparent", alpha = 0.3)

Data wrangling

The GHSL information contains the estimated population in each cell. However, the file has a high resolution (more than 2 million cells), so for plotting purposes we are going to reduce (i.e. aggregate) the number of cells so we can have a better dot visualization. Once we aggregate, we compute the area of each new aggregated cell and compute the corresponding population density.

Instead of using the numeric range of densities, we use categories for the final map, so we classify the density into different groups:

# Reduce resolution for visualization
# Compute factor to reduce raster to (aprox) 100 rows:
nrow(pop_init)
#> [1] 1511
factor <- round(nrow(pop_init) / 100)

# Each new cell contains the sum of population of the aggregated cells
pop_agg <- terra::aggregate(pop_init,
  fact = factor, fun = "sum",
  na.rm = TRUE
)


# Compute area of each new cell
pop_agg$area_km2 <- cellSize(pop_agg, unit = "km")

# Compute densities, mask to owin, convert to points and create categories
pop_points <- pop_agg %>%
  # Compute density by cell
  mutate(dens = population / area_km2) %>%
  select(dens) %>%
  # Mask to the countries shapes
  mask(as_spatvector(countries), touches = FALSE) %>%
  # SpatVector as points
  as.points() %>%
  # Categorize
  mutate(cat = case_when(
    dens < 25 ~ "A",
    dens < 50 ~ "B",
    dens < 100 ~ "C",
    dens < 250 ~ "D",
    dens < 500 ~ "E",
    dens < 1500 ~ "F",
    TRUE ~ "G"
  ))

Final plot

And finally, the map. In this case, I save it as a high-resolution square map.

# Final plot
final_plot <- base_gg +
  # Layer, this object is a SpatVector instead of sf object
  geom_spatvector(
    pop_points,
    mapping = aes(size = cat),
    # Use a point with a border AND a fill
    pch = 21, color = "white", fill = "black", linewidth = 0.05
  ) +
  scale_size_manual(
    values = c(0.3, 1, 1.25, 1.5, 2, 2.5, 3.5),
    labels = c(
      "< 25", "[25, 50)", "[50, 100)", "[100, 250)",
      "[250, 500)", "[500, 1500)", "≥ 1500"
    ),
    guide = guide_legend(
      nrow = 1,
      title.position = "top",
      keywidth = 1,
      label.position = "bottom"
    )
  ) +
  labs(
    title = "**Population density in Iberia**",
    subtitle = "in the way of Jacques Bertin",
    size = "Inhabitants per km2",
    caption = "**Data** GHSL **| Plot** @dhernangomez based on @BjnNowak"
  ) +
  theme_void() +
  # This CRS for representation only
  coord_sf(expand = TRUE, crs = 3035) +
  theme(
    # plot.margin = margin(20,0,20,0,"cm"),
    plot.background = element_rect(fill = "white", color = NA),
    legend.position = "bottom",
    legend.margin = margin(r = 20, unit = "pt"),
    legend.title = element_markdown(),
    legend.key.width = unit(50, "pt"),
    plot.title = element_markdown(hjust = 0.5, size = 20),
    plot.subtitle = element_text(hjust = 0.5, color = "grey40"),
    plot.caption = element_markdown(
      color = "grey20",
      margin = margin(t = 20, b = 5, unit = "pt"),
      hjust = .5
    )
  )



ggsave("202312_finalmap.png", dpi = 300, width = 8, height = 8)

Alternative hexagonal grid

The previous plot is based on the centroids of each cell of the raster, which is, by definition, a rectangular grid. I would also like to experiment with hexagonal grids (i.e. a grid of hexagons) since I have the feeling that they look more “natural” than the rectangular ones, which present a regularity hardly seen in the wild.

The issue here is that terra does not produce this type of grid. However, it is possible to create them with sf::st_make_grid(), so the workflow for this alternative is:

Create a hexagonal grid, where each hexagon represents a similar area to each cell in the aggregated raster.
Extract the values of the raster to the new grid.
Finally, follow the same data wrangling and plotting steps.

When working with sf::st_make_grid(square = FALSE), the parameter cellsize should be the “diameter” of the hexagon instead of the area. Luckily, we can infer this value since the area of a hexagon is

[A = \frac{\sqrt{3}}{2}d^{2}]

So we can extract \(d\) from the previous expression knowing the area \(A\) of the aggregated cells:

# Hex grid with sf ----

# Avg size of the cells on the aggregated grid
target_area <- cellSize(pop_agg, unit = "km") %>%
  pull() %>%
  mean() %>%
  as_units("km^2")

target_area
#> 224.7461 [km^2]

# Infer diam hex
diam_hex <- sqrt(2 * target_area / sqrt(3))
# Create hexagonal grid
pop_agg_sf <- st_make_grid(owin, cellsize = diam_hex, square = FALSE)

length(pop_agg_sf)
#> [1] 10340
ncell(pop_agg)
#> [1] 10100

area_km2 <- st_area(pop_agg_sf) %>%
  set_units("km^2") %>%
  as.double()

pop_agg_sf <- st_sf(area_km2 = area_km2, geom = pop_agg_sf)

Now, we use exact_extract() to extract the population in each hexagonal cell.

# Extract aggregated population by hex cell
pop_agg_sf$population <- exact_extract(pop_init,
  y = pop_agg_sf,
  progress = FALSE,
  fun = "sum"
)


base_gg +
  geom_sf(
    data = pop_agg_sf %>% filter(population > 0),
    aes(fill = population), color = NA
  ) +
  scale_fill_viridis_c(na.value = "transparent", alpha = 0.3)

Finally, we compute densities, create categories and produce the map:

# Mask and categorize
pop_sf_points <- pop_agg_sf %>%
  # Compute density by cell
  mutate(dens = population / area_km2) %>%
  select(dens) %>%
  # To points and filter to country shape
  st_centroid(of_largest_polygon = TRUE) %>%
  st_filter(countries) %>%
  # Categorize
  mutate(cat = case_when(
    dens < 25 ~ "A",
    dens < 50 ~ "B",
    dens < 100 ~ "C",
    dens < 250 ~ "D",
    dens < 500 ~ "E",
    dens < 1500 ~ "F",
    TRUE ~ "G"
  ))

# Final plot
final_plot_hex <- base_gg +
  # Layer, this object is a sf object
  geom_sf(
    pop_sf_points,
    mapping = aes(size = cat),
    # Use a point with a border AND a fill
    pch = 21, color = "white", fill = "black", linewidth = 0.05
  ) +
  scale_size_manual(
    values = c(0.3, 1, 1.25, 1.5, 2, 2.5, 3.5),
    labels = c(
      "< 25", "[25, 50)", "[50, 100)", "[100, 250)",
      "[250, 500)", "[500, 1500)", "≥ 1500"
    ),
    guide = guide_legend(
      nrow = 1,
      title.position = "top",
      keywidth = 1,
      label.position = "bottom"
    )
  ) +
  labs(
    title = "**Population density in Iberia**",
    subtitle = "in the way of Jacques Bertin",
    size = "Inhabitants per km2",
    caption = "**Data** GHSL **| Plot** @dhernangomez based on @BjnNowak"
  ) +
  theme_void() +
  # This CRS for representation only
  coord_sf(expand = TRUE, crs = 3035) +
  theme(
    # plot.margin = margin(20,0,20,0,"cm"),
    plot.background = element_rect(fill = "white", color = NA),
    legend.position = "bottom",
    legend.margin = margin(r = 20, unit = "pt"),
    legend.title = element_markdown(),
    legend.key.width = unit(50, "pt"),
    plot.title = element_markdown(hjust = 0.5, size = 20),
    plot.subtitle = element_text(hjust = 0.5, color = "grey40"),
    plot.caption = element_markdown(
      color = "grey20",
      margin = margin(t = 20, b = 5, unit = "pt"),
      hjust = .5
    )
  )

ggsave("202312_finalmap_hex.png", dpi = 300, width = 8, height = 8)

And that’s it! Which one do you like the most? Let me know in the comments.

References

Bertin J (1967). Sémiologie graphique. Les diagrammes. Les réseaux. Les cartes. Gauthier-Villars, Paris.
European Commission. Joint Research Centre. (2023). GHSL data package 2023.. Publications Office, LU https://doi.org/10.2760/098587
Hernangómez D (2023). “Using the tidyverse with terra objects: the tidyterra package Journal of Open Source Software, 8(91), 5751. ISSN 2475-9066 https://doi.org/10.21105/joss.05751
Pesaresi M, Politis P (2023). “GHS-BUILT-C R2023A - GHS Settlement Characteristics, derived from Sentinel2 composite (2018) and other GHS R2023A data.” https://doi.org/10.2905/3C60DDF6-0586-4190-854B-F6AA0EDC2A30

Star map with R

Wed, 25 Jan 2023 00:00:00 +0100

Creating Star Map Visualizations Based on Location and Date

13 min.

A couple of weeks ago I was doing my daily check on Stack Overflow when I found a question by Benjamin Smith that blew my mind: Creating Star Map Visualizations Based on Location and Date !!

Oh my! Can we do this with R? The answer is: Of course! In fact, Kim Fitter already worked on this two years earlier, see his Celestial Maps. So I decided to put some work into this.

Since then, I have also learned that Benjamin and I have been working in parallel on the same topic. He is preparing an R package named starBliss and hopefully this post will be of some help.

I have very little knowledge of this topic, so if you find errors or have any suggestions, please let me know in the comments section below.

First things first: the data

The initial data source for all these projects (Kim’s, Benjamin’s and mine) is the same, and it is provided by the D3 plugin d3-celestial by Olaf Frohn. As Kim Fitter pointed out in his post, these data files present the problem (experienced by almost any sf user) of lines crossing the international date line (longitude 180º). I also found that some files are not valid as per sf::st_make_valid().

Solution? I processed and fixed almost every file, including the files corresponding to the Milky Way and the lines for Chinese constellations, manually, to provide a set of files. That is the origin of my project Celestial Data, which provides all these files in several spatial formats. Please check out the repo to learn more about it.

Creating a star map with R

The first step is to load libraries that will help us with this cosmic task:

# Spatial manipulation
library(sf)
library(s2)
library(nominatimlite)

## Wrangling data and dates
library(dplyr)
library(lubridate)
library(lutz)

## Visualization
library(ggplot2)
library(ggfx)
library(ggshadow)

Helper functions

Now we prepare some helper functions:

load_celestial() just downloads the corresponding .geojson from the Celestial Data repo¹ to a specific directory cachedir and loads it with sf::st_read().
pretty_lonlat() is a labeler that returns a decimal longitude or latitude coordinate in the format degrees/minutes/seconds (e.g., a latitude 34.72782 would be converted into 34° 43’ 40.15” N).

Show load_celestial and pretty_lonlat()

Celestial data

Mon, 23 Jan 2023 00:00:00 +0100

A compilation of celestial data files

1 min.

This project provides several datasets of celestial objects as of the J2000 epoch in GeoJSON and GeoPackage formats.

The original files were provided by the d3-celestial plugin (Frohn 2015) under BSD 3-Clause. The datasets produced by this project consist of the same data provided by the d3-celestial plugin processed with the R package sf (Pebesma 2018) to ensure its validity:

The spatial data objects are bounded by \([-180, -90, 180, 90]\).
Data are provided in WGS 84 - World Geodetic System 1984 (EPSG:4326).
All geometries are valid as per ST_IsValid (GEOS 3.9.3).

Distribution

The data can be accessed from several API endpoints:

https://raw.githubusercontent.com/dieghernan/celestial_data/main/data/mw.min.geojson

https://dieghernan.github.io/celestial_data/data/mw.min.geojson

https://cdn.jsdelivr.net/gh/dieghernan/celestial_data@main/data/mw.min.geojson

Data

Data are provided in GeoJSON (*.geojson) and GeoPackage (*.gpkg) formats. Additionally, for GeoJSON files a minified version (*.min.geojson) is also provided.

The data source can be found in the corresponding GitHub repo.

List of files provided:

Hillshade, colors and marginal plots with tidyterra (II)

Mon, 12 Dec 2022 00:00:00 +0100

The rain in Spain does not stay mainly in the plain

12 min.

This is the second post of the series “Hillshade, colors and marginal plots with tidyterra”. In this post, I explore an approach for annotating marginal plots on a ggplot2 map of a SpatRaster, including information about the values by longitude and latitude. See the first post of the series here.

If you love watching classic movies, especially from Hollywood’s Golden Age, you may recognize the following lyrics:

The rain in Spain stays mainly in the plain!

By George, she’s got it! By George, she’s got it!

Now, once again where does it rain? On the plain! On the plain!

And where’s that soggy plain? In Spain! In Spain!

The rain in Spain stays mainly in the plain!

The rain in Spain stays mainly in the plain!

This emphatic statement is made in My Fair Lady (1964) by Audrey Hepburn, Rex Harrison and Stanley Holloway. But as a Spaniard, I can tell you it is completely false.

The rain in Spain stays mainly in the north, most notably in Galicia. And I can prove it!

In this post, I overlay a SpatRaster showing average precipitation data with an extra set of plots on the margin to identify where the rain in Spain stays (mainly).

Libraries

In this post, we will use the following libraries:

## Libraries

# Data manipulation
library(terra)
library(tidyterra)
library(dplyr)

# Get the data
library(geodata)
library(mapSpain)

# Plotting
library(ggplot2)
library(scales)
library(cowplot)
library(colorspace)

The plain in Spain

The plain (or as we call it, La Meseta Central) covers a large area of inland Spain, with an average altitude of 650 meters above sea level.

I didn’t find any accurate spatial data file with the bounds of the plain, so for this case I would approximate it using a mixture of political borders (historically the Meseta is associated with Castile and Madrid) and elevation data to get a rough shape.

# Using mapSpain
the_plain <- esp_get_prov(
  c(
    "Madrid", "Castilla-La Mancha",
    "Extremadura", "Castilla y Leon",
    "Teruel"
  ),
  epsg = 4326, resolution = 1
) %>%
  mutate(the_plain = TRUE) %>%
  group_by(the_plain) %>%
  # Combine
  summarise() %>%
  # To terra, until this step was sf
  vect()

# Get altitude

# I use here a local directory to cache downloaded files on my PC.
# Modify this to your likes, e.g. using
# mydir <- tempdir()

mydir <- "~/R/mapslib/misc"


r_init <- elevation_30s("ESP", path = mydir)

# For better handling we set here the names
names(r_init) <- "alt"

# We don't want values lower than 0 on the raster
r <- r_init %>%
  mutate(alt = pmax(0, alt))


# Now intersect the raster and the vector and filter by range

exploded <- r %>%
  crop(the_plain, mask = TRUE) %>%
  # Let's define here a range of elevations
  filter(alt > 600 & alt < 1100) %>%
  drop_na() %>%
  as.polygons(dissolve = TRUE, na.rm = TRUE) %>%
  # Aggregate first
  aggregate() %>%
  # Explode vectors
  disagg() %>%
  # And fill holes
  fillHoles()



# Select biggest polygons (area bigger than 50 kms 2)
r_plain <- exploded %>%
  # Add area
  mutate(area = expanse(exploded)) %>%
  filter(area > 50000**2) %>%
  # And convert to lines
  as.lines()

autoplot(r_plain)

We can create a new plot similar to the one produced in the previous post to identify the plain. First, I create a base layer with a representation of the hillshade, which we will reuse later:

# Creating hillshade

slope <- terrain(r, "slope", unit = "radians")
aspect <- terrain(r, "aspect", unit = "radians")
hill <- shade(slope, aspect, 30, 45)

# normalize names
names(hill) <- "shades"

# Hillshading palette
pal_greys <- hcl.colors(1000, "Grays")

# Index of color by cell
index <- hill %>%
  mutate(index_col = rescale(shades, to = c(1, length(pal_greys)))) %>%
  mutate(index_col = round(index_col)) %>%
  pull(index_col)


# Get cols
vector_cols <- pal_greys[index]

# Need to avoid resampling
# and don't use aes

# Base hill plot
hill_plot <- ggplot() +
  geom_spatraster(
    data = hill, fill = vector_cols, maxcell = Inf,
    alpha = 1
  )

hill_plot

And finally we overlay the altitude and the outline of the plain in Spain.

# Overlaying and theming

# Aware of limits of the raster

alt_limits <- minmax(r) %>% as.vector()
# Round to lower and higher 500 integer with a min of 0
alt_limits <- pmax(
  c(floor(alt_limits[1] / 500), ceiling(alt_limits[2] / 500)) * 500,
  0
)

alt_limits
#> [1]    0 3500


base_text_size <- 9


plot_esp <- hill_plot +
  geom_spatraster(data = r, maxcell = Inf) +
  # Overlay the_plain
  geom_spatvector(
    data = r_plain,
    color = alpha("black", 0.7),
    linewidth = 0.15
  ) +
  scale_fill_hypso_tint_c(
    palette = "wiki-schwarzwald-cont",
    limits = alt_limits,
    alpha = 0.4,
    breaks = seq(0, 3500, 250),
    labels = label_comma()
  ) +
  guides(fill = guide_legend(
    title = "   m.",
    title.position = "top",
    keywidth = .5,
    reverse = TRUE,
    override.aes = list(alpha = 0.8)
  )) +
  labs(
    title = "Elevation of Spain",
    subtitle = "The plain represented with black line"
  ) +
  theme_minimal(base_family = "serif") +
  theme(
    plot.background = element_rect(fill = "white", color = "white"),
    plot.title = element_text(
      face = "bold", size = base_text_size * 1.5,
      hjust = 0.5
    ),
    plot.subtitle = element_text(
      size = base_text_size * 0.9,
      hjust = 0.5
    ),
    plot.caption = element_text(
      margin = margin(t = base_text_size * 3),
      face = "italic"
    ),
    legend.key = element_rect("grey50"),
    legend.text = element_text(hjust = 0),
    legend.position = "left"
  )

plot_esp

The rain in Spain

Let’s check now whether the rain falls mainly in the plain or not. We use here geodata::worldclim_country() to get the average precipitation by month from WorldClim:

# Precipitation of Spain

# Get precip data
precip <- geodata::worldclim_country("ESP", "prec", mydir)

precip
#> class       : SpatRaster
#> dimensions  : 1980, 2760, 12  (nrow, ncol, nlyr)
#> resolution  : 0.008333333, 0.008333333  (x, y)
#> extent      : -18.5, 4.5, 27.5, 44  (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84 (EPSG:4326)
#> source      : ESP_wc2.1_30s_prec.tif
#> names       : ESP_w~rec_1, ESP_w~rec_2, ESP_w~rec_3, ESP_w~rec_4, ESP_w~rec_5, ESP_w~rec_6, ...
#> min values  :           0,           1,           1,           0,           0,           0, ...
#> max values  :         296,         255,         199,         166,         181,         140, ...

We have now a SpatRaster with 12 layers representing the value of each month. So we now just add the values by cell to get the annual average. Note that we also need to normalize the SpatRaster to the projection, extent and resolution of our hill object:

# Sum all layers
precip_avg <- sum(precip)

precip_avg
#> class       : SpatRaster
#> dimensions  : 1980, 2760, 1  (nrow, ncol, nlyr)
#> resolution  : 0.008333333, 0.008333333  (x, y)
#> extent      : -18.5, 4.5, 27.5, 44  (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84 (EPSG:4326)
#> source(s)   : memory
#> name        :  sum
#> min value   :    8
#> max value   : 2055


compare_spatrasters(precip_avg, hill)

# Align raster using hill

precip_avg_mask <- precip_avg %>%
  project(hill) %>%
  crop(hill) %>%
  mask(hill)

# Normalize
names(precip_avg_mask) <- "prec"

compare_spatrasters(precip_avg_mask, hill)

autoplot(precip_avg_mask)

Creating a modified palette

We can now start representing our precipitation map. I chose here to create a custom palette with colorspace to better highlight the differences:

mypal <- sequential_hcl(
  n = 16,
  h = c(320, 80),
  c = c(60, 65, 20),
  l = c(30, 95), power = c(0.7, 1.3),
  rev = TRUE
)

show_col(mypal)

And now we can create the final map showing if the rain in Spain stays mainly in the plain:

# Precipitation limits, rounded to 100
prec_limits <- floor(as.vector(minmax(precip_avg_mask)) / 100) * 100 + c(0, 100)


meteo_plot <- hill_plot +
  geom_spatraster(data = precip_avg_mask, maxcell = Inf) +
  # Overlay the_plain
  geom_spatvector(
    data = r_plain, color = alpha("black", 0.7),
    linewidth = .1
  ) +
  # This part is theming only
  scale_fill_gradientn(
    colours = alpha(mypal, 0.7),
    na.value = NA,
    labels = label_comma(),
    breaks = seq(0, prec_limits[2], 250)
  ) +
  guides(fill = guide_legend(
    direction = "horizontal",
    keyheight = .5,
    keywidth = 2,
    title.position = "right",
    label.position = "bottom",
    nrow = 1,
    family = "serif",
    title = " mm.",
    override.aes = list(alpha = 0.9)
  )) +
  labs(
    title = "Average yearly precipitation of Spain",
    subtitle = "The rain in Spain does not stay mainly in the plain"
  ) +
  theme_minimal(base_family = "serif") +
  theme(
    plot.background = element_rect(fill = "white", color = "white"),
    plot.title = element_text(
      face = "bold", size = base_text_size * 1.5,
      hjust = 0.5
    ),
    plot.subtitle = element_text(
      size = base_text_size,
      hjust = 0.5
    ),
    axis.text = element_text(size = base_text_size * 0.7, face = "italic"),
    legend.key = element_rect("grey50"),
    legend.position = "bottom",
    legend.title = element_text(size = base_text_size * .7),
    legend.text = element_text(size = base_text_size * .7),
    legend.spacing.x = unit(0, "pt")
  )


meteo_plot

We can now see that the rain in Spain falls mainly on the Atlantic coast (northern Spain) and specifically in Galicia. That’s why in Spanish the lyrics The rain in Spain stays mainly in the plain were translated into:

La lluvia en Sevilla es una pura maravilla.

That can be translated as “The rain in Seville is a true marvel”. And it is, indeed. Seville (located in the south on the Guadalquivir Valley) has circa 50 rainy days per year, featuring very hot and dry summers.

Marginal plots (finally)

We can now start profiling our final plot. The idea is to create two bar charts, representing the value to be plotted (in this case, average annual precipitation) by longitude and latitude.

But first we add some additional margins and axis titles to the main plot, so we can easily insert those marginal plots into our main plot:

# Now we can add titles on the secondary axis

plot_main <- meteo_plot +
  xlab("") +
  ylab("") +
  # titles on secondary axis, for later
  scale_x_continuous(sec.axis = dup_axis(
    name = "avg. precipitation by longitude"
  )) +
  scale_y_continuous(sec.axis = dup_axis(
    name = "avg. precipitation by latitude"
  )) +
  theme(
    axis.title.x = element_text(
      margin = margin(t = base_text_size),
      size = base_text_size * 0.9, face = "italic"
    ),
    axis.title.y = element_text(
      angle = 270,
      margin = margin(
        l = base_text_size,
        t = base_text_size
      ),
      size = base_text_size * 0.9, face = "italic"
    )
  )

plot_main

Profiling marginal plots

In the following code, I am drafting what the marginal plots would look like, so we can have a preview of the final result:

# Profiling marginal plots

# Getting averages by x,y
marg_x <- precip_avg_mask %>%
  as_tibble(xy = TRUE) %>%
  drop_na() %>%
  group_by(x) %>%
  summarise(avg = mean(prec))

marg_y <- precip_avg_mask %>%
  as_tibble(xy = TRUE) %>%
  drop_na() %>%
  group_by(y) %>%
  summarise(avg = mean(prec))


# Cowplot would delete axis, we create an axis at 1000 and 2000
br_4marginal <- c(1000, 2000)

labs <- data.frame(labs = paste(
  prettyNum(br_4marginal, big.mark = " "),
  "mm."
))

labs$for_x <- max(marg_x$x) - diff(range(marg_x$x)) * 0.05
labs$for_y <- min(marg_y$y) + diff(range(marg_y$y)) * 0.05
labs$y <- br_4marginal

# Profiling
ggplot() +
  geom_col(
    data = marg_x,
    aes(x, avg, fill = avg),
    color = NA,
    show.legend = FALSE
  ) +
  geom_text(
    data = labs, aes(x = for_x, y = y, label = labs),
    nudge_y = 100,
    size = 3
  ) +
  scale_fill_gradientn(
    colours = alpha(mypal, 0.9),
    na.value = NA,
    labels = label_comma(),
    limits = prec_limits
  ) +
  scale_y_continuous(
    breaks = br_4marginal,
    limits = c(0, max(br_4marginal) * 1.5)
  ) +
  theme_void() +
  theme(panel.grid.major.y = element_line(
    colour = "grey50",
    linetype = "dashed"
  ))

ggplot() +
  geom_col(
    data = marg_y,
    aes(y, avg, fill = avg),
    color = NA,
    show.legend = FALSE
  ) +
  geom_text(
    data = labs, aes(x = for_y, y = y, label = labs),
    nudge_y = 100,
    angle = 270,
    size = 3
  ) +
  scale_fill_gradientn(
    colours = alpha(mypal, 0.9),
    na.value = NA,
    labels = label_comma(),
    limits = prec_limits
  ) +
  scale_y_continuous(
    breaks = br_4marginal,
    limits = c(0, max(br_4marginal) * 1.2)
  ) +
  coord_flip() +
  theme_void() +
  theme(panel.grid.major.x = element_line(
    colour = "grey50",
    linetype = "dashed"
  ))

Putting all the pieces together

Finally, we use cowplot::axis_canvas() to create the marginal plots as we want:

# Last step: We combine plots

# Marginal plots
plot_x <- axis_canvas(plot_main, axis = "x") +
  geom_col(
    data = marg_x,
    aes(x, avg, fill = avg),
    color = NA,
    show.legend = FALSE
  ) +
  geom_text(
    data = labs, aes(x = for_x, y = y, label = labs),
    # Adjust the position of the labels
    nudge_y = 300,
    family = "serif",
    fontface = "italic",
    size = base_text_size * 0.2
  ) +
  scale_fill_gradientn(
    colours = alpha(mypal, 0.9),
    na.value = NA,
    labels = label_comma(),
    limits = prec_limits
  ) +
  scale_y_continuous(
    breaks = br_4marginal,
    limits = c(0, max(br_4marginal) * 1.5)
  ) +
  theme_void() +
  theme(panel.grid.major.y = element_line(
    colour = "grey50",
    linetype = "dashed",
    linewidth = 0.1
  ))

plot_x

plot_y <- axis_canvas(plot_main, axis = "y", coord_flip = TRUE) +
  geom_col(
    data = marg_y,
    aes(y, avg, fill = avg),
    color = NA,
    show.legend = FALSE
  ) +
  geom_text(
    data = labs, aes(x = for_y, y = y, label = labs),
    # Adjust the position of the labels
    nudge_y = 300,
    angle = 270,
    family = "serif",
    fontface = "italic",
    size = base_text_size * 0.2
  ) +
  scale_fill_gradientn(
    limits = prec_limits,
    colours = alpha(mypal, 0.9),
    na.value = NA,
    labels = label_comma()
  ) +
  scale_y_continuous(
    breaks = br_4marginal,
    limits = c(0, max(br_4marginal) * 1.5)
  ) +
  coord_flip() +
  theme_void() +
  theme(panel.grid.major.x = element_line(
    colour = "grey50",
    linetype = "dashed",
    linewidth = 0.1
  ))
plot_y

And insert everything in the main plot. See the final result:

# Combine all plots into one
sizes_axis <- grid::unit(.3, "null")

plot_final <- insert_xaxis_grob(plot_main, plot_x,
  position = "top",
  height = sizes_axis
)
plot_final <- insert_yaxis_grob(plot_final, plot_y,
  position = "right",
  width = sizes_axis * 1.25
)

gg_final <- ggdraw(plot_final)
gg_final

And with a bit of effort we got it.

Recap

Much of the code we have created relates to the theming and labels of the plot. Here you can find a simplified version:

Simplified version

Hillshade, colors and marginal plots with tidyterra (I)

Mon, 17 Oct 2022 00:00:00 +0200

How to overlay SpatRasters

8 min.

This is the first post of a series of two, showing how to overlay a SpatRaster on top of a hillshade background. The next post shows how to add marginal plots including information about the values of the raster by longitude and latitude. See the second post here.

Using shadow effects on relief maps is a very common technique that helps produce informative yet beautiful maps. If you are interested in this topic and you work with R, you have probably seen this map:

The production of this map by Timo Grossenbacher has been a reference for years. However, recent developments in the R package ecosystem (terra, sf and support of both classes on ggplot2, development of ggnewscale, etc.) can make it even easier to produce these types of maps.

In fact, Dominic Royé recently wrote a very detailed post on creating shadow effects on map reliefs. In this first post of the series, I replicate that technique with a slight variation (e.g. not making use of ggnewscale) and discuss the potential choice of a color palette for this kind of map.

Libraries

I will use the following libraries:

## Libraries

library(terra)
library(tidyterra)
library(ggplot2)
library(dplyr)
library(scales)

# Get the data
library(geodata)

Get the data

The first step is to get the altitude data. I use the geodata package for simplicity, but you can also use elevatr, which is much more comprehensive. However, elevatr produces the result as a RasterLayer, so you would need to convert the object to SpatRaster with terra::rast().

# Cache map data
mydir <- "~/R/mapslib/misc"

r_init <- elevation_30s("ROU", path = mydir)

r_init
#> class       : SpatRaster
#> dimensions  : 588, 1176, 1  (nrow, ncol, nlyr)
#> resolution  : 0.008333333, 0.008333333  (x, y)
#> extent      : 20.1, 29.9, 43.5, 48.4  (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84 (EPSG:4326)
#> source      : ROU_elv_msk.tif
#> name        : ROU_elv_msk
#> min value   :          -4
#> max value   :        2481

# For better handling we set here the names
names(r_init) <- "alt"

# We don't want values lower than 0
r <- r_init %>%
  mutate(alt = pmax(0, alt))

r
#> class       : SpatRaster
#> dimensions  : 588, 1176, 1  (nrow, ncol, nlyr)
#> resolution  : 0.008333333, 0.008333333  (x, y)
#> extent      : 20.1, 29.9, 43.5, 48.4  (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84 (EPSG:4326)
#> source      : memory
#> name        :  alt
#> min value   :    0
#> max value   : 2481

We can now have a quick look at the plot with tidyterra::autoplot():

# Quick look
autoplot(r) +
  theme_minimal()

Hillshading

The next step is to calculate the hillshade. Royé has a very detailed discussion here, so I will not go into detail. What we want to create is a layer that approximates the potential “texture” of the surface based on the elevation and the sun’s position. This is straightforward with the terra::terrain() and terra::shade() functions:

## Create hillshade effect

slope <- terrain(r, "slope", unit = "radians")
aspect <- terrain(r, "aspect", unit = "radians")
hill <- shade(slope, aspect, 30, 270)

# normalize names
names(hill) <- "shades"

# Hillshading, but we need a palette
pal_greys <- hcl.colors(1000, "Grays")

ggplot() +
  geom_spatraster(data = hill) +
  scale_fill_gradientn(colors = pal_greys, na.value = NA)
#> SpatRaster resampled to ncells = 501501

We can also do the following hack to avoid the use of a scale_fill_* (via ggplot2 or via ggnewscale::new_scale_fill()):

Select a vector of colors (in this post pal_greys).
Extract the values of the raster and rescale them to the length of the palette (c(1, 1000)).
Round those rescaled values to the nearest integer. So we would have an index indicating which value of pal_greys should be mapped to each cell.
Now use the parameter fill on the geom_ instead of using the scale.

An additional note is that geom_spatraster() has a parameter maxcell that would perform a spatial resampling if the raster has more cells than maxcell. This is for optimization (note that terra::plot() has the same setup and that users often forget about it), but we can force all cells to be plotted by using maxcell = Inf. In this approach using fill, the value of maxcell needs to be effectively set to Inf to ensure that the number of color values and the number of cells are the same.

# Use a vector of colors


index <- hill %>%
  mutate(index_col = rescale(shades, to = c(1, length(pal_greys)))) %>%
  mutate(index_col = round(index_col)) %>%
  pull(index_col)


# Get cols
vector_cols <- pal_greys[index]

# Need to avoid resampling
# and don't use aes

hill_plot <- ggplot() +
  geom_spatraster(
    data = hill, fill = vector_cols, maxcell = Inf,
    alpha = 1
  )

hill_plot

Selecting colors

The selection of colors for elevation maps is a key aspect when designing this kind of visualization since colors can be confused with environmental phenomena (Patterson and Jenny, 2011). For example, by convention green colors are associated with low elevations, while oranges, browns and whites are associated with high elevations on some of the most common elevation palettes (aka hypsometric tints). See for example the Wikipedia Topographic maps conventions.

This is not ideal, since greens can be confused with forests, for example, so an elevation map of desert areas would not be appropriate with a green-brown-white color scheme.

There is an additional point to take into account when designing color palettes for maps. A regular gradient would just interpolate colors assuming that the distance among colors is the same:

# Regular gradient
grad <- hypso.colors(10, "dem_poster")

autoplot(r) +
  scale_fill_gradientn(colours = grad, na.value = NA)

For that reason, tidyterra provides additional gradients whose colors are placed unevenly with the goal of providing a better understanding of the maps:

# Hypso gradient
grad_hypso <- hypso.colors2(10, "dem_poster")


autoplot(r) +
  scale_fill_gradientn(colours = grad_hypso, na.value = NA)

Can you notice the difference? In the first map, green is the dominant color. However, greens represent a wide range of elevations (0-750 meters) that correspond to most of the territory. In terms of perception, we won’t be clearly spotting elevation differences in the center of the country, while with the uneven gradient greens only correspond to the range (0 - 250 meters) and the overall perception of elevation improves. Note that the only difference between plots is the color palette.

For producing our map we are going to assess visually the result of a selection of palettes provided by tidyterra. We use here the version tidyterra::scale_fill_hypso_tint_c() instead of tidyterra::scale_fill_hypso_c() for taking advantage of the uneven color gradients.

A downside of using these scales is that we also need to adjust the limits argument of the functions to make ggplot2 aware of the limits of the value of the raster. This is easily achieved with terra::minmax() but I added an extra touch rounding up and down the range of values to the nearest 500.

# Try some options, but we need to be aware of the values of our raster

r_limits <- minmax(r) %>% as.vector()

# Rounded to lower and upper 500
r_limits <- c(floor(r_limits[1] / 500), ceiling(r_limits[2] / 500)) * 500

# And making min value to 0.
r_limits <- pmax(r_limits, 0)

# Compare
minmax(r) %>% as.vector()
#> [1]    0 2481
r_limits
#> [1]    0 2500


# Now let's have some fun with scales from tidyterra

elevt_test <- ggplot() +
  geom_spatraster(data = r)

# Create a helper function

plot_pal_test <- function(pal) {
  elevt_test +
    scale_fill_hypso_tint_c(
      limits = r_limits,
      palette = pal
    ) +
    ggtitle(pal) +
    theme_minimal()
}

plot_pal_test("etopo1_hypso")
plot_pal_test("dem_poster")
plot_pal_test("spain")
plot_pal_test("pakistan")
plot_pal_test("utah_1")
plot_pal_test("wiki-2.0_hypso")

I finally selected for my plot the "dem_poster" palette, but this is completely a personal choice. You should select the palette you feel more comfortable with. See the full range of color palettes provided by tidyterra here.

Final plot

So now it is time to blend both the hillshade layer and the altitude layer using some level of alpha on the upper layer.

base_plot <- hill_plot +
  # Avoid resampling with maxcell
  geom_spatraster(data = r, maxcell = Inf) +
  scale_fill_hypso_tint_c(
    limits = r_limits,
    palette = "dem_poster",
    alpha = 0.4,
    labels = label_comma(),
    # For the legend I use custom breaks
    breaks = c(
      seq(0, 500, 100),
      seq(750, 1500, 250),
      2000
    )
  )

base_plot

And with a bit of trickery and theming we can have our final map. First we load a font from Google with a custom function:

myload_fonts <- function(fontname, family,
                         fontdir = tempdir()) {
  fontname_url <- utils::URLencode(fontname)
  fontzip <- tempfile(fileext = ".zip")
  download.file(paste0("https://fonts.google.com/download?family=", fontname_url),
    fontzip,
    quiet = TRUE,
    mode = "wb"
  )
  unzip(fontzip,
    exdir = fontdir,
    junkpaths = TRUE
  )

  # Load fonts
  paths <- list(
    regular = "Regular.ttf",
    bold = "Bold.ttf",
    italic = "Italic.ttf",
    bolditalic = "BoldItalic.ttf"
  )


  namefile <- gsub(" ", "", fontname)
  paths_end <- file.path(
    fontdir,
    paste(namefile, paths, sep = "-")
  )


  names(paths_end) <- names(paths)

  sysfonts::font_add(family,
    regular = paths_end["regular"],
    bold = paths_end["bold"],
    italic = paths_end["italic"],
    bolditalic = paths_end["bolditalic"]
  )

  return(invisible())
}

And now we theme it:

# Theming
myload_fonts("Noto Serif", "notoserif", "~/R/googlefonts")
showtext::showtext_auto()

# Adjust text size
base_text_size <- 30

base_plot +
  # Change guide
  guides(fill = guide_legend(
    title = "   m.",
    direction = "horizontal",
    nrow = 1,
    keywidth = 1.75,
    keyheight = 0.5,
    label.position = "bottom",
    title.position = "right",
    override.aes = list(alpha = 1)
  )) +
  labs(
    title = "Elevation of Romania",
    subtitle = "Hillshade and hypsometric tint blend",
    caption = paste0(
      "@dhernangomez using tidyterra, ggplot2, geodata R packages.",
      " Data: Shuttle Radar Topography Mission (SRTM)"
    )
  ) +
  theme_minimal(base_family = "notoserif") +
  theme(
    plot.background = element_rect("grey97", colour = NA),
    plot.margin = margin(20, 20, 20, 20),
    plot.caption = element_text(size = base_text_size * 0.5),
    plot.title = element_text(face = "bold", size = base_text_size * 1.4),
    plot.subtitle = element_text(
      margin = margin(b = 10),
      size = base_text_size
    ),
    axis.text = element_text(size = base_text_size * 0.7),
    legend.position = "bottom",
    legend.title = element_text(size = base_text_size * 0.8),
    legend.text = element_text(size = base_text_size * 0.8),
    legend.key = element_rect("grey50"),
    legend.spacing.x = unit(0, "pt")
  )

References

Patterson T, Jenny B (2011). “The Development and Rationale of Cross-blended Hypsometric Tints.” Cartographic Perspectives, 31–46. https://doi.org/10.14714/CP69.20

Grossenbacher T (2016). “Beautiful thematic maps with ggplot2 (only).” https://timogrossenbacher.ch/bivariate-maps-with-ggplot2-and-sf/.

Royé D (2022). “Hillshade effects.” https://dominicroye.github.io/en/2022/hillshade-effects/.

Hernangómez D (2022). tidyterra: tidyverse Methods and ggplot2 Helpers for terra Objects. https://doi.org/10.5281/zenodo.6572471.

Introducing tidyterra

Wed, 25 May 2022 00:00:00 +0200

Easily work with and plot SpatRasters

4 min.

If you have been playing around with R for a while, you are probably familiar with the volcano dataset:

data("volcano")
image(volcano, col = terrain.colors(256, rev = TRUE))

This represents the topographic information about one of the volcanoes of Auckland (New Zealand), specifically Maungawhau / Mount Eden. But do you know that this map is flipped?

In this post I introduce the tidyterra package, recently added to CRAN, and I show you how to geotag the volcano dataset. We will also produce ggplot2 maps using the functions of tidyterra.

# Libraries
library(terra)
library(ggplot2)
library(tidyterra)
library(maptiles)
library(sf)

Wait, `volcano` is flipped?

Let’s check it out. Thanks to the package maptiles we can have a glimpse of the location of Maungawhau using map tiles, as in Google Maps. We will use tidyterra for displaying the map tile:

# location of Maungawhau

box <- c(
  174.7611552780,
  -36.8799200525,
  174.7682380109,
  -36.8719519780
)
class(box) <- "bbox"
box <- st_as_sfc(box)
st_crs(box) <- 4326

box <- box %>%
  # To crs for NZGD49
  st_transform(27200)

tile <- get_tiles(box, crop = TRUE, zoom = 16)


ggtile <- ggplot() +
  geom_spatraster_rgb(data = tile)

ggtile

Here we have a crisp RGB tile of Maungawhau. Now, the next question is how to match the volcano dataset (a matrix) with this tile (a geotagged map tile)? Let’s check it out.

Working with SpatRasters

Thanks to the terra package we can start converting volcano into a SpatRaster:

volcano_rast <- rast(volcano)

terra::plot(volcano_rast)

# Wait, it is flipped!
volcano_rast_ok <- rast(volcano[
  seq(nrow(volcano), 1, -1),
  seq(ncol(volcano), 1, -1)
])

# Much better!
terra::plot(volcano_rast_ok)

volcano_rast_ok
#> class       : SpatRaster
#> dimensions  : 87, 61, 1  (nrow, ncol, nlyr)
#> resolution  : 1, 1  (x, y)
#> extent      : 0, 61, 0, 87  (xmin, xmax, ymin, ymax)
#> coord. ref. :
#> source      : memory
#> name        : lyr.1
#> min value   :    94
#> max value   :   195

Nice! Now we have a raster of volcano, but still without geotagged information. Thanks to this article by Tomislav Hengl (@tom_hengl) we can check the basic geographic parameters of volcano (see Volcano Maungawhau), which are:

CRS: EPSG:27200
xllcorner: 2667400
yllcorner: 6478700
cellsize: 10 m
ncols: 61
nrows: 87

And we can translate that easily to an empty SpatRaster:

# Extra length for proper handling extent
xrange <- range(seq(from = 2667400, length.out = 62, by = 10))
yrange <- range(seq(from = 6478700, length.out = 88, by = 10))

template <- rast(
  crs = "EPSG:27200",
  xmin = xrange[1],
  xmax = xrange[2],
  ymin = yrange[1],
  ymax = yrange[2],
  resolution = 10
)
template
#> class       : SpatRaster
#> dimensions  : 87, 61, 1  (nrow, ncol, nlyr)
#> resolution  : 10, 10  (x, y)
#> extent      : 2667400, 2668010, 6478700, 6479570  (xmin, xmax, ymin, ymax)
#> coord. ref. : NZGD49 / New Zealand Map Grid (EPSG:27200)

So now we only need to transfer the values from volcano_rast_ok to our template:

# Use tidyterra to pull the values of one raster
# and create a new layer

volcano2 <- template %>%
  mutate(elevation = pull(volcano_rast_ok, lyr.1)) %>%
  select(elevation)

volcano2
#> class       : SpatRaster
#> dimensions  : 87, 61, 1  (nrow, ncol, nlyr)
#> resolution  : 10, 10  (x, y)
#> extent      : 2667400, 2668010, 6478700, 6479570  (xmin, xmax, ymin, ymax)
#> coord. ref. : NZGD49 / New Zealand Map Grid (EPSG:27200)
#> source      : memory
#> name        : elevation
#> min value   :        94
#> max value   :       195

terra::plot(volcano2)

# And plot it
ggtile +
  geom_spatraster(data = volcano2) +
  scale_fill_terrain_c(alpha = 0.75)

An Easter egg

The volcano dataset may not be completely up to date. As a complement, tidyterra includes a .tif file with the same dimensions as our volcano2 raster, but with the topographic values extracted from Auckland LiDAR 1m DEM (2013) and resampled to a resolution of 5x5 meters, for package size optimization. See here how to load it and check the plotting possibilities of tidyterra:

# Load out Easter Egg

volcano2_easter <- rast(system.file("extdata/volcano2.tif",
  package = "tidyterra"
))

volcano2_easter
#> class       : SpatRaster
#> dimensions  : 174, 122, 1  (nrow, ncol, nlyr)
#> resolution  : 5, 5  (x, y)
#> extent      : 1756969, 1757579, 5917003, 5917873  (xmin, xmax, ymin, ymax)
#> coord. ref. : NZGD2000 / New Zealand Transverse Mercator 2000 (EPSG:2193)
#> source      : volcano2.tif
#> name        : elevation
#> min value   :  76.26222
#> max value   :  195.5542
terra::plot(volcano2_easter)

# Only altitudes of more than 130m

volcano_filter <- volcano2_easter %>%
  filter(elevation > 130)


ggtile +
  geom_spatraster(data = volcano_filter) +
  scale_fill_viridis_c(na.value = NA, alpha = 0.7) +
  labs(fill = "Elevation (m)")

# Contour lines

ggtile +
  geom_spatraster_contour(data = volcano2_easter, binwidth = 10)

# Contour lines + contour polygons

ggtile +
  geom_spatraster_contour_filled(
    data = volcano2_easter,
    breaks = seq(70, 210, 20),
    alpha = 0.7
  ) +
  geom_spatraster_contour(
    data = volcano2_easter, binwidth = 2.5,
    alpha = 0.7, size = .2, color = "grey10"
  ) +
  coord_sf(expand = FALSE)

Unknown pleasures with R

Sun, 01 May 2022 00:00:00 +0200

Joyplot elevation maps with ggridges and terra

8 min.

In 1970, Harold D. Craft Jr. published his Ph.D. thesis “Radio observations of the pulse profiles and dispersion measures of twelve pulsars”. The thesis (337 pages) includes on pages 214 to 216 the following depictions of successive pulses of some pulsars:

From “Radio Observations of the Pulse Profiles and Dispersion Measures of Twelve Pulsars” by Harold D. Craft, Jr. (September 1970). Original source: https://blogs.scientificamerican.com/sa-visual/pop-culture-pulsar-origin-story-of-joy-division-s-unknown-pleasures-album-cover-video/

Nine years later, a young graphic designer named Peter Saville had a new project. He had to design the cover of the debut album of a young British rock band, named Joy Division. At some point in the process, Bernard Sumner (lead guitarist of Joy Division)¹ found the following image in The Cambridge Encyclopaedia of Astronomy (1977 edition):

Saville presented a black-and-white version, producing a cover that reached iconic status in the ’80s. This cover has been reproduced in the form of tattoos, clothing, merchandise, video games and even 3-D sculptures:

If you are interested in learning more about this fascinating history of science and design, you can read Pop Culture Pulsar: Origin Story of Joy Division’s Unknown Pleasures Album Cover by Jen Christiansen.

Since then, these kinds of plots have become very popular, known as ridge plots or joyplots, in honor of Joy Division. In this post, I produce “joyplots” with R for specific regions of the world using elevation data for creating the ridges.

Creating joyplot maps with R

This topic has already been covered by other authors, such as Daniel Redondo (Spanish) and Travis M. White. However, they both use QGIS, while in this post I work completely in R.

Some initial considerations we may need to bear in mind:

In this post I will use geom_ridgeline() instead of geom_density_ridges(). This gives us more control over the final plot, but there is a caveat: both the coordinates and the elevation should be in the same unit (See why). Therefore, we should project both the raster and the base sf object to a suitable CRS defined in meters (in this case).
Joyplots are much cooler when only a few lines are displayed. This is directly related to the number of rows in our raster. A very detailed raster (e.g. lots of rows) would produce a much more detailed plot but it may not suit our needs.

Now, let’s start with the required libraries:

# Libraries

# Spatial
library(sf)
library(terra)
library(giscoR) # Shapes
library(elevatr)

# Data viz and wrangling
library(ggplot2)
library(dplyr)
library(ggridges)

The first step consists of selecting our region of interest (sf object) and extracting the elevation data. We can achieve that with giscoR and elevatr. In this post, I create a joyplot of Andalusia. Note that, given we are creating just a visualization, the resolution of the sf object is not very relevant.

# Select a Spanish Region: Andalucia
region <- gisco_get_nuts(nuts_id = "ES61") %>%
  # And project data
  st_transform(25830)

Now we need to extract the elevation using elevatr. We can also adjust the zoom level as needed. You can find guidance on zoom levels in the OpenStreetMap wiki.

dem <- get_elev_raster(region, z = 7, clip = "bbox", expand = 10000) %>%
  # And convert to terra
  rast() %>%
  # Mask to the shape
  mask(vect(region))

# Rename layer for further manipulation
names(dem) <- "elev"

nrow(dem)
#> [1] 698

terra::plot(dem)

We already have our elevation raster. Now the next step is to adjust the number of rows of our raster to a lower number. We can then aggregate the raster (i.e. reduce the number of cells or increase their size) using a scaling factor that would reduce the number of rows to our desired target (in this case 90 rows):

# Approx
factor <- round(nrow(dem) / 90)

dem_agg <- aggregate(dem, factor)

nrow(dem_agg)
#> [1] 88

terra::plot(dem_agg)

We can check how the number of rows has decreased. Also, the plot shows that we now have fewer cells.

Now, we may need to perform additional manipulations on the values of the raster:

We need to ensure that all valid values are greater than or equal to zero.
We will replace the NA values produced when masking the raster with zeros. We will use this later to decide whether to remove some parts of the plot.

After that, we create a data frame with the information needed for creating the joyplot.

dem_agg[dem_agg < 0] <- 0
dem_agg[is.na(dem_agg)] <- 0

dem_df <- as.data.frame(dem_agg, xy = TRUE, na.rm = FALSE)

as_tibble(dem_df)
#> # A tibble: 12,848 x 3
#>          x        y  elev
#>           
#>  1  77184. 4306315.     0
#>  2  81049. 4306315.     0
#>  3  84914. 4306315.     0
#>  4  88779. 4306315.     0
#>  5  92644. 4306315.     0
#>  6  96510. 4306315.     0
#>  7 100375. 4306315.     0
#>  8 104240. 4306315.     0
#>  9 108105. 4306315.     0
#> 10 111970. 4306315.     0
#> # ... with 12,838 more rows

Now is a good moment to adjust the units of the coordinates and the elevation if needed. In this case both are in meters, but I will show you how to perform those adjustments with the units package:

library(units)

# Units of DEM projection
units_crs <- st_crs(dem_agg)$units

units_crs
#> [1] "m"

# Example, convert to miles
# Adjust as needed

dem_miles <- dem_df %>%
  mutate(
    x = set_units(x, "m"),
    x_mile = set_units(x, "mi"),
    y = set_units(y, "m"),
    y_mile = set_units(y, "mi"),
    elev = set_units(elev, "m"),
    elev_mile = set_units(elev, "mi")
  )

as_tibble(dem_miles)
#> # A tibble: 12,848 x 6
#>          x        y elev x_mile y_mile elev_mile
#>        [m]      [m]  [m]   [mi]   [mi]      [mi]
#>  1  77184. 4306315.    0   48.0  2676.         0
#>  2  81049. 4306315.    0   50.4  2676.         0
#>  3  84914. 4306315.    0   52.8  2676.         0
#>  4  88779. 4306315.    0   55.2  2676.         0
#>  5  92644. 4306315.    0   57.6  2676.         0
#>  6  96510. 4306315.    0   60.0  2676.         0
#>  7 100375. 4306315.    0   62.4  2676.         0
#>  8 104240. 4306315.    0   64.8  2676.         0
#>  9 108105. 4306315.    0   67.2  2676.         0
#> 10 111970. 4306315.    0   69.6  2676.         0
#> # ... with 12,838 more rows

Finally, we can create our joyplot. Note that we can “train” the scales of our ggplot to a spatial object automatically if we pass our region object into the plot. The relative height of the ridges is controlled via the scale parameter:

ggplot() +
  # Just for the scales, pass with NA arguments so it is not shown
  geom_sf(data = region, color = NA, fill = NA) +
  geom_ridgeline(
    data = dem_df, aes(
      x = x, y = y,
      group = y,
      height = elev
    ),
    scale = 25
  ) +
  theme_ridges()

The last step is to provide a black theme, resembling the cover of the album:

ggplot() +
  geom_sf(data = region, color = NA, fill = NA) +
  geom_ridgeline(
    data = dem_df, aes(
      x = x, y = y,
      group = y,
      height = elev
    ),
    scale = 25,
    fill = "black",
    color = "white",
    size = .25
  ) +
  theme_void() +
  theme(plot.background = element_rect(fill = "black"))

Variations

We can produce some variations of the same map using several parameters and other artifacts.

Using `geom_density_ridges()`

We can use geom_density_ridges() with stat="identity" instead of geom_ridgeline() for creating a similar map:

ggplot() +
  geom_sf(data = region, color = NA, fill = NA) +
  geom_density_ridges(
    data = dem_df, aes(
      x = x, y = y,
      group = y,
      height = elev
    ),
    stat = "identity",
    scale = 25,
    fill = "black",
    color = "white",
    size = .25
  ) +
  theme_void() +
  theme(plot.background = element_rect(fill = "black"))

Land only

If we use geom_ridgeline() it is quite easy to remove some parts of the lines, as the parameter min_height allows us to control the minimum height to be plotted. I found this much more difficult when using geom_density_ridges(), where the equivalent parameter rel_min_height is relative to the overall maximum height.

This is the main reason why we replaced the NA values with zeros, so those parts of the string can be easily removed.

ggplot() +
  geom_sf(data = region, color = NA, fill = NA) +
  geom_ridgeline(
    data = dem_df, aes(
      x = x, y = y,
      group = y,
      height = elev
    ),
    scale = 25,
    fill = "black",
    color = "white",
    size = .25,
    min_height = 0.1
  ) +
  theme_void() +
  theme(plot.background = element_rect(fill = "black"))

With colors

We can apply different colors to the plot. Note that ggridges only accepts different aes by row, not by column:

# Classify on three different bands

dem_df <- dem_df %>%
  mutate(class = cut_number(y, n = 3))

ggplot() +
  geom_sf(data = region, color = NA, fill = NA) +
  geom_ridgeline(
    data = dem_df, aes(
      x = x, y = y,
      group = y,
      height = elev,
      color = class
    ),
    scale = 25,
    fill = "black",
    size = .5,
    show.legend = FALSE
  ) +
  theme_void() +
  theme(plot.background = element_rect(fill = "black")) +
  scale_color_manual(values = alpha(
    c(
      "#007A33",
      "white",
      "#007A33"
    ),
    .95
  ))

Combine with another object

For example, using an sf object:

highres <- gisco_get_nuts(
  nuts_id = "ES61",
  resolution = 1
) %>%
  # And project data
  st_transform(25830) %>%
  st_buffer(-5000)

ggplot() +
  geom_sf(data = highres, color = NA, fill = "#007A33", alpha = 0.95) +
  geom_ridgeline(
    data = dem_df, aes(
      x = x, y = y,
      group = y,
      height = elev
    ),
    scale = 25,
    fill = "black",
    color = "white",
    size = .25,
    min_height = 0.1
  ) +
  theme_void() +
  theme(plot.background = element_rect(fill = "black"))

Or adding a frame to the plot:

frame <- as.polygons(dem_agg, extent = TRUE) %>%
  st_as_sf()

ggplot() +
  geom_sf(data = frame, color = "lightblue", fill = NA, size = 2) +
  geom_ridgeline(
    data = dem_df, aes(
      x = x, y = y,
      group = y,
      height = elev
    ),
    scale = 25,
    fill = "black",
    color = "white",
    size = .25
  ) +
  theme_void() +
  theme(plot.background = element_rect(fill = "black"))

References

Craft Jr, H. D. (1970). Radio observations of the pulse profiles and dispersion measures of twelve pulsars. Cornell University.

Mitton, Simon (1977). The Cambridge encyclopaedia of astronomy. Prentice-Hall of Canada.

Lipez, Zachary (2019, June 14). “How Joy Division’s ‘Unknown Pleasures’ image went from underground album cover to a piece of cultural ubiquity” The Washington Post. https://wapo.st/3K6Chsc

White, T. M. (2019). Cartographic Pleasures: Maps Inspired by Joy Division’s Unknown Pleasures Album Art. Cartographic Perspectives, (92), 65–78. https://doi.org/10.14714/CP92.1536

Redondo, Daniel (2020, January 25). “Mapas estilo Joy Division con QGIS y R.” https://danielredondo.com/blog/2020-01-25-joy_division/

Other versions of the story credit drummer Stephen Morris for finding it. ↑

Corona timelapse

Mon, 14 Mar 2022 00:00:00 +0100

Travel restrictions amidst the COVID crisis across time - A German perspective

1 min.

Project discontinued

In April 2021, my brother Diego and I saw the need for a friendly and automated interface to the meticulous and ever-changing restrictions that the German authorities imposed on travel abroad amid the COVID crisis.

Despite the drastic variations in this regard that most foreign countries have experienced during the last year, the mild character of the currently predominant Omicron variant has finally led Germany to lift all COVID-related obstacles to international travel. The long-awaited contemplation of an all-green world map has filled us with joy, but, to be honest, it has also rendered our website quite boring, no matter how many languages we have translated it into (6 as of now 🇩🇪 🇬🇧 🇪🇸 🇫🇷 🇵🇱 🇹🇷).

To compensate for this, we have put all the pieces together to produce a chronology of the COVID crisis through the lenses of the Robert Koch Institut (RKI), the German entity that was responsible for COVID risk assessment of international areas. Most of the effort was already made, since we have been scraping RKI’s information (via scrapy) for almost one year. To complete the puzzle, we only needed to apply our method to the old risk assessment reports that had been issued before we started the project. That is, we have just combined our already developed scraping muscle with the Archive.org Wayback Machine as provided by Evan Sangaline, and we have of course worked around the inconsistencies of German bureaucracy.

After all, we hope that corona-atlas remains boring and that our world map remains green. Now it is finally time for quite some Wanderlust!

Insets with ggplot2 and tmap - and mapsf!

Thu, 03 Mar 2022 00:00:00 +0100

A map on a map

3 min.

This post is dedicated to Dominic Royé, AKA \@dr_xeo

A common challenge when creating maps is how to include an inset map in your visualization. An inset map is nothing more than a smaller map usually included in a corner that may provide additional context to the overall map. It is also useful for representing spatial units that may form part of a country but whose geographical location would result in an imperfect visualization, or for including small units that would otherwise not be shown on the map.

I have already covered this using the base plot() function, but this time I show how to produce these insets using the ggplot2 and tmap packages. In short: use the cowplot package.

Test case: Canary Islands as an inset

In this example, I create a map of Spain using mapSpain and an inset for the Canary Islands.

The “true” map of Spain is:

library(mapSpain)
library(sf)
library(ggplot2)
library(dplyr)

regions <- esp_get_ccaa(moveCAN = FALSE)

ggplot(regions) +
  geom_sf()

I use a different CRS for each part of Spain. In the case of mainland Spain, I use ETRS89 / UTM 30N (EPSG:25830) and for the Canary Islands I use REGCAN95 / UTM 28N (EPSG:4083).

main <- regions %>%
  filter(ccaa.shortname.es != "Canarias") %>%
  st_transform(25830)

ggplot(main) +
  geom_sf()

island <- regions %>%
  filter(ccaa.shortname.es == "Canarias") %>%
  st_transform(4083)

ggplot(island) +
  geom_sf()

So that was easy! Just a couple of maps using ggplot2. Let’s start mixing and matching!

On ggplot2

We have already created two quick maps with ggplot2. Now, to produce our map with insets we will:

Produce two plots: the main plot and the subplot, providing a minimal style. We will store them as ggplot objects.
Combine both objects with cowplot.

# Main plot
main_gg <- ggplot(main) +
  geom_sf() +
  theme_void() +
  theme(
    plot.background = element_rect(fill = "grey85", colour = NA),
    # Add a bit of margin on the bottom left
    # We will place the inset there
    plot.margin = margin(l = 80, b = 80)
  )

# Sub plot
sub_gg <- ggplot(island) +
  geom_sf() +
  theme_void() +
  # Add a border to the inset
  theme(
    panel.border = element_rect(fill = NA, colour = "black"),
    plot.background = element_rect(fill = "grey95")
  )

We have our objects in place, and now is when the magic happens! With cowplot, we can combine both maps into a single one. You may need to play a bit with the parameters x, y, hjust and vjust of the subplot to improve the placement:

library(cowplot)

ggdraw() +
  draw_plot(main_gg) +
  draw_plot(sub_gg,
    height = 0.2,
    x = -0.25,
    y = 0.08
  )

Note also that this approach is valid not only for maps, but for all types of plots produced by ggplot2, since this package is not specific to map objects:

# Combining non-spatial plots
library(palmerpenguins)

mass_flipper <- ggplot(
  data = penguins,
  aes(
    x = flipper_length_mm,
    y = body_mass_g
  )
) +
  geom_point(aes(
    color = species,
    shape = species
  ),
  size = 3,
  alpha = 0.8
  ) +
  theme_minimal() +
  scale_color_manual(values = c("darkorange", "purple", "cyan4"))

flipper_hist <- ggplot(data = penguins, aes(x = flipper_length_mm)) +
  geom_histogram(aes(fill = species),
    alpha = 0.5,
    position = "identity",
    show.legend = FALSE
  ) +
  scale_fill_manual(values = c("darkorange", "purple", "cyan4")) +
  theme_void() +
  theme(plot.background = element_rect(fill = "white"))


# Nonsense plot!
ggdraw() +
  draw_plot(mass_flipper) +
  draw_plot(flipper_hist,
    scale = 0.25,
    y = 0.3,
    x = -0.2
  )

On tmap

We can follow a similar approach with tmap. In version 3.x.x (there is a new revamped version under development), we can use tmap_grob() to convert the tmap objects to the objects that cowplot can handle.

library(tmap)

main_tmap <- tm_shape(main) +
  tm_polygons() +
  tm_layout(
    inner.margins = c(.3, .3, 0, 0),
    frame = FALSE
  )


main_tmap <- tmap_grob(main_tmap)

sub_tmap <- tm_shape(island) +
  tm_polygons()

sub_tmap <- tmap_grob(sub_tmap)

Once we have these new “grobs”, we can use the same approach as the one we applied to ggplot2 objects.

ggdraw() +
  draw_plot(main_tmap) +
  draw_plot(sub_tmap,
    height = 0.3,
    x = -0.2
  )

Update: On mapsf

Timotheé Giraud (AKA \@rgeomatic), the developer of mapsf, also shared how to create inset maps using that package:

library(mapsf)

mf_map(main)
mf_inset_on(island, pos = "bottomright", cex = .3)
mf_map(island)
box(lwd = .5)
mf_inset_off()

Beautiful maps with R (IV): Fun with flags revisited

Fri, 28 Jan 2022 00:00:00 +0100

Any picture as a basemap

2 min.

On 27 Jan. 2022 my package rasterpic was accepted on CRAN (Hooray!). This package geotags images, using a spatial object (from sf or terra) as a geographic reference.

I tweeted about that, and it seems to have received good feedback from the #rspatial community:

#rspatial Do we need a package for using our own pictures as base maps? I don’t know, but anyway we have it! {rasterpic} 📦 is now on CRAN, and we can convert our pngs to spatial rasters like this https://t.co/fpoollARoN pic.twitter.com/l9o7rQwdgX
— dieghernan ن (@dhernangomez) January 27, 2022

I also received an interesting reply to this from Hefin Ioan Rhys @HRJ21:

Ooh I think a map with countries filled with their own flag would be poppin'.
— Hefin Ioan Rhys (@HRJ21) January 28, 2022

That reminds me of a previous post that I wrote when I added some new functions to the cartography package, now replaced by the mapsf package.

With rasterpic, we now have an alternative tool for creating maps using images, and this quick post shows you how to do it.

I will replicate the Africa map presented in my previous plot, but this time I will use newer packages, such as giscoR, and the development version of ggspatial (not released yet), which adds support for SpatRaster objects in ggplot2. The flags will be extracted from the GitHub repository https://github.com/hampusborgos/country-flags.

# Development version of ggspatial
# devtools::install_github("paleolimbot/ggspatial")
library(ggspatial)
library(ggplot2)
library(giscoR)
library(dplyr)
library(rasterpic)

# For country names
library(countrycode)

world <- gisco_get_countries(epsg = 3857)
africa <- gisco_get_countries(region = "Africa", epsg = 3857)

# Base map of Africa
plot <- ggplot(world) +
  geom_sf(fill = "grey90") +
  theme_minimal() +
  theme(panel.background = element_rect(fill = "lightblue"))

plot +
  # Zoom on Africa
  coord_sf(
    xlim = c(-2000000, 6000000),
    ylim = c(-4000000, 5000000)
  )

Now, let’s add the flags with a loop:

# We paste the ISO2 code to each African country
africa$iso2 <- countrycode(africa$ISO3_CODE, "iso3c", "iso2c")

# Get flags from repo - low quality to speed up the code
flagrepo <- "https://raw.githubusercontent.com/hjnilsson/country-flags/master/png250px/"

# Loop and add
for (iso in africa$iso2) {
  # Download pic and plot
  imgurl <- paste0(flagrepo, tolower(iso), ".png")
  tmpfile <- tempfile(fileext = ".png")
  download.file(imgurl, tmpfile, quiet = TRUE, mode = "wb")

  # Raster
  x <- africa %>% filter(iso2 == iso)
  x_rast <- rasterpic_img(x, tmpfile, crop = TRUE, mask = TRUE)
  plot <- plot + layer_spatial(x_rast)
}

plot +
  geom_sf(data = africa, fill = NA) +
  # Zoom on Africa
  coord_sf(
    xlim = c(-2000000, 6000000),
    ylim = c(-4000000, 5000000)
  )

Corona Atlas

Fri, 30 Apr 2021 00:00:00 +0200

Interactive map of the international COVID-19 risk areas as designated by the German authorities.

1 min.

Project discontinued

Visit https://dieghernan.github.io/corona-atlas.de/

Interactive map of the international COVID-19 risk areas as designated by the German authorities.

The data is updated periodically from the website of the Robert Koch Institute.

Data scraping is performed in Python with scrapy. The scraper also uses pandas and pycountry.

For the prototype version, map visualization was created with R and generated via rmarkdown using leaflet, giscoR and some packages included in the tidyverse. For the deployment, map logic has moved to JavaScript to support multiple languages.

spain-munic-bot

Fri, 29 Jan 2021 00:00:00 +0100

A Twitter bot written in R.

1 min.

Project discontinued

🤖 Twitter bot: random municipalities of Spain 🇪🇸 with mapSpain, posted with rtweet via a GitHub Action

Hi! I am a bot 🤖 that tweets a random map of a Spanish municipality with its name, province and autonomous community (and an inset map of Spain showing the region and the community). I run 🏃‍♀️ every 20 minutes.

I have a website!

Tweets by spainmunic

📦 R packages

Core packages used in the project are:

mapSpain for the location of the municipalities, base polygons, coordinates and imagery.
osmdata for the streets.
tmap for plotting.
rtweet for posting.

Other packages used are sf, dplyr and other common supporting packages.

Leaflet-providersESP

Mon, 26 Oct 2020 00:00:00 +0100

Plugin for Leaflet.js

1 min.

Leaflet-providersESP is a plugin for Leaflet that contains configurations for various tile layers provided by public agencies in Spain.

Demo

Full docs and examples are available at https://dieghernan.github.io/leaflet-providersESP/.

This code generates a Leaflet map with a layer provided by Leaflet-providersESP.

  
    </span>Minimal page | leaflet-providersESP<span class="nt">
     charset="utf-8" />
     name="viewport" content="width=device-width, initial-scale=1.0" />
    
      rel="stylesheet"
      href="https://unpkg.com/leaflet@1.7.1/dist/leaflet.css"
    />
    
     id="mapid">

All providers

Head/tail breaks in the classInt package

Sun, 05 Apr 2020 00:00:00 +0200

11 min.

There are far more ordinary people (say, 80 percent) than extraordinary people (say, 20 percent), and this is often characterized by the 80/20 principle, based on the observation made by the Italian economist Vilfredo Pareto in 1906 that 80% of land in Italy was owned by 20% of the population. A histogram of the data values for these phenomena would reveal a right-skewed or heavy-tailed distribution. How to map the data with the heavy-tailed distribution?

Jiang (2013)

Abstract

This vignette discusses the implementation of the “Head/tail breaks” style (Jiang (2013)) in the classIntervals() function from the classInt package. A step-by-step example is presented to clarify the method. A case study using spData::afcon is also included, making use of additional packages such as sf.

Introduction

Head/tail breaks is a classification scheme introduced by Jiang (2013) for revealing hierarchies in data with many small values and a few large ones. The related ht-index measures the depth of this hierarchy, rather than being another name for the classification method.

The distributions considered here are strongly right-skewed, with a minority of large values in the head and a majority of small values in the tail. This imbalance can be expressed as “far more small things than large things”.

Power-law and lognormal distributions are examples of heavy-tailed distributions. The head/tail breaks literature also considers exponential distributions under its broader description of this imbalance. Nature, society and finance (Vasicek (2002)) provide examples of rare and extreme events. Taleb (2008) discusses the impact of unexpected extreme events, offering another reason to pay attention to low-frequency observations.

library(classInt)

# 1. Characterization of heavy-tail distributions----
set.seed(1234)
# Pareto distribution a=1 b=1.161 n=1000
sample_par <- 1 / (1 - runif(1000))^(1 / 1.161)
opar <- par(no.readonly = TRUE)
par(mar = c(2, 4, 3, 1), cex = 0.8)
plot(
  sort(sample_par, decreasing = TRUE),
  type = "l",
  ylab = "F(x)",
  xlab = "",
  main = "80/20 principle"
)
abline(
  h = quantile(sample_par, .8),
  lty = 2,
  col = "red3"
)
abline(
  v = 0.2 * length(sample_par),
  lty = 2,
  col = "darkblue"
)
legend(
  "topleft",
  legend = c("F(x): p80", "x: Top 20%"),
  col = c("red3", "darkblue"),
  lty = 2,
  cex = 0.8
)

hist(
  sample_par,
  n = 100,
  xlab = "",
  main = "Histogram",
  col = "grey50",
  border = NA,
  probability = TRUE
)
par(opar)

Breaking method

The method itself consists of a four-step process performed recursively until a stopping condition is satisfied. Given a vector of values \(v = (a_1, a_2, ..., a_n)\), the process can be described as follows:

Compute the arithmetic mean, \(\mu = \frac{1}{n}\sum_{i=1}^{n} a_i\).
Break \(v\) into the \(tail\) and the \(head\): \(tail = \{ a_x \in v | a_x \lt \mu \}\) \(head = \{ a_x \in v | a_x \gt \mu \}\).
Check whether the proportion of observations in the head is at most the chosen threshold: \(\frac{|head|}{|v|} \le threshold\)
If step 3 is TRUE and the head contains at least two observations, replace \(v\) with \(head\) and repeat. Otherwise, stop.

Only values strictly above the mean enter the next iteration. Values equal to the mean are not part of the head. Stopping does not require an exact 50/50 split.

A threshold of 40% provides a practical stopping rule. It is not a statistical test for whether a distribution is heavy-tailed.

The final breaks are the vector of consecutive \(\mu\):

[breaks = (\mu_1, \mu_2, \mu_3, …, \mu_n )]

Step-by-step example

We reproduce here the pseudo-code¹ as per Jiang (2019):

Recursive function Head/tail Breaks:
 Rank the input data from the largest to the smallest
 Break the data into the head and the tail around the mean;
 // the head for those above the mean
 // the tail for those below the mean
 While (head <= 40%):
 Head/tail Breaks (head);
End Function

The following R example uses prop < thr, whereas the pseudocode above uses head <= 40%. At exactly 40%, the R loop stops and the pseudocode continues. This distinction does not affect the example below.

opar <- par(no.readonly = TRUE)
par(mar = c(2, 2, 3, 1), cex = 0.8)
var <- sample_par
thr <- .4
brks <- c(min(var), max(var)) # Initialise with min and max

sum_table <- data.frame(
  iter = 0,
  mu = NA,
  prop = NA,
  n_var = NA,
  n_head = NA
)
# Pars for chart
limchart <- brks
# Iteration
for (i in 1:10) {
  mu <- mean(var)
  brks <- sort(c(brks, mu))
  head <- var[var > mu]
  prop <- length(head) / length(var)
  stopit <- prop < thr & length(head) > 1
  sum_table <- rbind(
    sum_table,
    c(i, mu, prop, length(var), length(head))
  )
  hist(
    var,
    main = paste0("Iter ", i),
    breaks = 50,
    col = "grey50",
    border = NA,
    xlab = "",
    xlim = limchart
  )
  abline(v = mu, col = "red3", lty = 2)
  ylabel <- max(hist(var, breaks = 50, plot = FALSE)$counts)
  labelplot <- paste0("PropHead: ", round(prop * 100, 2), "%")
  text(
    x = mu,
    y = ylabel,
    labels = labelplot,
    cex = 0.8,
    pos = 4
  )
  legend(
    "right",
    legend = paste0("mu", i),
    col = c("red3"),
    lty = 2,
    cex = 0.8
  )
  if (isFALSE(stopit)) {
    break
  }
  var <- head
}
par(opar)

The head proportion varies across iterations and reaches 50% in the fourth, which stops the loop. It does not increase monotonically.

iter	mu	prop	n_var	n_head
1	5.6755	14.5%	1000	145
2	27.2369	21.38%	145	31
3	85.1766	19.35%	31	6
4	264.7126	50%	6	3

The break vector includes the original minimum and maximum, plus the means computed during the iterations. Here the original data are sample_par, since var is replaced by the head inside the loop.

Implementation in the classInt package

The implementation in classIntervals() reproduces these results:

ht_sample_par <- classIntervals(sample_par, style = "headtails")
brks == ht_sample_par$brks

## [1] TRUE TRUE TRUE TRUE TRUE TRUE

As stated in Jiang (2013), the number of breaks is determined by the data. However, the thr parameter can help adjust the final number. A lower value of thr can yield fewer breaks, while a larger thr can increase the number if the underlying distribution follows the “far more small things than large things” principle.

opar <- par(no.readonly = TRUE)
par(mar = c(2, 2, 2, 1), cex = 0.8)

pal1 <- c("wheat1", "wheat2", "red3")
# Minimum: single break
print(paste("number of breaks", length(classIntervals(sample_par, style = "headtails", thr = 0)$brks - 1)))
plot(
  classIntervals(sample_par, style = "headtails", thr = 0),
  pal = pal1,
  main = "thr = 0"
)

# Two breaks
print(paste("number of breaks", length(classIntervals(sample_par, style = "headtails", thr = 0.2)$brks - 1)))
plot(
  classIntervals(sample_par, style = "headtails", thr = 0.2),
  pal = pal1,
  main = "thr = 0.2"
)

# Default breaks: 0.4
print(paste("number of breaks", length(classIntervals(sample_par, style = "headtails")$brks - 1)))
plot(classIntervals(sample_par, style = "headtails"),
  pal = pal1,
  main = "thr = Default"
)

# Maximum breaks
print(paste("number of breaks", length(classIntervals(sample_par, style = "headtails", thr = 1)$brks - 1)))
plot(
  classIntervals(sample_par, style = "headtails", thr = 1),
  pal = pal1,
  main = "thr = 1"
)
par(opar)

For this example, even thr = 0 retains the mean as an internal break. The returned vector also contains the minimum and maximum, so this gives two classes, not one.

Case study

Jiang (2013) states that "the new classification scheme is more natural than the natural breaks in finding the groupings or hierarchy for data with a heavy-tailed distribution." (p. 482), referring to Jenks’ natural breaks method. In this case study, we compare headtails vs. fisher, which is the alias for the Fisher-Jenks algorithm and is always preferred to the jenks style (see ?classIntervals). For this example, we will use the afcon dataset from the spData package, plus some additional spatial information to create the data visualization.

library(spData)
data(afcon, package = "spData")

Let’s have a look at the top 10 values and the distribution of the variable totcon (index of total conflict 1966-78):

# Top10
knitr::kable(head(afcon[order(afcon$totcon, decreasing = TRUE), c("name", "totcon")], 10))

opar <- par(no.readonly = TRUE)
par(mar = c(4, 4, 3, 1), cex = 0.8)
hist(afcon$totcon,
  n = 20,
  main = "Histogram",
  xlab = "totcon",
  col = "grey50",
  border = NA,
)
plot(
  density(afcon$totcon),
  main = "Distribution",
  xlab = "totcon",
)
par(opar)

The values for Egypt (EG) and Sudan (SU) stand out from the rest. The histogram shows a strongly right-skewed pattern with many small values and a few large ones.

In addition to headtails and fisher, we use quantile to compare the classification styles. Quantile breaks are based on ranks rather than the size of the gaps between observations.

Applying the three aforementioned methods to break the data:

brks_ht <- classIntervals(afcon$totcon, style = "headtails")
print(brks_ht)
# Same number of classes for "fisher"
nclass <- length(brks_ht$brks) - 1
brks_fisher <- classIntervals(afcon$totcon,
  style = "fisher",
  n = nclass
)
print(brks_fisher)

brks_quantile <- classIntervals(afcon$totcon,
  style = "quantile",
  n = nclass
)
print(brks_quantile)

pal1 <- c("wheat1", "wheat2", "red3")
opar <- par(no.readonly = TRUE)
par(mar = c(2, 2, 2, 1), cex = 0.8)
plot(brks_ht, pal = pal1, main = "headtails")
plot(brks_fisher, pal = pal1, main = "fisher")
plot(brks_quantile, pal = pal1, main = "quantile")
par(opar)

The top three classes of headtails contain five observations, whereas those of fisher contain 13. In this example, headtails gives more detail at the upper end of the distribution.

The next plot compares density estimates of the rescaled totcon values and the class assignments from each method. The original values are rescaled to [1, nclass] and shifted by -0.5 for the visual comparison.

# Helper function to reescale values
help_reescale <- function(x, min = 1, max = 10) {
  r <- (x - min(x)) / (max(x) - min(x))
  r <- r * (max - min) + min
  return(r)
}
afcon$ecdf_class <- help_reescale(afcon$totcon,
  min = 1 - 0.5,
  max = nclass - 0.5
)
afcon$ht_breaks <- cut(afcon$totcon,
  brks_ht$brks,
  labels = FALSE,
  include.lowest = TRUE
)

afcon$fisher_breaks <- cut(afcon$totcon,
  brks_fisher$brks,
  labels = FALSE,
  include.lowest = TRUE
)

afcon$quantile_break <- cut(afcon$totcon,
  brks_quantile$brks,
  labels = FALSE,
  include.lowest = TRUE
)

opar <- par(no.readonly = TRUE)
par(mar = c(4, 4, 1, 1), cex = 0.8)
plot(
  density(afcon$ecdf_class),
  ylim = c(0, 0.8),
  lwd = 2,
  main = "",
  xlab = "class"
)
lines(density(afcon$ht_breaks), col = "darkblue", lty = 2)
lines(density(afcon$fisher_breaks), col = "limegreen", lty = 2)
lines(density(afcon$quantile_break),
  col = "red3",
  lty = 2
)
legend("topright",
  legend = c(
    "Continuous", "headtails",
    "fisher", "quantile"
  ),
  col = c("black", "darkblue", "limegreen", "red3"),
  lwd = c(2, 1, 1, 1),
  lty = c(1, 2, 2, 2),
  cex = 0.8
)
par(opar)

In this example, the class assignments from headtails retain more of the original imbalance. By contrast, quantile aims for similar numbers of observations per class, regardless of the gaps between values.

We now compare the methods using proportional-symbol maps. Symbol size represents totcon, while color distinguishes the classes.

The first map uses proportional symbols without class-based colors, providing a reference for the three classified maps.

library(sf)
library(giscoR)
library(cartography)

opar <- par(no.readonly = TRUE)

par(
  mfrow = c(2, 2),
  mar = c(1, 1, 1, 1),
  bg = "white"
)
africa <- gisco_get_countries(resolution = 60, region = "Africa", epsg = 3857)

afcon.sf <- st_as_sf(afcon, crs = 4326, coords = c("x", "y"))
afcon.sf <- st_transform(afcon.sf, st_crs(africa))
# afcon.sf <- st_join(africa[, "admin"], afcon.sf)
afcon.sf <- afcon.sf[order(afcon.sf$totcon), ]



# High granularity map
plot(st_geometry(africa), col = "grey80", border = NA)
propSymbolsLayer(
  afcon.sf,
  var = "totcon",
  inches = 0.2,
  col = adjustcolor("grey10", alpha.f = 0.5),
  border = NA
)
title(main = "High granularity map")

# Quantile

pal <- hcl.colors(5, palette = "inferno", alpha = 0.6)
plot(st_geometry(africa), col = "grey80", border = NA)
propSymbolsTypoLayer(
  afcon.sf,
  var = "totcon",
  inches = 0.2,
  col = pal,
  border = NA,
  legend.var.pos = "n",
  legend.var2.pos = "bottomleft",
  var2 = "quantile_break"
)
title(main = "Quantile")


# Fisher
plot(st_geometry(africa), col = "grey80", border = NA)
propSymbolsTypoLayer(
  afcon.sf,
  var = "totcon",
  inches = 0.2,
  col = pal,
  border = NA,
  legend.var.pos = "n",
  legend.var2.pos = "bottomleft",
  var2 = "fisher_breaks"
)
title(main = "Fisher")

# Head Tails
plot(st_geometry(africa), col = "grey80", border = NA)
propSymbolsTypoLayer(
  afcon.sf,
  var = "totcon",
  inches = 0.2,
  col = pal,
  border = NA,
  legend.var.pos = "n",
  legend.var2.pos = "bottomleft",
  var2 = "ht_breaks"
)
title(main = "Head Tails")
par(opar)

Compared with the unclassified proportional-symbol map, headtails makes the most extreme values easier to distinguish. The quantile style groups observations by rank, while fisher provides an intermediate view in this example.

It is also important to note that headtails and fisher reveal different information that can be useful depending on the context. While headtails highlights the outliers, it fails to provide good clustering on the tail, while fisher seems to reflect these patterns better. This can be observed in the values of Western Africa and the Niger River Basin, where headtails does not highlight any special cluster of conflicts, while fisher suggests a potential cluster consistent with the unclassified map. This can be confirmed in the histogram generated previously, where a concentration of totcon around 1,000 is visible.

References

Jiang, Bin. 2013. "Head/Tail Breaks: A New Classification Scheme for Data with a Heavy-Tailed Distribution." The Professional Geographer 65 (3): 482–94. DOI.

———. 2019. "A Recursive Definition of Goodness of Space for Bridging the Concepts of Space and Place for Sustainability." Sustainability 11 (15): 4091. DOI.

Jiang, Bin, Xintao Liu, and Tao Jia. 2013. "Scaling of Geographic Space as a Universal Rule for Map Generalization." Annals of the Association of American Geographers 103 (4): 844–55. DOI.

Jiang, Bin, and Junjun Yin. 2013. "Ht-Index for Quantifying the Fractal or Scaling Structure of Geographic Features." Annals of the Association of American Geographers 104 (3): 530–40. DOI.

Taleb, Nassim Nicholas. 2008. The Black Swan: The Impact of the Highly Improbable. 1st ed. London: Random House.

Vasicek, Oldrich. 2002. "Loan Portfolio Value." Risk, December, 160–62.

The method implemented in classInt corresponds to head/tail breaks 1.0, as named in this article. ↑

COVID19 microsite

Sat, 04 Apr 2020 00:00:00 +0200

Tracking the outbreak in Spain by region

1 min.

Project discontinued

Visit the microsite with maps and official data on the impact of COVID-19 in Spain.

https://dieghernan.github.io/COVID19 [In Spanish]

Overall deaths in Spain due to COVID-19: evolution

New features in the cartography package

Mon, 17 Feb 2020 00:00:00 +0100

Vignette of the package expansion

6 min.

Introduction

This document describes the new features added to cartography in version 2.4.0 by dieghernan and already available on CRAN.

Those new features are:

hatchedLayer and legendHatched functions.
pngLayer and getPngLayer functions.
wordcloudLayer function.

These functions don’t handle sp objects on purpose, favoring sf instead.

Installation

#install.packages("cartography")
library(cartography)
packageVersion("cartography")
## [1] '3.0.0'

Hatched map

Version of typology/choropleth maps using a hatched filling. This is particularly useful for maps that need to be printed in black and white, such as academic papers. These maps are also useful for representing overlapping dimensions.

Example 1

library(sf)
library(jsonlite)
library(dplyr)

#Shape
cntries = st_read("https://ec.europa.eu/eurostat/cache/GISCO/distribution/v2/countries/geojson/CNTR_RG_20M_2016_3035.geojson",
                  stringsAsFactors = FALSE)
## Reading layer `CNTR_RG_20M_2016_3035' from data source `https://ec.europa.eu/eurostat/cache/GISCO/distribution/v2/countries/geojson/CNTR_RG_20M_2016_3035.geojson' using driver `GeoJSON'
## Simple feature collection with 257 features and 6 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -7142317 ymin: -9160665 xmax: 16932290 ymax: 15428010
## Projected CRS: ETRS89-extended / LAEA Europe

# Include trade blocks
df <- fromJSON("https://raw.githubusercontent.com/dieghernan/Country-Codes-and-International-Organizations/master/outputs/Countrycodesfull.json")
ISO_memcol <- function(df,
                       orgtosearch) {
  ind <- match(orgtosearch, unlist(df[1, "org_id"]))
  or <- lapply(1:nrow(df), function(x)
    unlist(df[x, "org_member"])[ind])
  or <- data.frame(matrix(unlist(or)), stringsAsFactors = F)
  names(or) <- orgtosearch
  df2 <- as.data.frame(cbind(df, or, stringsAsFactors = F))
  return(df2)
}
df <- ISO_memcol(df, "EU")
df <- ISO_memcol(df, "EFTA")
df <- ISO_memcol(df, "EuroArea")


cntries = merge(cntries,
                df,
                by.x = "ISO3_CODE",
                by.y = "ISO_3166_3",
                all.x = TRUE)

library(cartography)


#Limits EU
#Plot base map
plot(
  st_geometry(cntries),
  xlim = c(2200000, 7150000),
  ylim = c(1380000, 5500000),
)
plot(st_geometry(cntries), add = TRUE)
plot(st_geometry(cntries[!is.na(cntries$EU),]), col = "grey60", add = TRUE)
plot(st_geometry(cntries[!is.na(cntries$EFTA),]), col = "black", add = TRUE)
#Add hatching
hatchedLayer(
  cntries[!is.na(cntries$EuroArea),],
  pattern = "right2left",
  col = "white",
  density = 3,
  add = TRUE
)
legendTypo(
  "topright",
  title.txt = "",
  categ = c("EU", "EFTA"),
  col = c("grey60", "black"),
  nodata = FALSE
)

legendHatched(
  "right",
  title.txt = "Within EU",
  categ = "Euro\nArea",
  patterns = "right2left",
  frame = TRUE
)
layoutLayer(
  title = "European Trade Blocks",
  theme = "grey.pal",
  sources = "© EuroGeographics for the administrative boundaries.",
  author =  paste0("cartography ", packageVersion("cartography")),
  scale = 500,
  frame = TRUE
)

Example 2

library(sf)
library(cartography)

# Plot World
plot(
  cntries$geometry,
  col = "white",
  xlim = c(2200000, 7150000),
  ylim = c(1380000, 5500000),
)
#Add layers for non european area - left2right
NOEUR = subset(cntries, CONTINENT.EN != "Europe" | is.na(CONTINENT.EN))
hatchedLayer(
  NOEUR,
  pattern = "left2right",
  add = TRUE,
  #Basic usage
  density = 2,
  #Densify default grid
  lwd = 1.2,
  lty = 3,
  col = "grey50"
)            #Formatting

#Extract Europe Regions
EUR = subset(cntries, CONTINENT.EN == "Europe" & SUBREGION.EN != "Western Asia")[, "SUBREGION.EN"]
levels <- sort(unique(EUR$SUBREGION.EN))


#Plot Regions
# First element with zigzag
hatchedLayer(EUR[EUR$SUBREGION.EN == levels[1], ],
             add = TRUE,
             density = 4,
             pattern = "zigzag")

#dot with parms
hatchedLayer(
  EUR[EUR$SUBREGION.EN == levels[2], ],
  add = TRUE,
  pattern = "dot",
  pch = 4,
  cex = 0.5,
  density = 3.5)

#vertical
hatchedLayer(EUR[EUR$SUBREGION.EN == levels[3], ],
             add = TRUE,
             pattern = "vertical",
             density = 3)

#another dot
hatchedLayer(EUR[EUR$SUBREGION.EN == levels[4], ],
             add = TRUE,
             pattern = "dot",
             pch= 15,
             density = 3.5)

#create legend
legendHatched(
  pos = "topright",
  title.txt = "",
  title.cex = 0.1,
  categ = c(levels, "Others"),
  patterns = c("zigzag",
               "dot",
               "vertical",
               "dot",
               "left2right"),
  pch = c(4,15),
  lty = c(1, 1, 3),
  col = c(rep("black", length(levels)), "grey50"),
  frame = TRUE
)

layoutLayer(
  title = "Regions of Europe (United Nations)",
  theme = "grey.pal",
  sources = "© EuroGeographics for the administrative boundaries.",
  author =  paste0("cartography ", packageVersion("cartography")),
  scale = 500,
  frame = TRUE
)

legendHatched honors the order of the parameters. In this case, two dot patterns are present, so pch = c(4,15) takes care of that. Note that three line-type patterns are also plotted, as in the previous case, and lty = c(1, 1, 3) respects that order.

Example 3

hatchedLayer could also be useful for plotting several dimensions on the same map, in combination with another function of the package.

library(sf)
library(cartography)



#Warsaw Pact - roughly mapped via UN Region
wp <- subset(cntries, SUBREGION.EN == "Eastern Europe")

#European Union - after Brexit
eu <- subset(cntries, !is.na(EU))

#Euro Area
ea <- subset(cntries, !is.na(EuroArea))

#Flags for plotting
flag = ifelse(cntries$ISO3_CODE %in% eu$ISO3_CODE,
              "European Union",
              cntries$CONTINENT.EN)


flag = ifelse(!flag %in% c("Europe", "European Union"), "Other",
              flag)
cntries$flag <- flag



#Plot lims
plot(
  st_geometry(cntries),
  xlim = c(2200000, 7150000),
  ylim = c(1380000, 5500000)
)


#Combine with typoLayer
typoLayer(
  x = cntries,
  var = "flag",
  legend.pos = "n",
  legend.values.order = c("European Union",
                          "Europe",
                          "Other"),
  col = c("#A6BDDB",
          "#FEFEE9",
          "#E0E0E0"),
  add = TRUE
)

#hatching
hatchedLayer(
  x = ea,
  pattern = "left2right",
  cellsize = 100000,
  add = TRUE
)

hatchedLayer(
  x = wp,
  pattern = "vertical",
  col="red",
  cellsize = 75000,
  add = TRUE
)

#Legend
legendHatched(
  pos = "right",
  title.txt = "Economic Region",
  categ = c(
    "Euro Area",
    "Former \nWarsaw Pact",
    "European Union",
    "Europe",
    "Other"
  ),
  patterns = c("left2right", "vertical"),
  col = c("black", "red", "#A6BDDB",
          "#FEFEE9",
          "#E0E0E0"),
  ptrn.bg = c("white", "white", "#A6BDDB",
              "#FEFEE9",
              "#E0E0E0"),
  frame = TRUE
)

layoutLayer(
  title = "European Countries - Blocks",
  theme = "blue.pal",
  sources = "© EuroGeographics for the administrative boundaries.",
  author =  paste0("cartography ", packageVersion("cartography")),
  scale = 500,
  frame = TRUE
)

PNG layer

This new capability geotags a .png file, effectively converting the image into a tile. This allows the user to create visual maps by masking an image to the shape of a POLYGON/MULTIPOLYGON.

For high-quality PNG maps, it is recommended to plot your map on an SVG graphics device.

Example 1

library(sf)
library(cartography)

cntries2 = st_read("https://ec.europa.eu/eurostat/cache/GISCO/distribution/v2/countries/geojson/CNTR_RG_20M_2016_3857.geojson",
                  stringsAsFactors = FALSE)
## Reading layer `CNTR_RG_20M_2016_3857' from data source `https://ec.europa.eu/eurostat/cache/GISCO/distribution/v2/countries/geojson/CNTR_RG_20M_2016_3857.geojson' using driver `GeoJSON'
## Simple feature collection with 257 features and 6 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -20037510 ymin: -30240970 xmax: 20037510 ymax: 18446790
## Projected CRS: WGS 84 / Pseudo-Mercator

cntries2 = merge(cntries2,
                df,
                by.x = "ISO3_CODE",
                by.y = "ISO_3166_3",
                all.x = TRUE)

africa=subset(cntries2, CONTINENT.EN =="Africa") %>%
  arrange(desc(area_km2))


#Get bigger countries

plot(st_geometry(africa[1:20,]), bg="lightblue")


plot(st_geometry(cntries2), col="grey90", add=TRUE)

#Iterate for Africa
#Get flags from repo - low quality to speed up the vignette
flagrepo = "https://raw.githubusercontent.com/hjnilsson/country-flags/master/png250px/"


for (i in 1:nrow(africa)) {
  cntry <- as.character(st_drop_geometry(africa[i, "ISO_3166_2"]))
  a = getPngLayer(africa[i,],
                  paste(flagrepo, tolower(cntry), ".png", sep = ""))
  pngLayer(a, add = TRUE)
}
#Add borders
plot(st_geometry(cntries2), add = TRUE, col = NA, lwd=0.4)

layoutLayer(
  title = "Flags of Africa",
  theme = "green.pal",
  sources = "© EuroGeographics for the administrative boundaries.",
  author =  paste0("cartography ", packageVersion("cartography")),
  scale = 500,
  frame = TRUE
)

Example 2

library(sf)
library(cartography)

box <- c(xmin=2200000, xmax=7150000,ymin=1380000, ymax=5500000)
nuts0 <-  st_crop(cntries, box)

UK = nuts0 %>% filter(id == "UK")
url = "https://upload.wikimedia.org/wikipedia/commons/thumb/b/b7/Flag_of_Europe.svg/800px-Flag_of_Europe.svg.png"


EU=getPngLayer(nuts0,url, mask=FALSE)
pngLayer(EU, alpha=100)
urluk=flagrepo = "https://raw.githubusercontent.com/hjnilsson/country-flags/master/png250px/gb.png"

UKpng=getPngLayer(UK,urluk)

pngLayer(UKpng, add=TRUE)

`wordcloudLayer()`

A word cloud (or tag cloud) is a visual representation of text data. In a mapping context, this representation is useful for including several pieces of information at a glance.

Word cloud layers fitted into a map shape provide a good trade-off between physical location, scale and labels. The size and color of the words are based on the frequency of the factor being plotted, highlighting the most frequent terms.

Example 1

eu$dens=eu$pop/eu$area_km2

wordcloudLayer(eu,txt="NAME.EN",freq="dens",
               fittopol = TRUE,
               nclass=7,
               cex.maxmin = c(3,1) )
br=getBreaks(eu$dens, nclass=7)

legendChoro(breaks=br, title.txt="Pop Density",col=carto.pal("blue.pal",7))
layoutLayer(
  title = "Population Density in Europe",
  theme = "blue.pal",
  sources = "© EuroGeographics for the administrative boundaries.",
  author =  paste0("cartography ", packageVersion("cartography")),
  scale = 500,
  frame = TRUE
)

Example 2

# Genres from MB--
#Import genres
collected = read.csv("./assets/data/US_MB.csv", stringsAsFactors = F)
collected=collected[-1,] %>% arrange(desc(n))

set.seed(1234)

library(rnaturalearth)
shape = ne_countries(country="united states of america", returnclass = "sf") %>% st_transform(3857)
#Get main polygon
shape = shape %>% st_union %>% st_cast("POLYGON")
areas = st_area(shape)
shape = shape[areas == max(areas)]

set.seed(1234)
points = 100
#Sample regular
points = st_sample(shape, points + 5, type = "regular")

#Center points

centr=st_centroid(shape, of_largest_polygon = TRUE)
f=st_distance(points,centr)
dfpoints=st_sf(dist=f,
               geometry=points) %>%
  arrange((dist))


#Create df
points=st_sf(collected[1:100,],
             geometry=st_geometry(dfpoints)[1:100])

plot(shape, col="grey95", border = NA)
wordcloudLayer(points,
               txt="genre",
               freq="n",
               cex.maxmin =  c(3, 0.6),
               col=c("#ba478f", "#eb743b"),
               nclass=7,
               add=TRUE)
layoutLayer(title="Most frequent genres on US",
            sources="Musicbrainz",
              author =  paste0("cartography ", packageVersion("cartography")),
            theme="orange.pal")

We’ll miss you, UK

Thu, 06 Feb 2020 00:00:00 +0100

Brexit and the consequences

1 min.

This is just a short post regarding Brexit. Setting aside economic, political and social considerations, there is another consequence: there is now one fewer country in the EU.

We will miss you, UK. We wish you the best.

library(cartography)
library(sf)
library(giscoR)


#EU
eu <- giscoR::gisco_countrycode %>% filter(eu)

# Download maps
NUTS1 <- gisco_get_nuts(epsg = 3035, country = eu$ISO3_CODE, nuts_level = 1)


UK <- gisco_get_countries(country =  "GBR", epsg = 3035)

noplot = c("FRY", "ES7", "PT2", "PT3")
NUTS1_Clean = NUTS1 %>% subset(!NUTS_ID %in% noplot) %>%
  group_by(CNTR_CODE) %>% summarise(a=dplyr::n())

# Flag image
url = "https://upload.wikimedia.org/wikipedia/commons/thumb/b/b7/Flag_of_Europe.svg/800px-Flag_of_Europe.svg.png"

#Mask UK
flagcut = getPngLayer(NUTS1_Clean,
                       url)
# Full extent
flag = getPngLayer(NUTS1_Clean,
                       url, mask = FALSE)


par(mar = c(0, 0, 0, 0))
tilesLayer(flag, alpha = 150)
tilesLayer(flagcut, bgalpha = 0, add = T)
plot(st_geometry(UK),
     col = "white",
     border = NA,
     add = TRUE)

Beautiful maps with R (III): Patterns and hatched maps

Thu, 12 Dec 2019 00:00:00 +0100

A solution for black-and-white and academic maps

2 min.

Updated 17 February 2020: All these pieces of work are already available in cartography >v.2.4.0 through the hatchedLayer and legendHatched functions. Just install it via install.packages("cartography"). A dedicated blog post with examples is available at this link.

In this post, I show how to produce different filling patterns that can be added over your shapefiles with the cartography package.

Required R packages

library(sf)
library(dplyr)
library(giscoR)
library(cartography)

DE <- gisco_get_countries(country = "Germany", epsg = 3857)

Let’s see how it works.

par(
  mfrow = c(3, 4),
  mar = c(1, 1, 1, 1),
  cex = 0.5
)
hatchedLayer(DE, "dot")
title("dot")
hatchedLayer(DE, "text", txt = "Y")
title("text")
hatchedLayer(DE, "diamond", density = 0.5)
title("diamond")
hatchedLayer(DE, "grid", lwd = 1.5)
title("grid")
hatchedLayer(DE, "hexagon", col = "blue")
title("hexagon")
hatchedLayer(DE, "horizontal", lty = 5)
title("horizontal")
hatchedLayer(DE, "vertical")
title("vertical")
hatchedLayer(DE, "left2right")
title("left2right")
hatchedLayer(DE, "right2left")
title("right2left")
hatchedLayer(DE, "zigzag")
title("zigzag")
hatchedLayer(DE, "circle")
title("circle")

Let’s play a little bit more with some of the additional features of the function:

par(mar = c(1, 1, 1, 1), mfrow = c(2, 3))
plot(st_geometry(DE))
hatchedLayer(
  DE,
  "dot",
  pch = 10,
  density = 0.5,
  cex = 2,
  col = "darkblue",
  add = T
)
plot(st_geometry(DE))
hatchedLayer(
  DE,
  "dot",
  pch = 21,
  col = "red",
  bg = "green",
  cex = 1.25,
  add = T
)
plot(st_geometry(DE), col = "grey")
hatchedLayer(
  DE,
  "text",
  txt = "DE",
  density = 1.1,
  col = "white",
  add = T
)
plot(st_geometry(DE), col = "blue")
hatchedLayer(
  DE,
  "horizontal",
  lty = 3,
  cellsize = 150 * 1000,
  add = T
)
hatchedLayer(DE, "zigzag", lwd = 2, col = "red")
plot(st_geometry(DE), border = "orange", lwd = 2)
hatchedLayer(DE,
  "left2right",
  density = 2,
  col = "orange",
  add = T
)

Adding legends: the `legendHatched` function

As a complementary function, there is also legendHatched. The main parameters are:

pos, title.txt, title.cex, values.cex, categ, cex and frame: See ?cartography::legendTypo.
patterns: Vector of patterns to be created for each element on categ.
ptrn.bg: Background of the legend box for each categ.
ptrn.text: Text to be used for each categ="text", as a single value or a vector.
dot.cex: cex of each categ="dot", as a single value or a vector.
text.cex: Text size of each categ="text", as a single value or a vector.
As in the case of the hatchedLayer function, different graphical parameters can be passed (lty, lwd, pch, bg on points).

Note that it is also possible to create solid legends by setting col and ptrn.bg to the same color. Parameters respect the order of the categ variable.

par(mar = c(0, 0, 0, 0), mfrow = c(1, 1))
plot(st_geometry(DE)) # Null geometry
legendHatched(
  title.txt = "Example 1",
  categ = c("a", "b"),
  patterns = "dot",
  pch = c(16, 23),
  frame = T
)
legendHatched(
  pos = "left",
  title.txt = "Example 2",
  categ = c("c", "d", "other text"),
  patterns = c("text", "zigzag"),
  ptrn.text = c("s", "pp"),
  ptrn.bg = "grey80",
  col = c("red", "blue")
)

legendHatched(
  pos = "topright",
  title.txt = "Example 3",
  categ = c("e", "f", "solid"),
  patterns = c("circle", "left2right"),
  ptrn.bg = c("orange", "yellow", "green"),
  col = c("white", "white", "green"),
  lty = c(2, 4),
  lwd = c(1, 3)
)


legendHatched(
  pos = "bottomright",
  title.txt = "Example 4",
  values.cex = 1.2,
  categ = c("h", "i", "j", "k"),
  patterns = c("grid", "diamond", "horizontal", "dot"),
  cex = 2,
  pch = 22,
  col = "white",
  ptrn.bg = "black",
  bg = "pink"
)

I hope that you find these functions useful. Enjoy, and happy mapping!

Quick R: Inset maps

Thu, 07 Nov 2019 00:00:00 +0100

An alternative using plot()

3 min.

How to place an inset map in R? There are many solutions out there using the ggplot2 package (see Drawing beautiful maps programmatically with R, sf and ggplot2 by Mel Moreno and Mathieu Basille). However, I like the old reliable plot function, so the question is: is there another way?

There is. I found inspiration here and I just applied it to a map.

Required R packages

library(sf)
library(dplyr)
library(rnaturalearth)

Mimicking Moreno & Basille

I present here an alternative version of Drawing beautiful maps programmatically with R, sf and ggplot2, so the bulk of the detail can be found there. I focus only on the plot() side.

world <- ne_countries(scale = "medium", returnclass = "sf")
USA <- subset(world, admin == "United States of America")

# Plot mainland USA----
par(mar = c(0, 0, 0, 0))
plot(
  st_geometry(world %>%
    st_transform(2163)),
  xlim = c(-2500000, 2500000),
  ylim = c(-2300000, 730000),
  col = "#F6E1B9",
  border = "#646464",
  bg = "#C6ECFF"
)
plot(
  st_geometry(USA) %>% st_transform(2163),
  col = "#FEFEE9",
  border = "black",
  add = T
)

# Plot Alaska----
plot(
  st_geometry(world %>%
    st_transform(3467)),
  xlim = c(-2400000, 1600000),
  ylim = c(200000, 2500000),
  col = "#F6E1B9",
  border = "#646464",
  bg = "#C6ECFF"
)
plot(
  st_geometry(USA) %>% st_transform(3467),
  col = "#FEFEE9",
  border = "black",
  add = T
)

# Plot Hawaii----
plot(
  st_geometry(world %>%
    st_transform(4135)),
  xlim = c(-161, -154),
  ylim = c(18, 23),
  col = "#F6E1B9",
  border = "#646464",
  bg = "#C6ECFF"
)
plot(
  st_geometry(USA) %>% st_transform(4135),
  col = "#FEFEE9",
  border = "black",
  add = T
)

Insetting

From now on, I focus on the inset part, using the fig argument of par(). Quoting statmethods:

(…) think of the full graph area as going from (0,0) in the lower left corner to (1,1) in the upper right corner. The format of the fig= parameter is a numerical vector of the form c(x1, x2, y1, y2)(…) fig= starts a new plot, so to add to an existing plot use new=TRUE.

With x1 and y1 as the starting points and x2, y2 as the final points, we can set up those parameters and adjust the final placement of the insets. Additionally, I added a box around the insets using bbox(). I didn’t mimic Moreno & Basille here and I just worked it out by myself.

par(mar = c(0, 0, 0, 0))
plot(
  st_geometry(world %>%
    st_transform(2163)),
  xlim = c(-2500000, 2500000),
  ylim = c(-2300000, 730000),
  col = "#F6E1B9",
  border = "#646464",
  bg = "#C6ECFF"
)
plot(
  st_geometry(USA) %>% st_transform(2163),
  col = "#FEFEE9",
  border = "black",
  add = T
)
# Alaska
par(
  fig = c(0.01, 0.28, 0.01, 0.33),
  new = TRUE
)
plot(
  st_geometry(world %>%
    st_transform(3467)),
  xlim = c(-2400000, 1600000),
  ylim = c(200000, 2500000),
  col = "#F6E1B9",
  border = "#646464",
  bg = "#C6ECFF"
)
plot(
  st_geometry(USA) %>% st_transform(3467),
  col = "#FEFEE9",
  border = "black",
  add = T
)
box(which = "figure", lwd = 1)

# Hawaii
par(
  fig = c(0.29, 0.45, 0.01, 0.15),
  new = TRUE
)
plot(
  st_geometry(world %>%
    st_transform(4135)),
  xlim = c(-161, -154),
  ylim = c(18, 23),
  col = "#F6E1B9",
  border = "#646464",
  bg = "#C6ECFF"
)
plot(
  st_geometry(USA) %>% st_transform(4135),
  col = "#FEFEE9",
  border = "black",
  add = T
)

box(which = "figure", lwd = 1)

Results may vary depending on the size of the original plot (Mainland USA), your plotting device and the output. However, with a bit of trial and error, it is quite easy to adjust the final result.

As an example, see one of my contributions to Wikimedia Commons, which represents a map of the NUTS3 regions of the European Union. Several countries (France, Portugal, Spain) have overseas territories, so I made a few insets on the right side.

Wikipedia maps (I): Organ donor rates

Wed, 16 Oct 2019 00:00:00 +0200

A choropleth map with R

2 min.

This is a quick post on how to create a map according to the Wikipedia conventions. In this case, I have chosen to plot the international organ donor rates, retrieved on February 10, 2019, although the data refers to 2017 (source: IRODaT).

Web scraping

The first step is to scrape Wikipedia in order to get the final table. To do so, I will use the rvest package. You can get the xpath you want to scrape as explained here.

library(rvest)
library(dplyr)

Base <-
  read_html("https://en.wikipedia.org/wiki/International_organ_donor_rates") %>%
  html_nodes(xpath = '//*[@id="mw-content-text"]/div/table[3]') %>%
  html_table() %>%
  as.data.frame(
    stringsAsFactors = F,
    fix.empty.names = F
  ) %>%
  select(Country,
    RateDonperMill = Number.of.deceased.donors..per.million.of.population
  )

knitr::kable(head(Base, 10), format = "markdown")

Country	RateDonperMill
Argentina	19.60
Armenia	0.00
Australia	21.60
Austria	23.88
Azerbaijan	0.00
Bahrain	4.00
Bangladesh	0.00
Belarus	26.20
Belgium	30.30
Bolivia	0.36

Now we need to choose a good source of maps:

library(sf)
library(giscoR)

# Map import from Eurostat
WorldMap <- gisco_get_countries(resolution = 3, epsg = 3857) %>%
  select(ISO_3166_3 = ISO3_CODE)

Merging everything together

Now let’s join and have a look to see what is going on. We use the countrycode package to retrieve the ISO3 codes of our scraped dataset:

library(countrycode)

Base$ISO_3166_3 <- countrycode(Base$Country, origin = "country.name", destination = "iso3c")


DonorRate <- left_join(
  WorldMap,
  Base
) %>%
  select(
    Country,
    ISO_3166_3,
    RateDonperMill
  )

Make the `.svg` file

As already explained, I would like to follow the Wikipedia conventions, so there are some things to bear in mind:

Obviously, the colors. Wikipedia already provides good guidance for this. I will use the RColorBrewer library, which implements ColorBrewer in R.
In terms of projection, Wikipedia recommends the Equirectangular projection but, as in their own sample of a gradient map, I will use the Robinson projection.
I should also produce an .svg file following the naming convention.

Some libraries remain to be used: RColorBrewer, rsvg and, especially, one of my favorites, cartography:

library(RColorBrewer)
library(cartography)
library(rsvg)

# Create bbox of the world
bbox <- st_linestring(rbind(
  c(-180, 90),
  c(180, 90),
  c(180, -90),
  c(-180, -90),
  c(-180, 90)
)) %>%
  st_segmentize(5) %>%
  st_cast("POLYGON") %>%
  st_sfc(crs = 4326) %>%
  st_transform(crs = "+proj=robin")

# Create SVG
svg(
  "Organ donor rate per million by country gradient map (2017).svg",
  pointsize = 90,
  width =  1600 / 90,
  height = 728 / 90
)

par(mar = c(0.5, 0, 0, 0))
choroLayer(
  DonorRate %>% st_transform("+proj=robin"),
  var = "RateDonperMill",
  breaks = c(0, 5, 10, 20, 30, 40, 50),
  col = brewer.pal(6, "PuBu"),
  border = "#646464",
  lwd = 0.1,
  colNA = "#E0E0E0",
  legend.pos = "left",
  legend.title.txt = "",
  legend.values.cex = 0.25
)

# Bounding box
plot(bbox,
  add = T,
  border = "#646464",
  lwd = 0.2
)

dev.off()

And that’s all. Our .svg file is ready to be included in Wikipedia.

Update: The map is already part of the Wikipedia article.

Beautiful maps with R (II): Fun with flags

Tue, 18 Jun 2019 00:00:00 +0200

Put a picture on your map

3 min.

Updated 29 December 2020: All these pieces of work are already available in cartography >v.2.4.0 in the getPngLayer function. Just install it via install.packages("cartography"). A dedicated blog post with examples is available at this link.

Updated 25 January 2023: cartography is in maintenance mode. You can use rasterpic + tidyterra to achieve the same result, see link1 and link2.

Want to use a flag (or any *.png file) as a background for your map? You are in the right place. I am aware that there are some R packages out there, but we focus here on the option provided by cartography::getPngLayer(), which basically converts your image into a raster. See also Paul Murrell’s article “Raster Images in R Graphics” (The R Journal, Volume 3/1, June 2011).

Required R packages

library(dplyr)
library(sf)
library(cartography)
library(mapSpain)
library(giscoR)

Choosing a good source for our shape

In this post, I am going to plot a map of Spain with its autonomous communities (plus 2 autonomous cities), which are the first-level administrative divisions of the country. Wikipedia shows an initial map that also identifies the flag of each territory.

For that, I will use mapSpain, which uses information from giscoR, whose source is the geodata available in Eurostat. I will also use giscoR to get the world around Spain.

Spain <- esp_get_ccaa(epsg = 3857, res = 3)

World <- gisco_get_countries(epsg = 3857, res = 3)

bboxcan <- esp_get_can_box(epsg = 3857)

# Plot
par(mar = c(0, 0, 0, 0))
plot(st_geometry(Spain),
  col = NA,
  border = NA,
  bg = "#C6ECFF"
)
plot(st_geometry(World),
  col = "#E0E0E0",
  bg = "#C6ECFF",
  add = T
)
plot(st_geometry(Spain), col = "#FEFEE9", add = T)
layoutLayer(
  title = "",
  frame = FALSE,
  scale = 500,
  sources = gisco_attributions(),
  author = "dieghernan, 2019",
)
plot(bboxcan, add = TRUE)

Now we have it! A nice map of Spain with a layout based on the Wikipedia convention for location maps.

Loading the flag

As a first example, I chose Asturias to build my code. The goal here is to create a RasterBrick from the desired *.png file, add the necessary geographical information and use the shape of Asturias to crop the flag.

# 1.Shape---
shp <- Spain %>% filter(ccaa.shortname.es == "Asturias")

# 2.Get flag---

# Masked
url <- "https://upload.wikimedia.org/wikipedia/commons/thumb/3/3e/Flag_of_Asturias.svg/800px-Flag_of_Asturias.svg.png"

flagnomask <- getPngLayer(shp, url, mask = FALSE)

flagmask <- getPngLayer(shp, url, mask = TRUE)

opar <- par(no.readonly = TRUE)
par(mar = c(1, 1, 1, 1), mfrow = c(1, 2))
pngLayer(flagnomask)
plot(st_geometry(Spain), add = T)

# 4.Mask---
pngLayer(flagmask)
plot(st_geometry(Spain), add = T)

par(opar)

Pro tip: Use high-quality *.png files, otherwise the plot will look quite poor. Here I show an extreme example.

MURshp <- Spain %>% filter(ccaa.shortname.es == "Murcia")
MURLow <- getPngLayer(
  MURshp,
  "https://upload.wikimedia.org/wikipedia/commons/thumb/a/a5/Flag_of_the_Region_of_Murcia.svg/100px-Flag_of_the_Region_of_Murcia.svg.png"
)
MURHigh <- getPngLayer(
  MURshp,
  "https://upload.wikimedia.org/wikipedia/commons/thumb/a/a5/Flag_of_the_Region_of_Murcia.svg/1200px-Flag_of_the_Region_of_Murcia.svg.png"
)


# Plot and compare
opar <- par(no.readonly = TRUE)
par(mfrow = c(1, 2), mar = c(1, 1, 1, 1))
plot_sf(MURshp, main = "Low")
pngLayer(MURLow, add = TRUE)

plot_sf(MURshp, main = "High")
pngLayer(MURHigh, add = TRUE)

par(opar)

Now, we are ready to have fun with flags. It’s time to make the flag map of the autonomous communities of Spain.

par(mar = c(0, 0, 0, 0), mfrow = c(1, 1))
plot(Spain %>%
  st_geometry(),
col = NA,
border = NA,
bg = "#C6ECFF"
)
plot(st_geometry(World),
  col = "#E0E0E0",
  add = T
)
plot(st_geometry(bboxcan),
  add = T
)
layoutLayer(
  title = "",
  frame = FALSE,
  sources = "© EuroGeographics for the administrative boundaries",
  author = "dieghernan, 2019",
)
# Andalucia
flag <-
  "https://upload.wikimedia.org/wikipedia/commons/thumb/9/9a/Bandera_de_Andalucia.svg/1000px-Bandera_de_Andalucia.svg.png"
shp <- Spain %>% filter(ccaa.shortname.es == "Andalucía")
pngLayer(getPngLayer(shp, flag), add = TRUE)

# ...more flags
# Go to the source code of this post on GitHub for the full code

plot(st_geometry(Spain),
  col = NA,
  lwd = 2,
  add = T
)

We are done now. If you have suggestions, you can leave a comment. As always, if you enjoyed the post, you can share it on your preferred social network.

Beautiful maps with R (I): Fishnets, honeycombs and pixels

Sun, 02 Jun 2019 00:00:00 +0200

Simplified maps with R

5 min.

Sometimes you want to produce maps with special layouts. I especially like maps with modified geometries, e.g. simplifying the original shapes to squares or dots. When searching the web, I found the fantastic post Fishnets and Honeycomb: Square vs. Hexagonal Spatial Grids by Matt Strimas-Mackey, which was a huge inspiration (by the way, don’t miss his blog, full of very interesting pieces of work).

The only thing I was not completely comfortable with was that the post used the old-fashioned sp package instead of my personal favorite, the sf package. The post was published in 2016, and note that the author has also moved to the sf package since then. So I decided to explore further options with sf.

The approach is similar, using grids over a map and working with them, but with st_make_grid. I also expanded it by grouping the grids and producing dots over the geometries. So basically I produced five variations of the map:

Type	Replacement	Grouped
Fishnet	Square	No
Puzzle	Square	Yes
Honeycomb	Hexagon	No
Hexbin	Hexagon	Yes
Pixel	Dot	No

Required R packages

library(sf)
library(giscoR)
library(dplyr)
library(RColorBrewer)

Working with square grids

Let’s use the square option of st_make_grid and play a bit with it.

GB <- ne_download(50,
  type = "map_subunits",
  returnclass = "sf",
  destdir = tempdir()
) %>%
  subset(CONTINENT == "Europe") %>%
  subset(ADM0_A3 == "GBR")

# Projecting and cleaning
GB <- st_transform(GB, 3857) %>% select(NAME_EN, ADM0_A3)
initial <- GB
initial$index_target <- 1:nrow(initial)
target <- st_geometry(initial)

# Create my own color palette
mypal <- colorRampPalette(c("#F3F8F8", "#008080"))

Warning: The cellsize should be set in the same unit as the projection (in this case, meters). Pay special attention to this because if the parameter is too small, meaning that the grid is too dense, R could crash easily.

grid <- st_make_grid(target,
  50 * 1000,
  # Kms
  crs = st_crs(initial),
  what = "polygons",
  square = TRUE
)

# To sf
grid <- st_sf(index = 1:length(lengths(grid)), grid) # Add index

# We identify the grids that belong to an entity by assessing the centroid
cent_grid <- st_centroid(grid)
cent_merge <- st_join(cent_grid, initial["index_target"], left = F)
grid_new <- inner_join(grid, st_drop_geometry(cent_merge))

# Fishnet
Fishgeom <- aggregate(grid_new,
  by = list(grid_new$index_target),
  FUN = min,
  do_union = FALSE
)

# Let's add the data frame
Fishnet <- left_join(
  Fishgeom %>% select(index_target),
  st_drop_geometry(initial)
) %>%
  select(-index_target)

# Now let's create the puzzle
Puzzlegeom <- aggregate(st_buffer(grid_new, 0.5), # Avoid slivers
  by = list(grid_new$index_target),
  FUN = min,
  do_union = TRUE
) # This changes!!!

Puzzle <- left_join(
  Puzzlegeom %>% select(index_target),
  st_drop_geometry(initial)
) %>%
  select(-index_target)

# Plot
par(mfrow = c(1, 2), mar = c(1, 1, 1, 1), bg = NA)
plot(st_geometry(Fishnet), col = mypal(4), main = "Fishnet")
plot(st_geometry(Puzzle), col = mypal(4), main = "Puzzle")

Going hex

Extremely easy. We just need to change the square parameter of st_make_grid from TRUE to FALSE.

grid <- st_make_grid(target,
  50 * 1000, # Kms
  crs = st_crs(initial),
  what = "polygons",
  square = FALSE # This is the only piece that changes!!!
)
# Make sf
grid <- st_sf(index = 1:length(lengths(grid)), grid) # Add index

# We identify the grids that belong to an entity by assessing the centroid
cent_grid <- st_centroid(grid)
cent_merge <- st_join(cent_grid, initial["index_target"], left = F)
grid_new <- inner_join(grid, st_drop_geometry(cent_merge))

# Honeycomb
Honeygeom <- aggregate(
  grid_new,
  by = list(grid_new$index_target),
  FUN = min,
  do_union = FALSE
)

# Let's add the data frame
Honeycomb <- left_join(
  Honeygeom %>%
    select(index_target),
  st_drop_geometry(initial)
) %>%
  select(-index_target)

# Now let's create the hexbin

Hexbingeom <- aggregate(
  st_buffer(grid_new, 0.5), # Avoid slivers
  by = list(grid_new$index_target),
  FUN = min,
  do_union = TRUE
)

Hexbin <- left_join(
  Hexbingeom %>%
    select(index_target),
  st_drop_geometry(initial)
) %>%
  select(-index_target)

# Plot
par(mfrow = c(1, 2), mar = c(1, 1, 1, 1), bg = NA)
plot(st_geometry(Honeycomb), col = mypal(4), main = "Honeycomb")
plot(st_geometry(Hexbin), col = mypal(4), main = "Hexbin")

Pixel it!

Also quite easy, just a couple more tweaks, still using st_make_grid.

grid <- st_make_grid(target,
  50 * 1000, # Kms
  crs = st_crs(initial),
  what = "centers"
)

# Make sf
grid <- st_sf(index = 1:length(lengths(grid)), grid) # Add index

# We identify the grids that belong to an entity by assessing the centroid
cent_grid <- st_centroid(grid)
cent_merge <- st_join(cent_grid, initial["index_target"], left = F)
grid_new <- st_buffer(cent_merge, 50 * 1000 / 2)
Pixelgeom <- aggregate(
  grid_new,
  by = list(grid_new$index_target),
  FUN = min,
  do_union = FALSE
)
# Let's add the data frame
Pixel <- left_join(
  Pixelgeom %>%
    select(index_target),
  st_drop_geometry(initial)
) %>%
  select(-index_target)

# Plot
par(mfrow = c(1, 1), mar = c(1, 1, 1, 1), bg = NA)
plot(st_geometry(Pixel), col = mypal(4), main = "Pixel")

Wrap up

Finally, I wrapped all that in a function named stdh_gridpol. See the code in my repo:

stdh_gridpol <- function(sf,
                         to = "fishnet",
                         gridsize = as.integer(
                           min(
                             diff(st_bbox(sf)[c(1, 3)]),
                             diff(st_bbox(sf)[c(2, 4)])
                           ) / 40
                         ),
                         sliver = 0.5) {
  if (!unique(st_geometry_type(sf)) %in% c("POLYGON", "MULTIPOLYGON")) {
    stop("Input should be MULTIPOLYGON or POLYGON")
  }
  if (!to %in% c("fishnet", "puzzle", "honeycomb", "hexbin", "pixel")) {
    stop("'to' should be 'fishnet','puzzle','honeycomb','hexbin' or 'pixel'")
  }

  if (class(sf)[1] == "sf") {
    initial <- sf
    initial$index_target <- 1:nrow(initial)
  } else {
    initial <- st_sf(index_target = 1:length(sf), geom = sf)
  }

  target <- st_geometry(initial)

  if (to %in% c("fishnet", "puzzle")) {
    sq <- T
  } else {
    sq <- F
  }
  if (to == "pixel") {
    grid <- st_make_grid(target,
      gridsize,
      crs = st_crs(initial),
      what = "centers"
    )
  } else {
    grid <- st_make_grid(
      target,
      gridsize,
      crs = st_crs(initial),
      what = "polygons",
      square = sq
    )
  }
  grid <- st_sf(index = 1:length(lengths(grid)), grid) # Add index
  if (to == "pixel") {
    cent_merge <- st_join(grid, initial["index_target"], left = F)
    grid_new <- st_buffer(cent_merge, gridsize / 2)
  } else {
    cent_grid <- st_centroid(grid)
    cent_merge <- st_join(cent_grid, initial["index_target"], left = F)
    grid_new <- inner_join(grid, st_drop_geometry(cent_merge))
  }
  if (to %in% c("fishnet", "honeycomb", "pixel")) {
    geom <- aggregate(
      grid_new,
      by = list(grid_new$index_target),
      FUN = min,
      do_union = FALSE
    )
  } else {
    geom <- aggregate(
      st_buffer(grid_new, sliver),
      by = list(grid_new$index_target),
      FUN = min,
      do_union = TRUE
    )
  }
  if (class(initial)[1] == "sf") {
    fin <- left_join(
      geom %>% select(index_target),
      st_drop_geometry(initial)
    ) %>%
      select(-index_target)
    fin <- st_cast(fin, "MULTIPOLYGON")
    return(fin)
  } else {
    fin <- st_cast(geom, "MULTIPOLYGON")
    return(st_geometry(fin))
  }
}
# End of the function-----

fish <- stdh_gridpol(GB, to = "fishnet", gridsize = 50 * 1000)
puzz <- stdh_gridpol(GB, to = "puzzle", gridsize = 50 * 1000)
hon <- stdh_gridpol(GB, to = "honeycomb", gridsize = 50 * 1000)
hex <- stdh_gridpol(GB, to = "hexbin", gridsize = 50 * 1000)
pix <- stdh_gridpol(GB, to = "pixel", gridsize = 50 * 1000)

And that’s it! The function stdh_gridpol has some alert mechanisms, such as accepting only POLYGON or MULTIPOLYGON, and the default value of gridsize is computed so that the shortest dimension has 40 cells.

Leaflet, R, Markdown, Jekyll and GitHub

Mon, 20 May 2019 00:00:00 +0200

Make it work in 6 steps - A short tutorial

5 min.

Recently, I have been struggling when trying to embed a leaflet map created with RStudio on my blog, hosted on GitHub via Jekyll (Spoiler: I succeeded ). In my case, I use the Chulapa remote theme that I created.

Index

The generated ToC will be an ordered list

Ready? Let’s go!

The GitHub/Jekyll part

The first step is to install the required libraries on your GitHub page. As Jekyll basically transforms Markdown into HTML, this step is a matter of what to include and where in your own repository.

1. What to include

This part is not really hard. When looking at the source code of the Leaflet for R site, you can see this chunk:

  
   name="viewport" content="width=device-width, initial-scale=1" />
   href="libs/bootstrap/css/flatly.min.css" rel="stylesheet" />
  
  ...
  
  ...

   href="libs/rstudio_leaflet/rstudio_leaflet.css" rel="stylesheet" />

So now we have it! The only thing to remember is that we need to load the libraries from the leaflet server (https://rstudio.github.io/leaflet), meaning that we have to prepend that URL to the libraries in our installation:

 name="viewport" content="width=device-width, initial-scale=1" />

  href="https://rstudio.github.io/leaflet/libs/bootstrap/css/flatly.min.css"
  rel="stylesheet"
/>

...

...


  href="https://rstudio.github.io/leaflet/libs/rstudio_leaflet/rstudio_leaflet.css"
  rel="stylesheet"
/>

You can have a look at my implementation in ./_includes/leaflet.html.

2. Where to include

This is a little more complicated, depending on the structure of your Jekyll template. The code chunk should be included in the section of your page, so you would need to find where to put it. In the case of Chulapa it is on ./_includes/custom/custom_head_before_css.html.

So now you just have to paste the code that you got in step 1 into the .

Pro tip: For a better performance of the site, include these libraries only when you need them. In my case, I added a custom variable in my YAML front matter for those posts with a leaflet map, leafletmap: true. Go to step 4 for a working example.

The RStudio part

3. Creating the leaflet map

Now it’s time to create a leaflet map with RStudio. I will keep it simple for this post, so I took the first example provided in Leaflet for R - Introduction.

library(leaflet)

m <- leaflet() %>%
  addTiles() %>%  # Add default OpenStreetMap map tiles
  addMarkers(lng=174.768, lat=-36.852, popup="The birthplace of R")
m  # Print the map

It is assumed that you are creating a post with RStudio, so the code presented above should be embedded in an .Rmd file.

4. Set up the YAML front matter

Before knitting your .Rmd, you have to set up the YAML front matter. Here it is essential to set up the option always_allow_html: yes, as well as output: github_document. As an example, this post was created with this front matter:

---
title: Leaflet, R, Markdown, Jekyll and GitHub
subtitle: Make it work in 6 steps - a short tutorial
tags: [R, leaflet, Jekyll, html, maps]
header_img: https://dieghernan.github.io/assets/figs/20190520_imgpost.webp
leafletmap: true
always_allow_html: yes
last_modified_at: 2021-05-30
output:
  md_document:
    variant: gfm
    preserve_yaml: true
---

We are almost there! Now “Knit” your code and get the corresponding .md file.

The Markdown part

5. Modifying the `.md` file

Update: This is no longer needed. I have kept it here for reference. You can skip to the next section.

Have a look at the .md code that you have just created. Although not displayed in the preview, you can see in the file itself a chunk that looks like this:

Actually that chunk is your leaflet map, created with RStudio. You can’t see it now because you are previewing a markdown file in your local PC, and the libraries installed in step 1 are installed on GitHub, but we will solve that later.

Now you just need to paste this piece of code before that chunk:


 id="htmlwidget-7ab57412f7b1df4d5773" style="width:100%;height:216px;" class="leaflet html-widget">


  

 Warning: Have you checked
the YAML front matter of your .md file? Have another look, especially
if you have followed my Pro tip.

Gallery: Size of a leaflet map 

A note: For a complete understanding of this section, it is
recommended to access it on multiple devices, so you can see the
different behavior on different screens. Google Chrome allows you to
simulate different devices (more info
here).

Fixed size

With these examples, you can see how to control the absolute size of the
leaflet map. The disadvantage of this method is that the size would be
fixed for all the devices, so maps sized for smartphones or tablets
wouldn’t look as nice on laptops, and vice versa.

Example 1: 672x480px

Fixed size in pixels. The default on my machine:

leaflet(options = leafletOptions(minZoom = 1.25, maxZoom = 8)) %>%
  addTiles() %>%
  setMaxBounds(-200, -90, 200, 90) %>%
  setView(-3.56948, 40.49181, zoom = 3)





Example 2: 200x300px

Let’s go narrow and long with html "width:200px;height:300px;":

leaflet(
  options = leafletOptions(minZoom = 1.25, maxZoom = 8),
  width = "200px", height = "300px"
) %>%
  addTiles() %>%
  setMaxBounds(-200, -90, 200, 90) %>%
  setView(-3.56948, 40.49181, zoom = 3)





Responsive size

Recommended option. These maps will adapt to the width of your
screen, no matter what device you are using.

Example 3: 100% width

leaflet(
  options = leafletOptions(minZoom = 1.25, maxZoom = 8),
  width = "100%"
) %>%
  addTiles() %>%
  setMaxBounds(-200, -90, 200, 90) %>%
  setView(-3.56948, 40.49181, zoom = 3)



Where in the world?
Mon, 13 May 2019 00:00:00 +0200
	
 				A leaflet map with the places I have flown
    		1 min.
				This is a very personal post, where I just show the map of all the places I have
traveled to by plane.




✈️ 255,622.0 kms. flown so far.

Top cities


  
    
      City
      Country
      N
    
  
  
    
      Bilbao
      Spain
      66
    
    
      London
      United Kingdom
      23
    
    
      Edinburgh
      United Kingdom
      21
    
    
      Barcelona
      Spain
      16
    
    
      Brussels
      Belgium
      8
    
    
      Berlin
      Germany
      6
    
    
      Munich
      Germany
      6
    
    
      Palma de Mallorca
      Spain
      6
    
    
      Amsterdam
      Netherlands
      4
    
    
      Frankfurt
      Germany
      4
    
  


Top countries


  
    
      Country
      Continent
      N
    
  
  
    
      Spain
      Europe
      101
    
    
      United Kingdom
      Europe
      46
    
    
      Germany
      Europe
      18
    
    
      Belgium
      Europe
      8
    
    
      France
      Europe
      6
    
  


Top continents


  
    
      Continent
      Region
      N
    
  
  
    
      Europe
      Southern Europe
      105
    
    
      Europe
      Northern Europe
      52
    
    
      Europe
      Western Europe
      38
    
    
      Asia
      Western Asia
      6
    
    
      North America
      Northern America
      6
    
  


				


Cast a line to subsegments in R
Sun, 05 May 2019 00:00:00 +0200
	
 				User-defined function using the sf package
    		3 min.
				This post introduces a user-defined function for casting sf objects of class
LINESTRING or POLYGON into substrings.

Required R packages

library(sf)
library(rnaturalearth)
library(dplyr)


The problem

The sf package includes st_cast,
a powerful function that transforms geometries into other types of geometries
(i.e. LINESTRING to POLYGON, etc.).

italy <- ne_countries(country = "italy", returnclass = "sf")
italy_pol <- italy %>% st_cast("POLYGON")
italy_lin <- italy_pol %>% st_cast("LINESTRING")
italy_pt <- italy_lin %>% st_cast("POINT")
par(mfrow = c(2, 2), mar = c(1, 1, 1, 1), bg = NA)
plot(st_geometry(italy), col = c("red", "yellow", "blue"), main = "MULTIPOLYGON")
plot(st_geometry(italy_pol), col = c("red", "yellow", "blue"), main = "POLYGON")
plot(st_geometry(italy_lin), col = c("red", "yellow", "blue"), main = "LINE")
plot(st_geometry(italy_pt), col = c("red", "yellow", "blue"), main = "POINT")




What I missed when using st_cast was the possibility of breaking
LINESTRING objects into subsegments:



An approach

One possible solution is to create LINESTRING objects for each consecutive
pair of POINT objects across the original geometry. Let’s check it:

par(mfrow = c(1, 2), mar = c(1, 1, 1, 1))
test <- ne_countries(country = "spain", returnclass = "sf") %>%
  st_cast("POLYGON") %>%
  st_cast("LINESTRING")
plot(st_geometry(test), col = c("red", "yellow", "blue"), main = "LINESTRING")

geom <- lapply(
  1:(length(st_coordinates(test)[, 1]) - 1),
  function(i) {
    rbind(
      as.numeric(st_coordinates(test)[i, 1:2]),
      as.numeric(st_coordinates(test)[i + 1, 1:2])
    )
  }
) %>%
  st_multilinestring() %>%
  st_sfc(crs = st_crs(test)) %>%
  st_cast("LINESTRING")
plot(st_geometry(geom), col = c("red", "yellow", "blue"), main = "AFTER FUNCTION")




The function stdh_cast_substring

Finally, I wrapped the solution into a function and extended it a little bit:


  
    When the input is not a LINESTRING or a POLYGON, it returns an error and
stops.
  
  
    The function accepts sf objects with several rows or sfc objects with
several geometries, and returns the same class as the input. In the case of
sf objects, the input data.frame is added.
  
  
    By default, the output is a MULTILINESTRING geometry. This has the benefit
that the output has the same number of geometries as the input. This can be
modified by setting the to parameter to LINESTRING, which only casts the
MULTILINESTRING object into LINESTRING.
  


stdh_cast_substring <- function(x, to = "MULTILINESTRING") {
  ggg <- st_geometry(x)

  if (!unique(st_geometry_type(ggg)) %in% c("POLYGON", "LINESTRING")) {
    stop("Input should be LINESTRING or POLYGON")
  }
  for (k in 1:length(st_geometry(ggg))) {
    sub <- ggg[k]
    geom <- lapply(
      1:(length(st_coordinates(sub)[, 1]) - 1),
      function(i) {
        rbind(
          as.numeric(st_coordinates(sub)[i, 1:2]),
          as.numeric(st_coordinates(sub)[i + 1, 1:2])
        )
      }
    ) %>%
      st_multilinestring() %>%
      st_sfc()

    if (k == 1) {
      endgeom <- geom
    }
    else {
      endgeom <- rbind(endgeom, geom)
    }
  }
  endgeom <- endgeom %>% st_sfc(crs = st_crs(x))
  if (class(x)[1] == "sf") {
    endgeom <- st_set_geometry(x, endgeom)
  }

  if (to == "LINESTRING") {
    endgeom <- endgeom %>% st_cast("LINESTRING")
  }
  return(endgeom)
}


The function could be improved in terms of performance. Given that it works at
the coordinate level, high-resolution objects introduce some delay.

test100 <- ne_countries(
  continent = "south america",
  returnclass = "sf"
) %>%
  st_cast("POLYGON")

test50 <- ne_countries(50,
  continent = "south america",
  returnclass = "sf"
) %>%
  st_cast("POLYGON")



init <- Sys.time()
t1 <- stdh_cast_substring(test100, "LINESTRING")
end <- Sys.time()
kable(end - init, format = "markdown")



  
    
      x
    
  
  
    
      0.1729319 secs
    
  


init <- Sys.time()
t2 <- stdh_cast_substring(test50, "LINESTRING")
end <- Sys.time()
kable(end - init, format = "markdown")



  
    
      x
    
  
  
    
      2.288558 secs
    
  


par(mfrow = c(1, 1), mar = c(0, 0, 0, 0))
plot(st_geometry(test50), col = NA, bg = "#C6ECFF")
plot(st_geometry(ne_countries(50, returnclass = "sf")), col = "#F6E1B9", border = "#646464", add = T)
plot(st_geometry(test50), col = "#FEFEE9", border = "#646464", add = T)
plot(st_geometry(t2), col = c("red", "yellow", "blue"), add = T, lwd = 0.5)




There is a difference in performance: test100 has 15 polygons decomposed
into 914 substrings, while test50 has 80 polygons decomposed into 8,414
substrings. In that sense, the original st_cast is much faster, although
this solution may work well in most cases.

				


Using the CountryCodes database and sf package
Sat, 27 Apr 2019 00:00:00 +0200
	
 				Vignette of the CountryCodes project
    		2 min.
				This vignette shows how to use the database provided in the GitHub project
Country Codes and International Organizations & Groups
with the sf package in R.

Required R packages

library(sf)
library(jsonlite)
library(rnaturalearth)
library(dplyr)


Reading the data

The first step is to read the provided database (in this example, the json
file) and extract one international organization. In this example, we will plot
the Commonwealth of Nations.

df <- fromJSON("https://raw.githubusercontent.com/dieghernan/Country-Codes-and-International-Organizations/master/outputs/Countrycodesfull.json")
# Identify Commonwealth acronym
orgsdb <- read.csv("https://raw.githubusercontent.com/dieghernan/Country-Codes-and-International-Organizations/master/outputs/CountrycodesOrgs.csv") %>%
  distinct(org_id, org_name)

kable(orgsdb[grep("Common", orgsdb$org_name), ], format = "markdown")



  
    
       
      org_name
      org_id
    
  
  
    
      25
      Commonwealth
      C
    
    
      26
      Central American Common Market
      CACM
    
    
      30
      Caribbean Community and Common Market
      CARICOM
    
    
      42
      Commonwealth of Independent States
      CIS
    
    
      43
      Common Market for Eastern and Southern Africa
      COMESA
    
    
      115
      Southern Cone Common Market
      MERCOSUR
    
  


In our case, the value to search for is C. A function that extracts the
membership from the json database is also provided:

ISO_memcol <- function(df,
                       orgtosearch) {
  ind <- match(orgtosearch, unlist(df[1, "org_id"]))
  or <- lapply(1:nrow(df), function(x) {
    unlist(df[x, "org_member"])[ind]
  })
  or <- data.frame(matrix(unlist(or)), stringsAsFactors = F)
  names(or) <- orgtosearch
  df2 <- as.data.frame(cbind(df, or, stringsAsFactors = F))
  return(df2)
}
df_org <- ISO_memcol(df, "C")


Now df_org has a new column, named C, containing the membership status
of each country.

df_org %>%
  count(C) %>%
  kable(format = "markdown")



  
    
      C
      n
    
  
  
    
      member
      53
    
    
      NA
      222
    
  


df_org %>%
  filter(!is.na(C)) %>%
  select(
    ISO_3166_3,
    NAME.EN,
    C
  ) %>%
  head() %>%
  kable(format = "markdown")



  
    
      ISO_3166_3
      NAME.EN
      C
    
  
  
    
      ATG
      Antigua & Barbuda
      member
    
    
      AUS
      Australia
      member
    
    
      BHS
      Bahamas
      member
    
    
      BGD
      Bangladesh
      member
    
    
      BRB
      Barbados
      member
    
    
      BLZ
      Belize
      member
    
  


Replacing the data on a map

In this example the rnaturalearth package is used for retrieving an sf
object. The code below replaces the data.frame part of the sf object with
the dedicated database.

testmap <- ne_countries(50,
  "countries",
  returnclass = "sf"
) %>%
  select(ISO_3166_3 = adm0_a3) %>%
  full_join(df_org)

# We also add tiny countries
tiny <- ne_countries(50,
  "tiny_countries",
  returnclass = "sf"
) %>%
  select(ISO_3166_3 = adm0_a3) %>%
  full_join(df_org)

# Identify dependencies
ISOCommon <- df_org %>%
  filter(!is.na(C)) %>%
  select(
    ISO_3166_3.sov = ISO_3166_3,
    C_sov = C
  )
tiny <- left_join(tiny, ISOCommon)
tiny$C <- coalesce(tiny$C, tiny$C_sov)


Plotting a map: Wikipedia style

Now we will try to plot a map resembling the one presented in the
Wikipedia page for the
Commonwealth.



The map we will generate is presented in a Robinson projection, and the color
palette will be based on the Wikipedia convention for Orthographic Maps,
since it is the one used in the example.

# Projecting the map
testmap_rob <- st_transform(testmap, "+proj=robin")
tiny_rob <- st_transform(tiny, "+proj=robin")

# Bounding box
bbox <- st_linestring(rbind(
  c(-180, 90),
  c(180, 90),
  c(180, -90),
  c(-180, -90),
  c(-180, 90)
)) %>%
  st_segmentize(5) %>%
  st_cast("POLYGON") %>%
  st_sfc(crs = 4326) %>%
  st_transform(crs = "+proj=robin")

# Plotting
par(mar = c(0, 0, 0, 0), bg = NA)
plot(bbox,
  col = "#FFFFFF",
  border = "#AAAAAA",
  lwd = 1.5
)
plot(
  st_geometry(testmap_rob),
  col = "#B9B9B9",
  border = "#FFFFFF",
  lwd = 0.1,
  add = T
)

plot(
  st_geometry(testmap_rob %>%
    filter(!is.na(C))),
  col = "#346733",
  border = "#FFFFFF",
  lwd = 0.1,
  add = T
)

# Finally, add tiny countries
# All
plot(
  st_geometry(tiny_rob),
  col = "#000000",
  bg = "#B9B9B9",
  add = T,
  pch = 21
)
# Dependencies
plot(
  st_geometry(tiny_rob %>%
    filter(!is.na(C)) %>%
    filter(!is.na(ISO_3166_3.sov))),
  bg = "#C6DEBD",
  col = "#000000",
  pch = 21,
  add = T
)
# Independent
plot(
  st_geometry(tiny_rob %>%
    filter(!is.na(C)) %>%
    filter(is.na(ISO_3166_3.sov))),
  bg = "#346733",
  col = "#000000",
  pch = 21,
  add = T
)
plot(bbox,
  col = NA,
  border = "#AAAAAA",
  lwd = 1.5,
  add = T
)




				


Country codes & organizations
Thu, 11 Apr 2019 00:00:00 +0200
	
 				A database with geocodes
    		2 min.
				Complete database of countries and territories, their different country codes
under common standards (ISO-3166, GEC (formerly FIPS), M49 (UN), STANAG
(NATO), NUTS (EU), etc.) and their membership in different international
organizations.

^{Note that blanks are presented as "" instead of NA since ISO-3166-ALPHA 2 for Namibia is NA.}

Vignette: Using country codes

A. Country codes .csv

Main .csv file
(link)
containing:


  Country and regional codes
  Currency, dependency status and sovereignty information
  Names in English and Spanish as provided by Unicode CLDR
  Additional information (demographics, capital, area, etc.)


Codes included


  
    
      Field
      Description
      Source
      Notes
    
  
  
    
      ISO_3166_1
      ISO 3166-1 numeric
      Wikipedia
       
    
    
      ISO_3166_2
      ISO 3166-1 alpha-2
      Wikipedia
       
    
    
      ISO_3166_3
      ISO 3166-1 alpha-3
      Wikipedia
       
    
    
      FIPS_GEC
      Geopolitical Entities and Codes (GEC)
      CIA World Factbook
      Formerly FIPS 1PUB 10-4
    
    
      STANAG
      STANAG 1059 Country Codes
      CIA World Factbook
      Used by NATO
    
    
      M49
      UN Country Code
      UN Stats
       
    
    
      NUTS
      NUTS 0 code
      Wikipedia
      Used by EU
    
    
      geonameId
      geonameId
      geonames
       
    
    
      continentcode
      geonames Continent Code
      geonames
       
    
    
      regioncode
      UN Regional Code
      UN Stats
       
    
    
      interregioncode
      Interregional Code
      UN Stats
       
    
    
      subregioncode
      Subregion Code
      UN Stats
       
    
    
      ISO_3166_3.sov
      Sovereign code
      Wikipedia, Statoids
      If non-independent
    
  


Other information included


  Currency
  Dependency status
  Names in English and Spanish for countries, continents, regions and capitals
  Population, area (km²) and developed region


B. International organizations .csv

A single .csv file
(link)
describing the membership status of each country across 186 international
organizations.


  
    
      Field
      Description
    
  
  
    
      ISO_3166_2
      Matches Countrycodes .csv
    
    
      ISO_3166_3
      Matches Countrycodes .csv
    
    
      NAME.EN
      Matches Countrycodes .csv
    
    
      source
      Main data source
    
    
      org_name
      Name of the organization
    
    
      org_id
      Abbreviation or internal ID
    
    
      org_member
      Membership status
    
  


C. Full JSON file .json

This .json file
(link)
combines the previous files:

[
  ...
  {
    "ISO_3166_1": 12,
    "ISO_3166_2": "DZ",
    "ISO_3166_3": "DZA",
    "ISO_Official": true,
    "FIPS_GEC": "AG",
    "STANAG": "DZA",
    "M49": 12,
    "geonameId": 2589581,
    "continentcode": "AF",
    "regioncode": 2,
    "subregioncode": 15,
    "currency": "DZD",
    "independent": true,
    "NAME.EN": "Algeria",
    "CONTINENT.EN": "Africa",
    "REGION.EN": "Africa",
    "SUBREGION.EN": "Northern Africa",
    "CAPITAL.EN": "Algiers",
    "NAME.ES": "Argelia",
    "CONTINENT.ES": "Africa",
    "REGION.ES": "África",
    "SUBREGION.ES": "África septentrional",
    "CAPITAL.ES": "Argel",
    "pop": 34586184,
    "area_km2": 2381740,
    "Developed": "Developing",
    "org_id": ["ABEDA", "ACP", "ADB", "AFDB", "AFESD", "AG", "AL",
    ...
    ],
    "org_member": ["member", null, null, "member", "member", null,
    "member",
    ...
    ]
  },
  ...
]


A complementary function (intended to be used in R) has been developed:

ISO_memcol = function(df, #Input dataframe
                      orgtosearch #org id
) {
  ind = match(orgtosearch, unlist(df[1, "org_id"]))
  or = lapply(1:nrow(df), function(x)
    unlist(df[x, "org_member"])[ind])
  or = data.frame(matrix(unlist(or)), stringsAsFactors = F)
  names(or) = orgtosearch
  df2 = as.data.frame(cbind(df, or, stringsAsFactors = F))
  return(df2)
}


D. Data sources


  Wikipedia, the free encyclopedia
    
      ISO-3166
      NUTS
    
  
  The World Factbook - CIA
  United Nations Statistical Division
  geonames
  REST COUNTRIES
  Unicode Common Locale Data Repository (CLDR) Project
  http://www.statoids.com/


				


Bzel
Thu, 25 May 2017 00:00:00 +0200
	
 				A Pebble  project
    		1 min.
				Project discontinued due to the shutdown of Pebble. {: .alert .alert-danger
.p-3 .mx-2 .mb-3 .lead}

Bzel integrates the bezel into your watch face. Display minutes as digits,
as a moving dot or as a fill in the bezel.



::: text-center
Download
from Rebble Appstore
:::

Features


  Clock mode:
    
      Digital: Minute display based on analog movement
      Dot: Moving dot as a minute marker
      Bezel: A bar moving around the bezel as a minute marker
    
  
  Autodetection of 12h/24h mode based on your watch settings


Take your pick


  Pebble Health: Display daily steps.
  Date - Get the weekday based on the language set on your Pebble.
  Weather: Current conditions in °C or °F.
  Choose your weather provider:
    
      Yahoo.com No API key required at this
moment
      Wunderground
      OpenWeatherMap
    
  
  Implementation of pmkey.xyz
  Location based on your selected weather provider
  Night theme displayed between sunset and sunrise


Internationalization

Automatic weekday translation is supported for:


  English
  Spanish
  German
  French
  Portuguese
  Italian


Future developments


  Location for weather
  Square support
  New minute mode: bezel
  Steps
  More health metrics


Screenshots

:::::: row
::: {.col-sm .mb-1}
    

:::

::: {.col-sm .mb-1}
    

:::

::: {.col-sm .mb-1}
    

:::
::::::

Attributions

Fonts


  Weather Icons by Eric Flowers,
modified and fitted to the regular alphabet instead of Unicode values.
  Custom font for icons created via Fontastic.
  Gotham Fonts downloaded from fontsgeek.com


Weather providers

:::::: row
::: col

:::

::: col

:::

::: col

:::
::::::

Others

Master Key is a service for Pebble users. Get a unique
PIN and add API keys for your favorite online services. Please check
www.pmkey.xyz for more info.

License

Developed under license
MIT.

Made in Madrid, Spain ❤️

				


7egment
Wed, 17 May 2017 00:00:00 +0200
	
 				A Pebble  project
    		1 min.
				Project discontinued due to the shutdown of Pebble.

7egment is a customizable watch face based on the classic 7-segment display
that adds your location and current weather information in the language used on
your watch and smartphone.




Download from Rebble Appstore


Features


  Autodetection of 12h/24h mode based on your watch settings
  Internationalization: Automatic weekday translation is supported for:
    
      English
      Spanish
      German
      French
      Portuguese
      Italian
    
  


Options


  Choose colors for the background, frame and text
  Three-band design. Make it match your tie!
  Weather: Current conditions in °C or °F.
  Choose your weather provider:
    
      Wunderground
      OpenWeatherMap
    
  
  Implementation of pmkey.xyz
  Location based on your selected weather provider
  Bluetooth and GPS warnings
  Night theme displayed between sunset and sunrise


Screenshots



        


        


        



Attributions

Fonts


  DSEG7Modern-Bold by Keshikan けしかん.
  Digital7-Regular downloaded from fontsgeek.com


Weather providers










Others

Master Key is a service for Pebble users. Get a unique
PIN and add API keys for your favorite online services. Please check
www.pmkey.xyz for more info.

License

Developed under license MIT.

Made in Madrid, Spain ❤️

				


Sfera
Tue, 14 Mar 2017 00:00:00 +0100
	
 				A Pebble  project
    		1 min.
				Project discontinued due to the shutdown of Pebble.

Sfera for Pebble Time Round is a highly customizable watch face that gets
the most out of the smartwatch’s capabilities. Set your preferences and enjoy this
beautifully designed watch face.




Download from Rebble Appstore


Features


  Clock mode:
    
      Analog: Classic analog watch face
      Digital: Centered hour and minute display based on analog movement
      Dual: Analog and digital, all in one
      Mix: Digital hour and analog minute
    
  
  Autodetection of 12h/24h mode based on your watch settings


Take your pick


  Date - Get the weekday based on the language set on your Pebble.
  Dots as minute markers - choose your color
  Battery level displayed beautifully as an arc near the bezel. Choose your color and, below 20%, it turns red!
  Weather: Current conditions in °C or °F.
  Choose your weather provider:
    
      Yahoo.com No API key required at this moment
      Wunderground
      OpenWeatherMap
    
  
  Implementation of pmkey.xyz
  Location based on your selected weather provider
  Night theme displayed between sunset and sunrise


Internationalization

Automatic weekday translation is supported for:


  English
  Spanish
  German
  French
  Portuguese
  Italian


Future developments


  12/24h mode
  Night theme
  Several weather providers available
  pmkey.xyz implemented for easy API key management


Screenshots



Attributions

Fonts


  Weather Icons by Eric Flowers,
modified and fitted to the regular alphabet instead of Unicode values.
  Custom font for icons created via Fontastic downloaded from fontsgeek.com


Weather providers













Others

Master Key is a service for Pebble users. Get a unique
PIN and add API keys for your favorite online services. Please check
www.pmkey.xyz for more info.

License

Developed under license MIT.

Made in Madrid, Spain ❤️

				


TextWatch Clima
Thu, 16 Feb 2017 00:00:00 +0100
	
 				A Pebble  project
    		1 min.
				Project discontinued due to the shutdown of Pebble.

TextWatch Clima upgrades the classic TextWatch watch face by adding a set of
new capabilities.



Available for all the Classic, Time and Pebble 2 models


Download from Rebble Appstore


Features


  Exact time in natural language
  Autofit to screen




Take your pick


  Date format: Day Month / Month Day
  Fuzzy time option
  Text animation
  Language
    
      Spanish
      English
      German (thanks to rodher)
      French
      Italian
      Portuguese
      Norwegian
      Danish
      Swedish
      Esperanto
      Dutch
      Catalan * More available on request
    
  
  Battery bar display
  Weather: Current conditions in °C or °F.
  Night theme displayed between sunset and sunrise
  Choose your weather provider:
    
      Yahoo No API key required at this moment
      Wunderground
      OpenWeatherMap
    
  
  Implementation of pmkey.xyz




Future developments


  Fuzzy time
  Battery
  Option for animations
  Option for non-pmkey users
  More languages (Swedish, Esperanto…)


Attributions

Fonts


  Weather Icons by Eric Flowers,
modified and fitted to the regular alphabet instead of Unicode values.
  Custom font for icons created via Fontastic.
  Gotham Fonts downloaded from fontsgeek.com


Weather providers













Others


  Master Key is a service for Pebble users. Get a
unique PIN and add API keys for your favorite online services. Please check
www.pmkey.xyz for more info.
  wackyneighbor project DC TextWatch Deluxe


Screenshots



        


        


        



License

Developed under license MIT.

Made in Madrid, Spain ❤️

Field	Description
`ISO_3166_2`	Matches Countrycodes `.csv`
`ISO_3166_3`	Matches Countrycodes `.csv`
`NAME.EN`	Matches Countrycodes `.csv`
`source`	Main data source
`org_name`	Name of the organization
`org_id`	Abbreviation or internal ID
`org_member`	Membership status

City	Country	N
Bilbao	Spain	66
London	United Kingdom	23
Edinburgh	United Kingdom	21
Barcelona	Spain	16
Brussels	Belgium	8
Berlin	Germany	6
Munich	Germany	6
Palma de Mallorca	Spain	6
Amsterdam	Netherlands	4
Frankfurt	Germany	4

Country	Continent	N
Spain	Europe	101
United Kingdom	Europe	46
Germany	Europe	18
Belgium	Europe	8
France	Europe	6

Continent	Region	N
Europe	Southern Europe	105
Europe	Northern Europe	52
Europe	Western Europe	38
Asia	Western Asia	6
North America	Northern America	6

	org_name	org_id
25	Commonwealth	C
26	Central American Common Market	CACM
30	Caribbean Community and Common Market	CARICOM
42	Commonwealth of Independent States	CIS
43	Common Market for Eastern and Southern Africa	COMESA
115	Southern Cone Common Market	MERCOSUR

ISO_3166_3	NAME.EN	C
ATG	Antigua & Barbuda	member
AUS	Australia	member
BHS	Bahamas	member
BGD	Bangladesh	member
BRB	Barbados	member
BLZ	Belize	member

Field	Description	Source	Notes
`ISO_3166_1`	ISO 3166-1 numeric	Wikipedia
`ISO_3166_2`	ISO 3166-1 alpha-2	Wikipedia
`ISO_3166_3`	ISO 3166-1 alpha-3	Wikipedia
`FIPS_GEC`	Geopolitical Entities and Codes (GEC)	CIA World Factbook	Formerly FIPS 1PUB 10-4
`STANAG`	STANAG 1059 Country Codes	CIA World Factbook	Used by NATO
`M49`	UN Country Code	UN Stats
`NUTS`	NUTS 0 code	Wikipedia	Used by EU
`geonameId`	geonameId	geonames
`continentcode`	geonames Continent Code	geonames
`regioncode`	UN Regional Code	UN Stats
`interregioncode`	Interregional Code	UN Stats
`subregioncode`	Subregion Code	UN Stats
`ISO_3166_3.sov`	Sovereign code	Wikipedia, Statoids	If non-independent

One world | Projects, maps and coding

Introducing geobounds

Easy access to administrative boundaries from geoBoundaries

Installation

Getting administrative levels (ADM)

Global Composite Boundaries (CGAZ)

Understanding the data

Caching

When should you use geobounds?

Related packages

rnaturalearth

giscoR

osmdata

Bottom line

Mapping Antarctica

Cool maps from the South Pole

Fixing the geometry

Plotting examples

Graham Bartram’s proposal (1996)

Emblem of the Antarctic Treaty

Antarctica flag redesigned

Implementing group_by count in Liquid

Alternative group_by with Liquid

Happy Valentine’s Day

Do you know the Bonne projection?

Optimize your images with R and reSmush.it

Introducing the resmush package

What is reSmush.it?

Why the resmush package?

Using the resmush package

With local files

With online files

Other alternatives

Beautiful maps with R (V): Point densities

Bertin’s dot density maps with R and GHSL

Libraries

Get the data

Data wrangling

Final plot

Alternative hexagonal grid

References

Star map with R

First things first: the data

Creating a star map with R

Helper functions

Celestial data

Distribution

Data

Hillshade, colors and marginal plots with tidyterra (II)

Libraries

The plain in Spain

The rain in Spain

Creating a modified palette

Marginal plots (finally)

Profiling marginal plots

Putting all the pieces together

Recap

Hillshade, colors and marginal plots with tidyterra (I)

How to overlay SpatRasters

Libraries

Get the data

Hillshading

Selecting colors

Final plot

References

Introducing tidyterra

Easily work with and plot SpatRasters

Wait, volcano is flipped?

Working with SpatRasters

An Easter egg

Unknown pleasures with R

Joyplot elevation maps with ggridges and terra

Creating joyplot maps with R

Variations

Using geom_density_ridges()

Land only

With colors

Combine with another object

References

Corona timelapse

Alternative `group_by` with Liquid

Wait, `volcano` is flipped?

Using `geom_density_ridges()`

`wordcloudLayer()`

Adding legends: the `legendHatched` function

Make the `.svg` file