Merge pull request #47 from davidcarslaw/feat/site-finder

Site Finder
davidcarslaw · Jul 31, 2023 · da2b909 · da2b909
2 parents 3c4f396 + 29825eb
commit da2b909
Show file tree

Hide file tree

Showing 22 changed files with 565 additions and 151 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -21,6 +21,8 @@ Imports:
     ggmap,
     ggplot2,
     ggtext,
+    httr,
+    jsonlite,
     leaflet,
     lifecycle,
     lubridate,

diff --git a/NAMESPACE b/NAMESPACE
@@ -7,6 +7,7 @@ export(addTrajPaths)
 export(annulusMap)
 export(annulusMapStatic)
 export(buildPopup)
+export(convertPostcode)
 export(diffMap)
 export(diffMapStatic)
 export(freqMap)
@@ -19,6 +20,7 @@ export(polarMapStatic)
 export(pollroseMap)
 export(pollroseMapStatic)
 export(quickTextHTML)
+export(searchNetwork)
 export(trajLevelMap)
 export(trajLevelMapStatic)
 export(trajMap)

diff --git a/NEWS.md b/NEWS.md
@@ -8,6 +8,10 @@ These are items associated with the development version of `{openairmaps}`.
 
 ## New features
 
+* 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()`.
+
 * The "data" argument of `addPolarMarkers()` and `addTrajPaths()` and both the "before" and "after" arguments of `addPolarDiffMarkers()` now default to `leaflet::getMapData(map)`. This makes their use less verbose when creating multiple polar plots with the same underlying data, which will likely be a common use-case. (#45)
 
 * `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". (#39)

diff --git a/R/networkMap.R b/R/networkMap.R
@@ -46,6 +46,9 @@
 #'
 #' @return A leaflet object.
 #' @export
+#' @family uk air quality network mapping functions
+#'
+#' @order 1
 #'
 #' @examples
 #' \dontrun{
@@ -61,8 +64,10 @@ networkMap <-
            control = NULL,
            year = NULL,
            cluster = TRUE,
-           provider = c("Default" = "OpenStreetMap",
-                        "Satellite" = "Esri.WorldImagery"),
+           provider = c(
+             "Default" = "OpenStreetMap",
+             "Satellite" = "Esri.WorldImagery"
+           ),
            draw.legend = TRUE,
            collapse.control = FALSE) {
     # if year isn't provided, use current year
@@ -99,8 +104,10 @@ 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")
 
@@ -125,11 +132,13 @@ 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
+          )
       }
     }
 
@@ -160,35 +169,37 @@ networkMap <-
     if (!is.null(control)) {
       if (!control %in% names(meta)) {
         trycols <- names(meta)[!names(meta) %in%
-                                 c(
-                                   "code",
-                                   "site",
-                                   "latitude",
-                                   "longitude",
-                                   "country_iso_code",
-                                   "elevation",
-                                   "ratified_to",
-                                   "Address",
-                                   "la_id",
-                                   "eu_code",
-                                   "eoi_code",
-                                   "data_source",
-                                   "os_grid_x",
-                                   "os_grid_y",
-                                   "start_date",
-                                   "end_date",
-                                   "observation_count",
-                                   "start_date2",
-                                   "end_date2",
-                                   "lab",
-                                   "pcode",
-                                   "colour",
-                                   "colour2"
-                                 )]
+          c(
+            "code",
+            "site",
+            "latitude",
+            "longitude",
+            "country_iso_code",
+            "elevation",
+            "ratified_to",
+            "Address",
+            "la_id",
+            "eu_code",
+            "eoi_code",
+            "data_source",
+            "os_grid_x",
+            "os_grid_y",
+            "start_date",
+            "end_date",
+            "observation_count",
+            "start_date2",
+            "end_date2",
+            "lab",
+            "pcode",
+            "colour",
+            "colour2"
+          )]
 
         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}}"
+          )
         )
       }
 
@@ -325,9 +336,11 @@ 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(
@@ -380,7 +393,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",
@@ -440,8 +453,7 @@ prepNetworkData <- function(source, year) {
           lab = stringr::str_remove_all(.data$lab, "<b>Site Type:</b> unknown unknown<br>")
         )
     } else {
-      domain <- switch(
-        source,
+      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/",
@@ -562,10 +574,13 @@ 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_annulusMap.R b/R/polar_annulusMap.R
@@ -51,8 +51,10 @@ annulusMap <- function(data,
     lifecycle::deprecate_soft(
       when = "0.5.0",
       what = "openairmaps::annulusMap(type)",
-      details = c("Different sites are now automatically detected based on latitude and longitude",
-                  "Please use the `popup` argument to create popups.")
+      details = c(
+        "Different sites are now automatically detected based on latitude and longitude",
+        "Please use the `popup` argument to create popups."
+      )
     )
   }
 

diff --git a/R/polar_diffMap.R b/R/polar_diffMap.R
@@ -72,8 +72,10 @@ diffMap <- function(before,
     lifecycle::deprecate_soft(
       when = "0.5.0",
       what = "openairmaps::diffMap(type)",
-      details = c("Different sites are now automatically detected based on latitude and longitude",
-                  "Please use the `popup` argument to create popups.")
+      details = c(
+        "Different sites are now automatically detected based on latitude and longitude",
+        "Please use the `popup` argument to create popups."
+      )
     )
   }
 
@@ -460,8 +462,8 @@ create_polar_diffmarkers <-
     # create plots
     plots_df <-
       dplyr::inner_join(nested_before,
-                        nested_after,
-                        by = c(latitude, longitude, split_col)
+        nested_after,
+        by = c(latitude, longitude, split_col)
       ) %>%
       dplyr::mutate(
         plot = purrr::map2(before, after, fun, .progress = "Creating Polar Markers"),
@@ -478,21 +480,21 @@ create_polar_diffmarkers <-
     }
 
     purrr::pwalk(list(plots_df[[latitude]], plots_df[[longitude]], plots_df[[split_col]], plots_df$plot),
-                 .f = ~ {
-                   grDevices::png(
-                     filename = paste0(dir, "/", ..1, "_", ..2, "_", ..3, "_", id, ".png"),
-                     width = width * 300,
-                     height = height * 300,
-                     res = 300,
-                     bg = "transparent",
-                     type = "cairo",
-                     antialias = "none"
-                   )
-
-                   plot(..4)
-
-                   grDevices::dev.off()
-                 }
+      .f = ~ {
+        grDevices::png(
+          filename = paste0(dir, "/", ..1, "_", ..2, "_", ..3, "_", id, ".png"),
+          width = width * 300,
+          height = height * 300,
+          res = 300,
+          bg = "transparent",
+          type = "cairo",
+          antialias = "none"
+        )
+
+        plot(..4)
+
+        grDevices::dev.off()
+      }
     )
 
     return(plots_df)

diff --git a/R/polar_freqMap.R b/R/polar_freqMap.R
@@ -66,8 +66,10 @@ freqMap <- function(data,
     lifecycle::deprecate_soft(
       when = "0.5.0",
       what = "openairmaps::freqMap(type)",
-      details = c("Different sites are now automatically detected based on latitude and longitude",
-                  "Please use the `popup` argument to create popups.")
+      details = c(
+        "Different sites are now automatically detected based on latitude and longitude",
+        "Please use the `popup` argument to create popups."
+      )
     )
   }
 

diff --git a/R/polar_percentileMap.R b/R/polar_percentileMap.R
@@ -50,8 +50,10 @@ percentileMap <- function(data,
     lifecycle::deprecate_soft(
       when = "0.5.0",
       what = "openairmaps::percentileMap(type)",
-      details = c("Different sites are now automatically detected based on latitude and longitude",
-                  "Please use the `popup` argument to create popups.")
+      details = c(
+        "Different sites are now automatically detected based on latitude and longitude",
+        "Please use the `popup` argument to create popups."
+      )
     )
   }
 
@@ -290,7 +292,7 @@ percentileMapStatic <- function(data,
     ggplot2::geom_point(
       data = plots_df,
       ggplot2::aes(.data[[longitude]], .data[[latitude]],
-                   fill = intervals[1]
+        fill = intervals[1]
       ),
       size = 0,
       key_glyph = ggplot2::draw_key_rect

diff --git a/R/polar_polarMap.R b/R/polar_polarMap.R
@@ -99,8 +99,10 @@ polarMap <- function(data,
     lifecycle::deprecate_soft(
       when = "0.5.0",
       what = "openairmaps::polarMap(type)",
-      details = c("Different sites are now automatically detected based on latitude and longitude",
-                  "Please use the `popup` argument to create popups.")
+      details = c(
+        "Different sites are now automatically detected based on latitude and longitude",
+        "Please use the `popup` argument to create popups."
+      )
     )
   }
 
@@ -373,9 +375,11 @@ polarMapStatic <- function(data,
   if (!is.null(limits)) {
     plt <-
       plt +
-      ggplot2::geom_point(data = plots_df,
-                          ggplot2::aes(.data[[longitude]], .data[[latitude]], color = 0),
-                          alpha = 0) +
+      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)

diff --git a/R/polar_pollroseMap.R b/R/polar_pollroseMap.R
@@ -62,8 +62,10 @@ pollroseMap <- function(data,
     lifecycle::deprecate_soft(
       when = "0.5.0",
       what = "openairmaps::pollroseMap(type)",
-      details = c("Different sites are now automatically detected based on latitude and longitude",
-                  "Please use the `popup` argument to create popups.")
+      details = c(
+        "Different sites are now automatically detected based on latitude and longitude",
+        "Please use the `popup` argument to create popups."
+      )
     )
   }
 

diff --git a/R/polar_windroseMap.R b/R/polar_windroseMap.R
@@ -55,8 +55,10 @@ windroseMap <- function(data,
     lifecycle::deprecate_soft(
       when = "0.5.0",
       what = "openairmaps::windroseMap(type)",
-      details = c("Different sites are now automatically detected based on latitude and longitude",
-                  "Please use the `popup` argument to create popups.")
+      details = c(
+        "Different sites are now automatically detected based on latitude and longitude",
+        "Please use the `popup` argument to create popups."
+      )
     )
   }
 
@@ -323,7 +325,7 @@ windroseMapStatic <- function(data,
     ggplot2::geom_point(
       data = plots_df,
       ggplot2::aes(.data[[longitude]], .data[[latitude]],
-                   fill = intervals[1]
+        fill = intervals[1]
       ),
       size = 0,
       key_glyph = ggplot2::draw_key_rect