Added new functions, get_taxon and get_taxa

With get_taxon, we can retrieve taxon data from the API taxon endpoint. Then, we pass the result to a get_taxa function that would return the sites that contain said taxa. get_taxa accepts all arguments that the taxon API endpoint can receive.

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: neotoma2
 Title: Working with the Neotoma Paleoecology Database
-Date: 2024-08-14
-Version: 1.0.5
+Date: 2024-12-27
+Version: 1.0.6
 Authors@R:
     c(person(given = "Dominguez Vidana",
              family = "Socorro",
@@ -20,7 +20,7 @@ Description: Access and manipulation of data using the Neotoma Paleoecology Data
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Suggests:
     testthat,
     knitr,

NAMESPACE

@@ -21,6 +21,9 @@ S3method(get_sites,sites)
 S3method(get_specimens,default)
 S3method(get_specimens,numeric)
 S3method(get_specimens,sites)
+S3method(get_taxa,default)
+S3method(get_taxon,default)
+S3method(get_taxon,numeric)
 S3method(getids,collunit)
 S3method(getids,collunits)
 S3method(getids,site)
@@ -51,6 +54,8 @@ export(get_sites)
 export(get_specimens)
 export(get_stats)
 export(get_table)
+export(get_taxa)
+export(get_taxon)
 export(getids)
 export(parseURL)
 export(pingNeotoma)
@@ -90,6 +95,8 @@ exportClasses(samples)
 exportClasses(site)
 exportClasses(specimen)
 exportClasses(specimens)
+exportClasses(taxa)
+exportClasses(taxon)
 exportMethods("$")
 exportMethods("$<-")
 exportMethods("[")

R/get_taxa.R

@@ -5,123 +5,23 @@
 #' @returns A Neotoma2 sites object with datasets with the requested taxa.
 #' 
 #' @export
-get_taxon <- function(x = NA, ...) {
-  if (!missing(x)) {
-    UseMethod("get_taxa", x)
-  } else {
+get_taxa <- function(x = NA, ...) {
     UseMethod("get_taxa", NA)
   }
-}
-
-parse_taxon <- function(result) { # nolint
-
-  fix_null <- function(x) {
-    for (i in seq_len(length(x))) {
-      if (is.null(x[[i]])) {
-        x[[i]] <- NA
-      } else {
-        if (is(x[[i]], "list")) {
-          x[[i]] <- fix_null(x[[i]])
-        }
-      }
-    }
-    return(x)
-  }
-
-  data <- result$data %>%
-    fix_null()
-
-  # With a large dataset this seems to take some time, but it's not too bad.
-  newTaxon <- map(data, function(x) {
-
-    new_taxon <- new("taxon",
-                     taxonid = x$taxonid,
-                     taxoncode = x$taxoncode,
-                     taxonname = x$taxonname,
-                     author = x$author,
-                     ecolgroup = x$ecolgroup,
-                     highertaxonid = x$highertaxonid,
-                     status = x$status,
-                     taxagroupid = x$taxagroupid,
-                     publicationid = x$publicationid,
-                     publication = x$publication)
-
-    print(new_taxon)
-  })
-
-  return(new_taxon)
-
-}
-
 
 #' @title Get Taxa Default
 #' @param x Use a taxon ID to extract site information
 #' @param ... accepted arguments, see details for more information.
 #' @importFrom utils URLencode
 #' @returns `sites` object containing the requested `taxa`
 #' @export
-get_taxon.default <- function(x, ...) {
+get_taxa.default <- function(x, ...) {
   oo <- options(scipen = 9999999)
   on.exit(options(oo))
-  cl <- as.list(match.call())
-
-  cl[[1]] <- NULL
-
-  cl <- lapply(cl, eval, envir = parent.frame())
 
-  all_data <- ifelse(is.null(cl$all_data), FALSE, TRUE)
-  error_check <- check_args(cl) # nolint
+  taxa_data <- get_taxon(x, ...)
+  taxa_names <- as.data.frame(x=taxa_data)$taxonname
+  sites <- get_datasets(taxa=taxa_names)
 
-  if (error_check[[2]]$flag == 1) {
-    stop(paste0(unlist(error_check[[2]]$message), collapse = "\n  "))
-  } else {
-    cl <- error_check[[1]]
-  }
-
-    base_url <- paste0("data/taxa")
-    result <- parseURL(base_url, ...) %>%
-      cleanNULL()
-
-  if (is.null(result$data[1][[1]]) || is.null(result[1][[1]])) {
-    return(NULL)
-
-  } else {
-    output <- parse_taxa(result)
-    return(output)
-  }
+  return(sites)
 }
-
-#' @title Get Taxa Numeric
-#' @param x Use a taxon ID to extract sites information
-#' @param ... Additional parameters to get_taxa
-#' @returns `sites` object with requested `taxa`
-#' @examples \donttest{
-#' allds <- get_datasets(1:3)
-#' }
-#' @export
-get_taxon.numeric <- function(x, ...) {
-  use_na <- function(x, type) {
-    if (is.na(x)) {
-      return(switch(type,
-                    "char" = NA_character_,
-                    "int" = NA_integer_))
-    } else {
-      return(x)
-    }
-  }
-
-  if (length(x) > 0) {
-    taxa_id <- paste0(x, collapse = ",")
-  }
-
-  base_url <- paste0("data/taxa/", taxa_id)
-  result <- neotoma2::parseURL(base_url, ...)
-  result_length <- length(result[2]$data)
-
-  if (result_length > 0) {
-    output <- parse_taxa(result)
-    return(output)
-  } else {
-    return(NULL)
-  }
-}

R/taxon-methods.R

@@ -178,16 +178,16 @@ setMethod(f = "$",
 setMethod(f = "as.data.frame",
           signature = signature("taxon"),
           definition = function(x) {
-            data.frame(taxonid = as.character(object@taxonid),
-                       taxoncode = object@taxoncode,
-                       taxonname = object@taxonname,
-                       author =  object@author,
-                       ecolgroup =  object@ecolgroup,
-                       highertaxonid = object@highertaxonid,
-                       status = object@status,
-                       taxagroupid = object@taxagroupid,
-                       publicationid = object@publicationid,
-                       publication = object@publication)
+            data.frame(taxonid = as.character(x@taxonid),
+                       taxoncode = x@taxoncode,
+                       taxonname = x@taxonname,
+                       author =  x@author,
+                       ecolgroup =  x@ecolgroup,
+                       highertaxonid = x@highertaxonid,
+                       status = x@status,
+                       taxagroupid = x@taxagroupid,
+                       publicationid = x@publicationid,
+                       publication = x@publication)
           })
 
 #' @title  as.data.frame taxa
@@ -196,10 +196,27 @@ setMethod(f = "as.data.frame",
 #' @returns `data.frame` with `taxa` metadata
 #' @export
 setMethod(f = "as.data.frame",
-          signature = signature("taxa"),
+          signature = "taxa",
           definition = function(x) {
-            x@taxa %>% map(as.data.frame) %>% bind_rows()
-          })
+            df <- map(x@taxa, function(y) {
+              data.frame(
+                taxonid = as.character(y@taxonid),
+                taxoncode = y@taxoncode,
+                taxonname = y@taxonname,
+                author = y@author,
+                ecolgroup = y@ecolgroup,
+                highertaxonid = y@highertaxonid,
+                status = y@status,
+                taxagroupid = y@taxagroupid,
+                publicationid = y@publicationid,
+                publication = y@publication
+              )
+            }) %>%
+              bind_rows()
+
+            return(df)
+          }
+)
 
 #' @title Length Method taxa
 #' @export