##
context("Tapers class and methods")
taps.o = c(0,1:10,100)
taps = c(0,1:10,100)
ataps <- as.tapers(taps)
ataps.s <- as.tapers(taps, setspan = TRUE)
ms.taps <- minspan(taps)
ms.ataps <- minspan(ataps)
test_that("coercion is functioning",{
expect_is(ataps, 'tapers')
expect_is(ataps.s, 'tapers')
expect_is(as.vector(ataps), 'integer')
expect_is(as.vector(ataps.s), 'integer')
expect_is(as.data.frame(ataps), 'data.frame')
expect_is(as.data.frame(ataps.s), 'data.frame')
expect_is(summary(ataps), 'summary.tapers')
expect_is(summary(ataps.s), 'summary.tapers')
expect_is(ms.taps, 'integer')
expect_is(ms.ataps, 'tapers')
})
test_that("constrained-range is correct",{
expect_equal(min(ataps), 1)
expect_equal(max(ataps), max(taps))
expect_equal(min(ataps.s), min(minspan(taps)))
expect_equal(max(ataps.s), max(minspan(taps)))
})
test_that("parabolic weighting is applied correctly",{
nk <- 10
PW <- parabolic_weights(nk)
PWr <- parabolic_weights_rcpp(nk)
expect_is(PW[['ntap']], 'integer')
expect_is(PWr[['ntap']], 'integer')
expect_equal(PW[['ntap']], nk)
expect_equal(PWr[['ntap']], nk)
expect_equal(max(PW[['taper_seq']]), nk)
expect_equal(max(PWr[['taper_seq']]), nk)
expect_equal(sum(PW[['taper_weights']]), 1)
expect_equal(sum(PWr[['taper_weights']]), 1)
# num tapers is always integer
nkd <- 10.99
PWd <- parabolic_weights(nkd)
PWdr <- parabolic_weights_rcpp(nkd)
expect_is(PWd[['ntap']], 'integer')
expect_is(PWdr[['ntap']], 'integer')
expect_equal(PWd[['ntap']], PWdr[['ntap']])
expect_equal(max(PWd[['taper_seq']]), as.integer(nkd))
expect_equal(max(PWdr[['taper_seq']]), as.integer(nkd))
expect_equal(sum(PWd[['taper_weights']]), 1)
expect_equal(sum(PWdr[['taper_weights']]), 1)
})
test_that("environment variables are protected",{
expect_equal(taps, taps.o)
expect_equal(ms.taps, as.vector(ms.ataps))
expect_is(ctap_simple(taps), 'integer')
expect_is(ctap_simple(ataps), 'tapers')
expect_warning(ctap_loess(taps)) # because a sequence is not given
expect_is(suppressWarnings(ctap_loess(taps)), 'integer')
expect_is(suppressWarnings(ctap_loess(ataps)), 'tapers')
expect_error(constrain_tapers(taps, constraint.method = "some.nonexistent.method", verbose = FALSE))
expect_is(constrain_tapers(taps, constraint.method = "simple.slope", verbose = FALSE), 'integer')
expect_is(suppressWarnings(constrain_tapers(taps, constraint.method = "loess.smooth", verbose = FALSE)), 'integer')
expect_equal(taps, constrain_tapers(taps, constraint.method = "none", verbose = FALSE))
expect_is(constrain_tapers(ataps, verbose = FALSE), 'tapers')
})
test_that("constraint coercion is functioning",{
expect_is(constrain_tapers(taps, verbose = FALSE), 'integer')
expect_is(constrain_tapers(ataps, verbose = FALSE), 'tapers')
expect_is(ctap_simple(taps), 'integer')
expect_is(ctap_simple(ataps), 'tapers')
expect_is(suppressWarnings(ctap_loess(taps)), 'integer')
expect_is(suppressWarnings(ctap_loess(ataps)), 'tapers')
})
test_that("constrained-range is correct",{
taps <- c(0,1:10,100)
taps.c <- ctap_simple(taps, maxslope=1)
taps.c2 <- ctap_simple(taps, maxslope=2)
expect_equal(min(taps.c), 1)
expect_equal(min(taps.c2), 1)
expect_equal(max(taps.c), 11)
expect_equal(max(taps.c2), 12)
})
test_that("bad input is handled correctly",{
expect_error(rcpp_ctap_simple(NULL))
expect_equal(ctap_simple(NA), 1)
expect_warning(ctap_simple(Inf))
expect_equal(ctap_simple(NULL), integer(0))
expect_error(ctap_simple(1, maxslope=-1))
})
test_that("Length and positivity requirements are checked correctly",{
expect_error(minspan(1))
expect_error(minspan(0))
expect_error(minspan(-1))
expect_error(minspan(-1:0))
})
test_that("the result is limited by section length", {
ms. <- minspan(0:2)
expect_equal(min(ms.), 1)
expect_equal(max(ms.), 1)
ms. <- minspan(0:3)
expect_equal(min(ms.), 1)
expect_equal(max(ms.), 2)
ms. <- minspan(0:4)
expect_equal(min(ms.), 1)
expect_equal(max(ms.), 2)
ms. <- minspan(0:5)
expect_equal(min(ms.), 1)
expect_equal(max(ms.), 3)
ms. <- minspan(0:6)
expect_equal(min(ms.), 1)
expect_equal(max(ms.), 3)
ms. <- minspan(0:7)
expect_equal(min(ms.), 1)
expect_equal(max(ms.), 4)
})
test_that("strange values are dealt with", {
expect_warning(ms. <- minspan(c(0:7,Inf)))
expect_equal(min(ms.), 1)
expect_equal(max(ms.), 4)
expect_equal(length(ms.), 9)
ms. <- minspan(c(0:7,NA))
expect_equal(min(ms.), 1)
expect_equal(max(ms.), 4)
expect_equal(length(ms.), 9)
ms. <- minspan(c(0:7,""))
expect_equal(min(ms.), 1)
expect_equal(max(ms.), 4)
expect_equal(length(ms.), 9)
ms. <- minspan(c(0:7,NULL))
expect_equal(min(ms.), 1)
expect_equal(max(ms.), 4)
expect_equal(length(ms.), 8) # instead of 9
})
##
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.