R/mod06_add_CROME.R

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

#######################################
### Worflow functions               ###
### for EcoservR                    ###
### Sandra Angers-Blondin           ###
### 26 October 2020                 ###
#######################################

#' Add Crop Map of England data
#'
#' This function adds Crop Map of England data to the basemap (England only).

#' @param mm The mm object loaded in the environment, can be at various stages of updating.
#' @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 project_title_MM_06.RDS file to project folder
#' @export

add_CROME <- 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(scratch_path)) dir.create(scratch_path)

   # Get path
   cromepath <- projectLog$df[projectLog$df$dataset == "crome", ][["path"]]  # path to corine data, if available
   dsname <- projectLog$df[projectLog$df$dataset == "crome", ][["prettynames"]] # dataset name

   if (!is.na(cromepath) & !is.null(cromepath)){
      message("Preparing to update baseline with CROME data...")

      crometype <- guessFiletype(cromepath)   # file type, gpkg or shp

      crome_cols <- tolower(  # making all lowercase for easier matching
         projectLog$df[projectLog$df$dataset == "crome", ][["cols"]][[1]]  # attributes
      )

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

   # Import crome data and key

crome <- loadSpatial(cromepath, filetype = crometype)  # using the loading into list function in case there are many shp



# DATA PREP -----------------------------------------------------------------------------------

# Crome data can be weird with inconsistent columns between regions... subset to just the columns we need first and THEN combine list elements

crome <- lapply(crome, function(x){

   names(x) <- tolower(names(x)) # make all lowercase for easier matching

   x <- dplyr::select(x, tidyselect::all_of(crome_cols)) %>%
                   sf::st_make_valid()

   return(x)
})


crome <- do.call(rbind, crome) %>% sf::st_as_sf()

## Crop to study area

   crome <- checkcrs(crome, studyAreaBuffer) # check that same crs before clipping

   # Speed up intersection by indexing which polygons need it

   crome <- faster_intersect(crome, studyAreaBuffer) %>% sf::st_make_valid()

## Replace lucode with the text description

crome$lucode <- dplyr::recode(crome$lucode, !!!crome_lookup, .default = as.factor(NA))


## Rasterize data

      ## These custom functions will check data size and create tiles if required, otherwise will process everything in memory

      crome_v <- prepTiles(mm, crome, studyArea = studyAreaBuffer, value = "lucode")
      rm(crome)

      if(is.null(crome_v)){

         projectLog$ignored <- c(projectLog$ignored, dsname)
         updateProjectLog(projectLog)

         return(message("WARNING: CROME data not added: No data coverage for your study area."))
      }

      crome_r <- makeTiles(crome_v, value = "lucode", name = "crome")
      rm(crome_v)



# ZONAL STATISTICS TO UPDATE MASTERMAP ----------------------------------------------------------

   message("Extracting CROME data...")

      # Create a key from the rasters' levels to add the descriptions back into the mastermap after extraction
      key <- as.data.frame(raster::levels(crome_r[[1]]))

      # Adds a new column populated with crome id

      mm <- mapply(function(x, n) extractRaster(x, crome_r, fun = "majority", tile = n, newcol = "crome"),
                   x = mm,
                   n = names(mm), # passing the names of the tiles will allow to select corresponding raster, making function faster. If user is not working with named tiles, will be read as null and the old function will kick in (slower but works)
                   SIMPLIFY = FALSE)  # absolutely necessary


      rm(crome_r)

      names(key) <- c("ID", "rcode")  # rename columns of key df to match the function

      #  Replace the numeric codes by the text description (also a custom function)

      mm <- lapply(mm, function(x) addAttributes(x, "crome", key))






# SAVE UPDATED MASTER MAP ---------------------------------------------------------------------

   saveRDS(mm, file.path(output_temp, paste0(title, "_MM_06.RDS")))


   # Update the project log with the information that map was updated

   projectLog$last_success <- "MM_06.RDS"

   timeB <- Sys.time() # stop time

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

   updateProjectLog(projectLog) # save revised log

   # and delete contents of scratch folder
   cleanUp(scratch_path)


   message(paste0("Finished updating with Crop Map of England data. Process took ",
                     round(difftime(timeB, timeA, units = "mins"), digits = 1),
                     " minutes."))



   } else {message("No Crop Map of England data input specified.")} # end of running condition


   # Return mm to environment, whether it has been updated or not.
   return({
      invisible({
         mm <<- mm
         projectLog <<- projectLog
      })
   })

} # end of function