Nothing
fa.pooled <- function(datasets,nfactors=1,rotate="oblimin",scores="regression", residuals=FALSE,SMC=TRUE,covar=FALSE,missing=FALSE,impute="median", min.err = .001,max.iter=50,symmetric=TRUE,warnings=TRUE,fm="minres",alpha=.1, p =.05,oblique.scores=FALSE,np.obs=NULL,use="pairwise",cor="cor",correct=.5,weight=NULL,...) {
cl <- match.call()
replicates <- list()
replicateslist <- list()
rep.rots <- list()
n.iter <- length(datasets)
#the first fa becomes the target for the remaining ones
X <- datasets[[1]]
f <- fac(X,nfactors=nfactors,rotate=rotate,scores="none",SMC = SMC,missing=missing,impute=impute,min.err=min.err,max.iter=max.iter,symmetric=symmetric,warnings=warnings,fm=fm,alpha=alpha,oblique.scores=oblique.scores,np.obs=np.obs,use=use,cor=cor,correct=correct,...=...)
fl <- f$loadings
nvar <- ncol(X)
#now do the replicated
for (iter in (1:n.iter)) {
X <- datasets[[iter]]
fs <- fac(X,nfactors=nfactors,rotate=rotate,scores="none",SMC = SMC,missing=missing,impute=impute,min.err=min.err,max.iter=max.iter,symmetric=symmetric,warnings=warnings,fm=fm,alpha=alpha,oblique.scores=oblique.scores,np.obs=np.obs,use=use,cor=cor,correct=correct,...=...) #call fa with the appropriate parameters
if(nfactors == 1) {replicateslist[[iter]] <- list(loadings=fs$loadings)} else {
t.rot <- target.rot(fs$loadings,fl)
if(!is.null(fs$Phi)) { phis <- fs$Phi # should we rotate the simulated factor correlations?
#we should report the target rotated phis, not the untarget rotated phis
replicateslist[[iter]] <- list(loadings=t.rot$loadings,phis=phis[lower.tri(t.rot$Phi)]) #corrected 6/10/15
#replicates <- list(loadings=t.rot$loadings,phis=phis[lower.tri(phis)])
} else
{replicateslist[[iter]] <- list(loadings=t.rot$loadings)}
}
}
replicates <- matrix(unlist(replicateslist),nrow=n.iter,byrow=TRUE)
means <- colMeans(replicates,na.rm=TRUE)
sds <- apply(replicates,2,sd,na.rm=TRUE)
if(length(means) > (nvar * nfactors) ) {
means.rot <- means[(nvar*nfactors +1):length(means)]
sds.rot <- sds[(nvar*nfactors +1):length(means)]
ci.rot.lower <- means.rot + qnorm(p/2) * sds.rot
ci.rot.upper <- means.rot + qnorm(1-p/2) * sds.rot
ci.rot <- data.frame(lower=ci.rot.lower,upper=ci.rot.upper) } else {
rep.rots <- NULL
means.rot <- NULL
sds.rot <- NULL
z.rot <- NULL
ci.rot <- NULL }
means <- matrix(means[1:(nvar*nfactors)],ncol=nfactors)
sds <- matrix(sds[1:(nvar*nfactors)],ncol=nfactors)
tci <- abs(means)/sds
ptci <- 1-pnorm(tci)
if(!is.null(rep.rots)) {
tcirot <- abs(means.rot)/sds.rot
ptcirot <- 1- pnorm(tcirot)} else {tcirot <- NULL
ptcirot <- NULL}
ci.lower <- means + qnorm(p/2) * sds
ci.upper <- means + qnorm(1-p/2) * sds
ci <- data.frame(lower = ci.lower,upper=ci.upper)
class(means) <- "loadings"
colnames(means) <- colnames(sds) <- colnames(fl)
rownames(means) <- rownames(sds) <- rownames(fl)
f$cis <- list(means = means,sds = sds,ci = ci,p =2*ptci, means.rot=means.rot,sds.rot=sds.rot,ci.rot=ci.rot,p.rot = ptcirot,Call= cl,replicates=replicates,rep.rots=rep.rots)
results <- f
results$Call <- cl
class(results) <- c("psych","fa.ci")
return(results)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.