tests/testthat/test-fitgllvm.R

context("test-fitgllvm")

test_that("basic data fitting works", {
  data(microbialdata)
  X <- microbialdata$Xenv[1:30,]
  y <- microbialdata$Y[1:30, order(colMeans(microbialdata$Y > 0), decreasing = TRUE)[21:35]]
  f0<-gllvm(y, family = poisson(), seed = 999)
  f1<-gllvm(y, family = "negative.binomial", seed = 999)
  f2<-gllvm(y, X, formula = ~pH + Phosp, family = "negative.binomial", seed = 999)
  expect_true(round(mean(f0$params$beta0), digits = 1)-2<0.01)
  expect_true(round(mean(f1$params$beta0), digits = 1)-2<0.01)
  expect_true(round(mean(f2$params$Xcoef[,1]), digits = 1)-0.1<0.01)
})


test_that("fourth corner models works", {
  data(microbialdata)
  X <- microbialdata$Xenv[1:30,2:3]
  y <- microbialdata$Y[1:30, order(colMeans(microbialdata$Y > 0), decreasing = TRUE)[21:35]]
  TR <- matrix(rnorm(15)); colnames(TR) <- "t1"
  ff0<-gllvm(y, X, TR=TR, family = "negative.binomial", seed = 999)
  ff1<-gllvm(y, X, TR=TR, formula = ~pH + pH:t1, family = "negative.binomial", seed = 999)
  expect_true(is.finite(ff0$logL))
  expect_true(is.finite(ff1$logL))
})

test_that("row effects works", {
  data(microbialdata)
  y <- microbialdata$Y[1:30, order(colMeans(microbialdata$Y > 0), decreasing = TRUE)[21:35]]
  fr0<-gllvm(y, family = "negative.binomial", seed = 999, row.eff = "fixed", num.lv = 1)
  fr1<-gllvm(y, family = "negative.binomial", seed = 999, row.eff = "random", num.lv = 0)
  result<-c(-0.34, 0.29)
  names(result)<-c("AB3", "sigma")
  expect_true(round(fr0$params$row.params[2], digits = 2)- result[1]<0.1)
  expect_true(round(fr1$params$sigma, digits = 2)- result[2]<0.1)
})

test_that("binomial works", {
  data(microbialdata)
  y <- microbialdata$Y[, order(colMeans(microbialdata$Y > 0), decreasing = TRUE)[160:175]]
  y01<-(y>0)*1
  fb0<-gllvm(y01, family = binomial(link = "logit"), seed = 999, method = "LA", num.lv = 1)
  fb2<-gllvm(y01, family = binomial(link = "probit"), seed = 999)
  expect_true(is.finite(fb0$logL))
  expect_true(is.finite(fb2$logL))
})

test_that("ZIP works", {
  data(eSpider)
  spider <- eSpider
  spider$abund <- eSpider$abund[eSpider$nonNA,]
  y <- spider$abund[order(rowSums(spider$abund>0), decreasing = TRUE)[1:20],1:8]
  fz0<-gllvm(y, family = "ZIP", seed = 999, method = "LA", num.lv = 1)
  expect_equal( length(fz0$params$beta0), 8 )
  expect_true( is.finite(fz0$logL))
})

test_that("quadratic models work", {
  data(eSpider)
  spider <- eSpider
  spider$abund <- spider$abund[spider$nonNA,]
  spider$x <- spider$X[spider$nonNA,]
  X <- scale(spider$x)
  y <- spider$abund
  fq0<-gllvm(y, num.lv = 2, family = "poisson", seed = 999)
  fq1<-gllvm(y, X, num.lv = 2, family = "poisson", seed = 999)
  fq2<-gllvm(y, X, num.lv = 2, family = "poisson", row.eff="random", seed = 999)
  expect_true(is.finite(fq0$logL))
  expect_true(is.finite(fq1$logL))
  expect_true(is.finite(fq2$logL))
})

test_that("constrained ordination models work", {
  data(eSpider)
  spider <- eSpider
  spider$abund <- spider$abund[spider$nonNA,]
  spider$x <- spider$X[spider$nonNA,]
  X <- scale(spider$x)
  y <- spider$abund
  fc0<-gllvm(y, X, num.RR = 2, family = "poisson", seed = 999)
  fc1<-gllvm(y, X, num.RR = 2, family = "poisson", seed = 999, randomB="LV")
  fc2<-gllvm(y, X, num.RR = 2, family = "poisson", seed = 999, randomB="LV", row.eff="random")
  fc3<-gllvm(y, X, num.RR = 2, quadratic=T, family = "poisson", seed = 9226, randomB="LV", row.eff="random")
  expect_true(is.finite(fc0$logL))
  expect_true(is.finite(fc1$logL))
  expect_true(is.finite(fc2$logL))
  expect_true(is.finite(fc3$logL))
})

test_that("concurrent ordination models work", {
  data(eSpider)
  spider <- eSpider
  spider$abund <- spider$abund[spider$nonNA,]
  spider$x <- spider$X[spider$nonNA,]
  X <- scale(spider$x)
  y <- spider$abund
  fc0<-gllvm(y, X, num.lv.c = 2, family = "poisson", seed = 999)
  fc1<-gllvm(y, X, num.lv.c = 2, family = "poisson", seed = 999, randomB="LV")
  #this has a warning for overfitting that can be ignored
  suppressWarnings(fc2<-gllvm(y, X, num.lv.c = 2, family = "poisson", seed = 999, randomB="LV", row.eff="random"))
  fc3<-gllvm(y, X, num.lv.c = 2, quadratic=T, family = "poisson", seed = 999, randomB="LV")
  expect_true(is.finite(fc0$logL))
  expect_true(is.finite(fc1$logL))
  expect_true(is.finite(fc2$logL))
  expect_true(is.finite(fc3$logL))
})

test_that("phylogenetic models work", {
  data(eSpider)
  spider <- eSpider
  spider$abund <- spider$abund[spider$nonNA,]
  spider$x <- spider$X[spider$nonNA,]
  X <- scale(spider$x)
  y <- spider$abund
  colMat=matrix(rnorm(12*12),12,12)
  colMat<-colMat%*%t(colMat)
  dist=abs(colMat)
  colnames(dist)<-colnames(colMat)<-1:12
  
  expect_error({model<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),num.lv=0, sd.errors = FALSE)})
  
  colnames(colMat)<-row.names(colMat)<-colnames(dist)<-row.names(dist)<-colnames(spider$abund)
  expect_error({model<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=colMat,colMat.rho.struct="term",num.lv=0, sd.errors=FALSE)})
  
  expect_warning({model<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=colMat,Ab.struct="diagonal", num.lv=0, sd.errors = FALSE)})

  #trait models are not yet tested in the following, just basic infrastructure for phylogenetic rando effects
  suppressMessages(invisible(capture.output({
  model11<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="diagonal",Ab.struct.rank=12,beta0com=TRUE)
  model12<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="blockdiagonal",Ab.struct.rank=12,beta0com=TRUE)
  model13<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="MNdiagonal",Ab.struct.rank=12,beta0com=TRUE)
  model14<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="MNunstructured",Ab.struct.rank=12,beta0com=TRUE)
  model15<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="spblockdiagonal",Ab.struct.rank=12,beta0com=TRUE)
  model16<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="diagonalCL1",Ab.struct.rank=12,beta0com=TRUE)
  model17<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="CL1",Ab.struct.rank=12,beta0com=TRUE)
  model18<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="CL2",Ab.struct.rank=12,beta0com=TRUE)
  model19<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="unstructured",Ab.struct.rank=1e3,beta0com=TRUE)

  model21<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="diagonal",Ab.struct.rank=12,beta0com=TRUE)
  model22<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="blockdiagonal",Ab.struct.rank=12,beta0com=TRUE)
  model23<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="MNdiagonal",Ab.struct.rank=12,beta0com=TRUE)
  model24<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="MNunstructured",Ab.struct.rank=12,beta0com=TRUE)
  model25<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="spblockdiagonal",Ab.struct.rank=12,beta0com=TRUE)
  model26<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="diagonalCL1",Ab.struct.rank=12,beta0com=TRUE)
  model27<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="CL1",Ab.struct.rank=12,beta0com=TRUE)
  model28<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="CL2",Ab.struct.rank=12,beta0com=TRUE)
  model29<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="unstructured",Ab.struct.rank=1e3,beta0com=TRUE)

  model31<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="diagonal",Ab.struct.rank=1,beta0com=TRUE)
  model32<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="blockdiagonal",Ab.struct.rank=1,beta0com=TRUE)
  model33<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="MNdiagonal",Ab.struct.rank=1,beta0com=TRUE)
  model34<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="MNunstructured",Ab.struct.rank=1,beta0com=TRUE)
  model35<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="spblockdiagonal",Ab.struct.rank=1,beta0com=TRUE)
  model36<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="diagonalCL1",Ab.struct.rank=1,beta0com=TRUE)
  model37<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="CL1",Ab.struct.rank=1,beta0com=TRUE)
  model38<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="CL2",Ab.struct.rank=1,beta0com=TRUE)
  model39<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="single",Ab.struct="unstructured",Ab.struct.rank=1,beta0com=TRUE)

  model41<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="diagonal",Ab.struct.rank=1,beta0com=TRUE)
  model42<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="blockdiagonal",Ab.struct.rank=1,beta0com=TRUE)
  model43<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="MNdiagonal",Ab.struct.rank=1,beta0com=TRUE)
  model44<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="MNunstructured",Ab.struct.rank=1,beta0com=TRUE)
  model45<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="spblockdiagonal",Ab.struct.rank=1,beta0com=TRUE)
  model46<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="diagonalCL1",Ab.struct.rank=1,beta0com=TRUE)
  model47<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="CL1",Ab.struct.rank=1,beta0com=TRUE)
  model48<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="CL2",Ab.struct.rank=1,beta0com=TRUE)
  model49<-gllvm(spider$abund,X=spider$x,formula=~nocorr(ConWate+CovMoss|1),family="poisson",colMat=list(colMat,dist=dist),nn.colMat=3,num.lv=0,colMat.rho.struct="term",Ab.struct="unstructured",Ab.struct.rank=1,beta0com=TRUE)
  })))
  expect_true(is.finite(model11$logL))
  expect_true(is.finite(model12$logL))
  expect_true(is.finite(model13$logL))
  expect_true(is.finite(model14$logL))
  expect_true(is.finite(model15$logL))
  expect_true(is.finite(model16$logL))
  expect_true(is.finite(model17$logL))
  expect_true(is.finite(model18$logL))
  expect_true(is.finite(model19$logL))
  expect_true(is.finite(model21$logL))
  expect_true(is.finite(model22$logL))
  expect_true(is.finite(model23$logL))
  expect_true(is.finite(model24$logL))
  expect_true(is.finite(model25$logL))
  expect_true(is.finite(model26$logL))
  expect_true(is.finite(model27$logL))
  expect_true(is.finite(model28$logL))
  expect_true(is.finite(model29$logL))
  expect_true(is.finite(model31$logL))
  expect_true(is.finite(model32$logL))
  expect_true(is.finite(model33$logL))
  expect_true(is.finite(model34$logL))
  expect_true(is.finite(model35$logL))
  expect_true(is.finite(model36$logL))
  expect_true(is.finite(model37$logL))
  expect_true(is.finite(model38$logL))
  expect_true(is.finite(model39$logL))
  expect_true(is.finite(model41$logL))
  expect_true(is.finite(model42$logL))
  expect_true(is.finite(model43$logL))
  expect_true(is.finite(model44$logL))
  expect_true(is.finite(model45$logL))
  expect_true(is.finite(model46$logL))
  expect_true(is.finite(model47$logL))
  expect_true(is.finite(model48$logL))
  expect_true(is.finite(model49$logL))
  
})
JenniNiku/gllvm documentation built on Sept. 15, 2024, 9:53 a.m.