tests/testthat/test-polygons.R

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

# tests/testthat/test-polygons.R
# Tests for polygon generation functions
#
# Functions tested:
# - hexify_cell_to_sf()
# - cell_to_sf()
# - hexify_grid_rect()
# - hexify_grid_global()
# - hex_corners_to_sf()

# =============================================================================
# HEXIFY_CELL_TO_SF
# =============================================================================

test_that("hexify_cell_to_sf returns data frame with return_sf=FALSE", {
  hex_ids <- c(12847, 12532, 22178)

  result <- hexify_cell_to_sf(hex_ids, resolution = 10, aperture = 3, return_sf = FALSE)

  expect_s3_class(result, "data.frame")
  expect_true(all(c("cell_id", "lon", "lat", "order") %in% names(result)))
})

test_that("hexify_cell_to_sf returns 7 vertices per cell (closed polygon)", {
  hex_ids <- c(12847, 12532, 22178)

  result <- hexify_cell_to_sf(hex_ids, resolution = 10, aperture = 3, return_sf = FALSE)

  expect_equal(nrow(result), length(hex_ids) * 7)
  expect_equal(unique(result$order), 1:7)
})

test_that("hexify_cell_to_sf returns valid coordinates", {
  hex_ids <- c(12847, 12532)

  result <- hexify_cell_to_sf(hex_ids, resolution = 10, aperture = 3, return_sf = FALSE)

  expect_true(all(result$lon >= -180 & result$lon <= 180))
  expect_true(all(result$lat >= -90 & result$lat <= 90))
})

test_that("hexify_cell_to_sf produces closed polygons", {
  hex_ids <- c(12847)

  result <- hexify_cell_to_sf(hex_ids, resolution = 10, aperture = 3, return_sf = FALSE)

  first_vertex <- result[result$order == 1, c("lon", "lat")]
  last_vertex <- result[result$order == 7, c("lon", "lat")]

  expect_equal(first_vertex$lon, last_vertex$lon)
  expect_equal(first_vertex$lat, last_vertex$lat)
})

test_that("hexify_cell_to_sf returns sf object with return_sf=TRUE", {
  skip_if_not_installed("sf")

  hex_ids <- c(12847, 12532, 22178)

  result <- hexify_cell_to_sf(hex_ids, resolution = 10, aperture = 3, return_sf = TRUE)

  expect_s3_class(result, "sf")
  expect_true("cell_id" %in% names(result))
  expect_true("geometry" %in% names(result))
  expect_equal(sf::st_crs(result)$epsg, 4326)

  geom_types <- sf::st_geometry_type(result)
  expect_true(all(geom_types == "POLYGON"))
})

test_that("hexify_cell_to_sf removes duplicates", {
  hex_ids <- c(12847, 12847, 12532)

  result <- hexify_cell_to_sf(hex_ids, resolution = 10, aperture = 3, return_sf = FALSE)

  expect_equal(length(unique(result$cell_id)), 2)
  expect_equal(nrow(result), 2 * 7)
})

test_that("hexify_cell_to_sf handles NA values", {
  hex_ids <- c(12847, NA, 12532)

  result <- hexify_cell_to_sf(hex_ids, resolution = 10, aperture = 3, return_sf = FALSE)

  expect_equal(length(unique(result$cell_id)), 2)
})

test_that("hexify_cell_to_sf validates aperture", {
  expect_error(
    hexify_cell_to_sf(c(12847), resolution = 10, aperture = 5),
    "aperture must be 3, 4, or 7"
  )
})

test_that("hexify_cell_to_sf validates resolution", {
  expect_error(
    hexify_cell_to_sf(c(12847), resolution = -1, aperture = 3),
    "resolution must be between 0 and 30"
  )

  expect_error(
    hexify_cell_to_sf(c(12847), resolution = 31, aperture = 3),
    "resolution must be between 0 and 30"
  )
})

test_that("hexify_cell_to_sf works with aperture 4", {
  hex_ids <- c(100, 200, 300)

  result <- hexify_cell_to_sf(hex_ids, resolution = 8, aperture = 4, return_sf = FALSE)

  expect_s3_class(result, "data.frame")
  expect_equal(nrow(result), 3 * 7)
})

test_that("hexify_cell_to_sf works with aperture 7", {
  hex_ids <- c(100, 200, 300)

  result <- hexify_cell_to_sf(hex_ids, resolution = 5, aperture = 7, return_sf = FALSE)

  expect_s3_class(result, "data.frame")
  expect_equal(nrow(result), 3 * 7)
})

# =============================================================================
# CELL_TO_SF (grid helper)
# =============================================================================

test_that("cell_to_sf works with HexGrid object", {
  skip_if_not_installed("sf")

  grid <- hex_grid(area_km2 = 1000)
  hex_ids <- c(12847, 12532, 22178)

  result <- cell_to_sf(hex_ids, grid)

  expect_s3_class(result, "sf")
  expect_equal(nrow(result), 3)
})

test_that("cell_to_sf works with HexData object (extracts unique cells)", {
  skip_if_not_installed("sf")

  df <- data.frame(lon = c(0, 5, 10), lat = c(45, 46, 47))
  hex_data <- hexify(df, lon = "lon", lat = "lat", area_km2 = 5000)

  # When called with HexData and no cell_id, it uses the cells from data
  result <- cell_to_sf(grid = hex_data)

  expect_s3_class(result, "sf")
  expect_true(nrow(result) >= 1)
})

# =============================================================================
# HEXIFY_GRID_RECT
# =============================================================================

test_that("hexify_grid_rect generates grid for rectangular region", {
  skip_on_cran()  # Generates many polygons
  skip_if_not_installed("sf")

  grid <- hexify_grid_rect(
    minlon = 0, maxlon = 5,
    minlat = 45, maxlat = 48,
    area = 5000
  )

  expect_s3_class(grid, "sf")
  expect_true(nrow(grid) > 0)

  geom_types <- sf::st_geometry_type(grid)
  expect_true(all(geom_types == "POLYGON"))
})

# =============================================================================
# HEX_CORNERS_TO_SF
# =============================================================================

test_that("hex_corners_to_sf builds valid polygon", {
  skip_if_not_installed("sf")

  lon <- c(0, 1, 1, 0, -1, -1)
  lat <- c(0, 0.5, 1, 1, 0.5, 0)

  poly <- hex_corners_to_sf(lon, lat)

  expect_s3_class(poly, "sf")
  expect_true(sf::st_is_valid(poly))
  expect_equal(nrow(poly), 1L)
  expect_identical(as.character(sf::st_geometry_type(poly)), "POLYGON")
})

test_that("hex_corners_to_sf closes polygon correctly", {
  skip_if_not_installed("sf")

  lon <- c(0, 1, 1, 0, -1, -1)
  lat <- c(0, 0.5, 1, 1, 0.5, 0)

  poly <- hex_corners_to_sf(lon, lat)

  coords <- sf::st_coordinates(poly)
  expect_true(all(c("X", "Y") %in% colnames(coords)))

  # XY must match provided points + closing vertex
  xy_expected <- rbind(cbind(lon, lat), c(lon[1], lat[1]))
  actual_xy <- unname(as.matrix(coords[, c("X", "Y"), drop = FALSE]))
  expected_xy <- unname(as.matrix(xy_expected))

  expect_equal(actual_xy, expected_xy, tolerance = 0)
})

test_that("hex_corners_to_sf validates input lengths", {
  expect_error(
    hex_corners_to_sf(c(1, 2, 3), c(1, 2, 3, 4, 5, 6)),
    ""
  )
})

# =============================================================================
# ADDITIONAL INPUT VALIDATION
# =============================================================================

test_that("hexify_cell_to_sf validates cell_id is numeric", {
  expect_error(
    hexify_cell_to_sf("not_numeric", resolution = 10, aperture = 3),
    "cell_id must be numeric"
  )
})

test_that("hexify_cell_to_sf errors on empty input", {
  expect_error(
    hexify_cell_to_sf(numeric(0), resolution = 10, aperture = 3),
    "No valid cell_id values"
  )
})

test_that("hexify_cell_to_sf errors on all NA input", {
  expect_error(
    hexify_cell_to_sf(as.numeric(c()), resolution = 10, aperture = 3),
    "No valid cell_id values"
  )
})

# =============================================================================
# AS_SF METHOD
# =============================================================================

test_that("as_sf creates point geometry from HexData object", {
  skip_if_not_installed("sf")

  df <- data.frame(
    name = c("A", "B"),
    lon = c(10.5, 11.2),
    lat = c(48.5, 49.1)
  )

  hex_data <- hexify(df, lon = "lon", lat = "lat", area_km2 = 1000)
  result <- as_sf(hex_data, geometry = "point")

  expect_s3_class(result, "sf")
  expect_equal(nrow(result), 2)
  expect_true(all(sf::st_geometry_type(result) == "POINT"))
})

test_that("as_sf creates polygon geometry from HexData object", {
  skip_if_not_installed("sf")

  df <- data.frame(
    name = c("A", "B"),
    lon = c(10.5, 11.2),
    lat = c(48.5, 49.1)
  )

  hex_data <- hexify(df, lon = "lon", lat = "lat", area_km2 = 1000)
  result <- as_sf(hex_data, geometry = "polygon")

  expect_s3_class(result, "sf")
  expect_true(all(sf::st_geometry_type(result) == "POLYGON"))
})

# =============================================================================
# RESOLUTION FROM AREA HELPER
# =============================================================================

test_that(".resolution_from_area returns valid resolution", {
  res <- hexify:::.resolution_from_area(1000, aperture = 3)
  expect_true(is.numeric(res))
  expect_true(res >= 0 && res <= 30)
})

# =============================================================================
# HEXIFY_GRID_RECT
# =============================================================================

test_that("hexify_grid_rect validates parameters", {
  skip_if_not_installed("sf")

  # Test basic functionality was already done, test different apertures
  grid_ap4 <- hexify_grid_rect(
    minlon = 0, maxlon = 5,
    minlat = 45, maxlat = 48,
    area = 5000, aperture = 4
  )

  expect_s3_class(grid_ap4, "sf")
  expect_true(nrow(grid_ap4) > 0)
})

test_that("hexify_grid_rect works with resround", {
  skip_if_not_installed("sf")

  grid_up <- hexify_grid_rect(
    minlon = 0, maxlon = 5,
    minlat = 45, maxlat = 48,
    area = 5000, resround = "up"
  )

  grid_down <- hexify_grid_rect(
    minlon = 0, maxlon = 5,
    minlat = 45, maxlat = 48,
    area = 5000, resround = "down"
  )

  expect_s3_class(grid_up, "sf")
  expect_s3_class(grid_down, "sf")
})

# =============================================================================
# HEXIFY_GRID_GLOBAL
# =============================================================================

test_that("hexify_grid_global works with large area", {
  skip_on_cran()  # Generates many cells
  skip_if_not_installed("sf")

  # Use very large area to avoid warning
  grid <- hexify_grid_global(area = 10000000)

  expect_s3_class(grid, "sf")
  expect_true(nrow(grid) > 0)
})

test_that("hexify_grid_global warns on small area", {
  skip_on_cran()  # Slow computation
  skip_if_not_installed("sf")

  expect_warning(
    hexify_grid_global(area = 1000),
    "approximately.*cells"
  )
})

# =============================================================================
# EDGE CASES FOR HEXIFY_CELL_TO_SF
# =============================================================================

test_that("hexify_cell_to_sf works with large cell IDs", {
  skip_if_not_installed("sf")

  # Higher resolution -> larger cell IDs
  hex_ids <- c(100000, 200000, 300000)

  result <- hexify_cell_to_sf(
    hex_ids, resolution = 12, aperture = 3, return_sf = TRUE
  )

  expect_s3_class(result, "sf")
  expect_equal(nrow(result), 3)
})

test_that("hexify_cell_to_sf handles duplicate IDs correctly", {
  skip_if_not_installed("sf")

  hex_ids <- c(100, 100, 200, 200, 200)

  result <- hexify_cell_to_sf(
    hex_ids, resolution = 5, aperture = 3, return_sf = TRUE
  )

  expect_s3_class(result, "sf")
  expect_equal(nrow(result), 2)  # Should be deduplicated
})

test_that("hexify_cell_to_sf with return_sf=FALSE produces correct structure", {
  hex_ids <- c(100, 200)

  result <- hexify_cell_to_sf(
    hex_ids, resolution = 5, aperture = 3, return_sf = FALSE
  )

  expect_s3_class(result, "data.frame")
  expect_true(all(c("cell_id", "lon", "lat", "order") %in% names(result)))
  expect_equal(nrow(result), 2 * 7)  # 7 vertices per hex
})

# =============================================================================
# AS_SF ADDITIONAL TESTS
# =============================================================================

test_that("as_sf preserves all columns", {
  skip_if_not_installed("sf")

  df <- data.frame(
    name = c("A", "B"),
    lon = c(10.5, 11.2),
    lat = c(48.5, 49.1),
    custom_col = c("x", "y")
  )

  hex_data <- hexify(df, lon = "lon", lat = "lat", area_km2 = 1000)
  result <- as_sf(hex_data, geometry = "point")

  expect_true("name" %in% names(result))
  expect_true("custom_col" %in% names(result))
})

test_that("as_sf polygon geometry preserves attributes", {
  skip_if_not_installed("sf")

  df <- data.frame(
    lon = c(10.5, 11.2),
    lat = c(48.5, 49.1),
    value = c(100, 200)
  )

  hex_data <- hexify(df, lon = "lon", lat = "lat", area_km2 = 1000)
  result <- as_sf(hex_data, geometry = "polygon")

  expect_s3_class(result, "sf")
  expect_true("value" %in% names(result))
})

# =============================================================================
# CELL_TO_SF DEDUPLICATION
# =============================================================================

test_that("cell_to_sf deduplicates cell_ids", {
  skip_if_not_installed("sf")

  grid <- hex_grid(area_km2 = 1000)
  hex_ids <- c(12847, 12847, 12532)  # duplicate

  result <- cell_to_sf(hex_ids, grid)

  expect_s3_class(result, "sf")
  expect_equal(nrow(result), 2)  # Should deduplicate
})

# =============================================================================
# HEXIFY_CELL_TO_SF WITH GRID PARAMETER
# =============================================================================

test_that("hexify_cell_to_sf extracts parameters from grid object", {
  skip_if_not_installed("sf")

  grid <- hex_grid(area_km2 = 1000)
  hex_ids <- c(12847, 12532)

  # Pass grid instead of resolution/aperture

  result <- hexify_cell_to_sf(hex_ids, grid = grid)

  expect_s3_class(result, "sf")
  expect_equal(nrow(result), 2)
})

test_that("hexify_cell_to_sf errors when resolution/aperture missing and no grid", {
  expect_error(
    hexify_cell_to_sf(c(12847), resolution = 10),
    "resolution and aperture must be provided"
  )

  expect_error(
    hexify_cell_to_sf(c(12847), aperture = 3),
    "resolution and aperture must be provided"
  )
})