diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/PELMO_runs.R | 82 |
1 files changed, 56 insertions, 26 deletions
diff --git a/R/PELMO_runs.R b/R/PELMO_runs.R index f708fa0..3d4f03b 100644 --- a/R/PELMO_runs.R +++ b/R/PELMO_runs.R @@ -8,6 +8,12 @@ #' installed into the package installation directory of \code{PELMO.installeR} #' and run using \code{wine}. #' +#' As a side effect, an R data file (period_pfm.rda) is generated in each +#' run directory, holding the results for all FOCUS periods, equivalent to +#' the period.plm file generated by the FOCUS PELMO GUI. +#' +#' @return If evaluate is TRUE, a list of lists of data frames holding the +#' PEC data. #' @param runs A list of lists. Each inner lists has an element named 'psm' #' that holds the psm string, and elements named using three letter crop acronyms, #' as used in \code{\link{FOCUS_PELMO_crops}}, @@ -21,7 +27,7 @@ #' @param evaluate Should the results be returned? #' @param overwrite Should an existing run directories be overwritten #' @references PELMO.installeR \url{https://jranke.github.io/PELMO.installeR} -#' +#' #' Wine \url{https://winehq.org} #' @export PELMO_runs <- function(runs, psm_dir = ".", version = "5.5.3", PELMO_base = "auto", @@ -146,7 +152,10 @@ PELMO_runs <- function(runs, psm_dir = ".", version = "5.5.3", PELMO_base = "aut } if (evaluate) { - evaluate_PELMO(runs, version = version, PELMO_base = PELMO_base) + pfm_PECgw <- evaluate_PELMO(runs, version = version, PELMO_base = PELMO_base) + return(pfm_PECgw) + } else { + invisible(NULL) } } @@ -223,7 +232,7 @@ run_PELMO <- function(runs, version = "5.5.3", PELMO_base = "auto", #' @param psm The psm identifier #' @param crop The PELMO crop acronym #' @param scenario The scenario -PELMO_path <- function(psm, crop, scenario) { +PELMO_path <- function(psm, crop, scenario = NA) { if (crop %in% names(FOCUS_PELMO_crops)) { crop <- FOCUS_PELMO_crops[crop] } @@ -237,24 +246,28 @@ PELMO_path <- function(psm, crop, scenario) { # scenario irrigation_string <- "" - # 'Irrigation' is only possible in the GUI for five scenarios - if (scenario %in% c("Cha", "Pia", "Por", "Sev", "Thi")) { - crop_acronyms <- names(FOCUS_PELMO_crops) - names(crop_acronyms) <- FOCUS_PELMO_crops - crop_acronym <- crop_acronyms[[crop]] - # Some crops are not 'irrigated' according to the GUI - if (crop_acronym %in% c("win", "fbe", "woi", "ape", "spr")) { - irrigation_string <- "--_-_no_-_irrigation" - } else { - irrigation_string <- "--_-_irrigated" + if (is.na(scenario)) { + return(file.path(psm_dir, crop_dir)) + } else { + # 'Irrigation' is only possible in the GUI for five scenarios + if (scenario %in% c("Cha", "Pia", "Por", "Sev", "Thi")) { + crop_acronyms <- names(FOCUS_PELMO_crops) + names(crop_acronyms) <- FOCUS_PELMO_crops + crop_acronym <- crop_acronyms[[crop]] + # Some crops are not 'irrigated' according to the GUI + if (crop_acronym %in% c("win", "fbe", "woi", "ape", "spr")) { + irrigation_string <- "--_-_no_-_irrigation" + } else { + irrigation_string <- "--_-_irrigated" + } } - } - scenario_dir <- paste0( - FOCUS_GW_scenarios_2012$names[scenario], "_-_(", FOCUS_PELMO_location_codes[scenario], ")", - irrigation_string, ".run") + scenario_dir <- paste0( + FOCUS_GW_scenarios_2012$names[scenario], "_-_(", FOCUS_PELMO_location_codes[scenario], ")", + irrigation_string, ".run") - return(file.path(psm_dir, crop_dir, scenario_dir)) + return(file.path(psm_dir, crop_dir, scenario_dir)) + } } #' Create a list of runs that we can traverse @@ -304,18 +317,30 @@ evaluate_PELMO <- function(runs, version = "5.5.3", PELMO_base = "auto") paste0("FOCUSPELMO.", gsub("\\.", "", version))) } + pfm_PECgw <- list() for (run in runs) { psm <- run$psm + pfm_PECgw[[psm]] <- list() crops <- setdiff(names(run), "psm") + + # Get acronyms of simulated compounds + example_run_dir <- file.path(PELMO_base, "FOCUS", PELMO_path(psm, crops[1], run[[crops[1]]][1])) + example_echo_file <- readLines(file.path(example_run_dir, "ECHO.PLM"), encoding = "latin1") + parm_lines <- grep("\\*\\*\\* PARAMETERS OF", example_echo_file, value = TRUE) + acronyms <- gsub(".*\\((.*)\\).*", "\\1", parm_lines) + met_codes <- gsub(".*METABOLITE (..).*", "\\1", parm_lines) + met_codes[1] <- NA + names(met_codes) <- acronyms + + # Loop over runs to get results for (crop in crops) { - for (scenario in run[[crop]]) { + scenarios <- run[[crop]] + + pfm_PECgw[[psm]][[crop]] <- matrix(nrow = length(scenarios), ncol = length(acronyms), + dimnames = list(scenarios, acronyms)) + + for (scenario in scenarios) { run_dir <- file.path(PELMO_base, "FOCUS", PELMO_path(psm, crop, scenario)) - echo_file <- readLines(file.path(run_dir, "ECHO.PLM"), encoding = "latin1") - parm_lines <- grep("\\*\\*\\* PARAMETERS OF", echo_file, value = TRUE) - acronyms <- gsub(".*\\((.*)\\).*", "\\1", parm_lines) - met_codes <- gsub(".*METABOLITE (..).*", "\\1", parm_lines) - met_codes[1] <- NA - names(met_codes) <- acronyms psm_file <- file.path(run_dir, paste0(psm, ".psm")) location_code <- FOCUS_PELMO_location_codes[scenario] @@ -349,12 +374,17 @@ evaluate_PELMO <- function(runs, version = "5.5.3", PELMO_base = "auto") periods$conc <- 100 * periods$flux / periods$percolate results_pfm[[acronym]]$periods <- periods - results_pfm[[acronym]]$focus <- focus_80th(periods$conc) + PECgw <- focus_80th(periods$conc) + + results_pfm[[acronym]]$focus <- PECgw + + pfm_PECgw[[psm]][[crop]][scenario, acronym] <- round(PECgw, 3) } save(results_pfm, file = file.path(run_dir, "period_pfm.rda")) } } } + return(pfm_PECgw) } #' Get the application interval in years from a psm file |