Reduce dependencies: TMB, coda, cubelyr

DESCRIPTION

@@ -31,37 +31,36 @@ Description: Convert fitted objects from various R mixed-model packages
     provides a one-row summary of model-level statistics.
 Imports:
     broom,
+    coda,
     dplyr,
-    tidyr,
-    purrr,
-    tibble,
-    nlme,
     methods,
+    nlme,
+    purrr,
     stringr,
-    coda,
-    TMB,
-    cubelyr
+    tibble,
+    tidyr
 Suggests:
+    brms,
+    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

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)

R/MCMCglmm_prediction.R

@@ -77,10 +77,10 @@
 ##     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"), ...) {
+
   use <- match.arg(use)
   type <- match.arg(type)
 
@@ -132,9 +132,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 +149,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")
   }
 

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)

R/brms_tidiers.R

@@ -255,6 +255,7 @@ tidy.brmsfit <- function(x, parameters = NA,
   out$estimate <- apply(samples, 2, pointfun)
   out$std.error <- apply(samples, 2, stdfun)
   if (conf.int) {
+
     stopifnot(length(conf.level) == 1L)
     probs <- c((1 - conf.level) / 2, 1 - (1 - conf.level) / 2)
     if (conf.method == "HPDinterval") {

R/lme4_tidiers.R

@@ -526,12 +526,21 @@ tidy.lmList4 <- function(x, conf.int = FALSE,
 
     ss <- summary(x)$coefficients
     names(dimnames(ss)) <- c("group","cols","terms")
-    ret <- (ss
-        %>% cubelyr::as.tbl_cube()
-        %>% dplyr::as_data_frame()
-        %>% tidyr::spread(cols,".")
-        %>% rename_regex_match()
-    )
+
+    # flatten results cube
+    tmp <- list()
+    for (i in 1:dim(ss)[3]) {
+      tmp[[i]] <- ss[, , i, drop=TRUE] %>%
+                  as.data.frame %>%
+                  tibble::rownames_to_column(var = "group") %>%
+                  rename_regex_match() %>%
+                  dplyr::mutate(`terms` = dimnames(ss)$terms[i])
+    }
+    tmp <- dplyr::bind_rows(tmp)
+    tmp <- tmp[, unique(c("group", "terms"), sort(colnames(tmp)))]
+    tmp <- tmp[order(tmp$group, tmp$terms),]
+    ret <- tibble::as_tibble(tmp)
+
     if (conf.int) {
         qq <- qnorm((1+conf.level)/2)
         ret <- (ret %>%

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,7 @@ tidyMCMC <- function(x,
                      ess = FALSE,
                      index = FALSE,
                      ...) {
+
   conf.method <- match.arg(conf.method)
 
   stan <- inherits(x, "stanfit")
@@ -119,7 +119,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,15 +146,15 @@ tidyMCMC <- function(x,
 
 
 ##' @rdname mcmc_tidiers
-##' @importFrom coda as.mcmc
 ##' @export
 tidy.rjags <- function(x,
                        robust = FALSE,
                        conf.int = FALSE,
                        conf.level = 0.95,
                        conf.method = "quantile",
                        ...) {
-  tidyMCMC(as.mcmc(x$BUGS),
+
+  tidyMCMC(coda::as.mcmc(x$BUGS),
            robust = robust,
            conf.int = conf.int,
            conf.level = conf.level,
@@ -178,6 +178,7 @@ tidy.mcmc.list <- tidyMCMC
 
 ## copied from emdbook ...
 as.mcmc.bugs <- function (x) {
+
     if (x$n.chains > 1) {
         z <- list()
         for (i in 1:x$n.chains) {

R/rstanarm_tidiers.R

@@ -114,6 +114,7 @@ tidy.stanreg <- function(x,
         }
 
         if (conf.int) {
+
             cifix <- switch(conf.method,
                             HPDinterval= {
                                 m <- as.matrix(x$stanfit)

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