Chronologies table

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.
         <https://api.neotomadb.org/api-docs/>.
+        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)

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
 

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

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))
-          })
+          })

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)

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)

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)

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()
 #' }

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)

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()) {

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") %>%

R/get_sites.R

@@ -62,42 +62,19 @@
 #'  * `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],
 #'  [-56.953125,-33.137551192346145],
 #'  [-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

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

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) {

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

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