From bc846579a36befb940fb9a77c3eff828f061247a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul-Christian=20B=C3=BCrkner?= Date: Wed, 12 Jul 2023 15:45:37 +0200 Subject: [PATCH] fix issue #1501 --- DESCRIPTION | 4 +-- NEWS.md | 2 ++ R/data-response.R | 34 ++++++++------------------ R/make_standata.R | 6 ----- tests/testthat/tests.make_standata.R | 2 -- tests/testthat/tests.posterior_epred.R | 5 +++- 6 files changed, 18 insertions(+), 35 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3f3d3de17..c3b6f21da 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,8 +2,8 @@ Package: brms Encoding: UTF-8 Type: Package Title: Bayesian Regression Models using 'Stan' -Version: 2.19.6 -Date: 2023-05-17 +Version: 2.19.7 +Date: 2023-07-12 Authors@R: c(person("Paul-Christian", "Bürkner", email = "paul.buerkner@gmail.com", role = c("aut", "cre")), diff --git a/NEWS.md b/NEWS.md index 04050ce79..b07af61e3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,6 +14,8 @@ and incompatible with the newly implemented global shrinkage prior framework. * No longer support multiple deprecated prior options for categorical and multivariate models after around 3 years of deprecation. (#1420) * Deprecate argument `newdata` of `get_refmodel.brmsfit()`. (#1502) +* Disallow binomial models without `trials` argument after several years +of deprecation. (#1501) ### Bug Fixes diff --git a/R/data-response.R b/R/data-response.R index 71476223e..013e6c1e2 100644 --- a/R/data-response.R +++ b/R/data-response.R @@ -173,32 +173,18 @@ data_response.brmsterms <- function(x, data, check_response = TRUE, # data for addition arguments of the response if (has_trials(x$family) || is.formula(x$adforms$trials)) { if (!length(x$adforms$trials)) { - if (is_multinomial(x$family)) { - stop2("Specifying 'trials' is required in multinomial models.") - } - trials <- round(max(out$Y, na.rm = TRUE)) - if (isTRUE(is.finite(trials))) { - message("Using the maximum response value as the number of trials.") - warning2( - "Using 'binomial' families without specifying 'trials' ", - "on the left-hand side of the model formula is deprecated." - ) - } else if (!is.null(basis$trials)) { - trials <- max(basis$trials) - } else { - stop2("Could not compute the number of trials.") - } - } else if (is.formula(x$adforms$trials)) { - trials <- get_ad_values(x, "trials", "trials", data) - if (!is.numeric(trials)) { - stop2("Number of trials must be numeric.") - } - if (any(!is_wholenumber(trials) | trials < 0)) { - stop2("Number of trials must be non-negative integers.") - } - } else { + stop2("Specifying 'trials' is required for this model.") + } + if (!is.formula(x$adforms$trials)) { stop2("Argument 'trials' is misspecified.") } + trials <- get_ad_values(x, "trials", "trials", data) + if (!is.numeric(trials)) { + stop2("Number of trials must be numeric.") + } + if (any(!is_wholenumber(trials) | trials < 0)) { + stop2("Number of trials must be non-negative integers.") + } if (length(trials) == 1L) { trials <- rep(trials, nrow(data)) } diff --git a/R/make_standata.R b/R/make_standata.R index 57ab1427f..f20975a3e 100644 --- a/R/make_standata.R +++ b/R/make_standata.R @@ -210,12 +210,6 @@ standata_basis.brmsterms <- function(x, data, ...) { } # old levels are required to select the right indices for new levels out$levels <- get_levels(tidy_meef(x, data), tidy_ranef(x, data)) - if (has_trials(x$family)) { - # trials should not be computed based on new data - datr <- data_response(x, data, check_response = FALSE, internal = TRUE) - # partially match via $ to be independent of the response suffix - out$trials <- datr$trials - } if (is_binary(x$family) || is_categorical(x$family)) { y <- model.response(model.frame(x$respform, data, na.action = na.pass)) out$resp_levels <- levels(as.factor(y)) diff --git a/tests/testthat/tests.make_standata.R b/tests/testthat/tests.make_standata.R index c5cd4fcfd..81009dd0e 100644 --- a/tests/testthat/tests.make_standata.R +++ b/tests/testthat/tests.make_standata.R @@ -162,8 +162,6 @@ test_that("make_standata returns correct values for addition terms", { as.array(c(rep(1:0, 4), 0))) expect_equal(make_standata(y | cens(c4, y + 2) ~ 1, data = dat)$rcens, as.array(c(rep(0, 5), dat$y[6:9] + 2))) - sdata <- suppressWarnings(make_standata(s ~ 1, dat, family = "binomial")) - expect_equal(sdata$trials, as.array(rep(9, 9))) expect_equal(make_standata(s | trials(10) ~ 1, dat, family = "binomial")$trials, as.array(rep(10, 9))) diff --git a/tests/testthat/tests.posterior_epred.R b/tests/testthat/tests.posterior_epred.R index 55eb248be..968c36c06 100644 --- a/tests/testthat/tests.posterior_epred.R +++ b/tests/testthat/tests.posterior_epred.R @@ -65,10 +65,12 @@ test_that("posterior_epred helper functions run without errors", { expect_equal(dim(SW(posterior_epred(fit, summary = FALSE))), c(ndraws, nobs)) # pseudo binomial model + old_formula <- fit$formula$formula + fit$formula$formula <- update(fit$formula$formula, . | trials(100) ~ .) fit$autocor <- brms:::cor_empty() fit$family <- fit$formula$family <- binomial() expect_equal(dim(SW(posterior_epred(fit, summary = FALSE))), c(ndraws, nobs)) - + # pseudo beta-binomial model fit$family <- fit$formula$family <- beta_binomial() expect_equal(dim(SW(posterior_epred(fit, summary = FALSE))), c(ndraws, nobs)) @@ -82,6 +84,7 @@ test_that("posterior_epred helper functions run without errors", { expect_equal(dim(SW(posterior_epred(fit, summary = FALSE))), c(ndraws, nobs)) # pseudo hurdle poisson model + fit$formula$formula <- old_formula fit$family <- fit$formula$family <- hurdle_poisson() fit$formula <- bf(count ~ Trt*Age + mo(Exp) + offset(Age) + (1+Trt|visit), family = family(fit))