R/ctModelFromFit.R

In ctsemOMX: Continuous Time SEM - 'OpenMx' Based Functions

#' Extract a ctsem model structure with parameter values from a ctsem fit object.
#'
#' @param fit object output by \code{\link{ctFit}}
#'
#' @return object of class 'ctsemInit' (as generated by \code{\link{ctModel}}), 
#' which can be used with \code{\link{ctFit}} and functions.
#' @export
#'
#' @examples
#' data(AnomAuth) 
#' AnomAuthmodel <- ctModel(LAMBDA = matrix(c(1, 0, 0, 1), nrow = 2, ncol = 2), 
#'   Tpoints = 5, n.latent = 2, n.manifest = 2, MANIFESTVAR=diag(0, 2)) 
#' AnomAuthfit <- ctFit(AnomAuth, AnomAuthmodel)
#' 
#' fitmodel <- ctModelFromFit(AnomAuthfit)
ctModelFromFit <- function(fit){
  if(!'ctsemFit' %in% class(fit)) stop('not a ctsemFit object')
  s=summary(fit,verbose=TRUE)
  gm=fit$ctmodelobj
  
  #fix ctmodel matrices to fitted matrices
  gm$LAMBDA=s$LAMBDA
  gm$DRIFT=s$DRIFT
  gm$DIFFUSION=t(chol(Matrix::nearPD(s$DIFFUSION+diag(1e-8,gm$n.latent))$mat))
  gm$CINT=s$CINT
  gm$T0MEANS=s$T0MEANS
  gm$MANIFESTMEANS=s$MANIFESTMEANS
  gm$T0VAR=t(chol(Matrix::nearPD(s$T0VAR)$mat))
  gm$MANIFESTVAR=t(chol(Matrix::nearPD(s$MANIFESTVAR+diag(1e-8,gm$n.manifest))$mat))
  
  if(!is.null(gm$TRAITVAR)) { #adjust traitvar from asymptotic form to cint variance form
    gm$TRAITVAR<- (gm$DRIFT) %*% s$TRAITVAR %*% t(gm$DRIFT)
    gm$TRAITVAR=t(chol(Matrix::nearPD(gm$TRAITVAR+diag(1e-8,gm$n.latent))$mat))
  }
  
  if(!is.null(gm$MANIFESTTRAITVAR)) gm$MANIFESTTRAITVAR=t(chol(Matrix::nearPD(s$MANIFESTTRAITVAR+diag(1e-8,gm$n.manifest))$mat))
  
  if(gm$n.TDpred > 0) gm$TDPREDEFFECT=s$TDPREDEFFECT
  if(gm$n.TIpred > 0) gm$TIPREDEFFECT=s$TIPREDEFFECT
  
  class(gm) = 'ctsemInit'
  return(gm)
  
}