Allow empty levels in move2 object

R/align_move.R

@@ -84,8 +84,8 @@ align_move <- function(m, res = "minimum", start_end_time = NULL, fill_na_values
 
   # check inputs
   .check_move2(m)
-  m_tracks <- split(m, mt_track_id(m))
-  m_length <- if(mt_n_tracks(m) > 1) sapply(split(m, mt_track_id(m)), nrow) else nrow(m)
+  m_tracks <- split(m, mt_track_id(m), drop = TRUE)
+  m_length <- if(mt_n_tracks(m) > 1) sapply(split(m, mt_track_id(m), drop = TRUE), nrow) else nrow(m)
   if(any(m_length < 2)) out(paste0("Individual track(s) ", paste0(which(m_length < 2), collapse = ", "), " of 'm' consist(s) of less than 2 locations. A minimum of 2 locations per indvidual track is required for alignment."), type = 3)
 
   # check resolution and define resolution
@@ -183,7 +183,7 @@ align_move <- function(m, res = "minimum", start_end_time = NULL, fill_na_values
 
   # fill variables
   if(isTRUE(fill_na_values)){
-    m_aligend_filled <- lapply(split(m_aligned, mt_track_id(m_aligned)), function(m_track){
+    m_aligend_filled <- lapply(split(m_aligned, mt_track_id(m_aligned), drop = TRUE), function(m_track){
       for(x in names_attr){
         this_attr <- m_track[[x]]
 

R/internal.R

@@ -343,7 +343,7 @@ repl_vals <- function(data, x, y){
 #' @noRd 
 .time_conform <- function(m){
 
-  m.indi <- if(mt_n_tracks(m) > 1) split(m, mt_track_id(m)) else list(m)
+  m.indi <- if(mt_n_tracks(m) > 1) split(m, mt_track_id(m), drop = TRUE) else list(m)
   ts <- .lapply(m.indi, mt_time, moveVis.verbose = F)
   tl <- .lapply(m.indi, mt_time_lags, unit = "secs", moveVis.verbose = F)
 

R/view_spatial.R

@@ -57,6 +57,13 @@ view_spatial <- function(m, render_as = "mapview", time_labels = TRUE, stroke =
   ## preprocess movement data
   m <- .add_m_attributes(m, path_colours = path_colours)
 
+  # Prevents incorrect color mapping in mapview
+  track_id_col <- mt_track_id_column(m)
+
+  if (is.factor(m[[track_id_col]])) {
+    m[[track_id_col]] <- droplevels(m[[track_id_col]])
+  }
+
   ## render as mapview object
   if(render_as == "mapview"){
     if(length(grep("mapview", rownames(utils::installed.packages()))) == 0) out("'mapview' has to be installed to use this function. Use install.packages('mapview').", type = 3)
@@ -75,7 +82,7 @@ view_spatial <- function(m, render_as = "mapview", time_labels = TRUE, stroke =
     if(length(grep("leaflet", rownames(utils::installed.packages()))) == 0) out("'leaflet' has to be installed to use this function. Use install.packages('leaflet').", type = 3)
 
     # compose
-    m.split <- split(m, mt_track_id(m))
+    m.split <- split(m, mt_track_id(m), drop = TRUE)
     map <- leaflet::addTiles(map = leaflet::leaflet(m))
     for(i in 1:length(m.split)) map <- leaflet::addCircleMarkers(
       map = map, lng = st_coordinates(m.split[[i]])[,1], 

tests/testthat/test-align_move.R

@@ -33,3 +33,12 @@ test_that("align_move (default)", {
   expect_warning(align_move(m, digit = "max", verbose = F))
 })
 #}
+
+test_that("align_move() handles empty factor levels", {
+  m_filt <- move2::filter_track_data(m, .track_id = c("T246a", "T932u"))
+
+  expect_silent(x <- align_move(m_filt, verbose = FALSE))
+  expect_is(x, "move2")
+  expect_length(na.omit(unique(unlist(move2::mt_time_lags(x, units = "secs")))), 1)
+  expect_equal(nrow(x), 300)
+})