tests/testthat/test_DataInputChecks.R

library(mrds)
library(testthat)

context("Data Input")

test_that("Test data input checks", {


  #datasetup
  ex.filename<-system.file("testData/input_checks/ddf_dat.robj", package="mads")
  load(ex.filename)
  ex.filename<-system.file("testData/input_checks/obs_table.robj", package="mads")
  load(ex.filename)
  ex.filename<-system.file("testData/input_checks/region_table.robj", package="mads")
  load(ex.filename)
  ex.filename<-system.file("testData/input_checks/sample_table.robj", package="mads")
  load(ex.filename)

  #run ddf analyses
  ddf.1 <- ddf(dsmodel = ~mcds(key = "hn", formula = ~ size), method='ds', data=ddf.dat,meta.data=list(width=4))
  ddf.2 <- ddf(dsmodel = ~mcds(key = "hr", formula = ~ size), method='ds', data=ddf.dat,meta.data=list(width=4))
  #ddf.3 <- ddf(dsmodel = ~mcds(key = "unif", formula = ~ 1, adj.series = "cos", adj.order = c(2)), method='ds', data=ddf.dat,meta.data=list(width=4))
  ddf.3 <- ddf(dsmodel = ~mcds(key = "hn", formula = ~ 1, adj.series = "cos", adj.order = c(2)), method='ds', data=ddf.dat,meta.data=list(width=4, mono=TRUE))
  ddf.4 <- ddf(dsmodel = ~mcds(key = "hn", formula = ~ size), method='trial',mrmodel=~glm(link='logit',formula=~distance + size + sex + exposure), data=ddf.dat,meta.data=list(width=4))
  ddf.5 <- ddf(dsmodel = ~mcds(key = "hn", formula = ~ size), method='trial.fi',mrmodel=~glm(link='logit',formula=~distance + size + sex + exposure), data=ddf.dat,meta.data=list(width=4))
  #ddf.6 <- ddf(dsmodel = ~mcds(key = "hn", formula = ~ size), method='io',mrmodel=~glm(link='logit',formula=~distance + size + sex + exposure), data=ddf.dat,meta.data=list(width=4))
  ddf.7 <- ddf(dsmodel = ~mcds(key = "hn", formula = ~ size), method='io.fi',mrmodel=~glm(link='logit',formula=~distance + size + sex + exposure), data=ddf.dat,meta.data=list(width=4))
  ddf.8 <- ddf.7
  class(ddf.8) <- c("rem", "ddf")
  ddf.9 <- ddf.7
  class(ddf.9) <- c("glm")
  ddf.10 <- ddf.3
  ddf.10$data  <- ddf.10$data[,-3]

  #set up information for mads
  #Multi-analysis options
  model.names              <- list("CD"=c("ddf.1","ddf.2"), "WD"=c("ddf.1","ddf.2"), "UnidDol"=c("ddf.1","ddf.2"))
  ddf.models               <- list("ddf.1" = ddf.1, "ddf.2" = ddf.2)
  species.code.definitions <- list("UnidDol" = c("CD","WD"))
  species.presence         <- list("1. A" = c("CD","WD"))
  covariate.uncertainty    <- NULL
  ddf.model.options        <- list(criterion="AIC")
  ddf.model.options$distance.naming.conv <- TRUE
  bootstrap                <- TRUE
  bootstrap.options        <- list(resample="samples", n=1)
  seed.array               <- NULL

  #~~~~~~~~~~~~~~~~~~~~~~~~ TEST check.ddf.models(...) ~~~~~~~~~~~~~~~~~~~~~~~~~

  # check that there is an error when the same model is selected multiple times for a given species
  model.names              <- list("CD"=c("ddf.1","ddf.1"), "WD"=c("ddf.1","ddf.2"), "UnidDol"=c("ddf.1","ddf.2"))
  ddf.models               <- list("ddf.1" = ddf.1, "ddf.2" = ddf.2)
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("The model names are not unique for species CD."))

  # check that there is an error when ds models are mixed with io/trial
  model.names              <- list("CD"=c("ddf.1","ddf.4"), "WD"=c("ddf.1","ddf.2"), "UnidDol"=c("ddf.1","ddf.2"))
  ddf.models               <- list("ddf.1" = ddf.1, "ddf.2" = ddf.2, "ddf.4" = ddf.4)
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
              throws_error("Unsupported model types have been selected: trial"))
  # check that there is an error when io models are mixed with trial
  model.names              <- list("CD"=c("ddf.4","ddf.5"), "WD"=c("ddf.4","ddf.5"), "UnidDol"=c("ddf.4","ddf.7"))
  ddf.models               <- list("ddf.4" = ddf.4, "ddf.5" = ddf.5, "ddf.7" = ddf.7)
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("Unsupported model types have been selected: trial, trial.fi, trial, trial.fi, trial, io.fi"))
  # check that there is an error when models don't exists
  model.names              <- list("CD"=c("ddf.40","ddf.5"), "WD"=c("ddf.4","ddf.5"), "UnidDol"=c("ddf.4","ddf.5"))
  ddf.models               <- list("ddf.4" = ddf.4, "ddf.5" = ddf.5)
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("ddf object 1, analysis name ddf.40, for species code CD has not been provided."))
  # check that there is an error when some models contain data with cluster size and some contain data withough cluster size
  model.names              <- list("CD"=c("ddf.2","ddf.3"), "WD"=c("ddf.2","ddf.3"), "UnidDol"=c("ddf.2","ddf.10"))
  ddf.models               <- list("ddf.2" = ddf.2, "ddf.3" = ddf.3, "ddf.10" = ddf.10)
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("Cluster size must be present in all datasets within the ddf models or none."))

  #~~~~~~~~~~~~~~~~ TEST check.species.code.definitions(...) ~~~~~~~~~~~~~~~~~~~

  model.names              <- list("CD"=c("ddf.1","ddf.2"), "WD"=c("ddf.1","ddf.2"), "UnidDol"=c("ddf.1","ddf.2"))
  ddf.models               <- list("ddf.1" = ddf.1, "ddf.2" = ddf.2)
  species.code.definitions <- list("UnidDol"=c("CD","WD"), "CD"=NULL)
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("No species codes specified for CD in the species code definitions list."))
  species.code.definitions <- list("UnidDol"=c("CD","WD"), "CP"="CP")
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("Species mismatch in ddf models and species code definitions. Models not suppled for all species or models supplied for species not included in species code definitions."))
  species.code.definitions <- list("UnidDol"=c("CD","WD"), "CD"="WD")
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("Incorrect species code definition for species CD. If only a single code is entered it must match the name of the list element."))
  species.code.definitions <- list("UnidDol"=c("UnidDol","CD","WD"))
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("Incorrect species code definition for species UnidDol. Unidentified code cannot be prorated to itself."))
  species.code.definitions <- list("UnidDol"=c("CD","WD"), "UnidDel" = c("CD", "WD", "UnidDol"))
  model.names              <- list("CD"=c("ddf.1","ddf.2"), "WD"=c("ddf.1","ddf.2"), "UnidDol"=c("ddf.1","ddf.2"), "UnidDel"=c("ddf.1","ddf.2"))
  ddf.models               <- list("ddf.1" = ddf.1, "ddf.2" = ddf.2)
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("Incorrect species code definition for species UnidDel. An Unidentified code cannot be prorated to another unidentified code."))
  species.code.definitions <- list("UnidDol"=c("CD","WD"), "UnidDol"=c("CD","HP"))
  model.names              <- list("CD"=c("ddf.1","ddf.2"), "WD"=c("ddf.1","ddf.2"), "UnidDol"=c("ddf.1","ddf.2"))
  ddf.models               <- list("ddf.1" = ddf.1, "ddf.2" = ddf.2)
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("Multiple species code entries in the species code definitions list."))
  species.code.definitions <- list("UnidDol"=c("CD","WD"))
  model.names              <- list("CD"=c("ddf.1","ddf.2"), "WD"=c("ddf.1","ddf.2"), "UnidDol"=c("ddf.1","ddf.2"), "HP"=c("ddf.1","ddf.2"))
  ddf.models               <- list("ddf.1" = ddf.1, "ddf.2" = ddf.2)
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("Species mismatch in ddf models and species code definitions. Models not suppled for all species or models supplied for species not included in species code definitions."))

  #~~~~~~~~~~~~~~~~~~~ TEST check.covar.uncertainty(...) ~~~~~~~~~~~~~~~~~~~~~~~

  model.names              <- list("CD"=c("ddf.1","ddf.2"), "WD"=c("ddf.1","ddf.2"), "UnidDol"=c("ddf.1","ddf.2"))
  ddf.models               <- list("ddf.1" = ddf.1, "ddf.2" = ddf.2)
  covariate.uncertainty = data.frame(variable.layer = c("observation"), variable.name = c("scaledtotsize"), cor.factor.layer = "numeric", cor.factor.name = 1, uncertainty.layer = c("observation"), uncertainty.name = c("totsizecv"), uncertainty.measure = c("CV"), sampling.distribution = c("Norm"))
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("An unsupported sampling distribution has been chosen for covariate uncertainty. Only one of the following may be specified: Normal, Normal.Absolute, Lognormal.BC, Poisson, TruncPoisson.BC"))

  covariate.uncertainty = data.frame(variable.layer = c("observation"), variable.name = c("scaledtotsize"), cor.factor.layer = "numeric", cor.factor.name = 1, uncertainty.layer = c("observation"), uncertainty.name = c("totsizecv"), uncertainty.measure = c("CV"), sampling.distribution = c("Normal"))
  expect_that(results <- execute.multi.analysis(
                              species.code = names(model.names),
                              unidentified.sightings = species.code.definitions,
                              species.presence = species.presence,
                              covariate.uncertainty = covariate.uncertainty,
                              models.by.species.code = model.names,
                              ddf.model.objects = ddf.models,
                              ddf.model.options = ddf.model.options,
                              region.table = region.table,
                              sample.table = sample.table,
                              obs.table = obs.table,
                              bootstrap = bootstrap,
                              bootstrap.option = bootstrap.options,
                              silent = FALSE),
           throws_error("Invalid names for the covariates or associated uncertainty have been specified in the covariate uncertainty dataframe."))
  
  
  #Test that the species.field.name argument works
  ddf.1 <- ddf(dsmodel = ~mcds(key = "hn", formula = ~ size), method='ds', data=ddf.dat,meta.data=list(width=4))
  ddf.2 <- ddf(dsmodel = ~mcds(key = "hr", formula = ~ size), method='ds', data=ddf.dat,meta.data=list(width=4))
  model.names              <- list("CD"=c("ddf.1","ddf.2"), "WD"=c("ddf.1","ddf.2"), "UnidDol"=c("ddf.1","ddf.2"))
  ddf.models               <- list("ddf.1" = ddf.1, "ddf.2" = ddf.2)
  species.code.definitions <- list("UnidDol" = c("CD","WD"))
  species.presence         <- list("1. A" = c("CD","WD"))
  covariate.uncertainty    <- NULL
  ddf.model.options        <- list(criterion="AIC")
  ddf.model.options$distance.naming.conv <- TRUE
  bootstrap                <- FALSE
  bootstrap.options        <- list(resample="samples", n=1)
  seed.array               <- NULL
  
  set.seed(444)
  #Surpressing the warning about not bootstrapping
  species.field.name <- suppressWarnings(execute.multi.analysis(
    species.code = names(model.names),
    unidentified.sightings = species.code.definitions,
    species.presence = species.presence,
    covariate.uncertainty = covariate.uncertainty,
    models.by.species.code = model.names,
    ddf.model.objects = ddf.models,
    ddf.model.options = ddf.model.options,
    region.table = region.table,
    sample.table = sample.table,
    obs.table = obs.table,
    bootstrap = bootstrap,
    bootstrap.option = bootstrap.options,
    silent = FALSE))
  
  #add a new column of a different name the same as species
  ddf.dat$test <- ddf.dat$species
  #Remove the species column
  new.dat <- ddf.dat[,-13]
  
  #re-run ddf analyses so they have the updated data
  ddf.1 <- ddf(dsmodel = ~mcds(key = "hn", formula = ~ size), method='ds', data=new.dat,meta.data=list(width=4))
  ddf.2 <- ddf(dsmodel = ~mcds(key = "hr", formula = ~ size), method='ds', data=new.dat,meta.data=list(width=4))
  #Use new models!
  ddf.models               <- list("ddf.1" = ddf.1, "ddf.2" = ddf.2)
  
  #provide the new species.field.name
  ddf.model.options <- list(criterion="AIC", species.field.name = "test")
  set.seed(444)
  #Surpressing the warning about not bootstrapping
  alternative.field.name <- suppressWarnings(execute.multi.analysis(
    species.code = names(model.names),
    unidentified.sightings = species.code.definitions,
    species.presence = species.presence,
    covariate.uncertainty = covariate.uncertainty,
    models.by.species.code = model.names,
    ddf.model.objects = ddf.models,
    ddf.model.options = ddf.model.options,
    region.table = region.table,
    sample.table = sample.table,
    obs.table = obs.table,
    bootstrap = bootstrap,
    bootstrap.option = bootstrap.options,
    silent = FALSE))
  
  expect_identical(species.field.name, alternative.field.name)
  
})

Try the mads package in your browser

Any scripts or data that you put into this service are public.

mads documentation built on July 2, 2020, 2:12 a.m.