Last active
June 27, 2023 01:04
-
-
Save k-barton/ca144a569a70ca3a6d7ddcacfefbb4d3 to your computer and use it in GitHub Desktop.
Draw a rectangle surrounding text in a plot
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# All arguments as in `graphics::text`, except pad which specifies padding (optionally | |
# for vertical and horizontal) around the text as a fraction of a character width. | |
# `...` is passed to `rect` | |
textbox <- | |
function(x, y, labels, adj = NULL, | |
pos = NULL, | |
offset = 0.5, | |
pad = c(0, 0), | |
vfont = NULL, | |
cex = par("cex"), | |
font = NULL, ...) { | |
xy <- xy.coords(x, y, recycle = TRUE, setLab = FALSE) | |
n <- length(xy$x) | |
if(is.call(labels)) labels <- as.expression(labels) | |
pad <- as.numeric(rep(pad, length.out = 2L)) | |
if(is.null(pos)) | |
pos <- NA | |
if(is.null(font)) | |
font <- par("font") | |
u2ix <- function(x) grconvertX(x, from = "user", to = "inch") | |
u2iy <- function(x) grconvertY(x, from = "user", to = "inch") | |
i2ux <- function(x) grconvertX(x, from = "in", to = "user") | |
i2uy <- function(x) grconvertY(x, from = "in", to = "user") | |
# from now on all is in inches | |
x <- u2ix(xy$x) | |
y <- u2iy(xy$y) | |
offset <- grconvertX(offset, from = "chars", to = "in") | |
pad <- grconvertX(pad, from = "chars", to = "in") | |
adj <- if (is.null(adj)) { | |
c(.5, .5) | |
} else if (is.numeric(adj)) { | |
if (length(adj) == 0) { | |
c(.5, .5) | |
} else if (length(adj) == 1L) { | |
c(adj, .5) | |
} else { | |
adj[1L:2L] | |
} | |
} else stop("invalid 'adj' value") | |
# values taken from R source src/library/grDevices/src/dev*.c | |
yCharOffset <- switch(names(dev.cur()), | |
windows = 0.40, | |
"xfig" = , "pdf" = , "postscript" = 0.3333, | |
pictex = 0, | |
#CAIRO | |
"png" =, "jpeg"=, "svg"=, "png"=, | |
"cairo_pdf"=, "cairo_ps"=, "tiff"=, "bmp"= 0.3333, | |
"null device" = stop("no device is open"), | |
stop("unknown device") | |
) | |
z <- .mapply(function(x, y, s, pos, cex, font, pad, ...) { | |
switch(pos, { # 1 bottom | |
y <- y - offset | |
adj <- c(0.5, 1 - (0.5 - yCharOffset)) | |
}, { # 2 left | |
x <- x - offset | |
adj <- c(1, yCharOffset) | |
}, { # 3 top | |
y <- y + offset | |
adjx <- 0.5 | |
adjy <- 0 | |
adj <- c(.5, 0) | |
}, { # 4 right | |
x <- x + offset | |
adj <- c(0, yCharOffset) | |
}, { }) | |
w <- strwidth(s, cex = cex, units = "in", font = font, vfont = vfont) | |
h <- strheight(s, cex = cex, units = "in", font = font, vfont = vfont) | |
x <- x - (adj[1L] * w) | |
y <- y - (adj[2L] * h) | |
c(x - pad[1L], y - pad[2L], x + w + pad[1L], y + h + pad[2L]) | |
}, | |
list(x = x, y = y, s = labels, pos = pos, cex = cex, | |
font = font, ...), | |
MoreArgs = list(pad = pad)) | |
z <- do.call("rbind", z) | |
rect(i2ux(z[, 1L]), i2uy(z[, 2L]), | |
i2ux(z[, 3L]), i2uy(z[, 4L]), | |
...) | |
} |
Author
k-barton
commented
Jun 27, 2023
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment