tests/testthat/test-ctap.R

In abarbour/psd: Adaptive, Sine-Multitaper Power Spectral Density and Cross Spectrum Estimation

##

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
  
})

##