482 lines
15 KiB
R
482 lines
15 KiB
R
mnr_geoplot_env <- new.env()
|
|
|
|
#' MNR GIS plot base map generator
|
|
#'
|
|
#' Base layers are loaded and cached on first call to each of the boot methods.
|
|
#'
|
|
#' @export
|
|
# nolint next: object_name_linter. R6Class
|
|
MNR.GeoPlot <- R6::R6Class(
|
|
"MNR.GeoPlot",
|
|
public = list(
|
|
#' @description Initialises the object by building the grid lines
|
|
initialize = function() {
|
|
private$bootGridLines()
|
|
},
|
|
|
|
#' @description Loads the JNCC layers required from file for the base map
|
|
bootLayers = function() {
|
|
if (exists("layers_loaded", envir = mnr_geoplot_env)) {
|
|
private$boundaryIoM <- get("boundaryIoM", envir = mnr_geoplot_env)
|
|
private$boundaryMSFD <- get("boundaryMSFD", envir = mnr_geoplot_env)
|
|
private$boundaryUKCS <- get("boundaryUKCS", envir = mnr_geoplot_env)
|
|
private$boundaryUKTerritorial <- get(
|
|
"boundaryUKTerritorial", envir = mnr_geoplot_env
|
|
)
|
|
return(invisible(NULL))
|
|
}
|
|
|
|
boundaryIoM <- sf::st_read(
|
|
file.path(
|
|
system.file(package = "AVSDevR.MarineNoiseRegistry"),
|
|
"layers",
|
|
"20230411_IoM"
|
|
),
|
|
quiet = TRUE
|
|
)
|
|
boundaryMSFD <- sf::st_read(
|
|
file.path(
|
|
system.file(package = "AVSDevR.MarineNoiseRegistry"),
|
|
"layers",
|
|
"20250123_MSFD_BoundaryLine"
|
|
),
|
|
quiet = TRUE
|
|
)
|
|
boundaryUKCS <- sf::st_read(
|
|
file.path(
|
|
system.file(package = "AVSDevR.MarineNoiseRegistry"),
|
|
"layers",
|
|
"20230411_UKCSBoundary"
|
|
),
|
|
quiet = TRUE
|
|
)
|
|
boundaryUKTerritorial <- sf::st_read(
|
|
file.path(
|
|
system.file(package = "AVSDevR.MarineNoiseRegistry"),
|
|
"layers",
|
|
"20250123_UK_Territorial_Sea_Limit"
|
|
),
|
|
quiet = TRUE
|
|
)
|
|
|
|
assign("boundaryIoM", boundaryIoM, envir = mnr_geoplot_env)
|
|
assign("boundaryMSFD", boundaryMSFD, envir = mnr_geoplot_env)
|
|
assign("boundaryUKCS", boundaryUKCS, envir = mnr_geoplot_env)
|
|
assign(
|
|
"boundaryUKTerritorial", boundaryUKTerritorial, envir = mnr_geoplot_env
|
|
)
|
|
assign("layers_loaded", TRUE, envir = mnr_geoplot_env)
|
|
|
|
invisible(self$bootLayers())
|
|
},
|
|
|
|
#' @description Loads the Oil & Gas quadrants from file for the base map
|
|
bootQuadrants = function() {
|
|
if (exists("quadrants_loaded", envir = mnr_geoplot_env)) {
|
|
private$quadrants <- get("quadrants", envir = mnr_geoplot_env)
|
|
private$quadrant_annotations <- get(
|
|
"quadrant_annotations", envir = mnr_geoplot_env
|
|
)
|
|
return(invisible(NULL))
|
|
}
|
|
|
|
old_opts <- options(sf_use_s2 = FALSE)
|
|
on.exit({
|
|
options(old_opts)
|
|
})
|
|
|
|
quadrants <- sf::st_read(
|
|
file.path(
|
|
system.file(package = "AVSDevR.MarineNoiseRegistry"),
|
|
"layers",
|
|
"20230411_OGBQuadrants"
|
|
),
|
|
quiet = TRUE
|
|
)
|
|
quadrant_annotations <- suppressWarnings({
|
|
quadrants %>%
|
|
dplyr::select(quadrnt) %>%
|
|
sf::st_centroid()
|
|
})
|
|
|
|
assign("quadrants", quadrants, envir = mnr_geoplot_env)
|
|
assign(
|
|
"quadrant_annotations", quadrant_annotations, envir = mnr_geoplot_env
|
|
)
|
|
assign("quadrants_loaded", TRUE, envir = mnr_geoplot_env)
|
|
|
|
invisible(self$bootQuadrants())
|
|
},
|
|
|
|
#' @description Loads the Conservation Areas from the database for the base
|
|
#' map.
|
|
#' @param db_client <\link[AVSDevR.DBClient]{DBClient}> A DBClient instance
|
|
bootConservationAreas = function(db_client) {
|
|
if (exists("conservation_areas_loaded", envir = mnr_geoplot_env)) {
|
|
private$conservation_areas <- get(
|
|
"conservation_areas", envir = mnr_geoplot_env
|
|
)
|
|
private$conservation_area_colours <- get(
|
|
"conservation_area_colours", envir = mnr_geoplot_env
|
|
)
|
|
return(invisible(NULL))
|
|
}
|
|
|
|
old_opts <- options(sf_use_s2 = FALSE)
|
|
on.exit({
|
|
options(old_opts)
|
|
})
|
|
|
|
conservation_areas <- db_client$table("conservation_areas") %>%
|
|
dplyr::select(name, season, geom) %>%
|
|
db_client$collectGeometries() %>%
|
|
sf::st_sf() %>%
|
|
sf::st_cast("MULTIPOLYGON")
|
|
|
|
colour_palette <- conservation_areas %>%
|
|
dplyr::mutate(
|
|
colour = sapply(season, function(s) {
|
|
switch(
|
|
s,
|
|
Winter = "rgba(30,203,225,0.3)",
|
|
Summer = "rgba(225,52,30,0.3)",
|
|
"rgba(235,175,20,0.3)"
|
|
)
|
|
})
|
|
) %>%
|
|
dplyr::pull(colour)
|
|
|
|
conservation_area_colours <- conservation_areas %>%
|
|
sf::st_coordinates() %>%
|
|
tibble::as_tibble() %>%
|
|
dplyr::mutate(colour = colour_palette[L3]) %>%
|
|
dplyr::pull(colour)
|
|
|
|
assign("conservation_areas", conservation_areas, envir = mnr_geoplot_env)
|
|
assign(
|
|
"conservation_area_colours", conservation_area_colours,
|
|
envir = mnr_geoplot_env
|
|
)
|
|
assign("conservation_areas_loaded", TRUE, envir = mnr_geoplot_env)
|
|
|
|
invisible(self$bootConservationAreas(db_client))
|
|
},
|
|
|
|
#' @description Generates a base plotly map with optional layers included
|
|
#' @param ... Options to call plotly::plot_ly with
|
|
#' @param with_jncc_layers <logical> Includes the JNCC base layers if TRUE
|
|
#' (call obj$bootLayers() first)
|
|
#' @param with_quadrants <logical> Includes the Oil & Gas Quadrants if TRUE
|
|
#' (call obj$bootQuadrants() first)
|
|
#' @param with_conservation_areas <logical> Includes the Conservation Areas
|
|
#' if TRUE (call obj$bootConservationAreas() first)
|
|
#' @returns A plolty object base map
|
|
makeBasePlot = function(
|
|
..., with_jncc_layers = TRUE, with_quadrants = FALSE,
|
|
with_conservation_areas = FALSE
|
|
) {
|
|
do.call(plotly::plot_ly, list(...)) %>%
|
|
private$addGridLines() %>%
|
|
private$addQuadrants(with_quadrants) %>%
|
|
private$addJNCCLayers(with_jncc_layers) %>%
|
|
private$addConservationAreas(with_conservation_areas) %>%
|
|
plotly::layout(
|
|
mapbox = list(style = "carto-positron"),
|
|
legend = list(
|
|
groupclick = "toggleitem",
|
|
itemdoubleclick = FALSE
|
|
),
|
|
xaxis = list(
|
|
title = list(text = "Longitude", font = list(size = 18)),
|
|
visible = FALSE,
|
|
# Grid:
|
|
showgrid = TRUE,
|
|
gridcolor = "#BEBEBE",
|
|
# Line:
|
|
showline = TRUE,
|
|
linewidth = 2,
|
|
linecolor = "#7F7F7F",
|
|
mirror = TRUE,
|
|
zeroline = FALSE,
|
|
# Ticks:
|
|
showticklabels = TRUE,
|
|
tickmode = "linear",
|
|
tick0 = 0,
|
|
dtick = 5,
|
|
ticksuffix = " ° W"
|
|
),
|
|
yaxis = list(
|
|
title = list(text = "Latitude", font = list(size = 18)),
|
|
visible = FALSE,
|
|
# Grid:
|
|
showgrid = TRUE,
|
|
gridcolor = "#BEBEBE",
|
|
# Line:
|
|
showline = TRUE,
|
|
linewidth = 2,
|
|
linecolor = "#7F7F7F",
|
|
mirror = TRUE,
|
|
zeroline = FALSE,
|
|
# Ticks:
|
|
showticklabels = TRUE,
|
|
tickmode = "linear",
|
|
tick0 = 0,
|
|
dtick = 5,
|
|
ticksuffix = " ° N"
|
|
)
|
|
)
|
|
},
|
|
|
|
#' @description Bounds a mapbox map to a specific area and zoom
|
|
#' @param p A plotly mapbox map object
|
|
#' @param c_lat <numeric> Center latitude
|
|
#' @param c_lon <numeric> Center longitude
|
|
#' @param zoom <numeric> A mapbox zoom level
|
|
#' @param xmin <numeric> Minimum longitude to bound with
|
|
#' @param ymin <numeric> Minimum latitude to bound with
|
|
#' @param xmax <numeric> Maximum longitude to bound with
|
|
#' @param ymax <numeric> Maximum latitude to bound with
|
|
#' @returns The plotly object
|
|
boundMap = function(
|
|
p, c_lat = 56, c_lon = -5.5, zoom = 3.5, xmin = -25, ymin = 45, xmax = 5,
|
|
ymax = 65
|
|
) {
|
|
p %>%
|
|
plotly::layout(
|
|
mapbox = list(
|
|
zoom = zoom,
|
|
center = list(lat = c_lat, lon = c_lon),
|
|
`_fitBounds` = list(
|
|
bounds = list(list(xmin, ymin), list(xmax, ymax)),
|
|
options = list()
|
|
)
|
|
)
|
|
)
|
|
}
|
|
),
|
|
private = list(
|
|
major_lines = NULL,
|
|
minor_lines = NULL,
|
|
zero_lines = NULL,
|
|
|
|
boundaryIoM = NULL,
|
|
boundaryMSFD = NULL,
|
|
boundaryUKCS = NULL,
|
|
boundaryUKTerritorial = NULL,
|
|
|
|
quadrants = NULL,
|
|
quadrant_annotations = NULL,
|
|
|
|
conservation_areas = NULL,
|
|
conservation_area_colours = NULL,
|
|
|
|
|
|
bootGridLines = function() {
|
|
if (exists("gridlines_loaded", envir = mnr_geoplot_env)) {
|
|
private$major_lines <- get("major_lines", envir = mnr_geoplot_env)
|
|
private$minor_lines <- get("minor_lines", envir = mnr_geoplot_env)
|
|
private$zero_lines <- get("zero_lines", envir = mnr_geoplot_env)
|
|
return(invisible(NULL))
|
|
}
|
|
|
|
old_opts <- options(sf_use_s2 = FALSE)
|
|
on.exit({
|
|
options(old_opts)
|
|
})
|
|
|
|
points <- tibble::tibble()
|
|
for (lat in seq(-90, +90, 5)) {
|
|
points <- points %>%
|
|
dplyr::bind_rows(
|
|
tibble::tibble(
|
|
grp = nrow(points) + 1,
|
|
lat = lat,
|
|
lon = c(-180, 180),
|
|
is_major = (lat %% 10) == 0
|
|
)
|
|
)
|
|
}
|
|
for (lon in seq(-180, +175, 5)) {
|
|
points <- points %>%
|
|
dplyr::bind_rows(
|
|
tibble::tibble(
|
|
grp = nrow(points) + 1,
|
|
lat = c(-90, 90),
|
|
lon = lon,
|
|
is_major = (lat %% 10) == 0
|
|
)
|
|
)
|
|
}
|
|
suppressMessages({
|
|
major_lines <- points %>%
|
|
dplyr::filter(is_major) %>%
|
|
sf::st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
|
|
dplyr::group_by(grp) %>%
|
|
dplyr::summarise() %>%
|
|
sf::st_cast("LINESTRING")
|
|
minor_lines <- points %>%
|
|
dplyr::filter(!is_major) %>%
|
|
sf::st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
|
|
dplyr::group_by(grp) %>%
|
|
dplyr::summarise() %>%
|
|
sf::st_cast("LINESTRING")
|
|
zero_lines <- points %>%
|
|
dplyr::filter((lat == 0) | (lon == 0)) %>%
|
|
sf::st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
|
|
dplyr::group_by(grp) %>%
|
|
dplyr::summarise() %>%
|
|
sf::st_cast("LINESTRING")
|
|
assign("major_lines", major_lines, envir = mnr_geoplot_env)
|
|
assign("minor_lines", minor_lines, envir = mnr_geoplot_env)
|
|
assign("zero_lines", zero_lines, envir = mnr_geoplot_env)
|
|
})
|
|
|
|
assign("gridlines_loaded", TRUE, envir = mnr_geoplot_env)
|
|
private$bootGridLines()
|
|
},
|
|
|
|
addGridLines = function(p) {
|
|
p %>%
|
|
plotly::add_sf(
|
|
type = "scattermapbox",
|
|
data = private$minor_lines,
|
|
name = "minor_grid_lines",
|
|
line = list(width = 1),
|
|
color = I("#6161ff20"),
|
|
showlegend = FALSE,
|
|
hoverinfo = I("skip")
|
|
) %>%
|
|
plotly::add_sf(
|
|
type = "scattermapbox",
|
|
data = private$major_lines,
|
|
name = "major_grid_lines",
|
|
line = list(width = 2),
|
|
color = I("#6161ff30"),
|
|
showlegend = FALSE,
|
|
hoverinfo = I("skip")
|
|
) %>%
|
|
plotly::add_sf(
|
|
type = "scattermapbox",
|
|
data = private$zero_lines,
|
|
name = "zero_grid_lines",
|
|
line = list(width = 2),
|
|
color = I("#3131ff40"),
|
|
showlegend = FALSE,
|
|
hoverinfo = I("skip")
|
|
)
|
|
},
|
|
|
|
addJNCCLayers = function(p, with_jncc_layers) {
|
|
if (length(with_jncc_layers) == 0 || !with_jncc_layers) {
|
|
return(p)
|
|
}
|
|
if (is.null(private$boundaryIoM)) {
|
|
rlang::abort(
|
|
"JNCC layers have not been loaded. Call bootLayers first!"
|
|
)
|
|
}
|
|
p %>%
|
|
plotly::add_sf(
|
|
type = "scattermapbox",
|
|
data = dplyr::bind_rows(
|
|
sf::st_cast(private$boundaryUKCS, "LINESTRING", warn = FALSE),
|
|
sf::st_cast(private$boundaryIoM, "LINESTRING", warn = FALSE),
|
|
sf::st_cast(private$boundaryMSFD, "LINESTRING", warn = FALSE)
|
|
),
|
|
fillcolor = "#96005b00",
|
|
line = list(width = 1.5),
|
|
color = I("#96005b"),
|
|
name = "UKMS Sub-region Borders",
|
|
legendgrouptitle = list(text = "<b>Regional Boundaries</b>"),
|
|
legendgroup = "regional_boundaries",
|
|
legendrank = 850,
|
|
hoverinfo = I("skip")
|
|
) %>%
|
|
plotly::add_sf(
|
|
type = "scattermapbox",
|
|
data = private$boundaryUKCS,
|
|
fillcolor = "#00000000",
|
|
line = list(width = 1.5),
|
|
color = I("#000000"),
|
|
name = "UK Continental Shelf",
|
|
legendgrouptitle = list(text = "<b>Regional Boundaries</b>"),
|
|
legendgroup = "regional_boundaries",
|
|
legendrank = 800,
|
|
hoverinfo = I("skip")
|
|
) %>%
|
|
plotly::add_sf(
|
|
type = "scattermapbox",
|
|
data = private$boundaryUKTerritorial,
|
|
fillcolor = "#008ac100",
|
|
line = list(width = 1),
|
|
color = I("#008ac1"),
|
|
name = "UK Territorial Sea Limit",
|
|
legendgrouptitle = list(text = "<b>Regional Boundaries</b>"),
|
|
legendgroup = "regional_boundaries",
|
|
legendrank = 800,
|
|
hoverinfo = I("skip")
|
|
)
|
|
},
|
|
|
|
addQuadrants = function(p, with_quadrants) {
|
|
if (length(with_quadrants) == 0 || !with_quadrants) {
|
|
return(p)
|
|
}
|
|
if (is.null(private$quadrants)) {
|
|
rlang::abort(
|
|
"Quadrants have not been loaded. Call bootQuadrants first!"
|
|
)
|
|
}
|
|
p %>%
|
|
plotly::add_sf(
|
|
type = "scattermapbox",
|
|
data = private$quadrants,
|
|
fillcolor = "rgba(0,0,0,0)",
|
|
line = list(width = 1),
|
|
color = I("#bebebe"),
|
|
name = "Oil & Gas Quadrants",
|
|
legendgrouptitle = list(text = "<b>Oil & Gas</b>"),
|
|
legendgroup = "oil_and_gas",
|
|
legendrank = 900,
|
|
hoverinfo = I("none")
|
|
) %>%
|
|
plotly::add_sf(
|
|
type = "scattermapbox",
|
|
data = private$quadrant_annotations,
|
|
color = I("#bebebe00"),
|
|
name = "Oil & Gas Quadrant Labels",
|
|
showlegend = FALSE,
|
|
text = ~quadrnt,
|
|
hoverinfo = I("text"),
|
|
hovertemplate = I("O&G Quadrant: %{text}<extra></extra>")
|
|
)
|
|
},
|
|
|
|
addConservationAreas = function(p, with_conservation_areas) {
|
|
if (length(with_conservation_areas) == 0 || !with_conservation_areas) {
|
|
return(p)
|
|
}
|
|
if (is.null(private$conservation_areas)) {
|
|
rlang::abort(
|
|
"Conservation Areas have not been loaded. \
|
|
Call bootConservationAreas first!"
|
|
)
|
|
}
|
|
p %>%
|
|
plotly::add_sf(
|
|
type = "scattermapbox",
|
|
data = private$conservation_areas,
|
|
fillcolor = private$conservation_area_colours,
|
|
line = list(width = 0),
|
|
color = I(private$conservation_area_colours),
|
|
name = ~paste0(name, " (", season, ")"),
|
|
legendgrouptitle = list(
|
|
text = "<b>Special Areas of Conservation</b>"
|
|
),
|
|
legendgroup = "conservation_areas",
|
|
legendrank = 950
|
|
)
|
|
}
|
|
)
|
|
)
|