From 3ddec2af4369a68d69e79ec7d479f7b1ecf502af Mon Sep 17 00:00:00 2001
From: seonghobae <8172694+seonghobae@users.noreply.github.com>
Date: Tue, 18 Aug 2026 04:22:08 +0000
Subject: [PATCH] Optimize ifelse with vectorized subsetting in llcont.glm

Replaced two instances of `ifelse()` with preallocation and vectorized
subsetting in the `binomial` family branch of `llcont.glm` to improve
performance.
---
 R/llcont.R                | 12 ++++++++--
 benchmark_hurdle_ifelse.R | 48 ---------------------------------------
 2 files changed, 10 insertions(+), 50 deletions(-)
 delete mode 100644 benchmark_hurdle_ifelse.R

diff --git a/R/llcont.R b/R/llcont.R
index d8e496a..6f20b62 100644
--- a/R/llcont.R
+++ b/R/llcont.R
@@ -53,12 +53,20 @@ llcont.glm <- function(x, ...){
              if(is.matrix(y)) {
                ## Bolt: replaced apply(..., 1, sum) with optimized rowSums() for performance
                n <- rowSums(y)
-               y <- ifelse(n == 0, 0, y[, 1]/n)
+               ## Bolt: replaced ifelse with preallocation and vectorized subsetting for performance
+               res_y <- y[, 1] * 0
+               cond <- n != 0
+               res_y[cond] <- y[cond, 1]/n[cond]
+               y <- res_y
              } else {
                n <- rep.int(1, length(y))
              }
              m <- if (any(n > 1)) n else wt
-             wt <- ifelse(m > 0, (wt/m), 0)
+             ## Bolt: replaced ifelse with preallocation and vectorized subsetting for performance
+             res_wt <- wt * 0
+             cond <- m > 0
+             res_wt[cond] <- wt[cond]/m[cond]
+             wt <- res_wt
              dbinom(round(m * y), round(m), mpreds, log = TRUE) * wt
            },
            quasibinomial = {
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")