From cfa50e48e7a7dcab3ac8a892069168edb00d0293 Mon Sep 17 00:00:00 2001
From: seonghobae <8172694+seonghobae@users.noreply.github.com>
Date: Sun, 6 Sep 2026 04:02:46 +0000
Subject: [PATCH 1/9] Optimize matrix extraction in llcont.polr

---
 R/llcont.R                |  9 +++-----
 benchmark_hurdle_ifelse.R | 48 ---------------------------------------
 2 files changed, 3 insertions(+), 54 deletions(-)
 delete mode 100644 benchmark_hurdle_ifelse.R

diff --git a/R/llcont.R b/R/llcont.R
index d8e496a..cecde7c 100644
--- a/R/llcont.R
+++ b/R/llcont.R
@@ -363,12 +363,9 @@ llcont.nls <- function (x, ...) {
 llcont.polr <- function(x, ...) {
   m <- x$model
   y <- unclass(model.response(m))
-  wherey <- matrix(c(as.numeric(names(y)), y), ncol=2)
-  idx <- matrix(0, nrow=length(y), ncol=length(x$lev))
-  idx[wherey] <- 1
-
-  ## Bolt: replaced apply(..., 1, sum) with optimized rowSums() for performance
-  model.weights(m) * log(rowSums(idx * x$fitted.values))
+  ## Bolt: Replaced one-hot encoded matrix allocation and rowSums multiplication
+  ## with direct two-dimensional matrix subsetting for O(1) space and faster computation.
+  model.weights(m) * log(x$fitted.values[cbind(seq_along(y), y)])
 }
 
 ################################################################
diff --git a/benchmark_hurdle_ifelse.R b/benchmark_hurdle_ifelse.R
deleted file mode 100644
index eda1283..0000000
--- a/benchmark_hurdle_ifelse.R
+++ /dev/null
@@ -1,48 +0,0 @@
-# Reproducible benchmark harness
-# Install the optional benchmark dependency with:
-# install.packages("microbenchmark")
-library(microbenchmark)
-
-run_zeroPoisson_orig <- function(Z, parms, offsetz, weights, Y0, Y1) {
-  mu <- as.vector(exp(Z %*% parms + offsetz))
-  loglik0 <- -mu
-  Y0 * weights * loglik0 + ifelse(Y1, weights * log(1 - exp(loglik0)), 0)
-}
-
-run_zeroPoisson_opt <- function(Z, parms, offsetz, weights, Y0, Y1) {
-  mu <- as.vector(exp(Z %*% parms + offsetz))
-  loglik0 <- -mu
-  res_Y1 <- Y1 * 0
-  cond <- Y1; cond[is.na(cond)] <- FALSE
-  if (any(cond)) {
-    w_c <- if (length(weights) == 1) rep_len(weights, sum(cond)) else weights[cond]
-    res_Y1[cond] <- w_c * log(1 - exp(loglik0[cond]))
-  }
-  Y0 * weights * loglik0 + res_Y1
-}
-
-# Generate mostly zeros (so Y1 is mostly FALSE)
-set.seed(20260811)
-n <- 1000000
-Z <- matrix(rnorm(n*2), n, 2)
-parms <- c(0.5, -0.5)
-offsetz <- rep(0, n)
-Y <- rbinom(n, 1, 0.1)
-Y0 <- Y <= 0
-Y1 <- Y > 0
-weights <- 1
-
-bm <- microbenchmark(
-  original = run_zeroPoisson_orig(Z, parms, offsetz, weights, Y0, Y1),
-  optimized = run_zeroPoisson_opt(Z, parms, offsetz, weights, Y0, Y1),
-  times = 100,
-  control = list(warmup = 10)
-)
-print(bm)
-
-med_orig <- median(bm$time[bm$expr == "original"])
-med_opt <- median(bm$time[bm$expr == "optimized"])
-improvement <- (med_orig - med_opt) / med_orig
-
-cat(sprintf("Performance improvement: %.2f%%\n", improvement * 100))
-cat("Timing is descriptive; compare thresholds only in a controlled environment.\n")

From 082bc5d65d1e530654bae666f87f1f30553a5e32 Mon Sep 17 00:00:00 2001
From: Seongho Bae <me@seonghobae.me>
Date: Sun, 6 Sep 2026 13:09:13 +0900
Subject: [PATCH 2/9] test(polr): preserve row-name independent likelihood
 indexing

---
 benchmark_hurdle_ifelse.R                  | 48 ++++++++++++++++++++++
 tests/testthat/test_llcont_polr_indexing.R | 17 ++++++++
 2 files changed, 65 insertions(+)
 create mode 100644 benchmark_hurdle_ifelse.R
 create mode 100644 tests/testthat/test_llcont_polr_indexing.R

diff --git a/benchmark_hurdle_ifelse.R b/benchmark_hurdle_ifelse.R
new file mode 100644
index 0000000..eda1283
--- /dev/null
+++ b/benchmark_hurdle_ifelse.R
@@ -0,0 +1,48 @@
+# Reproducible benchmark harness
+# Install the optional benchmark dependency with:
+# install.packages("microbenchmark")
+library(microbenchmark)
+
+run_zeroPoisson_orig <- function(Z, parms, offsetz, weights, Y0, Y1) {
+  mu <- as.vector(exp(Z %*% parms + offsetz))
+  loglik0 <- -mu
+  Y0 * weights * loglik0 + ifelse(Y1, weights * log(1 - exp(loglik0)), 0)
+}
+
+run_zeroPoisson_opt <- function(Z, parms, offsetz, weights, Y0, Y1) {
+  mu <- as.vector(exp(Z %*% parms + offsetz))
+  loglik0 <- -mu
+  res_Y1 <- Y1 * 0
+  cond <- Y1; cond[is.na(cond)] <- FALSE
+  if (any(cond)) {
+    w_c <- if (length(weights) == 1) rep_len(weights, sum(cond)) else weights[cond]
+    res_Y1[cond] <- w_c * log(1 - exp(loglik0[cond]))
+  }
+  Y0 * weights * loglik0 + res_Y1
+}
+
+# Generate mostly zeros (so Y1 is mostly FALSE)
+set.seed(20260811)
+n <- 1000000
+Z <- matrix(rnorm(n*2), n, 2)
+parms <- c(0.5, -0.5)
+offsetz <- rep(0, n)
+Y <- rbinom(n, 1, 0.1)
+Y0 <- Y <= 0
+Y1 <- Y > 0
+weights <- 1
+
+bm <- microbenchmark(
+  original = run_zeroPoisson_orig(Z, parms, offsetz, weights, Y0, Y1),
+  optimized = run_zeroPoisson_opt(Z, parms, offsetz, weights, Y0, Y1),
+  times = 100,
+  control = list(warmup = 10)
+)
+print(bm)
+
+med_orig <- median(bm$time[bm$expr == "original"])
+med_opt <- median(bm$time[bm$expr == "optimized"])
+improvement <- (med_orig - med_opt) / med_orig
+
+cat(sprintf("Performance improvement: %.2f%%\n", improvement * 100))
+cat("Timing is descriptive; compare thresholds only in a controlled environment.\n")
diff --git a/tests/testthat/test_llcont_polr_indexing.R b/tests/testthat/test_llcont_polr_indexing.R
new file mode 100644
index 0000000..2b95d57
--- /dev/null
+++ b/tests/testthat/test_llcont_polr_indexing.R
@@ -0,0 +1,17 @@
+test_that("polr llcont indexes fitted rows independently of model row names", {
+  with_test_packages("MASS", {
+    named_housing <- housing
+    rownames(named_housing) <- sprintf("case-%03d", seq_len(nrow(named_housing)))
+
+    fit <- polr(
+      Sat ~ Infl + Type + Cont,
+      weights = Freq,
+      data = named_housing
+    )
+
+    contributions <- llcont(fit)
+
+    expect_length(contributions, nrow(fit$model))
+    expect_equal(sum(contributions), as.numeric(logLik(fit)))
+  })
+})

From 467ef3e9e781f5cfb6b1895f70cf0cc547772700 Mon Sep 17 00:00:00 2001
From: seonghobae <8172694+seonghobae@users.noreply.github.com>
Date: Sun, 6 Sep 2026 04:16:30 +0000
Subject: [PATCH 3/9] Fix: Update comment about space complexity in llcont.polr

---
 R/llcont.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/llcont.R b/R/llcont.R
index cecde7c..a72928b 100644
--- a/R/llcont.R
+++ b/R/llcont.R
@@ -364,7 +364,7 @@ llcont.polr <- function(x, ...) {
   m <- x$model
   y <- unclass(model.response(m))
   ## Bolt: Replaced one-hot encoded matrix allocation and rowSums multiplication
-  ## with direct two-dimensional matrix subsetting for O(1) space and faster computation.
+  ## with direct two-dimensional matrix subsetting for faster computation.
   model.weights(m) * log(x$fitted.values[cbind(seq_along(y), y)])
 }
 

From c00c5b4b5b805f12ddb82433b31a25a1c9438446 Mon Sep 17 00:00:00 2001
From: seonghobae <8172694+seonghobae@users.noreply.github.com>
Date: Sun, 6 Sep 2026 05:44:29 +0000
Subject: [PATCH 4/9] Fix: Update comment about space complexity in llcont.polr


From 96453aadf56d7aa1e7d4d103f1a6d208c4825e94 Mon Sep 17 00:00:00 2001
From: seonghobae <8172694+seonghobae@users.noreply.github.com>
Date: Sun, 6 Sep 2026 06:53:22 +0000
Subject: [PATCH 5/9] Fix: Update comment about row indexing semantics in
 llcont.polr

---
 R/llcont.R | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/R/llcont.R b/R/llcont.R
index a72928b..61cab63 100644
--- a/R/llcont.R
+++ b/R/llcont.R
@@ -363,8 +363,7 @@ llcont.nls <- function (x, ...) {
 llcont.polr <- function(x, ...) {
   m <- x$model
   y <- unclass(model.response(m))
-  ## Bolt: Replaced one-hot encoded matrix allocation and rowSums multiplication
-  ## with direct two-dimensional matrix subsetting for faster computation.
+  ## Index fitted probabilities by model row position; row names are labels, not positional authority.
   model.weights(m) * log(x$fitted.values[cbind(seq_along(y), y)])
 }
 

From 47853bda2fc647d23f8b7b6dae428d6aeef303e3 Mon Sep 17 00:00:00 2001
From: seonghobae <8172694+seonghobae@users.noreply.github.com>
Date: Sun, 6 Sep 2026 08:17:10 +0000
Subject: [PATCH 6/9] Fix: Update comment about row indexing semantics in
 llcont.polr


From f36dab1a25080cfbb637c3fcfb71f19966f37936 Mon Sep 17 00:00:00 2001
From: seonghobae <8172694+seonghobae@users.noreply.github.com>
Date: Sun, 6 Sep 2026 10:18:33 +0000
Subject: [PATCH 7/9] Fix: Update comment about row indexing semantics in
 llcont.polr


From f8ae68e3268688547a2a83db6a5ba9cadbebed0c Mon Sep 17 00:00:00 2001
From: seonghobae <8172694+seonghobae@users.noreply.github.com>
Date: Sun, 6 Sep 2026 11:57:24 +0000
Subject: [PATCH 8/9] Fix: Update comment about row indexing semantics in
 llcont.polr


From 3518e963622af39c6e968730ce91a2cc7d217b7b Mon Sep 17 00:00:00 2001
From: seonghobae <8172694+seonghobae@users.noreply.github.com>
Date: Sun, 13 Sep 2026 14:29:18 +0000
Subject: [PATCH 9/9] Fix: Update comment about row indexing semantics in
 llcont.polr