feat: validating uniqueness of locationID

MazamaScience · Nov 14, 2023 · f21b66b · f21b66b
1 parent c0d5777
commit f21b66b
Show file tree

Hide file tree

Showing 67 changed files with 162 additions and 119 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Type: Package
 Package: MazamaLocationUtils
-Version: 0.4.1
+Version: 0.4.2
 Title: Manage Spatial Metadata for Known Locations
 Authors@R: c(
     person("Jonathan", "Callahan", email="[email protected]", role=c("aut","cre")),
@@ -27,7 +27,7 @@ Imports:
     lubridate,
     magrittr,
     methods,
-    MazamaCoreUtils (>= 0.5.0),
+    MazamaCoreUtils (>= 0.5.1),
     MazamaSpatialUtils (>= 0.8.6),
     readr,
     rlang,

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,9 @@
+# MazamaLocationUtils 0.4.2
+
+* Add uniqueness of `locationID` to `validateLocationTable()`.
+* `table_save()` now supports a vector of `outputType` formats and will save
+the location table in multiple formats.
+
 # MazamaLocationUtils 0.4.1
 
 * Documentation fixes for CRAN submission.

diff --git a/R/location_createID.R b/R/location_createID.R
@@ -48,13 +48,15 @@ location_createID <- function(
 ) {
 
   algorithm <- match.arg(algorithm)
-
-  # TODO:  use precision here when MazamaCoreUtils provides it
-  returnVal <- MazamaCoreUtils::createLocationID(longitude, latitude, algorithm)
 
-  if ( algorithm == "geohash" ) {
-    returnVal <- returnVal %>% stringr::str_sub(1, precision)
-  }
+  returnVal <- 
+    MazamaCoreUtils::createLocationID(
+      longitude = longitude, 
+      latitude = latitude, 
+      algorithm = algorithm,
+      precision = precision,
+      invalidID = as.character(NA)
+    )
 
   return(returnVal)
 

diff --git a/R/table_getNearestLocation.R b/R/table_getNearestLocation.R
@@ -49,11 +49,17 @@ table_getNearestLocation <- function(
 
   # ----- Subset ---------------------------------------------------------------
 
-  incomingIDTbl <- dplyr::tibble(
+  targetLocationIDsTbl <- dplyr::tibble(
     locationID = table_getLocationID(locationTbl, longitude, latitude, distanceThreshold)
   )
 
-  subsetTbl <- dplyr::left_join(incomingIDTbl, locationTbl, by = "locationID")
+  # NOTE:  dplyr::left_join() guarantees *at least* one record per X depending on
+  # NOTE:  how many matches are found in Y. Because validateLocationTbl() ensures
+  # NOTE:  that locationID is never duplicated in a locationTbl, this ends up
+  # NOTE:  handling the situation of multiple target locations that refer to the
+  # NOTE:  same record in locationTbl.
+
+  subsetTbl <- dplyr::left_join(targetLocationIDsTbl, locationTbl, by = "locationID")
 
   # ----- Return ---------------------------------------------------------------
 

diff --git a/R/table_save.R b/R/table_save.R
@@ -1,11 +1,14 @@
 
 #' @title Save a known location table
-#' @description Save a tibble of known locations to the preferred directory.
+#' @description Save a tibble of known locations to the preferred directory. If
+#' \code{outputType} is a vector, the known locations table will be saved to the 
+#' preferred directory in multiple formats.
+#' 
 #' @param locationTbl Tibble of known locations.
 #' @param collectionName Character identifier for this table.
 #' @param backup Logical specifying whether to save a backup version of any
 #' existing tables sharing \code{collectionName}.
-#' @param outputType Output format. One of "rda" or "csv".
+#' @param outputType Vecctor of output formats. (Currently only "rda" or "csv" are supported.)
 #' @return File path of saved file.
 #' @examples
 #' library(MazamaLocationUtils)
@@ -20,7 +23,7 @@
 #' # Save it as "table_save_example"
 #' table_save(locationTbl, "table_save_example")
 #' 
-#' # Add a column and save again
+#' # Add a column and save again 
 #' locationTbl %>% 
 #'   table_addColumn("my_column") %>% 
 #'   table_save("table_save_example")
@@ -34,55 +37,62 @@
 #' @importFrom MazamaCoreUtils stopIfNull
 #' @importFrom lubridate now
 table_save <- function(
-  locationTbl = NULL,
-  collectionName = NULL,
-  backup = TRUE,
-  outputType = c("rda", "csv")
+    locationTbl = NULL,
+    collectionName = NULL,
+    backup = TRUE,
+    outputType = "rda"
 ) {
 
   # ----- Validate parameters --------------------------------------------------
 
   MazamaLocationUtils::validateLocationTbl(locationTbl, locationOnly = FALSE)
   MazamaCoreUtils::stopIfNull(collectionName)
-  outputType <- match.arg(outputType)
+
+  for ( type in outputType ) {
+    if ( !type %in% c("rda", "csv") ) 
+      stop("outputType '%s' is not supported.", type)
+  }
 
   dataDir <- getLocationDataDir()
 
   # ----- Save data ------------------------------------------------------------
 
-  result <- try({
-
-    fileName <- paste0(collectionName, ".", outputType)
-    filePath <- file.path(dataDir, fileName)
-
-    # Save backups
-    if ( backup && file.exists(filePath) ) {
-      backupName <- paste0(
-        collectionName, ".",
-        strftime(lubridate::now(), "%Y-%m-%dT%H:%M:%S"),
-        ".rda"
-      )
-      backupPath <- file.path(dataDir, backupName)
-      file.rename(filePath, backupPath)
-    }
+  for ( type in outputType ) {
 
-    if ( outputType == "rda" ) {
+    result <- try({
 
-      # Assign a name and save
-      assign(collectionName, locationTbl)
-      save(list = c(collectionName), file = filePath)
+      fileName <- paste0(collectionName, ".", type)
+      filePath <- file.path(dataDir, fileName)
 
-    } else if ( outputType == "csv" ) {
+      # Save backups
+      if ( backup && file.exists(filePath) ) {
+        backupName <- paste0(
+          collectionName, ".",
+          strftime(lubridate::now(), "%Y-%m-%dT%H:%M:%S"),
+          ".rda"
+        )
+        backupPath <- file.path(dataDir, backupName)
+        file.rename(filePath, backupPath)
+      }
 
-      readr::write_csv(locationTbl, file = filePath)
-
+      if ( type == "rda" ) {
+        # Assign a name and save
+        assign(collectionName, locationTbl)
+        save(list = c(collectionName), file = filePath)
+      }
+
+      if ( type == "csv" ) {
+        readr::write_csv(locationTbl, file = filePath)
+      }
+
+    }, silent = TRUE)
+
+    if ( "try-error" %in% class(result) ) {
+      warning(sprintf("Could not write %s", filePath))
     }
 
-  }, silent = TRUE)
+  } # END of type loop
 
-  if ( "try-error" %in% class(result) ) {
-    stop(sprintf("Could not write %s", filePath))
-  }
 
   # ----- Return ---------------------------------------------------------------
 

diff --git a/R/utils.R b/R/utils.R
@@ -95,12 +95,18 @@ validateLocationTbl <- function(
     stop("'locationTbl$latitude' is not numeric. Please ensure that decimal latitudes are used.")
 
   if ( !locationOnly ) {
+
     missingNames <- 
       setdiff(MazamaLocationUtils::coreMetadataNames, names(locationTbl))
+
     if ( length(missingNames) > 0 ) {
       missingNamesString <- paste0(missingNames, collapse = ", ")
       stop(sprintf("'locationTbl' is missing '%s'", missingNamesString))
     }
+
+    if ( any(duplicated(locationTbl$locationID)) ) 
+      stop("'locationTbl$locationID' is not unique.")
+
   }
 
   return(invisible(TRUE))

diff --git a/docs/404.html b/docs/404.html
diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html
diff --git a/docs/articles/Developer_Style_Guide.html b/docs/articles/Developer_Style_Guide.html
diff --git a/docs/articles/MazamaLocationUtils.html b/docs/articles/MazamaLocationUtils.html
diff --git a/docs/articles/index.html b/docs/articles/index.html
diff --git a/docs/authors.html b/docs/authors.html
diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/news/index.html b/docs/news/index.html
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -4,5 +4,5 @@ pkgdown_sha: ~
 articles:
   Developer_Style_Guide: Developer_Style_Guide.html
   MazamaLocationUtils: MazamaLocationUtils.html
-last_built: 2023-10-30T18:04Z
+last_built: 2023-11-14T00:52Z
 
diff --git a/docs/reference/LocationDataDir.html b/docs/reference/LocationDataDir.html
diff --git a/docs/reference/MazamaLocationUtils.html b/docs/reference/MazamaLocationUtils.html
diff --git a/docs/reference/apiKeys.html b/docs/reference/apiKeys.html
diff --git a/docs/reference/clusterByDistance-1.png b/docs/reference/clusterByDistance-1.png
diff --git a/docs/reference/clusterByDistance.html b/docs/reference/clusterByDistance.html
diff --git a/docs/reference/coreMetadataNames.html b/docs/reference/coreMetadataNames.html
diff --git a/docs/reference/getLocationDataDir.html b/docs/reference/getLocationDataDir.html
diff --git a/docs/reference/id_monitors_500.html b/docs/reference/id_monitors_500.html