Skip to content

Instantly share code, notes, and snippets.

@k-barton
Last active November 20, 2020 11:05
Show Gist options
  • Save k-barton/ce7229a56dde187b7af8077e6ed6455a to your computer and use it in GitHub Desktop.
Save k-barton/ce7229a56dde187b7af8077e6ed6455a to your computer and use it in GitHub Desktop.
Draw a connecting line to a label, not overlapping the label text (with base graphics).
# draws a line from point `x`, `y` to a text `label` located at `ly`, `ly`,
#' without overlapping the text area.
#' @example
#' plot(c(-1, 1), c(-1, 1), type = "n", ann = FALSE)
#' label.x <- .666
#' label.y <- .123
#' lab <- "multiline\nlabel"
#' cex <- 1.2345
#' a <- seq(0, pi, length.out = 15)
#' connector.line(sin(a), cos(a), label.x, label.y, lab, cex = cex, pad = c(.02, .02))
#' a <- seq(pi, 2 * pi, length.out = 15)
#' connector.line(sin(a), cos(a), label.x, label.y, lab, cex = cex, arrow = TRUE,
#' pad = c(0.01, 0.01), lty = 1:2,
#' length = .15)
#' text(label.x, label.y, lab, cex = 1.234)
connector.line <-
function(x, y, lx, ly, label, arrow = FALSE, pad = c(0, 0), cex = par("cex"), ...) {
z <- cbind(x, y, lx, ly, deparse.level = 0L)
x <- z[, 1L]
y <- z[, 2L]
lx <- z[, 3L]
ly <- z[, 4L]
n <- nrow(z)
label <- rep(label, length.out = n)
pad <- as.numeric(rep(pad, length.out = 2L))
dx <- x - lx
dy <- y - ly
l <- sqrt(dx^2 + dy^2)
w <- strwidth(label, cex = cex, units = "user") / 2 + pad[1L]
h <- strheight(label, cex = cex, units = "user") / 2 + pad[2L]
b1 <- abs(dx / dy)
b2 <- w / h
p <- matrix(NA_real_, ncol = 2L, nrow = n)
g <- b1 > b2
for(i in 1L:n) {
if(g[i]) {
p[i, 1L] <- lx[i] + (sign(dx[i]) * w[i])
p[i, 2L] <- ly[i] + (dy[i] * abs(w[i] / dx[i]))
} else {
p[i, 2L] <- ly[i] + (sign(dy[i]) * h[i])
p[i, 1L] <- lx[i] + (dx[i] * abs(h[i] / dy[i]))
}
}
(if(isTRUE(arrow)) arrows else segments)(p[, 1L], p[, 2L], x, y, ...)
invisible(p)
}
@k-barton
Copy link
Author

k-barton commented Aug 8, 2019

plot(c(-1, 1), c(-1, 1), type = "n", ann = FALSE)
label.x <- .666
label.y <- .123
lab <- "multiline\nlabel"
cex <- 1.2345
a <- seq(0, pi, length.out = 15)
connector.line(sin(a), cos(a), label.x, label.y, lab, cex = cex, pad = c(.02, .02))
a <- seq(pi, 2 * pi, length.out = 15)
connector.line(sin(a), cos(a), label.x, label.y, lab, cex = cex, arrow = TRUE,
               pad = c(0.01, 0.01), lty = 1:2,
               length = .15)
text(label.x, label.y, lab, cex = 1.234)

connector-line-example

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment