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

measurements_archive
noerw 6 年前
父节点 6a95171bd3
当前提交 364f612216

@ -6,3 +6,4 @@
^appveyor\.yml$
^CONDUCT\.md$
^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-lib/covr
- jimhester/lintr
before_install:
- sudo add-apt-repository ppa:ubuntugis/ubuntugis-unstable --yes
@ -21,4 +22,4 @@ before_install:
after_success:
- Rscript -e 'covr::codecov()'
#- Rscript -e 'lintr::lint_package()'
- Rscript -e 'lintr::lint_package()'

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

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

@ -24,7 +24,7 @@ get_boxes_ = function (..., endpoint) {
df = dplyr::bind_rows(boxesList)
df$exposure = df$exposure %>% 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
}

@ -105,23 +105,25 @@ parse_senseboxdata = function (boxdata) {
# to allow a simple data.frame structure
sensors = boxdata$sensors
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)
# 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))
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
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
thebox$lastMeasurement = max(lapply(sensors, function(s) {
get_last_measurement = function(s) {
if (!is.null(s$lastMeasurement))
as.POSIXct(strptime(s$lastMeasurement$createdAt, format = '%FT%T', tz = 'GMT'))
else
NA
})[[1]])
}
thebox$lastMeasurement = max(lapply(sensors, get_last_measurement)[[1]])
# extract coordinates & transform to simple feature object
thebox$lon = location$coordinates[[1]]

@ -1,12 +1,13 @@
#' @export
plot.sensebox = function (x, ..., mar = c(2,2,1,1)) {
plot.sensebox = function (x, ..., mar = c(2, 2, 1, 1)) {
if (
!requireNamespace("sf", quietly = TRUE) ||
!requireNamespace("maps", quietly = TRUE) ||
!requireNamespace("maptools", quietly = TRUE) ||
!requireNamespace("rgeos", quietly = TRUE)
!requireNamespace('sf', quietly = TRUE) ||
!requireNamespace('maps', quietly = TRUE) ||
!requireNamespace('maptools', 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 %>%
@ -21,7 +22,7 @@ plot.sensebox = function (x, ..., mar = c(2,2,1,1)) {
oldpar = par()
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)
legend('left', legend = levels(x$exposure), col = 1:length(x$exposure), pch = 1)
par(mar = oldpar$mar)
@ -48,7 +49,7 @@ summary.sensebox = function(object, ...) {
table(object$model) %>% print()
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(
'last_measurement_within' = c(
'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, ...) {
NextMethod(x, ..., coords = c('lon', 'lat'), crs = 4326)
}

@ -170,6 +170,6 @@ paged_measurements_req = function (query) {
dplyr::bind_rows()
# 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
}

@ -1,5 +1,5 @@
#' @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()
par(mar = mar)
plot(value~createdAt, x, col = factor(x$sensorId), xlab = NA, ylab = x$unit[1], ...)

@ -77,6 +77,8 @@
'_PACKAGE'
#' @importFrom graphics plot legend par
#' @importFrom 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()

@ -1,5 +1,5 @@
library("testthat")
library("opensensmapr")
library("sf")
library('testthat')
library('opensensmapr')
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")
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")
}
source('testhelpers.R')
context('box')
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()
box <- osem_box(boxes$X_id[[1]])
box = osem_box(boxes$X_id[[1]])
expect_true("sensebox" %in% class(box))
expect_true("data.frame" %in% class(box))
expect_true('sensebox' %in% class(box))
expect_true('data.frame' %in% class(box))
expect_true(nrow(box) == 1)
expect_true(box$X_id == boxes$X_id[[1]])
})
test_that("[.sensebox maintains attributes", {
test_that('[.sensebox maintains attributes', {
check_api()
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() {
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", {
test_that('a list of all boxes can be retrieved and returns a sensebox data.frame', {
check_api()
boxes <- osem_boxes()
boxes = osem_boxes()
expect_true(is.data.frame(boxes))
expect_true(is.factor(boxes$model))
expect_true(is.character(boxes$name))
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", {
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")
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(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()
boxes <- osem_boxes(exposure = "mobile")
expect_true(all(boxes$exposure == "mobile"))
boxes = osem_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()
boxes <- osem_boxes(model = "homeWifi")
expect_true(all(boxes$model == "homeWifi"))
boxes = osem_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()
boxes <- osem_boxes(exposure = "mobile", model = "homeWifi")
expect_true(all(boxes$model == "homeWifi"))
expect_true(all(boxes$exposure == "mobile"))
boxes = osem_boxes(exposure = 'mobile', model = 'homeWifi')
expect_true(all(boxes$model == 'homeWifi'))
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()
boxes <- osem_boxes(grouptag = "codeformuenster")
expect_true(all(boxes$grouptag == "codeformuenster"))
boxes = osem_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()
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()
suppressWarnings(boxes <- osem_boxes(grouptag = "does_not_exist"))
suppressWarnings({
boxes = osem_boxes(grouptag = 'does_not_exist')
})
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()
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", {
df <- osem_as_sensebox(data.frame(c(1,2), c("a", "b")))
expect_equal(class(df), c("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')))
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()
boxes <- osem_boxes()
boxes_sf <- sf::st_as_sf(boxes)
boxes = osem_boxes()
boxes_sf = sf::st_as_sf(boxes)
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()
boxes <- osem_boxes()
boxes_sf <- sf::st_as_sf(boxes)
boxes = osem_boxes()
boxes_sf = sf::st_as_sf(boxes)
# 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("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()
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)
})

@ -1,17 +1,10 @@
context("counts")
source('testhelpers.R')
context('counts')
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")
}
test_that("counts can be retrieved as a list of numbers", {
test_that('counts can be retrieved as a list of numbers', {
check_api()
counts <- osem_counts()
counts = osem_counts()
expect_true(is.list(counts))
expect_true(is.numeric(unlist(counts)))

@ -1,121 +1,116 @@
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")
}
source('testhelpers.R')
context('measurements')
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()
measurements <- osem_measurements(x = "Windgeschwindigkeit")
measurements = osem_measurements(x = 'Windgeschwindigkeit')
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()
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)
})
test_that("a response with no matching senseBoxes gives an error", {
test_that('a response with no matching senseBoxes gives an error', {
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", {
df <- osem_as_measurements(data.frame(c(1,2), c("a", "b")))
expect_equal(class(df), c("osem_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')))
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()
cols <- c("value", "boxId", "boxName")
measurements <- osem_measurements(x = "Windgeschwindigkeit", columns = cols)
cols = c('value', 'boxId', 'boxName')
measurements = osem_measurements(x = 'Windgeschwindigkeit', columns = 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()
measurements <- osem_measurements(x = "Temperatur", exposure = "unknown",
columns = c("value", "boxId", "boxName"))
measurements = osem_measurements(x = 'Temperatur', exposure = 'unknown',
columns = c('value', 'boxId', 'boxName'))
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()
# fix for subsetting
class(boxes) <- c("data.frame")
three_boxes <- boxes[1:3,]
class(boxes) <- c("sensebox", "data.frame")
three_boxes <- osem_as_sensebox(three_boxes)
phens <- names(osem_phenomena(three_boxes))
class(boxes) = c('data.frame')
three_boxes = boxes[1:3, ]
class(boxes) = c('sensebox', 'data.frame')
three_boxes = osem_as_sensebox(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("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()
sfc <- sf::st_sfc(sf::st_linestring(x = matrix(data = c(7, 8, 50, 51), ncol = 2)), crs = 4326)
bbox <- sf::st_bbox(sfc)
measurements <- osem_measurements(x = bbox, phenomenon = "Windrichtung")
sfc = sf::st_sfc(sf::st_linestring(x = matrix(data = c(7, 8, 50, 51), ncol = 2)), crs = 4326)
bbox = sf::st_bbox(sfc)
measurements = osem_measurements(x = bbox, phenomenon = 'Windrichtung')
expect_true(all(unique(measurements$lat) > 50))
expect_true(all(unique(measurements$lat) < 51))
expect_true(all(unique(measurements$lon) < 8))
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()
from_date <- as.POSIXct("2018-01-01 12:00:00")
to_date <- as.POSIXct("2018-01-01 13:00:00")
measurements <- osem_measurements(x = "Temperature", from = from_date, to = to_date)
from_date = as.POSIXct('2018-01-01 12:00:00')
to_date = as.POSIXct('2018-01-01 13:00:00')
measurements = osem_measurements(x = 'Temperature', from = from_date, to = to_date)
expect_true(all(measurements$createdAt < to_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()
from_date <- as.POSIXct("2017-11-01 12:00:00")
to_date <- as.POSIXct("2018-01-01 13:00:00")
measurements <- osem_measurements(x = "Windrichtung", from = from_date, to = to_date)
from_date = as.POSIXct('2017-11-01 12:00:00')
to_date = as.POSIXct('2018-01-01 13:00:00')
measurements = osem_measurements(x = 'Windrichtung', from = from_date, to = to_date)
expect_true(all(measurements$createdAt < to_date))
expect_true(all(measurements$createdAt > from_date))
})
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", to = as.POSIXct("2017-01-01")), "only together with")
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', to = as.POSIXct('2017-01-01')), 'only together with')
})
test_that("[.osem_measurements maintains attributes", {
test_that('[.osem_measurements maintains attributes', {
check_api()
sfc <- sf::st_sfc(sf::st_linestring(x = matrix(data = c(7, 8, 50, 51), ncol = 2)), crs = 4326)
bbox <- sf::st_bbox(sfc)
m <- osem_measurements(x = bbox, phenomenon = "Windrichtung")
sfc = sf::st_sfc(sf::st_linestring(x = matrix(data = c(7, 8, 50, 51), ncol = 2)), crs = 4326)
bbox = sf::st_bbox(sfc)
m = osem_measurements(x = bbox, phenomenon = 'Windrichtung')
expect_true(all(attributes(m[1:nrow(m), ]) %in% attributes(m)))
})

@ -1,40 +1,33 @@
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")
}
source('testhelpers.R')
context('phenomena')
try({
boxes <- osem_boxes()
all_phen <- unique(unlist(boxes$phenomena))
boxes = osem_boxes()
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()
phenomena <- osem_phenomena(boxes)
phenomena = osem_phenomena(boxes)
expect_true(is.numeric(unlist(phenomena)))
expect_true(is.list(phenomena))
})
test_that("phenomena from boxes has all phenomena", {
test_that('phenomena from boxes has all phenomena', {
check_api()
phenomena <- osem_phenomena(boxes)
phenomena = osem_phenomena(boxes)
expect_true(all(all_phen %in% names(phenomena)))
expect_true(all(names(phenomena) %in% all_phen))
})
test_that("phenomena from a not sensebox data.frame returns error", {
expect_error(osem_phenomena(list()), "no applicable method")
expect_error(osem_phenomena(data.frame()), "no applicable method")
boxes_df <- boxes
class(boxes_df) <- c("data.frame")
expect_error(osem_phenomena(boxes_df), "no applicable method")
test_that('phenomena from a not sensebox data.frame returns error', {
expect_error(osem_phenomena(list()), 'no applicable method')
expect_error(osem_phenomena(data.frame()), 'no applicable method')
boxes_df = boxes
class(boxes_df) = c('data.frame')
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')
}
正在加载...
取消
保存