tests/testthat/test.dBGB.R

In move: Visualizing and Analyzing Animal Track Data

# echo '`require(testthat); require(raster);require(geosphere); suppressMessages(require(rgdal)); t<-sapply(list.files("R", full.names=TRUE), source); test_dir("tests/testthat")' | R -q --vanilla
context("dynBGB")
test_that("dbgb vs dbbmm variance", {
  skip_on_os("solaris")
  skip_on_cran()
  vBBMM <- move:::brownian.motion.variance(x <- c(1, 1.5, 3, 3.5, 5, 5.5, 7, 7.5, 9), y <- c(0, .5, 0, .5, 0, .5, 0, .5, 0), time.lag = rep(1, 9), location.error = rep(.1, 9))
  yy <- move(x, y, Sys.time() + 1:9 * 60)
  vBGB <- move:::BGBvar(yy, locErr = rep(.1, 9))
  expect_equal(unlist(vBBMM$cll), unlist(vBGB[3]), check.names = F, tolerance = 1e-7)
  expect_equal(vBBMM$BMvar, prod(vBGB[1:2]), tolerance = 2e-5)
})
test_that("dbgb error handling in relation to projections", {
  skip_on_cran()
  skip_on_os("solaris")
  data(leroy)
  # 	expect_warning(
  expect_error(
    suppressWarnings(dynBGB(leroy[1:40, ], locErr = .0005, raster = .00150, ext = 17.3, margin = 15, windowSize = 31)),
    "You can not use longitude latitude projection for this function. To transform your coordinates use the spTransform function"
  )
  # 		     ,'Optimized to zero')
  r <- raster(nrows = 100, ncols = 100, xmn = 0, xmx = 10)
  expect_error(
    dynBGB(spTransform(leroy[1:40, ], center = T), locErr = .0005, raster = r, ext = 17.3, margin = 15, windowSize = 31), "The projection of the raster and the Move object are not equal"
  ) # equal projection
})
test_that("dbgb vs dbbmm", {
  skip_on_cran()
  skip_on_os("solaris")
  x <- 12:42
  xx <- floor(x / 2) + (y <- ((x / 2) %% 1) / 6)
  m <- move(x + y, y, Sys.time() + x)
  # 	 l<-(x+max(x))/(max(x)*5)
  l <- rep(.1, length(x))
  r <- raster(extent(m) + c(-22, 1.5))
  res(r) <- .025
  tss <- .00110523 / 60
  bgb <- dynBGB(m, r, locErr = l, windowSize = 23, margin = 9, timeStep = (tss <- .00110523 / 60))
  suppressMessages(bbmm <- brownian.bridge.dyn(m, raster = bgb, location.error = l, window.size = 23, margin = 9, time.step = tss))
  # 	 par(mfrow=c(2:1));plot(bgb); lines(m); points(m);plot(bbmm); lines(m); points(m)
  # 	 plot(bgb-bbmm); lines(m)
  # 	 plot((bgb-bbmm)/(bgb+bbmm), zlim=c(-.1,.1)); lines(m)
  # 	 plot( bgb@var@orthSd*bgb@var@paraSd, bbmm@DBMvar@means); abline(0,1)
  bbmm@method <- "dynBGB"
  expect_equal(as(bgb, ".UD"), as(bbmm, ".UD"), tolerance = tss * 60)
})
test_that("deltaParaOrth", {
  skip_on_cran()
  skip_on_os("solaris")
  expect_identical(move:::deltaParaOrth(cbind(0, 1), cbind(1, 2), cbind(0, 1)), move:::deltaParaOrth(0:1, cbind(1, 2), cbind(0, 1)))
  expect_identical(move:::deltaParaOrth(cbind(0, 1), cbind(1, 2), cbind(0, 1)), move:::deltaParaOrth(cbind(0, 1), 1:2, cbind(0, 1)))
  expect_identical(move:::deltaParaOrth(cbind(0:2, 1:3) + 2, cbind(c(1, 1, 1), c(2, 2, 2)), cbind(2:4, 1:3)), move:::deltaParaOrth(cbind(0:2, 1:3) + 2, 1:2, cbind(2:4, 1:3)))
  expect_equivalent(move:::deltaParaOrth(cbind(0, 1), cbind(1, 2), cbind(0, 1)), cbind(0, 0))
  expect_equivalent(move:::deltaParaOrth(cbind(0, 1), cbind(1, 2), cbind(0, 0)), cbind(-sqrt(.5), sqrt(.5)))
  expect_equivalent(move:::deltaParaOrth(cbind(0, 0), cbind(2, 2), cbind(1, 1)), cbind(sqrt(2), 0))
  suppressWarnings(expect_equivalent(move:::deltaParaOrth(cbind(0, 0), cbind(0, 0), cbind(1, 1)), cbind(1, 1)))
  expect_warning(move:::deltaParaOrth(cbind(0, 0), cbind(0, 0), cbind(1, 1)), "Brownian motion assumed, because no direction could be calculated")
})
test_that("dyn bgb basics", {
  skip_on_cran()
  skip_on_os("solaris")
  data(leroy)
  dataC <- spTransform(leroy, center = T)
  resUd <- 5.3
  ud <- dynBGB(dataC[1:45, ], windowSize = 31, margin = 15, locErr = 4, raster = resUd, ext = 9)
  ud2 <- dynBGB(v <- dynBGBvariance(m <- dataC[1:45, ], windowSize = 31, margin = 15, locErr = l <- rep(4, n.locs(dataC))), raster = resUd, ext = 9, locErr = l)
  expect_identical(
    as(Class = ".MoveTrackSingle", v[1:10, ]),
    as(Class = ".MoveTrackSingle", m[1:10, ])
  )
  expect_identical(
    slot(v, "paraSd")[1:20],
    slot(v[1:20, ], "paraSd")
  )
  expect_identical(
    v[c(T, T, F, F, T), ],
    v[rep(c(1, 2, 5), 9) + rep(0:8 * 5, each = 3), ]
  )

  expect_is(ud, "dynBGB")
  expect_is(ud, ".UD")
  expect_equal(res(ud), resUd[c(1, 1)])
  expect_equal(proj4string(ud), proj4string(dataC))
  expect_equal(ud2, ud)
})
test_that("work with time step with varying loc err", {
  skip_on_cran()
  skip_on_os("solaris")
  l <- dynBGB(m <- new("dBGBvariance", move(0:1, 0:1, Sys.time() + 0:1), margin = 1, windowSize = 1, segInterest = c(T, F), paraSd = 1:0 / 2, orthSd = 1:0 / 2, nEstim = 2:3), raster = .004, ext = 2, locErr = (le <- c(.01, .03)), timeStep = .4 / 60)
  expect_equal(sum(values(p <- crop(l, e <- extent(.5, .5, .5, .5) + .45))), 1 / 3, tolerance = 1.4e-7)
  a <- .5
  s <- sqrt((1 / 60) * a * (1 - a) * m@paraSd[1] * m@orthSd[1] + a^2 * le[2]^2 + (1 - a)^2 * le[1]^2)
  # 	  pp<-calc(rasterFromXYZ(rasterToPoints(p)[,c(1,2,1,2)]), function(x){prod(dnorm(x, .5, sd=s))* prod(res(p))/3})
  pp <- p
  values(pp) <- dnorm(xFromCell(pp, 1:ncell(pp)), .5, sd = s) *
    dnorm(yFromCell(pp, 1:ncell(pp)), .5, sd = s) * prod(res(pp)) / 3
  expect_equal(values(p), values(pp), tolerance = 1e-5)
  expect_lt(sum(values(abs(p - pp))), 2e-6)
  expect_equal(sum(values(p <- crop(l, e <- extent(.1, .1, .1, .1) + .4))), 1 / 3, tolerance = 1e-7)
  a <- .1
  s <- sqrt((1 / 60) * a * (1 - a) * m@paraSd[1] * m@orthSd[1] + a^2 * le[2]^2 + (1 - a)^2 * le[1]^2)
  pp <- p
  values(pp) <- dnorm(xFromCell(pp, 1:ncell(pp)), .1, sd = s) *
    dnorm(yFromCell(pp, 1:ncell(pp)), .1, sd = s) * prod(res(pp)) / 3
  # pp<-calc(rasterFromXYZ(rasterToPoints(p)[,c(1,2,1,2)]), function(x){prod(dnorm(x, .1, sd=s))* prod(res(p))/3})
  expect_equal(values(p), values(pp), tolerance = 1e-5)
  expect_lt(sum(values(abs(p - pp))), 2.2e-6)
})
test_that("work with time step var orth para", {
  skip_on_cran()
  skip_on_os("solaris")
  r <- raster(extent(c(-.5, 1.54, -1.123, 1)))
  res(r) <- .0053
  l <- dynBGB(m <- new("dBGBvariance", move(0:2 / 2, c(0, 0, 0), Sys.time() + 0:2), margin = 1, windowSize = 1, segInterest = c(T, T, F), paraSd = 2:0 / 2, orthSd = 1:3 / 3, nEstim = rep(2, 3)), raster = r, ext = 2, locErr = le <- .01, timeStep = 1.6 / 60)
  expect_equal(sum(values(p <- crop(l, e <- extent(.1, .1, 0, 0) + .6))), 1 / 2, tolerance = 2e-8)
  a <- .2
  s <- sqrt((1 / 60) * a * (1 - a) * c(m@paraSd[1], m@orthSd[1])^2 + a^2 * le^2 + (1 - a)^2 * le^2)
  pp <- p
  values(pp) <- dnorm(xFromCell(pp, 1:ncell(pp)), .1, sd = s[1]) *
    dnorm(yFromCell(pp, 1:ncell(pp)), 0, sd = s[2])
  # 	  	  pp<-calc(rasterFromXYZ(rasterToPoints(p)[,c(1,2,1,2)]), function(x){prod(dnorm(x, c(.1,0), sd=s))})
  expect_equal(values(p), values(pp) * prod(res(pp)) * 1 / 2, tolerance = 7e-7)
  expect_lt(sum(values(abs(p - pp * prod(res(pp)) / 2))), 7e-7)

  expect_equal(sum(values(p <- crop(l, e <- extent(.9, .9, 0, 0) + .6))), 1 / 2, tolerance = 2e-8)
  a <- .8
  s <- sqrt((1 / 60) * a * (1 - a) * c(m@paraSd[2], m@orthSd[2])^2 + a^2 * le^2 + (1 - a)^2 * le^2)
  # pp<-calc(rasterFromXYZ(rasterToPoints(p)[,c(1,2,1,2)]), function(x){prod(dnorm(x, c(.9,0), sd=s))})
  pp <- p
  values(pp) <- dnorm(xFromCell(pp, 1:ncell(pp)), .9, sd = s[1]) *
    dnorm(yFromCell(pp, 1:ncell(pp)), .0, sd = s[2])
  expect_equal(values(p), values(pp) * prod(res(pp)) * 1 / 2, tolerance = 3e-6)
  expect_lt(sum(values(abs(p - pp * prod(res(pp)) / 2))), 15e-7)
})