Affine transformations on Geographical objects with {sf}

Using {ggplot2} and {sf} to demonstrate shifting, scaling and rotating geometrical and geographical objects in R

Figure 1: This plot demonstrates the application of spatial transformations on the Andaman and Nicobar Islands using the `sf` package in R. It showcases four techniques: base mapping, northward shifting, scaling (enlargement), and rotation (90° clockwise), highlighting their effects on spatial geometries. The `facet_wrap` function neatly organizes the transformations for comparison, while `geom_sf` and custom labels enhance the visualization.

How I made this graphic?

Loading required libraries, data import & creating custom functions.

library(sf)        # Simple Features in R
library(terra)     # Handling rasters in R
library(tidyterra) # For plotting rasters in ggplot2
library(magrittr)  # Using pipes with raster objects
library(tidyverse) # All things tidy; Data Wrangling
library(spData)    # Spatial Datasets

# Final plot tools
library(scales)               # Nice Scales for ggplot2
library(fontawesome)          # Icons display in ggplot2
library(ggtext)               # Markdown text support for ggplot2
library(showtext)             # Display fonts in ggplot2
library(colorspace)           # Lighten and Darken colours

#### Base Map
india_states <- read_sf(
  here::here(
    "data",
    "india_map",
    "India_State_Boundary.shp"
  )
)

Visualization Parameters

# Font for titles
font_add_google("Bree Serif",
  family = "title_font"
) 

# Font for the caption
font_add_google("Stint Ultra Condensed",
  family = "caption_font"
) 

# Font for plot text
font_add_google("Stint Ultra Condensed",
  family = "body_font"
) 

mypal <- paletteer::paletteer_d("nbapalettes::pacers_classic")
showtext_auto()

# A base Colour
bg_col <- "white"
seecolor::print_color(bg_col)

# Colour for highlighted text
text_hil <- darken("#862633", 0.2)
seecolor::print_color(text_hil)

# Colour for the text
text_col <- darken("#862633", 0.5)
seecolor::print_color(text_col)


# Define Base Text Size
bts <- 90 

# Caption stuff for the plot
sysfonts::font_add(
  family = "Font Awesome 6 Brands",
  regular = here::here("docs", "Font Awesome 6 Brands-Regular-400.otf")
)
github <- "&#xf09b"
github_username <- "aditya-dahiya"
xtwitter <- "&#xe61b"
xtwitter_username <- "@adityadahiyaias"
social_caption_1 <- glue::glue("<span style='font-family:\"Font Awesome 6 Brands\";'>{github};</span> <span style='color: {text_hil}'>{github_username}  </span>")
social_caption_2 <- glue::glue("<span style='font-family:\"Font Awesome 6 Brands\";'>{xtwitter};</span> <span style='color: {text_hil}'>{xtwitter_username}</span>")
plot_caption <- paste0(
  "**Data:** Census of India", 
  " |  **Code:** ", 
  social_caption_1, 
  " |  **Graphics:** ", 
  social_caption_2
  )
rm(github, github_username, xtwitter, 
   xtwitter_username, social_caption_1, 
   social_caption_2)

# Add text to plot-------------------------------------------------
plot_title <- "Affine transformations with {sf}"

plot_subtitle <- "Scaling Shifting and Rotating geographical simple feature objects with the power of {sf}."

Exploratory Data Analysis and Wrangling

df1 <- india_states |>
  filter(State_Name == "Andaman & Nicobar") |> 
  st_cast("POLYGON") |> 
  mutate(id = row_number()) |> 
  filter(id <= 10) |> 
  mutate(
    name = case_when(
      id %in% c(4,8, 9, 7) ~ "Nicobar Islands",
      .default = "Andaman Islands"
    )
  ) |> 
  select(-State_Name)


# Pull out only sfc class (i.e. geometry for Andaman Islands)
a1 <- df1 |> 
  filter(name == "Andaman Islands") |> 
  st_geometry()

# Pull out only sfc class (i.e. geometry for Nicobar Islands)
n1 <- df1 |> 
  filter(name == "Nicobar Islands") |> 
  st_geometry()

# Compute centroid of n1 (Nicobar Islands): useful in future 
# scaling and rotating
n1_centroid <- st_centroid(n1)

# Custom function defined for rotating something by "a" degrees
rotation = function(a){
  r = a * pi / 180 #degrees to radians
  matrix(c(cos(r), sin(r), -sin(r), cos(r)), nrow = 2, ncol = 2)
} 

row1 <- c(a1, n1) |> 
  st_as_sf() |> 
  mutate(
    island = c(rep("Andaman Islands", 6), 
               rep("Nicobar Islands", 4)),
    description = "Base Map of Andaman and Nicobar Islands",
    facet_title = "1. Base Map"
  )

row2 <- c(
    a1, 
    # Shifting the Nicobar Islands by 400 km north
    n1 |> 
      add(c(0, 400000)) |> 
      st_set_crs(st_crs(n1))
  ) |> 
  st_as_sf() |> 
  mutate(
    island = c(rep("Andaman Islands", 6), 
               rep("Nicobar Islands", 4)),
    description = "Shiting Nicobar Islands 400 km northwards",
    facet_title = "2. Shifting"
  )

row3 <- c(
    a1, 
    # Scaling the Nicobar Islands: enlarging them 3 times
    (n1 - n1_centroid) |> 
      multiply_by(3) |> 
      add(n1_centroid) |> 
      st_set_crs(st_crs(n1))
  ) |> 
  st_as_sf() |> 
  mutate(
    island = c(rep("Andaman Islands", 6), 
               rep("Nicobar Islands", 4)),
    description = "Scaling Nicobar Islands: enlarging 3 times",
    facet_title = "3. Scaling"
  )

row4 <- c(
    a1, 
    # Scaling the Nicobar Islands: enlarging them 3 times
    (n1 - n1_centroid) |> 
      multiply_by(rotation(90)) |> 
      add(n1_centroid) |> 
      st_set_crs(st_crs(n1))
  ) |> 
  st_as_sf() |> 
  mutate(
    island = c(rep("Andaman Islands", 6), 
               rep("Nicobar Islands", 4)),
    description = "Rotating Nicobar Islands clockwise 90 degrees",
    facet_title = "4. Rotating"
  )

df2 <- bind_rows(
  row1, row2, row3, row4
)
rm(row1, row2, row3, row4, a1, n1, n1_centroid)

The Base Plot

g <- df2 |> 
  ggplot() +
  geom_sf(
    mapping = aes(
      fill = island
    ),
    colour = "black",
    linewidth = 0.4
  ) +
  geom_label(
    data = df2 |>
              st_drop_geometry() |> 
              distinct(description, facet_title),
    mapping = aes(
      x = 93.5,
      y = 8.5,
      label = str_wrap(description, 10)
    ),
    hjust = 0.5,
    family = "caption_font",
    vjust = 0,
    size = bts / 2.5,
    lineheight = 0.3,
    fill = alpha("white", 0.5),
    colour = text_col,
    label.size = NA
  ) +
  coord_sf(
    default_crs = 4326,
    expand = FALSE
  ) +
  facet_wrap(
    ~facet_title,
    nrow = 1
  ) +
  scale_fill_manual(values = mypal) +
  labs(
    title = plot_title,
    subtitle = plot_subtitle,
    caption = plot_caption,
    x = NULL, y = NULL, 
    fill = NULL
  ) +
  theme_minimal(
    base_family = "caption_font",
    base_size = bts
  ) +
  theme(
    
    # Overall Plot
    legend.position = "bottom",
    plot.title.position = "plot",
    plot.margin = margin(5,2,5,2, "mm"),
    text = element_text(
      lineheight = 0.3,
      colour = text_col,
      hjust = 0
    ),
    panel.grid = element_line(
      colour = alpha(text_hil, 0.2),
      linewidth = 0.3,
      linetype = 3
    ),
    
    # Panels
    panel.spacing = unit(2, "mm"),
    strip.text = element_text(
      hjust = 0.5,
      size = 2 * bts,
      colour = text_col
    ),
    
    # Axes
    axis.text = element_text(
      margin = margin(0,0,0,0, "mm"),
      vjust = 0.5
    ),
    axis.text.x = element_text(
      size = 0.5 * bts,
      hjust = 0.5,
      margin = margin(0,0,0,0, "mm")
    ),
    
    # Legend
    legend.margin = margin(-20,0,0,0, "mm"),
    legend.text = element_text(
      margin = margin(0,0,0,3, "mm"),
      size = 1.5 * bts
    ),
    # Labels
    plot.title = element_text(
      size = 2 * bts,
      family = "title_font",
      hjust = 0.5,
      margin = margin(5,0,5,0, "mm"),
      colour = text_hil
    ),
    plot.subtitle = element_text(
      margin = margin(0,0,5,0, "mm"),
      size = 1.5 * bts,
      hjust = 0.5
    ),
    plot.caption = element_textbox(
      hjust = 0.5,
      margin = margin(10,0,0,0, "mm"),
      size = 0.8 * bts,
      colour = text_hil
    )
  )

ggsave(
  filename = here::here(
    "data_vizs",
    "sf_affine_transformations.png"
  ),
  plot = g,
  width = 400,
  height = 500,
  units = "mm",
  bg = bg_col
)

Savings the thumbnail for the webpage

# Saving a thumbnail

library(magick)
# Saving a thumbnail for the webpage
image_read(here::here("data_vizs", 
                      "sf_affine_transformations.png")) |> 
  image_resize(geometry = "x400") |> 
  image_write(
    here::here(
      "data_vizs", 
      "thumbnails", 
      "sf_affine_transformations.png"
    )
  )

Session Info

library(sf)        # Simple Features in R
library(terra)     # Handling rasters in R
library(tidyterra) # For plotting rasters in ggplot2
library(magrittr)  # Using pipes with raster objects
library(tidyverse) # All things tidy; Data Wrangling
library(spData)    # Spatial Datasets

# Final plot tools
library(scales)               # Nice Scales for ggplot2
library(fontawesome)          # Icons display in ggplot2
library(ggtext)               # Markdown text support for ggplot2
library(showtext)             # Display fonts in ggplot2
library(colorspace)           # Lighten and Darken colours

sessioninfo::session_info()$packages |> 
  as_tibble() |> 
  select(package, 
         version = loadedversion, 
         date, source) |> 
  arrange(package) |> 
  janitor::clean_names(
    case = "title"
  ) |> 
  gt::gt() |> 
  gt::opt_interactive(
    use_search = TRUE
  ) |> 
  gtExtras::gt_theme_espn()

Table 1: R Packages and their versions used in the creation of this page and graphics