add lintr config, make code lint compliant, fixes #20

measurements_archive
noerw 6 years ago
parent 6a95171bd3
commit 364f612216

@ -6,3 +6,4 @@
^appveyor\.yml$ ^appveyor\.yml$
^CONDUCT\.md$ ^CONDUCT\.md$
^codecov\.yml$ ^codecov\.yml$
^\.lintr$

@ -0,0 +1,14 @@
exclusions: list('inst/doc/osem-intro.R')
linters: with_defaults(
# we use snake case
camel_case_linter = NULL,
# '=' for assignment is fine :^)
assignment_linter = NULL,
# single quotes are fine
single_quotes_linter = NULL,
# nobody reads code on a vt100 anymore
line_length_linter(120),
# this one throws lots of false positives, dial down the noise
object_usage_linter = NULL,
NULL
)

@ -10,6 +10,7 @@ r:
r_github_packages: r_github_packages:
- r-lib/covr - r-lib/covr
- jimhester/lintr
before_install: before_install:
- sudo add-apt-repository ppa:ubuntugis/ubuntugis-unstable --yes - sudo add-apt-repository ppa:ubuntugis/ubuntugis-unstable --yes
@ -21,4 +22,4 @@ before_install:
after_success: after_success:
- Rscript -e 'covr::codecov()' - Rscript -e 'covr::codecov()'
#- Rscript -e 'lintr::lint_package()' - Rscript -e 'lintr::lint_package()'

@ -18,6 +18,7 @@ Suggests:
rmarkdown, rmarkdown,
lubridate, lubridate,
units, units,
lintr,
testthat, testthat,
covr covr
Authors@R: c(person("Norwin", "Roosen", role = c("aut", "cre"), email = "bugs@nroo.de"), Authors@R: c(person("Norwin", "Roosen", role = c("aut", "cre"), email = "bugs@nroo.de"),

@ -30,6 +30,6 @@ dplyr_class_wrapper = function(callback) {
#' #'
#' @noRd #' @noRd
is_non_interactive = function () { is_non_interactive = function () {
ff <- sapply(sys.calls(), function(f) as.character(f[1])) ff = sapply(sys.calls(), function(f) as.character(f[1]))
any(ff %in% c("knit2html", "render")) || !interactive() any(ff %in% c('knit2html', 'render')) || !interactive()
} }

@ -24,7 +24,7 @@ get_boxes_ = function (..., endpoint) {
df = dplyr::bind_rows(boxesList) df = dplyr::bind_rows(boxesList)
df$exposure = df$exposure %>% as.factor() df$exposure = df$exposure %>% as.factor()
df$model = df$model %>% as.factor() df$model = df$model %>% as.factor()
if(!is.null(df$grouptag)) if (!is.null(df$grouptag))
df$grouptag = df$grouptag %>% as.factor() df$grouptag = df$grouptag %>% as.factor()
df df
} }

@ -105,23 +105,25 @@ parse_senseboxdata = function (boxdata) {
# to allow a simple data.frame structure # to allow a simple data.frame structure
sensors = boxdata$sensors sensors = boxdata$sensors
location = boxdata$currentLocation location = boxdata$currentLocation
boxdata[c('loc', 'locations', 'currentLocation', 'sensors', 'image', 'boxType')] <- NULL boxdata[c('loc', 'locations', 'currentLocation', 'sensors', 'image', 'boxType')] = NULL
thebox = as.data.frame(boxdata, stringsAsFactors = F) thebox = as.data.frame(boxdata, stringsAsFactors = F)
# parse timestamps (updatedAt might be not defined) # parse timestamps (updatedAt might be not defined)
thebox$createdAt = as.POSIXct(strptime(thebox$createdAt, format='%FT%T', tz = 'GMT')) thebox$createdAt = as.POSIXct(strptime(thebox$createdAt, format = '%FT%T', tz = 'GMT'))
if (!is.null(thebox$updatedAt)) if (!is.null(thebox$updatedAt))
thebox$updatedAt = as.POSIXct(strptime(thebox$updatedAt, format='%FT%T', tz = 'GMT')) thebox$updatedAt = as.POSIXct(strptime(thebox$updatedAt, format = '%FT%T', tz = 'GMT'))
# extract metadata from sensors # extract metadata from sensors
thebox$phenomena = list(unlist(lapply(sensors, function(s) { s$title }))) thebox$phenomena = lapply(sensors, function(s) s$title) %>% unlist %>% list
# FIXME: if one sensor has NA, max() returns bullshit # FIXME: if one sensor has NA, max() returns bullshit
thebox$lastMeasurement = max(lapply(sensors, function(s) { get_last_measurement = function(s) {
if (!is.null(s$lastMeasurement)) if (!is.null(s$lastMeasurement))
as.POSIXct(strptime(s$lastMeasurement$createdAt, format = '%FT%T', tz = 'GMT')) as.POSIXct(strptime(s$lastMeasurement$createdAt, format = '%FT%T', tz = 'GMT'))
else else
NA NA
})[[1]]) }
thebox$lastMeasurement = max(lapply(sensors, get_last_measurement)[[1]])
# extract coordinates & transform to simple feature object # extract coordinates & transform to simple feature object
thebox$lon = location$coordinates[[1]] thebox$lon = location$coordinates[[1]]

@ -1,12 +1,13 @@
#' @export #' @export
plot.sensebox = function (x, ..., mar = c(2,2,1,1)) { plot.sensebox = function (x, ..., mar = c(2, 2, 1, 1)) {
if ( if (
!requireNamespace("sf", quietly = TRUE) || !requireNamespace('sf', quietly = TRUE) ||
!requireNamespace("maps", quietly = TRUE) || !requireNamespace('maps', quietly = TRUE) ||
!requireNamespace("maptools", quietly = TRUE) || !requireNamespace('maptools', quietly = TRUE) ||
!requireNamespace("rgeos", quietly = TRUE) !requireNamespace('rgeos', quietly = TRUE)
) { ) {
stop('this functions requires additional packages. install them with\n install.packages(c("sf", "maps", "maptools", "rgeos"))') stop('this functions requires additional packages. install them with
install.packages(c("sf", "maps", "maptools", "rgeos"))')
} }
geom = x %>% geom = x %>%
@ -21,7 +22,7 @@ plot.sensebox = function (x, ..., mar = c(2,2,1,1)) {
oldpar = par() oldpar = par()
par(mar = mar) par(mar = mar)
plot(world, col = 'gray', xlim = bbox[c(1,3)], ylim = bbox[c(2,4)], axes = T) plot(world, col = 'gray', xlim = bbox[c(1, 3)], ylim = bbox[c(2, 4)], axes = T)
plot(geom, add = T, col = x$exposure) plot(geom, add = T, col = x$exposure)
legend('left', legend = levels(x$exposure), col = 1:length(x$exposure), pch = 1) legend('left', legend = levels(x$exposure), col = 1:length(x$exposure), pch = 1)
par(mar = oldpar$mar) par(mar = oldpar$mar)
@ -48,7 +49,7 @@ summary.sensebox = function(object, ...) {
table(object$model) %>% print() table(object$model) %>% print()
cat('\n') cat('\n')
diffNow = (utc_date(Sys.time()) - object$lastMeasurement) %>% as.numeric(unit='hours') diffNow = (utc_date(Sys.time()) - object$lastMeasurement) %>% as.numeric(unit = 'hours')
list( list(
'last_measurement_within' = c( 'last_measurement_within' = c(
'1h' = nrow(dplyr::filter(object, diffNow <= 1)), '1h' = nrow(dplyr::filter(object, diffNow <= 1)),
@ -122,4 +123,3 @@ mutate.sensebox = dplyr_class_wrapper(osem_as_sensebox)
st_as_sf.sensebox = function (x, ...) { st_as_sf.sensebox = function (x, ...) {
NextMethod(x, ..., coords = c('lon', 'lat'), crs = 4326) NextMethod(x, ..., coords = c('lon', 'lat'), crs = 4326)
} }

@ -170,6 +170,6 @@ paged_measurements_req = function (query) {
dplyr::bind_rows() dplyr::bind_rows()
# coerce all character columns (sensorId, unit, ...) to factors AFTER binding # coerce all character columns (sensorId, unit, ...) to factors AFTER binding
df[sapply(df, is.character)] <- lapply(df[sapply(df, is.character)], as.factor) df[sapply(df, is.character)] = lapply(df[sapply(df, is.character)], as.factor)
df df
} }

@ -1,5 +1,5 @@
#' @export #' @export
plot.osem_measurements = function (x, ..., mar = c(2,4,1,1)) { plot.osem_measurements = function (x, ..., mar = c(2, 4, 1, 1)) {
oldpar = par() oldpar = par()
par(mar = mar) par(mar = mar)
plot(value~createdAt, x, col = factor(x$sensorId), xlab = NA, ylab = x$unit[1], ...) plot(value~createdAt, x, col = factor(x$sensorId), xlab = NA, ylab = x$unit[1], ...)

@ -77,6 +77,8 @@
'_PACKAGE' '_PACKAGE'
#' @importFrom graphics plot legend par #' @importFrom graphics plot legend par
#' @importFrom magrittr %>% #' @importFrom magrittr %>%
`%>%` = magrittr::`%>%` `%>%` = magrittr::`%>%`
# just to make R CMD check happy, due to NSE (dplyr) functions
globalVariables(c('lastMeasurement'))

@ -70,4 +70,3 @@ st_as_sf(pm25) %>% st_geometry() %>% plot(col = factor(pm25$invalid), axes = T)
## ------------------------------------------------------------------------ ## ------------------------------------------------------------------------
pm25 %>% filter(invalid == FALSE) %>% plot() pm25 %>% filter(invalid == FALSE) %>% plot()

@ -1,5 +1,5 @@
library("testthat") library('testthat')
library("opensensmapr") library('opensensmapr')
library("sf") library('sf')
test_check("opensensmapr") test_check('opensensmapr')

@ -0,0 +1,8 @@
if (requireNamespace('lintr', quietly = TRUE)) {
context('lints')
test_that('Package Style', {
skip_on_cran()
lintr::expect_lint_free()
})
}

@ -1,30 +1,23 @@
context("box") source('testhelpers.R')
context('box')
check_api <- function() {
skip_on_cran()
code <- NA
try(code <- httr::status_code(httr::GET(osem_endpoint())))
if (is.na(code)) skip("API not available")
}
try({ try({
boxes <- osem_boxes() boxes = osem_boxes()
}) })
test_that("a single box can be retrieved by ID", { test_that('a single box can be retrieved by ID', {
check_api() check_api()
box <- osem_box(boxes$X_id[[1]]) box = osem_box(boxes$X_id[[1]])
expect_true("sensebox" %in% class(box)) expect_true('sensebox' %in% class(box))
expect_true("data.frame" %in% class(box)) expect_true('data.frame' %in% class(box))
expect_true(nrow(box) == 1) expect_true(nrow(box) == 1)
expect_true(box$X_id == boxes$X_id[[1]]) expect_true(box$X_id == boxes$X_id[[1]])
}) })
test_that("[.sensebox maintains attributes", { test_that('[.sensebox maintains attributes', {
check_api() check_api()
expect_true(all(attributes(boxes[1:nrow(boxes), ]) %in% attributes(boxes))) expect_true(all(attributes(boxes[1:nrow(boxes), ]) %in% attributes(boxes)))

@ -1,112 +1,108 @@
context("boxes") source('testhelpers.R')
context('boxes')
check_api <- function() { test_that('a list of all boxes can be retrieved and returns a sensebox data.frame', {
skip_on_cran()
code <- NA
try(code <- httr::status_code(httr::GET(osem_endpoint())))
if (is.na(code)) skip("API not available")
}
test_that("a list of all boxes can be retrieved and returns a sensebox data.frame", {
check_api() check_api()
boxes <- osem_boxes() boxes = osem_boxes()
expect_true(is.data.frame(boxes)) expect_true(is.data.frame(boxes))
expect_true(is.factor(boxes$model)) expect_true(is.factor(boxes$model))
expect_true(is.character(boxes$name)) expect_true(is.character(boxes$name))
expect_length(names(boxes), 14) expect_length(names(boxes), 14)
expect_true(any("sensebox" %in% class(boxes))) expect_true(any('sensebox' %in% class(boxes)))
}) })
test_that("both from and to are required when requesting boxes, error otherwise", { test_that('both from and to are required when requesting boxes, error otherwise', {
expect_error(osem_boxes(from = as.POSIXct("2017-01-01")), "must be used together") expect_error(osem_boxes(from = as.POSIXct('2017-01-01')), 'must be used together')
expect_error(osem_boxes(to = as.POSIXct("2017-01-01")), "must be used together") expect_error(osem_boxes(to = as.POSIXct('2017-01-01')), 'must be used together')
}) })
test_that("a list of boxes with exposure filter returns only the requested exposure", { test_that('a list of boxes with exposure filter returns only the requested exposure', {
check_api() check_api()
boxes <- osem_boxes(exposure = "mobile") boxes = osem_boxes(exposure = 'mobile')
expect_true(all(boxes$exposure == "mobile")) expect_true(all(boxes$exposure == 'mobile'))
}) })
test_that("a list of boxes with model filter returns only the requested model", { test_that('a list of boxes with model filter returns only the requested model', {
check_api() check_api()
boxes <- osem_boxes(model = "homeWifi") boxes = osem_boxes(model = 'homeWifi')
expect_true(all(boxes$model == "homeWifi")) expect_true(all(boxes$model == 'homeWifi'))
}) })
test_that("box query can combine exposure and model filter", { test_that('box query can combine exposure and model filter', {
check_api() check_api()
boxes <- osem_boxes(exposure = "mobile", model = "homeWifi") boxes = osem_boxes(exposure = 'mobile', model = 'homeWifi')
expect_true(all(boxes$model == "homeWifi")) expect_true(all(boxes$model == 'homeWifi'))
expect_true(all(boxes$exposure == "mobile")) expect_true(all(boxes$exposure == 'mobile'))
}) })
test_that("a list of boxes with grouptype returns only boxes of that group", { test_that('a list of boxes with grouptype returns only boxes of that group', {
check_api() check_api()
boxes <- osem_boxes(grouptag = "codeformuenster") boxes = osem_boxes(grouptag = 'codeformuenster')
expect_true(all(boxes$grouptag == "codeformuenster")) expect_true(all(boxes$grouptag == 'codeformuenster'))
}) })
test_that("endpoint can be (mis)configured", { test_that('endpoint can be (mis)configured', {
check_api() check_api()
expect_error(osem_boxes(endpoint = "http://not.the.opensensemap.org"), "resolve host") expect_error(osem_boxes(endpoint = 'http://not.the.opensensemap.org'), 'resolve host')
}) })
test_that("a response with no matches returns empty sensebox data.frame and a warning", { test_that('a response with no matches returns empty sensebox data.frame', {
check_api() check_api()
suppressWarnings(boxes <- osem_boxes(grouptag = "does_not_exist")) suppressWarnings({
boxes = osem_boxes(grouptag = 'does_not_exist')
})
expect_true(is.data.frame(boxes)) expect_true(is.data.frame(boxes))
expect_true(any("sensebox" %in% class(boxes))) expect_true(any('sensebox' %in% class(boxes)))
}) })
test_that("a response with no matches gives a warning", { test_that('a response with no matches gives a warning', {
check_api() check_api()
expect_warning(osem_boxes(grouptag = "does_not_exist"), "no senseBoxes found") expect_warning(osem_boxes(grouptag = 'does_not_exist'), 'no senseBoxes found')
}) })
test_that("data.frame can be converted to sensebox data.frame", { test_that('data.frame can be converted to sensebox data.frame', {
df <- osem_as_sensebox(data.frame(c(1,2), c("a", "b"))) df = osem_as_sensebox(data.frame(c(1, 2), c('a', 'b')))
expect_equal(class(df), c("sensebox", "data.frame")) expect_equal(class(df), c('sensebox', 'data.frame'))
}) })
test_that("boxes can be converted to sf object", { test_that('boxes can be converted to sf object', {
check_api() check_api()
boxes <- osem_boxes() boxes = osem_boxes()
boxes_sf <- sf::st_as_sf(boxes) boxes_sf = sf::st_as_sf(boxes)
expect_true(all(sf::st_is_simple(boxes_sf))) expect_true(all(sf::st_is_simple(boxes_sf)))
expect_true("sf" %in% class(boxes_sf)) expect_true('sf' %in% class(boxes_sf))
}) })
test_that("boxes converted to sf object keep all attributes", { test_that('boxes converted to sf object keep all attributes', {
check_api() check_api()
boxes <- osem_boxes() boxes = osem_boxes()
boxes_sf <- sf::st_as_sf(boxes) boxes_sf = sf::st_as_sf(boxes)
# coord columns get removed! # coord columns get removed!
cols <- names(boxes)[!names(boxes) %in% c('lon', 'lat')] cols = names(boxes)[!names(boxes) %in% c('lon', 'lat')]
expect_true(all(cols %in% names(boxes_sf))) expect_true(all(cols %in% names(boxes_sf)))
expect_true("sensebox" %in% class(boxes_sf)) expect_true('sensebox' %in% class(boxes_sf))
}) })
test_that("box retrieval does not give progress information in non-interactive mode", { test_that('box retrieval does not give progress information in non-interactive mode', {
check_api() check_api()
if (!opensensmapr:::is_non_interactive()) skip("interactive session") if (!opensensmapr:::is_non_interactive()) skip('interactive session')
out <- capture.output(b <- osem_boxes()) out = capture.output({
b = osem_boxes()
})
expect_length(out, 0) expect_length(out, 0)
}) })

@ -1,17 +1,10 @@
context("counts") source('testhelpers.R')
context('counts')
check_api <- function() { test_that('counts can be retrieved as a list of numbers', {
skip_on_cran()
code <- NA
try(code <- httr::status_code(httr::GET(osem_endpoint())))
if (is.na(code)) skip("API not available")
}
test_that("counts can be retrieved as a list of numbers", {
check_api() check_api()
counts <- osem_counts() counts = osem_counts()
expect_true(is.list(counts)) expect_true(is.list(counts))
expect_true(is.numeric(unlist(counts))) expect_true(is.numeric(unlist(counts)))

@ -1,121 +1,116 @@
context("measurements") source('testhelpers.R')
context('measurements')
check_api <- function() {
skip_on_cran()
code <- NA
try(code <- httr::status_code(httr::GET(osem_endpoint())))
if (is.na(code)) skip("API not available")
}
try({ try({
boxes <- osem_boxes() boxes = osem_boxes()
}) })
test_that("measurements can be retrieved for a phenomenon", { test_that('measurements can be retrieved for a phenomenon', {
check_api() check_api()
measurements <- osem_measurements(x = "Windgeschwindigkeit") measurements = osem_measurements(x = 'Windgeschwindigkeit')
expect_true(is.data.frame(measurements)) expect_true(is.data.frame(measurements))
expect_true("osem_measurements" %in% class(measurements)) expect_true('osem_measurements' %in% class(measurements))
}) })
test_that("measurement retrieval does not give progress information in non-interactive mode", { test_that('measurement retrieval does not give progress information in non-interactive mode', {
check_api() check_api()
if (!opensensmapr:::is_non_interactive()) skip("interactive session") if (!opensensmapr:::is_non_interactive()) skip('interactive session')
out <- capture.output(measurements <- osem_measurements(x = "Licht")) out = capture.output({
measurements = osem_measurements(x = 'Licht')
})
expect_length(out, 0) expect_length(out, 0)
}) })
test_that("a response with no matching senseBoxes gives an error", { test_that('a response with no matching senseBoxes gives an error', {
check_api() check_api()
expect_error(osem_measurements(x = "Windgeschwindigkeit", exposure = "indoor"), "No senseBoxes found") expect_error(osem_measurements(x = 'Windgeschwindigkeit', exposure = 'indoor'), 'No senseBoxes found')
}) })
test_that("data.frame can be converted to measurements data.frame", { test_that('data.frame can be converted to measurements data.frame', {
df <- osem_as_measurements(data.frame(c(1,2), c("a", "b"))) df = osem_as_measurements(data.frame(c(1, 2), c('a', 'b')))
expect_equal(class(df), c("osem_measurements", "data.frame")) expect_equal(class(df), c('osem_measurements', 'data.frame'))
}) })
test_that("columns can be specified for phenomena", { test_that('columns can be specified for phenomena', {
check_api() check_api()
cols <- c("value", "boxId", "boxName") cols = c('value', 'boxId', 'boxName')
measurements <- osem_measurements(x = "Windgeschwindigkeit", columns = cols) measurements = osem_measurements(x = 'Windgeschwindigkeit', columns = cols)
expect_equal(names(measurements), cols) expect_equal(names(measurements), cols)
}) })
test_that("measurements can be retrieved for a phenomenon and exposure", { test_that('measurements can be retrieved for a phenomenon and exposure', {
check_api() check_api()
measurements <- osem_measurements(x = "Temperatur", exposure = "unknown", measurements = osem_measurements(x = 'Temperatur', exposure = 'unknown',
columns = c("value", "boxId", "boxName")) columns = c('value', 'boxId', 'boxName'))
expect_equal(nrow(measurements), 0) expect_equal(nrow(measurements), 0)
}) })
test_that("measurements of specific boxes can be retrieved for one phenomenon and returns a measurements data.frame", { test_that('measurements of specific boxes can be retrieved for one phenomenon and returns a measurements data.frame', {
check_api() check_api()
# fix for subsetting # fix for subsetting
class(boxes) <- c("data.frame") class(boxes) = c('data.frame')
three_boxes <- boxes[1:3,] three_boxes = boxes[1:3, ]
class(boxes) <- c("sensebox", "data.frame") class(boxes) = c('sensebox', 'data.frame')
three_boxes <- osem_as_sensebox(three_boxes) three_boxes = osem_as_sensebox(three_boxes)
phens <- names(osem_phenomena(three_boxes)) phens = names(osem_phenomena(three_boxes))
measurements <- osem_measurements(x = three_boxes, phenomenon = phens[[1]]) measurements = osem_measurements(x = three_boxes, phenomenon = phens[[1]])
expect_true(is.data.frame(measurements)) expect_true(is.data.frame(measurements))
expect_true("osem_measurements" %in% class(measurements)) expect_true('osem_measurements' %in% class(measurements))
}) })
test_that("measurements can be retrieved for a bounding box", { test_that('measurements can be retrieved for a bounding box', {
check_api() check_api()
sfc <- sf::st_sfc(sf::st_linestring(x = matrix(data = c(7, 8, 50, 51), ncol = 2)), crs = 4326) sfc = sf::st_sfc(sf::st_linestring(x = matrix(data = c(7, 8, 50, 51), ncol = 2)), crs = 4326)
bbox <- sf::st_bbox(sfc) bbox = sf::st_bbox(sfc)
measurements <- osem_measurements(x = bbox, phenomenon = "Windrichtung") measurements = osem_measurements(x = bbox, phenomenon = 'Windrichtung')
expect_true(all(unique(measurements$lat) > 50)) expect_true(all(unique(measurements$lat) > 50))
expect_true(all(unique(measurements$lat) < 51)) expect_true(all(unique(measurements$lat) < 51))
expect_true(all(unique(measurements$lon) < 8)) expect_true(all(unique(measurements$lon) < 8))
expect_true(all(unique(measurements$lon) > 7)) expect_true(all(unique(measurements$lon) > 7))
}) })
test_that("measurements can be retrieved for a time period", { test_that('measurements can be retrieved for a time period', {
check_api() check_api()
from_date <- as.POSIXct("2018-01-01 12:00:00") from_date = as.POSIXct('2018-01-01 12:00:00')
to_date <- as.POSIXct("2018-01-01 13:00:00") to_date = as.POSIXct('2018-01-01 13:00:00')
measurements <- osem_measurements(x = "Temperature", from = from_date, to = to_date) measurements = osem_measurements(x = 'Temperature', from = from_date, to = to_date)
expect_true(all(measurements$createdAt < to_date)) expect_true(all(measurements$createdAt < to_date))
expect_true(all(measurements$createdAt > from_date)) expect_true(all(measurements$createdAt > from_date))
}) })
test_that("measurements can be retrieved for a time period > 31 days", { test_that('measurements can be retrieved for a time period > 31 days', {
check_api() check_api()
from_date <- as.POSIXct("2017-11-01 12:00:00") from_date = as.POSIXct('2017-11-01 12:00:00')
to_date <- as.POSIXct("2018-01-01 13:00:00") to_date = as.POSIXct('2018-01-01 13:00:00')
measurements <- osem_measurements(x = "Windrichtung", from = from_date, to = to_date) measurements = osem_measurements(x = 'Windrichtung', from = from_date, to = to_date)
expect_true(all(measurements$createdAt < to_date)) expect_true(all(measurements$createdAt < to_date))
expect_true(all(measurements$createdAt > from_date)) expect_true(all(measurements$createdAt > from_date))
}) })
test_that("both from and to are required when requesting measurements, error otherwise", { test_that('both from and to are required when requesting measurements, error otherwise', {
expect_error(osem_measurements(x = "Temperature", from = as.POSIXct("2017-01-01")), "only together with") expect_error(osem_measurements(x = 'Temperature', from = as.POSIXct('2017-01-01')), 'only together with')
expect_error(osem_measurements(x = "Temperature", to = as.POSIXct("2017-01-01")), "only together with") expect_error(osem_measurements(x = 'Temperature', to = as.POSIXct('2017-01-01')), 'only together with')
}) })
test_that("[.osem_measurements maintains attributes", { test_that('[.osem_measurements maintains attributes', {
check_api() check_api()
sfc <- sf::st_sfc(sf::st_linestring(x = matrix(data = c(7, 8, 50, 51), ncol = 2)), crs = 4326) sfc = sf::st_sfc(sf::st_linestring(x = matrix(data = c(7, 8, 50, 51), ncol = 2)), crs = 4326)
bbox <- sf::st_bbox(sfc) bbox = sf::st_bbox(sfc)
m <- osem_measurements(x = bbox, phenomenon = "Windrichtung") m = osem_measurements(x = bbox, phenomenon = 'Windrichtung')
expect_true(all(attributes(m[1:nrow(m), ]) %in% attributes(m))) expect_true(all(attributes(m[1:nrow(m), ]) %in% attributes(m)))
}) })

@ -1,40 +1,33 @@
context("phenomena") source('testhelpers.R')
context('phenomena')
check_api <- function() {
skip_on_cran()
code <- NA
try(code <- httr::status_code(httr::GET(osem_endpoint())))
if (is.na(code)) skip("API not available")
}
try({ try({
boxes <- osem_boxes() boxes = osem_boxes()
all_phen <- unique(unlist(boxes$phenomena)) all_phen = unique(unlist(boxes$phenomena))
}) })
test_that("phenomena from boxes is a list of counts", { test_that('phenomena from boxes is a list of counts', {
check_api() check_api()
phenomena <- osem_phenomena(boxes) phenomena = osem_phenomena(boxes)
expect_true(is.numeric(unlist(phenomena))) expect_true(is.numeric(unlist(phenomena)))
expect_true(is.list(phenomena)) expect_true(is.list(phenomena))
}) })
test_that("phenomena from boxes has all phenomena", { test_that('phenomena from boxes has all phenomena', {
check_api() check_api()
phenomena <- osem_phenomena(boxes) phenomena = osem_phenomena(boxes)
expect_true(all(all_phen %in% names(phenomena))) expect_true(all(all_phen %in% names(phenomena)))
expect_true(all(names(phenomena) %in% all_phen)) expect_true(all(names(phenomena) %in% all_phen))
}) })
test_that("phenomena from a not sensebox data.frame returns error", { test_that('phenomena from a not sensebox data.frame returns error', {
expect_error(osem_phenomena(list()), "no applicable method") expect_error(osem_phenomena(list()), 'no applicable method')
expect_error(osem_phenomena(data.frame()), "no applicable method") expect_error(osem_phenomena(data.frame()), 'no applicable method')
boxes_df <- boxes boxes_df = boxes
class(boxes_df) <- c("data.frame") class(boxes_df) = c('data.frame')
expect_error(osem_phenomena(boxes_df), "no applicable method") expect_error(osem_phenomena(boxes_df), 'no applicable method')
}) })

@ -0,0 +1,9 @@
check_api = function() {
skip_on_cran()
code = NA
try({
code = httr::status_code(httr::GET(osem_endpoint()))
})
if (is.na(code)) skip('API not available')
}
Loading…
Cancel
Save