path: root/tests/testthat/test_PELMO.R

library(testthat)
library(pfm)
context("Create PELMO runs from psm files and execute them")
PELMO_base <- system.file("FOCUSPELMO.553", package = "PELMO.installeR")

test_archive <- system.file("testdata/FOCUS_PELMO.tar.bz2", package = "pfm")
test_dir <- tempdir()
untar(test_archive, exdir = test_dir, compressed = "bzip2")

runs <- list(
  list(
    psm = "Pesticide_D",
    fbe = c("Por"),
    vbe = c("Por")),
  list(
    psm = "Pesticide_D_1_day_pre_em_every_third_year",
    pot = c("Cha", "Ham")),
  list(
    psm = "Pesticide_D_1_May_every_other_year_mets",
    win = names(FOCUS_GW_scenarios_2012$names)))

test_that("PELMO paths are correctly created", {
  psm_paths = c(
     PELMO_path(runs[[1]]$psm, "fbe", "Por"),
     PELMO_path(runs[[2]]$psm, "pot", "Ham"),
     PELMO_path(runs[[3]]$psm, "win", "Cha"))

  for (i in seq_along(psm_paths)) {
    psm_file <- file.path(test_dir, psm_paths[i], paste0(runs[[i]]$psm, ".psm"))
    expect_true(file.exists(psm_file))
    psm_new_location <- file.path(PELMO_base, basename(psm_file))
    file.copy(psm_file, psm_new_location, overwrite = TRUE)
  }
})

test_that("PELMO runs are correctly set up", {

  # Prepare runs in analogy to the test archive
  PELMO_runs(runs, psm_dir = PELMO_base, execute = FALSE, evaluate = FALSE, overwrite = TRUE)

  # Check that input files are correctly generated in the right location
  for (run in runs) {
    psm <- run$psm
    crops <- setdiff(names(run), "psm")
    for (crop in crops) {
      for (scenario in run[[crop]]) {
        pp <- PELMO_path(psm, crop, scenario)

        input_new <- readLines(file.path(PELMO_base, "FOCUS", pp, "pelmo.inp"))
        input_test <- readLines(file.path(test_dir, pp, "pelmo.inp"))

        # Check if the input files are correctly reproduced
        expect_identical(input_new, input_test)
      }
    }
  }
})

test_that("PELMO runs can be run and give the expected result files", {
  run_PELMO(runs, cores = 7)

  plm_files <- c("CHEM.PLM", "ECHO.PLM",
                 "KONZCHEM.PLM", "KONZC_A1", "KONZC_B1",
                 "PLNTPEST.plm", "PLOT.PLM", "WASSER.PLM")

  # Check that if output is the same as in the test archive
  for (run in runs) {
    psm <- run$psm
    crops <- setdiff(names(run), "psm")
    for (crop in crops) {
      for (scenario in run[[crop]]) {
        pp <- PELMO_path(psm, crop, scenario)

        for (plm in plm_files) {
          if (file.exists(file.path(test_dir, pp, plm))) {
            new <- readLines(file.path(PELMO_base, "FOCUS", pp, plm))
            test <- readLines(file.path(test_dir, pp, plm))

            # Check if the ouput files are correctly reproduced
            expect_identical(new, test)
          }
        }
      }
    }
  }
})

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) {
    psm <- run$psm
    crops <- setdiff(names(run), "psm")
    for (crop in crops) {
      for (scenario in run[[crop]]) {
        pp <- PELMO_path(psm, crop, scenario)

        period_file <- readLines(file.path(test_dir, pp, "period.plm"), encoding = "latin1")

        result_lines <- grep("^\tResults for.*in the percolate at 1 m soil depth$", period_file)
        acronyms <- gsub(".*\\((.*)\\).*", "\\1", period_file[result_lines])
        names(result_lines) <- acronyms

        results <- list()
        for (acronym in acronyms) {
          results[[acronym]] <- list()
          conc_lines <- result_lines[acronym] + 5:24
          tmp <- read.table(text = period_file[conc_lines], sep = "\t")
          results[[acronym]]$periods <- data.frame(
            period = as.integer(tmp$V2),
            flux = tmp$V3,
            percolate = tmp$V4,
            conc = tmp$V5)
          tmp80 <- read.table(text = period_file[result_lines[acronym] + 27], sep = "\t")
          results[[acronym]]$focus <- tmp80[[1, "V5"]]
        }

        period_pfm_file <- file.path(PELMO_base, "FOCUS", pp, "period_pfm.rda")
        load(period_pfm_file)

        # Test for equality of all the components separately,
        # as we need to adapt the tolerance
        for (acronym in acronyms) {
          p_pelmo <- results[[acronym]]$periods
          p_test <- results_pfm[[acronym]]$periods
          expect_equal(p_test$flux, p_pelmo$flux, tol = 1e-6, scale = 1)
          expect_equal(p_test$percolate, p_pelmo$percolate)
          # PELMO sets the concentration to 0 when the percolate is zero.
          # We get NaN, which is more reasonable, but we need to
          # take this into account for testing
          p_test$conc <- ifelse(is.na(p_test$conc), 0, p_test$conc)
          expect_equal(p_test$conc, p_pelmo$conc, tol = 1e-3, scale = 1)

          # FOCUS PEC
          expect_equal(results_pfm[[acronym]]$focus, results[[acronym]]$focus,
                       tol = 1e-3, scale = 1)
        }
      }
    }
  }
})