# 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)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.