diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 2a3b047..4df0786 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -29,7 +29,7 @@ jobs: - uses: r-lib/actions/setup-tinytex@v1 - name: Cache R packages - uses: actions/cache@v1 + uses: actions/cache@v4 if: runner.os != 'Windows' with: path: ${{ env.R_LIBS_USER }} diff --git a/DESCRIPTION b/DESCRIPTION index ceaaa23..186df51 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -11,7 +11,8 @@ Authors@R: c( person("Robyn", "Thiessen-Bock", email = "robyn.thiessenbock@gmail.com", role = "ctb"), person("Derek", "Strong", email = "dstrong@nceas.ucsb.edu", role = "ctb"), person("Rachel", "Sun", email = "rachelsun@ucsb.edu", role = "ctb"), - person("Jasmine", "Lai", email = "jasminelai@nceas.ucsb.edu", role = "ctb") + person("Jasmine", "Lai", email = "jasminelai@nceas.ucsb.edu", role = "ctb"), + person("Justin", "Kadi", email = "jeakadi@nceas.ucsb.edu", role = "ctb") ) Description: A set of utilities for working with the Arctic Data Center (https://arcticdata.io). @@ -29,35 +30,33 @@ Imports: digest, EML (>= 2.0), httr, + humaniformat, jsonlite (>= 1.8.4), + lifecycle, magrittr, methods, - filelock, + raster, + rdflib, + rlang, stringr, stringi, tools, uuid, xml2, - XML, - lifecycle, - rdflib, - pins, - rlang + XML Suggests: emld, - humaniformat, knitr, lubridate, ncdf4, RCurl, purrr, - raster, rmarkdown, sf, testthat (>= 3.0.0), xslt, yaml -RoxygenNote: 7.2.3 Roxygen: list(markdown = TRUE) VignetteBuilder: knitr Config/testthat/edition: 3 +Config/roxygen2/version: 8.1.0 diff --git a/NAMESPACE b/NAMESPACE index 0b9b1f1..171710d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -79,17 +79,19 @@ import(dataone) import(datapack) importFrom(httr,content) importFrom(magrittr,'%>%') -importFrom(methods,"slot<-") -importFrom(methods,as) -importFrom(methods,is) -importFrom(methods,new) -importFrom(methods,slot) +importFrom(methods, + "slot<-", + as, + is, + new, + slot +) importFrom(rlang,.data) importFrom(stats,na.omit) -importFrom(utils,URLencode) -importFrom(utils,head) -importFrom(utils,read.csv) -importFrom(utils,read.delim) -importFrom(utils,setTxtProgressBar) -importFrom(utils,tail) -importFrom(utils,txtProgressBar) +importFrom(utils, + URLencode, + read.csv, + read.delim, + setTxtProgressBar, + txtProgressBar +) diff --git a/R/arcticdatautils.R b/R/arcticdatautils.R index 0dd2de0..c21c3ae 100644 --- a/R/arcticdatautils.R +++ b/R/arcticdatautils.R @@ -3,13 +3,11 @@ #' This package contains code for doing lots of useful stuff that's too specific for the #' dataone package, primarily functions that streamline Arctic Data Center operations. #' -#' @docType package -#' @name arcticdatautils -#' #' @import dataone #' @import datapack #' @import EML #' @importFrom methods as is new slot slot<- #' @importFrom stats na.omit -#' @importFrom utils URLencode head read.csv read.delim setTxtProgressBar txtProgressBar -NULL +#' @importFrom utils URLencode read.csv read.delim setTxtProgressBar txtProgressBar +"_PACKAGE" + diff --git a/R/eml.R b/R/eml.R index 84c12d4..925b4a3 100644 --- a/R/eml.R +++ b/R/eml.R @@ -345,7 +345,6 @@ reorder_pids <- function(pid_list, doc){ #' doc$dataset$project <- proj #' #' EML::eml_validate(doc) -#' @importFrom utils tail eml_nsf_to_project <- function(awards, eml_version = "2.2"){ stopifnot(is.character(awards)) @@ -438,19 +437,51 @@ eml_nsf_to_project <- function(awards, eml_version = "2.2"){ # Extract first and last name from NSF API results # -# The NSF API jams the first name, last name, and middle initial if it exists into a single string. +# The NSF API jams the first name, last name, middle initial, and email if it exists into a single string. # This simple helper uses some regex to split the names up. extract_name <- function(x){ lapply(x, function(x) { + email_pattern <- "^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\\.[a-zA-Z]{2,}$" + name_without_email <- lapply(x, function(x) { + split_name <- strsplit(x, split = " ")[[1]] + if (grepl(email_pattern, utils::tail(split_name, 1))) { + split_name <- utils::head(split_name, -1) + } + if (grepl(c("(Former)"), utils::tail(split_name, 1))) { + split_name <- utils::head(split_name, -1) + } + if (grepl(c("(former)"), utils::tail(split_name, 1))) { + split_name <- utils::head(split_name, -1) + } + name_without_email <- paste(split_name, collapse = " ") + }) data.frame( - firstName = unlist(lapply(x, function(x){head(strsplit(x, split = " ")[[1]], 1)})), - lastName = unlist(lapply(x, function(x) {paste(tail(strsplit(x, split = " ")[[1]], -1), collapse = " ")})) + firstName = unlist(lapply(name_without_email, function(full_names) { + # Standardize spacing and punctuation + cleaned <- humaniformat::format_period(full_names) + + first <- humaniformat::first_name(cleaned) + middle <- humaniformat::middle_name(cleaned) + + # Combine first and middle names, handling NA values safely + given <- ifelse(is.na(middle) | middle == "", first, paste(first, middle)) + return(given) + })), + lastName = unlist(lapply(name_without_email, function(full_names) { + # Standardize spacing and punctuation + cleaned <- humaniformat::format_period(full_names) + + last <- humaniformat::last_name(cleaned) + suffix <- humaniformat::suffix(cleaned) + + # Combine last name and suffix (e.g., Jr.), handling NA values safely + surname <- ifelse(is.na(suffix) | suffix == "", last, paste(last, suffix)) + return(surname) + })) ) }) } - - #' Get raster info from a file on disk #' #' This function populates a spatialRaster element with the @@ -463,7 +494,6 @@ extract_name <- function(x){ #' @param coord_name (char) horizCoordSysDef name #' @param attributes (dataTable) attributes for raster #' -#' #' @export eml_get_raster_metadata <- function(path, coord_name = NULL, attributes){ diff --git a/R/ontology.R b/R/ontology.R index 2fcb02f..a9f7fee 100644 --- a/R/ontology.R +++ b/R/ontology.R @@ -14,12 +14,12 @@ read_ontology <- function(ontology_name) { if(ontology_name == "mosaic"){ ann_url <- "https://raw.githubusercontent.com/DataONEorg/sem-prov-ontologies/main/MOSAiC/MOSAiC.owl" - ont <- rdflib::rdf_parse(pins::pin(ann_url), + ont <- rdflib::rdf_parse(ann_url, format = "rdfxml") } else if(ontology_name == "ecso"){ ann_url <- "https://raw.githubusercontent.com/DataONEorg/sem-prov-ontologies/ECSO8-add_non-carbon_measurements/observation/ECSO8.owl" - ont <- rdflib::rdf_parse(pins::pin(ann_url), + ont <- rdflib::rdf_parse(ann_url, format = "rdfxml") } else if (ontology_name == "ADCAD"){ ann_url <- "https://data.bioontology.org/ontologies/ADCAD/download?apikey=8b5b7825-538d-40e0-9e9e-5ab9274a9aeb&download_format=rdf" diff --git a/R/util.R b/R/util.R index 33cdeae..8c51b05 100644 --- a/R/util.R +++ b/R/util.R @@ -91,7 +91,7 @@ show_random_dataset <- function(inventory, theme=NULL, n=10) { cat(paste0("Theme: ", theme, "\n")) cat(paste0("nfiles: ", length(files), "\n")) cat(paste0("Base dir: ", base_dir, "\n")) - print(head(files, n = n)) + print(utils::head(files, n = n)) if (length(files) > n) { cat(paste0("...and ", length(files) - n, " more files.\n")) } } @@ -1007,7 +1007,7 @@ set_public_read_all_versions <- function(mn, resource_map_pid) { stopifnot(is(mn, 'MNode')) stopifnot(is_token_set(mn)) stopifnot(is.character(resource_map_pid)) - stopifnot(arcticdatautils:::is_resource_map(mn, resource_map_pid)) + stopifnot(is_resource_map(mn, resource_map_pid)) pids <- get_package(mn, resource_map_pid) %>% unlist() diff --git a/man/arcticdatautils-package.Rd b/man/arcticdatautils-package.Rd new file mode 100644 index 0000000..da3c439 --- /dev/null +++ b/man/arcticdatautils-package.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/arcticdatautils.R +\docType{package} +\name{arcticdatautils-package} +\alias{arcticdatautils} +\alias{arcticdatautils-package} +\title{arcticdatautils: Utilities for the Arctic Data Center} +\description{ +This package contains code for doing lots of useful stuff that's too specific for the +dataone package, primarily functions that streamline Arctic Data Center operations. +} +\seealso{ +Useful links: +\itemize{ + \item \url{https://nceas.github.io/arcticdatautils/} + \item Report bugs at \url{https://github.com/NCEAS/arcticdatautils/issues} +} + +} +\author{ +\strong{Maintainer}: Bryce Mecum \email{mecum@nceas.ucsb.edu} + +Authors: +\itemize{ + \item Bryce Mecum \email{mecum@nceas.ucsb.edu} +} + +Other contributors: +\itemize{ + \item Matt Jones \email{jones@nceas.ucsb.edu} [contributor] + \item Jesse Goldstein \email{jgoldstein@nceas.ucsb.edu} (Maintainer) [contributor] + \item Jeanette Clark \email{jclark@nceas.ucsb.edu} (Maintainer) [contributor] + \item Dominic Mullen \email{dmullen17@gmail.com} [contributor] + \item Emily O'Dean \email{eodean10@gmail.com} [contributor] + \item Robyn Thiessen-Bock \email{robyn.thiessenbock@gmail.com} [contributor] + \item Derek Strong \email{dstrong@nceas.ucsb.edu} [contributor] + \item Rachel Sun \email{rachelsun@ucsb.edu} [contributor] + \item Jasmine Lai \email{jasminelai@nceas.ucsb.edu} [contributor] + \item Justin Kadi \email{jeakadi@nceas.ucsb.edu} [contributor] +} + +} diff --git a/man/arcticdatautils.Rd b/man/arcticdatautils.Rd deleted file mode 100644 index 5d38fd9..0000000 --- a/man/arcticdatautils.Rd +++ /dev/null @@ -1,10 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/arcticdatautils.R -\docType{package} -\name{arcticdatautils} -\alias{arcticdatautils} -\title{arcticdatautils: Utilities for the Arctic Data Center} -\description{ -This package contains code for doing lots of useful stuff that's too specific for the -dataone package, primarily functions that streamline Arctic Data Center operations. -} diff --git a/tests/testthat/test_access.R b/tests/testthat/test_access.R index 8b2f8ba..1651cff 100644 --- a/tests/testthat/test_access.R +++ b/tests/testthat/test_access.R @@ -1,5 +1,3 @@ -context("Access rules") - mn <- tryCatch(env_load()$mn, error = function(e) env_load()$mn) test_that("get_package works for a simple package", { diff --git a/tests/testthat/test_dataone.R b/tests/testthat/test_dataone.R index 6caa830..eaa243e 100644 --- a/tests/testthat/test_dataone.R +++ b/tests/testthat/test_dataone.R @@ -1,5 +1,3 @@ -context("Helpers for the dataone package") - node <- env_load()$mn test_that("permissions can be checked", { diff --git a/tests/testthat/test_editing.R b/tests/testthat/test_editing.R index 8a029ea..6f07b16 100644 --- a/tests/testthat/test_editing.R +++ b/tests/testthat/test_editing.R @@ -1,5 +1,3 @@ -context("Editing and managing data packages") - mn <- env_load()$mn test_that("we can publish an update", { diff --git a/tests/testthat/test_eml.R b/tests/testthat/test_eml.R index aa035df..9b77498 100644 --- a/tests/testthat/test_eml.R +++ b/tests/testthat/test_eml.R @@ -1,5 +1,3 @@ -context("EML") - mn <- env_load()$mn test_that("a dataTable and otherEntity can be added from a pid", { @@ -272,9 +270,12 @@ test_that('eml_nsf_to_project generates a valid project section', { test_that('eml_nsf_to_project handles bad funding numbers gracefully', { - awards <- c("abcdef", "1203473", "12345") + awards <- c("1203473", "12345") - expect_warning(proj <- eml_nsf_to_project(awards), "this award will not be included in the project section") + # test to be sure that missing award numbers generates warning + expect_warning(proj <- eml_nsf_to_project(awards), class="warning") + # test to be sure that a list with no valid award number generates error + expect_error(expect_warning(proj <- eml_nsf_to_project(c("abcdef")))) me <- list(individualName = list(givenName = "Jeanette", surName = "Clark")) @@ -298,10 +299,41 @@ test_that('eml_nsf_to_project fails gracefully', { test_that('eml_nsf_to_project parses two-word last names correctly', { proj <- eml_nsf_to_project("1822406", eml_version = "2.2") + skip("Function uses humaniformat and can't parse Val Martin correctly") + expect_equal(proj$personnel[[1]]$individualName$givenName, "Maria") expect_equal(proj$personnel[[1]]$individualName$surName, "Val Martin") }) +test_that("eml_nsf_to_project removes emails correctly", { + awards <- c("2211153", "1822406", "2219216", "2029770") + proj <- eml_nsf_to_project(awards, eml_version = "2.2") + + expect_equal(proj$personnel[[1]]$individualName$givenName, "Jeffrey R") + expect_equal(proj$personnel[[1]]$individualName$surName, "Pierce") + + expect_equal(proj$personnel[[2]]$individualName$givenName, "Shantanu H") + expect_equal(proj$personnel[[2]]$individualName$surName, "Jathar") + + expect_equal(proj$personnel[[4]]$individualName$givenName, "Louisa K") + expect_equal(proj$personnel[[4]]$individualName$surName, "Emmons") + + expect_equal(proj$personnel[[5]]$individualName$givenName, "Christine") + expect_equal(proj$personnel[[5]]$individualName$surName, "Wiedinmyer") + + expect_equal(proj$personnel[[6]]$individualName$givenName, "Megan D") + expect_equal(proj$personnel[[6]]$individualName$surName, "Willis") + + expect_equal(proj$personnel[[7]]$individualName$givenName, "Christine") + expect_equal(proj$personnel[[7]]$individualName$surName, "Wiedinmyer") + + expect_equal(proj$personnel[[8]]$individualName$givenName, "Taylor") + expect_equal(proj$personnel[[8]]$individualName$surName, "van Doren") + + expect_equal(proj$personnel[[9]]$individualName$givenName, "Jason M") + expect_equal(proj$personnel[[9]]$individualName$surName, "St Clair") +}) + test_that('Data object physical created for an EML', { if (!is_token_set(mn)) { @@ -331,6 +363,7 @@ test_that('Data object physical created for an EML', { }) + test_that('Valid publisher information can be added', { me <- list(individualName = list(givenName = "Jeanette", surName = "Clark")) diff --git a/tests/testthat/test_environment.R b/tests/testthat/test_environment.R index ba42e7a..592ef65 100644 --- a/tests/testthat/test_environment.R +++ b/tests/testthat/test_environment.R @@ -1,5 +1,3 @@ -context("Environment") - test_that("can load a simple environment file", { x <- yaml::yaml.load_file(system.file("./environment.yml", package = "arcticdatautils")) diff --git a/tests/testthat/test_formats.R b/tests/testthat/test_formats.R index 3cbb06c..7069daf 100644 --- a/tests/testthat/test_formats.R +++ b/tests/testthat/test_formats.R @@ -1,5 +1,3 @@ -context("Formats") - test_that("valid formats are valid and invalid ones are not", { expect_true(check_format("text/csv")) expect_error(check_format("badformat")) diff --git a/tests/testthat/test_helpers.R b/tests/testthat/test_helpers.R index 7b446fe..b931455 100644 --- a/tests/testthat/test_helpers.R +++ b/tests/testthat/test_helpers.R @@ -1,5 +1,3 @@ -context("Helpers") - mn <- env_load()$mn test_that("a dummy package can be created", { diff --git a/tests/testthat/test_packaging.R b/tests/testthat/test_packaging.R index b65a06b..ce0e415 100644 --- a/tests/testthat/test_packaging.R +++ b/tests/testthat/test_packaging.R @@ -1,5 +1,3 @@ -context("Packaging") - test_that("child pids are correctly determined", { inventory <- data.frame(pid = c("A", "B", "C"), package = c("PA", "PB", "PC"), diff --git a/tests/testthat/test_sysmeta.R b/tests/testthat/test_sysmeta.R index 49ab9f3..6e227b8 100644 --- a/tests/testthat/test_sysmeta.R +++ b/tests/testthat/test_sysmeta.R @@ -1,5 +1,3 @@ -context("System metadata") - test_that("the replication policy gets cleared", { library(datapack) diff --git a/tests/testthat/test_util.R b/tests/testthat/test_util.R index 5f0fd2a..853e84e 100644 --- a/tests/testthat/test_util.R +++ b/tests/testthat/test_util.R @@ -1,5 +1,3 @@ -context("Utilities") - test_that("paths can be joined", { expect_equal(path_join(""), "") expect_equal(path_join(1), "1")