在ggplot中标记段的中点

Question

In the plot below I'd like to label the arrows with the text in bar$lbl . I'd like to do so in a way that would keep any labels from overlapping (they wouldn't in the simple example below). I'd prefer not to calculate the label position by hand.

I'm familiar with getting pretty, non-overlapping labels on points with ggrepel and curious if there is a similar way to label the midpoints of segments?

Any advice appreciated.

library(ggplot2)
foo <- data.frame(x=runif(50),y=runif(50))
bar <- data.frame(x1=c(0.2,0),x2=c(0.7,0.2),
                  y1=c(0.1,0.9),y2=c(0.6,0.5),
                  lbl=c("Arrow 1", "Arrow 2"))
p1 <- ggplot(data=foo,aes(x=x,y=y))
p1 <- p1 + geom_point(color="grey")
p1 <- p1 + geom_segment(data=bar,aes(x=x1, xend=x2, y=y1, yend=y2), 
                        size = 0.75,arrow = arrow(length = unit(0.5, "cm")))
p1

Answer 1

I know you would prefer not to calculate the mid points by hand, however, it is often easier to work with variables inside the aesthetics then with statistics, so I did it calculating the midpoints before hand and mapping to the axis

library(ggplot2)
library(directlabels) # provides a geom_dl that works easier with labels

foo <- data.frame(x=runif(50),y=runif(50))
bar <- data.frame(x1=c(0.2,0),x2=c(0.7,0.2),
                  y1=c(0.1,0.9),y2=c(0.6,0.5),
                  midx = c(0.45, 0.1), # x mid points
                  midy = c(0.35, 0.7), # y midpoints
                  lbl=c("Arrow 1", "Arrow 2"))

p1 <- ggplot(data=foo,aes(x=x,y=y))
p1 <- p1 + geom_point(color="grey")
p1 <- p1 + geom_segment(data=bar,aes(x=x1, xend=x2, y=y1, yend=y2), 
                        size = 0.75,arrow = arrow(length = unit(0.5, "cm")))
p1 + geom_dl(data = bar, aes(x = midx, y = midy, label = lbl),
             method = list(dl.trans(x = unit(x, 'cm'), y = unit(y, 'cm'))))

Answer 2

Here are two ways to do it with a lot of tidying. You don't need to do anything by hand if you think about the fact that the midpoint has coordinates that are just the means of x values and the means of y values of the 2 endpoints. First way is to tidy your data frame, calculate the midpoints, then make it wide again to have x and y columns. That data frame goes into ggplot , so it's passed through all the geoms, but we override with data arguments to geom_point and geom_segment . geom_segment gets just the original copy of the bar data frame.

library(tidyverse)
foo <- data.frame(x=runif(50),y=runif(50))
bar <- data.frame(x1=c(0.2,0),x2=c(0.7,0.2),
                                    y1=c(0.1,0.9),y2=c(0.6,0.5),
                                    lbl=c("Arrow 1", "Arrow 2"))

bar %>%
    gather(key = coord, value = value, -lbl) %>%
    mutate(coord = str_sub(coord, 1, 1)) %>%
    group_by(lbl, coord) %>%
    summarise(value = mean(value)) %>%
    ungroup() %>%
    spread(key = coord, value = value) %>%
    ggplot() +
        geom_point(aes(x = x, y = y), data = foo, color = "grey") +
        geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), data = bar, size = 0.75, arrow = arrow(length = unit(0.5, "cm"))) +
        geom_text(aes(x = x, y = y, label = lbl))

But maybe you don't want to do all that piping at the beginning, or you have to do this several times, so you want a function to calculate the midpoints. For the second version, I wrote a function that does basically what was piped into ggplot in the first version. You supply it with the bare column name where your labels are kept, which is the column it will be grouped on. Then you can just use that in your geom_text .

## cool function!
tidy_midpt <- function(df, lbl_col) {
    lbl_quo <- enquo(lbl_col)

    df %>%
        gather(key = coord, value = value, -!!lbl_quo) %>%
        mutate(coord = str_sub(coord, 1, 1)) %>%
        group_by(lbl, coord) %>%
        summarise(value = mean(value)) %>%
        ungroup() %>%
        spread(key = coord, value = value)
}

ggplot(data = bar) +
    geom_point(aes(x = x, y = y), data = foo, color = "grey") +
    geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), size = 0.75, arrow = arrow(length = unit(0.5, "cm"))) +
    geom_text(aes(x = x, y = y, label = lbl), data = . %>% tidy_midpt(lbl))

Created on 2018-05-03 by the reprex package (v0.2.0).