R/faReg.R

Defines functions faRegression

Documented in faRegression

#probably not needed since the loadings of the fa.extend are functionally the beta weights
#redone to simply organize the results more clearly from fa.extend
#and to find the t and p values of the beta weights
#the beta weights are just factor extension  values

faReg <- faRegression <- function(r,nfactors=1,ov=NULL,dv=NULL, n.obs = NA, np.obs=NULL,correct=TRUE,rotate="oblimin",SMC=TRUE,warnings=TRUE, fm="minres",alpha=.1, omega=FALSE,cor="cor",use="pairwise",cor.correct=.5,weight=NULL,smooth=TRUE, ...) {
 cl <- match.call()
# if(is.numeric(ev)) ev  <- colnames(r)[ev]    #in case we are selecting variables 
 if(is.numeric(ov)) ov  <- colnames(r)[ov]
if(is.numeric(dv)) dv   <- colnames(r)[dv]
  nv <- c(ov, dv)
  nv  <- nfactors + length(dv)
  
  if(isCorrelation(r)) {
  #if the data are a correlation matrix, do an extension analysis
 #first find the extension analysis
# n.obs <- NROW(r) 
 fe <- fa.extend(r=r,nfactors=nfactors, ov = ov, ev = dv, n.obs = n.obs, np.obs= np.obs,
                correct=correct, rotate = rotate, SMC = SMC, warnings=warnings, fm =fm ,
                alpha = alpha, omega= FALSE,                                   
                cor="cor",use="pairwise",cor.correct=.5,weight=NULL,smooth=TRUE, ...) 
                 if(!isCorrelation(r))  {rdv <-  cor(r[,dv],use=use)} else { 
                                        rdv<- r[dv,dv]}
                                        fdv <- fe$loadings[dv,1:nfactors]
  } else {
  #do a conventional factor analysis on the ov and then find the factor score correlations with the dvs
  n.obs <- NROW(r)
  fe <- fa(r[ov], nfactors=nfactors, scores ="tenBerge")

  fdv <- cor(r[,dv],fe$scores,  use=use)
  rdv <- cor(r[,dv],use=use)
  }              
 Phi <- fe$Phi
#Phi <- diag(1,nrow=nfactors)  # we set this to identity to use the fa extension loadings

   #fdv <- fe$Structure[dv,1:nfactors]
 R <- matrix(NA,ncol=nv, nrow=nv)
 R[1:nfactors,1:nfactors] <- Phi
 R[1:nfactors,(nfactors +1):nv] <- t(fdv)
 R[(nfactors +1):nv, 1:nfactors]  <- (fdv)
 R[((nfactors +1):nv),((nfactors +1):nv)] <- rdv
rownames(R) <-  colnames(R) <- c(colnames(Phi) , dv)
 
 diag(R) <- 1
 set <- setCor(y=dv, x = colnames(fdv), data=R ,n.obs=n.obs, plot=FALSE)
 result <- list(regression=set,fa.extend =fe, dv.cor =rdv, R= R, Call=cl)
 class(result) <- c("psych", "fa.reg")
 return(result)
 #return(set) 
 }
 

  

Try the psych package in your browser

Any scripts or data that you put into this service are public.

psych documentation built on Sept. 26, 2023, 1:06 a.m.