diff --git a/NEWS.md b/NEWS.md index 9121438..a551a96 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,9 @@ * Updated `load_longlake_data()` to use terra package by default instead of the deprecated raster package * Updated example for `layer_spatial()` to avoid error when plotting raster layer +* Added `"line"` style and `text_pos` argument to `annotatation_scale()`. +`annotation_scale(style = "line", width_hint = 0.2)` yields a scale bar line +with the bar length text above it. # ggspatial 1.1.9 diff --git a/R/annotation-scale.R b/R/annotation-scale.R index ed14f42..6f1a451 100644 --- a/R/annotation-scale.R +++ b/R/annotation-scale.R @@ -8,6 +8,8 @@ #' @param height Height of scale bar #' @param pad_x,pad_y Distance between scale bar and edge of panel #' @param text_pad,text_cex,text_face,text_family Parameters for label +#' @param text_pos Text position relative to bar, either "`above`" or `"inside"` +#' (towards plot center). #' @param tick_height Height of ticks relative to height of scale bar #' @param mapping,data,... See Aesthetics #' @@ -17,9 +19,9 @@ #' and a different (or missing) scale bar is required in different panels. #' Otherwise, just pass them as arguments to `annotation_scale`. #' \itemize{ -#' \item width_hint: The (suggested) proportion of the plot area which the scalebar should occupy. +#' \item width_hint: The (suggested) proportion of the plot width which the scalebar should occupy. #' \item unit_category: Use "metric" or "imperial" units. -#' \item style: One of "bar" or "ticks" +#' \item style: One of "bar", "ticks", or "line" #' \item location: Where to put the scale bar ("tl" for top left, etc.) #' \item line_col and text_col: Line and text colour, respectively #' } @@ -36,11 +38,20 @@ #' city = c("Halifax", "Beijing") #' ) #' -#' ggplot(cities) + +#' p <- ggplot(cities) + #' geom_spatial_point(aes(x, y), crs = 4326) + -#' annotation_scale() + #' coord_sf(crs = 3995) #' +#' # Box +#' p + annotation_scale() +#' +#' # Ticks +#' p + annotation_scale(style = "ticks") +#' +#' # Line +#' p + annotation_scale(style = "line", width_hint = 0.2) +#' +#' annotation_scale <- function(mapping = NULL, data = NULL, ..., plot_unit = NULL, @@ -53,7 +64,8 @@ annotation_scale <- function(mapping = NULL, data = NULL, text_cex = 0.7, text_face = NULL, text_family = "", - tick_height = 0.6) { + tick_height = 0.6, + text_pos = NULL) { if(is.null(data)) { data <- data.frame(x = NA) @@ -79,7 +91,8 @@ annotation_scale <- function(mapping = NULL, data = NULL, text_cex = text_cex, text_face = text_face, text_family = text_family, - tick_height = tick_height + tick_height = tick_height, + text_pos = text_pos ) ) } @@ -115,11 +128,12 @@ GeomScaleBar <- ggplot2::ggproto( text_cex = 0.7, text_face = NULL, text_family = "", - tick_height = 0.6) { + tick_height = 0.6, + text_pos = NULL) { width_hint <- data$width_hint[1] style <- data$style[1] - location = data$location[1] + location <- data$location[1] unit_category <- data$unit_category[1] text_col <- data$text_col[1] line_col <- data$line_col[1] @@ -136,7 +150,8 @@ GeomScaleBar <- ggplot2::ggproto( grid::is.unit(pad_y), length(pad_y) == 1, grid::is.unit(text_pad), length(text_pad) == 1, length(text_col) == 1, - is.numeric(tick_height), length(tick_height) == 1 + is.numeric(tick_height), length(tick_height) == 1, + is.null(text_pos) || text_pos %in% c("above", "inside") ) # ranges have to be unnamed because when given @@ -183,14 +198,15 @@ GeomScaleBar <- ggplot2::ggproto( text_col = text_col, text_face = text_face, text_family = text_family, - tick_height = tick_height + tick_height = tick_height, + text_pos = text_pos ) } ) scalebar_grobs <- function( params, - style = c("ticks", "bar"), + style = c("ticks", "bar", "line"), location = c("bl", "br", "tr", "tl"), bar_cols = c("black", "white"), line_width = 1, @@ -203,20 +219,44 @@ scalebar_grobs <- function( text_col = "black", text_face = NULL, text_family = "", - tick_height = 0.6 + tick_height = 0.6, + text_pos = NULL ) { style <- match.arg(style) location <- match.arg(location) + if (is.null(text_pos)) + text_pos <- ifelse(style == "line", "above", "inside") + + if (style == "line"){ + tick_height <- unit(0, "cm") + height <- unit(0, "cm") + } + adj_x <- as.numeric(grepl("r", location)) adj_y <- as.numeric(grepl("t", location)) width <- unit(params$widthnpc, "npc") + # origins are the left and bottom edge of the bar bounding box origin_x <- unit(adj_x, "npc") - adj_x * width + (0.5 - adj_x) * 2 * pad_x origin_y <- unit(adj_y, "npc") - adj_y * height + (0.5 - adj_y) * 2 * pad_y - text_origin_x <- unit(adj_x, "npc") + (0.5 - adj_x) * 2 * (pad_x + text_pad + width) - text_origin_y <- unit(adj_y, "npc") + (0.5 - adj_y) * 2 * (pad_y + 0.5 * height) + + if(text_pos == "inside") { + text_hjust <- adj_x + text_vjust <- 0.5 + text_origin_x <- unit(adj_x, "npc") + (0.5 - adj_x) * 2 * (pad_x + text_pad + width) + text_origin_y <- unit(adj_y, "npc") + (0.5 - adj_y) * 2 * (pad_y + 0.5 * height) + } + + if(text_pos == "above") { + text_height <- grid::unit(1, "char") * text_cex + text_hjust <- 0.5 + text_vjust <- 0 + origin_y <- origin_y - adj_y * (text_height + text_pad) + text_origin_x <- origin_x + width / 2 # horizontal center of box + text_origin_y <- origin_y + height + text_pad + } if(style == "bar") { bar_grob <- grid::rectGrob( @@ -255,6 +295,19 @@ scalebar_grobs <- function( ) ) ) + } else if (style == "line") { + bar_grob <- grid::gList( + grid::segmentsGrob( + x0 = origin_x, + y0 = origin_y, + x1 = origin_x + width, + y1 = origin_y, + gp = grid::gpar( + lwd = line_width, + col = line_col + ) + ) + ) } else { stop("not implemented") } @@ -265,8 +318,8 @@ scalebar_grobs <- function( label = params$labeltext, x = text_origin_x, y = text_origin_y, - hjust = adj_x, - vjust = 0.5, + hjust = text_hjust, + vjust = text_vjust, gp = grid::gpar( cex = text_cex, col = text_col, diff --git a/man/annotation_scale.Rd b/man/annotation_scale.Rd index 0380c26..b89dfc1 100644 --- a/man/annotation_scale.Rd +++ b/man/annotation_scale.Rd @@ -23,7 +23,8 @@ annotation_scale( text_cex = 0.7, text_face = NULL, text_family = "", - tick_height = 0.6 + tick_height = 0.6, + text_pos = NULL ) GeomScaleBar @@ -45,6 +46,9 @@ Must be one of km, m, cm, mi, ft, or in.} \item{text_pad, text_cex, text_face, text_family}{Parameters for label} \item{tick_height}{Height of ticks relative to height of scale bar} + +\item{text_pos}{Text position relative to bar, either "\code{above}" or \code{"inside"} +(towards plot center).} } \value{ A ggplot2 layer. @@ -59,9 +63,9 @@ aesthetics is useful when facets are used to display multiple panels, and a different (or missing) scale bar is required in different panels. Otherwise, just pass them as arguments to \code{annotation_scale}. \itemize{ -\item width_hint: The (suggested) proportion of the plot area which the scalebar should occupy. +\item width_hint: The (suggested) proportion of the plot width which the scalebar should occupy. \item unit_category: Use "metric" or "imperial" units. -\item style: One of "bar" or "ticks" +\item style: One of "bar", "ticks", or "line" \item location: Where to put the scale bar ("tl" for top left, etc.) \item line_col and text_col: Line and text colour, respectively } @@ -74,10 +78,19 @@ cities <- data.frame( city = c("Halifax", "Beijing") ) -ggplot(cities) + +p <- ggplot(cities) + geom_spatial_point(aes(x, y), crs = 4326) + - annotation_scale() + coord_sf(crs = 3995) + # Box + p + annotation_scale() + + # Ticks + p + annotation_scale(style = "ticks") + + # Line + p + annotation_scale(style = "line", width_hint = 0.2) + + } \keyword{datasets} diff --git a/tests/testthat/_snaps/annotation-scale/scale-bar-line.svg b/tests/testthat/_snaps/annotation-scale/scale-bar-line.svg new file mode 100644 index 0000000..ed6543a --- /dev/null +++ b/tests/testthat/_snaps/annotation-scale/scale-bar-line.svg @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 m + + + +-4 +-3 +-2 +-1 +0 + + + + + + + + + + +0 +1 +2 +3 +4 +x +y +scale bar (line) + + diff --git a/tests/testthat/test-annotation-scale.R b/tests/testthat/test-annotation-scale.R index b8b11f5..87c4774 100644 --- a/tests/testthat/test-annotation-scale.R +++ b/tests/testthat/test-annotation-scale.R @@ -125,6 +125,15 @@ test_that("annotation scale works as intended", { annotation_scale(plot_unit = "m", style = "ticks") + ggplot2::coord_fixed() ) + + expect_doppelganger( + "scale bar (line)", + ggplot() + + ggplot2::geom_point(aes(x, y), data = data.frame(x = 0:4, y = -(0:4))) + + annotation_scale(plot_unit = "m", style = "line") + + ggplot2::coord_fixed() + ) + }) test_that("font items are passed on to annotation_scale()", { @@ -175,3 +184,5 @@ test_that("certain parameters can be passed as aesthetics to show up on differen ggplot2::coord_fixed() ) }) + +