too much at once (brms, fix check problems, rstanarm)

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

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)

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

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()

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"),

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")))
 }