R/Ppca.R

Ppca <-
function(x,p=ncol(x)-1,locfun=L1medcen,loc.val=NULL,SCORES=FALSE,
gvar.fun=cov.mba,pr=TRUE,SEED=TRUE,gcov=rmba,SCALE=TRUE,...){
#
# Robust PCA aimed at finding scores that maximize a
# robust generalized variance given the goal of reducing data from
# m dimensions to
# p, which defaults to m-1
#
#  locfun, location used to center design space.
#  by default, use the spatial median
#  alternatives are mcd, tauloc, ...
#
#  # data are centered based on measure of location indicated by
#  locfun: default is spatial median.
#
#  SCALE=T means the marginal distributions are rescaled using the
#  measure and scatter indicated by
#  gcov, which defaults to median ball measure of location and variance
#
#  Output: the projection matrix. If
#  SCORES=T, the projected scores are returned.
#
x=as.matrix(x)
x<-elimna(x)
n<-nrow(x)
m<-ncol(x)
xdat=c(n,m,p,as.vector(x))
if(!SCALE){
if(is.null(loc.val))info<-locfun(x,...)$center
if(!is.null(loc.val))info<-loc.val
for(i in 1:n)x[i,]<-x[i,]-info
}
if(SCALE){
ms=gcov(x)
for(i in 1:n)x[i,]<-x[i,]-ms$center
for(j in 1:m)x[,j]<-x[,j]/sqrt(ms$cov[j,j])
}
vals<-NA
z<-matrix(nrow=n,ncol=p)
np=p*m
B=robpca(x,pval=p,plotit=FALSE,pr=pr,SEED=SEED,scree=FALSE)$P
B=t(B)
Bs=nelderv2(xdat,np,NMpca,START=B)
Bop=matrix(Bs,nrow=p,ncol=m)
Bop=t(ortho(t(Bop)))
z<-matrix(nrow=n,ncol=p)
zval<-NULL
for(i in 1:n)z[i,]<-Bop%*%as.matrix(x[i,])
if(SCORES)zval<-z
val=gvarg(z)
list(B=Bop,gen.sd=sqrt(val),scores=zval)
}
musto101/wilcox_R documentation built on May 23, 2019, 10:52 a.m.