R/fsi.R

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

 #factor score indeterminancy  following Nicewander  2022
 #and Grice 2001
fsi <- function(f,phi=NULL,r=NULL,Grice=FALSE,short=TRUE) {
if(Grice){R2 <- gricef(f=f,phi=phi,r=r)
     Hn <- NULL} else {
if(!is.matrix(f)) f <- as.matrix(f)
H2 <- rowSums(f^2)
H2[H2>1] <- 1
fe <- diag(sqrt(1-H2))
L <- cbind(f,fe)
if(is.null(phi)) {H <- Pinv(L) %*% L } else {
 fr <-  f %*% phi
 H2 <- rowSums(f^2)
 H2[H2>1] <- 1
fe <- diag(sqrt(1-H2))
L <- cbind(fr,fe)
 H <- Pinv(L) %*% L}
 R2 <- diag(H) 
 Hn <- H[1:ncol(f),1:ncol(f)]}
 names(R2) <- colnames(f) 
if(short) {result <- R2[1:ncol(f)]} else {result <- list(R2=R2, H = Hn)}
return(result)   #these are the R2 of the  factors with the scores
#note that fungible:fsIndeterminacy  returns r
}  

gricef <- function(f,phi=NULL,r=NULL) {
    if(is.null(phi) ){phi <- diag(ncol(f))}
      S <- f %*% phi 
      w  <- Pinv(r) %*% S 
      R2 <- diag(t(w) %*% S)
      R2[R2 >1] <- 1 
      return(R2)
      }