From 6d2f6f67e1eb77d93c6c950685ccea6451a73ef7 Mon Sep 17 00:00:00 2001 From: Norwin Roosen Date: Mon, 15 Jan 2018 15:23:26 +0100 Subject: [PATCH] add some tests, fix failing tests --- R/box_utils.R | 2 +- R/measurement_utils.R | 2 +- tests/testthat/test_box.R | 25 ++++++++++----------- tests/testthat/test_boxes.R | 33 ++++++++++++++++++++++++++++ tests/testthat/test_measurements.R | 35 +++++++++++++++++++++++++----- 5 files changed, 75 insertions(+), 22 deletions(-) diff --git a/R/box_utils.R b/R/box_utils.R index ab9b483..92460d1 100644 --- a/R/box_utils.R +++ b/R/box_utils.R @@ -107,7 +107,7 @@ mutate.sensebox = dplyr_class_wrapper(osem_as_sensebox) #' @export `[.sensebox` = function(x, i, ...) { s = NextMethod('[') - mostattributes(s) = attributes(x) + mostattributes(s) = attributes(s) s } diff --git a/R/measurement_utils.R b/R/measurement_utils.R index 75d83d1..3291be9 100644 --- a/R/measurement_utils.R +++ b/R/measurement_utils.R @@ -43,7 +43,7 @@ mutate.osem_measurements = dplyr_class_wrapper(osem_as_measurements) #' @export `[.osem_measurements` = function(x, i, ...) { s = NextMethod('[') - mostattributes(s) = attributes(x) + mostattributes(s) = attributes(s) s } diff --git a/tests/testthat/test_box.R b/tests/testthat/test_box.R index a213a9b..b6ca332 100644 --- a/tests/testthat/test_box.R +++ b/tests/testthat/test_box.R @@ -10,23 +10,20 @@ try({ boxes <- osem_boxes() }) -test_that("a box can be converted to sf object", { +test_that("a single box can be retrieved by ID", { check_api() - + box <- osem_box(boxes$X_id[[1]]) - box_sf <- sf::st_as_sf(box) - - expect_true(sf::st_is_simple(box_sf)) - expect_true("sf" %in% class(box_sf)) + + 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("a box converted to sf object keeps all attributes", { + +test_that("[.sensebox maintains attributes", { check_api() - - skip("FIXME") - - box <- osem_box(boxes$X_id[[1]]) - box_sf <- sf::st_as_sf(box) - - expect_true(all(names(box) %in% names(box_sf))) + + expect_true(all(attributes(boxes[1:nrow(boxes), ]) %in% attributes(boxes))) }) diff --git a/tests/testthat/test_boxes.R b/tests/testthat/test_boxes.R index 0638a39..d7021ab 100644 --- a/tests/testthat/test_boxes.R +++ b/tests/testthat/test_boxes.R @@ -75,3 +75,36 @@ 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", { + check_api() + + 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)) +}) + +test_that("boxes converted to sf object keep all attributes", { + check_api() + + boxes <- osem_boxes() + boxes_sf <- sf::st_as_sf(boxes) + + # coord columns get removed! + cols <- names(boxes)[!names(boxes) %in% c('lon', 'lat')] + expect_true(all(cols %in% names(boxes_sf))) + + expect_true("sensebox" %in% class(boxes_sf)) +}) + +test_that("box retrieval does not give progress information in non-interactive mode", { + check_api() + + if (!opensensmapr:::is_non_interactive()) skip("interactive session") + + out <- capture.output(b <- osem_boxes()) + expect_length(out, 0) +}) + diff --git a/tests/testthat/test_measurements.R b/tests/testthat/test_measurements.R index ffbc701..e4600fc 100644 --- a/tests/testthat/test_measurements.R +++ b/tests/testthat/test_measurements.R @@ -21,14 +21,16 @@ test_that("measurements can be retrieved for a phenomenon", { test_that("measurement retrieval does not give progress information in non-interactive mode", { check_api() - + + if (!opensensmapr:::is_non_interactive()) skip("interactive session") + out <- capture.output(measurements <- osem_measurements(x = "Licht")) expect_length(out, 0) }) test_that("a response with no matching senseBoxes gives an error", { check_api() - + expect_error(osem_measurements(x = "Windgeschwindigkeit", exposure = "indoor"), "No senseBoxes found") }) @@ -70,10 +72,10 @@ test_that("measurements of specific boxes can be retrieved for one phenomenon an 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 = "Temperatur") + 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)) @@ -82,11 +84,22 @@ test_that("measurements can be retrieved for a bounding box", { 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) - + + 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", { + 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) + expect_true(all(measurements$createdAt < to_date)) expect_true(all(measurements$createdAt > from_date)) }) @@ -95,3 +108,13 @@ test_that("both from and to are required when requesting measurements, error oth 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", { + 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") + + expect_true(all(attributes(m[1:nrow(m), ]) %in% attributes(m))) +})