Fix legend label/color mapping

R/frames_spatial.R

@@ -15,7 +15,7 @@
 #' @param path_colours character, a vector of colours. Must be of same length as number of individual tracks in \code{m} and refers to the order of tracks in \code{m}. If undefined (\code{NA}) and \code{m} contains a column named \code{colour}, colours provided within \code{m} are used (see details). Othwersie, colours are selected from a standard rainbow palette per individual track.
 #' @param path_alpha numeric, defines alpha (transparency) of the path. Value between 0 and 1. Default is 1.
 #' @param path_fade logical, whether paths should be faded towards the last frame or not. Useful, if \code{trace_show = TRUE} and you want to hold the last frame using \code{end_pause} in \code{\link{animate_frames}}.
-#' @param path_legend logical, wether to add a path legend from \code{m} or not. Legend tracks and colours will be ordered by the tracks' temporal apperances, not by their order in \code{m}.
+#' @param path_legend logical, whether to add a path legend from \code{m} or not. Legend tracks and colours will be ordered by the tracks' temporal apperances, not by their order in \code{m}.
 #' @param path_legend_title character, path legend title. Default is \code{"Names"}.
 #' @param tail_length numeric, length of tail per movement path.
 #' @param tail_size numeric, size of the last tail element. Default is 1.

R/internal.R

@@ -555,7 +555,8 @@ gg.spatial <- function(x, y, m_names, m_colour, path_end, path_join, path_mitre,
     coords <- st_coordinates(x)
     st_sf(geometry = st_sfc(st_linestring(coords), crs = st_crs(x)))  
   }))
-  x_lines_legend$name <- unique(m_names)
+  x_lines_legend$name <- factor(unique(m_names), levels = unique(m_names))
+  x_lines_legend$colour <- unique(m_colour)
 
   # scale plot to ext and set na.rm to TRUE to avoid warnings
   y$layers[[1]]$geom_params$na.rm <- T
@@ -577,7 +578,7 @@ gg.spatial <- function(x, y, m_names, m_colour, path_end, path_join, path_mitre,
       geom_sf(data = x_lines_legend, aes(colour = .data$name, linetype = NA), linewidth = path_size, na.rm = TRUE) + 
       scale_linetype(guide = "none") +
       scale_colour_manual(
-        values = unique(m_colour),
+        values = setNames(x_lines_legend$colour, x_lines_legend$name),
         name = path_legend_title) + guides(color = guide_legend(order = 1)))
   }    
 
@@ -600,13 +601,16 @@ gg.spatial <- function(x, y, m_names, m_colour, path_end, path_join, path_mitre,
 
   ## add legend
   if(isTRUE(path_legend)){
-    l.df <- cbind.data.frame(frame = x[1,]$frame, value = x[1,]$value, name = levels(y$name),
-                             colour = as.character(y$colour[sapply(as.character(unique(y$name)), function(x) match(x, y$name)[1] )]), stringsAsFactors = F)
+    colour_pos <- sapply(as.character(unique(y$name)), function(x) match(x, y$name)[1] )
+
+    l.df <- cbind.data.frame(frame = x[1,]$frame, value = x[1,]$value, name = names(colour_pos),
+                             colour = as.character(y$colour[colour_pos]), stringsAsFactors = F)
     l.df$name <- factor(l.df$name, levels = l.df$name)
     l.df <- rbind(l.df, l.df)
     p <- p + geom_path(data = l.df, aes(x = .data$frame, y = .data$value, colour = .data$name), linewidth = path_size, na.rm = TRUE) + scale_colour_manual(values = as.character(l.df$colour), name = path_legend_title) #linetype = NA)
-  }  
+  }
   return(p)
+
 }
 
 
@@ -631,12 +635,11 @@ gg.spatial <- function(x, y, m_names, m_colour, path_end, path_join, path_mitre,
                              colour = as.character(y$colour[sapply(as.character(unique(y$name)), function(x) match(x, y$name)[1] )]), stringsAsFactors = F)
     l.df$name <- factor(l.df$name, levels = l.df$name)
     l.df <- rbind(l.df, l.df)
-    p <- p + geom_path(data = l.df, aes(x = .data$value, y = .data$count, colour = .data$name), linewidth = path_size, na.rm = TRUE) + scale_colour_manual(values = as.character(l.df$colour), name = path_legend_title) #linetype = NA
+    p <- p + geom_path(data = l.df, aes(x = .data$value, y = .data$count, colour = .data$name), linewidth = path_size, na.rm = TRUE) + scale_colour_manual(values = setNames(as.character(l.df$colour), as.character(l.df$name)), name = path_legend_title) #linetype = NA
   }
   return(p)
 }
 
-
 #' package attatching
 #' @noRd 
 .onAttach <- function(...) {

tests/testthat/test-frames_graph.R

@@ -70,4 +70,48 @@ test_that("frames_graph (discrete, hist)", {
   frames <- expect_length(expect_is(frames_graph(m.aligned, r_disc, r_type = "discrete", graph_type = "hist", verbose = F, val_by = 1), "moveVis"), 188)
   expect_is(frames[[1]], "ggplot")
 })
-#}
+#}
+
+test_that("frames_graph maps correct colours to tracks (flow)", {
+  fr <- frames_graph(
+    m = m.aligned,
+    r_grad,
+    graph_type = "flow",
+    verbose = F,
+    path_colours = c("#F2A08F", "#65A7C9", "#461A6B")
+  )
+
+  built <- ggplot2::ggplot_build(fr[[50]])
+  sc <- built$plot$scales$get_scales("colour")
+
+  lims <- sc$get_limits()
+  cols <- sc$map(lims)
+
+  pal <- setNames(cols, lims)
+
+  expect_equal(pal[["T246a"]],  "#F2A08F")
+  expect_equal(pal[["T342g"]],  "#65A7C9")
+  expect_equal(pal[["T932u"]],  "#461A6B")
+})
+
+test_that("frames_graph maps correct colours to tracks (hist)", {
+  fr <- frames_graph(
+    m = m.aligned,
+    r_grad,
+    graph_type = "hist",
+    verbose = F,
+    path_colours = c("#F2A08F", "#65A7C9", "#461A6B")
+  )
+
+  built <- ggplot2::ggplot_build(fr[[50]])
+  sc <- built$plot$scales$get_scales("colour")
+
+  lims <- sc$get_limits()
+  cols <- sc$map(lims)
+
+  pal <- setNames(cols, lims)
+
+  expect_equal(pal[["T246a"]],  "#F2A08F")
+  expect_equal(pal[["T342g"]],  "#65A7C9")
+  expect_equal(pal[["T932u"]],  "#461A6B")
+})

tests/testthat/test-frames_spatial.R

@@ -22,6 +22,29 @@ test_that("frames_spatial (default maps)", {
   expect_error(frames_spatial(m.aligned, equidistant = "abc", map_res = 0.1, verbose = F)) # false path_legend
 })
 
+test_that("frames_spatial maps correct colours to tracks", {
+  fr <- frames_spatial(
+    m = m.aligned,
+    verbose = F,
+    map_res = 0.1,
+    path_colours = c("#F2A08F", "#65A7C9", "#461A6B")
+  )
+
+  built <- ggplot2::ggplot_build(fr[[50]])
+
+  built <- ggplot2::ggplot_build(fr[[50]])
+  sc <- built$plot$scales$get_scales("colour")
+
+  lims <- sc$get_limits()
+  cols <- sc$map(lims)
+
+  pal <- setNames(cols, lims)
+
+  expect_equal(pal[["T246a"]],  "#F2A08F")
+  expect_equal(pal[["T342g"]],  "#65A7C9")
+  expect_equal(pal[["T932u"]],  "#461A6B")
+})
+
 test_that("frames_spatial (raster, gradient)", {
   # correct calls
   frames <- expect_length(expect_is(frames_spatial(m.aligned, r = r_grad, r_type = "gradient", verbose = F), "moveVis"), 188)