tests/testthat/test-mt_interpolate.R

In move2: Processing and Analysing Animal Trajectories

test_that("basic interpolation", {
  d <- data.frame(x = c(1L:5L), y = c(1L:5L), timestamp = 1L:5L, track = gl(1, 5), timestamp2 = c(0, 1, 3, 6, 10)) |>
    st_as_sf(coords = 1L:2L) |>
    mt_as_move2(track_id_column = "track", time_column = "timestamp")
  expect_silent(mt_interpolate(d))
  expect_identical(mt_interpolate(d, 2:4, omit = TRUE) |> mt_time(), 2:4)
  dd <- d
  dd$geometry[c(1, 3, 5)] <- sf::st_point()
  expect_equal(st_coordinates(mt_interpolate(dd)), cbind(c(NA, 2:4, NA), c(NA, 2:4, NA)), ignore_attr = TRUE)
  dd <- d
  dd$geometry[c(2, 3, 4)] <- sf::st_point()
  expect_equal(st_coordinates(mt_interpolate(dd)), cbind(c(1L:5L), c(1L:5L)), ignore_attr = TRUE)
  expect_identical(mt_interpolate(dd), d)
  expect_identical(st_geometry(mt_interpolate(d[-3, ], 3L)), st_geometry(d)[TRUE, ]) # temporary fix for points matrix
  expect_silent(mt_interpolate(d[-3, ], 3L))
  expect_silent(mt_interpolate(d[-3, ], 3L))
  expect_error(mt_interpolate(d[-3, ], "5 mins"), "does not correspond to the class of the .time.")
})

test_that("crs in crs out for interpolate", {
  m <- mt_sim_brownian_motion()
  sf::st_geometry(m)[c(3:5, 14, 20)] <- sf::st_point()
  expect_identical(st_crs(m), st_crs(mt_interpolate(m)))
  m <- sf::st_set_crs(mt_sim_brownian_motion(), 4326)
  expect_identical(st_crs(m), st_crs(mt_interpolate(m)))
  m <- sf::st_set_crs(mt_sim_brownian_motion(), 3857)
  expect_identical(st_crs(m), st_crs(mt_interpolate(m)))
})


test_that("start end locations stay empty", {
  m <- mt_sim_brownian_motion()
  sf::st_geometry(m)[c(3:5, 10, 14, 20)] <- sf::st_point()
  expect_identical(which(st_is_empty(mt_interpolate(m))), c(10L, 20L))
  # omit only takes effect when time argument is used
  expect_identical(mt_interpolate(m, omit = TRUE), mt_interpolate(m, omit = FALSE))
  expect_identical(which(st_is_empty(mt_interpolate(sf::st_set_crs(m, 4326)))), c(10L, 20L))
  m <- mt_sim_brownian_motion()
  sf::st_geometry(m)[c(1, 3:5, 11, 14, 20)] <- sf::st_point()
  expect_identical(which(st_is_empty(mt_interpolate(m))), c(1L, 11L, 20L))
  expect_identical(which(st_is_empty(mt_interpolate(sf::st_set_crs(m, 4326)))), c(1L, 11L, 20L))
})


test_that("works on long lat", {
  # to gen data: dput(data.frame(geosphere::destPoint(c(45,67),270, d = c(0,10,60,90)*1000), t=c(1,2,7,10), id="a"))
  m <- structure(list(lon = c(
    45, 44.7707477678058, 43.6247042339104,
    42.9374757707606
  ), lat = c(
    67, 66.9998348693807, 66.9940560433849,
    66.9866282535198
  ), t = c(1, 2, 7, 10), id = c(
    "a", "a", "a",
    "a"
  )), class = "data.frame", row.names = c(NA, -4L)) |>
    st_as_sf(coords = 1L:2L, crs = 4326) |>
    mt_as_move2(time_column = "t", track_id_column = "id")
  mm <- m
  mm$geometry[2L:3L] <- st_point()
  expect_equal(mt_interpolate(mm), m, tolerance = 7e-08) # allow small tolerances as geosphere might differ from s2
  expect_true(all(sf::st_distance(mt_interpolate(mm), m, by_element = TRUE) < set_units(1, "m")))
  expect_equal(mt_interpolate(st_transform(mm, 3857)), st_transform(m, 3857),
    tolerance = 7e-08
  ) # allow small tolerances as geosphere might differ from s2
  expect_true(all(sf::st_distance(mt_interpolate(st_transform(mm, 3857)),
    st_transform(m, 3857),
    by_element = TRUE
  ) < set_units(1, "m")))
  expect_equal(st_transform(mt_interpolate(st_transform(mm, 3857)), 4326), m,
    tolerance = 7e-08
  ) # allow small tolerances as geosphere might differ from s2
  expect_true(all(sf::st_distance(st_transform(mt_interpolate(st_transform(mm, 3857)), 4326), m,
    by_element = TRUE
  ) < set_units(1, "m")))
  mmm <- m
  mmm$x <- 1
  expect_identical(
    mt_interpolate(m, mt_time(m)[2L:3L], omit = TRUE),
    mt_interpolate(mmm, mt_time(mmm)[2L:3L], omit = TRUE)[, 1L:3L]
  )
  expect_identical(
    mmm$x,
    mt_interpolate(mmm, mt_time(mmm)[2L:3L])$x
  )
  mmm$x <- NULL
  mmm$time <- 1

  expect_identical(
    mt_interpolate(m, mt_time(m)[2L:3L] + 2, omit = TRUE),
    mt_interpolate(mmm, mt_time(mmm)[2L:3L] + 2, omit = TRUE)[, 1L:3L]
  )
  expect_identical(
    c(1, 1, NA, 1, NA, 1),
    mt_interpolate(mmm, mt_time(mmm)[2L:3L] + 2)$time
  )
})

test_that("time_gap", {
  t <- c(1, 3, 5, 6, 7)
  m <- mt_as_move2(data.frame(x = t, y = t, t = t, id = "a", stringsAsFactors = FALSE),
    coords = 1L:2L, time_column = "t", track_id_column = "id"
  )
  m$geometry[c(2L, 4L)] <- sf::st_point()
  expect_identical(which(st_is_empty(mt_interpolate(m, max_time_lag = 5))), integer(0))
  expect_identical(which(st_is_empty(mt_interpolate(m, max_time_lag = 3))), 2L)
  expect_identical(which(st_is_empty(mt_interpolate(m, max_time_lag = 2))), 2L)
  expect_identical(which(st_is_empty(mt_interpolate(m, max_time_lag = 1.5))), c(2L, 4L))
  expect_error(mt_interpolate(m, max_time_lag = as.difftime(141, units = "secs")))
  expect_error(mt_interpolate(m, max_time_lag = set_units(3, "min")))
})

test_that("time_gap with posixct", {
  t <- as.POSIXct("1980-1-1", tz = "UTC") + c(1, 3, 5, 6, 7) * 60
  m <- mt_as_move2(data.frame(x = t, y = t, t = t, id = "a", stringsAsFactors = FALSE),
    coords = 1L:2L, time_column = "t", track_id_column = "id"
  )
  m$geometry[c(2L, 4L)] <- sf::st_point()
  expect_identical(which(st_is_empty(mt_interpolate(m, max_time_lag = as.difftime(5, units = "mins")))), integer(0))
  expect_identical(which(st_is_empty(mt_interpolate(m, max_time_lag = as.difftime(241, units = "secs")))), integer(0))
  expect_identical(which(st_is_empty(mt_interpolate(m, max_time_lag = as.difftime(3, units = "mins")))), 2L)
  expect_identical(which(st_is_empty(mt_interpolate(m, max_time_lag = as.difftime(141, units = "secs")))), 2L)
  expect_identical(which(st_is_empty(mt_interpolate(m, max_time_lag = set_units(3, "min")))), 2L)
  expect_identical(which(st_is_empty(mt_interpolate(m, max_time_lag = set_units(141, "sec")))), 2L)
  expect_error(mt_interpolate(m, max_time_lag = 3))
  expect_identical(
    mt_interpolate(m, "2 mins") |> mt_time(),
    as.POSIXct("1980-1-1", tz = "UTC") + c(1, 2, 3, 4, 5, 6, 7) * 60
  )
  expect_identical(
    mt_interpolate(m, "2 mins", omit = TRUE) |> mt_time(),
    as.POSIXct("1980-1-1", tz = "UTC") + c(2, 4, 6) * 60
  )
  t <- mt_time(m)[2L:3L]
  expect_identical(
    mt_interpolate(m, t, omit = TRUE),
    mt_interpolate(m, lubridate::with_tz(t, "EST"), omit = TRUE)
  )
  expect_identical(
    mt_interpolate(m, t, omit = FALSE),
    mt_interpolate(m, lubridate::with_tz(t, "EST"), omit = FALSE)
  )
})


test_that("time_gap with posixct", {
  t <- as.Date("1980-1-1") + c(1, 3, 5, 6, 7)
  m <- mt_as_move2(data.frame(
    x = t, y = t, t = t, id = "a",
    stringsAsFactors = FALSE
  ), coords = 1L:2L, time_column = "t", track_id_column = "id")
  m$geometry[c(2L, 4L)] <- sf::st_point()
  expect_error(mt_interpolate(m, max_time_lag = 5))
  expect_identical(
    which(st_is_empty(
      mt_interpolate(m, max_time_lag = set_units(5, "days"))
    )),
    integer(0)
  )
  expect_identical(
    which(st_is_empty(
      mt_interpolate(m, max_time_lag = set_units(3, "days"))
    )),
    2L
  )
  expect_identical(
    which(st_is_empty(
      mt_interpolate(m, max_time_lag = as.difftime(48, units = "hours"))
    )),
    2L
  )
  expect_identical(
    which(st_is_empty(
      mt_interpolate(m, max_time_lag = set_units(36, "hour"))
    )),
    c(2L, 4L)
  )
})
test_that("error different time", {
  m <- mt_sim_brownian_motion(t = c(1L:5L, 5.5))
  tt <- Sys.time()
  mt <- mt_sim_brownian_motion(t = (as.Date(tt) + -1L:4L))

  expect_s3_class(mt_interpolate(m, 1.5), "move2")
  expect_error(mt_interpolate(m, tt), "does not correspond to the class of the .time.")
  expect_error(mt_interpolate(mt, tt), "does not correspond to the class of the .time.")
  expect_error(mt_interpolate(mt, "hour"), "does not correspond to the class of the .time.")
})


test_that("spatial interpolation works (unprojected)", {
  d <- data.frame(x = c(1L:5L), y = c(1L:5L), track = gl(1, 5), timestamp = c(0, 1, 3, 6, 10)) |>
    st_as_sf(coords = 1L:2L) |>
    mt_as_move2(track_id_column = "track", time_column = "timestamp")
  ln <- st_sfc(st_linestring(cbind(c(0, 3), c(3, 0))))
  expect_s3_class(m <- mt_interpolate(d, sf = ln), "move2")
  expect_identical(
    mt_time(m),
    sort(c(mt_time(d), mean(mt_time(d)[1:2])))
  )
  expect_identical(nrow(m),6L)
  expect_identical(st_geometry(m)[[2]], st_point(c(1.5, 1.5)))
  expect_error(mt_interpolate(d, sf = st_sfc(st_linestring(cbind(c(0, 3), c(3, 0))), crs = 4326)))
})


test_that("spatial interpolation works (projected)", {
  d <- data.frame(x = c(1L:5L), y = c(1L:5L), track = gl(1, 5),
                  timestamp = as.POSIXct("1970-1-1", tz = "CEST") + c(0, 1, 3, 6, 10)) |>
    st_as_sf(coords = 1L:2L, crs = 4326) |>
    mt_as_move2(track_id_column = "track", time_column = "timestamp")
  ln <- st_sfc(st_linestring(cbind(c(0, 3), c(3, 0))), crs = 4326)
  expect_s3_class(m <- mt_interpolate(d, sf = ln), "move2")
  expect_identical(nrow(m),6L)
  expect_identical(mt_time(m)[2], as.POSIXct("1970-1-1", tz = "CEST") + .5008000209503045)
  expect_identical(st_geometry(m)[[2]], st_point(c(1.50068573746802270, 1.50085712245130076)))
  expect_error(mt_interpolate(d, sf = st_sfc(st_linestring(cbind(c(0, 3), c(3, 0))))))
  expect_error(mt_interpolate(d, sf = st_sfc(st_linestring(cbind(c(0, 3), c(3, 0))), crs = 3035)))
})


test_that("spatial interpolation with sf and two tracks", {
  d <- data.frame(x = c(1L:5L, 0:4), y = c(1L:5L),
                  tt=1:10,
                  track = gl(2, 5), timestamp = c(0, 1, 3, 6, 10)) |>
    st_as_sf(coords = 1L:2L) |>
    mt_as_move2(track_id_column = "track", time_column = "timestamp")
  ln <- st_sf(data.frame(ha=c("a","b"),g=st_sfc(list(st_linestring(cbind(c(0, 3), c(3, 0))),
                                                     st_linestring(cbind(c(0, 5), c(3, 0)))))))
  #no intersection
  expect_identical(mt_interpolate(d, sf=st_sfc(st_linestring(cbind(0:1,0)))),d)
  expect_null(mt_interpolate(d, sf=st_sfc(st_linestring(cbind(0:1,0))), omit = T))
  # intersection on point
  expect_s3_class(m <- mt_interpolate(d, sf = ln), "move2")
  expect_identical(nrow(m), 13L)
  expect_named(m, c('tt','track','timestamp', 'geometry',"ha"))
})



test_that("spatial interpolation track data", {
  d <- data.frame(x = c(1L:5L,0:4), y = c(1L:5L), track = gl(2, 5),  age = gl(2, 5),
                  timestamp = as.POSIXct("1970-1-1", tz = "CEST") + c(0, 1, 3, 6, 10)) |>
    st_as_sf(coords = 1L:2L) |> dplyr::as_tibble() |>
    mt_as_move2(track_id_column = "track", time_column = "timestamp", track_att="age")
  ln <- st_sfc(st_linestring(cbind(c(0, 3), c(3, 0))))
  expect_s3_class(m <- mt_interpolate(d, sf = ln), "move2")
  # One location is exactly at line
  expect_identical(nrow(m),11L)
  expect_identical(mt_track_data(m), mt_track_data(d))
  expect_identical(m[-2,],d)
  expect_s3_class(m <- mt_interpolate(d, sf = ln, omit=T), "move2")
  expect_identical(nrow(m),2L)
  expect_identical(mt_track_data(m), mt_track_data(d))
})



test_that("spatial interpolation with multiline", {
  d <- data.frame(x = rep(1:2, each=5), y = c(0L:4L), track = gl(2, 5),  age = gl(2, 5),
                  timestamp = as.POSIXct("1970-1-1", tz = "UTC") + c(0, 1, 3, 6, 10)) |>
    st_as_sf(coords = 1L:2L) |> dplyr::as_tibble() |>
    mt_as_move2(track_id_column = "track", time_column = "timestamp", track_att="age")
  ln <- st_sfc(list(
    sf::st_multilinestring(list(cbind(c(0,3),2.5),cbind(c(0,3),3.5))),
    st_linestring(cbind(c(0, 3,3,0), c(.5,.5, 1.5,1.5)))))
  expect_s3_class(m <- mt_interpolate(d, sf = ln), "move2")
  expect_identical(nrow(m),18L)
  expect_identical(mt_time(m)[1:9], as.POSIXct("1970-1-1", tz = "UTC")+c(0,.5,1,2,3,4.5,6,8,10))
  expect_identical(mt_track_data(m), mt_track_data(d))
  expect_s3_class(m <- mt_interpolate(d, sf = ln, omit=T), "move2")
  expect_identical(nrow(m),8L)
  expect_identical(mt_track_data(m), mt_track_data(d))
  expect_identical(st_coordinates(m), cbind(X=rep(1:2, each=4), Y=(1:4)-.5))
})



test_that("spatial interpolation with duplicated records", {
  d <- data.frame(x = rep(1:2, each=5), y = c(0L:4L), track = gl(2, 5),  age = gl(2, 5),
                  timestamp = as.POSIXct("1970-1-1", tz = "UTC") + c(0, 1, 3, 6, 10)) |>
    st_as_sf(coords = 1L:2L) |> dplyr::as_tibble() |>
    mt_as_move2(track_id_column = "track", time_column = "timestamp", track_att="age")
  ln <- st_sf(
    data.frame(ha=c("a"),g=st_sfc(list(st_linestring(cbind(c(0.2, 3), c(3, 0)))))))

  expect_warning(m<-mt_interpolate(d, sf = ln[c(1,1),]), class="move2_warning_interpolation_duplicates_sf")
  expect_identical(nrow(m),12L)
  expect_s3_class(m , "move2")
  expect_warning(m<-mt_interpolate(d[c(1:2,2,3:10),], sf = ln), class="move2_warning_interpolation_duplicates_x")

  expect_identical(nrow(m),12L)
  expect_s3_class(m , "move2")
  })