Nothing
library(trajr)
context("Basic tests")
trjFromAnglesAndLengths <- function(angles, lengths) {
coords <- c(0, cumsum(complex(modulus = lengths, argument = angles)))
TrajFromCoords(data.frame(Re(coords), Im(coords)))
}
# Reads a set of points from a file. The points come from multiple tracks
# due to noise in the video conversion process.
# The longest track is the one we are interested in
#
# Value - data frame with values x & y, and an attribute "numFrames" which records the number of frames in the source video
.MreadPoints <- function(file, ...) {
points <- read.csv(file, comment.char = '#')
# Save the number of frames in the file in case the track doesn't extend until the end
maxFrame <- max(points$Frame)
# Save number of frames
attr(points, 'numFrames') <- maxFrame
points
}
test_that("Trajectory creation", {
csvFile <- "../testdata/096xypts.csv"
expect_true(file.exists(csvFile))
coords <- utils::read.csv(csvFile, stringsAsFactors = FALSE)
expect_false(is.null(coords))
trj <- TrajFromCoords(coords, fps = 850)
expect_false(is.null(trj))
expect_equal(2030, nrow(trj))
xRange <- c(997.31, 1541.549436)
expect_equal(range(trj$x), xRange)
yRange <- c(669.883810, 956.924828)
expect_equal(range(trj$y), yRange)
expect_equal(TrajGetFPS(trj), 850)
expect_equal(TrajGetNCoords(trj), nrow(coords))
# Scaling
scale <- 1 / 2500
scaled <- TrajScale(trj, scale, "m")
#plot(scaled)
expect_false(is.null(scaled))
expect_equal(nrow(trj), nrow(scaled))
expect_equal(range(scaled$x), xRange * scale)
expect_equal(range(scaled$y), yRange * scale)
# Test different x & y scales
yScale <- scale * 0.8
scaledXY <- TrajScale(trj, scale, "m", yScale)
#lines(scaledXY, col = "red")
expect_false(is.null(scaledXY))
expect_equal(nrow(trj), nrow(scaledXY))
expect_equal(range(scaledXY$x), xRange * scale)
expect_equal(range(scaledXY$y), yRange * yScale)
# Duration
expect_equal(TrajDuration(trj), (nrow(trj) - 1) / 850)
# Velocity
v <- TrajMeanVelocity(scaled)
expect_equal(Mod(v), 0.0728938)
expect_equal(Arg(v), 0.03861151)
# Smoothing
smoothed <- TrajSmoothSG(scaled, 3, 101)
#plot(smoothed)
expect_true(TrajLength(smoothed) < TrajLength(scaled))
expect_true(abs(TrajDistance(smoothed) - TrajDistance(scaled)) < TrajDistance(scaled) / 10)
# Derivatives
derivs <- TrajDerivatives(smoothed)
#plot(derivs$speed, type = 'l', col = 'red')
#plot(derivs$acceleration, type = 'l')
# Rediscretization
rd <- TrajRediscretize(smoothed, .001)
expect_error(TrajRediscretize(smoothed, 0))
expect_error(TrajRediscretize(smoothed, -0.001))
expect_error(TrajRediscretize(smoothed, 0.2))
#plot(rd)
expect_true(TrajStraightness(smoothed) < 1)
expect_true(TrajStraightness(smoothed) > 0)
corr <- TrajDirectionAutocorrelations(rd)
# Check it can be plotted without an error
expect_error(plot(corr, type = 'l'), NA)
mn <- TrajDAFindFirstMinimum(corr, 10)
# points(mn["deltaS"], mn["C"], pch = 16, col = "red", lwd = 2)
# points(mn["deltaS"], mn["C"], col = "black", lwd = 2)
mx <- TrajDAFindFirstMaximum(corr, 5)
# points(mx["deltaS"], mx["C"], pch = 16, col = "green", lwd = 2)
# points(mx["deltaS"], mx["C"], col = "black", lwd = 2)
})
test_that("Creation ignores unimportant NAs", {
# Silently ignore NAs in other columns
trj <- TrajFromCoords(data.frame(0, 0, NA))
expect_equal(nrow(trj), 1)
# Silently ignore leading or trailing NAs
trj <- TrajFromCoords(data.frame(c(0, 1, 2, 3, NA), c(NA, 1, 2, 3, 4), other = c(NA, "a", NA, "c", NA)))
expect_equal(nrow(trj), 3)
testthat::expect_true(all.equal(trj$other, c("a", NA, "c")))
# Report error if NA is in the middle of the trajectory
expect_error(TrajFromCoords(data.frame(c(0, 1, 2), c(0, NA, 2), c(NA, 1, NA))),
"Trajectory contains missing coordinate or time values, first row with NA is 2")
# Complain about NA in time
expect_error(TrajFromCoords(data.frame(c(0, 1, 2, 3, 4), c(0, 1, 2, 3, 4), c(NA, "a", NA, "c", NA)), timeCol = 3),
"Trajectory contains missing coordinate or time values, first row with NA is 3")
# Skip leading/trailing NAs in time
trj <- TrajFromCoords(data.frame(c(0, 1, 2, 3, 4), c(0, 1, 2, 3, 4), c(NA, 1, 2, 3, NA)), timeCol = 3)
expect_equal(nrow(trj), 3)
trj <- TrajFromCoords(data.frame(c(0, 1, 2, 3, 4), c(0, 1, 2, 3, 4), c(0, 1, 2, 3, 4)), timeCol = 3)
expect_equal(nrow(trj), 5)
})
test_that("Speed intervals", {
# 1 Interval with no start and 1 stop
set.seed(1)
trj <- TrajGenerate(200, random = TRUE)
slowerThan = NULL
fasterThan = 120
smoothed <- TrajSmoothSG(trj, 3, 101)
intervals <- TrajSpeedIntervals(smoothed, slowerThan = slowerThan, fasterThan = fasterThan)
expect_error(plot(intervals), NA)
expect_equal(nrow(intervals), 1)
# 1 Interval with 1 start and no stop
set.seed(2)
trj <- TrajGenerate(200, random = TRUE)
slowerThan = NULL
fasterThan = 120
smoothed <- TrajSmoothSG(trj, 3, 101)
intervals <- TrajSpeedIntervals(smoothed, slowerThan = slowerThan, fasterThan = fasterThan)
#plot(intervals)
expect_equal(nrow(intervals), 1)
# 0 intervals
set.seed(3)
trj <- TrajGenerate(200, random = TRUE)
slowerThan = NULL
fasterThan = 200
smoothed <- TrajSmoothSG(trj, 3, 101)
intervals <- TrajSpeedIntervals(smoothed, slowerThan = slowerThan, fasterThan = fasterThan)
expect_error(plot(intervals), NA)
expect_equal(nrow(intervals), 0)
# 3 intervals
set.seed(4)
trj <- TrajGenerate(200, random = TRUE)
slowerThan = 150
fasterThan = 90
smoothed <- TrajSmoothSG(trj, 3, 101)
intervals <- TrajSpeedIntervals(smoothed, slowerThan = slowerThan, fasterThan = fasterThan)
#plot(intervals)
expect_equal(nrow(intervals), 3)
# 3 intervals
set.seed(4)
trj <- TrajGenerate(200, random = TRUE)
slowerThan = 50
fasterThan = NULL
smoothed <- TrajSmoothSG(trj, 3, 101)
intervals <- TrajSpeedIntervals(smoothed, slowerThan = slowerThan, fasterThan = fasterThan)
expect_error(plot(intervals), NA)
expect_equal(nrow(intervals), 3)
# 2 intervals
set.seed(4)
trj <- TrajGenerate(20, random = TRUE)
slowerThan = 92
fasterThan = NULL
intervals <- TrajSpeedIntervals(trj, slowerThan = slowerThan, fasterThan = fasterThan)
expect_equal(nrow(intervals), 2)
# Interval wholly contained within a segment
set.seed(4)
trj <- TrajGenerate(10, random = TRUE)
slowerThan = 110
fasterThan = 107
intervals <- TrajSpeedIntervals(trj, slowerThan = slowerThan, fasterThan = fasterThan)
expect_equal(nrow(intervals), 0)
set.seed(1)
trj <- TrajGenerate(10, random = TRUE)
slowerThan = NULL
fasterThan = 110
intervals <- TrajSpeedIntervals(trj, slowerThan = slowerThan, fasterThan = fasterThan)
expect_equal(nrow(intervals), 2)
# Central diffs gives lower speed
intervals <- TrajSpeedIntervals(trj, diff = "central", slowerThan = slowerThan, fasterThan = fasterThan)
expect_equal(nrow(intervals), 0)
slowerThan = 107
fasterThan = NULL
intervals <- TrajSpeedIntervals(trj, slowerThan = slowerThan, fasterThan = fasterThan)
expect_equal(nrow(intervals), 3)
# Central diffs gives lower speed
intervals <- TrajSpeedIntervals(trj, diff = "central", slowerThan = slowerThan, fasterThan = fasterThan)
expect_equal(nrow(intervals), 2)
# Entire trajectory is a single interval
slowerThan = NULL
fasterThan = 50
intervals <- TrajSpeedIntervals(trj, diff = "central", slowerThan = slowerThan, fasterThan = fasterThan)
expect_equal(nrow(intervals), 1)
# No intervals
slowerThan = 50
fasterThan = NULL
intervals <- TrajSpeedIntervals(trj, diff = "central", slowerThan = slowerThan, fasterThan = fasterThan)
#plot(intervals)
expect_equal(nrow(intervals), 0)
})
test_that("Emax", {
set.seed(1)
trj1 <- TrajGenerate(1000, angularErrorSd = .5)
trj2 <- TrajGenerate(1000, angularErrorSd = .2)
# trj2 (black) should be straighter than trj1 (red), hence Emax(trj1) < Emax(trj2)
#plot(trj2, asp = NULL, xlim = range(c(trj1$x, trj2$x)), ylim = range(c(trj1$y, trj2$y)))
#plot(trj1, col = "red", add = TRUE)
expect_true(TrajEmax(trj1) < TrajEmax(trj2))
})
test_that("Sinuosity", {
set.seed(1)
trj1 <- TrajGenerate(1000, angularErrorSd = .5)
trj2 <- TrajGenerate(1000, angularErrorSd = .2)
# trj2 (black) should be straighter than trj1 (red), hence Sinuosity(trj1) > Sinuosity(trj2)
#plot(trj2, asp = NULL, xlim = range(c(trj1$x, trj2$x)), ylim = range(c(trj1$y, trj2$y)))
#plot(trj1, col = "red", add = TRUE)
expect_true(TrajSinuosity(trj1) > TrajSinuosity(trj2))
})
test_that("Directional change", {
# Test that directional change as implemented gives the same results as the equation in the book
L <- c(1, 1, 1, 1)
A <- c(pi / 4, 0, -pi / 8, pi / 6)
trj <- trjFromAnglesAndLengths(A, L)
#plot(trj, turning.angles = "random")
.bookCalc <- function(trj) {
# Lengths between consecutive points
lengths1 <- Mod(diff(trj$polar))
# Lengths between points 2 apart
lengths2 <- Mod(trj$polar[3:nrow(trj)] - trj$polar[1:(nrow(trj) - 2)])
# Times between points 2 apart
times2 <- trj$displacementTime[3:nrow(trj)] - trj$displacementTime[1:(nrow(trj) - 2)]
sapply(1:(nrow(trj) - 2), function(i) {
a <- lengths1[i]
b <- lengths1[i+1]
c <- lengths2[i]
t <- times2[i]
(180 - (180 / pi * acos((a ^ 2 + b ^ 2 - c ^ 2) / (2 * a * b)))) / t
})
}
expect_equal(TrajDirectionalChange(trj), .bookCalc(trj))
set.seed(1)
trj <- TrajGenerate()
expect_equal(TrajDirectionalChange(trj), .bookCalc(trj))
# csvFile <- "../testdata/test-dc.tsv"
# expect_true(file.exists(csvFile))
# data <- read.table(csvFile)
# names(data) <- c("time(s)", "x", "y", "immobile")
# trj <- TrajFromCoords(data, xCol = "x", yCol = "y", timeCol = "time(s)", spatialUnits = "pixels")
# expect_equal(TrajDirectionalChange(trj), .bookCalc(trj))
#microbenchmark(TrajDirectionalChange(trj), .bookCalc(trj), times = 1000)
})
test_that("Reverse", {
set.seed(1)
trj <- TrajGenerate()
rv <- TrajReverse(trj)
expect_equal(nrow(rv), nrow(trj))
expect_equal(rv$polar[1], trj$polar[nrow(trj)])
expect_equal(rv$polar[nrow(rv)], trj$polar[1])
expect_equal(TrajLength(rv), TrajLength(trj))
expect_equal(TrajEmax(rv), TrajEmax(trj))
})
test_that("Translate", {
set.seed(1)
trj <- TrajGenerate()
dx <- 10
dy <- 15
dt <- 2
tt <- TrajTranslate(trj, dx, dy, dt)
expect_equal(nrow(tt), nrow(trj))
expect_equal(tt$x, trj$x + dx)
expect_equal(tt$y, trj$y + dy)
expect_equal(tt$time, trj$time + dt)
expect_equal(tt$displacement, trj$displacement)
expect_equal(TrajLength(tt), TrajLength(trj))
expect_equal(TrajEmax(tt), TrajEmax(trj))
tto <- TrajTranslate(tt, -tt$x[1], -tt$y[1], -tt$time[1])
expect_equal(nrow(tto), nrow(trj))
expect_equal(tto$polar, trj$polar)
expect_equal(tto$x, trj$x)
expect_equal(tto$y, trj$y)
expect_equal(tto$time, trj$time)
expect_equal(TrajLength(tto), TrajLength(trj))
expect_equal(TrajEmax(tto), TrajEmax(trj))
})
test_that("Step lengths", {
set.seed(1)
nSteps <- 100
nTrajs <- 4
stepLength <- 1
trjs <- lapply(1:nTrajs, TrajGenerate, n = nSteps, stepLength = stepLength)
sl <- TrajsStepLengths(trjs)
expect_equal(length(sl), nSteps * nTrajs)
# Expect mean and median to be roughly equal to the specified step length
expect_equal(mean(sl), stepLength, tolerance = 2e-2)
expect_equal(median(sl), stepLength, tolerance = 2e-2)
})
test_that("Generate", {
unifDist <- function(n) runif(n, -1, 1)
set.seed(1)
sd <- 0.5
trj <- TrajGenerate(angularErrorSd = sd, linearErrorDist = unifDist)
# Should NOT be able to reject the NULL hypothesis that turning angle errors are normally distributed
expect_true(shapiro.test(TrajAngles(trj))$p.value > 0.05)
expect_equal(sd(TrajAngles(trj)), sd, tolerance = 5e-2)
# Should be able to reject the NULL hypothesis that linear errors are normally distributed
expect_true(shapiro.test(TrajStepLengths(trj))$p.value <= 0.05)
trj <- TrajGenerate(angularErrorDist = unifDist)
# Should be able to reject the NULL hypothesis that turning angles are normally distributed
expect_true(shapiro.test(TrajAngles(trj))$p.value <= 0.05)
# Should NOT be able to reject the NULL hypothesis that linear errors are normally distributed
expect_true(shapiro.test(TrajStepLengths(trj))$p.value > 0.05)
})
test_that("Smoothing", {
set.seed(1)
sd <- 0.5
trj <- TrajGenerate(angularErrorSd = sd)
smoothed <- TrajSmoothSG(trj, 3, 41)
expect_true(TrajEmax(trj) < TrajEmax(smoothed))
smoothed2 <- TrajSmoothSG(trj, 3, 101)
expect_true(TrajEmax(smoothed) < TrajEmax(smoothed2))
})
test_that("Convenience", {
tracks <- rbind(
data.frame(file = "3527.csv", species = "Zodariid2 sp1", category = "spider"),
data.frame(file = "3530.csv", species = "Daerlac nigricans", category = "mimic bug"),
data.frame(file = "3534.csv", species = "Daerlac nigricans", category = "mimic bug"),
data.frame(file = "3537.csv", species = "Myrmarachne erythrocephala", category = "mimic spider"),
data.frame(file = NA, species = "", category = ""),
data.frame(file = "3542.csv", species = "Polyrhachis sp1", category = "ant"),
data.frame(file = "3543.csv", species = "Polyrhachis sp1", category = "ant"),
data.frame(file = "3548.csv", species = "Crematogaster sp1", category = "ant"),
data.frame(file = NA, species = "", category = ""),
stringsAsFactors = FALSE
)
csvStruct <- list(x = "x", y = "y", time = "Time")
# Expect to fail with a message when there are blank
expect_error(TrajsBuild(tracks$file, scale = .220 / 720, spatialUnits = "m", timeUnits = "s", csvStruct = csvStruct, rootDir = "..", csvReadFn = .MreadPoints),
"Trajectory input file name is blank or NULL.*")
tracks <- na.omit(tracks)
trjs <- TrajsBuild(tracks$file, scale = .220 / 720, spatialUnits = "m", timeUnits = "s", csvStruct = csvStruct, rootDir = "..", csvReadFn = .MreadPoints)
expect_equal(length(trjs), nrow(tracks))
expect_equal(TrajGetUnits(trjs[[2]]), "m")
expect_equal(TrajGetTimeUnits(trjs[[2]]), "s")
# Trajectories should start at origin
expect_true(!any(sapply(trjs, function(t) c(t$x[1], t$y[1])) == 0))
# Define a function which calculates some statistics
# of interest for a single trajectory
characteriseTrajectory <- function(trj) {
# Measures of speed
derivs <- TrajDerivatives(trj)
mean_speed <- mean(derivs$speed)
sd_speed <- sd(derivs$speed)
# Measures of straightness
sinuosity <- TrajSinuosity(trj)
resampled <- TrajRediscretize(trj, .001)
Emax <- TrajEmax(resampled)
# Periodicity
corr <- TrajDirectionAutocorrelations(resampled, round(nrow(resampled) / 4))
first_min <- TrajDAFindFirstMinimum(corr)
# Return a list with all of the statistics for this trajectory
list(mean_speed = mean_speed,
sd_speed = sd_speed,
sinuosity = sinuosity,
Emax = Emax,
first_min_deltaS = first_min[1],
first_min_C = first_min[2])
}
stats <- TrajsMergeStats(trjs, characteriseTrajectory)
expect_true(any(is.na(stats)))
stats <- TrajsStatsReplaceNAs(stats, "first_min_deltaS", flagColumn = "No_first_min")
stats <- TrajsStatsReplaceNAs(stats, "first_min_C")
expect_false(any(is.na(stats)))
# Test translating to the origin
trjs <- TrajsBuild(tracks$file, translateToOrigin = TRUE, scale = .220 / 720, spatialUnits = "m", timeUnits = "s", csvStruct = csvStruct, rootDir = "..", csvReadFn = .MreadPoints)
expect_true(all(sapply(trjs, function(t) c(t$x[1], t$y[1])) == 0))
# Check that check.names works as expected
stats <- TrajsMergeStats(trjs, function(trj) list(`Mean speed` = 0, `Speed (sd)` = 0), check.names = TRUE)
expect_equal(names(stats), c("Mean.speed", "Speed..sd."))
stats <- TrajsMergeStats(trjs, function(trj) list(`Mean speed` = 0, `Speed (sd)` = 0), check.names = FALSE)
expect_equal(names(stats), c("Mean speed", "Speed (sd)"))
})
test_that("Convenience-multi", {
# Test building multiple trajectories from each "file"
readFn <- function(filename, ...) {
# Return 2 very different trajectories
t1 <- TrajGenerate(50)
t2 <- TrajGenerate(20, random = FALSE)
list(t1 = t1[, c('x', 'y', 'time')], t2 = t2[, c('x', 'y', 'time')])
}
trjs <- TrajsBuild(c("one", "two"), csvReadFn = readFn, smoothN = 11)
expect_equal(length(trjs), 4)
})
test_that("works with readr", {
tracks <- rbind(
data.frame(file = "3527.csv", species = "Zodariid2 sp1", category = "spider"),
data.frame(file = "3530.csv", species = "Daerlac nigricans", category = "mimic bug"),
data.frame(file = "3534.csv", species = "Daerlac nigricans", category = "mimic bug"),
data.frame(file = "3537.csv", species = "Myrmarachne erythrocephala", category = "mimic spider"),
data.frame(file = "3542.csv", species = "Polyrhachis sp1", category = "ant"),
data.frame(file = "3543.csv", species = "Polyrhachis sp1", category = "ant"),
data.frame(file = "3548.csv", species = "Crematogaster sp1", category = "ant"),
stringsAsFactors = FALSE
)
csvStruct <- list(x = "x", y = "y", time = "Time")
trjs <- TrajsBuild(tracks$file, csvStruct = csvStruct, smoothN = 11, rootDir = "..",
csvReadFn = readr::read_csv,
col_types = readr::cols(
Frame = readr::col_integer(),
Time = readr::col_double(),
TrackId = readr::col_integer(),
x = readr::col_double(),
y = readr::col_double(),
ValueChanged = readr::col_logical()
))
expect_equal(length(trjs), nrow(tracks))
})
test_that("Sinuosity", {
set.seed(1)
for(aa in seq(0, 2, by = .1)) {
trj <- TrajGenerate(angularErrorSd = aa)
# Don't expect equal, just close
expect_equal(TrajSinuosity(trj), TrajSinuosity2(trj), tolerance = 0.2)
}
})
test_that("fractal dimension", {
set.seed(1)
n <- 5
angErr <- runif(n, 0, pi)
trjs <- lapply(1:n, function(i) TrajGenerate(500, angularErrorSd = angErr[i]))
range <- TrajLogSequence(1, 10, 10)
fd <- sapply(trjs, function(trj) TrajFractalDimension(trj, range))
# Test slope of regression
l <- lm(fd ~ angErr)
l$coefficients[2] %>% expect_gt(0.2) %>% expect_lt(2)
})
test_that("Expected square displacement", {
set.seed(1)
n <- 200
angErr <- runif(n, 0, pi)
trjs <- lapply(1:n, function(i) TrajGenerate(500, angularErrorSd = angErr[i]))
esd1 <- sapply(trjs, function(trj) TrajExpectedSquareDisplacement(trj, eqn1 = TRUE))
esd2 <- sapply(trjs, function(trj) TrajExpectedSquareDisplacement(trj, eqn1 = FALSE))
# plot(angErr, y = abs(esd1), log = 'xy', pch = 16, cex = .7)
# points(angErr, y = esd2, pch = 16, cex = .6, col = "red")
# Test slopes of regressions
l <- lm(log(esd1) ~ log(angErr))
l$coefficients[2] %>% expect_lt(-1.5) %>% expect_gt(-2)
l <- lm(log(esd2) ~ log(angErr))
l$coefficients[2] %>% expect_lt(-1.5) %>% expect_gt(-2)
})
test_that("straightness r", {
set.seed(1)
n <- 200
angErr <- runif(n, 0, pi)
trjs <- lapply(1:n, function(i) TrajRediscretize(TrajGenerate(500, angularErrorSd = angErr[i]), 2))
sir <- sapply(trjs, function(trj) Mod(TrajMeanVectorOfTurningAngles(trj)))
sid <- sapply(trjs, function(trj) TrajStraightness(trj))
# plot(angErr, y = sid, pch = 16, cex = .7, ylim = range(c(sir, sid)))
# points(angErr, y = sir, pch = 16, cex = .6, col = "red")
# Test slopes of regressions
l <- lm(sir ~ angErr)
l$coefficients[2] %>% expect_lt(0) %>% expect_gt(-.5)
l <- lm(sid ~ angErr)
l$coefficients[2] %>% expect_lt(0) %>% expect_gt(-.5)
})
test_that("plots", {
csvFile <- "../testdata/096xypts.csv"
coords <- utils::read.csv(csvFile, stringsAsFactors = FALSE)
trj <- TrajFromCoords(coords, fps = 850)
# Scaling
scale <- 1 / 2500
scaled <- TrajScale(trj, scale, "m")
# Smoothing
smoothed <- TrajSmoothSG(scaled, 3, 101)
# Expect no errors from plotting (weird syntax!)
expect_error(plot(scaled), NA)
expect_error(lines(smoothed, col = "red"), NA)
expect_error(points(smoothed, pch = '.', col = 'green'), NA)
# Plot a simple trajectory with turning angles
set.seed(2)
trj <- TrajGenerate(5)
expect_error(plot(scaled, turning.angles = TRUE))
expect_error(plot(trj, turning.angles = "random"), NA)
expect_error(plot(trj, turning.angles = "directed"), NA)
})
test_that("rotation", {
# Expect a value to be equal in the first and last points
.expectSameCol <- function(trj, col = "x") {
expect_equal(trj[1, col], tail(trj, 1)[, col])
}
set.seed(1)
trj <- TrajGenerate(10)
# All default parameters
r <- TrajRotate(trj)
.expectSameCol(r, "y")
rotAngle <- pi / 2
r <- TrajRotate(trj, rotAngle)
.expectSameCol(r)
# Test rotation of trajectory that doesn't start at the origin
ttrj <- TrajTranslate(trj, 1, 1)
tr <- TrajRotate(ttrj, rotAngle)
.expectSameCol(tr)
or <- TrajRotate(trj, rotAngle, origin = as.numeric(trj[1, c("x", "y")]))
.expectSameCol(or)
# Rotate about start point
otr <- TrajRotate(ttrj, rotAngle, origin = as.numeric(ttrj[1, c("x", "y")]))
.expectSameCol(otr)
# Rotated start point should be same as unrotated start point
expect_equal(otr[1, "x"], ttrj[1, "x"])
expect_equal(otr[1, "y"], ttrj[1, "y"])
vo <- TrajMeanVelocity(trj)
vr <- TrajMeanVelocity(r)
# Expect mean vector length and path length to be unchanged, but angle to be changed
expect_equal(Mod(vr), Mod(vo))
expect_equal(TrajLength(trj), TrajLength(r))
expect_true(Arg(vr) != Arg(vo))
# Test absolute rotation
aotr <- TrajRotate(ttrj, rotAngle, origin = as.numeric(ttrj[1, c("x", "y")]), relative = FALSE)
expect_equal(Arg(aotr$displacement[2]), Arg(ttrj$displacement[2]) + rotAngle)
expect_true(aotr[1, "y"] != tail(aotr, 1)[, "y"])
plot(trj, ylim = c(-5, 20))
plot(ttrj, lty = 2, add = TRUE)
plot(r, col = "blue", add = TRUE)
plot(tr, col = "blue", lty = 2, add = TRUE)
plot(or, col = "red", lty = 3, add = TRUE)
plot(otr, col = "red", lty = 3, add = TRUE)
plot(aotr, col = "green", lty = 3, lwd = 2, add = TRUE)
})
test_that("Convert times", {
.checkTimes <- function(t, s) {
seconds <- TrajConvertTime(t)
expect_equal(length(t), length(seconds))
expect_identical(seconds, s)
}
.checkTimes(c("0:00:00:000", "0:00:00:001", "0:00:01:000", "0:01:00:000", "1:00:00:000"),
c(0, .001, 1, 60, 60 * 60))
.checkTimes(c("0:00:00:001", "0:00:00:002", "0:00:00:003", "0:00:00:004"),
c(.001, .002, .003, .004))
.checkTimes(c("1:01:01:001", "2:02:02:002", "3:03:03:003", "4:04:04:004"),
c(3661.001, 7322.002, 10983.003, 14644.004))
})
test_that("Resampling", {
# Plot one trajectory over another
plotTwoTrjs <- function(trj1, trj2) {
plot(trj1, draw.start.pt = FALSE, lwd = 2)
points(trj1, cex = .6, draw.start.pt = FALSE)
lines(trj2, col = "red", lty = 2)
points(trj2, col = "red", draw.start.pt = FALSE)
}
set.seed(1)
# Give it a constant step length of 1 so that it has a constant speed to simplify some tests
trj <- TrajGenerate(10, angularErrorSd = 1, stepLength = 1, linearErrorDist = function(n) rep(0, n), fps = 1)
trjL <- TrajLength(trj)
# These tests aren't strictly required to be true because resampled
# trajectories are also smoothed, so may be shorter than expected
ta <- TrajResampleTime(trj, .5)
expect_true(trjL - TrajLength(ta) < .5)
# plotTwoTrjs(trj, ta)
tb <- TrajResampleTime(trj, .7)
expect_true(trjL - TrajLength(tb) < .7)
# plotTwoTrjs(trj, tb)
tc <- TrajResampleTime(trj, 1)
expect_true(trjL - TrajLength(tc) == 0)
# plotTwoTrjs(trj, tc)
td <- TrajResampleTime(trj, 2)
expect_true(trjL - TrajLength(td) < 2)
# plotTwoTrjs(trj, td)
te <- TrajResampleTime(trj, 2.1)
# This isn't TRUE, since resampled te is straighter than trj
#expect_true(trjL - TrajLength(td) < 2)
# plotTwoTrjs(trj, te)
expect_error(TrajResampleTime(trj, 0))
expect_error(TrajResampleTime(trj, -0.5))
})
test_that("Invalid parameter detection", {
expect_error(TrajsBuild("short.csv", csvStruct = list(x = "x", y = "y", time="t"), rootDir = ".."),
"Invalid smoothing parameter n \\(41): n must be less than the number of points in the trajectory \\(5)")
})
test_that("FPS calculation", {
tracks <- rbind(
data.frame(file = "3527.csv", species = "Zodariid2 sp1", category = "spider"),
stringsAsFactors = FALSE
)
csvStruct <- list(x = "x", y = "y")
# Expect an error if there's no time column or FPS specified
expect_error(TrajsBuild(tracks$file, scale = .220 / 720, spatialUnits = "m", timeUnits = "s", csvStruct = csvStruct, rootDir = "..", csvReadFn = .MreadPoints),
".*Cannot create a trajectory without times: one of fps or a time column must be specified")
fps <- 50
trjs <- TrajsBuild(tracks$file, fps = fps, scale = .220 / 720, spatialUnits = "m", timeUnits = "s", csvStruct = csvStruct, rootDir = "..", csvReadFn = .MreadPoints)
# Expect the time interval between every 50 frames to be 1 second (allow small tolerance when testing == 1)
diffs <- diff(trjs[[1]]$Time, fps)
expect_true(all(abs(diffs - 1) < .00001))
# Now do the same thing with a frame rate of 240
fps <- 240
trjs <- TrajsBuild(tracks$file, fps = fps, scale = .220 / 720, spatialUnits = "m", timeUnits = "s", csvStruct = csvStruct, rootDir = "..", csvReadFn = .MreadPoints)
# Expect the time interval between every 50 frames to be 1 second (allow small tolerance when testing == 1)
diffs <- diff(trjs[[1]]$Time, fps)
expect_true(all(abs(diffs - 1) < .00001))
})
test_that("Empty trajectory", {
trj <- TrajFromCoords(data.frame(numeric(), numeric()))
expect_equal(nrow(trj), 0)
trj <- TrajFromCoords(data.frame(0, 0))
expect_equal(nrow(trj), 1)
})
test_that("Turning angles", {
set.seed(1)
nsteps <- 10000
trj <- TrajGenerate(nsteps)
expect_equal(nrow(trj), nsteps + 1)
expect_equal(length(TrajAngles(trj)), nsteps - 1)
expect_equal(length(TrajAngles(trj, compass.direction = 0)), nsteps)
# # Now add in some 0-length segments
idx <- sort(sample(seq_len(nsteps + 1), round(nsteps * 1.5), replace = T))
trj <- TrajFromCoords(trj[idx, ])
nsteps <- nrow(trj) - 1
expect_equal(nrow(trj), nsteps + 1)
expect_equal(length(TrajAngles(trj)), nsteps - 1)
expect_equal(length(TrajAngles(trj, compass.direction = 0)), nsteps)
# Check that zero length segments return an angle of NA
testdf = data.frame(x = c(1,1,2,3,4,5,5,5,5,6,7), y = c(1,2,3,3,4,3,3,3,3,2,2))
trj = TrajFromCoords(testdf)
angles <- TrajAngles(trj)
# Any angle before or after a zero segment should be NA. There are 3
# contiguous zero segments in this trajectory, so there should be 4 NAs
expect_equal(which(is.na(angles)), c(5, 6, 7, 8))
})
test_that("TrajFromTrjPoints", {
# Check that the documented method for creating a trajectory without NA angles
# works
testdf = data.frame(tc = 1:11, y = c(1,2,3,3,4,3,3,3,3,2,2), x = c(1,1,2,3,4,5,5,5,5,6,7))
trj = TrajFromCoords(testdf, xCol = "x", yCol = "y", timeCol = "tc", fps = 20, timeUnits = "hours", spatialUnits = "km")
trj2 <- TrajFromTrjPoints(trj, c(1, which(Mod(trj$displacement) != 0)))
expect_equal(TrajLength(trj2), TrajLength(trj))
# There should be no NA angles in trj2
expect_true(any(is.na(TrajAngles(trj))))
expect_false(any(is.na(TrajAngles(trj2))))
expect_equal(TrajGetUnits(trj2), TrajGetUnits(trj))
expect_equal(TrajGetFPS(trj2), TrajGetFPS(trj))
expect_equal(TrajGetTimeUnits(trj2), TrajGetTimeUnits(trj))
expect_equal(trj2$displacementTime[nrow(trj2)], trj$displacementTime[nrow(trj)])
})
test_that("Rediscretization with simulated speed", {
trj <- TrajGenerate()
rd <- TrajRediscretize(trj, 2, simConstantSpeed = TRUE)
# plot(trj, lwd = 3)
# lines(rd, col = 2)
# Start times should be equal
expect_equal(rd$time[1], trj$time[1])
# Average speed should be similar
rdSp <- mean(Mod(TrajVelocity(rd)), na.rm = TRUE)
trjSp <- mean(Mod(TrajVelocity(trj)), na.rm = TRUE)
expect_lt(abs(log(rdSp / trjSp)), log(1.02))
# FPS should be similar
expect_equal(TrajGetFPS(rd), TrajGetFPS(trj), tolerance = 0.1)
# Change in speed roughly 0
acc <- mean(TrajDerivatives(rd)$acceleration, na.rm = TRUE)
expect_equal(acc, 0)
# Test that simulation without time throws exception
rd2 <- TrajRediscretize(trj, 2, simConstantSpeed = FALSE)
expect_error(TrajRediscretize(rd2, 4, simConstantSpeed = TRUE))
})
test_that("column overwriting check", {
n <- 10
df <- data.frame(realX = cumsum(rnorm(n)), realY = cumsum(rnorm(n)), x = rnorm(n), y = rnorm(n))
trj <- TrajFromCoords(df, "x", "y")
expect_equal(trj$x, df$x)
expect_equal(trj$y, df$y)
trj <- TrajFromCoords(df, 3, 4)
expect_equal(trj$x, df$x)
expect_equal(trj$y, df$y)
# Should throw an error because columns x and y will be overwritten
expect_error(TrajFromCoords(df))
expect_error(TrajFromCoords(df, 1, 2))
expect_error(TrajFromCoords(df, "realX", "realY"))
})
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.