dont make boxes an sf object, remove lubridate dependency

also start adding documentation

DESCRIPTION

@@ -2,7 +2,8 @@ Package: opensensemap
 Type: Package
 Title: Work with Sensor Data from opensensemap.org in R
 Version: 0.1.0
-Imports: lubridate, httr, sf
+Imports: dplyr, httr
+Suggests: readr, sf
 Author: Norwin Roosen
 Maintainer: Norwin Roosen <noerw@gmx.de>
 Description: This packages ingests data (measurements, sensorstations) from the
@@ -12,3 +13,4 @@ Description: This packages ingests data (measurements, sensorstations) from the
 License: GPL-2
 Encoding: UTF-8
 LazyData: true
+RoxygenNote: 6.0.1

R/api.R

@@ -11,19 +11,12 @@ get_boxes_ = function (..., endpoint) {
   }
 
   # parse each list element as sensebox & combine them to a single data.frame
-  #
-  # bind_rows() kills the attributes and classes of sf_sfc column, and warns
-  # about that. see https://github.com/r-spatial/sf/issues/49
-  # we readd the attributes manually afterwards, so we can ignore the warnings.
-  # rbind() wouldn't have this problem, but would be far slower and con't
-  # handle missing columns, so this seems like a good tradeoff..
   boxesList = lapply(response, parse_senseboxdata)
-  suppressWarnings({ data = dplyr::bind_rows(boxesList) })
+  df = dplyr::bind_rows(boxesList)
-  data$geometry = sf::st_sfc(data$geometry, crs = 4326)
+  df$exposure = df$exposure %>% as.factor()
-  #sf::st_geometry(data) = sf::st_sfc(data$geometry, crs = 4326)
+  df$model    = df$model %>% as.factor()
-  #sf::st_sf(data)
+  df$grouptag = df$grouptag %>% as.factor()
-
+  df
-  data
 }
 
 get_box_ = function (..., endpoint) {
@@ -34,9 +27,13 @@ get_box_ = function (..., endpoint) {
 }
 
 get_measurements_ = function (..., endpoint) {
-  httr::GET(endpoint, path = c('boxes', 'data'), query = list(...)) %>%
+  # FIXME: get rid of readr warnings
-    httr::content() %>%
+  result = httr::GET(endpoint, path = c('boxes', 'data'), query = list(...)) %>%
+    httr::content(encoding = 'UTF-8') %>%
     osem_remote_error()
+
+  class(result) = c('osem_measurements', class(result))
+  result
 }
 
 get_stats_ = function (endpoint) {

R/api_utils.R

@@ -1,11 +1,31 @@
 osem_remote_error = function (response) {
-  if (!is.null(response$code)) stop(response$message)
+  suppressWarnings({
+    hasCode = !is.null(response$code)
+  })
 
+  if (hasCode) stop(response$message)
   invisible(response)
 }
 
-date_as_isostring = function (date) {
+parse_dateparams = function (from, to) {
-  # as_datetime is required so UTC times are always returned
+  from = utc_date(from)
-  # TODO: check if we can get along without lubridate dependency?
+  to = utc_date(to)
-  lubridate::as_datetime(date) %>% format.Date(format = '%FT%TZ')
+  if (from - to > 0)
+    stop('"from" must be earlier than "to"')
+
+  c(date_as_isostring(from), date_as_isostring(to))
+}
+
+# NOTE: cannot handle mixed vectors of POSIXlt and POSIXct
+utc_date = function (date) {
+  time = as.POSIXct(date)
+  attr(time, 'tzone') = 'UTC'
+  time
+}
+
+# NOTE: cannot handle mixed vectors of POSIXlt and POSIXct
+date_as_isostring = function (date) format(date, format = '%FT%TZ')
+
+osem_as_sf = function (x, ...) {
+  sf::st_as_sf(x, ..., coords = c('lon', 'lat'), crs = 4326)
 }

R/box_api.R

@@ -28,20 +28,16 @@ osem_boxes = function (exposure = NA, model = NA, grouptag = NA,
 
   if (!is.na(to) && !is.na(from)) {
     # error, if from is after to
-    if (lubridate::as_datetime(from) - lubridate::as_datetime(to) > 0)
-      stop('Parameter "from" must be earlier than "to"')
     # convert dates to commaseparated UTC ISOdates
-    query$date = c(date_as_isostring(from), date_as_isostring(to)) %>%
+    query$date = parse_dateparams(from, to) %>% paste(collapse = ',')
-      paste(collapse = ',')
 
-    print(query$date)
   } else if (!is.na(date)) {
-    query$date = format.Date(lubridate::as_datetime(date), '%FT%TZ')
+    query$date = utc_date(date) %>% date_as_isostring()
   }
 
   do.call(get_boxes_, query)
 }
 
 osem_box = function (boxId, endpoint = 'https://api.opensensemap.org') {
-  get_box_(boxId, endpoint)
+  get_box_(boxId, endpoint = endpoint)
 }

R/box_parse.R

@@ -4,7 +4,7 @@ parse_senseboxdata = function (boxdata) {
   sensors = boxdata$sensors
   location = boxdata$loc
   boxdata[c('loc', 'sensors', 'image', 'boxType')] <- NULL
-  thebox = as.data.frame(boxdata)
+  thebox = as.data.frame(boxdata, stringsAsFactors = F)
 
   # parse timestamps (updatedAt might be not defined)
   thebox$createdAt = as.POSIXct(strptime(thebox$createdAt, format='%FT%T', tz = 'GMT'))
@@ -22,15 +22,11 @@ parse_senseboxdata = function (boxdata) {
   })[[1]])
 
   # extract coordinates & transform to simple feature object
-  thebox$lng = location[[1]]$geometry$coordinates[[1]]
+  thebox$lon = location[[1]]$geometry$coordinates[[1]]
   thebox$lat = location[[1]]$geometry$coordinates[[2]]
   if (length(location[[1]]$geometry$coordinates) == 3)
     thebox$height = location[[1]]$geometry$coordinates[[3]]
 
-  # sf does not like to combine 2D and 3D coords, so we just use 2D
-  # IDEA: convert to sf only after rbind?
-  thebox = sf::st_as_sf(thebox, coords = c('lng', 'lat'), crs = 4326)
-
   # attach a custom class for methods
   class(thebox) = c('sensebox', class(thebox))
   thebox

R/box_utils.R

@@ -1,50 +1,52 @@
 `%>%` = magrittr::`%>%`
 
-plot.sensebox = function (x) {
+plot.sensebox = function (x, ...) {
-  # TODO: background map?
+  # TODO: background map (maps::world), graticule?
-  geom = sf::st_geometry(x)
+  geom = x %>%
-  plot(geom, graticule = st_crs(geom), axes = TRUE)
+    osem_as_sf() %>%
+    sf::st_geometry()
+
+  # FIXME:trying to add graticule crashes RStudio?!
+  plot(geom, ..., axes = T) #graticule = sf::st_crs(sf)
+
   invisible(x)
 }
 
-print.sensebox = function(x) {
+print.sensebox = function(x, ...) {
   important_columns = c('name', 'exposure', 'lastMeasurement', 'phenomena')
   data = as.data.frame(x) # to get rid of the sf::`<-[` override..
-  message(class(data))
+  print(data[important_columns], ...)
-  print(data[important_columns])
   invisible(x)
 }
 
-summary.sensebox = function(x) {
+summary.sensebox = function(x, ...) {
-  df = as.data.frame(x) # the sf methods are messing with us again..
+  cat('boxes total:', nrow(x), fill = T)
-
-  cat('boxes total:', nrow(df), fill = T)
   cat('\nboxes by exposure:')
-  table(df$exposure) %>% print()
+  table(x$exposure) %>% print()
   cat('\nboxes by model:')
-  table(df$model) %>% print()
+  table(x$model) %>% print()
   cat('\n')
 
-  diffNow = (lubridate::now() - df$lastMeasurement) %>% as.numeric(unit='hours')
+  diffNow = (utc_time(Sys.time()) - x$lastMeasurement) %>% as.numeric(unit='hours')
-  neverActive = df[is.na(df$lastMeasurement), ] %>% nrow()
+  neverActive = x[is.na(x$lastMeasurement), ] %>% nrow()
   list(
     'last_measurement_within' = c(
-      '1h' = nrow(df[diffNow <= 1, ]) - neverActive,
+      '1h' = nrow(x[diffNow <= 1, ]) - neverActive,
-      '1d' = nrow(df[diffNow <= 24, ]) - neverActive,
+      '1d' = nrow(x[diffNow <= 24, ]) - neverActive,
-      '30d' = nrow(df[diffNow <= 720, ]) - neverActive,
+      '30d' = nrow(x[diffNow <= 720, ]) - neverActive,
-      '365d' = nrow(df[diffNow <= 8760, ]) - neverActive,
+      '365d' = nrow(x[diffNow <= 8760, ]) - neverActive,
       'never' = neverActive
     )
   ) %>%
     print()
 
-  oldest = df[df$createdAt == min(df$createdAt), ]
+  oldest = x[x$createdAt == min(x$createdAt), ]
-  newest = df[df$createdAt == max(df$createdAt), ]
+  newest = x[x$createdAt == max(x$createdAt), ]
   cat('oldest box:', format(oldest$createdAt, '%F %T'), paste0('(', oldest$name, ')'), fill = T)
   cat('newest box:', format(newest$createdAt, '%F %T'), paste0('(', newest$name, ')'), fill = T)
 
   cat('\nsensors per box:', fill = T)
-  lapply(df$phenomena, length) %>%
+  lapply(x$phenomena, length) %>%
     as.numeric() %>%
     summary() %>%
     print()
@@ -56,7 +58,7 @@ osem_phenomena = function (x) UseMethod('osem_phenomena')
 osem_phenomena.default = function (x) stop('not implemented')
 osem_phenomena.sensebox = function (x) {
   Reduce(`c`, x$phenomena) %>% # get all the row contents in a single vector
-    table() %>%                # get the counts
+    table() %>%                # get count for each phenomenon
-    t() %>%                    # transform the table to an easier to work with df
+    t() %>%                    # transform the table to a df
     as.data.frame.matrix()
 }

R/measurement_api.R

@@ -1,11 +1,68 @@
+# ==============================================================================
+#
+#' Get the Measurements of a Phenomenon on opensensemap.org
+#'
+#' Measurements can be retrieved either for a set of boxes, or through a spatial
+#' bounding box filter. To get all measurements, the \code{default} function applies
+#' a bounding box spanning the whole world.
+#'
+#' @param phenomenon The phenomenon to retrieve measurements for
+#' @param exposure Filter sensors by their exposure ('indoor', 'outdoor', 'mobile')
+#' @param from A \code{POSIXt} like object to select a time interval
+#' @param to A \code{POSIXt} like object to select a time interval
+#' @param columns Select specific column in the output (see oSeM documentation)
+#' @param endpoint The URL of the openSenseMap API
+#'
+#' @return An \code{osem_measurements} \code{data.frame} containing the
+#'   requested measurements
+#'
+#' @export
+#' @family osem_measurements
+#' @seealso \href{https://docs.opensensemap.org/#api-Measurements-getDataMulti}{openSenseMap API documentation}
 osem_measurements = function (x, ...) UseMethod('osem_measurements')
 
+# ==============================================================================
+#
+#' Get the Measurements of a Phenomenon from all sensors
+#'
+#' @param ... Passed on to \code{\link{osem_measurements.bbox}}
+#' @inherit osem_measurements seealso return
+#' @inheritParams osem_measurements
+#'
+#' @export
+#' @family osem_measurements
+#' @seealso \code{\link{osem_measurements.bbox}}
+#' @seealso \href{https://docs.opensensemap.org/#api-Measurements-getDataMulti}{openSenseMap API documentation}
+#'
+#' @examples
+#' osem_measurements('PM2.5')
 osem_measurements.default = function (phenomenon, ...) {
   bbox = structure(c(-180, -90, 180, 90), class = 'bbox')
   osem_measurements(bbox, phenomenon, ...)
 }
 
-# /boxes/data?bbox=
+# ==============================================================================
+#
+#' Get the Measurements of a Phenomenon by a spatial filter
+#'
+#' @param bbox A \code{\link[sf]{st_bbox}} to select sensors spatially
+#' @inheritParams phenomenon,exposure,from,to,columns,endpoint osem_measurements
+#'
+#' @return An \code{osem_measurements} \code{data.frame} containing the
+#'   requested measurements
+#'
+#' @export
+#' @family osem_measurements
+#' @seealso \href{https://docs.opensensemap.org/#api-Measurements-getDataMulti}{openSenseMap API documentation}
+#' @seealso \code{\link[sf]{st_bbox}}
+#'
+#' @examples
+#' bbox = structure(c(7.5, 51, 8, 52), class = 'bbox')
+#' osem_measurements(bbox, 'Temperature')
+#'
+#'
+#' bbox2 = sf::st_point(c(7, 51)) %>% sf::st_bbox()
+#' osem_measurements(bbox2, 'Temperature', exposure = 'outdoor')
 osem_measurements.bbox = function (bbox, phenomenon, exposure = NA,
                                    from = NA, to = NA,
                                    columns = NA,
@@ -14,7 +71,27 @@ osem_measurements.bbox = function (bbox, phenomenon, exposure = NA,
   do.call(get_measurements_, query)
 }
 
-# /boxes/data?boxId=1,2,3,4
+# ==============================================================================
+#
+#' Get the Measurements of a Phenomenon for a set of senseBoxes
+#'
+#' @param boxes A \code{sensebox} \code{data.frame} to select boxes from which
+#'   measurements will be retrieved
+#' @inheritParams phenomenon,exposure,from,to,columns,endpoint osem_measurements
+#'
+#' @return An \code{osem_measurements} \code{data.frame} containing the
+#'   requested measurements
+#'
+#' @export
+#' @family osem_measurements
+#' @seealso [osem_boxes()]
+#' @seealso [osem_box()]
+#'
+#' @examples
+#' osem_boxes(grouptag = 'ifgi') %>% get_measurements(phenomenon = 'Temperatur')
+#'
+#' b = osem_box('593bcd656ccf3b0011791f5a')
+#' get_measurements(b, phenomenon = 'Temperatur')
 osem_measurements.sensebox = function (boxes, phenomenon, exposure = NA,
                                        from = NA, to = NA,
                                        columns = NA,
@@ -23,6 +100,16 @@ osem_measurements.sensebox = function (boxes, phenomenon, exposure = NA,
   do.call(get_measurements_, query)
 }
 
+# ==============================================================================
+#
+#' Validates and parses the Parameters for \code{osem_measurements()}
+#'
+#' @param params A named \code{list} of parameters
+#'
+#' @return A named \code{list} of parsed parameters.
+#'
+#' @family osem_internal
+#' @noRd
 parse_get_measurements_params = function (params) {
   if (is.null(params$phenomenon) | is.na(params$phenomenon))
     stop('Parameter "phenomenon" is required')
@@ -37,8 +124,10 @@ parse_get_measurements_params = function (params) {
   if (!is.null(params$boxes))  query$boxIds = paste(params$boxes$X_id, collapse = ',')
   if (!is.null(params$bbox))   query$bbox = paste(params$bbox, collapse = ',')
 
-  if (!is.na(params$from))     query$`from-date` = date_as_isostring(params$from)
+  if (!is.na(params$from))
-  if (!is.na(params$to))       query$`to-date` = date_as_isostring(params$to)
+    query$`from-date` = utc_date(params$from) %>% date_as_isostring()
+  if (!is.na(params$to))
+    query$`to-date` = utc_date(params$to) %>% date_as_isostring()
   if (!is.na(params$exposure)) query$exposure = params$exposure
   if (!is.na(params$columns))  query$columns = paste(params$columns, collapse = ',')
 

R/measurement_utils.R

@@ -0,0 +1,17 @@
+#' Plot openSenseMap Measurements by Time & Value
+#'
+#' @param x An \code{osem_measurements} \code{data.frame}.
+#' @param ... Any parameters you would otherwise pass to \code{plot.formula}.
+#'
+#' @return The input data is returned
+#' @export
+#'
+#' @examples
+#' osem_boxes(grouptag = 'ifgi') %>%
+#'   osem_measurements(phenomenon = 'Temperatur') %>%
+#'   plot()
+plot.osem_measurements = function (x, ...) {
+  # TODO: group/color by sensor_id
+  plot(value~createdAt, x, ...)
+  invisible(x)
+}