tests/testthat/test_basic.R

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"))
})
JimMcL/trajr documentation built on Jan. 31, 2024, 12:57 a.m.