Add nearest_neighbor_TMP

DESCRIPTION

@@ -12,7 +12,7 @@ URL: https://compass.pnnl.gov
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Depends: R (>= 3.4.0)
 Imports:
     readr,

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(list_directories)
+export(nearest_neighbor_TMP)
 export(process_aquatroll_dir)
 export(process_sapflow_dir)
 export(process_teros_dir)

R/datalogger.R

@@ -4,10 +4,10 @@
 #'
 #' @param filename Fully-qualified filename of a raw Campbell datalogger file
 #' @param quiet Print diagnostic messages? Logical
-#' @param ... Other parameters to pass on to \code{\link{read_csv}}
+#' @param ... Other parameters to pass on to \code{read_csv}
 #' @description This function reads a local file of raw sapflow data,
 #' extracts the logger number from the header, and uses
-#' \code{\link[readr]{read_csv}} to parse the file into a data frame.
+#' \code{read_csv} to parse the file into a data frame.
 #' @author Stephanie Pennington and Ben Bond-Lamberty
 #' @return A \code{\link[tibble]{tibble}} with the data.
 #' @export

R/spatial.r

@@ -0,0 +1,44 @@
+# spatial.R
+
+#' Find the nearest-neighbor grid squares - TEMPEST
+#'
+#' @param location Location grid cell ID (A1 to J8), character
+#' @param radius Radius desired, 0 or greater (see examples), numeric
+#'
+#' @returns A vector of grid square IDs in a box of radius \code{radius}
+#' @export
+#'
+#' @examples
+#' nearest_neighbor_TMP("C2")
+#' nearest_neighbor_TMP("A1") # returns four squares (others are out)
+#' nearest_neighbor_TMP("F3", radius = 0) # returns F3
+#' nearest_neighbor_TMP("F3", radius = 1) # returns the nine squares around F3
+#'
+#' # Construct a data frame of neighboring grid squares for a vector of locations
+#' locations <- c("C2", "F3")
+#' grid_map <- lapply(locations, function(x)
+#'     data.frame(location = x, neighbor = nearest_neighbor_TMP(x)))
+#' dplyr::bind_rows(grid_map)
+nearest_neighbor_TMP <- function(location, radius = 1) {
+
+    # Sanity checking
+    stopifnot(length(location) == 1)
+    stopifnot(radius >= 0)
+    if(!grepl("^[A-J][1-8]$", location)) {
+        stop(location, " does not appear to be a TEMPEST grid cell")
+    }
+
+    x <- which(LETTERS == substr(location, 1, 1))
+    xseq <- seq(x - radius, x + radius)
+    # remove x values not in 1-10 (i.e., A-J) range
+    xseq <- xseq[xseq > 0 & xseq < 11]
+
+    y <- as.integer(substr(location, 2, 2))
+    yseq <- seq(y - radius, y + radius)
+    # remove x values not in 1-8 range
+    yseq <- yseq[yseq > 0 & yseq < 9]
+
+    # Generate all grid cell combinations
+    df <- expand.grid(LETTERS[xseq], yseq)
+    return(paste0(df[,1], df[,2]))
+}

tests/testthat/test-spatial.r

@@ -0,0 +1,20 @@
+test_that("spatial works", {
+    # handles bad inputs
+    expect_error(nearest_neighbor_TMP(1:2), regexp = "length\\(location")
+    expect_error(nearest_neighbor_TMP("xx"), regexp = "does not appear to be a TEMPEST grid cell")
+    expect_error(nearest_neighbor_TMP("A1", radius = -1), regexp = "radius >= 0")
+
+    # 0-radius
+    expect_identical(nearest_neighbor_TMP("A1", radius = 0), "A1")
+    # 1-radius
+    expect_identical(sort(nearest_neighbor_TMP("C2", radius = 1)),
+                     sort(c("B1", "C1", "D1", "B2", "C2", "D2", "B3", "C3", "D3")))
+    # edge case
+    expect_identical(sort(nearest_neighbor_TMP("A2", radius = 1)),
+                     sort(c("A1", "B1", "A2", "B2", "A3", "B3")))
+    # corner case
+    expect_identical(sort(nearest_neighbor_TMP("A1", radius = 1)),
+                     sort(c("A1", "B1", "A2", "B2")))
+    # 2-radius
+    expect_length(nearest_neighbor_TMP("C3", radius = 2), 25)
+})