inst/doc/visualization.R

In hexify: Equal-Area Hex Grids on the 'Snyder' 'ISEA' 'Icosahedron'

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 5
)
library(hexify)
library(sf)
library(ggplot2)

## ----sample-data--------------------------------------------------------------
cities <- data.frame(
  name = c("Vienna", "Paris", "Madrid", "Berlin", "Rome",
           "Warsaw", "Prague", "Brussels", "Amsterdam", "Lisbon"),
  lon = c(16.37, 2.35, -3.70, 13.40, 12.50,
          21.01, 14.42, 4.35, 4.90, -9.14),
  lat = c(48.21, 48.86, 40.42, 52.52, 41.90,
          52.23, 50.08, 50.85, 52.37, 38.72)
)

grid <- hex_grid(area_km2 = 10000)
result <- hexify(cities, lon = "lon", lat = "lat", grid = grid)

## ----plot-basic, fig.width=7, fig.height=5------------------------------------
plot(result, main = "European Cities")

## ----plot-custom, fig.width=7, fig.height=5-----------------------------------
plot(result,
     grid_fill = "steelblue",
     grid_border = "darkblue",
     grid_alpha = 0.6,
     basemap_fill = "ivory",
     basemap_border = "gray50",
     main = "Custom Styling")

## ----plot-no-basemap, fig.width=7, fig.height=5-------------------------------
plot(result,
     basemap = FALSE,
     grid_fill = "forestgreen",
     grid_border = "darkgreen",
     main = "No Basemap")

## ----plot-extent, fig.width=7, fig.height=5-----------------------------------
plot(result,
     crop = TRUE,
     crop_expand = 0.2,
     main = "Custom Extent (20% padding)")

## ----plot-points, fig.width=7, fig.height=5-----------------------------------
plot(result,
     show_points = TRUE,
     point_color = "red",
     main = "Cities with Points")

## ----point-sizes, fig.width=7, fig.height=7-----------------------------------
oldpar <- par(mfrow = c(2, 2))

plot(result, show_points = TRUE, point_size = "small",
     point_color = "red", main = "small (~5%)")
plot(result, show_points = TRUE, point_size = "normal",
     point_color = "red", main = "normal (~10%)")
plot(result, show_points = TRUE, point_size = "large",
     point_color = "red", main = "large (~20%)")
plot(result, show_points = TRUE, point_size = "very large",
     point_color = "red", main = "very large (~35%)")

par(oldpar)

## ----plot-points-custom, fig.width=7, fig.height=5----------------------------
plot(result,
     show_points = TRUE,
     point_size = "small",
     point_color = "darkblue",
     point_alpha = 0.8,
     grid_fill = "lightyellow",
     grid_border = "orange",
     main = "Custom Point Styling")

## ----plot-no-jitter, fig.width=7, fig.height=5--------------------------------
plot(result,
     show_points = TRUE,
     jitter = FALSE,
     point_color = "red",
     main = "Points at Cell Centers (No Jitter)")

## ----ggplot-basic, fig.width=7, fig.height=5----------------------------------
hexify_heatmap(result, basemap = "world", title = "European Cities")

## ----ggplot-custom, fig.width=7, fig.height=5---------------------------------
hexify_heatmap(result, basemap = "world") +
  labs(
    title = "Major European Cities",
    subtitle = "Assigned to ISEA hexagonal grid cells",
    caption = "Data: Sample cities"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(face = "bold", size = 14),
    panel.grid = element_blank()
  )

## ----ggplot-layers, fig.width=7, fig.height=5---------------------------------
# Get the city coordinates
city_points <- st_as_sf(cities, coords = c("lon", "lat"), crs = 4326)

hexify_heatmap(result, basemap = "world", title = "Cities with Labels") +
  geom_sf(data = city_points, color = "red", size = 2) +
  geom_sf_text(data = city_points, aes(label = name),
               nudge_y = 0.8, size = 3, color = "darkgray") +
  coord_sf(xlim = c(-5, 25), ylim = c(45, 55))

## ----heatmap-setup------------------------------------------------------------
# Simulate observation data with counts
set.seed(42)
n_obs <- 100
obs_data <- data.frame(
  lon = c(rnorm(60, 10, 8), rnorm(40, 0, 10)),
  lat = c(rnorm(60, 48, 5), rnorm(40, 52, 6)),
  count = rpois(n_obs, lambda = 50)
)

# Hexify
grid <- hex_grid(area_km2 = 10000)
obs_hex <- hexify(obs_data, lon = "lon", lat = "lat", grid = grid)

## ----heatmap-basic, fig.width=8, fig.height=6---------------------------------
hexify_heatmap(
  obs_hex,
  value = "count",
  title = "Observation Counts"
)

## ----heatmap-colors, fig.width=8, fig.height=6--------------------------------
hexify_heatmap(
  obs_hex,
  value = "count",
  colors = "YlOrRd",
  title = "Yellow-Orange-Red Palette"
)

## ----heatmap-palettes, fig.width=8, fig.height=4------------------------------
p1 <- hexify_heatmap(obs_hex, value = "count", colors = "viridis",
                     title = "viridis", xlim = c(-20, 35), ylim = c(35, 65))
p2 <- hexify_heatmap(obs_hex, value = "count", colors = "YlGnBu",
                     title = "YlGnBu", xlim = c(-20, 35), ylim = c(35, 65))

gridExtra::grid.arrange(p1, p2, ncol = 2)

## ----heatmap-extent, fig.width=8, fig.height=6--------------------------------
hexify_heatmap(
  obs_hex,
  value = "count",
  xlim = c(-20, 35),
  ylim = c(35, 65),
  title = "Zoomed to Region",
  legend_title = "Count"
)

## ----heatmap-basemap, fig.width=8, fig.height=6-------------------------------
# With world basemap (default)
hexify_heatmap(
  obs_hex,
  value = "count",
  basemap = "world",
  xlim = c(-20, 35),
  ylim = c(35, 65),
  title = "With World Basemap"
)

## ----heatmap-no-basemap, fig.width=8, fig.height=6----------------------------
# Without basemap
hexify_heatmap(
  obs_hex,
  value = "count",
  basemap = NULL,
  xlim = c(-20, 35),
  ylim = c(35, 65),
  title = "No Basemap"
)

## ----plot-world, fig.width=8, fig.height=4------------------------------------
plot_world(fill = "lightgray", border = "gray50")

## ----plot-world-custom, fig.width=8, fig.height=4-----------------------------
plot_world(
  fill = "antiquewhite",
  border = "sienna",
  xlim = c(-30, 50),
  ylim = c(30, 70)
)

## ----pentagon-locations, fig.width=8, fig.height=4----------------------------
# Pentagon locations (icosahedron vertices in standard ISEA orientation)
pentagon_coords <- data.frame(
  type = c("Pole", "Pole", rep("Vertex", 10)),
  lon = c(0, 0, seq(0, 324, by = 36)),
  lat = c(90, -90, rep(c(26.57, -26.57), 5))
)

# Assign to grid and get polygons
grid <- hex_grid(area_km2 = 500000)
pentagon_cells <- lonlat_to_cell(pentagon_coords$lon, pentagon_coords$lat, grid)

pentagon_polys <- cell_to_sf(pentagon_cells, grid)

ggplot() +
  geom_sf(data = hexify_world, fill = "gray95", color = "gray70", linewidth = 0.2) +
  geom_sf(data = pentagon_polys, fill = alpha("purple", 0.6),
          color = "purple", linewidth = 0.8) +
  labs(
    title = "Pentagon Cell Locations",
    subtitle = "12 pentagonal cells at icosahedron vertices (area = 5/6 of hexagons)"
  ) +
  theme_minimal() +
  theme(axis.text = element_blank(), axis.ticks = element_blank())

## ----random-sample, fig.width=8, fig.height=4---------------------------------
# Grid parameters (coarse for faster build)
grid <- hex_grid(area_km2 = 200000, aperture = 3)
max_cell <- 10 * (3^grid@resolution) + 2

# Sample random cell IDs
set.seed(123)
N <- 50
random_cells <- sample(1:max_cell, N, replace = FALSE)

# Generate polygons for sampled cells
sample_polys <- cell_to_sf(random_cells, grid)

ggplot() +
  geom_sf(data = hexify_world, fill = "gray95", color = "gray70", linewidth = 0.2) +
  geom_sf(data = sample_polys, fill = alpha("forestgreen", 0.5),
          color = "darkgreen", linewidth = 0.4) +
  labs(title = sprintf("Random Sample of %d Cells (~%.0f km2 each)", N, grid@area_km2)) +
  theme_minimal() +
  theme(axis.text = element_blank(), axis.ticks = element_blank())

## ----custom-viz, fig.width=8, fig.height=6------------------------------------
# Create data with a numeric variable
set.seed(456)
stations <- data.frame(
  lon = runif(50, -10, 30),
  lat = runif(50, 35, 60),
  temperature = rnorm(50, mean = 15, sd = 5)
)

# Hexify (coarser grid for faster build)
grid <- hex_grid(area_km2 = 20000)
stations_hex <- hexify(stations, lon = "lon", lat = "lat", grid = grid)

# Aggregate temperature by cell
stations_df <- as.data.frame(stations_hex)
stations_df$cell_id <- stations_hex@cell_id
cell_temps <- aggregate(temperature ~ cell_id, data = stations_df, FUN = mean)

# Generate polygons and merge data
cell_polys <- cell_to_sf(cell_temps$cell_id, grid)
cell_polys <- merge(cell_polys, cell_temps, by = "cell_id")

# Custom visualization
europe <- hexify_world[hexify_world$continent == "Europe", ]

ggplot() +
  geom_sf(data = europe, fill = "gray95", color = "gray60", linewidth = 0.2) +
  geom_sf(data = cell_polys, aes(fill = temperature),
          color = "white", linewidth = 0.2) +
  scale_fill_gradient2(
    low = "blue", mid = "white", high = "red",
    midpoint = 15, name = "Temp (°C)"
  ) +
  coord_sf(xlim = c(-10, 30), ylim = c(35, 60)) +
  labs(
    title = "Mean Temperature by Grid Cell",
    subtitle = "Diverging color scale centered at 15°C"
  ) +
  theme_minimal() +
  theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_line(color = "gray90")
  )