From ca2c0248ad76b4d4659d9cb4e1ea8121e9be08c1 Mon Sep 17 00:00:00 2001
From: Marc Suchard <msuchard@ucla.edu>
Date: Thu, 9 Jan 2025 10:54:00 -0800
Subject: [PATCH] change CI to return NA per MJS when monotonic

---
 R/ModelFit.R                    | 19 +++++++++++++------
 tests/testthat/test-finiteMLE.R |  2 +-
 2 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/R/ModelFit.R b/R/ModelFit.R
index e244e838..0d93f917 100644
--- a/R/ModelFit.R
+++ b/R/ModelFit.R
@@ -845,6 +845,7 @@ confint.cyclopsFit <- function(object, parm, level = 0.95, #control,
     .checkInterface(object$cyclopsData, testOnly = TRUE)
     #.setControl(object$cyclopsData$cyclopsInterfacePtr, control)
 
+    savedParm <- parm
     parm <- .checkCovariates(object$cyclopsData, parm)
     if (level < 0.01 || level > 0.99) {
         stop("level must be between 0 and 1")
@@ -861,13 +862,19 @@ confint.cyclopsFit <- function(object, parm, level = 0.95, #control,
     hessianDiagonal <- .cyclopsGetLogLikelihoodHessianDiagonal(object$cyclopsData$cyclopsInterfacePtr,
                                                                parm)
     if (any(hessianDiagonal > maximumCurvature)) {
-        stop("Cannot estimate confidence interval for a monotonic log-likelihood function")
-    }
+        warning("Cannot estimate confidence interval for a monotonic log-likelihood function")
+
+        prof <- data.frame(covariates = savedParm,
+                           lower = rep(NA, length(parm)),
+                           upper = rep(NA, length(parm)),
+                           evaluations = rep(NA, length(parm)))
+    } else {
 
-    prof <- .cyclopsProfileModel(object$cyclopsData$cyclopsInterfacePtr, parm,
-                                 threads, threshold,
-                                 overrideNoRegularization,
-                                 includePenalty)
+        prof <- .cyclopsProfileModel(object$cyclopsData$cyclopsInterfacePtr, parm,
+                                     threads, threshold,
+                                     overrideNoRegularization,
+                                     includePenalty)
+    }
 
     indices <- match(parm, getCovariateIds(object$cyclopsData))
 
diff --git a/tests/testthat/test-finiteMLE.R b/tests/testthat/test-finiteMLE.R
index 14a8942f..97e13815 100644
--- a/tests/testthat/test-finiteMLE.R
+++ b/tests/testthat/test-finiteMLE.R
@@ -25,7 +25,7 @@ test_that("Check for infinite MLE in Cox example with no outcomes in one treatme
     cyclopsData <- createCyclopsData(Surv(time, outcome) ~ exposure, data = data, modelType = "cox")
     expect_warning(fit <- fitCyclopsModel(cyclopsData), regexp =".*coefficient may be infinite.*")
 
-    expect_error(ci <- confint(fit, parm = "exposureTRUE", level = 0.9))
+    expect_warning(ci <- confint(fit, parm = "exposureTRUE", level = 0.9))
     ci <- confint(fit, parm = "exposureTRUE", level = 0.9, maximumCurvature = 0)
     expect_true(is.na(ci[2]))
 })