R/bc_bound.R

In bcgov/bcmaps: Map Layers and Spatial Utilities for British Columbia

# Copyright 2020 Province of British Columbia
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and limitations under the License.

#' BC Boundary - High Resolution
#'
#' @param ask Should the function ask the user before downloading the data to a cache? Defaults to the value of interactive().
#' @param force Should you force download the data?
#'
#' @return The spatial layer of `bc_bound_hres` as an `sf` object
#'
#' @examples
#' \dontrun{
#' my_layer <- bc_bound_hres()
#' }
#'
#' @source `bcdc_get_data(record = '30aeb5c1-4285-46c8-b60b-15b1a6f4258b',
#'          resource = '3d72cf36-ab53-4a2a-9988-a883d7488384',
#'          layer = 'BC_Boundary_Terrestrial_Multipart')`
#'
#' @family BC layers
#'
#' @export
bc_bound_hres <- function(ask = interactive(), force = FALSE) {

  dir <- data_dir()
  fpath <- file.path(dir, "bc_bound_hres.rds")

  if (!file.exists(fpath) | force) {
    check_write_to_data_dir(dir, ask)
    ret <- bcdata::bcdc_get_data(record = '30aeb5c1-4285-46c8-b60b-15b1a6f4258b',
                                 resource = '3d72cf36-ab53-4a2a-9988-a883d7488384',
                                 layer = 'BC_Boundary_Terrestrial_Multipart')
    ret <- rename_sf_col_to_geometry(ret)
    saveRDS(ret, fpath)
  } else {
    ret <- readRDS(fpath)
    time <- attributes(ret)$time_downloaded
    update_message_once(paste0('bc_bound_hres was updated on ', format(time, "%Y-%m-%d")))
  }

  ret
}


#' BC Boundary
#'
#' @inheritParams bc_bound_hres
#'
#' @return The spatial layer of `bc_bound` as an `sf` object
#'
#' @source `bcdata::bcdc_get_data('b9bd93e1-0226-4351-b943-05c6f80bd5da')`
#'
#' @examples
#' \dontrun{
#' my_layer <- bc_bound()
#' }
#'
#' @family BC layers
#'
#' @export
bc_bound <- function(ask = interactive(), force = FALSE) {

  dir <- data_dir()
  fpath <- file.path(dir, "bc_bound.rds")

  if (!file.exists(fpath) | force) {
    check_write_to_data_dir(dir, ask)
    ret <- bcdata::bcdc_get_data('b9bd93e1-0226-4351-b943-05c6f80bd5da')
    ret <- ret[ret$ENGLISH_NAME == "British Columbia",]
    ret <- ret[!is.na(ret$ENGLISH_NAME), c("ISLAND")]
    colnames(ret) <- tolower(colnames(ret))
    saveRDS(ret, fpath)
  } else {
    ret <- readRDS(fpath)
    time <- attributes(ret)$time_downloaded
    update_message_once(paste0('bc_bound_hres was updated on ', format(time, "%Y-%m-%d")))
  }

  ret
}


#' Boundary of British Columbia, provinces/states and the portion of the Pacific Ocean that borders British Columbia
#'
#'
#' @inheritParams bc_bound_hres
#'
#' @return The spatial layer of `bc_neighbours` as an `sf` object
#'
#'
#' @source `bcdata::bcdc_get_data('b9bd93e1-0226-4351-b943-05c6f80bd5da')`
#'
#' @examples
#' \dontrun{
#' my_layer <- bc_neighbours()
#' }
#'
#' @export
bc_neighbours <- function(ask = interactive(), force = FALSE) {

  dir <- data_dir()
  fpath <- file.path(dir, "bc_neighbours.rds")

  if (!file.exists(fpath) | force) {
    check_write_to_data_dir(dir, ask)
    ret <- bcdata::bcdc_get_data("b9bd93e1-0226-4351-b943-05c6f80bd5da")
    time <- attributes(ret)$time_downloaded

    ## Square box on projected surface
    coords <- list(matrix(c(
      -142, 59.9, -137.69, 47,
      -114.31, 47, -110, 59.9,
      -142, 59.9
    ),
    ncol = 2,
    byrow = TRUE
    ))

    outside_bc_box <- sf::st_polygon(coords)
    outside_bc_box <- sf::st_sfc(outside_bc_box, crs = 4326)
    outside_bc_box <- transform_bc_albers(outside_bc_box)

    bc_neighbours <- suppressWarnings(sf::st_intersection(ret, outside_bc_box))
    bc_neighbours$iso_a2 <- ifelse(bc_neighbours$NATION_ENGLISH_NAME == "Canada", "CA", "US")
    bc_neighbours <- bc_neighbours[!is.na(bc_neighbours$ENGLISH_NAME), c("iso_a2", "NAME", "STATUS")]
    colnames(bc_neighbours) <- c("iso_a2", "name", "type", "geometry")

    ## Pull out a Pacific Ocean polygon and give it the same cols as bc_neighbours
    bc_oceans_sfc <- sf::st_difference(outside_bc_box, sf::st_union(bc_neighbours))
    bc_oceans <- data.frame(iso_a2 = "OC", name = "Pacific Ocean", type = "Ocean")
    sf::st_geometry(bc_oceans) <- bc_oceans_sfc

    ## Bind the neighbours and ocean data together and aggregate
    ret <- rbind(bc_neighbours, bc_oceans)
    ret <- stats::aggregate(ret, by = list(ret$iso_a2, ret$name, ret$type),
                            FUN = unique, do_union = TRUE)
    ret <- ret[, !grepl("Group\\.", names(ret))]


    class(ret) <- c("sf", "tbl_df", "tbl", "data.frame")
    attr(ret, 'time_downloaded') <- time
    saveRDS(ret, fpath)
  } else {
    ret <- readRDS(fpath)
    time <- attributes(ret)$time_downloaded
    update_message_once(paste0('bc_neighbours was updated on ', format(time, "%Y-%m-%d")))
  }

  ret
}