diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | R/PELMO_runs.R | 82 | ||||
| -rw-r--r-- | man/PELMO_path.Rd | 2 | ||||
| -rw-r--r-- | man/PELMO_runs.Rd | 9 | ||||
| -rw-r--r-- | tests/testthat/test_PELMO.R | 36 |
5 files changed, 115 insertions, 28 deletions
@@ -1,3 +1,17 @@ +commit 80b451ddb4e749041c2b216603274a012dc83d59 +Author: Johannes Ranke <jranke@uni-bremen.de> +Date: 2017-01-30 14:28:23 +0100 + + PELMO summary files for testing + +commit 826cf9a2687ff1d7ca5b568882f5686f76f82074 +Author: Johannes Ranke <jranke@uni-bremen.de> +Date: 2017-01-30 14:11:34 +0100 + + Use relative tolerance of 1e-6 for flux test + + to pass test also for more extreme situations as in the current test data. + commit eea72720956dc8358fac98b29c9a627a9363cbd2 Author: Johannes Ranke <jranke@uni-bremen.de> Date: 2017-01-30 13:12:24 +0100 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 diff --git a/man/PELMO_path.Rd b/man/PELMO_path.Rd index e8ca50e..49292c2 100644 --- a/man/PELMO_path.Rd +++ b/man/PELMO_path.Rd @@ -4,7 +4,7 @@ \alias{PELMO_path} \title{Create a path of run directories as the PELMO GUI does} \usage{ -PELMO_path(psm, crop, scenario) +PELMO_path(psm, crop, scenario = NA) } \arguments{ \item{psm}{The psm identifier} diff --git a/man/PELMO_runs.Rd b/man/PELMO_runs.Rd index 9967b0d..60519bd 100644 --- a/man/PELMO_runs.Rd +++ b/man/PELMO_runs.Rd @@ -36,6 +36,10 @@ as used in \code{\link{FOCUS_GW_scenarios_2012}}.} \item{overwrite}{Should an existing run directories be overwritten} } +\value{ +If evaluate is TRUE, a list of lists of data frames holding the + PEC data. +} \description{ Per default, the runs are not only set up but also executed with FOCUS PELMO, the results are processed and returned. Currently, only FOCUS PELMO @@ -45,6 +49,11 @@ maintained on github is supported. In such installations, FOCUS PELMO is installed into the package installation directory of \code{PELMO.installeR} and run using \code{wine}. } +\details{ +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. +} \references{ PELMO.installeR \url{https://jranke.github.io/PELMO.installeR} diff --git a/tests/testthat/test_PELMO.R b/tests/testthat/test_PELMO.R index a08f607..9bebc95 100644 --- a/tests/testthat/test_PELMO.R +++ b/tests/testthat/test_PELMO.R @@ -85,8 +85,9 @@ test_that("PELMO runs can be run and give the expected result files", { } }) +pfm_PECgw <- evaluate_PELMO(runs) + test_that("PELMO runs are correctly evaluated", { - results <- evaluate_PELMO(runs) # Check that if output is the same as in the test archive for (run in runs) { @@ -142,3 +143,36 @@ test_that("PELMO runs are correctly evaluated", { } } }) + +test_that("PECgw from FOCUS summary files can be reproduced", { + focus_summary <- list() + + for (run in runs) { + psm <- run$psm + focus_summary[[psm]] <- list() + + crops <- setdiff(names(run), "psm") + for (crop in crops) { + scenarios <- run[[crop]] + + # Read contents of summary text file copied from the GUI output. We only + # have results for one crop per psm file, so the crop is not in the file + # name. + sumfile_path <- system.file(paste0("testdata/FOCUS_Summary_", psm, + ".txt"), package = "pfm") + sumfile <- readLines(sumfile_path, encoding = "latin1") + result_anchors <- grep("Results for", sumfile) + acronyms <- gsub(".*\\((.*)\\).*", "\\1", sumfile[result_anchors]) + names(result_anchors) <- acronyms + focus_summary[[psm]][[crop]] <- matrix(nrow = length(scenarios), ncol = length(acronyms), + dimnames = list(scenarios, acronyms)) + for (acronym in acronyms) { + tmp <- sumfile[result_anchors[acronym] + 4 + (1:length(scenarios))] + tmp_frame <- read.table(text = tmp, sep = "\t") + PECgw <- tmp_frame$V5 + focus_summary[[psm]][[crop]][, acronym] <- PECgw + } + } + } + expect_equal(pfm_PECgw, focus_summary) +}) |