Merge pull request #57 from RobLBaker/master

Increment version to v0.3.2

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: NPSutils
 Type: Package
 Title: Collection of Functions to read and manipulate information from the NPS DataStore
-Version: 0.3.1
+Version: 0.3.2
 Authors@R: c(
     person(given = "Robert", family = "Baker", email = "robert_baker@nps.gov",
            role = c("aut", "cre"),
@@ -17,9 +17,10 @@ Description: NPSutils is a collection of functions for interacting with NPS Data
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-Remotes:  
+Remotes: 
     nationalparkservice/EMLeditor,
-    nationalparkservice/DPchecker
+    nationalparkservice/DPchecker,
+    nationalparkservice/QCkit
 Imports: 
     EML,
     sf,
@@ -36,9 +37,12 @@ Imports:
     lifecycle,
     EMLeditor (>= 0.1.5),
     DPchecker (>= 0.3.4),
+    QCkit (>= 0.1.4),
     here,
     jsonlite,
-    cli
+    cli,
+    purrr,
+    tibble
 RoxygenNote: 7.3.2
 Suggests: 
     knitr,

NAMESPACE

@@ -16,6 +16,7 @@ export(get_unit_code_info)
 export(get_unit_info)
 export(load_core_metadata)
 export(load_data_package)
+export(load_data_package_deprecated)
 export(load_data_packages)
 export(load_domains)
 export(load_pkg_metadata)

NEWS.md

@@ -1,4 +1,6 @@
-# NPSutils 0.3.2 (in development)
+# NPSutils 0.3.2 "Lost Coast"
+  * Add new functions, `load_data_packages()` and `load_data_package()`, which can load data packages (EML in .xml and data in .csv) similarly to the deprecated `load_data_package_deprecated()` function but also allows the data types in the tibbles loaded to be specified based on the information in the metadata.
+  * Deprecate `load_data_package()` and rename it to `load_data_package_deprecated()`.
   * Update readme to us pak for package installation instead of devtools.
   * Update _pkgdown.yml to use bootstrap 5
   * added helper functions for API requests and user input to facilitate unit testing.

R/get_data_packages.R

@@ -112,7 +112,7 @@ get_data_packages <- function(reference_id,
     destination_dir <- paste("data/", reference_id[i], sep = "")
     #if the directory already exists, prompt user to overwrite:
     if(force == FALSE) {
-      if (file.exists(destination_dir) & force == FALSE){
+      if (file.exists(destination_dir)){
         cat("The directory ",
             crayon::blue$bold(destination_dir),
             " already exists.\n",

R/load_core_metadata.R

@@ -132,6 +132,7 @@ load_core_metadata <- function(ds_ref, path = paste0(getwd(), "/data")){
 #'
 #' @return dataframe
 #' @keywords private
+#' @noRd
 #'
 #' @examples
 #' \dontrun{
@@ -199,6 +200,7 @@ load_core_metadata <- function(ds_ref, path = paste0(getwd(), "/data")){
 #'
 #' @return dataframe
 #' @keywords private
+#' @noRd
 #'
 #' @examples
 #' \dontrun{

R/load_data_package.R

@@ -1,6 +1,7 @@
 #' Read contents of data package and constructs a list of tibbles based on the data file(s)
 #'
-#' @description \code{load_data_package} reads the data file(s) from a package and loads it into a list of tibbles. Current implementation only supports .csv data files.
+#' `r lifecycle::badge("deprecated")`
+#' @description `load_data_package_deprecated()` reads the data file(s) from a package and loads it into a list of tibbles. Current implementation only supports .csv data files.
 #'
 #' @param reference_id is a 6-7 digit number corresponding to the reference ID of the data package.
 #'
@@ -12,9 +13,13 @@
 #' \dontrun{
 #' load_data_package(2272461)
 #' }
-load_data_package <- function(reference_id) {
+load_data_package_deprecated <- function(reference_id) {
   data_package_directory <- paste("data/", reference_id, sep = "")
   data_package_filename <- paste(data_package_directory, ".zip", sep = "")
+
+  lifecycle::deprecate_warn("0.3.2",
+                            "load_data_pacakge_deprecated()",
+                            "load_data_packages()")
 
   # Look for the zipped data package and attempt to unzip it. If the zipped file exists but cannot be unzipped, give the user a warning. If neither the unzipped nor zipped data packages exist, suggest the user check their working directory or use getDataPackage() to get the data package.
   if (!file.exists(data_package_directory)) {

R/load_data_packages.R

@@ -1,15 +1,13 @@
-#' Read contents of data package(s) and return a tibble with a tibble for each data file. 
-#' 
-#' `r lifecycle::badge("experimental")`
+#' Read contents of data package(s) and return a list of tibbles list of tibbles based on the data file(s). Can use metadata to specify data types.
 #'
-#' @description `load_data_packages()` loads one to may data packages and returns a tibble of tibbles where each data package is a tibble and within that each data file is it's own tibble. `load_data_packages()` will only work with .csv data files and EML metadata. `load_data_packages()` can also utilize the metadata to assign attributes to each data column.
+#' @description `load_data_packages()` loads one to many data packages and returns a list. If only one data package is loaded, the list will be a list of tibbles where each tibble is a data (.csv) file from the data package. If multiple data packages are loaded, the list will be a list of lists where each nested list contains a list of tibble and each tibble is a data file (.csv). See `simplify` below for details on handling these lists.
 #' 
-#' @details currently `load_data_packages()` only supports EML metadata and .csv files. To take advantage of the default settings in load_data_packages, use the default settings in `get_data_package()` or `get_data_packages()`. Archived (.zip) files must be extracted before `load_data_packages()` will work properly. Again, `get_data_package()` or `get_data_packages()` will accomplish this for you. 
+#' @details currently `load_data_packages()` only supports EML metadata and .csv files. The reference_id 
 #' '
-#' @param reference_id is a list of 6-7 digit numbers corresponding to the DataStore reference ID of the datapackage(s) to load. Alternatively, you can set `reference_id` to "load_all", which will load all the data packages in your /data folder.
-#' @param directory is the location of a folder, 'data' (created during `get_data_packages()`) which contains sub-directories where each sub-directory is the DataStore referenceId of the data package. Again, this file structure is all set up using `get_data_packages()`. Defaults to the current working directory (which is the default location for `get_data_packages()`).
-#' @param assign_attributes Logical. Defaults to FALSE. Data will be loaded using `readr::read_csv()` guessing algorithm for calling column types. If set to TRUE, column types will be set using metadata attributes via the yet-to-be written `load_metadata()` function. `r lifecycle::badge('experimental')`
-#' @param simplify Logical. Defaults to TRUE. If there is only a single data package loaded, the function will return a simple list of tibbles (where each tibble reflects a data file from within the data package). If set to FALSE, the function will return a list that contains a list of tibbles. This structure mirrors the object structure returned if multiple data packages are simultaneously loaded (a list of data packages with each data package containing a list of tibbles where each tibble corresponds to a data file in the given data package).
+#' @param reference_id the immediate directory/directories where your data packages reside. For data packages downloaded from DataStore using `get_data_package()` or `get_data_packages()` default settings, this is the DataStore reference ID for your data package(s). Alternatively, you can set `reference_id` to "`load_all`", which will load all the data packages in the directory specified in via `directory` (typically ./data).
+#' @param directory is the location of a folder that contains all of the data packages (where data packages are a folder containing .csv data files and a single .xml EML metadata file). If these data packages were downloaded from DataStore using the default settings for `get_data_packages`, this folder is "./data" and you can use the default settings for `directory`.
+#' @param assign_attributes Logical. Defaults to FALSE. Data will be loaded using `readr::read_csv()` guessing algorithm for calling column types. If you set to `assign_attributes = TRUE`, column types will be set using the data types specified in the metadata. Currently supported data types include string, dateTime, float, double, integer, and categorical (factor in R). This assignment is very stringent: for instance if you did not specify date-time formats using ISO-8601 notation (i.e. "YYYY", not "yyyy"), your data will import as NAs. If you have undefined missing values or blank cells, your data will not import at all. If you run into problems consider using the default settings and letting `read_csv` guess the column types.
+#' @param simplify Logical. Defaults to TRUE. If `simplify = TRUE`, the function will return a list of tibbles where each tibble is a data file from the data package(s) specified. The tibbles are named using the following format: "pkg_<reference_id.filename" (without the filename extension). If you want to load each individual data file into R for further processing, use `simplify = TRUE` and then run `list2env(x, envir=.GlobalEnv)`. If you set `simplify = FALSE`, the object returned will either be a list of tibbles identical to that returned by `simplify = TRUE` (if only one data package is loaded) or will be a list of lists where each nested list is a contains one tibble for each data file in each data package.Setting `simplify = FALSE` may make it easier to do post-processing on a package-by-package level rather than a tibble-by-tibble level.
 #'
 #' @return a list of (of lists of) tibbles. 
 #'
@@ -21,61 +19,172 @@
 #' }
 #'
 load_data_packages <- function(reference_id, 
-                             directory = here::here(),
+                             directory = here::here("data"),
                              assign_attributes = FALSE,
                              simplify = TRUE){
-  #capture original working directory
-  orig_wd <- getwd()
-  #set directory back to original working directory on exit.
-  on.exit(setwd(orig_wd))
-  #set wd to path; defaults to wd. 
-  setwd(directory)
+
 
   #is user specifies "allData" get all directories from the data folder:
-  if (reference_id == "all_data") {
+  if (length(seq_along(reference_id)) == 1 && reference_id == "load_all") {
     reference_id <- list.dirs(path = directory,
                                      full.names = FALSE,
                                      recursive = FALSE)
   }
 
-  ### fix how single data packages are handled later:
-  if(length(
-    seq_along(
-      reference_id)) == 1 
-    & reference_id != "all_data" 
-    & simplify == TRUE) {
-  #return a tibble of data files  
-  }
-
-
-  for(i in 1:seq_along(reference_id)){
-    data_package_directory <- paste("data/", reference_id[i])
-    filenames <- list.files(
-      path = data_package_directory,
-      pattern = data_format)
+  tibble_list <- list()
+  for (h in 1:length(seq_along(reference_id))) {
+    suppressWarnings(rm(directory1))
+    directory1 <- paste0(directory, "/", reference_id[h])
+    #get csv file names:
+    filenames <- list.files(path = directory1,
+                            pattern = "*csv")
     ## Create list of data frame names without the ".csv" part
     names <- gsub(pattern = "\\.csv$", "", filenames)
 
     ### Load all files into tibbles
-    reference_id[i] <- list()
-    for (j in names) {
-      filepath <- file.path(data_package_directory, paste(j, ".csv", sep = ""))
-      tibble_list[[i]] <- assign(j,
-                                 readr::read_csv(filepath,
-                                                 show_col_types = FALSE))
-    }
-  }
-
-  data_package_filename <- paste0(data_package_directory, "/", reference_id,
-                               ".zip")
+    package_data <- list()
+    for (i in 1:length(seq_along(filenames))) {
+        file_path <- file.path(paste0(directory1,"/", filenames[i]))
+
+        #get attributes information from metadata:
+        #To do: handle case when only one data file in the data package!
+        if (assign_attributes == TRUE) {
+        #load metadata:
+          metadata <- DPchecker::load_metadata(directory = directory1)
+          # when there is only one dataTable:
+          if ("physical" %in% names(metadata$dataset$dataTable)) {
+            dataTable <- metadata[["dataset"]][["dataTable"]]
+          } else {
+            for (j in 1:length(seq_along(metadata$dataset$dataTable))) {
+              if (filenames[i] %in% 
+                  metadata$dataset$dataTable[[j]]$physical$objectName) {
+                dataTable <- metadata[["dataset"]][["dataTable"]][[j]]
+              }
+            }
+          }
+          #turn the metadata into a useable tibble          
+          attribs <- purrr::map_dfr(dataTable[["attributeList"]][["attribute"]],
+                                    tibble::as_tibble)
+          #map_dfr started double counting rows; fix it if it happens:
+          attribs <- attribs %>% dplyr::distinct(attributeName,
+                                                 .keep_all = TRUE)
 
-  if (data_format == "csv" & metadata_format == "eml") {
-    filelist <- utils::unzip(data_package_filename, list = TRUE)
-    if (assign_attributes == TRUE) {
-      #assign attributes using metadata via a yet-to-be-built sub-function.
+          attribs <- attribs %>% dplyr::mutate(R_data_type = dplyr::case_when(
+            storageType == "string" ~ "collector_character",
+            storageType == "date" ~ "collector_date",
+            storageType == "float" ~ "collector_double",
+            storageType == "double" ~ "collector_double",
+            storageType == "integer" ~ "collector_integer"))
+
+          #get column specification as R would guess:
+          csv_cols <- readr::spec_csv(file_path)
+
+          #set data types based on EML, simple:
+          for(j in 1:nrow(attribs)) {
+            class(csv_cols$cols[[j]]) <- attribs$R_data_type[[j]]
+          }
+
+          #set date/time col type format string:
+          for(j in 1:nrow(attribs)) {
+            if("dateTime" %in% names(attribs$measurementScale[j])) {
+              eml_date <- 
+                attribs$measurementScale[j][["dateTime"]][["formatString"]]
+              r_date <- QCkit::convert_datetime_format(eml_date)
+              csv_cols$cols[[j]]$format <- r_date
+            }
+          }
+          #set levels for factor call types:
+          for (j in 1:nrow(attribs)) {
+            if("nominal" %in% names(attribs$measurementScale[j])) {
+              nom <- attribs$measurementScale[j][["nominal"]]
+              if ("nonNumericDomain" %in% names(nom)) {
+                nom2 <- nom[["nonNumericDomain"]]
+                if ("enumeratedDomain" %in% names(nom2)) {
+                  nom3 <- nom2[["enumeratedDomain"]]
+                  if ("codeDefinition" %in% names(nom3)) {
+                    nom4 <- nom3[["codeDefinition"]]
+                    #get factors
+                    factors <- NULL
+                    #handle case where there is only one code definition
+                    if ("code" %in% names(nom4)) {
+                      nom4 <- list(nom4)
+                    }
+                    for (k in 1:length(seq_along(nom4))) {
+                      factors <- append(factors, nom4[[k]][["code"]])
+                    }
+                    #set column type:
+                    csv_cols$cols[[j]] <- readr::col_factor(factors,
+                                                            include_na = FALSE,
+                                                            ordered = FALSE)
+                  }
+                }
+              }
+            }
+          }
+          suppressWarnings(package_data[[i]] <-
+                             assign(names[i],
+                                    readr::read_csv(file_path,
+                                                    col_types = csv_cols,
+                                                    show_col_types = FALSE)
+                                    )
+                           )
+          names(package_data)[i] <- names[i]
+        } else {
+        # Do not call attributes:
+        suppressWarnings(package_data[[i]] <- 
+                           assign(names[i],
+                                  readr::read_csv(file_path,
+                                                  show_col_types = FALSE)
+                           )
+        )
+        names(package_data)[i] <- names[i]
+      }
     }
-    return(fileList)
-  }  else {
-    print("data/metadata format combination not supported")
+    tibble_list[[h]] <- package_data
+    names(tibble_list)[[h]] <- paste0("pkg_", reference_id[h])
   }
+  #put all the tibbles in a single list that is not nested 
+  #(simplifies subsequent extraction)
+  if (simplify == TRUE) {
+    tibble_list <- extract_tbl(tibble_list)
+  }
+  return(tibble_list)
+}
+
+#' @export
+#' @rdname load_data_packages
+load_data_package <- function(reference_id, 
+                              directory = here::here("data"),
+                              assign_attributes = FALSE,
+                              simplify = TRUE) {
+
+  x <- load_data_packages(reference_id, 
+                          directory = here::here("data"),
+                          assign_attributes = FALSE,
+                          simplify = TRUE)
+  return(x)
 }
+
+#' extract nested tibbles
+#' 
+#' Adapted from stack overflow find_df function found at:
+#' https://stackoverflow.com/questions/70512869/extract-data-frames-from-nested-list
+#' And accessed on 2024-10-02
+#'
+#' @param x a (potentially deeply) nested list containing at least one tibble
+#'
+#' @return a list where each item in the list is a tibble found in the nested list `x`
+#' @keywords Internal
+#' @noRd
+#'
+#' @examples 
+#' \dontrun{
+#' z <- .extract_tbl(x)
+#' }
+extract_tbl <- function(x) {
+  if (is_tibble(x))
+    return(list(x))
+  if (!is.list(x))
+    return(NULL)
+  unlist(lapply(x, extract_tbl), FALSE)
+}

R/utils.R

@@ -29,7 +29,8 @@ assign("ds_dev_api", "https://irmadevservices.nps.gov/datastore-secure/v7/rest/"
 #' Prompts for, gets, and returns binary user input (1 or 2)
 #'
 #' @return Factor. 1 or 2.
-#'
+#' @keywords internal
+#' @noRd
 #' @examples
 #' \dontrun{
 #' var1 <- .get_user_input()