Text labels with background colour in R
Apparently, there does not seem to be a simple solution. So, I wrote my own function which does the job:
#' Add text with background box to a plot
#'
#' \code{boxtext} places a text given in the vector \code{labels}
#' onto a plot in the base graphics system and places a coloured box behind
#' it to make it stand out from the background.
#'
#' @param x numeric vector of x-coordinates where the text labels should be
#' written. If the length of \code{x} and \code{y} differs, the shorter one
#' is recycled.
#' @param y numeric vector of y-coordinates where the text labels should be
#' written.
#' @param labels a character vector specifying the text to be written.
#' @param col.text the colour of the text
#' @param col.bg color(s) to fill or shade the rectangle(s) with. The default
#' \code{NA} means do not fill, i.e., draw transparent rectangles.
#' @param border.bg color(s) for rectangle border(s). The default \code{NA}
#' omits borders.
#' @param adj one or two values in [0, 1] which specify the x (and optionally
#' y) adjustment of the labels.
#' @param pos a position specifier for the text. If specified this overrides
#' any adj value given. Values of 1, 2, 3 and 4, respectively indicate
#' positions below, to the left of, above and to the right of the specified
#' coordinates.
#' @param offset when \code{pos} is specified, this value gives the offset of
#' the label from the specified coordinate in fractions of a character width.
#' @param padding factor used for the padding of the box around
#' the text. Padding is specified in fractions of a character width. If a
#' vector of length two is specified then different factors are used for the
#' padding in x- and y-direction.
#' @param cex numeric character expansion factor; multiplied by
#' code{par("cex")} yields the final character size.
#' @param font the font to be used
#'
#' @return Returns the coordinates of the background rectangle(s). If
#' multiple labels are placed in a vactor then the coordinates are returned
#' as a matrix with columns corresponding to xleft, xright, ybottom, ytop.
#' If just one label is placed, the coordinates are returned as a vector.
#' @author Ian Kopacka
#' @examples
#' ## Create noisy background
#' plot(x = runif(1000), y = runif(1000), type = "p", pch = 16,
#' col = "#40404060")
#' boxtext(x = 0.5, y = 0.5, labels = "some Text", col.bg = "#b2f4f480",
#' pos = 4, font = 2, cex = 1.3, padding = 1)
#' @export
boxtext <- function(x, y, labels = NA, col.text = NULL, col.bg = NA,
border.bg = NA, adj = NULL, pos = NULL, offset = 0.5,
padding = c(0.5, 0.5), cex = 1, font = graphics::par('font')){
## The Character expansion factro to be used:
theCex <- graphics::par('cex')*cex
## Is y provided:
if (missing(y)) y <- x
## Recycle coords if necessary:
if (length(x) != length(y)){
lx <- length(x)
ly <- length(y)
if (lx > ly){
y <- rep(y, ceiling(lx/ly))[1:lx]
} else {
x <- rep(x, ceiling(ly/lx))[1:ly]
}
}
## Width and height of text
textHeight <- graphics::strheight(labels, cex = theCex, font = font)
textWidth <- graphics::strwidth(labels, cex = theCex, font = font)
## Width of one character:
charWidth <- graphics::strwidth("e", cex = theCex, font = font)
## Is 'adj' of length 1 or 2?
if (!is.null(adj)){
if (length(adj == 1)){
adj <- c(adj[1], 0.5)
}
} else {
adj <- c(0.5, 0.5)
}
## Is 'pos' specified?
if (!is.null(pos)){
if (pos == 1){
adj <- c(0.5, 1)
offsetVec <- c(0, -offset*charWidth)
} else if (pos == 2){
adj <- c(1, 0.5)
offsetVec <- c(-offset*charWidth, 0)
} else if (pos == 3){
adj <- c(0.5, 0)
offsetVec <- c(0, offset*charWidth)
} else if (pos == 4){
adj <- c(0, 0.5)
offsetVec <- c(offset*charWidth, 0)
} else {
stop('Invalid argument pos')
}
} else {
offsetVec <- c(0, 0)
}
## Padding for boxes:
if (length(padding) == 1){
padding <- c(padding[1], padding[1])
}
## Midpoints for text:
xMid <- x + (-adj[1] + 1/2)*textWidth + offsetVec[1]
yMid <- y + (-adj[2] + 1/2)*textHeight + offsetVec[2]
## Draw rectangles:
rectWidth <- textWidth + 2*padding[1]*charWidth
rectHeight <- textHeight + 2*padding[2]*charWidth
graphics::rect(xleft = xMid - rectWidth/2,
ybottom = yMid - rectHeight/2,
xright = xMid + rectWidth/2,
ytop = yMid + rectHeight/2,
col = col.bg, border = border.bg)
## Place the text:
graphics::text(xMid, yMid, labels, col = col.text, cex = theCex, font = font,
adj = c(0.5, 0.5))
## Return value:
if (length(xMid) == 1){
invisible(c(xMid - rectWidth/2, xMid + rectWidth/2, yMid - rectHeight/2,
yMid + rectHeight/2))
} else {
invisible(cbind(xMid - rectWidth/2, xMid + rectWidth/2, yMid - rectHeight/2,
yMid + rectHeight/2))
}
}
This function allows me to add text to a plot with a background box while retaining most of the flexibility of the function text()
.
Example:
## Create noisy background:
plot(x = runif(1000), y = runif(1000), type = "p", pch = 16, col = "#40404060")
## Vector of labels, using argument 'pos' to position right of coordinates:
boxtext(x = c(0.3, 0.1), y = c(0.6, 0.1), labels = c("some Text", "something else"),
col.bg = "#b2f4f4c0", pos = 4, padding = 0.3)
## Tweak cex, font and adj:
boxtext(x = 0.2, y = 0.4, labels = "some big and bold text",
col.bg = "#b2f4f4c0", adj = c(0, 0.6), font = 2, cex = 1.8)
Base graphics
Using legend
:
plot(x = runif(1000), y = runif(1000), type = "p", pch = 16, col = "#40404050")
legend(0.4, 0.5, "Some text", box.col = "lightblue", bg = "lightblue", adj = 0.2)
Output:
ggplot2
With geom_label
:
library(ggplot2)
df <- data.frame(x = runif(1000), y = runif(1000))
ggplot(data = df, aes(x = x , y = y))+
geom_point(alpha = 0.2)+
geom_label(aes(x = 0.5, y = 0.5, label = "Some text"),
fill = "lightblue", label.size = NA, size = 5)
Output:
Quick hack using altcode character for a box:
plot(x=runif(1000), y=runif(1000),
type="p", pch=16, col="#40404050")
labels <- c("some text", "something else")
boxes <- sapply(nchar(labels), function(n)
paste(rep("\U2588", n), collapse=""))
pos <- rbind(c(0.2, .1), c(.5, .5))
text(pos, labels=boxes, col="#CCCCCC99")
text(pos, labels=labels, family = "mono")