Added common files (geo layers, css, js and images) as well as the geo plot method and a mechanism to insert the mnr css etc files in the header
This commit is contained in:
382
R/geoPlot.R
Normal file
382
R/geoPlot.R
Normal file
@@ -0,0 +1,382 @@
|
||||
#' @export
|
||||
# nolint next: object_name_linter. R6Class
|
||||
MNR.GeoPlot <- R6::R6Class(
|
||||
"MNR.GeoPlot",
|
||||
public = list(
|
||||
initialize = function() {
|
||||
private$bootGridLines()
|
||||
},
|
||||
|
||||
bootLayers = function() {
|
||||
private$boundaryIoM <- sf::st_read(
|
||||
file.path(
|
||||
system.file(package = "AVSDevR.MarineNoiseRegistry"),
|
||||
"layers",
|
||||
"20230411_IoM"
|
||||
),
|
||||
quiet = TRUE
|
||||
)
|
||||
private$boundaryMSFD <- sf::st_read(
|
||||
file.path(
|
||||
system.file(package = "AVSDevR.MarineNoiseRegistry"),
|
||||
"layers",
|
||||
"20250123_MSFD_BoundaryLine"
|
||||
),
|
||||
quiet = TRUE
|
||||
)
|
||||
private$boundaryUKCS <- sf::st_read(
|
||||
file.path(
|
||||
system.file(package = "AVSDevR.MarineNoiseRegistry"),
|
||||
"layers",
|
||||
"20230411_UKCSBoundary"
|
||||
),
|
||||
quiet = TRUE
|
||||
)
|
||||
private$boundaryUKTerritorial <- sf::st_read(
|
||||
file.path(
|
||||
system.file(package = "AVSDevR.MarineNoiseRegistry"),
|
||||
"layers",
|
||||
"20250123_UK_Territorial_Sea_Limit"
|
||||
),
|
||||
quiet = TRUE
|
||||
)
|
||||
},
|
||||
|
||||
bootQuadrants = function() {
|
||||
old_opts <- options(sf_use_s2 = FALSE)
|
||||
on.exit({
|
||||
options(old_opts)
|
||||
})
|
||||
|
||||
private$quadrants <- sf::st_read(
|
||||
file.path(
|
||||
system.file(package = "AVSDevR.MarineNoiseRegistry"),
|
||||
"layers",
|
||||
"20230411_OGBQuadrants"
|
||||
),
|
||||
quiet = TRUE
|
||||
)
|
||||
private$quadrant_annotations <- suppressWarnings({
|
||||
private$quadrants %>%
|
||||
dplyr::select(quadrnt) %>%
|
||||
sf::st_centroid()
|
||||
})
|
||||
},
|
||||
|
||||
bootConservationAreas = function(db_client) {
|
||||
old_opts <- options(sf_use_s2 = FALSE)
|
||||
on.exit({
|
||||
options(old_opts)
|
||||
})
|
||||
|
||||
private$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 %>%
|
||||
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)
|
||||
|
||||
private$conservation_area_colours <- private$conservation_areas %>%
|
||||
sf::st_coordinates() %>%
|
||||
tibble::as_tibble() %>%
|
||||
dplyr::mutate(colour = colour_palette[L3]) %>%
|
||||
dplyr::pull(colour)
|
||||
},
|
||||
|
||||
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"
|
||||
)
|
||||
)
|
||||
},
|
||||
|
||||
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() {
|
||||
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({
|
||||
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")
|
||||
})
|
||||
},
|
||||
|
||||
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
|
||||
)
|
||||
}
|
||||
)
|
||||
)
|
||||
Reference in New Issue
Block a user