tests/testthat/test_aggregationMethods.R

In BoulderCodeHub/RWDataPlyr: Read and Manipulate Data from 'RiverWare'

library(RWDataPlyr)
library(dplyr)
library(tidyr)

context('check RWDataPlyr:::processSlots aggregation computations')

# -----------------------------------
# hand compute values
# keyRdf exists as data in package
mReg <- rdf_get_slot(keyRdf, "Mead.Pool Elevation")
pReg <- rdf_get_slot(keyRdf, "Powell.Outflow")
lbShort <- as.data.frame(rdf_get_slot(
  sysRdf, 
  "SummaryOutputData.LBShortageConditions"
))
cNames <- seq_len(ncol(mReg))
colnames(mReg) <- cNames
colnames(pReg) <- cNames
colnames(lbShort) <- cNames

mEocy <- as.data.frame(mReg[seq(12,nrow(mReg), 12),])
pMin <- as.data.frame(rwslot_annual_min(pReg))
pEowy <- as.data.frame(pReg[seq(9,nrow(pReg),12),])
mBocy <- as.data.frame(mReg[seq(1, nrow(mReg), 12),])
mMax <- as.data.frame(rwslot_annual_max(mReg))
mSum <- as.data.frame(rwslot_annual_sum(mReg))
p800 <- as.data.frame((rwslot_annual_min(pReg) <= 800000) * 1)

pPad <- rbind(pReg[1,], pReg[1,], pReg[1,], pReg)[seq_len(nrow(pReg)),]
attr(pPad, "timespan") <- c("October 2000", "September 2004")
p750 <- as.data.frame((rwslot_annual_min(pPad) <= 750000) * 1)

p500 <- as.data.frame((rwslot_annual_max(pPad) <= 500000) * 1)

m1050 <- as.data.frame((mReg[seq(12,nrow(mReg),12),] <= 1050) * 1)

m1100 <- as.data.frame((mReg[seq(12,nrow(mReg),12),] >= 1100) * 1)


filterVarToMatrix <- function(zz, var, scen = "ISM1988_2014,2007Dems,IG,Most") {
  zz %>% 
    filter(Variable == var, Scenario == scen) %>%
    select(-Scenario, -Variable) %>%
    arrange(Year) %>%
    spread(Trace, Value) %>%
    select(-Year)
}

# ---------------------------------------
# create a sal that tests every one of the agg methods
sal <- slot_agg_list(matrix(c(
  "KeySlots.rdf", "Powell.Outflow", "AnnMin", NA, "powellMin",
  "KeySlots.rdf", "Powell.Outflow", "EOWY", NA, "powellEowy",
  "KeySlots.rdf", "Mead.Pool Elevation", "EOCY", NA, "meadPe",
  "KeySlots.rdf", "Mead.Pool Elevation", "BOCY", NA, "meadBocy",
  "KeySlots.rdf", "Mead.Pool Elevation", "AnnMax", NA, "meadMax",
  "KeySlots.rdf", "Mead.Pool Elevation", "AnnualSum", NA, "meadSum",
  "KeySlots.rdf", "Powell.Outflow", "AnnMinLTE", 800000, "powellLt800",
  "KeySlots.rdf", "Powell.Outflow", "WYMinLTE", 750000, "powellLt750",
  "KeySlots.rdf", "Powell.Outflow", "WYMaxLTE", 500000, "powellLt500",
  "KeySlots.rdf", "Mead.Pool Elevation", "EOCYLTE", 1050, "meadLt1050",
  "KeySlots.rdf", "Mead.Pool Elevation", "EOCYGTE", 1100, "meadGt1100",
  "KeySlots.rdf", "Mead.Pool Elevation", "AnnualRaw", NA, "meadPe2",
  "SystemConditions.rdf", "SummaryOutputData.LBShortageConditions", "AnnualRaw",
    NA, "lbShort"), 
  ncol = 5, byrow = TRUE
))

# for now have to process monthly seperately
salMonthly <- slot_agg_list(matrix(c(
  "KeySlots.rdf", "Powell.Outflow", "Monthly", 10, "powellMothly10",
  "KeySlots.rdf", "Mead.Pool Elevation", "Monthly", .001, "meadMonthly001"),
  ncol = 5, byrow = TRUE
))

zzMonthly <- expect_warning(
    getDataForAllScens(
    scenFolders = "ISM1988_2014,2007Dems,IG,Most", 
    scenNames = "ISM1988_2014,2007Dems,IG,Most", 
    slotAggList = salMonthly,
    scenPath = system.file('extdata','Scenario/',package = 'RWDataPlyr'),
    retFile = TRUE
  ) %>%
    mutate(monthNum = match(Month, month.name))
)
# compare the results computed by getDataForAllScen -> processSlots
# to those computed by hand using rdf_get_slot
test_that("processSlots monthly to annual aggregation methods work", {
  expect_warning(
    zz <- getDataForAllScens(
      scenFolders = "ISM1988_2014,2007Dems,IG,Most", 
      scenNames = "ISM1988_2014,2007Dems,IG,Most", 
      slotAggList = sal, 
      scenPath = system.file('extdata','Scenario/',package = 'RWDataPlyr'),
      retFile = TRUE
    )
  )
  expect_equal(filterVarToMatrix(zz, "powellMin"), pMin)
  expect_equal(filterVarToMatrix(zz, "powellEowy"), pEowy)
  expect_equal(filterVarToMatrix(zz, "meadPe"), mEocy)
  expect_equal(filterVarToMatrix(zz, "meadBocy"), mBocy)
  expect_equal(filterVarToMatrix(zz, "meadMax"), mMax)
  expect_equal(filterVarToMatrix(zz, "meadSum"), mSum)
  expect_equal(filterVarToMatrix(zz, "powellLt800"), p800)
  expect_equal(filterVarToMatrix(zz, "powellLt750"), p750)
  expect_equal(filterVarToMatrix(zz, "powellLt500"), p500)
  expect_equal(filterVarToMatrix(zz, "meadLt1050"), m1050)
  expect_equal(filterVarToMatrix(zz, "meadGt1100"), m1100)
  expect_equal(filterVarToMatrix(zz, "powellMin"), pMin)
  expect_equal(filterVarToMatrix(zz, "meadPe2"), mEocy)
  expect_equal(
    filterVarToMatrix(zz, "meadPe2"), 
    filterVarToMatrix(zz, "meadPe")
  )
  expect_equal(filterVarToMatrix(zz, "lbShort"), lbShort)
  expect_equal({
    zzMonthly %>% 
      filter(
        Variable == "powellMothly10", 
        Scenario == "ISM1988_2014,2007Dems,IG,Most"
      ) %>%
      select(-Scenario, -Variable, -Month) %>%
      arrange(Year,monthNum) %>%
      spread(Trace, Value) %>%
      select(-Year, -monthNum)
  }, as.data.frame(pReg * 10))
  
  expect_equal({
    zzMonthly %>% 
      filter(
        Variable == "meadMonthly001", 
        Scenario == "ISM1988_2014,2007Dems,IG,Most"
      ) %>%
      select(-Scenario, -Variable, -Month) %>%
      arrange(Year,monthNum) %>%
      spread(Trace, Value) %>%
      select(-Year, -monthNum)
  }, as.data.frame(mReg * 0.001))
})


# -----------------------------------
# and check all of them for a single trace

# hand compute values
# keyRdf exists as data in package
key <- read.rdf(system.file(
  "extdata/Scenario/T13,CT,IG", 
  "KeySlots.rdf", 
  package = "RWDataPlyr"
))
mReg <- rdf_get_slot(key, "Mead.Pool Elevation")
pReg <- rdf_get_slot(key, "Powell.Outflow")
sys <- read.rdf(system.file(
  "extdata/Scenario/T13,CT,IG", 
  "SystemConditions.rdf", package = "RWDataPlyr"
))
lbShort <- as.data.frame(rdf_get_slot(
  sys, 
  "SummaryOutputData.LBShortageConditions"
))
cNames <- seq_len(ncol(mReg))
colnames(mReg) <- cNames
colnames(pReg) <- cNames
colnames(lbShort) <- cNames

mEocy <- as.data.frame(mReg[seq(12,nrow(mReg), 12),, drop = FALSE])
pMin <- as.data.frame(rwslot_annual_min(pReg))
pEowy <- as.data.frame(pReg[seq(9,nrow(pReg),12),, drop = FALSE])
mBocy <- as.data.frame(mReg[seq(1, nrow(mReg), 12),, drop = FALSE])
mMax <- as.data.frame(rwslot_annual_max(mReg))
mSum <- as.data.frame(rwslot_annual_sum(mReg))
p800 <- as.data.frame((rwslot_annual_min(pReg) <= 800000) * 1)

pPad <- rbind(
  pReg[1,], 
  pReg[1,], 
  pReg[1,], pReg
)[seq_len(nrow(pReg)),, drop = FALSE]
attr(pPad, "timespan") <- c("October 2000", "September 2004")
p750 <- as.data.frame((rwslot_annual_min(pPad) <= 750000) * 1)

p500 <- as.data.frame((rwslot_annual_max(pPad) <= 500000) * 1)

m1050 <- as.data.frame((mReg[seq(12,nrow(mReg),12),, drop = FALSE] <= 1050) * 1)

m1100 <- as.data.frame((mReg[seq(12,nrow(mReg),12),, drop = FALSE] >= 1100) * 1)

stScen <- "T13,CT,IG"

zzMonthly <- expect_warning(
  getDataForAllScens(
    scenFolders = stScen, 
    scenNames = stScen, 
    slotAggList = salMonthly,
    scenPath = system.file('extdata','Scenario/',package = 'RWDataPlyr')
  ) %>%
    mutate(monthNum = match(Month, month.name))
)

test_that("processSlots mon to ann agg methods work for rdf with 1 trace", {
  expect_warning(
    zz <- getDataForAllScens(
      scenFolders = stScen, 
      scenNames = stScen, 
      slotAggList = sal, 
      scenPath = system.file('extdata','Scenario/',package = 'RWDataPlyr'),
      retFile = TRUE
    )
  )

  expect_equal(filterVarToMatrix(zz, "powellMin", stScen), pMin)
  expect_equal(filterVarToMatrix(zz, "powellEowy", stScen), pEowy)
  expect_equal(filterVarToMatrix(zz, "meadPe", stScen), mEocy)
  expect_equal(filterVarToMatrix(zz, "meadBocy", stScen), mBocy)
  expect_equal(filterVarToMatrix(zz, "meadMax", stScen), mMax)
  expect_equal(filterVarToMatrix(zz, "meadSum", stScen), mSum)
  expect_equal(filterVarToMatrix(zz, "powellLt800", stScen), p800)
  expect_equal(filterVarToMatrix(zz, "powellLt750", stScen), p750)
  expect_equal(filterVarToMatrix(zz, "powellLt500", stScen), p500)
  expect_equal(filterVarToMatrix(zz, "meadLt1050", stScen), m1050)
  expect_equal(filterVarToMatrix(zz, "meadGt1100", stScen), m1100)
  expect_equal(filterVarToMatrix(zz, "powellMin", stScen), pMin)
  expect_equal(filterVarToMatrix(zz, "meadPe2", stScen), mEocy)
  expect_equal(
    filterVarToMatrix(zz, "meadPe2", stScen), 
    filterVarToMatrix(zz, "meadPe", stScen)
  )
  expect_equal(filterVarToMatrix(zz, "lbShort", stScen), lbShort)
  expect_equal({
    zzMonthly %>% 
      filter(Variable == "powellMothly10", Scenario == stScen) %>%
      select(-Scenario, -Variable, -Month) %>%
      arrange(Year,monthNum) %>%
      spread(Trace, Value) %>%
      select(-Year, -monthNum)
  }, as.data.frame(pReg * 10))
  
  expect_equal({
    zzMonthly %>% 
      filter(Variable == "meadMonthly001", Scenario == stScen) %>%
      select(-Scenario, -Variable, -Month) %>%
      arrange(Year,monthNum) %>%
      spread(Trace, Value) %>%
      select(-Year, -monthNum)
  }, as.data.frame(mReg * 0.001))
})