revdep/checks.noindex/runMCMCbtadjust/new/runMCMCbtadjust.Rcheck/tests/testthat/test-runMCMC_btadjust.R

In greta-dev/greta: Simple and Scalable Statistical Modelling in R

context("runMCMC_btadjust")

### minimal setup for running runMCMC_btadjust: see vignette
set.seed(1)
y1000<-rnorm(n=1000,mean=600,sd=30)

if (length(find.package("nimble", quiet=TRUE, verbose=FALSE))>0) {library(nimble); nimble_installed<-TRUE} else {nimble_installed<-FALSE}

#first condition added to prevent these tests being done on CRAN and outisde devtools: see: https://stackoverflow.com/questions/36166288/skip-tests-on-cran-but-run-locally
if(identical(Sys.getenv("NOT_CRAN"), "true")) {if (length(find.package("rjags", quiet=TRUE, verbose=FALSE))>0) {library(rjags); if (length(jags.version())==0) {rjags_installed<-FALSE} else {if (substring(jags.version(),first=1,last=1)!="4") {rjags_installed<-FALSE} else {rjags_installed<-TRUE}}} else {rjags_installed<-FALSE}} else {rjags_installed<-FALSE}

################
#not done with greta as loading greta gives error outside testthat.
################

if (nimble_installed)
  {ModelData <-list(mass = y1000)
ModelConsts <- list(nobs = length(y1000))
ModelCode<-nimbleCode(
  {
    # Priors
    population.mean ~ dunif(0,5000)
    population.sd ~ dunif(0,100)

    # Precision = 1/variance
    population.variance <- population.sd * population.sd

    # Normal parameterized by precision
    precision <- 1 / population.variance

    # Likelihood
    for(i in 1:nobs){
      mass[i] ~ dnorm(population.mean, precision)
    }
  })
}

if (rjags_installed)
{
ModelData.Jags <-list(mass = y1000, nobs = length(y1000))

modeltotransfer<-"model {

		# Priors
			population.mean ~ dunif(0,5000)
			population.sd ~ dunif(0,100)

			# Precision = 1/variance
			population.variance <- population.sd * population.sd

			# Normal parameterized by precision
			precision <- 1 / population.variance

			# Likelihood
			for(i in 1:nobs){
			  mass[i] ~ dnorm(population.mean, precision)
			}
		}"

}

ModelInits <- function()
{list (population.mean = rnorm(1,600,90), population.sd = runif(1, 1, 30))}

Nchains <- 3

set.seed(1)
Inits<-lapply(1:Nchains,function(x){ModelInits()})


ModelInitsbis <- function()
{list (population.mean = rnorm(1,600,90), population.sd = runif(1, -1, 0))}

Nchains <- 3

set.seed(1)
Initsbis<-lapply(1:Nchains,function(x){ModelInitsbis()})

#specifying the names of parameters to analyse and save:
params <- c("population.mean", "population.sd")



if (nimble_installed){
testthat::test_that("errors", {
##

  #should give  an error because time.max & niter.max are not specified at the same time
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2)))

   #should give  an error because Nchains=1 & control$convtype="Gelman"
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                          inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=1,niter.max=2000,control=list(convtype="Gelman"))))

  #should give  an error because Nchains=1 & control$convtype="Gelman_new"
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                          inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=1,niter.max=2000,control=list(convtype="Gelman_new"))))

  #should give  an error because control has an unidentified component
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                          inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(toto=0))))

  #should give  an error because props.conv in control has negative values
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                          inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(props.conv=-1))))

  #should give  an error because props.conv in control has values >1
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                          inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(props.conv=c(0.5,2)))))

  #should give an error because safemultiplier.Nvals is not numeric
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                          inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(safemultiplier.Nvals="toto"))))

  #should give an error because time.max is NULL & niter.max is not finite
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=Inf, time.max=NULL)))

  #should give an error because if Nchains>1, convtype!= "Gelman" or convtype!= "Gelman_new" or if Nchains==1, convtype!= "Geweke" or convType!="Heidleberger"
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(convType="Geweke"))))
 testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(convType="Heidleberger"))))
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=1,niter.max=2000,control=list(convType="Gelman"))))
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=1,niter.max=2000,control=list(convType="Gelman_new"))))
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(convType="toto"))))

#should give an error because control$convtype.alpha is inadequate
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(convType="Gelman",convtype.alpha=c(0.1,0.3)))))
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(convType="Gelman",convtype.alpha=NULL))))
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(convType="Gelman",convtype.alpha=1.1))))


  #should give an error because neff.method is not "Stan" or "Coda"
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000,control=list(neff.method="toto"))))

  #should give an error because MCMC_language is not among "Nimble","Jags" or"Greta"
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="toto",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000)))

  #should give an error because constants is not provided or is null with MCMC_language="Nimble"
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=NULL,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000)))

  #should give an error because code is not provided or is null with MCMC_language="Nimble"
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=NULL,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000)))

  #should give an error because data is not provided or is null with MCMC_language="Nimble"
  testthat::expect_error((runMCMC_btadjust(data=NULL,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000)))


  #should give an error because data is not provided or is null with MCMC_language="Jags"
  testthat::expect_error((runMCMC_btadjust(data=NULL,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000)))

  #should give an error because params is not provided
  testthat::expect_error((runMCMC_btadjust(data=ModelData,constants=ModelConsts,code=ModelCode,MCMC_language="Nimble",
                                           inits=Inits,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000)))



  })}




if (rjags_installed){
testthat::test_that("errors", {
##
  #should give an error because code is not provided or is null with MCMC_language="Jags"
  testthat::expect_error((runMCMC_btadjust(data=ModelData.Jags,code=NULL,MCMC_language="Jags",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000)))

  #should give an error because code is not provided or is null with MCMC_language="Jags"
  testthat::expect_error((runMCMC_btadjust(data=ModelData.Jags,MCMC_language="Jags",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000)))


  #should give an error because code is not of type character with MCMC_language="Jags"
  testthat::expect_error((runMCMC_btadjust(data=ModelData.Jags,code=1,MCMC_language="Jags",
                                           inits=Inits,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000)))

  #should give an error because Inits should give bad values for all chains is not provided
  testthat::expect_error((runMCMC_btadjust(data=ModelData.Jags,code=modeltotransfer,MCMC_language="Jags",
                                           inits=Initsbis,params=params,neff.min=150,conv.max=1.05,Nchains=2,niter.max=2000)))



  })}