Nothing
#' Create a leaflet map of air quality measurement network sites
#'
#' This function uses [openair::importMeta()] to obtain metadata for measurement
#' sites and uses it to create an attractive `leaflet` map. By default a map
#' will be created in which readers may toggle between a vector base map and a
#' satellite/aerial image, although users can further customise the control menu
#' using the `provider` and `control` parameters.
#'
#' When selecting multiple data sources using `source`, please be mindful that
#' there can be overlap between the different networks. For example, an air
#' quality site in Scotland may be part of the AURN *and* the SAQN.
#' [networkMap()] will only show one marker for such sites, and uses the order
#' in which `source` arguments are provided as the hierarchy by which to assign
#' sites to networks. The aforementioned AURN & SAQN site will therefore have
#' its SAQN code displayed if `source = c("saqn", "aurn")`, and its AURN code
#' displayed if `source = c("aurn", "saqn")`.
#'
#' This hierarchy is also reflected when `control = "network"` is used. As
#' `leaflet` markers cannot be part of multiple groups, the AURN & SAQN site
#' will be part of the "SAQN" layer control group when `source = c("saqn",
#' "aurn")` and the "AURN" layer control group when `source = c("aurn",
#' "saqn")`.
#'
#' @param source *One or more UK or European monitoring networks.*
#'
#' *default:* `"aurn"`
#'
#' One or more air quality networks for which data is available through
#' openair. Available networks include:
#' - `"aurn"`, The UK Automatic Urban and Rural Network.
#' - `"aqe"`, The Air Quality England Network.
#' - `"saqn"`, The Scottish Air Quality Network.
#' - `"waqn"`, The Welsh Air Quality Network.
#' - `"ni"`, The Northern Ireland Air Quality Network.
#' - `"local"`, Locally managed air quality networks in England.
#' - `"kcl"`, King's College London networks.
#' - `"europe"`, European AirBase/e-reporting data.
#'
#' There are two additional options provided for convenience:
#' - `"ukaq"` will return metadata for all networks for which data is imported by importUKAQ() (i.e., AURN, AQE, SAQN, WAQN, NI, and the local networks).
#' - `"all"` will import all available metadata (i.e., "ukaq" plus "kcl" and "europe").
#'
#' @param control *Option to create a 'layer control' menu.*
#'
#' *default*: `NULL`
#'
#' A string to specify categories in a "layer control" menu, to allow readers
#' to select between different site categories. Choices include:
#' - `"variable"` to toggle between different pollutants
#' - `"site_type"` for different site classifications
#' - `"agglomeration"`, `"zone"` or `"local_authority"` for different regions of the UK
#' - `"network"` for different monitoring networks, if more than one `source` is provided.
#'
#' @param year *A year, or range of years, with which to filter data.*
#'
#' *default*: `NULL`
#'
#' By default, [networkMap()] visualises sites which are currently
#' operational. `year` allows users to show sites open in a specific year, or
#' over a range of years. See [openair::importMeta()] for more information.
#'
#' @param cluster *Cluster markers together when zoomed out?*
#'
#' *default:* `TRUE`
#'
#' When `cluster = TRUE`, markers are clustered together. This may be useful
#' for sources like "kcl" where there are many markers very close together.
#' Defaults to `TRUE`, and is forced to be `TRUE` when `source = "europe"` due
#' to the large number of sites.
#'
#' @param provider *The basemap(s) to be used.*
#'
#' *default:* `c("Default" = "OpenStreetMap", "Satellite" = "Esri.WorldImagery")`
#'
#' Any number of [leaflet::providers]. 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. 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 legend *Draw a shared legend?*
#'
#' *default:* `TRUE`
#'
#' When multiple `source`s are defined, should a shared legend be created at
#' the side of the map?
#'
#' @param legend.position *Position of the legend*
#'
#' *default:* `"topright"`
#'
#' Where should the shared legend be placed? One of "topleft", "topright",
#' "bottomleft" or "bottomright". Passed to the `position` argument of
#' [leaflet::addLayersControl()].
#'
#' @param control.collapsed *Show the layer control as a collapsed?*
#'
#' *default:* `FALSE`
#'
#' Should the "layer control" interface be collapsed? If `TRUE`, users will
#' have to hover over an icon to view the options.
#'
#' @param control.position *Position of the layer control menu*
#'
#' *default:* `"topright"`
#'
#' Where should the "layer control" interface be placed? One of "topleft",
#' "topright", "bottomleft" or "bottomright". Passed to the `position`
#' argument of [leaflet::addLayersControl()].
#'
#' @returns A leaflet object.
#' @export
#' @family uk air quality network mapping functions
#'
#' @order 1
#'
#' @examples
#' \dontrun{
#' # view one network, grouped by site type
#' networkMap(source = "aurn", control = "site_type")
#'
#' # view multiple networks, grouped by network
#' networkMap(source = c("aurn", "waqn", "saqn"), control = "network")
#' }
#'
networkMap <-
function(source = "aurn",
control = NULL,
year = NULL,
cluster = TRUE,
provider = c(
"Default" = "OpenStreetMap",
"Satellite" = "Esri.WorldImagery"
),
legend = TRUE,
legend.position = "topright",
control.collapsed = FALSE,
control.position = "topright") {
# 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}}."))
}
source <- unique(source)
cols <-
dplyr::tibble(
network = c(
"AURN",
"SAQN",
"AQE",
"WAQN",
"NI",
"Locally Managed",
"KCL",
"Europe"
),
colour = c(
"red",
"orange",
"blue",
"green",
"purple",
"lightgray",
"black",
"pink"
),
realcolour = c(
"#d33d29",
"#f49630",
"#36a5d7",
"#70ad25",
"#cf51b6",
"#a3a3a3",
"#303030",
"#ff8ee9"
)
) %>%
dplyr::mutate(colour2 = ifelse(.data$colour == "#FFFFFF", "#303030", "#FFFFFF"))
# read in data
meta <-
purrr::map(
.x = source,
.f = ~ prepNetworkData(source = .x, year = year)
) %>%
purrr::list_rbind() %>%
dplyr::left_join(cols, by = "network")
# prep for legend
cols <- dplyr::filter(cols, .data$network %in% meta$network)
meta <-
meta %>%
dplyr::group_by(.data$site, .data$latitude, .data$longitude) %>%
dplyr::mutate(
network2 = paste(unique(.data$network), collapse = " <i>(& "),
network2 = dplyr::if_else(
stringr::str_detect(.data$network2, "&"),
paste0(.data$network2, ")</i>"),
.data$network2
),
lab = stringr::str_replace(.data$lab, .data$network, .data$network2)
) %>%
dplyr::select(-"network2")
# get unique pollutants if control = pollutant
if (!is.null(control)) {
if (control %in% c("Parameter_name", "variable")) {
meta <-
dplyr::group_by(
meta,
.data$site,
.data$latitude,
.data$longitude,
.data$variable
)
}
}
# get unique sites (& pollutants if appropriate)
meta <- dplyr::slice_head(meta, n = 1)
# build maps
# initialise map
map <- leaflet::leaflet()
# add provider tiles
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 = names(provider)[[i]])
}
# cluster options
if (cluster | "europe" %in% source) {
clusteropts <- leaflet::markerClusterOptions()
} else {
clusteropts <- NA
}
# sort out control
if (!is.null(control)) {
control.position <- check_legendposition(control.position, static = FALSE)
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"
)]
cli::cli_abort(
c(
"x" = "'{control}' is not an appropriate {.coed control} option.",
"i" = "Suggested control options: {.emph {trycols}}"
)
)
}
if (!control %in% c("Parameter_name", "variable")) {
meta <-
dplyr::distinct(meta, .data$code, .data$site, .keep_all = TRUE)
}
# ensure "control" is always present, and that "other" category is at the end
if (control != "network") {
meta[[control]][is.na(meta[[control]])] <- "Other"
meta[[control]] <- factor(meta[[control]])
if ("Other" %in% levels(meta[[control]])) {
meta[[control]] <-
forcats::fct_relevel(meta[[control]], "Other", after = Inf)
}
}
# get control variables
control_vars <- sort(unique(meta[[control]]))
control_vars <- control_vars[control_vars != "NO"]
# add markers
for (i in seq(length(control_vars))) {
dat <- dplyr::filter(meta, .data[[control]] == control_vars[[i]])
map <- map %>%
leaflet::addAwesomeMarkers(
data = dat,
lat = dat[["latitude"]],
lng = dat[["longitude"]],
group = quickTextHTML(control_vars[[i]]),
popup = dat[["lab"]],
label = dat[["site"]],
clusterOptions = clusteropts,
icon = leaflet::makeAwesomeIcon(
library = "fa",
icon = "info-circle",
markerColor = dat$colour,
iconColor = dat$colour2
)
)
}
if (control %in% c("Parameter_name", "variable")) {
if (length(provider) > 1) {
map <-
leaflet::addLayersControl(
map,
position = control.position,
options = leaflet::layersControlOptions(collapsed = control.collapsed, autoZIndex = FALSE),
baseGroups = sort(quickTextHTML(control_vars)),
overlayGroups = names(provider)
) %>%
leaflet::hideGroup(group = names(provider)[[-1]])
} else {
map <-
leaflet::addLayersControl(
map,
position = control.position,
options = leaflet::layersControlOptions(collapsed = control.collapsed, autoZIndex = FALSE),
baseGroups = quickTextHTML(sort(control_vars))
)
}
} else {
if (length(provider) > 1) {
map <-
leaflet::addLayersControl(
map,
position = control.position,
options = leaflet::layersControlOptions(collapsed = control.collapsed, autoZIndex = FALSE),
overlayGroups = quickTextHTML(sort(control_vars)),
baseGroups = names(provider)
) %>%
leaflet::hideGroup(group = names(provider)[[-1]])
} else {
map <-
leaflet::addLayersControl(
map,
position = control.position,
options = leaflet::layersControlOptions(collapsed = control.collapsed, autoZIndex = FALSE),
overlayGroups = quickTextHTML(sort(control_vars))
)
}
}
} else {
meta <-
dplyr::distinct(meta, .data$code, .data$site, .keep_all = TRUE)
dat <- dplyr::distinct(meta, .data$site, .keep_all = TRUE)
map <- map %>%
leaflet::addAwesomeMarkers(
data = dat,
lat = dat[["latitude"]],
lng = dat[["longitude"]],
popup = dat[["lab"]],
label = dat[["site"]],
clusterOptions = clusteropts,
icon = leaflet::makeAwesomeIcon(
library = "fa",
icon = "info-circle",
markerColor = dat$colour,
iconColor = dat$colour2
)
)
if (length(provider) > 1) {
map <-
leaflet::addLayersControl(
map,
position = control.position,
options = leaflet::layersControlOptions(collapsed = control.collapsed, autoZIndex = FALSE),
baseGroups = names(provider)
) %>%
leaflet::hideGroup(group = names(provider)[[-1]])
}
}
# multiple sources - add legend
if (length(source) > 1 & legend) {
map <-
leaflet::addLegend(
map,
opacity = 1,
position = check_legendposition(legend.position, static = FALSE),
title = "Network",
colors = cols$realcolour,
labels = paste0("<span style='line-height:1.6'>", cols$network, "</span>")
)
}
map
}
#' Function to prep network data
#' @param source source (from parent)
#' @param year year (from parent)
#' @noRd
prepNetworkData <- function(source, year) {
if (source == "saqd") {
source <- "saqn"
}
# import metadata
meta <-
openair::importMeta(
source = source,
all = TRUE,
year = year
) %>%
dplyr::filter(!is.na(.data$latitude), !is.na(.data$longitude)) %>%
dplyr::mutate(
network = dplyr::case_when(
source %in% c("local", "lmam") ~ "Locally Managed",
source == "europe" ~ "Europe",
TRUE ~ toupper(source)
)
)
names(meta)[names(meta) %in% c("date_start", "OpeningDate")] <-
"start_date"
names(meta)[names(meta) %in% c("date_end", "ClosingDate")] <-
"end_date"
# drop HC vars
if ("variable" %in% names(meta)) {
hc_vars <- c(
"ETHANE",
"ETHENE",
"ETHYNE",
"PROPANE",
"PROPENE",
"iBUTANE",
"nBUTANE",
"1BUTENE",
"t2BUTENE",
"c2BUTENE",
"iPENTANE",
"nPENTANE",
"13BDIENE",
"t2PENTEN",
"1PENTEN",
"2MEPENT",
"ISOPRENE",
"nHEXANE",
"nHEPTANE",
"iOCTANE",
"nOCTANE",
"BENZENE",
"TOLUENE",
"ETHBENZ",
"mpXYLENE",
"oXYLENE",
"123TMB",
"124TMB",
"135TMB",
"c2PENTEN",
"MEPENT",
"3MEPENT",
"NAPHTH"
)
meta <- dplyr::filter(
meta, !.data$variable %in% hc_vars, !.data$variable %in% c(
"ws",
"wd",
"temp",
"NV10",
"V10",
"NV2.5",
"V2.5",
"PM1",
"BC"
)
)
}
# network-specific manipulations
if (!source %in% c("kcl", "europe")) {
if (source %in% c("local", "lmam")) {
meta <-
prepManagedNetwork(
meta,
c(
"code",
"site",
"site_type",
"latitude",
"longitude",
"network",
"zone",
"agglomeration",
"provider"
)
) %>%
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><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,
c(
"code",
"site",
"site_type",
"network",
"latitude",
"longitude",
"zone",
"agglomeration",
"local_authority"
)
) %>%
dplyr::mutate(
lab = stringr::str_glue(
"<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>
<b>Zone:</b> {zone}<br>
<b>Agglomeration:</b> {agglomeration}<br>
<b>Local Authority:</b> {local_authority}<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>Local Authority:</b> NA<br>")
)
}
}
if (source == "kcl") {
# create labels
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(
is.na(.data$end_date),
"ongoing",
as.character(.data$end_date)
),
lab = stringr::str_glue(
"<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>
<b>Site Type:</b> {site_type}<br>
<b>Authority:</b> {Authority} ({la_id})<hr>
{start_date} - {end_date}"
)
)
}
if (source == "europe") {
# create labels
meta <-
dplyr::mutate(
meta,
site = dplyr::if_else(is.na(.data$site), "Unknown Name", .data$site),
start_date = lubridate::as_date(.data$start_date),
start_date = dplyr::if_else(
is.na(.data$start_date),
"unknown start",
as.character(.data$start_date)
),
end_date = lubridate::as_date(.data$end_date),
end_date = dplyr::if_else(
is.na(.data$end_date),
"ongoing",
as.character(.data$end_date)
),
lab = stringr::str_glue(
"<u><b>{toupper(stringr::str_to_title(site))}</b> ({code})</u><br>
<b>Lat:</b> {round(latitude, 6)} | <b>Lon:</b> {round(longitude, 6)}<br>
<b>Network:</b> {network}<br>
<b>Country:</b> {stringr::str_to_title(country)} ({country_iso_code})<br>
<b>Site Type:</b> {stringr::str_to_title(site_type)}<br>
<b>Site Area:</b> {stringr::str_replace(site_area, '_', ' ') %>% stringr::str_to_title()}<hr>
{start_date} - {end_date}"
)
)
}
return(meta)
}
#' function to prep AURN and LMAM data for plotting
#' not used for Europe and KCL
#' @param data metadata
#' @param vec char vector of columns - used for grouping/joining
#' @param date from parent func
#' @noRd
prepManagedNetwork <- function(data, vec) {
# get variable names
vars <- unique(data$variable)
vars[vars == "NO"] <- "NOx"
# create labels
data <- data %>%
dplyr::filter(.data$variable != "NO") %>%
dplyr::mutate(
lab = stringr::str_glue(
"<b>{quickTextHTML(Parameter_name)} ({quickTextHTML(variable)})</b><br>{start_date} - {end_date}"
)
) %>%
dplyr::group_by(dplyr::across(dplyr::all_of(vec))) %>%
dplyr::summarise(
lab = paste(.data$lab, collapse = "<br>"),
.groups = "drop"
) %>%
dplyr::right_join(data,
by = vec
)
return(data)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.