R/CompRobustDist.R

In musto101/wilcox_R: What the package does (short line)

CompRobustDist <-
function(data, r, out, classic) {
	n <- nrow(data)
	p <- ncol(data)
	out$sd <- sqrt(mahalanobis(out$T, center=rep(0, length=ncol(out$T)), cov=diag(x=out$L, nrow=length(out$L))))
	out$cutoff$sd <- sqrt(qchisq(0.975, out$k))
	XRc <- data - matrix(data=rep(out$M, times=n), nrow=n, ncol=p, byrow=T)
	Xtilde <- out$T %*% t(out$P)
	Rdiff <- XRc - Xtilde
	out$od <- vector(mode="numeric", length=n)
	if(is.list(dimnames(out$T))) {
		names(out$od) <- dimnames(out$T)[[1]]
	}
	out$od<-apply(Rdiff,1,vecnorm)
	if(out$k != r) {
		ms <- unimcd(out$od^(2/3), quan=out$h)
		out$cutoff$od <- sqrt(qnorm(0.975, ms$tmcd, ms$smcd)^3)
		out$flag <- (out$od <= rep(x=out$cutoff$od, times=length(out$od))) & (out$sd <= rep(x=out$cutoff$sd, times=length(out$sd)))
	}
	else {
		out$cutoff$od <- 0
		out$flag <- out$sd <= rep(x=out$cutoff$sd, times=length(out$sd))
	}
	if(classic == 0) {
		out$classic <- 0
	}
	out$class <- "ROBPCA"

	return(out)
}