fix #184 fix print.occdatind to not throw tibble column warnings when col doesnt exist

fix #182 fix stand_date internal fxn to convert ALA timestamps correctly and ecoengine format had changed too
fix #181 added date param to occ() fxn to do date range searches across the data sources
bump patch version for the new parameter added
for changes to some data sources, now need dev versions of rbison, rvernet, and rgbif for date stuff to work
for spocc_inat_obs: added d1 and d2 params to do date range search
fixed some egs in occ_egs file

Author: sckott

DESCRIPTION

@@ -8,7 +8,7 @@ Description: A programmatic interface to many species occurrence data sources,
     System ('OBIS'), and Atlas of Living Australia ('ALA'). Includes
     functionality for retrieving species occurrence data, and combining
     those data.
-Version: 0.7.0.9411
+Version: 0.7.2.9100
 License: MIT + file LICENSE
 Authors@R: c(
     person("Scott", "Chamberlain", role = c("aut", "cre"),
@@ -23,10 +23,10 @@ VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)
 Imports:
     utils,
-    rgbif (>= 0.9.8),
-    rbison (>= 0.5.0),
+    rgbif (>= 0.9.9.9412),
+    rbison (>= 0.5.5.9210),
     rebird (>= 0.3.0),
-    rvertnet (>= 0.6.3.9110),
+    rvertnet (>= 0.6.3.9112),
     ridigbio (>= 0.3.5),
     lubridate (>= 1.5.0),
     crul (>= 0.3.4),
@@ -40,5 +40,5 @@ Suggests:
     testthat,
     knitr,
     taxize (>= 0.8.4)
-Remotes: ropensci/rvertnet
+Remotes: ropensci/rvertnet, ropensci/rbison, ropensci/rgbif
 RoxygenNote: 6.0.1

R/inat.R

@@ -1,5 +1,6 @@
 spocc_inat_obs <- function(query=NULL, taxon = NULL, quality=NULL, geo=TRUE, 
                            year=NULL, month=NULL, day=NULL, bounds=NULL, 
+                           date_start = NULL, date_end = NULL,
                            maxresults=100, page=NULL, callopts) {
 
   # input parameter checks
@@ -45,7 +46,8 @@ spocc_inat_obs <- function(query=NULL, taxon = NULL, quality=NULL, geo=TRUE,
 
   args <- sc(list(q = query, quality_grade = quality, taxon_name = taxon, 
                   `has[]` = if (!is.null(geo) && geo) "geo" else NULL, 
-                  year = year, month = month, day = day))
+                  year = year, month = month, day = day, 
+                  d1 = date_start, d2 = date_end))
   bounds <- list(swlat = bounds[1], swlng = bounds[2], nelat = bounds[3], 
                  nelng = bounds[4])
   args <- sc(c(args, bounds))

R/methods.r

@@ -154,6 +154,7 @@ occinddf <- function(obj) {
 
   cat(sprintf("First 10 rows of [%s]\n\n", nms))
 
+  if (NROW(z) == 0) return(data_frame())
   df <- data.frame(name = z$name, longitude = z$longitude,
                    latitude = z$latitude, prov = z$prov, 
                    stringsAsFactors = FALSE)

R/occ.r

@@ -7,7 +7,8 @@
 #' @template occtemp
 #' @template occ_egs
 occ <- function(query = NULL, from = "gbif", limit = 500, start = NULL, 
-  page = NULL, geometry = NULL, has_coords = NULL, ids = NULL, callopts=list(),
+  page = NULL, geometry = NULL, has_coords = NULL, ids = NULL, date = NULL,
+  callopts=list(),
   gbifopts = list(), bisonopts = list(), inatopts = list(),
   ebirdopts = list(), ecoengineopts = list(), antwebopts = list(),
   vertnetopts = list(), idigbioopts = list(), obisopts = list(), 
@@ -43,37 +44,44 @@ occ <- function(query = NULL, from = "gbif", limit = 500, start = NULL,
     stop(
       sprintf(
         "Woops, the following are not supported or spelled incorrectly: %s",
-        from[!from %in% sources]))
+        from[!from %in% sources]), 
+      call. = FALSE)
   }
 
-  loopfun <- function(x, y, s, p, z, hc, w) {
+  if (!is.null(date)) {
+    if (!inherits(date, c('character', 'Date'))) {
+      stop("'date' must be of class character or Date", call. = FALSE)
+    }
+  }
+
+  loopfun <- function(x, y, s, p, z, hc, d, w) {
     # x = query; y = limit; s = start; p = page;
-    # z = geometry; hc = has_coords; w = callopts
-    gbif_res <- foo_gbif(sources, x, y, s, z, hc, w, gbifopts)
-    bison_res <- foo_bison(sources, x, y, s, z, w, bisonopts)
-    inat_res <- foo_inat(sources, x, y, p, z, hc, w, inatopts)
+    # z = geometry; hc = has_coords; d = date; w = callopts
+    gbif_res <- foo_gbif(sources, x, y, s, z, hc, d, w, gbifopts)
+    bison_res <- foo_bison(sources, x, y, s, z, d, w, bisonopts)
+    inat_res <- foo_inat(sources, x, y, p, z, hc, d, w, inatopts)
     ebird_res <- foo_ebird(sources, x, y, w, ebirdopts)
-    ecoengine_res <- foo_ecoengine(sources, x, y, p, z, hc, w, ecoengineopts)
-    antweb_res <- foo_antweb(sources, x, y, s, z, hc, w, antwebopts)
-    vertnet_res <- foo_vertnet(sources, x, y, hc, w, vertnetopts)
-    idigbio_res <- foo_idigbio(sources, x, y, s, z, hc, w, idigbioopts)
-    obis_res <- foo_obis(sources, x, y, s, z, hc, w, obisopts)
-    ala_res <- foo_ala(sources, x, y, s, z, hc, w, alaopts)
+    ecoengine_res <- foo_ecoengine(sources, x, y, p, z, hc, d, w, ecoengineopts)
+    antweb_res <- foo_antweb(sources, x, y, s, z, hc, d, w, antwebopts)
+    vertnet_res <- foo_vertnet(sources, x, y, hc, d, w, vertnetopts)
+    idigbio_res <- foo_idigbio(sources, x, y, s, z, hc, d, w, idigbioopts)
+    obis_res <- foo_obis(sources, x, y, s, z, hc, d, w, obisopts)
+    ala_res <- foo_ala(sources, x, y, s, z, hc, d, w, alaopts)
     list(gbif = gbif_res, bison = bison_res, inat = inat_res, ebird = ebird_res,
          ecoengine = ecoengine_res, antweb = antweb_res, vertnet = vertnet_res,
          idigbio = idigbio_res, obis = obis_res, ala = ala_res)
   }
 
-  loopids <- function(x, y, s, p, z, hc, w) {
+  loopids <- function(x, y, s, p, z, hc, d, w) {
     classes <- class(x)
     if (!all(classes %in% c("gbifid", "tsn")))
       stop("Currently, taxon identifiers have to be of class gbifid or tsn",
            call. = FALSE)
     if (class(x) == 'gbifid') {
-      gbif_res <- foo_gbif(sources, x, y, s, z, hc, w, gbifopts)
+      gbif_res <- foo_gbif(sources, x, y, s, z, hc, d, w, gbifopts)
       bison_res <- list(time = NULL, data = data_frame())
     } else if (class(x) == 'tsn') {
-      bison_res <- foo_bison(sources, x, y, s, z, w, bisonopts)
+      bison_res <- foo_bison(sources, x, y, s, z, d, w, bisonopts)
       gbif_res <- list(time = NULL, data = data_frame())
     }
     list(gbif = gbif_res,
@@ -106,6 +114,7 @@ occ <- function(query = NULL, from = "gbif", limit = 500, start = NULL,
                   p = page,
                   x = query[[i]],
                   hc = has_coords,
+                  d = date,
                   w = callopts)
         })
 
@@ -133,7 +142,7 @@ occ <- function(query = NULL, from = "gbif", limit = 500, start = NULL,
       }
     } else {
       tmp <- lapply(query, loopfun, y = limit, s = start, p = page,
-                    z = geometry, hc = has_coords, w = callopts)
+                    z = geometry, hc = has_coords, d = date, w = callopts)
     }
   } else if (is.null(query) && is.null(geometry) && !is.null(ids)) {
     unlistids <- function(x) {
@@ -164,19 +173,19 @@ occ <- function(query = NULL, from = "gbif", limit = 500, start = NULL,
     # ids can only be passed to gbif and bison for now
     # so don't pass anything on to ecoengine, inat, or ebird
     tmp <- lapply(ids, loopids, y = limit, s = start, p = page,
-                  z = geometry, hc = has_coords, w = callopts)
+                  z = geometry, hc = has_coords, d = date, w = callopts)
   } else if (is.null(query) && is.null(geometry) && is.null(ids)) {
     tmp <- list(loopfun(x = query, y = limit, s = start, p = page,
-                  z = geometry, hc = has_coords, w = callopts))
+                  z = geometry, hc = has_coords, d = date, w = callopts))
   } else {
     type <- 'geometry'
     if (is.numeric(geometry) || is.character(geometry)) {
       tmp <- list(loopfun(z = geometry, y = limit, s = start, p = page,
-                          x = query, hc = has_coords, w = callopts))
+                          x = query, hc = has_coords, d = date, w = callopts))
     } else if (is.list(geometry)) {
       tmp <- lapply(geometry, function(b) {
         loopfun(z = b, y = limit, s = start, p = page,
-                x = query, hc = has_coords, w = callopts)
+                x = query, hc = has_coords, d = date, w = callopts)
       })
     }
   }

R/plugin_helpers.R

@@ -42,16 +42,22 @@ stand_dates <- function(dat, from){
       bison = as_date(ydm_hm(dat[[var]], truncated = 6, quiet = TRUE)),
       inat = as_date(ymd_hms(dat[[var]], truncated = 3, quiet = TRUE)),
       ebird = as_date(ymd_hm(dat[[var]], truncated = 3, quiet = TRUE)),
-      ecoengine = as_date(ymd(dat[[var]], truncated = 3, quiet = TRUE)),
+      ecoengine = as_date(ymd_hms(dat[[var]], truncated = 3, quiet = TRUE)),
       vertnet = as_date(ymd(dat[[var]], truncated = 3, quiet = TRUE)),
       idigbio = as_date(ymd_hms(dat[[var]], truncated = 3, quiet = TRUE)),
       obis = as_date(ymd_hms(dat[[var]], truncated = 3, quiet = TRUE)),
-      ala = as_date(ymd_hms(dat[[var]], truncated = 3, quiet = TRUE))
+      ala = as_date(date_ala(dat[[var]]))
     )
     if (from == "bison") rename(dat, stats::setNames('date', var)) else dat
   }
 }
 
+date_ala <- function(x) {
+  x <- as.numeric(substr(x, 1, 10))
+  x <- as.POSIXct(x, origin = "1970-01-01", tz = "UTC")
+  sub("\\sUTC$", "", x)
+}
+
 is_null <- function(...) {
   xx <- tryCatch(..., error = function(e) e)
   inherits(xx, "error") || is.null(xx)

R/plugins.r

@@ -2,7 +2,7 @@
 ## the plugins
 #' @noRd
 foo_gbif <- function(sources, query, limit, start, geometry, has_coords,
-                     callopts, opts) {
+                     date, callopts, opts) {
   if (any(grepl("gbif", sources))) {
 
     opts$hasCoordinate <- has_coords
@@ -24,6 +24,10 @@ foo_gbif <- function(sources, query, limit, start, geometry, has_coords,
     } else {
       query_use <- NULL
     }
+    if (!is.null(date)) {
+      if (length(date) != 2) stop("'date' for GBIF must be length 2")
+      opts$eventDate <- paste0(date, collapse = ",")
+    }
 
     if (is.null(query_use) && is.null(geometry) && length(opts) == 0) {
       warning(sprintf("No records found in GBIF for %s", query), call. = FALSE)
@@ -88,7 +92,7 @@ foo_gbif <- function(sources, query, limit, start, geometry, has_coords,
 
 #' @noRd
 foo_ecoengine <- function(sources, query, limit, page, geometry, has_coords,
-                          callopts, opts) {
+                          date, callopts, opts) {
   if (any(grepl("ecoengine", sources))) {
     opts <- limit_alias(opts, "ecoengine")
     time <- now()
@@ -105,6 +109,11 @@ foo_ecoengine <- function(sources, query, limit, page, geometry, has_coords,
         geometry
       }
     }
+    if (!is.null(date)) {
+      if (length(date) != 2) stop("'date' for Ecoengine must be length 2")
+      opts$min_date <- date[1]
+      opts$max_date <- date[2]
+    }
     # This could hang things if request is super large.  Will deal with this issue
     # when it arises in a usecase
     # For now default behavior is to retrive one page.
@@ -141,7 +150,7 @@ foo_ecoengine <- function(sources, query, limit, page, geometry, has_coords,
 
 #' @noRd
 foo_antweb <- function(sources, query, limit, start, geometry, has_coords,
-                       callopts, opts) {
+                       date, callopts, opts) {
   if (any(grepl("antweb", sources))) {
     time <- now()
     opts$georeferenced <- has_coords
@@ -158,8 +167,15 @@ foo_antweb <- function(sources, query, limit, start, geometry, has_coords,
       opts$scientific_name <- NULL
     }
 
+    if (!is.null(date)) {
+      if (length(date) != 2) stop("'date' for Ecoengine must be length 2")
+      opts$min_date <- date[1]
+      opts$max_date <- date[2]
+    }
+
     if (!'limit' %in% names(opts)) opts$limit <- limit
     if (!'offset' %in% names(opts)) opts$offset <- start
+    if (length(callopts) > 0) opts$callopts <- callopts
     out <- tryCatch(do.call(aw_data2, opts), error = function(e) e)
 
     if (is.null(out) || inherits(out, "simpleError")) {
@@ -181,7 +197,9 @@ foo_antweb <- function(sources, query, limit, start, geometry, has_coords,
 }
 
 #' @noRd
-foo_bison <- function(sources, query, limit, start, geometry, callopts, opts) {
+foo_bison <- function(sources, query, limit, start, geometry, date, 
+  callopts, opts) {
+
   if (any(grepl("bison", sources))) {
     opts <- limit_alias(opts, "bison", geometry)
     if (class(query) %in% c("ids","tsn")) {
@@ -190,10 +208,12 @@ foo_bison <- function(sources, query, limit, start, geometry, callopts, opts) {
       } else {
         opts$TSNs <- query
       }
+      if (!is.null(date)) opts$eventDate <- date
       bisonfxn <- "bison_solr"
     } else {
       if (is.null(geometry)) {
-        opts$scientificName <- query
+        opts$ITISscientificName <- query
+        if (!is.null(date)) opts$eventDate <- date
         bisonfxn <- "bison_solr"
       } else {
         opts$species <- query
@@ -250,7 +270,8 @@ foo_bison <- function(sources, query, limit, start, geometry, callopts, opts) {
 
 #' @noRd
 foo_inat <- function(sources, query, limit, page, geometry, has_coords,
-                     callopts, opts) {
+                     date, callopts, opts) {
+
   if (any(grepl("inat", sources))) {
     opts <- limit_alias(opts, "inat")
     opts$geo <- has_coords
@@ -268,6 +289,11 @@ foo_inat <- function(sources, query, limit, page, geometry, has_coords,
         c(geometry[2], geometry[1], geometry[4], geometry[3])
       }
     }
+    if (!is.null(date)) {
+      if (length(date) != 2) stop("'date' for Inaturalist must be length 2")
+      opts$date_start <- date[1]
+      opts$date_end <- date[2]
+    }
     opts$callopts <- callopts
     out <- tryCatch(do.call("spocc_inat_obs", opts), error = function(e) e)
     if (!is.data.frame(out$data) || inherits(out, "simpleError")) {
@@ -325,14 +351,25 @@ foo_ebird <- function(sources, query, limit, callopts, opts) {
 }
 
 #' @noRd
-foo_vertnet <- function(sources, query, limit, has_coords, callopts, opts) {
+foo_vertnet <- function(sources, query, limit, has_coords, date, callopts, opts) {
   if (any(grepl("vertnet", sources))) {
     time <- now()
     if (!is.null(has_coords)) {
       opts$mappable <- has_coords
     }
     opts$query <- query
     opts$messages <- FALSE
+    if (!is.null(date)) {
+      if (length(date) != 2) stop("'date' for Vertnet must be length 2")
+      date <- tryCatch(as.Date(date), error = function(e) e)
+      if (inherits(date, "error")) stop("'date' values do not appear to be dates")
+      opts$year <- c(paste0('>=', format(date[1], "%Y")),
+        paste0('<=', format(date[2], "%Y")))
+      opts$month <- c(paste0('>=', as.numeric(format(date[1], "%m"))),
+        paste0('<=', as.numeric(format(date[2], "%m"))))
+      opts$day <- c(paste0('>=', as.numeric(format(date[1], "%d"))),
+        paste0('<=', as.numeric(format(date[2], "%d"))))
+    }
     if (!'limit' %in% names(opts)) opts$limit <- limit
     opts$callopts <- callopts
     out <- tryCatch(do.call(rvertnet::searchbyterm, opts),
@@ -363,7 +400,7 @@ foo_vertnet <- function(sources, query, limit, has_coords, callopts, opts) {
 
 #' @noRd
 foo_idigbio <- function(sources, query, limit, start, geometry, has_coords,
-                        callopts, opts) {
+                        date, callopts, opts) {
   if (any(grepl("idigbio", sources))) {
     time <- now()
 
@@ -375,6 +412,11 @@ foo_idigbio <- function(sources, query, limit, start, geometry, has_coords,
       list(type = "missing")
     }
 
+    if (!is.null(date)) {
+      if (length(date) != 2) stop("'date' for IdigBio must be length 2")
+      opts$rq$datecollected <- list(type = "range", gte = date[1], lte = date[2])
+    }
+
     if (!is.null(geometry)) {
       if (grepl('POLYGON', paste(as.character(geometry), collapse = " "))) {
         geometry <- unlist(unname(c(wkt2bbox(geometry))))
@@ -429,7 +471,7 @@ foo_idigbio <- function(sources, query, limit, start, geometry, has_coords,
 
 #' @noRd
 foo_obis <- function(sources, query, limit, start, geometry, has_coords,
-                     callopts, opts) {
+                     date, callopts, opts) {
 
   if (any(grepl("obis", sources))) {
     time <- now()
@@ -444,6 +486,12 @@ foo_obis <- function(sources, query, limit, start, geometry, has_coords,
       }
     }
 
+    if (!is.null(date)) {
+      if (length(date) != 2) stop("'date' for OBIS must be length 2")
+      opts$startdate <- date[1]
+      opts$enddate <- date[2]
+    }
+
     if (!"limit" %in% names(opts)) opts$limit <- limit
     if (!'offset' %in% names(opts)) opts$offset <- start
 
@@ -475,10 +523,15 @@ foo_obis <- function(sources, query, limit, start, geometry, has_coords,
 
 #' @noRd
 foo_ala <- function(sources, query, limit, start, geometry, has_coords,
-                    callopts, opts) {
+                    date, callopts, opts) {
+
   if (any(grepl("ala", sources))) {
     time <- now()
     opts$taxon <- sprintf('taxon_name:"%s"', query)
+    if (!is.null(date)) {
+      if (length(date) != 2) stop("'date' for ALA must be length 2")
+      opts$taxon <- paste0(opts$taxon, sprintf(" occurrence_date:[%s TO %s]", date[1], date[2]))
+    }
 
     if (!is.null(geometry)) {
       opts$wkt <- if (grepl('POLYGON', paste(as.character(geometry),