R/prep_model.R

In philliplab/modgenTester: Test and reporting for modgen models with R

#' Copy the model from the model folder to the target folder
#' @param scenario_folder The path to the folder containing the scenario
#' @param scenario_file The name of the scenario file
#' @param model_exe_folder The path to the folder containing the model's executable file
#' @export

copy_model <- function(source_folder, model_name, target_folder){
  source_path <- file.path(source_folder, model_name)
  target_path <- file.path(target_folder, model_name)
  file.copy(source_path, target_path, overwrite = TRUE)
}

#' Copy the 'base' scenario that will be used to construct the other scenarios.
#' 
#' This function also copies the dat file and makes the scenario point to 
#' the appropriate dat file
#' 
#' @param scenario_folder The path to the folder containing the scenario
#' @param scenario_file The name of the scenario file
#' @param model_exe_folder The path to the folder containing the model's executable file
#' @export

copy_scenario <- function(source_folder, scenario_name, scenario_dat_name, target_folder){
  source_path <- file.path(source_folder, scenario_name)
  target_path <- file.path(target_folder, scenario_name)
  sfmod <- gsub('/', '\\\\\\\\', source_folder)
  tfmod <- gsub('/', '\\\\\\\\', target_folder)
  scenario <- readLines(source_path)
  scenario_mod <- gsub(sfmod, tfmod, scenario)
  cat(scenario_mod, file=target_path, sep = '\n')
  
  source_path <- file.path(source_folder, scenario_dat_name)
  target_path <- file.path(target_folder, scenario_dat_name)
  file.copy(source_path, target_path, overwrite = TRUE)
}

#' Generates a new scenario by modifying a given base scenario
#' 
#' Copies the scex file, giving it a new name.
#' 
#' Makes the scex file point to a new .dat file
#' 
#' Performs substitutions on the scex file
#' 
#' Performs substitutions on the .dat file
#' 
#' @param test_folder The folder in which the tests are run
#' @param base_scenario The name of the base scenario
#' @param base_scenario_dat The name of the base scenario's dat file
#' @param scenario_name_sub The substritution list for the name of the scenario. 
#' A list with to elements, to and from.
#' @param scex_sub The substritutions to perform on the scex file
#' @param dat_sub The substritutions to perform on the dat file
#' @param notes The note of the scenario
#' @param label The label of the scenario
#' @export

generate_scenario <- function(test_folder, base_scenario, base_scenario_dat,
                              scenario_name_sub, scex_sub = NULL, dat_sub = NULL,
                              notes = NULL, label = NULL){
  new_scenario <- gsub(scenario_name_sub$from, scenario_name_sub$to, base_scenario)
  new_scenario_dat <- gsub(scenario_name_sub$from, scenario_name_sub$to, base_scenario_dat)
  
  source_path <- file.path(test_folder, base_scenario)
  target_path <- file.path(test_folder, new_scenario)
  
  scenario_mod <- readLines(source_path)
  scenario_mod <- gsub(scenario_name_sub$from, scenario_name_sub$to, scenario_mod)
  for (sub in scex_sub){
    scenario_mod <- gsub(sub$from, sub$to, scenario_mod)
  }
  if (!is.null(label)){
    scenario_mod_end <- scenario_mod[length(scenario_mod)]
    scenario_mod <- scenario_mod[1:(length(scenario_mod)-1)]
    label_lines <- c("\t<Labels>",
                    paste0("\t\t<Label Language='EN'>", label, "</Label>"),
                    "\t</Labels>")
    scenario_mod <- c(scenario_mod,
                      label_lines,
                      scenario_mod_end)
  }
  if (!is.null(notes)){
    scenario_mod_end <- scenario_mod[length(scenario_mod)]
    scenario_mod <- scenario_mod[1:(length(scenario_mod)-1)]
    notes_dat <- ""
    for (sub in dat_sub){
      notes_dat <- paste0(notes_dat, "Substitude: '",
                          gsub(";", "", sub$from), "' with '", gsub(";", "", sub$to), "';")
    }
    
    note_lines <- c("\t<Notes>",
                    paste0("\t\t<Note Language='EN'>", notes, "; ", notes_dat, "</Note>"),
                    "\t</Notes>")
    scenario_mod <- c(scenario_mod,
                      note_lines,
                      scenario_mod_end)
  }
  cat(scenario_mod, file=target_path, sep = '\n')
  
  source_path <- file.path(test_folder, base_scenario_dat)
  target_path <- file.path(test_folder, new_scenario_dat)
  
  scenario_dat_mod <- readLines(source_path)
  scenario_dat_mod <- gsub(scenario_name_sub$from, scenario_name_sub$to, scenario_dat_mod)
  for (sub in dat_sub){
    scenario_dat_mod <- gsub(sub$from, sub$to, scenario_dat_mod)
  }
  cat(scenario_dat_mod, file=target_path, sep = '\n')
}

#' Lists all available scenarios
#' @param scenario_dir The directory containing the scenarios
#' @param full_path Display full path to the scenario file if set to TRUE.
#' @export

list_all_scenarios <- function(scenario_dir, full_path = TRUE){
  scex_scenarios <- list.files(scenario_dir, pattern = '.scex')
  full_scenarios <- NULL
  indx <- 1
  for (scex_file in scex_scenarios){
    dat_file <- list.files(scenario_dir, pattern = gsub(".scex", ".*.dat", scex_file))
    full_scenarios[[as.character(indx)]] <- list(scex = scex_file,
                                                  dat = dat_file)
    indx <- indx + 1
  }
  
  return(full_scenarios)
}