Updated package for final update to meet new HTML5 requirements.

ropensci · Sep 13, 2022 · 1148d6f · 1148d6f
1 parent 287f2a7
commit 1148d6f
Show file tree

Hide file tree

Showing 16 changed files with 100 additions and 75 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: neotoma
 Type: Package
 Title: Access to the Neotoma Paleoecological Database Through R
-Version: 1.7.6
-Date: 2020-09-20
+Version: 1.7.7
+Date: 2022-09-13
 Encoding: UTF-8
 Author: Simon J. Goring [aut, cre], Gavin L. Simpson [aut], Jeremiah P. Marsicek
     [ctb], Karthik Ram [aut], Luke Sosalla [ctb]
@@ -13,10 +13,13 @@ Authors@R: c(person(given = c("Simon", "J."), family = "Goring",
     person(given = "Karthik", family = "Ram", role = "aut"),
     person(given = "Luke", family = "Sosalla", role = "ctb"))
 Maintainer: Simon J. Goring <[email protected]>
-Description: Access paleoecological datasets from the Neotoma Paleoecological
-    Database using the published API (<http://wnapi.neotomadb.org/>).  The functions
-    in this package access various pre-built API functions and attempt to return
-    the results from Neotoma in a usable format for researchers and the public.
+Description: NOTE: This package is deprecated. Please use the neotoma2 package 
+    described at https://github.com/NeotomaDB/neotoma2. Access paleoecological 
+    datasets from the Neotoma Paleoecological Database using the published API 
+    (<http://wnapi.neotomadb.org/>), only containing datasets uploaded prior to
+    June 2020.  The functions in this package access various pre-built API 
+    functions and attempt to return the results from Neotoma in a usable format
+    for researchers and the public.
 License: MIT + file LICENSE
 URL: https://docs.ropensci.org/neotoma, https://github.com/ropensci/neotoma
 BugReports: https://github.com/ropensci/neotoma/issues
@@ -32,8 +35,9 @@ Imports:
     leaflet,
     dplyr,
     sf,
-    assertthat
+    assertthat,
+    methods
 Suggests:
     testthat,
     knitr
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.1
diff --git a/NAMESPACE b/NAMESPACE
@@ -115,6 +115,7 @@ importFrom(leaflet,addProviderTiles)
 importFrom(leaflet,leaflet)
 importFrom(leaflet,markerClusterOptions)
 importFrom(leaflet,markerOptions)
+importFrom(methods,is)
 importFrom(plyr,ldply)
 importFrom(stats,aggregate)
 importFrom(stats,na.omit)

diff --git a/NEWS b/NEWS
@@ -1,3 +1,8 @@
+neotoma 1.7.7
+====================
+o This represents the end-of-life update for the package. Updates some function calls and Rd file formatting.
+o All new development for Neotoma in R is part of the `neotoma2` R package at https://github.com/NeotomaDB/neotoma2
+
 neotoma 1.7.6
 ====================
 o Updated the API endpoints to correctly point to the new windows API endpoint, in preparation for migration.

diff --git a/R/get_chroncontrol.R b/R/get_chroncontrol.R
@@ -78,9 +78,9 @@ get_chroncontrol.default <- function(x, chronology = 1, verbose = TRUE, add = FA
   if (identical(neotoma_content, "")) {
     stop("")
   }
-  
+
   aa <- jsonlite::fromJSON(neotoma_content, simplifyVector = FALSE)
-  
+
   # Might as well check here for error and bail
   if (inherits(aa, "try-error")) {
     return(aa)
@@ -98,7 +98,7 @@ get_chroncontrol.default <- function(x, chronology = 1, verbose = TRUE, add = FA
     rep_NULL <- function(x) { 
       if (is.null(x)) { NA }
       else{
-        if (class(x) == 'list') {
+        if (is(x, "list")) {
           lapply(x, rep_NULL)
         } else {
           return(x)

diff --git a/R/get_dataset.R b/R/get_dataset.R
@@ -3,6 +3,7 @@
 #'
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr content GET
+#' @importFrom methods is
 #' @param x An optional value, either a \code{numeric} site ID or object of class \code{download}, \code{download_list} or \code{site}.
 #' @param datasettype A character string corresponding to one of the allowed dataset types in the Neotoma Database.  Allowed types include: \code{"geochronologic"}, \code{"loss-on-ignition"}, \code{"pollen"}, \code{"plant macrofossils"}, \code{"vertebrate fauna"}, \code{"mollusks"}, and \code{"pollen surface sample"}.  See note in Details delow.
 #' @param piid Numeric value for the Principle Investigator's ID number.
@@ -68,6 +69,7 @@ get_dataset <- function(x, datasettype, piid, altmin, altmax, loc, gpid, taxonid
 #'
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr GET content
+#' @importFrom methods is
 #' @param x A numeric value corresponding to the site ID.
 #' @param datasettype A character string corresponding to one of the allowed dataset types in the Neotoma Database.  You can find the full list of allowed datasettypes using: \code{get_table("datasettypes")}.
 #' @param piid Numeric value for the Principle Investigator's ID number.
@@ -119,7 +121,7 @@ get_dataset.default <- function(x, datasettype, piid, altmin, altmax, loc, gpid,
     rep_NULL <- function(x) { 
       if (is.null(x)) {NA}
       else{
-        if (class(x) == 'list') {
+        if (is(x, 'list')) {
           lapply(x, rep_NULL)
         } else {
           return(x)
@@ -166,18 +168,18 @@ get_dataset.default <- function(x, datasettype, piid, altmin, altmax, loc, gpid,
 
           if ('CollType' %in% names(x)) {x$CollUnitType <- x$CollType} # This is a fix for a very specific issue we were having.
 
-          new.output$dataset.meta <- data.frame(dataset.id = ifelse(class(x$DatasetID) == 'logical',
+          new.output$dataset.meta <- data.frame(dataset.id = ifelse(is(x$DatasetID, 'logical'),
                                                                     NA, x$DatasetID),
-                                                dataset.name = ifelse(class(x$DatasetName) == 'logical',
+                                                dataset.name = ifelse(is(x$DatasetName, 'logical'),
                                                                       NA, x$DatasetName),
-                                                collection.type = ifelse(class(x$CollUnitType) == 'logical',
+                                                collection.type = ifelse(is(x$CollUnitType, 'logical'),
                                                                          NA, x$CollUnitType),
-                                                collection.handle = ifelse(class(x$CollUnitHandle) == 'logical',
+                                                collection.handle = ifelse(is(x$CollUnitHandle, 'logical'),
                                                                            NA, x$CollUnitHandle),
-                                                dataset.type = ifelse(class(x$DatasetType) == 'logical',
+                                                dataset.type = ifelse(is(x$DatasetType,  'logical'),
                                                                       NA, x$DatasetType),
                                                 stringsAsFactors = FALSE)
-          if (class(x$DatasetPIs) == 'logical') { 
+          if (is(x$DatasetPIs, 'logical')) { 
             new.output$pi.data <- NA
           } else {
             new.output$pi.data <- do.call(rbind.data.frame, x$DatasetPIs)
@@ -217,13 +219,14 @@ get_dataset.default <- function(x, datasettype, piid, altmin, altmax, loc, gpid,
 #' @param ... objects passed from the generic.  Not used in the call.
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr GET content
+#' @importFrom methods is
 #' @export
 get_dataset.site <- function(x, ...) {
 
   rep_NULL <- function(x) { 
     if (is.null(x) | length(x) == 0) {NA}
     else{
-      if (class(x) == 'list') {
+      if (is(x, 'list')) {
         lapply(x, rep_NULL)
       } else {
         return(x)
@@ -286,18 +289,18 @@ get_dataset.site <- function(x, ...) {
                                          row.names = x$Site$SiteName,
                                          stringsAsFactors = FALSE)
 
-      new.output$dataset.meta <- data.frame(dataset.id = ifelse(class(x$DatasetID) == 'logical',
+      new.output$dataset.meta <- data.frame(dataset.id = ifelse(is(x$DatasetID, 'logical'),
                                                                 NA, x$DatasetID),
-                                            dataset.name = ifelse(class(x$DatasetName) == 'logical',
+                                            dataset.name = ifelse(is(x$DatasetName, 'logical'),
                                                                   NA, x$DatasetName),
-                                            collection.type = ifelse(class(x$CollUnitType) == 'logical',
+                                            collection.type = ifelse(is(x$CollUnitType, 'logical'),
                                                                      NA, x$CollUnitType),
-                                            collection.handle = ifelse(class(x$CollUnitHandle) == 'logical',
+                                            collection.handle = ifelse(is(x$CollUnitHandle, 'logical'),
                                                                        NA, x$CollUnitHandle),
-                                            dataset.type = ifelse(class(x$DatasetType) == 'logical',
+                                            dataset.type = ifelse(is(x$DatasetType, 'logical'),
                                                                   NA, x$DatasetType),
                                             stringsAsFactors = FALSE)
-      if (class(x$DatasetPIs) == 'logical') { 
+      if (is(x$DatasetPIs, 'logical')) { 
         new.output$pi.data <- NA
       } else {
         new.output$pi.data <- do.call(rbind.data.frame, x$DatasetPIs)
@@ -399,15 +402,15 @@ get_dataset.geochronologic_list <- function(x, ...) {
 #' @param ... objects passed from the generic.  Not used in the call.
 #' @export
 get_dataset.numeric <- function(x = NULL, ...) {
-  
+
   if (is.null(x)) {
     return(get_dataset.default(...))
   }
-  
+
   rep_NULL <- function(x) { 
     if (is.null(x) | length(x) == 0) {NA}
-    else{
-      if (class(x) == 'list') {
+    else {
+      if (is(x, 'list')) {
         lapply(x, rep_NULL)
       } else {
         return(x)
@@ -458,18 +461,18 @@ get_dataset.numeric <- function(x = NULL, ...) {
                                          row.names = x$Site$SiteName,
                                          stringsAsFactors = FALSE)
 
-      new.output$dataset.meta <- data.frame(dataset.id = ifelse(class(x$DatasetID) == 'logical',
+      new.output$dataset.meta <- data.frame(dataset.id = ifelse(is(x$DatasetID, 'logical'),
                                                                 NA, x$DatasetID),
-                                            dataset.name = ifelse(class(x$DatasetName) == 'logical',
+                                            dataset.name = ifelse(is(x$DatasetName, 'logical'),
                                                                   NA, x$DatasetName),
-                                            collection.type = ifelse(class(x$CollUnitType) == 'logical',
+                                            collection.type = ifelse(is(x$CollUnitType, 'logical'),
                                                                      NA, x$CollUnitType),
-                                            collection.handle = ifelse(class(x$CollUnitHandle) == 'logical',
+                                            collection.handle = ifelse(is(x$CollUnitHandle, 'logical'),
                                                                        NA, x$CollUnitHandle),
-                                            dataset.type = ifelse(class(x$DatasetType) == 'logical',
+                                            dataset.type = ifelse(is(x$DatasetType, 'logical'),
                                                                   NA, x$DatasetType),
                                             stringsAsFactors = FALSE)
-      if (class(x$DatasetPIs) == 'logical') { 
+      if (is(x$DatasetPIs, 'logical')) { 
         new.output$pi.data <- NA
       } else {
         new.output$pi.data <- do.call(rbind.data.frame, x$DatasetPIs)

diff --git a/R/get_download.R b/R/get_download.R
@@ -4,6 +4,7 @@
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr content GET
 #' @importFrom stats na.omit
+#' @importFrom methods is
 #' @param x A single numeric dataset ID or a vector of numeric dataset IDs as returned by \code{get_datasets}, or a \code{site}, \code{dataset}, or \code{dataset_list}.
 #' @param verbose logical; should messages on API call be printed?
 #' @author Simon J. Goring \email{simon.j.goring@@gmail.com}
@@ -79,6 +80,7 @@ get_download <- function(x, verbose = TRUE) {
 #'
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr content GET
+#' @importFrom methods is
 #' @param x A single numeric dataset ID or a vector of numeric dataset IDs as returned by \code{get_datasets}.
 #' @param verbose logical; should messages on API call be printed?
 #' @export
@@ -126,7 +128,7 @@ get_download.default <- function(x, verbose = TRUE) {
           # small function to recursively fill all NULL values with NAs.
           if (is.null(x)) {NA}
           else{
-            if (class(x) == 'list') {
+            if (is(x, 'list')) {
               lapply(x, rep_NULL)
             } else {
               return(x)
@@ -335,7 +337,7 @@ get_download.default <- function(x, verbose = TRUE) {
                                       'age.younger', 'chronology.name',
                                       'age.type', 'chronology.id', 'dataset.id')
 
-            if (!class(chrons) == 'try-error') {
+            if (!is(chrons, 'try-error')) {
               # Now we create the chronologies, so long as samples have assigned "SampleAges"
               # If they don't, then we stick in the empty `base.frame` and assign it a name "1"
               # Create the list:

diff --git a/R/get_geochron.R b/R/get_geochron.R
@@ -5,6 +5,7 @@
 #'
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr GET content
+#' @importFrom methods is
 #' @param x A numeric dataset ID or a vector of numeric dataset IDs, or an object of class of class \code{site}, \code{dataset}, \code{dataset_list}, \code{download} or \code{download_list} for which geochrons are required.
 #' @param verbose logical; should messages on API call be printed?
 #' 
@@ -40,8 +41,8 @@
 #'
 #' get_ages <- function(x){
 #'   any.ages <- try(x[[2]]$age[x[[2]]$age.type == 'Radiocarbon years BP'])
-#'   if(class(any.ages) == 'try-error') output <- NA
-#'   if(!class(any.ages) == 'try-error') output <- unlist(any.ages)
+#'   if(is(any.ages, 'try-error')) output <- NA
+#'   if(!is(any.ages, 'try-error')) output <- unlist(any.ages)
 #'   output
 #' }
 #'
@@ -63,6 +64,7 @@ get_geochron <- function(x, verbose = TRUE){
 
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr GET content
+#' @importFrom methods is
 #' @export
 get_geochron.default <- function(x, verbose = TRUE){
 
@@ -107,7 +109,7 @@ get_geochron.default <- function(x, verbose = TRUE){
       rep_NULL <- function(x){ 
         if (is.null(x)) {NA}
         else {
-          if (class(x) == 'list') {
+          if (is(x, 'list')) {
             lapply(x, rep_NULL)
           } else {
             return(x)

diff --git a/R/get_publication.R b/R/get_publication.R
@@ -4,6 +4,7 @@
 #'
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr GET content
+#' @importFrom methods is
 #' @param x Numeric Publication ID value, either from \code{\link{get_dataset}} or known.
 #' @param contactid Numeric Contact ID value, either from \code{\link{get_dataset}} or \code{\link{get_contact}}
 #' @param datasetid Numeric Dataset ID, known or from \code{\link{get_dataset}}
@@ -46,6 +47,7 @@ get_publication<- function(x, contactid, datasetid, author,
 #'
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr content GET
+#' @importFrom methods is
 #' @param x Numeric Publication ID value, either from \code{\link{get_dataset}} or known.
 #' @param contactid Numeric Contact ID value, either from \code{\link{get_dataset}} or \code{\link{get_contact}}
 #' @param datasetid Numeric Dataset ID, known or from \code{\link{get_dataset}}
@@ -90,7 +92,7 @@ get_publication.default <- function(x, contactid, datasetid, author,
     rep_NULL <- function(x){ 
       if(is.null(x)){NA}
       else{
-        if(class(x) == 'list'){
+        if(is(x, 'list')){
           lapply(x, rep_NULL)
         } else {
           return(x)
@@ -109,7 +111,7 @@ get_publication.default <- function(x, contactid, datasetid, author,
     }
   }
 
-  if (class(aa) == 'try-error'){
+  if (is(aa, 'try-error')){
     output <- NA
   } else {
 

diff --git a/R/get_site.R b/R/get_site.R
@@ -5,6 +5,7 @@
 #'    based on parameters defined by the user.
 #'
 #' @importFrom jsonlite fromJSON
+#' @importFrom methods is
 #' @importFrom httr content GET
 #' @param sitename character string representing the full or partial site name, or an object of class \code{dataset}, \code{dataset_list}, \code{download} or \code{download_list}
 #' @param altmin Minimum site altitude  (in m).
@@ -54,6 +55,7 @@ get_site <- function(sitename, altmin, altmax, loc, gpid, ...) {
 #' @description Return site information from the Neotoma Paleoecological Database.
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr content GET
+#' @importFrom methods is
 
 #' @param sitename A character string representing the full or partial site name.
 #' @param ... Arguments passed from the generic method, not used.
@@ -91,7 +93,7 @@ get_site.default <- function(sitename, ...) {
     rep_NULL <- function(x) { 
       if (is.null(x)) {NA}
       else{
-        if (class(x) == 'list') {
+        if (is(x, 'list')) {
           lapply(x, rep_NULL)
         } else {
           return(x)
@@ -111,7 +113,7 @@ get_site.default <- function(sitename, ...) {
 
   }
 
-  if (class(aa) == 'try-error') {
+  if (is(aa, 'try-error')) {
      output <- aa
   } else {
 
@@ -227,6 +229,7 @@ get_site.geochronologic_list <- function(sitename, ...) {
 #'
 #' @param sitename An integer or vector of integers.
 #' @param ... Arguments passed from the generic method, not used.
+#' @importFrom methods is
 #' @export
 get_site.integer <- function(sitename, ...) {
 
@@ -248,7 +251,7 @@ get_site.integer <- function(sitename, ...) {
       rep_NULL <- function(x) { 
         if (is.null(x)) {NA}
         else{
-          if (class(x) == 'list') {
+          if (is(x, 'list')) {
             lapply(x, rep_NULL)
           } else {
             return(x)
@@ -268,7 +271,7 @@ get_site.integer <- function(sitename, ...) {
 
     }
 
-    if (class(aa) == 'try-error') {
+    if (is(aa, 'try-error')) {
       output <- aa
     } else {
 

diff --git a/R/get_table.R b/R/get_table.R
@@ -2,6 +2,7 @@
 #'
 #' @importFrom jsonlite fromJSON
 #' @importFrom httr content GET
+#' @importFrom methods is
 #' @param table.name Call one of the available tables in the Neotoma Database.
 #'    A full listing of tables can be found here: \url{http://wnapi.neotomadb.org/doc/resources/dbtables}.
 #'    By default it returns all objects in the table.
@@ -82,7 +83,7 @@ get_table <- function(table.name = NULL){
         rep_NULL <- function(x){ 
           if(is.null(x)){NA}
           else{
-            if(class(x) == 'list'){
+            if(is(x, 'list')){
               lapply(x, rep_NULL)
             } else {
               return(x)