diff --git a/R/stan_glm.R b/R/stan_glm.R index 94c4acf34..b332355af 100644 --- a/R/stan_glm.R +++ b/R/stan_glm.R @@ -236,6 +236,7 @@ stan_glm <- if (is.empty.model(mt)) stop("No intercept or predictors specified.", call. = FALSE) X <- model.matrix(mt, mf, contrasts) + contrasts <- attr(X, "contrasts") weights <- validate_weights(as.vector(model.weights(mf))) offset <- validate_offset(as.vector(model.offset(mf)), y = Y) if (binom_y_prop(Y, family, weights)) { @@ -277,7 +278,7 @@ stan_glm <- fit <- nlist(stanfit, algorithm, family, formula, data, offset, weights, x = X, y = Y, model = mf, terms = mt, call, na.action = attr(mf, "na.action"), - contrasts = attr(X, "contrasts"), + contrasts = contrasts, stan_function = "stan_glm") out <- stanreg(fit) diff --git a/tests/testthat/test_stan_glm.R b/tests/testthat/test_stan_glm.R index 6f18f735c..fcc91ac88 100644 --- a/tests/testthat/test_stan_glm.R +++ b/tests/testthat/test_stan_glm.R @@ -457,3 +457,12 @@ test_that("posterior_predict compatible with glms", { expect_linpred_equal(fit_igaus) }) + + +test_that("contrasts attribute isn't dropped", { + contrasts <- list(wool = "contr.sum", tension = "contr.sum") + fit <- stan_glm(breaks ~ wool * tension, data = warpbreaks, + contrasts = contrasts, + chains = 1, refresh = 0) + expect_equal(fit$contrasts, contrasts) +})