local_convertFunctions/convertMTBSBurnArea.R

In MazamaScience/MazamaSpatialUtils: Spatial Data Download and Utility Functions

#' @keywords datagen
#' @importFrom rlang .data
#' @export
#'
#' @title Convert MTBS Burn Area Shapefile
#'
#' @param nameOnly Logical specifying whether to only return the name without
#' creating the file.
#' @param simplify Logical specifying whether to create "_05", _02" and "_01"
#' versions of the file that are simplified to 5\%, 2\% and 1\%.
#'
#' @description Create a simple features data frame for MTBS Burn Areas
#'
#' @details A MTBS Burn Area shapefile is downloaded and converted to a
#' simple features data frame with additional columns of data. The resulting file
#' will be created in the spatial data directory which is set with
#' \code{setSpatialDataDir()}.
#'
#' The source data is from 2020.
#'
#' @note From the source documentation:
#'
#' The Monitoring Trends in Burn Severity (MTBS) project assesses the frequency,
#' extent, and magnitude (size and severity) of all large wildland fires
#' (includes wildfire, wildland fire use, and prescribed fire) in the
#' conterminous United States (CONUS), Alaska, Hawaii, and Puerto Rico for the
#' period of 1984 through 2018 All fires reported as greater than 1,000 acres in
#' the western U.S. and greater than 500 acres in the eastern U.S. are mapped
#' across all ownerships. MTBS produces a series of geospatial and tabular data
#' for analysis at a range of spatial, temporal, and thematic scales and are
#' intended to meet a variety of information needs that require consistent data
#' about fire effects through space and time. This map layer is a vector point
#' shapefile of the location of all currently inventoried and mappable MTBS
#' fires occurring between calendar year 1984 and 2018 for the continental
#' United States, Alaska, Hawaii and Puerto Rico.
#'
#' The data generated by MTBS will be used to identify national trends in burn
#' severity, providing information necessary to monitor the effectiveness of the
#' National Fire Plan and Healthy Forests Restoration Act. MTBS is sponsored by
#' the Wildland Fire Leadership Council (WFLC), a multi-agency oversight group
#' responsible for implementing and coordinating the National Fire Plan and
#' Federal Wildland Fire Management Policies. The MTBS project objective is to
#' provide consistent, 30 meter resolution burn severity data and burned area
#' delineations that will serve four primary user groups: 1. National policies
#' and policy makers such as the National Fire Plan and WFLC which require
#' information about long-term trends in burn severity and recent burn severity
#' impacts within vegetation types, fuel models, condition classes, and land
#' management activities. 2. Field management units that benefit from mid to
#' broad scale GIS-ready maps and data for pre- and post-fire assessment and
#' monitoring. Field units that require finer scale burn severity data will also
#' benefit from increased efficiency, reduced costs, and data consistency by
#' starting with MTBS data. 3. Existing databases from other comparably scaled
#' programs, such as Fire Regime and Condition Class (FRCC) within LANDFIRE,
#' that will benefit from MTBS data for validation and updating of geospatial
#' data sets. 4. Academic and agency research entities interested in fire
#' severity data over significant geographic and temporal extents.
#'
#' @return Name of the datasetName being created.
#'
#' @references \url{https://edcintl.cr.usgs.gov/downloads/sciweb1/shared/MTBS_Fire/data/composite_data/burned_area_extent_shapefile/mtbs_perimeter_data.zip}
#' @seealso setSpatialDataDir
#' @seealso getVariable

convertMTBSBurnArea <- function(
  nameOnly = FALSE,
  simplify = TRUE
) {

  # ----- Setup ----------------------------------------------------------------

  # Use package internal data directory
  dataDir <- getSpatialDataDir()

  # Specify the name of the dataset and file being created
  datasetName <- "MTBSBurnAreas"

  if (nameOnly)
    return(datasetName)

  # ----- Get the data ---------------------------------------------------------

  # Build appropriate request URL
  url <- 'https://edcintl.cr.usgs.gov/downloads/sciweb1/shared/MTBS_Fire/data/composite_data/burned_area_extent_shapefile/mtbs_perimeter_data.zip'

  filePath <- file.path(dataDir, basename(url))
  utils::download.file(url, filePath)

  utils::unzip(filePath, exdir = dataDir)

  # ----- Convert to SFDF ------------------------------------------------------

  # Convert shapefile into simple features data frame
  # NOTE:  The 'mtbs_perims_DD' directory has been created
  dsnPath <- file.path(dataDir, 'mtbs_perims_DD')
  shpName <- 'mtbs_perims_DD'
  SFDF <- convertLayer(
    dsn = dsnPath,
    layer = shpName,
    encoding = 'UTF-8'
  )

  # ----- Select useful columns and rename -------------------------------------

  # > dplyr::glimpse(SFDF)
  # Observations: 23,372
  # Variables: 7
  # $ Fire_ID    <chr> "OK3677609586220120329", "CA3893112229619980829", "CA40979...
  # $ Fire_Name  <chr> "UNNAMED", "MIDDLE", "MCDONALD", "CONWAY", "3 SPRINGS", "U...
  # $ Year       <chr> "2012", "1998", "1998", "1998", "1998", "2016", "2016", "2...
  # $ StartMonth <chr> "3", "8", "8", "2", "1", "4", "4", "4", "4", "4", "4", "5"...
  # $ StartDay   <chr> "29", "29", "31", "9", "1", "24", "8", "8", "8", "24", "24...
  # $ Fire_Type  <chr> "Unknown", "Wildfire", "Prescribed Fire", "Prescribed Fire...
  # $ Acres      <int> 1216, 6385, 3278, 1462, 1468, 10483, 24445, 1288, 31480, 7...

  # Data Dictionary:
  #   Fire_ID -----> fireID: MTBS unique identifier
  #   Fire_Name ---> fireName: name of fire
  #   Year --------> year: year of fire ignition
  #   StartMonth --> startMonth: month of fire ignition
  #   StartDay ----> startDay: day of fire ignition
  #   Fire_Type ---> fireType: type of fire
  #   Acres -------> acres: burn area in acres

  # Create stateCode from the 1st 2 letters of the Fire_ID
  SFDF$stateCode <- substr(SFDF$Fire_ID, 1, 2)
  SFDF$countryCode <- "US"

  # Create the new dataframe in a specific column order
  SFDF <-
    dplyr::select(
      .data = SFDF,
      fireID = .data$Fire_ID,
      fireName = .data$Fire_Name,
      stateCode = .data$stateCode,
      countryCode = .data$countryCode,
      year = .data$Year,
      startMonth = .data$StartMonth,
      startDay = .data$StartDay,
      fireType = .data$Fire_Type,
      acres = .data$Acres
  )

  # ----- Clean SFDF -----------------------------------------------------------

  # Group polygons with the same identifier (fireID)
  SFDF <- organizePolygons(
    SFDF,
    uniqueID = 'fireID',
    sumColumns = NULL
  )

  # Clean topology errors
  if ( !cleangeo::clgeo_IsValid(SFDF) ) {
    SFDF <- cleangeo::clgeo_Clean(SFDF, verbose = TRUE)
  }

  # ----- Name and save the data -----------------------------------------------

  # Assign a name and save the data
  message("Saving full resolution version...\n")
  assign(datasetName, SFDF)
  save(list = c(datasetName), file = paste0(dataDir, '/', datasetName, '.rda'))
  rm(list = datasetName)

  # ----- Simplify -------------------------------------------------------------

  if ( simplify ) {
    # Create new, simplified datsets: one with 5%, 2%, and one with 1% of the vertices of the original
    # NOTE:  This may take several minutes.
    message("Simplifying to 5%...\n")
    SFDF_05 <- rmapshaper::ms_simplify(SFDF, 0.05)
    SFDF_05@data$rmapshaperid <- NULL # Remove automatically generated "rmapshaperid" column
    # Clean topology errors
    if ( !cleangeo::clgeo_IsValid(SFDF_05) ) {
      SFDF_05 <- cleangeo::clgeo_Clean(SFDF_05)
    }
    datasetName_05 <- paste0(datasetName, "_05")
    message("Saving 5% version...\n")
    assign(datasetName_05, SFDF_05)
    save(list = datasetName_05, file = paste0(dataDir,"/", datasetName_05, '.rda'))
    rm(list = c("SFDF_05",datasetName_05))

    message("Simplifying to 2%...\n")
    SFDF_02 <- rmapshaper::ms_simplify(SFDF, 0.02)
    SFDF_02@data$rmapshaperid <- NULL # Remove automatically generated "rmapshaperid" column
    # Clean topology errors
    if ( !cleangeo::clgeo_IsValid(SFDF_02) ) {
      SFDF_02 <- cleangeo::clgeo_Clean(SFDF_02)
    }
    datasetName_02 <- paste0(datasetName, "_02")
    message("Saving 2% version...\n")
    assign(datasetName_02, SFDF_02)
    save(list = datasetName_02, file = paste0(dataDir,"/", datasetName_02, '.rda'))
    rm(list = c("SFDF_02",datasetName_02))

    message("Simplifying to 1%...\n")
    SFDF_01 <- rmapshaper::ms_simplify(SFDF, 0.01)
    SFDF_01@data$rmapshaperid <- NULL # Remove automatically generated "rmapshaperid" column
    # Clean topology errors
    if ( !cleangeo::clgeo_IsValid(SFDF_01) ) {
      SFDF_01 <- cleangeo::clgeo_Clean(SFDF_01)
    }
    datasetName_01 <- paste0(datasetName, "_01")
    message("Saving 1% version...\n")
    assign(datasetName_01, SFDF_01)
    save(list = datasetName_01, file = paste0(dataDir,"/", datasetName_01, '.rda'))
    rm(list = c("SFDF_01",datasetName_01))
  }

  # ----- Clean up and return --------------------------------------------------

  # Clean up
  unlink(filePath, force = TRUE)
  unlink(dsnPath, recursive = TRUE, force = TRUE)

  return(invisible(datasetName))

}