rpca<-function(datpca) { nr <- nrow(datpca) nc <- ncol(datpca) heikin <- apply(datpca, 2, mean) bunsan <- apply(datpca, 2, var) sd <- sqrt(bunsan) eval <- (result <- eigen(r <-cor(datpca)))$values evec <- result$vectors cum.contr <- cumsum(contr <- eval/nc*100) fl <- sqrt(matrix(eval, nc, nc, byrow=TRUE))*evec fs <- scale(datpca)%*%evec*sqrt(nr/(nr-1)) names(heikin) <- names(bunsan) <- names(sd) <- rownames(r) <- colnames(r) <- rownames(fl) <- paste(colvar) names(eval) <- names(contr) <- names(cum.contr) <- colnames(fl) <- colnames(fs) <- paste("PC", 1:nc) list(mean=heikin, variance=bunsan, standard.deviation=sd, r=r, factor.loadings=fl, eval=eval, contribution=contr, cum.contribution=cum.contr, fs=fs) } resrpca<-rpca(datpca)