Question

I am developing a graphic with ggplot2 wherein I need to superimpose text over other graphical elements. Depending on the color of the elements underlying the text, it can be difficult to read the text. Is there a way to draw geom_text in a bounding box with a semi-transparent background?

I can do this with plotrix:

library(plotrix)
Labels <- c("Alabama", "Alaska", "Arizona", "Arkansas")
SampleFrame <- data.frame(X = 1:10, Y = 1:10)
TextFrame <- data.frame(X = 4:7, Y = 4:7, LAB = Labels)
### plotrix ###
plot(SampleFrame, pch = 20, cex = 20)
boxed.labels(TextFrame$X, TextFrame$Y, TextFrame$LAB,
 bg = "#ffffff99", border = FALSE,
 xpad = 3/2, ypad = 3/2)

But I do not know of a way to achieve similar results with ggplot2:

### ggplot2 ###
library(ggplot2)
Plot <- ggplot(data = SampleFrame,
 aes(x = X, y = Y)) + geom_point(size = 20)
Plot <- Plot + geom_text(data = TextFrame,
 aes(x = X, y = Y, label = LAB))
print(Plot)

As you can see, the black text labels are impossible to perceive where they overlap the black geom_points in the background.

Answer 1

Try this geom, which is slightly modified from GeomText.

GeomText2 <- proto(GeomText, {
  objname <- "text2"
  draw <- function(., data, scales, coordinates, ..., parse = FALSE,
                   expand = 1.2, bgcol = "grey50", bgfill = NA, bgalpha = 1) {
    lab <- data$label
    if (parse) {
      lab <- parse(text = lab)
    }

    with(coordinates$transform(data, scales), {
      tg <- do.call("mapply",
        c(function(...) {
            tg <- with(list(...), textGrob(lab, default.units="native", rot=angle, gp=gpar(fontsize=size * .pt)))
            list(w = grobWidth(tg), h = grobHeight(tg))
          }, data))
      gList(rectGrob(x, y,
                     width = do.call(unit.c, tg["w",]) * expand,
                     height = do.call(unit.c, tg["h",]) * expand,
                     gp = gpar(col = alpha(bgcol, bgalpha), fill = alpha(bgfill, bgalpha))),
            .super$draw(., data, scales, coordinates, ..., parse))
    })
  }
})

geom_text2 <- GeomText2$build_accessor()

Labels <- c("Alabama", "Alaska", "Arizona", "Arkansas")
SampleFrame <- data.frame(X = 1:10, Y = 1:10)
TextFrame <- data.frame(X = 4:7, Y = 4:7, LAB = Labels)

Plot <- ggplot(data = SampleFrame, aes(x = X, y = Y)) + geom_point(size = 20)
Plot <- Plot + geom_text2(data = TextFrame, aes(x = X, y = Y, label = LAB),
                          size = 5, expand = 1.5, bgcol = "green", bgfill = "skyblue", bgalpha = 0.8)
print(Plot)

BUG FIXED AND CODE IMPROVED

GeomText2 <- proto(GeomText, {
  objname <- "text2"
  draw <- function(., data, scales, coordinates, ..., parse = FALSE,
                   expand = 1.2, bgcol = "grey50", bgfill = NA, bgalpha = 1) {
    lab <- data$label
    if (parse) {
      lab <- parse(text = lab)
    }
    with(coordinates$transform(data, scales), {
      sizes <- llply(1:nrow(data),
        function(i) with(data[i, ], {
          grobs <- textGrob(lab[i], default.units="native", rot=angle, gp=gpar(fontsize=size * .pt))
          list(w = grobWidth(grobs), h = grobHeight(grobs))
        }))

      gList(rectGrob(x, y,
                     width = do.call(unit.c, lapply(sizes, "[[", "w")) * expand,
                     height = do.call(unit.c, lapply(sizes, "[[", "h")) * expand,
                     gp = gpar(col = alpha(bgcol, bgalpha), fill = alpha(bgfill, bgalpha))),
            .super$draw(., data, scales, coordinates, ..., parse))
    })
  }
})

geom_text2 <- GeomText2$build_accessor()