tests/testthat/test-dataManip-rclm.R

# test for good behavior of data manipulation functions

context("data manipulation - rclm")

test_that("makeModelData and makeRawData are inversions of each other", {
  data(Phosphorus)

  todf <- function(obj) {
    nms = names(obj)
    attributes(obj) = NULL
    setNames(data.frame(obj), nms)
  }

  moddat1 = makeModelData(Phosphorus)
  rawdat1 = makeRawData(moddat1)
  expect_equal(todf(moddat1), todf(makeModelData(rawdat1))[names(moddat1)])

  mod2 = rclm(c ~ q + sharm(Date) + time, moddat1)
  moddat1.1 = as.data.frame(moddat1)
  rawdat1.1 = makeRawData(todf(moddat1.1), rcmodel = mod2)
  expect_equal(todf(moddat1.1), todf(makeModelData(rawdat1.1))[names(moddat1.1)])

  data(rc_synth)
  moddat2 = makeModelData(rc_synth)
  rawdat2 = makeModelData(makeRawData(moddat2))[names(moddat2)]
  attributes(rawdat2) = NULL
  attributes(moddat2) = NULL
  expect_equal(moddat2, rawdat2)
})

test_that("data manipulation works using an rclm object", {
  data(Phosphorus)
  pdat = makeModelData(Phosphorus)
  mod2 = rclm(c ~ q + sharm(Date) + time, pdat)
  fakepred = data.frame(Date = Sys.Date() - 3:1, flow = rlnorm(3),
                        flow.units = rep("CFS", 3),
                        conc = rlnorm(3), conc.units = rep("mg/l", 3),
                        is.bdl = rep(FALSE, 3))

  expect_is(makeModelData(fakepred, model = mod2), "rcData")

  expect_is(makePredData(Phosphorus, object = mod2), "rcData")
})

test_that("getData works for rclms", {
  data(Phosphorus)
  pdat = makeModelData(Phosphorus)
  mod2 = rclm(c ~ q + sharm(Date) + time, pdat)

  expect_is(getData(mod2, type = "rcData"), "rcData")
  expect_is(getData(mod2, type = "raw"), "data.frame")
})


test_that("rcdata object is recoverable from rclm object", {
  data(Phosphorus)
  pdat = makeModelData(Phosphorus)
  mod2 = rclm(c ~ q + sharm(Date) + time, pdat)

  expect_is(getData(mod2, type = "rcData"), "rcData")
  expect_is(getData(mod2, type = "raw"), "data.frame")

  oc <- function(df) df[order(names(df))]
  expect_equal(oc(makeModelData(getData(mod2, type = "raw"))),
               oc(getData(mod2, type = "rcData")))
  expect_equal(oc(makeRawData(getData(mod2, type = "rcData"))),
               oc(getData(mod2, type = "raw")))
})


# Transformation functions

test_that("functions generated by transf return numeric", {
  link1 = make.link("log")
  tfm = transf(link1, 5, 3)

  expect_is(tfm$trans(rexp(10)), "numeric")
  expect_is(tfm$invert(rexp(10)), "numeric")

  data(Phosphorus)
  mod2 <- rclm(c ~ q + sharm(Date) + time, Phosphorus)

  expect_is(mod2$transform$cinvert(exp(10)), "numeric")
})

test_that("Date transformations go to and fro", {
  testdates = seq.Date(Sys.Date(), Sys.Date() + 19, 1)
  tfm = transf(testdates, mean(testdates))

  expect_is(tfm$trans(testdates), "numeric")
  expect_equal(tfm$invert(tfm$trans(testdates)), testdates)
})


test_that("subsetting preserves attributes in rcData objects", {
  data(Phosphorus)
  pdat = makeModelData(Phosphorus)
  atnames <- c("class", "stats", "transform", "units", "names")

  expect_identical(attributes(pdat[1:10,])[atnames], attributes(pdat)[atnames])
})


test_that("load unit conversion works", {
  expect_lt(abs(loadTS(flow = 1, conc = 1, Sys.Date())$load -
                  3600 * 24 * 28.3168 / 1000000),
                   0.0001)
})

test_that("custom arguments to makeModelData behave as intended", {
  data(Phosphorus)

  dat1 <- makeModelData(Phosphorus)
  dat2 <- makeModelData(Phosphorus, qbar = 3, qsd = 0.8)
  expect_gt(abs(mean(dat2$q)), abs(mean(dat1$q)))
  expect_gt(abs(sd(dat2$q) - 1), abs(sd(dat1$q) - 1))

})

test_that("sharm behaves correctly", {
  date1 <- Sys.Date() - sample(0L:10000L, 1)
  date2 <- date1 - 365L
  date3 <- date1 - 366L / 2L

  expect_lt(max(abs(sharm(date1) - sharm(date2))), 0.02)
  expect_lt(max(abs(sharm(date1, degree = 2) - sharm(date2, degree = 2))), 0.04)
  expect_lt(max(abs(sharm(date1, degree = 2)[1, c(2, 4)] -
                             sharm(date3, degree = 2)[1, c(2, 4)])), 0.04)
})
markwh/rcmodel documentation built on May 21, 2019, 12:26 p.m.