Function to translate dynamic factor models into epxected graphical VAR models.

factorToVAR.R

# This function computes the equivalent graphical VAR model given a dynamical factor model. It requires graphicalVAR to be installed.
factorToVAR <- function(lambda, beta, psi, theta){
  if (missing(lambda) | missing(beta) | missing(psi) | missing(theta)){
    stop("'lambda', 'beta', 'psi' and 'theta' may not be missing.")
  }
  # Number of observed:
  nObs <- nrow(lambda)
  
  # Number of latents:
  nLat <- ncol(lambda)
  
  # Compute stationary latent variance:
  vecSigmaPsi <- solve(diag(nLat^2) - kronecker(beta, beta)) %*% c(psi)
  SigmaPsi <- matrix(vecSigmaPsi, nLat, nLat)
  
  # Compute stationary observed variance:
  SigmaY <- lambda %*% SigmaPsi %*% t(lambda) + theta
  
  # Implied beta of VAR model:
  BetaVAR <- lambda %*% beta %*% SigmaPsi %*% t(lambda) %*% solve(SigmaY)
  
  # Implied Psi of VAR Model:
  PsiVAR <- lambda %*% SigmaPsi %*% t(lambda) + theta - BetaVAR %*% SigmaY %*% t(BetaVAR)
  
  # Results object:
  Results <- list(
    beta = BetaVAR,
    psi = PsiVAR,
    PDC = graphicalVAR:::computePDC(BetaVAR, solve(PsiVAR)),
    PCC = graphicalVAR:::computePCC(solve(PsiVAR))
  )
  class(Results) <- "factorToVAR"
  return(Results)
}

plot.factorToVAR <- function(x,...){
  library("qgraph")
  L <- averageLayout(x$PDC,x$PCC)
  layout(t(1:2))
  qgraph(x$PDC, title = "Temporal network", layout = L, ...,
         directed = TRUE)
  qgraph(x$PCC, title = "Contemporaneous network", layout = L, ...)
}