How to highlight significant results in Tukey Test

Question

I am using R in order to create a graph for my Tukey Test after my ANOVA analysis. This is the code: TukeyHSD(my.anova)

Tukeytest <- TukeyHSD(my.anova)

plot(Tukeytest)

I get this figure:

What I want to do is to highlight significant results (lines 1 and 3) with red color. I'd appreciate if I can get help here.

Answer 1

I've hacked stats:::plot.TukeyHSD to do this.

fm1 <- aov(breaks ~ wool + tension, data = warpbreaks)
tt <- TukeyHSD(fm1, "tension", ordered = TRUE)
png("tukey_red.png")
my_plot(tt)
dev.off()

---

There is one extra argument, and three modified lines of code (indicated by comments).

## add sig.col as an argument
my_plot <- function (x, sig.col = "red", ...) {
    for (i in seq_along(x)) {
      xi <- x[[i]][, -4L, drop = FALSE]
      ## assign colors for significant entries
      seg.col <- ifelse(sign(xi[, "lwr"]*xi[, "upr"]) > 0,
                    sig.col, par("fg"))
      yvals <- nrow(xi):1L
      dev.hold()
      on.exit(dev.flush())
      plot(c(xi[, "lwr"], xi[, "upr"]), rep.int(yvals, 2L),
           type = "n", axes = FALSE, xlab = "", ylab = "", main = NULL,
           ...)
      axis(1, ...)
      axis(2, at = nrow(xi):1, labels = dimnames(xi)[[1L]],
           srt = 0, ...)
      abline(h = yvals, lty = 1, lwd = 0.5, col = "lightgray")
      abline(v = 0, lty = 2, lwd = 0.5, ...)
      ## add seg.col to the next two statements
      segments(xi[, "lwr"], yvals, xi[, "upr"], yvals,
               col = seg.col, ...)
      segments(as.vector(xi), rep.int(yvals - 0.1, 3L), as.vector(xi),
               rep.int(yvals + 0.1, 3L),
               rep(seg.col, 3), ...)
      title(main = paste0(format(100 * attr(x, "conf.level"),
                                 digits = 2L), "% family-wise confidence level\n"),
            xlab = paste("Differences in mean levels of", names(x)[i]))
      box()
      dev.flush()
      on.exit()
    }
}