dont make boxes an sf object, remove lubridate dependency

also start adding documentation
pull/17/head
noerw 7 years ago
parent bd0d8b403d
commit a2d71ac3e8

@ -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

@ -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) {

@ -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)
}

@ -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)
}

@ -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

@ -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()
}

@ -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 = ',')

@ -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)
}
Loading…
Cancel
Save