Nothing
skip_on_cran()
oldtz <- Sys.getenv('TZ', unset = NA)
Sys.setenv(TZ = 'UTC')
tests.home <- getwd()
setwd(tempdir())
exampleWorkspace("exampleWorkspace", force = TRUE)
setwd("exampleWorkspace")
bio <- read.csv("biometrics.csv")
deployments <- read.csv("deployments.csv")
spatial <- read.csv("spatial.csv")
detections <- example.detections
detections$ExtraCol <- NA
dot <- paste(unique(spatial$Array[spatial$Type == "Hydrophone"]), collapse = "--")
test_that("Correct error is triggered if datapack is not valid", {
expect_error(results <- explore(datapack = "a"),
"The datapack's token is invalid or missing. Please the function preload() to compile the input data.
Additionally, data must to be compiled during the current R session.", fixed = TRUE)
expect_error(results <- migration(datapack = "a"),
"The datapack's token is invalid or missing. Please the function preload() to compile the input data.
Additionally, data must to be compiled during the current R session.", fixed = TRUE)
expect_error(results <- residency(datapack = "a"),
"The datapack's token is invalid or missing. Please the function preload() to compile the input data.
Additionally, data must to be compiled during the current R session.", fixed = TRUE)
})
test_that("basic preload works as expected", {
expect_warning(d <<- preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = detections,
dot = dot, tz = "Europe/Copenhagen"),
"No detections were found for receiver(s) 132907", fixed = TRUE)
})
test_that("checkArguments complains if preload is used together with tz", {
expect_warning(explore(datapack = d, tz = "Europe/Copenhagen"),
"Argument 'tz' was set but a datapack was provided. Disregarding set arguments.", fixed = TRUE)
})
# n
# n
test_that("checkArguments stops if wrong override is provided with preload", {
expect_error(
expect_warning(explore(datapack = d, override = 1234),
"Override is numeric (i.e. the code space has not been included). Will attempt to identify tags to be excluded based on signal alone.", fixed = TRUE),
"Some tags listed in 'override' (1234) are not listed in the biometrics data", fixed = TRUE)
})
test_that("explore with preload yields the same results as with traditional loading", {
results <- suppressWarnings(explore(datapack = d))
results2 <- suppressWarnings(explore(tz = "Europe/Copenhagen"))
for (i in 1:length(results$valid.movements)) {
expect_equal(results$movements[[i]], results2$movements[[i]])
expect_equal(results$valid.movements[[i]], results2$valid.movements[[i]])
}
expect_equal(extractSignals(names(results$valid.movements)), extractSignals(names(results2$valid.movements)))
expect_equal(results$arrays, results2$arrays)
expect_equal(results$spatial, results2$spatial)
})
# n
# n
# n
# n
test_that("migration and residency don't start if datapack is incompatible", {
xspatial <- spatial[, -match("Section", colnames(spatial))]
expect_warning(d <- preload(biometrics = bio, deployments = deployments, spatial = xspatial, detections = detections, tz = "Europe/Copenhagen"),
"The spatial input does not contain a 'Section' column. This input is only valid for explore() analyses.", fixed = TRUE)
expect_error(results <- migration(datapack = d, GUI = "never"),
"To run migration(), please assign the arrays to their sections using a 'Section' column in the spatial input.", fixed = TRUE)
expect_error(results <- residency(datapack = d, GUI = "never"),
"To run residency(), please assign the arrays to their sections using a 'Section' column in the spatial input.", fixed = TRUE)
})
test_that("migration and residency with preload yield the same results as with traditional loading", {
expect_warning(d2 <- preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = detections,
tz = "Europe/Copenhagen"),
"No detections were found for receiver(s) 132907", fixed = TRUE)
results <- suppressWarnings(migration(datapack = d2))
results2 <- suppressWarnings(migration(tz = "Europe/Copenhagen"))
expect_equal(extractSignals(names(results$valid.movements)), extractSignals(names(results2$valid.movements)))
expect_equal(results$status.df[, -1], results2$status.df[, -1])
for (i in 1:length(results$valid.movements)) {
expect_equal(results$movements[[i]], results2$movements[[i]])
expect_equal(results$valid.movements[[i]], results2$valid.movements[[i]])
}
results <- suppressWarnings(residency(datapack = d2))
results2 <- suppressWarnings(residency(tz = "Europe/Copenhagen"))
for (i in 1:length(results$valid.movements)) {
expect_equal(results$movements[[i]], results2$movements[[i]])
expect_equal(results$valid.movements[[i]], results2$valid.movements[[i]])
}
expect_equal(extractSignals(names(results$valid.movements)), extractSignals(names(results2$valid.movements)))
expect_equal(results$arrays, results2$arrays)
expect_equal(results$status.df[, -1], results2$status.df[, -1])
})
# n # migration1
# n
# n
# n
# n # migration2
# n
# n
# n
# n # residency1
# n
# n
# n # residency2
# n
# n
test_that("tz and exclude.tags stops are working", {
expect_error(preload(tz = "test"), "'tz' could not be recognized as a timezone. Check available timezones with OlsonNames()", fixed = TRUE)
expect_error(preload(tz = "Europe/Copenhagen", exclude.tags = "test"),
"Not all contents in 'exclude.tags' could be recognized as tags (i.e. 'codespace-signal'). Valid examples: 'R64K-1234', A69-1303-1234'", fixed = TRUE)
})
test_that("dot stop is working", {
expect_error(
expect_warning(preload(biometrics = bio, deployments = deployments, spatial = spatial,
detections = detections, tz = "Europe/Copenhagen", dot = 1),
"No detections were found for receiver(s) 132907", fixed = TRUE),
"'dot' was set but could not recognised as a string. Please prepare a dot string and include it in the dot argument.
You can use readDot to check the quality of your dot string.", fixed = TRUE)
})
test_that("start.time and stop.time are working fine in preload", {
expect_message(suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial,
detections = detections, tz = "Europe/Copenhagen", start.time = "2018-05-01 00:00")),
"M: Discarding detection data previous to 2018-05-01 00:00 per user command (9866 detections discarded).", fixed = TRUE)
expect_message(suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial,
detections = detections, tz = "Europe/Copenhagen", stop.time = "2018-05-08 00:00")),
"M: Discarding detection data posterior to 2018-05-08 00:00 per user command (544 detections discarded).", fixed = TRUE)
expect_message(suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial,
detections = detections, tz = "Europe/Copenhagen", start.time = "2018-05-01 00:00",
stop.time = "2018-05-08 00:00")),
"M: Data time range: 2018-05-01 00:04:30 to 2018-05-07 23:59:47 (Europe/Copenhagen).", fixed = TRUE)
})
write.csv(example.distances, "distances.csv")
test_that("distances are correctly handled with preload", {
d2 <- suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = detections,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen"))
results <- suppressWarnings(explore(datapack = d2))
results2 <- suppressWarnings(explore(tz = "Europe/Copenhagen"))
for (i in 1:length(results$valid.movements)) {
expect_equal(results$movements[[i]], results2$movements[[i]])
expect_equal(results$valid.movements[[i]], results2$valid.movements[[i]])
}
expect_equal(extractSignals(names(results$valid.movements)), extractSignals(names(results2$valid.movements)))
expect_equal(results$arrays, results2$arrays)
expect_equal(results$spatial, results2$spatial)
})
# n
# n
# n
# n
test_that("preload stops if mandatory columns are missing or have NAs", {
x <- detections[, -1]
expect_error(suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = x,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen")),
"The following mandatory columns are missing in the detections: Timestamp", fixed = TRUE)
x <- detections[, -match("Signal", colnames(detections))]
expect_error(suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = x,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen")),
"The following mandatory columns are missing in the detections: Signal
The functions extractSignals and extractCodeSpaces can be used to break transmitter codes apart.", fixed = TRUE)
x <- detections
x[1, 1] <- NA
expect_error(suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = x,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen")),
"There is missing data in the following mandatory columns of the detections: Timestamp", fixed = TRUE)
})
test_that("Data conversion warnings and errors kick in", {
d <- detections
d$Signal <- as.character(d$Signal)
expect_warning(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = d,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen"),
"The 'Signal' column in the detections is not of type integer. Attempting to convert.", fixed = TRUE)
d <- detections
d$Receiver <- as.character(d$Receiver)
expect_warning(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = d,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen"),
"The 'Receiver' column in the detections is not of type integer. Attempting to convert.", fixed = TRUE)
d <- detections
d$Receiver <- paste0("a-", d$Receiver)
expect_warning(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = d,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen"),
"Attempting to convert the 'Receiver' to integer failed. Attempting to extract only the serial numbers.", fixed = TRUE)
d <- detections
d$Receiver <- "a"
expect_error(suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = d,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen")),
"Extracting the serial numbers failed. Aborting.", fixed = TRUE)
d <- detections
d$Sensor.Value <- "1"
expect_warning(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = d,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen"),
"The 'Sensor.Value' column in the detections is not of type numeric. Attempting to convert.", fixed = TRUE)
d <- detections
d$Sensor.Value <- "b"
expect_error(suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = d,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen")),
"Attempting to convert the 'Sensor.Value' to numeric failed. Aborting.", fixed = TRUE)
d <- detections
d$Timestamp <- as.character(d$Timestamp)
expect_message(suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = d,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen")),
"Converting detection timestamps to POSIX objects", fixed = TRUE)
d <- detections
d$Timestamp <- "b"
expect_error(suppressWarnings(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = d,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen")),
"Converting the timestamps failed. Aborting.", fixed = TRUE)
d <- detections
d$Valid <- "b"
expect_warning(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = d,
dot = dot, distances = example.distances, tz = "Europe/Copenhagen"),
"The detections have a column named 'Valid' but its content is not logical. Resetting to Valid = TRUE.", fixed = TRUE)
})
test_that("preload stops if user-defined section order has duplicates", {
expect_error(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = detections,
dot = dot, tz = "Europe/Copenhagen", section.order = c("A", "A")),
"Some section names are duplicated in the 'section.order' argument. Please include each section only once.", fixed = TRUE)
})
test_that("preload can handle spatial objects with one array only", {
xdeployments <- deployments[deployments$Station == "Station 1", ]
xspatial <- spatial[c(2, 18), ]
xdetections <- detections[detections$Receiver == xdeployments$Receiver, ]
expect_warning(preload(biometrics = bio, deployments = xdeployments, spatial = xspatial, detections = xdetections, tz = "Europe/Copenhagen"),
regexp = NA)
})
test_that("preload does not flop on circular study areas (extreme test)", {
xdot <- paste0(dot, "--A0")
expect_warning(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = detections,
dot = xdot, tz = "Europe/Copenhagen"),
"No detections were found for receiver(s) 132907", fixed = TRUE)
})
test_that("preload does not flop if timestamps and/or codespaces are not characters", {
xdetections <- detections
xdetections$Timestamp <- as.POSIXct(xdetections$Timestamp, tz = "Europe/Copenhagen")
xdetections$CodeSpace <- as.factor(xdetections$CodeSpace)
expect_warning(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = xdetections,
dot = dot, tz = "Europe/Copenhagen"),
"No detections were found for receiver(s) 132907", fixed = TRUE)
})
test_that("preload works even if Sensor.Value/Sensor.Unit is missing", {
xdetections <- detections
xdetections$Sensor.Value <- NULL
expect_warning(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = xdetections,
dot = dot, tz = "Europe/Copenhagen"),
"Could not find a 'Sensor.Value' column in the detections. Filling one with NA.", fixed = TRUE)
xdetections <- detections
xdetections$Sensor.Unit <- NULL
expect_warning(preload(biometrics = bio, deployments = deployments, spatial = spatial, detections = xdetections,
dot = dot, tz = "Europe/Copenhagen"),
"Could not find a 'Sensor.Unit' column in the detections. Filling one with NA.", fixed = TRUE)
})
setwd("..")
unlink("exampleWorkspace", recursive = TRUE)
setwd(tests.home)
if (is.na(oldtz)) Sys.unsetenv("TZ") else Sys.setenv(TZ = oldtz)
rm(list = ls())
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.