R/clean_hedgerows.R

In ecoservR/ecoserv_tool: Natural Capital Mapping Toolkit (UK)

#' Prepare Hedgerows
#'
#' This function supersedes the add_hedgerows() function that used to embed new geometries within the basemap. Instead, this function imports the source hedgerow data (line data) and cleans it up into a layer that can be used as optional input in the ES models.

#' @param mm The mm object loaded in the environment, usually after running the whole basemap process.
#' @param studyAreaBuffer The buffered study area generated during mod01 or reloaded when resuming a session.
#' @param projectLog The RDS project log file generated by the wizard app and containing all file paths to data inputs and model parameters
#' @return Saves a clean_hedges_project-title.RDS file to project folder in intermediary folder. The path is saved in projectLog$clean_hedges and this is the path that is read in the ES models when use_hedges = TRUE.
#' @export


clean_hedgerows <- function (mm = parent.frame()$mm,
                             studyAreaBuffer = parent.frame()$studyAreaBuffer,
                             projectLog = parent.frame()$projectLog){

   timeA <- Sys.time() # start time

   ## Extract the file paths and other info from project log ----------------------

   output_temp <- projectLog$output_temp
   title <- projectLog$title
   scratch_path <- file.path(output_temp, "ecoservR_scratch")

   if (!dir.exists(output_temp))
      dir.create(output_temp)

   if (!dir.exists(scratch_path))
      dir.create(scratch_path)


   # Get path
   hedgepath <- projectLog$df[projectLog$df$dataset == "hedgerows", ][["path"]]
   hedgetype <- guessFiletype(hedgepath)

   if (!is.na(hedgepath) & !is.null(hedgepath)) {

      # DATA IMPORT ---------------------------------------------------------------------------------

      # Import hedge data

      hedge <- loadSpatial(hedgepath, filetype = hedgetype)
      message("Imported hedgerow data...")

      # Tidy up the files so we can combine them together
      hedge <- lapply(hedge, function(x) sf::st_zm(x, drop = TRUE) %>% # remove Z dimension if present
                         checkcrs(., studyAreaBuffer) %>%  # check proj
                         sf::st_geometry() %>% # drop attributes
                         sf::st_union() %>%
                         sf::st_as_sf() %>% #make sure format is sf df
                         sf::st_cast(to = "MULTILINESTRING") %>%
                         sf::st_cast(to = "LINESTRING"))

      hedge <- do.call(rbind, hedge) %>% sf::st_as_sf() # putting back into one single sf object

      ## make sure the geometry column has the same name as mm
      hedge <- ecoservR::rename_geometry(hedge, attr(mm[[1]], "sf_column"))


      # DATA PREP -----------------------------------------------------------------------------------
      message("Creating hedgerows from linear features")

      # Keep only the geometry column
      # and buffer to create polygons from linear features
      hedge <- sf::st_geometry(hedge) %>%
         sf::st_buffer(1.25, endCapStyle = "ROUND", joinStyle = "MITRE")  # rounded ends give best results when unioning, even if add an extra meter to the end of the hedge


      ## Grid the polygonized hedgerows so we have named tiles that match mm
      SAgrid <- ecoservR::grid_study(studyAreaBuffer)
      SAgrid <- SAgrid[names(SAgrid) %in% names(mm)]
      hedge <- lapply(SAgrid, function(x) sf::st_intersection(hedge,
                                                              sf::st_geometry(x)) %>%
                         checkgeometry(.) %>%
                         sf::st_as_sf())


      hedge <- hedge[sapply(hedge, function(x) nrow(x) > 0)] # remove empty tiles
      rm(SAgrid)

      # The union is necessary to remove overlap (takes a while)
      message("Unioning hedgerows to remove overlaps")

      hedge <- lapply(hedge, function(x) {
         sf::st_union(x) %>%
            sf::st_as_sf() %>%
            ecoservR::checkgeometry(.)
      })

      # Trim hedges -------------------------------------------------------------

      # Trim hedges so that the buffer doesn't encroach on structures (buildings and roads)

      for (i in 1:length(mm)) {

         tilename <- names(mm)[[i]]
         if (!tilename %in% names(hedge)) {
            next
         }

         message("Reshaping hedgerows, tile ", tilename)

         # Get index of manmade features for that tile
         index <- (mm[[i]][["Make"]] == "Manmade" |
                      mm[[i]][["Theme"]] == "Water")

         if (any(index)) { # if we detected some of those features
            hedge[[tilename]] <- rmapshaper::ms_erase(hedge[[tilename]],
                                                      mm[[i]][index, ]) %>%
               checkgeometry(.)
         }
      }



      # Combine hedges in single layer ------------------------------------------

      hedge <- do.call(rbind, hedge) %>%
         sf::st_union() %>%
         sf::st_as_sf() %>%
         #sf::st_buffer(0.1) %>%
         #sf::st_buffer(-0.1) %>%
         #sf::st_union() %>%
         #sf::st_as_sf() %>%
         sf::st_make_valid() %>%
         sf::st_cast(to = "MULTIPOLYGON") %>%
         sf::st_cast(to = "POLYGON")



      # Save --------------------------------------------------------------------

      saveRDS(hedge,
              paste0(projectLog$output_temp, '/cleaned_hedges_', title, '.RDS'))

      # Save the path so we can recall it in ES models
      projectLog$clean_hedges <- paste0(projectLog$output_temp, '/cleaned_hedges_', title, '.RDS')

      timeB <- Sys.time() # stop time

      # add performance to log
      projectLog$performance[["clean_hedges"]] <- as.numeric(difftime(
         timeB, timeA, units="mins"
      ))

      updateProjectLog(projectLog) # save revised log



      message(paste0("Finished preparing hedgerow data. Process took ",
                     round(difftime(timeB, timeA, units = "mins"), digits = 1),
                     " minutes."))

   } else {
      message("No hedgerow data input specified.")
   }

   return({
      invisible({
         mm <<- mm
         projectLog <<- projectLog
      })
   })
}