R/fitmod.R

Defines functions fitmod

# Internal function used for fitting models

#' @importFrom lavaan lavaan lavInspect fitMeasures
fitmod <- function(indx,lavmodel,out_mat,vnames,j,saveModel,d,fit.measure){

  temp_matrix <- matrix(out_mat[,indx],d,d)
  colnames(temp_matrix) <- rownames(temp_matrix) <- vnames

  # added from ShortForm Tabu code; nuke all starting values? Does this work? Not with older lavaan version
  ptab <- lavmodel@ParTable
  ptab$est <- NULL
  ptab$start <- NULL
  #lavmodel@ParTable$est<-NULL
  #lavmodel@ParTable$start<-NULL

  # replaced with update()?; might be slower, but more stable? (doesn't work with older lavaan version)
  #res<-try({my_fitted_model<-update(lavmodel, sample.cov=temp_matrix)

  res<-try ({
    lavmodel@Options$se="none"
    lavmodel@Options$start="default"
    lavmodel@Options$do.fit=TRUE

    my_fitted_model<-lavaan(sample.cov=temp_matrix,
                            sample.nobs=lavInspect(lavmodel,"nobs"),
                            slotOptions = lavmodel@Options,
                            slotParTable = ptab,
                            slotCache = lavmodel@Cache)

    if(my_fitted_model@optim$converged){

      #Store fit values
      fit_out <- fitMeasures(my_fitted_model, fit.measure)
    } else {
      fit_out <-rep(NA,length(fit.measure))
    }

    # regardless, save fitted lavaan model for later inspection
    if(saveModel) {
      attr(fit_out,"model")<-my_fitted_model
    }

  }, silent=T)

  if(class(res)!="try-error"){
    return(fit_out)
  } else {
    return(rep(NA,length(fit.measure)))
  }
}
falkcarl/ockhamSEM documentation built on June 23, 2024, 4:25 a.m.