# Test group_lines context('test group_lines') library(spatsoc) DT <- fread('../testdata/DT.csv') utm <- 32736 DT[, datetime := as.POSIXct(datetime)] DT[, jul := data.table::yday(datetime)] DT[, family := sample(c(1, 2, 3, 4), .N, replace = TRUE)] test_that('one of DT or sfLines is required, not both or neither', { expect_error( group_lines( DT = NULL, threshold = 10, sfLines = NULL ), 'must provide either DT or sfLines' ) expect_error( group_lines( DT = DT, threshold = 10, sfLines = build_lines( DT, crs = utm, coords = c('X', 'Y'), id = 'ID', sortBy = 'datetime' ) ), 'cannot provide both DT and sfLines' ) }) test_that('coords, id, crs provided and proper format', { copyDT <- copy(DT) group_times(copyDT, datetime = 'datetime', threshold = '1 day') expect_error( group_lines( DT = copyDT, threshold = 10, timegroup = 'timegroup', id = NULL, coords = c('X', 'Y'), crs = utm ), 'id must be provided' ) expect_error( group_lines( DT = copyDT, threshold = 10, timegroup = 'timegroup', id = 'ID', coords = c('X', 'Y'), crs = NULL ), 'crs must be provided', fixed = FALSE ) expect_error( group_lines( DT = copyDT, threshold = 10, timegroup = 'timegroup', id = 'ID', coords = NULL, crs = utm ), 'coords must be provided' ) expect_error( group_lines( DT = copyDT, threshold = 10, timegroup = 'timegroup', id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = NULL ), 'sortBy must be provided' ) }) test_that('column names must exist in DT', { expect_error( group_lines( DT = DT, threshold = 10, timegroup = 'timegroup', id = 'potatoID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ), 'not present in input', fixed = FALSE ) expect_error( group_lines( DT = DT, threshold = 10, timegroup = 'timegroup', id = 'ID', coords = c('potatoX', 'potatoY'), crs = utm, sortBy = 'datetime' ), 'not present in input', fixed = FALSE ) }) test_that('timegroup is correctly provided but is not required', { copyDT <- copy(DT) # to avoid block length warning suppressWarnings( group_times(copyDT, datetime = 'datetime', threshold = '14 days') ) copyDT[, N := .N, by = .(ID, timegroup)] expect_error( group_lines( DT = copyDT[N > 2], threshold = 10, timegroup = 'potato', id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ), 'potato field', fixed = FALSE ) expect_true(inherits(group_lines( DT = copyDT, threshold = 10, timegroup = NULL, id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ), 'data.table') ) }) test_that('threshold is correctly provided, or error', { copyDT <- copy(DT) # to avoid block length warning suppressWarnings( group_times(copyDT, datetime = 'datetime', threshold = '14 days') ) copyDT[, N := .N, by = .(ID, timegroup)] expect_message( group_lines( DT = copyDT[N > 2], threshold = NULL, timegroup = 'timegroup', id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ), 'threshold missing, using 0 by default' ) expect_error( group_lines( DT = DT, threshold = -10, timegroup = 'timegroup', id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ), 'threshold must be > 0' ) expect_error( group_lines( DT = DT, threshold = '0', timegroup = 'timegroup', id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ), 'threshold must be of class numeric' ) }) test_that('group lines returns a single warning for <2 locs', { copyDT <- copy(DT) # to avoid block length warning suppressWarnings( group_times(copyDT, datetime = 'datetime', threshold = '14 days') ) copyDT[1, ID := 'Z'] expect_warning( group_lines( DT = copyDT, threshold = 10, timegroup = 'timegroup', id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ), 'some rows were dropped, cannot build a line with', fixed = FALSE ) copyDT <- copy(DT) copyDT[1, ID := 'Z'] expect_warning( group_lines( DT = copyDT, threshold = 10, timegroup = NULL, id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ), 'some rows were dropped, cannot build a line with', fixed = FALSE ) }) test_that('group column is added to result or NA if < 2 locs', { copyDT <- copy(DT) # to avoid block length warning suppressWarnings( group_times(copyDT, datetime = 'datetime', threshold = '14 days') ) copyDT[, N := .N, by = .(ID, timegroup)] expect_true('group' %in% colnames( group_lines( DT = copyDT[N > 2], threshold = 10, timegroup = 'timegroup', id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ) )) copyDT <- copy(DT) copyDT[1, ID := 'Z'] expect_true(suppressWarnings( group_lines( DT = copyDT, threshold = 10, id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' )[is.na(group), .N] != 0) ) copyDT <- DT[, .SD[1], by = ID] expect_true(suppressWarnings( group_lines( DT = copyDT, threshold = 10, id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' )[is.na(group), .N] != 0) ) }) test_that('only one column added to the result DT', { copyDT <- copy(DT) # to avoid block length warning suppressWarnings( group_times(copyDT, datetime = 'datetime', threshold = '14 days') ) copyDT[, N := .N, by = .(ID, timegroup)] expect_equal(ncol(copyDT[N > 2]) + 1, ncol( group_lines( DT = copyDT[N > 2], threshold = 10, timegroup = 'timegroup', id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ) )) }) test_that('no rows are added to the result DT', { copyDT <- copy(DT) # to avoid block length warning suppressWarnings( group_times(copyDT, datetime = 'datetime', threshold = '14 days') ) copyDT[, N := .N, by = .(ID, timegroup)] copyDT <- copyDT[N > 2] expect_equal(nrow(copyDT), nrow( group_lines( DT = copyDT, threshold = 10, timegroup = 'timegroup', id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ) )) }) test_that('withinGroup is not returned to the user', { copyDT <- copy(DT) # to avoid block length warning suppressWarnings( group_times(copyDT, datetime = 'datetime', threshold = '14 days') ) copyDT[, N := .N, by = .(ID, timegroup)] expect_false('withinGroup' %in% colnames( group_lines( DT = copyDT[N > 2], threshold = 10, timegroup = 'timegroup', id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ) )) }) test_that('only 1 unique timegroup * splitBy', { copyDT <- DT[, mnth := month(datetime)][, yr := year(datetime)] copyDT[, nBy := .N, by = .(yr, mnth, ID)] copyDT <- copyDT[nBy > 2] group_lines( DT = copyDT, threshold = 100, timegroup = 'mnth', id = 'ID', coords = c('X', 'Y'), crs = utm, splitBy = 'yr', sortBy = 'datetime' ) expect_equal(copyDT[, .(uniqueMonths = uniqueN(mnth)), by = .(group)][, max(uniqueMonths)], 1) expect_equal(copyDT[, .(uniqueYears = uniqueN(yr)), by = .(group)][, max(uniqueYears)], 1) }) # or uniquen(.SD, by = c(id, splitBy)) test_that('group column succesfully detected', { copyDT <- copy(DT)[, group := 1] copyDT[, mnth := month(datetime)][, yr := year(datetime)] copyDT[, nBy := .N, by = .(yr, mnth, ID)] copyDT <- copyDT[nBy > 2] expect_message( group_lines( DT = copyDT, threshold = 0, timegroup = 'mnth', id = 'ID', coords = c('X', 'Y'), crs = utm, splitBy = 'yr', sortBy = 'datetime' ), 'group column will be overwritten' ) expect_message( group_lines( DT = copyDT, threshold = 0, id = 'ID', coords = c('X', 'Y'), crs = utm, splitBy = 'yr', sortBy = 'datetime' ), 'group column will be overwritten' ) }) # group_lines( # DT = DT, # threshold = 10, # datetime = 'timegroup', # splitBy = 'family', # id = 'ID', # coords = c('X', 'Y'), # crs = utm # ) test_that('sfLines provided must be an sf LINESTRING', { expect_error( group_lines(sfLines = DT, threshold = 10, id = 'ID'), 'sfLines provided must be a sf object' ) # TODO: test linestring }) test_that('sfLines id provided, uniqueN(id) match n rows', { sfLines <- build_lines( DT = DT, id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ) expect_error( group_lines(sfLines = sfLines, threshold = 10, id = NULL), 'id must be provided' ) sfLines_dup <- rbind(sfLines, sfLines) expect_error( group_lines(sfLines = sfLines_dup, threshold = 10, id = 'ID'), 'number of unique values in sfLines' ) }) test_that('sfLines provided returns data.table', { sfLines <- build_lines( DT = DT, id = 'ID', coords = c('X', 'Y'), crs = utm, sortBy = 'datetime' ) expect_true( inherits(group_lines(sfLines = sfLines, threshold = 10, id = 'ID'), 'data.table') ) expect_true( inherits(group_lines(sfLines = sfLines, threshold = 0, id = 'ID'), 'data.table') ) expect_equal( nrow(group_lines(sfLines = sfLines, threshold = 10, id = 'ID')), nrow(sfLines) ) }) test_that('splitBy argument doesnt use splitBy column', { copyDT <- copy(DT) copyDT[, splitBy := as.IDate(datetime)] group_times(copyDT, 'datetime', '1 day') utm <- 'EPSG:32736' expect_true( group_lines( DT = copyDT, threshold = 0, id = 'ID', coords = c('X', 'Y'), crs = utm, timegroup = 'timegroup', splitBy = 'splitBy', sortBy = 'datetime' )[, uniqueN(splitBy), group][, all(V1 == 1)] ) }) test_that('group_lines can accomodate NULL timegroup and non null splitBy', { copyDT <- copy(DT) copyDT[, yr := year(datetime)] expect_contains( group_lines( DT = copyDT, threshold = 10, id = 'ID', coords = c('X', 'Y'), crs = utm, timegroup = NULL, splitBy = 'yr', sortBy = 'datetime' ) |> colnames(), 'group' ) }) test_that('projection arg is deprecated', { expect_warning( group_lines( DT = DT, threshold = 0, id = 'ID', coords = c('X', 'Y'), splitBy = 'yr', sortBy = 'datetime', projection = utm ), 'projection argument is deprecated' ) })