Nothing
#this function works as a shortcut for users. It's a "recognition engine" to auto perform 1) correct preprocessing and 2) supplemental projection.
#RE: PCA -- with cols, the normalization gets tricky. With variables, center/scale should occur as it did with active.
supplementaryCols <- function(SUP.DATA,res,center=TRUE,scale=TRUE){
SUP.DATA <- as.matrix(SUP.DATA)
output.types <- c("expoOutput","texpoOutput","mexpoOutput")
data.types <- c("ExPosition.Data","TExPosition.Data","MExPosition.Data")
mds.types <- c('epMDS')#can add DiSTATIS to this.
pca.types <- c('epPCA','epGPCA','tepBADA')
ca.types <- c('epCA','epMCA','tepDICA')
if(class(res)[1] %in% output.types){
indicator <- which(output.types %in% class(res)[1])
if(names(res) %in% data.types && length(names(res))==2){
if(output.types[indicator]=="expoOutput"){
res <- res$ExPosition.Data
}
if(output.types[indicator]=="texpoOutput"){
res <- res$TExPosition.Data
}
if(output.types[indicator]=="mexpoOutput"){
res <- res$MExPosition.Data
}
}else{
stop(paste("res class type is unknown:",names(res),sep=" "))
}
}
if((class(res)[1] %in% c(pca.types))){
#some trickery happens here... if no res$M is available, it is passed as NULL.
sup.transform <- pcaSupplementaryColsPreProcessing(SUP.DATA,center=center,scale=scale,M=res$M)
sup.proj <- supplementalProjection(sup.transform,res$fi,res$pdq$Dv)
}
else if((class(res)[1] %in% c(ca.types))){
if(res$hellinger){
sup.transform <- hellingerSupplementaryColsPreProcessing(SUP.DATA)
if(res$symmetric){
sup.proj <- supplementalProjection(sup.transform,f.scores=res$fi,Dv=res$pdq$Dv)
}else{
sup.proj <- supplementalProjection(sup.transform,f.scores=res$pdq$p,Dv=res$pdq$Dv)
}
}else{
sup.transform <- caSupplementalElementsPreProcessing(t(SUP.DATA))
if(res$symmetric){
this.Dv <- res$pdq$Dv
}else{
this.Dv <- res$eigs
}
if((class(res)[1] %in% c('epMCA'))){ ##stupid corrections.
sup.proj <- supplementalProjection(sup.transform,res$fi,this.Dv,scale.factor=res$pdq$Dv/res$pdq.uncor$Dv[1:length(res$pdq$Dv)])
}else{
sup.proj <- supplementalProjection(sup.transform,res$fi,this.Dv)
}
}
}
else if((class(res)[1] %in% c(mds.types))){ #this is the same as rows.
sup.transform <- mdsSupplementalElementsPreProcessing(SUP.DATA,res$D,res$M)
sup.proj <- supplementalProjection(sup.transform,res$fi,res$pdq$Dv)
}else{
stop("Unknown class type. Supplementary projection computation must stop.")
}
fjj <- sup.proj$f.out
djj <- sup.proj$d.out
rjj <- sup.proj$r.out
rownames(fjj) <- rownames(djj) <- rownames(rjj) <- colnames(SUP.DATA)
return(list(fjj=fjj,djj=djj,rjj=rjj))
}
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.