extra error handling for when lavaan models fail evaluation of likeli…

…hood

R/evaluateDataLikelihood.R

@@ -94,6 +94,9 @@ evaluateDataLikelihood <-
       #  eval(parse(text=paste(model@Options$model.type,'(lavaan::parTable(model),data=data,missing=\'',
       #                        model@Options$missing,'\')',sep="")))),silent=FALSE)
 
+      ll <- NA
+
+      tryCatch({
       modelrun <- lavaan::lavaan(
         lavaan::parTable(model),
         data = data,
@@ -106,6 +109,11 @@ evaluateDataLikelihood <-
       # evaluate likelihood
       ll <- -2 * lavaan::logLik(modelrun)
 
+      },error = function(e) {
+        ui_warn("Could not evaluate lavaan model likelihood. Lavaan had the following error:\n ",e)
+
+      })
+
       return(ll)
 
     } else {

R/semforest.R

@@ -215,6 +215,14 @@ semforest <- function(model,
   # postprocess to correct any erroneous trees
   trees <- lapply(X = trees, FUN = postprocess)
 
+  # remove NULL trees
+  if (semforest.control$remove_dead_trees) {
+    null_trees <- sapply(FUN=is.null, trees)
+    if (sum(null_trees)>0) ui_warn("Removing ", sum(null_trees)," trees with errors.")
+    trees[null_trees]<-NULL
+    forest.data[null_trees]<-NULL
+  }
+
   # store all results in result object
   result$covariates <- covariates
   result$data <- data

R/semforest.control.R

@@ -1,35 +1,42 @@
 #' SEM Forest Control Object
-#' 
+#'
 #' A SEM Forest control object to tune parameters of the forest learning
 #' algorithm.
-#' 
-#' 
+#'
+#'
 #' @aliases semforest.control print.semforest.control
 #' @param num.trees Number of trees.
 #' @param sampling Sampling procedure. Can be subsample or bootstrap.
 #' @param control A SEM Tree control object. Will be generated by default.
 #' @param mtry Number of subsampled covariates at each node.
+#' @param remove_dead_trees Remove trees from forest that had runtime errors
 #' @author Andreas M. Brandmaier, John J. Prindle
 #' @references Brandmaier, A.M., Oertzen, T. v., McArdle, J.J., & Lindenberger,
 #' U. (2013). Structural equation model trees. \emph{Psychological Methods},
 #' 18(1), 71-86.
-#' 
+#'
 #' @export
-semforest.control <- function(num.trees=5, sampling="subsample", control=NA, mtry=2)
-{
-	options <- list()
-	options$num.trees <- num.trees
-	options$sampling <- sampling
-	options$premtry <- 0
-	options$mtry <- mtry
-	if (all(is.na(control))) {
-		options$semtree.control <- semtree.control()
-    options$semtree.control$method <- "fair"
-    options$semtree.control$alpha <- 1
-    options$semtree.control$exclude.heywood <- FALSE
-	} else {
-		options$semtree.control <- control
-	}
-	class(options) <- "semforest.control"
+semforest.control <-
+  function(num.trees = 5,
+           sampling = "subsample",
+           control = NA,
+           mtry = 2,
+           remove_dead_trees = TRUE)
+  {
+    options <- list()
+    options$num.trees <- num.trees
+    options$sampling <- sampling
+    options$premtry <- 0
+    options$mtry <- mtry
+    if (all(is.na(control))) {
+      options$semtree.control <- semtree.control()
+      options$semtree.control$method <- "fair"
+      options$semtree.control$alpha <- 1
+      options$semtree.control$exclude.heywood <- FALSE
+    } else {
+      options$semtree.control <- control
+    }
+    options$remove_dead_trees <- remove_dead_trees
+    class(options) <- "semforest.control"
     return(options)
-}
+  }