fills repo

DESCRIPTION

@@ -1,9 +1,20 @@
 Package: sentinel2
-Title: What the Package Does (one line, title case)
+Title: Tools to access Sentinel-2 data pre-processed by IVFL, BOKU Vienna
 Version: 0.0.0.9000
-Authors@R: person("First", "Last", email = "[email protected]", role = c("aut", "cre"))
-Description: What the package does (one paragraph).
-Depends: R (>= 3.2.2)
-License: What license is it under?
+Authors@R: person("Sebastian", "Boeck", email = "[email protected]", role = c("aut", "cre"))
+Description: Tools to conveniently query and access pre-processed Sentinel-2
+    data. Registration to 'https://s2.boku.eodc.eu' is required for most operations.
+    Please consult the 'https://s2.boku.eodc.eu' (, i.e. the 'FAQ' and 'wiki'
+    pages), if you are unclear on how to use this package.
+Depends:
+    R (>= 3.2.2)
+Imports:
+    curl,
+    httr,
+    jsonlite,
+    raster,
+    sp
+License: GPL-3
 Encoding: UTF-8
 LazyData: true
+RoxygenNote: 5.0.1

NAMESPACE

@@ -1,2 +1,12 @@
-# Generated by roxygen2: fake comment so roxygen2 overwrites silently.
-exportPattern("^[^\\.]")
+# Generated by roxygen2: do not edit by hand
+
+export(S2_buy_granule)
+export(S2_check_access)
+export(S2_generate_RGB)
+export(S2_initialize_user)
+export(S2_put_ROI)
+export(S2_query_angle)
+export(S2_query_granule)
+export(S2_query_image)
+export(S2_query_job)
+export(S2_query_product)

R/S2_buy_granule.R

@@ -0,0 +1,18 @@
+#' Buy a granule at 'https://s2.boku.eodc.eu'
+#'
+#' Buy granule using granuleId
+#'
+#' @param granuleId character the granuleId
+#' @export
+
+
+S2_buy_granule <- function(granuleId){
+  user     <- getOption("S2user")
+  password <- getOption("S2password")
+  rtrn     <- httr::PUT('https://s2.boku.eodc.eu',
+                        config = httr::authenticate(user, password),
+                        path   = list('granule', granuleId))
+  jsonlite::fromJSON(httr::content(rtrn, as = 'text'))
+  return(invisible(rtrn))
+}
+

R/S2_check_access.R

@@ -0,0 +1,58 @@
+#' (Very basic) check if server/database can be accessed
+#'
+#' Checks accessibility of server / database and does basic checking of
+#'   user credentials
+#'
+#' @param verbose logical
+#' @return logical \code{TRUE} if access to server was successfull and user
+#'   credentials seem to be valid, FALSE if 'anything' went wrong
+#' @export
+
+S2_check_access <- function(verbose = TRUE){
+  user     <- getOption("S2user")
+  password <- getOption("S2password")
+  srvrsp   <- httr::GET('https://s2.boku.eodc.eu/user/current',
+                        config = httr::authenticate(user, password))
+
+  if (httr::status_code(srvrsp) == 200){
+    if (httr::content(srvrsp)$userId == user){
+
+      if (isTRUE(verbose)){
+        cat(sprintf("Logged in to 'https://s2.boku.eodc.eu' as %s\n", user))
+      }
+      return(TRUE)
+
+    } else if (httr::content(srvrsp)$userId == "public"){
+
+      if (user == "default" && password == "default"){
+        if (isTRUE(verbose)){
+          warning("Not logged in at 'https://s2.boku.eodc.eu' -> limited access to database:\n",
+                  "please supply 'user' and 'password' via 'S2_initialize_user()'\n",
+                  "see '?S2_intialize_user' for details!")
+        }
+        return(FALSE)
+
+      } else {
+
+        if (isTRUE(verbose)){
+          warning("Not logged in to s2.boku.eodc.eu -> access to database limited:\n",
+                  "please check credentials and use 'S2_initialize_user()' to\n",
+                  "supply a valid 'user' and 'password'\n",
+                  "see '?S2_intialize_user' or visit 'https://s2.boku.eodc.eu' for details!")
+        }
+        return(FALSE)
+
+      }
+    }
+  } else {
+
+    if (isTRUE(verbose)){
+      warning(sprintf("Unable to access server! Status code %s returned",
+                   httr::status_code(srvrsp)))
+    }
+    return(FALSE)
+
+  }
+
+}
+

R/S2_do_query.R

@@ -0,0 +1,25 @@
+#' Send a query to 'https://s2.boku.eodc.eu'
+#'
+#' Query database and return response as data.frame
+#'
+#' @param query list of named arguments 'known' to the database. Typically
+#'   created using e.g. 'S2_query_granule'
+#' @param path character altering the query url with respect to the desired
+#'   output. One of "product", "granule", "image", "qiData", "angle", "roi",
+#'   "job", "rgb".
+
+
+S2_do_query <- function(query, path){
+  user     <- getOption("S2user")
+  password <- getOption("S2password")
+  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)
+}
+
+
+# query <- S2_query_granule(utm = "33UWP", atmCorr = 1)
+# S2_do_query(query, path='granule')

R/S2_download.R

@@ -0,0 +1,29 @@
+#' S2_download helper function
+#'
+#' Simple helper function to zip download and unzip i.e. a 'granule' in a single
+#'   step
+#'
+#' @param url character (valid) url to download file from.
+#' @param destfile character download destination. If \code{zip = TRUE}, the
+#'   ending '.zip' will be attached to destfile (, if it is not already).
+#' @param zip logical if \code{TRUE}, the url will be downloaded as zip archive
+#'   and (automatically) unzipped in the parent directory of 'destfile'
+#' @return NULL
+
+S2_download <- function(url, destfile, zip = TRUE){
+
+  if (isTRUE(zip)){
+    url <- paste0(url, "?format=application/zip")
+    if (!grepl("[.]zip$", destfile)) destfile <- paste0(destfile, ".zip")
+  }
+
+  curl::curl_download(url = url, destfile = destfile, quiet = TRUE)
+
+  if (isTRUE(zip)) unzip(zipfile = destfile, exdir = dirname(destfile))
+
+  return(invisible(NULL))
+}
+
+
+
+

R/S2_generate_RGB.R

@@ -0,0 +1,109 @@
+#' Generate RGB image and download
+#'
+#' Generates 8-bit/channel composite image (see 'https://s2.boku.eodc.eu/wiki/'
+#'   for details)
+#'
+#' @param granuleId integer the granuleId for which to create the RGB composite
+#' @param destfile character path to the output file. If destfile is a path to
+#'   an existing directory, a filename will be automatically generated. If NULL,
+#'   the file will be saved to the current working directory. If a filename is
+#'   supplied, it will have to have a '.tif' extension.
+#' @param resolution integer desired (minimum) resolution, typically 10, 20 or 60.
+#' @param atmCorr 0 (default) or 1, if atmospherically corrected bands should be
+#'   used
+#' @param r character red band, e.g. "B08"
+#' @param g character green band, e.g. "B04"
+#' @param b character blue band, e.g. "B03"
+#' @param ra see wiki
+#' @param ga see wiki
+#' @param ba see wiki
+#' @param rb see wiki
+#' @param gb see wiki
+#' @param bb see wiki
+#' @param overwrite logical, should existing files be overwritten?
+#' @return NULL
+#' @export
+
+S2_generate_RGB <- function(granuleId,
+                            destfile = NULL,
+                            resolution = 10,
+                            atmCorr = 0,
+                            r = "B08",
+                            g = "B04",
+                            b = "B03",
+                            ra = 20,
+                            ga = 20,
+                            ba = 20,
+                            rb = 20,
+                            gb = 20,
+                            bb = 20,
+                            overwrite = FALSE){
+
+  query <- S2_query_image(granuleId = granuleId, atmCorr = atmCorr)
+  respo <- S2_do_query(query, path = "image")
+
+  if (length(respo) == 0 && atmCorr == 0){
+
+    warning("Unable to process 'granuleId ", granuleId, "'. Not found in database!")
+    return(invisible(NULL))
+
+  } else if (length(respo) == 0 && atmCorr == 1){
+
+    warning("Unable to process 'granuleId ", granuleId, "'. Maybe its not (yet) ",
+         "atmospherically corrected!\n")
+    return(invisible(NULL))
+
+  }
+
+  imageIds <- integer(3)
+  for (i in seq_len(3)){
+    sel           <- respo[respo$band == c(r, g, b)[i] & respo$resolution >= resolution, , drop=FALSE]
+    sel           <- sel[order(sel$resolution)[1], , drop=FALSE]
+
+    if (is.na(sel$url)){
+      warning("Access to image denied. You seem to lack permission to download file!")
+      return(invisible(NULL))
+    }
+
+    imageIds[i]   <- sel[, "imageId"]
+  }
+
+  query <- list(r = imageIds[1],
+                g = imageIds[2],
+                b = imageIds[3],
+                ra = ra,
+                ga = ga,
+                ba = ba,
+                rb = rb,
+                gb = gb,
+                bb = bb)
+
+  user     <- getOption("S2user")
+  password <- getOption("S2password")
+  rtrn     <- httr::modify_url('https://s2.boku.eodc.eu',
+                               username = URLencode(user, reserved = TRUE),
+                               password = URLencode(password, reserved = TRUE),
+                               path     = "rgb",
+                               query    = query)
+
+
+  if (is.null(destfile)){
+    destfile <- sprintf("granuleId_%s_r_%s_g_%s_b_%s_atmCorr_%s.tif",
+                        granuleId, r, g, b, atmCorr)
+  }
+
+  if (dir.exists(destfile)){
+    destfile <- sprintf("%s/granuleId_%s_r_%s_g_%s_b_%s_atmCorr_%s.tif",
+                        destfile, granuleId, r, g, b, atmCorr)
+  }
+
+  if (file.exists(destfile) & !isTRUE(overwrite)){
+    warning(destfile, " already exists! Use 'overwrite=TRUE'")
+    return(invisible(NULL))
+  }
+
+  curl::curl_download(url = rtrn, destfile = destfile)
+  return(invisible(NULL))
+}
+
+

R/S2_initialize_user.R

@@ -0,0 +1,20 @@
+#' Function used to set 'user' and 'password' login credentials for the current
+#'   R session
+#'
+#' S2_initialize_user stores 'user' and 'password' usign \code{options()}.
+#'  Functions in package 'S2boku' (that require authentication) will retrieve
+#'  the credentials using 'getOption()'. This will avoid passing login
+#'  credentials multiple times in a single session and allows the user
+#'  for permanent configuration in '.Rprofile'.
+#'
+#' @note Requires a valid registration to 'https://s2.boku.eodc.eu' to gain
+#'    access to database functionality where authentication is mandatory.
+#' @param user character user login you have registered with at
+#'   'https://s2.boku.eodc.eu'
+#' @param password character password for 'https://s2.boku.eodc.eu'
+#' @export
+
+S2_initialize_user <- function(user = "[email protected]", password = "default"){
+  options("S2user" = user)
+  options("S2password" = password)
+}

R/S2_put_ROI.R

@@ -0,0 +1,55 @@
+#' Creates new or update existing regions of interest
+#'
+#' Place/Update roi for processing Sentinel-2 data
+#'
+#' @param geometry SpatialPoints, SpatialPolygons or path to a shapefile on disk
+#' @param regionId character a new or existing region name
+#' @param cloudCovMax integer cloud coverage treshold for a given region
+#' @param dateMin character, date 'YYYY-MM-DD' beginning of the region's time span
+#' @param dateMax character, date 'YYYY-MM-DD' end of the region's time span
+#' @param indicators character vector of indicator names to be computed for a
+#'   given region (e.g. \code{c("LAI", "FAPAR")})
+#' @param srid integer geometry projection SRID (e.g. 4326 for WGS-84)
+#' @return side effect of putting the roi supplied via 'geometry' to
+#'   's2.boku.eodc.eu'
+#' @export
+
+
+S2_put_ROI <- function(geometry,
+                       regionId    = NULL,
+                       cloudCovMax = 50,
+                       indicators  = NULL,
+                       dateMin     = NULL,
+                       dateMax     = NULL,
+                       srid        = 4326){
+
+  if (is.null(dateMin) || is.null(dateMax)){
+    stop("Please supply 'dateMin' and 'dateMax' in format 'YYYY-MM-DD")
+  }
+
+  if (is.null(regionId)){
+    stop("'regionId' not specified!",
+         "\n-> If you want to update an existing 'roi', please supply valid 'regionId'",
+         "\n-> If you like to create a new 'regionId' enter desired name")
+  }
+
+  geometry  <- roi_to_jgeom(geometry)
+
+  body_l    <- list(cloudCovMax  = cloudCovMax,
+                    dateMin      = dateMin,
+                    dateMax      = dateMax,
+                    geometry     = geometry,
+                    srid         = srid)
+
+  body_l   <- body_l[!sapply(body_l , is.null)]
+
+  user     <- getOption("S2user")
+  password <- getOption("S2password")
+  rtrn     <- httr::PUT('https://s2.boku.eodc.eu',
+                        config = httr::authenticate(user, password),
+                        path   = list("roi", regionId),
+                        body   = body_l)
+
+  return(rtrn)
+
+}