Add tests for dggrid_compat, plot_methods, grid_helpers (coverage 74% -> 82%)

gillescolling051 · gillescolling051 · commit 07b7cfa1fce8 · 2026-01-09T14:21:12.000+01:00
diff --git a/tests/testthat/test-dggrid-compat-functions.R b/tests/testthat/test-dggrid-compat-functions.R
@@ -0,0 +1,144 @@
+# tests/testthat/test-dggrid-compat-functions.R
+# Tests for dggridR compatibility layer functions
+
+test_that("as_dggrid converts hexify_grid to dggridR format", {
+  grid <- hexify_grid(area = 1000, aperture = 3)
+  dggs <- as_dggrid(grid)
+
+  expect_type(dggs, "list")
+  expect_equal(dggs$aperture, 3)
+  expect_equal(dggs$res, grid$resolution)
+  expect_equal(dggs$topology, "HEXAGON")
+  expect_equal(dggs$projection, "ISEA")
+  expect_equal(dggs$precision, 7L)
+  expect_equal(dggs$pole_lon_deg, 11.25)
+})
+
+test_that("as_dggrid rejects non-hexify_grid objects", {
+  expect_error(as_dggrid(list(a = 1)), "must be a hexify_grid object")
+  expect_error(as_dggrid(data.frame()), "must be a hexify_grid object")
+})
+
+test_that("from_dggrid converts dggridR format to hexify_grid", {
+  dggs <- list(
+    res = 5L,
+    aperture = 3L,
+    topology = "HEXAGON",
+    projection = "ISEA"
+  )
+
+  grid <- from_dggrid(dggs)
+
+  expect_s3_class(grid, "hexify_grid")
+  expect_equal(grid$resolution, 5L)
+  expect_equal(grid$aperture, 3L)
+})
+
+test_that("from_dggrid rejects invalid input", {
+  expect_error(from_dggrid("not a list"), "must be a list")
+  expect_error(from_dggrid(list()), "missing required fields")
+  expect_error(from_dggrid(list(res = 5)), "missing required fields")
+})
+
+test_that("from_dggrid warns on unsupported projection", {
+  dggs <- list(
+    res = 5L,
+    aperture = 3L,
+    topology = "HEXAGON",
+    projection = "FULLER"
+  )
+  expect_warning(from_dggrid(dggs), "Only ISEA projection")
+})
+
+test_that("from_dggrid warns on unsupported topology", {
+  dggs <- list(
+    res = 5L,
+    aperture = 3L,
+    topology = "DIAMOND",
+    projection = "ISEA"
+  )
+  expect_warning(from_dggrid(dggs), "Only HEXAGON topology")
+})
+
+test_that("from_dggrid rejects unsupported aperture", {
+  dggs <- list(
+    res = 5L,
+    aperture = 5L,
+    topology = "HEXAGON",
+    projection = "ISEA"
+  )
+  expect_error(from_dggrid(dggs), "Aperture 5 not supported")
+})
+
+test_that("from_dggrid warns on non-default orientation", {
+  dggs <- list(
+    res = 5L,
+    aperture = 3L,
+    topology = "HEXAGON",
+    projection = "ISEA",
+    pole_lon_deg = 0
+  )
+  expect_warning(from_dggrid(dggs), "Non-default pole_lon_deg")
+
+  dggs$pole_lon_deg <- 11.25
+  dggs$pole_lat_deg <- 0
+  expect_warning(from_dggrid(dggs), "Non-default pole_lat_deg")
+
+  dggs$pole_lat_deg <- 58.28252559
+  dggs$azimuth_deg <- 45
+  expect_warning(from_dggrid(dggs), "Non-default azimuth_deg")
+})
+
+test_that("dggrid_is_compatible validates compatible grids", {
+  dggs <- list(
+    res = 5L,
+    aperture = 3L,
+    topology = "HEXAGON",
+    projection = "ISEA"
+  )
+  expect_true(dggrid_is_compatible(dggs))
+})
+
+test_that("dggrid_is_compatible rejects incompatible grids (strict=TRUE)", {
+  # Not a list
+  expect_error(dggrid_is_compatible("not a list"), "not compatible")
+
+  # Wrong projection
+  dggs <- list(aperture = 3L, topology = "HEXAGON", projection = "FULLER")
+  expect_error(dggrid_is_compatible(dggs), "ISEA projection")
+
+  # Wrong topology
+  dggs <- list(aperture = 3L, topology = "DIAMOND", projection = "ISEA")
+  expect_error(dggrid_is_compatible(dggs), "HEXAGON topology")
+
+  # Wrong aperture
+  dggs <- list(aperture = 5L, topology = "HEXAGON", projection = "ISEA")
+  expect_error(dggrid_is_compatible(dggs), "Aperture must be")
+})
+
+test_that("dggrid_is_compatible returns FALSE for incompatible grids (strict=FALSE)", {
+  dggs <- list(aperture = 3L, topology = "HEXAGON", projection = "FULLER")
+  expect_false(dggrid_is_compatible(dggs, strict = FALSE))
+
+  dggs <- list(aperture = 3L, topology = "DIAMOND", projection = "ISEA")
+  expect_false(dggrid_is_compatible(dggs, strict = FALSE))
+})
+
+test_that("dggrid_is_compatible detects non-default orientation", {
+  dggs <- list(
+    aperture = 3L,
+    topology = "HEXAGON",
+    projection = "ISEA",
+    pole_lon_deg = 0
+  )
+  expect_error(dggrid_is_compatible(dggs), "pole_lon_deg")
+})
+
+test_that("round-trip: hexify_grid -> dggridR -> hexify_grid", {
+  original <- hexify_grid(area = 1000, aperture = 3)
+  dggs <- as_dggrid(original)
+  recovered <- from_dggrid(dggs)
+
+  expect_equal(original$resolution, recovered$resolution)
+  expect_equal(original$aperture, recovered$aperture)
+})
diff --git a/tests/testthat/test-grid-helpers.R b/tests/testthat/test-grid-helpers.R
@@ -0,0 +1,190 @@
+# tests/testthat/test-grid-helpers.R
+# Tests for grid helper functions
+
+test_that("lonlat_to_cell works with HexGridInfo", {
+  grid <- hex_grid(area_km2 = 1000)
+  cells <- lonlat_to_cell(lon = c(0, 10), lat = c(45, 50), grid = grid)
+
+  expect_type(cells, "double")
+  expect_length(cells, 2)
+  expect_true(all(cells > 0))
+})
+
+test_that("lonlat_to_cell works with HexData", {
+  df <- data.frame(lon = c(0, 10), lat = c(45, 50))
+  result <- hexify(df, lon = "lon", lat = "lat", area_km2 = 1000)
+
+  # Use the HexData object as grid source
+  cells <- lonlat_to_cell(lon = 5, lat = 48, grid = result)
+
+  expect_type(cells, "double")
+  expect_length(cells, 1)
+})
+
+test_that("lonlat_to_cell works with mixed aperture", {
+  grid <- hex_grid(area_km2 = 1000, aperture = "4/3")
+  cells <- lonlat_to_cell(lon = c(0, 10), lat = c(45, 50), grid = grid)
+
+  expect_type(cells, "double")
+  expect_length(cells, 2)
+})
+
+test_that("cell_to_lonlat returns cell centers", {
+  grid <- hex_grid(area_km2 = 1000)
+  cells <- lonlat_to_cell(lon = c(0, 10), lat = c(45, 50), grid = grid)
+  coords <- cell_to_lonlat(cells, grid)
+
+  expect_type(coords, "list")
+  expect_true("lon_deg" %in% names(coords))
+  expect_true("lat_deg" %in% names(coords))
+  expect_length(coords$lon_deg, 2)
+})
+
+test_that("cell_to_lonlat works with mixed aperture", {
+  grid <- hex_grid(area_km2 = 1000, aperture = "4/3")
+  cells <- lonlat_to_cell(lon = c(0, 10), lat = c(45, 50), grid = grid)
+  coords <- cell_to_lonlat(cells, grid)
+
+  expect_type(coords, "list")
+  expect_length(coords$lon_deg, 2)
+})
+
+test_that("lonlat_to_cell -> cell_to_lonlat round-trip lands in same cell", {
+  grid <- hex_grid(area_km2 = 1000)
+
+  original_lon <- c(0, 10, -5)
+  original_lat <- c(45, 50, 48)
+
+  cells1 <- lonlat_to_cell(original_lon, original_lat, grid)
+  centers <- cell_to_lonlat(cells1, grid)
+  cells2 <- lonlat_to_cell(centers$lon_deg, centers$lat_deg, grid)
+
+  expect_equal(cells1, cells2)
+})
+
+test_that("cell_to_sf creates sf polygons", {
+  skip_if_not_installed("sf")
+
+  grid <- hex_grid(area_km2 = 10000)
+  cells <- lonlat_to_cell(lon = c(0, 10), lat = c(45, 50), grid = grid)
+  polys <- cell_to_sf(cells, grid)
+
+  expect_s3_class(polys, "sf")
+  expect_true("cell_id" %in% names(polys))
+  expect_equal(nrow(polys), length(unique(cells)))
+})
+
+test_that("cell_to_sf works with HexData (no cell_id)", {
+  skip_if_not_installed("sf")
+
+  df <- data.frame(lon = c(0, 10, 20), lat = c(45, 50, 55))
+  result <- hexify(df, lon = "lon", lat = "lat", area_km2 = 10000)
+
+  polys <- cell_to_sf(grid = result)
+
+  expect_s3_class(polys, "sf")
+  expect_equal(nrow(polys), length(unique(result@cell_id)))
+})
+
+test_that("cell_to_sf errors without cell_id for HexGridInfo", {
+  skip_if_not_installed("sf")
+
+  grid <- hex_grid(area_km2 = 10000)
+  expect_error(cell_to_sf(grid = grid), "cell_id required")
+})
+
+test_that("cell_to_sf errors on empty cell_id", {
+  skip_if_not_installed("sf")
+
+  grid <- hex_grid(area_km2 = 10000)
+  expect_error(cell_to_sf(cell_id = numeric(0), grid = grid), "No valid")
+  expect_error(cell_to_sf(cell_id = c(NA, NA), grid = grid), "No valid")
+})
+
+test_that("grid_rect generates regional grid", {
+  skip_if_not_installed("sf")
+
+  grid <- hex_grid(area_km2 = 50000)
+  europe <- grid_rect(c(-10, 35, 30, 60), grid)
+
+  expect_s3_class(europe, "sf")
+  expect_gt(nrow(europe), 0)
+})
+
+test_that("grid_rect accepts sf bbox input", {
+  skip_if_not_installed("sf")
+
+  grid <- hex_grid(area_km2 = 50000)
+  france <- hexify_world[hexify_world$name == "France", ]
+  hexes <- grid_rect(france, grid)
+
+  expect_s3_class(hexes, "sf")
+  expect_gt(nrow(hexes), 0)
+})
+
+test_that("grid_global generates global grid", {
+  skip_if_not_installed("sf")
+
+  # Use very coarse grid to keep test fast
+  grid <- hex_grid(area_km2 = 500000)
+  global <- grid_global(grid)
+
+  expect_s3_class(global, "sf")
+  expect_gt(nrow(global), 10)  # Should have at least some cells
+})
+
+test_that("grid_global warns for large grids", {
+  skip_if_not_installed("sf")
+
+  # Small cells = many cells = warning
+  grid <- hex_grid(area_km2 = 100)  # Very small cells
+  expect_warning(grid_global(grid), "cells")
+})
+
+test_that("grid_clip clips to boundary", {
+  skip_if_not_installed("sf")
+
+  grid <- hex_grid(area_km2 = 20000)
+  france <- hexify_world[hexify_world$name == "France", ]
+  clipped <- grid_clip(france, grid)
+
+  expect_s3_class(clipped, "sf")
+  expect_gt(nrow(clipped), 0)
+})
+
+test_that("grid_clip with crop = FALSE keeps full hexagons", {
+  skip_if_not_installed("sf")
+
+  grid <- hex_grid(area_km2 = 20000)
+  france <- hexify_world[hexify_world$name == "France", ]
+  clipped <- grid_clip(france, grid, crop = FALSE)
+
+  expect_s3_class(clipped, "sf")
+})
+
+test_that("extract_grid works with HexGridInfo", {
+  grid <- hex_grid(area_km2 = 1000)
+  g <- hexify:::extract_grid(grid)
+
+  expect_s4_class(g, "HexGridInfo")
+})
+
+test_that("extract_grid works with HexData", {
+  df <- data.frame(lon = c(0, 10), lat = c(45, 50))
+  result <- hexify(df, lon = "lon", lat = "lat", area_km2 = 1000)
+  g <- hexify:::extract_grid(result)
+
+  expect_s4_class(g, "HexGridInfo")
+})
+
+test_that("extract_grid works with legacy hexify_grid", {
+  grid <- hexify_grid(area = 1000, aperture = 3)
+  g <- hexify:::extract_grid(grid)
+
+  expect_s4_class(g, "HexGridInfo")
+})
+
+test_that("extract_grid errors on invalid input", {
+  expect_error(hexify:::extract_grid(list(a = 1)), "Cannot extract grid")
+  expect_error(hexify:::extract_grid(data.frame()), "Cannot extract grid")
+})
diff --git a/tests/testthat/test-plot-methods.R b/tests/testthat/test-plot-methods.R
