From 4fea316540b631a4e5b2de3cf35236bb3fa6e00b Mon Sep 17 00:00:00 2001
From: Ben Bolker <bbolker@gmail.com>
Date: Mon, 27 Nov 2023 11:01:40 -0500
Subject: [PATCH] too much at once (brms, fix check problems, rstanarm)

---
 DESCRIPTION                |  2 +-
 NAMESPACE                  |  3 +++
 R/brms_tidiers.R           | 37 +++++++++++++++++++++++++++++++------
 R/glmm_tidiers.R           |  3 +++
 R/rstanarm_tidiers.R       |  2 +-
 man/rstanarm_tidiers.Rd    |  2 +-
 tests/testthat/test-brms.R |  2 ++
 7 files changed, 42 insertions(+), 9 deletions(-)

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