modification to bootSem for R sem package to prevent crashing on Mac

bootSem2.R

# bootstrapped standard errors and confidence intervals for sem
# original sem code from sem:::bootSem.sem
# original post: http://r.789695.n4.nabble.com/Bootstrap-bootSem-causes-R-to-crash-tp4661900p4677999.html


# commented out lines referencing tcltk

bootSem2 <- function (model, R = 100, Cov = cov, data = model$data, max.failures = 10, 
          ...) 
{
  refit <- function() {
    indices <- sample(N, N, replace = TRUE)
    S <- Cov(data[indices, ])
    refitted.model <- sem(ram, S, N, param.names = coef.names, 
                          var.names = var.names, optimizer = model$optimizer, 
                          objective = model$objective, ...)
    refitted.model$coeff
  }
  if (!require("boot")) 
    stop("package boot not available")
  #has.tcltk <- require("tcltk")
  #if (has.tcltk) 
  #  pb <- tkProgressBar("Bootstrap Sampling", "Bootstrap sample: ", 
  #                      0, R)
  if (!exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) 
    runif(1)
  seed <- get(".Random.seed", envir = .GlobalEnv, inherits = FALSE)
  warn <- options(warn = -2)
  on.exit(options(warn))
  nErrors <- 0
  if (is.null(data)) 
    stop("the model object doesn't contain a data matrix")
  N <- nrow(data)
  coefficients <- model$coeff
  coef.names <- names(coefficients)
  var.names <- model$var.names
  ram <- model$ram
  ram[coef.names, "start value"] <- coefficients
  coefs <- matrix(numeric(0), R, length(coefficients))
  colnames(coefs) <- coef.names
  for (b in 1:R) {
    #if (has.tcltk) 
    #  setTkProgressBar(pb, b, label = sprintf("Bootstrap sample: %d", 
    #                                          b))
    for (try in 1:(max.failures + 1)) {
      if (try > max.failures) 
        stop("more than ", max.failures, " consecutive convergence failures")
      res <- try(refit(), silent = TRUE)
      if (inherits(res, "try-error")) 
        nErrors <- nErrors + 1
      else {
        coefs[b, ] <- res
        (break)()
      }
    }
  }
  options(warn)
  if (nErrors > 0) 
    warning("there were", nErrors, "apparent convergence failures;\nthese are discarded from the", 
            R, "bootstrap replications returned")
  res <- list(t0 = coefficients, t = coefs, R = R, data = data, 
              seed = seed, statistic = refit, sim = "ordinary", stype = "i", 
              call = match.call(), strata = rep(1, N), weights = rep(1/N, 
                                                                     N))
  res$call[[1]] <- as.name("bootSem")
  #if (has.tcltk) 
  #  close(pb)
  class(res) <- c("bootsem", "boot")
  res
}