change CI to return NA per MJS when monotonic

OHDSI · Jan 9, 2025 · ca2c024 · ca2c024
1 parent a49a520
commit ca2c024
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 7 deletions.
diff --git 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
@@ -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]))
 })