Rfp bcd get data bbox

DESCRIPTION

@@ -7,7 +7,7 @@ Description: Tools to build and document GIS projects and GIS analysis as reprod
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2.9000
 Imports:
     bcdata,
     chk,

NAMESPACE

@@ -8,12 +8,16 @@ export(rfp_gpx_import)
 export(rfp_meta_bcd_xref)
 export(rfp_meta_bcd_xref_col_comments)
 export(rfp_photo_metadata_rm)
+export(rfp_source_bcdata)
 export(rfp_source_csv)
 export(rfp_source_url)
 export(rfp_u_rm_gpkg_layers)
+importFrom(bcdata,INTERSECTS)
 importFrom(bcdata,bcdc_describe_feature)
 importFrom(bcdata,bcdc_query_geodata)
 importFrom(bcdata,bcdc_search)
+importFrom(bcdata,collect)
+importFrom(bcdata,filter)
 importFrom(chk,chk_character)
 importFrom(chk,chk_ext)
 importFrom(chk,chk_file)
@@ -58,8 +62,10 @@ importFrom(purrr,pluck)
 importFrom(purrr,set_names)
 importFrom(rlang,sym)
 importFrom(sf,st_drop_geometry)
+importFrom(sf,st_intersection)
 importFrom(sf,st_layers)
 importFrom(sf,st_read)
+importFrom(sf,st_transform)
 importFrom(sf,st_write)
 importFrom(stringr,str_to_lower)
 importFrom(stringr,str_to_upper)

R/rfp_source_bcdata.R

@@ -0,0 +1,75 @@
+#' Download and Save BC Data to GPKG
+#'
+#' Downloads a layer from the BC Data Catalogue, optionally intersects with a mask, and writes it to a GeoPackage.
+#'
+#' @param bcdata_record_id [character] A character string specifying the BC Data Catalogue record ID permanent id (7ecfafa6-5e18-48cd-8d9b-eae5b5ea2881),
+#' name of the record (pscis-assessments) or `object name` (ex. WHSE_FISH.PSCIS_ASSESSMENT_SVW).  The name of the record
+#' can be found at https://catalogue.data.gov.bc.ca/.  This does not need to be in capitals as we will convert to capitals
+#' within the function.
+#' @param path_gpkg [character] Path to the output GeoPackage file.
+#' @param mask [sf] Optional masking polygon to clip spatial extent. Can massively increase download speed as first queries only bbox from api.
+#' @param layer_name [character] Optional layer name for writing to the GPKG. If NULL - the name of the layer defaults to `bcdata_record_id` as all lower case.
+#' Designed to work best with object name fed to `bcdata_record_id`.
+#'
+#' @importFrom bcdata bcdc_query_geodata collect filter INTERSECTS
+#' @importFrom sf st_transform st_intersection st_write
+#' @importFrom stringr str_to_lower
+#' @importFrom chk chk_string chk_file
+#' @export
+#' @examples
+#' \dontrun{
+#' path_gpkg <- "~/Projects/gis/restoration_wedzin_kwa/background_layers.gpkg"
+#' mask <- sf::st_read(
+#'   path_gpkg,
+#'   layer = "whse_basemapping.fwa_watershed_groups_poly"
+#' )
+#' get_this <- c("whse_basemapping.bcgs_5k_grid", "WHSE_BASEMAPPING.BCGS_2500_GRID")
+#' name_this <- c("test", "test2")
+#' purrr::walk2(
+#'   .x = get_this,
+#'   .y = name_this,
+#'   .f = ~rfp_source_bcdata(
+#'     bcdata_record_id = .x,
+#'     path_gpkg = path_gpkg,
+#'     layer_name = .y,
+#'     mask = mask
+#'   )
+#' )
+#' }
+rfp_source_bcdata <- function(
+    bcdata_record_id = NULL,
+    path_gpkg = NULL,
+    mask = NULL,
+    layer_name = NULL
+){
+  chk::chk_string(bcdata_record_id)
+  chk::chk_file(path_gpkg)
+  if (!is.null(layer_name)) {
+    chk::chk_string(layer_name)
+  }
+  bcdata_record_id <- stringr::str_to_upper(bcdata_record_id)
+
+  if (!is.null(mask)) {
+    mask <- mask |>
+      sf::st_geometry() |>
+      sf::st_transform(crs = 3005)
+    l <- bcdata::bcdc_query_geodata(bcdata_record_id) |>
+      bcdata::filter(bcdata::INTERSECTS(mask)) |>
+      bcdata::collect() |>
+      sf::st_intersection(mask)
+  } else {
+    l <- bcdata::bcdc_query_geodata(bcdata_record_id) |>
+      bcdata::collect()
+  }
+
+  if (is.null(layer_name)) {
+    layer_name <- bcdata_record_id
+  }
+
+  l |>
+    sf::st_write(
+      dsn = path_gpkg,
+      layer = stringr::str_to_lower(layer_name),
+      delete_layer = TRUE
+    )
+}

dev/config.R

@@ -0,0 +1,12 @@
+# setup actions
+
+use_pipe(export = TRUE)
+usethis::use_package("dplyr")
+usethis::use_package("purrr")
+usethis::use_package("stringr")
+usethis::use_package("tibble")
+usethis::use_package("cli")
+usethis::use_package("bcdata")
+usethis::use_package("chk")
+usethis::use_package("sf")
+usethis::use_package("glue")

tests/testthat/test-rfp_source_bcdata.R

@@ -0,0 +1,35 @@
+# path_gpkg <- "~/Projects/gis/restoration_wedzin_kwa/background_layers.gpkg"
+# mask <- sf::st_read(
+#   path_gpkg,
+#   layer = "whse_basemapping.fwa_watershed_groups_poly"
+# )
+# get_this <- c("whse_basemapping.bcgs_5k_grid", "WHSE_BASEMAPPING.BCGS_2500_GRID")
+# name_this <- c("test", "test2")
+# purrr::walk2(
+#   .x = get_this,
+#   .y = name_this,
+#   .f = ~rfp_source_bcdata(
+#     bcdata_record_id = .x,
+#     path_gpkg = path_gpkg,
+#     layer_name = .y,
+#     mask = mask
+#   )
+# )
+#
+# rfp_source_bcdata(
+#   bcdata_record_id = bcdata_record_id,
+#   path_gpkg = path_gpkg,
+#   mask = mask,
+#   layer_name = "test"
+# )
+#
+# layers <- ngr::ngr_spk_layer_info(path_gpkg)
+#
+# bcdata_record_id <- stringr::str_to_lower("WHSE_BASEMAPPING.BCGS_2500_GRID")
+#
+# t2 |>
+#   mapview::mapview()
+#
+# purrr::map(name_this, ~ gdalraster::ogr_layer_delete(path_gpkg, .x))
+#
+# gdalraster::ogr_layer_delete(path_gpkg, "test")