tests/testthat/test_occuMulti.R
In rbchan/unmarked: Models for Data from Unmarked Animals
context("occuMulti fitting function")
skip_on_cran()
test_that("unmarkedFrameOccuMulti construction and methods work",{
y <- list(matrix(1:15,5,3),
matrix(1:15,5,3))
umf <- unmarkedFrameOccuMulti(y = y)
expect_is(umf, "unmarkedFrameOccuMulti")
out <- capture.output(umf)
expect_equal(out[2], "Only showing observation matrix for species 1.")
s <- capture.output(summary(umf))
expect_equal(s[4], "2 species: sp1 sp2 ")
# Check plot
pdf(NULL)
pl <- plot(umf)
expect_is(pl, "trellis")
dev.off()
# check subset
umf_sub <- umf[,1:2]
expect_equal(umf_sub@ylist[[1]], umf@ylist[[1]][,1:2])
})
test_that("occuMulti can fit simple models",{
y <- list(matrix(rep(1,10)[1:10],5,2),
matrix(rep(1,10)[1:10],5,2))
umf <- unmarkedFrameOccuMulti(y = y)
fm <- occuMulti(detformulas=rep("~1",2),
stateformulas=rep("~1",3), data = umf, se=FALSE)
#Probably should not be calling predict here b/c unit test
#but complicated to get actual occupancy prob otherwise
occ <- predict(fm,'state')$Predicted[1,1]
expect_equivalent(occ,1, tolerance = 1e-4)
detlist <- predict(fm,'det')
det <- sapply(detlist,function(x) x[1,1])
expect_equivalent(det, rep(1,length(detlist)), tolerance= 1e-4)
#Check fitList
expect_message(fl <- fitList(fm, fm))
expect_message(expect_warning(fl <- fitList(fm, fm, autoNames='formula')))
expect_message(expect_warning(fl <- fitList(fits=list(fm, fm), autoNames='formula')))
expect_is(fl,"unmarkedFitList")
expect_equivalent(length(fl@fits), 2)
#Check error when random effect in formula
expect_error(occuMulti(detformulas=rep("~1",2),
stateformulas=c("~(1|group)",rep("~1",2)), umf))
y <- list(matrix(rep(0,10)[1:10],5,2),
matrix(rep(0,10)[1:10],5,2))
umf <- unmarkedFrameOccuMulti(y = y)
fm <- occuMulti(detformulas=rep("~1",2),
stateformulas=rep("~1",3), data = umf, se=FALSE)
occ <- predict(fm,'state')$Predicted[1,1]
expect_equivalent(occ,0, tolerance = 1e-4)
detlist <- predict(fm,'det')
det <- sapply(detlist,function(x) x[1,1])
expect_equivalent(det, rep(0,length(detlist)), tolerance= 1e-4)
})
test_that("occuMulti can fit models with covariates",{
y <- list(matrix(rep(0:1,10)[1:10],5,2),
matrix(rep(0:1,10)[1:10],5,2))
set.seed(123)
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
stateformulas <- c('~occ_cov1','~occ_cov2','~occ_cov3')
detformulas <- c('~det_cov1','~det_cov2')
fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE)
occ <- fm['state']
det <- fm['det']
expect_equivalent(coef(occ), c(5.36630,0.79876,5.45492,-0.868451,9.21242,1.14561),
tolerance = 1e-4)
expect_equivalent(coef(det), c(-0.27586,-0.81837,-0.09537,0.42334), tolerance = 1e-4)
fit <- fitted(fm)
expect_equivalent(length(fit),2)
expect_equivalent(sapply(fit,function(x) x[1,1]),c(0.14954,0.30801), tol = 1e-4)
res <- residuals(fm)
expect_equivalent(length(res),2)
expect_equivalent(sapply(res,function(x) x[1,1]),c(-0.14954,-0.30801), tol= 1e-4)
gp <- getP(fm)
expect_equivalent(length(gp), 2)
expect_equivalent(dim(gp[[1]]), c(N,J))
# ranef
expect_error(ran <- ranef(fm))
ran <- ranef(fm, species=1)
expect_equal(bup(ran), rep(1,5))
#Check site cov can be used in detection formula
detformulas <- c('~occ_cov1','~det_cov2')
fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE)
expect_equivalent(coef(fm,'det')[2],3.355328e-05, tol=1e-4)
})
test_that("occuMulti can handle NAs",{
y <- list(matrix(rep(0:1,10)[1:10],5,2),
matrix(rep(0:1,10)[1:10],5,2))
set.seed(456)
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
stateformulas <- c('~occ_cov1','~occ_cov2','~occ_cov3')
detformulas <- c('~det_cov1','~det_cov2')
#Check error thrown when missing site covariates
occ_covsNA <- occ_covs
occ_covsNA[1,1] <- NA
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covsNA, obsCovs = det_covs)
expect_error(occuMulti(detformulas, stateformulas, data=umf, se=FALSE))
yna <- y
yna[[1]][1,1] <- NA
expect_warning(umf <- unmarkedFrameOccuMulti(y = yna, siteCovs = occ_covs, obsCovs = det_covs))
#Check correct answer given when missing detection
expect_warning(fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE))
expect_equivalent(coef(fm)[c(1,7)], c(6.63207,0.35323), tol= 1e-4)
fit <- fitted(fm)
expect_true(is.na(fit[[1]][1,1]))
res <- residuals(fm)
expect_true(is.na(res[[1]][1,1]))
gp <- getP(fm)
expect_true(is.na(gp[[1]][1,1]))
#Check error thrown when all detections are missing
yna[[1]][1,] <- NA
expect_warning(umf <- unmarkedFrameOccuMulti(y = yna, siteCovs = occ_covs, obsCovs = det_covs))
expect_error(occuMulti(detformulas, stateformulas, data=umf, se=FALSE))
#Check warning when missing covariate value on detection
det_covsNA <- det_covs
det_covsNA[1,1] <- NA
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covsNA)
expect_warning(occuMulti(detformulas,stateformulas,data=umf, se=FALSE))
})
test_that("occuMulti handles fixed 0 parameters",{
y <- list(matrix(rep(0:1,10)[1:10],5,2),
matrix(rep(0:1,10)[1:10],5,2))
set.seed(123)
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
stateformulas <- c('~occ_cov1','~occ_cov2','0')
detformulas <- c('~det_cov1','~det_cov2')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE)
occ <- fm['state']
expect_equivalent(length(coef(occ)),4)
expect_equivalent(coef(occ),c(12.26043,0.61183,12.41110,0.18764),tol=1e-4)
stateformulas <- c('~occ_cov1','~occ_cov2')
fm2 <- occuMulti(detformulas, stateformulas, data = umf, maxOrder=1,se=FALSE)
occ <- fm2['state']
expect_equivalent(length(coef(occ)),4)
expect_equivalent(coef(occ),c(12.26043,0.61183,12.41110,0.18764),tol=1e-4)
})
test_that("occuMulti predict method works",{
set.seed(123)
y <- list(matrix(rbinom(40,1,0.2),20,2),
matrix(rbinom(40,1,0.3),20,2))
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
stateformulas <- c('~occ_cov1','~occ_cov2','0')
detformulas <- c('~det_cov1','~det_cov2')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
fm <- occuMulti(detformulas, stateformulas, data = umf)
nul <- capture.output(prState <- predict(fm, type='state'))
expect_equivalent(sapply(prState,function(x) x[1,1]),
c(0.30807707,0.19287755,0.04734032,0.76785951),tol=0.05)
nul <- capture.output(prDet <- predict(fm, type='det'))
expect_equivalent(as.numeric(prDet$sp2[1,]),
c(0.190485,0.12201,0.0475270,0.525988), tol=1e-4)
#Check with newdata
nd <- siteCovs(umf)[1:2,]
nul <- capture.output(pr_nd <- predict(fm, type='state', newdata=nd)$Predicted)
expect_equivalent(pr_nd[,1],c(0.3080771,0.3196486), tol=1e-4)
nd <- siteCovs(umf)[1:2,]
nul <- capture.output(pr_nd <- predict(fm, type='state', newdata=nd, species=1, cond=2)$Predicted)
expect_equivalent(pr_nd,c(0.3858233,0.5402935), tol=1e-4)
#Make sure it works with newdata having only one row
nd <- siteCovs(umf)[1,]
nul <- capture.output(pr_nd <- predict(fm, type='state', newdata=nd)$Predicted)
expect_equivalent(pr_nd[,1],c(0.3080771), tol=1e-4)
nul <- capture.output(pr_nd <- predict(fm, type='state', newdata=nd, species=1, cond=2)$Predicted)
expect_equivalent(pr_nd,c(0.3858233), tol=1e-4)
stateformulas <- c('~1','~1','0')
detformulas <- c('~1','~det_cov2')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
fm <- occuMulti(detformulas, stateformulas, data = umf)
nul <- capture.output(prState <- predict(fm, type='state'))
expect_equivalent(sapply(prState,function(x) x[1,1]),
c(0.475928,0.25311741,0.01468389,0.85687218),tol=0.05)
nul <- capture.output(prDet <- predict(fm, type='det'))
expect_equivalent(as.numeric(prDet$sp2[1,]),
c(0.20494,0.11865,0.0582563,0.517888), tol=1e-4)
#Check predicting co-occurrence
nul <- capture_output({
nd <- siteCovs(umf)[1:2,]
pr_all <- predict(fm, type='state', se=F)$Predicted[1:2,1]
pr_nd <- predict(fm, type='state', newdata=nd, species=c(1,2))$Predicted
expect_equivalent(pr_nd,pr_all, tol=1e-4)
#Check with site cov in detection formula
stateformulas <- c('~occ_cov2','~1','0')
detformulas <- c('~occ_cov1','~det_cov2')
fm <- occuMulti(detformulas, stateformulas, data = umf)
pr_state_actual <- predict(fm, "state")
expect_equivalent(length(pr_state_actual), 4)
expect_equivalent(pr_state_actual$Predicted[1,1], 0.729927907, tol=1e-5)
expect_equivalent(nrow(pr_state_actual$Predicted), 20)
pr_det_actual <- predict(fm, "det")
expect_equivalent(length(pr_det_actual), 2)
expect_equivalent(pr_det_actual$sp1$Predicted[1], 0.1448311, tol=1e-5)
expect_equivalent(nrow(pr_det_actual$sp1), 20*2)
#with newdata
pr_state_nd <- predict(fm, "state", newdata=data.frame(occ_cov2=0))
expect_equivalent(length(pr_state_nd), 4)
expect_equivalent(pr_state_nd$Predicted[1,1], 0.7538309, tol=1e-5)
expect_equivalent(nrow(pr_state_nd$Predicted), 1)
pr_det_nd <- predict(fm, "det", newdata=data.frame(occ_cov1=0, det_cov2=0))
expect_equivalent(length(pr_det_nd), 2)
expect_equivalent(pr_state_nd$Predicted[1,1], 0.7538309, tol=1e-5)
expect_equivalent(nrow(pr_state_nd$Predicted), 1)
#With maxOrder set
stateformulas <- c('~occ_cov2','~1')
detformulas <- c('~occ_cov1','~det_cov2')
fm <- occuMulti(detformulas, stateformulas, data = umf, maxOrder=1)
pr_state <- predict(fm, "state")
expect_equivalent(length(pr_state), 4)
expect_equivalent(pr_state$Predicted[1,1], 0.729927907, tol=1e-5)
expect_equivalent(nrow(pr_state$Predicted), 20)
pr_state_nd <- predict(fm, "state", newdata=data.frame(occ_cov2=0))
expect_equivalent(length(pr_state_nd), 4)
expect_equivalent(pr_state_nd$Predicted[1,1], 0.7538309, tol=1e-5)
expect_equivalent(nrow(pr_state_nd$Predicted), 1)
pr_det <- predict(fm, "det")
expect_equivalent(length(pr_det), 2)
expect_equivalent(pr_det$sp1$Predicted[1], 0.1448311, tol=1e-5)
expect_equivalent(nrow(pr_det$sp1), 20*2)
pr_det_nd <- predict(fm, "det", newdata=data.frame(occ_cov1=0, det_cov2=0))
expect_equivalent(length(pr_det_nd), 2)
expect_equivalent(pr_state_nd$Predicted[1,1], 0.7538309, tol=1e-5)
expect_equivalent(nrow(pr_state_nd$Predicted), 1)
})
#getP with maxOrder set
gp <- getP(fm)
expect_equal(length(gp), 2)
expect_equal(dim(gp[[1]]), c(20,2))
#simulate with maxOrder set
s <- simulate(fm, 2)
expect_is(s, "list")
expect_equal(length(s), 2)
expect_equal(dim(s[[1]][[1]]), c(N, J))
#fitList with maxOrder set
fm2 <- occuMulti(c("~1","~1"), c("~1","~1"), umf, maxOrder=1)
expect_message(fl2 <- fitList(fm, fm2))
expect_is(fl2, "unmarkedFitList")
ms <- modSel(fl2)
expect_is(ms, "unmarkedModSel")
#fitted with maxOrder set
ft <- fitted(fm)
expect_equal(length(ft), 2)
#parboot with maxOrder set
pb <- parboot(fm, nsim=2)
expect_is(pb, "parboot")
})
test_that("occuMulti predict can handle NAs",{
set.seed(123)
y <- list(matrix(rbinom(40,1,0.2),20,2),
matrix(rbinom(40,1,0.3),20,2))
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
det_covs[1,1] <- NA
stateformulas <- c('~occ_cov1','~occ_cov2','0')
detformulas <- c('~det_cov1','~det_cov2')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
expect_warning(fm <- occuMulti(detformulas, stateformulas, data = umf))
prDet <- predict(fm, type='det')
expect_true(all(is.na(prDet$sp1[1,])))
expect_equivalent(as.numeric(prDet$sp1[2,]),
c(0.49781,0.19621,0.175514,0.8219401), tol=1e-4)
#Check that you can predict with NAs in siteCovs
nul <- capture_output({
newdata <- siteCovs(umf)
newdata[1,1] <- NA
prOcc <- predict(fm, type='state', newdata=newdata)
expect_true(all(is.na(prOcc$Predicted[1,])))
expect_true(all(!is.na(sapply(prOcc,`[`,2,1))))
prOcc_sp <- predict(fm, type='state', species=1, newdata=newdata)
expect_true(all(is.na(prOcc_sp[1,])))
expect_true(all(!is.na(prOcc_sp[2,])))
expect_equivalent(prOcc_sp$Predicted[2],0.4731427, tol=1e-4)
prOcc_cond <- predict(fm, type='state', species=1, cond=2, newdata=newdata)
expect_true(all(is.na(prOcc_cond[1,])))
expect_true(all(!is.na(prOcc_cond[2,])))
expect_equivalent(prOcc_sp$Predicted[2],0.4731427, tol=1e-4)
})
})
test_that("occuMulti can handle complex formulas",{
#Check scale(), etc
set.seed(123)
y <- list(matrix(rbinom(40,1,0.2),20,2),
matrix(rbinom(40,1,0.3),20,2))
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3, mean=2),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2, mean=3),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
stateformulas <- c('~scale(occ_cov1)','~1','0')
detformulas <- c('~scale(det_cov1)','~1')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
fm <- occuMulti(detformulas, stateformulas, data = umf)
nul <- capture_output({
#Check with newdata; contents of newdata should not
#effect resulting predictions (scale should be based on
#original data)
nd <- siteCovs(umf)[1:5,]
pr_nd <- predict(fm, type='state', newdata=nd, se=F)$Predicted
nd <- siteCovs(umf)[1:2,]
pr_nd2 <- predict(fm, type='state', newdata=nd, se=F)$Predicted
nd <- siteCovs(umf)[c(1,1),]
pr_nd3 <- predict(fm, type='state', newdata=nd, se=F)$Predicted
expect_equivalent(pr_nd[1:2,], pr_nd2)
expect_equivalent(pr_nd[c(1,1),], pr_nd3)
#Check for factor level handling
occ_covs$occ_fac <- factor(sample(c('a','b','c'),N,replace=T))
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
stateformulas <- c('~occ_fac','~1','~1')
fm <- occuMulti(detformulas, stateformulas, data = umf)
nd <- siteCovs(umf)[1:2,]
pr_nd <- predict(fm, type='state', newdata=nd, se=F)$Predicted
nd2 <- data.frame(occ_fac=factor(c('a','b'),levels=c('a','b','c')))
pr_nd2 <- predict(fm, type='state', newdata=nd2, se=F)$Predicted
expect_equivalent(pr_nd, pr_nd2[c(2,1),])
nd3 <- data.frame(occ_fac=c('a','b'))
pr_nd3 <- predict(fm, type='state', newdata=nd3, se=F)$Predicted
expect_equivalent(pr_nd, pr_nd3[c(2,1),])
nd4 <- data.frame(occ_fac=factor(c('a','d'),levels=c('a','d')))
expect_error(predict(fm, type='state', newdata=nd4, se=F))
#Check that predicting detection also works
nd5 <- data.frame(det_cov1 = rnorm(5))
pr_nd5 <- predict(fm, type='det', newdata=nd5)
expect_equivalent(sapply(pr_nd5, nrow), c(5,5))
expect_equivalent(pr_nd5$sp1$Predicted[1], 0.1680881)
})
})
test_that("occuMulti penalized likelihood works",{
set.seed(123)
N <- 100; nspecies <- 3; J <- 5
occ_covs <- as.data.frame(matrix(rnorm(N * 10),ncol=10))
names(occ_covs) <- paste('occ_cov',1:10,sep='')
det_covs <- list()
for (i in 1:nspecies){
det_covs[[i]] <- matrix(rnorm(N*J),nrow=N)
}
names(det_covs) <- paste('det_cov',1:nspecies,sep='')
#True vals
beta <- c(0.5,0.2,0.4,0.5,-0.1,-0.3,0.2,0.1,-1,0.1)
f1 <- beta[1] + beta[2]*occ_covs$occ_cov1
f2 <- beta[3] + beta[4]*occ_covs$occ_cov2
f3 <- beta[5] + beta[6]*occ_covs$occ_cov3
f4 <- beta[7]
f5 <- beta[8]
f6 <- beta[9]
f7 <- beta[10]
f <- cbind(f1,f2,f3,f4,f5,f6,f7)
z <- expand.grid(rep(list(1:0),nspecies))[,nspecies:1]
colnames(z) <- paste('sp',1:nspecies,sep='')
dm <- model.matrix(as.formula(paste0("~.^",nspecies,"-1")),z)
psi <- exp(f %*% t(dm))
psi <- psi/rowSums(psi)
#True state
ztruth <- matrix(NA,nrow=N,ncol=nspecies)
for (i in 1:N){
ztruth[i,] <- as.matrix(z[sample(8,1,prob=psi[i,]),])
}
p_true <- c(0.6,0.7,0.5)
y <- list()
for (i in 1:nspecies){
y[[i]] <- matrix(NA,N,J)
for (j in 1:N){
for (k in 1:J){
y[[i]][j,k] <- rbinom(1,1,ztruth[j,i]*p_true[i])
}
}
}
names(y) <- c('coyote','tiger','bear')
umf = unmarkedFrameOccuMulti(y=y,siteCovs=occ_covs,obsCovs=det_covs)
occFormulas <- c('~occ_cov1','~occ_cov2','~occ_cov3','~1','~1','~1','~1')
detFormulas <- c('~1','~1','~1')
nul <- capture_output({
fm <- occuMulti(detFormulas,occFormulas,umf)
fm_pen <- occuMulti(detFormulas, occFormulas, data = umf, penalty=1, boot=5)
expect_equivalent(coef(fm_pen)[c(1,5)], c(0.5014605, -0.1078711), tol=1e-5)
expect_equivalent(length(fm_pen@bootstrapSamples), 5)
expect_equivalent(vcov(fm_pen), fm_pen@covMatBS)
expect_equivalent(fm_pen@estimates@estimates$state@covMat,
fm_pen@estimates@estimates$state@covMatBS)
set.seed(123)
opt_fit <- optimizePenalty(fm, penalties=c(0,1), boot=2)
expect_equal(opt_fit@call$penalty, 1)
ll <- unmarked:::occuMultiLogLik(fm, fm@data)
expect_equal(length(ll), numSites(fm@data))
expect_equal(-sum(ll), fm@negLogLike)
})
})
test_that("Mismatched NAs are identified in unmarkedFrameOccuMulti",{
y1 <- matrix(rbinom(10,1,0.5), nrow=5)
y1[1,1] <- NA
y2 <- matrix(rbinom(10,1,0.5), nrow=5)
y2[1,1] <- NA
y3 <- matrix(rbinom(10,1,0.5), nrow=5)
y3[1,1] <- NA
y3[5,1] <- NA
ylist <- list(y1=y1,y2=y2,y3=y3)
expect_warning(umf <- unmarkedFrameOccuMulti(y=ylist))
pre_na <- sapply(ylist, function(x) sum(is.na(x)))
post_na <- sapply(umf@ylist, function(x) sum(is.na(x)))
expect_true(any(pre_na[1] != pre_na))
expect_true(!any(post_na[1] != post_na))
})
test_that("R and C++ engines give same results",{
y <- list(matrix(rep(0:1,10)[1:10],5,2),
matrix(rep(0:1,10)[1:10],5,2))
set.seed(123)
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
stateformulas <- c('~occ_cov1','~occ_cov2','~occ_cov3')
detformulas <- c('~det_cov1','~det_cov2')
fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE,
control=list(maxit=1))
fmR <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE,
engine="R",control=list(maxit=1))
expect_equal(coef(fm), coef(fmR))
})
rbchan/unmarked documentation built on April 3, 2024, 10:11 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("occuMulti fitting function")
skip_on_cran()
test_that("unmarkedFrameOccuMulti construction and methods work",{
y <- list(matrix(1:15,5,3),
matrix(1:15,5,3))
umf <- unmarkedFrameOccuMulti(y = y)
expect_is(umf, "unmarkedFrameOccuMulti")
out <- capture.output(umf)
expect_equal(out[2], "Only showing observation matrix for species 1.")
s <- capture.output(summary(umf))
expect_equal(s[4], "2 species: sp1 sp2 ")
# Check plot
pdf(NULL)
pl <- plot(umf)
expect_is(pl, "trellis")
dev.off()
# check subset
umf_sub <- umf[,1:2]
expect_equal(umf_sub@ylist[[1]], umf@ylist[[1]][,1:2])
})
test_that("occuMulti can fit simple models",{
y <- list(matrix(rep(1,10)[1:10],5,2),
matrix(rep(1,10)[1:10],5,2))
umf <- unmarkedFrameOccuMulti(y = y)
fm <- occuMulti(detformulas=rep("~1",2),
stateformulas=rep("~1",3), data = umf, se=FALSE)
#Probably should not be calling predict here b/c unit test
#but complicated to get actual occupancy prob otherwise
occ <- predict(fm,'state')$Predicted[1,1]
expect_equivalent(occ,1, tolerance = 1e-4)
detlist <- predict(fm,'det')
det <- sapply(detlist,function(x) x[1,1])
expect_equivalent(det, rep(1,length(detlist)), tolerance= 1e-4)
#Check fitList
expect_message(fl <- fitList(fm, fm))
expect_message(expect_warning(fl <- fitList(fm, fm, autoNames='formula')))
expect_message(expect_warning(fl <- fitList(fits=list(fm, fm), autoNames='formula')))
expect_is(fl,"unmarkedFitList")
expect_equivalent(length(fl@fits), 2)
#Check error when random effect in formula
expect_error(occuMulti(detformulas=rep("~1",2),
stateformulas=c("~(1|group)",rep("~1",2)), umf))
y <- list(matrix(rep(0,10)[1:10],5,2),
matrix(rep(0,10)[1:10],5,2))
umf <- unmarkedFrameOccuMulti(y = y)
fm <- occuMulti(detformulas=rep("~1",2),
stateformulas=rep("~1",3), data = umf, se=FALSE)
occ <- predict(fm,'state')$Predicted[1,1]
expect_equivalent(occ,0, tolerance = 1e-4)
detlist <- predict(fm,'det')
det <- sapply(detlist,function(x) x[1,1])
expect_equivalent(det, rep(0,length(detlist)), tolerance= 1e-4)
})
test_that("occuMulti can fit models with covariates",{
y <- list(matrix(rep(0:1,10)[1:10],5,2),
matrix(rep(0:1,10)[1:10],5,2))
set.seed(123)
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
stateformulas <- c('~occ_cov1','~occ_cov2','~occ_cov3')
detformulas <- c('~det_cov1','~det_cov2')
fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE)
occ <- fm['state']
det <- fm['det']
expect_equivalent(coef(occ), c(5.36630,0.79876,5.45492,-0.868451,9.21242,1.14561),
tolerance = 1e-4)
expect_equivalent(coef(det), c(-0.27586,-0.81837,-0.09537,0.42334), tolerance = 1e-4)
fit <- fitted(fm)
expect_equivalent(length(fit),2)
expect_equivalent(sapply(fit,function(x) x[1,1]),c(0.14954,0.30801), tol = 1e-4)
res <- residuals(fm)
expect_equivalent(length(res),2)
expect_equivalent(sapply(res,function(x) x[1,1]),c(-0.14954,-0.30801), tol= 1e-4)
gp <- getP(fm)
expect_equivalent(length(gp), 2)
expect_equivalent(dim(gp[[1]]), c(N,J))
# ranef
expect_error(ran <- ranef(fm))
ran <- ranef(fm, species=1)
expect_equal(bup(ran), rep(1,5))
#Check site cov can be used in detection formula
detformulas <- c('~occ_cov1','~det_cov2')
fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE)
expect_equivalent(coef(fm,'det')[2],3.355328e-05, tol=1e-4)
})
test_that("occuMulti can handle NAs",{
y <- list(matrix(rep(0:1,10)[1:10],5,2),
matrix(rep(0:1,10)[1:10],5,2))
set.seed(456)
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
stateformulas <- c('~occ_cov1','~occ_cov2','~occ_cov3')
detformulas <- c('~det_cov1','~det_cov2')
#Check error thrown when missing site covariates
occ_covsNA <- occ_covs
occ_covsNA[1,1] <- NA
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covsNA, obsCovs = det_covs)
expect_error(occuMulti(detformulas, stateformulas, data=umf, se=FALSE))
yna <- y
yna[[1]][1,1] <- NA
expect_warning(umf <- unmarkedFrameOccuMulti(y = yna, siteCovs = occ_covs, obsCovs = det_covs))
#Check correct answer given when missing detection
expect_warning(fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE))
expect_equivalent(coef(fm)[c(1,7)], c(6.63207,0.35323), tol= 1e-4)
fit <- fitted(fm)
expect_true(is.na(fit[[1]][1,1]))
res <- residuals(fm)
expect_true(is.na(res[[1]][1,1]))
gp <- getP(fm)
expect_true(is.na(gp[[1]][1,1]))
#Check error thrown when all detections are missing
yna[[1]][1,] <- NA
expect_warning(umf <- unmarkedFrameOccuMulti(y = yna, siteCovs = occ_covs, obsCovs = det_covs))
expect_error(occuMulti(detformulas, stateformulas, data=umf, se=FALSE))
#Check warning when missing covariate value on detection
det_covsNA <- det_covs
det_covsNA[1,1] <- NA
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covsNA)
expect_warning(occuMulti(detformulas,stateformulas,data=umf, se=FALSE))
})
test_that("occuMulti handles fixed 0 parameters",{
y <- list(matrix(rep(0:1,10)[1:10],5,2),
matrix(rep(0:1,10)[1:10],5,2))
set.seed(123)
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
stateformulas <- c('~occ_cov1','~occ_cov2','0')
detformulas <- c('~det_cov1','~det_cov2')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE)
occ <- fm['state']
expect_equivalent(length(coef(occ)),4)
expect_equivalent(coef(occ),c(12.26043,0.61183,12.41110,0.18764),tol=1e-4)
stateformulas <- c('~occ_cov1','~occ_cov2')
fm2 <- occuMulti(detformulas, stateformulas, data = umf, maxOrder=1,se=FALSE)
occ <- fm2['state']
expect_equivalent(length(coef(occ)),4)
expect_equivalent(coef(occ),c(12.26043,0.61183,12.41110,0.18764),tol=1e-4)
})
test_that("occuMulti predict method works",{
set.seed(123)
y <- list(matrix(rbinom(40,1,0.2),20,2),
matrix(rbinom(40,1,0.3),20,2))
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
stateformulas <- c('~occ_cov1','~occ_cov2','0')
detformulas <- c('~det_cov1','~det_cov2')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
fm <- occuMulti(detformulas, stateformulas, data = umf)
nul <- capture.output(prState <- predict(fm, type='state'))
expect_equivalent(sapply(prState,function(x) x[1,1]),
c(0.30807707,0.19287755,0.04734032,0.76785951),tol=0.05)
nul <- capture.output(prDet <- predict(fm, type='det'))
expect_equivalent(as.numeric(prDet$sp2[1,]),
c(0.190485,0.12201,0.0475270,0.525988), tol=1e-4)
#Check with newdata
nd <- siteCovs(umf)[1:2,]
nul <- capture.output(pr_nd <- predict(fm, type='state', newdata=nd)$Predicted)
expect_equivalent(pr_nd[,1],c(0.3080771,0.3196486), tol=1e-4)
nd <- siteCovs(umf)[1:2,]
nul <- capture.output(pr_nd <- predict(fm, type='state', newdata=nd, species=1, cond=2)$Predicted)
expect_equivalent(pr_nd,c(0.3858233,0.5402935), tol=1e-4)
#Make sure it works with newdata having only one row
nd <- siteCovs(umf)[1,]
nul <- capture.output(pr_nd <- predict(fm, type='state', newdata=nd)$Predicted)
expect_equivalent(pr_nd[,1],c(0.3080771), tol=1e-4)
nul <- capture.output(pr_nd <- predict(fm, type='state', newdata=nd, species=1, cond=2)$Predicted)
expect_equivalent(pr_nd,c(0.3858233), tol=1e-4)
stateformulas <- c('~1','~1','0')
detformulas <- c('~1','~det_cov2')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
fm <- occuMulti(detformulas, stateformulas, data = umf)
nul <- capture.output(prState <- predict(fm, type='state'))
expect_equivalent(sapply(prState,function(x) x[1,1]),
c(0.475928,0.25311741,0.01468389,0.85687218),tol=0.05)
nul <- capture.output(prDet <- predict(fm, type='det'))
expect_equivalent(as.numeric(prDet$sp2[1,]),
c(0.20494,0.11865,0.0582563,0.517888), tol=1e-4)
#Check predicting co-occurrence
nul <- capture_output({
nd <- siteCovs(umf)[1:2,]
pr_all <- predict(fm, type='state', se=F)$Predicted[1:2,1]
pr_nd <- predict(fm, type='state', newdata=nd, species=c(1,2))$Predicted
expect_equivalent(pr_nd,pr_all, tol=1e-4)
#Check with site cov in detection formula
stateformulas <- c('~occ_cov2','~1','0')
detformulas <- c('~occ_cov1','~det_cov2')
fm <- occuMulti(detformulas, stateformulas, data = umf)
pr_state_actual <- predict(fm, "state")
expect_equivalent(length(pr_state_actual), 4)
expect_equivalent(pr_state_actual$Predicted[1,1], 0.729927907, tol=1e-5)
expect_equivalent(nrow(pr_state_actual$Predicted), 20)
pr_det_actual <- predict(fm, "det")
expect_equivalent(length(pr_det_actual), 2)
expect_equivalent(pr_det_actual$sp1$Predicted[1], 0.1448311, tol=1e-5)
expect_equivalent(nrow(pr_det_actual$sp1), 20*2)
#with newdata
pr_state_nd <- predict(fm, "state", newdata=data.frame(occ_cov2=0))
expect_equivalent(length(pr_state_nd), 4)
expect_equivalent(pr_state_nd$Predicted[1,1], 0.7538309, tol=1e-5)
expect_equivalent(nrow(pr_state_nd$Predicted), 1)
pr_det_nd <- predict(fm, "det", newdata=data.frame(occ_cov1=0, det_cov2=0))
expect_equivalent(length(pr_det_nd), 2)
expect_equivalent(pr_state_nd$Predicted[1,1], 0.7538309, tol=1e-5)
expect_equivalent(nrow(pr_state_nd$Predicted), 1)
#With maxOrder set
stateformulas <- c('~occ_cov2','~1')
detformulas <- c('~occ_cov1','~det_cov2')
fm <- occuMulti(detformulas, stateformulas, data = umf, maxOrder=1)
pr_state <- predict(fm, "state")
expect_equivalent(length(pr_state), 4)
expect_equivalent(pr_state$Predicted[1,1], 0.729927907, tol=1e-5)
expect_equivalent(nrow(pr_state$Predicted), 20)
pr_state_nd <- predict(fm, "state", newdata=data.frame(occ_cov2=0))
expect_equivalent(length(pr_state_nd), 4)
expect_equivalent(pr_state_nd$Predicted[1,1], 0.7538309, tol=1e-5)
expect_equivalent(nrow(pr_state_nd$Predicted), 1)
pr_det <- predict(fm, "det")
expect_equivalent(length(pr_det), 2)
expect_equivalent(pr_det$sp1$Predicted[1], 0.1448311, tol=1e-5)
expect_equivalent(nrow(pr_det$sp1), 20*2)
pr_det_nd <- predict(fm, "det", newdata=data.frame(occ_cov1=0, det_cov2=0))
expect_equivalent(length(pr_det_nd), 2)
expect_equivalent(pr_state_nd$Predicted[1,1], 0.7538309, tol=1e-5)
expect_equivalent(nrow(pr_state_nd$Predicted), 1)
})
#getP with maxOrder set
gp <- getP(fm)
expect_equal(length(gp), 2)
expect_equal(dim(gp[[1]]), c(20,2))
#simulate with maxOrder set
s <- simulate(fm, 2)
expect_is(s, "list")
expect_equal(length(s), 2)
expect_equal(dim(s[[1]][[1]]), c(N, J))
#fitList with maxOrder set
fm2 <- occuMulti(c("~1","~1"), c("~1","~1"), umf, maxOrder=1)
expect_message(fl2 <- fitList(fm, fm2))
expect_is(fl2, "unmarkedFitList")
ms <- modSel(fl2)
expect_is(ms, "unmarkedModSel")
#fitted with maxOrder set
ft <- fitted(fm)
expect_equal(length(ft), 2)
#parboot with maxOrder set
pb <- parboot(fm, nsim=2)
expect_is(pb, "parboot")
})
test_that("occuMulti predict can handle NAs",{
set.seed(123)
y <- list(matrix(rbinom(40,1,0.2),20,2),
matrix(rbinom(40,1,0.3),20,2))
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
det_covs[1,1] <- NA
stateformulas <- c('~occ_cov1','~occ_cov2','0')
detformulas <- c('~det_cov1','~det_cov2')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
expect_warning(fm <- occuMulti(detformulas, stateformulas, data = umf))
prDet <- predict(fm, type='det')
expect_true(all(is.na(prDet$sp1[1,])))
expect_equivalent(as.numeric(prDet$sp1[2,]),
c(0.49781,0.19621,0.175514,0.8219401), tol=1e-4)
#Check that you can predict with NAs in siteCovs
nul <- capture_output({
newdata <- siteCovs(umf)
newdata[1,1] <- NA
prOcc <- predict(fm, type='state', newdata=newdata)
expect_true(all(is.na(prOcc$Predicted[1,])))
expect_true(all(!is.na(sapply(prOcc,`[`,2,1))))
prOcc_sp <- predict(fm, type='state', species=1, newdata=newdata)
expect_true(all(is.na(prOcc_sp[1,])))
expect_true(all(!is.na(prOcc_sp[2,])))
expect_equivalent(prOcc_sp$Predicted[2],0.4731427, tol=1e-4)
prOcc_cond <- predict(fm, type='state', species=1, cond=2, newdata=newdata)
expect_true(all(is.na(prOcc_cond[1,])))
expect_true(all(!is.na(prOcc_cond[2,])))
expect_equivalent(prOcc_sp$Predicted[2],0.4731427, tol=1e-4)
})
})
test_that("occuMulti can handle complex formulas",{
#Check scale(), etc
set.seed(123)
y <- list(matrix(rbinom(40,1,0.2),20,2),
matrix(rbinom(40,1,0.3),20,2))
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3, mean=2),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2, mean=3),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
stateformulas <- c('~scale(occ_cov1)','~1','0')
detformulas <- c('~scale(det_cov1)','~1')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
fm <- occuMulti(detformulas, stateformulas, data = umf)
nul <- capture_output({
#Check with newdata; contents of newdata should not
#effect resulting predictions (scale should be based on
#original data)
nd <- siteCovs(umf)[1:5,]
pr_nd <- predict(fm, type='state', newdata=nd, se=F)$Predicted
nd <- siteCovs(umf)[1:2,]
pr_nd2 <- predict(fm, type='state', newdata=nd, se=F)$Predicted
nd <- siteCovs(umf)[c(1,1),]
pr_nd3 <- predict(fm, type='state', newdata=nd, se=F)$Predicted
expect_equivalent(pr_nd[1:2,], pr_nd2)
expect_equivalent(pr_nd[c(1,1),], pr_nd3)
#Check for factor level handling
occ_covs$occ_fac <- factor(sample(c('a','b','c'),N,replace=T))
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
stateformulas <- c('~occ_fac','~1','~1')
fm <- occuMulti(detformulas, stateformulas, data = umf)
nd <- siteCovs(umf)[1:2,]
pr_nd <- predict(fm, type='state', newdata=nd, se=F)$Predicted
nd2 <- data.frame(occ_fac=factor(c('a','b'),levels=c('a','b','c')))
pr_nd2 <- predict(fm, type='state', newdata=nd2, se=F)$Predicted
expect_equivalent(pr_nd, pr_nd2[c(2,1),])
nd3 <- data.frame(occ_fac=c('a','b'))
pr_nd3 <- predict(fm, type='state', newdata=nd3, se=F)$Predicted
expect_equivalent(pr_nd, pr_nd3[c(2,1),])
nd4 <- data.frame(occ_fac=factor(c('a','d'),levels=c('a','d')))
expect_error(predict(fm, type='state', newdata=nd4, se=F))
#Check that predicting detection also works
nd5 <- data.frame(det_cov1 = rnorm(5))
pr_nd5 <- predict(fm, type='det', newdata=nd5)
expect_equivalent(sapply(pr_nd5, nrow), c(5,5))
expect_equivalent(pr_nd5$sp1$Predicted[1], 0.1680881)
})
})
test_that("occuMulti penalized likelihood works",{
set.seed(123)
N <- 100; nspecies <- 3; J <- 5
occ_covs <- as.data.frame(matrix(rnorm(N * 10),ncol=10))
names(occ_covs) <- paste('occ_cov',1:10,sep='')
det_covs <- list()
for (i in 1:nspecies){
det_covs[[i]] <- matrix(rnorm(N*J),nrow=N)
}
names(det_covs) <- paste('det_cov',1:nspecies,sep='')
#True vals
beta <- c(0.5,0.2,0.4,0.5,-0.1,-0.3,0.2,0.1,-1,0.1)
f1 <- beta[1] + beta[2]*occ_covs$occ_cov1
f2 <- beta[3] + beta[4]*occ_covs$occ_cov2
f3 <- beta[5] + beta[6]*occ_covs$occ_cov3
f4 <- beta[7]
f5 <- beta[8]
f6 <- beta[9]
f7 <- beta[10]
f <- cbind(f1,f2,f3,f4,f5,f6,f7)
z <- expand.grid(rep(list(1:0),nspecies))[,nspecies:1]
colnames(z) <- paste('sp',1:nspecies,sep='')
dm <- model.matrix(as.formula(paste0("~.^",nspecies,"-1")),z)
psi <- exp(f %*% t(dm))
psi <- psi/rowSums(psi)
#True state
ztruth <- matrix(NA,nrow=N,ncol=nspecies)
for (i in 1:N){
ztruth[i,] <- as.matrix(z[sample(8,1,prob=psi[i,]),])
}
p_true <- c(0.6,0.7,0.5)
y <- list()
for (i in 1:nspecies){
y[[i]] <- matrix(NA,N,J)
for (j in 1:N){
for (k in 1:J){
y[[i]][j,k] <- rbinom(1,1,ztruth[j,i]*p_true[i])
}
}
}
names(y) <- c('coyote','tiger','bear')
umf = unmarkedFrameOccuMulti(y=y,siteCovs=occ_covs,obsCovs=det_covs)
occFormulas <- c('~occ_cov1','~occ_cov2','~occ_cov3','~1','~1','~1','~1')
detFormulas <- c('~1','~1','~1')
nul <- capture_output({
fm <- occuMulti(detFormulas,occFormulas,umf)
fm_pen <- occuMulti(detFormulas, occFormulas, data = umf, penalty=1, boot=5)
expect_equivalent(coef(fm_pen)[c(1,5)], c(0.5014605, -0.1078711), tol=1e-5)
expect_equivalent(length(fm_pen@bootstrapSamples), 5)
expect_equivalent(vcov(fm_pen), fm_pen@covMatBS)
expect_equivalent(fm_pen@estimates@estimates$state@covMat,
fm_pen@estimates@estimates$state@covMatBS)
set.seed(123)
opt_fit <- optimizePenalty(fm, penalties=c(0,1), boot=2)
expect_equal(opt_fit@call$penalty, 1)
ll <- unmarked:::occuMultiLogLik(fm, fm@data)
expect_equal(length(ll), numSites(fm@data))
expect_equal(-sum(ll), fm@negLogLike)
})
})
test_that("Mismatched NAs are identified in unmarkedFrameOccuMulti",{
y1 <- matrix(rbinom(10,1,0.5), nrow=5)
y1[1,1] <- NA
y2 <- matrix(rbinom(10,1,0.5), nrow=5)
y2[1,1] <- NA
y3 <- matrix(rbinom(10,1,0.5), nrow=5)
y3[1,1] <- NA
y3[5,1] <- NA
ylist <- list(y1=y1,y2=y2,y3=y3)
expect_warning(umf <- unmarkedFrameOccuMulti(y=ylist))
pre_na <- sapply(ylist, function(x) sum(is.na(x)))
post_na <- sapply(umf@ylist, function(x) sum(is.na(x)))
expect_true(any(pre_na[1] != pre_na))
expect_true(!any(post_na[1] != post_na))
})
test_that("R and C++ engines give same results",{
y <- list(matrix(rep(0:1,10)[1:10],5,2),
matrix(rep(0:1,10)[1:10],5,2))
set.seed(123)
N <- dim(y[[1]])[1]
J <- dim(y[[1]])[2]
occ_covs <- as.data.frame(matrix(rnorm(N * 3),ncol=3))
names(occ_covs) <- paste('occ_cov',1:3,sep='')
det_covs <- as.data.frame(matrix(rnorm(N*J*2),ncol=2))
names(det_covs) <- paste('det_cov',1:2,sep='')
umf <- unmarkedFrameOccuMulti(y = y, siteCovs = occ_covs, obsCovs = det_covs)
stateformulas <- c('~occ_cov1','~occ_cov2','~occ_cov3')
detformulas <- c('~det_cov1','~det_cov2')
fm <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE,
control=list(maxit=1))
fmR <- occuMulti(detformulas, stateformulas, data = umf, se=FALSE,
engine="R",control=list(maxit=1))
expect_equal(coef(fm), coef(fmR))
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.