Fix short ID coordinate scaling and CRS propagation; add .tz_count utility; update tests for round-trip and parsing accuracy

Author: e-kotov

R/backend_sequential.R

@@ -34,17 +34,8 @@ inspire_grid_from_extent_internal <- function(
     )
   }
 
-  tz_count <- function(x) {
-    n <- 0L
-    x <- as.integer(x)
-    while (x %% 10L == 0L && x != 0) {
-      n <- n + 1L
-      x <- x %/% 10L
-    }
-    n
-  }
   make_ids <- function(x_llc, y_llc, cs, axis_order, epsg = 3035) {
-    nzeros <- tz_count(cs)
+    nzeros <- .tz_count(cs)
     div <- as.integer(10^nzeros)
     size_lbl <- if (cs >= 1000) paste0(cs / 1000, "km") else paste0(cs, "m")
 

R/inspire_grid_from_ids_internal.R

@@ -26,7 +26,11 @@ inspire_grid_from_ids_internal <- function(
   }
 
   # Parse IDs to get coords and validate consistency across all IDs
-  grid_df <- inspire_id_to_coords(ids, as_sf = FALSE)
+  # IMPORTANT: Check ... for 'crs' to allow user overrides for short IDs
+  dots <- list(...)
+  crs_in <- dots$crs
+
+  grid_df <- inspire_id_to_coords(ids, as_sf = FALSE, crs = crs_in)
   names(grid_df) <- c("crs", "cellsize", "Y_LLC", "X_LLC")
 
   if (length(unique(grid_df$crs)) > 1) {

R/inspire_id_format.R

@@ -84,8 +84,13 @@ inspire_id_format <- function(ids, crs = 3035, axis_order = "NE") {
       paste0(parsed$cellsize, "m")
     )
 
-    y_short <- parsed$y / parsed$cellsize
-    x_short <- parsed$x / parsed$cellsize
+    # Use robust divisor logic (10^tz_count) consistent with grid generation
+    divisors <- vapply(parsed$cellsize, function(cs) {
+      10^.tz_count(cs)
+    }, FUN.VALUE = numeric(1))
+
+    y_short <- parsed$y / divisors
+    x_short <- parsed$x / divisors
 
     if (axis_order == "NE") {
       sprintf("%sN%.0fE%.0f", res_str, y_short, x_short)
@@ -123,8 +128,13 @@ inspire_id_format <- function(ids, crs = 3035, axis_order = "NE") {
     numeric_res <- as.numeric(gsub("k?m", "", parsed$res_str))
     cellsize_m <- ifelse(is_km, numeric_res * 1000, numeric_res)
 
-    y_long <- parsed$y * cellsize_m
-    x_long <- parsed$x * cellsize_m
+    # Use robust multiplier logic
+    multipliers <- vapply(cellsize_m, function(cs) {
+      10^.tz_count(cs)
+    }, FUN.VALUE = numeric(1))
+
+    y_long <- parsed$y * multipliers
+    x_long <- parsed$x * multipliers
 
     sprintf("CRS%.0fRES%.0fmN%.0fE%.0f", crs, cellsize_m, y_long, x_long)
   }

R/inspire_id_to_coords.R

@@ -123,8 +123,15 @@ parse_inspire_ids <- function(inspire, is_long, is_short) {
     }
 
     parsed[short_indices, "cellsize"] <- res_to_m(parsed_short_ne$cellsize_str)
-    parsed[short_indices, "y"] <- parsed_short_ne$y
-    parsed[short_indices, "x"] <- parsed_short_ne$x
+
+    # Calculate multipliers to restore coordinates based on cellsize trailing zeros
+    # This inverses the division logic used during grid generation
+    multipliers <- vapply(parsed[short_indices, "cellsize"], function(cs) {
+      10^.tz_count(cs)
+    }, FUN.VALUE = numeric(1))
+
+    parsed[short_indices, "y"] <- parsed_short_ne$y * multipliers
+    parsed[short_indices, "x"] <- parsed_short_ne$x * multipliers
   }
 
   return(parsed)

R/utils.R

@@ -372,6 +372,19 @@ validate_disk_compatibility <- function(output_type, dsn) {
   return(TRUE)
 }
 
+#' Count trailing zeros
+#' @keywords internal
+#' @noRd
+.tz_count <- function(x) {
+  n <- 0L
+  x <- as.integer(x)
+  while (!is.na(x) && x != 0L && x %% 10L == 0L) {
+    n <- n + 1L
+    x <- x %/% 10L
+  }
+  n
+}
+
 #' Internal helper to write a grid chunk to disk (sf or flat file)
 #' @keywords internal
 #' @noRd

tests/testthat/test-inspire_grid_from_ids.R

@@ -120,3 +120,99 @@ test_that("inspire_grid_from_ids_internal handles empty input", {
     "Input 'inspire' cannot be an empty vector."
   )
 })
+
+test_that("Round-trip: grid from extent -> short IDs -> grid from IDs matches original", {
+  # This test verifies that a grid can be correctly reconstructed from short IDs
+  # when CRS is provided, fixing the coordinate scaling and CRS propagation bugs.
+
+  # Step 1: Create a small extent for testing
+  test_extent <- st_bbox(
+    c(xmin = 1000000, ymin = 1000000, xmax = 1030000, ymax = 1030000),
+    crs = st_crs(TARGET_CRS)
+  )
+
+  # Step 2: Generate the original grid from extent with short IDs
+  grid_original <- inspire_grid_from_extent(
+    grid_extent = test_extent,
+    cellsize_m = CELLSIZE,
+    crs = TARGET_CRS,
+    output_type = "sf_polygons",
+    id_format = "short"
+  )
+
+  expect_s3_class(grid_original, "sf")
+  expect_gt(nrow(grid_original), 0)
+  expect_true("GRD_ID" %in% names(grid_original))
+
+  # Step 3: Extract the short IDs
+  short_ids <- grid_original$GRD_ID
+
+  # Verify they are indeed short format (no "CRS" prefix)
+  expect_true(all(!startsWith(short_ids, "CRS")))
+
+  # Step 4: Regenerate grid from short IDs WITH crs parameter
+  # This should NOT produce a warning and should use the correct CRS
+  grid_regenerated <- inspire_grid_from_ids_internal(
+    short_ids,
+    output_type = "sf_polygons",
+    crs = TARGET_CRS
+  )
+
+  # Step 5: Compare the two grids
+  expect_s3_class(grid_regenerated, "sf")
+  expect_equal(nrow(grid_regenerated), nrow(grid_original))
+  expect_equal(st_crs(grid_regenerated), st_crs(grid_original))
+
+  # The regenerated grid should have the same cell positions
+  # Sort both by short ID to ensure proper comparison
+  grid_original_sorted <- grid_original[order(grid_original$GRD_ID), ]
+  grid_regenerated_sorted <- grid_regenerated[order(grid_regenerated$id), ]
+
+  # Compare LLC coordinates (these should match exactly)
+  expect_equal(
+    grid_original_sorted$X_LLC,
+    grid_regenerated_sorted$X_LLC,
+    tolerance = 1e-6
+  )
+  expect_equal(
+    grid_original_sorted$Y_LLC,
+    grid_regenerated_sorted$Y_LLC,
+    tolerance = 1e-6
+  )
+
+  # Compare geometries (should be identical)
+  geom_original <- st_geometry(grid_original_sorted)
+  geom_regenerated <- st_geometry(grid_regenerated_sorted)
+
+  # Extract centroids and compare
+  centroid_original <- st_coordinates(st_centroid(geom_original))
+  centroid_regenerated <- st_coordinates(st_centroid(geom_regenerated))
+
+  expect_equal(
+    centroid_original[, "X"],
+    centroid_regenerated[, "X"],
+    tolerance = 1e-6
+  )
+  expect_equal(
+    centroid_original[, "Y"],
+    centroid_regenerated[, "Y"],
+    tolerance = 1e-6
+  )
+})
+
+test_that("Short IDs with explicit CRS parameter do not produce warnings", {
+  # This test verifies that the CRS propagation fix works correctly
+  short_ids <- c("10kmN100E100", "10kmN101E100")
+
+  # With CRS provided, there should be NO warning
+  expect_no_warning(
+    grid_with_crs <- inspire_grid_from_ids_internal(
+      short_ids,
+      output_type = "sf_polygons",
+      crs = TARGET_CRS
+    )
+  )
+
+  expect_s3_class(grid_with_crs, "sf")
+  expect_equal(st_crs(grid_with_crs), st_crs(TARGET_CRS))
+})

tests/testthat/test-inspire_id_to_coords.R

@@ -30,21 +30,23 @@ test_that("inspire_id_to_coords works with short format IDs", {
   )
 
   # Default output (dataframe)
+  # 10km cells with short coords N349E444 scale to (3490000, 4440000) in meters
+  # Because 10000m has 4 trailing zeros, multiplier = 10^4 = 10000
   parsed_df <- inspire_id_to_coords(short_id, crs = 3035)
   expect_s3_class(parsed_df, "data.frame")
   expect_equal(names(parsed_df), c("crs", "cellsize", "y", "x"))
   expect_equal(parsed_df$cellsize, 10000) # Check m conversion
-  expect_equal(parsed_df$y, 349)
-  expect_equal(parsed_df$x, 444)
+  expect_equal(parsed_df$y, 3490000)
+  expect_equal(parsed_df$x, 4440000)
 
   # sf output
   parsed_sf <- inspire_id_to_coords(short_id, as_sf = TRUE, crs = 3035)
   expect_s3_class(parsed_sf, "sf")
   # Short format IDs default to CRS 3035
   expect_equal(sf::st_crs(parsed_sf), sf::st_crs(3035))
   coords <- sf::st_coordinates(parsed_sf)
-  expect_equal(as.numeric(coords[1, "X"]), 444)
-  expect_equal(as.numeric(coords[1, "Y"]), 349)
+  expect_equal(as.numeric(coords[1, "X"]), 4440000)
+  expect_equal(as.numeric(coords[1, "Y"]), 3490000)
 })
 
 test_that("inspire_id_to_coords handles vectorization and mixed-format issues", {
@@ -60,10 +62,12 @@ test_that("inspire_id_to_coords handles vectorization and mixed-format issues",
   )
   expect_equal(nrow(parsed_vec), 3)
 
+  # 1km = 1000m has 3 trailing zeros, multiplier = 10^3 = 1000
+  # So short coords 3618 and 4478 scale to 3618000 and 4478000
   expect_equal(parsed_vec$cellsize[1], 1000)
   expect_equal(parsed_vec$x[1], 4447000)
-  expect_equal(parsed_vec$y[2], 3618)
-  expect_equal(parsed_vec$x[3], 4478)
+  expect_equal(parsed_vec$y[2], 3618000)
+  expect_equal(parsed_vec$x[3], 4478000)
 })
 
 test_that("inspire_id_to_coords handles edge cases: malformed, NA, and empty inputs", {