Merge pull request #163 from sfcheung/devel

0.11.2

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: semlbci
 Title: Likelihood-Based Confidence Interval in Structural Equation Models
-Version: 0.11.0
+Version: 0.11.2
 Authors@R:
     c(
       person(given = "Shu Fai",

NEWS.md

@@ -1,4 +1,4 @@
-# semlbci 0.11.0
+# semlbci 0.11.2
 
 ## New Feature
 

R/ci_bound_ur_i.R

@@ -412,9 +412,21 @@ ci_bound_ur_i <- function(i = NULL,
         check_level_of_confidence <- TRUE
       }
 
-    if (!all(check_optimization,
-             check_post_check,
-             check_level_of_confidence)) {
+    if (!is.na(bound)) {
+        check_direction <- switch(which,
+                             lbound = (bound < i_est),
+                             ubound = (bound > i_est))
+        if (!check_direction) {
+            status <- 1
+          }
+      } else {
+        check_direction <- NA
+      }
+
+    if (!all(isTRUE(check_optimization),
+             isTRUE(check_post_check),
+             isTRUE(check_level_of_confidence),
+             isTRUE(check_direction))) {
         bound <- NA
       }
 
@@ -450,7 +462,9 @@ ci_bound_ur_i <- function(i = NULL,
                  standardized = standardized,
                  check_optimization = check_optimization,
                  check_post_check = check_post_check,
-                 check_level_of_confidence = check_level_of_confidence
+                 check_level_of_confidence = check_level_of_confidence,
+                 check_direction = check_direction,
+                 interval0 = interval0
                  )
     if (verbose) {
         out0 <- out
@@ -461,8 +475,8 @@ ci_bound_ur_i <- function(i = NULL,
         diag$history <- NULL
         diag$fit_final <- NULL
       }
-    if (status < 0) {
-        # If convergence status < 0, override verbose
+    if (status != 0) {
+        # If status != 0, override verbose
         diag$history <- out
       }
     out <- list(bound = bound,
@@ -579,7 +593,8 @@ ci_bound_ur_i <- function(i = NULL,
 #' to the argument `extendInt` of
 #' [uniroot()]. Whether the interval
 #' should be extended if the root is not
-#' found. Default is `"yes"`. Refer to
+#' found. Default value depends on
+#' the bound to be searched. Refer to
 #' the help page of [uniroot()] for
 #' possible values.
 #'
@@ -678,7 +693,7 @@ ci_bound_ur <- function(sem_out,
                         tol = .0005, # This is the tolerance in x, not in y
                         root_target = c("chisq", "pvalue"),
                         d = 5,
-                        uniroot_extendInt = "yes",
+                        uniroot_extendInt = switch(which, lbound = "downX", ubound = "upX"),
                         uniroot_trace = 0,
                         uniroot_maxiter = 1000,
                         use_callr = TRUE,

R/ci_bound_wn_i.R

@@ -541,6 +541,12 @@ ci_bound_wn_i <- function(i = NULL,
                         opts)
     try_harder <- as.integer(max(try_harder, 0))
     try_harder_count <- 0
+    # Make sure the starting values are within the bounds
+    xstart <- pmin(pmax(xstart,
+                        fit_lb_na,
+                        na.rm = TRUE),
+                   fit_ub_na,
+                   na.rm = TRUE)
     xstart_i <- xstart
     while(try_harder_count <= try_harder) {
         out <- tryCatch(nloptr::nloptr(
@@ -562,7 +568,11 @@ ci_bound_wn_i <- function(i = NULL,
             xstart_i <- stats::runif(length(xstart_i),
                                      min = -2,
                                      max = 2) * xstart_i
-            xstart_i <- pmin(pmax(xstart_i, fit_lb_na), fit_ub_na)
+            xstart_i <- pmin(pmax(xstart_i,
+                                  fit_lb_na,
+                                  na.rm = TRUE),
+                             fit_ub_na,
+                             na.rm = TRUE)
             try_harder_count <- try_harder_count + 1
           } else {
             try_harder_count <- Inf

README.md

@@ -9,7 +9,7 @@
 [![DOI](https://img.shields.io/badge/doi-10.1080/10705511.2023.2183860-blue.svg)](https://doi.org/10.1080/10705511.2023.2183860)
 <!-- badges: end -->
 
-(Version 0.11.0, updated on 2024-06-01 [release history](https://sfcheung.github.io/semlbci/news/index.html))
+(Version 0.11.2, updated on 2024-06-05 [release history](https://sfcheung.github.io/semlbci/news/index.html))
 
 # semlbci <img src="man/figures/logo.png" align="right" height="150" />