Skip to content

Commit

Permalink
More tests
Browse files Browse the repository at this point in the history
  • Loading branch information
kenkellner committed Jan 30, 2024
1 parent 2fcba4f commit 717c6c7
Show file tree
Hide file tree
Showing 4 changed files with 29 additions and 4 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: unmarked
Version: 1.4.1.9001
Date: 2024-01-23
Version: 1.4.1.9002
Date: 2024-01-30
Type: Package
Title: Models for Data from Unmarked Animals
Authors@R: c(
Expand Down
2 changes: 1 addition & 1 deletion R/mixedModelTools.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
# Generate required random effects info----------------------------------------
# Sort-of drop-in replacement for lme4::mkReTrms
get_reTrms <- function(formula, data, newdata=NULL){
get_reTrms <- function(formula, data){
if(!has_random(formula)){
stop("No random effect terms in formula", call.=FALSE)
}
Expand Down
Binary file modified tests/testthat/lme4_output.Rdata
Binary file not shown.
27 changes: 26 additions & 1 deletion tests/testthat/test_mixed_models.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
context("mixed model tools")
skip_on_cran()

test_that("get_reTrms matches lme4::mkReTrms", {

Expand Down Expand Up @@ -65,11 +66,35 @@ test_that("get_reTrms matches lme4::mkReTrms", {
expect_identical(r7$cnms, l7$cnms)
attributes(l7$flist)$assign <- NULL
expect_identical(r7$flist, l7$flist)

# Check that unused factor levels aren't dropped
dat2 <- data.frame(x = c(0.1, 0.2, -0.1),
group = factor(c("a","b","c"), levels=c("a","b","c","d")))
form8 <- ~x + (1|group)
#l8 <- lme4::mkReTrms(lme4::findbars(form8), dat2, drop.unused.levels=FALSE)
r8 <- get_reTrms(form8, dat2)
expect_identical(r8$Z, Matrix::t(l8$Zt))

# Check that get_Z handles newdata
form9 <- ~x + (x||group) + (1|id)
nd <- data.frame(x=c(0.5,1), group=c("e","d"), id=c("i","i"))
Z <- get_Z(form9, dat, newdata=nd)
expect_equivalent(as.matrix(Z), matrix(c(0,1,0,0,0.5,0,0,0,1,
1,0,0,1,0,0,0,0,1), nrow=2, byrow=T))

# New level
nd <- data.frame(x=c(0.5,1), group=c("a","d"), id=c("i","i"))
expect_error(get_Z(form9, dat, newdata=nd))

#save(l1,l2,l3,l4,l5,l6,l7, file='lme4_output.Rdata')
#save(l1,l2,l3,l4,l5,l6,l7,l8, file='lme4_output.Rdata')
})

test_that("get_reTrms errors correctly", {
set.seed(123)
dat <- data.frame(x = rnorm(20), y = rnorm(20), z = factor(sample(letters[1:3], 20, replace=T)),
group = factor(sample(letters[4:6], 20, replace=T)),
id = factor(sample(letters[7:9], 20, replace=T)))

form1 <- ~x + (x+z||group) + (y||id)
expect_error(get_reTrms(form1, dat))

Expand Down

0 comments on commit 717c6c7

Please sign in to comment.