Add id_format and axis_order options for grid ID output; update tests and docs for new ID formatting features

Author: e-kotov

R/inspire_grid_from_ids.R

@@ -29,6 +29,8 @@ inspire_grid_from_ids <- function(
   point_type = c("llc", "centroid"),
   output_type = c("sf_polygons", "sf_points", "dataframe"),
   include_llc = TRUE,
+  id_format = c("both", "long", "short"),
+  axis_order = c("NE", "EN"),
   quiet = FALSE,
   dsn = NULL,
   layer = NULL,
@@ -48,6 +50,8 @@ inspire_grid_from_ids <- function(
       point_type = point_type,
       output_type = output_type,
       include_llc = include_llc,
+      id_format = id_format,
+      axis_order = axis_order,
       dsn = dsn,
       layer = layer,
       quiet = quiet

R/inspire_grid_from_ids_internal.R

@@ -3,13 +3,17 @@ inspire_grid_from_ids_internal <- function(
   point_type = c("llc", "centroid"),
   output_type = c("sf_polygons", "sf_points", "dataframe"),
   include_llc = TRUE,
+  id_format = c("both", "long", "short"),
+  axis_order = c("NE", "EN"),
   quiet = FALSE,
   dsn = NULL,
   layer = NULL,
   ...
 ) {
   output_type <- match.arg(output_type)
   point_type <- match.arg(point_type)
+  id_format <- match.arg(id_format)
+  axis_order <- match.arg(axis_order)
 
   if (!requireNamespace("sf", quietly = TRUE)) {
     stop("The 'sf' package is required. Please install it.", call. = FALSE)
@@ -56,6 +60,44 @@ inspire_grid_from_ids_internal <- function(
   }
 
   cellsize <- grid_df$cellsize[[1]]
+  epsg_code <- grid_crs$epsg %||% 3035
+
+  # Detect input format (long IDs start with "CRS")
+  input_is_long <- all(startsWith(ids, "CRS"))
+
+  # Helper to convert/format IDs based on id_format and axis_order
+  format_output_ids <- function(input_ids, id_format, axis_order, epsg) {
+    if (id_format == "long") {
+      if (input_is_long) {
+        list(GRD_ID = input_ids)
+      } else {
+        list(GRD_ID = inspire_id_format(input_ids, crs = epsg))
+      }
+    } else if (id_format == "short") {
+      if (input_is_long) {
+        list(GRD_ID = inspire_id_format(input_ids, axis_order = axis_order))
+      } else {
+        # Input is short - convert to long first, then back to short with desired axis_order
+        long_ids <- inspire_id_format(input_ids, crs = epsg)
+        list(GRD_ID = inspire_id_format(long_ids, axis_order = axis_order))
+      }
+    } else {
+      # id_format == "both"
+      if (input_is_long) {
+        list(
+          GRD_ID_LONG = input_ids,
+          GRD_ID_SHORT = inspire_id_format(input_ids, axis_order = axis_order)
+        )
+      } else {
+        long_ids <- inspire_id_format(input_ids, crs = epsg)
+        short_ids <- inspire_id_format(long_ids, axis_order = axis_order)
+        list(
+          GRD_ID_LONG = long_ids,
+          GRD_ID_SHORT = short_ids
+        )
+      }
+    }
+  }
 
   # --- 1. In-Memory Generation (dsn is NULL) ---
   if (is.null(dsn)) {
@@ -67,8 +109,11 @@ inspire_grid_from_ids_internal <- function(
       point_type = point_type
     )
 
-    # Add ID (Specific to this function)
-    out_obj$id <- ids
+    # Add IDs with proper format and column names
+    formatted_ids <- format_output_ids(ids, id_format, axis_order, epsg_code)
+    for (col_name in names(formatted_ids)) {
+      out_obj[[col_name]] <- formatted_ids[[col_name]]
+    }
 
     # Cleanup and reorder using helper
     return(clean_and_order_grid(
@@ -118,7 +163,11 @@ inspire_grid_from_ids_internal <- function(
       point_type = point_type
     )
 
-    chunk_obj$id <- chunk_ids
+    # Add IDs with proper format and column names
+    formatted_ids <- format_output_ids(chunk_ids, id_format, axis_order, epsg_code)
+    for (col_name in names(formatted_ids)) {
+      chunk_obj[[col_name]] <- formatted_ids[[col_name]]
+    }
 
     # Use helper for consistency
     chunk_obj <- clean_and_order_grid(

man/inspire_grid.Rd

@@ -4,27 +4,27 @@ test_that("inspire_grid_from_ids_internal produces correct output types", {
     "CRS3035RES1000mN3501000E4400000"
   )
 
-  # Test sf_polygons output
+  # Test sf_polygons output (default id_format = "both")
   grid_poly <- inspire_grid_from_ids_internal(ids, output_type = "sf_polygons")
   expect_s3_class(grid_poly, "sf")
   expect_true(inherits(st_geometry(grid_poly), "sfc_POLYGON"))
   expect_equal(nrow(grid_poly), 2)
-  expect_true("id" %in% names(grid_poly))
+  expect_true(all(c("GRD_ID_LONG", "GRD_ID_SHORT") %in% names(grid_poly)))
   expect_equal(st_crs(grid_poly), st_crs(3035))
 
   # Test sf_points output
   grid_pts <- inspire_grid_from_ids_internal(ids, output_type = "sf_points")
   expect_s3_class(grid_pts, "sf")
   expect_true(inherits(st_geometry(grid_pts), "sfc_POINT"))
   expect_equal(nrow(grid_pts), 2)
-  expect_true("id" %in% names(grid_pts))
+  expect_true(all(c("GRD_ID_LONG", "GRD_ID_SHORT") %in% names(grid_pts)))
   expect_equal(st_crs(grid_pts), st_crs(3035))
 
   # Test dataframe output
   grid_df <- inspire_grid_from_ids_internal(ids, output_type = "dataframe")
   expect_s3_class(grid_df, "data.frame")
   expect_equal(nrow(grid_df), 2)
-  expect_true("id" %in% names(grid_df))
+  expect_true(all(c("GRD_ID_LONG", "GRD_ID_SHORT") %in% names(grid_df)))
   expect_true(all(
     c("X_LLC", "Y_LLC", "X_centroid", "Y_centroid") %in% names(grid_df)
   ))
@@ -166,7 +166,7 @@ test_that("Round-trip: grid from extent -> short IDs -> grid from IDs matches or
   # 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), ]
+  grid_regenerated_sorted <- grid_regenerated[order(grid_regenerated$GRD_ID_SHORT), ]
 
   # Compare LLC coordinates (these should match exactly)
   expect_equal(
@@ -216,3 +216,169 @@ test_that("Short IDs with explicit CRS parameter do not produce warnings", {
   expect_s3_class(grid_with_crs, "sf")
   expect_equal(st_crs(grid_with_crs), st_crs(TARGET_CRS))
 })
+
+test_that("id_format = 'long' produces long format IDs", {
+  # From long input IDs
+  long_ids <- c(
+    "CRS3035RES1000mN3500000E4400000",
+    "CRS3035RES1000mN3501000E4400000"
+  )
+
+  grid_long <- inspire_grid_from_ids_internal(
+    long_ids,
+    output_type = "sf_polygons",
+    id_format = "long"
+  )
+
+  expect_true("GRD_ID" %in% names(grid_long))
+  expect_false(any(c("GRD_ID_LONG", "GRD_ID_SHORT") %in% names(grid_long)))
+  expect_true(all(startsWith(grid_long$GRD_ID, "CRS")))
+  expect_equal(grid_long$GRD_ID, long_ids)
+
+  # From short input IDs - should convert to long
+  short_ids <- c("1kmN3500E4400", "1kmN3501E4400")
+
+  expect_warning(
+    grid_from_short <- inspire_grid_from_ids_internal(
+      short_ids,
+      output_type = "sf_polygons",
+      id_format = "long"
+    ),
+    regexp = "CRS not specified"
+  )
+
+  expect_true("GRD_ID" %in% names(grid_from_short))
+  expect_true(all(startsWith(grid_from_short$GRD_ID, "CRS")))
+})
+
+test_that("id_format = 'short' produces short format IDs", {
+  # From long input IDs
+  long_ids <- c(
+    "CRS3035RES1000mN3500000E4400000",
+    "CRS3035RES1000mN3501000E4400000"
+  )
+
+  grid_short <- inspire_grid_from_ids_internal(
+    long_ids,
+    output_type = "sf_polygons",
+    id_format = "short"
+  )
+
+  expect_true("GRD_ID" %in% names(grid_short))
+  expect_false(any(c("GRD_ID_LONG", "GRD_ID_SHORT") %in% names(grid_short)))
+  expect_false(any(startsWith(grid_short$GRD_ID, "CRS")))
+  # Default axis_order is "NE", so IDs should start with "1kmN"
+  expect_true(all(startsWith(grid_short$GRD_ID, "1kmN")))
+})
+
+test_that("id_format = 'both' produces both long and short format IDs", {
+  long_ids <- c(
+    "CRS3035RES1000mN3500000E4400000",
+    "CRS3035RES1000mN3501000E4400000"
+  )
+
+  grid_both <- inspire_grid_from_ids_internal(
+    long_ids,
+    output_type = "sf_polygons",
+    id_format = "both"
+  )
+
+  expect_true(all(c("GRD_ID_LONG", "GRD_ID_SHORT") %in% names(grid_both)))
+  expect_false("GRD_ID" %in% names(grid_both))
+  expect_true(all(startsWith(grid_both$GRD_ID_LONG, "CRS")))
+  expect_false(any(startsWith(grid_both$GRD_ID_SHORT, "CRS")))
+})
+
+test_that("axis_order = 'EN' produces E...N format short IDs", {
+  long_ids <- c(
+    "CRS3035RES1000mN3500000E4400000",
+    "CRS3035RES1000mN3501000E4400000"
+  )
+
+  # Test with id_format = "short"
+  grid_en <- inspire_grid_from_ids_internal(
+    long_ids,
+    output_type = "sf_polygons",
+    id_format = "short",
+    axis_order = "EN"
+  )
+
+  expect_true("GRD_ID" %in% names(grid_en))
+  # IDs should start with "1kmE" (not "1kmN")
+  expect_true(all(startsWith(grid_en$GRD_ID, "1kmE")))
+  expect_true(all(grepl("E[0-9]+N[0-9]+$", grid_en$GRD_ID)))
+
+  # Test with id_format = "both"
+  grid_both_en <- inspire_grid_from_ids_internal(
+    long_ids,
+    output_type = "sf_polygons",
+    id_format = "both",
+    axis_order = "EN"
+  )
+
+  expect_true(all(startsWith(grid_both_en$GRD_ID_SHORT, "1kmE")))
+})
+
+test_that("axis_order = 'NE' produces N...E format short IDs (default)", {
+  long_ids <- c(
+    "CRS3035RES1000mN3500000E4400000",
+    "CRS3035RES1000mN3501000E4400000"
+  )
+
+  grid_ne <- inspire_grid_from_ids_internal(
+    long_ids,
+    output_type = "sf_polygons",
+    id_format = "short",
+    axis_order = "NE"
+  )
+
+  expect_true("GRD_ID" %in% names(grid_ne))
+  # IDs should start with "1kmN" (not "1kmE")
+  expect_true(all(startsWith(grid_ne$GRD_ID, "1kmN")))
+  expect_true(all(grepl("N[0-9]+E[0-9]+$", grid_ne$GRD_ID)))
+})
+
+test_that("axis_order converts short IDs between NE and EN formats", {
+  # Input short IDs in NE format
+  short_ids_ne <- c("1kmN3500E4400", "1kmN3501E4400")
+
+  expect_warning(
+    grid_to_en <- inspire_grid_from_ids_internal(
+      short_ids_ne,
+      output_type = "sf_polygons",
+      id_format = "short",
+      axis_order = "EN"
+    ),
+    regexp = "CRS not specified"
+  )
+
+  # Should convert NE -> Long -> EN
+  expect_true(all(startsWith(grid_to_en$GRD_ID, "1kmE")))
+  expect_equal(grid_to_en$GRD_ID, c("1kmE4400N3500", "1kmE4400N3501"))
+})
+
+test_that("inspire_grid S3 generic passes id_format and axis_order correctly", {
+  long_ids <- c(
+    "CRS3035RES1000mN3500000E4400000",
+    "CRS3035RES1000mN3501000E4400000"
+  )
+
+  # Test via S3 generic with id_format = "long"
+  grid_long <- inspire_grid(
+    x = long_ids,
+    id_format = "long"
+  )
+
+  expect_true("GRD_ID" %in% names(grid_long))
+  expect_true(all(startsWith(grid_long$GRD_ID, "CRS")))
+
+  # Test via S3 generic with id_format = "short" and axis_order = "EN"
+  grid_short_en <- inspire_grid(
+    x = long_ids,
+    id_format = "short",
+    axis_order = "EN"
+  )
+
+  expect_true("GRD_ID" %in% names(grid_short_en))
+  expect_true(all(startsWith(grid_short_en$GRD_ID, "1kmE")))
+})

tests/testthat/test-inspire_grid_from_ids.R

@@ -194,11 +194,11 @@ test_that("inspire_grid_from_ids writes dataframe to CSV correctly (with chunkin
 
   expect_true(file.exists(tmp_csv))
 
-  # Check content
+  # Check content (default id_format = "both" produces GRD_ID_LONG and GRD_ID_SHORT)
   df_in <- readr::read_csv(tmp_csv, show_col_types = FALSE)
   expect_equal(nrow(df_in), 2)
-  expect_true("id" %in% names(df_in))
-  expect_equal(df_in$id, ids)
+  expect_true(all(c("GRD_ID_LONG", "GRD_ID_SHORT") %in% names(df_in)))
+  expect_equal(df_in$GRD_ID_LONG, ids)
 })
 
 test_that("inspire_grid_from_extent streams to CSV (dropping geometry)", {