tests/testthat/test-simulate.R

cat(crayon::yellow("\ntest-simulate:\n"))
data("Loaloa")
HLC <- HLCor(cbind(npos,ntot-npos)~Matern(1|longitude+latitude),
             data=Loaloa,family=binomial(),
             ranPars=list(lambda=1,nu=0.5,rho=1/0.7)) 
testthat::expect_equal(dim(simulate(HLC, nsim=2)),c(197,2)) ## matrix 2 col -> OK
testthat::expect_equal(dim(simulate(HLC, nsim=1)),NULL) ## vector length N -> OK
testthat::expect_equal(dim(simulate(HLC, type = "residual", nsim=2)),c(197,2)) ## matrix 2 col -> OK
testthat::expect_equal(dim(simulate(HLC, type = "residual", nsim=1)),NULL) ## vector length N -> OK
testthat::expect_equal(dim(simulate(HLC, type = "predVar", nsim=2,
                                    variances=list(linPred=TRUE, disp=FALSE,cov=TRUE))),c(197,2)) ## matrix 2 col -> OK
testthat::expect_equal(dim(simulate(HLC, type = "predVar", nsim=1,
                                    variances=list(linPred=TRUE, disp=FALSE,cov=TRUE))),NULL) ## vector length N -> OK

# check that ZAL is used in marginal simulation (here, further, with new locations):
set.seed(123)
check_marg_ZAL <- simulate(HLC, newdata=Loaloa[c(1:3,1:3)+0.1,], sizes=HLC$BinomialDen[1:6])
crit <- unique(check_marg_ZAL - c(53L, 73L, 68L, 23L, 52L, 55L))
testthat::expect_equal(crit,0) 

cat("simulate on trivial toy examples:\n") 
x0 <- c(-1, 1)
var(x0)
fit0 <- HLfit(x0~1,data=data.frame(x0=x0)) 
vcov(fit0)
sim0 <- simulate(fit0, nsim=10000, seed=1) # ignores uncertainty
var(t(sim0))
sim0 <- simulate(fit0, nsim=10000, seed=1, type="predVar", variances=list(predVar=TRUE)) # Accounting for uncertainty in fixed effects (cf Spencer Graves, R-devel, 2019/12/28)
var(t(sim0))
x1 <- 1 
fit1 <- HLfit(x1~1,data=data.frame(x1=x1), family=poisson)
fixef(fit1)
exp(fixef(fit1))
vcov(fit1)
sim1 <- simulate(fit1, 10000, 1)  # ignores uncertainty
var(t(sim1))
sim1 <- simulate(fit1, nsim=10000, seed=1, type="predVar", variances=list(predVar=TRUE))
var(t(sim1)) # \approx 6 
#
fit1 <- HLfit(x1~1+(1|x2),data=data.frame(x1=c(1,1),x2=c(1,2)), ranFix=list(lambda=1),family=poisson)
sim1 <- simulate(fit1, nsim=3, seed=1, type="predVar", variances=list(predVar=TRUE)) # test of .calc_invV_factors() for ZAfix=ZAL= Identity

cat("simulate for Gamma response:\n") 
set.seed(123)
gr <- data.frame(y=rgamma(1000,shape=9/2,scale=2/3)) # mean mu=3=exp(1.0986), variance=2 => phi=2/9
# Here fitme uses HLfit methods which provide cond. SE for phi by default:
(gamfit <- fitme(y~1,data=gr,family=Gamma(log)))
var(simulate(gamfit,type="residual")) ## must approach 2

{ # Without newdata, etaFix and offset() should ive equivalent results
  set.seed(1)
  data_resp <- data.frame(y = rnorm(100), x = rnorm(100), ID = gl(100, 10))
  fake_fit_etaFix <- fitme(y ~ 0+offset(2+0.5*x) + (1|ID), data = data_resp,
                    fixed = list(lambda = 5, phi = 10))
  fake_fit_offset <- fitme(y ~ x + (1|ID), data = data_resp,
                    etaFix = list(beta = c("(Intercept)" = 2, x = 0.5)),
                    fixed = list(lambda = 5, phi = 10))
  set.seed(123)
  s1 <- simulate(fake_fit_etaFix)
  set.seed(123)
  s2 <- simulate(fake_fit_offset)
  diff(range(s2-s1))
  diff(range(get_predVar(fake_fit_etaFix)-get_predVar(fake_fit_offset)))
  # LM:
  fake_fit_etaFix <- fitme(y ~ 0+offset(2+0.5*x), data = data_resp,
                           fixed = list(lambda = 5, phi = 10))
  fake_fit_offset <- fitme(y ~ x, data = data_resp,
                           etaFix = list(beta = c("(Intercept)" = 2, x = 0.5)),
                           fixed = list(lambda = 5, phi = 10))
  set.seed(123)
  s1 <- simulate(fake_fit_etaFix)
  set.seed(123)
  s2 <- simulate(fake_fit_offset)
  diff(range(s2-s1))
  diff(range(get_predVar(fake_fit_etaFix)-get_predVar(fake_fit_offset)))
  
}

Try the spaMM package in your browser

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

spaMM documentation built on Aug. 30, 2023, 1:07 a.m.