mirror of
https://github.com/sensebox/opensensmapr
synced 2025-03-11 03:30:27 +01:00
dont make boxes an sf object, remove lubridate dependency
also start adding documentation
This commit is contained in:
parent
bd0d8b403d
commit
a2d71ac3e8
8 changed files with 180 additions and 61 deletions
|
@ -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
|
||||
|
|
25
R/api.R
25
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) {
|
||||
|
|
|
@ -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)
|
||||
}
|
||||
|
|
10
R/box_api.R
10
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)
|
||||
}
|
||||
|
|
|
@ -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 = ',')
|
||||
|
||||
|
|
17
R/measurement_utils.R
Normal file
17
R/measurement_utils.R
Normal file
|
@ -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…
Add table
Reference in a new issue