Merge pull request #405 from lucdw/master

better performance in lav_model_information
yrosseel · Dec 20, 2024 · e65e642 · e65e642
2 parents aacf667 + d76bb8f
commit e65e642
Show file tree

Hide file tree

Showing 2 changed files with 10 additions and 4 deletions.
diff --git a/R/lav_matrix.R b/R/lav_matrix.R
@@ -274,6 +274,9 @@ lav_matrix_vechr_reverse <- lav_matrix_vechu_reverse <-
 lav_matrix_diag_idx <- function(n = 1L) {
   # if(n < 1L) return(integer(0L))
   n <- as.integer(n)
+  if (n < 1L) {
+    return(integer(0L))
+  }
   if (lav_use_lavaanC()) {
     return(lavaanC::m_diag_idx(n))
   }

diff --git a/R/lav_model_information.R b/R/lav_model_information.R
@@ -153,7 +153,6 @@ lav_model_information_expected <- function(lavmodel = NULL,
         )
       Info.group[[g]] <- fg * Info.g
     } else {
-      # ldw_trace(paste(sum(Delta[[g]] == 0),"/",length(Delta[[g]])))
       # compute information for this group
       if (lavmodel@estimator %in% c("DWLS", "ULS")) {
         # diagonal weight matrix
@@ -162,9 +161,13 @@ lav_model_information_expected <- function(lavmodel = NULL,
       } else {
         # full weight matrix
         if (lav_use_lavaanC()) {
-          Info.group[[g]] <-
-            fg * lavaanC::m_prod(
-              lavaanC::m_crossprod(Delta[[g]], A1[[g]], "L"), Delta[[g]], "R")  
+        # (i) use of m_crossprod with sparse matrix on the left:
+        # Info.group[[g]] <- fg * lavaanC::m_crossprod(Delta[[g]], 
+        #                     lavaanC::m_prod(A1[[g]], Delta[[g]], "R"), "L")
+        #
+        # (ii) use of m_prod on transposed sparse first matrix, faster than (i):
+          Info.group[[g]] <- fg * lavaanC::m_prod(t(Delta[[g]]), 
+                              lavaanC::m_prod(A1[[g]], Delta[[g]], "R"), "L")
         } else {
           Info.group[[g]] <-
             fg * (crossprod(Delta[[g]], A1[[g]]) %*% Delta[[g]])