diff --git a/DESCRIPTION b/DESCRIPTION index 71776ee..be67beb 100644 --- a/DESCRIPTION +++ b/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 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..0c1964c 100644 --- a/R/MCMCglmm_prediction.R +++ b/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") } 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..bc595aa 100644 --- a/R/brms_tidiers.R +++ b/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") { diff --git a/R/lme4_tidiers.R b/R/lme4_tidiers.R index 4eeb0e8..718cbb5 100644 --- a/R/lme4_tidiers.R +++ b/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 %>% diff --git a/R/mcmc_tidiers.R b/R/mcmc_tidiers.R index 9df78e9..65784f7 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,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,7 +146,6 @@ tidyMCMC <- function(x, ##' @rdname mcmc_tidiers -##' @importFrom coda as.mcmc ##' @export tidy.rjags <- function(x, robust = FALSE, @@ -154,7 +153,8 @@ tidy.rjags <- function(x, 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) { diff --git a/R/rstanarm_tidiers.R b/R/rstanarm_tidiers.R index c0155d5..633115e 100644 --- a/R/rstanarm_tidiers.R +++ b/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) 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}