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")
write.csv(example.distances, "distances.csv")
study.data <- suppressWarnings(loadStudyData(tz = "Europe/Copenhagen", start.time = NULL,
stop.time = NULL, exclude.tags = NULL))
# n
detections.list <- study.data$detections.list
bio <- study.data$bio
spatial <- study.data$spatial
dist.mat <- study.data$dist.mat
output <- groupMovements(detections.list = detections.list[1:2], bio = bio, spatial = spatial,
speed.method = "last to first", max.interval = 60, tz = "Europe/Copenhagen", dist.mat = dist.mat)
test_that("groupMovements assigns correct names to objects", {
expect_equal(names(output), c("R64K-4451", "R64K-4453"))
expect_equal(colnames(output[[1]]), c('Array', 'Section', 'Detections', 'First.station', 'Last.station', 'First.time', 'Last.time', 'Time.travelling', 'Time.in.array', 'Average.speed.m.s', 'Valid'))
})
test_that("groupMovements assigns timestamps correctly", {
m <- output$`R64K-4451`
d <- detections.list$`R64K-4451`
expect_equal(m$First.time[1], d$Timestamp[1])
expect_equal(m$Last.time[1], d$Timestamp[m$Detections[1]])
for (i in 2:nrow(m)) {
expect_equal(m$First.time[i], d$Timestamp[sum(m$Detections[1:(i - 1)]) + 1])
expect_equal(m$Last.time[i], d$Timestamp[sum(m$Detections[1:i])])
}
})
test_that("groupMovements assigns arrays correctly", {
m <- output$`R64K-4451`
d <- detections.list$`R64K-4451`
expect_equal(m$Array[1], as.character(d$Array[1]))
expect_equal(m$Array[1], as.character(d$Array[m$Detections[1]]))
for (i in 2:nrow(m)) {
expect_equal(m$Array[i], as.character(d$Array[sum(m$Detections[1:(i - 1)]) + 1]))
expect_equal(m$Array[i], as.character(d$Array[sum(m$Detections[1:i])]))
}
})
test_that("groupMovements only uses dist.mat if it is valid", {
xdist <- dist.mat
attributes(xdist)$valid <- FALSE
aux <- groupMovements(detections.list = detections.list[1:2], bio = bio, spatial = spatial,
speed.method = "last to first", max.interval = 60, tz = "Europe/Copenhagen", dist.mat = xdist)
expect_equal(names(aux), c("R64K-4451", "R64K-4453"))
expect_equal(colnames(aux[[1]]), c('Array', 'Section', 'Detections', 'First.station', 'Last.station', 'First.time', 'Last.time', 'Time.travelling', 'Time.in.array', 'Valid'))
})
test_that("groupMovements can handle unknown detections", {
d <- detections.list[1:2]
levels(d[[1]]$Array) <- c(levels(d[[1]]$Array), "Unknown")
d[[1]]$Array[1] <- "Unknown"
levels(d[[1]]$Standard.name) <- c(levels(d[[1]]$Standard.name), "Ukn.")
d[[1]]$Standard.name[1] <- "Ukn."
expect_warning(aux <- groupMovements(detections.list = d, bio = bio, spatial = spatial,
speed.method = "last to first", max.interval = 60, tz = "Europe/Copenhagen", dist.mat = dist.mat),
"Movement events at 'Unknown' locations have been rendered invalid.", fixed = TRUE)
expect_equal(names(aux), c("R64K-4451", "R64K-4453"))
expect_equal(colnames(aux[[1]]), c('Array', 'Section', 'Detections', 'First.station', 'Last.station', 'First.time', 'Last.time', 'Time.travelling', 'Time.in.array', 'Average.speed.m.s', 'Valid'))
expect_equal(aux[[1]]$Array[1], "Unknown")
expect_equal(aux[[1]]$First.station[1], "Ukn.")
expect_equal(aux[[1]]$Last.station[1], "Ukn.")
expect_equal(aux[[1]]$Average.speed.m.s[1], NA_real_)
expect_equal(aux[[1]]$Average.speed.m.s[2], NA_real_)
moves <<- aux
})
test_that("Switching speed.method leads to different speed results.", {
aux <- groupMovements(detections.list = detections.list[1:2], bio = bio, spatial = spatial,
speed.method = "last to last", max.interval = 60, tz = "Europe/Copenhagen", dist.mat = dist.mat)
expect_true(aux[[1]]$Average.speed.m.s[3] != moves[[1]]$Average.speed.m.s[3])
})
test_that("Movement events with one detection have '0:00' residency time.", {
d <- detections.list[1:2]
d[[1]] <- d[[1]][-c(2:12, 14:17), ]
aux <- groupMovements(detections.list = d, bio = bio, spatial = spatial,
speed.method = "last to last", max.interval = 60, tz = "Europe/Copenhagen", dist.mat = dist.mat)
# First event
expect_equal(aux[[1]]$Detections[1], 1)
expect_equal(aux[[1]]$Time.in.array[1], "0:00:00")
# Following events
expect_equal(aux[[1]]$Detections[2], 1)
expect_equal(aux[[1]]$Time.in.array[2], "0:00:00")
})
test_that("speedReleaseToFirst can handle unknown events", {
aux <- names(moves)
output <- lapply(names(moves), function(tag) {
speedReleaseToFirst(tag = tag, bio = bio, movements = moves[[tag]],
dist.mat = dist.mat, speed.method = "last to last")
})
names(output) <- aux
rm(aux)
expect_equal(output[[1]]$Time.travelling[1], "295:44:39")
expect_equal(output[[1]]$Average.speed.m.s[1], NA_real_)
expect_equal(output[[2]]$Time.travelling[1], "334:01:00")
expect_equal(output[[2]]$Average.speed.m.s[1], 0.001759)
})
test_that("speedReleaseToFirst can handle a first detection previous to release", {
xbio <- bio
xbio$Release.date[4] <- xbio$Release.date[4] + (40 * 24 * 3600)
aux <- names(moves)
output <- lapply(names(moves), function(tag) {
speedReleaseToFirst(tag = tag, bio = xbio, movements = moves[[tag]],
dist.mat = dist.mat, speed.method = "last to last")
})
names(output) <- aux
rm(aux)
expect_equal(output[[2]]$Time.travelling[1], NA_character_)
expect_equal(output[[2]]$Average.speed.m.s[1], NA_real_)
})
test_that("movementTimes correctly handles events with one detection.", {
xmoves <- output[[1]]
xmoves$Detections <- 1
output <- movementTimes(xmoves)
expect_equal(unique(output$Time.in.array), "0:00:00")
})
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.