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