R/omega.bifactor.R

In psych: Procedures for Psychological, Psychometric, and Personality Research

"omega.bifactor" <- function(r,nfactors=3,rotate="bifactor",n.obs = NA,flip=TRUE,key=NULL,title="Omega from bifactor",...) {
 cl <- match.call()
 if(dim(r)[2] != dim(r)[1]) {n.obs <- dim(r)[1]
                             r <- cor(r,use="pairwise")}
 nvar <- dim(r)[2]
  if(is.null(colnames(r))) {  rownames(r) <- colnames(r) <- paste("V",1:nvar,sep="") }
       r.names <- colnames(r)
 
 if (!is.null(key)) { r <- diag(key) %*% r %*% diag(key)
                           colnames(r) <- r.names   #flip items if we choose to do so
                           flip <- FALSE   #we do this if we specify the key
                           } else {key <- rep(1,nvar) }
                           
 f <- fa(r,nfactors=nfactors,rotate=rotate,n.obs = n.obs) 
 if (flip) {       #should we think about flipping items ?
       			key <- sign(f$loadings[,1])
      		 	key[key==0] <- 1     # a rare and weird case where the gloading is 0 and thus needs not be flipped
      			 if (sum(key) < nvar) {  #some items have negative g loadings and should be flipped  
            		 r <- diag(key) %*% r %*% diag(key)  #this is just flipping the correlation matrix so we can calculate alpha
            		f$loadings <-  diag(key) %*% f$loadings
            		 signkey <- strtrim(key,1)
            		 signkey[signkey=="1"] <- ""
            		 r.names <- paste(r.names,signkey,sep="")
            		 colnames(r) <- rownames(r) <- r.names
            		 rownames(f$loadings) <- r.names
          				
     		 
            }
          }
          Vt <- sum(r)   #find the total variance in the scale
     	  Vitem <- sum(diag(r)) 
     	  gload <- f$loadings[,1]	
 
 
       gsq <- (sum(gload))^2
      uniq <- nvar - tr(f$loadings %*% t(f$loadings))
       
      om.tot <- (Vt-uniq)/Vt
      om.limit <- gsq/(Vt-uniq)  
      alpha <- ((Vt-Vitem)/Vt)*(nvar/(nvar-1))
      sum.smc <- sum(smc(r))
      lambda.6 <- (Vt +sum.smc-sum(diag(r)))/Vt
      omega_h= gsq/Vt
      omega <-list(omega_h= omega_h,alpha=alpha,G6 = lambda.6,omega.tot =om.tot ,key = key,title=title,f=f)
      class(omega) <- c("psych","bifactor")
      return(omega)
      }