User experience improvements

* A `spatial` parameter of the `S2_query_granule()` and `S2_query_image()` is now a string and allows to choose between the `sp` package and the `sf` package spatial object representation. * All `S2_query_...()` functions always return a data frame even when query fetches no results. Returned data frame is guaranteed to have at least an `{objectType}Id` column (e.g. `granuleId` for granules, `regionId` for regions of interest, etc.). * The `S2_download()` can now display a progress bar.
IVFL-BOKU · Dec 18, 2018 · 541f9b5 · 541f9b5
1 parent d313eb3
commit 541f9b5
Show file tree

Hide file tree

Showing 17 changed files with 359 additions and 221 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: sentinel2
 Title: Tools to access Sentinel-2 data pre-processed by IVFL, BOKU Vienna
-Version: 0.2.1
+Version: 0.3.0
 Authors@R: c(
     person("Sebastian", "Boeck",  email = "[email protected]", role = c("aut", "cre")),
     person("Mateusz",   "Zoltak", email = "[email protected]",  role = c("ctb"))
@@ -23,7 +23,8 @@ Suggests:
     testthat,
     covr,
     knitr,
-    rmarkdown
+    rmarkdown,
+    sf
 License: GPL-3
 Encoding: UTF-8
 LazyData: true

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,13 @@
+# 0.3.0 (2018-12-18)
+
+* A `spatial` parameter of the `S2_query_granule()` and `S2_query_image()` is now
+  a string and allows to choose between the `sp` package and the `sf` package spatial
+  object representation.
+* All `S2_query_...()` functions always return a data frame even when query fetches no
+  results. Returned data frame is guaranteed to have at least an `{objectType}Id` 
+  column (e.g. `granuleId` for granules, `regionId` for regions of interest, etc.).
+* The `S2_download()` can now display a progress bar.
+
 # 0.2.1 (2018-10-25)
 
 * A `regionId` parameter added to all `S2_query_...()` functions for which it's valid.

diff --git a/R/S2_do_query.R b/R/S2_do_query.R
@@ -9,18 +9,21 @@
 #'   "job", "rgb".
 
 
-S2_do_query <- function(query, path){
-  user     <- getOption("S2user")
-  password <- getOption("S2password")
+S2_do_query = function(query, path){
+  user     = getOption("S2user")
+  password = getOption("S2password")
 
-  filter        <- sapply(query, is.logical)
-  query[filter] <- as.numeric(query[filter])
+  filter        = sapply(query, is.logical)
+  query[filter] = as.numeric(query[filter])
+
+  rtrn = httr::GET(
+    'https://s2.boku.eodc.eu',
+    config = httr::authenticate(user, password),
+    path   = path,
+    query  = query
+  )
+  rtrn = as.data.frame(jsonlite::fromJSON(httr::content(rtrn, as = 'text')))
 
-  rtrn     <- httr::GET('https://s2.boku.eodc.eu',
-                         config = httr::authenticate(user, password),
-                         path   = path,
-                         query  = query)
-  rtrn     <- jsonlite::fromJSON(httr::content(rtrn, as = 'text'))
   return(rtrn)
 }
 
diff --git a/R/S2_download.R b/R/S2_download.R
@@ -8,6 +8,7 @@
 #' @param zip logical if \code{TRUE}, the url will be downloaded as zip archive
 #'   and (automatically) unzipped in the parent directory of 'destfile'
 #'   (plays any role only when downloading granules).
+#' @param progressBar should a progress bar be displayed?
 #' @param ... further arguments not implemented directly - see
 #'   the \href{https://s2.boku.eodc.eu/wiki/#!granule.md#GET_https://s2.boku.eodc.eu/granule/{granuleId}}{granule API doc}
 #'   and the \href{https://s2.boku.eodc.eu/wiki/#!image.md#GET_https://s2.boku.eodc.eu/image/{imageId}}{image API doc}.
@@ -42,13 +43,15 @@
 #'   )
 #' }
 
-S2_download <- function(url, destfile, zip = TRUE, skipExisting = TRUE, ...){
+S2_download <- function(url, destfile, zip = TRUE, skipExisting = TRUE, progressBar = TRUE, ...){
   url = as.character(url)
   destfile = as.character(destfile)
   stopifnot(
     is.vector(url), length(url) > 0, is.vector(destfile),
-    is.logical(skipExisting), is.vector(zip), is.logical(zip), length(zip) == 1,
-    all(!is.na(zip)), length(url) == length(destfile)
+    is.logical(skipExisting),
+    is.vector(zip), is.logical(zip), length(zip) == 1, all(!is.na(zip)),
+    is.vector(progressBar), is.logical(progressBar), length(progressBar) == 1, all(!is.na(progressBar)),
+    length(url) == length(destfile)
   )
   filter = !is.na(url)
   url <- url[filter]
@@ -71,12 +74,18 @@ S2_download <- function(url, destfile, zip = TRUE, skipExisting = TRUE, ...){
   }
 
   success <- rep(FALSE, length(url))
+  if (progressBar) {
+    pb = txtProgressBar(0, length(url), style = 3)
+  }
   for (i in seq_along(url)) {
-
     if (isTRUE(skipExisting) && file.exists(destfile[i])) {
       next
     }
 
+    if (progressBar) {
+      setTxtProgressBar(pb, i)
+    }
+
     try({
       curl::curl_download(url = url[i], destfile = destfile[i], quiet = TRUE)
 

diff --git a/R/S2_query_angle.R b/R/S2_query_angle.R
@@ -22,29 +22,30 @@
 #' @return list of query arguments
 #' @export
 
-S2_query_angle <- function(angleType    = NULL,
-                           band         = NULL,
-                           broken       = FALSE,
-                           dateMax      = NULL,
-                           dateMin      = NULL,
-                           geometry     = NULL,
-                           granule      = NULL,
-                           granuleId    = NULL,
-                           orbitNo      = NULL,
-                           product      = NULL,
-                           productId    = NULL,
-                           regionId     = NULL,
-                           retGeometry  = FALSE,
-                           utm          = NULL,
-                           dateSingle   = NULL,
-                           ...){
-
+S2_query_angle = function(
+  angleType    = NULL,
+  band         = NULL,
+  broken       = FALSE,
+  dateMax      = NULL,
+  dateMin      = NULL,
+  geometry     = NULL,
+  granule      = NULL,
+  granuleId    = NULL,
+  orbitNo      = NULL,
+  product      = NULL,
+  productId    = NULL,
+  regionId     = NULL,
+  retGeometry  = FALSE,
+  utm          = NULL,
+  dateSingle   = NULL,
+  ...
+){
   # check inputs ---------------------------------------------------------------
   if (!is.null(dateSingle)) {
     check_date(dateSingle)
-    dateMin    <- dateSingle
-    dateMax    <- dateSingle
-    dateSingle <- NULL
+    dateMin    = dateSingle
+    dateMax    = dateSingle
+    dateSingle = NULL
   }
 
   if (!is.null(dateMin) && !is.null(dateMax) && check_date(dateMin) > check_date(dateMax)) {
@@ -53,15 +54,18 @@ S2_query_angle <- function(angleType    = NULL,
 
   # prepare json geometry ------------------------------------------------------
   if (!is.null(geometry)) {
-    geometry <- roi_to_jgeom(geometry)
+    geometry = roi_to_jgeom(geometry)
   }
 
   # make named query list ------------------------------------------------------
-  query <- c(as.list(environment()), list(...))
-  query <- query[!sapply(query, is.null)]
+  query = c(as.list(environment()), list(...))
+  query = query[!sapply(query, is.null)]
 
   # return query list ----------------------------------------------------------
-  rtrn  <- S2_do_query(query = query, path = 'angle')
+  rtrn  = S2_do_query(query = query, path = 'angle')
+  if (nrow(rtrn) == 0) {
+    rtrn$angleId = integer()
+  }
   return(rtrn)
 }
 
diff --git a/R/S2_query_granule.R b/R/S2_query_granule.R
@@ -26,45 +26,46 @@
 #' @param utm character UTM zone, e.g. 33U, 01C.
 #' @param dateSingle character date of format "YYYY-MM-DD", specifies a single
 #'   date and will override \code{dateMin} and \code{dateMax}.
-#' @param spatial logical, if TRUE the geometry column will contain
-#'   SpatialPolygonsDataFrame objects instead of GeoJSON strings.
-#'   Be aware that such conversion may take quite some time for large number of
-#'   returned granules.
+#' @param spatial character, R package name (\code{sp} or \code{sf}) to the
+#'   format used by which granule geometries should be converted. Be aware that
+#'   such conversion may take quite some time for large number of returned
+#'   granules.
 #' @param ... further arguments not implemented directly - see
 #'   the \href{https://s2.boku.eodc.eu/wiki/#!granule.md#GET_https://s2.boku.eodc.eu/granule}{API doc}.
 #' @return data.frame describing matching granules.
 #' @export
 
-S2_query_granule <- function(atmCorr      = NULL,
-                             broken       = FALSE,
-                             cloudCovMin  = NULL,
-                             cloudCovMax  = NULL,
-                             dateMax      = NULL,
-                             dateMin      = NULL,
-                             geometry     = NULL,
-                             granule      = NULL,
-                             granuleId    = NULL,
-                             orbitNo      = NULL,
-                             owned        = FALSE,
-                             product      = NULL,
-                             productId    = NULL,
-                             regionId     = NULL,
-                             retGeometry  = FALSE,
-                             utm          = NULL,
-                             dateSingle   = NULL,
-                             spatial      = FALSE,
-                             ...){
-
+S2_query_granule = function(
+  atmCorr      = NULL,
+  broken       = FALSE,
+  cloudCovMin  = NULL,
+  cloudCovMax  = NULL,
+  dateMax      = NULL,
+  dateMin      = NULL,
+  geometry     = NULL,
+  granule      = NULL,
+  granuleId    = NULL,
+  orbitNo      = NULL,
+  owned        = FALSE,
+  product      = NULL,
+  productId    = NULL,
+  regionId     = NULL,
+  retGeometry  = FALSE,
+  utm          = NULL,
+  dateSingle   = NULL,
+  spatial      = NULL,
+  ...
+){
   # check inputs ---------------------------------------------------------------
-  if (isTRUE(spatial)) {
-    retGeometry <- TRUE
+  if (!is.null(spatial)) {
+    retGeometry = TRUE
   }
 
   if (!is.null(dateSingle)) {
     check_date(dateSingle)
-    dateMin    <- dateSingle
-    dateMax    <- dateSingle
-    dateSingle <- NULL
+    dateMin    = dateSingle
+    dateMax    = dateSingle
+    dateSingle = NULL
   }
 
   if (!is.null(dateMin) && !is.null(dateMax) && check_date(dateMin) > check_date(dateMax)) {
@@ -73,22 +74,21 @@ S2_query_granule <- function(atmCorr      = NULL,
 
   # prepare json geometry ------------------------------------------------------
   if (!is.null(geometry)) {
-    geometry <- roi_to_jgeom(geometry)
+    geometry = roi_to_jgeom(geometry)
   }
 
   # make named query list ------------------------------------------------------
-  query <- c(as.list(environment()), list(...))
-  query <- query[!sapply(query, is.null)]
+  query = c(as.list(environment()), list(...))
+  query = query[!sapply(query, is.null)]
 
   # return query list ----------------------------------------------------------
-  rtrn  <- S2_do_query(query = query, path = 'granule')
+  rtrn = S2_do_query(query = query, path = 'granule')
+  if (nrow(rtrn) == 0) {
+    rtrn$granuleId = integer()
+  }
 
-  if (isTRUE(spatial)) {
-    geometryJson = rtrn$geometry
-    rtrn$geometry = vector('list', length(geometryJson))
-    for (i in seq_along(geometryJson)) {
-      rtrn$geometry[[i]] = rgdal::readOGR(geometryJson[i], 'OGRGeoJSON', verbose = FALSE)
-    }
+  if (!is.null(spatial) & nrow(rtrn) > 0) {
+    rtrn$geometry = geojson2geometry(rtrn$geometry, spatial)
   }
 
   return(rtrn)