R/outpca.R

outpca <-
function(x,cor=TRUE,loadings=TRUE,covlist=NULL,scree=TRUE,
SCORES=FALSE,ALL=TRUE,pval=NULL,cop=3,ADJ=FALSE,SEED=TRUE,pr=TRUE,STAND=TRUE,
xlab= "Principal Component", ylab = "Proportion of Variance",...){
#
# Remove outliers with outpro
# (using projection method)
# apply standard principle compoenents to remaining data
#
# ALL=T, when computing scores, all of the data are used, not just
# the data left after outliers are removed.
#
x<-elimna(x) # removes any rows having missing values
m<-ncol(x)
if(m>9){
if(pr)print("With more than 9 variables, might want to use ADJ=T")
}
if(!ADJ)flag<-outpro(x,cop=cop,STAND=STAND)$keep
if(ADJ)flag<-outproad(x,cop=cop,SEED=SEED,STAND=STAND)$results$keep
remx<-x
temp2<-princomp(remx)
x<-x[flag,]
loc<-apply(x,2,mean)
temp<-princomp(x,cor=cor,scores=TRUE,covlist=covlist)
if(scree){
z=temp$sdev
pv=z^2
cs=pv/sum(pv)
cm=cumsum(cs)
plot(rep(c(1:ncol(x)),2),c(cs,cm),type="n",xlab=xlab,ylab=ylab)
points(c(1:ncol(x)),cs,pch="*")
lines(c(1:ncol(x)),cs,lty=1)
points(c(1:ncol(x)),cm,pch=".")
lines(c(1:ncol(x)),cm,lty=2)
}
if(!SCORES)temp<-summary(temp,loadings=loadings)
if(SCORES){
if(is.null(pval))
stop("When computing scores, specify pval, number of components")
if (!ALL)temp<-temp$scores[,1:pval]
if(ALL){
temp<-summary(temp,loadings=T)
B<-temp[2]$loadings[1:m,1:m] # Use robust loadings
 z<-remx
for(i in 1:nrow(z))z[i,]<-z[i,]-loc
temp<-t(B)%*%t(z)
temp<-t(temp)
temp<-temp[,1:pval]
}}
temp
}
musto101/wilcox_R documentation built on May 23, 2019, 10:52 a.m.