[Rd] Silent failure with NA results in fligner.test()

[Karolis K]

Hello,

In certain cases fligner.test() returns NaN statistic and NA p-value.
The issue happens when, after centering with the median, all absolute values become constant, which ten leads to identical ranks.

Below are a few examples:

# 2 groups, 2 values each
# issue is caused by residual values after centering (-0.5, 0.5, -0.5, 0.5)
# then, after taking the absolute value, all the ranks become identical.
> fligner.test(c(2,3,4,5), gl(2,2))

        Fligner-Killeen test of homogeneity of variances

data:  c(2, 3, 4, 5) and gl(2, 2)
Fligner-Killeen:med chi-squared = NaN, df = 1, p-value = NA


# similar situation with more observations and 3 groups
> fligner.test(c(2,3,2,3,4,4,5,5,8,9,9,8), gl(3,4))

        Fligner-Killeen test of homogeneity of variances

data:  c(2, 3, 2, 3, 4, 4, 5, 5, 8, 9, 9, 8) and gl(3, 4)
Fligner-Killeen:med chi-squared = NaN, df = 2, p-value = NA


Two simple patches are proposed below. One returns an error, and another returns a p-value of 1.
Not sure which one is more appropriate, so submitting both.

Warm regards,
Karolis Koncevičius

---

Index: fligner.test.R
===================================================================
--- fligner.test.R	(revision 79650)
+++ fligner.test.R	(working copy)
@@ -59,8 +59,13 @@
         stop("data are essentially constant")
 
     a <- qnorm((1 + rank(abs(x)) / (n + 1)) / 2)
-    STATISTIC <- sum(tapply(a, g, "sum")^2 / tapply(a, g, "length"))
-    STATISTIC <- (STATISTIC - n * mean(a)^2) / var(a)
+    if (var(a) > 0) {
+        STATISTIC <- sum(tapply(a, g, "sum")^2 / tapply(a, g, "length"))
+        STATISTIC <- (STATISTIC - n * mean(a)^2) / var(a)
+    }
+    else {
+        STATISTIC <- 0
+    }
     PARAMETER <- k - 1
     PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE)
     names(STATISTIC) <- "Fligner-Killeen:med chi-squared”

---

Index: fligner.test.R
===================================================================
--- fligner.test.R	(revision 79650)
+++ fligner.test.R	(working copy)
@@ -57,6 +57,8 @@
     x <- x - tapply(x,g,median)[g]
     if (all(x == 0))
         stop("data are essentially constant")
+    if (var(abs(x)) == 0)
+        stop("absolute residuals from the median are essentially constant")
 
     a <- qnorm((1 + rank(abs(x)) / (n + 1)) / 2)
     STATISTIC <- sum(tapply(a, g, "sum")^2 / tapply(a, g, "length"))