Merge pull request #48 from davidcarslaw/auto-detect-limits

Feature: Allow openairmaps to auto-detect certain limits (e.g., `polarMap(limits = ...)`)
davidcarslaw · Jul 31, 2023 · e5a5518 · e5a5518
2 parents 9acddf6 + 9e36e92
commit e5a5518
Show file tree

Hide file tree

Showing 19 changed files with 735 additions and 245 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: openairmaps
 Title: Create Maps of Air Pollution Data
-Version: 0.8.0.9003
+Version: 0.8.0.9004
 Authors@R: c(
     person("Jack", "Davison", , "jack.davison@ricardo.com", role = c("cre", "aut")),
     person("David", "Carslaw", , "david.carslaw@york.ac.uk", role = "aut")

diff --git a/NEWS.md b/NEWS.md
@@ -6,8 +6,17 @@ These are items associated with the development version of `{openairmaps}`.
 
 * BREAKING: The arguments of `addPolarMarkers()` have been rejigged to move "data" after "pollutant", owing to the new use of `leaflet::getMapData()`. (#45)
 
+* BREAKING: The default arguments of some `polarMap()`-family functions have changed from, e.g., `NULL` to `"free"` or `"fixed"`. (#34)
+
 ## New features
 
+* Several "limit" arguments can now take one of three options: "fixed" (which forces all markers to share scales), "free" (which allows them to use different scales), or a numeric vector to define the scales. (#34) These arguments and their defaults include:
+
+  * `polarMap()`: `upper` (fixed); `limits` (free)
+  * `annulusMap()`: `limits` (free)
+  * `freqMap()`: `breaks` (free)
+  * `percentileMap()`: `intervals` (fixed)
+
 * Added `searchNetwork()`, which allows users to find local air quality monitoring sites by specifying a target latitude and longitude. Function arguments allow the site metadata to be subset (for example, by site type, pollutants measured, or distance from the target).
 
 * Added `convertPostcode()`, which converts a valid UK postcode to a latitude/longitude pair. This is intended to be used with `searchNetwork()`.

diff --git a/R/polar_annulusMap.R b/R/polar_annulusMap.R
@@ -31,7 +31,7 @@
 annulusMap <- function(data,
                        pollutant = NULL,
                        period = "hour",
-                       limits = NULL,
+                       limits = "free",
                        latitude = NULL,
                        longitude = NULL,
                        control = NULL,
@@ -59,17 +59,45 @@ annulusMap <- function(data,
   }
 
   # assume lat/lon
-  latlon <- assume_latlon(
-    data = data,
-    latitude = latitude,
-    longitude = longitude
-  )
+  latlon <- assume_latlon(data = data,
+                          latitude = latitude,
+                          longitude = longitude)
   latitude <- latlon$latitude
   longitude <- latlon$longitude
 
-  # deal with limits
-  theLimits <- limits
-  if (is.null(limits)) theLimits <- NA
+  # auto limits
+  limits <- check_multipoll(limits, pollutant)
+
+  if ("fixed" %in% limits) {
+    data <-
+      dplyr::mutate(data, latlng = paste(.data[[latitude]], .data[[longitude]]))
+
+    type <- control
+    if (is.null(control)) {
+      type <- "default"
+    }
+
+    testplots <-
+      openair::polarAnnulus(
+        data,
+        pollutant = pollutant,
+        period = period,
+        type = c("latlng", type),
+        plot = FALSE,
+        ...
+      )$data
+
+    theLimits <- range(testplots$z, na.rm = TRUE)
+  } else if ("free" %in% limits) {
+    theLimits <- NA
+  } else if (is.numeric(limits)) {
+    theLimits <- limits
+  } else {
+    cli::cli_abort(
+      c("!" = "Do not recognise {.field limits} value of {.code {limits}}",
+        "i" = "{.field limits} should be one of {.code 'fixed'}, {.code 'free'} or a numeric vector of length 2.")
+    )
+  }
 
   # cut data
   data <- quick_cutdata(data = data, type = control)
@@ -113,7 +141,7 @@ annulusMap <- function(data,
 
   # define function
   fun <- function(data) {
-    if (!is.null(limits)) {
+    if (!"free" %in% limits) {
       openair::polarAnnulus(
         data,
         pollutant = "conc",
@@ -156,10 +184,20 @@ annulusMap <- function(data,
 
   # create leaflet map
   map <-
-    make_leaflet_map(plots_df, latitude, longitude, provider, d.icon, popup, label, split_col, collapse.control)
+    make_leaflet_map(
+      plots_df,
+      latitude,
+      longitude,
+      provider,
+      d.icon,
+      popup,
+      label,
+      split_col,
+      collapse.control
+    )
 
   # add legend if limits are set
-  if (!is.null(limits) & all(!is.na(limits)) & draw.legend) {
+  if (!all(is.na(theLimits)) & draw.legend) {
     map <-
       leaflet::addLegend(
         map,
@@ -205,7 +243,7 @@ annulusMapStatic <- function(data,
                              pollutant = NULL,
                              period = "hour",
                              facet = NULL,
-                             limits = NULL,
+                             limits = "free",
                              latitude = NULL,
                              longitude = NULL,
                              zoom = 13,
@@ -218,18 +256,44 @@ annulusMapStatic <- function(data,
                              d.fig = 3,
                              ...) {
   # assume lat/lon
-  latlon <- assume_latlon(
-    data = data,
-    latitude = latitude,
-    longitude = longitude
-  )
+  latlon <- assume_latlon(data = data,
+                          latitude = latitude,
+                          longitude = longitude)
   latitude <- latlon$latitude
   longitude <- latlon$longitude
 
-  # deal with limits
-  theLimits <- limits
-  if (is.null(limits)) {
+  # auto limits
+  limits <- check_multipoll(limits, pollutant)
+
+  if ("fixed" %in% limits) {
+    data <-
+      dplyr::mutate(data, latlng = paste(.data[[latitude]], .data[[longitude]]))
+
+    type <- facet
+    if (is.null(facet)) {
+      type <- "default"
+    }
+
+    testplots <-
+      openair::polarAnnulus(
+        data,
+        pollutant = pollutant,
+        period = period,
+        type = c("latlng", type),
+        plot = FALSE,
+        ...
+      )$data
+
+    theLimits <- range(testplots$z, na.rm = TRUE)
+  } else if ("free" %in% limits) {
     theLimits <- NA
+  } else if (is.numeric(limits)) {
+    theLimits <- limits
+  } else {
+    cli::cli_abort(
+      c("!" = "Do not recognise {.field limits} value of {.code {limits}}",
+        "i" = "{.field limits} should be one of {.code 'fixed'}, {.code 'free'} or a numeric vector of length 2.")
+    )
   }
 
   # cut data
@@ -259,7 +323,7 @@ annulusMapStatic <- function(data,
 
   # define function
   fun <- function(data) {
-    if (!is.null(limits)) {
+    if (!"free" %in% limits) {
       openair::polarAnnulus(
         data,
         pollutant = "conc",
@@ -323,18 +387,14 @@ annulusMapStatic <- function(data,
     )
 
   # create colorbar if limits specified
-  if (!is.null(limits)) {
+  if (!all(is.na(theLimits))) {
     plt <-
       plt +
-      ggplot2::geom_point(
-        data = plots_df,
-        ggplot2::aes(.data[[longitude]], .data[[latitude]], color = 0),
-        alpha = 0
-      ) +
-      ggplot2::scale_color_gradientn(
-        limits = theLimits,
-        colours = openair::openColours(scheme = cols)
-      ) +
+      ggplot2::geom_point(data = plots_df,
+                          ggplot2::aes(.data[[longitude]], .data[[latitude]], color = 0),
+                          alpha = 0) +
+      ggplot2::scale_color_gradientn(limits = theLimits,
+                                     colours = openair::openColours(scheme = cols)) +
       ggplot2::labs(color = openair::quickText(paste(pollutant, collapse = ", ")))
   }
 

diff --git a/R/polar_diffMap.R b/R/polar_diffMap.R
@@ -42,7 +42,7 @@ diffMap <- function(before,
                     after,
                     pollutant = NULL,
                     x = "ws",
-                    limits = NULL,
+                    limits = "free",
                     latitude = NULL,
                     longitude = NULL,
                     control = NULL,
@@ -88,10 +88,43 @@ diffMap <- function(before,
   latitude <- latlon$latitude
   longitude <- latlon$longitude
 
-  # deal with limits
-  theLimits <- limits
-  if (is.null(limits)) {
+  # auto limits
+  if ("fixed" %in% limits) {
+    cli::cli_abort("{.code limits = 'fixed'} is currently not supported for {.fun diffMap} and {.fun diffMapStatic}.")
+    # if (length(pollutant) == 1) {
+    #   before <-
+    #     dplyr::mutate(before, latlng = paste(.data[[latitude]], .data[[longitude]]))
+    #   after <-
+    #     dplyr::mutate(after, latlng = paste(.data[[latitude]], .data[[longitude]]))
+    #
+    #   type <- control
+    #   if (is.null(control)) {
+    #     type <- "default"
+    #   }
+    #
+    #   testplots <-
+    #     openair::polarDiff(
+    #       before = before, after = after,
+    #       pollutant = pollutant,
+    #       x = x,
+    #       type = c("latlng", type),
+    #       plot = FALSE,
+    #       ...
+    #     )$data
+    #
+    #   theLimits <- range(testplots[[pollutant]], na.rm = TRUE)
+    # } else {
+    #   cli::cli_warn("{.code limits == 'auto'} only works with a single given {.field pollutant}")
+    # }
+  } else if ("free" %in% limits) {
     theLimits <- NA
+  } else if (is.numeric(limits)){
+    theLimits <- limits
+  } else {
+    cli::cli_abort(
+      c("!" = "Do not recognise {.field limits} value of {.code {limits}}",
+        "i" = "{.field limits} should be one of {.code 'fixed'}, {.code 'free'} or a numeric vector of length 2.")
+    )
   }
 
   # deal with popups
@@ -193,7 +226,7 @@ diffMap <- function(before,
     )
 
   # add legend if limits are set
-  if (!is.null(limits) & all(!is.na(limits)) & draw.legend) {
+  if (!all(is.na(theLimits)) & draw.legend) {
     map <-
       leaflet::addLegend(
         map,
@@ -235,11 +268,11 @@ diffMap <- function(before,
 diffMapStatic <- function(before,
                           after,
                           pollutant = NULL,
+                          limits = "free",
                           x = "ws",
-                          facet = NULL,
-                          limits = NULL,
                           latitude = NULL,
                           longitude = NULL,
+                          facet = NULL,
                           zoom = 13,
                           ggmap = NULL,
                           cols = c(
@@ -268,10 +301,43 @@ diffMapStatic <- function(before,
   latitude <- latlon$latitude
   longitude <- latlon$longitude
 
-  # deal with limits
-  theLimits <- limits
-  if (is.null(limits)) {
+  # auto limits
+  if ("fixed" %in% limits) {
+    cli::cli_abort("{.code limits = 'fixed'} is currently not supported for {.fun diffMap} and {.fun diffMapStatic}.")
+    # if (length(pollutant) == 1) {
+    #   before <-
+    #     dplyr::mutate(before, latlng = paste(.data[[latitude]], .data[[longitude]]))
+    #   after <-
+    #     dplyr::mutate(after, latlng = paste(.data[[latitude]], .data[[longitude]]))
+    #
+    #   type <- facet
+    #   if (is.null(facet)) {
+    #     type <- "default"
+    #   }
+    #
+    #   testplots <-
+    #     openair::polarDiff(
+    #       before = before, after = after,
+    #       pollutant = pollutant,
+    #       x = x,
+    #       type = c("latlng", type),
+    #       plot = FALSE,
+    #       ...
+    #     )$data
+    #
+    #   theLimits <- range(testplots[[pollutant]], na.rm = TRUE)
+    # } else {
+    #   cli::cli_warn("{.code limits == 'auto'} only works with a single given {.field pollutant}")
+    # }
+  } else if ("free" %in% limits) {
     theLimits <- NA
+  } else if (is.numeric(limits)){
+    theLimits <- limits
+  } else {
+    cli::cli_abort(
+      c("!" = "Do not recognise {.field limits} value of {.code {limits}}",
+        "i" = "{.field limits} should be one of {.code 'fixed'}, {.code 'free'} or a numeric vector of length 2.")
+    )
   }
 
   # cut data
@@ -366,7 +432,7 @@ diffMapStatic <- function(before,
     )
 
   # create colorbar if limits specified
-  if (!is.null(limits)) {
+  if (!all(is.na(theLimits))) {
     plt <-
       plt +
       ggplot2::geom_point(