R/convert_ler_to_lerwq.R

In aemon-j/LakeEnsemblR_WQ: Run Ensembles of Water Quality 1D Lake Models

#'Convert LakeEnsemblR configuration to LakeEnsemblR.WQ
#'
#'Copies folder contents generated by LakeEnsemblR::export_config
#' and activates running the models with water quality
#'
#'@param ler_config_file character; name of LakeEnsemblR config file
#'@param lerwq_config_file character; name of LakeEnsemblR_WQ config file
#'@param folder path; location of both configuration files
#'@param copy_folder logical; if true, copies folders from LakeEnsemblR run
#'@param rename_folders logical; if true, will rename LakeEnsemblR folders
#' when able
#'@param activate_wq logical; if true, changes parameters to run with WQ
#'@param verbose logical; if true, prints messages
#'
#'@examples
#'
#'@importFrom configr read.config
#'@importFrom LakeEnsemblR input_yaml_multiple input_json
#'@importFrom glmtools read_nml set_nml write_nml
#'
#'@export

convert_ler_to_lerwq <- function(ler_config_file = "LakeEnsemblR.yaml",
                                 lerwq_config_file = "LakeEnsemblR_WQ.yaml",
                                 folder = ".",
                                 copy_folder = TRUE,
                                 rename_folders = FALSE,
                                 activate_wq = TRUE,
                                 verbose = FALSE){
  # Read config files as lists
  lst_config_ler <- read.config(file.path(folder, ler_config_file)) 
  lst_config_wq <- read.config(file.path(folder, lerwq_config_file)) 
  
  models_coupled <- lst_config_wq[["models"]]
  phys_models <- strsplit(models_coupled, "-")
  phys_models <- sapply(phys_models, function (x) x[1L])
  table_phys_models <- table(phys_models)
  ler_models <- lst_config_ler[["config_files"]]
  
  if(activate_wq){
    settings_section <- lst_config_wq[["run_settings"]]
  }
  
  for(i in seq_len(length(models_coupled))){
    phys_model <- phys_models[i]
    
    if(!(phys_model %in% names(ler_models))){
      if(verbose){
        message("Skipped copying LakeEnsemblR folder for ", models_coupled[i],
                ": ", phys_model, " not found in ", file.path(folder,
                                                              ler_config_file))
      }
      next
    }
    
    ler_folder <- dirname(lst_config_ler[["config_files"]][[phys_model]])
    lerwq_folder <- dirname(lst_config_wq[["config_files"]][[models_coupled[i]]])
    
    ### Part 1: Copy folder contents
    if(copy_folder){
      if(!dir.exists(file.path(folder, ler_folder))){
        stop("LakeEnsemblR folder ", file.path(folder, ler_folder),
             " not found; when using LakeEnsemblR.WQ::export_config with ",
             "convert_from_lakeensemblr = TRUE, ensure that ",
             "LakeEnsemblR::export_config has been run beforehand!")
      }
      
      # E.g. for MyLake
      if(ler_folder == lerwq_folder) next
      
      if(!dir.exists(file.path(folder, lerwq_folder))){
        dir.create(file.path(folder, lerwq_folder))
      }
      
      if(rename_folders){
        # If true, this becomes a bit complicated; need to check if the only
        # or not. If yes, rename, if no, copy if not the last
        if(table_phys_models[phys_model] == 1L){
          system(paste("rename", ler_folder, lerwq_folder))
        }else{
          this_model_ind <- which(phys_models == phys_model)
          if(i != this_model_ind[length(this_model_ind)]){
            file.copy(list.files(file.path(folder, ler_folder),
                                 full.names = TRUE), 
                      file.path(folder, lerwq_folder), 
                      recursive = TRUE)
          }else{
            system(paste("rename", ler_folder, lerwq_folder))
          }
        }
      }else{
        file.copy(list.files(file.path(folder, ler_folder), full.names = TRUE), 
                  file.path(folder, lerwq_folder), 
                  recursive = TRUE)
      }
    }
    
    ### Part 2: activating the water quality run
    if(activate_wq){
      # Not needed for PCLake and MyLake; these models always run with
      # water quality
      if(phys_model == "GOTM"){
        filename <- basename(lst_config_ler[["config_files"]][["GOTM"]])
        
        input_yaml_multiple(file.path(folder, lerwq_folder, filename),
                            "true",
                            key1 = "fabm", key2 = "use", verbose = verbose)
        
        # See helpers.R
        add_fabm_settings_gotm(folder = folder,
                               gotmyaml = file.path(lerwq_folder,
                                                        filename),
                               verbose = verbose,
                               settings_section = settings_section)
      }else if(phys_model == "Simstrat"){
        filename <- basename(lst_config_ler[["config_files"]][["Simstrat"]])
        
        # Set CoupleAED2 to true, 
        input_json(file.path(folder, lerwq_folder, filename),
                   value = "true", label = "ModelConfig", key = "CoupleAED2")
        
        # Then: add a AED2Config section to the simstrat config file
        # See helpers.R
        add_aed2_section_simstrat(folder = folder,
                                  simstrat_par = file.path(lerwq_folder,
                                                           filename),
                                  verbose = verbose,
                                  settings_section = settings_section)
      }else if(phys_model == "GLM"){
        filename <- basename(lst_config_ler[["config_files"]][["GLM"]])
        
        nml <- read_nml(file.path(folder, lerwq_folder, filename))
        
        shading <- settings_section[["bio-shading"]]
        repair <- settings_section[["repair_state"]]
        split <- settings_section[["split_factor"]]
        
        ode_method <- settings_section[["ode_method"]]
        valid_ode <- c("Euler", "RK2", "RK4", "Pat1", "PatRK2", "PatRK4", "ModPat1",
                       "ModPatRK2", "ModPatRK4", "ExtModPat1", "ExtModPatRK2")
        if(!(ode_method %in% valid_ode)){
          stop(ode_method, " is not a valid entry for GLM!")
        }else{
          ode_num <- which(valid_ode == ode_method)
        }
        
        # If not yet present, add wq_setup section to the glm nml file
        if(!("wq_setup" %in% names(nml))){
          nml[["wq_setup"]] <- list(wq_lib = "aed2",
                                    wq_nml_file = "aed2.nml")
        }
        nml[["wq_setup"]][["ode_method"]] <- ode_num
        nml[["wq_setup"]][["split_factor"]] <- split
        nml[["wq_setup"]][["repair_state"]] <- repair
        nml[["wq_setup"]][["bioshade_feedback"]] <- shading
        
        write_nml(nml, file.path(folder, lerwq_folder, filename))
      }
    }
    
  }
}