.packageName <- "mvoutlier"
"aq.plot" <-
function(x, delta=qchisq(0.975, df=ncol(x)), quan=1/2, alpha=0.025) {

  #library(rrcov)
  if(is.vector(x) == TRUE || ncol(x) == 1) { stop("x must be at least two-dimensional") }

  covr <- covMcd(x, alpha=quan)
  dist <- mahalanobis(x, center=covr$center, cov=covr$cov)
  s <- sort(dist, index=TRUE)

  z <- x
  if(ncol(x) > 2) {
        #library(stats)
	p <- princomp(x,covmat=covr)
	z <- p$scores[,1:2]
	sdprop <- (p$sd[1]+p$sd[2])/sum(p$sd)
	cat("Projection to the first and second robust principal components.\n")
	cat("Proportion of total variation (explained variance): ")
	cat(sdprop)
	cat("\n")
  }
	
    par(mfrow=c(2,2), mai=c(0.8,0.6,0.2,0.2), mgp=c(2.4,1,0))
    plot(z, col=3, type="n", xlab="", ylab="")
    text(z, dimnames(as.data.frame(z))[[1]], col=3, cex=0.8)

  plot(s$x, (1:length(dist))/length(dist), col=3, xlab="Ordered squared robust distance", ylab="Cumulative probability", type="n")
  text(s$x, (1:length(dist))/length(dist), as.character(s$ix), col=3, cex=0.8)
  t <- seq(0,max(dist), by=0.01)
  lines(t, pchisq(t, df=ncol(x)), col=6)

  abline(v=delta, col=5)
  text(x=delta, y=0.4, paste(100*(1-alpha),"% Quantile",sep=""), col=5, pos=4, srt=90, cex=0.8)

  xarw <- arw(x, covr$center, covr$cov, alpha=alpha)
  abline(v=xarw$cn, col=4)
  text(x=xarw$cn, y=0.4, "Adjusted Quantile", col=4, pos=2, srt=90, cex=0.8)

    plot(z, col=3, type="n", main=paste("Outliers based on ",100*(1-alpha),"% quantile",sep=""), xlab="", ylab="")
    for(i in 1:nrow(x)) { 
      if(dist[i] >= delta) text(z[i,1], z[i,2], dimnames(as.data.frame(x))[[1]][i], col=2, cex=0.8)
      if(dist[i] < delta) text(z[i,1], z[i,2], dimnames(as.data.frame(x))[[1]][i], col=3, cex=0.8)
    }

    plot(z, col=3, type="n", main="Outliers based on adjusted quantile", xlab="", ylab="")
    for(i in 1:nrow(x)) { 
      if(dist[i] >= xarw$cn) text(z[i,1], z[i,2], dimnames(as.data.frame(x))[[1]][i], col=2, cex=0.8)
      if(dist[i] < xarw$cn) text(z[i,1], z[i,2], dimnames(as.data.frame(x))[[1]][i], col=3, cex=0.8)
    }
    
}
"arw" <-
function(x,m0,c0,alpha,pcrit){
# Adaptive reweighted estimator for multivariate location and scatter
# with hard-rejection weights and delta = chi2inv(1-d,p)
#
# Input arguments
#   x:  Dataset (n x p)
#   m0: Initial location estimator (1 x p)
#   c0: Initial scatter estimator (p x p)
#   alpha:  Maximum thresholding proportion
#       (optional scalar, default: alpha = 0.025)
#   pcrit: critical value for outlier probability
#       (optional scalar, default values from simulations)
#
# Output arguments:
#   m:  Adaptive location estimator (p x 1)
#   c:  Adaptive scatter estimator (p x p)
#   cn: Adaptive threshold (scalar)
#   w:  Weight vector (n x 1)
#
n <- nrow(x)
p <- ncol(x)
# Critical value for outlier probability based on simulations for alpha=0.025
if (missing(pcrit)){
  if (p<=10) pcrit <- (0.24-0.003*p)/sqrt(n)
  if (p>10) pcrit <- (0.252-0.0018*p)/sqrt(n)
}
if (missing(alpha)) delta<-qchisq(0.975,p) else delta<-qchisq(1-alpha,p)
d2<-mahalanobis(x,m0,c0)
d2ord <- sort(d2)
dif <- pchisq(d2ord,p) - (0.5:n)/n
i <- (d2ord>=delta) & (dif>0)
if (sum(i)==0) alfan<-0 else alfan<-max(dif[i])
if (alfan<pcrit) alfan<-0
#if (alfan>0) cn<-max(d2ord[n-floor(n*alfan)],delta) else cn<-Inf
if (alfan>0) cn<-max(d2ord[n-ceiling(n*alfan)],delta) else cn<-Inf
w <- d2<cn
if(sum(w)==0) {
  m <- m0
  c <- c0
} 
else {
  m <- apply(x[w,],2,mean)
  c1 <- as.matrix(x-rep(1,n)%*%t(m))
  c <- (t(c1)%*%diag(w)%*%c1)/sum(w)
}
list(m=m,c=c,cn=cn,w=w)
}
"chisq.plot" <-
function(x, quan=1/2, ask=TRUE, ...) {
  
  #library(rrcov)

  covr <- covMcd(x, alpha=quan)
  dist <- mahalanobis(x, center=covr$center, cov=covr$cov)
	
  s <- sort(dist, index=TRUE)
  q <- (0.5:length(dist))/length(dist)
  qchi <- qchisq(q, df=ncol(x))

  plot(s$x, qchi, xlab="Ordered robust MD^2", ylab="Quantiles of Chi_p^2", main="Chi^2-Plot", col=3, ...)

  if(ask==TRUE) {
    for(i in (nrow(x)-1):1) {
      par(ask=TRUE)
      q <- (0.5:i)/i
      qchi <- qchisq(q, df=ncol(x))
      
      plot(s$x[-(length(s$x):(i+1))], qchi, xlab="Ordered robust MD^2", ylab="Quantiles of Chi_p^2", main="Chi^2-Plot", col=3, ...)
      cat("Observations left out:\n"); cat(s$ix[length(s$ix):(i+1)]); cat("\n")
      outliers <<- s$ix[length(s$ix):(i+1)]
      par(ask=FALSE)
    }
  }
}
"color.plot" <-
function(x, quan=1/2, alpha=0.025, ...)  {

	#library(rrcov)
	if(!is.matrix(x) && !is.data.frame(x)) stop("x has to be matrix or data.frame")
	if(ncol(x) != 2) stop("x has to be two-dimensional")

	n <- nrow(x)
	rob <- covMcd(x, alpha=quan)
	xarw <- arw(x, rob$center, rob$cov, alpha=alpha)
	xs <- scale(x) - min(scale(x))
	eucl <- sqrt(xs[,1]^2 + xs[,2]^2)
	rbcol <- rev(rainbow(nrow(x),start=0,end=0.7))[as.integer(cut(eucl,nrow(x),labels=1:nrow(x)))]

	covr <- rob$cov
	mer <- rob$center

	covr.svd <- svd(covr, nv = 0)
	rr <- covr.svd[["u"]] %*% diag(sqrt(covr.svd[["d"]]))

	m <- 1000
	if(xarw$cn != Inf) { alpha <- sqrt(c(xarw$cn, qchisq(c(0.75,0.5,0.25),ncol(x)))) }
	else { alpha <- sqrt(qchisq(c(0.975, 0.75,0.5,0.25),ncol(x))) }
	lpch <- c(3,3,16,1,1)
	lcex <- c(1.5,1,0.5,1,1.5)
	lalpha <- length(alpha)

	rd <- sqrt(mahalanobis(x, mer, covr))

	for(j in 1:lalpha) {
        	e1 <- cos(c(0:m)/m * 2 * pi) * alpha[j]
	        e2 <- sin(c(0:m)/m * 2 * pi) * alpha[j]
        	e <- cbind(e1, e2)
        	ttr <- t(rr %*% t(e)) + rep(1, m + 1) %o% mer
	        if(j == 1) {
        	        xmax <- max(c(x[, 1],ttr[,1]))
        	        xmin <- min(c(x[, 1],ttr[,1]))
			ymax <- max(c(x[, 2],ttr[,2]))
	                ymin <- min(c(x[, 2],ttr[,2]))
        	        plot(x, xlab = "x", ylab = "y", xlim = c(xmin, xmax), ylim = c(ymin, ymax),type="n", main="Color according to Euclidean distance", ...)
			points(x[rd>=alpha[j],],pch=lpch[j],cex=lcex[j],col=rbcol[rd>=alpha[j]])
	        }
       	        if (j>1 & j<lalpha) points(x[rd<alpha[j-1] & rd>=alpha[j],],cex=lcex[j],pch=lpch[j], col=rbcol[rd<alpha[j-1] & rd>=alpha[j]])
        	if (j==lalpha){
           		points(x[rd<alpha[j-1] & rd>=alpha[j],],cex=lcex[j],pch=lpch[j], col=rbcol[rd<alpha[j-1] & rd>=alpha[j]])
		        points(x[rd<alpha[j],],pch=lpch[j+1],cex=lcex[j+1], col=rbcol[rd<alpha[j]])
        	}
 		lines(ttr[, 1], ttr[, 2], lty=3)
	}
	l <- list(md = rd, euclidean = eucl)
	l
}
"cor.plot" <-
function(x, y, quan=1/2, alpha=0.025, ...) {

  #library(rrcov)  
  x <- as.matrix(cbind(x,y))

  covr <- covMcd(x, cor=TRUE, alpha=quan)
  cov.svd <- svd(cov(x), nv = 0)
  covr.svd <- svd(covr$cov, nv = 0)
  r <- cov.svd[["u"]] %*% diag(sqrt(cov.svd[["d"]]))
  rr <- covr.svd[["u"]] %*% diag(sqrt(covr.svd[["d"]]))
  
  e <- cbind(cos(c(0:100)/100 * 2 * pi) * sqrt(qchisq(1-alpha,2)), sin(c(0:100)/100 * 2 * pi) * sqrt(qchisq(1-alpha,2)))
  tt <- t(r %*% t(e)) + rep(1, 101) %o% apply(x, 2, mean)
  ttr <- t(rr %*% t(e)) + rep(1, 101) %o% covr$center
  plot(x, xlim=c(min(c(x[, 1], tt[, 1],ttr[,1])), max(c(x[, 1], tt[, 1],ttr[,1]))), ylim=c(min(c(x[, 2], tt[, 2],ttr[,2])), max(c(x[, 2], tt[, 2],ttr[,2]))), ...)
  title(main=list(paste("Classical cor =",round(cor(x)[1,2],2),"                                      "),col=4))
  title(main=list(paste("                                      Robust cor =",round(covr$cor[1,2],2)),col=2))

  lines(tt[, 1], tt[, 2], type = "l",col=4,lty=3)
  lines(ttr[, 1], ttr[, 2], type = "l",col=2)

  ret <- list(cor.cla = cor(x)[1,2], cor.rob=covr$cor[1,2])
  ret
}
"dd.plot" <-
function(x, quan=1/2, alpha=0.025, ...) {
	if(!is.matrix(x) && !is.data.frame(x)) stop("x must be matrix or data.frame")
	#library(rrcov)
	rob <- covMcd(x, alpha=quan)
	xarw <- arw(x, rob$center, rob$cov, alpha=alpha)
	
	distcla <- sqrt(mahalanobis(x, center=apply(x, 2, mean), cov=cov(x)))
	distrob <- sqrt(mahalanobis(x, center=rob$center, cov=rob$cov))
	plot(distcla, distrob, main="Distance-Distance Plot", xlab="Mahalanobis Distance", ylab="Robust Distance", type="n", ...)
	
	
	if(xarw$cn != Inf) { alpha <- sqrt(c(xarw$cn, qchisq(c(0.75,0.5,0.25),ncol(x)))) }
	else { alpha <- sqrt(qchisq(c(0.975, 0.75,0.5,0.25),ncol(x))) }
	abline(h=alpha[1])
	abline(v=alpha[1])
	abline(a=0, b=1)
	lpch <- c(3,3,16,1,1)
	lcex <- c(1.5,1,0.5,1,1.5)
	lalpha <- length(alpha)
	
	xs <- scale(x) - min(scale(x))
	eucl <- sqrt(apply(xs^2, 1, sum))
	rbcol <- rev(rainbow(nrow(x),start=0,end=0.7))[as.integer(cut(eucl,nrow(x),labels=1:nrow(x)))]
	rd <- distrob
	
	for(j in 1:lalpha) {
		if(j==1) {
			points(distcla[rd>=alpha[j]], distrob[rd>=alpha[j]], pch=lpch[j],cex=lcex[j],col=rbcol[rd>=alpha[j]])
		}
		if (j>1 & j<lalpha) points(distcla[rd<alpha[j-1] & rd>=alpha[j]], distrob[rd<alpha[j-1] & rd>=alpha[j]], cex=lcex[j],pch=lpch[j], col=rbcol[rd<alpha[j-1] & rd>=alpha[j]])
		if (j==lalpha){
        		points(distcla[rd<alpha[j-1] & rd>=alpha[j]], distrob[rd<alpha[j-1] & rd>=alpha[j]], cex=lcex[j],pch=lpch[j], col=rbcol[rd<alpha[j-1] & rd>=alpha[j]])
		       	points(distcla[rd<alpha[j]], distrob[rd<alpha[j]], pch=lpch[j+1],cex=lcex[j+1], col=rbcol[rd<alpha[j]])
        	}
        }
        l <- list(md.cla = distcla, md.rob=distrob)
        l
}
"map.plot" <-
function(coord, data, quan=1/2, alpha=0.025, symb=FALSE, ... ) {

	#library(rrcov)
	if(ncol(coord) != 2) stop("argument coord has to be two-dimensional")  

	rob <- covMcd(data, alpha=quan)
	dist <- mahalanobis(data, center=rob$center, cov=rob$cov)
	xarw <- arw(data, rob$center, rob$cov, alpha=alpha)
  
  	if(xarw$cn != Inf) { alpha <- sqrt(c(xarw$cn, qchisq(c(0.75,0.5,0.25),ncol(data)))) }
	else { alpha <- sqrt(qchisq(c(0.975, 0.75,0.5,0.25),ncol(data))) }
  
	if(symb==FALSE) {
		plot(coord, col=((sqrt(dist)<alpha[1])+2))
		l <- list(md=sqrt(dist))
		l
	}
	
  
	if(symb==TRUE) {
		rd <- sqrt(dist)
		lpch <- c(3,3,16,1,1)
		lcex <- c(1.5,1,0.5,1,1.5)
		lalpha <- length(alpha)

		xs <- scale(data) - min(scale(data))
		eucl <- sqrt(apply(xs^2, 1, sum))
		rbcol <- rev(rainbow(nrow(data),start=0,end=0.7))[as.integer(cut(eucl,nrow(data),labels=1:nrow(data)))]
		
		for(j in 1:lalpha) {
			if(j==1) {
				plot(coord,type="n", ...)
				points(coord[rd>=alpha[j],],pch=lpch[j],cex=lcex[j],col=rbcol[rd>=alpha[j]])
				}
			if (j>1 & j<lalpha) points(coord[rd<alpha[j-1] & rd>=alpha[j],],cex=lcex[j],pch=lpch[j], col=rbcol[rd<alpha[j-1] & rd>=alpha[j]])
			if (j==lalpha){
           			points(coord[rd<alpha[j-1] & rd>=alpha[j],],cex=lcex[j],pch=lpch[j], col=rbcol[rd<alpha[j-1] & rd>=alpha[j]])
		        	points(coord[rd<alpha[j],],pch=lpch[j+1],cex=lcex[j+1], col=rbcol[rd<alpha[j]])
        		}
		}
		l <- list(md=sqrt(dist), euclidean=eucl)
		l
	}
}
"symbol.plot" <-
function(x, quan=1/2, alpha=0.025, ...)  {

	#library(rrcov)
	if(!is.matrix(x) && !is.data.frame(x)) stop("x has to be matrix or data.frame")
	if(ncol(x) != 2) stop("x has to be two-dimensional")

	n <- nrow(x)
	rob <- covMcd(x, alpha=quan)
	xarw <- arw(x, rob$center, rob$cov, alpha=alpha)

	covr <- rob$cov
	mer <- rob$center

	covr.svd <- svd(covr, nv = 0)
	rr <- covr.svd[["u"]] %*% diag(sqrt(covr.svd[["d"]]))

	m <- 1000
	if(xarw$cn != Inf) { alpha <- sqrt(c(xarw$cn, qchisq(c(0.75,0.5,0.25),ncol(x)))) }
	else { alpha <- sqrt(qchisq(c(0.975, 0.75,0.5,0.25),ncol(x))) }
	lpch <- c(3,3,16,1,1)
	lcex <- c(1.5,1,0.5,1,1.5)
	lalpha <- length(alpha)

	rd <- sqrt(mahalanobis(x,mer,covr))

	for(j in 1:lalpha) {
        	e1 <- cos(c(0:m)/m * 2 * pi) * alpha[j]
	        e2 <- sin(c(0:m)/m * 2 * pi) * alpha[j]
        	e <- cbind(e1, e2)
        	ttr <- t(rr %*% t(e)) + rep(1, m + 1) %o% mer
	        if(j == 1) {
        	        xmax <- max(c(x[, 1],ttr[,1]))
        	        xmin <- min(c(x[, 1],ttr[,1]))
			ymax <- max(c(x[, 2],ttr[,2]))
	                ymin <- min(c(x[, 2],ttr[,2]))
        	        plot(x, xlab = "x", ylab = "y", xlim = c(xmin, xmax), ylim = c(ymin, ymax),type="n", ...)
			points(x[rd>=alpha[j],],pch=lpch[j],cex=lcex[j],col=1)
	        }
	        if (j>1 & j<lalpha) points(x[rd<alpha[j-1] & rd>=alpha[j],],cex=lcex[j],pch=lpch[j])
        	if (j==lalpha){
           		points(x[rd<alpha[j-1] & rd>=alpha[j],],cex=lcex[j],pch=lpch[j])
		        points(x[rd<alpha[j],],pch=lpch[j+1],cex=lcex[j+1])
        	}
		lines(ttr[, 1], ttr[, 2], type = "l",col=j+1)
	}

	legend(xmin, ymax, c("25% quantile", "50% quantile", "75% quantile", "Adjusted quantile"), fill=c(5:2), text.col=c(5:2), cex=0.8, bty="n")
	l <- list(md = rd)
	l
}
"uni.plot" <-
function(x, symb=FALSE, quan=1/2, alpha=0.025, ...) {
	if(!is.matrix(x) && !is.data.frame(x)) stop("x must be matrix or data.frame")
	if(ncol(x) < 2) stop("x must be at least two-dimensional")
	if(ncol(x) > 10) stop("x should not be more than 10-dimensional")
	
	#library(rrcov)
	par(mfrow=c(1, ncol(x)), mai=c(0.6,0,0.6,0), oma=c(0,3,0,3))
	
	rob <- covMcd(x, alpha=quan)
	xarw <- arw(x, rob$center, rob$cov, alpha=alpha)
	
	if(xarw$cn != Inf) { alpha <- sqrt(c(xarw$cn, qchisq(c(0.75,0.5,0.25),ncol(x)))) }
	else { alpha <- sqrt(qchisq(c(0.975, 0.75,0.5,0.25),ncol(x))) }
	
	dist <- mahalanobis(x, center=rob$center, cov=rob$cov)
	sx <- matrix(NA, nrow=nrow(x), ncol=ncol(x))
	for(i in 1:ncol(x)) sx[,i] <- (x[,i]-xarw$m[i])/sqrt(xarw$c[i,i])
	r <- range(sx)
	
	if(symb == FALSE) {
		for(i in 1:ncol(x)) {
			plot(runif(nrow(x), min=-1, max=1), sx[,i], main=dimnames(x)[[2]][i], xlim=c(-1.5,1.5), ylim=c(r[1], r[2]), xlab="", ylab="Scaled Data", xaxt="n", col=(sqrt(dist)<alpha[1])+2, ...)
			par(yaxt="n")
			abline(h=0, lty="dotted")
			l <- list(md=sqrt(dist))
		}
	}
	
	if(symb == TRUE) {
		rd <- sqrt(dist)
		lpch <- c(3,3,16,1,1)
		lcex <- c(1.5,1,0.5,1,1.5)
		lalpha <- length(alpha)
		
		xs <- scale(x) - min(scale(x))
		eucl <- sqrt(apply(xs^2, 1, sum))
		rbcol <- rev(rainbow(nrow(x),start=0,end=0.7))[as.integer(cut(eucl,nrow(x),labels=1:nrow(x)))]
		
		for(i in 1:ncol(x)) {
			for(j in 1:lalpha) {
				if(j==1) {
					plot(runif(nrow(x), min=-1, max=1), sx[,i], main=dimnames(x)[[2]][i], xlim=c(-1.5,1.5), ylim=c(r[1], r[2]), xlab="", ylab="Scaled Data", xaxt="n", type="n", ...)
					par(yaxt="n")
					points(runif(nrow(x), min=-1, max=1)[rd>=alpha[j]], sx[rd>=alpha[j],i], pch=lpch[j],cex=lcex[j],col=rbcol[rd>=alpha[j]])
				}
				if (j>1 & j<lalpha) points(runif(nrow(x), min=-1, max=1)[rd<alpha[j-1] & rd>=alpha[j]], sx[rd<alpha[j-1] & rd>=alpha[j],i], cex=lcex[j],pch=lpch[j], col=rbcol[rd<alpha[j-1] & rd>=alpha[j]])
				if (j==lalpha){
           				points(runif(nrow(x), min=-1, max=1)[rd<alpha[j-1] & rd>=alpha[j]], sx[rd<alpha[j-1] & rd>=alpha[j],i], cex=lcex[j],pch=lpch[j], col=rbcol[rd<alpha[j-1] & rd>=alpha[j]])
		        		points(runif(nrow(x), min=-1, max=1)[rd<alpha[j]], sx[rd<alpha[j],i], pch=lpch[j+1],cex=lcex[j+1], col=rbcol[rd<alpha[j]])
        			}
        		}
        		abline(h=0, lty="dotted")
        	}
        l <- list(x=x, md=sqrt(dist), euclidean=eucl)
        }
        par(yaxt="s")
	l
}
