1"print.factor.pa" <- 2function(x,digits=2,all=FALSE,cutoff=NULL,sort=FALSE,...) { 3 4 if(is.null(cutoff)) cutoff <- .3 5 load <- x$loadings 6 nitems <- dim(load)[1] 7 nfactors <- dim(load)[2] 8 loads <- data.frame(item=seq(1:nitems),cluster=rep(0,nitems),unclass(load)) 9 if(sort) { 10 #first sort them into clusters 11 #first find the maximum for each row and assign it to that cluster 12 loads$cluster <- apply(abs(load),1,which.max) 13 ord <- sort(loads$cluster,index.return=TRUE) 14 loads[1:nitems,] <- loads[ord$ix,] 15 rownames(loads)[1:nitems] <- rownames(loads)[ord$ix] 16 17 #now sort column wise 18 items <- c(table(loads$cluster),1) #how many items are in each cluster? 19 if(length(items) < (nfactors+1)) {items <- rep(0,(nfactors+1)) #this is a rare case where some clusters don't have anything in them 20 for (i in 1:nfactors+1) {items[i] <- sum(loads$cluster==i) } } 21 22 #now sort the loadings that have their highest loading on each cluster 23 first <- 1 24 for (i in 1:nfactors) { 25 if(items[i]>0 ) { 26 last <- first + items[i]- 1 27 ord <- sort(abs(loads[first:last,i+2]),decreasing=TRUE,index.return=TRUE) 28 loads[first:last,] <- loads[ord$ix+first-1,] 29 rownames(loads)[first:last] <- rownames(loads)[ord$ix+first-1] 30 first <- first + items[i] } 31 } 32 } #end of sort 33 #they are now sorted, don't print the small loadings 34 ncol <- dim(loads)[2]-2 35 fx <- format(loads,digits=digits) 36 nc <- nchar(fx[1,3], type = "c") 37 fx.1 <- fx[,1] 38 fx.2 <- fx[,3:(2+ncol)] 39 load.2 <- loads[,3:(ncol+2)] 40 fx.2[abs(load.2)< cutoff] <- paste(rep(" ", nc), collapse = "") 41 fx <- data.frame(V=fx.1,fx.2) 42 print(fx,quote="FALSE") 43 44 #adapted from print.loadings 45 vx <- colSums(load.2^2) 46 varex <- rbind("SS loadings" = vx) 47 varex <- rbind(varex, "Proportion Var" = vx/nitems) 48 if (nfactors > 1) 49 varex <- rbind(varex, "Cumulative Var"= cumsum(vx/nitems)) 50 51 cat("\n") 52 53 print(round(varex, digits)) 54 55 if(!is.null(x$phi)) { 56 cat ("\n With factor correlations of \n" ) 57 colnames(x$phi) <- rownames(x$phi) <- colnames(x$loadings) 58 print(round(x$phi,digits))} else { 59 if(!is.null(x$rotmat)) { 60 U <- x$rotmat 61 phi <- t(U) %*% U 62 phi <- cov2cor(phi) 63 cat ("\n With factor correlations of \n" ) 64 colnames(phi) <- rownames(phi) <- colnames(x$loadings) 65 print(round(phi,digits)) 66 } } 67 68 objective <- x$criteria[1] 69 if(!is.null(objective)) { cat("\nTest of the hypothesis that", nfactors, if (nfactors == 1) "factor is" else "factors are", "sufficient.\n") 70 cat("\nThe degrees of freedom for the model is",x$dof," and the fit was ",round(objective,digits),"\n") 71 if(!is.na(x$n.obs)) {cat("The number of observations was ",x$n.obs, " with Chi Square = ",round(x$STATISTIC,digits), " with prob < ", signif(x$PVAL,digits),"\n")} 72 73} 74 75 } 76