From 89e8b9a55742618f0ee4a5364c5265ef1249883f Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Fri, 25 Sep 2020 13:34:22 -0400 Subject: [PATCH] TMB and coda to Suggests --- DESCRIPTION | 38 +++++++++++++++++++------------------- NAMESPACE | 6 ------ R/MCMCglmm_prediction.R | 10 ++++++---- R/TMB_tidiers.R | 10 ++++++---- R/brms_tidiers.R | 3 +++ R/mcmc_tidiers.R | 15 +++++++++++---- R/rstanarm_tidiers.R | 3 +++ R/utilities.R | 11 +++++++++++ man/assert_dependency.Rd | 12 ++++++++++++ 9 files changed, 71 insertions(+), 37 deletions(-) create mode 100644 man/assert_dependency.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 71776ee..58e87f9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,37 +31,37 @@ Description: Convert fitted objects from various R mixed-model packages provides a one-row summary of model-level statistics. Imports: broom, + cubelyr, dplyr, - tidyr, - purrr, - tibble, - nlme, methods, + nlme, + purrr, stringr, - coda, - TMB, - cubelyr + tibble, + tidyr Suggests: + brms, + coda, + dotwhisker, knitr, testthat, - ggplot2, - Matrix, - MCMCglmm, - lme4, - brms, - mgcv, gamlss, gamlss.data, - lmerTest, - pbkrtest, + ggplot2, + GLMMadaptive, glmmADMB, glmmTMB, - dotwhisker, + lmerTest, + lme4, + Matrix, + MCMCglmm, + mgcv, pander, - R2jags, - GLMMadaptive, + pbkrtest, rstan, - rstanarm + rstanarm, + R2jags, + TMB URL: http://github.com/bbolker/broom.mixed BugReports: http://github.com/bbolker/broom.mixed/issues License: GPL-3 diff --git a/NAMESPACE b/NAMESPACE index e20037b..ee82f45 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -47,16 +47,10 @@ export(tidy) export(tidyMCMC) if(getRversion()>='3.3.0') importFrom(stats, sigma) else importFrom(lme4,sigma) import(dplyr) -importFrom(TMB,sdreport) -importFrom(TMB,tmbprofile) -importFrom(TMB,tmbroot) importFrom(broom,augment) importFrom(broom,augment_columns) importFrom(broom,glance) importFrom(broom,tidy) -importFrom(coda,HPDinterval) -importFrom(coda,as.mcmc) -importFrom(coda,mcmc) importFrom(dplyr,bind_cols) importFrom(dplyr,bind_rows) importFrom(dplyr,mutate) diff --git a/R/MCMCglmm_prediction.R b/R/MCMCglmm_prediction.R index ca3ac0e..3d698c8 100644 --- a/R/MCMCglmm_prediction.R +++ b/R/MCMCglmm_prediction.R @@ -77,10 +77,12 @@ ## boxplot(M ~ Level, data = longsum) ## } #' @importFrom stats pnorm plogis -#' @importFrom coda mcmc #' @importFrom nlme fixef ranef predict2.MCMCglmm <- function(object, X, Z, use = c("all", "mean"), type = c("lp", "response"), ...) { + + assert_dependency("coda") + use <- match.arg(use) type <- match.arg(type) @@ -132,9 +134,9 @@ predict2.MCMCglmm <- function(object, X, Z, use = c("all", "mean"), q <- vector("list", length(CP) - 2) for (i in 2:(length(CP) - 1)) { - q[[i - 1]] <- mcmc(CP[[i + 1]] - CP[[i]]) + q[[i - 1]] <- coda::mcmc(CP[[i + 1]] - CP[[i]]) } - q <- c(list(mcmc(1 - Reduce(`+`, q[1:(i - 1)]))), q) + q <- c(list(coda::mcmc(1 - Reduce(`+`, q[1:(i - 1)]))), q) class(q) <- c("list", "MCMCglmmPredictedProbs") res <- q } else if (all(object$family %in% c("categorical", "multinomial"))) { @@ -149,7 +151,7 @@ predict2.MCMCglmm <- function(object, X, Z, use = c("all", "mean"), stop("Function does not support response type for families beside ordinal") } } else if (type == "lp") { - res <- as.mcmc(res) + res <- coda::as.mcmc(res) class(res) <- c("mcmc", "MCMCglmmPredictedLP") } diff --git a/R/TMB_tidiers.R b/R/TMB_tidiers.R index 7f3f1de..6678f8e 100644 --- a/R/TMB_tidiers.R +++ b/R/TMB_tidiers.R @@ -6,7 +6,6 @@ ##' @param effect which effects should be returned? ##' @param conf.method method for computing confidence intervals ##' @param ... additional arguments passed to confint function (tmbroot, tmbprofile) -##' @importFrom TMB sdreport tmbroot tmbprofile ##' @importFrom stats approx predict ##' @importFrom splines backSpline interpSpline ## FIXME: retrieving stored objects doesn't work well ... @@ -26,9 +25,12 @@ tidy.TMB <- function(x, effect = c("fixed", "random"), conf.int = FALSE, conf.level = 0.95, conf.method = c("wald", "uniroot", "profile"), ...) { + + assert_dependency("TMB") + ## R CMD check/global variables branch <- v <- param <- value <- zeta <- Estimate <- estimate <- std.error <- NULL - sdr <- sdreport(x) + sdr <- TMB::sdreport(x) retlist <- list() if ("fixed" %in% effect) { ss <- summary(sdr, select = "fixed") %>% @@ -51,7 +53,7 @@ tidy.TMB <- function(x, effect = c("fixed", "random"), tt <- do.call( rbind, lapply(seq(nrow(ss)), - tmbroot, + TMB::tmbroot, obj = x, ... ) @@ -66,7 +68,7 @@ tidy.TMB <- function(x, effect = c("fixed", "random"), all_vars <- all_vars[-rnd] } prof0 <- purrr::map_dfr(seq_along(all_vars), - ~ setNames(tmbprofile(x,name=.,trace=FALSE),c("focal","value")), + ~ setNames(TMB::tmbprofile(x,name=.,trace=FALSE),c("focal","value")), .id="param") prof1 <- (prof0 %>% group_by(param) diff --git a/R/brms_tidiers.R b/R/brms_tidiers.R index 2bea82f..8e1adaa 100644 --- a/R/brms_tidiers.R +++ b/R/brms_tidiers.R @@ -255,6 +255,9 @@ tidy.brmsfit <- function(x, parameters = NA, out$estimate <- apply(samples, 2, pointfun) out$std.error <- apply(samples, 2, stdfun) if (conf.int) { + + assert_dependency("coda") + stopifnot(length(conf.level) == 1L) probs <- c((1 - conf.level) / 2, 1 - (1 - conf.level) / 2) if (conf.method == "HPDinterval") { diff --git a/R/mcmc_tidiers.R b/R/mcmc_tidiers.R index 9df78e9..34b7e32 100644 --- a/R/mcmc_tidiers.R +++ b/R/mcmc_tidiers.R @@ -69,7 +69,6 @@ #' #' @importFrom stats median sd -#' @importFrom coda HPDinterval as.mcmc #' @export tidyMCMC <- function(x, pars, @@ -82,6 +81,9 @@ tidyMCMC <- function(x, ess = FALSE, index = FALSE, ...) { + + assert_dependency("coda") + conf.method <- match.arg(conf.method) stan <- inherits(x, "stanfit") @@ -119,7 +121,7 @@ tidyMCMC <- function(x, ci <- switch(conf.method, quantile = t(apply(ss, 2, stats::quantile, levs)), - HPDinterval(as.mcmc(ss), prob = conf.level) + coda::HPDinterval(coda::as.mcmc(ss), prob = conf.level) ) %>% as.data.frame() @@ -146,7 +148,6 @@ tidyMCMC <- function(x, ##' @rdname mcmc_tidiers -##' @importFrom coda as.mcmc ##' @export tidy.rjags <- function(x, robust = FALSE, @@ -154,7 +155,10 @@ tidy.rjags <- function(x, conf.level = 0.95, conf.method = "quantile", ...) { - tidyMCMC(as.mcmc(x$BUGS), + + assert_dependency("coda") + + tidyMCMC(coda::as.mcmc(x$BUGS), robust = robust, conf.int = conf.int, conf.level = conf.level, @@ -178,6 +182,9 @@ tidy.mcmc.list <- tidyMCMC ## copied from emdbook ... as.mcmc.bugs <- function (x) { + + assert_dependency("coda") + if (x$n.chains > 1) { z <- list() for (i in 1:x$n.chains) { diff --git a/R/rstanarm_tidiers.R b/R/rstanarm_tidiers.R index c0155d5..113ea15 100644 --- a/R/rstanarm_tidiers.R +++ b/R/rstanarm_tidiers.R @@ -114,6 +114,9 @@ tidy.stanreg <- function(x, } if (conf.int) { + + assert_dependency("coda") + cifix <- switch(conf.method, HPDinterval= { m <- as.matrix(x$stanfit) diff --git a/R/utilities.R b/R/utilities.R index 77b8493..81a5ea3 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -1,6 +1,17 @@ ## most of these are unexported (small) functions from broom; ## could be removed if these were exported + +#' check if a package is available and return informative message otherwise +#' +#' @keywords internal +assert_dependency <- function(library_name) { + if (!requireNamespace(library_name, quietly = TRUE)) { + stop(sprintf("Please install the %s package.", library_name)) + } +} + + ## https://github.com/klutometis/roxygen/issues/409 #' @importFrom broom tidy glance augment #' @export diff --git a/man/assert_dependency.Rd b/man/assert_dependency.Rd new file mode 100644 index 0000000..775b95d --- /dev/null +++ b/man/assert_dependency.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{assert_dependency} +\alias{assert_dependency} +\title{check if a package is available and return informative message otherwise} +\usage{ +assert_dependency(library_name) +} +\description{ +check if a package is available and return informative message otherwise +} +\keyword{internal}