R/semforest.control.R

In brandmaier/semtree: Recursive Partitioning for Structural Equation Models

#' SEM Forest Control Object
#'
#' A SEM Forest control object to tune parameters of the forest learning
#' algorithm.
#'
#'
#' @aliases semforest.control semforest_control print.semforest.control semforest_score_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,
           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 {
      # 1.9.2022: switch refit to TRUE
      if (base::isFALSE(control$refit)) {
        warning("refit = FALSE detected. Models in root nodes require estimation for forests. Set refit to TRUE")
        control$refit <- TRUE
      }
      options$semtree.control <- control
    }
    options$remove_dead_trees <- remove_dead_trees
    class(options) <- "semforest.control"
    return(options)
  }

#' @export
semforest_score_control <- function(...)
{
  ctrl <- semforest.control(...)
  ctrl$semtree.control$method <- "score"
  
  return(ctrl)
}

#' @export
semforest_control <- function(...)
{
  semforest.control(...)
}