diff --git a/DESCRIPTION b/DESCRIPTION index ff6d9e6..feb3412 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: neotoma2 Title: Working with the Neotoma Paleoecology Database -Date: 2025-12-12 +Date: 2025-12-13 Version: 1.0.11 Authors@R: c(person(given = "Dominguez Vidana", @@ -17,6 +17,8 @@ URL: https://github.com/NeotomaDB/neotoma2 BugReports: https://github.com/NeotomaDB/neotoma2/issues Description: Access and manipulation of data using the Neotoma Paleoecology Database. . + Examples in functions that require API access are not executed during CRAN checks. + Vignettes do not execute as to avoid API calls during CRAN checks. License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) diff --git a/NEWS.md b/NEWS.md index 624a86f..8d09566 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,9 @@ ## neotoma2 1.0.11 -Added flag error=True to all vignette codechunks to not run when API is down in case API comes down in between a knitting. +Set examples to \dontrun{} to avoid violating CRAN's policy that allows access to internet. +Set vignettes to `eval=FALSE` as to avoid calling APIs that require access to internet. +Set all tests that require API call to `skip on CRAN`. ## neotoma2 1.0.10 diff --git a/R/01_classDefinitions.R b/R/01_classDefinitions.R index 3b7cb16..f0c94a2 100644 --- a/R/01_classDefinitions.R +++ b/R/01_classDefinitions.R @@ -7,8 +7,9 @@ setClassUnion("id", c("character", "integer", "numeric")) #' @name contacts_classes #' @description An unordered list of individual S4 `contact` objects. #' @export -#' @examples +#' @examples { #' new("contact", familyname = "Goring", givennames = "Simon J.") +#' } #' @returns object of class `contact` #' @aliases contact-class #' @md diff --git a/R/chronology-methods.R b/R/chronology-methods.R index 75029df..e70c8d9 100644 --- a/R/chronology-methods.R +++ b/R/chronology-methods.R @@ -1,3 +1,181 @@ +#' @title Display a `chronology` object +#' @name show +#' @export +setMethod( + "show", + "chronology", + function(object) { + + df <- data.frame( + chronologyid = object@chronologyid, + chronologyname = object@chronologyname, + agemodel = object@agemodel, + ageboundolder = object@ageboundolder, + ageboundyounger = object@ageboundyounger, + dateprepared = object@dateprepared, + modelagetype = object@modelagetype, + isdefault = object@isdefault, + n_controls = sum(!is.na(object@chroncontrols$chroncontrolid)) + ) + + df <- subset( + df, + !(is.na(chronologyname) & + is.na(agemodel) & + is.na(ageboundolder) & + is.na(ageboundyounger) & + is.na(dateprepared) & + is.na(modelagetype) & + is.na(isdefault) & + n_controls == 0) + ) + + if (nrow(df) > 0) { + print(df, row.names = FALSE) + } else { + cat("No chronology information available.\n") + } + } +) +#' @title Display a `chronologies` object +#' @name show +#' @export +setMethod( + "show", + "chronologies", + function(object) { + + if (length(object@chronologies) == 0) { + cat("No chronology information available.\n") + return(invisible(NULL)) + } + + df <- purrr::map(object@chronologies, function(ch) { + data.frame( + chronologyid = ch@chronologyid, + chronologyname = ch@chronologyname, + agemodel = ch@agemodel, + ageboundolder = ch@ageboundolder, + ageboundyounger = ch@ageboundyounger, + dateprepared = ch@dateprepared, + modelagetype = ch@modelagetype, + isdefault = ch@isdefault, + n_controls = sum(!is.na(ch@chroncontrols$chroncontrolid)) + ) + }) |> + dplyr::bind_rows() + + df <- subset( + df, + !(is.na(chronologyname) & + is.na(agemodel) & + is.na(ageboundolder) & + is.na(ageboundyounger) & + is.na(dateprepared) & + is.na(modelagetype) & + is.na(isdefault) & + n_controls == 0) + ) + + if (nrow(df) > 0) { + print(df, row.names = FALSE) + } else { + cat("No chronology information available.\n") + } + } +) + +#' @export +setMethod( + "chroncontrols", + "chronologies", + function(x) { + + if (length(x@chronologies) == 0) { + return( + data.frame( + chronologyid = integer(), + chronologyname = character(), + depth = numeric(), + thickness = numeric(), + agelimityounger = numeric(), + agelimitolder = numeric(), + chroncontrolid = integer(), + chroncontrolage = numeric(), + chroncontroltype = character() + ) + ) + } + + df <- purrr::map(x@chronologies, function(ch) { + + data.frame( + chronologyid = ch@chronologyid, + chronologyname = ch@chronologyname, + ch@chroncontrols + ) + + }) |> + dplyr::bind_rows() + + df <- subset( + df, + !(is.na(depth) & + is.na(thickness) & + is.na(agelimityounger) & + is.na(agelimitolder) & + is.na(chroncontrolid) & + is.na(chroncontrolage) & + is.na(chroncontroltype)) + ) + + df + } +) +#' @export +setMethod( + "chroncontrols", + "chronology", + function(x) { + + df <- x@chroncontrols + + df <- subset( + df, + !(is.na(depth) & + is.na(thickness) & + is.na(agelimityounger) & + is.na(agelimitolder) & + is.na(chroncontrolid) & + is.na(chroncontrolage) & + is.na(chroncontroltype)) + ) + + df + } +) + +setMethod( + "chroncontrols", + "site", + function(x) { + + siteid <- as.data.frame(x)$siteid + + chronset <- chroncontrols(chronologies(x)) + + if (nrow(chronset) == 0) { + chronset$siteid <- integer(0) + } else { + chronset$siteid <- siteid + } + + chronset <- dplyr::select(chronset, siteid, dplyr::everything()) + + chronset + } +) + #' @rdname sub-sub setMethod(f = "[[", signature = signature(x = "chronologies", i = "numeric"), @@ -119,4 +297,4 @@ setMethod(f = "set_default", return(x@chronologies[[y]]) }) return(new("chronologies", chronologies = chronout)) - }) \ No newline at end of file + }) diff --git a/R/clean.R b/R/clean.R index 4bcd523..d9942da 100644 --- a/R/clean.R +++ b/R/clean.R @@ -16,7 +16,7 @@ #' * After: \{site: 1, dataset: \[1, 2\]\} #' So the site is gathered, and the datasets are now part of an #' array of datasets. -#' @examples \donttest{ +#' @examples \dontrun{ #' tryCatch({ #' alex <- get_sites(sitename = "Alex%") #' alex2 <- get_sites(24) diff --git a/R/filter.R b/R/filter.R index bdd005f..71bbf76 100644 --- a/R/filter.R +++ b/R/filter.R @@ -49,7 +49,7 @@ #' @param .by (only used for filtering `data.frame` objects) #' @param .preserve (only used for filtering `data.frame` objects) #' @returns filtered `sites` object -#' @examples \donttest{ +#' @examples \dontrun{ #' # Download 10 sites, but only keep the sites that are close to sea level. #' tryCatch({ #' some_sites <- get_sites(sitename = "Lake%", limit = 3) diff --git a/R/get_datasets.R b/R/get_datasets.R index 56b5b45..3f67002 100644 --- a/R/get_datasets.R +++ b/R/get_datasets.R @@ -60,7 +60,7 @@ #' record. #' * `all_data` The API only downloads the first 25 records of the query. #' For the complete records, use `all_data=TRUE` -#' @examples \donttest{ +#' @examples \dontrun{ #' tryCatch({ #' random_sites <- get_sites(1) #' allds <- get_datasets(random_sites, limit=3) diff --git a/R/get_documentation.R b/R/get_documentation.R index 321bca6..9828d35 100644 --- a/R/get_documentation.R +++ b/R/get_documentation.R @@ -4,7 +4,7 @@ #' @importFrom utils browseURL #' @importFrom rlang is_interactive #' @returns NULL -#' @examples \donttest{ +#' @examples \dontrun{ #' if (interactive()) { #' get_documentation() #' } diff --git a/R/get_downloads.R b/R/get_downloads.R index e4d7982..46b3202 100644 --- a/R/get_downloads.R +++ b/R/get_downloads.R @@ -48,7 +48,7 @@ #' \item{ \code{pi list} }{P.I. info} #' \item{ \code{analyst} }{analyst info} #' \item{ \code{metadata} }{dataset metadata} -#' @examples \donttest{ +#' @examples \dontrun{ #' # To find the downloads object of dataset 24: #' tryCatch({ #' downloads24 <- get_downloads(24) diff --git a/R/get_manual.R b/R/get_manual.R index 15400d6..95bdb4a 100644 --- a/R/get_manual.R +++ b/R/get_manual.R @@ -3,7 +3,7 @@ #' @description Open up the Neotoma manual homepage. #' @importFrom utils browseURL #' @importFrom rlang is_interactive -#' @examples { +#' @examples \dontrun{ #' # This call does not work from `source()` calls or in testing. #' # interactive() just lets us know you are interacting with the console: #' if (interactive()) { diff --git a/R/get_publications.R b/R/get_publications.R index be2a0f4..0eb7ed4 100644 --- a/R/get_publications.R +++ b/R/get_publications.R @@ -17,7 +17,7 @@ #' `year` The year the publication was released. #' `search` A plain text search string used to search the citation. #' @returns `publications` object -#' @examples \donttest{ +#' @examples \dontrun{ #' # How old are the papers in Neotoma that include the term "mammut"? #' tryCatch({ #' mammoth_papers <- get_publications(search="mammut") %>% diff --git a/R/get_sites.R b/R/get_sites.R index bee10f6..3575445 100644 --- a/R/get_sites.R +++ b/R/get_sites.R @@ -62,21 +62,11 @@ #' * `loc` An `sf` object that describes site's location. #' * `description` #' * `collunits` limited information on collunits -#' @examples -#' \donttest{ +#' @examples \dontrun{ #' ## Find sites with a min altitude of 12m and a max altitude of 25m -#' tryCatch({ -#' sites_12to25 <- get_sites(altmin=12, altmax=25) -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) -#' ## Return all sites, using a minimum altitude of 2500m (returns >500 sites): -#' tryCatch({ -#' sites_2500 <- get_sites(altmin=2500, all_data = TRUE) -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) -#' ## To find sites in Brazil +#' sites_12to25 <- get_sites(altmin=12, altmax=25) +#' sites_2500 <- get_sites(altmin=2500, all_data = TRUE) +#' ## To find sites in Brazil #' brazil <- '{"type": "Polygon", #' "coordinates": [[ #' [-73.125, -9.102096738726443], @@ -84,20 +74,7 @@ #' [-36.5625,-7.710991655433217], #' [-68.203125,13.923403897723347], #' [-73.125,-9.102096738726443]]]}' -#' tryCatch({ #' brazil_sites <- get_sites(loc = brazil[1]) -#' # Finding all sites with Liliaceae pollen in 1000 year bins: -#' lilysites <- c() -#' for (i in seq(0, 10000, by = 1000)) { -#' lily <- get_sites(taxa=c("Liliaceae"), -#' ageyoung = i - 500, -#' ageold = i + 500, -#' all_data = TRUE) -#' lilysites <- c(lilysites, length(lily)) -#' } -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) #' } #' @md #' @export diff --git a/R/get_speleothems.R b/R/get_speleothems.R index a0aebf1..d4f4181 100644 --- a/R/get_speleothems.R +++ b/R/get_speleothems.R @@ -58,13 +58,9 @@ speleo_helper <- function(sites) { #' * `x` The unique dataset ID (integer) in Neotoma. Can be passed as a #' vector of dataset IDs. #' * `sites` A `sites` R object. -#' @examples { +#' @examples \dontrun{ #' ## Find speleothems by numeric datasetid: -#' tryCatch({ -#' speleo <- get_speleothems(c(2,5)) -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) +#' speleo <- get_speleothems(c(2,5)) #' } #' @md #' @export diff --git a/R/get_stats.R b/R/get_stats.R index 58f26e7..3c747c1 100644 --- a/R/get_stats.R +++ b/R/get_stats.R @@ -21,7 +21,7 @@ #' added per month), and \code{dstypemonth} (the number of datasets added #' per dataset type per month). Default is \code{dsdbmonth}. #' @returns `data.frame` with summary statistics -#' @examples \donttest{ +#' @examples \dontrun{ #' tryCatch({ #' last_month <- get_stats(start = 0, end = 1, type = "dsdbmonth") #' }, error = function(e) { diff --git a/R/get_table.R b/R/get_table.R index 43a6047..ca54655 100644 --- a/R/get_table.R +++ b/R/get_table.R @@ -6,13 +6,9 @@ #' @param limit Default 25 records #' @param offset Default 0. #' @returns selected `table` values from the Database. -#' @examples { +#' @examples \dontrun{ #' # Returns only the first 25 specimen records. -#' tryCatch({ #' someSpec <- get_table('specimens') -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) #' } #' @importFrom dplyr bind_rows #' @importFrom purrr map diff --git a/R/getids.r b/R/getids.r index 8e6d47a..05a3327 100644 --- a/R/getids.r +++ b/R/getids.r @@ -9,13 +9,9 @@ #' @param x A Neotoma2 \code{sites} or \code{collunits} object. #' @param order sort items by `siteid`, `collunitid`, `datasetid` #' @returns `data.frame` containing `siteid`, `datasetid`, and `collunitid` -#' @examples \donttest{ -#' tryCatch({ +#' @examples \dontrun{ #' marion <- get_sites(sitename = "Marion Lake") #' collunitids <- getids(collunits(marion)) -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) #' } #' @md #' @export diff --git a/R/pingNeotoma.r b/R/pingNeotoma.r index bfa6b09..9cada98 100644 --- a/R/pingNeotoma.r +++ b/R/pingNeotoma.r @@ -8,7 +8,7 @@ #' numeric port), \code{neotoma} or \code{dev}. #' @returns A valid HTTP status code or returns an error if a connection #' is refused. -#' @examples { +#' @examples \dontrun{ #' test_connection <- pingNeotoma("neotoma") #' } #' @export diff --git a/R/plotLeaflet.R b/R/plotLeaflet.R index 33e25e1..2b180a7 100644 --- a/R/plotLeaflet.R +++ b/R/plotLeaflet.R @@ -4,7 +4,7 @@ #' @importFrom leaflet leaflet addTiles addCircleMarkers #' @importFrom leaflet markerOptions markerClusterOptions #' @param object Sites object to plot -#' @examples \donttest{ +#' @examples \dontrun{ #' # Note that by default the limit for queries is 25 records: #' tryCatch({ #' modernSites <- get_sites(keyword = "Modern") diff --git a/R/samples.R b/R/samples.R index ee1e0e5..927bb91 100644 --- a/R/samples.R +++ b/R/samples.R @@ -3,13 +3,10 @@ #' @author Simon Goring \email{goring@wisc.edu} #' @param x sites object #' @description Obtain all samples within a sites object -#' @examples { -#' tryCatch({ +#' @examples \dontrun{ +#' # Get full data download from API and create a long table with samples data. #' dw <- get_downloads(1) #' pollen <- samples(dw) -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) #' } #' @importFrom dplyr bind_rows left_join rename mutate #' @importFrom purrr map diff --git a/R/set_server.R b/R/set_server.R index 4d9bdbc..ff0e2a1 100644 --- a/R/set_server.R +++ b/R/set_server.R @@ -3,7 +3,7 @@ #' @importFrom assertthat assert_that #' @param server One of \code{local} (when the API is running locally on #' port 3005), \code{neotoma} or \code{dev}. -#' @examples \donttest{ +#' @examples \dontrun{ #' # The user is running the API locally using the node/express API #' # cloned from github: https://github.com/NeotomaDB/api_nodetest #' set_server(server = "local") diff --git a/R/site-methods.R b/R/site-methods.R index e7138c3..5a05f9b 100644 --- a/R/site-methods.R +++ b/R/site-methods.R @@ -48,13 +48,9 @@ setMethod(f = "show", #' @description Obtain one of the elements within a `sites`, #' `collectionunits`, `datasets`, etc... Neotoma objects. #' @returns sliced `site` object -#' @examples \donttest{ -#' tryCatch({ -#' some_site <- get_sites(sitename = "Site%", limit=3) -#' some_site[[2]] -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) +#' @examples \dontrun{ +#' some_site <- get_sites(sitename = "Site%", limit=3) +#' some_site[[2]] #' } #' @aliases [[,sites,numeric-method #' @exportMethod [[ @@ -407,13 +403,10 @@ setMethod(f = "summary", #' @importFrom dplyr bind_rows full_join select arrange filter #' @importFrom dplyr mutate group_by row_number #' @returns `data.frame` object with DOIs information. -#' @examples { -#' tryCatch({ +#' @examples \dontrun{ +#' # Get datasets metadata from API and retrieve DOIs #' ds <- get_datasets(1) #' doi(ds) -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) #' } #' @aliases doi,sites-method #' @exportMethod doi @@ -460,13 +453,9 @@ setMethod(f = "doi", #' @importFrom purrr map #' @importFrom dplyr bind_rows full_join select arrange filter #' @returns `data.frame` object with citation information. -#' @examples { -#' tryCatch({ +#' @examples \dontrun{ +#' # Get datasets metadata from API #' ds <- get_datasets(1) -#' cite_data(ds) -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) #' } #' @aliases cite_data,sites-method #' @exportMethod cite_data diff --git a/R/speleothemdetails.R b/R/speleothemdetails.R index 065a94a..5d76f3e 100644 --- a/R/speleothemdetails.R +++ b/R/speleothemdetails.R @@ -7,16 +7,12 @@ #' @returns `data.frame` with speleothem records #' @description Obtain elements on the speleothems level #' Experimental function: API and behavior may change. -#' @examples \donttest{ -#' tryCatch({ +#' @examples \dontrun{ #' kesang <- get_sites(sitename = "Kesang cave") %>% #' get_datasets() %>% #' filter(datasettype == "pollen") %>% #' get_speleothems() #' sp <- speleothemdetails(kesang) -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) #' } #' @md #' @export diff --git a/R/speleothems.R b/R/speleothems.R index 3a262ac..b2d0348 100644 --- a/R/speleothems.R +++ b/R/speleothems.R @@ -7,13 +7,9 @@ #' @returns `data.frame` with sample records #' @description Obtain all speleothems within a sites object #' Experimental function: API and behavior may change. -#' @examples { -#' tryCatch({ +#' @examples \dontrun{ #' ds <- get_datasets(37302) #' sp <- speleothems(ds) -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) #' } #' @md #' @export diff --git a/R/taxa.R b/R/taxa.R index 98fef5c..12d803f 100644 --- a/R/taxa.R +++ b/R/taxa.R @@ -6,15 +6,11 @@ #' @returns A \code{data.frame} reporting the taxa/data objects, units, #' elements and other features within a set of records. #' @description Extract taxonomic data from a set of sites. -#' @examples \donttest{ -#' tryCatch({ +#' @examples \dontrun{ #' somesites <- get_sites(datasettype = "diatom") %>% #' get_downloads() #' diatomtaxa <- taxa(somesites) -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) -#' } +#' } #' @md #' @export setMethod(f = "taxa", diff --git a/R/toWide.R b/R/toWide.R index c68ac1c..6c35d3d 100644 --- a/R/toWide.R +++ b/R/toWide.R @@ -14,9 +14,7 @@ #' @param operation label or vector of operations to be chosen from: #' 'prop', 'sum', 'presence'. #' @returns wide `data.frame` obtained from long `samples` `data.frame` -#' @examples -#' \donttest{ -#' tryCatch({ +#' @examples \dontrun{ #' fc_sites <- neotoma2::get_datasets(limit=5, datasettype = "vertebrate fauna") #' fc_ds <- fc_sites %>% #' neotoma2::get_downloads() @@ -24,10 +22,7 @@ #' fc_smp <- samples(fc_dl1) #' toWide(fc_smp, ecologicalgroups=c('AVES', 'RODE'), #' elementtypes='bone/tooth', unit='present/absent') -#' }, error = function(e) { -#' message("Neotoma server not responding. Try again later.") -#' }) -#'} +#' } #' @description Obtain a wide table with information regarding of #' samples grouped by variablename and depth/age. #' @export diff --git a/cran-comments.md b/cran-comments.md index fff265b..e5f34a8 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -9,7 +9,10 @@ ## Bugfix neotoma2 1.0.11 -Added flag error=True to all vignette codechunks to not run when API is down in case API comes down in between a knitting. +Set examples to \dontrun{} to avoid violating CRAN's policy that allows access to internet. +Set vignettes to `eval=FALSE` as to avoid calling APIs that require access to internet. +Set all tests that require API call to `skip on CRAN`. + ## Bugfix neotoma2 1.0.10 diff --git a/man/cite_data-sites-method.Rd b/man/cite_data-sites-method.Rd index 546f672..3aecf3f 100644 --- a/man/cite_data-sites-method.Rd +++ b/man/cite_data-sites-method.Rd @@ -18,12 +18,8 @@ Given complete dataset objects in Neotoma (must have used citation for the record, including the dataset DOI. } \examples{ -{ -tryCatch({ +\dontrun{ +# Get datasets metadata from API ds <- get_datasets(1) -cite_data(ds) -}, error = function(e) { -message("Neotoma server not responding. Try again later.") -}) } } diff --git a/man/clean.Rd b/man/clean.Rd index fc17a98..c74756a 100644 --- a/man/clean.Rd +++ b/man/clean.Rd @@ -39,7 +39,7 @@ array of datasets. } } \examples{ -\donttest{ +\dontrun{ tryCatch({ alex <- get_sites(sitename = "Alex\%") alex2 <- get_sites(24) diff --git a/man/contacts_classes.Rd b/man/contacts_classes.Rd index 8fb1b81..084d8bc 100644 --- a/man/contacts_classes.Rd +++ b/man/contacts_classes.Rd @@ -14,5 +14,7 @@ object of class \code{contact} An unordered list of individual S4 \code{contact} objects. } \examples{ +{ new("contact", familyname = "Goring", givennames = "Simon J.") } +} diff --git a/man/doi-sites-method.Rd b/man/doi-sites-method.Rd index 77a9ab0..6e3d9a7 100644 --- a/man/doi-sites-method.Rd +++ b/man/doi-sites-method.Rd @@ -18,12 +18,9 @@ Given complete dataset objects in Neotoma (must have used DOI for the record. } \examples{ -{ -tryCatch({ +\dontrun{ +# Get datasets metadata from API and retrieve DOIs ds <- get_datasets(1) doi(ds) -}, error = function(e) { -message("Neotoma server not responding. Try again later.") -}) } } diff --git a/man/filter.Rd b/man/filter.Rd index 38533df..a149056 100644 --- a/man/filter.Rd +++ b/man/filter.Rd @@ -71,7 +71,7 @@ depositional environment. } } \examples{ -\donttest{ +\dontrun{ # Download 10 sites, but only keep the sites that are close to sea level. tryCatch({ some_sites <- get_sites(sitename = "Lake\%", limit = 3) diff --git a/man/get_datasets.Rd b/man/get_datasets.Rd index 79a12e2..a823f46 100644 --- a/man/get_datasets.Rd +++ b/man/get_datasets.Rd @@ -88,7 +88,7 @@ For the complete records, use \code{all_data=TRUE} } } \examples{ -\donttest{ +\dontrun{ tryCatch({ random_sites <- get_sites(1) allds <- get_datasets(random_sites, limit=3) diff --git a/man/get_documentation.Rd b/man/get_documentation.Rd index 1f2c8ec..f36e1e9 100644 --- a/man/get_documentation.Rd +++ b/man/get_documentation.Rd @@ -10,7 +10,7 @@ get_documentation() Open up the Neotoma R homepage. } \examples{ -\donttest{ +\dontrun{ if (interactive()) { get_documentation() } diff --git a/man/get_downloads.Rd b/man/get_downloads.Rd index 369a88e..7e750bc 100644 --- a/man/get_downloads.Rd +++ b/man/get_downloads.Rd @@ -71,7 +71,7 @@ For the complete records, use \code{all_data=TRUE} } } \examples{ -\donttest{ +\dontrun{ # To find the downloads object of dataset 24: tryCatch({ downloads24 <- get_downloads(24) diff --git a/man/get_manual.Rd b/man/get_manual.Rd index 33f1978..e021385 100644 --- a/man/get_manual.Rd +++ b/man/get_manual.Rd @@ -13,7 +13,7 @@ NULL side effect for opening browser with the manual Open up the Neotoma manual homepage. } \examples{ -{ +\dontrun{ # This call does not work from `source()` calls or in testing. # interactive() just lets us know you are interacting with the console: if (interactive()) { diff --git a/man/get_publications.Rd b/man/get_publications.Rd index bca472a..efa11cd 100644 --- a/man/get_publications.Rd +++ b/man/get_publications.Rd @@ -42,7 +42,7 @@ Uses the Neotoma API to search and access information about publications associated with data in the Neotoma Paleoecology Database } \examples{ -\donttest{ +\dontrun{ # How old are the papers in Neotoma that include the term "mammut"? tryCatch({ mammoth_papers <- get_publications(search="mammut") \%>\% diff --git a/man/get_sites.Rd b/man/get_sites.Rd index 5067869..34d375c 100644 --- a/man/get_sites.Rd +++ b/man/get_sites.Rd @@ -88,20 +88,11 @@ and datasets located at that site. } } \examples{ -\donttest{ +\dontrun{ ## Find sites with a min altitude of 12m and a max altitude of 25m -tryCatch({ - sites_12to25 <- get_sites(altmin=12, altmax=25) -}, error = function(e) { - message("Neotoma server not responding. Try again later.") -}) -## Return all sites, using a minimum altitude of 2500m (returns >500 sites): -tryCatch({ - sites_2500 <- get_sites(altmin=2500, all_data = TRUE) -}, error = function(e) { - message("Neotoma server not responding. Try again later.") -}) - ## To find sites in Brazil +sites_12to25 <- get_sites(altmin=12, altmax=25) +sites_2500 <- get_sites(altmin=2500, all_data = TRUE) +## To find sites in Brazil brazil <- '{"type": "Polygon", "coordinates": [[ [-73.125, -9.102096738726443], @@ -109,20 +100,7 @@ brazil <- '{"type": "Polygon", [-36.5625,-7.710991655433217], [-68.203125,13.923403897723347], [-73.125,-9.102096738726443]]]}' -tryCatch({ brazil_sites <- get_sites(loc = brazil[1]) -# Finding all sites with Liliaceae pollen in 1000 year bins: -lilysites <- c() -for (i in seq(0, 10000, by = 1000)) { - lily <- get_sites(taxa=c("Liliaceae"), - ageyoung = i - 500, - ageold = i + 500, - all_data = TRUE) - lilysites <- c(lilysites, length(lily)) -} -}, error = function(e) { - message("Neotoma server not responding. Try again later.") -}) } } \author{ diff --git a/man/get_speleothems.Rd b/man/get_speleothems.Rd index def9d9b..f9702f4 100644 --- a/man/get_speleothems.Rd +++ b/man/get_speleothems.Rd @@ -36,13 +36,9 @@ vector of dataset IDs. } } \examples{ -{ +\dontrun{ ## Find speleothems by numeric datasetid: -tryCatch({ - speleo <- get_speleothems(c(2,5)) -}, error = function(e) { - message("Neotoma server not responding. Try again later.") -}) +speleo <- get_speleothems(c(2,5)) } } \author{ diff --git a/man/get_stats.Rd b/man/get_stats.Rd index 2bf5f1e..ba80d05 100644 --- a/man/get_stats.Rd +++ b/man/get_stats.Rd @@ -36,7 +36,7 @@ information about the overall number of sites/datasets (using an arbitrarily high value for \code{end}). } \examples{ -\donttest{ +\dontrun{ tryCatch({ last_month <- get_stats(start = 0, end = 1, type = "dsdbmonth") }, error = function(e) { diff --git a/man/get_table.Rd b/man/get_table.Rd index 03b0b96..66a341a 100644 --- a/man/get_table.Rd +++ b/man/get_table.Rd @@ -22,12 +22,8 @@ Call Neotoma and return a table (with limits & offsets for large tables) } \examples{ -{ +\dontrun{ # Returns only the first 25 specimen records. -tryCatch({ someSpec <- get_table('specimens') -}, error = function(e) { - message("Neotoma server not responding. Try again later.") -}) } } diff --git a/man/getids.Rd b/man/getids.Rd index 393b31e..6f01db3 100644 --- a/man/getids.Rd +++ b/man/getids.Rd @@ -32,13 +32,9 @@ This function parses a site object, from \code{site} to site, collectionunit and dataset IDs for each element within the site. } \examples{ -\donttest{ -tryCatch({ +\dontrun{ marion <- get_sites(sitename = "Marion Lake") collunitids <- getids(collunits(marion)) -}, error = function(e) { - message("Neotoma server not responding. Try again later.") -}) } } \author{ diff --git a/man/pingNeotoma.Rd b/man/pingNeotoma.Rd index 38701bb..801e4ba 100644 --- a/man/pingNeotoma.Rd +++ b/man/pingNeotoma.Rd @@ -19,7 +19,7 @@ A quick function to test whether or not the Neotoma Database API is currently running. } \examples{ -{ +\dontrun{ test_connection <- pingNeotoma("neotoma") } } diff --git a/man/plotLeaflet-sites-method.Rd b/man/plotLeaflet-sites-method.Rd index 8fe958c..4be5e23 100644 --- a/man/plotLeaflet-sites-method.Rd +++ b/man/plotLeaflet-sites-method.Rd @@ -16,7 +16,7 @@ Plot sites on a leaflet map } \examples{ -\donttest{ +\dontrun{ # Note that by default the limit for queries is 25 records: tryCatch({ modernSites <- get_sites(keyword = "Modern") diff --git a/man/samples-sites-method.Rd b/man/samples-sites-method.Rd index 305aa75..35dadaf 100644 --- a/man/samples-sites-method.Rd +++ b/man/samples-sites-method.Rd @@ -16,13 +16,10 @@ Obtain all samples within a sites object } \examples{ -{ -tryCatch({ +\dontrun{ +# Get full data download from API and create a long table with samples data. dw <- get_downloads(1) pollen <- samples(dw) -}, error = function(e) { - message("Neotoma server not responding. Try again later.") -}) } } \author{ diff --git a/man/set_server.Rd b/man/set_server.Rd index b0f62de..4e4bad9 100644 --- a/man/set_server.Rd +++ b/man/set_server.Rd @@ -18,7 +18,7 @@ Choose to pull Neotoma data from the main Neotoma server, the development server or from a local instance of the API. } \examples{ -\donttest{ +\dontrun{ # The user is running the API locally using the node/express API # cloned from github: https://github.com/NeotomaDB/api_nodetest set_server(server = "local") diff --git a/man/speleothemdetails-sites-method.Rd b/man/speleothemdetails-sites-method.Rd index d03ae05..706f9d3 100644 --- a/man/speleothemdetails-sites-method.Rd +++ b/man/speleothemdetails-sites-method.Rd @@ -17,16 +17,12 @@ Obtain elements on the speleothems level Experimental function: API and behavior may change. } \examples{ -\donttest{ -tryCatch({ +\dontrun{ kesang <- get_sites(sitename = "Kesang cave") \%>\% get_datasets() \%>\% filter(datasettype == "pollen") \%>\% get_speleothems() sp <- speleothemdetails(kesang) -}, error = function(e) { -message("Neotoma server not responding. Try again later.") -}) } } \author{ diff --git a/man/speleothems-sites-method.Rd b/man/speleothems-sites-method.Rd index d732211..96d42b7 100644 --- a/man/speleothems-sites-method.Rd +++ b/man/speleothems-sites-method.Rd @@ -17,13 +17,9 @@ Obtain all speleothems within a sites object Experimental function: API and behavior may change. } \examples{ -{ -tryCatch({ +\dontrun{ ds <- get_datasets(37302) sp <- speleothems(ds) -}, error = function(e) { -message("Neotoma server not responding. Try again later.") -}) } } \author{ diff --git a/man/sub-sub.Rd b/man/sub-sub.Rd index e7eeeaa..e2f21f5 100644 --- a/man/sub-sub.Rd +++ b/man/sub-sub.Rd @@ -54,12 +54,8 @@ Obtain one of the elements within a \code{sites}, \code{collectionunits}, \code{datasets}, etc... Neotoma objects. } \examples{ -\donttest{ -tryCatch({ - some_site <- get_sites(sitename = "Site\%", limit=3) - some_site[[2]] -}, error = function(e) { - message("Neotoma server not responding. Try again later.") -}) +\dontrun{ +some_site <- get_sites(sitename = "Site\%", limit=3) +some_site[[2]] } } diff --git a/man/taxa-sites-method.Rd b/man/taxa-sites-method.Rd index 1021971..ec1f1a1 100644 --- a/man/taxa-sites-method.Rd +++ b/man/taxa-sites-method.Rd @@ -17,15 +17,11 @@ elements and other features within a set of records. Extract taxonomic data from a set of sites. } \examples{ -\donttest{ -tryCatch({ +\dontrun{ somesites <- get_sites(datasettype = "diatom") \%>\% get_downloads() diatomtaxa <- taxa(somesites) -}, error = function(e) { -message("Neotoma server not responding. Try again later.") -}) - } +} } \author{ Socorro Dominguez \email{dominguezvid@wisc.edu} diff --git a/man/toWide.Rd b/man/toWide.Rd index 40366c7..ae6457d 100644 --- a/man/toWide.Rd +++ b/man/toWide.Rd @@ -40,8 +40,7 @@ Obtain a wide table with information regarding of samples grouped by variablename and depth/age. } \examples{ -\donttest{ -tryCatch({ +\dontrun{ fc_sites <- neotoma2::get_datasets(limit=5, datasettype = "vertebrate fauna") fc_ds <- fc_sites \%>\% neotoma2::get_downloads() @@ -49,9 +48,6 @@ fc_dl1 <- fc_dl[[1]] fc_smp <- samples(fc_dl1) toWide(fc_smp, ecologicalgroups=c('AVES', 'RODE'), elementtypes='bone/tooth', unit='present/absent') -}, error = function(e) { -message("Neotoma server not responding. Try again later.") -}) } } \author{ diff --git a/tests/testthat/test_chroncontrols.R b/tests/testthat/test_chroncontrols.R index 606e6e7..bcd48bd 100644 --- a/tests/testthat/test_chroncontrols.R +++ b/tests/testthat/test_chroncontrols.R @@ -14,4 +14,12 @@ test_that("Chroncontrols gets record", { testthat::expect_is(multi, "data.frame") testthat::expect_gt(length(unique(multi$chronologyid)), 4) testthat::expect_is(mamchron, "data.frame") +}) + +context("Chronology controls return nothing when nothing.") +test_that("Chroncontrols returns nothing", { + skip_on_cran() + empty <- chroncontrols(get_downloads(100)) + + testthat::expect_equal(length(empty[,0]), 0) }) \ No newline at end of file diff --git a/tests/testthat/test_chronologies.R b/tests/testthat/test_chronologies.R index 98c41b4..8ef0a04 100644 --- a/tests/testthat/test_chronologies.R +++ b/tests/testthat/test_chronologies.R @@ -14,4 +14,16 @@ test_that("`get_downloads()` fills up chronologies' slots.", { # Careful, if the DB is wrong, so will the API and this test will fail testthat::expect_equal(sum(chron$isdefault), 1) testthat::expect_is(chron, "data.frame") +}) + + + +context("`chronologies()` function is empty for empty downloads") +test_that("`get_downloads()` is empty for empty download", { + skip_on_cran() + dl <- get_downloads(100) + chron <- dl %>% chronologies() + + testthat::expect_equal(length(chron@chronologies),0) + }) \ No newline at end of file diff --git a/vignettes/neotoma2-package.Rmd b/vignettes/neotoma2-package.Rmd index eebc53f..4610e43 100644 --- a/vignettes/neotoma2-package.Rmd +++ b/vignettes/neotoma2-package.Rmd @@ -14,22 +14,18 @@ library(dplyr) library(neotoma2) ``` +> **Note** +> This package is an interface to an external web API. +> To comply with CRAN policies on Internet access, code examples in this vignette +> are shown but not executed during CRAN checks. +> Users can run all examples locally after installation. + ```{r setOpts, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -api_available <- FALSE -res <- pingNeotoma() -if (res$status_code == 200) { - api_available <- TRUE - } -# Disable evaluation globally if API is down knitr::opts_chunk$set(eval = FALSE, error = TRUE) ``` -```{r setup_md, include=FALSE, error=TRUE} +```{r setup_md, include=FALSE} safe_eval <- function(expr, fallback = "N/A") { tryCatch(eval(expr, envir = .GlobalEnv), error = function(e) fallback) } @@ -89,7 +85,7 @@ All sites in Neotoma have a unique numeric identifier. With the `neotoma2` pack If we're looking for a site and we know its specific identifier, we can use the simplest implementation of `get_sites()`. Here we are searching for a site (Alexander Lake), where we know that the siteid for the record in Neotoma is `24`. We can get these siteids using the [Neotoma Explorer web application](https://apps.neotomadb.org/explorer/), or if we have some familiarity with the site records already. -```{r getSiteBySiteID, error=TRUE, eval=FALSE} +```{r getSiteBySiteID} # Search for site by a single numeric ID: alex <- get_sites(24) alex @@ -107,14 +103,14 @@ Once you search for a site, the `neotoma2` R package makes a call to the Neotoma Often we do not know the particular `siteid`. If we're looking for a site and we know its name or a part of its name, we can search using the function with the `sitename` argument, `get_site(sitename = 'XXX')`, where `'XXX'` is the site name. This does not support multiple text strings (i.e., you can't use `c()`). -```{r getsitename, error=TRUE} +```{r getsitename} alex <- get_sites(sitename = "Alexander Lake") alex ``` Neotoma uses a Postgres Database to manage data. Postgres uses the `%` sign as a general wildcard, so we can use the `%` in the `sitename` argument operator to help us find sites when we're not sure the exact match. Note that the search is case **insensitive** so a search for `alex%` or `Alex%` will return the same results. -```{r sitewithwildcardname, error=TRUE} +```{r sitewithwildcardname} alex <- get_sites(sitename = 'Alex%') alex ``` @@ -131,7 +127,7 @@ We offer several methods of searching because different users have different req We can see how these age bounds differ: -```{r agebounds, eval=FALSE, error=TRUE} +```{r agebounds} # Note, we are using the `all_data = TRUE` flag here to avoid the default limit of 25 records, discussed below. # Because these queries are searching through every record they are slow and and are not # run in knitting this vignette. @@ -148,14 +144,14 @@ Although the `sites` are structured using S4 objects (see [Hadley Wickham's S4 d The `alex` object is composed of several smaller objects of class `site`. We can call any individual site using `[[ ]]`, placing the index of the desired object between the brackets. Then we can also call the particular variable we want using the `$` symbol. -```{r extractElement, error=TRUE} +```{r extractElement} alex <- get_sites(sitename = "Alexander Lake") alex[[1]]$siteid ``` The elements within a `site` are the same as the defined columns within the Neotoma [`ndb.sites`](https://open.neotomadb.org/dbschema/ndb/tables/sites.html) table, with the exception of the `collunits` slot, which contains the collection units and associated datasets that are found within a site. You can see all the `site` slots using the `names()` function. You can select individual elements of a `site`, and you can assign values to these parameters: -```{r showallNamesSite, error=TRUE} +```{r showallNamesSite} names(alex[[1]]) # Modify a value using $<- assignment: @@ -175,7 +171,7 @@ Using assignment, we can add information programmatically, for example, by worki As explained above, a `site` is the fundamental unit of the Neotoma Database. If you are working with your own data, you might want to create a `site` object to allow it to interact with other data within Neotoma. You can create a site with the `set_site()` function. It will ask you to provide important information such as `sitename`, `lat`, and `long` attributes. -```{r setsitefunction, error=TRUE} +```{r setsitefunction} my_site <- set_site(sitename = "My Lake", geography = st_sf(a = 3, st_sfc(st_point(1:2))), description = "my lake", @@ -187,7 +183,7 @@ If we have a set of sites that we are analyzing, we can add the new site to the This method allows us to begin modifying site information for existing sites if we have updated knowledge about site properties. -```{r addtosites, error=TRUE} +```{r addtosites} # Add a new site that's been edited using set_site() longer_alex <- c(alex, my_site) # Or replace an element within the existing list of sites @@ -217,7 +213,7 @@ If you need to get to a deeper level of the sites object, you may want to look a Getting the datasets by id is the easiest call, you can also pass a vector of IDs or, if you already have a `sites` object, you can pass a sites object. -```{r getdatasetsbyid, error=TRUE} +```{r getdatasetsbyid} # Getting datasets by ID my_datasets <- get_datasets(c(5, 10, 15, 20)) my_datasets @@ -225,7 +221,7 @@ my_datasets You can also retrieve datasets by type directly from the API. -```{r getdatasetsbytype, error=TRUE} +```{r getdatasetsbytype} # Getting datasets by type my_pollen_datasets <- get_datasets(datasettype = "pollen", limit = 25) my_pollen_datasets @@ -235,7 +231,7 @@ It can be computationally intensive to obtain the full set of records for `sites We can use that `all_data = TRUE` in R in the following way: -```{r all_data, eval=FALSE, error=TRUE} +```{r all_data} allSites_dt <- get_sites(datasettype = "diatom") allSites_dt_all <- get_sites(datasettype = "diatom", all_data = TRUE) @@ -250,7 +246,7 @@ You can get the coordinates to create a GeoJson bounding box from [here](https:/ Accessing datasets by bounding box: -```{r boundingBox, error=TRUE} +```{r boundingBox} brazil <- '{"type": "Polygon", "coordinates": [[ [-73.125, -9.102], @@ -272,7 +268,7 @@ Now we have an object called `brazil_datasets` that contains `r tryCatch(length( You can plot these findings! -```{r leafletBrazil, error=TRUE} +```{r leafletBrazil} plotLeaflet(brazil_datasets) ``` @@ -280,7 +276,7 @@ plotLeaflet(brazil_datasets) Sometimes we take a large number of records, do some analysis, and then choose to select a subset. For example, we may want to select all sites in a region, and then subset those by dataset type. If we want to look at only the geochronological datasets from Brazil, we can start with the set of records returned from our `get_datasets()` query, and then use the `filter` function in `neotoma2` to select only those datasets that are geochronologic: -```{r filterBrazil, error=TRUE} +```{r filterBrazil} brazil_dates <- neotoma2::filter(brazil_datasets, datasettype == "geochronologic") @@ -309,7 +305,7 @@ Once we have the set of records we wish to examine, we then want to recover the Assuming we continue with our example from Brazil, we want to extract records from the country, filter to only pollen records with samples covering the last 10,000 years, and then look at the relative frequency of taxa across sites. We might do something like this: -```{r filterAndShowTaxa, error=TRUE} +```{r filterAndShowTaxa} brazil <- '{"type": "Polygon", "coordinates": [[ [-73.125, -9.102], @@ -352,14 +348,14 @@ The most simple case is a search for a publication based on one or more publicat We can use a single publication ID or multiple IDs. In either case the API returns the publication(s) and creates a new `publications` object (which consists of multiple individual `publication`s). -```{r pubsbyid, eval=FALSE, error=TRUE} +```{r pubsbyid} one <- get_publications(12) two <- get_publications(c(12, 14)) ``` From there we can then then subset and extract elements from the list using the standard `[[` format. For example: -```{r showSinglePub, eval=FALSE, error=TRUE} +```{r showSinglePub} two[[2]] ``` @@ -379,7 +375,7 @@ We can also use search elements to search for publications. The `get_publicatio * `limit` * `offset` -```{r fulltestPubSearch, error=TRUE} +```{r fulltestPubSearch} michPubs <- get_publications(search = "Michigan", limit = 2) ``` @@ -387,7 +383,7 @@ This results in a set of `r tryCatch(length(michPubs), error = function(e) "N/A" Text matching in Neotoma is approximate, meaning it is a measure of the overall similarity between the search string and the set of article titles. This means that using a nonsense string may still return results results: -```{r nonsenseSearch, error=TRUE} +```{r nonsenseSearch} noise <- get_publications(search = "Canada Banada Nanada", limit = 5) ``` @@ -395,7 +391,7 @@ This returns a result set of length `r tryCatch(length(noise), error = function( This returns the (Neotoma) ID, the citation and the publication DOI (if that is stored in Neotoma). We can get the first publication using the standard `[[` nomenclature: -```{r getSecondPub, eval=FALSE, error=TRUE} +```{r getSecondPub} two[[1]] ``` @@ -403,7 +399,7 @@ The output will look similar to the output for `two` above, however you will see We can select an array of `publication` objects using the `[[` method, either as a sequence (`1:10`, or as a numeric vector (`c(1, 2, 3)`)): -```{r subsetPubs, eval=FALSE, error=TRUE} +```{r subsetPubs} # Select publications with Neotoma Publication IDs 1 - 10. pubArray <- get_publications(1:10) # Select the first five publications: @@ -415,7 +411,7 @@ subPub Just as we can use the `set_sites()` function to set new site information, we can also create new publication information using `set_publications()`. With `set_publications()` you can enter as much or as little of the article metadata as you'd like, but it's designed (in part) to use the CrossRef API to return information from a DOI. -```{r setNewPub, eval=FALSE, error=TRUE} +```{r setNewPub} new_pub <- set_publications( articletitle = "Myrtle Lake: a late- and post-glacial pollen diagram from northern Minnesota", journal = "Canadian Journal of Botany", @@ -424,7 +420,7 @@ volume = 46) A `publication` has a large number of slots that can be defined. These may be left blank, they may be set directly after the publication is defined: -```{r setPubValue, eval=FALSE, error=TRUE} +```{r setPubValue} new_pub@pages <- "1397-1410" ```