223 lines
7.6 KiB
R
223 lines
7.6 KiB
R
#' MNR database queries for Actuals
|
|
#'
|
|
#' @export
|
|
# nolint next: object_name_linter. R6Class
|
|
MNR.DB.Actuals <- R6::R6Class(
|
|
"MNR.DB.Actuals",
|
|
inherit = MNR.DB,
|
|
public = list(
|
|
#' @description Select the actuals for `refs`
|
|
#' @param refs <character> The MNR application noise source references
|
|
#' @returns A tibble of Actuals for `refs`
|
|
selectActuals = function(refs) {
|
|
cat("Actuals:\n")
|
|
private$db_client$table("actual_activities") %>%
|
|
dplyr::filter(proposed_activity_ref %in% !!refs) %>%
|
|
dplyr::left_join(
|
|
private$db_client$table("locations"), by = c(location_id = "id")
|
|
) %>%
|
|
dplyr::left_join(
|
|
private$db_client$table("location_blocks"), by = "location_id"
|
|
) %>%
|
|
dplyr::select(
|
|
proposed_activity_ref,
|
|
location_id,
|
|
block = block_ref,
|
|
geom,
|
|
date = occurrence_date
|
|
) %>%
|
|
dplyr::arrange(proposed_activity_ref, dplyr::desc(date)) %>%
|
|
dplyr::collect() %>%
|
|
dplyr::glimpse()
|
|
},
|
|
|
|
#' @description Returns the current actuals for a application or builds a
|
|
#' default actuals list from the proposed locations if there are none
|
|
#' @param refs <character> The MNR application noise source references
|
|
#' @returns A tibble of the proposed actuals
|
|
selectProposedActuals = function(refs) {
|
|
partA <- private$db_client$table("proposed_activities") %>%
|
|
dplyr::filter(is.null(deleted_at), is.null(cancelled_at)) %>%
|
|
dplyr::filter(ref %in% !!refs) %>%
|
|
dplyr::select(ref, application_id, location_id) %>%
|
|
dplyr::inner_join(
|
|
private$db_client$table("locations") %>%
|
|
dplyr::filter(
|
|
(area_type == "Coordinates") | (area_type == "O&G Blocks")
|
|
),
|
|
by = c(`location_id` = "id")
|
|
) %>%
|
|
dplyr::left_join(
|
|
private$db_client$table("location_blocks") %>%
|
|
dplyr::mutate(area_type = "O&G Blocks"),
|
|
by = c("location_id", "area_type")
|
|
) %>%
|
|
dplyr::select(
|
|
proposed_activity_ref = ref, location_id, block = block_ref, geom
|
|
) %>%
|
|
dplyr::collect() %>%
|
|
dplyr::transmute(
|
|
proposed_activity_ref,
|
|
location_id,
|
|
block,
|
|
date = lubridate::ymd(NA_character_),
|
|
geom = geom
|
|
)
|
|
partB <- private$db_client$table("proposed_activities") %>%
|
|
dplyr::filter(is.null(deleted_at), is.null(cancelled_at)) %>%
|
|
dplyr::filter(ref %in% !!refs) %>%
|
|
dplyr::select(ref, application_id, location_id) %>%
|
|
dplyr::inner_join(
|
|
private$db_client$table("locations") %>%
|
|
dplyr::filter(area_type == "Shapefile"),
|
|
by = c(`location_id` = "id")
|
|
) %>%
|
|
dplyr::select(proposed_activity_ref = ref, location_id, geom) %>%
|
|
dplyr::collect() %>%
|
|
dplyr::mutate(
|
|
geom.sf = sf::st_as_sfc(geom, crs = 4326, EWKB = TRUE)
|
|
) %>%
|
|
dplyr::filter(
|
|
sf::st_is(geom.sf, "POINT")
|
|
| sf::st_is(geom.sf, "MULTIPOINT")
|
|
| sf::st_is(geom.sf, "LINESTRING")
|
|
) %>%
|
|
dplyr::mutate(
|
|
geom = tolower(
|
|
sf::st_as_binary(geom.sf, EWKB = TRUE, hex = TRUE, srid = 4326)
|
|
),
|
|
geom = magrittr::set_class(geom, "pq_geometry"),
|
|
geom.sf = NULL
|
|
) %>%
|
|
dplyr::transmute(
|
|
proposed_activity_ref,
|
|
location_id,
|
|
block = NA_character_,
|
|
date = lubridate::ymd(NA_character_),
|
|
geom
|
|
)
|
|
|
|
cat("Proposed:\n")
|
|
dplyr::bind_rows(partA, partB) %>%
|
|
dplyr::glimpse()
|
|
},
|
|
|
|
#' @description Upserts the actuals in the actuals.sf into the database
|
|
#' @param actuals.sf <sf> An sf table containing the new actuals
|
|
upsertActuals = function(actuals.sf) {
|
|
if (length(actuals.sf) == 0 || (nrow(actuals.sf) == 0)) {
|
|
return(invisible(NULL))
|
|
}
|
|
|
|
self$deleteActuals(unique(actuals.sf$ref))
|
|
|
|
refs_with_actuals <- actuals.sf %>%
|
|
tidyr::unnest(dates) %>%
|
|
dplyr::filter(!is.na(dates)) %>%
|
|
dplyr::pull(ref)
|
|
|
|
actuals <- actuals.sf %>%
|
|
tibble::as_tibble() %>%
|
|
dplyr::filter(ref %in% refs_with_actuals) %>%
|
|
dplyr::mutate(
|
|
area_type = dplyr::if_else(
|
|
sf::st_is_empty(geom), "O&G Blocks", "Coordinates"
|
|
),
|
|
geom = sf::st_as_binary(geom, EWKB = TRUE, hex = TRUE)
|
|
)
|
|
|
|
if (nrow(actuals) == 0) {
|
|
cat("## No actuals to insert\n")
|
|
return(invisible(NULL))
|
|
}
|
|
|
|
cat("## Inserting locations for actuals\n")
|
|
location_rows <- actuals %>%
|
|
dplyr::select(area_type, geom) %>%
|
|
dplyr::mutate(
|
|
geom = dplyr::if_else(area_type == "O&G Blocks", NA_character_, geom)
|
|
)
|
|
location_ids <- private$db_client$appendRows(
|
|
"locations", location_rows, key_name = "id"
|
|
)
|
|
cat("NEW LOCATION ID(s):", paste(location_ids$id, collapse = ","), "\n")
|
|
|
|
actuals_w_ids <- location_ids %>%
|
|
dplyr::bind_cols(actuals) %>%
|
|
dplyr::rename(location_id = id)
|
|
|
|
location_blocks <- actuals_w_ids %>%
|
|
dplyr::select(location_id, block_ref)
|
|
private$db_client$appendRows("location_blocks", location_blocks)
|
|
|
|
cat("## Inserting actuals\n")
|
|
actuals_rows <- actuals_w_ids %>%
|
|
tidyr::unnest(dates) %>%
|
|
dplyr::filter(!is.na(dates)) %>%
|
|
dplyr::transmute(
|
|
proposed_activity_ref = ref,
|
|
location_id,
|
|
occurrence_date = dates
|
|
) %>%
|
|
dplyr::glimpse()
|
|
private$db_client$appendRows("actual_activities", actuals_rows)
|
|
|
|
cat("## Inserting marine regions\n")
|
|
marine_region_rows <- actuals_w_ids %>%
|
|
tidyr::unnest(marine_region_ids) %>%
|
|
dplyr::select(location_id, marine_region_id) %>%
|
|
dplyr::glimpse()
|
|
private$db_client$appendRows(
|
|
"location_marine_regions", marine_region_rows
|
|
)
|
|
|
|
cat("## Inserting location conservation distances\n")
|
|
sac_distance_rows <- actuals_w_ids %>%
|
|
tidyr::unnest(conservation_area_distances) %>%
|
|
dplyr::select(location_id, conservation_area_id, distance_km) %>%
|
|
dplyr::mutate(
|
|
distance_km = units::drop_units(distance_km),
|
|
flag_actual = TRUE
|
|
) %>%
|
|
dplyr::glimpse()
|
|
private$db_client$appendRows(
|
|
"location_conservation_area_distances", sac_distance_rows
|
|
)
|
|
|
|
invisible(NULL)
|
|
},
|
|
|
|
#' @description Deletes actuals for `refs`
|
|
#' @param refs <character> The MNR application noise source references
|
|
deleteActuals = function(refs) {
|
|
cat("## Deleting old actuals for", paste(refs, collapse = ","), "\n")
|
|
old_references <- private$db_client$table("actual_activities") %>%
|
|
dplyr::filter(proposed_activity_ref %in% !!refs) %>%
|
|
dplyr::select(map_id, location_id) %>%
|
|
dplyr::collect()
|
|
|
|
if (nrow(old_references) > 0) {
|
|
old_locations <- old_references %>%
|
|
dplyr::select(location_id) %>%
|
|
dplyr::distinct()
|
|
|
|
old_actuals <- old_references %>%
|
|
dplyr::select(map_id) %>%
|
|
dplyr::distinct()
|
|
|
|
private$db_client$deleteRows("actual_activities", old_actuals)
|
|
private$db_client$deleteRows("location_marine_regions", old_locations)
|
|
private$db_client$deleteRows(
|
|
"location_conservation_area_distances", old_locations
|
|
)
|
|
private$db_client$deleteRows("location_blocks", old_locations)
|
|
private$db_client$deleteRows(
|
|
"locations", old_locations %>% dplyr::rename(id = location_id)
|
|
)
|
|
}
|
|
|
|
invisible(NULL)
|
|
}
|
|
)
|
|
)
|