From 93ba51a96451efda2797bcc1230a796f33f7bec8 Mon Sep 17 00:00:00 2001
From: taekop <taekop@naver.com>
Date: Tue, 29 Sep 2026 11:32:14 +0900
Subject: [PATCH] Fix novel level value in step_lencode_glm()

---
 NEWS.md                           |  2 ++
 R/lencode_glm.R                   | 22 +++++++++++++++++++---
 man/step_lencode_glm.Rd           |  3 ++-
 tests/testthat/test-lencode_glm.R | 26 ++++++++++++++++++++++++++
 4 files changed, 49 insertions(+), 4 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index cd5a018e..c8cc74d0 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,7 @@
 # embed (development version)
 
+* Fixed bug where `step_lencode_glm()` calculated the value for novel levels from the mean of the per-level coefficients instead of a pooled model fit to the whole outcome. (#243)
+
 # embed 1.2.2
 
 * Fixed bug on step_umap() where the number of calculated components would be zero. (#271)
diff --git a/R/lencode_glm.R b/R/lencode_glm.R
index 0ce73652..e949115c 100644
--- a/R/lencode_glm.R
+++ b/R/lencode_glm.R
@@ -40,7 +40,8 @@
 #' factor outcomes are used, the log-odds reflect the event of interest being
 #' the _first_ level of the factor.
 #'
-#' For novel levels, a slightly timmed average of the coefficients is returned.
+#' For novel levels, the coefficient of an intercept-only model fit to the
+#' whole outcome is returned.
 #'
 #' # Tidying
 #'
@@ -168,10 +169,12 @@ glm_coefs <- function(x, y, wts = NULL, ...) {
     x <- as_tibble(x)
   }
 
+  dat <- vec_cbind(x, y)
+
   mod <-
     glm(
       form,
-      data = vec_cbind(x, y),
+      data = dat,
       family = fam,
       weights = wts,
       na.action = na.omit,
@@ -182,7 +185,20 @@ glm_coefs <- function(x, y, wts = NULL, ...) {
   names(coefs) <- gsub("^value", "", names(coefs))
   mean_coef <- mean(coefs, na.rm = TRUE, trim = .1)
   coefs[is.na(coefs)] <- mean_coef
-  coefs <- c(coefs, ..new = mean_coef)
+
+  # For unseen levels, use the coefficient of a pooled model (i.e. the
+  # overall outcome mean on the link scale) rather than a trimmed mean of
+  # the per-level coefficients. See #243.
+  new_form <- as.formula(paste0(names(y), "~ 1"))
+  new_mod <- glm(
+    new_form,
+    data = dat,
+    family = fam,
+    weights = wts,
+    na.action = na.omit,
+    ...
+  )
+  coefs <- c(coefs, ..new = unname(coef(new_mod)))
   if (is.factor(y[[1]])) {
     coefs <- -coefs
   }
diff --git a/man/step_lencode_glm.Rd b/man/step_lencode_glm.Rd
index a883ae60..045d4838 100644
--- a/man/step_lencode_glm.Rd
+++ b/man/step_lencode_glm.Rd
@@ -64,7 +64,8 @@ units. The coefficients are created using a no intercept model and, when two
 factor outcomes are used, the log-odds reflect the event of interest being
 the \emph{first} level of the factor.
 
-For novel levels, a slightly timmed average of the coefficients is returned.
+For novel levels, the coefficient of an intercept-only model fit to the
+whole outcome is returned.
 }
 \section{Tidying}{
 When you \code{\link[recipes:tidy.recipe]{tidy()}} this step, a tibble is returned with
diff --git a/tests/testthat/test-lencode_glm.R b/tests/testthat/test-lencode_glm.R
index e5c09959..39e5a8f9 100644
--- a/tests/testthat/test-lencode_glm.R
+++ b/tests/testthat/test-lencode_glm.R
@@ -238,6 +238,32 @@ test_that("bad args", {
   )
 })
 
+test_that("new level value is based on a pooled model, not per-level coefs (#243)", {
+  reg_test <- recipe(x1 ~ ., data = ex_dat) |>
+    step_lencode_glm(x3, outcome = vars(x1)) |>
+    prep(training = ex_dat, retain = TRUE)
+
+  ref_mod <- glm(x1 ~ 1, data = ex_dat, family = gaussian)
+
+  key <- reg_test$steps[[1]]$mapping$x3
+  expect_equal(
+    key$..value[key$..level == "..new"],
+    unname(coef(ref_mod))
+  )
+
+  class_test <- recipe(x2 ~ ., data = ex_dat) |>
+    step_lencode_glm(x3, outcome = vars(x2)) |>
+    prep(training = ex_dat, retain = TRUE)
+
+  ref_mod_cls <- glm(x2 ~ 1, data = ex_dat, family = binomial)
+
+  key_cls <- class_test$steps[[1]]$mapping$x3
+  expect_equal(
+    key_cls$..value[key_cls$..level == "..new"],
+    -unname(coef(ref_mod_cls))
+  )
+})
+
 test_that("case weights", {
   wts_int <- rep(c(0, 1), times = c(100, 400))