find one outlier using Grubbs' test

find_one_outlier.R

# code adapted from Lukasz Komsta's grubbs.test

# outlier value ("o" in grubbs.test) is stored in $outlier_value
# row name of the outlier ("G" in grubbs.test) is stored in $outlier_rowname

find_one_outlier <- function (x, opposite = FALSE) 
{
    DNAME <- deparse(substitute(x))
    x <- sort(x[complete.cases(x)])
    n <- length(x)

    if (xor(((x[n] - mean(x)) < (mean(x) - x[1])), opposite)) {
        alt = paste("lowest value", x[1], "is an outlier")
        o <- x[1]
        d <- x[2:n]
    }
    else {
        alt = paste("highest value", x[n], "is an outlier")
        o <- x[n]
        d <- x[1:(n - 1)]
    }
    g <- abs(o - mean(x))/sd(x)
    u <- var(d)/var(x) * (n - 2)/(n - 1)
    pval <- 1 - pgrubbs(g, n, type = 10)
    method <- "Grubbs test for one outlier"

    
    RVAL <- list(statistic = c(G = g, U = u), alternative = alt, 
        p.value = pval, method = method, data.name = DNAME,
        outlier_value = o, outlier_rowname = g)
    class(RVAL) <- "htest"
    return(RVAL)
}