tests/testthat/test_bootdht.R

In Distance: Distance Sampling Detection Function and Abundance Estimation

context("Testing bootdht")

test_that("area=0 with default summary",{

  skip_on_cran()

  data(amakihi)
  # subset for testing speed
  amakihi <- amakihi[1:300,]
  conv <- convert_units("meter", NULL, "hectare")
  surv <- ds(amakihi, transect="point", key="hr",
             formula=~Region.Label, convert_units=conv,
             truncation = 82.5, er_var="P3")
  expect_error(bootdht(surv, flatfile=amakihi, nboot=5),
               "No Area in flatfile, densities will be returned and the default summary function records only abundances. You need to write your own summary_fun.")

  amakihi$Area <- NULL
  expect_error(bootdht(surv, flatfile=amakihi, nboot=5),
               "No Area in flatfile, densities will be returned and the default summary function records only abundances. You need to write your own summary_fun.")

})


# generate some data to test on
dat <- data.frame(Sample.Label = 1:10)
dat$Region.Label <- c(rep(1, 5), rep(2, 5))
set.seed(123)
dat2 <- dat[sample(1:nrow(dat), nrow(dat), replace=TRUE), ]
dat2$object <- 1:nrow(dat2)
dat <- dat[!(dat$Sample.Label %in% dat2$Sample.Label),]
dat$object <- NA
dat <- rbind(dat, dat2)
dat$save.ind <- 1:nrow(dat)
dat$distance <- rnorm(nrow(dat), 0, 50)
dat$distance <- ifelse(is.na(dat$object),NA,dat$distance)


test_that("resamples work - strata", {

  set.seed(123)
  obs <- bootdht_resample_data(dat, c("Region.Label"))

  expect_equal(obs$save.ind, c(1, 4, 5, 7, 9, 10, 2, 3, 6, 13, 8, 11, 12))
})


test_that("resamples work - sample", {

  set.seed(123)
  obs <- bootdht_resample_data(dat, c("Sample.Label"))

  expect_equal(obs$save.ind, c(7, 7, 4, 5, 4, 5, 7, 12, 8, 11, 2, 3, 6, 13))
})

test_that("resamples work - object", {

  set.seed(123)
  obs <- bootdht_resample_data(dat, c("object"))

  expect_equal(obs$save.ind, c(1, 4, 5, 6, 5, 2, 3, 6, 11, 9))
})

test_that("resamples work - strata/object", {

  set.seed(123)
  obs <- bootdht_resample_data(dat, c("Region.Label", "object"))

  expect_equal(obs$save.ind, c(1, 4, 5, 5, 5, 9, 2, 3, 13, 8, 11, 8))
})


test_that("resamples work - sample/object", {

  set.seed(123)
  obs <- bootdht_resample_data(dat, c("Sample.Label", "object"))

  expect_equal(obs$save.ind, c(7, 4, 4, 4, 5, 4, 12, 8, 2, 3, 6, 13))
})

test_that("resamples work - strata/sample/object", {

  set.seed(1223)
  obs <- bootdht_resample_data(dat, c("Region.Label", "Sample.Label", "object"))

  expect_equal(obs$save.ind, c(6, 1, 9, 6, 6, 2, 3, 8, 11, 6, 13, 8))
})

# generate some data to test on
dat <- data.frame(Sample.Label = 1:10)
dat$Region.Label <- c(rep(1, 5), rep(2, 5))
set.seed(115)
dat2 <- dat
dat2$Region.Label <- paste("YEAR", as.character(dat2$Region.Label), sep = "")
dat2 <- rbind(dat2, dat2, dat2)
dat2$distance <- abs(rnorm(nrow(dat2), 0, 25))
dat2$Effort <- 1000
dat2$Area <- 100
dat2$size <- rpois(nrow(dat2), 20)
dat2$object <- 1:nrow(dat2)

conversion.factor <- convert_units("meter", "meter", "square kilometer")

fit.ds <- ds(data=dat2,
             truncation=50,
             key="hn",
             adjustment=NULL,
             convert_units=conversion.factor,
             formula=~size)



test_that("Issue #158 is fixed (stratum names > 'Total' bug)", {
  
  skip_on_cran()
  
  set.seed(225)
  easybootn <- suppressMessages(bootdht(model=fit.ds,
                       flatfile=dat2,
                       summary_fun=bootdht_Nhat_summarize,
                       convert_units=conversion.factor,
                       sample_fraction=1,
                       nboot=3, cores=1,
                       progress_bar = "none"))

  # Make check table
  check.tab <- easybootn %>% dplyr::group_by(Label) %>%
    dplyr::summarize(LCI=quantile(Nhat,probs=0.025,na.rm=TRUE),
                     UCI=quantile(Nhat,probs=0.975,na.rm=TRUE))
  
  # This was TRUE should now be FALSE after fix
  expect_false(any(is.na(check.tab$LCI)))
  
  # Now check cluster fix
  bootdht_NChat_summarize <- function(ests, fit) {
    return(data.frame(Label = ests$clusters$N$Label,
                      Nhat  = ests$cluster$N$Estimate))
  }
  
  set.seed(225)
  easybootn <- suppressMessages(bootdht(model=fit.ds,
                       flatfile=dat2,
                       summary_fun=bootdht_NChat_summarize,
                       convert_units=conversion.factor,
                       sample_fraction=1,
                       nboot=3, cores=1,
                       progress_bar = "none"))
  # Make check table
  check.tab <- easybootn %>% dplyr::group_by(Label) %>%
    dplyr::summarize(LCI=quantile(Nhat,probs=0.025,na.rm=TRUE),
                     UCI=quantile(Nhat,probs=0.975,na.rm=TRUE))
  
  # This was TRUE should now be FALSE after fix
  expect_false(any(is.na(check.tab$LCI)))
})


# Test data from Eric
data(minke)
# convert exact distances into bins
vals <- seq(0,2,.2)
minke$bin <- cut(minke$distance, breaks=seq(0, 2, .2), right=FALSE, labels=FALSE)
minke$distbegin <- vals[minke$bin]
minke$distend <- vals[minke$bin+1]
# remove exact distances
minke$distance <- NULL

test_that("Issue #147 is fixed (bootdht with distbegin/distend)", {
  
  skip_on_cran()
  mod1 <- ds(minke)
  set.seed(225)
  bootout <- bootdht(mod1, flatfile=minke,  nboot=3)
  expect_true(nrow(bootout) > 0)
})


# generate some data to test on
dat <- data.frame(object = 1:60, Sample.Label = rep(1:10,6),
                  Area = 100, Effort = 1000)
dat$Region.Label <- c(rep("StrataA", 30), rep("StrataB", 30))
dat$distance <- abs(rnorm(nrow(dat), 0, 25))
dat$size <- rpois(nrow(dat), 20)
dat$ref.object <- dat$object
test_that("Error raised when sampler ID not unique (Issue #157)", {
  
  set.seed(123)
  expect_error(bootdht_resample_data(dat, c("Sample.Label")), 
               "Cannot bootstrap on samplers within strata as sampler ID values are not unique across strata. Please ensure all Sample.Label values are unique.")
})