Merge pull request #6 from digitalnature-ie/issue-3

Tetrad and tmap 4.0.0 support, closing #3 and #4

DESCRIPTION

@@ -8,8 +8,8 @@ Authors@R: c(
   )
 Description: Convert between Irish grid references and Irish Grid coordinates. Irish grid 
     references can also be converted to or from an 'sf' object in any coordinate reference 
-    system. Precisions from 1 m to 100 km are supported, as are datasets with mixed 
-    precision. Conversion to 'sf' polygons is precision-aware.
+    system. Precisions from 1 m to 100 km including 2 km tetrads are supported, as are 
+    datasets with mixed precision. Conversion to 'sf' polygons is precision-aware.
 License: GPL (>= 3)
 URL: https://github.com/digitalnature-ie/igr,
     https://digitalnature-ie.github.io/igr/
@@ -21,7 +21,8 @@ Suggests:
     maps,
     rmarkdown,
     testthat (>= 3.0.0),
-    tmap
+    tmap,
+    units
 VignetteBuilder: 
     knitr
 Config/testthat/edition: 3

NEWS.md

@@ -1,5 +1,8 @@
 # igr (development version)
 
+* Tetrad support added (2000 m precision, "DINTY" system, e.g. "N85H").
+* tmap 4.0.0 compatibility.
+
 # igr 0.1.1
 
 * Description extended and vignette build technique adjusted for CRAN compatibility.

R/ig_to_igr.R

@@ -6,8 +6,8 @@
 #' Either `digits` or `precision` must be specified. `precision` overrides
 #' `digits`.
 #'
-#' @param x A matrix containing Irish Grid X and Y coordinates in the first
-#'   and second columns respectively.
+#' @param x A matrix containing Irish Grid X and Y coordinates in the first and
+#'   second columns respectively.
 #' @param digits An integer, the number of digits for both easting and northing
 #'   in the Irish grid references.
 #'   * `0`: equivalent to a precision of 100 km.
@@ -17,9 +17,10 @@
 #'   * `4`: equivalent to a precision of 10 m.
 #'   * `5`: equivalent to a precision of 1 m.
 #' @param precision An integer, the precision of the Irish grid references in
-#'   metres: `1`, `10`, `100`, `1000`, `10000`, or `100000`. Overrides `digits`.
-#' @param sep A character string to separate the 100 km grid letter, easting,
-#'   and northing.
+#'   metres: `1`, `10`, `100`, `1000`, `2000`, `10000`, or `100000`. Overrides
+#'   `digits`. Use `2000` to produce the tetrad form of Irish grid reference.
+#' @param sep A character string to place between the 100 km grid letter,
+#'   easting, northing, and tetrad.
 #'
 #' @return A character vector of Irish grid references.
 #' @export
@@ -41,6 +42,9 @@
 #'
 #' # Convert into Irish grid references with 1 km precision (2 digit easting and northing)
 #' ig_to_igr(m, precision = 1000)
+#' 
+#' # Convert into Irish grid references with 2 km precision (tetrad form)
+#' ig_to_igr(m, precision = 2000)
 ig_to_igr <- function(x, digits = 3, precision = NULL, sep = "") {
   if (is.na(digits) & is.null(precision)) {
     stop_custom("no_precision", "precision or digits must be specified")
@@ -93,16 +97,29 @@ ig_to_igr <- function(x, digits = 3, precision = NULL, sep = "") {
     )
   }
 
-  # calculate x and y offsets within 100km square to required precision
-  offsets <- x %% 100000 |>
-    formatC(width = 5, format = "d", flag = "0") |>
-    strtrim(ifelse(is.null(precision), digits, 5 - log10(precision)))
+  # for tetrads the base grid reference is the 10000 m grid reference
+  base_precision <- ifelse(precision == 2000, 10000, precision)
+
+  # calculate x and y offsets within 100km square to 1m  precision
+  offsets_1m <- x %% 100000 |>
+    formatC(width = 5, format = "d", flag = "0")
+
+  offsets_base <- offsets_1m |>
+    strtrim(ifelse(is.null(precision), digits, 5 - log10(base_precision)))
+
+  tetrads <- ""
+
+  if(!is.null(precision)) {
+    if(precision == 2000) {
+      tetrads <- mapply(lookup_tetrad, x = x[, 1], y = x[, 2])
+    }
+  }
 
   # concatenate into Irish Grid References
   res <- ifelse(
     invalid,
     NA_character_,
-    paste(igr_letters, offsets[, 1], offsets[, 2], sep = sep)
+    trimws(paste(igr_letters, offsets_base[, 1], offsets_base[, 2], tetrads, sep = sep))
   )
 
   return(res)

R/igr_is_valid.R

@@ -7,27 +7,42 @@
 #' the same length of between 1 and 5 digits. There may be whitespace between
 #' the letter, easting and northing.
 #'
+#' The tetrad form of Irish grid reference consists of a valid 10 km precision
+#' Irish grid reference (one letter, one digit easting and one digit northing)
+#' followed by a letter (other than O). This refers to a 2 km square within the
+#' 10 km square referenced.
+#'
 #' @param x A character vector of Irish grid references.
+#' @param tetrad Permit tetrad form of Irish grid reference?
 #'
 #' @return A logical vector indicating the validity of each Irish grid
 #'   reference.
 #' @export
 #'
 #' @examples
 #' # A vector of alternating valid and invalid Irish grid references
-#' v <- c("N8090", "D 12 345 88800", "W34", "I30", "W", "A123", "B1234", "")
+#' v <- c("N8090", "D 12 345 88800", "W34", "I30", "W", "A123", "B1234", "", "A12Z", "A12O")
 #'
 #' # Check validity of Irish Grid coordinates
 #' igr_is_valid(v)
-igr_is_valid <- function(x) {
+#'
+#' # Check validity of Irish Grid coordinates, dissallowing tetrad form
+#' igr_is_valid(v, tetrad = FALSE) 
+igr_is_valid <- function(x, tetrad = TRUE) {
   if (is.null(x)) {
     return(NULL)
   }
 
   valid <- grepl(
     paste0(
       "^\\s*", # ignore whitespace at start
-      "[A-H,J-Z]\\s*(()|(\\d\\s*\\d)|(\\d{2}\\s*\\d{2})|(\\d{3}\\s*\\d{3})|(\\d{4}\\s*\\d{4})|(\\d{5}\\s*\\d{5}))",
+      "[A-H,J-Z]\\s*(()|", # 100 km
+      "(\\d\\s*\\d)|", # 10 km
+      ifelse(tetrad, "(\\d\\s*\\d\\s*[A-N,P-Z])|", ""), # 10 km tetrad
+      "(\\d{2}\\s*\\d{2})|", # 1 km
+      "(\\d{3}\\s*\\d{3})|", # 100 m
+      "(\\d{4}\\s*\\d{4})|", # 10 m
+      "(\\d{5}\\s*\\d{5}))", # 1 m
       "\\s*$" # ignore whitespace at end
     ),
     x,

R/igr_to_ig.R

@@ -4,6 +4,7 @@
 #' (EPSG:29903) X and Y coordinates. The precision of each Irish grid reference
 #' in metres can be returned.
 #'
+#' @inheritParams igr_is_valid
 #' @param x A character vector of Irish grid references. See [igr_is_valid()]
 #'   for a definition of valid Irish grid references.
 #' @param coords A character vector of the names of the columns to contain the
@@ -18,7 +19,7 @@
 #'
 #' @examples
 #' # A vector of Irish grid references of different precisions
-#' v <- c("N8090", "D1234588800", "W34", "")
+#' v <- c("N8090", "D1234588800", "W34", "", "D12T")
 #'
 #' # Convert to Irish Grid coordinates
 #' igr_to_ig(v)
@@ -28,12 +29,12 @@
 #'
 #' # Also return the precision in metres of each Irish grid reference
 #' igr_to_ig(v, precision = "prec")
-igr_to_ig <- function(x, coords = c("x", "y"), precision = NULL) {
+igr_to_ig <- function(x, coords = c("x", "y"), precision = NULL, tetrad = TRUE) {
   if (is.null(x)) {
     return(list(x = double(), y = double()))
   }
 
-  invalid <- !igr_is_valid(x)
+  invalid <- !igr_is_valid(x, tetrad)
 
   if (any(invalid)) {
     warning(
@@ -48,26 +49,33 @@ igr_to_ig <- function(x, coords = c("x", "y"), precision = NULL) {
 
   igr <- gsub(" ", "", x, fixed = TRUE)
 
+  igr_len <- nchar(igr)
+
   igr_letter <- toupper(substring(igr, 1, 1))
-
+  #igr_tetrad <- ifelse(igr_len  == 4, toupper(as.character(substring(igr, 4, 4))), "A")
+  igr_tetrad_letter <- toupper(substring(igr, 4, 4)) 
+
+  #igr_tetrad_letter[is.numeric(igr_tetrad_letter) | igr_tetrad_letter == ""] <- "A"  # not a tetrad so add no offset just like tetrad "A"
+
   igr_100_index <- match(igr_letter, igr_100$letter)
+  igr_tetrad_index <- match(igr_tetrad_letter, igr_tetrad$letter, nomatch = 1)   # if not a tetrad add no offset just like tetrad "A", index 1
 
-  igr_len <- nchar(igr)
-  igr_digits <- ifelse(invalid, NA_integer_, (igr_len - 1) / 2)
-  igr_res <- 10^(5 - igr_digits)
+  igr_digits <- ifelse(invalid, NA_integer_, trunc((igr_len - 1) / 2))   #trunc() in case tetrad
+  igr_base_res <- 10^(5 - igr_digits)   # resolution ignoring tetrad
 
-  # calculate 1m offset within the 100km grid
-  offset_x <- ifelse(invalid, NA_integer_, ifelse(igr_len == 1, 0, as.integer(substring(igr, 2, 1 + igr_digits)) * igr_res))
-  offset_y <- ifelse(invalid, NA_integer_, ifelse(igr_len == 1, 0, as.integer(substring(igr, 2 + igr_digits)) * igr_res))
+  # calculate 1 m offset within the 100 km grid for the base grid reference
+  offset_x <- ifelse(invalid, NA_integer_, ifelse(igr_len == 1, 0, as.integer(substring(igr, 2, 1 + igr_digits)) * igr_base_res))
+  offset_y <- ifelse(invalid, NA_integer_, ifelse(igr_len == 1, 0, as.integer(substring(igr, 2 + igr_digits, 1 + igr_digits + igr_digits)) * igr_base_res))
 
-  # calculate full Irish Grid coordinates to 1m
-  ig_x <- ifelse(invalid, NA_integer_, igr_100$x[igr_100_index] + offset_x)
-  ig_y <- ifelse(invalid, NA_integer_, igr_100$y[igr_100_index] + offset_y)
+  # calculate full Irish Grid coordinates to 1m, including any tetrad offset 
+  ig_x <- ifelse(invalid, NA_integer_, igr_100$x[igr_100_index] + offset_x + igr_tetrad$x[igr_tetrad_index])
+  ig_y <- ifelse(invalid, NA_integer_, igr_100$y[igr_100_index] + offset_y + igr_tetrad$y[igr_tetrad_index])
 
   if (is.null(precision)) {
     ig <- list(ig_x, ig_y)
     names(ig) <- coords[1:2]
   } else {
+    igr_res <- ifelse(igr_len != 4, igr_base_res, 2000)
     ig <- list(ig_x, ig_y, igr_res)
     names(ig) <- c(coords, precision)
   }

R/st_igr_as_sf.R

@@ -31,7 +31,7 @@
 #'
 #' @examples
 #' # A data.frame containing two Irish grid references
-#' x <- data.frame(igr = c("A00", "N8000"))
+#' x <- data.frame(igr = c("A00", "N8000", "D12T"))
 #'
 #' # Convert a data.frame of Irish grid references to an sf object in the
 #' # Irish Grid coordinate reference system
@@ -54,7 +54,8 @@ st_igr_as_sf <- function(
     add_coords = FALSE,
     coords = c("x", "y"),
     precision = NULL,
-    polygons = FALSE) {
+    polygons = FALSE,
+    tetrad = TRUE) {
   # if x includes column names in coords then stop
   coords_existing <- intersect(colnames(x), coords)
   if (length(coords_existing) > 0) {
@@ -82,7 +83,7 @@ st_igr_as_sf <- function(
   # raise as error
   tryCatch(
     {
-      ig <- igr_to_ig(x[[igrefs]], coords = coords, precision = igr_precision)
+      ig <- igr_to_ig(x[[igrefs]], coords = coords, precision = igr_precision, tetrad = tetrad)
     },
     warning = function(w) {
       stop_custom(
@@ -110,7 +111,7 @@ st_igr_as_sf <- function(
       # remove precision column
       res_sf <- res_sf[, !names(res_sf) == "prec"]
     } else {
-      # rename res column
+      # rename precision column
       names(res_sf)[names(res_sf) == "prec"] <- precision
     }
   } else {

R/st_irishgridrefs.R

@@ -25,6 +25,9 @@
 #'
 #' # Convert into Irish grid references with 1 km precision (2 digit easting and northing)
 #' st_irishgridrefs(x_sf, precision = 1000)
+#' 
+#' # Convert into Irish grid references with 2 km precision (tetrad form)
+#' st_irishgridrefs(x_sf, precision = 2000)
 #'
 #' # Insert a space between the 100 km grid letter, easting, and northing
 #' st_irishgridrefs(x_sf, sep = " ")

R/utils.R

@@ -5,8 +5,15 @@ igr_100 <- list(
   y = rep(c(4:0), each = 5) * 100000 # SW corner northing in metres
 )
 
+# tetrad offsets
+igr_tetrad <- list(
+  letter = LETTERS[-15], # Letter reference (no O)
+  x = rep(c(0:4), each = 5) * 2000, # SW corner easting in metres
+  y = rep(c(0:4), 5) * 2000 # SW corner northing in metres
+)
+
 # Supported precisions of Irish grid references in metres
-valid_precisions <- c(1, 10, 100, 1000, 10000, 100000)
+valid_precisions <- c(1, 10, 100, 1000, 2000, 10000, 100000)
 
 #' Lookup 100 km Irish grid reference for Irish Grid coordinate
 #'
@@ -29,6 +36,28 @@ lookup_igr_100 <- function(x, y) {
   }
 }
 
+#' Lookup tetrad for Irish Grid coordinate
+#'
+#' @param x Irish Grid easting.
+#' @param y Irish Grid northing.
+#'
+#' @return Letter indicating the tetrad containing the
+#'   coordinate, or NA_character_ for an invalid Irish Grid coordinate.
+#'
+#' @noRd
+lookup_tetrad <- function(x, y) {
+  if (!is.numeric(x) | x < 0 | x >= 500000 |
+      !is.numeric(y) | y < 0 | y >= 500000) {
+    NA_character_
+  } else {
+    igr_tetrad$letter[
+      (igr_tetrad$x == (x %% 10000) - (x %% 2000)) &
+      (igr_tetrad$y == (y %% 10000) - (y %% 2000))
+    ]
+
+  }
+}
+
 #' Create custom error subclass
 #'
 #' @param .subclass Name of the error subclass.