aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2017-01-30 16:10:30 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2017-01-30 16:10:30 +0100
commite6bb9654679f43af6958d6e28cb5206abb91d574 (patch)
tree1d2532c3a00b1c81838b555c1ee567cbb4547ac8
parentf6e76c9a71fc99594a0fc7e0b21b77b396117b99 (diff)
Test reproducing the FOCUS Summary information
generated from the FOCUS PELMO GUI, as copied into the text files in the testdata directory.
-rw-r--r--ChangeLog14
-rw-r--r--R/PELMO_runs.R82
-rw-r--r--man/PELMO_path.Rd2
-rw-r--r--man/PELMO_runs.Rd9
-rw-r--r--tests/testthat/test_PELMO.R36
5 files changed, 115 insertions, 28 deletions
diff --git a/ChangeLog b/ChangeLog
index e769feb..6923efa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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)
+})

Contact - Imprint