R/AVSDevR.MarineNoiseRegistry
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Updated documentation

Browse Source
This commit is contained in:
Craig Williams
2026-02-10 17:54:17 +00:00
parent 0a648f92f0
commit 02813b0583
19 changed files with 1669 additions and 153 deletions
Download Patch File Download Diff File Expand all files Collapse all files

155
R/geoPlot.R
View File

@@ -1,14 +1,32 @@
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() {
private$boundaryIoM <- sf::st_read(
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",
@@ -16,7 +34,7 @@ MNR.GeoPlot <- R6::R6Class(
),
quiet = TRUE
)
private$boundaryMSFD <- sf::st_read(
boundaryMSFD <- sf::st_read(
file.path(
system.file(package = "AVSDevR.MarineNoiseRegistry"),
"layers",
@@ -24,7 +42,7 @@ MNR.GeoPlot <- R6::R6Class(
),
quiet = TRUE
)
private$boundaryUKCS <- sf::st_read(
boundaryUKCS <- sf::st_read(
file.path(
system.file(package = "AVSDevR.MarineNoiseRegistry"),
"layers",
@@ -32,7 +50,7 @@ MNR.GeoPlot <- R6::R6Class(
),
quiet = TRUE
)
private$boundaryUKTerritorial <- sf::st_read(
boundaryUKTerritorial <- sf::st_read(
file.path(
system.file(package = "AVSDevR.MarineNoiseRegistry"),
"layers",
@@ -40,15 +58,34 @@ MNR.GeoPlot <- R6::R6Class(
),
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)
})
private$quadrants <- sf::st_read(
quadrants <- sf::st_read(
file.path(
system.file(package = "AVSDevR.MarineNoiseRegistry"),
"layers",
@@ -56,26 +93,47 @@ MNR.GeoPlot <- R6::R6Class(
),
quiet = TRUE
)
private$quadrant_annotations <- suppressWarnings({
private$quadrants %>%
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)
})
private$conservation_areas <- db_client$table("conservation_areas") %>%
conservation_areas <- db_client$table("conservation_areas") %>%
dplyr::select(name, season, geom) %>%
db_client$collectGeometries() %>%
sf::st_sf() %>%
sf::st_cast("MULTIPOLYGON")
colour_palette <- private$conservation_areas %>%
colour_palette <- conservation_areas %>%
dplyr::mutate(
colour = sapply(season, function(s) {
switch(
@@ -88,13 +146,31 @@ MNR.GeoPlot <- R6::R6Class(
) %>%
dplyr::pull(colour)
private$conservation_area_colours <- private$conservation_areas %>%
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", TRUE, envir = mnr_geoplot_env)
invisible(self$bootConservationAreas())
},
#' @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
@@ -151,6 +227,16 @@ MNR.GeoPlot <- R6::R6Class(
)
},
#' @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
@@ -186,6 +272,13 @@ MNR.GeoPlot <- R6::R6Class(
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)
@@ -215,25 +308,31 @@ MNR.GeoPlot <- R6::R6Class(
)
}
suppressMessages({
private$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")
private$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")
private$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")
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) {