.Rhistory

expect_true(all(dim(out) == c(10, 4)))
# test names
expect_true(all(names(as.data.frame(out)) == c("mu", "n_traditional_1",
"n_traditional_2", "n_eDNA")))
# test numeric
expect_true(all(is.numeric(out[, 1]),
is.numeric(out[, 2]),
is.numeric(out[, 3]),
is.numeric(out[, 4])), TRUE)
# test plot
out_plot <- detection_plot(fit$model, mu_min = 0.1, mu_max = 1)
# test plot type
expect_equal(mode(out_plot), "list")
# test data in plot
expect_equal(all(is.numeric(out_plot$data$mu),
is.character(out_plot$data$survey_type),
is.numeric(out_plot$data$value)), TRUE)
})
# constants
nsite <- 20
nobs_count <- 100
nobs_pcr <- 8
# params
mu <- rlnorm(nsite, meanlog = log(1), sdlog = 1)
beta <- 0.5
log_p10 <- -4.5
q <- 2
phi <- 1.2
# traditional type
count_type <- cbind(matrix(1, nrow = nsite, ncol = nobs_count / 2),
matrix(2, nrow = nsite, ncol = nobs_count / 2))
# count
count <- matrix(NA, nrow = nsite, ncol = nobs_count)
for (i in 1:nsite) {
for (j in 1:nobs_count) {
if (count_type[i, j] == 1) {
count[i, j] <- rnbinom(n = 1, mu = mu[i], size = phi)
} else {
count[i, j] <- rnbinom(n = 1, mu = mu[i] * q, size = phi)
}
}
}
# p11 (probability of true positive eDNA detection) and p (probability
# of eDNA detection)
p11 <- rep(NA, nsite)
p <- rep(NA, nsite)
for (i in 1:nsite) {
p11[i] <- mu[i] / (mu[i] + exp(beta))
p[i] <- min(p11[i] + exp(log_p10), 1)
}
# pcr_n (# qPCR observations)
pcr_n <- matrix(nobs_pcr, nrow = nsite, ncol = nobs_pcr)
# pcr_k (# positive qPCR detections)
pcr_k <- matrix(NA, nrow = nsite, ncol = nobs_pcr)
for (i in 1:nsite) {
pcr_k[i, ] <- rbinom(nobs_pcr, pcr_n[i, ], rep(p[i], nobs_pcr))
}
# collect data
data <- list(
pcr_n = pcr_n,
pcr_k = pcr_k,
count = count,
count_type = count_type
)
# initial values
inits <- list()
inits[[1]] <- list(
mu = mu,
p10 = exp(log_p10),
alpha = beta,
phi = phi,
q = q
)
names(inits[[1]]) <- c("mu", "p10", "alpha", "phi", "q")
# run model
fit <- suppressWarnings({
joint_model(data = data, q = TRUE, family = "negbin",
initial_values = inits, n_warmup = 25, n_iter = 100,
n_chain = 1, multicore = FALSE, seed = 10)
})
# get output params
output_params <- rownames(as.data.frame(joint_summarize(fit$model)))
# test expectation
expect_true(all(c("p10", "q[1]", "phi", "alpha[1]") %in% output_params))
# test expectation
expect_true(fit$model@par_dims$phi == 1)
# detection_calculate and detection_plot
out <- detection_calculate(fit$model, mu = seq(from = 0.1, to = 1, by = 0.1))
# test dimensions
expect_true(all(dim(out) == c(10, 4)))
# test names
expect_true(all(names(as.data.frame(out)) == c("mu", "n_traditional_1",
"n_traditional_2", "n_eDNA")))
# test numeric
expect_true(all(is.numeric(out[, 1]),
is.numeric(out[, 2]),
is.numeric(out[, 3]),
is.numeric(out[, 4])), TRUE)
# test plot
out_plot <- detection_plot(fit$model, mu_min = 0.1, mu_max = 1)
devtools::load_all()
# test plot
out_plot <- detection_plot(fit$model, mu_min = 0.1, mu_max = 1)
# test plot type
expect_equal(mode(out_plot), "list")
# test data in plot
expect_equal(all(is.numeric(out_plot$data$mu),
is.character(out_plot$data$survey_type),
is.numeric(out_plot$data$value)), TRUE)
## 17.
# model, pois (traditional model)
# constants
nsite <- 20
nobs_count <- 100
# params
mu <- rlnorm(nsite, meanlog = log(1), sdlog = 1)
# count
count <- matrix(NA, nrow = nsite, ncol = nobs_count)
for (i in 1:nsite) {
count[i, ] <- rpois(n = nobs_count, mu[i])
}
# collect data
data <- list(
count = count
)
# initial values
inits <- list()
inits[[1]] <- list(
mu = mu
)
names(inits[[1]]) <- c("mu")
# run model
fit <- suppressWarnings({
traditional_model(data = data, n_chain = 1, multicore = FALSE, seed = 10,
initial_values = inits, n_warmup = 25, n_iter = 100)
})
# get output params
output_params <- rownames(as.data.frame(joint_summarize(fit$model)))
# test expectation
expect_true(all(!c("p10", "alpha[1]", "q", "phi") %in% output_params))
# test expectation
expect_true(fit$model@par_dims$phi == 0)
# detection_calculate and detection_plot
out <- detection_calculate(fit$model, mu = seq(from = 0.1, to = 1, by = 0.1))
# test dimensions
expect_true(all(dim(out) == c(10, 2)))
# test names
expect_true(all(names(as.data.frame(out)) == c("mu", "n_traditional")))
# test numeric
expect_true(all(is.numeric(out[, 1]),
is.numeric(out[, 2])), TRUE)
# test plot
out_plot <- detection_plot(fit$model, mu_min = 0.1,
mu_max = 1)
# test plot type
expect_equal(mode(out_plot), "list")
# test data in plot
expect_equal(all(is.numeric(out_plot$data$mu),
is.character(out_plot$data$survey_type),
is.numeric(out_plot$data$value)), TRUE)
# run joint model to do tests with
model1 <- suppressWarnings({
joint_model(data = goby_data, cov = c("Filter_time", "Salinity"),
multicore = FALSE, n_chain = 1,
n_warmup = 25, n_iter = 100)
})
model2 <- suppressWarnings({
traditional_model(data = goby_data, multicore = FALSE,
n_chain = 1, n_warmup = 25, n_iter = 100)
})
model3 <- suppressWarnings({
joint_model(data = green_crab_data, family = "negbin", multicore = FALSE,
n_chain = 1, n_warmup = 25, n_iter = 100)
})
#1. make sure model fit is of class stanfit
expect_error(mu_critical(as.matrix(model1$model), cov_val = c(0, 0)),
"model_fit must be of class 'stanfit'.")
#2. make sure ci is valid
expect_error(mu_critical(model1$model, ci = 1, cov_val = c(0, 0)),
"ci must be a numeric value >0 and <1.")
#3. make sure model fit contains p10 parameter
expect_error(mu_critical(model2$model),
"modelfit must contain 'p10' parameter.")
#3. make sure model fit contains p10 parameter
expect_error(mu_critical(model2$model),
"model_fit must contain 'p10' parameter.")
#4. if modelfit contains alpha, cov_val must be provided
expect_error(mu_critical(model1$model),
paste0("If model_fit contains site-level covariates, values ",
"must be provided for cov_val"))
#5. cov_val is numeric, if provided
expect_error(mu_critical(model1$model, cov_val = c(TRUE, TRUE)),
"cov_val must be a numeric vector")
#6. Only include input cov_val if covariates are included in model
expect_error(mu_critical(model3$model, cov_val = c(0, 0)),
paste0("cov_val must be NULL if the model does not ",
"contain site-level covariates."))
#7. Only include input cov_val if covariates are included in model
expect_error(mu_critical(model1$model, cov_val = c(0, 0, 0)),
paste0("cov_val must be of the same length as the number of ",
"non-intercept site-level coefficients in the model."))
#' @srrstats {G5.2,G5.2b,BS2.15} Tests the assure function input checks are
#'   behaving as expected.
#1. input tags are valid, q = TRUE
expect_error(traditional_model(data = list(Count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 2, NA))),
q = TRUE,
multicore = FALSE),
"Data should include 'count' and 'count_type'.")
#2. input tags are valid, q = FALSE
expect_error(traditional_model(data = list(Count = rbind(c(4, 1, 1),
c(1, 1, NA))),
multicore = FALSE),
"Data should include 'count'.")
#3. make sure dimensions of count and count_type are equal, if count_type is
# present
#' @srrstats {BS2.1a} Test to ensure pre-processing routines to ensure all
#'   input data is dimensionally commensurate
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2),
c(1, 2))),
q = TRUE,
multicore = FALSE),
"Dimensions of count and count_type do not match.")
#4. make sure all data is numeric -- if q == TRUE
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c("NA", 2, 2),
c(1, 2, 2))),
q = TRUE,
multicore = FALSE),
"Data should be numeric.")
#5. make sure all data is numeric -- if q == FALSE
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, "NA"))),
multicore = FALSE),
"Data should be numeric.")
#6. make sure locations of NAs in count data match locations of NAs in
# count_type data
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(NA, 2, 2),
c(1, 2, 2))),
q = TRUE,
multicore = FALSE),
paste0("Empty data cells \\(NA\\) in count data should match ",
"empty data cells \\(NA\\) in count_type data."))
#7. make sure family is either 'poisson', 'negbin', or 'gamma'
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA))),
family = "normal",
multicore = FALSE),
paste0("Invalid family. Options include 'poisson', ",
"'negbin', or 'gamma'."))
#8. the smallest count_type is 1
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(0, 1, 2),
c(1, 2, NA))),
q = TRUE,
multicore = FALSE),
paste0("The first gear type should be referenced as 1 in ",
"count_type. Subsequent gear types should be ",
"referenced 2, 3, 4, etc."))
#9. count are integers
expect_error(traditional_model(data = list(count = rbind(c(4.1, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 1, 2),
c(1, 2, NA))),
q = TRUE, family = "negbin",
multicore  = FALSE),
paste0("All values in count should be non-negative integers. ",
"Use family = 'gamma' if count is continuous."))
#10. count_type are integers
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1.1, 1, 2),
c(1, 2, NA))),
q = TRUE,
multicore = FALSE),
"All values in count_type should be integers.")
#11. phi priors is a vector of two numeric values
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA))),
phi_priors = c(0, 1), family = "negbin",
multicore = FALSE),
paste0("phi_priors should be a vector of two positive ",
"numeric values. ex. c\\(0.25,0.25\\)"))
#12. make sure no column is entirely NA in count
expect_error(traditional_model(data = list(count = rbind(c(4, 1, NA),
c(1, 1, NA))),
multicore = FALSE),
"count contains a column with all NA.")
#13. make sure no data are undefined
expect_error(traditional_model(data = list(count = rbind(c(4, 1, Inf),
c(1, 1, NA))),
multicore = FALSE),
"count contains undefined values \\(i.e., Inf or -Inf\\)")
#14. length of initial values is equal to the number of chains
n_chain <- 4
inits <- list()
for (i in 1:n_chain) {
inits[[i]] <- list(
mu <- stats::runif(2, 0, 1)
)
names(inits[[i]]) <- c("mu")
}
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA))),
n_chain = 5, initial_values = inits,
multicore = FALSE),
paste0("The length of the list of initial values should equal ",
"the number of chains \\(n_chain, default is 4\\)."))
#15. initial values check mu length
n_chain <- 4
inits <- list()
for (i in 1:n_chain) {
inits[[i]] <- list(
mu <- stats::runif(3, 0, 1)
)
names(inits[[i]]) <- c("mu")
}
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA))),
initial_values = inits,
multicore = FALSE),
paste0("The length of initial values for 'mu' should ",
"equal the number of sites."))
#16. initial values check mu is positive numeric
n_chain <- 4
inits <- list()
for (i in 1:n_chain) {
inits[[i]] <- list(
mu <- stats::runif(3, -1, 0)
)
names(inits[[i]]) <- c("mu")
}
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA))),
initial_values = inits,
multicore = FALSE),
"Initial values for 'mu' should be numeric values > 0.")
#17. initial values check q
n_chain <- 4
inits <- list()
for (i in 1:n_chain) {
inits[[i]] <- list(
q <- c(0.1, 0.1)
)
names(inits[[i]]) <- c("q")
}
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 1, 2),
c(1, 2, NA))),
initial_values = inits,
multicore = FALSE),
paste0("The length of initial values for 'q' should equal: ",
"\\# unique gear types \\- 1 \\(i.e., q for reference ",
"type = 1\\)."))
#18. check length and range of n_chain
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
n_chain = c(1, 1), multicore = FALSE),
paste0("n_chain should be an integer > 0 and of length 1."))
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
n_chain = 0, multicore = FALSE),
paste0("n_chain should be an integer > 0 and of length 1."))
#19. check length and range of n_iter
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
n_iter = c(1, 1), multicore = FALSE),
paste0("n_iter should be an integer > 0 and of length 1."))
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
n_iter = 0, multicore = FALSE),
paste0("n_iter should be an integer > 0 and of length 1."))
#20. check length and range of n_warmup
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
n_warmup = c(1, 1), multicore = FALSE),
"n_warmup should be an integer > 0 and of length 1.")
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
n_warmup = 0, multicore = FALSE),
"n_warmup should be an integer > 0 and of length 1.")
#21. check length and range of thin
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
thin = c(1, 1), multicore = FALSE),
"thin should be an integer > 0 and of length 1.")
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
thin = 0, multicore = FALSE),
"thin should be an integer > 0 and of length 1.")
#22. check length and range of adapt_delta
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
adapt_delta = c(0.9, 0.9), multicore = FALSE),
paste0("adapt_delta should be a numeric value > 0 and < 1 and ",
"of length 1."))
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
adapt_delta = 1.2, multicore = FALSE),
paste0("adapt_delta should be a numeric value > 0 and < 1 and ",
"of length 1."))
#23. check length of seed
expect_error(traditional_model(data = list(count = rbind(c(4, 1, 1),
c(1, 1, NA)),
count_type = rbind(c(1, 2, 1),
c(1, 1, NA))),
seed = c(1, 2), multicore = FALSE),
"seed should be an integer of length 1.")
devtools::install()
# constants
nsite <- 20
nobs_count <- 100
# params
mu <- rlnorm(nsite, meanlog = log(1), sdlog = 1)
q <- 2
beta_gamma <- 1
alpha_gamma <- mu * beta_gamma
# traditional type
count_type <- cbind(matrix(1, nrow = nsite, ncol = nobs_count / 2),
matrix(2, nrow = nsite, ncol = nobs_count / 2))
# collect data
data <- list(
count = count,
count_type = count_type
)
# initial values
inits <- list()
# constants
nsite <- 20
nobs_count <- 100
# params
mu <- rlnorm(nsite, meanlog = log(1), sdlog = 1)
q <- 2
beta_gamma <- 1
alpha_gamma <- mu * beta_gamma
# count
for (i in 1:nsite) {
for (j in 1:nobs_count) {
if (count_type[i, j] == 1) {
count[i, j] <- rgamma(1, shape = alpha_gamma[i],
rate = beta_gamma)
} else {
count[i, j] <- rgamma(1, shape = alpha_gamma[i] * q,
rate = beta_gamma)
}
}
}
# count
count <- matrix(NA, nrow = nsite, ncol = nobs_count)
for (i in 1:nsite) {
for (j in 1:nobs_count) {
if (count_type[i, j] == 1) {
count[i, j] <- rgamma(1, shape = alpha_gamma[i],
rate = beta_gamma)
} else {
count[i, j] <- rgamma(1, shape = alpha_gamma[i] * q,
rate = beta_gamma)
}
}
}
# traditional type
count_type <- cbind(matrix(1, nrow = nsite, ncol = nobs_count / 2),
matrix(2, nrow = nsite, ncol = nobs_count / 2))
# collect data
data <- list(
count = count,
count_type = count_type
)
# initial values
inits <- list()
inits[[1]] <- list(
alpha = mu,
beta = rep(1, length(mu)),
q = q
)
names(inits[[1]]) <- c("alpha", "beta", "q")
# run model
fit <- suppressWarnings({
traditional_model(data = data, q = TRUE, family = "gamma",
n_chain = 1, multicore = FALSE, seed = 10,
initial_values = inits, n_warmup = 25, n_iter = 100)
})
devtools::load_all()