add function to extract points from rasters

DESCRIPTION

@@ -12,6 +12,7 @@ Authors@R: c(
     person("Stijn", "Van Hoey", role = c("aut", "cre"), email = "stijnvanhoey@gmail.com", comment = c(ORCID = "0000-0001-6413-3185")),
     person("Willem", "Maetens", role = "ctb", email = "w.maetens@vmm.be"),
     person("Peter", "Desmet", role = "ctb", email = "peter.desmet@inbo.be", comment = c(ORCID = "0000-0002-8442-8025")),
+    person(given = "Thierry", family = "Onkelinx", role = "ctb", email = "thierry.onkelinx@inbo.be", comment = c(ORCID = "0000-0001-8804-4216")),
     person("Research Institute for Nature and Forest (INBO)", role = "cph", email = "info@inbo.be")
     )
 License: MIT + file LICENSE
@@ -20,10 +21,12 @@ BugReports: https://github.com/ropensci/wateRinfo/issues
 Depends:
     R (>= 2.10)
 Imports:
+    assertthat,
     dplyr,
     httr,
     jsonlite,
     openssl,
+    purrr,
     lubridate (>= 1.6.0),
     rlang,
     utils
@@ -36,4 +39,4 @@ Suggests:
 LazyData: true
 Encoding: UTF-8
 VignetteBuilder: knitr
-RoxygenNote: 6.1.1
+RoxygenNote: 7.1.1

NAMESPACE

@@ -6,6 +6,7 @@ S3method(print,token)
 S3method(print,waterinfo_api)
 export(check_period_format)
 export(expires.in)
+export(get_raster_points)
 export(get_stations)
 export(get_timeseries_tsid)
 export(get_token)
@@ -17,9 +18,14 @@ export(resolve_timeseriesgroupid)
 export(show.token)
 export(supported_frequencies)
 export(supported_variables)
+importFrom(assertthat,assert_that)
+importFrom(assertthat,has_name)
 importFrom(dplyr,"%>%")
+importFrom(dplyr,bind_cols)
+importFrom(dplyr,bind_rows)
 importFrom(dplyr,filter)
 importFrom(dplyr,filter_)
+importFrom(dplyr,mutate)
 importFrom(dplyr,select)
 importFrom(httr,GET)
 importFrom(httr,POST)
@@ -32,6 +38,8 @@ importFrom(jsonlite,fromJSON)
 importFrom(lubridate,parse_date_time)
 importFrom(lubridate,ymd_hms)
 importFrom(openssl,base64_encode)
+importFrom(purrr,map)
+importFrom(purrr,map2)
 importFrom(rlang,.data)
 importFrom(rlang,quo)
 importFrom(utils,read.csv)

R/call_waterinfo.R

@@ -9,6 +9,10 @@ waterinfo_pro_base <- function() {
 hic_base <- function() {
   "https://www.waterinfo.be/tsmhic/KiWIS/KiWIS"
 }
+hydro_base <- function() {
+  "https://hydro.vmm.be/grid/kiwis/KiWIS"
+}
+
 
 #' http call to waterinfo.be
 #'
@@ -26,20 +30,15 @@ hic_base <- function() {
 #'
 #' @importFrom httr GET http_type status_code http_error content add_headers
 #' @importFrom jsonlite fromJSON
-call_waterinfo <- function(query, base_url = "vmm", token = NULL) {
-
-  hic_base
-
+call_waterinfo <- function(
+  query, base_url = c("vmm", "hic", "pro", "hydro"), token = NULL
+) {
   # check the base url, which depends of the query to execute
-  if (base_url == "vmm") {
-    base <- waterinfo_base()
-  } else if (base_url == "hic") {
-    base <- hic_base()
-  } else if (base_url == "pro") {
-    base <- waterinfo_pro_base()
-  } else {
-    stop("Base url should be vmm, hic or pro")
-  }
+  base_url <- match.arg(base_url)
+  base <- switch(
+    base_url, vmm = waterinfo_base(), hic = hic_base(),
+    pro = waterinfo_pro_base(), hydro = hydro_base()
+  )
 
   if (is.null(token)) {
     res <- GET(base, query = query)

R/get_raster_points.R

@@ -0,0 +1,47 @@
+#' Get timeseries data for specific points on a raster
+#' @inheritParams get_timeseries_tsid
+#' @param points a matrix or data.frame with coordinates in decimal degrees
+#' using the EPSG 4326 coordinate system.
+#' It must have the colnames `lat` and `long`.
+#' @export
+#' @importFrom assertthat assert_that has_name
+#' @importFrom dplyr bind_cols bind_rows mutate %>%
+#' @importFrom lubridate ymd_hms
+#' @importFrom purrr map map2
+get_raster_points <- function(
+  ts_id = 911010, period = NULL, from = NULL, to = NULL, points,
+  datasource = 10, token = NULL
+) {
+  # check and handle the date/period information
+  period_info <- parse_period(from, to, period)
+  assert_that(
+    inherits(points, "data.frame"), has_name(points, c("long", "lat"))
+  )
+
+  query_list <- list(
+    type = "queryServices", service = "kisters",
+    request = "getRasterToPointValues", ts_id = ts_id, format = "json",
+    datasource = datasource, raster_epsg = 4326, metadata = "True",
+    raster_x = paste(points$long, collapse = ","),
+    raster_y = paste(points$lat, collapse = ",")
+  )
+  time_series <- call_waterinfo(
+    query = c(query_list, period_info), base_url = "hydro", token = token
+  )
+  map(
+    seq_along(points$long),
+    function(i) {
+      cbind(points[i, c("long", "lat")], ts_id = ts_id)
+    }
+  ) %>%
+    map(`rownames<-`, NULL) -> points_list
+
+  map(time_series$content$data, `colnames<-`, c("timestamp", "value")) %>%
+    map(data.frame) %>%
+    map2(points_list, bind_cols) %>%
+    bind_rows() %>%
+    mutate(
+      timestamp = ymd_hms(timestamp),
+      value = as.numeric(value)
+    )
+}