Test reproducing the FOCUS Summary information

generated from the FOCUS PELMO GUI, as copied into the text files
in the testdata directory.

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)
+})