tests/testthat/test_adjustments.R

In Distance: Distance Sampling Detection Function and Abundance Estimation

# test ds()

par.tol <- 1e-5
N.tol <- 1e-3
lnl.tol <- 1e-4

context("Adjustment terms")

# data setup
data(book.tee.data)
egdata <- book.tee.data$book.tee.dataframe
egdata <- egdata[!duplicated(egdata$object),]


test_that("adjustments expand correctly",{
  skip_on_cran()

  egdata <- egdata[egdata$observer==1,]

  # hn + cos(2)
  expect_equal(suppressWarnings(summary(ds(egdata, 4, key="hn",
                                           nadj=1))$ddf$name.message),
               "half-normal key function with cosine(2) adjustments")

  # hn + cos(2,3,4,5)
  expect_equal(suppressWarnings(summary(ds(egdata, 4, key="hn",
                                           nadj=4))$ddf$name.message),
               "half-normal key function with cosine(2,3,4,5) adjustments")

  #unif + cos(1,2)
  expect_equal(suppressWarnings(summary(ds(egdata, 4, key="unif",
                                           nadj=2))$ddf$name.message),
               "uniform key function with cosine(1,2) adjustments")

  #unif + poly(2)
  expect_equal(suppressWarnings(summary(ds(egdata, 4, key="unif",
                                           adjustment="poly",
                                           nadj=1))$ddf$name.message),
               "uniform key function with simple polynomial(2) adjustments")

  #unif + herm(2)
  expect_equal(suppressWarnings(summary(ds(egdata, 4, key="unif",
                                           adjustment="herm",
                                           nadj=1))$ddf$name.message),
               "uniform key function with Hermite(2) adjustments")

  # hn + cos(2,3)
  expect_equal(suppressWarnings(summary(ds(egdata, 4, key="hn",
                                           order=2:3))$ddf$name.message),
               "half-normal key function with cosine(2,3) adjustments")
})

test_that("adjustments orders start correctly",{
  skip_on_cran()

  # hn+poly starts at 4
  expect_message(suppressWarnings(ds(egdata, trunc=4, key="hn", adj="poly", max_adjustments=1)),
                 "Fitting half-normal key function with simple polynomial\\(4\\) adjustments")
  # hn+cos starts at 2
  expect_message(suppressWarnings(ds(egdata, trunc=4, key="hn", adj="cos", max_adjustments=1)),
                 "Fitting half-normal key function with cosine\\(2\\) adjustments")
  # hn+herm starts at 4
  expect_message(suppressWarnings(ds(egdata, trunc=4, key="hn", adj="herm", max_adjustments=1)),
                 "Fitting half-normal key function with Hermite\\(4\\) adjustments")

  # hr+poly starts at 4
  expect_message(suppressWarnings(ds(egdata, trunc=4, key="hr", adj="poly", max_adjustments=1)),
                 "Fitting hazard-rate key function with simple polynomial\\(4\\) adjustments")
  # hr+cos starts at 2
  expect_message(suppressWarnings(ds(egdata, trunc=4, key="hr", adj="cos", max_adjustments=1)),
                 "Fitting hazard-rate key function with cosine\\(2\\) adjustments")
  # hr+herm starts at 4
  expect_message(suppressWarnings(ds(egdata, trunc=4, key="hr", adj="herm", max_adjustments=1)),
                 "Fitting hazard-rate key function with Hermite\\(4\\) adjustments")

  # unif+poly starts at 2
  expect_message(suppressWarnings(ds(egdata, trunc=4, key="unif",
                                     adj="poly", max_adjustments=1)),
                 "Fitting uniform key function with simple polynomial\\(2\\) adjustments")
  # unif+cos starts at 1
  expect_message(suppressWarnings(ds(egdata, trunc=4, key="unif",
                                     adj="cos", max_adjustments=1)),
                 "Fitting uniform key function with cosine\\(1\\) adjustments")
  # unif+herm starts at 2
  expect_message(suppressWarnings(ds(egdata, trunc=4, key="unif",
                                     adj="herm", max_adjustments=1)),
                 "Fitting uniform key function with Hermite\\(2\\) adjustments")

})

# max adjustments arg
test_that("max.adjustments works",{
  skip_on_cran()

  egdata <- egdata[egdata$observer==1,]

  # setting max.adjustments=0 gives no adjustments
  expect_equal(summary(ds(egdata, 4, key="hn", max_adjustments=0,
                          adjustment="cos"))$ddf$name.message,
               "half-normal key function")

  # some delicious stake
  data(stake77)
  dists <- stake77$PD[stake77$Obs2==1]
  dists <- c(dists, dists[dists>10])
  dists <- c(dists, dists[dists<5])
  dists <- c(dists, dists[dists<5])

  # ignore warnings below from monotonicity checks, don't care about that here
  expect_equal(summary(suppressWarnings(
                ds(dists, 20, key="hn", max_adjustments=2,
                   adjustment="cos")))$ddf$name.message,
               "half-normal key function with cosine(2,3) adjustments")

  expect_equal(summary(suppressWarnings(
                ds(dists, 20, key="hn", max_adjustments=1,
                   adjustment="cos")))$ddf$name.message,
               "half-normal key function with cosine(2) adjustments")

})

test_that("errors thrown",{

  egdata <- egdata[egdata$observer==1,]

  # nadj and length(order) don't match
  expect_error(suppressWarnings(summary(ds(egdata, 4, key="hn", order=c(2,3),
                                           nadj=1))$ddf$name.message),
               "The number of adjustment orders specified in 'order' must match 'nadj'")

})