From 8258199424afe26f95ce9a580da1f5387cb54b8f Mon Sep 17 00:00:00 2001 From: Andrew Collier Date: Wed, 11 Aug 2021 03:52:43 +0100 Subject: [PATCH 1/7] feat: Add set_map_alpha() --- NAMESPACE | 1 + R/set_map_alpha.R | 52 ++++++++++++++++++++++++++++++++++++++++++++ man/set_map_alpha.Rd | 44 +++++++++++++++++++++++++++++++++++++ 3 files changed, 97 insertions(+) create mode 100644 R/set_map_alpha.R create mode 100644 man/set_map_alpha.Rd diff --git a/NAMESPACE b/NAMESPACE index 9c782ac..d716832 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -58,6 +58,7 @@ export(route) export(routeQueryCheck) export(scrub_key) export(set_ggmap_option) +export(set_map_alpha) export(showing_key) export(theme_inset) export(theme_nothing) diff --git a/R/set_map_alpha.R b/R/set_map_alpha.R new file mode 100644 index 0000000..dbea738 --- /dev/null +++ b/R/set_map_alpha.R @@ -0,0 +1,52 @@ +#' Add transparency to a ggmap object +#' +#' Add an alpha (transparency) layer to a \code{ggmap} object. This makes it +#' possible to superimpose multiple map layers and have the lower layers shine +#' through. +#' +#' @param map A \code{ggmap} object. +#' @param alpha The required transparency (a number between 0 and 1). +#' +#' @return A \code{ggmap} object. +#' @export +#' +#' @examples +#' zoom <- 12 +#' bbox <- c( +#' left = -0.3275, +#' bottom = 51.407222, +#' right = 0.0725, +#' top = 51.607222 +#' ) +#' +#' base <- get_map(location = bbox, zoom = zoom, maptype = "terrain-lines") +#' overlay <- get_map(location = bbox, zoom = zoom, maptype = "watercolor") +#' +#' # Plot the base map. +#' ggmap(base) +#' # Plot the overlay map (100% opacity). +#' ggmap(overlay) +#' +#' # Plot the base map with the overlay superimposed at 25% opacity. +#' ggmap(base) + +#' inset_ggmap( +#' set_map_alpha(overlay, 0.25) +#' ) +set_map_alpha <- function(map, alpha) { + # Record the attributes & dimensions of the map object. + map_attributes <- attributes(map) + map_dimensions <- dim(map) + + # Add an alpha channel. + map <- adjustcolor(map, alpha) + + # Add back the dimensions (convert vector to matrix). + dim(map) <- map_dimensions + # Add back the attributes. + attributes(map) <- map_attributes + + # Convert from matrix to map. + class(map) <- c("ggmap", "raster") + + map +} diff --git a/man/set_map_alpha.Rd b/man/set_map_alpha.Rd new file mode 100644 index 0000000..699ba18 --- /dev/null +++ b/man/set_map_alpha.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/set_map_alpha.R +\name{set_map_alpha} +\alias{set_map_alpha} +\title{Add transparency to a ggmap object} +\usage{ +set_map_alpha(map, alpha) +} +\arguments{ +\item{map}{A \code{ggmap} object.} + +\item{alpha}{The required transparency (a number between 0 and 1).} +} +\value{ +A \code{ggmap} object. +} +\description{ +Add an alpha (transparency) layer to a \code{ggmap} object. This makes it +possible to superimpose multiple map layers and have the lower layers shine +through. +} +\examples{ +zoom <- 12 +bbox <- c( + left = -0.3275, + bottom = 51.407222, + right = 0.0725, + top = 51.607222 +) + +base <- get_map(location = bbox, zoom = zoom, maptype = "terrain-lines") +overlay <- get_map(location = bbox, zoom = zoom, maptype = "watercolor") + +# Plot the base map. +ggmap(base) +# Plot the overlay map (100\% opacity). +ggmap(overlay) + +# Plot the base map with the overlay superimposed at 25\% opacity. +ggmap(base) + + inset_ggmap( + set_map_alpha(overlay, 0.25) + ) +} From c717a03566e5e6494728e3e0405632c3be7c26b1 Mon Sep 17 00:00:00 2001 From: Andrew Collier Date: Wed, 11 Aug 2021 03:53:03 +0100 Subject: [PATCH 2/7] chore: Add data to fake map --- tests/testthat/util.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/testthat/util.R b/tests/testthat/util.R index 5067ee3..3d29a57 100644 --- a/tests/testthat/util.R +++ b/tests/testthat/util.R @@ -1,5 +1,7 @@ getFakeMap <- function() { - map <- character() + map <- rep("#FFFFFF", 4) + dim(map) <- c(2, 2) + class(map) <- c('ggmap','raster') attr(map, "source") <- "osm" attr(map, "maptype") <- "openstreetmap" @@ -9,4 +11,4 @@ getFakeMap <- function() { ur.lat = 3, ur.lon = 4 ) map -} \ No newline at end of file +} From 760dfa923e3152a958190593951b28c5a2a48d33 Mon Sep 17 00:00:00 2001 From: Andrew Collier Date: Wed, 11 Aug 2021 03:57:37 +0100 Subject: [PATCH 3/7] feat: Add simple test for set_map_alpha() --- tests/testthat/test-set-map-alpha.R | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 tests/testthat/test-set-map-alpha.R diff --git a/tests/testthat/test-set-map-alpha.R b/tests/testthat/test-set-map-alpha.R new file mode 100644 index 0000000..ea5fab6 --- /dev/null +++ b/tests/testthat/test-set-map-alpha.R @@ -0,0 +1,8 @@ +context("alpha") +source("util.R") + +test_that("adds alpha layer", { + map <- getFakeMap() + map <- set_map_alpha(map, 0.5) + expect_identical(as.character(map), rep("#FFFFFF80", 4)) +}) From 730fc51fe114548b65a37eb2f3da88834dab646d Mon Sep 17 00:00:00 2001 From: Andrew Collier Date: Wed, 11 Aug 2021 04:05:50 +0100 Subject: [PATCH 4/7] fix: Explicit about package for adjustcolor() --- R/set_map_alpha.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/set_map_alpha.R b/R/set_map_alpha.R index dbea738..00f0bb1 100644 --- a/R/set_map_alpha.R +++ b/R/set_map_alpha.R @@ -38,7 +38,7 @@ set_map_alpha <- function(map, alpha) { map_dimensions <- dim(map) # Add an alpha channel. - map <- adjustcolor(map, alpha) + map <- grDevices::adjustcolor(map, alpha) # Add back the dimensions (convert vector to matrix). dim(map) <- map_dimensions From ce2938d25586cf49eac1b0da35cd261f014a47fe Mon Sep 17 00:00:00 2001 From: Andrew Collier Date: Wed, 11 Aug 2021 04:08:48 +0100 Subject: [PATCH 5/7] fix: Add checks on input parameters --- R/set_map_alpha.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/set_map_alpha.R b/R/set_map_alpha.R index 00f0bb1..12e3a44 100644 --- a/R/set_map_alpha.R +++ b/R/set_map_alpha.R @@ -33,6 +33,13 @@ #' set_map_alpha(overlay, 0.25) #' ) set_map_alpha <- function(map, alpha) { + if(class(map)[1] != "ggmap") { + stop("map must be a ggmap object", call. = FALSE) + } + if(class(alpha) != "numeric" || alpha < 0 || alpha > 1) { + stop("alpha must be a number between 0 and 1", call. = FALSE) + } + # Record the attributes & dimensions of the map object. map_attributes <- attributes(map) map_dimensions <- dim(map) From 5a34c02247b6e61650fd4ba12abd1bb694a84c6e Mon Sep 17 00:00:00 2001 From: Andrew Collier Date: Wed, 11 Aug 2021 04:27:51 +0100 Subject: [PATCH 6/7] fix: Remove explicit argument names Just makes the example more concise --- R/set_map_alpha.R | 4 ++-- man/set_map_alpha.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/set_map_alpha.R b/R/set_map_alpha.R index 12e3a44..dd29361 100644 --- a/R/set_map_alpha.R +++ b/R/set_map_alpha.R @@ -19,8 +19,8 @@ #' top = 51.607222 #' ) #' -#' base <- get_map(location = bbox, zoom = zoom, maptype = "terrain-lines") -#' overlay <- get_map(location = bbox, zoom = zoom, maptype = "watercolor") +#' base <- get_map(bbox, zoom, maptype = "terrain-lines") +#' overlay <- get_map(bbox, zoom, maptype = "watercolor") #' #' # Plot the base map. #' ggmap(base) diff --git a/man/set_map_alpha.Rd b/man/set_map_alpha.Rd index 699ba18..752addc 100644 --- a/man/set_map_alpha.Rd +++ b/man/set_map_alpha.Rd @@ -28,8 +28,8 @@ bbox <- c( top = 51.607222 ) -base <- get_map(location = bbox, zoom = zoom, maptype = "terrain-lines") -overlay <- get_map(location = bbox, zoom = zoom, maptype = "watercolor") +base <- get_map(bbox, zoom, maptype = "terrain-lines") +overlay <- get_map(bbox, zoom, maptype = "watercolor") # Plot the base map. ggmap(base) From f51fd1b4f0f6d437bbdeb1a824cc1c1f3c9b161b Mon Sep 17 00:00:00 2001 From: Andrew Collier Date: Wed, 11 Aug 2021 04:29:35 +0100 Subject: [PATCH 7/7] fix: Remove explicit names from elements of bounding box --- R/set_map_alpha.R | 7 +------ man/set_map_alpha.Rd | 7 +------ 2 files changed, 2 insertions(+), 12 deletions(-) diff --git a/R/set_map_alpha.R b/R/set_map_alpha.R index dd29361..eb26ec7 100644 --- a/R/set_map_alpha.R +++ b/R/set_map_alpha.R @@ -12,12 +12,7 @@ #' #' @examples #' zoom <- 12 -#' bbox <- c( -#' left = -0.3275, -#' bottom = 51.407222, -#' right = 0.0725, -#' top = 51.607222 -#' ) +#' bbox <- c(-0.3275, 51.407222, 0.0725, 51.607222) #' #' base <- get_map(bbox, zoom, maptype = "terrain-lines") #' overlay <- get_map(bbox, zoom, maptype = "watercolor") diff --git a/man/set_map_alpha.Rd b/man/set_map_alpha.Rd index 752addc..1fa60c1 100644 --- a/man/set_map_alpha.Rd +++ b/man/set_map_alpha.Rd @@ -21,12 +21,7 @@ through. } \examples{ zoom <- 12 -bbox <- c( - left = -0.3275, - bottom = 51.407222, - right = 0.0725, - top = 51.607222 -) +bbox <- c(-0.3275, 51.407222, 0.0725, 51.607222) base <- get_map(bbox, zoom, maptype = "terrain-lines") overlay <- get_map(bbox, zoom, maptype = "watercolor")