Home > Software design >  Is there way in ggplot2 to place text on a curved path?
Is there way in ggplot2 to place text on a curved path?

Time:11-08

Is there a way to put text along a density line, or for that matter, any path, in ggplot2? By that, I mean either once as a label, in this style of xkcd: enter image description here

Or, if we want to replace part of the line with text:

df$col <- cut(df$x, c(-1, 0.95, 2.24, 5), c("black", "white", "#000000"))

ggplot(df, aes(x, y))   
  geom_line(aes(color = col, group = col))   
  geom_text(aes(label = label, angle = angle), data = df2,
            size = 4, fontface = "bold")  
  scale_color_identity()  
  coord_equal()  
  theme_bw()

enter image description here

or, with some theme tweaks:

enter image description here


Addendum

Realistically, I probably won't get round to writing a geom_textpath package, but I thought it would be useful to show the sort of approach that might work for labelling density curves as per the OP's example. It requires the following suite of functions:

gradient_to_text_angle <- function(grad, mult = 1)
{
  angle <- mult * atan(grad) * 180 / pi
}

get_path_data <- function(x, y)
{
  grad <- diff(y)/diff(x)
  multiplier <- diff(range(x))/diff(range(y))
  new_x <- (head(x, -1)   tail(x, -1)) / 2
  new_y <- (head(y, -1)   tail(y, -1)) / 2
  path_length <- cumsum(sqrt(diff(x)^2   diff(multiplier * y)^2))
  data.frame(x = new_x, y = new_y, gradient = grad, 
             angle = gradient_to_text_angle(grad, multiplier/5), 
             length = path_length)
}

get_path_points <- function(path, x_start, x_end, n)
{
  start_dist <- approx(x = path$x, y = path$length, xout = x_start)$y
  end_dist <- approx(x = path$x, y = path$length, xout = x_end)$y
  dist_points <- seq(start_dist, end_dist, length.out = n)
  x <- approx(x = path$length, y = path$x, xout = dist_points)$y
  y <- approx(x = path$length, y = path$y, xout = dist_points)$y
  grad <- approx(x = path$length, y = path$gradient, xout = dist_points)$y
  angle <- approx(x = path$length, y = path$angle, xout = dist_points)$y
  data.frame(x = x, y = y, gradient = grad, 
             angle = angle, length = dist_points)
}

label_to_path <- function(label, path, x_start = head(path$x, 1), 
                          x_end = tail(path$x, 1)) 
{
  letters <- unlist(strsplit(label, "")[1])
  df <- get_path_points(path, x_start, x_end, length(letters))
  df$letter <- letters
  df
}


get_densities <- function(var, groups)
{
  if(missing(groups)) values <- list(var)
  else values <- split(var, groups)
  lapply(values, function(x) { 
    d <- density(x)
    data.frame(x = d$x, y = d$y)})
}

density_labels <- function(var, groups, proportion = 0.25)
{
  d <- get_densities(var, groups)
  d <- lapply(d, function(x) get_path_data(x$x, x$y))
  labels <- unique(groups)
  x_starts <- lapply(d, function(x) x$x[round((length(x$x) * (1 - proportion))/2)])
  x_ends <- lapply(d, function(x) x$x[round((length(x$x) * (1   proportion))/2)])
  do.call(rbind, lapply(seq_along(d), function(i) {
    df <- label_to_path(labels[i], d[[i]], x_starts[[i]], x_ends[[i]])
    df$group <- labels[i]
    df}))
}

With these functions defined, we can now do:

set.seed(100)

df <- data.frame(value = rpois(100, 3),
                 group = rep(paste("This is a nice long label",
                                   "that will demonstrate the ability",
                                   "of text to follow a density curve"), 100))

ggplot(df, aes(value))   
  geom_text(aes(x = x, y = y, label = letter, angle = angle), 
            data = density_labels(df$value, df$group, 0.8))  
  theme(legend.position = "none")

Created on 2021-11-07 by the reprex package (v2.0.0)

  • Related