From a2d71ac3e87d382cb1033edcbcb10f77170b14aa Mon Sep 17 00:00:00 2001 From: noerw Date: Sat, 12 Aug 2017 15:17:47 +0200 Subject: [PATCH] dont make boxes an sf object, remove lubridate dependency also start adding documentation --- DESCRIPTION | 4 +- R/api.R | 25 +++++------ R/api_utils.R | 30 ++++++++++--- R/box_api.R | 10 ++--- R/box_parse.R | 8 +--- R/box_utils.R | 50 +++++++++++----------- R/measurement_api.R | 97 +++++++++++++++++++++++++++++++++++++++++-- R/measurement_utils.R | 17 ++++++++ 8 files changed, 180 insertions(+), 61 deletions(-) create mode 100644 R/measurement_utils.R diff --git a/DESCRIPTION b/DESCRIPTION index 55a43c0..d3b2471 100644 --- a/DESCRIPTION +++ b/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 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 diff --git a/R/api.R b/R/api.R index 7580511..9cc1418 100644 --- a/R/api.R +++ b/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) }) - data$geometry = sf::st_sfc(data$geometry, crs = 4326) - #sf::st_geometry(data) = sf::st_sfc(data$geometry, crs = 4326) - #sf::st_sf(data) - - data + df = dplyr::bind_rows(boxesList) + df$exposure = df$exposure %>% as.factor() + df$model = df$model %>% as.factor() + df$grouptag = df$grouptag %>% as.factor() + df } 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(...)) %>% - httr::content() %>% + # FIXME: get rid of readr warnings + 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) { diff --git a/R/api_utils.R b/R/api_utils.R index 4a8aeda..ef59c82 100644 --- a/R/api_utils.R +++ b/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) { - # as_datetime is required so UTC times are always returned - # TODO: check if we can get along without lubridate dependency? - lubridate::as_datetime(date) %>% format.Date(format = '%FT%TZ') +parse_dateparams = function (from, to) { + from = utc_date(from) + to = utc_date(to) + 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) } diff --git a/R/box_api.R b/R/box_api.R index d428c92..dd127d8 100644 --- a/R/box_api.R +++ b/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)) %>% - paste(collapse = ',') + query$date = parse_dateparams(from, to) %>% 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) } diff --git a/R/box_parse.R b/R/box_parse.R index a279b98..a3c937e 100644 --- a/R/box_parse.R +++ b/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 diff --git a/R/box_utils.R b/R/box_utils.R index 541b992..a591f61 100644 --- a/R/box_utils.R +++ b/R/box_utils.R @@ -1,50 +1,52 @@ `%>%` = magrittr::`%>%` -plot.sensebox = function (x) { - # TODO: background map? - geom = sf::st_geometry(x) - plot(geom, graticule = st_crs(geom), axes = TRUE) +plot.sensebox = function (x, ...) { + # TODO: background map (maps::world), graticule? + geom = x %>% + 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) { - df = as.data.frame(x) # the sf methods are messing with us again.. - - cat('boxes total:', nrow(df), fill = T) +summary.sensebox = function(x, ...) { + cat('boxes total:', nrow(x), 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') - neverActive = df[is.na(df$lastMeasurement), ] %>% nrow() + diffNow = (utc_time(Sys.time()) - x$lastMeasurement) %>% as.numeric(unit='hours') + neverActive = x[is.na(x$lastMeasurement), ] %>% nrow() list( 'last_measurement_within' = c( - '1h' = nrow(df[diffNow <= 1, ]) - neverActive, - '1d' = nrow(df[diffNow <= 24, ]) - neverActive, - '30d' = nrow(df[diffNow <= 720, ]) - neverActive, - '365d' = nrow(df[diffNow <= 8760, ]) - neverActive, + '1h' = nrow(x[diffNow <= 1, ]) - neverActive, + '1d' = nrow(x[diffNow <= 24, ]) - neverActive, + '30d' = nrow(x[diffNow <= 720, ]) - neverActive, + '365d' = nrow(x[diffNow <= 8760, ]) - neverActive, 'never' = neverActive ) ) %>% print() - oldest = df[df$createdAt == min(df$createdAt), ] - newest = df[df$createdAt == max(df$createdAt), ] + oldest = x[x$createdAt == min(x$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 - t() %>% # transform the table to an easier to work with df + table() %>% # get count for each phenomenon + t() %>% # transform the table to a df as.data.frame.matrix() } diff --git a/R/measurement_api.R b/R/measurement_api.R index e9e8be5..249e192 100644 --- a/R/measurement_api.R +++ b/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$to)) query$`to-date` = date_as_isostring(params$to) + if (!is.na(params$from)) + 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 = ',') diff --git a/R/measurement_utils.R b/R/measurement_utils.R new file mode 100644 index 0000000..5236d2b --- /dev/null +++ b/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) +}