improve decision about when to compute mll, fixing #81

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: blavaan
 Title: Bayesian Latent Variable Analysis
-Version: 0.5-5.1290
+Version: 0.5-5.1291
 Authors@R: c(person(given = "Edgar", family = "Merkle",
                     role = c("aut", "cre"),
                     email = "[email protected]",

R/blav_utils.R

@@ -409,9 +409,21 @@ checkcovs <- function(lavobject){
     psinums <- sapply(psis, function(x) x[lower.tri(x)])
     diagpsi <- all(unlist(psinums) == 0L, na.rm = TRUE)
     fullpsi <- all(unlist(psinums) > 0L, na.rm = TRUE) & (anyDuplicated(unlist(psinums), MARGIN = 0) == 0L)
+    ## check for blocks of free covariances that have no impact on each other
+    psiblk <- sapply(psis, function(x) {
+      x[!lower.tri(x)] <- 0
+      frnums <- which(x > 0, arr.ind = TRUE)
+      if (nrow(frnums) > 0) {
+        blk <- !duplicated(as.numeric(frnums))
+      } else {
+        blk <- TRUE
+      }
+      blk} )
+    blkp <- all(psiblk)
   } else {
     diagpsi <- FALSE
     fullpsi <- TRUE
+    blkp <- TRUE
   }
 
   if (nrow(free[[1]]$theta) > 0) {
@@ -420,12 +432,24 @@ checkcovs <- function(lavobject){
     diagthet <- all(unlist(thetnums) == 0L, na.rm = TRUE)
     ## surprising if this happens:
     fullthet <- all(unlist(thetnums) > 0L, na.rm = TRUE) & (anyDuplicated(unlist(thetnums), MARGIN = 0) == 0L)
+    ## check for blocks of free covariances that have no impact on each other
+    thetblk <- sapply(thets, function(x) {
+      x[!lower.tri(x)] <- 0
+      frnums <- which(x > 0, arr.ind = TRUE)
+      if (nrow(frnums) > 0) {
+        blk <- !duplicated(as.numeric(frnums))
+      } else {
+        blk <- TRUE
+      }
+      blk} )
+    blkt <- all(thetblk)
   } else {
     diagthet <- FALSE
     fullthet <- TRUE
+    blkt <- TRUE
   }
 
-  list(diagpsi = diagpsi, fullpsi = fullpsi, diagthet = diagthet, fullthet = fullthet)
+  list(diagpsi = diagpsi, fullpsi = fullpsi, diagthet = diagthet, fullthet = fullthet, dobf = (blkp && blkt))
 }
 
 ## check whether model cov matrix is block diagonal

R/blavaan.R

@@ -1037,9 +1037,24 @@ blavaan <- function(...,  # default lavaan arguments
     domll <- TRUE
     covres <- checkcovs(LAV)
     ## in these cases, we cannot reliably evaluate the priors
-    if(ordmod | !(covres$diagthet | covres$fullthet)) domll <- FALSE
-    if(target == "stan" && !l2s$blkpsi) domll <- FALSE
-    if(target != "stan" && !(covres$diagpsi | covres$fullpsi)) domll <- FALSE
+    if(ordmod) domll <- FALSE
+    if(target == "stan") {
+      if(covres$dobf) {
+        domll <- TRUE
+      } else if((covres$diagthet | covres$fullthet) & l2s$blkpsi) {
+        domll <- TRUE
+      } else {
+        domll <- FALSE
+      }
+    } else {
+      if(covres$dobf) {
+        domll <- TRUE
+      } else if((covres$diagpsi | covres$fullpsi) & covres$diagthet) {
+        domll <- TRUE
+      } else {
+        domll <- FALSE
+      }
+    }
 
     if(lavoptions$test != "none") { # && attr(x, "converged")) {
         TEST <- blav_model_test(lavmodel            = lavmodel,