Last updated on 2020-02-19 10:49:01 CET.
Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
---|---|---|---|---|---|---|
r-devel-linux-x86_64-debian-clang | 0.1.2 | 2.81 | 31.70 | 34.51 | NOTE | |
r-devel-linux-x86_64-debian-gcc | 0.1.2 | 2.41 | 24.97 | 27.38 | NOTE | |
r-devel-linux-x86_64-fedora-clang | 0.1.2 | 52.72 | WARN | |||
r-devel-linux-x86_64-fedora-gcc | 0.1.2 | 50.26 | WARN | |||
r-devel-windows-ix86+x86_64 | 0.1.2 | 8.00 | 91.00 | 99.00 | OK | |
r-devel-windows-ix86+x86_64-gcc8 | 0.1.2 | 10.00 | 127.00 | 137.00 | OK | |
r-patched-linux-x86_64 | 0.1.2 | 2.27 | 29.21 | 31.48 | NOTE | |
r-release-linux-x86_64 | 0.1.2 | 2.45 | 29.57 | 32.02 | NOTE | |
r-release-windows-ix86+x86_64 | 0.1.2 | 6.00 | 100.00 | 106.00 | OK | |
r-release-osx-x86_64 | 0.1.2 | NOTE | ||||
r-oldrel-windows-ix86+x86_64 | 0.1.2 | 4.00 | 93.00 | 97.00 | OK | |
r-oldrel-osx-x86_64 | 0.1.2 | NOTE |
Version: 0.1.2
Check: package dependencies
Result: NOTE
Package suggested but not available for checking: 'INLA'
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-patched-linux-x86_64, r-release-linux-x86_64, r-release-osx-x86_64, r-oldrel-osx-x86_64
Version: 0.1.2
Check: re-building of vignette outputs
Result: WARN
Error(s) in re-building vignettes:
--- re-building ‘nmaINLA.Rnw’ using knitr
Loading required package: INLA
Loading required package: Matrix
Loading required package: sp
Loading required package: parallel
This is INLA_19.09.03 built 2020-02-15 02:59:58 UTC.
See www.r-inla.org/contact-us for how to get help.
To enable PARDISO sparse library; see inla.pardiso()
Loading required package: nmaINLA
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
nmaINLA
--- call from context ---
nma_inla(SmokdatINLA, likelihood = "binomial", fixed.par = c(0,
1000), tau.prior = "uniform", tau.par = c(0, 5), type = "consistency")
--- call from argument ---
if (class(try.tau) != "try-error") {
tau.stdev = sqrt(INLA::inla.emarginal(function(x) x^2, tau) -
INLA::inla.emarginal(function(x) x^1, tau)^2)
} else {
tau.stdev = NA
}
--- R stacktrace ---
where 1 at <text>#12: nma_inla(SmokdatINLA, likelihood = "binomial", fixed.par = c(0,
1000), tau.prior = "uniform", tau.par = c(0, 5), type = "consistency")
where 2: eval(expr, envir, enclos)
where 3: eval(expr, envir, enclos)
where 4: withVisible(eval(expr, envir, enclos))
where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
error = eHandler, message = mHandler)
where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
enclos)), warning = wHandler, error = eHandler, message = mHandler))
where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
debug = debug, last = i == length(out), use_try = stop_on_error !=
2L, keep_warning = keep_warning, keep_message = keep_message,
output_handler = output_handler, include_timing = include_timing)
where 9: evaluate::evaluate(...)
where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
options$include) 0L else 2L, output_handler = knit_handlers(options$render,
options))
where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
stop_on_error = if (options$error && options$include) 0L else 2L,
output_handler = knit_handlers(options$render, options)))
where 12: block_exec(params)
where 13: call_block(x)
where 14: process_group.block(group)
where 15: process_group(group)
where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
error = function(e) {
setwd(wd)
cat(res, sep = "\n", file = output %n% "")
message("Quitting from lines ", paste(current_lines(i),
collapse = "-"), " (", knit_concord$get("infile"),
") ")
})
where 17: process_file(text, output)
where 18: (if (grepl("\\.[Rr]md$", file)) knit2html_v1 else if (grepl("\\.[Rr]rst$",
file)) knit2pandoc else knit)(file, encoding = encoding,
quiet = quiet, envir = globalenv(), ...)
where 19: engine$weave(file, quiet = quiet, encoding = enc)
where 20: doTryCatch(return(expr), name, parentenv, handler)
where 21: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 22: tryCatchList(expr, classes, parentenv, handlers)
where 23: tryCatch({
engine$weave(file, quiet = quiet, encoding = enc)
setwd(startdir)
output <- find_vignette_product(name, by = "weave", engine = engine)
if (!have.makefile && vignette_is_tex(output)) {
texi2pdf(file = output, clean = FALSE, quiet = quiet)
output <- find_vignette_product(name, by = "texi2pdf",
engine = engine)
}
outputs <- c(outputs, output)
}, error = function(e) {
thisOK <<- FALSE
fails <<- c(fails, file)
message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
file, conditionMessage(e)))
})
where 24: tools:::buildVignettes(dir = "/data/gannet/ripley/R/packages/tests-clang/nmaINLA.Rcheck/vign_test/nmaINLA",
ser_elibs = "/tmp/RtmpPYeqrb/file8d892fa2eafc.rds")
--- value of length: 2 type: logical ---
[1] TRUE TRUE
--- function from context ---
function (datINLA, likelihood = NULL, fixed.par = c(0, 1000),
tau.prior = "uniform", tau.par = c(0, 5), kappa.prior = "uniform",
kappa.par = c(0, 5), mreg = FALSE, type = "consistency",
verbose = FALSE, inla.strategy = "simplified.laplace", improve.hyperpar.dz = 0.75,
correct = FALSE, correct.factor = 10, improve.hyperpar = TRUE)
{
if (requireNamespace("INLA", quietly = TRUE)) {
if (!(sum(search() == "package:INLA")) == 1) {
stop("INLA need to be loaded! \n\n Please use the following command to load INLA,\n\n library(INLA) \n")
}
if (!is.data.frame(datINLA)) {
stop("Data MUST be a data frame!!!")
}
if (likelihood %in% c("binomial", "normal", "poisson") ==
FALSE) {
stop("Function argument \"likelihood\" must be equal to \"binomial\" or \"normal\" or \"poisson\" !!!")
}
if (type %in% c("FE", "consistency", "jackson") == FALSE) {
stop("Function argument \"type\" must be equal to \"FE\" or \"consistency\" or \"jackson\" !!!")
}
if (tau.prior %in% c("uniform", "half-normal") == FALSE) {
stop("Function argument \"tau.prior\" must be equal to \"uniform\" or \"half-normal\" !!!")
}
if (kappa.prior %in% c("uniform", "half-normal") == FALSE) {
stop("Function argument \"kappa.prior\" must be equal to \"uniform\" or \"half-normal\" !!!")
}
cor <- 0.5
ngroup <- max(datINLA$na) - 1
cor.inla.init <- log((1 + cor * (ngroup - 1))/(1 - cor))
N <- max(datINLA$study)
d_params <- grep("d1", names(datINLA), value = TRUE)
N_d_params <- length(d_params)
inla.form <- paste("Y ~ -1 + mu +", paste(d_params, collapse = "+",
sep = " "), sep = " ")
if (mreg == TRUE) {
inla.form <- paste(inla.form, " + cov", sep = "")
}
if (type %in% c("consistency", "jackson") == TRUE) {
hyperunif.function <- function(x) {
ifelse(exp(x)^-0.5 < tau.par[2] & exp(x)^-0.5 >
tau.par[1], logdens <- log(1/(tau.par[2] -
tau.par[1])), logdens <- log(9.98012604599318e-322))
logdenst <- logdens + log(0.5 * exp(-x/2))
return(logdenst)
}
lprec <- seq(from = -40, to = 40, len = 20000)
unif.prior.table <- paste(c("table:", cbind(lprec,
sapply(lprec, FUN = hyperunif.function))), sep = "",
collapse = " ")
if (tau.prior == "uniform") {
het.expr <- " + f(het, model=\"iid\", hyper = list(theta = list(prior = unif.prior.table)"
}
if (tau.prior == "half-normal") {
tau.par[2] <- 1/tau.par[2]
het.expr <- " + f(het, model=\"iid\", hyper = list(theta = list(prior = \"logtnormal\", param = tau.par)"
}
multi.arm.expr <- ", group = g, control.group = list(model = \"exchangeable\", hyper = list(rho = list(fixed = TRUE, initial = cor.inla.init)))"
inla.form <- paste(inla.form, het.expr, ")", sep = "")
inla.form <- paste(inla.form, multi.arm.expr, ")",
sep = "")
}
if (type == "jackson") {
if (kappa.prior == "uniform") {
inc.expr <- " + f(inc, model=\"iid\", hyper = list(theta = list(prior = unif.prior.table)"
}
if (kappa.prior == "half-normal") {
kappa.par[2] <- 1/kappa.par[2]
inc.expr <- " + f(inc, model=\"iid\", hyper = list(theta = list(prior = \"logtnormal\", param = kappa.par)"
}
inla.form <- paste(inla.form, inc.expr, ")", sep = "")
inla.form <- paste(inla.form, multi.arm.expr, ")",
sep = "")
}
if (likelihood == "binomial") {
datINLA$Y = datINLA$responders
Ntrials = datINLA$sampleSize
fit.inla <- INLA::inla(stats::as.formula(inla.form),
data = datINLA, family = "binomial", verbose = verbose,
control.fixed = list(expand.factor.strategy = "inla",
mean = fixed.par[1], prec = 1/fixed.par[2]),
Ntrials = Ntrials, control.compute = list(dic = TRUE,
waic = TRUE, cpo = TRUE, mlik = TRUE, config = TRUE),
control.inla = list(strategy = inla.strategy,
correct = correct, correct.factor = correct.factor))
}
if (likelihood == "normal") {
datINLA$Y = datINLA$mean
prec = 1/datINLA$std.err^2
fit.inla <- INLA::inla(stats::as.formula(inla.form),
family = "normal", verbose = verbose, data = datINLA,
control.fixed = list(expand.factor.strategy = "inla",
mean = fixed.par[1], prec = 1/fixed.par[2]),
control.family = list(hyper = list(prec = list(fixed = TRUE,
initial = 0))), scale = prec, control.compute = list(dic = TRUE,
waic = TRUE, cpo = TRUE, mlik = TRUE, config = TRUE),
control.inla = list(strategy = inla.strategy,
correct = correct, correct.factor = correct.factor))
}
if (likelihood == "poisson") {
datINLA$Y = datINLA$responders
E = datINLA$exposure
fit.inla <- INLA::inla(stats::as.formula(inla.form),
data = datINLA, family = "poisson", verbose = verbose,
control.fixed = list(expand.factor.strategy = "inla",
mean = fixed.par[1], prec = 1/fixed.par[2]),
E = E, control.compute = list(dic = TRUE, waic = TRUE,
cpo = TRUE, mlik = TRUE, config = TRUE), control.inla = list(strategy = inla.strategy,
correct = correct, correct.factor = correct.factor))
}
if (!fit.inla$ok) {
stop("Something wrong while running model with data! Please set verbose = TRUE to check!!!!")
}
if (type %in% c("consistency", "jackson") == TRUE) {
if (improve.hyperpar == TRUE) {
fit.inla <- INLA::inla.hyperpar(fit.inla, dz = improve.hyperpar.dz)
}
}
d_params <- as.matrix(fit.inla$summary.fixed[(N + 1):(N +
N_d_params), c(1, 2, 3, 4, 5)])
if (mreg == TRUE) {
cov <- as.matrix(fit.inla$summary.fixed[N + N_d_params +
1, c(1, 2, 3, 4, 5)])
}
if (type %in% c("consistency", "jackson") == TRUE) {
tau.mean <- INLA::inla.emarginal(function(x) 1/sqrt(x),
fit.inla$marginals.hyperpar[["Precision for het"]])
try.tau = try(tau <- INLA::inla.tmarginal(function(x) 1/sqrt(x),
fit.inla$marginals.hyperpar[["Precision for het"]]),
silent = TRUE)
if (class(try.tau) != "try-error") {
tau.stdev = sqrt(INLA::inla.emarginal(function(x) x^2,
tau) - INLA::inla.emarginal(function(x) x^1,
tau)^2)
}
else {
tau.stdev = NA
}
tau.quant <- as.numeric(rev(sqrt((1/summary(fit.inla)$hyperpar[1,
c(3, 4, 5)]))))
if (type == "jackson") {
kappa.mean <- INLA::inla.emarginal(function(x) 1/sqrt(x),
fit.inla$marginals.hyperpar[["Precision for inc"]])
try.kappa = try(kappa <- INLA::inla.tmarginal(function(x) 1/sqrt(x),
fit.inla$marginals.hyperpar[["Precision for inc"]]),
silent = TRUE)
if (class(try.kappa) != "try-error") {
kappa.stdev = sqrt(INLA::inla.emarginal(function(x) x^2,
kappa) - INLA::inla.emarginal(function(x) x^1,
kappa)^2)
}
else {
kappa.stdev = NA
}
kappa.quant <- as.numeric(rev(sqrt((1/summary(fit.inla)$hyperpar[2,
c(3, 4, 5)]))))
tab <- matrix(NA, 2, 5)
tab[1, ] <- c(tau.mean, tau.stdev, tau.quant[1],
tau.quant[2], tau.quant[3])
tab[2, ] <- c(kappa.mean, kappa.stdev, kappa.quant[1],
kappa.quant[2], kappa.quant[3])
}
else {
tab <- matrix(NA, 1, 5)
rownames(tab) <- "tau"
}
tab[1, ] <- c(tau.mean, tau.stdev, tau.quant[1],
tau.quant[2], tau.quant[3])
colnames(tab) <- c("mean", "sd", "0.025quant", "0.5quant",
"0.975quant")
}
else tab <- NA
fit.inla$d_params <- d_params
if (mreg == TRUE) {
fit.inla$cov <- cov
}
fit.inla$hyperpar <- tab
fit.inla$fixed.par <- fixed.par
fit.inla$tau.prior <- tau.prior
fit.inla$tau.par <- tau.par
fit.inla$kappa.prior <- kappa.prior
fit.inla$kappa.par <- kappa.par
fit.inla$type <- type
fit.inla$mreg <- mreg
fit.inla$inla.strategy <- inla.strategy
fit.inla$N <- N
fit.inla$N_d_params <- N_d_params
class(fit.inla) <- "nma_inla"
return(fit.inla)
}
else {
stop("INLA need to be installed and loaded!\n\nPlease use the following command to install and load INLA,\n\ninstall.packages(\"INLA\", repos=c(getOption(\"repos\"), INLA=\"https://inla.r-inla-download.org/R/stable\"), dep=TRUE) \n\nlibrary(INLA) \n")
}
}
<bytecode: 0xdacdc08>
<environment: namespace:nmaINLA>
--- function search by body ---
Function nma_inla in namespace nmaINLA has this body.
----------- END OF FAILURE REPORT --------------
Quitting from lines 99-142 (nmaINLA.Rnw)
Error: processing vignette 'nmaINLA.Rnw' failed with diagnostics:
the condition has length > 1
--- failed re-building ‘nmaINLA.Rnw’
SUMMARY: processing the following file failed:
‘nmaINLA.Rnw’
Error: Vignette re-building failed.
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 0.1.2
Check: re-building of vignette outputs
Result: WARN
Error(s) in re-building vignettes:
--- re-building ‘nmaINLA.Rnw’ using knitr
Loading required package: INLA
Loading required package: Matrix
Loading required package: sp
Loading required package: parallel
This is INLA_19.09.03 built 2020-02-16 10:27:38 UTC.
See www.r-inla.org/contact-us for how to get help.
To enable PARDISO sparse library; see inla.pardiso()
Loading required package: nmaINLA
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
nmaINLA
--- call from context ---
nma_inla(SmokdatINLA, likelihood = "binomial", fixed.par = c(0,
1000), tau.prior = "uniform", tau.par = c(0, 5), type = "consistency")
--- call from argument ---
if (class(try.tau) != "try-error") {
tau.stdev = sqrt(INLA::inla.emarginal(function(x) x^2, tau) -
INLA::inla.emarginal(function(x) x^1, tau)^2)
} else {
tau.stdev = NA
}
--- R stacktrace ---
where 1 at <text>#12: nma_inla(SmokdatINLA, likelihood = "binomial", fixed.par = c(0,
1000), tau.prior = "uniform", tau.par = c(0, 5), type = "consistency")
where 2: eval(expr, envir, enclos)
where 3: eval(expr, envir, enclos)
where 4: withVisible(eval(expr, envir, enclos))
where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
error = eHandler, message = mHandler)
where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
enclos)), warning = wHandler, error = eHandler, message = mHandler))
where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
debug = debug, last = i == length(out), use_try = stop_on_error !=
2L, keep_warning = keep_warning, keep_message = keep_message,
output_handler = output_handler, include_timing = include_timing)
where 9: evaluate::evaluate(...)
where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
options$include) 0L else 2L, output_handler = knit_handlers(options$render,
options))
where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
stop_on_error = if (options$error && options$include) 0L else 2L,
output_handler = knit_handlers(options$render, options)))
where 12: block_exec(params)
where 13: call_block(x)
where 14: process_group.block(group)
where 15: process_group(group)
where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
error = function(e) {
setwd(wd)
cat(res, sep = "\n", file = output %n% "")
message("Quitting from lines ", paste(current_lines(i),
collapse = "-"), " (", knit_concord$get("infile"),
") ")
})
where 17: process_file(text, output)
where 18: (if (grepl("\\.[Rr]md$", file)) knit2html_v1 else if (grepl("\\.[Rr]rst$",
file)) knit2pandoc else knit)(file, encoding = encoding,
quiet = quiet, envir = globalenv(), ...)
where 19: engine$weave(file, quiet = quiet, encoding = enc)
where 20: doTryCatch(return(expr), name, parentenv, handler)
where 21: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 22: tryCatchList(expr, classes, parentenv, handlers)
where 23: tryCatch({
engine$weave(file, quiet = quiet, encoding = enc)
setwd(startdir)
output <- find_vignette_product(name, by = "weave", engine = engine)
if (!have.makefile && vignette_is_tex(output)) {
texi2pdf(file = output, clean = FALSE, quiet = quiet)
output <- find_vignette_product(name, by = "texi2pdf",
engine = engine)
}
outputs <- c(outputs, output)
}, error = function(e) {
thisOK <<- FALSE
fails <<- c(fails, file)
message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
file, conditionMessage(e)))
})
where 24: tools:::buildVignettes(dir = "/data/gannet/ripley/R/packages/tests-devel/nmaINLA.Rcheck/vign_test/nmaINLA",
ser_elibs = "/tmp/RtmpIDn2gk/file3a885afc1254.rds")
--- value of length: 2 type: logical ---
[1] TRUE TRUE
--- function from context ---
function (datINLA, likelihood = NULL, fixed.par = c(0, 1000),
tau.prior = "uniform", tau.par = c(0, 5), kappa.prior = "uniform",
kappa.par = c(0, 5), mreg = FALSE, type = "consistency",
verbose = FALSE, inla.strategy = "simplified.laplace", improve.hyperpar.dz = 0.75,
correct = FALSE, correct.factor = 10, improve.hyperpar = TRUE)
{
if (requireNamespace("INLA", quietly = TRUE)) {
if (!(sum(search() == "package:INLA")) == 1) {
stop("INLA need to be loaded! \n\n Please use the following command to load INLA,\n\n library(INLA) \n")
}
if (!is.data.frame(datINLA)) {
stop("Data MUST be a data frame!!!")
}
if (likelihood %in% c("binomial", "normal", "poisson") ==
FALSE) {
stop("Function argument \"likelihood\" must be equal to \"binomial\" or \"normal\" or \"poisson\" !!!")
}
if (type %in% c("FE", "consistency", "jackson") == FALSE) {
stop("Function argument \"type\" must be equal to \"FE\" or \"consistency\" or \"jackson\" !!!")
}
if (tau.prior %in% c("uniform", "half-normal") == FALSE) {
stop("Function argument \"tau.prior\" must be equal to \"uniform\" or \"half-normal\" !!!")
}
if (kappa.prior %in% c("uniform", "half-normal") == FALSE) {
stop("Function argument \"kappa.prior\" must be equal to \"uniform\" or \"half-normal\" !!!")
}
cor <- 0.5
ngroup <- max(datINLA$na) - 1
cor.inla.init <- log((1 + cor * (ngroup - 1))/(1 - cor))
N <- max(datINLA$study)
d_params <- grep("d1", names(datINLA), value = TRUE)
N_d_params <- length(d_params)
inla.form <- paste("Y ~ -1 + mu +", paste(d_params, collapse = "+",
sep = " "), sep = " ")
if (mreg == TRUE) {
inla.form <- paste(inla.form, " + cov", sep = "")
}
if (type %in% c("consistency", "jackson") == TRUE) {
hyperunif.function <- function(x) {
ifelse(exp(x)^-0.5 < tau.par[2] & exp(x)^-0.5 >
tau.par[1], logdens <- log(1/(tau.par[2] -
tau.par[1])), logdens <- log(9.98012604599318e-322))
logdenst <- logdens + log(0.5 * exp(-x/2))
return(logdenst)
}
lprec <- seq(from = -40, to = 40, len = 20000)
unif.prior.table <- paste(c("table:", cbind(lprec,
sapply(lprec, FUN = hyperunif.function))), sep = "",
collapse = " ")
if (tau.prior == "uniform") {
het.expr <- " + f(het, model=\"iid\", hyper = list(theta = list(prior = unif.prior.table)"
}
if (tau.prior == "half-normal") {
tau.par[2] <- 1/tau.par[2]
het.expr <- " + f(het, model=\"iid\", hyper = list(theta = list(prior = \"logtnormal\", param = tau.par)"
}
multi.arm.expr <- ", group = g, control.group = list(model = \"exchangeable\", hyper = list(rho = list(fixed = TRUE, initial = cor.inla.init)))"
inla.form <- paste(inla.form, het.expr, ")", sep = "")
inla.form <- paste(inla.form, multi.arm.expr, ")",
sep = "")
}
if (type == "jackson") {
if (kappa.prior == "uniform") {
inc.expr <- " + f(inc, model=\"iid\", hyper = list(theta = list(prior = unif.prior.table)"
}
if (kappa.prior == "half-normal") {
kappa.par[2] <- 1/kappa.par[2]
inc.expr <- " + f(inc, model=\"iid\", hyper = list(theta = list(prior = \"logtnormal\", param = kappa.par)"
}
inla.form <- paste(inla.form, inc.expr, ")", sep = "")
inla.form <- paste(inla.form, multi.arm.expr, ")",
sep = "")
}
if (likelihood == "binomial") {
datINLA$Y = datINLA$responders
Ntrials = datINLA$sampleSize
fit.inla <- INLA::inla(stats::as.formula(inla.form),
data = datINLA, family = "binomial", verbose = verbose,
control.fixed = list(expand.factor.strategy = "inla",
mean = fixed.par[1], prec = 1/fixed.par[2]),
Ntrials = Ntrials, control.compute = list(dic = TRUE,
waic = TRUE, cpo = TRUE, mlik = TRUE, config = TRUE),
control.inla = list(strategy = inla.strategy,
correct = correct, correct.factor = correct.factor))
}
if (likelihood == "normal") {
datINLA$Y = datINLA$mean
prec = 1/datINLA$std.err^2
fit.inla <- INLA::inla(stats::as.formula(inla.form),
family = "normal", verbose = verbose, data = datINLA,
control.fixed = list(expand.factor.strategy = "inla",
mean = fixed.par[1], prec = 1/fixed.par[2]),
control.family = list(hyper = list(prec = list(fixed = TRUE,
initial = 0))), scale = prec, control.compute = list(dic = TRUE,
waic = TRUE, cpo = TRUE, mlik = TRUE, config = TRUE),
control.inla = list(strategy = inla.strategy,
correct = correct, correct.factor = correct.factor))
}
if (likelihood == "poisson") {
datINLA$Y = datINLA$responders
E = datINLA$exposure
fit.inla <- INLA::inla(stats::as.formula(inla.form),
data = datINLA, family = "poisson", verbose = verbose,
control.fixed = list(expand.factor.strategy = "inla",
mean = fixed.par[1], prec = 1/fixed.par[2]),
E = E, control.compute = list(dic = TRUE, waic = TRUE,
cpo = TRUE, mlik = TRUE, config = TRUE), control.inla = list(strategy = inla.strategy,
correct = correct, correct.factor = correct.factor))
}
if (!fit.inla$ok) {
stop("Something wrong while running model with data! Please set verbose = TRUE to check!!!!")
}
if (type %in% c("consistency", "jackson") == TRUE) {
if (improve.hyperpar == TRUE) {
fit.inla <- INLA::inla.hyperpar(fit.inla, dz = improve.hyperpar.dz)
}
}
d_params <- as.matrix(fit.inla$summary.fixed[(N + 1):(N +
N_d_params), c(1, 2, 3, 4, 5)])
if (mreg == TRUE) {
cov <- as.matrix(fit.inla$summary.fixed[N + N_d_params +
1, c(1, 2, 3, 4, 5)])
}
if (type %in% c("consistency", "jackson") == TRUE) {
tau.mean <- INLA::inla.emarginal(function(x) 1/sqrt(x),
fit.inla$marginals.hyperpar[["Precision for het"]])
try.tau = try(tau <- INLA::inla.tmarginal(function(x) 1/sqrt(x),
fit.inla$marginals.hyperpar[["Precision for het"]]),
silent = TRUE)
if (class(try.tau) != "try-error") {
tau.stdev = sqrt(INLA::inla.emarginal(function(x) x^2,
tau) - INLA::inla.emarginal(function(x) x^1,
tau)^2)
}
else {
tau.stdev = NA
}
tau.quant <- as.numeric(rev(sqrt((1/summary(fit.inla)$hyperpar[1,
c(3, 4, 5)]))))
if (type == "jackson") {
kappa.mean <- INLA::inla.emarginal(function(x) 1/sqrt(x),
fit.inla$marginals.hyperpar[["Precision for inc"]])
try.kappa = try(kappa <- INLA::inla.tmarginal(function(x) 1/sqrt(x),
fit.inla$marginals.hyperpar[["Precision for inc"]]),
silent = TRUE)
if (class(try.kappa) != "try-error") {
kappa.stdev = sqrt(INLA::inla.emarginal(function(x) x^2,
kappa) - INLA::inla.emarginal(function(x) x^1,
kappa)^2)
}
else {
kappa.stdev = NA
}
kappa.quant <- as.numeric(rev(sqrt((1/summary(fit.inla)$hyperpar[2,
c(3, 4, 5)]))))
tab <- matrix(NA, 2, 5)
tab[1, ] <- c(tau.mean, tau.stdev, tau.quant[1],
tau.quant[2], tau.quant[3])
tab[2, ] <- c(kappa.mean, kappa.stdev, kappa.quant[1],
kappa.quant[2], kappa.quant[3])
}
else {
tab <- matrix(NA, 1, 5)
rownames(tab) <- "tau"
}
tab[1, ] <- c(tau.mean, tau.stdev, tau.quant[1],
tau.quant[2], tau.quant[3])
colnames(tab) <- c("mean", "sd", "0.025quant", "0.5quant",
"0.975quant")
}
else tab <- NA
fit.inla$d_params <- d_params
if (mreg == TRUE) {
fit.inla$cov <- cov
}
fit.inla$hyperpar <- tab
fit.inla$fixed.par <- fixed.par
fit.inla$tau.prior <- tau.prior
fit.inla$tau.par <- tau.par
fit.inla$kappa.prior <- kappa.prior
fit.inla$kappa.par <- kappa.par
fit.inla$type <- type
fit.inla$mreg <- mreg
fit.inla$inla.strategy <- inla.strategy
fit.inla$N <- N
fit.inla$N_d_params <- N_d_params
class(fit.inla) <- "nma_inla"
return(fit.inla)
}
else {
stop("INLA need to be installed and loaded!\n\nPlease use the following command to install and load INLA,\n\ninstall.packages(\"INLA\", repos=c(getOption(\"repos\"), INLA=\"https://inla.r-inla-download.org/R/stable\"), dep=TRUE) \n\nlibrary(INLA) \n")
}
}
<bytecode: 0xd65ed08>
<environment: namespace:nmaINLA>
--- function search by body ---
Function nma_inla in namespace nmaINLA has this body.
----------- END OF FAILURE REPORT --------------
Quitting from lines 99-142 (nmaINLA.Rnw)
Error: processing vignette 'nmaINLA.Rnw' failed with diagnostics:
the condition has length > 1
--- failed re-building ‘nmaINLA.Rnw’
SUMMARY: processing the following file failed:
‘nmaINLA.Rnw’
Error: Vignette re-building failed.
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc