diff --git a/DESCRIPTION b/DESCRIPTION index c3342df..9ccce94 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -80,4 +80,4 @@ License: GPL-3 Encoding: UTF-8 Additional_repositories: http://bbolker.github.io/drat VignetteBuilder: knitr -RoxygenNote: 7.2.1 +RoxygenNote: 7.2.3 diff --git a/NAMESPACE b/NAMESPACE index 48431cc..79737c7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,6 +29,7 @@ S3method(tidy,allFit) S3method(tidy,brmsfit) S3method(tidy,gamlss) S3method(tidy,gamm4) +S3method(tidy,glmm) S3method(tidy,glmmTMB) S3method(tidy,glmmadmb) S3method(tidy,gls) @@ -62,6 +63,7 @@ importFrom(dplyr,across) importFrom(dplyr,bind_cols) importFrom(dplyr,bind_rows) importFrom(dplyr,mutate) +importFrom(dplyr,tibble) importFrom(forcats,fct_inorder) importFrom(furrr,future_map_dfr) importFrom(methods,is) @@ -92,6 +94,7 @@ importFrom(stats,quantile) importFrom(stats,sd) importFrom(stats,setNames) importFrom(stats,terms) +importFrom(stats,vcov) importFrom(tibble,rownames_to_column) importFrom(tibble,tibble) importFrom(tidyr,complete) diff --git a/R/brms_tidiers.R b/R/brms_tidiers.R index 27b8fa3..37cb04c 100644 --- a/R/brms_tidiers.R +++ b/R/brms_tidiers.R @@ -110,7 +110,10 @@ tidy.brmsfit <- function(x, parameters = NA, ...) { check_dots(...) - + bad_effects <- setdiff(effects, c("fixed", "ran_pars", "ran_vals", "ran_coefs")) + if (length(bad_effects)>0) { + stop("unrecognized effects: ", paste(bad_effects, collapse = ", ")) + } std.error <- NULL ## NSE/code check if (!requireNamespace("brms", quietly=TRUE)) { stop("can't tidy brms objects without brms installed") @@ -226,8 +229,28 @@ tidy.brmsfit <- function(x, parameters = NA, term = sapply(ss2, termfun) ) } + + ## nice, but needs to be done outside averaging loop ... + ## meltfun <- function(a) { + + ## dd <- as.data.frame(ftable(a)) |> + ## setNames(c("level", "var", "term", "value")) |> + ## tidyr::pivot_wider(names_from = var, values_from = value) |> + ## rename(estimate = "Estimate", + ## std.error = "Est.Error", + ## ## FIXME: not robust to changing levels + ## conf.low = "Q2.5", + ## conf.high = "Q97.5") + ## } + + + ## ## purrr:::map_dfr(ranef(x), meltfun, .id = "group") + + ## if ("ran_coefs" %in% effects) { + ## res_list$ran_coefs <- purrr:::map_dfr(coef(x), meltfun, .id = "group") + ## } if ("ran_vals" %in% effects) { - rterms <- grep(mkRE(prefs$ran_vals), terms, value = TRUE) + rterms <- grep(mkRE(prefs$ran_vals), terms, value = TRUE) vals <- stringr::str_match_all(rterms, "_(.+?)\\[(.+?),(.+?)\\]") @@ -242,10 +265,12 @@ tidy.brmsfit <- function(x, parameters = NA, out <- dplyr::bind_rows(res_list, .id = "effect") v <- if (fixed.only) seq(nrow(out)) else is.na(out$term) newterms <- stringr::str_remove(terms[v], mkRE(prefs[c("fixed")])) - if (fixed.only) { - out$term <- newterms - } else { - out$term[v] <- newterms + if (length(newterms)>0) { + if (fixed.only) { + out$term <- newterms + } else { + out$term[v] <- newterms + } } if (is.multiresp) { out$response <- response diff --git a/R/glmm_tidiers.R b/R/glmm_tidiers.R index 11b981e..cfb5264 100644 --- a/R/glmm_tidiers.R +++ b/R/glmm_tidiers.R @@ -1,6 +1,9 @@ ##' @importFrom dplyr bind_rows tibble +##' @importFrom stats vcov ##' @export tidy.glmm <- function(x, effects = "fixed") { + + estimate <- std.error <- statistic <- p.value <- NULL ## avoid check warnings for NSE fix_nm <- names(coef(x)) ran_nm <- x$varcomps.names res <- list() diff --git a/R/rstanarm_tidiers.R b/R/rstanarm_tidiers.R index 42706af..81fb472 100644 --- a/R/rstanarm_tidiers.R +++ b/R/rstanarm_tidiers.R @@ -76,7 +76,7 @@ NULL #' #' @export tidy.stanreg <- function(x, - effects = "fixed", + effects = c("fixed", "ran_pars"), conf.int = FALSE, conf.level = 0.9, conf.method=c("quantile","HPDinterval"), diff --git a/man/rstanarm_tidiers.Rd b/man/rstanarm_tidiers.Rd index 44e4804..667fd47 100644 --- a/man/rstanarm_tidiers.Rd +++ b/man/rstanarm_tidiers.Rd @@ -8,7 +8,7 @@ \usage{ \method{tidy}{stanreg}( x, - effects = "fixed", + effects = c("fixed", "ran_pars"), conf.int = FALSE, conf.level = 0.9, conf.method = c("quantile", "HPDinterval"), diff --git a/tests/testthat/test-brms.R b/tests/testthat/test-brms.R index e1c259b..894eea3 100644 --- a/tests/testthat/test-brms.R +++ b/tests/testthat/test-brms.R @@ -17,4 +17,6 @@ if (require(brms, quietly = TRUE) && require(rstanarm, quietly=TRUE)) { ## GH #101 gg <- glance(brms_noran) expect_equal(names(gg),c("algorithm","pss","nobs","sigma")) + + expect_error(suppressWarnings(tidy(brms_multi, effects = "junk"))) }