resolve merge

Merge branch 'master' of https://github.com/davidcarslaw/openairmaps # Conflicts: # tests/testthat/test-polar_percentileMap.R
davidcarslaw · Jun 6, 2023 · 254b3d0 · 254b3d0
2 parents d1835d8 + b90f17d
commit 254b3d0
Show file tree

Hide file tree

Showing 27 changed files with 201 additions and 116 deletions.
diff --git a/.github/ISSUE_TEMPLATE/question.md b/.github/ISSUE_TEMPLATE/question.md
@@ -0,0 +1,16 @@
+---
+name: Question
+about: Ask a question about `{openairmaps}` maps or functions
+title: "[Question]: "
+labels: ["question"]
+---
+
+Please ask your question about `{openairmaps}`. This could be about how to properly use `{openairmaps}` functions, interpret maps, or something else entirely.
+
+Before you submit your issue, it may be useful to check through the [openair book](https://bookdown.org/david_carslaw/openair/) just to make sure your question hasn't already been answered!
+
+Feel free to delete these instructions before you submit your issue.
+
+------------------------------------------------------------------------
+
+Your question, with example code/[reprex](https://bookdown.org/david_carslaw/openair/sections/appendices/appendix-gethelp.html#sec-reprex) if appropriate.
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
+Version: 0.8.0.9001
 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
@@ -1,3 +1,15 @@
+# openairmaps (development version)
+
+These are items associated with the development version of `{openairmaps}`.
+
+## New features
+
+* `networkMap()` popups now contain links to the associated network websites. For example, the popup for London Marylebone Road in `networkMap("aurn")` now contains a link to <https://uk-air.defra.gov.uk/networks/site-info?site_id=MY1>. All networks are supported with the exception of "europe".
+
+* `addPolarMarkers()` and `addPolarDiffMarkers()` now have all of the "options" arguments of `leaflet::addMarkers()`. This means that, for example, polar markers can be clustered (<https://leafletjs.com/reference.html#marker>).
+
+* The `polarMap()` family and `networkMap()` `provider` argument can now take a named vector. The names will be used in the layer control menu, if `length(provider) > 1`.
+
 # openairmaps 0.8.0
 
 This is a minor release adding a range of quality of life features, adding two new experimental functions, and fixing a few bugs.

diff --git a/R/addPolarMarkers.R b/R/addPolarMarkers.R
@@ -84,7 +84,12 @@ addPolarMarkers <-
            layerId = NULL,
            group = NULL,
            popup = NULL,
+           popupOptions = NULL,
            label = NULL,
+           labelOptions = NULL,
+           options = leaflet::markerOptions(),
+           clusterOptions = NULL,
+           clusterId = NULL,
            key = FALSE,
            d.icon = 200,
            d.fig = 3.5,
@@ -152,7 +157,12 @@ addPolarMarkers <-
         iconAnchorY = height / 2
       ),
       group = group,
-      layerId = layerId
+      layerId = layerId,
+      popupOptions = popupOptions,
+      labelOptions = labelOptions,
+      options = options,
+      clusterOptions = clusterOptions,
+      clusterId = clusterId
     )
 
     # deal w/ popups/labels
@@ -184,7 +194,12 @@ addPolarDiffMarkers <-
            layerId = NULL,
            group = NULL,
            popup = NULL,
+           popupOptions = NULL,
            label = NULL,
+           labelOptions = NULL,
+           options = leaflet::markerOptions(),
+           clusterOptions = NULL,
+           clusterId = NULL,
            key = FALSE,
            d.icon = 200,
            d.fig = 3.5,
@@ -256,7 +271,12 @@ addPolarDiffMarkers <-
         iconAnchorY = height / 2
       ),
       group = group,
-      layerId = layerId
+      layerId = layerId,
+      popupOptions = popupOptions,
+      labelOptions = labelOptions,
+      options = options,
+      clusterOptions = clusterOptions,
+      clusterId = clusterId
     )
 
     # deal w/ popups/labels

diff --git a/R/networkMap.R b/R/networkMap.R
@@ -61,16 +61,15 @@ networkMap <-
            control = NULL,
            year = NULL,
            cluster = TRUE,
-           provider = c("OpenStreetMap", "Esri.WorldImagery"),
+           provider = c("Default" = "OpenStreetMap",
+                        "Satellite" = "Esri.WorldImagery"),
            draw.legend = TRUE,
            collapse.control = FALSE) {
     # if year isn't provided, use current year
     if (is.null(year)) {
       year <- lubridate::year(Sys.Date())
       cli::cli_inform(c("i" = "{.code year} not specified. Showing sites open in {.field {year}}."))
     }
-
-    provider <- unique(provider)
     source <- unique(source)
 
     cols <-
@@ -100,10 +99,8 @@ networkMap <-
 
     # read in data
     meta <-
-      purrr::map(
-        .x = source,
-        .f = ~ prepNetworkData(source = .x, year = year)
-      ) %>%
+      purrr::map(.x = source,
+                 .f = ~ prepNetworkData(source = .x, year = year)) %>%
       purrr::list_rbind() %>%
       dplyr::left_join(cols, by = "network")
 
@@ -128,13 +125,11 @@ networkMap <-
     if (!is.null(control)) {
       if (control %in% c("Parameter_name", "variable")) {
         meta <-
-          dplyr::group_by(
-            meta,
-            .data$site,
-            .data$latitude,
-            .data$longitude,
-            .data$variable
-          )
+          dplyr::group_by(meta,
+                          .data$site,
+                          .data$latitude,
+                          .data$longitude,
+                          .data$variable)
       }
     }
 
@@ -146,9 +141,12 @@ networkMap <-
     map <- leaflet::leaflet()
 
     # add provider tiles
-    for (i in seq(length(provider))) {
+    if (is.null(names(provider)) | "" %in% names(provider)) {
+      names(provider) <- provider
+    }
+    for (i in seq_along(provider)) {
       map <-
-        leaflet::addProviderTiles(map, provider = provider[i], group = provider[i])
+        leaflet::addProviderTiles(map, provider = provider[[i]], group = names(provider)[[i]])
     }
 
     # cluster options
@@ -189,10 +187,8 @@ networkMap <-
                                  )]
 
         cli::cli_abort(
-          c(
-            "x" = "'{control}' is not an appropriate {.coed control} option.",
-            "i" = "Suggested control options: {.emph {trycols}}"
-          )
+          c("x" = "'{control}' is not an appropriate {.coed control} option.",
+            "i" = "Suggested control options: {.emph {trycols}}")
         )
       }
 
@@ -243,9 +239,9 @@ networkMap <-
               map,
               options = leaflet::layersControlOptions(collapsed = collapse.control, autoZIndex = FALSE),
               baseGroups = quickTextHTML(sort(control_vars)),
-              overlayGroups = provider
+              overlayGroups = names(provider)
             ) %>%
-            leaflet::hideGroup(group = provider[-1])
+            leaflet::hideGroup(group = names(provider)[[-1]])
         } else {
           map <-
             leaflet::addLayersControl(
@@ -261,9 +257,9 @@ networkMap <-
               map,
               options = leaflet::layersControlOptions(collapsed = collapse.control, autoZIndex = FALSE),
               overlayGroups = quickTextHTML(sort(control_vars)),
-              baseGroups = provider
+              baseGroups = names(provider)
             ) %>%
-            leaflet::hideGroup(group = provider[-1])
+            leaflet::hideGroup(group = names(provider)[[-1]])
         } else {
           map <-
             leaflet::addLayersControl(
@@ -294,15 +290,14 @@ networkMap <-
           )
         )
 
-
       if (length(provider) > 1) {
         map <-
           leaflet::addLayersControl(
             map,
             options = leaflet::layersControlOptions(collapsed = collapse.control, autoZIndex = FALSE),
-            baseGroups = provider
+            baseGroups = names(provider)
           ) %>%
-          leaflet::hideGroup(group = provider[-1])
+          leaflet::hideGroup(group = names(provider)[[-1]])
       }
     }
 
@@ -317,8 +312,6 @@ networkMap <-
         )
     }
 
-
-
     map
   }
 
@@ -332,11 +325,9 @@ prepNetworkData <- function(source, year) {
   }
   # import metadata
   meta <-
-    openair::importMeta(
-      source = source,
-      all = TRUE,
-      year = year
-    ) %>%
+    openair::importMeta(source = source,
+                        all = TRUE,
+                        year = year) %>%
     dplyr::filter(!is.na(.data$latitude), !is.na(.data$longitude)) %>%
     dplyr::mutate(
       network = dplyr::case_when(
@@ -389,7 +380,7 @@ prepNetworkData <- function(source, year) {
     )
 
     meta <- dplyr::filter(
-      meta, !.data$variable %in% hc_vars, !.data$variable %in% c(
+      meta,!.data$variable %in% hc_vars,!.data$variable %in% c(
         "ws",
         "wd",
         "temp",
@@ -422,22 +413,43 @@ prepNetworkData <- function(source, year) {
           )
         ) %>%
         dplyr::mutate(
+          provider = stringr::str_trim(.data$provider),
+          pcode = dplyr::case_when(
+            .data$provider == "Norfolk Air Quality" ~ "norfolk",
+            .data$provider == "Nottingham Air Quality" ~ "notts",
+            .data$provider == "Wolverhampton Air Quality" ~ "wolverhampton",
+            .data$provider == "Liverpool Air Quality" ~ "liverpool",
+            .data$provider == "Heathrow Airwatch" ~ "heathrow",
+            .data$provider == "Hertfordshire and Bedfordshire Air Quality Network" ~ "hertsbeds",
+            .data$provider == "Wiltshire Air Quality" ~ "wiltshire",
+            .default = .data$pcode
+          ),
           lab = stringr::str_glue(
-            "<u><b>{toupper(stringr::str_to_title(site))}</b> ({code})</u><br>
-      <b>Lat:</b> {latitude} | <b>Lon:</b> {longitude}<br>
-      <b>Network:</b> {network}<br>
-      <b>Site Type:</b> {site_type}<br>
-      <b>Zone:</b> {zone}<br>
-      <b>Agglomeration:</b> {agglomeration}<br>
-      <b>Provider:</b> {provider}<br>
-      <hr>{lab}"
+            "<u><a href='https://uk-air.defra.gov.uk/networks/site-info?uka_id={code}&provider={pcode}'><b>{toupper(stringr::str_to_title(site))}</b> ({code})</a></u><br>
+            <b>Lat:</b> {latitude} | <b>Lon:</b> {longitude}<br>
+            <b>Network:</b> {network}<br>
+            <b>Site Type:</b> {site_type}<br>
+            <b>Zone:</b> {zone}<br>
+            <b>Agglomeration:</b> {agglomeration}<br>
+            <b>Provider:</b> {provider}<br>
+            <hr>{lab}"
           )
         ) %>%
         dplyr::mutate(
           lab = stringr::str_remove_all(.data$lab, "<b>Agglomeration:</b> NA<br>"),
           lab = stringr::str_remove_all(.data$lab, "<b>Site Type:</b> unknown unknown<br>")
         )
     } else {
+      domain <- switch(
+        source,
+        "aurn" = "https://uk-air.defra.gov.uk/networks/site-info?site_id=",
+        "saqn" = "https://www.scottishairquality.scot/latest/site-info/",
+        "saqd" = "https://www.scottishairquality.scot/latest/site-info/",
+        "waqn" = "https://airquality.gov.wales/air-pollution/site/",
+        "ni" = "https://www.airqualityni.co.uk/site/",
+        "aqe" = "https://www.airqualityengland.co.uk/site/latest?site_id="
+      )
+
       meta <-
         prepManagedNetwork(
           meta,
@@ -455,7 +467,7 @@ prepNetworkData <- function(source, year) {
         ) %>%
         dplyr::mutate(
           lab = stringr::str_glue(
-            "<u><b>{toupper(stringr::str_to_title(site))}</b> ({code})</u><br>
+            "<u><a href='{domain}{code}'><b>{toupper(stringr::str_to_title(site))}</b> ({code})</a></u><br>
       <b>Lat:</b> {latitude} | <b>Lon:</b> {longitude}<br>
       <b>Network:</b> {network}<br>
       <b>Site Type:</b> {site_type}<br>
@@ -477,6 +489,7 @@ prepNetworkData <- function(source, year) {
     meta <-
       dplyr::mutate(
         meta,
+        url = paste0("https://www.londonair.org.uk/london/asp/publicdetails.asp?site=", .data$code),
         start_date = lubridate::as_date(.data$start_date),
         end_date = lubridate::as_date(.data$end_date),
         end_date = dplyr::if_else(
@@ -485,7 +498,7 @@ prepNetworkData <- function(source, year) {
           as.character(.data$end_date)
         ),
         lab = stringr::str_glue(
-          "<u><b>{toupper(stringr::str_to_title(site))}</b> ({code})</u><br>
+          "<u><a href='{url}'><b>{toupper(stringr::str_to_title(site))}</b> ({code})</a></u><br>
           <b>Lat:</b> {round(latitude, 6)} | <b>Lon:</b> {round(longitude, 6)}<br>
           <b>Network:</b> {network}<br>
           <b>Address:</b> {Address}<br>
@@ -549,13 +562,10 @@ prepManagedNetwork <- function(data, vec) {
       )
     ) %>%
     dplyr::group_by(dplyr::across(dplyr::all_of(vec))) %>%
-    dplyr::summarise(
-      lab = paste(.data$lab, collapse = "<br>"),
-      .groups = "drop"
-    ) %>%
+    dplyr::summarise(lab = paste(.data$lab, collapse = "<br>"),
+                     .groups = "drop") %>%
     dplyr::right_join(data,
-                      by = vec
-    )
+                      by = vec)
 
   return(data)
 }
diff --git a/R/polar_polarMap.R b/R/polar_polarMap.R
@@ -36,7 +36,10 @@
 #' @param provider The base map(s) to be used. See
 #'   <http://leaflet-extras.github.io/leaflet-providers/preview/> for a list of
 #'   all base maps that can be used. If multiple base maps are provided, they
-#'   can be toggled between using a "layer control" interface.
+#'   can be toggled between using a "layer control" interface. By default, the
+#'   interface will use the provider names as labels, but users can define their
+#'   own using a named vector (e.g., `c("Default" = "OpenStreetMap", "Satellite"
+#'   = "Esri.WorldImagery")`)
 #' @param cols The colours used for plotting. See [openair::openColours()] for
 #'   more information.
 #' @param alpha The alpha transparency to use for the plotting surface (a value

diff --git a/R/utils-map.R b/R/utils-map.R
@@ -308,8 +308,13 @@ make_leaflet_map <-
     map <- leaflet::leaflet(data)
 
     # add provider tiles
-    for (i in unique(provider)) {
-      map <- leaflet::addProviderTiles(map, i, group = i)
+    if (is.null(names(provider)) | "" %in% names(provider)) {
+      names(provider) <- provider
+    }
+    for (i in seq_along(provider)) {
+      map <- leaflet::addProviderTiles(map,
+                                       provider[[i]],
+                                       group = names(provider)[[i]])
     }
 
     # work out width/height
@@ -356,14 +361,14 @@ make_leaflet_map <-
         leaflet::addLayersControl(
           map,
           baseGroups = quickTextHTML(unique(data[[split_col]])),
-          overlayGroups = provider,
+          overlayGroups = names(provider),
           options = opts
         ) %>%
-        leaflet::hideGroup(group = provider[-1])
+        leaflet::hideGroup(group = names(provider)[-1])
     } else if (flag_provider & !flag_split) {
       map <-
-        leaflet::addLayersControl(map, baseGroups = provider, options = opts) %>%
-        leaflet::hideGroup(group = provider[-1])
+        leaflet::addLayersControl(map, baseGroups = names(provider), options = opts) %>%
+        leaflet::hideGroup(group = names(provider)[-1])
     } else if (!flag_provider & flag_split) {
       map <-
         leaflet::addLayersControl(map, baseGroups = quickTextHTML(unique(data[[split_col]])), options = opts)