R/f_extract_watersheds_output.R

In biopsichas/swattools: SWAT output assessment and visualising of modelling results

#' Function to extract all output data from SWAT model output.rch, output.sub and output.hru files
#'
#'This function allows reading in all output.rch, output.sub, output.hru files generated by SWAT2012
#'in Lithuanian EPA model, which was applied for different climate and measures scenarios.
#'
#' @param watersheds_folder_path String giving path to the Watersheds folder where all output results are saved.
#' (example "../../MODEL/MODEL_CLIMATE_LONG/Setup/Watersheds")
#' @param scenarios Vector providing scenario name used in saving modeling results. Example for combining climate and measures could be:
#' as.vector(outer(c("C1", "C2"), c("M1", "M2"), paste, sep="_")). This would allow generation of vector, which could be used in loop.
#' An example, scenarios = c("HIRHAM5_rcp45_measure_30'", "HIRHAM5_rcp45_measure_31", "HIRHAM5_rcp85_measure_30", "HIRHAM5_rcp85_measure_31")
#' @param output_type Number the same as in IPRINT (0 - Monthly, 1 - Daily, 2 - Year)
#' @param starting_date Sting with time series starting date (example "1997-01-01")
#' @param ending_date Sting with time series ending date (example "2019-12-31")
#' @param output_files Vector of files endings for output files to extract.
#' @param save_results_to_files Logical value with TRUE or FALSE values. If TRUE  results will be saved to hru.rda,
#' rch.rda, sub.rda files in working directory.
#' @return List with three data.frames: rch, sub and hru for data extracted from different output files.
#' @importFrom sf st_set_geometry
#' @importFrom dplyr bind_cols bind_rows arrange %>%
#' @export
#' @examples
#' ##extract_watersheds_output(path, scenarios, 2, "1997-01-01", "2099-12-31", c("sub"), TRUE)

extract_watersheds_output <- function(watersheds_folder_path, scenarios, output_type, starting_date, ending_date,
                                      output_files = c("sub", "rch", "hru"), save_results_to_files = FALSE){

  #################################################################
  ####              Loop to extract modeling data              ####
  #################################################################
  ##Setting up dataframes
  df_rch <- NULL
  df_sub <- NULL
  df_hru <- NULL
  ##Creating dataframe for looping over setups in modeling results
  setups_to_loop <- basins %>%
    st_set_geometry(NULL) %>%
    select(Subbasin, Setup_name) %>%
    unique() %>%
    arrange(Subbasin, Setup_name)
  ##Main loop to extract and save all modeling data
  for (row in 1:nrow(setups_to_loop)) {
    subbasin_name <- setups_to_loop[row, "Subbasin"]
    setup_name  <- setups_to_loop[row, "Setup_name"]
    print(paste("Started extracting", subbasin_name, setup_name))
    for (scenario in scenarios){
      ##Forming path to modeling result folder
      scenario_path <- paste0(watersheds_folder_path, "/", subbasin_name,
                              "/", setup_name, "/SWAT/", scenario)
      for (f in output_files){
        f_path <- paste0(scenario_path, "/output.", f)

        ##Checking if files exists and they are not empty
        if ((file.exists(f_path) & file.info(f_path)$size > 2000)) {

          ##Extracting and cleaning data from SWAT output.*** files
          f_df <- clean_swat_output(read_swat_output(scenario_path, output_type, f,
                                                    starting_date, ending_date))
          f_df  <- bind_cols(f_df , SUBBASIN = subbasin_name, SETUP = setup_name, SC_FOLDER = scenario)
          ##Saving to a single dataframe each of output files.
          ##Add column for the scenario, which shows basins, setup, climate data and
          ##measure used.
          f_df <- within(f_df,  SCENARIO <- paste(SUBBASIN, SETUP, SC_FOLDER, sep="_"))
          ##Saving results
          if (f == "rch"){
            if (length(df_rch) != 0){
              df_rch <- bind_rows(df_rch, f_df)
            } else {
              df_rch <- f_df
            }
          } else if (f == "sub"){
            if (length(df_sub) != 0){
              df_sub <- bind_rows(df_sub, f_df)
            } else {
              df_sub <- f_df
            }
          } else if (f == "hru"){
            if (length(df_hru) != 0){
              df_hru <- bind_rows(df_hru, f_df)
            } else {
              df_hru <- f_df
            }
          }
        } else {
          message(paste0("OUTPUT files are missing for . ", f, " or files are empty", scenario_path, " !!!"))
        }
      }
    }
    print(paste("Finished extracting", subbasin_name, setup_name, ".",
               round(row/nrow(setups_to_loop)*100, 1), "% already done."))
  }
  ##Saving data to *.rda files
  if (save_results_to_files == TRUE){
    ##Saving results to files
    print("Results are being saved into .rda files.")
    if (length(df_rch) != 0){
      save(df_rch, file = "rch.rda")
    }
    if (length(df_sub) != 0){
      save(df_sub, file = "sub.rda")
    }
    if (length(df_hru) != 0){
      save(df_hru, file = "hru.rda")
    }
    print("Finished saving results into .rda files. files are in working directory.")
  }
  print ("Extracting from Watersheds folder is finished!!!")
  ##Returning list with 3 dataframes.
  return(list(rch = df_rch, sub = df_sub, hru = df_hru))
}