Commit de4c0b08 authored by Chris Jewell's avatar Chris Jewell
Browse files

Added tests.

parent a16214b9
context("Test Dirichlet Process inference")
# A rather basic test of the DP is to detect 4 groups
# from Poisson simulated data. This test only checks the
# number of groups is correct, not the means of the groups.
test_that("Dirichlet process inference", {
# Test rpois(9, c(4,4,4,40,40,40,400,400,400,1000,1000,1000))
obs <- c(6L, 1L, 2L, 40L, 43L, 45L, 400L, 363L, 402L, 994L, 1026L, 994L)
mu <- DirichletProcessNode$new(theta = 10, s = rep(1,length(obs)), alpha = 0.1,
base = dgamma, shape = 1,
rate = 0.1, name = 'mu')
offset <- DataNode$new(rep(1, length(obs)), name='offset')
y <- PoissonNode$new(obs, lambda=mu, offset=offset, name = 'y')
upd <- PoisGammaDPUpdate$new(mu)
iter <- 1000
posterior <- matrix(nrow=iter, ncol=length(obs))
posterior[1,] <- mu$getData()
for(i in 2:1000) {
upd$update()
posterior[i,] <- mu$getData()
}
nGrp <- apply(posterior,1,function(x) length(unique(x)))
ux <- unique(nGrp)
m <- ux[which.max(tabulate(match(nGrp,ux)))]
expect_equal(m, 4)
})
context("Tests HaldDP model")
# Test data structure
dat <- structure(
list(
Human = c(7L, 1L, 13L, 19L, 41L, 42L, 23L, 17L),
ChickenA = c(0L, 2L, 0L, 4L, 36L, 1L, 5L, 6L),
ChickenB = c(1L,
0L, 0L, 0L, 15L, 27L, 21L, 0L),
ChickenC = c(0L, 2L, 0L, 0L,
23L, 7L, 13L, 0L),
Bovine = c(4L, 0L, 1L, 11L, 2L, 0L, 12L, 0L),
Ovine = c(1L, 0L, 0L, 18L, 2L, 0L, 22L, 0L),
Environment = c(0L,
1L, 0L, 1L, 16L, 0L, 1L, 0L),
Time = structure(
c(1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L),
.Label = "1",
class = "factor"
),
Location = structure(
c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L),
.Label = "A",
class = "factor"
),
Type = structure(
c(1L, 2L, 3L, 4L, 5L, 6L, 8L, 10L),
.Label = c("21",
"25", "38", "42", "45", "48", "5", "50", "51", "52"),
class = "factor"
)
),
.Names = c(
"Human",
"ChickenA",
"ChickenB",
"ChickenC",
"Bovine",
"Ovine",
"Environment",
"Time",
"Location",
"Type"
),
row.names = c(21L, 25L, 38L, 42L,
45L, 48L, 50L, 52L),
class = "data.frame"
)
# Test prevalence
k <- data.frame(
Value = rep(1, 6),
Source = colnames(campy[, 2:7]),
Time = rep("1", 6),
Location = rep("A", 6)
)
# Test priors
priors <-
list(
a_theta = 0.01,
b_theta = 0.00001,
a_alpha = 1,
a_r = 0.1
)
# Test suite
test_that("HaldDP model construction", {
skip("Skip whole model for now")
set.seed(1)
model <- HaldDP$new(
data = dat,
k = k,
priors = priors,
a_q = 0.1
)
model$fit_params(n_iter = 100,
burn_in = 0,
thin = 1)
sink("/dev/null")
model$update()
sink()
expect_equal_to_reference(model$summary(), "haldDPres.rds")
})
context("Check MH updaters")
# Poisson(10) distributed data
y <- c(15L, 11L, 8L, 7L, 13L, 4L, 12L, 9L, 6L, 10L, 16L, 11L, 8L,
18L, 10L, 14L, 9L, 6L, 4L, 9L, 14L, 10L, 5L, 11L, 13L, 6L, 9L,
16L, 11L, 8L, 8L, 13L, 11L, 11L, 13L, 18L, 12L, 13L, 12L, 7L,
7L, 13L, 9L, 11L, 14L, 13L, 7L, 13L, 10L, 11L, 11L, 10L, 4L,
16L, 10L, 9L, 14L, 10L, 8L, 11L, 9L, 15L, 13L, 14L, 12L, 10L,
12L, 8L, 8L, 5L, 11L, 11L, 12L, 5L, 11L, 8L, 16L, 11L, 9L, 11L,
9L, 9L, 13L, 11L, 14L, 9L, 6L, 10L, 13L, 8L, 10L, 4L, 5L, 7L,
4L, 15L, 5L, 14L, 15L, 7L)
test_that("AdaptiveSingleSiteMRW", {
shape <- DataNode$new(data=1, name='shape')
rate <- DataNode$new(data=0.1, name='rate')
lambda <- GammaNode$new(data=1, shape=shape,rate=rate, name='lambda')
offset <- DataNode$new(data=rep(1, length(y)), name='offset')
y <- PoissonNode$new(data=y, lambda=lambda, offset=offset, name='y')
upd <- AdaptiveSingleSiteMRW$new(lambda)
iter <- 2000
posterior <- numeric(iter)
posterior[1] <- lambda$getData()
for(i in 2:iter) {
upd$update()
posterior[i] <- lambda$getData()
}
pAlpha <- shape$getData() + sum(y$getData())
pBeta <- rate$getData() + length(y$getData())
expect_equal(mean(posterior[200:2000]), pAlpha/pBeta, tolerance=0.04)
expect_equal(var(posterior[200:2000]), pAlpha/pBeta^2, tolerance=0.03)
})
context("Tests queue")
test_that("Testing queue", {
q = queue()
for(i in 1:5) enqueue(q,i)
expect_equal(dequeue(q), 1)
expect_equal(dequeue(q), 2)
enqueue(q, 15)
expect_equal(dequeue(q), 3)
})
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment