From f7106d4dca190e184fc758ea21d26c0c33f22a85 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Paul-Christian=20B=C3=BCrkner?= <paul.buerkner@gmail.com>
Date: Fri, 8 Nov 2024 09:24:29 +0100
Subject: [PATCH] fix issue #1703

---
 DESCRIPTION         |  2 +-
 NEWS.md             |  4 ++++
 R/stan-likelihood.R | 14 +++++++-------
 3 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 7818f9c0..27e8c5fa 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: brms
 Encoding: UTF-8
 Type: Package
 Title: Bayesian Regression Models using 'Stan'
-Version: 2.22.4
+Version: 2.22.5
 Date: 2024-11-08
 Authors@R:
     c(person("Paul-Christian", "Bürkner", email = "paul.buerkner@gmail.com",
diff --git a/NEWS.md b/NEWS.md
index e2c9d216..eb5351b4 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -5,6 +5,10 @@
 * Fit extended-support Beta models via family `xbeta` 
 thanks to Ioannis Kosmidis. (#1698)
 
+### Other Changes
+
+* Improve sampling efficiency of `beta_binomial` models. (#1703)
+
 # brms 2.22.0
 
 ### New Features
diff --git a/R/stan-likelihood.R b/R/stan-likelihood.R
index aa417283..7884b27a 100644
--- a/R/stan-likelihood.R
+++ b/R/stan-likelihood.R
@@ -629,14 +629,15 @@ stan_log_lik_binomial <- function(bterms, ...) {
 }
 
 stan_log_lik_beta_binomial <- function(bterms, ...) {
-  p <- stan_log_lik_dpars(bterms, reqn = TRUE)
+  p <- stan_log_lik_dpars(bterms)
   p$trials <- stan_log_lik_advars(bterms, "trials", ...)$trials
+  req_dot_multiply <- !stan_log_lik_adj(bterms) && is_pred_dpar(bterms, "phi")
+  multiply <- str_if(req_dot_multiply, " .* ", " * ")
   sdist(
     "beta_binomial",
     p$trials,
-    paste0(p$mu, " * ", p$phi),
-    paste0("(1 - ", p$mu, ") * ", p$phi),
-    vec = FALSE
+    paste0(p$mu, multiply, p$phi),
+    paste0("(1 - ", p$mu, ")", multiply, p$phi)
   )
 }
 
@@ -732,9 +733,8 @@ stan_log_lik_beta <- function(bterms, ...) {
 }
 
 stan_log_lik_xbeta <- function(bterms, ...) {
-  reqn <- stan_log_lik_adj(bterms)
-  p <- stan_log_lik_dpars(bterms, reqn = reqn)
-  sdist("xbeta", p$mu, p$phi, p$kappa, vec = TRUE)
+  p <- stan_log_lik_dpars(bterms)
+  sdist("xbeta", p$mu, p$phi, p$kappa)
 }
 
 stan_log_lik_von_mises <- function(bterms, ...) {