From 8a752b496409da0a3c0020af70e48d33029a096e Mon Sep 17 00:00:00 2001 From: Finn Roberts Date: Tue, 9 Sep 2025 16:41:07 +0200 Subject: [PATCH 1/2] Fixes 16Eagle/moveVis#133; Ensure correct legend color order --- R/frames_spatial.R | 2 +- R/internal.R | 14 +++++---- man/frames_graph.Rd | 2 +- man/frames_spatial.Rd | 2 +- man/view_spatial.Rd | 2 +- tests/testthat/test-frames_graph.R | 46 +++++++++++++++++++++++++++- tests/testthat/test-frames_spatial.R | 23 ++++++++++++++ 7 files changed, 80 insertions(+), 11 deletions(-) diff --git a/R/frames_spatial.R b/R/frames_spatial.R index 2fc032e..fa54412 100644 --- a/R/frames_spatial.R +++ b/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 track levels in \code{m} (if a factor) or alphabetically (if a character). #' @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. diff --git a/R/internal.R b/R/internal.R index f8e7bcc..4d3b05a 100755 --- a/R/internal.R +++ b/R/internal.R @@ -577,7 +577,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(unique(m_colour), unique(m_names)), name = path_legend_title) + guides(color = guide_legend(order = 1))) } @@ -600,13 +600,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 +634,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(...) { diff --git a/man/frames_graph.Rd b/man/frames_graph.Rd index cfdaba7..d105699 100644 --- a/man/frames_graph.Rd +++ b/man/frames_graph.Rd @@ -46,7 +46,7 @@ frames_graph( \item{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.} -\item{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}.} +\item{path_legend}{logical, whether to add a path legend from \code{m} or not. Legend tracks and colours will be ordered by the track levels in \code{m} (if a factor) or alphabetically (if a character).} \item{path_legend_title}{character, path legend title. Default is \code{"Names"}.} diff --git a/man/frames_spatial.Rd b/man/frames_spatial.Rd index 933cb21..ac1dd2a 100644 --- a/man/frames_spatial.Rd +++ b/man/frames_spatial.Rd @@ -90,7 +90,7 @@ so that baesmap tiles that had been already downloaded by moveVis do not have to \item{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}}.} -\item{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}.} +\item{path_legend}{logical, whether to add a path legend from \code{m} or not. Legend tracks and colours will be ordered by the track levels in \code{m} (if a factor) or alphabetically (if a character).} \item{path_legend_title}{character, path legend title. Default is \code{"Names"}.} diff --git a/man/view_spatial.Rd b/man/view_spatial.Rd index 13e2afa..0ca9b0d 100644 --- a/man/view_spatial.Rd +++ b/man/view_spatial.Rd @@ -26,7 +26,7 @@ view_spatial( \item{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.} -\item{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}.} +\item{path_legend}{logical, whether to add a path legend from \code{m} or not. Legend tracks and colours will be ordered by the track levels in \code{m} (if a factor) or alphabetically (if a character).} \item{path_legend_title}{character, path legend title. Default is \code{"Names"}.} diff --git a/tests/testthat/test-frames_graph.R b/tests/testthat/test-frames_graph.R index e4c8a57..c2dae5b 100755 --- a/tests/testthat/test-frames_graph.R +++ b/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") }) -#} \ No newline at end of file +#} + +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") +}) diff --git a/tests/testthat/test-frames_spatial.R b/tests/testthat/test-frames_spatial.R index 61bacc8..db62e8a 100644 --- a/tests/testthat/test-frames_spatial.R +++ b/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) From b498448f9d94fb9bf5c08e0dd4e55eaa349acac9 Mon Sep 17 00:00:00 2001 From: Finn Roberts Date: Thu, 11 Sep 2025 17:18:11 +0200 Subject: [PATCH 2/2] Order all legends by temporal appearance Makes `frames_spatial()` consistent with `frames_graph()` after fixing label mapping --- R/frames_spatial.R | 2 +- R/internal.R | 5 +++-- man/frames_graph.Rd | 2 +- man/frames_spatial.Rd | 2 +- man/view_spatial.Rd | 2 +- 5 files changed, 7 insertions(+), 6 deletions(-) diff --git a/R/frames_spatial.R b/R/frames_spatial.R index fa54412..2a7d29e 100644 --- a/R/frames_spatial.R +++ b/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, whether to add a path legend from \code{m} or not. Legend tracks and colours will be ordered by the track levels in \code{m} (if a factor) or alphabetically (if a character). +#' @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. diff --git a/R/internal.R b/R/internal.R index 4d3b05a..a9be3bb 100755 --- a/R/internal.R +++ b/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 = setNames(unique(m_colour), unique(m_names)), + values = setNames(x_lines_legend$colour, x_lines_legend$name), name = path_legend_title) + guides(color = guide_legend(order = 1))) } diff --git a/man/frames_graph.Rd b/man/frames_graph.Rd index d105699..a43a524 100644 --- a/man/frames_graph.Rd +++ b/man/frames_graph.Rd @@ -46,7 +46,7 @@ frames_graph( \item{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.} -\item{path_legend}{logical, whether to add a path legend from \code{m} or not. Legend tracks and colours will be ordered by the track levels in \code{m} (if a factor) or alphabetically (if a character).} +\item{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}.} \item{path_legend_title}{character, path legend title. Default is \code{"Names"}.} diff --git a/man/frames_spatial.Rd b/man/frames_spatial.Rd index ac1dd2a..8b5eaeb 100644 --- a/man/frames_spatial.Rd +++ b/man/frames_spatial.Rd @@ -90,7 +90,7 @@ so that baesmap tiles that had been already downloaded by moveVis do not have to \item{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}}.} -\item{path_legend}{logical, whether to add a path legend from \code{m} or not. Legend tracks and colours will be ordered by the track levels in \code{m} (if a factor) or alphabetically (if a character).} +\item{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}.} \item{path_legend_title}{character, path legend title. Default is \code{"Names"}.} diff --git a/man/view_spatial.Rd b/man/view_spatial.Rd index 0ca9b0d..2d823cc 100644 --- a/man/view_spatial.Rd +++ b/man/view_spatial.Rd @@ -26,7 +26,7 @@ view_spatial( \item{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.} -\item{path_legend}{logical, whether to add a path legend from \code{m} or not. Legend tracks and colours will be ordered by the track levels in \code{m} (if a factor) or alphabetically (if a character).} +\item{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}.} \item{path_legend_title}{character, path legend title. Default is \code{"Names"}.}