diff --git a/DESCRIPTION b/DESCRIPTION index d3b2471..f56655e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,14 +2,13 @@ Package: opensensemap Type: Package Title: Work with Sensor Data from opensensemap.org in R Version: 0.1.0 -Imports: dplyr, httr +Imports: dplyr, httr, magrittr Suggests: readr, sf Author: Norwin Roosen Maintainer: Norwin Roosen Description: This packages ingests data (measurements, sensorstations) from the - API of opensensemap.org and transforms them into easy to use data.tables. - It uses the sf package for spatial handling of datapoints and aims to be - compatible with the tidyverse. + API of opensensemap.org for analysis in R. + The package aims to be compatible with sf and the tidyverse. License: GPL-2 Encoding: UTF-8 LazyData: true diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..db4db95 --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,13 @@ +# Generated by roxygen2: do not edit by hand + +S3method(osem_measurements,bbox) +S3method(osem_measurements,default) +S3method(osem_measurements,sensebox) +S3method(osem_phenomena,sensebox) +export(osem_box) +export(osem_boxes) +export(osem_counts) +export(osem_measurements) +export(osem_phenomena) +importFrom(graphics,plot) +importFrom(magrittr,"%>%") diff --git a/R/api.R b/R/api.R index 9cc1418..78c98fa 100644 --- a/R/api.R +++ b/R/api.R @@ -1,3 +1,9 @@ +# ============================================================================== +# getters for the opensensemap API. +# the awesome httr library does all the curling, query and response parsing. +# for CSV responses (get_measurements) the readr package is a hidden dependency +# ============================================================================== + # does not actually get called by the user. ... contains all the query parameters. # the proxy is just for parameter autocompletion, filtering out the endpoint get_boxes_ = function (..., endpoint) { diff --git a/R/box.R b/R/box.R new file mode 100644 index 0000000..2cd1fdd --- /dev/null +++ b/R/box.R @@ -0,0 +1,125 @@ +# ============================================================================== +# +#' Get a set of senseBoxes from the openSenseMap +#' +#' Boxes can be selected by a set of filters. +#' Note that some filters do not work together: +#' \enumerate{ +#' \item \code{phenomenon} can only be applied together with \code{date} or +#' \code{from / to} +#' \item \code{date} and \code{from / to} cannot be specified together +#' } +#' +#' @param exposure Only return boxes with the given exposure ('indoor', 'outdoor', 'mobile') +#' @param model Only return boxes with the given model +#' @param grouptag Only return boxes with the given grouptag +#' @param date Only return boxes that were measuring within ±4 hours of the given time +#' @param from Only return boxes that were measuring later than this time +#' @param to Only return boxes that were measuring earlier than this time +#' @param phenomenon Only return boxes that measured the given phenomenon in the +#' time interval as specified through \code{date} or \code{from / to} +#' @param endpoint The URL of the openSenseMap API instance +#' @return A \code{sensebox data.frame} containing a box in each row +#' +#' @seealso \href{https://docs.opensensemap.org/#api-Measurements-findAllBoxes}{openSenseMap API documentation (web)} +#' @seealso \code{\link{osem_phenomena}} +#' @export +#' @examples +#' # TODO +osem_boxes = function (exposure = NA, model = NA, grouptag = NA, + date = NA, from = NA, to = NA, phenomenon = NA, + endpoint = 'https://api.opensensemap.org') { + + # error, if phenomenon, but no time given + if (!is.na(phenomenon) && is.na(date) && is.na(to) && is.na(from)) + stop('Parameter "phenomenon" can only be used together with "date" or "from"/"to"') + + # error, if date and from/to given + if (!is.na(date) && (!is.na(to) || !is.na(from))) + stop('Parameter "date" cannot be used together with "from"/"to"') + + # error, if only one of from/to given + if ( + (!is.na(to) && is.na(from)) || + (is.na(to) && !is.na(from)) + ) { + stop('Parameter "from"/"to" must be used together') + } + + query = list(endpoint = endpoint) + if (!is.na(exposure)) query$exposure = exposure + if (!is.na(model)) query$model = model + if (!is.na(grouptag)) query$grouptag = grouptag + if (!is.na(phenomenon)) query$phenomenon = phenomenon + + if (!is.na(to) && !is.na(from)) { + # error, if from is after to + # convert dates to commaseparated UTC ISOdates + query$date = parse_dateparams(from, to) %>% paste(collapse = ',') + + } else if (!is.na(date)) { + query$date = utc_date(date) %>% date_as_isostring() + } + + do.call(get_boxes_, query) +} + +# ============================================================================== +# +#' Get a single senseBox by its ID +#' +#' @param boxId A string containing a senseBox ID +#' @param endpoint The URL of the openSenseMap API instance +#' @return A \code{sensebox data.frame} containing a box in each row +#' +#' @seealso \href{https://docs.opensensemap.org/#api-Measurements-findAllBoxes}{openSenseMap API documentation (web)} +#' @seealso \code{\link{osem_phenomena}} +#' @export +#' @examples +#' # TODO +osem_box = function (boxId, endpoint = 'https://api.opensensemap.org') { + get_box_(boxId, endpoint = endpoint) +} + +# ============================================================================== +# +#' Construct a senseBox data.frame +#' +#' Parses the fields of a \code{/boxes} response from the openSenseMap API +#' +#' @param boxdata A named \code{list} containing the data for a box +#' @return A \code{data.frame} with an attached class \code{sensebox}. +#' @noRd +parse_senseboxdata = function (boxdata) { + # extract nested lists for later use & clean them from the list + # to allow a simple data.frame structure + sensors = boxdata$sensors + location = boxdata$loc + boxdata[c('loc', 'sensors', 'image', 'boxType')] <- NULL + 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')) + if (!is.null(thebox$updatedAt)) + thebox$updatedAt = as.POSIXct(strptime(thebox$updatedAt, format='%FT%T', tz = 'GMT')) + + # extract metadata from sensors + thebox$phenomena = list(unlist(lapply(sensors, function(s) { s$title }))) + # FIXME: if one sensor has NA, max() returns bullshit + thebox$lastMeasurement = max(lapply(sensors, function(s) { + if (!is.null(s$lastMeasurement)) + as.POSIXct(strptime(s$lastMeasurement$createdAt, format = '%FT%T', tz = 'GMT')) + else + NA + })[[1]]) + + # extract coordinates & transform to simple feature object + 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]] + + # attach a custom class for methods + class(thebox) = c('sensebox', class(thebox)) + thebox +} diff --git a/R/box_api.R b/R/box_api.R deleted file mode 100644 index dd127d8..0000000 --- a/R/box_api.R +++ /dev/null @@ -1,43 +0,0 @@ -`%>%` = magrittr::`%>%` - -osem_boxes = function (exposure = NA, model = NA, grouptag = NA, - date = NA, from = NA, to = NA, phenomenon = NA, - endpoint = 'https://api.opensensemap.org') { - - # error, if phenomenon, but no time given - if (!is.na(phenomenon) && is.na(date) && is.na(to) && is.na(from)) - stop('Parameter "phenomenon" can only be used together with "date" or "from"/"to"') - - # error, if date and from/to given - if (!is.na(date) && (!is.na(to) || !is.na(from))) - stop('Parameter "date" cannot be used together with "from"/"to"') - - # error, if only one of from/to given - if ( - (!is.na(to) && is.na(from)) || - (is.na(to) && !is.na(from)) - ) { - stop('Parameter "from"/"to" must be used together') - } - - query = list(endpoint = endpoint) - if (!is.na(exposure)) query$exposure = exposure - if (!is.na(model)) query$model = model - if (!is.na(grouptag)) query$grouptag = grouptag - if (!is.na(phenomenon)) query$phenomenon = phenomenon - - if (!is.na(to) && !is.na(from)) { - # error, if from is after to - # convert dates to commaseparated UTC ISOdates - query$date = parse_dateparams(from, to) %>% paste(collapse = ',') - - } else if (!is.na(date)) { - 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 = endpoint) -} diff --git a/R/box_parse.R b/R/box_parse.R deleted file mode 100644 index a3c937e..0000000 --- a/R/box_parse.R +++ /dev/null @@ -1,40 +0,0 @@ -parse_senseboxdata = function (boxdata) { - # extract nested lists for later use & clean them from the list - # to allow a simple data.frame structure - sensors = boxdata$sensors - location = boxdata$loc - boxdata[c('loc', 'sensors', 'image', 'boxType')] <- NULL - 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')) - if (!is.null(thebox$updatedAt)) - thebox$updatedAt = as.POSIXct(strptime(thebox$updatedAt, format='%FT%T', tz = 'GMT')) - - # extract metadata from sensors - thebox$phenomena = list(unlist(lapply(sensors, function(s) { s$title }))) - # FIXME: if one sensor has NA, max() returns bullshit - thebox$lastMeasurement = max(lapply(sensors, function(s) { - if (!is.null(s$lastMeasurement)) - as.POSIXct(strptime(s$lastMeasurement$createdAt, format = '%FT%T', tz = 'GMT')) - else - NA - })[[1]]) - - # extract coordinates & transform to simple feature object - 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]] - - # attach a custom class for methods - class(thebox) = c('sensebox', class(thebox)) - thebox -} - -get_phenomena = function (x, ...) UseMethod('get_phenomena') -get_phenomena.default = function (x, ...) stop('not implemented') -get_phenomena.sensebox = function (x, ...) { - # FIXME: only returns first box for get_boxes! - x$phenomena[[1]] -} diff --git a/R/box_utils.R b/R/box_utils.R index a591f61..2b6f3a2 100644 --- a/R/box_utils.R +++ b/R/box_utils.R @@ -1,5 +1,3 @@ -`%>%` = magrittr::`%>%` - plot.sensebox = function (x, ...) { # TODO: background map (maps::world), graticule? geom = x %>% @@ -16,6 +14,7 @@ print.sensebox = function(x, ...) { important_columns = c('name', 'exposure', 'lastMeasurement', 'phenomena') data = as.data.frame(x) # to get rid of the sf::`<-[` override.. print(data[important_columns], ...) + invisible(x) } @@ -27,7 +26,7 @@ summary.sensebox = function(x, ...) { table(x$model) %>% print() cat('\n') - diffNow = (utc_time(Sys.time()) - x$lastMeasurement) %>% as.numeric(unit='hours') + diffNow = (utc_date(Sys.time()) - x$lastMeasurement) %>% as.numeric(unit='hours') neverActive = x[is.na(x$lastMeasurement), ] %>% nrow() list( 'last_measurement_within' = c( @@ -53,12 +52,3 @@ summary.sensebox = function(x, ...) { invisible(x) } - -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 count for each phenomenon - t() %>% # transform the table to a df - as.data.frame.matrix() -} diff --git a/R/counts.R b/R/counts.R new file mode 100644 index 0000000..6636b1f --- /dev/null +++ b/R/counts.R @@ -0,0 +1,16 @@ +# ============================================================================== +# +#' Get count statistics of the openSenseMap Instance +#' +#' Provides information on number of senseBoxes, measurements, and measurements per minute. +#' +#' @details Note that the API caches these values for 5 minutes. +#' +#' @param endpoint The URL of the openSenseMap API +#' @return A named \code{list} containing the counts +#' +#' @export +#' @seealso \href{https://docs.opensensemap.org/#api-Misc-getStatistics}{openSenseMap API documentation (web)} +osem_counts = function (endpoint = 'https://api.opensensemap.org') { + get_stats_(endpoint) +} diff --git a/R/counts_api.R b/R/counts_api.R deleted file mode 100644 index fc2e80d..0000000 --- a/R/counts_api.R +++ /dev/null @@ -1,3 +0,0 @@ -osem_counts = function (endpoint = 'https://api.opensensemap.org') { - get_stats_(endpoint) -} diff --git a/R/measurement_api.R b/R/measurement.R similarity index 55% rename from R/measurement_api.R rename to R/measurement.R index 249e192..b4d172f 100644 --- a/R/measurement_api.R +++ b/R/measurement.R @@ -6,6 +6,14 @@ #' bounding box filter. To get all measurements, the \code{default} function applies #' a bounding box spanning the whole world. #' +#' @param x Depending on the method, either +#' \enumerate{ +#' \item a \code{chr} specifying the phenomenon, see \code{phenomenon} +#' \item a \code{\link[sf]{st_bbox}} to select sensors spatially, +#' \item a \code{sensebox data.frame} to select boxes from which +#' measurements will be retrieved, +#' } +#' @param ... see parameters below #' @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 @@ -13,102 +21,79 @@ #' @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 +#' @return An \code{osem_measurements data.frame} containing the #' requested measurements #' #' @export -#' @family osem_measurements -#' @seealso \href{https://docs.opensensemap.org/#api-Measurements-getDataMulti}{openSenseMap API documentation} +#' @seealso \href{https://docs.opensensemap.org/#api-Measurements-getDataMulti}{openSenseMap API documentation (web)} +#' @seealso \code{\link{osem_boxes}} 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 -#' +#' @describeIn osem_measurements Get measurements from \strong{all} senseBoxes. #' @export -#' @family osem_measurements -#' @seealso \code{\link{osem_measurements.bbox}} -#' @seealso \href{https://docs.opensensemap.org/#api-Measurements-getDataMulti}{openSenseMap API documentation} -#' #' @examples +#' # get measurements from all boxes +#' \dontrun{ #' osem_measurements('PM2.5') -osem_measurements.default = function (phenomenon, ...) { +#' } +#' +osem_measurements.default = function (x, ...) { bbox = structure(c(-180, -90, 180, 90), class = 'bbox') - osem_measurements(bbox, phenomenon, ...) + osem_measurements(bbox, x, ...) } # ============================================================================== # -#' 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 -#' +#' @describeIn osem_measurements Get measurements by a spatial filter. #' @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') +#' # get measurements from sensors within a bounding box +#' bbox = structure(c(7, 51, 8, 52), class = 'bbox') +#' osem_measurements(bbox, 'Temperatur') #' +#' points = sf::st_multipoint(x = matrix(c(7,8,51,52),2,2)) +#' bbox2 = sf::st_bbox(points) +#' osem_measurements(bbox2, 'Temperatur', exposure = 'outdoor') #' -#' 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, +osem_measurements.bbox = function (x, phenomenon, exposure = NA, + from = NA, to = NA, columns = NA, + ..., endpoint = 'https://api.opensensemap.org') { + bbox = x query = parse_get_measurements_params(as.list(environment())) do.call(get_measurements_, query) } # ============================================================================== # -#' 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 -#' +#' @describeIn osem_measurements Get measurements from a set of senseBoxes. #' @export -#' @family osem_measurements -#' @seealso [osem_boxes()] -#' @seealso [osem_box()] -#' #' @examples -#' osem_boxes(grouptag = 'ifgi') %>% get_measurements(phenomenon = 'Temperatur') +#' # get measurements from a set of boxes +#' b = osem_boxes(grouptag = 'ifgi') +#' osem_measurements(b, phenomenon = 'Temperatur') #' +#' # ...or a single box #' b = osem_box('593bcd656ccf3b0011791f5a') -#' get_measurements(b, phenomenon = 'Temperatur') -osem_measurements.sensebox = function (boxes, phenomenon, exposure = NA, - from = NA, to = NA, - columns = NA, +#' osem_measurements(b, phenomenon = 'Temperatur') +#' +osem_measurements.sensebox = function (x, phenomenon, exposure = NA, + from = NA, to = NA, columns = NA, + ..., endpoint = 'https://api.opensensemap.org') { + boxes = x query = parse_get_measurements_params(as.list(environment())) do.call(get_measurements_, query) } # ============================================================================== # -#' Validates and parses the Parameters for \code{osem_measurements()} +#' Validates and parses the Parameters for use in \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)) diff --git a/R/measurement_utils.R b/R/measurement_utils.R index 5236d2b..33286b0 100644 --- a/R/measurement_utils.R +++ b/R/measurement_utils.R @@ -1,15 +1,3 @@ -#' 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, ...) diff --git a/R/opensensemap.R b/R/opensensemap.R new file mode 100644 index 0000000..7fa96aa --- /dev/null +++ b/R/opensensemap.R @@ -0,0 +1,29 @@ +#' opensensemap: Work with sensor data from opensensemap.org +#' +#' The opensensemap package provides three categories functions: +#' \enumerate{ +#' \item retrieval of senseBoxes +#' \item retrieval of measurements +#' \item general stats about the opensensemap database +#' } +#' +#' @section Retrieving senseBox metadata: +#' TODO +#' +#' @section Retrieving measurements: +#' TODO +#' +#' @section Retrieving statistics: +#' TODO +#' +#' @section Working with spatial data from openSenseMap: +#' TODO +#' +#' @docType package +#' @name opensensemap +'_PACKAGE' + +#' @importFrom graphics plot + +#' @importFrom magrittr %>% +`%>%` = magrittr::`%>%` diff --git a/R/phenomena.R b/R/phenomena.R new file mode 100644 index 0000000..182710c --- /dev/null +++ b/R/phenomena.R @@ -0,0 +1,35 @@ +# ============================================================================== +# +#' Get the counts of sensors for each observed phenomenon. +#' +#' @param boxes A \code{sensebox data.frame} of boxes +#' @return An \code{data.frame} containing the count of sensors observing a +#' phenomenon per column. +#' @export +osem_phenomena = function (boxes) UseMethod('osem_phenomena') + +# ============================================================================== +# +#' @describeIn osem_phenomena Get counts of sensors observing each phenomenon +#' from a set of senseBoxes. +#' @export +#' @seealso \code{\link{osem_boxes}} +#' @examples +#' # get the phenomena for a single senseBox +#' osem_phenomena(osem_box('593bcd656ccf3b0011791f5a')) +#' +#' # get the phenomena for a group of senseBoxes +#' osem_phenomena( +#' osem_boxes(grouptag = 'ifgi', exposure = 'outdoor', date = Sys.time()) +#' ) +#' +#' # get phenomena with at least 10 sensors on opensensemap +#' phenoms = osem_phenomena(osem_boxes()) +#' colnames(dplyr::select_if(phenoms, function(v) v > 9)) +#' +osem_phenomena.sensebox = function (boxes) { + Reduce(`c`, boxes$phenomena) %>% # get all the row contents in a single vector + table() %>% # get count for each phenomenon + t() %>% # transform the table to a df + as.data.frame.matrix() +}